commit 51170f34acb8f5c420f728f3e755be2f8961ef11 (HEAD, refs/remotes/origin/master) Author: Steven De Herdt Date: Sat Nov 24 23:57:57 2018 +0100 Honor 'vc-bzr-log-switches' in 'vc-bzr-expanded-log-entry' * lisp/vc/vc-bzr.el (vc-bzr-expanded-log-entry): Honor 'vc-bzr-log-switches'. (Bug#33494) Copyright-paperwork-exempt: yes diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index 8e1a6bec20..e6d636f23c 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -782,7 +782,11 @@ If LIMIT is non-nil, show no more than this many entries." (defun vc-bzr-expanded-log-entry (revision) (with-temp-buffer (apply 'vc-bzr-command "log" t nil nil - (list "--long" (format "-r%s" revision))) + (append + (list "--long" (format "-r%s" revision)) + (if (stringp vc-bzr-log-switches) + (list vc-bzr-log-switches) + vc-bzr-log-switches))) (goto-char (point-min)) (when (looking-at "^-+\n") ;; Indent the expanded log entry. commit 7e9f62c0bc3b4f3d47deb5917c90ea449a19460b Merge: 2877471fef d2b3a37886 Author: Eli Zaretskii Date: Sat Dec 8 11:13:28 2018 +0200 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit 2877471fefc21d157462d766afbcf3b2c47c4ee8 Author: Eli Zaretskii Date: Sat Dec 8 11:12:38 2018 +0200 Document that Eshell follows symlinks in history file names * etc/NEWS: Mention that Eshell now follows symlinks in history file names. diff --git a/etc/NEWS b/etc/NEWS index cad44f9233..f6a03aee22 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -820,8 +820,15 @@ To restore the old behavior, use 'eshell-uniqify-list'. *** The function 'eshell/kill' is now able to handle signal switches. -Previously 'eshell/kill' would fail if provided a kill signal to send to the -process. It now accepts signals specified either by name or by its number. +Previously 'eshell/kill' would fail if provided a kill signal to send +to the process. It now accepts signals specified either by name or by +its number. + +--- +*** Emacs now follows symlinks in history-related files. +The files specified by 'eshell-history-file-name' and +'eshell-last-dir-ring-file-name' can include symlinks; these are now +followed when Emacs writes the relevant history variables to the disk. ** Shell commit ddb6efdbc52d9abc09511842988c5220961e1ec8 Author: Philip Hudson Date: Sat Nov 24 00:16:14 2018 +0000 Follow links in Eshell last-dir-ring * lisp/eshell/em-hist.el (eshell-write-last-dir-ring): Follow symlinks in 'eshell-last-dir-ring-file-name'. (Bug#33477) diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el index b7d13ee27b..c16a5ac6e0 100644 --- a/lisp/eshell/em-dirs.el +++ b/lisp/eshell/em-dirs.el @@ -552,15 +552,16 @@ in the minibuffer: (defun eshell-write-last-dir-ring () "Write the buffer's `eshell-last-dir-ring' to a history file." - (let ((file eshell-last-dir-ring-file-name)) + (let* ((file eshell-last-dir-ring-file-name) + (resolved-file (file-truename file))) (cond ((or (null file) (equal file "") (null eshell-last-dir-ring) (ring-empty-p eshell-last-dir-ring)) nil) - ((not (file-writable-p file)) - (message "Cannot write last-dir-ring file %s" file)) + ((not (file-writable-p resolved-file)) + (message "Cannot write last-dir-ring file %s" resolved-file)) (t (let* ((ring eshell-last-dir-ring) (index (ring-length ring))) @@ -570,7 +571,7 @@ in the minibuffer: (insert (ring-ref ring index) ?\n)) (insert (eshell/pwd) ?\n) (eshell-with-private-file-modes - (write-region (point-min) (point-max) file nil + (write-region (point-min) (point-max) resolved-file nil 'no-message)))))))) (provide 'em-dirs) commit 3660d665874dfea54571be0619f5d033b7873594 Author: Philip Hudson Date: Wed Nov 21 23:09:16 2018 +0000 Follow symlink in Eshell history * lisp/eshell/em-hist.el (eshell-write-history): Follow symlinks in 'eshell-history-file-name'. (Bug#33460) diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el index 62e2f57d0f..f866dfd727 100644 --- a/lisp/eshell/em-hist.el +++ b/lisp/eshell/em-hist.el @@ -466,15 +466,16 @@ lost if `eshell-history-ring' is not empty. If Useful within process sentinels. See also `eshell-read-history'." - (let ((file (or filename eshell-history-file-name))) + (let* ((file (or filename eshell-history-file-name)) + (resolved-file (file-truename file))) (cond ((or (null file) (equal file "") (null eshell-history-ring) (ring-empty-p eshell-history-ring)) nil) - ((not (file-writable-p file)) - (message "Cannot write history file %s" file)) + ((not (file-writable-p resolved-file)) + (message "Cannot write history file %s" resolved-file)) (t (let* ((ring eshell-history-ring) (index (ring-length ring))) @@ -489,7 +490,7 @@ See also `eshell-read-history'." (insert (substring-no-properties (ring-ref ring index)) ?\n) (subst-char-in-region start (1- (point)) ?\n ?\177))) (eshell-with-private-file-modes - (write-region (point-min) (point-max) file append + (write-region (point-min) (point-max) resolved-file append 'no-message)))))))) (defun eshell-list-history () commit d2b3a37886d97abdc10e16f6389200e8ad45dd7a Author: Martin Rudalics Date: Sat Dec 8 09:37:40 2018 +0100 New buffer display action alist entry 'window-min-height' (Bug#32825) * lisp/window.el (display-buffer-below-selected): Handle 'window-min-height' action alist entry (Bug#32825). * doc/lispref/windows.texi (Buffer Display Action Functions) (Buffer Display Action Alists): Add documentation for 'window-min-height' action alist entries. * etc/NEWS: Mention 'window-min-height' action alist entry. diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index b86bccab20..eb05766211 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -2607,6 +2607,12 @@ suitable @code{window-height} or @code{window-width} entry, see above. If splitting the selected window fails and there is a non-dedicated window below the selected one showing some other buffer, this function tries to use that window for showing @var{buffer}. + +If @var{alist} contains a @code{window-min-height} entry, this +function ensures that the window used is or can become at least as +high as specified by that entry's value. Note that this is only a +guarantee. In order to actually resize the window used, @var{alist} +must also provide an appropriate @code{window-height} entry. @end defun @defun display-buffer-at-bottom buffer alist @@ -2790,6 +2796,22 @@ The value specifies an alist of window parameters to give the chosen window. All action functions that choose a window should process this entry. +@vindex window-min-height@r{, a buffer display action alist entry} +@item window-min-height +The value specifies a minimum height of the window used, in lines. If +a window is not or cannot be made as high as specified by this entry, +the window is not considered for use. The only client of this entry +is presently @code{display-buffer-below-selected}. + +Note that providing such an entry alone does not necessarily make the +window as tall as specified by its value. To actually resize an +existing window or make a new window as tall as specified by that +value, a @code{window-height} entry specifying that value should be +provided as well. Such a @code{window-height} entry can, however, +specify a completely different value or ask the window height to be +fit to that of its buffer in which case the @code{window-min-height} +entry provides the guaranteed minimum height of the window used. + @vindex window-height@r{, a buffer display action alist entry} @item window-height The value specifies whether and how to adjust the height of the chosen diff --git a/etc/NEWS b/etc/NEWS index cad44f9233..7a0db87265 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1227,6 +1227,12 @@ of the Emacs Lisp Reference manual for more detail. A buffer-local value of this hook is now run only if at least one window showing the buffer has changed its size. ++++ +** New buffer display action alist entry 'window-min-height'. +Such an entry allows to specify a minimum height of the window used +for displaying a buffer. 'display-buffer-below-selected' is the only +action function to respect it at the moment. + +++ ** The function 'assoc-delete-all' now takes an optional predicate argument. diff --git a/lisp/window.el b/lisp/window.el index a16ceb4eb9..25a599f91d 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -7465,22 +7465,45 @@ If there is a window below the selected one and that window already displays BUFFER, use that window. Otherwise, try to create a new window below the selected one and show BUFFER there. If that attempt fails as well and there is a non-dedicated window -below the selected one, use that window." - (let (window) +below the selected one, use that window. + +If ALIST contains a 'window-min-height' entry, this function +ensures that the window used is or can become at least as high as +specified by that entry's value. Note that such an entry alone +will not resize the window per se. In order to do that, ALIST +must also contain a 'window-height' entry with the same value." + (let ((min-height (cdr (assq 'window-min-height alist))) + window) (or (and (setq window (window-in-direction 'below)) - (eq buffer (window-buffer window)) + (eq buffer (window-buffer window)) + (or (not (numberp min-height)) + (>= (window-height window) min-height) + ;; 'window--display-buffer' can resize this window if + ;; and only if it has a 'quit-restore' parameter + ;; certifying that it always showed BUFFER before. + (let ((height (window-height window)) + (quit-restore (window-parameter window 'quit-restore))) + (and quit-restore + (eq (nth 1 quit-restore) 'window) + (window-resizable-p window (- min-height height))))) (window--display-buffer buffer window 'reuse alist)) (and (not (frame-parameter nil 'unsplittable)) - (let ((split-height-threshold 0) + (or (not (numberp min-height)) + (window-sizable-p nil (- min-height))) + (let ((split-height-threshold 0) split-width-threshold) - (setq window (window--try-to-split-window + (setq window (window--try-to-split-window (selected-window) alist))) - (window--display-buffer - buffer window 'window alist display-buffer-mark-dedicated)) + (window--display-buffer + buffer window 'window alist display-buffer-mark-dedicated)) (and (setq window (window-in-direction 'below)) - (not (window-dedicated-p window)) + (not (window-dedicated-p window)) + (or (not (numberp min-height)) + ;; A window that showed another buffer before cannot + ;; be resized. + (>= (window-height window) min-height)) (window--display-buffer - buffer window 'reuse alist display-buffer-mark-dedicated))))) + buffer window 'reuse alist display-buffer-mark-dedicated))))) (defun display-buffer--maybe-at-bottom (buffer alist) (let ((alist (append alist `(,(if temp-buffer-resize-mode commit 1d676aabca4bdba6948fb7a9d875ba63b51aed63 Author: Martin Rudalics Date: Sat Dec 8 09:18:28 2018 +0100 Adjust windows' previous buffers when reverting dired buffers (Bug#33458) * lisp/dired.el (dired-save-positions, dired-restore-positions): For each window that showed the reverted buffer before, fix the point positions in its list of previously shown buffers the way these routines handle window point for all windows currently showing the buffer (Bug#33458). diff --git a/lisp/dired.el b/lisp/dired.el index cbd85fed91..e5dc8623a4 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1478,12 +1478,36 @@ change; the point does." (list w (dired-get-filename nil t) (line-number-at-pos (window-point w))))) - (get-buffer-window-list nil 0 t)))) + (get-buffer-window-list nil 0 t)) + ;; For each window that showed the current buffer before, scan its + ;; list of previous buffers. For each association thus found save + ;; a triple where 'point' is that window's + ;; window-point marker stored in the window's list of previous + ;; buffers, 'name' is the filename at the position of 'point' and + ;; 'line' is the line number at the position of 'point'. + (let ((buffer (current-buffer)) + prevs) + (walk-windows + (lambda (window) + (let ((prev (assq buffer (window-prev-buffers window)))) + (when prev + (with-current-buffer buffer + (save-excursion + (goto-char (nth 2 prev)) + (setq prevs + (cons + (list (nth 2 prev) + (dired-get-filename nil t) + (line-number-at-pos (point))) + prevs))))))) + 'nomini t) + prevs))) (defun dired-restore-positions (positions) "Restore POSITIONS saved with `dired-save-positions'." (let* ((buf-file-pos (nth 0 positions)) - (buffer (nth 0 buf-file-pos))) + (buffer (nth 0 buf-file-pos)) + (prevs (nth 2 positions))) (unless (and (nth 1 buf-file-pos) (dired-goto-file (nth 1 buf-file-pos))) (goto-char (point-min)) @@ -1497,7 +1521,21 @@ change; the point does." (dired-goto-file (nth 1 win-file-pos))) (goto-char (point-min)) (forward-line (1- (nth 2 win-file-pos))) - (dired-move-to-filename))))))) + (dired-move-to-filename))))) + (when prevs + (with-current-buffer buffer + (save-excursion + (dolist (prev prevs) + (let ((point (nth 0 prev))) + ;; Sanity check of the point marker. + (when (and (markerp point) + (eq (marker-buffer point) buffer)) + (unless (and (nth 0 prev) + (dired-goto-file (nth 1 prev))) + (goto-char (point-min)) + (forward-line (1- (nth 2 prev)))) + (dired-move-to-filename) + (move-marker point (point) buffer))))))))) (defun dired-remember-marks (beg end) "Return alist of files and their marks, from BEG to END." commit 1fc73de597ba395b3575c70dae68b6c3e5b5a3b7 Author: Martin Rudalics Date: Sat Dec 8 09:01:23 2018 +0100 Improve how 'balance-windows' handles fixed-size windows (Bug#33254) * lisp/window.el (balance-windows-2): When a child window has fixed size, don't count it as resizable (Bug#33254). Handle case where a window has no resizable child windows. diff --git a/lisp/window.el b/lisp/window.el index 2634955a75..a16ceb4eb9 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -5317,11 +5317,12 @@ is non-nil)." (total-sum parent-size) failed size sub-total sub-delta sub-amount rest) (while sub - (setq number-of-children (1+ number-of-children)) - (when (window-size-fixed-p sub horizontal) - (setq total-sum - (- total-sum (window-size sub horizontal t))) - (set-window-new-normal sub 'ignore)) + (if (window-size-fixed-p sub horizontal) + (progn + (setq total-sum + (- total-sum (window-size sub horizontal t))) + (set-window-new-normal sub 'ignore)) + (setq number-of-children (1+ number-of-children))) (setq sub (window-right sub))) (setq failed t) @@ -5346,16 +5347,16 @@ is non-nil)." (set-window-new-normal sub 'skip))) (setq sub (window-right sub)))) - ;; How can we be sure that `number-of-children' is NOT zero here ? - (setq rest (% total-sum number-of-children)) - ;; Fix rounding by trying to enlarge non-stuck windows by one line - ;; (column) until `rest' is zero. - (setq sub first) - (while (and sub (> rest 0)) - (unless (window--resize-child-windows-skip-p window) - (set-window-new-pixel sub (min rest char-size) t) - (setq rest (- rest char-size))) - (setq sub (window-right sub))) + (when (> number-of-children 0) + (setq rest (% total-sum number-of-children)) + ;; Fix rounding by trying to enlarge non-stuck windows by one line + ;; (column) until `rest' is zero. + (setq sub first) + (while (and sub (> rest 0)) + (unless (window--resize-child-windows-skip-p window) + (set-window-new-pixel sub (min rest char-size) t) + (setq rest (- rest char-size))) + (setq sub (window-right sub)))) ;; Fix rounding by trying to enlarge stuck windows by one line ;; (column) until `rest' equals zero. commit f6a69957d654f0d0d870209da303b4e9360d577e Author: Alan Mackenzie Date: Fri Dec 7 17:38:03 2018 +0000 CC Mode: Compensate for backward-sexp ignoring trailing commas after {...} This fixes bug #32808. * lisp/progmodes/cc-engine.el (c-beginning-of-statement-1): New variable comma-delimited, set when we're about to scan backward over a comma. Do not reckon a brace block as bounding a statement when it is followed or preceded by a comma (except when argument comma-delim is non-nil). (c-guess-basic-syntax, CASE 9C): Call c-beginning-of-statement-1 with argument comma-delim changed to non-nil. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 9cd2174b66..376d0bb3d3 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -1080,12 +1080,15 @@ comment at the start of cc-engine.el for more info." (let ((before-sws-pos (point)) ;; The end position of the area to search for statement ;; barriers in this round. - (maybe-after-boundary-pos pos)) + (maybe-after-boundary-pos pos) + comma-delimited) ;; Go back over exactly one logical sexp, taking proper ;; account of macros and escaped EOLs. (while (progn + (setq comma-delimited (and (not comma-delim) + (eq (char-before) ?\,))) (unless (c-safe (c-backward-sexp) t) ;; Give up if we hit an unbalanced block. Since the ;; stack won't be empty the code below will report a @@ -1121,6 +1124,7 @@ comment at the start of cc-engine.el for more info." ;; Just gone back over a brace block? ((and (eq (char-after) ?{) + (not comma-delimited) (not (c-looking-at-inexpr-block lim nil t)) (save-excursion (c-backward-token-2 1 t nil) @@ -1132,8 +1136,11 @@ comment at the start of cc-engine.el for more info." (if (and (looking-at c-symbol-start) (not (looking-at c-keywords-regexp))) (c-backward-token-2 1 t nil)) - (not (looking-at - c-opt-block-decls-with-vars-key))))) + (and + (not (looking-at + c-opt-block-decls-with-vars-key)) + (or comma-delim + (not (eq (char-after) ?\,))))))) (save-excursion (c-forward-sexp) (point))) ;; Just gone back over some paren block? @@ -12711,7 +12718,7 @@ comment at the start of cc-engine.el for more info." (c-back-over-member-initializers) (point))) (c-most-enclosing-brace state-cache (point)))) - (c-beginning-of-statement-1 lim) + (c-beginning-of-statement-1 lim nil nil t) (c-add-stmt-syntax 'brace-list-intro nil t lim paren-state))) ;; CASE 9D: this is just a later brace-list-entry or commit 294b2c2bb71f1f7e7024a854d4a4ae43785d9594 Author: Michael Albinus Date: Fri Dec 7 17:21:03 2018 +0100 Refactor some Tramp functions * lisp/net/tramp-compat.el (tramp-compat-file-local-name): New defsubst. (tramp-compat-file-name-quoted-p, tramp-compat-file-name-quote) (tramp-compat-file-name-unquote): * lisp/net/tramp.el (tramp-handle-file-name-case-insensitive-p) (tramp-handle-file-truename, tramp-get-remote-tmpdir): * lisp/net/tramp-adb.el (tramp-adb-handle-copy-file) (tramp-adb-handle-rename-file, tramp-adb-handle-exec-path): * lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file-directly) (tramp-sh-handle-exec-path, tramp-find-inline-encoding) (tramp-get-remote-touch): Use it. * lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist): Use `tramp-handle-expand-file-name'. (tramp-adb-handle-expand-file-name): Move to tramp.el. (tramp-adb-handle-file-writable-p): Adapt docstring. * lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): Use `tramp-handle-file-local-copy', `tramp-handle-file-writable-p' and `tramp-handle-write-region'. (tramp-gvfs-handle-file-local-copy) (tramp-gvfs-handle-file-writable-p) (tramp-gvfs-handle-write-region): Move to tramp.el. * lisp/net/tramp-rclone.el: Dont't require `tramp-adb' and `tramp-gvfs' anymore. (tramp-rclone-file-name-handler-alist): Use `tramp-handle-expand-file-name', `tramp-handle-file-local-copy', `tramp-handle-file-writable-p' and `tramp-handle-write-region'. (tramp-rclone-handle-directory-files): Simplify. * lisp/net/tramp.el (tramp-methods): Extend docstring. (tramp-parse-netrc): Require `netrc'. (tramp-handle-expand-file-name, tramp-handle-file-local-copy) (tramp-handle-file-writable-p, tramp-handle-write-region): New defuns. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 76bcdf0941..7906ec9f7c 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -108,7 +108,7 @@ It is used for TCP/IP devices." (dired-compress-file . ignore) (dired-uncache . tramp-handle-dired-uncache) (exec-path . tramp-adb-handle-exec-path) - (expand-file-name . tramp-adb-handle-expand-file-name) + (expand-file-name . tramp-handle-expand-file-name) (file-accessible-directory-p . tramp-handle-file-accessible-directory-p) (file-acl . ignore) (file-attributes . tramp-adb-handle-file-attributes) @@ -226,28 +226,6 @@ pass to the OPERATION." result) result)))) -(defun tramp-adb-handle-expand-file-name (name &optional dir) - "Like `expand-file-name' for Tramp files." - ;; If DIR is not given, use DEFAULT-DIRECTORY or "/". - (setq dir (or dir default-directory "/")) - ;; Unless NAME is absolute, concat DIR and NAME. - (unless (file-name-absolute-p name) - (setq name (concat (file-name-as-directory dir) name))) - ;; If NAME is not a Tramp file, run the real handler. - (if (not (tramp-tramp-file-p name)) - (tramp-run-real-handler 'expand-file-name (list name nil)) - ;; Dissect NAME. - (with-parsed-tramp-file-name name nil - (unless (tramp-run-real-handler 'file-name-absolute-p (list localname)) - (setq localname (concat "/" localname))) - ;; Do normal `expand-file-name' (this does "/./" and "/../"). - ;; `default-directory' is bound, because on Windows there would - ;; be problems with UNC shares or Cygwin mounts. - (let ((default-directory (tramp-compat-temporary-file-directory))) - (tramp-make-tramp-file-name - v (tramp-drop-volume-letter - (tramp-run-real-handler 'expand-file-name (list localname)))))))) - (defun tramp-adb-handle-file-system-info (filename) "Like `file-system-info' for Tramp files." (ignore-errors @@ -640,7 +618,7 @@ Emacs dired can't find files." tmpfile))) (defun tramp-adb-handle-file-writable-p (filename) - "Like `tramp-sh-handle-file-writable-p'. + "Like `file-writable-p' for Tramp files. But handle the case, if the \"test\" command is not available." (with-parsed-tramp-file-name filename nil (with-tramp-file-property v localname "file-writable-p" @@ -754,8 +732,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." v 0 (format "Copying %s to %s" filename newname) (if (and t1 t2 (tramp-equal-remote filename newname)) - (let ((l1 (file-remote-p filename 'localname)) - (l2 (file-remote-p newname 'localname))) + (let ((l1 (tramp-compat-file-local-name filename)) + (l2 (tramp-compat-file-local-name newname))) (when (and (not ok-if-already-exists) (file-exists-p newname)) (tramp-error v 'file-already-exists newname)) @@ -835,8 +813,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (if (and t1 t2 (tramp-equal-remote filename newname) (not (file-directory-p filename))) - (let ((l1 (file-remote-p filename 'localname)) - (l2 (file-remote-p newname 'localname))) + (let ((l1 (tramp-compat-file-local-name filename)) + (l2 (tramp-compat-file-local-name newname))) (when (and (not ok-if-already-exists) (file-exists-p newname)) (tramp-error v 'file-already-exists newname)) @@ -1132,7 +1110,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (read (current-buffer))) ":" 'omit))) ;; The equivalent to `exec-directory'. - `(,(file-remote-p default-directory 'localname)))) + `(,(tramp-compat-file-local-name default-directory)))) (defun tramp-adb-get-device (vec) "Return full host name from VEC to be used in shell execution. diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 9e02ebb24d..01377240ad 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -187,15 +187,23 @@ This is a string of ten letters or dashes as in ls -l." (if (get 'file-missing 'error-conditions) 'file-missing 'file-error) "The error symbol for the `file-missing' error.") -;; `file-name-quoted-p', `file-name-quote' and `file-name-unquote' are -;; introduced in Emacs 26. +;; `file-local-name', `file-name-quoted-p', `file-name-quote' and +;; `file-name-unquote' are introduced in Emacs 26. (eval-and-compile + (if (fboundp 'file-local-name) + (defalias 'tramp-compat-file-local-name 'file-local-name) + (defsubst tramp-compat-file-local-name (name) + "Return the local name component of NAME. +It returns a file name which can be used directly as argument of +`process-file', `start-file-process', or `shell-command'." + (or (file-remote-p name 'localname) name))) + (if (fboundp 'file-name-quoted-p) (defalias 'tramp-compat-file-name-quoted-p 'file-name-quoted-p) (defsubst tramp-compat-file-name-quoted-p (name) "Whether NAME is quoted with prefix \"/:\". If NAME is a remote file name, check the local part of NAME." - (string-prefix-p "/:" (or (file-remote-p name 'localname) name)))) + (string-prefix-p "/:" (tramp-compat-file-local-name name)))) (if (fboundp 'file-name-quote) (defalias 'tramp-compat-file-name-quote 'file-name-quote) @@ -205,14 +213,14 @@ If NAME is a remote file name, the local part of NAME is quoted." (if (tramp-compat-file-name-quoted-p name) name (concat - (file-remote-p name) "/:" (or (file-remote-p name 'localname) name))))) + (file-remote-p name) "/:" (tramp-compat-file-local-name name))))) (if (fboundp 'file-name-unquote) (defalias 'tramp-compat-file-name-unquote 'file-name-unquote) (defsubst tramp-compat-file-name-unquote (name) "Remove quotation prefix \"/:\" from file NAME. If NAME is a remote file name, the local part of NAME is unquoted." - (let ((localname (or (file-remote-p name 'localname) name))) + (let ((localname (tramp-compat-file-local-name name))) (when (tramp-compat-file-name-quoted-p localname) (setq localname (if (= (length localname) 2) "/" (substring localname 2)))) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 8211872471..e034f7bba5 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -546,7 +546,7 @@ It has been changed in GVFS 1.14.") (file-executable-p . tramp-gvfs-handle-file-executable-p) (file-exists-p . tramp-handle-file-exists-p) (file-in-directory-p . tramp-handle-file-in-directory-p) - (file-local-copy . tramp-gvfs-handle-file-local-copy) + (file-local-copy . tramp-handle-file-local-copy) (file-modes . tramp-handle-file-modes) (file-name-all-completions . tramp-gvfs-handle-file-name-all-completions) (file-name-as-directory . tramp-handle-file-name-as-directory) @@ -567,7 +567,7 @@ It has been changed in GVFS 1.14.") (file-symlink-p . tramp-handle-file-symlink-p) (file-system-info . tramp-gvfs-handle-file-system-info) (file-truename . tramp-handle-file-truename) - (file-writable-p . tramp-gvfs-handle-file-writable-p) + (file-writable-p . tramp-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `get-file-buffer' performed by default handler. (insert-directory . tramp-handle-insert-directory) @@ -592,7 +592,7 @@ It has been changed in GVFS 1.14.") (unhandled-file-name-directory . ignore) (vc-registered . ignore) (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) - (write-region . tramp-gvfs-handle-write-region)) + (write-region . tramp-handle-write-region)) "Alist of handler functions for Tramp GVFS method. Operations not mentioned here will be handled by the default Emacs primitives.") @@ -1132,17 +1132,6 @@ If FILE-SYSTEM is non-nil, return file system attributes." (with-tramp-file-property v localname "file-executable-p" (tramp-check-cached-permissions v ?x)))) -(defun tramp-gvfs-handle-file-local-copy (filename) - "Like `file-local-copy' for Tramp files." - (with-parsed-tramp-file-name filename nil - (unless (file-exists-p filename) - (tramp-error - v tramp-file-missing - "Cannot make local copy of non-existing file `%s'" filename)) - (let ((tmpfile (tramp-compat-make-temp-file filename))) - (copy-file filename tmpfile 'ok-if-already-exists 'keep-time) - tmpfile))) - (defun tramp-gvfs-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." (unless (string-match-p "/" filename) @@ -1280,16 +1269,6 @@ file-notify events." (- (string-to-number size) (string-to-number used)) (string-to-number free)))))) -(defun tramp-gvfs-handle-file-writable-p (filename) - "Like `file-writable-p' for Tramp files." - (with-parsed-tramp-file-name filename nil - (with-tramp-file-property v localname "file-writable-p" - (if (file-exists-p filename) - (tramp-check-cached-permissions v ?w) - ;; If file doesn't exist, check if directory is writable. - (and (file-directory-p (file-name-directory filename)) - (file-writable-p (file-name-directory filename))))))) - (defun tramp-gvfs-handle-make-directory (dir &optional parents) "Like `make-directory' for Tramp files." (setq dir (directory-file-name (expand-file-name dir))) @@ -1324,48 +1303,6 @@ file-notify events." (tramp-run-real-handler 'rename-file (list filename newname ok-if-already-exists)))) -(defun tramp-gvfs-handle-write-region - (start end filename &optional append visit lockname mustbenew) - "Like `write-region' for Tramp files." - (setq filename (expand-file-name filename)) - (with-parsed-tramp-file-name filename nil - (when (and mustbenew (file-exists-p filename) - (or (eq mustbenew 'excl) - (not - (y-or-n-p - (format "File %s exists; overwrite anyway? " filename))))) - (tramp-error v 'file-already-exists filename)) - - (let ((tmpfile (tramp-compat-make-temp-file filename))) - (when (and append (file-exists-p filename)) - (copy-file filename tmpfile 'ok)) - ;; We say `no-message' here because we don't want the visited file - ;; modtime data to be clobbered from the temp file. We call - ;; `set-visited-file-modtime' ourselves later on. - (tramp-run-real-handler - 'write-region (list start end tmpfile append 'no-message lockname)) - (condition-case nil - (rename-file tmpfile filename 'ok-if-already-exists) - (error - (delete-file tmpfile) - (tramp-error - v 'file-error "Couldn't write region to `%s'" filename)))) - - (tramp-flush-file-properties v (file-name-directory localname)) - (tramp-flush-file-properties v localname) - - ;; Set file modification time. - (when (or (eq visit t) (stringp visit)) - (set-visited-file-modtime - (tramp-compat-file-attribute-modification-time - (file-attributes filename)))) - - ;; The end. - (when (and (null noninteractive) - (or (eq visit t) (null visit) (stringp visit))) - (tramp-message v 0 "Wrote %s" filename)) - (run-hooks 'tramp-handle-write-region-hook))) - ;; File name conversions. diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 3f3cac8ebc..5ea42c07bf 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -31,17 +31,13 @@ ;; A remote file under rclone control has the form ;; "/rclone::/path/to/file". is the name of a ;; storage system in rclone's configuration. Therefore, such a remote -;; file name does not know any user or port specification. +;; file name does not know of any user or port specification. ;;; Code: (eval-when-compile (require 'cl-lib)) (require 'tramp) -;; TODDDDDDDDDO: REPLACE -(require 'tramp-adb) -(require 'tramp-gvfs) - ;;;###tramp-autoload (defconst tramp-rclone-method "rclone" "When this method name is used, forward all calls to rclone mounts.") @@ -86,7 +82,7 @@ (dired-compress-file . ignore) (dired-uncache . tramp-handle-dired-uncache) (exec-path . ignore) - (expand-file-name . tramp-adb-handle-expand-file-name) + (expand-file-name . tramp-handle-expand-file-name) (file-accessible-directory-p . tramp-handle-file-accessible-directory-p) (file-acl . ignore) (file-attributes . tramp-rclone-handle-file-attributes) @@ -95,7 +91,7 @@ (file-executable-p . tramp-rclone-handle-file-executable-p) (file-exists-p . tramp-handle-file-exists-p) (file-in-directory-p . tramp-handle-file-in-directory-p) - (file-local-copy . tramp-gvfs-handle-file-local-copy) + (file-local-copy . tramp-handle-file-local-copy) (file-modes . tramp-handle-file-modes) (file-name-all-completions . tramp-rclone-handle-file-name-all-completions) (file-name-as-directory . tramp-handle-file-name-as-directory) @@ -116,7 +112,7 @@ (file-symlink-p . tramp-handle-file-symlink-p) (file-system-info . tramp-rclone-handle-file-system-info) (file-truename . tramp-handle-file-truename) - (file-writable-p . tramp-gvfs-handle-file-writable-p) + (file-writable-p . tramp-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `get-file-buffer' performed by default handler. (insert-directory . tramp-handle-insert-directory) @@ -141,7 +137,7 @@ (unhandled-file-name-directory . ignore) (vc-registered . ignore) (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) - (write-region . tramp-gvfs-handle-write-region)) + (write-region . tramp-handle-write-region)) "Alist of handler functions for Tramp RCLONE method. Operations not mentioned here will be handled by the default Emacs primitives.") @@ -328,12 +324,10 @@ file names." (tramp-rclone-local-file-name directory) full match))) ;; Massage the result. (when full - (let* ((quoted (tramp-compat-file-name-quoted-p directory)) - (local - (concat "^" (regexp-quote (tramp-rclone-mount-point v)))) - (remote - (funcall (if quoted 'tramp-compat-file-name-quote 'identity) - (file-remote-p directory)))) + (let ((local (concat "^" (regexp-quote (tramp-rclone-mount-point v)))) + (remote (funcall (if (tramp-compat-file-name-quoted-p directory) + 'tramp-compat-file-name-quote 'identity) + (file-remote-p directory)))) (setq result (mapcar (lambda (x) (replace-regexp-in-string local remote x)) @@ -427,8 +421,7 @@ file names." (insert-file-contents (tramp-rclone-local-file-name filename) visit beg end replace))) (prog1 - (list (expand-file-name filename) - (cadr result)) + (list (expand-file-name filename) (cadr result)) (when visit (setq buffer-file-name filename))))) (defun tramp-rclone-handle-make-directory (dir &optional parents) @@ -609,10 +602,7 @@ connection if a previous connection has died for some reason." ;;; TODO: -;; * Refactor tramp-gvfs.el in order to move used functions to -;; tramp.el. -;; -;; * If possible, get rid of rclone mount. Maybe it is more +;; * If possible, get rid of "rclone mount". Maybe it is more ;; performant then. ;;; tramp-rclone.el ends here diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 3f426bb040..a6e9d299a8 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2192,8 +2192,8 @@ the uid and gid from FILENAME." v 'file-error "Unknown operation `%s', must be `copy' or `rename'" op)))) - (localname1 (if t1 (file-remote-p filename 'localname) filename)) - (localname2 (if t2 (file-remote-p newname 'localname) newname)) + (localname1 (tramp-compat-file-local-name filename)) + (localname2 (tramp-compat-file-local-name newname)) (prefix (file-remote-p (if t1 filename newname))) cmd-result) (when (and (eq op 'copy) (file-directory-p filename)) @@ -3087,7 +3087,7 @@ the result will be a local, non-Tramp, file name." (append (tramp-get-remote-path (tramp-dissect-file-name default-directory)) ;; The equivalent to `exec-directory'. - `(,(file-remote-p default-directory 'localname)))) + `(,(tramp-compat-file-local-name default-directory)))) (defun tramp-sh-handle-file-local-copy (filename) "Like `file-local-copy' for Tramp files." @@ -4448,8 +4448,7 @@ Goes through the list `tramp-local-coding-commands' and (format-spec value (format-spec-make - ?t - (file-remote-p tmpfile 'localname))))) + ?t (tramp-compat-file-local-name tmpfile))))) (tramp-maybe-send-script vec value name) (setq rem-dec name))) (tramp-message @@ -5531,7 +5530,7 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil." "%s -t %s %s" result (format-time-string "%Y%m%d%H%M.%S") - (file-remote-p tmpfile 'localname)))) + (tramp-compat-file-local-name tmpfile)))) (delete-file tmpfile)) result))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 02870faf64..a44abfdcbb 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -169,6 +169,7 @@ See the variable `tramp-encoding-shell' for more information." This is a list of entries of the form (NAME PARAM1 PARAM2 ...). Each NAME stands for a remote access method. Each PARAM is a pair of the form (KEY VALUE). The following KEYs are defined: + * `tramp-remote-shell' This specifies the shell to use on the remote host. This MUST be a Bourne-like shell. It is normally not necessary to @@ -177,19 +178,23 @@ pair of the form (KEY VALUE). The following KEYs are defined: for it. Also note that \"/bin/sh\" exists on all Unixen, this might not be true for the value that you decide to use. You Have Been Warned. + * `tramp-remote-shell-login' This specifies the arguments to let `tramp-remote-shell' run as a login shell. It defaults to (\"-l\"), but some shells, like ksh, require another argument. See `tramp-connection-properties' for a way to overwrite the default value. + * `tramp-remote-shell-args' For implementation of `shell-command', this specifies the arguments to let `tramp-remote-shell' run a single command. + * `tramp-login-program' This specifies the name of the program to use for logging in to the remote host. This may be the name of rsh or a workalike program, or the name of telnet or a workalike, or the name of su or a workalike. + * `tramp-login-args' This specifies the list of arguments to pass to the above mentioned program. Please note that this is a list of list of arguments, @@ -205,59 +210,88 @@ pair of the form (KEY VALUE). The following KEYs are defined: `tramp-make-tramp-temp-file'. \"%k\" indicates the keep-date parameter of a program, if exists. \"%c\" adds additional `tramp-ssh-controlmaster-options' options for the first hop. + The existence of `tramp-login-args', combined with the absence of + `tramp-copy-args', is an indication that the method is capable of + multi-hops. + * `tramp-login-env' A list of environment variables and their values, which will be set when calling `tramp-login-program'. + * `tramp-async-args' When an asynchronous process is started, we know already that the connection works. Therefore, we can pass additional parameters to suppress diagnostic messages, in order not to tamper the process output. + * `tramp-copy-program' This specifies the name of the program to use for remotely copying the file; this might be the absolute filename of scp or the name of a workalike program. It is always applied on the local host. + * `tramp-copy-args' This specifies the list of parameters to pass to the above mentioned program, the hints for `tramp-login-args' also apply here. + * `tramp-copy-env' A list of environment variables and their values, which will be set when calling `tramp-copy-program'. + * `tramp-remote-copy-program' The listener program to be applied on remote side, if needed. + * `tramp-remote-copy-args' The list of parameters to pass to the listener program, the hints for `tramp-login-args' also apply here. Additionally, \"%r\" could be used here and in `tramp-copy-args'. It denotes a randomly chosen port for the remote listener. + * `tramp-copy-keep-date' This specifies whether the copying program when the preserves the timestamp of the original file. + * `tramp-copy-keep-tmpfile' This specifies whether a temporary local file shall be kept for optimization reasons (useful for \"rsync\" methods). + * `tramp-copy-recursive' Whether the operation copies directories recursively. + * `tramp-default-port' The default port of a method. + * `tramp-tmpdir' A directory on the remote host for temporary files. If not specified, \"/tmp\" is taken as default. + * `tramp-connection-timeout' This is the maximum time to be spent for establishing a connection. In general, the global default value shall be used, but for some methods, like \"su\" or \"sudo\", a shorter timeout might be desirable. + * `tramp-session-timeout' How long a Tramp connection keeps open before being disconnected. This is useful for methods like \"su\" or \"sudo\", which shouldn't run an open connection in the background forever. + * `tramp-case-insensitive' Whether the remote file system handles file names case insensitive. Only a non-nil value counts, the default value nil means to perform further checks on the remote host. See `tramp-connection-properties' for a way to overwrite this. + * `tramp-mount-args' + * `tramp-copyto-args' + * `tramp-moveto-args' + * `tramp-about-args' + These parameters, a list of list like `tramp-login-args', are used + for the \"rclone\" method, and are appended to the respective + \"rclone\" commands. In general, they shouldn't be changed inside + `tramp-methods'; it is recommended to change their values via + `tramp-connection-properties'. Unlike `tramp-login-args' there is + no pattern replacement. + What does all this mean? Well, you should specify `tramp-login-program' for all methods; this program is used to log in to the remote site. Then, there are two ways to actually transfer the files between the local and the @@ -2993,6 +3027,7 @@ Host is always \"localhost\"." (defun tramp-parse-netrc (filename) "Return a list of (user host) tuples allowed to access. User may be nil." + (require 'netrc) (mapcar (lambda (item) (and (assoc "machine" item) @@ -3101,6 +3136,28 @@ User is always nil." (if (file-directory-p dir) dir (file-name-directory dir)) nil (tramp-flush-directory-properties v localname))) +(defun tramp-handle-expand-file-name (name &optional dir) + "Like `expand-file-name' for Tramp files." + ;; If DIR is not given, use DEFAULT-DIRECTORY or "/". + (setq dir (or dir default-directory "/")) + ;; Unless NAME is absolute, concat DIR and NAME. + (unless (file-name-absolute-p name) + (setq name (concat (file-name-as-directory dir) name))) + ;; If NAME is not a Tramp file, run the real handler. + (if (not (tramp-tramp-file-p name)) + (tramp-run-real-handler 'expand-file-name (list name nil)) + ;; Dissect NAME. + (with-parsed-tramp-file-name name nil + (unless (tramp-run-real-handler 'file-name-absolute-p (list localname)) + (setq localname (concat "/" localname))) + ;; Do normal `expand-file-name' (this does "/./" and "/../"). + ;; `default-directory' is bound, because on Windows there would + ;; be problems with UNC shares or Cygwin mounts. + (let ((default-directory (tramp-compat-temporary-file-directory))) + (tramp-make-tramp-file-name + v (tramp-drop-volume-letter + (tramp-run-real-handler 'expand-file-name (list localname)))))))) + (defun tramp-handle-file-accessible-directory-p (filename) "Like `file-accessible-directory-p' for Tramp files." (and (file-directory-p filename) @@ -3136,6 +3193,17 @@ User is always nil." (file-remote-p (expand-file-name directory))) (tramp-run-real-handler 'file-in-directory-p (list filename directory)))) +(defun tramp-handle-file-local-copy (filename) + "Like `file-local-copy' for Tramp files." + (with-parsed-tramp-file-name filename nil + (unless (file-exists-p filename) + (tramp-error + v tramp-file-missing + "Cannot make local copy of non-existing file `%s'" filename)) + (let ((tmpfile (tramp-compat-make-temp-file filename))) + (copy-file filename tmpfile 'ok-if-already-exists 'keep-time) + tmpfile))) + (defun tramp-handle-file-modes (filename) "Like `file-modes' for Tramp files." (let ((truename (or (file-truename filename) filename))) @@ -3184,7 +3252,7 @@ User is always nil." ;; lower case letters. This avoids us to create a ;; temporary file. (while (and (string-match-p - "[a-z]" (file-remote-p candidate 'localname)) + "[a-z]" (tramp-compat-file-local-name candidate)) (not (file-exists-p candidate))) (setq candidate (directory-file-name @@ -3195,7 +3263,7 @@ User is always nil." ;; so there is no compatibility problem calling it. (unless (string-match-p - "[a-z]" (file-remote-p candidate 'localname)) + "[a-z]" (tramp-compat-file-local-name candidate)) (setq tmpfile (let ((default-directory (file-name-directory filename))) @@ -3208,7 +3276,7 @@ User is always nil." (file-exists-p (concat (file-remote-p candidate) - (upcase (file-remote-p candidate 'localname)))) + (upcase (tramp-compat-file-local-name candidate)))) ;; Cleanup. (when tmpfile (delete-file tmpfile))))))))))) @@ -3341,7 +3409,17 @@ User is always nil." (tramp-error v1 'file-error "Maximum number (%d) of symlinks exceeded" numchase-limit))) - (file-remote-p (directory-file-name result) 'localname))))))) + (tramp-compat-file-local-name (directory-file-name result)))))))) + +(defun tramp-handle-file-writable-p (filename) + "Like `file-writable-p' for Tramp files." + (with-parsed-tramp-file-name filename nil + (with-tramp-file-property v localname "file-writable-p" + (if (file-exists-p filename) + (tramp-check-cached-permissions v ?w) + ;; If file doesn't exist, check if directory is writable. + (and (file-directory-p (file-name-directory filename)) + (file-writable-p (file-name-directory filename))))))) (defun tramp-handle-find-backup-file-name (filename) "Like `find-backup-file-name' for Tramp files." @@ -3717,6 +3795,48 @@ of." ;; only if that agrees with the buffer's record. (t (tramp-compat-time-equal-p mt tramp-time-doesnt-exist)))))))) +(defun tramp-handle-write-region + (start end filename &optional append visit lockname mustbenew) + "Like `write-region' for Tramp files." + (setq filename (expand-file-name filename)) + (with-parsed-tramp-file-name filename nil + (when (and mustbenew (file-exists-p filename) + (or (eq mustbenew 'excl) + (not + (y-or-n-p + (format "File %s exists; overwrite anyway? " filename))))) + (tramp-error v 'file-already-exists filename)) + + (let ((tmpfile (tramp-compat-make-temp-file filename))) + (when (and append (file-exists-p filename)) + (copy-file filename tmpfile 'ok)) + ;; We say `no-message' here because we don't want the visited file + ;; modtime data to be clobbered from the temp file. We call + ;; `set-visited-file-modtime' ourselves later on. + (tramp-run-real-handler + 'write-region (list start end tmpfile append 'no-message lockname)) + (condition-case nil + (rename-file tmpfile filename 'ok-if-already-exists) + (error + (delete-file tmpfile) + (tramp-error + v 'file-error "Couldn't write region to `%s'" filename)))) + + (tramp-flush-file-properties v (file-name-directory localname)) + (tramp-flush-file-properties v localname) + + ;; Set file modification time. + (when (or (eq visit t) (stringp visit)) + (set-visited-file-modtime + (tramp-compat-file-attribute-modification-time + (file-attributes filename)))) + + ;; The end. + (when (and (null noninteractive) + (or (eq visit t) (null visit) (stringp visit))) + (tramp-message v 0 "Wrote %s" filename)) + (run-hooks 'tramp-handle-write-region-hook))) + ;; This is used in tramp-gvfs.el and tramp-sh.el. (defconst tramp-gio-events '("attribute-changed" "changed" "changes-done-hint" @@ -4344,7 +4464,7 @@ This handles also chrooted environments, which are not regarded as local." (tramp-make-tramp-file-name vec (or (tramp-get-method-parameter vec 'tramp-tmpdir) "/tmp")))) (or (and (file-directory-p dir) (file-writable-p dir) - (file-remote-p dir 'localname)) + (tramp-compat-file-local-name dir)) (tramp-error vec 'file-error "Directory %s not accessible" dir)) dir))) diff --git a/lisp/net/zeroconf.el b/lisp/net/zeroconf.el index 0a3f2777b9..25a8dea431 100644 --- a/lisp/net/zeroconf.el +++ b/lisp/net/zeroconf.el @@ -528,22 +528,27 @@ DOMAIN is nil, the local domain is used." zeroconf-avahi-current-domain zeroconf-avahi-flags-unspec)))) +(defvar zeroconf-service-type-browser-handler-running nil + "Prevent infinite recursion in `zeroconf-service-type-browser-handler'.") + (defun zeroconf-service-type-browser-handler (&rest val) "Registered service type browser handler at the Avahi daemon." - (when zeroconf-debug - (message "zeroconf-service-type-browser-handler: %s %S" - (dbus-event-member-name last-input-event) val)) - (cond - ((string-equal (dbus-event-member-name last-input-event) "ItemNew") - ;; Parameters: (interface protocol type domain flags) - ;; Register a service browser. - (let ((object-path (zeroconf-register-service-browser (nth 2 val)))) - ;; Register the signals. - (dolist (member '("ItemNew" "ItemRemove" "Failure")) - (dbus-register-signal - :system zeroconf-service-avahi object-path - zeroconf-interface-avahi-service-browser member - 'zeroconf-service-browser-handler)))))) + (unless zeroconf-service-type-browser-handler-running + (let ((zeroconf-service-type-browser-handler-running t)) + (when zeroconf-debug + (message "zeroconf-service-type-browser-handler: %s %S" + (dbus-event-member-name last-input-event) val)) + (cond + ((string-equal (dbus-event-member-name last-input-event) "ItemNew") + ;; Parameters: (interface protocol type domain flags) + ;; Register a service browser. + (let ((object-path (zeroconf-register-service-browser (nth 2 val)))) + ;; Register the signals. + (dolist (member '("ItemNew" "ItemRemove" "Failure")) + (dbus-register-signal + :system zeroconf-service-avahi object-path + zeroconf-interface-avahi-service-browser member + 'zeroconf-service-browser-handler)))))))) (defun zeroconf-register-service-browser (type) "Register a service browser at the Avahi daemon." commit e4a8f6ebbf4e8cf4d87d5b7b9940b61b51073fd3 Author: Eli Zaretskii Date: Fri Dec 7 10:54:57 2018 +0200 Fix the value of default-directory upon startup on MS-Windows * src/w32.c (w32_get_current_directory): New function. (GetCachedVolumeInformation, init_environment): Use it. (w32_init_current_directory): New function. * src/w32.h (w32_init_current_directory): Add prototype. * src/emacs.c (main) [WINDOWSNT]: Use w32_init_current_directory to get the accurate value of cwd. This is needed to record the correct directory in emacs_wd, which is now initialized way earlier in the startup process, when init_environment was not yet called. For details, see the problems reported in http://lists.gnu.org/archive/html/emacs-devel/2018-12/msg00068.html. Reported by Angelo Graziosi . diff --git a/src/emacs.c b/src/emacs.c index acb4959bfe..eddd729f0a 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -736,6 +736,8 @@ main (int argc, char **argv) /* Initialize the codepage for file names, needed to decode non-ASCII file names during startup. */ w32_init_file_name_codepage (); + /* Initialize the startup directory, needed for emacs_wd below. */ + w32_init_current_directory (); #endif w32_init_main_thread (); #endif @@ -816,6 +818,10 @@ main (int argc, char **argv) exit (1); } original_pwd = emacs_wd; +#ifdef WINDOWSNT + /* Reinitialize Emacs's notion of the startup directory. */ + w32_init_current_directory (); +#endif emacs_wd = emacs_get_current_dir_name (); } diff --git a/src/w32.c b/src/w32.c index 26cfae7a6a..dc8bed582c 100644 --- a/src/w32.c +++ b/src/w32.c @@ -1771,7 +1771,40 @@ filename_from_ansi (const char *fn_in, char *fn_out) /* The directory where we started, in UTF-8. */ static char startup_dir[MAX_UTF8_PATH]; -/* Get the current working directory. */ +/* Get the current working directory. The caller must arrange for CWD + to be allocated with enough space to hold a 260-char directory name + in UTF-8. IOW, the space should be at least MAX_UTF8_PATH bytes. */ +static void +w32_get_current_directory (char *cwd) +{ + /* FIXME: Do we need to resolve possible symlinks in startup_dir? + Does it matter anywhere in Emacs? */ + if (w32_unicode_filenames) + { + wchar_t wstartup_dir[MAX_PATH]; + + if (!GetCurrentDirectoryW (MAX_PATH, wstartup_dir)) + emacs_abort (); + filename_from_utf16 (wstartup_dir, cwd); + } + else + { + char astartup_dir[MAX_PATH]; + + if (!GetCurrentDirectoryA (MAX_PATH, astartup_dir)) + emacs_abort (); + filename_from_ansi (astartup_dir, cwd); + } +} + +/* For external callers. Used by 'main' in emacs.c. */ +void +w32_init_current_directory (void) +{ + w32_get_current_directory (startup_dir); +} + +/* Return the original directory where Emacs started. */ char * getcwd (char *dir, int dirsize) { @@ -2997,24 +3030,7 @@ init_environment (char ** argv) } /* Remember the initial working directory for getcwd. */ - /* FIXME: Do we need to resolve possible symlinks in startup_dir? - Does it matter anywhere in Emacs? */ - if (w32_unicode_filenames) - { - wchar_t wstartup_dir[MAX_PATH]; - - if (!GetCurrentDirectoryW (MAX_PATH, wstartup_dir)) - emacs_abort (); - filename_from_utf16 (wstartup_dir, startup_dir); - } - else - { - char astartup_dir[MAX_PATH]; - - if (!GetCurrentDirectoryA (MAX_PATH, astartup_dir)) - emacs_abort (); - filename_from_ansi (astartup_dir, startup_dir); - } + w32_get_current_directory (startup_dir); { static char modname[MAX_PATH]; @@ -3198,22 +3214,7 @@ GetCachedVolumeInformation (char * root_dir) /* NULL for root_dir means use root from current directory. */ if (root_dir == NULL) { - if (w32_unicode_filenames) - { - wchar_t curdirw[MAX_PATH]; - - if (GetCurrentDirectoryW (MAX_PATH, curdirw) == 0) - return NULL; - filename_from_utf16 (curdirw, default_root); - } - else - { - char curdira[MAX_PATH]; - - if (GetCurrentDirectoryA (MAX_PATH, curdira) == 0) - return NULL; - filename_from_ansi (curdira, default_root); - } + w32_get_current_directory (default_root); parse_root (default_root, (const char **)&root_dir); *root_dir = 0; root_dir = default_root; diff --git a/src/w32.h b/src/w32.h index 42b3d98245..5054b400c5 100644 --- a/src/w32.h +++ b/src/w32.h @@ -201,6 +201,7 @@ extern int codepage_for_filenames (CPINFO *); extern Lisp_Object ansi_encode_filename (Lisp_Object); extern int w32_copy_file (const char *, const char *, int, int, int); extern int w32_accessible_directory_p (const char *, ptrdiff_t); +extern void w32_init_current_directory (void); extern BOOL init_winsock (int load_now); extern void srandom (int); commit bcd74314626db88a8ff3c9deeb6ea7fbcd337413 Author: Juri Linkov Date: Fri Dec 7 00:38:42 2018 +0200 * lisp/vc/vc.el (vc-find-revision-no-save): Add optional arg BUFFER. (Bug#33567) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index de43544864..dbbc3e2038 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1998,33 +1998,41 @@ Saves the buffer to the file." (set (make-local-variable 'vc-parent-buffer) filebuf)) result-buf))) -(defun vc-find-revision-no-save (file revision &optional backend) - "Read REVISION of FILE into a buffer and return the buffer. -Unlike `vc-find-revision-save', doesn't save the created buffer to file." - (let ((filebuf (or (get-file-buffer file) (current-buffer))) - (filename (vc-version-backup-file-name file revision 'manual))) - (unless (or (get-file-buffer filename) - (file-exists-p filename)) +(defun vc-find-revision-no-save (file revision &optional backend buffer) + "Read REVISION of FILE into BUFFER and return the buffer. +If BUFFER omitted or nil, this function creates a new buffer and sets +`buffer-file-name' to the name constructed from the file name and the +revision number. +Unlike `vc-find-revision-save', doesn't save the buffer to the file." + (let* ((buffer (when (buffer-live-p buffer) buffer)) + (filebuf (or buffer (get-file-buffer file) (current-buffer))) + (filename (unless buffer (vc-version-backup-file-name file revision 'manual)))) + (unless (and (not buffer) + (or (get-file-buffer filename) + (file-exists-p filename))) (with-current-buffer filebuf (let ((failed t)) (unwind-protect (let ((coding-system-for-read 'no-conversion) - (coding-system-for-write 'no-conversion)) - (with-current-buffer (create-file-buffer filename) - (setq buffer-file-name filename) + (coding-system-for-write 'no-conversion)) + (with-current-buffer (or buffer (create-file-buffer filename)) + (unless buffer (setq buffer-file-name filename)) (let ((outbuf (current-buffer))) (with-current-buffer filebuf (if backend (vc-call-backend backend 'find-revision file revision outbuf) (vc-call find-revision file revision outbuf)))) (goto-char (point-min)) - (normal-mode) + (if buffer (let ((buffer-file-name file)) (normal-mode)) (normal-mode)) (set-buffer-modified-p nil) (setq buffer-read-only t)) (setq failed nil)) - (when (and failed (get-file-buffer filename)) + (when (and failed (unless buffer (get-file-buffer filename))) + (with-current-buffer (get-file-buffer filename) + (set-buffer-modified-p nil)) (kill-buffer (get-file-buffer filename))))))) - (let ((result-buf (or (get-file-buffer filename) + (let ((result-buf (or buffer + (get-file-buffer filename) (find-file-noselect filename)))) (with-current-buffer result-buf (set (make-local-variable 'vc-parent-buffer) filebuf)) commit 0e8e5da1e8da0752fc02bf590a17697af4c0afd3 Author: Paul Eggert Date: Thu Dec 6 12:59:42 2018 -0800 Mention EMACS_SOCKET_NAME, not XDG_RUNTIME_DIR. diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index 19770455f1..18a857f7dc 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -2011,8 +2011,12 @@ When this is done, Emacs by default creates a Unix domain socket named desktop and @file{$TMPDIR/emacs@var{userid}} otherwise. See the variable @code{server-socket-dir}. Traditionally, Emacs used @file{$TMPDIR/emacs@var{userid}} even when running under an X desktop; -if you prefer this traditional (and less-secure) behavior, unset -@env{XDG_RUNTIME_DIR} before invoking Emacs and @samp{emacsclient}. +if you prefer this traditional (and less-secure) behavior, you +can set the environment variable @env{EMACS_SOCKET_NAME} to +@samp{$TMPDIR/emacs@var{userid}/server} before invoking Emacs and +@samp{emacsclient}, although it will be your responsibility to create +the directory @samp{$TMPDIR/emacs@var{userid}} with appropriate +ownership and permissions. To get your news reader, mail reader, etc., to invoke @samp{emacsclient}, try setting the environment variable @code{EDITOR} diff --git a/etc/NEWS b/etc/NEWS index e7f2d606f8..cad44f9233 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -133,8 +133,8 @@ to apply. as the directory for client/server sockets, if Emacs is running under an X Window System desktop that sets the XDG_RUNTIME_DIR environment variable to indicate where session sockets should go. -To get the old and less-secure behavior, unset XDG_RUNTIME_DIR before -invoking emacs and emacsclient. +To get the old, less-secure behavior, you can set the +EMACS_SOCKET_NAME environment variable to an appropriate value. --- *** When run by root, emacsclient no longer connects to non-root sockets. commit b1d7f19ae785ce7fa609bc57432d01cc23a3d49a Author: Paul Eggert Date: Thu Dec 6 11:07:18 2018 -0800 Mention unsetting XDG_RUNTIME_DIR in doc. diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index d457267c24..19770455f1 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -2009,7 +2009,10 @@ When this is done, Emacs by default creates a Unix domain socket named @file{server} in a well-known directory, typically @file{$XDG_RUNTIME_DIR/emacs} if Emacs is running under an X Window System desktop and @file{$TMPDIR/emacs@var{userid}} otherwise. See the variable -@code{server-socket-dir}. +@code{server-socket-dir}. Traditionally, Emacs used +@file{$TMPDIR/emacs@var{userid}} even when running under an X desktop; +if you prefer this traditional (and less-secure) behavior, unset +@env{XDG_RUNTIME_DIR} before invoking Emacs and @samp{emacsclient}. To get your news reader, mail reader, etc., to invoke @samp{emacsclient}, try setting the environment variable @code{EDITOR} diff --git a/etc/NEWS b/etc/NEWS index 60cba9ed46..e7f2d606f8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -133,6 +133,8 @@ to apply. as the directory for client/server sockets, if Emacs is running under an X Window System desktop that sets the XDG_RUNTIME_DIR environment variable to indicate where session sockets should go. +To get the old and less-secure behavior, unset XDG_RUNTIME_DIR before +invoking emacs and emacsclient. --- *** When run by root, emacsclient no longer connects to non-root sockets. commit 46b810081165fecae5086b71fafdb3eb19c30df5 Author: Paul Eggert Date: Thu Dec 6 10:46:06 2018 -0800 emacsclient: avoid background chatter * lib-src/emacsclient.c (process_grouping): New function. (act_on_signals, main): Use it. (main): Omit "Waiting for Emacs..." and later "\n" messages if in background, since that messes up the screen. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 653ab955df..c596fb23ae 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -1095,6 +1095,26 @@ find_tty (const char **tty_type, const char **tty_name, bool noabort) return true; } +/* Return the process group if in the foreground, the negative of the + process group if in the background, and zero if there is no + foreground process group for the controlling terminal. + Unfortunately, use of this function introduces an unavoidable race, + since whether the process is in the foreground or background can + change at any time. */ + +static pid_t +process_grouping (void) +{ +#ifdef SOCKETS_IN_FILE_SYSTEM + pid_t tcpgrp = tcgetpgrp (STDOUT_FILENO); + if (0 <= tcpgrp) + { + pid_t pgrp = getpgrp (); + return tcpgrp == pgrp ? pgrp : -pgrp; + } +#endif + return 0; +} #ifdef SOCKETS_IN_FILE_SYSTEM @@ -1253,21 +1273,17 @@ act_on_signals (HSOCKET emacs_socket) { got_sigcont = 0; took_action = true; - pid_t tcpgrp = tcgetpgrp (STDOUT_FILENO); - if (0 <= tcpgrp) + pid_t grouping = process_grouping (); + if (grouping < 0) { - pid_t pgrp = getpgrp (); - if (tcpgrp == pgrp) - { - /* We are in the foreground. */ - send_to_emacs (emacs_socket, "-resume \n"); - } - else if (tty) + if (tty) { - /* We are in the background; cancel the continue. */ - kill (-pgrp, SIGTTIN); + /* Cancel the continue. */ + kill (grouping, SIGTTIN); } } + else + send_to_emacs (emacs_socket, "-resume \n"); } if (got_sigtstp) @@ -1767,13 +1783,12 @@ main (int argc, char **argv) exit (EXIT_FAILURE); } -#ifndef WINDOWSNT +#ifdef SOCKETS_IN_FILE_SYSTEM if (tty) { - pid_t pgrp = getpgrp (); - pid_t tcpgrp = tcgetpgrp (STDOUT_FILENO); - if (0 <= tcpgrp && tcpgrp != pgrp) - kill (-pgrp, SIGTTIN); + pid_t grouping = process_grouping (); + if (grouping < 0) + kill (grouping, SIGTTIN); } #endif @@ -1946,7 +1961,7 @@ main (int argc, char **argv) send_to_emacs (emacs_socket, "\n"); /* Wait for an answer. */ - if (!eval && !tty && !nowait && !quiet) + if (!eval && !tty && !nowait && !quiet && 0 <= process_grouping ()) { printf ("Waiting for Emacs..."); skiplf = false; @@ -2052,7 +2067,7 @@ main (int argc, char **argv) } } - if (!skiplf) + if (!skiplf && 0 <= process_grouping ()) printf ("\n"); if (rl < 0) commit 2f985977f691a37a6d45298128b88d0cefcc93a1 Author: Paul Eggert Date: Thu Dec 6 08:54:00 2018 -0800 Fix emacsclient hang when backgrounded Problem reported by Kaushal Modi in: https://lists.gnu.org/r/emacs-devel/2018-12/msg00083.html The tcdrain call replaced an fdatasync call which had no effect on the tty, so removing it entirely shouldn’t cause problems. The fdatasync call replaced an fsync call which also had no effect on the tty, and the fsync call seems to be badly-merged revenant of emacsclient’s old (circa 2004) way of communicating to and from Emacs via FILE * streams, where fsync was apparently needed when talking to sockets. * lib-src/emacsclient.c [!DOS_NT]: Don’t include termios.h. (flush_stdout): Remove. All callers removed. (main): Do not drain the tty after "Waiting for Emacs..." message. There should be no need to drain, and draining it might send us a SIGTTOU. Do not fflush stdout just before exiting, as exiting does that for us. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 7de3665114..653ab955df 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -66,10 +66,6 @@ char *w32_getenv (const char *); #endif /* !WINDOWSNT */ -#ifndef DOS_NT -# include -#endif - #include #include #include @@ -1740,15 +1736,6 @@ start_daemon_and_retry_set_socket (void) return emacs_socket; } -/* Flush standard output and its underlying file descriptor. */ -static void -flush_stdout (HSOCKET emacs_socket) -{ - fflush (stdout); - while (tcdrain (STDOUT_FILENO) != 0 && errno == EINTR) - act_on_signals (emacs_socket); -} - int main (int argc, char **argv) { @@ -1964,7 +1951,7 @@ main (int argc, char **argv) printf ("Waiting for Emacs..."); skiplf = false; } - flush_stdout (emacs_socket); + fflush (stdout); /* Now, wait for an answer and print any messages. */ while (exit_status == EXIT_SUCCESS) @@ -2067,7 +2054,6 @@ main (int argc, char **argv) if (!skiplf) printf ("\n"); - flush_stdout (emacs_socket); if (rl < 0) exit_status = EXIT_FAILURE; commit c5b6f1672bc62d9ffdd3c7200074727a4608af03 Author: Paul Eggert Date: Thu Dec 6 07:48:42 2018 -0800 struct image_type layout is private to image.c * src/dispextern.h (struct image_type): Move from here ... * src/image.c (struct image_type): ... to here. diff --git a/src/dispextern.h b/src/dispextern.h index 776d14080e..4cd017603d 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -2935,34 +2935,6 @@ struct redisplay_interface #ifdef HAVE_WINDOW_SYSTEM -/* Each image format (JPEG, TIFF, ...) supported is described by - a structure of the type below. */ - -struct image_type -{ - /* Index of a symbol uniquely identifying the image type, e.g., 'jpeg'. */ - int type; - - /* Check that SPEC is a valid image specification for the given - image type. Value is true if SPEC is valid. */ - bool (* valid_p) (Lisp_Object spec); - - /* Load IMG which is used on frame F from information contained in - IMG->spec. Value is true if successful. */ - bool (* load) (struct frame *f, struct image *img); - - /* Free resources of image IMG which is used on frame F. */ - void (* free) (struct frame *f, struct image *img); - - /* Initialization function (used for dynamic loading of image - libraries on Windows), or NULL if none. */ - bool (* init) (void); - - /* Next in list of all supported image types. */ - struct image_type *next; -}; - - /* Structure describing an image. Specific image formats like XBM are converted into this form, so that display only has to deal with this type of image. */ diff --git a/src/image.c b/src/image.c index ad4f95ba99..633d66e7a7 100644 --- a/src/image.c +++ b/src/image.c @@ -525,6 +525,33 @@ x_create_bitmap_mask (struct frame *f, ptrdiff_t id) Image types ***********************************************************************/ +/* Each image format (JPEG, TIFF, ...) supported is described by + a structure of the type below. */ + +struct image_type +{ + /* Index of a symbol uniquely identifying the image type, e.g., 'jpeg'. */ + int type; + + /* Check that SPEC is a valid image specification for the given + image type. Value is true if SPEC is valid. */ + bool (*valid_p) (Lisp_Object spec); + + /* Load IMG which is used on frame F from information contained in + IMG->spec. Value is true if successful. */ + bool (*load) (struct frame *f, struct image *img); + + /* Free resources of image IMG which is used on frame F. */ + void (*free) (struct frame *f, struct image *img); + + /* Initialization function (used for dynamic loading of image + libraries on Windows), or NULL if none. */ + bool (*init) (void); + + /* Next in list of all supported image types. */ + struct image_type *next; +}; + /* List of supported image types. Use define_image_type to add new types. Use lookup_image_type to find a type for a given symbol. */ commit 6fa44f9696801eeed6a4af29549cedd5c570785a Author: Eli Zaretskii Date: Thu Dec 6 19:35:16 2018 +0200 Avoid an error on exit in a build without threads * lisp/simple.el (list-processes--refresh): Avoid signaling an error in a build --without-threads. (Bug#33629) diff --git a/lisp/simple.el b/lisp/simple.el index e1922384f2..db59b9f5bc 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -4006,7 +4006,9 @@ Also, delete any process that is exited or signaled." (tty (or (process-tty-name p) "--")) (thread (cond - ((null (process-thread p)) "--") + ((or + (null (process-thread p)) + (not (fboundp 'thread-name))) "--") ((eq (process-thread p) main-thread) "Main") ((thread-name (process-thread p))))) (cmd commit 7d33c775b245dc011f56559a8a776728888d7246 Author: Michael Albinus Date: Thu Dec 6 16:11:27 2018 +0100 Add missing handler to tramp-rclone.el, improve robustness * lisp/net/tramp-rclone.el (tramp-adb): Require. (tramp-rclone-file-name-handler-alist): Use `tramp-adb-handle-expand-file-name'. (tramp-rclone-flush-directory-cache): New defun, derived from `tramp-rclone-flush-mount'. (tramp-rclone-do-copy-or-rename-file) (tramp-rclone-handle-delete-directory) (tramp-rclone-handle-delete-file) (tramp-rclone-handle-make-directory): Use it. (tramp-rclone-handle-directory-files) (tramp-rclone-local-file-name): Use `tramp-compat-file-name-quoted-p', `tramp-compat-file-name-quote' and ´tramp-compat-file-name-unquote'. (tramp-rclone-handle-file-executable-p) (tramp-rclone-handle-file-readable-p): Cache result. (tramp-rclone-handle-file-name-all-completions) (tramp-rclone-mounted-p, tramp-rclone-remote-file-name) (tramp-rclone-maybe-open-connection): Rewrite. * test/lisp/net/tramp-tests.el (tramp--test-rclone-p): New defun. (tramp-test05-expand-file-name-relative) (tramp--test-special-characters): Use it. diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 6c01d7def1..3f3cac8ebc 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -39,6 +39,7 @@ (require 'tramp) ;; TODDDDDDDDDO: REPLACE +(require 'tramp-adb) (require 'tramp-gvfs) ;;;###tramp-autoload @@ -85,7 +86,7 @@ (dired-compress-file . ignore) (dired-uncache . tramp-handle-dired-uncache) (exec-path . ignore) - ;; `expand-file-name' performed by default handler. + (expand-file-name . tramp-adb-handle-expand-file-name) (file-accessible-directory-p . tramp-handle-file-accessible-directory-p) (file-acl . ignore) (file-attributes . tramp-rclone-handle-file-attributes) @@ -258,7 +259,15 @@ file names." (with-parsed-tramp-file-name filename v1 (tramp-flush-file-properties v1 (file-name-directory v1-localname)) - (tramp-flush-file-properties v1 v1-localname))) + (tramp-flush-file-properties v1 v1-localname) + (when (tramp-rclone-file-name-p filename) + (tramp-rclone-flush-directory-cache v1) + ;; The mount point's directory cache might need time + ;; to flush. + (while (file-exists-p filename) + (tramp-flush-file-properties + v1 (file-name-directory v1-localname)) + (tramp-flush-file-properties v1 v1-localname))))) (when t2 (with-parsed-tramp-file-name newname v2 @@ -266,7 +275,13 @@ file names." v2 (file-name-directory v2-localname)) (tramp-flush-file-properties v2 v2-localname) (when (tramp-rclone-file-name-p newname) - (tramp-rclone-flush-mount v2))))))))) + (tramp-rclone-flush-directory-cache v2) + ;; The mount point's directory cache might need time + ;; to flush. + (while (not (file-exists-p newname)) + (tramp-flush-file-properties + v2 (file-name-directory v2-localname)) + (tramp-flush-file-properties v2 v2-localname)))))))))) (defun tramp-rclone-handle-copy-file (filename newname &optional ok-if-already-exists keep-date @@ -289,17 +304,18 @@ file names." (directory &optional recursive trash) "Like `delete-directory' for Tramp files." (with-parsed-tramp-file-name (expand-file-name directory) nil + (delete-directory (tramp-rclone-local-file-name directory) recursive trash) (tramp-flush-file-properties v (file-name-directory localname)) (tramp-flush-directory-properties v localname) - (delete-directory - (tramp-rclone-local-file-name directory) recursive trash))) + (tramp-rclone-flush-directory-cache v))) (defun tramp-rclone-handle-delete-file (filename &optional trash) "Like `delete-file' for Tramp files." (with-parsed-tramp-file-name (expand-file-name filename) nil + (delete-file (tramp-rclone-local-file-name filename) trash) (tramp-flush-file-properties v (file-name-directory localname)) (tramp-flush-file-properties v localname) - (delete-file (tramp-rclone-local-file-name filename) trash))) + (tramp-rclone-flush-directory-cache v))) (defun tramp-rclone-handle-directory-files (directory &optional full match nosort) @@ -312,11 +328,11 @@ file names." (tramp-rclone-local-file-name directory) full match))) ;; Massage the result. (when full - (let* ((quoted (file-name-quoted-p directory)) + (let* ((quoted (tramp-compat-file-name-quoted-p directory)) (local (concat "^" (regexp-quote (tramp-rclone-mount-point v)))) (remote - (funcall (if quoted 'file-name-quote 'identity) + (funcall (if quoted 'tramp-compat-file-name-quote 'identity) (file-remote-p directory)))) (setq result (mapcar @@ -341,15 +357,32 @@ file names." (defun tramp-rclone-handle-file-executable-p (filename) "Like `file-executable-p' for Tramp files." - (file-executable-p (tramp-rclone-local-file-name filename))) + (with-parsed-tramp-file-name (expand-file-name filename) nil + (with-tramp-file-property v localname "file-executable-p" + (file-executable-p (tramp-rclone-local-file-name filename))))) (defun tramp-rclone-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (file-name-all-completions filename (tramp-rclone-local-file-name directory))) + (all-completions + filename + (delete-dups + (append + (file-name-all-completions + filename (tramp-rclone-local-file-name directory)) + ;; Some storage systems do not return "." and "..". + (let (result) + (dolist (item '(".." ".") result) + (when (string-prefix-p filename item) + (catch 'match + (dolist (elt completion-regexp-list) + (unless (string-match-p elt item) (throw 'match nil))) + (setq result (cons (concat item "/") result)))))))))) (defun tramp-rclone-handle-file-readable-p (filename) "Like `file-readable-p' for Tramp files." - (file-readable-p (tramp-rclone-local-file-name filename))) + (with-parsed-tramp-file-name (expand-file-name filename) nil + (with-tramp-file-property v localname "file-readable-p" + (file-readable-p (tramp-rclone-local-file-name filename))))) (defun tramp-rclone-handle-file-system-info (filename) "Like `file-system-info' for Tramp files." @@ -401,13 +434,14 @@ file names." (defun tramp-rclone-handle-make-directory (dir &optional parents) "Like `make-directory' for Tramp files." (with-parsed-tramp-file-name (expand-file-name dir) nil + (make-directory (tramp-rclone-local-file-name dir) parents) ;; When PARENTS is non-nil, DIR could be a chain of non-existent ;; directories a/b/c/... Instead of checking, we simply flush the - ;; whole cache. + ;; whole file cache. (tramp-flush-file-properties v localname) (tramp-flush-directory-properties v (if parents "/" (file-name-directory localname))) - (make-directory (tramp-rclone-local-file-name dir) parents))) + (tramp-rclone-flush-directory-cache v))) (defun tramp-rclone-handle-rename-file (filename newname &optional ok-if-already-exists) @@ -436,24 +470,38 @@ file names." (defun tramp-rclone-mounted-p (vec) "Check, whether storage system determined by VEC is mounted." - (with-tramp-file-property vec "/" "mounted" - (string-match - (format "^%s:" (regexp-quote (tramp-file-name-host vec))) - (shell-command-to-string "mount")))) - -(defun tramp-rclone-flush-mount (vec) + (when (tramp-get-connection-process vec) + ;; We cannot use `with-connection-property', because we don't want + ;; to cache a nil result. + (or (tramp-get-connection-property + (tramp-get-connection-process vec) "mounted" nil) + (tramp-set-connection-property + (tramp-get-connection-process vec) "mounted" + (let* ((default-directory temporary-file-directory) + (mount (shell-command-to-string "mount -t fuse.rclone"))) + (tramp-message vec 6 "%s" "mount -t fuse.rclone") + (tramp-message vec 6 "\n%s" mount) + (when (string-match + (format + "^\\(%s:\\S-*\\)" (regexp-quote (tramp-file-name-host vec))) + mount) + (match-string 1 mount))))))) + +(defun tramp-rclone-flush-directory-cache (vec) "Flush directory cache of VEC mount." (let ((rclone-pid ;; Identify rclone process. - (with-tramp-file-property vec "/" "rclone-pid" - (catch 'pid - (dolist (pid (list-system-processes)) ;; "pidof rclone" ? - (and (string-match - (regexp-quote - (format "rclone mount %s:" (tramp-file-name-host vec))) - (or (cdr (assoc 'args (process-attributes pid))) "")) - (throw 'pid pid))))))) - ;; Send a SIGHUP in order to flush directory caches. + (when (tramp-get-connection-process vec) + (with-tramp-connection-property + (tramp-get-connection-process vec) "rclone-pid" + (catch 'pid + (dolist (pid (list-system-processes)) ;; "pidof rclone" ? + (and (string-match-p + (regexp-quote + (format "rclone mount %s:" (tramp-file-name-host vec))) + (or (cdr (assoc 'args (process-attributes pid))) "")) + (throw 'pid pid)))))))) + ;; Send a SIGHUP in order to flush directory cache. (when rclone-pid (tramp-message vec 6 "Send SIGHUP %d: %s" @@ -462,15 +510,16 @@ file names." (defun tramp-rclone-local-file-name (filename) "Return local mount name of FILENAME." - (with-parsed-tramp-file-name (expand-file-name filename) nil + (setq filename (tramp-compat-file-name-unquote (expand-file-name filename))) + (with-parsed-tramp-file-name filename nil ;; As long as we call `tramp-rclone-maybe-open-connection' here, ;; we cache the result. (with-tramp-file-property v localname "local-file-name" (tramp-rclone-maybe-open-connection v) - (let ((quoted (file-name-quoted-p localname)) - (localname (file-name-unquote localname))) + (let ((quoted (tramp-compat-file-name-quoted-p localname)) + (localname (tramp-compat-file-name-unquote localname))) (funcall - (if quoted 'file-name-quote 'identity) + (if quoted 'tramp-compat-file-name-quote 'identity) (expand-file-name (if (file-name-absolute-p localname) (substring localname 1) localname) @@ -478,43 +527,59 @@ file names." (defun tramp-rclone-remote-file-name (filename) "Return FILENAME as used in the `rclone' command." - (setq filename (file-name-unquote (expand-file-name filename))) + (setq filename (tramp-compat-file-name-unquote (expand-file-name filename))) (if (tramp-rclone-file-name-p filename) (with-parsed-tramp-file-name filename nil - ;; TODO: This shall be handled by `expand-file-name'. - (setq localname (replace-regexp-in-string "^\\." "" (or localname ""))) - (format "%s:%s" host localname)) + ;; As long as we call `tramp-rclone-maybe-open-connection' here, + ;; we cache the result. + (with-tramp-file-property v localname "remote-file-name" + (tramp-rclone-maybe-open-connection v) + ;; TODO: This shall be handled by `expand-file-name'. + (setq localname + (replace-regexp-in-string "^\\." "" (or localname ""))) + (format "%s%s" (tramp-rclone-mounted-p v) localname))) + ;; It is a local file name. filename)) (defun tramp-rclone-maybe-open-connection (vec) "Maybe open a connection VEC. Does not do anything if a connection is already open, but re-opens the connection if a previous connection has died for some reason." - (unless (tramp-rclone-mounted-p vec) - (let ((host (tramp-file-name-host vec))) + (let ((host (tramp-file-name-host vec))) + (when (rassoc `(,host) (tramp-rclone-parse-device-names nil)) (if (zerop (length host)) (tramp-error vec 'file-error "Storage %s not connected" host)) - (with-tramp-progress-reporter vec 3 "Mounting rclone storage" - (unless (file-directory-p (tramp-rclone-mount-point vec)) - (make-directory (tramp-rclone-mount-point vec) 'parents)) - (let* ((buf (tramp-get-connection-buffer vec)) - (coding-system-for-read 'utf-8-dos) ;is this correct? - (process-connection-type tramp-process-connection-type) - (args `("mount" ,(concat host ":") - ,(tramp-rclone-mount-point vec) - ,(tramp-get-method-parameter vec 'tramp-mount-args))) - (p (let ((default-directory - (tramp-compat-temporary-file-directory))) - (apply 'start-process (tramp-get-connection-name vec) buf - tramp-rclone-program (delq nil args))))) - (tramp-set-file-property vec "/" "mounted" t) - (tramp-message - vec 6 "%s" (mapconcat 'identity (process-command p) " ")) - (process-put p 'adjust-window-size-function 'ignore) + + ;; We need a process bound to the connection buffer. Therefore, + ;; we create a dummy process. Maybe there is a better solution? + (unless (get-buffer-process (tramp-get-connection-buffer vec)) + (let ((p (make-network-process + :name (tramp-buffer-name vec) + :buffer (tramp-get-connection-buffer vec) + :server t :host 'local :service t :noquery t))) + (process-put p 'vector vec) (set-process-query-on-exit-flag p nil) ;; Set connection-local variables. - (tramp-set-connection-local-variables vec))))) + (tramp-set-connection-local-variables vec))) + + ;; Create directory. + (unless (file-directory-p (tramp-rclone-mount-point vec)) + (make-directory (tramp-rclone-mount-point vec) 'parents)) + + ;; Mount. This command does not return, so we use 0 as + ;; DESTINATION of `tramp-call-process'. + (unless (tramp-rclone-mounted-p vec) + (apply + 'tramp-call-process + vec tramp-rclone-program nil 0 nil + (delq nil + `("mount" ,(concat host ":/") + ,(tramp-rclone-mount-point vec) + ;; This could be nil. + ,(tramp-get-method-parameter vec 'tramp-mount-args)))) + (while (not (file-exists-p (tramp-make-tramp-file-name vec 'localname))) + (tramp-cleanup-connection vec 'keep-debug 'keep-password))))) ;; In `tramp-check-cached-permissions', the connection properties ;; {uig,gid}-{integer,string} are used. We set them to proper values. @@ -529,7 +594,6 @@ connection if a previous connection has died for some reason." (defun tramp-rclone-send-command (vec &rest args) "Send the COMMAND to connection VEC." -; (tramp-rclone-maybe-open-connection vec) (with-current-buffer (tramp-get-connection-buffer vec) (erase-buffer) (let ((flags (tramp-get-method-parameter diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 15a120704e..1fcecb85eb 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -1997,7 +1997,7 @@ handled properly. BODY shall not contain a timeout." (skip-unless (tramp--test-enabled)) ;; These are the methods the test doesn't fail. - (when (or (tramp--test-adb-p) (tramp--test-gvfs-p) + (when (or (tramp--test-adb-p) (tramp--test-gvfs-p) (tramp--test-rclone-p) (tramp-smb-file-name-p tramp-test-temporary-file-directory)) (setf (ert-test-expected-result-type (ert-get-test 'tramp-test05-expand-file-name-relative)) @@ -4551,6 +4551,11 @@ This does not support external Emacs calls." (string-equal "nextcloud" (file-remote-p tramp-test-temporary-file-directory 'method))) +(defun tramp--test-rclone-p () + "Check, whether the remote host is offered by rclone. +This requires restrictions of file name syntax." + (tramp-rclone-file-name-p tramp-test-temporary-file-directory)) + (defun tramp--test-rsync-p () "Check, whether the rsync method is used. This does not support special file names." @@ -4755,7 +4760,9 @@ This requires restrictions of file name syntax." ;; expanded to . (let ((files (list - (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) + (if (or (tramp--test-gvfs-p) + (tramp--test-rclone-p) + (tramp--test-windows-nt-or-smb-p)) "foo bar baz" (if (or (tramp--test-adb-p) (tramp--test-docker-p) @@ -4781,7 +4788,9 @@ This requires restrictions of file name syntax." (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) "!foo!bar!baz!" "!foo|bar!baz|") - (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) + (if (or (tramp--test-gvfs-p) + (tramp--test-rclone-p) + (tramp--test-windows-nt-or-smb-p)) ";foo;bar;baz;" ":foo;bar:baz;") (unless (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) commit 66b49fc1d522b8d2cce7e957a5c6e7a4f6c90e0f Author: Michael Albinus Date: Thu Dec 6 16:00:05 2018 +0100 Rework Tramp wrt string-match-p, looking-at-p, save-match-data * lisp/net/tramp.el (tramp-find-method, tramp-find-user) (tramp-find-host, tramp-dissect-file-name, tramp-make-tramp-file-name) (tramp-completion-make-tramp-file-name, tramp-debug-message) (tramp-message, tramp-progress-reporter-update) (tramp-set-completion-function) (tramp-rfn-eshadow-update-overlay) (tramp-find-file-name-coding-system-alist) (tramp-file-name-for-operation) (tramp-use-absolute-autoload-file-names) (tramp-get-completion-methods, tramp-get-completion-user-host) (tramp-handle-directory-files) (tramp-handle-file-name-case-insensitive-p) (tramp-handle-file-name-completion, tramp-handle-file-truename) (tramp-handle-insert-directory, tramp-handle-load) (tramp-handle-shell-command, tramp-action-yesno) (tramp-action-yn, tramp-process-actions) (tramp-mode-string-to-int, tramp-get-local-locale) (tramp-local-host-p): * lisp/net/tramp-adb.el (tramp-adb-handle-file-system-info) (tramp-adb-handle-directory-files-and-attributes) (tramp-adb--gnu-switches-to-ash, tramp-adb-sh-fix-ls-output) (tramp-adb-handle-file-name-all-completions) (tramp-adb-handle-shell-command) (tramp-adb-handle-start-file-process): * lisp/net/tramp-archive.el (tramp-archive-dissect-file-name): * lisp/net/tramp-cache.el (tramp-get-hash-table) (tramp-flush-directory-properties, tramp-flush-file-function): * lisp/net/tramp-cmds.el (tramp-reporter-dump-variable) (tramp-append-tramp-buffers): * lisp/net/tramp-compat.el (tramp-compat-process-running-p): * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-expand-file-name) (tramp-gvfs-get-file-attributes) (tramp-gvfs-handle-file-attributes) (tramp-gvfs-monitor-process-filter) (tramp-gvfs-handler-mounted-unmounted) (tramp-gvfs-connection-mounted-p, tramp-gvfs-mount-spec-entry) (tramp-gvfs-mount-spec, tramp-gvfs-maybe-open-connection): * lisp/net/tramp-sh.el (tramp-do-file-attributes-with-ls) (tramp-do-file-attributes-with-stat) (tramp-sh-handle-file-selinux-context) (tramp-sh-handle-directory-files-and-attributes) (tramp-do-directory-files-and-attributes-with-stat) (tramp-sh-handle-file-name-all-completions) (tramp-sh-handle-dired-compress-file) (tramp-sh-handle-insert-directory) (tramp-sh-handle-expand-file-name) (tramp-sh-handle-start-file-process) (tramp-sh-handle-process-file, tramp-sh-handle-write-region) (tramp-sh-handle-file-notify-add-watch) (tramp-sh-gio-monitor-process-filter) (tramp-sh-gvfs-monitor-dir-process-filter) (tramp-sh-inotifywait-process-filter) (tramp-sh-handle-file-system-info, tramp-maybe-send-script) (tramp-find-executable, tramp-open-shell, tramp-find-shell) (tramp-open-connection-setup-interactive-shell) (tramp-find-inline-encoding, tramp-call-local-coding-command) (tramp-compute-multi-hops, tramp-maybe-open-connection) (tramp-convert-file-attributes) (tramp-make-copy-program-file-name, tramp-get-remote-locale) (tramp-get-test-nt-command, tramp-get-remote-stat) (tramp-get-inline-coding): * lisp/net/tramp-smb.el (tramp-smb-handle-directory-files) (tramp-smb-action-get-acl, tramp-smb-handle-file-attributes) (tramp-smb-handle-file-name-all-completions) (tramp-smb-handle-file-system-info) (tramp-smb-handle-file-writable-p) (tramp-smb-handle-insert-directory) (tramp-smb-handle-make-directory) (tramp-smb-handle-make-directory-internal) (tramp-smb-handle-start-file-process, tramp-smb-get-localname) (tramp-smb-read-file-entry): Use `string-match-p' and `looking-at-p'. Remove superfluous `save-match-data'. Apply `eval-when-compile' on constant concat data. * lisp/net/tramp-compat.el (tramp-compat-file-name-quoted-p-p): Use `string-prefix-p'. (tramp-compat-file-name-unquote): Do not use match data. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index d0cead2b88..76bcdf0941 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -259,10 +259,11 @@ pass to the OPERATION." (goto-char (point-min)) (forward-line) (when (looking-at - (concat "[[:space:]]*[^[:space:]]+" - "[[:space:]]+\\([[:digit:]]+\\)" - "[[:space:]]+\\([[:digit:]]+\\)" - "[[:space:]]+\\([[:digit:]]+\\)")) + (eval-when-compile + (concat "[[:space:]]*[^[:space:]]+" + "[[:space:]]+\\([[:digit:]]+\\)" + "[[:space:]]+\\([[:digit:]]+\\)" + "[[:space:]]+\\([[:digit:]]+\\)"))) ;; The values are given as 1k numbers, so we must change ;; them to number of bytes. (list (* 1024 (string-to-number (match-string 1))) @@ -462,7 +463,7 @@ pass to the OPERATION." (sort result (lambda (x y) (string< (car x) (car y)))))) (delq nil (mapcar (lambda (x) - (if (or (not match) (string-match match (car x))) + (if (or (not match) (string-match-p match (car x))) x)) result))))))))) @@ -499,7 +500,7 @@ Convert (\"-al\") to (\"-a\" \"-l\"). Remove arguments like \"--dired\"." (delq nil (mapcar (lambda (s) - (and (not (string-match "\\(^--\\|^[^-]\\)" s)) s)) + (and (not (string-match-p "\\(^--\\|^[^-]\\)" s)) s)) switches)))))) (defun tramp-adb-sh-fix-ls-output (&optional sort-by-time) @@ -514,7 +515,7 @@ Emacs dired can't find files." "[[:space:]]\\([[:space:]][0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9][[:space:]]\\)" nil t) (replace-match "0\\1" "\\1" nil) ;; Insert missing "/". - (when (looking-at "[0-9][0-9]:[0-9][0-9][[:space:]]+$") + (when (looking-at-p "[0-9][0-9]:[0-9][0-9][[:space:]]+$") (end-of-line) (insert "/"))) ;; Sort entries. @@ -594,28 +595,27 @@ Emacs dired can't find files." filename (with-parsed-tramp-file-name (expand-file-name directory) nil (with-tramp-file-property v localname "file-name-all-completions" - (save-match-data - (tramp-adb-send-command - v (format "%s -a %s" - (tramp-adb-get-ls-command v) - (tramp-shell-quote-argument localname))) - (mapcar - (lambda (f) - (if (file-directory-p (expand-file-name f directory)) - (file-name-as-directory f) - f)) - (with-current-buffer (tramp-get-buffer v) - (delete-dups - (append - ;; In older Android versions, "." and ".." are not - ;; included. In newer versions (toybox, since Android - ;; 6) they are. We fix this by `delete-dups'. - '("." "..") - (delq - nil - (mapcar - (lambda (l) (and (not (string-match "^[[:space:]]*$" l)) l)) - (split-string (buffer-string) "\n")))))))))))) + (tramp-adb-send-command + v (format "%s -a %s" + (tramp-adb-get-ls-command v) + (tramp-shell-quote-argument localname))) + (mapcar + (lambda (f) + (if (file-directory-p (expand-file-name f directory)) + (file-name-as-directory f) + f)) + (with-current-buffer (tramp-get-buffer v) + (delete-dups + (append + ;; In older Android versions, "." and ".." are not + ;; included. In newer versions (toybox, since Android 6) + ;; they are. We fix this by `delete-dups'. + '("." "..") + (delq + nil + (mapcar + (lambda (l) (and (not (string-match-p "^[[:space:]]*$" l)) l)) + (split-string (buffer-string) "\n"))))))))))) (defun tramp-adb-handle-file-local-copy (filename) "Like `file-local-copy' for Tramp files." @@ -967,7 +967,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (defun tramp-adb-handle-shell-command (command &optional output-buffer error-buffer) "Like `shell-command' for Tramp files." - (let* ((asynchronous (string-match "[ \t]*&[ \t]*\\'" command)) + (let* ((asynchronous (string-match-p "[ \t]*&[ \t]*\\'" command)) ;; We cannot use `shell-file-name' and `shell-command-switch', ;; they are variables of the local host. (args (list "sh" "-c" (substring command 0 asynchronous))) @@ -1111,7 +1111,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." p)))) ;; Save exit. - (if (string-match tramp-temp-buffer-name (buffer-name)) + (if (string-match-p tramp-temp-buffer-name (buffer-name)) (ignore-errors (set-process-buffer (tramp-get-connection-process v) nil) (kill-buffer (current-buffer))) diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 4c9439102a..cb072ac720 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -378,6 +378,7 @@ pass to the OPERATION." (defun tramp-archive-file-name-p (name) "Return t if NAME is a string with archive file name syntax." (and (stringp name) + ;; We cannot use `string-match-p', the matches are used. (string-match tramp-archive-file-name-regexp name) t)) @@ -430,8 +431,9 @@ name is kept in slot `hop'" ;; http://... ((and url-handler-mode tramp-compat-use-url-tramp-p - (string-match url-handler-regexp archive) - (string-match "https?" (url-type (url-generic-parse-url archive)))) + (string-match-p url-handler-regexp archive) + (string-match-p + "https?" (url-type (url-generic-parse-url archive)))) (let* ((url-tramp-protocols (cons (url-type (url-generic-parse-url archive)) diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 51a8f13c4a..0a799d721d 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -104,7 +104,7 @@ matching entries of `tramp-connection-properties'." (puthash key (make-hash-table :test 'equal) tramp-cache-data))) (when (tramp-file-name-p key) (dolist (elt tramp-connection-properties) - (when (string-match + (when (string-match-p (or (nth 0 elt) "") (tramp-make-tramp-file-name key 'noloc 'nohop)) (tramp-set-connection-property key (nth 1 elt) (nth 2 elt))))) @@ -217,8 +217,8 @@ Remove also properties of all files in subdirectories." (lambda (key _value) (when (and (tramp-file-name-p key) (stringp (tramp-file-name-localname key)) - (string-match (regexp-quote directory) - (tramp-file-name-localname key))) + (string-match-p (regexp-quote directory) + (tramp-file-name-localname key))) (remhash key tramp-cache-data))) tramp-cache-data) ;; Remove file properties of symlinks. @@ -236,7 +236,7 @@ Remove also properties of all files in subdirectories." This is suppressed for temporary buffers." (save-match-data (unless (or (null (buffer-name)) - (string-match "^\\( \\|\\*\\)" (buffer-name))) + (string-match-p "^\\( \\|\\*\\)" (buffer-name))) (let ((bfn (if (stringp (buffer-file-name)) (buffer-file-name) default-directory)) diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index 3c8f182ae9..b886223c95 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -261,7 +261,7 @@ buffer in your bug report. (set varsym (read (format "(%s)" (tramp-cache-print val)))) ;; There are non-7bit characters to be masked. (when (and (stringp val) - (string-match + (string-match-p (concat "[^" (bound-and-true-p mm-7bit-chars) "]") val)) (with-current-buffer reporter-eval-buffer (set @@ -277,10 +277,11 @@ buffer in your bug report. ;; Remove string quotation. (forward-line -1) (when (looking-at - (concat "\\(^.*\\)" "\"" ;; \1 " - "\\((base64-decode-string \\)" "\\\\" ;; \2 \ - "\\(\".*\\)" "\\\\" ;; \3 \ - "\\(\")\\)" "\"$")) ;; \4 " + (eval-when-compile + (concat "\\(^.*\\)" "\"" ;; \1 " + "\\((base64-decode-string \\)" "\\\\" ;; \2 \ + "\\(\".*\\)" "\\\\" ;; \3 \ + "\\(\")\\)" "\"$"))) ;; \4 " (replace-match "\\1\\2\\3\\4") (beginning-of-line) (insert " ;; Variable encoded due to non-printable characters.\n")) @@ -305,7 +306,7 @@ buffer in your bug report. (delq nil (mapcar (lambda (b) - (when (string-match "\\*tramp/" (buffer-name b)) b)) + (when (string-match-p "\\*tramp/" (buffer-name b)) b)) (buffer-list)))) (let ((reporter-eval-buffer buffer) (elbuf (get-buffer-create " *tmp-reporter-buffer*"))) @@ -333,7 +334,7 @@ buffer in your bug report. (insert "\nload-path shadows:\n==================\n") (ignore-errors (mapc - (lambda (x) (when (string-match "tramp" x) (insert x "\n"))) + (lambda (x) (when (string-match-p "tramp" x) (insert x "\n"))) (split-string (list-load-path-shadows t) "\n"))) ;; Append buffers only when we are in message mode. diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 4db45f3c40..9e02ebb24d 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -97,7 +97,7 @@ Add the extension of F, if existing." ;; The returned command name could be truncated ;; to 15 characters. Therefore, we cannot check ;; for `string-equal'. - (and comm (string-match + (and comm (string-match-p (concat "^" (regexp-quote comm)) process-name)))) (setq result t))))))))) @@ -195,7 +195,7 @@ This is a string of ten letters or dashes as in ls -l." (defsubst tramp-compat-file-name-quoted-p (name) "Whether NAME is quoted with prefix \"/:\". If NAME is a remote file name, check the local part of NAME." - (string-match "^/:" (or (file-remote-p name 'localname) name)))) + (string-prefix-p "/:" (or (file-remote-p name 'localname) name)))) (if (fboundp 'file-name-quote) (defalias 'tramp-compat-file-name-quote 'file-name-quote) @@ -212,14 +212,11 @@ If NAME is a remote file name, the local part of NAME is quoted." (defsubst tramp-compat-file-name-unquote (name) "Remove quotation prefix \"/:\" from file NAME. If NAME is a remote file name, the local part of NAME is unquoted." - (save-match-data - (let ((localname (or (file-remote-p name 'localname) name))) - (when (tramp-compat-file-name-quoted-p localname) - (setq - localname - (replace-match - (if (= (length localname) 2) "/" "") nil t localname))) - (concat (file-remote-p name) localname)))))) + (let ((localname (or (file-remote-p name 'localname) name))) + (when (tramp-compat-file-name-quoted-p localname) + (setq + localname (if (= (length localname) 2) "/" (substring localname 2)))) + (concat (file-remote-p name) localname))))) ;; `tramp-syntax' has changed its meaning in Emacs 26. We still ;; support old settings. diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 76747f7c99..8211872471 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -899,14 +899,14 @@ file names." (tramp-get-connection-property v "default-location" "~") nil t localname 1))) ;; Tilde expansion is not possible. - (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) + (when (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) (tramp-error v 'file-error "Cannot expand tilde in file `%s'" name)) (unless (tramp-run-real-handler 'file-name-absolute-p (list localname)) (setq localname (concat "/" localname))) ;; We do not pass "/..". - (if (string-match "^\\(afp\\|davs?\\|smb\\)$" method) + (if (string-match-p "^\\(afp\\|davs?\\|smb\\)$" method) (when (string-match "^/[^/]+\\(/\\.\\./?\\)" localname) (setq localname (replace-match "/" t t localname 1))) (when (string-match "^/\\.\\./?" localname) @@ -997,8 +997,8 @@ If FILE-SYSTEM is non-nil, return file system attributes." (setq filename (directory-file-name (expand-file-name filename))) (with-parsed-tramp-file-name filename nil (setq localname (tramp-compat-file-name-unquote localname)) - (if (or (and (string-match "^\\(afp\\|davs?\\|smb\\)$" method) - (string-match "^/?\\([^/]+\\)$" localname)) + (if (or (and (string-match-p "^\\(afp\\|davs?\\|smb\\)$" method) + (string-match-p "^/?\\([^/]+\\)$" localname)) (string-equal localname "/")) (tramp-gvfs-get-root-attributes filename) (assoc @@ -1038,7 +1038,8 @@ If FILE-SYSTEM is non-nil, return file system attributes." (if (eq id-format 'integer) (string-to-number (or (cdr (assoc "unix::uid" attributes)) - (format "%s" tramp-unknown-id-integer))) + (eval-when-compile + (format "%s" tramp-unknown-id-integer)))) (or (cdr (assoc "owner::user" attributes)) (cdr (assoc "unix::uid" attributes)) tramp-unknown-id-string))) @@ -1046,7 +1047,8 @@ If FILE-SYSTEM is non-nil, return file system attributes." (if (eq id-format 'integer) (string-to-number (or (cdr (assoc "unix::gid" attributes)) - (format "%s" tramp-unknown-id-integer))) + (eval-when-compile + (format "%s" tramp-unknown-id-integer)))) (or (cdr (assoc "owner::group" attributes)) (cdr (assoc "unix::gid" attributes)) tramp-unknown-id-string))) @@ -1216,14 +1218,16 @@ file-notify events." string (replace-regexp-in-string "renamed to" "moved" string)) ;; https://bugs.launchpad.net/bugs/1742946 - (when (string-match "Monitoring not supported\\|No locations given" string) + (when + (string-match-p "Monitoring not supported\\|No locations given" string) (delete-process proc)) (while (string-match - (concat "^.+:" - "[[:space:]]\\(.+\\):" - "[[:space:]]" (regexp-opt tramp-gio-events t) - "\\([[:space:]]\\(.+\\)\\)?$") + (eval-when-compile + (concat "^.+:" + "[[:space:]]\\(.+\\):" + "[[:space:]]" (regexp-opt tramp-gio-events t) + "\\([[:space:]]\\(.+\\)\\)?$")) string) (let ((file (match-string 1 string)) @@ -1233,11 +1237,11 @@ file-notify events." ;; File names are returned as URL paths. We must convert them. (when (string-match ddu file) (setq file (replace-match dd nil nil file))) - (while (string-match "%\\([0-9A-F]\\{2\\}\\)" file) + (while (string-match-p "%\\([0-9A-F]\\{2\\}\\)" file) (setq file (url-unhex-string file))) (when (string-match ddu (or file1 "")) (setq file1 (replace-match dd nil nil file1))) - (while (string-match "%\\([0-9A-F]\\{2\\}\\)" (or file1 "")) + (while (string-match-p "%\\([0-9A-F]\\{2\\}\\)" (or file1 "")) (setq file1 (url-unhex-string file1))) ;; Remove watch when file or directory to be watched is deleted. (when (and (member action '(moved deleted)) @@ -1540,7 +1544,7 @@ file-notify events." (when (and (string-equal "dav" method) (string-equal "true" ssl)) (setq method "davs")) (when (and (string-equal "davs" method) - (string-match + (string-match-p tramp-gvfs-nextcloud-default-prefix-regexp prefix)) (setq method "nextcloud")) (when (string-equal "google-drive" method) @@ -1630,7 +1634,7 @@ file-notify events." (when (and (string-equal "dav" method) (string-equal "true" ssl)) (setq method "davs")) (when (and (string-equal "davs" method) - (string-match + (string-match-p tramp-gvfs-nextcloud-default-prefix-regexp prefix)) (setq method "nextcloud")) (when (string-equal "google-drive" method) @@ -1647,8 +1651,8 @@ file-notify events." (string-equal domain (tramp-file-name-domain vec)) (string-equal host (tramp-file-name-host vec)) (string-equal port (tramp-file-name-port vec)) - (string-match (concat "^/" (regexp-quote (or share ""))) - (tramp-file-name-unquote-localname vec))) + (string-match-p (concat "^/" (regexp-quote (or share ""))) + (tramp-file-name-unquote-localname vec))) ;; Set mountpoint and location. (tramp-set-file-property vec "/" "fuse-mountpoint" fuse-mountpoint) (tramp-set-connection-property @@ -1671,7 +1675,7 @@ file-notify events." (defun tramp-gvfs-mount-spec-entry (key value) "Construct a mount-spec entry to be used in a mount_spec. It was \"a(say)\", but has changed to \"a{sv})\"." - (if (string-match "^(aya{sv})" tramp-gvfs-mountlocation-signature) + (if (string-match-p "^(aya{sv})" tramp-gvfs-mountlocation-signature) (list :dict-entry key (list :variant (tramp-gvfs-dbus-string-to-byte-array value))) (list :struct key (tramp-gvfs-dbus-string-to-byte-array value)))) @@ -1686,7 +1690,7 @@ It was \"a(say)\", but has changed to \"a{sv})\"." (localname (tramp-file-name-unquote-localname vec)) (share (when (string-match "^/?\\([^/]+\\)" localname) (match-string 1 localname))) - (ssl (if (string-match "^davs\\|^nextcloud" method) "true" "false")) + (ssl (if (string-match-p "^davs\\|^nextcloud" method) "true" "false")) (mount-spec `(:array ,@(cond @@ -1694,7 +1698,7 @@ It was \"a(say)\", but has changed to \"a{sv})\"." (list (tramp-gvfs-mount-spec-entry "type" "smb-share") (tramp-gvfs-mount-spec-entry "server" host) (tramp-gvfs-mount-spec-entry "share" share))) - ((string-match "^dav\\|^nextcloud" method) + ((string-match-p "^dav\\|^nextcloud" method) (list (tramp-gvfs-mount-spec-entry "type" "dav") (tramp-gvfs-mount-spec-entry "host" host) (tramp-gvfs-mount-spec-entry "ssl" ssl))) @@ -1708,7 +1712,7 @@ It was \"a(say)\", but has changed to \"a{sv})\"." ((string-equal "nextcloud" method) (list (tramp-gvfs-mount-spec-entry "type" "owncloud") (tramp-gvfs-mount-spec-entry "host" host))) - ((string-match "^http" method) + ((string-match-p "^http" method) (list (tramp-gvfs-mount-spec-entry "type" "http") (tramp-gvfs-mount-spec-entry "uri" @@ -1725,7 +1729,7 @@ It was \"a(say)\", but has changed to \"a{sv})\"." ,@(when port (list (tramp-gvfs-mount-spec-entry "port" port))))) (mount-pref - (if (and (string-match "^dav" method) + (if (and (string-match-p "^dav" method) (string-match "^/?[^/]+" localname)) (match-string 0 localname) (tramp-gvfs-get-remote-prefix vec)))) @@ -1815,7 +1819,7 @@ connection if a previous connection has died for some reason." (string-equal localname "/")) (tramp-error vec 'file-error "Filename must contain an AFP volume")) - (when (and (string-match method "davs?") + (when (and (string-match-p "davs?" method) (string-equal localname "/")) (tramp-error vec 'file-error "Filename must contain a WebDAV share")) @@ -1856,7 +1860,7 @@ connection if a previous connection has died for some reason." ;; The call must be asynchronously, because of the "askPassword" ;; or "askQuestion" callbacks. - (if (string-match "(so)$" tramp-gvfs-mountlocation-signature) + (if (string-match-p "(so)$" tramp-gvfs-mountlocation-signature) (with-tramp-dbus-call-method vec nil :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker tramp-gvfs-interface-mounttracker tramp-gvfs-mountlocation diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 900b4b3c27..3f426bb040 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1257,18 +1257,17 @@ component is used as the target of the symlink." (with-parsed-tramp-file-name (expand-file-name filename) nil (with-tramp-file-property v localname (format "file-attributes-%s" id-format) - (save-excursion - (tramp-convert-file-attributes - v - (or - (cond - ((tramp-get-remote-stat v) - (tramp-do-file-attributes-with-stat v localname id-format)) - ((tramp-get-remote-perl v) - (tramp-do-file-attributes-with-perl v localname id-format)) - (t nil)) - ;; The scripts could fail, for example with huge file size. - (tramp-do-file-attributes-with-ls v localname id-format))))))))) + (tramp-convert-file-attributes + v + (or + (cond + ((tramp-get-remote-stat v) + (tramp-do-file-attributes-with-stat v localname id-format)) + ((tramp-get-remote-perl v) + (tramp-do-file-attributes-with-perl v localname id-format)) + (t nil)) + ;; The scripts could fail, for example with huge file size. + (tramp-do-file-attributes-with-ls v localname id-format)))))))) (defun tramp-sh--quoting-style-options (vec) (or @@ -1335,7 +1334,7 @@ component is used as the target of the symlink." (when symlinkp (search-forward "-> ") (setq res-symlink-target - (if (looking-at "\"") + (if (looking-at-p "\"") (read (current-buffer)) (buffer-substring (point) (point-at-eol))))) ;; Return data gathered. @@ -1383,15 +1382,16 @@ component is used as the target of the symlink." (tramp-send-command-and-read vec (format - (concat - ;; On Opsware, pdksh (which is the true name of ksh there) - ;; doesn't parse correctly the sequence "((". Therefore, we add - ;; a space. Apostrophes in the stat output are masked as - ;; `tramp-stat-marker', in order to make a proper shell escape of - ;; them in file names. - "( (%s %s || %s -h %s) && (%s -c " - "'((%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' " - "%s | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g') || echo nil)") + (eval-when-compile + (concat + ;; On Opsware, pdksh (which is the true name of ksh there) + ;; doesn't parse correctly the sequence "((". Therefore, we + ;; add a space. Apostrophes in the stat output are masked as + ;; `tramp-stat-marker', in order to make a proper shell escape + ;; of them in file names. + "( (%s %s || %s -h %s) && (%s -c " + "'((%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' " + "%s | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g') || echo nil)")) (tramp-get-file-exists-command vec) (tramp-shell-quote-argument localname) (tramp-get-test-command vec) @@ -1399,9 +1399,11 @@ component is used as the target of the symlink." (tramp-get-remote-stat vec) tramp-stat-marker tramp-stat-marker (if (eq id-format 'integer) - "%u" (concat tramp-stat-marker "%U" tramp-stat-marker)) + "%u" + (eval-when-compile (concat tramp-stat-marker "%U" tramp-stat-marker))) (if (eq id-format 'integer) - "%g" (concat tramp-stat-marker "%G" tramp-stat-marker)) + "%g" + (eval-when-compile (concat tramp-stat-marker "%G" tramp-stat-marker))) tramp-stat-marker tramp-stat-marker (tramp-shell-quote-argument localname) tramp-stat-quoted-marker))) @@ -1558,8 +1560,9 @@ be non-negative integers." (with-parsed-tramp-file-name filename nil (with-tramp-file-property v localname "file-selinux-context" (let ((context '(nil nil nil nil)) - (regexp (concat "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\):" - "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\)"))) + (regexp (eval-when-compile + (concat "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\):" + "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\)")))) (when (and (tramp-remote-selinux-p v) (tramp-send-command-and-check v (format @@ -1663,16 +1666,12 @@ be non-negative integers." ;; something smarter about it. (defun tramp-sh-handle-file-newer-than-file-p (file1 file2) "Like `file-newer-than-file-p' for Tramp files." - (cond ((not (file-exists-p file1)) - nil) - ((not (file-exists-p file2)) - t) - ;; We are sure both files exist at this point. - (t - (save-excursion - ;; We try to get the mtime of both files. If they are not - ;; equal to the "dont-know" value, then we subtract the times - ;; and obtain the result. + (cond ((not (file-exists-p file1)) nil) + ((not (file-exists-p file2)) t) + (t ;; We are sure both files exist at this point. We try to + ;; get the mtime of both files. If they are not equal to + ;; the "dont-know" value, then we subtract the times and + ;; obtain the result. (let ((fa1 (file-attributes file1)) (fa2 (file-attributes file2))) (if (and @@ -1701,7 +1700,7 @@ be non-negative integers." file1 file2))) (with-parsed-tramp-file-name file1 nil (tramp-run-test2 - (tramp-get-test-nt-command v) file1 file2)))))))) + (tramp-get-test-nt-command v) file1 file2))))))) ;; Functions implemented using the basic functions above. @@ -1758,25 +1757,22 @@ be non-negative integers." (with-tramp-file-property v localname (format "directory-files-and-attributes-%s" id-format) - (save-excursion - (mapcar - (lambda (x) - (cons (car x) - (tramp-convert-file-attributes v (cdr x)))) - (or - (cond - ((tramp-get-remote-stat v) - (tramp-do-directory-files-and-attributes-with-stat - v localname id-format)) - ((tramp-get-remote-perl v) - (tramp-do-directory-files-and-attributes-with-perl - v localname id-format)) - (t nil))))))))) + (mapcar + (lambda (x) + (cons (car x) (tramp-convert-file-attributes v (cdr x)))) + (cond + ((tramp-get-remote-stat v) + (tramp-do-directory-files-and-attributes-with-stat + v localname id-format)) + ((tramp-get-remote-perl v) + (tramp-do-directory-files-and-attributes-with-perl + v localname id-format)) + (t nil))))))) result item) (while temp (setq item (pop temp)) - (when (or (null match) (string-match match (car item))) + (when (or (null match) (string-match-p match (car item))) (when full (setcar item (expand-file-name (car item) directory))) (push item result))) @@ -1810,16 +1806,18 @@ be non-negative integers." (tramp-send-command-and-read vec (format - (concat - ;; We must care about file names with spaces, or starting with - ;; "-"; this would confuse xargs. "ls -aQ" might be a solution, - ;; but it does not work on all remote systems. Apostrophes in - ;; the stat output are masked as `tramp-stat-marker', in order to - ;; make a proper shell escape of them in file names. - "cd %s && echo \"(\"; (%s %s -a | " - "xargs %s -c " - "'(%s%%n%s (%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' " - "-- 2>/dev/null | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'); echo \")\"") + (eval-when-compile + (concat + ;; We must care about file names with spaces, or starting with + ;; "-"; this would confuse xargs. "ls -aQ" might be a + ;; solution, but it does not work on all remote systems. + ;; Apostrophes in the stat output are masked as + ;; `tramp-stat-marker', in order to make a proper shell escape + ;; of them in file names. + "cd %s && echo \"(\"; (%s %s -a | " + "xargs %s -c " + "'(%s%%n%s (%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' " + "-- 2>/dev/null | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'); echo \")\"")) (tramp-shell-quote-argument localname) (tramp-get-ls-command vec) ;; On systems which have no quoting style, file names with special @@ -1829,9 +1827,11 @@ be non-negative integers." tramp-stat-marker tramp-stat-marker tramp-stat-marker tramp-stat-marker (if (eq id-format 'integer) - "%u" (concat tramp-stat-marker "%U" tramp-stat-marker)) + "%u" + (eval-when-compile (concat tramp-stat-marker "%U" tramp-stat-marker))) (if (eq id-format 'integer) - "%g" (concat tramp-stat-marker "%G" tramp-stat-marker)) + "%g" + (eval-when-compile (concat tramp-stat-marker "%G" tramp-stat-marker))) tramp-stat-marker tramp-stat-marker tramp-stat-quoted-marker))) @@ -1858,12 +1858,13 @@ be non-negative integers." (format "tramp_perl_file_name_all_completions %s" (tramp-shell-quote-argument localname))) - (format (concat - "(cd %s 2>&1 && %s -a 2>/dev/null" - " | while IFS= read f; do" - " if %s -d \"$f\" 2>/dev/null;" - " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done" - " && \\echo ok) || \\echo fail") + (format (eval-when-compile + (concat + "(cd %s 2>&1 && %s -a 2>/dev/null" + " | while IFS= read f; do" + " if %s -d \"$f\" 2>/dev/null;" + " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done" + " && \\echo ok) || \\echo fail")) (tramp-shell-quote-argument localname) (tramp-get-ls-command v) (tramp-get-test-command v)))) @@ -1874,7 +1875,7 @@ be non-negative integers." ;; Check result code, found in last line of output. (forward-line -1) - (if (looking-at "^fail$") + (if (looking-at-p "^fail$") (progn ;; Grab error message from line before last line ;; (it was put there by `cd 2>&1'). @@ -1887,7 +1888,7 @@ be non-negative integers." ;; then it should end in `ok'. If neither are in the ;; buffer something went seriously wrong on the remote ;; side. - (unless (looking-at "^ok$") + (unless (looking-at-p "^ok$") (tramp-error v 'file-error "\ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" @@ -2545,12 +2546,11 @@ The method used must be an out-of-band method." ;; whole cache. (tramp-flush-directory-properties v (if parents "/" (file-name-directory localname))) - (save-excursion - (tramp-barf-unless-okay - v (format "%s %s" - (if parents "mkdir -p" "mkdir") - (tramp-shell-quote-argument localname)) - "Couldn't make directory %s" dir)))) + (tramp-barf-unless-okay + v (format "%s %s" + (if parents "mkdir -p" "mkdir") + (tramp-shell-quote-argument localname)) + "Couldn't make directory %s" dir))) (defun tramp-sh-handle-delete-directory (directory &optional recursive trash) "Like `delete-directory' for Tramp files." @@ -2584,41 +2584,39 @@ The method used must be an out-of-band method." ;; Code stolen mainly from dired-aux.el. (with-parsed-tramp-file-name file nil (tramp-flush-file-properties v localname) - (save-excursion - (let ((suffixes dired-compress-file-suffixes) - suffix) - ;; See if any suffix rule matches this file name. - (while suffixes - (let (case-fold-search) - (if (string-match (car (car suffixes)) localname) - (setq suffix (car suffixes) suffixes nil)) - (setq suffixes (cdr suffixes)))) - - (cond ((file-symlink-p file) - nil) - ((and suffix (nth 2 suffix)) - ;; We found an uncompression rule. - (with-tramp-progress-reporter - v 0 (format "Uncompressing %s" file) - (when (tramp-send-command-and-check - v (concat (nth 2 suffix) " " - (tramp-shell-quote-argument localname))) - (dired-remove-file file) - (string-match (car suffix) file) - (concat (substring file 0 (match-beginning 0)))))) - (t - ;; We don't recognize the file as compressed, so compress it. - ;; Try gzip. - (with-tramp-progress-reporter v 0 (format "Compressing %s" file) - (when (tramp-send-command-and-check - v (concat "gzip -f " - (tramp-shell-quote-argument localname))) - (dired-remove-file file) - (cond ((file-exists-p (concat file ".gz")) - (concat file ".gz")) - ((file-exists-p (concat file ".z")) - (concat file ".z")) - (t nil)))))))))) + (let ((suffixes dired-compress-file-suffixes) + suffix) + ;; See if any suffix rule matches this file name. + (while suffixes + (let (case-fold-search) + (if (string-match-p (car (car suffixes)) localname) + (setq suffix (car suffixes) suffixes nil)) + (setq suffixes (cdr suffixes)))) + + (cond ((file-symlink-p file) nil) + ((and suffix (nth 2 suffix)) + ;; We found an uncompression rule. + (with-tramp-progress-reporter + v 0 (format "Uncompressing %s" file) + (when (tramp-send-command-and-check + v (concat (nth 2 suffix) " " + (tramp-shell-quote-argument localname))) + (dired-remove-file file) + (string-match (car suffix) file) + (concat (substring file 0 (match-beginning 0)))))) + (t + ;; We don't recognize the file as compressed, so compress it. + ;; Try gzip. + (with-tramp-progress-reporter v 0 (format "Compressing %s" file) + (when (tramp-send-command-and-check + v (concat "gzip -f " + (tramp-shell-quote-argument localname))) + (dired-remove-file file) + (cond ((file-exists-p (concat file ".gz")) + (concat file ".gz")) + ((file-exists-p (concat file ".z")) + (concat file ".z")) + (t nil))))))))) (defun tramp-sh-handle-insert-directory (filename switches &optional wildcard full-directory-p) @@ -2698,7 +2696,7 @@ The method used must be an out-of-band method." ;; Check for "--dired" output. (forward-line -2) - (when (looking-at "//SUBDIRED//") + (when (looking-at-p "//SUBDIRED//") (forward-line -1)) (when (looking-at "//DIRED//\\s-+") (let ((databeg (match-end 0)) @@ -2719,7 +2717,7 @@ The method used must be an out-of-band method." ;; Some busyboxes are reluctant to discard colors. (unless - (string-match "color" (tramp-get-connection-property v "ls" "")) + (string-match-p "color" (tramp-get-connection-property v "ls" "")) (goto-char beg) (while (re-search-forward tramp-display-escape-sequence-regexp nil t) @@ -2787,7 +2785,7 @@ the result will be a local, non-Tramp, file name." ;; appropriate either, because ssh and companions might ;; use a user name from the config file. (when (and (string-equal uname "~") - (string-match "\\`su\\(do\\)?\\'" method)) + (string-match-p "\\`su\\(do\\)?\\'" method)) (setq uname (concat uname user))) (setq uname (with-tramp-connection-property v uname @@ -2837,7 +2835,7 @@ the result will be a local, non-Tramp, file name." ;; it might be that the arguments exceed the command line ;; length. Therefore, we modify the command. (heredoc (and (stringp program) - (string-match "sh$" program) + (string-match-p "sh$" program) (string-equal "-c" (car args)) (= (length args) 2))) ;; When PROGRAM is nil, we just provide a tty. @@ -2861,7 +2859,7 @@ the result will be a local, non-Tramp, file name." env uenv (env (dolist (elt (cons prompt process-environment) env) (or (member elt (default-toplevel-value 'process-environment)) - (if (string-match "=" elt) + (if (string-match-p "=" elt) (setq env (append env `(,elt))) (if (tramp-get-env-with-u-option v) (setq env (append `("-u" ,elt) env)) @@ -2951,7 +2949,7 @@ the result will be a local, non-Tramp, file name." p))) ;; Save exit. - (if (string-match tramp-temp-buffer-name (buffer-name)) + (if (string-match-p tramp-temp-buffer-name (buffer-name)) (ignore-errors (set-process-buffer p nil) (kill-buffer (current-buffer))) @@ -2974,7 +2972,7 @@ the result will be a local, non-Tramp, file name." ;; We use as environment the difference to toplevel `process-environment'. (dolist (elt process-environment) (or (member elt (default-toplevel-value 'process-environment)) - (if (string-match "=" elt) + (if (string-match-p "=" elt) (setq env (append env `(,elt))) (if (tramp-get-env-with-u-option v) (setq env (append `("-u" ,elt) env)) @@ -3114,50 +3112,49 @@ the result will be a local, non-Tramp, file name." ;; Use inline encoding for file transfer. (rem-enc - (save-excursion - (with-tramp-progress-reporter - v 3 - (format-message "Encoding remote file `%s' with `%s'" - filename rem-enc) - (tramp-barf-unless-okay - v (format rem-enc (tramp-shell-quote-argument localname)) - "Encoding remote file failed")) - - (with-tramp-progress-reporter - v 3 (format-message "Decoding local file `%s' with `%s'" - tmpfile loc-dec) - (if (functionp loc-dec) - ;; If local decoding is a function, we call it. - ;; We must disable multibyte, because - ;; `uudecode-decode-region' doesn't handle it - ;; correctly. Unset `file-name-handler-alist'. - ;; Otherwise, epa-file gets confused. - (let (file-name-handler-alist - (coding-system-for-write 'binary)) - (with-temp-file tmpfile - (set-buffer-multibyte nil) - (insert-buffer-substring (tramp-get-buffer v)) - (funcall loc-dec (point-min) (point-max)))) - - ;; If tramp-decoding-function is not defined for this - ;; method, we invoke tramp-decoding-command instead. - (let ((tmpfile2 (tramp-compat-make-temp-file filename))) - ;; Unset `file-name-handler-alist'. Otherwise, - ;; epa-file gets confused. - (let (file-name-handler-alist - (coding-system-for-write 'binary)) - (with-current-buffer (tramp-get-buffer v) - (write-region - (point-min) (point-max) tmpfile2 nil 'no-message))) - (unwind-protect - (tramp-call-local-coding-command - loc-dec tmpfile2 tmpfile) - (delete-file tmpfile2))))) - - ;; Set proper permissions. - (set-file-modes tmpfile (tramp-default-file-modes filename)) - ;; Set local user ownership. - (tramp-set-file-uid-gid tmpfile))) + (with-tramp-progress-reporter + v 3 + (format-message + "Encoding remote file `%s' with `%s'" filename rem-enc) + (tramp-barf-unless-okay + v (format rem-enc (tramp-shell-quote-argument localname)) + "Encoding remote file failed")) + + (with-tramp-progress-reporter + v 3 (format-message + "Decoding local file `%s' with `%s'" tmpfile loc-dec) + (if (functionp loc-dec) + ;; If local decoding is a function, we call it. We + ;; must disable multibyte, because + ;; `uudecode-decode-region' doesn't handle it + ;; correctly. Unset `file-name-handler-alist'. + ;; Otherwise, epa-file gets confused. + (let (file-name-handler-alist + (coding-system-for-write 'binary)) + (with-temp-file tmpfile + (set-buffer-multibyte nil) + (insert-buffer-substring (tramp-get-buffer v)) + (funcall loc-dec (point-min) (point-max)))) + + ;; If tramp-decoding-function is not defined for this + ;; method, we invoke tramp-decoding-command instead. + (let ((tmpfile2 (tramp-compat-make-temp-file filename))) + ;; Unset `file-name-handler-alist'. Otherwise, + ;; epa-file gets confused. + (let (file-name-handler-alist + (coding-system-for-write 'binary)) + (with-current-buffer (tramp-get-buffer v) + (write-region + (point-min) (point-max) tmpfile2 nil 'no-message))) + (unwind-protect + (tramp-call-local-coding-command + loc-dec tmpfile2 tmpfile) + (delete-file tmpfile2))))) + + ;; Set proper permissions. + (set-file-modes tmpfile (tramp-default-file-modes filename)) + ;; Set local user ownership. + (tramp-set-file-uid-gid tmpfile)) ;; Oops, I don't know what to do. (t (tramp-error @@ -3323,8 +3320,9 @@ the result will be a local, non-Tramp, file name." loc-enc tmpfile t)) (tramp-error v 'file-error - (concat "Cannot write to `%s', " - "local encoding command `%s' failed") + (eval-when-compile + (concat "Cannot write to `%s', " + "local encoding command `%s' failed")) filename loc-enc)))) ;; Send buffer into remote decoding command which @@ -3369,8 +3367,9 @@ the result will be a local, non-Tramp, file name." (buffer-string)))) (tramp-error v 'file-error - (concat "Couldn't write region to `%s'," - " decode using `%s' failed") + (eval-when-compile + (concat "Couldn't write region to `%s'," + " decode using `%s' failed")) filename rem-dec))))) ;; Save exit. @@ -3380,8 +3379,9 @@ the result will be a local, non-Tramp, file name." (t (tramp-error v 'file-error - (concat "Method `%s' should specify both encoding and " - "decoding command or an scp program") + (eval-when-compile + (concat "Method `%s' should specify both encoding and " + "decoding command or an scp program")) method)))) ;; Make `last-coding-system-used' have the right value. @@ -3568,11 +3568,13 @@ Fall back to normal file name handler if no Tramp handler exists." events (cond ((and (memq 'change flags) (memq 'attribute-change flags)) - (concat "create,modify,move,moved_from,moved_to,move_self," - "delete,delete_self,attrib,ignored")) + (eval-when-compile + (concat "create,modify,move,moved_from,moved_to,move_self," + "delete,delete_self,attrib,ignored"))) ((memq 'change flags) - (concat "create,modify,move,moved_from,moved_to,move_self," - "delete,delete_self,ignored")) + (eval-when-compile + (concat "create,modify,move,moved_from,moved_to,move_self," + "delete,delete_self,ignored"))) ((memq 'attribute-change flags) "attrib,ignored")) sequence `(,command "-mq" "-e" ,events ,localname) ;; Make events a list of symbols. @@ -3656,14 +3658,16 @@ Fall back to normal file name handler if no Tramp handler exists." string (replace-regexp-in-string "renamed to" "moved" string)) ;; https://bugs.launchpad.net/bugs/1742946 - (when (string-match "Monitoring not supported\\|No locations given" string) + (when + (string-match-p "Monitoring not supported\\|No locations given" string) (delete-process proc)) (while (string-match - (concat "^[^:]+:" - "[[:space:]]\\([^:]+\\):" - "[[:space:]]" (regexp-opt tramp-gio-events t) - "\\([[:space:]]\\([^:]+\\)\\)?$") + (eval-when-compile + (concat "^[^:]+:" + "[[:space:]]\\([^:]+\\):" + "[[:space:]]" (regexp-opt tramp-gio-events t) + "\\([[:space:]]\\([^:]+\\)\\)?$")) string) (let* ((file (match-string 1 string)) @@ -3712,11 +3716,12 @@ file-notify events." "ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string)) (while (string-match - (concat "^[\n\r]*" - "Directory Monitor Event:[\n\r]+" - "Child = \\([^\n\r]+\\)[\n\r]+" - "\\(Other = \\([^\n\r]+\\)[\n\r]+\\)?" - "Event = \\([^[:blank:]]+\\)[\n\r]+") + (eval-when-compile + (concat "^[\n\r]*" + "Directory Monitor Event:[\n\r]+" + "Child = \\([^\n\r]+\\)[\n\r]+" + "\\(Other = \\([^\n\r]+\\)[\n\r]+\\)?" + "Event = \\([^[:blank:]]+\\)[\n\r]+")) string) (let* ((file (match-string 1 string)) (file1 (match-string 3 string)) @@ -3755,10 +3760,11 @@ file-notify events." (tramp-message proc 6 "%S\n%s" proc string) (dolist (line (split-string string "[\n\r]+" 'omit)) ;; Check, whether there is a problem. - (unless (string-match - (concat "^[^[:blank:]]+" - "[[:blank:]]+\\([^[:blank:]]+\\)+" - "\\([[:blank:]]+\\([^\n\r]+\\)\\)?") + (unless (string-match-p + (eval-when-compile + (concat "^[^[:blank:]]+" + "[[:blank:]]+\\([^[:blank:]]+\\)+" + "\\([[:blank:]]+\\([^\n\r]+\\)\\)?")) line) (tramp-error proc 'file-notify-error "%s" line)) @@ -3796,9 +3802,10 @@ file-notify events." (goto-char (point-min)) (forward-line) (when (looking-at - (concat "[[:space:]]*\\([[:digit:]]+\\)" - "[[:space:]]+\\([[:digit:]]+\\)" - "[[:space:]]+\\([[:digit:]]+\\)")) + (eval-when-compile + (concat "[[:space:]]*\\([[:digit:]]+\\)" + "[[:space:]]+\\([[:digit:]]+\\)" + "[[:space:]]+\\([[:digit:]]+\\)"))) (list (string-to-number (match-string 1)) ;; The second value is the used size. We need the ;; free size. @@ -3823,7 +3830,7 @@ Only send the definition if it has not already been done." (setq script (replace-regexp-in-string (make-string 1 ?\t) (make-string 8 ? ) script)) ;; The script could contain a call of Perl. This is masked with `%s'. - (when (and (string-match "%s" script) + (when (and (string-match-p "%s" script) (not (tramp-get-remote-perl vec))) (tramp-error vec 'file-error "No Perl available on remote host")) (tramp-barf-unless-okay @@ -3884,12 +3891,12 @@ This function expects to be in the right *tramp* buffer." ;; 5.11") have problems with this command, we disable the call ;; therefore. (unless (or ignore-path - (string-match - (regexp-opt '("SunOS 5.10" "SunOS 5.11")) + (string-match-p + (eval-when-compile (regexp-opt '("SunOS 5.10" "SunOS 5.11"))) (tramp-get-connection-property vec "uname" ""))) (tramp-send-command vec (format "which \\%s | wc -w" progname)) (goto-char (point-min)) - (if (looking-at "^\\s-*1$") + (if (looking-at-p "^\\s-*1$") (setq result (concat "\\" progname)))) (unless result (when ignore-tilde @@ -3903,11 +3910,12 @@ This function expects to be in the right *tramp* buffer." (setq dirlist (nreverse newdl)))) (tramp-send-command vec - (format (concat "while read d; " - "do if test -x $d/%s && test -f $d/%s; " - "then echo tramp_executable $d/%s; " - "break; fi; done <<'%s'\n" - "%s\n%s") + (format (eval-when-compile + (concat "while read d; " + "do if test -x $d/%s && test -f $d/%s; " + "then echo tramp_executable $d/%s; " + "break; fi; done <<'%s'\n" + "%s\n%s")) progname progname progname tramp-end-of-heredoc (mapconcat 'identity dirlist "\n") @@ -3996,7 +4004,7 @@ file exists and nonzero exit status otherwise." item extra-args) (while (and alist (null extra-args)) (setq item (pop alist)) - (when (string-match (car item) shell) + (when (string-match-p (car item) shell) (setq extra-args (cdr item)))) ;; It is useful to set the prompt in the following command ;; because some people have a setting for $PS1 which /bin/sh @@ -4017,9 +4025,10 @@ file exists and nonzero exit status otherwise." ;; initial probes to ensure the remote shell is usable.) (tramp-send-command vec (format - (concat - "exec env TERM='%s' INSIDE_EMACS='%s,tramp:%s' " - "ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s") + (eval-when-compile + (concat + "exec env TERM='%s' INSIDE_EMACS='%s,tramp:%s' " + "ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s")) tramp-terminal-type emacs-version tramp-version ; INSIDE_EMACS (or (getenv-internal "ENV" tramp-remote-process-environment) "") @@ -4057,13 +4066,14 @@ file exists and nonzero exit status otherwise." ;; CCC: "root" does not exist always, see my QNAP TS-459. ;; Which check could we apply instead? (tramp-send-command vec "echo ~root" t) - (if (or (string-match "^~root$" (buffer-string)) + (if (or (string-match-p "^~root$" (buffer-string)) ;; The default shell (ksh93) of OpenSolaris and ;; Solaris is buggy. We've got reports for ;; "SunOS 5.10" and "SunOS 5.11" so far. - (string-match (regexp-opt '("SunOS 5.10" "SunOS 5.11")) - (tramp-get-connection-property - vec "uname" ""))) + (string-match-p + (eval-when-compile + (regexp-opt '("SunOS 5.10" "SunOS 5.11"))) + (tramp-get-connection-property vec "uname" ""))) (or (tramp-find-executable vec "bash" (tramp-get-remote-path vec) t t) @@ -4074,9 +4084,10 @@ file exists and nonzero exit status otherwise." default-shell (tramp-message vec 2 - (concat - "Couldn't find a remote shell which groks tilde " - "expansion, using `%s'") + (eval-when-compile + (concat + "Couldn't find a remote shell which groks tilde " + "expansion, using `%s'")) default-shell))) default-shell))) @@ -4122,7 +4133,7 @@ process to set up. VEC specifies the connection." (tramp-send-command vec "echo foo" t) (with-current-buffer (process-buffer proc) (goto-char (point-min)) - (when (looking-at "echo foo") + (when (looking-at-p "echo foo") (tramp-set-connection-property proc "remote-echo" t) (tramp-message vec 5 "Remote echo still on. Ok.") ;; Make sure backspaces and their echo are enabled and no line @@ -4161,10 +4172,10 @@ process to set up. VEC specifies the connection." ;; Use MULE to select the right EOL convention for communicating ;; with the process. (let ((cs (or (and (memq 'utf-8-hfs (coding-system-list)) - (string-match "^Darwin" uname) + (string-match-p "^Darwin" uname) (cons 'utf-8-hfs 'utf-8-hfs)) (and (memq 'utf-8 (coding-system-list)) - (string-match "utf-?8" (tramp-get-remote-locale vec)) + (string-match-p "utf-?8" (tramp-get-remote-locale vec)) (cons 'utf-8 'utf-8)) (process-coding-system proc) (cons 'undecided 'undecided))) @@ -4174,7 +4185,7 @@ process to set up. VEC specifies the connection." cs-encode (or (cdr cs) 'undecided) cs-encode (coding-system-change-eol-conversion - cs-encode (if (string-match "^Darwin" uname) 'mac 'unix))) + cs-encode (if (string-match-p "^Darwin" uname) 'mac 'unix))) (tramp-send-command vec "(echo foo ; echo bar)" t) (goto-char (point-min)) (when (search-forward "\r" nil t) @@ -4198,7 +4209,7 @@ process to set up. VEC specifies the connection." (t (tramp-message vec 5 "Checking remote host type for `send-process-string' bug") - (if (string-match "^FreeBSD" uname) 500 0)))) + (if (string-match-p "^FreeBSD" uname) 500 0)))) ;; Set remote PATH variable. (tramp-set-remote-path vec) @@ -4221,11 +4232,11 @@ process to set up. VEC specifies the connection." ;; IRIX64 bash expands "!" even when in single quotes. This ;; destroys our shell functions, we must disable it. See ;; . - (when (string-match "^IRIX64" uname) + (when (string-match-p "^IRIX64" uname) (tramp-send-command vec "set +H" t)) ;; Disable tab expansion. - (if (string-match "BSD\\|Darwin" uname) + (if (string-match-p "BSD\\|Darwin" uname) (tramp-send-command vec "stty tabs" t) (tramp-send-command vec "stty tab0" t)) @@ -4397,7 +4408,7 @@ Goes through the list `tramp-local-coding-commands' and (throw 'wont-work-remote nil))) ;; Check if remote perl exists when necessary. (when (and (symbolp rem-enc) - (string-match "perl" (symbol-name rem-enc)) + (string-match-p "perl" (symbol-name rem-enc)) (not (tramp-get-remote-perl vec))) (throw 'wont-work-remote nil)) ;; Check if remote encoding and decoding commands can be @@ -4410,7 +4421,7 @@ Goes through the list `tramp-local-coding-commands' and ;; it might change the permissions of /dev/null! (when (not (stringp rem-enc)) (let ((name (symbol-name rem-enc))) - (while (string-match (regexp-quote "-") name) + (while (string-match "-" name) (setq name (replace-match "_" nil t name))) (tramp-maybe-send-script vec (symbol-value rem-enc) name) (setq rem-enc name))) @@ -4425,9 +4436,9 @@ Goes through the list `tramp-local-coding-commands' and (let ((name (symbol-name rem-dec)) (value (symbol-value rem-dec)) tmpfile) - (while (string-match (regexp-quote "-") name) + (while (string-match "-" name) (setq name (replace-match "_" nil t name))) - (when (string-match "\\(^\\|[^%]\\)%t" value) + (when (string-match-p "\\(^\\|[^%]\\)%t" value) (setq tmpfile (make-temp-name (expand-file-name @@ -4452,7 +4463,7 @@ Goes through the list `tramp-local-coding-commands' and (with-current-buffer (tramp-get-buffer vec) (goto-char (point-min)) - (unless (looking-at (regexp-quote magic)) + (unless (looking-at-p (regexp-quote magic)) (throw 'wont-work-remote nil))) ;; `rem-enc' and `rem-dec' could be a string meanwhile. @@ -4482,12 +4493,12 @@ means standard output and thus the current buffer), or nil (which means discard it)." (tramp-call-process nil tramp-encoding-shell - (when (and input (not (string-match "%s" cmd))) input) + (when (and input (not (string-match-p "%s" cmd))) input) (if (eq output t) t nil) nil tramp-encoding-command-switch (concat - (if (string-match "%s" cmd) (format cmd input) cmd) + (if (string-match-p "%s" cmd) (format cmd input) cmd) (if (stringp output) (concat " >" output) "")))) (defconst tramp-inline-compress-commands @@ -4598,13 +4609,15 @@ Goes through the list `tramp-inline-compress-commands'." proxy (eval (nth 2 item))) (when (and ;; Host. - (string-match (or (eval (nth 0 item)) "") - (or (tramp-file-name-host-port (car target-alist)) - "")) + (string-match-p + (or (eval (nth 0 item)) "") + (or (tramp-file-name-host-port (car target-alist)) + "")) ;; User. - (string-match (or (eval (nth 1 item)) "") - (or (tramp-file-name-user-domain (car target-alist)) - ""))) + (string-match-p + (or (eval (nth 1 item)) "") + (or (tramp-file-name-user-domain (car target-alist)) + ""))) (if (null proxy) ;; No more hops needed. (setq choices nil) @@ -4646,7 +4659,7 @@ Goes through the list `tramp-inline-compress-commands'." (member '("%h") (tramp-get-method-parameter item 'tramp-login-args)) ;; The host name must match previous hop. - (string-match previous-host host)) + (string-match-p previous-host host)) (tramp-user-error item "Host name `%s' does not match `%s'" host previous-host)) (setq previous-host (concat "^" (regexp-quote host) "$"))))) @@ -4879,7 +4892,7 @@ connection if a previous connection has died for some reason." ;; Check, whether there is a restricted shell. (dolist (elt tramp-restricted-shell-hosts-alist) - (when (string-match elt current-host) + (when (string-match-p elt current-host) (setq r-shell t))) (setq current-host l-host) @@ -5121,82 +5134,85 @@ raises an error." Convert file mode bits to string and set virtual device number. Return ATTR." (when attr - ;; Remove color escape sequences from symlink. - (when (stringp (car attr)) - (while (string-match tramp-display-escape-sequence-regexp (car attr)) - (setcar attr (replace-match "" nil nil (car attr))))) - ;; Convert uid and gid. Use `tramp-unknown-id-integer' as - ;; indication of unusable value. - (when (and (numberp (nth 2 attr)) (< (nth 2 attr) 0)) - (setcar (nthcdr 2 attr) tramp-unknown-id-integer)) - (when (and (floatp (nth 2 attr)) - (<= (nth 2 attr) most-positive-fixnum)) - (setcar (nthcdr 2 attr) (round (nth 2 attr)))) - (when (and (numberp (nth 3 attr)) (< (nth 3 attr) 0)) - (setcar (nthcdr 3 attr) tramp-unknown-id-integer)) - (when (and (floatp (nth 3 attr)) - (<= (nth 3 attr) most-positive-fixnum)) - (setcar (nthcdr 3 attr) (round (nth 3 attr)))) - ;; Convert last access time. - (unless (listp (nth 4 attr)) - (setcar (nthcdr 4 attr) (seconds-to-time (nth 4 attr)))) - ;; Convert last modification time. - (unless (listp (nth 5 attr)) - (setcar (nthcdr 5 attr) (seconds-to-time (nth 5 attr)))) - ;; Convert last status change time. - (unless (listp (nth 6 attr)) - (setcar (nthcdr 6 attr) (seconds-to-time (nth 6 attr)))) - ;; Convert file size. - (when (< (nth 7 attr) 0) - (setcar (nthcdr 7 attr) -1)) - (when (and (floatp (nth 7 attr)) - (<= (nth 7 attr) most-positive-fixnum)) - (setcar (nthcdr 7 attr) (round (nth 7 attr)))) - ;; Convert file mode bits to string. - (unless (stringp (nth 8 attr)) - (setcar (nthcdr 8 attr) (tramp-file-mode-from-int (nth 8 attr))) + (save-match-data + ;; Remove color escape sequences from symlink. (when (stringp (car attr)) - (aset (nth 8 attr) 0 ?l))) - ;; Convert directory indication bit. - (when (string-match "^d" (nth 8 attr)) - (setcar attr t)) - ;; Convert symlink from `tramp-do-file-attributes-with-stat'. - ;; Decode also multibyte string. - (when (consp (car attr)) - (setcar attr - (and (stringp (caar attr)) - (string-match ".+ -> .\\(.+\\)." (caar attr)) - (decode-coding-string (match-string 1 (caar attr)) 'utf-8)))) - ;; Set file's gid change bit. - (setcar (nthcdr 9 attr) - (if (numberp (nth 3 attr)) - (not (= (nth 3 attr) - (tramp-get-remote-gid vec 'integer))) - (not (string-equal - (nth 3 attr) - (tramp-get-remote-gid vec 'string))))) - ;; Convert inode. - (when (floatp (nth 10 attr)) - (setcar (nthcdr 10 attr) - (condition-case nil - (let ((high (nth 10 attr)) - middle low) - (if (<= high most-positive-fixnum) - (floor high) - ;; The low 16 bits. - (setq low (mod high #x10000) - high (/ high #x10000)) + (while (string-match tramp-display-escape-sequence-regexp (car attr)) + (setcar attr (replace-match "" nil nil (car attr))))) + ;; Convert uid and gid. Use `tramp-unknown-id-integer' as + ;; indication of unusable value. + (when (and (numberp (nth 2 attr)) (< (nth 2 attr) 0)) + (setcar (nthcdr 2 attr) tramp-unknown-id-integer)) + (when (and (floatp (nth 2 attr)) + (<= (nth 2 attr) most-positive-fixnum)) + (setcar (nthcdr 2 attr) (round (nth 2 attr)))) + (when (and (numberp (nth 3 attr)) (< (nth 3 attr) 0)) + (setcar (nthcdr 3 attr) tramp-unknown-id-integer)) + (when (and (floatp (nth 3 attr)) + (<= (nth 3 attr) most-positive-fixnum)) + (setcar (nthcdr 3 attr) (round (nth 3 attr)))) + ;; Convert last access time. + (unless (listp (nth 4 attr)) + (setcar (nthcdr 4 attr) (seconds-to-time (nth 4 attr)))) + ;; Convert last modification time. + (unless (listp (nth 5 attr)) + (setcar (nthcdr 5 attr) (seconds-to-time (nth 5 attr)))) + ;; Convert last status change time. + (unless (listp (nth 6 attr)) + (setcar (nthcdr 6 attr) (seconds-to-time (nth 6 attr)))) + ;; Convert file size. + (when (< (nth 7 attr) 0) + (setcar (nthcdr 7 attr) -1)) + (when (and (floatp (nth 7 attr)) + (<= (nth 7 attr) most-positive-fixnum)) + (setcar (nthcdr 7 attr) (round (nth 7 attr)))) + ;; Convert file mode bits to string. + (unless (stringp (nth 8 attr)) + (setcar (nthcdr 8 attr) (tramp-file-mode-from-int (nth 8 attr))) + (when (stringp (car attr)) + (aset (nth 8 attr) 0 ?l))) + ;; Convert directory indication bit. + (when (string-match-p "^d" (nth 8 attr)) + (setcar attr t)) + ;; Convert symlink from `tramp-do-file-attributes-with-stat'. + ;; Decode also multibyte string. + (when (consp (car attr)) + (setcar attr + (and (stringp (caar attr)) + (string-match ".+ -> .\\(.+\\)." (caar attr)) + (decode-coding-string + (match-string 1 (caar attr)) 'utf-8)))) + ;; Set file's gid change bit. + (setcar (nthcdr 9 attr) + (if (numberp (nth 3 attr)) + (not (= (nth 3 attr) + (tramp-get-remote-gid vec 'integer))) + (not (string-equal + (nth 3 attr) + (tramp-get-remote-gid vec 'string))))) + ;; Convert inode. + (when (floatp (nth 10 attr)) + (setcar (nthcdr 10 attr) + (condition-case nil + (let ((high (nth 10 attr)) + middle low) (if (<= high most-positive-fixnum) - (cons (floor high) (floor low)) - ;; The middle 24 bits. - (setq middle (mod high #x1000000) - high (/ high #x1000000)) - (cons (floor high) (cons (floor middle) (floor low)))))) - ;; Inodes can be incredible huge. We must hide this. - (error (tramp-get-inode vec))))) - ;; Set virtual device number. - (setcar (nthcdr 11 attr) - (tramp-get-device vec)) + (floor high) + ;; The low 16 bits. + (setq low (mod high #x10000) + high (/ high #x10000)) + (if (<= high most-positive-fixnum) + (cons (floor high) (floor low)) + ;; The middle 24 bits. + (setq middle (mod high #x1000000) + high (/ high #x1000000)) + (cons (floor high) + (cons (floor middle) (floor low)))))) + ;; Inodes can be incredible huge. We must hide this. + (error (tramp-get-inode vec))))) + ;; Set virtual device number. + (setcar (nthcdr 11 attr) + (tramp-get-device vec))) attr)) (defun tramp-shell-case-fold (string) @@ -5216,9 +5232,9 @@ Return ATTR." (host (tramp-file-name-host vec)) (localname (directory-file-name (tramp-file-name-unquote-localname vec)))) - (when (string-match tramp-ipv6-regexp host) + (when (string-match-p tramp-ipv6-regexp host) (setq host (format "[%s]" host))) - (unless (string-match "ftp$" method) + (unless (string-match-p "ftp$" method) (setq localname (tramp-shell-quote-argument localname))) (cond ((tramp-get-method-parameter vec 'tramp-remote-copy-program) @@ -5336,8 +5352,8 @@ Nonexistent directories are removed from spec." (with-current-buffer (tramp-get-connection-buffer vec) (while candidates (goto-char (point-min)) - (if (string-match (format "^%s\r?$" (regexp-quote (car candidates))) - (buffer-string)) + (if (string-match-p (format "^%s\r?$" (regexp-quote (car candidates))) + (buffer-string)) (setq locale (car candidates) candidates nil) (setq candidates (cdr candidates))))) @@ -5408,7 +5424,7 @@ Nonexistent directories are removed from spec." vec (format "( %s / -nt / )" (tramp-get-test-command vec))) (with-current-buffer (tramp-get-buffer vec) (goto-char (point-min)) - (when (looking-at (regexp-quote tramp-end-of-output)) + (when (looking-at-p (regexp-quote tramp-end-of-output)) (format "%s %%s -nt %%s" (tramp-get-test-command vec))))) (progn (tramp-send-command @@ -5470,7 +5486,7 @@ Nonexistent directories are removed from spec." tmp (tramp-send-command-and-read vec (format "%s -c '(\"%%N\" %%s)' /" result) 'noerror)) (unless (and (listp tmp) (stringp (car tmp)) - (string-match "^\\(`/'\\|â€/’\\)$" (car tmp)) + (string-match-p "^\\(`/'\\|â€/’\\)$" (car tmp)) (integerp (cadr tmp))) (setq result nil))) result))) @@ -5721,14 +5737,14 @@ function cell is returned to be applied on a buffer." (tramp-find-inline-encoding vec) (tramp-get-connection-property (tramp-get-connection-process vec) prop nil))) - (prop1 (if (string-match "encoding" prop) + (prop1 (if (string-match-p "encoding" prop) "inline-compress" "inline-decompress")) compress) ;; The connection property might have been cached. So we must ;; send the script to the remote side - maybe. - (when (and coding (symbolp coding) (string-match "remote" prop)) + (when (and coding (symbolp coding) (string-match-p "remote" prop)) (let ((name (symbol-name coding))) - (while (string-match (regexp-quote "-") name) + (while (string-match "-" name) (setq name (replace-match "_" nil t name))) (tramp-maybe-send-script vec (symbol-value coding) name) (setq coding name))) @@ -5738,7 +5754,7 @@ function cell is returned to be applied on a buffer." ;; Return the value. (cond ((and compress (symbolp coding)) - (if (string-match "decompress" prop1) + (if (string-match-p "decompress" prop1) `(lambda (beg end) (,coding beg end) (let ((coding-system-for-write 'binary) @@ -5757,16 +5773,16 @@ function cell is returned to be applied on a buffer." (,coding (point-min) (point-max))))) ((symbolp coding) coding) - ((and compress (string-match "decoding" prop)) + ((and compress (string-match-p "decoding" prop)) (format ;; Windows shells need the program file name after ;; the pipe symbol be quoted if they use forward ;; slashes as directory separators. (cond - ((and (string-match "local" prop) + ((and (string-match-p "local" prop) (memq system-type '(windows-nt))) "(%s | \"%s\")") - ((string-match "local" prop) "(%s | %s)") + ((string-match-p "local" prop) "(%s | %s)") (t "(%s | %s >%%s)")) coding compress)) (compress @@ -5774,14 +5790,14 @@ function cell is returned to be applied on a buffer." ;; Windows shells need the program file name after ;; the pipe symbol be quoted if they use forward ;; slashes as directory separators. - (if (and (string-match "local" prop) + (if (and (string-match-p "local" prop) (memq system-type '(windows-nt))) "(%s <%%s | \"%s\")" "(%s <%%s | %s)") compress coding)) - ((string-match "decoding" prop) + ((string-match-p "decoding" prop) (cond - ((string-match "local" prop) (format "%s" coding)) + ((string-match-p "local" prop) (format "%s" coding)) (t (format "%s >%%s" coding)))) (t (format "%s <%%s" coding))))))) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index d1a922813d..5b7998ac97 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -677,7 +677,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (when match (setq result (delete nil - (mapcar (lambda (x) (when (string-match match x) x)) + (mapcar (lambda (x) (when (string-match-p match x) x)) result)))) ;; Append directory. (when full @@ -728,10 +728,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (widen) (tramp-message vec 10 "\n%s" (buffer-string)) (goto-char (point-min)) - (while (and (not (eobp)) (not (looking-at "^REVISION:"))) + (while (and (not (eobp)) (not (looking-at-p "^REVISION:"))) (forward-line) (delete-region (point-min) (point))) - (while (and (not (eobp)) (looking-at "^.+:.+")) + (while (and (not (eobp)) (looking-at-p "^.+:.+")) (forward-line)) (delete-region (point) (point-max)) (throw 'tramp-action 'ok)))) @@ -816,7 +816,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; Check result. (when entry - (list (and (string-match "d" (nth 1 entry)) + (list (and (string-match-p "d" (nth 1 entry)) t) ;0 file type -1 ;1 link count uid ;2 uid @@ -933,15 +933,14 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." filename (with-parsed-tramp-file-name (expand-file-name directory) nil (with-tramp-file-property v localname "file-name-all-completions" - (save-match-data - (delete-dups - (mapcar - (lambda (x) - (list - (if (string-match "d" (nth 1 x)) - (file-name-as-directory (nth 0 x)) - (nth 0 x)))) - (tramp-smb-get-file-entries directory)))))))) + (delete-dups + (mapcar + (lambda (x) + (list + (if (string-match-p "d" (nth 1 x)) + (file-name-as-directory (nth 0 x)) + (nth 0 x)))) + (tramp-smb-get-file-entries directory))))))) (defun tramp-smb-handle-file-system-info (filename) "Like `file-system-info' for Tramp files." @@ -956,9 +955,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (goto-char (point-min)) (forward-line) (when (looking-at - (concat "[[:space:]]*\\([[:digit:]]+\\)" - " blocks of size \\([[:digit:]]+\\)" - "\\. \\([[:digit:]]+\\) blocks available")) + (eval-when-compile + (concat "[[:space:]]*\\([[:digit:]]+\\)" + " blocks of size \\([[:digit:]]+\\)" + "\\. \\([[:digit:]]+\\) blocks available"))) (setq blocksize (string-to-number (match-string 2)) total (* blocksize (string-to-number (match-string 1))) avail (* blocksize (string-to-number (match-string 3))))) @@ -975,7 +975,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (defun tramp-smb-handle-file-writable-p (filename) "Like `file-writable-p' for Tramp files." (if (file-exists-p filename) - (string-match + (string-match-p "w" (or (tramp-compat-file-attribute-modes (file-attributes filename)) "")) (let ((dir (file-name-directory filename))) @@ -1027,7 +1027,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; Check for matching entries. (mapcar (lambda (x) - (when (string-match + (when (string-match-p (format "^%s" base) (nth 0 x)) x)) entries) @@ -1039,14 +1039,14 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (sort entries (lambda (x y) - (if (string-match "t" switches) + (if (string-match-p "t" switches) ;; Sort by date. (time-less-p (nth 3 y) (nth 3 x)) ;; Sort by name. (string-lessp (nth 0 x) (nth 0 y)))))) ;; Handle "-F" switch. - (when (string-match "F" switches) + (when (string-match-p "F" switches) (mapc (lambda (x) (when (not (zerop (length (car x)))) @@ -1075,7 +1075,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (expand-file-name (nth 0 x) (file-name-directory filename)) 'string))))) - (when (string-match "l" switches) + (when (string-match-p "l" switches) (insert (format "%10s %3d %-8s %-8s %8s %s " @@ -1106,7 +1106,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (put-text-property start (point) 'dired-filename t)) ;; Insert symlink. - (when (and (string-match "l" switches) + (when (and (string-match-p "l" switches) (stringp (tramp-compat-file-attribute-type attr))) (insert " -> " (tramp-compat-file-attribute-type attr)))) @@ -1121,18 +1121,17 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (unless (file-name-absolute-p dir) (setq dir (expand-file-name dir default-directory))) (with-parsed-tramp-file-name dir nil - (save-match-data - (let* ((ldir (file-name-directory dir))) - ;; Make missing directory parts. - (when (and parents - (tramp-smb-get-share v) - (not (file-directory-p ldir))) - (make-directory ldir parents)) - ;; Just do it. - (when (file-directory-p ldir) - (make-directory-internal dir)) - (unless (file-directory-p dir) - (tramp-error v 'file-error "Couldn't make directory %s" dir)))))) + (let* ((ldir (file-name-directory dir))) + ;; Make missing directory parts. + (when (and parents + (tramp-smb-get-share v) + (not (file-directory-p ldir))) + (make-directory ldir parents)) + ;; Just do it. + (when (file-directory-p ldir) + (make-directory-internal dir)) + (unless (file-directory-p dir) + (tramp-error v 'file-error "Couldn't make directory %s" dir))))) (defun tramp-smb-handle-make-directory-internal (directory) "Like `make-directory-internal' for Tramp files." @@ -1140,21 +1139,19 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (unless (file-name-absolute-p directory) (setq directory (expand-file-name directory default-directory))) (with-parsed-tramp-file-name directory nil - (save-match-data - (let* ((file (tramp-smb-get-localname v))) - (when (file-directory-p (file-name-directory directory)) - (tramp-smb-send-command - v - (if (tramp-smb-get-cifs-capabilities v) - (format "posix_mkdir \"%s\" %o" file (default-file-modes)) - (format "mkdir \"%s\"" file))) - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-file-properties v (file-name-directory localname)) - (tramp-flush-file-properties v localname)) - (unless (file-directory-p directory) - (tramp-error - v 'file-error "Couldn't make directory %s" directory)))))) + (let* ((file (tramp-smb-get-localname v))) + (when (file-directory-p (file-name-directory directory)) + (tramp-smb-send-command + v + (if (tramp-smb-get-cifs-capabilities v) + (format "posix_mkdir \"%s\" %o" file (default-file-modes)) + (format "mkdir \"%s\"" file))) + ;; We must also flush the cache of the directory, because + ;; `file-attributes' reads the values from there. + (tramp-flush-file-properties v (file-name-directory localname)) + (tramp-flush-file-properties v localname)) + (unless (file-directory-p directory) + (tramp-error v 'file-error "Couldn't make directory %s" directory))))) (defun tramp-smb-handle-make-symbolic-link (target linkname &optional ok-if-already-exists) @@ -1510,7 +1507,7 @@ component is used as the target of the symlink." ;; Save exit. (with-current-buffer (tramp-get-connection-buffer v) - (if (string-match tramp-temp-buffer-name (buffer-name)) + (if (string-match-p tramp-temp-buffer-name (buffer-name)) (progn (set-process-buffer (tramp-get-connection-process v) nil) (kill-buffer (current-buffer))) @@ -1621,7 +1618,7 @@ If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"." ;; A period followed by a space, or trailing periods and spaces, ;; are not supported. - (when (string-match "\\. \\|\\.$\\| $" localname) + (when (string-match-p "\\. \\|\\.$\\| $" localname) (tramp-error vec 'file-error "Invalid file name %s" (tramp-make-tramp-file-name vec localname))) @@ -1775,7 +1772,7 @@ Result is the list (LOCALNAME MODE SIZE MTIME)." (cl-return)) ;; weekday. - (if (string-match "\\(\\w+\\)$" line) + (if (string-match-p "\\(\\w+\\)$" line) (setq line (substring line 0 -5)) (cl-return)) @@ -2086,7 +2083,6 @@ Returns nil if an error message has appeared." (defun tramp-smb-call-winexe (vec) "Apply a remote command, if possible, using `tramp-smb-winexe-program'." - ;; Check for program. (unless (executable-find tramp-smb-winexe-program) (tramp-error diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index ab30a43de0..02870faf64 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1290,8 +1290,8 @@ This is METHOD, if non-nil. Otherwise, do a lookup in lmethod item) (while choices (setq item (pop choices)) - (when (and (string-match (or (nth 0 item) "") (or host "")) - (string-match (or (nth 1 item) "") (or user ""))) + (when (and (string-match-p (or (nth 0 item) "") (or host "")) + (string-match-p (or (nth 1 item) "") (or user ""))) (setq lmethod (nth 2 item)) (setq choices nil))) lmethod) @@ -1311,8 +1311,8 @@ This is USER, if non-nil. Otherwise, do a lookup in luser item) (while choices (setq item (pop choices)) - (when (and (string-match (or (nth 0 item) "") (or method "")) - (string-match (or (nth 1 item) "") (or host ""))) + (when (and (string-match-p (or (nth 0 item) "") (or method "")) + (string-match-p (or (nth 1 item) "") (or host ""))) (setq luser (nth 2 item)) (setq choices nil))) luser) @@ -1332,8 +1332,8 @@ This is HOST, if non-nil. Otherwise, do a lookup in lhost item) (while choices (setq item (pop choices)) - (when (and (string-match (or (nth 0 item) "") (or method "")) - (string-match (or (nth 1 item) "") (or user ""))) + (when (and (string-match-p (or (nth 0 item) "") (or method "")) + (string-match-p (or (nth 1 item) "") (or user ""))) (setq lhost (nth 2 item)) (setq choices nil))) lhost) @@ -1381,7 +1381,7 @@ default values are used." (setq v (tramp-dissect-hop-name hop) hop (and hop (tramp-make-tramp-hop-name v)))) (let ((tramp-default-host - (or (and v (not (string-match "%h" (tramp-file-name-host v))) + (or (and v (not (string-match-p "%h" (tramp-file-name-host v))) (tramp-file-name-host v)) tramp-default-host))) (setq method (tramp-find-method method user host) @@ -1481,7 +1481,7 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)." (unless (zerop (length user)) tramp-postfix-user-format) (when host - (if (string-match tramp-ipv6-regexp host) + (if (string-match-p tramp-ipv6-regexp host) (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format) host)) @@ -1510,7 +1510,7 @@ necessary only. This function will be used in file name completion." (concat user tramp-postfix-user-format)) (unless (zerop (length host)) (concat - (if (string-match tramp-ipv6-regexp host) + (if (string-match-p tramp-ipv6-regexp host) (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format) host) @@ -1655,22 +1655,23 @@ ARGUMENTS to actually emit the message (if applicable)." (setq fn (symbol-name btf)) (unless (and - (string-match "^tramp" fn) + (string-match-p "^tramp" fn) (not - (string-match - (concat - "^" - (regexp-opt - '("tramp-backtrace" - "tramp-compat-funcall" - "tramp-condition-case-unless-debug" - "tramp-debug-message" - "tramp-error" - "tramp-error-with-buffer" - "tramp-message" - "tramp-user-error") - t) - "$") + (string-match-p + (eval-when-compile + (concat + "^" + (regexp-opt + '("tramp-backtrace" + "tramp-compat-funcall" + "tramp-condition-case-unless-debug" + "tramp-debug-message" + "tramp-error" + "tramp-error-with-buffer" + "tramp-message" + "tramp-user-error") + t) + "$")) fn))) (setq fn nil))) (setq btn (1+ btn)))) @@ -1708,39 +1709,37 @@ control string and the remaining ARGUMENTS to actually emit the message (if applicable)." (ignore-errors (when (<= level tramp-verbose) - ;; Match data must be preserved! - (save-match-data - ;; Display only when there is a minimum level. - (when (and tramp-message-show-message (<= level 3)) - (apply 'message - (concat - (cond - ((= level 0) "") - ((= level 1) "") - ((= level 2) "Warning: ") - (t "Tramp: ")) - fmt-string) - arguments)) - ;; Log only when there is a minimum level. - (when (>= tramp-verbose 4) - (let ((tramp-verbose 0)) - ;; Append connection buffer for error messages. - (when (= level 1) - (with-current-buffer - (if (processp vec-or-proc) - (process-buffer vec-or-proc) - (tramp-get-connection-buffer vec-or-proc)) - (setq fmt-string (concat fmt-string "\n%s") - arguments (append arguments (list (buffer-string)))))) - ;; Translate proc to vec. - (when (processp vec-or-proc) - (setq vec-or-proc (process-get vec-or-proc 'vector)))) - ;; Do it. - (when (tramp-file-name-p vec-or-proc) - (apply 'tramp-debug-message - vec-or-proc - (concat (format "(%d) # " level) fmt-string) - arguments))))))) + ;; Display only when there is a minimum level. + (when (and tramp-message-show-message (<= level 3)) + (apply 'message + (concat + (cond + ((= level 0) "") + ((= level 1) "") + ((= level 2) "Warning: ") + (t "Tramp: ")) + fmt-string) + arguments)) + ;; Log only when there is a minimum level. + (when (>= tramp-verbose 4) + (let ((tramp-verbose 0)) + ;; Append connection buffer for error messages. + (when (= level 1) + (with-current-buffer + (if (processp vec-or-proc) + (process-buffer vec-or-proc) + (tramp-get-connection-buffer vec-or-proc)) + (setq fmt-string (concat fmt-string "\n%s") + arguments (append arguments (list (buffer-string)))))) + ;; Translate proc to vec. + (when (processp vec-or-proc) + (setq vec-or-proc (process-get vec-or-proc 'vector)))) + ;; Do it. + (when (tramp-file-name-p vec-or-proc) + (apply 'tramp-debug-message + vec-or-proc + (concat (format "(%d) # " level) fmt-string) + arguments)))))) (defsubst tramp-backtrace (&optional vec-or-proc) "Dump a backtrace into the debug buffer. @@ -1884,7 +1883,7 @@ If VAR is nil, then we bind `v' to the structure and `method', `user', "Report progress of an operation for Tramp." (let* ((parameters (cdr reporter)) (message (aref parameters 3))) - (when (string-match message (or (current-message) "")) + (when (string-match-p message (or (current-message) "")) (progress-reporter-update reporter value)))) (defmacro with-tramp-progress-reporter (vec level message &rest body) @@ -1979,7 +1978,6 @@ Example: \"ssh\" \\='((tramp-parse-sconfig \"/etc/ssh_config\") (tramp-parse-sconfig \"~/.ssh/config\")))" - (let ((r function-list) (v function-list)) (setq tramp-completion-function-alist @@ -1994,13 +1992,13 @@ Example: (unless (and (functionp (nth 0 (car v))) (cond ;; Windows registry. - ((string-match "^HKEY_CURRENT_USER" (nth 1 (car v))) + ((string-match-p "^HKEY_CURRENT_USER" (nth 1 (car v))) (and (memq system-type '(cygwin windows-nt)) (zerop (tramp-call-process v "reg" nil nil nil "query" (nth 1 (car v)))))) ;; Zeroconf service type. - ((string-match + ((string-match-p "^_[[:alpha:]]+\\._[[:alpha:]]+$" (nth 1 (car v)))) ;; Configuration file. (t (file-exists-p (nth 1 (car v)))))) @@ -2077,7 +2075,7 @@ been set up by `rfn-eshadow-setup-minibuffer'." (save-excursion (save-restriction (narrow-to-region - (1+ (or (string-match + (1+ (or (string-match-p (tramp-rfn-eshadow-update-overlay-regexp) (buffer-string) end) end)) @@ -2145,7 +2143,7 @@ expression, which matches more than the file name suffix, the coding system might not be determined. This function repairs it." (let (result) (dolist (elt file-coding-system-alist (nreverse result)) - (when (and (consp elt) (string-match (car elt) filename)) + (when (and (consp elt) (string-match-p (car elt) filename)) ;; We found a matching entry in `file-coding-system-alist'. ;; So we add a similar entry, but with the temporary file name ;; as regexp. @@ -2217,18 +2215,16 @@ ARGS are the arguments OPERATION has been called with." ;; file name to be checked. Handled properly in ;; `tramp-handle-*-make-symbolic-link'. file-newer-than-file-p make-symbolic-link rename-file)) - (save-match-data - (cond - ((tramp-tramp-file-p (nth 0 args)) (nth 0 args)) - ((tramp-tramp-file-p (nth 1 args)) (nth 1 args)) - (t default-directory)))) + (cond + ((tramp-tramp-file-p (nth 0 args)) (nth 0 args)) + ((tramp-tramp-file-p (nth 1 args)) (nth 1 args)) + (t default-directory))) ;; FILE DIRECTORY resp FILE1 FILE2. ((eq operation 'expand-file-name) - (save-match-data - (cond - ((file-name-absolute-p (nth 0 args)) (nth 0 args)) - ((tramp-tramp-file-p (nth 1 args)) (nth 1 args)) - (t default-directory)))) + (cond + ((file-name-absolute-p (nth 0 args)) (nth 0 args)) + ((tramp-tramp-file-p (nth 1 args)) (nth 1 args)) + (t default-directory))) ;; START END FILE. ((eq operation 'write-region) (if (file-name-absolute-p (nth 2 args)) @@ -2464,7 +2460,7 @@ remote file names." (lambda (atom) (when (and (functionp atom) (autoloadp (symbol-function atom)) - (string-match files-regexp (cadr (symbol-function atom)))) + (string-match-p files-regexp (cadr (symbol-function atom)))) (ignore-errors (setf (cadr (symbol-function atom)) (expand-file-name (cadr (symbol-function atom)) dir)))))))) @@ -2589,7 +2585,6 @@ not in completion mode." ;; completions. (defun tramp-completion-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for partial Tramp files." - (let ((fullname (tramp-drop-volume-letter (expand-file-name filename directory))) hop result result1) @@ -2686,7 +2681,6 @@ not in completion mode." (defun tramp-completion-dissect-file-name (name) "Returns a list of `tramp-file-name' structures. They are collected by `tramp-completion-dissect-file-name1'." - (let* ((x-nil "\\|\\(\\)") (tramp-completion-ipv6-regexp (format @@ -2761,7 +2755,6 @@ They are collected by `tramp-completion-dissect-file-name1'." "Returns a `tramp-file-name' structure matching STRUCTURE. The structure consists of remote method, remote user, remote host and localname (filename on remote host)." - (save-match-data (when (string-match (nth 0 structure) name) (make-tramp-file-name @@ -2779,7 +2772,7 @@ remote host and localname (filename on remote host)." (mapcar (lambda (method) (and method - (string-match (concat "^" (regexp-quote partial-method)) method) + (string-match-p (concat "^" (regexp-quote partial-method)) method) (tramp-completion-make-tramp-file-name method nil nil nil))) (mapcar 'car tramp-methods))) @@ -2792,7 +2785,7 @@ PARTIAL-USER must match USER, PARTIAL-HOST must match HOST." ((and partial-user partial-host) (if (and host - (string-match (concat "^" (regexp-quote partial-host)) host) + (string-match-p (concat "^" (regexp-quote partial-host)) host) (string-equal partial-user (or user partial-user))) (setq user partial-user) (setq user nil @@ -2801,13 +2794,15 @@ PARTIAL-USER must match USER, PARTIAL-HOST must match HOST." (partial-user (setq host nil) (unless - (and user (string-match (concat "^" (regexp-quote partial-user)) user)) + (and user + (string-match-p (concat "^" (regexp-quote partial-user)) user)) (setq user nil))) (partial-host (setq user nil) (unless - (and host (string-match (concat "^" (regexp-quote partial-host)) host)) + (and host + (string-match-p (concat "^" (regexp-quote partial-host)) host)) (setq host nil))) (t (setq user nil @@ -3086,7 +3081,7 @@ User is always nil." (while temp (setq item (directory-file-name (pop temp))) - (when (or (null match) (string-match match item)) + (when (or (null match) (string-match-p match item)) (push (if full (concat directory item) item) result))) (if nosort result (sort result 'string<))))) @@ -3188,7 +3183,7 @@ User is always nil." ;; Check, whether we find an existing file with ;; lower case letters. This avoids us to create a ;; temporary file. - (while (and (string-match + (while (and (string-match-p "[a-z]" (file-remote-p candidate 'localname)) (not (file-exists-p candidate))) (setq candidate @@ -3199,7 +3194,7 @@ User is always nil." ;; to Emacs 26+ like `file-name-case-insensitive-p', ;; so there is no compatibility problem calling it. (unless - (string-match + (string-match-p "[a-z]" (file-remote-p candidate 'localname)) (setq tmpfile (let ((default-directory @@ -3229,7 +3224,7 @@ User is always nil." (not (and completion-ignored-extensions - (string-match + (string-match-p (concat (regexp-opt completion-ignored-extensions 'paren) "$") x) ;; We remember the hit. (push x hits-ignored-extensions)))))) @@ -3346,7 +3341,7 @@ User is always nil." (tramp-error v1 'file-error "Maximum number (%d) of symlinks exceeded" numchase-limit))) - (file-local-name (directory-file-name result)))))))) + (file-remote-p (directory-file-name result) 'localname))))))) (defun tramp-handle-find-backup-file-name (filename) "Like `find-backup-file-name' for Tramp files." @@ -3383,7 +3378,7 @@ User is always nil." (list filename switches wildcard full-directory-p)) ;; `ls-lisp' always returns full listings. We must remove ;; superfluous parts. - (unless (string-match "l" switches) + (unless (string-match-p "l" switches) (save-excursion (goto-char (point-min)) (while (setq start @@ -3527,7 +3522,7 @@ User is always nil." ;; The first condition is always true for absolute file names. ;; Included for safety's sake. (unless (or (file-name-directory file) - (string-match "\\.elc?\\'" file)) + (string-match-p "\\.elc?\\'" file)) (tramp-error v 'file-error "File `%s' does not include a `.el' or `.elc' suffix" file))) @@ -3562,7 +3557,7 @@ support symbolic links." (defun tramp-handle-shell-command (command &optional output-buffer error-buffer) "Like `shell-command' for Tramp files." - (let* ((asynchronous (string-match "[ \t]*&[ \t]*\\'" command)) + (let* ((asynchronous (string-match-p "[ \t]*&[ \t]*\\'" command)) ;; We cannot use `shell-file-name' and `shell-command-switch', ;; they are variables of the local host. (args (append @@ -3809,7 +3804,7 @@ Send \"yes\" to remote process on confirmation, abort otherwise. See also `tramp-action-yn'." (save-window-excursion (let ((enable-recursive-minibuffers t)) - (save-match-data (pop-to-buffer (tramp-get-connection-buffer vec))) + (pop-to-buffer (tramp-get-connection-buffer vec)) (unless (yes-or-no-p (match-string 0)) (kill-process proc) (throw 'tramp-action 'permission-denied)) @@ -3823,7 +3818,7 @@ Send \"y\" to remote process on confirmation, abort otherwise. See also `tramp-action-yesno'." (save-window-excursion (let ((enable-recursive-minibuffers t)) - (save-match-data (pop-to-buffer (tramp-get-connection-buffer vec))) + (pop-to-buffer (tramp-get-connection-buffer vec)) (unless (y-or-n-p (match-string 0)) (kill-process proc) (throw 'tramp-action 'permission-denied)) @@ -3933,9 +3928,10 @@ connection buffer." (tramp-get-connection-buffer vec))) ((eq exit 'process-died) (substitute-command-keys - (concat - "Tramp failed to connect. If this happens repeatedly, try\n" - " `\\[tramp-cleanup-this-connection]'"))) + (eval-when-compile + (concat + "Tramp failed to connect. If this happens repeatedly, try\n" + " `\\[tramp-cleanup-this-connection]'")))) ((eq exit 'timeout) (format-message "Timeout reached, see buffer `%s' for details" @@ -4119,53 +4115,52 @@ would yield t. On the other hand, the following check results in nil: (other-read (aref mode-chars 7)) (other-write (aref mode-chars 8)) (other-execute-or-sticky (aref mode-chars 9))) - (save-match-data - (logior - (cond - ((char-equal owner-read ?r) (string-to-number "00400" 8)) - ((char-equal owner-read ?-) 0) - (t (error "Second char `%c' must be one of `r-'" owner-read))) - (cond - ((char-equal owner-write ?w) (string-to-number "00200" 8)) - ((char-equal owner-write ?-) 0) - (t (error "Third char `%c' must be one of `w-'" owner-write))) - (cond - ((char-equal owner-execute-or-setid ?x) (string-to-number "00100" 8)) - ((char-equal owner-execute-or-setid ?S) (string-to-number "04000" 8)) - ((char-equal owner-execute-or-setid ?s) (string-to-number "04100" 8)) - ((char-equal owner-execute-or-setid ?-) 0) - (t (error "Fourth char `%c' must be one of `xsS-'" - owner-execute-or-setid))) - (cond - ((char-equal group-read ?r) (string-to-number "00040" 8)) - ((char-equal group-read ?-) 0) - (t (error "Fifth char `%c' must be one of `r-'" group-read))) - (cond - ((char-equal group-write ?w) (string-to-number "00020" 8)) - ((char-equal group-write ?-) 0) - (t (error "Sixth char `%c' must be one of `w-'" group-write))) - (cond - ((char-equal group-execute-or-setid ?x) (string-to-number "00010" 8)) - ((char-equal group-execute-or-setid ?S) (string-to-number "02000" 8)) - ((char-equal group-execute-or-setid ?s) (string-to-number "02010" 8)) - ((char-equal group-execute-or-setid ?-) 0) - (t (error "Seventh char `%c' must be one of `xsS-'" - group-execute-or-setid))) - (cond - ((char-equal other-read ?r) (string-to-number "00004" 8)) - ((char-equal other-read ?-) 0) - (t (error "Eighth char `%c' must be one of `r-'" other-read))) - (cond - ((char-equal other-write ?w) (string-to-number "00002" 8)) - ((char-equal other-write ?-) 0) - (t (error "Ninth char `%c' must be one of `w-'" other-write))) - (cond - ((char-equal other-execute-or-sticky ?x) (string-to-number "00001" 8)) - ((char-equal other-execute-or-sticky ?T) (string-to-number "01000" 8)) - ((char-equal other-execute-or-sticky ?t) (string-to-number "01001" 8)) - ((char-equal other-execute-or-sticky ?-) 0) - (t (error "Tenth char `%c' must be one of `xtT-'" - other-execute-or-sticky))))))) + (logior + (cond + ((char-equal owner-read ?r) (string-to-number "00400" 8)) + ((char-equal owner-read ?-) 0) + (t (error "Second char `%c' must be one of `r-'" owner-read))) + (cond + ((char-equal owner-write ?w) (string-to-number "00200" 8)) + ((char-equal owner-write ?-) 0) + (t (error "Third char `%c' must be one of `w-'" owner-write))) + (cond + ((char-equal owner-execute-or-setid ?x) (string-to-number "00100" 8)) + ((char-equal owner-execute-or-setid ?S) (string-to-number "04000" 8)) + ((char-equal owner-execute-or-setid ?s) (string-to-number "04100" 8)) + ((char-equal owner-execute-or-setid ?-) 0) + (t (error "Fourth char `%c' must be one of `xsS-'" + owner-execute-or-setid))) + (cond + ((char-equal group-read ?r) (string-to-number "00040" 8)) + ((char-equal group-read ?-) 0) + (t (error "Fifth char `%c' must be one of `r-'" group-read))) + (cond + ((char-equal group-write ?w) (string-to-number "00020" 8)) + ((char-equal group-write ?-) 0) + (t (error "Sixth char `%c' must be one of `w-'" group-write))) + (cond + ((char-equal group-execute-or-setid ?x) (string-to-number "00010" 8)) + ((char-equal group-execute-or-setid ?S) (string-to-number "02000" 8)) + ((char-equal group-execute-or-setid ?s) (string-to-number "02010" 8)) + ((char-equal group-execute-or-setid ?-) 0) + (t (error "Seventh char `%c' must be one of `xsS-'" + group-execute-or-setid))) + (cond + ((char-equal other-read ?r) (string-to-number "00004" 8)) + ((char-equal other-read ?-) 0) + (t (error "Eighth char `%c' must be one of `r-'" other-read))) + (cond + ((char-equal other-write ?w) (string-to-number "00002" 8)) + ((char-equal other-write ?-) 0) + (t (error "Ninth char `%c' must be one of `w-'" other-write))) + (cond + ((char-equal other-execute-or-sticky ?x) (string-to-number "00001" 8)) + ((char-equal other-execute-or-sticky ?T) (string-to-number "01000" 8)) + ((char-equal other-execute-or-sticky ?t) (string-to-number "01001" 8)) + ((char-equal other-execute-or-sticky ?-) 0) + (t (error "Tenth char `%c' must be one of `xtT-'" + other-execute-or-sticky)))))) (defconst tramp-file-mode-type-map '((0 . "-") ; Normal file (SVID-v2 and XPG2) @@ -4246,8 +4241,9 @@ VEC is used for tracing." nil "locale" nil t nil "-a")))) (while candidates (goto-char (point-min)) - (if (string-match (format "^%s\r?$" (regexp-quote (car candidates))) - (buffer-string)) + (if (string-match-p + (format "^%s\r?$" (regexp-quote (car candidates))) + (buffer-string)) (setq locale (car candidates) candidates nil) (setq candidates (cdr candidates)))))) @@ -4324,7 +4320,7 @@ This handles also chrooted environments, which are not regarded as local." (port (tramp-file-name-port vec))) (and (stringp tramp-local-host-regexp) (stringp host) - (string-match tramp-local-host-regexp host) + (string-match-p tramp-local-host-regexp host) ;; A port is an indication for an ssh tunnel or alike. (null port) ;; The method shall be applied to one of the shell file name commit 8f3fde3884d818eb2eef39f8295c5884bc371cc4 Author: Michael Albinus Date: Thu Dec 6 15:25:22 2018 +0100 Make stronger tests for Tramp multi hops * lisp/net/tramp.el (tramp-dissect-file-name, tramp-dissect-hop-name): Check, that method is capable of multi hops. * test/lisp/net/tramp-tests.el (tramp-test02-file-name-dissect) (tramp-test02-file-name-dissect-simplified) (tramp-test02-file-name-dissect-separate): Suppress check for multihops. (tramp-test03-file-name-method-rules): Check for error if multi hops cannot be applied. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index fe0ba94f4c..ab30a43de0 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1391,19 +1391,36 @@ default values are used." (and hop (format-spec hop (format-spec-make ?h host ?u user)))))) - (make-tramp-file-name - :method method :user user :domain domain :host host :port port - :localname localname :hop hop))))) + ;; Return result. + (prog1 + (setq v (make-tramp-file-name + :method method :user user :domain domain :host host + :port port :localname localname :hop hop)) + ;; Only some methods from tramp-sh.el do support multi-hops. + (when (and + hop + (or (not (tramp-get-method-parameter v 'tramp-login-program)) + (tramp-get-method-parameter v 'tramp-copy-program))) + (tramp-user-error + v "Method `%s' is not supported for multi-hops." method))))))) (defun tramp-dissect-hop-name (name &optional nodefault) "Return a `tramp-file-name' structure of `hop' part of NAME. See `tramp-dissect-file-name' for details." - (tramp-dissect-file-name - (concat - tramp-prefix-format - (replace-regexp-in-string - (concat tramp-postfix-hop-regexp "$") tramp-postfix-host-format name)) - nodefault)) + (let ((v (tramp-dissect-file-name + (concat tramp-prefix-format + (replace-regexp-in-string + (concat tramp-postfix-hop-regexp "$") + tramp-postfix-host-format name)) + nodefault))) + ;; Only some methods from tramp-sh.el do support multi-hops. + (when (or (not (tramp-get-method-parameter v 'tramp-login-program)) + (tramp-get-method-parameter v 'tramp-copy-program)) + (tramp-user-error + v "Method `%s' is not supported for multi-hops." + (tramp-file-name-method v))) + ;; Return result. + v)) (defun tramp-buffer-name (vec) "A name for the connection buffer VEC." diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 4016ece94d..15a120704e 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -399,7 +399,10 @@ handled properly. BODY shall not contain a timeout." (tramp-default-host "default-host") tramp-default-method-alist tramp-default-user-alist - tramp-default-host-alist) + tramp-default-host-alist + ;; Suppress check for multihops. + (tramp-cache-data (make-hash-table :test 'equal)) + (tramp-connection-properties '((nil "login-program" t)))) ;; Expand `tramp-default-user' and `tramp-default-host'. (should (string-equal (file-remote-p "/method::") @@ -836,6 +839,9 @@ handled properly. BODY shall not contain a timeout." (tramp-default-host "default-host") tramp-default-user-alist tramp-default-host-alist + ;; Suppress check for multihops. + (tramp-cache-data (make-hash-table :test 'equal)) + (tramp-connection-properties '((nil "login-program" t))) (syntax tramp-syntax)) (unwind-protect (progn @@ -1157,6 +1163,9 @@ handled properly. BODY shall not contain a timeout." tramp-default-method-alist tramp-default-user-alist tramp-default-host-alist + ;; Suppress check for multihops. + (tramp-cache-data (make-hash-table :test 'equal)) + (tramp-connection-properties '((nil "login-program" t))) (syntax tramp-syntax)) (unwind-protect (progn @@ -1851,6 +1860,16 @@ handled properly. BODY shall not contain a timeout." (ert-deftest tramp-test03-file-name-method-rules () "Check file name rules for some methods." (skip-unless (tramp--test-enabled)) + ;; `user-error' has appeared in Emacs 24.3. + (skip-unless (fboundp 'user-error)) + + ;; Multi hops are allowed for inline methods only. + (should-error + (file-remote-p "/ssh:user1@host1|method:user2@host2:/path/to/file") + :type 'user-error) + (should-error + (file-remote-p "/method:user1@host1|ssh:user2@host2:/path/to/file") + :type 'user-error) ;; Samba does not support file names with periods followed by ;; spaces, and trailing periods or spaces. commit 8e8b8115386570ce186eea349ae937dbccbd61ed Author: JoĂŁo Távora Date: Thu Dec 6 12:50:07 2018 +0000 Keep Flymake compatible with Emacs 26.1 builds --without-x * lisp/progmodes/flymake.el (flymake-double-exclamation-mark): Don't define if 'define-fringe-bitmap isn't fbound. (Version): Bump to 1.0.2 diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index cbbb4d0dcb..ad8f50cd7a 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -4,7 +4,7 @@ ;; Author: Pavel Kobyakov ;; Maintainer: JoĂŁo Távora -;; Version: 1.0.1 +;; Version: 1.0.2 ;; Package-Requires: ((emacs "26.1")) ;; Keywords: c languages tools @@ -220,24 +220,25 @@ Specifically, start it when the saved buffer is actually displayed." :version "26.1" :type 'boolean) -(define-fringe-bitmap 'flymake-double-exclamation-mark - (vector #b00000000 - #b00000000 - #b00000000 - #b00000000 - #b01100110 - #b01100110 - #b01100110 - #b01100110 - #b01100110 - #b01100110 - #b01100110 - #b01100110 - #b00000000 - #b01100110 - #b00000000 - #b00000000 - #b00000000)) +(when (fboundp 'define-fringe-bitmap) + (define-fringe-bitmap 'flymake-double-exclamation-mark + (vector #b00000000 + #b00000000 + #b00000000 + #b00000000 + #b01100110 + #b01100110 + #b01100110 + #b01100110 + #b01100110 + #b01100110 + #b01100110 + #b01100110 + #b00000000 + #b01100110 + #b00000000 + #b00000000 + #b00000000))) (defvar-local flymake-timer nil "Timer for starting syntax check.") commit 4b42ef02d947300494ef15f3a0eab0117e7bc51a Author: Glenn Morris Date: Wed Dec 5 17:29:19 2018 -0500 * admin/unidata/uvs.el (uvs-print-table-ivd): Add more header detail. diff --git a/admin/unidata/uvs.el b/admin/unidata/uvs.el index 31840fb182..4c14439ccf 100644 --- a/admin/unidata/uvs.el +++ b/admin/unidata/uvs.el @@ -201,7 +201,8 @@ corresponding number." (uvs-alist-from-ivd collection-id sequence-id-to-glyph-func)))) (set-binary-mode 'stdout t) - (princ "/* Automatically generated by uvs.el. */\n") + (princ "/* This file was automatically generated from admin/unidata/IVD_Sequences.txt\n") + (princ " by the script admin/unidata/uvs.el */\n") (princ (format "static const unsigned char mac_uvs_table_%s_bytes[] =\n {\n" (replace-regexp-in-string "[^_[:alnum:]]" "_" commit 9a162e276e377f112173bbe099900358f157edd1 Author: JoĂŁo Távora Date: Tue Dec 4 23:37:39 2018 +0000 Prepare lisp/progmodes/flymake.el for distribution in GNU ELPA * lisp/progmodes/flymake.el (Package-Requires): Require Emacs 26.1. (Version): Bump to 1.0.1 diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 5352cc3fe6..cbbb4d0dcb 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -4,7 +4,8 @@ ;; Author: Pavel Kobyakov ;; Maintainer: JoĂŁo Távora -;; Version: 1.0 +;; Version: 1.0.1 +;; Package-Requires: ((emacs "26.1")) ;; Keywords: c languages tools ;; This file is part of GNU Emacs. commit 4ef97113b24045e87ee05acb48bb2befad84d47a (refs/remotes/origin/scratch/allow-custom-load-paths-in-elisp-flymake) Author: JoĂŁo Távora Date: Sat Nov 10 12:58:08 2018 +0000 Allow custom load paths in elisp's byte-compilation Flymake * lisp/progmodes/elisp-mode.el (elisp-flymake-byte-compile-load-path): New variable. (elisp-flymake-byte-compile): Use new variable diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 39df9efda2..8c9b5d2c4a 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -1669,6 +1669,16 @@ Calls REPORT-FN directly." (defvar-local elisp-flymake--byte-compile-process nil "Buffer-local process started for byte-compiling the buffer.") +(defvar elisp-flymake-byte-compile-load-path (list "./") + "Like `load-path' but used by `elisp-flymake-byte-compile'. +The default value contains just \"./\" which includes the default +directory of the buffer being compiled, and nothing else.") + +(put 'elisp-flymake-byte-compile-load-path 'safe-local-variable + (lambda (x) (and (listp x) (catch 'tag + (dolist (path x t) (unless (stringp path) + (throw 'tag nil))))))) + ;;;###autoload (defun elisp-flymake-byte-compile (report-fn &rest _args) "A Flymake backend for elisp byte compilation. @@ -1688,13 +1698,14 @@ current buffer state and calls REPORT-FN when done." (make-process :name "elisp-flymake-byte-compile" :buffer output-buffer - :command (list (expand-file-name invocation-name invocation-directory) - "-Q" - "--batch" - ;; "--eval" "(setq load-prefer-newer t)" ; for testing - "-L" default-directory - "-f" "elisp-flymake--batch-compile-for-flymake" - temp-file) + :command `(,(expand-file-name invocation-name invocation-directory) + "-Q" + "--batch" + ;; "--eval" "(setq load-prefer-newer t)" ; for testing + ,@(mapcan (lambda (path) (list "-L" path)) + elisp-flymake-byte-compile-load-path) + "-f" "elisp-flymake--batch-compile-for-flymake" + ,temp-file) :connection-type 'pipe :sentinel (lambda (proc _event) commit 12e922156c86a26fa4bb2cb9e7d2b3fd639e4707 Author: Stefan Monnier Date: Tue Dec 4 18:15:44 2018 -0500 * lisp/emacs-lisp/eldoc.el: Let the user interrupt the search (eldoc-print-current-symbol-info): Use while-no-input and non-essential. diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 49ba71fb1b..21be4f3ce3 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -357,12 +357,15 @@ return any documentation.") ;; This is run from post-command-hook or some idle timer thing, ;; so we need to be careful that errors aren't ignored. (with-demoted-errors "eldoc error: %s" - (and (or (eldoc-display-message-p) - ;; Erase the last message if we won't display a new one. - (when eldoc-last-message - (eldoc-message nil) - nil)) - (eldoc-message (funcall eldoc-documentation-function))))) + (if (not (eldoc-display-message-p)) + ;; Erase the last message if we won't display a new one. + (when eldoc-last-message + (eldoc-message nil)) + (let ((non-essential t)) + ;; Only keep looking for the info as long as the user hasn't + ;; requested our attention. This also locally disables inhibit-quit. + (while-no-input + (eldoc-message (funcall eldoc-documentation-function))))))) ;; If the entire line cannot fit in the echo area, the symbol name may be ;; truncated or eliminated entirely from the output to make room for the commit 6d898918980be4cb29a182ecde7f8e1f95a08462 Author: Eli Zaretskii Date: Tue Dec 4 20:27:20 2018 +0200 Support IBM038 (a.k.a. "EBCDIC-INT") encoding * lisp/international/mule-conf.el (ibm038): New charset. (ebcdic-int, cp038): Alias charsets of ibm038. * lisp/language/english.el (ibm038): New coding-system. (ebcdic-int, cp038): Alias coding-systems of ibm038. (Bug#33612) * etc/NEWS: Announce the new coding system ibm038. diff --git a/etc/NEWS b/etc/NEWS index 206f0fc1e6..60cba9ed46 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1307,6 +1307,11 @@ a multibyte string even if its second argument is an ASCII character. ** '(format "%d" X)' no longer mishandles a floating-point number X that does not fit in a machine integer. +--- +** New coding-system 'ibm038'. +This is the International EBCDIC encoding, also available as aliases +'ebcdic-int' and 'cp038'. + +++ ** In the DST slot, 'encode-time' and 'parse-time-string' now return -1 if it is not known whether daylight saving time is in effect. diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el index b08150a149..02323ea479 100644 --- a/lisp/international/mule-conf.el +++ b/lisp/international/mule-conf.el @@ -1066,6 +1066,15 @@ :mime-charset 'ebcdic-uk :map "EBCDICUK") +(define-charset 'ibm038 + "International version of EBCDIC" + :short-name "IBM038" + :code-space [0 255] + :mime-charset 'ibm038 + :map "IBM038") +(define-charset-alias 'ebcdic-int 'ibm038) +(define-charset-alias 'cp038 'ibm038) + (define-charset 'ibm1047 ;; Says groff: "IBM1047, `EBCDIC Latin 1/Open Systems' used by OS/390 Unix." diff --git a/lisp/language/english.el b/lisp/language/english.el index 72a85eb108..d3fdbfed20 100644 --- a/lisp/language/english.el +++ b/lisp/language/english.el @@ -62,6 +62,14 @@ Nothing special is needed to handle English.") :mnemonic ?*) (define-coding-system-alias 'cp1047 'ibm1047) +(define-coding-system 'ibm038 + "International version of EBCDIC" + :coding-type 'charset + :charset-list '(ibm038) + :mnemonic ?*) +(define-coding-system-alias 'ebcdic-int 'ibm038) +(define-coding-system-alias 'cp038 'ibm038) + ;; Make "ASCII" an alias of "English" language environment. (set-language-info-alist "ASCII" (cdr (assoc "English" language-info-alist))) commit 8e28aee6647ec23e8b0e45f78de2f60cb416b106 Author: Glenn Morris Date: Tue Dec 4 12:54:01 2018 -0500 Skip an autorevert test on hydra.nixos.org (bug#32645) * test/lisp/autorevert-tests.el (auto-revert-test02-auto-revert-deleted-file): Skip on hydra. diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el index 9710600f16..abf73ffc34 100644 --- a/test/lisp/autorevert-tests.el +++ b/test/lisp/autorevert-tests.el @@ -159,6 +159,9 @@ This expects `auto-revert--messages' to be bound by (ert-deftest auto-revert-test02-auto-revert-deleted-file () "Check autorevert for a deleted file." :tags '(:expensive-test) + ;; Repeated unpredictable failures, bug#32645. + ;; Unlikely to be hydra-specific? + (skip-unless (not (getenv "EMACS_HYDRA_CI"))) (let ((tmpfile (make-temp-file "auto-revert-test")) buf desc) commit eaeeece92da51b517097667f13d580aa92ad5d59 Author: Stefan Monnier Date: Tue Dec 4 12:39:47 2018 -0500 * lisp/shell.el (shell--parse-pcomplete-arguments): Stop at semi-colon * test/lisp/shell-tests.el (shell-tests-completion-before-semi): New corresponding test. diff --git a/lisp/shell.el b/lisp/shell.el index ac6f11aeb4..16aeffc1b6 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -426,7 +426,7 @@ Thus, this does not include the shell's current directory.") (while (looking-at (eval-when-compile (concat - "\\(?:[^\s\t\n\\\"']+" + "\\(?:[^\s\t\n\\\"';]+" "\\|'\\([^']*\\)'?" "\\|\"\\(\\(?:[^\"\\]\\|\\\\.\\)*\\)\"?" "\\|\\\\\\(\\(?:.\\|\n\\)?\\)\\)"))) @@ -490,7 +490,7 @@ Shell buffers. It implements `shell-completion-execonly' for (setq comint-input-autoexpand shell-input-autoexpand) ;; Not needed in shell-mode because it's inherited from comint-mode, but ;; placed here for read-shell-command. - (add-hook 'completion-at-point-functions 'comint-completion-at-point nil t)) + (add-hook 'completion-at-point-functions #'comint-completion-at-point nil t)) (put 'shell-mode 'mode-class 'special) @@ -606,7 +606,7 @@ buffer." ;; Bypass a bug in certain versions of bash. (when (string-equal shell "bash") (add-hook 'comint-preoutput-filter-functions - 'shell-filter-ctrl-a-ctrl-b nil t))) + #'shell-filter-ctrl-a-ctrl-b nil t))) (comint-read-input-ring t))) (defun shell-apply-ansi-color (beg end face) @@ -751,7 +751,7 @@ Otherwise, one argument `-i' is passed to the shell. (xargs-name (intern-soft (concat "explicit-" name "-args")))) (unless (file-exists-p startfile) (setq startfile (concat user-emacs-directory "init_" name ".sh"))) - (apply 'make-comint-in-buffer "shell" buffer prog + (apply #'make-comint-in-buffer "shell" buffer prog (if (file-exists-p startfile) startfile) (if (and xargs-name (boundp xargs-name)) (symbol-value xargs-name) @@ -973,10 +973,10 @@ this feature; see the function `dirtrack-mode'." nil nil nil (setq list-buffers-directory (if shell-dirtrack-mode default-directory)) (if shell-dirtrack-mode - (add-hook 'comint-input-filter-functions 'shell-directory-tracker nil t) - (remove-hook 'comint-input-filter-functions 'shell-directory-tracker t))) + (add-hook 'comint-input-filter-functions #'shell-directory-tracker nil t) + (remove-hook 'comint-input-filter-functions #'shell-directory-tracker t))) -(define-obsolete-function-alias 'shell-dirtrack-toggle 'shell-dirtrack-mode +(define-obsolete-function-alias 'shell-dirtrack-toggle #'shell-dirtrack-mode "23.1") (defun shell-cd (dir) diff --git a/test/lisp/shell-tests.el b/test/lisp/shell-tests.el index 105701ebbc..9550800f45 100644 --- a/test/lisp/shell-tests.el +++ b/test/lisp/shell-tests.el @@ -30,4 +30,12 @@ "Test problem found by Filipp Gunbin in emacs-devel." (should (equal (car (shell--unquote&requote-argument "te'st" 2)) "test"))) +(ert-deftest shell-tests-completion-before-semi () + (with-temp-buffer + (shell-mode) + (insert "cd ba;") + (forward-char -1) + (should (equal (shell--parse-pcomplete-arguments) + '(("cd" "ba") 1 4))))) + ;;; shell-tests.el ends here commit f745cf8c438cdb258bc1a37b617749d1c84e688e Author: Juri Linkov Date: Tue Dec 4 02:41:54 2018 +0200 * lisp/isearch.el (isearch-yank-on-move): New defcustom with shift-move related options extracted from `search-exit-option'. (isearch-pre-command-hook): Rename search-exit-option to isearch-yank-on-move in shift-move related places. (isearch-post-command-hook): Check for isearch-pre-move-point instead of search-exit-option. (Bug#15839) * doc/emacs/search.texi (Not Exiting Isearch): Rename search-exit-option to isearch-yank-on-move. * lisp/menu-bar.el (menu-bar-i-search-menu): Add more isearch commands. diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index 35e2bfbb62..8ea80cb9c6 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -548,12 +548,12 @@ an incremental search. This feature is disabled if @item Motion Commands @cindex motion commands, during incremental search -When @code{search-exit-option} is customized to @code{shift-move}, +When @code{isearch-yank-on-move} is customized to @code{shift}, you can extend the search string by holding down the shift key while typing cursor motion commands. It will yank text that ends at the new position after moving point in the current buffer. -When @code{search-exit-option} is @code{move}, you can extend the +When @code{isearch-yank-on-move} is @code{t}, you can extend the search string without using the shift key for cursor motion commands, but it applies only for certain motion command that have the @code{isearch-move} property on their symbols. diff --git a/etc/NEWS b/etc/NEWS index 042a4b59d3..206f0fc1e6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -691,11 +691,10 @@ highlight in one iteration while processing the full buffer. 'C-M-d'. +++ -*** 'search-exit-option' provides new options 'move' and 'shift-move' +*** New variable 'isearch-yank-on-move' provides options 't' and 'shift' to extend the search string by yanking text that ends at the new -position after moving point in the current buffer. 'shift-move' -extends the search string by motion commands while holding down -the shift key. +position after moving point in the current buffer. 'shift' extends +the search string by motion commands while holding down the shift key. *** 'isearch-allow-scroll' provides new option 'unlimited' to allow scrolling any distance off screen. diff --git a/lisp/isearch.el b/lisp/isearch.el index cc199b16d8..dcd119a517 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -72,21 +72,11 @@ If t, random control and meta characters terminate the search and are then executed normally. If `edit', edit the search string instead of exiting. -If `move', extend the search string by motion commands -that have the `isearch-move' property on their symbols -equal to `enabled', or the shift-translated command is -not disabled by the value `disabled' of the same property. -If `shift-move', extend the search string by motion commands -while holding down the shift key. -Both `move' and `shift-move' extend the search string by yanking text -that ends at the new position after moving point in the current buffer. If `append', the characters which you type that are not interpreted by the incremental search are simply appended to the search string. If nil, run the command without exiting Isearch." :type '(choice (const :tag "Terminate incremental search" t) (const :tag "Edit the search string" edit) - (const :tag "Extend the search string by motion commands" move) - (const :tag "Extend the search string by shifted motion keys" shift-move) (const :tag "Append control characters to the search string" append) (const :tag "Don't terminate incremental search" nil)) :version "27.1") @@ -2816,6 +2806,21 @@ the bottom." (defvar isearch-pre-scroll-point nil) (defvar isearch-pre-move-point nil) +(defcustom isearch-yank-on-move nil + "Motion keys yank text to the search string while you move the cursor. +If `shift', extend the search string by motion commands while holding down +the shift key. The search string is extended by yanking text that +ends at the new position after moving point in the current buffer. +If t, extend the search string without the shift key pressed +by motion commands that have the `isearch-move' property on their +symbols equal to `enabled', or for which the shift-translated command +is not disabled by the value `disabled' of property `isearch-move'." + :type '(choice (const :tag "Motion keys exit Isearch" nil) + (const :tag "Motion keys extend the search string" t) + (const :tag "Shifted motion keys extend the search string" shift)) + :group 'isearch + :version "27.1") + (defun isearch-pre-command-hook () "Decide whether to exit Isearch mode before executing the command. Don't exit Isearch if the key sequence that invoked this command @@ -2859,13 +2864,13 @@ See more for options in `search-exit-option'." (read-event) (setq this-command 'isearch-edit-string)) ;; Don't terminate the search for motion commands. - ((or (and (eq search-exit-option 'move) + ((or (and (eq isearch-yank-on-move t) (symbolp this-command) (or (eq (get this-command 'isearch-move) 'enabled) (and (not (eq (get this-command 'isearch-move) 'disabled)) (stringp (nth 1 (interactive-form this-command))) (string-match-p "^^" (nth 1 (interactive-form this-command)))))) - (and (eq search-exit-option 'shift-move) + (and (eq isearch-yank-on-move 'shift) this-command-keys-shift-translated)) (setq this-command-keys-shift-translated nil) (setq isearch-pre-move-point (point))) @@ -2890,9 +2895,8 @@ See more for options in `search-exit-option'." (when (eq isearch-allow-scroll 'unlimited) (when isearch-lazy-highlight (isearch-lazy-highlight-new-loop))) - (when (memq search-exit-option '(move shift-move)) - (when (and isearch-pre-move-point - (not (eq isearch-pre-move-point (point)))) + (when isearch-pre-move-point + (when (not (eq isearch-pre-move-point (point))) (let ((string (buffer-substring-no-properties (or isearch-other-end isearch-opoint) (point)))) (if isearch-regexp (setq string (regexp-quote string))) @@ -3188,12 +3192,12 @@ the word mode." (defun isearch-message-suffix (&optional c-q-hack) (propertize (concat (if c-q-hack "^Q" "") - (if isearch-error - (concat " [" isearch-error "]") - "") - (isearch-lazy-count-format 'suffix) - (or isearch-message-suffix-add "")) - 'face 'minibuffer-prompt)) + (isearch-lazy-count-format 'suffix) + (if isearch-error + (concat " [" isearch-error "]") + "") + (or isearch-message-suffix-add "")) + 'face 'minibuffer-prompt)) (defun isearch-lazy-count-format (&optional suffix-p) "Format the current match number and the total number of matches. diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 6de0a62bc2..1081fb4a05 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -277,6 +277,15 @@ ;; The Edit->Search->Incremental Search menu (defvar menu-bar-i-search-menu (let ((menu (make-sparse-keymap "Incremental Search"))) + (bindings--define-key menu [isearch-forward-symbol-at-point] + '(menu-item "Forward Symbol at Point..." isearch-forward-symbol-at-point + :help "Search forward for a symbol found at point")) + (bindings--define-key menu [isearch-forward-symbol] + '(menu-item "Forward Symbol..." isearch-forward-symbol + :help "Search forward for a symbol as you type it")) + (bindings--define-key menu [isearch-forward-word] + '(menu-item "Forward Word..." isearch-forward-word + :help "Search forward for a word as you type it")) (bindings--define-key menu [isearch-backward-regexp] '(menu-item "Backward Regexp..." isearch-backward-regexp :help "Search backwards for a regular expression as you type it")) commit beafe2bf50992b60cb4e8c9628a7000317279c8c Author: Juri Linkov Date: Tue Dec 4 02:24:29 2018 +0200 * lisp/isearch.el (isearch-allow-scroll): New option `unlimited'. (isearch-pre-command-hook): Call isearch-pre-scroll-point unless isearch-allow-scroll is 'unlimited'. (isearch-post-command-hook): Use `when' instead of `cond'. Call isearch-lazy-highlight-new-loop when isearch-allow-scroll is 'unlimited'. (Bug#15839) diff --git a/etc/NEWS b/etc/NEWS index 6297d07879..042a4b59d3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -697,6 +697,9 @@ position after moving point in the current buffer. 'shift-move' extends the search string by motion commands while holding down the shift key. +*** 'isearch-allow-scroll' provides new option 'unlimited' to allow +scrolling any distance off screen. + --- *** Isearch now remembers the regexp-based search mode for words/symbols and case-sensitivity together with search strings in the search ring. diff --git a/lisp/isearch.el b/lisp/isearch.el index eb0b25f9b1..cc199b16d8 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -2746,9 +2746,13 @@ to the barrier." (defcustom isearch-allow-scroll nil "Whether scrolling is allowed during incremental search. If non-nil, scrolling commands can be used in Isearch mode. -However, the current match will never scroll offscreen. -If nil, scrolling commands will first cancel Isearch mode." - :type 'boolean +However, you cannot scroll far enough that the current match is +no longer visible (is off screen). But if the value is `unlimited' +that limitation is removed and you can scroll any distance off screen. +If nil, scrolling commands exit Isearch mode." + :type '(choice (const :tag "Scrolling exits Isearch" nil) + (const :tag "Scrolling with current match on screen" t) + (const :tag "Scrolling with current match off screen" unlimited)) :group 'isearch) (defcustom isearch-allow-prefix t @@ -2846,7 +2850,8 @@ See more for options in `search-exit-option'." (or (eq (get this-command 'isearch-scroll) t) (eq (get this-command 'scroll-command) t)))) (when isearch-allow-scroll - (setq isearch-pre-scroll-point (point)))) + (unless (eq isearch-allow-scroll 'unlimited) + (setq isearch-pre-scroll-point (point))))) ;; A mouse click on the isearch message starts editing the search string. ((and (eq (car-safe main-event) 'down-mouse-1) (window-minibuffer-p (posn-window (event-start main-event)))) @@ -2875,29 +2880,31 @@ See more for options in `search-exit-option'." (isearch-clean-overlays))))) (defun isearch-post-command-hook () - (cond - (isearch-pre-scroll-point - (let ((ab-bel (isearch-string-out-of-window isearch-pre-scroll-point))) - (if ab-bel - (isearch-back-into-window (eq ab-bel 'above) isearch-pre-scroll-point) - (goto-char isearch-pre-scroll-point))) - (setq isearch-pre-scroll-point nil) - (isearch-update)) - ((memq search-exit-option '(move shift-move)) - (when (and isearch-pre-move-point - (not (eq isearch-pre-move-point (point)))) - (let ((string (buffer-substring-no-properties - (or isearch-other-end isearch-opoint) (point)))) - (if isearch-regexp (setq string (regexp-quote string))) - (setq isearch-string string) - (setq isearch-message (mapconcat 'isearch-text-char-description - string "")) - (setq isearch-yank-flag t) - (setq isearch-forward (<= (or isearch-other-end isearch-opoint) (point))) - (when isearch-forward - (goto-char isearch-pre-move-point)) - (isearch-search-and-update))) - (setq isearch-pre-move-point nil))) + (when isearch-pre-scroll-point + (let ((ab-bel (isearch-string-out-of-window isearch-pre-scroll-point))) + (if ab-bel + (isearch-back-into-window (eq ab-bel 'above) isearch-pre-scroll-point) + (goto-char isearch-pre-scroll-point))) + (setq isearch-pre-scroll-point nil) + (isearch-update)) + (when (eq isearch-allow-scroll 'unlimited) + (when isearch-lazy-highlight + (isearch-lazy-highlight-new-loop))) + (when (memq search-exit-option '(move shift-move)) + (when (and isearch-pre-move-point + (not (eq isearch-pre-move-point (point)))) + (let ((string (buffer-substring-no-properties + (or isearch-other-end isearch-opoint) (point)))) + (if isearch-regexp (setq string (regexp-quote string))) + (setq isearch-string string) + (setq isearch-message (mapconcat 'isearch-text-char-description + string "")) + (setq isearch-yank-flag t) + (setq isearch-forward (<= (or isearch-other-end isearch-opoint) (point))) + (when isearch-forward + (goto-char isearch-pre-move-point)) + (isearch-search-and-update))) + (setq isearch-pre-move-point nil)) (force-mode-line-update)) (defun isearch-quote-char (&optional count) commit df5614297b6d4ca8a3c9cd18fea5088401b25146 Author: Juri Linkov Date: Tue Dec 4 02:15:37 2018 +0200 * lisp/vc/vc-git.el (vc-git-stash): Call vc-dir-marked-files only in vc-dir-mode. diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index e406660d2f..f317400530 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1475,12 +1475,16 @@ This command shares argument histories with \\[rgrep] and \\[grep]." (if (eq next-error-last-buffer (current-buffer)) (setq default-directory dir)))))) +(autoload 'vc-dir-marked-files "vc-dir") + (defun vc-git-stash (name) "Create a stash." (interactive "sStash name: ") (let ((root (vc-git-root default-directory))) (when root - (apply #'vc-git--call nil "stash" "push" "-m" name (vc-dir-marked-files)) + (apply #'vc-git--call nil "stash" "push" "-m" name + (when (derived-mode-p 'vc-dir-mode) + (vc-dir-marked-files))) (vc-resynch-buffer root t t)))) (defvar vc-git-stash-read-history nil commit bc6ffabe803f63e99cfbeab79aa0dbdf77f756cb Author: Paul Eggert Date: Mon Dec 3 08:06:46 2018 -0800 emacsclient: fix typo on recent socket-leak change This ports to POSIXish platforms like macOS that lack SOCK_CLOEXEC. Fix suggested by Eli Zaretskii in: https://lists.gnu.org/r/emacs-devel/2018-12/msg00055.html * lib-src/emacsclient.c (set_local_socket): Don’t use SOCK_CLOEXEC; that’s cloexec_socket’s job. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index c430217470..7de3665114 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -1423,7 +1423,7 @@ set_local_socket (char const *server_name) if (sock_status == 0) { - HSOCKET s = cloexec_socket (AF_UNIX, SOCK_STREAM | SOCK_CLOEXEC, 0); + HSOCKET s = cloexec_socket (AF_UNIX, SOCK_STREAM, 0); if (s < 0) { message (true, "%s: socket: %s\n", progname, strerror (errno)); commit 2ff9dca17c5ba1658f8083e20f3bcc7e90c57bb2 Author: Eli Zaretskii Date: Mon Dec 3 12:29:34 2018 +0200 Fix WINDOWSNT/DOS_NT build Recent changes in sysdep.c and emacsclient unnecessarily removed useful code from DOS_NT builds. This changeset reinstates that code. * nt/inc/ms-w32.h (tcdrain): Redirect to _commit. (fdatasync): No need to redirect anymore. * lib-src/emacsclient.c (flush_stdout): Don't avoid calling tcdrain on DOS_NT platforms. * src/sysdep.c (reset_sys_modes): Don't ifdef away the call to tcdrain on DOS_NT platforms. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index a428788344..c430217470 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -1745,10 +1745,8 @@ static void flush_stdout (HSOCKET emacs_socket) { fflush (stdout); -#ifndef DOS_NT while (tcdrain (STDOUT_FILENO) != 0 && errno == EINTR) act_on_signals (emacs_socket); -#endif } int diff --git a/nt/inc/ms-w32.h b/nt/inc/ms-w32.h index e4dec04fb8..df35dff91b 100644 --- a/nt/inc/ms-w32.h +++ b/nt/inc/ms-w32.h @@ -311,7 +311,7 @@ extern int execve (const char *, char * const *, char * const *); #else extern intptr_t execve (const char *, char * const *, char * const *); #endif -#define fdatasync _commit +#define tcdrain _commit #define fdopen _fdopen #define fsync _commit #define ftruncate _chsize diff --git a/src/sysdep.c b/src/sysdep.c index b054839795..9901d6a089 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -1519,11 +1519,11 @@ reset_sys_modes (struct tty_display_info *tty_out) if (tty_out->terminal->reset_terminal_modes_hook) tty_out->terminal->reset_terminal_modes_hook (tty_out->terminal); -#ifndef DOS_NT /* Avoid possible loss of output when changing terminal modes. */ while (tcdrain (fileno (tty_out->output)) != 0 && errno == EINTR) continue; +#ifndef DOS_NT # ifdef F_SETOWN if (interrupt_input) { commit 5c412405c7422b356484a933179f852c30ce2f24 Author: Paul Eggert Date: Sun Dec 2 23:51:11 2018 -0800 emacsclient: don’t leak socket to child processes * lib-src/emacsclient.c [!WINDOWSNT]: Include fcntl.h. (cloexec_socket): New function. (set_tcp_socket, set_local_socket): Use it. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 1c62c09451..a428788344 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -50,6 +50,7 @@ char *w32_getenv (const char *); # include "syswait.h" # include +# include # include # include # include @@ -976,6 +977,24 @@ get_server_config (const char *config_file, struct sockaddr_in *server, return true; } +/* Like socket (DOMAIN, TYPE, PROTOCOL), except arrange for the + resulting file descriptor to be close-on-exec. */ + +static HSOCKET +cloexec_socket (int domain, int type, int protocol) +{ +#ifdef SOCK_CLOEXEC + return socket (domain, type | SOCK_CLOEXEC, protocol); +#else + HSOCKET s = socket (domain, type, protocol); +# ifndef WINDOWSNT + if (0 <= s) + fcntl (s, F_SETFD, FD_CLOEXEC); +# endif + return s; +#endif +} + static HSOCKET set_tcp_socket (const char *local_server_file) { @@ -994,7 +1013,7 @@ set_tcp_socket (const char *local_server_file) progname, inet_ntoa (server.in.sin_addr)); /* Open up an AF_INET socket. */ - HSOCKET s = socket (AF_INET, SOCK_STREAM, IPPROTO_TCP); + HSOCKET s = cloexec_socket (AF_INET, SOCK_STREAM, IPPROTO_TCP); if (s < 0) { /* Since we have an alternate to try out, this is not an error @@ -1404,7 +1423,7 @@ set_local_socket (char const *server_name) if (sock_status == 0) { - HSOCKET s = socket (AF_UNIX, SOCK_STREAM, 0); + HSOCKET s = cloexec_socket (AF_UNIX, SOCK_STREAM | SOCK_CLOEXEC, 0); if (s < 0) { message (true, "%s: socket: %s\n", progname, strerror (errno)); commit f5090b91299cbd36901bef7b94aeef618b1bc6d8 Author: Paul Eggert Date: Sun Dec 2 23:11:09 2018 -0800 Use tcdrain, not fdatasync, to drain ttys fdatasync is for storage devices, not ttys. * admin/merge-gnulib (GNULIB_MODULES): Remove fdatasync. * lib/fdatasync.c, m4/fdatasync.m4: Remove. * lib-src/Makefile.in (LIB_FDATASYNC): * src/Makefile.in (LIB_FDATASYNC): Remove. All uses removed. * lib-src/emacsclient.c [!DOS_NT]: Include , for tcdrain. * lib-src/emacsclient.c (flush_stdout): * src/sysdep.c (reset_sys_modes): On ttys, use tcdrain instead of fdatasync (except don’t use either function if DOS_NT). * lib/gnulib.mk.in, m4/gnulib-comp.m4: Regenerate. diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 84dcb0b875..ab0d34e162 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -32,7 +32,7 @@ GNULIB_MODULES=' crypto/md5-buffer crypto/sha1-buffer crypto/sha256-buffer crypto/sha512-buffer d-type diffseq dosname dtoastr dtotimespec dup2 environ execinfo explicit_bzero faccessat - fcntl fcntl-h fdatasync fdopendir + fcntl fcntl-h fdopendir filemode filevercmp flexmember fpieee fstatat fsusage fsync getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog ieee754-h ignore-value intprops largefile lstat diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in index ecb9208a1c..00151933ca 100644 --- a/lib-src/Makefile.in +++ b/lib-src/Makefile.in @@ -204,8 +204,6 @@ LIBRESOLV=@LIBRESOLV@ LIBS_MAIL=@LIBS_MAIL@ ## empty or -lrt or -lposix4 if HAVE_CLOCK_GETTIME LIB_CLOCK_GETTIME = @LIB_CLOCK_GETTIME@ -## empty or -lrt or -lposix4 if HAVE_FDATASYNC -LIB_FDATASYNC = @LIB_FDATASYNC@ ## empty or -lwsock2 for MinGW LIB_WSOCK32=@LIB_WSOCK32@ @@ -396,12 +394,12 @@ pop.o: ${srcdir}/pop.c ${srcdir}/pop.h ${srcdir}/../lib/min-max.h $(config_h) emacsclient${EXEEXT}: ${srcdir}/emacsclient.c $(NTLIB) $(config_h) $(AM_V_CCLD)$(CC) ${ALL_CFLAGS} $< \ - -DVERSION="\"${version}\"" $(NTLIB) $(LOADLIBES) $(LIB_FDATASYNC) \ + -DVERSION="\"${version}\"" $(NTLIB) $(LOADLIBES) \ $(LIB_WSOCK32) $(LIBS_ECLIENT) -o $@ emacsclientw${EXEEXT}: ${srcdir}/emacsclient.c $(NTLIB) $(CLIENTRES) $(config_h) $(AM_V_CCLD)$(CC) ${ALL_CFLAGS} $(CLIENTRES) -mwindows $< \ - -DVERSION="\"${version}\"" $(LOADLIBES) $(LIB_FDATASYNC) \ + -DVERSION="\"${version}\"" $(LOADLIBES) \ $(LIB_WSOCK32) $(LIBS_ECLIENT) -o $@ NTINC = ${srcdir}/../nt/inc diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index df44bc4087..1c62c09451 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -65,6 +65,10 @@ char *w32_getenv (const char *); #endif /* !WINDOWSNT */ +#ifndef DOS_NT +# include +#endif + #include #include #include @@ -1722,8 +1726,10 @@ static void flush_stdout (HSOCKET emacs_socket) { fflush (stdout); - while (fdatasync (STDOUT_FILENO) != 0 && errno == EINTR) +#ifndef DOS_NT + while (tcdrain (STDOUT_FILENO) != 0 && errno == EINTR) act_on_signals (emacs_socket); +#endif } int diff --git a/lib/fdatasync.c b/lib/fdatasync.c deleted file mode 100644 index c474e3dd36..0000000000 --- a/lib/fdatasync.c +++ /dev/null @@ -1,27 +0,0 @@ -/* Emulate fdatasync on platforms that lack it. - - Copyright (C) 2011-2018 Free Software Foundation, Inc. - - This library 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. - - This library 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 this program. If not, see . */ - -#include -#include - -int -fdatasync (int fd) -{ - /* This does more work than strictly necessary, but is the best we - can do portably. */ - return fsync (fd); -} diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index eca073d0e5..aa32dccb3f 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -92,7 +92,6 @@ # faccessat \ # fcntl \ # fcntl-h \ -# fdatasync \ # fdopendir \ # filemode \ # filevercmp \ @@ -731,7 +730,6 @@ LIB_ACL = @LIB_ACL@ LIB_CLOCK_GETTIME = @LIB_CLOCK_GETTIME@ LIB_EACCESS = @LIB_EACCESS@ LIB_EXECINFO = @LIB_EXECINFO@ -LIB_FDATASYNC = @LIB_FDATASYNC@ LIB_MATH = @LIB_MATH@ LIB_PTHREAD = @LIB_PTHREAD@ LIB_PTHREAD_SIGMASK = @LIB_PTHREAD_SIGMASK@ @@ -1586,17 +1584,6 @@ EXTRA_DIST += fcntl.in.h endif ## end gnulib module fcntl-h -## begin gnulib module fdatasync -ifeq (,$(OMIT_GNULIB_MODULE_fdatasync)) - - -EXTRA_DIST += fdatasync.c - -EXTRA_libgnu_a_SOURCES += fdatasync.c - -endif -## end gnulib module fdatasync - ## begin gnulib module fdopendir ifeq (,$(OMIT_GNULIB_MODULE_fdopendir)) diff --git a/m4/fdatasync.m4 b/m4/fdatasync.m4 deleted file mode 100644 index fd8e4320d2..0000000000 --- a/m4/fdatasync.m4 +++ /dev/null @@ -1,32 +0,0 @@ -# fdatasync.m4 serial 4 -dnl Copyright (C) 2008-2018 Free Software Foundation, Inc. -dnl This file is free software; the Free Software Foundation -dnl gives unlimited permission to copy and/or distribute it, -dnl with or without modifications, as long as this notice is preserved. - -AC_DEFUN([gl_FUNC_FDATASYNC], -[ - AC_REQUIRE([gl_UNISTD_H_DEFAULTS]) - - dnl Using AC_CHECK_FUNCS_ONCE would break our subsequent AC_SEARCH_LIBS - AC_CHECK_DECLS_ONCE([fdatasync]) - LIB_FDATASYNC= - AC_SUBST([LIB_FDATASYNC]) - - if test $ac_cv_have_decl_fdatasync = no; then - HAVE_DECL_FDATASYNC=0 - dnl Mac OS X 10.7 has fdatasync but does not declare it. - AC_CHECK_FUNCS([fdatasync]) - if test $ac_cv_func_fdatasync = no; then - HAVE_FDATASYNC=0 - fi - else - dnl Solaris <= 2.6 has fdatasync() in libposix4. - dnl Solaris 7..10 has it in librt. - gl_saved_libs=$LIBS - AC_SEARCH_LIBS([fdatasync], [rt posix4], - [test "$ac_cv_search_fdatasync" = "none required" || - LIB_FDATASYNC=$ac_cv_search_fdatasync]) - LIBS=$gl_saved_libs - fi -]) diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index a4dddbad73..d31dd5d533 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -81,7 +81,6 @@ AC_DEFUN([gl_EARLY], # Code from module faccessat: # Code from module fcntl: # Code from module fcntl-h: - # Code from module fdatasync: # Code from module fdopendir: # Code from module filemode: # Code from module filevercmp: @@ -241,11 +240,6 @@ AC_DEFUN([gl_INIT], fi gl_FCNTL_MODULE_INDICATOR([fcntl]) gl_FCNTL_H - gl_FUNC_FDATASYNC - if test $HAVE_FDATASYNC = 0; then - AC_LIBOBJ([fdatasync]) - fi - gl_UNISTD_MODULE_INDICATOR([fdatasync]) gl_FUNC_FDOPENDIR if test $HAVE_FDOPENDIR = 0 || test $REPLACE_FDOPENDIR = 1; then AC_LIBOBJ([fdopendir]) @@ -880,7 +874,6 @@ AC_DEFUN([gl_FILE_LIST], [ lib/faccessat.c lib/fcntl.c lib/fcntl.in.h - lib/fdatasync.c lib/fdopendir.c lib/filemode.c lib/filemode.h @@ -1028,7 +1021,6 @@ AC_DEFUN([gl_FILE_LIST], [ m4/fcntl-o.m4 m4/fcntl.m4 m4/fcntl_h.m4 - m4/fdatasync.m4 m4/fdopendir.m4 m4/filemode.m4 m4/flexmember.m4 diff --git a/src/Makefile.in b/src/Makefile.in index 2dba1026c3..6b2e54a160 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -141,7 +141,6 @@ M17N_FLT_LIBS = @M17N_FLT_LIBS@ LIB_ACL=@LIB_ACL@ LIB_CLOCK_GETTIME=@LIB_CLOCK_GETTIME@ LIB_EACCESS=@LIB_EACCESS@ -LIB_FDATASYNC=@LIB_FDATASYNC@ LIB_TIMER_TIME=@LIB_TIMER_TIME@ DBUS_CFLAGS = @DBUS_CFLAGS@ @@ -496,7 +495,7 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(LIBX_BASE) $(LIBIMAGE) \ $(LIBX_OTHER) $(LIBSOUND) \ $(RSVG_LIBS) $(IMAGEMAGICK_LIBS) $(LIB_ACL) $(LIB_CLOCK_GETTIME) \ $(WEBKIT_LIBS) \ - $(LIB_EACCESS) $(LIB_FDATASYNC) $(LIB_TIMER_TIME) $(DBUS_LIBS) \ + $(LIB_EACCESS) $(LIB_TIMER_TIME) $(DBUS_LIBS) \ $(LIB_EXECINFO) $(XRANDR_LIBS) $(XINERAMA_LIBS) $(XFIXES_LIBS) \ $(XDBE_LIBS) \ $(LIBXML2_LIBS) $(LIBGPM) $(LIBS_SYSTEM) $(CAIRO_LIBS) \ diff --git a/src/sysdep.c b/src/sysdep.c index ddcb594f66..b054839795 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -1519,19 +1519,19 @@ reset_sys_modes (struct tty_display_info *tty_out) if (tty_out->terminal->reset_terminal_modes_hook) tty_out->terminal->reset_terminal_modes_hook (tty_out->terminal); +#ifndef DOS_NT /* Avoid possible loss of output when changing terminal modes. */ - while (fdatasync (fileno (tty_out->output)) != 0 && errno == EINTR) + while (tcdrain (fileno (tty_out->output)) != 0 && errno == EINTR) continue; -#ifndef DOS_NT -#ifdef F_SETOWN +# ifdef F_SETOWN if (interrupt_input) { reset_sigio (fileno (tty_out->input)); fcntl (fileno (tty_out->input), F_SETOWN, old_fcntl_owner[fileno (tty_out->input)]); } -#endif /* F_SETOWN */ +# endif /* F_SETOWN */ fcntl (fileno (tty_out->input), F_SETFL, fcntl (fileno (tty_out->input), F_GETFL, 0) & ~O_NONBLOCK); #endif commit 25a33aa2d173d933af294a7ea130960c720e1be5 Author: Paul Eggert Date: Sun Dec 2 22:49:09 2018 -0800 Update from Gnulib This incorporates: 2018-11-30 memrchr: port better to clang 2018-11-21 mktime: add libc-config dependency * build-aux/config.guess, build-aux/config.sub, lib/memrchr.c: Copy from Gnulib. * m4/gnulib-comp.m4: Regenerate. diff --git a/build-aux/config.guess b/build-aux/config.guess index 18f8edc0ff..47d7bed50c 100755 --- a/build-aux/config.guess +++ b/build-aux/config.guess @@ -2,7 +2,7 @@ # Attempt to guess a canonical system name. # Copyright 1992-2018 Free Software Foundation, Inc. -timestamp='2018-08-29' +timestamp='2018-11-28' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -1424,6 +1424,9 @@ EOF amd64:Isilon\ OneFS:*:*) echo x86_64-unknown-onefs exit ;; + *:Unleashed:*:*) + echo "$UNAME_MACHINE"-unknown-unleashed"$UNAME_RELEASE" + exit ;; esac echo "$0: unable to guess system type" >&2 diff --git a/build-aux/config.sub b/build-aux/config.sub index f208558ec2..46708056af 100755 --- a/build-aux/config.sub +++ b/build-aux/config.sub @@ -2,7 +2,7 @@ # Configuration validation subroutine script. # Copyright 1992-2018 Free Software Foundation, Inc. -timestamp='2018-08-29' +timestamp='2018-11-28' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -1161,6 +1161,7 @@ case $cpu-$vendor in | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] \ | alphapca5[67] | alpha64pca5[67] \ | am33_2.0 \ + | amdgcn \ | arc | arceb \ | arm | arm[lb]e | arme[lb] | armv* \ | avr | avr32 \ @@ -1360,7 +1361,7 @@ case $os in | powermax* | dnix* | nx6 | nx7 | sei* | dragonfly* \ | skyos* | haiku* | rdos* | toppers* | drops* | es* \ | onefs* | tirtos* | phoenix* | fuchsia* | redox* | bme* \ - | midnightbsd*) + | midnightbsd* | amdhsa* | unleashed*) # Remember, each alternative MUST END IN *, to match a version number. ;; qnx*) diff --git a/lib/memrchr.c b/lib/memrchr.c index 99acfd9c56..2efc7cb975 100644 --- a/lib/memrchr.c +++ b/lib/memrchr.c @@ -68,7 +68,7 @@ __memrchr (void const *s, int c_in, size_t n) if (*--char_ptr == c) return (void *) char_ptr; - longword_ptr = (const longword *) char_ptr; + longword_ptr = (const void *) char_ptr; /* All these elucidatory comments refer to 4-byte longwords, but the theory applies equally well to any size longwords. */ diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 5618befebf..a4dddbad73 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -650,6 +650,9 @@ AC_DEFUN([gl_INIT], if test $NEED_LOCALTIME_BUFFER = 1; then func_gl_gnulib_m4code_2049e887c7e5308faad27b3f894bb8c9 fi + if test $REPLACE_MKTIME = 1; then + func_gl_gnulib_m4code_21ee726a3540c09237a8e70c0baf7467 + fi if test $HAVE_READLINKAT = 0; then func_gl_gnulib_m4code_260941c0e5dc67ec9e87d1fb321c300b fi commit 3e5d7755454bea9b6ffd232b1d115c629cdb193d Author: Paul Eggert Date: Sun Dec 2 22:32:28 2018 -0800 emacsclient: fix symlink/socket race * lib-src/emacsclient.c (socket_status): New arg UID. All uses changed. (set_local_socket): Don’t create the unbound socket unless the initial sanity checks on the socket file succeed; this simplifies cleaning it up. Check socket ownership again after connecting, to fix a race (Bug#33366). diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index ba72651343..df44bc4087 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -1079,20 +1079,21 @@ find_tty (const char **tty_type, const char **tty_name, bool noabort) #ifdef SOCKETS_IN_FILE_SYSTEM -/* Three possibilities: +/* Return the file status of NAME, ordinarily a socket. + It should be owned by UID. Return one of the following: >0 - 'stat' failed with this errno value -1 - isn't owned by us 0 - success: none of the above */ static int -socket_status (const char *name) +socket_status (const char *name, uid_t uid) { struct stat statbfr; if (stat (name, &statbfr) != 0) return errno; - if (statbfr.st_uid != geteuid ()) + if (statbfr.st_uid != uid) return -1; return 0; @@ -1316,18 +1317,11 @@ set_local_socket (char const *server_name) struct sockaddr_un un; struct sockaddr sa; } server = {{ .sun_family = AF_UNIX }}; - - HSOCKET s = socket (AF_UNIX, SOCK_STREAM, 0); - if (s < 0) - { - message (true, "%s: socket: %s\n", progname, strerror (errno)); - return INVALID_SOCKET; - } - char *sockname = server.un.sun_path; enum { socknamesize = sizeof server.un.sun_path }; int tmpdirlen = -1; int socknamelen = -1; + uid_t uid = geteuid (); if (strchr (server_name, '/') || (ISSLASH ('\\') && strchr (server_name, '\\'))) @@ -1359,7 +1353,7 @@ set_local_socket (char const *server_name) tmpdirlen = snprintf (sockname, socknamesize, "/tmp"); } socknamelen = local_sockname (sockname, socknamesize, tmpdirlen, - geteuid (), server_name); + uid, server_name); } } @@ -1370,7 +1364,7 @@ set_local_socket (char const *server_name) } /* See if the socket exists, and if it's owned by us. */ - int sock_status = socket_status (sockname); + int sock_status = socket_status (sockname, uid); if (sock_status) { /* Failing that, see if LOGNAME or USER exist and differ from @@ -1387,7 +1381,7 @@ set_local_socket (char const *server_name) { struct passwd *pw = getpwnam (user_name); - if (pw && (pw->pw_uid != geteuid ())) + if (pw && pw->pw_uid != uid) { /* We're running under su, apparently. */ socknamelen = local_sockname (sockname, socknamesize, tmpdirlen, @@ -1399,39 +1393,49 @@ set_local_socket (char const *server_name) exit (EXIT_FAILURE); } - sock_status = socket_status (sockname); + sock_status = socket_status (sockname, uid); } } } - switch (sock_status) + if (sock_status == 0) { - case -1: - /* There's a socket, but it isn't owned by us. */ - message (true, "%s: Invalid socket owner\n", progname); - break; + HSOCKET s = socket (AF_UNIX, SOCK_STREAM, 0); + if (s < 0) + { + message (true, "%s: socket: %s\n", progname, strerror (errno)); + return INVALID_SOCKET; + } + if (connect (s, &server.sa, sizeof server.un) != 0) + { + message (true, "%s: connect: %s\n", progname, strerror (errno)); + CLOSE_SOCKET (s); + return INVALID_SOCKET; + } - case 0: - if (connect (s, &server.sa, sizeof server.un) == 0) + struct stat connect_stat; + if (fstat (s, &connect_stat) != 0) + sock_status = errno; + else if (connect_stat.st_uid == uid) return s; - message (true, "%s: connect: %s\n", progname, strerror (errno)); - break; - - default: - /* 'stat' failed. */ - if (sock_status == ENOENT) - message (true, - ("%s: can't find socket; have you started the server?\n" - "%s: To start the server in Emacs," - " type \"M-x server-start\".\n"), - progname, progname); else - message (true, "%s: can't stat %s: %s\n", - progname, sockname, strerror (sock_status)); - break; + sock_status = -1; + + CLOSE_SOCKET (s); } - CLOSE_SOCKET (s); + if (sock_status < 0) + message (true, "%s: Invalid socket owner\n", progname); + else if (sock_status == ENOENT) + message (true, + ("%s: can't find socket; have you started the server?\n" + "%s: To start the server in Emacs," + " type \"M-x server-start\".\n"), + progname, progname); + else + message (true, "%s: can't stat %s: %s\n", + progname, sockname, strerror (sock_status)); + return INVALID_SOCKET; } #endif /* SOCKETS_IN_FILE_SYSTEM */ commit e5634aae531ce932ecb8d84243d690c7ca89bec3 Merge: 5f6d7a4f9d 745c9c0258 Author: Glenn Morris Date: Sun Dec 2 10:32:25 2018 -0800 Merge from origin/emacs-26 745c9c0 (origin/emacs-26) Revert "Revert "Fix infloop in GC mark_kboa... c418c85 Revert "Fix infloop in GC mark_kboards" 8fa0d96 * lisp/emacs-lisp/subr-x.el (if-let, when-let): Doc fix: acti... commit 5f6d7a4f9d5970e6cb1dfc3bd8cdfa4651cf0678 Merge: b6935dbe18 af914fc26d Author: Glenn Morris Date: Sun Dec 2 10:32:25 2018 -0800 ; Merge from origin/emacs-26 The following commit was skipped: af914fc Fix infloop in GC mark_kboards commit b6935dbe1816379dd6a9ffc14b2eaa4435003187 Merge: e8586d46f7 317b354782 Author: Glenn Morris Date: Sun Dec 2 10:32:24 2018 -0800 Merge from origin/emacs-26 317b354 ; Add notes about cross-compiling macOS versions 4b176eb Fix macOS run-time feature check c03574b * etc/NEWS-*: Fix capitalization of "Emacs" # Conflicts: # etc/NEWS commit e8586d46f774283b4efe9f34e3a6570d1a19edfa Merge: 3895e2229f 42320cc8ca Author: Glenn Morris Date: Sun Dec 2 10:32:24 2018 -0800 ; Merge from origin/emacs-26 The following commit was skipped: 42320cc ; Auto-commit of loaddefs files. commit 3895e2229fafa6cc92d3b1df1895f08c16ae0ab6 Merge: fa9411eddc e06562ce7c Author: Glenn Morris Date: Sun Dec 2 10:32:24 2018 -0800 Merge from origin/emacs-26 e06562c Fix "M-x man" when there's no 'man' program on PATH commit fa9411eddccb1eebbc0c362afe9026d51af222dd Merge: 4d66f9fe5e 7ecf49b5a5 Author: Glenn Morris Date: Sun Dec 2 10:32:24 2018 -0800 ; Merge from origin/emacs-26 The following commit was skipped: 7ecf49b Fix core dump in dbus-message-internal commit 4d66f9fe5eebd98f2483c9416620c096d245f549 Merge: 2064cd4c9b cc3ad9a3d1 Author: Glenn Morris Date: Sun Dec 2 10:32:23 2018 -0800 Merge from origin/emacs-26 cc3ad9a ; * CONTRIBUTE: Clarify rules for committing to release branc... a89dbe2 * doc/misc/dbus.texi (Type Conversion): Fix typo. (Bug#33551) 03ee726 ; Add comment to `customize-package-emacs-version-alist' bce1d1a Improve documentation of gdb-mi.el commit 2064cd4c9b60766f958a6dcffcaa810224ef2d7d Merge: 92282cb502 809989f79e Author: Glenn Morris Date: Sun Dec 2 10:32:23 2018 -0800 ; Merge from origin/emacs-26 The following commit was skipped: 809989f LDAP: Set process-connection-type to t on Darwin commit 745c9c02582443680167501b218cc59f1a2d3fb6 Author: Eli Zaretskii Date: Sun Dec 2 20:04:05 2018 +0200 Revert "Revert "Fix infloop in GC mark_kboards"" This reverts commit c418c85617babbe7b63730fefb71e2c87a0141af. This reinstates the original fix, as it had nothing to do with the behavior reported in bug#33571, which seems to be the expected behavior. diff --git a/src/keyboard.c b/src/keyboard.c index 0d56ea3f7a..dccc6b7f12 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -12011,7 +12011,12 @@ mark_kboards (void) for (event = kbd_fetch_ptr; event != kbd_store_ptr; event++) { if (event == kbd_buffer + KBD_BUFFER_SIZE) - event = kbd_buffer; + { + event = kbd_buffer; + if (event == kbd_store_ptr) + break; + } + /* These two special event types has no Lisp_Objects to mark. */ if (event->kind != SELECTION_REQUEST_EVENT && event->kind != SELECTION_CLEAR_EVENT) commit c418c85617babbe7b63730fefb71e2c87a0141af Author: Eli Zaretskii Date: Sun Dec 2 09:39:04 2018 +0200 Revert "Fix infloop in GC mark_kboards" This reverts commit af914fc26db273d8788e7efa57c569f0f778d037, since it caused unintended adverse effects on echoing of keys. (Bug#33571) diff --git a/src/keyboard.c b/src/keyboard.c index dccc6b7f12..0d56ea3f7a 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -12011,12 +12011,7 @@ mark_kboards (void) for (event = kbd_fetch_ptr; event != kbd_store_ptr; event++) { if (event == kbd_buffer + KBD_BUFFER_SIZE) - { - event = kbd_buffer; - if (event == kbd_store_ptr) - break; - } - + event = kbd_buffer; /* These two special event types has no Lisp_Objects to mark. */ if (event->kind != SELECTION_REQUEST_EVENT && event->kind != SELECTION_CLEAR_EVENT) commit 92282cb50248117185774cf8076d1ff83d501be7 Author: Paul Eggert Date: Sat Dec 1 23:06:06 2018 -0800 emacsclient: prefer XDG_RUNTIME_DIR (Bug#33367) * lib-src/emacsclient.c: Disable -Wformat-truncation=2, to avoid false alarms about the new snprintf calls. (local_sockname): New function. (set_local_socket): Use it. Prefer XDG_RUNTIME_DIR (if set) for location of socket directory. Avoid unnecessary memory allocation by using snprintf to destination. * lisp/server.el (server-socket-dir): Prefer XDG_RUNTIME_DIR if set. diff --git a/admin/notes/multi-tty b/admin/notes/multi-tty index 5b34bb598e..619af8e7fa 100644 --- a/admin/notes/multi-tty +++ b/admin/notes/multi-tty @@ -171,7 +171,11 @@ preload-emacs "$name" wait name="$1" waitp="$2" screendir="/var/run/screen/S-$USER" -serverdir="/tmp/emacs$UID" +if [ "${XDG_RUNTIME_DIR+set}" ]; then + serverdir="$XDG_RUNTIME_DIR/emacs" +else + serverdir="${TMPDIR-/tmp}/emacs$UID" +fi emacs=/usr/bin/emacs-multi-tty # Or wherever you installed your multi-tty Emacs if [ -z "$name" ]; then diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index 0d4e4ba8bd..d457267c24 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -2005,8 +2005,10 @@ or by invoking @code{server-start} from @file{.emacs}: (if (@var{some conditions are met}) (server-start)) @end lisp -When this is done, Emacs creates a Unix domain socket named -@file{server} in @file{/tmp/emacs@var{userid}}. See +When this is done, Emacs by default creates a Unix domain socket named +@file{server} in a well-known directory, typically +@file{$XDG_RUNTIME_DIR/emacs} if Emacs is running under an X Window System +desktop and @file{$TMPDIR/emacs@var{userid}} otherwise. See the variable @code{server-socket-dir}. To get your news reader, mail reader, etc., to invoke diff --git a/etc/NEWS b/etc/NEWS index 1ddc565b8b..6297d07879 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -128,6 +128,12 @@ command-line value specified via '--socket-name' will override the environment, and the natural default to TMPDIR, then "/tmp", continues to apply. ++++ +*** Emacs and emacsclient now default to $XDG_RUNTIME_DIR/emacs +as the directory for client/server sockets, if Emacs is running +under an X Window System desktop that sets the XDG_RUNTIME_DIR +environment variable to indicate where session sockets should go. + --- *** When run by root, emacsclient no longer connects to non-root sockets. (Instead you can use Tramp methods to run root commands in a non-root Emacs.) diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index c67d34f77f..ba72651343 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -87,6 +87,11 @@ char *w32_getenv (const char *); #define VERSION "unspecified" #endif +/* Work around GCC bug 88251. */ +#if GNUC_PREREQ (7, 0, 0) +# pragma GCC diagnostic ignored "-Wformat-truncation=2" +#endif + /* Name used to invoke this program. */ static char const *progname; @@ -1271,10 +1276,41 @@ act_on_signals (HSOCKET emacs_socket) } } -/* Create a local socket and connect it to Emacs. */ +/* Create in SOCKNAME (of size SOCKNAMESIZE) a name for a local socket. + The first TMPDIRLEN bytes of SOCKNAME are already initialized to be + the name of a temporary directory. Use UID and SERVER_NAME to + concoct the name. Return the total length of the name if successful, + -1 if it does not fit (and store a truncated name in that case). + Fail if TMPDIRLEN is out of range. */ + +static int +local_sockname (char *sockname, int socknamesize, int tmpdirlen, + uintmax_t uid, char const *server_name) +{ + /* If ! (0 <= TMPDIRLEN && TMPDIRLEN < SOCKNAMESIZE) the truncated + temporary directory name is already in SOCKNAME, so nothing more + need be stored. */ + if (0 <= tmpdirlen) + { + int remaining = socknamesize - tmpdirlen; + if (0 < remaining) + { + int suffixlen = snprintf (&sockname[tmpdirlen], remaining, + "/emacs%"PRIuMAX"/%s", uid, server_name); + if (0 <= suffixlen && suffixlen < remaining) + return tmpdirlen + suffixlen; + } + } + return -1; +} + +/* Create a local socket for SERVER_NAME and connect it to Emacs. If + SERVER_NAME is a file name component, the local socket name + relative to a well-known location in a temporary directory. + Otherwise, the local socket name is SERVER_NAME. */ static HSOCKET -set_local_socket (const char *local_socket_name) +set_local_socket (char const *server_name) { union { struct sockaddr_un un; @@ -1288,55 +1324,54 @@ set_local_socket (const char *local_socket_name) return INVALID_SOCKET; } - char const *server_name = local_socket_name; - char const *tmpdir = NULL; - char *tmpdir_storage = NULL; - char *socket_name_storage = NULL; - static char const subdir_format[] = "/emacs%"PRIuMAX"/"; - int subdir_size_bound = (sizeof subdir_format - sizeof "%"PRIuMAX - + INT_STRLEN_BOUND (uid_t) + 1); + char *sockname = server.un.sun_path; + enum { socknamesize = sizeof server.un.sun_path }; + int tmpdirlen = -1; + int socknamelen = -1; - if (! (strchr (local_socket_name, '/') - || (ISSLASH ('\\') && strchr (local_socket_name, '\\')))) + if (strchr (server_name, '/') + || (ISSLASH ('\\') && strchr (server_name, '\\'))) + socknamelen = snprintf (sockname, socknamesize, "%s", server_name); + else { /* socket_name is a file name component. */ - uintmax_t uid = geteuid (); - tmpdir = egetenv ("TMPDIR"); - if (!tmpdir) + char const *xdg_runtime_dir = egetenv ("XDG_RUNTIME_DIR"); + if (xdg_runtime_dir) + socknamelen = snprintf (sockname, socknamesize, "%s/emacs/%s", + xdg_runtime_dir, server_name); + else { + char const *tmpdir = egetenv ("TMPDIR"); + if (tmpdir) + tmpdirlen = snprintf (sockname, socknamesize, "%s", tmpdir); + else + { # ifdef DARWIN_OS # ifndef _CS_DARWIN_USER_TEMP_DIR # define _CS_DARWIN_USER_TEMP_DIR 65537 # endif - size_t n = confstr (_CS_DARWIN_USER_TEMP_DIR, NULL, 0); - if (n > 0) - { - tmpdir = tmpdir_storage = xmalloc (n); - confstr (_CS_DARWIN_USER_TEMP_DIR, tmpdir_storage, n); - } - else + size_t n = confstr (_CS_DARWIN_USER_TEMP_DIR, + sockname, socknamesize); + if (0 < n && n < (size_t) -1) + tmpdirlen = min (n - 1, socknamesize); # endif - tmpdir = "/tmp"; + if (tmpdirlen < 0) + tmpdirlen = snprintf (sockname, socknamesize, "/tmp"); + } + socknamelen = local_sockname (sockname, socknamesize, tmpdirlen, + geteuid (), server_name); } - socket_name_storage = - xmalloc (strlen (tmpdir) + strlen (server_name) + subdir_size_bound); - char *z = stpcpy (socket_name_storage, tmpdir); - strcpy (z + sprintf (z, subdir_format, uid), server_name); - local_socket_name = socket_name_storage; } - if (strlen (local_socket_name) < sizeof server.un.sun_path) - strcpy (server.un.sun_path, local_socket_name); - else + if (! (0 <= socknamelen && socknamelen < socknamesize)) { - message (true, "%s: socket-name %s too long\n", - progname, local_socket_name); + message (true, "%s: socket-name %s... too long\n", progname, sockname); fail (); } /* See if the socket exists, and if it's owned by us. */ - int sock_status = socket_status (server.un.sun_path); - if (sock_status && tmpdir) + int sock_status = socket_status (sockname); + if (sock_status) { /* Failing that, see if LOGNAME or USER exist and differ from our euid. If so, look for a socket based on the UID @@ -1355,31 +1390,20 @@ set_local_socket (const char *local_socket_name) if (pw && (pw->pw_uid != geteuid ())) { /* We're running under su, apparently. */ - uintmax_t uid = pw->pw_uid; - char *user_socket_name - = xmalloc (strlen (tmpdir) + strlen (server_name) - + subdir_size_bound); - char *z = stpcpy (user_socket_name, tmpdir); - strcpy (z + sprintf (z, subdir_format, uid), server_name); - - if (strlen (user_socket_name) < sizeof server.un.sun_path) - strcpy (server.un.sun_path, user_socket_name); - else + socknamelen = local_sockname (sockname, socknamesize, tmpdirlen, + pw->pw_uid, server_name); + if (socknamelen < 0) { - message (true, "%s: socket-name %s too long\n", - progname, user_socket_name); + message (true, "%s: socket-name %s... too long\n", + progname, sockname); exit (EXIT_FAILURE); } - free (user_socket_name); - sock_status = socket_status (server.un.sun_path); + sock_status = socket_status (sockname); } } } - free (socket_name_storage); - free (tmpdir_storage); - switch (sock_status) { case -1: @@ -1403,7 +1427,7 @@ set_local_socket (const char *local_socket_name) progname, progname); else message (true, "%s: can't stat %s: %s\n", - progname, server.un.sun_path, strerror (sock_status)); + progname, sockname, strerror (sock_status)); break; } @@ -1421,12 +1445,12 @@ set_socket (bool no_exit_if_error) INITIALIZE (); #ifdef SOCKETS_IN_FILE_SYSTEM - /* Explicit --socket-name argument. */ if (!socket_name) socket_name = egetenv ("EMACS_SOCKET_NAME"); if (socket_name) { + /* Explicit --socket-name argument, or environment variable. */ s = set_local_socket (socket_name); if (s != INVALID_SOCKET || no_exit_if_error) return s; diff --git a/lisp/server.el b/lisp/server.el index d0a8ca313e..28e789a4c8 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -281,7 +281,10 @@ changed while a server is running." (if internal--daemon-sockname (file-name-directory internal--daemon-sockname) (and (featurep 'make-network-process '(:family local)) - (format "%s/emacs%d" (or (getenv "TMPDIR") "/tmp") (user-uid)))) + (let ((xdg_runtime_dir (getenv "XDG_RUNTIME_DIR"))) + (if xdg_runtime_dir + (format "%s/emacs" xdg_runtime_dir) + (format "%s/emacs%d" (or (getenv "TMPDIR") "/tmp") (user-uid)))))) "The directory in which to place the server socket. If local sockets are not supported, this is nil.") commit 8fa0d9679d25c431bfe2da3d93997f5ed222ce35 Author: Glenn Morris Date: Sat Dec 1 17:21:29 2018 -0800 * lisp/emacs-lisp/subr-x.el (if-let, when-let): Doc fix: active voice. diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 7fab9083e8..2e24d5607b 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -122,7 +122,7 @@ If ELT is of the form ((EXPR)), listify (EXPR) with a dummy symbol." bindings))) (defmacro if-let* (varlist then &rest else) - "Bind variables according to VARLIST and eval THEN or ELSE. + "Bind variables according to VARLIST and evaluate THEN or ELSE. This is like `if-let' but doesn't handle a VARLIST of the form \(SYMBOL SOMETHING) specially." (declare (indent 2) @@ -136,14 +136,14 @@ This is like `if-let' but doesn't handle a VARLIST of the form `(let* () ,then))) (defmacro when-let* (varlist &rest body) - "Bind variables according to VARLIST and conditionally eval BODY. + "Bind variables according to VARLIST and conditionally evaluate BODY. This is like `when-let' but doesn't handle a VARLIST of the form \(SYMBOL SOMETHING) specially." (declare (indent 1) (debug if-let*)) (list 'if-let* varlist (macroexp-progn body))) (defmacro and-let* (varlist &rest body) - "Bind variables according to VARLIST and conditionally eval BODY. + "Bind variables according to VARLIST and conditionally evaluate BODY. Like `when-let*', except if BODY is empty and all the bindings are non-nil, then the result is non-nil." (declare (indent 1) @@ -157,22 +157,20 @@ are non-nil, then the result is non-nil." `(let* () ,@(or body '(t)))))) (defmacro if-let (spec then &rest else) - "Bind variables according to SPEC and eval THEN or ELSE. -Each binding is evaluated in turn, and evaluation stops if a -binding value is nil. If all are non-nil, the value of THEN is -returned, or the last form in ELSE is returned. + "Bind variables according to SPEC and evaluate THEN or ELSE. +Evaluate each binding in turn, stopping if a binding value is nil. +If all are non-nil return the value of THEN, otherwise the last form in ELSE. -Each element of SPEC is a list (SYMBOL VALUEFORM) which binds +Each element of SPEC is a list (SYMBOL VALUEFORM) that binds SYMBOL to the value of VALUEFORM. An element can additionally be of the form (VALUEFORM), which is evaluated and checked for nil; i.e. SYMBOL can be omitted if only the test result is of interest. It can also be of the form SYMBOL, then the binding of SYMBOL is checked for nil. -As a special case, a SPEC of the form \(SYMBOL SOMETHING) is -interpreted like \((SYMBOL SOMETHING)). This exists for backward -compatibility with the old syntax that accepted only one -binding." +As a special case, interprets a SPEC of the form \(SYMBOL SOMETHING) +like \((SYMBOL SOMETHING)). This exists for backward compatibility +with an old syntax that accepted only one binding." (declare (indent 2) (debug ([&or (&rest [&or symbolp (symbolp form) (form)]) (symbolp form)] @@ -184,10 +182,9 @@ binding." (list 'if-let* spec then (macroexp-progn else))) (defmacro when-let (spec &rest body) - "Bind variables according to SPEC and conditionally eval BODY. -Each binding is evaluated in turn, and evaluation stops if a -binding value is nil. If all are non-nil, the value of the last -form in BODY is returned. + "Bind variables according to SPEC and conditionally evaluate BODY. +Evaluate each binding in turn, stopping if a binding value is nil. +If all are non-nil, return the value of the last form in BODY. The variable list SPEC is the same as in `if-let'." (declare (indent 1) (debug if-let)) commit af914fc26db273d8788e7efa57c569f0f778d037 Author: Paul Eggert Date: Sat Dec 1 13:40:13 2018 -0800 Fix infloop in GC mark_kboards Do not merge to master, as I have a more systematic fix there. * src/keyboard.c (mark_kboards): Fix infloop (Bug#33547). diff --git a/src/keyboard.c b/src/keyboard.c index 0d56ea3f7a..dccc6b7f12 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -12011,7 +12011,12 @@ mark_kboards (void) for (event = kbd_fetch_ptr; event != kbd_store_ptr; event++) { if (event == kbd_buffer + KBD_BUFFER_SIZE) - event = kbd_buffer; + { + event = kbd_buffer; + if (event == kbd_store_ptr) + break; + } + /* These two special event types has no Lisp_Objects to mark. */ if (event->kind != SELECTION_REQUEST_EVENT && event->kind != SELECTION_CLEAR_EVENT) commit 317b3547820bf2468c1c0e9b5bed1bde94aeb544 Author: Alan Third Date: Sat Dec 1 13:36:58 2018 +0000 ; Add notes about cross-compiling macOS versions diff --git a/etc/NEWS b/etc/NEWS index 399508cacc..043573e3fc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -178,6 +178,11 @@ optional argument to do so. * Changes in Emacs 26.2 on Non-Free Operating Systems +** macOS features can now be detected at run-time as well as at +build-time. See nextstep/INSTALL for details. +(This change was actually made in Emacs 26.1, but was undocumented and +not called out in its NEWS.) + * Installation Changes in Emacs 26.1 diff --git a/nextstep/INSTALL b/nextstep/INSTALL index 64f8f8fcf7..726a897c37 100644 --- a/nextstep/INSTALL +++ b/nextstep/INSTALL @@ -45,6 +45,35 @@ files will be installed under whatever 'prefix' is set to (defaults to require 'sudo' for "make install"). +Targeting different macOS versions +---------------------------------- + +The Emacs build process automatically enables or disables macOS +features according to the version of macOS it is being built on. It +is possible to override this automatic configuration if you are +targeting a different version of macOS, or wish to build one +executable that is able to enable or disable features at run-time. + +To build a version compatible with an older version of macOS use this +flag: + + -DMAC_OS_X_VERSION_MIN_REQUIRED=x + +and to build for a newer version of macOS: + + -DMAC_OS_X_VERSION_MAX_ALLOWED=x + +For example, to enable run-time checks for features available between +macOS 10.6, and 10.12 inclusive: + + ./configure --with-ns CFLAGS="-DMAC_OS_X_VERSION_MIN_REQUIRED=1060 \ + -DMAC_OS_X_VERSION_MAX_ALLOWED=101200 -g3 -O2" + +The macOS version numbers are formatted as 10x0 for macOS up to 10.10, +and 10xx00 for macOS 10.10 and above. A full list is provided in +/usr/include/AvailabilityMacros.h. + + Installation ------------ commit 4b176eb86361cff94a223225e8b852adb1accc50 Author: Alan Third Date: Sat Dec 1 13:37:37 2018 +0000 Fix macOS run-time feature check * src/nsterm.m (x_set_parent_frame) [NS_IMPL_COCOA]: Fix run-time feature check. diff --git a/src/nsterm.m b/src/nsterm.m index 948dd1da2e..893bb1b441 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -1891,7 +1891,7 @@ so some key presses (TAB) are swallowed by the system. */ [[child parentWindow] removeChildWindow:child]; #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000 #if MAC_OS_X_VERSION_MIN_REQUIRED < 101000 - if ([child respondsToSelector:@selector(setAccessibilitySubrole:)] + if ([child respondsToSelector:@selector(setAccessibilitySubrole:)]) #endif [child setAccessibilitySubrole:NSAccessibilityStandardWindowSubrole]; #endif @@ -1905,7 +1905,7 @@ so some key presses (TAB) are swallowed by the system. */ ordered: NSWindowAbove]; #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000 #if MAC_OS_X_VERSION_MIN_REQUIRED < 101000 - if ([child respondsToSelector:@selector(setAccessibilitySubrole:)] + if ([child respondsToSelector:@selector(setAccessibilitySubrole:)]) #endif [child setAccessibilitySubrole:NSAccessibilityFloatingWindowSubrole]; #endif commit 070ef95c1007cb3d54e04bc337d9fb5463912cc1 Author: Stefan Monnier Date: Sat Dec 1 09:43:37 2018 -0500 * lisp/calendar/holidays.el: Use lexical-binding Remove redundant :group arguments. (holiday-sexp): Bind 'year' and 'date' dynamically for 'sexp' and 'string'. diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el index f38308378d..62b9d778e2 100644 --- a/lisp/calendar/holidays.el +++ b/lisp/calendar/holidays.el @@ -1,4 +1,4 @@ -;;; holidays.el --- holiday functions for the calendar package +;;; holidays.el --- holiday functions for the calendar package -*- lexical-binding:t -*- ;; Copyright (C) 1989-1990, 1992-1994, 1997, 2001-2018 Free Software ;; Foundation, Inc. @@ -64,8 +64,7 @@ (holiday-float 11 4 4 "Thanksgiving"))) "General holidays. Default value is for the United States. See the documentation for `calendar-holidays' for details." - :type 'sexp - :group 'holidays) + :type 'sexp) ;;;###autoload (put 'holiday-general-holidays 'risky-local-variable t) @@ -86,8 +85,7 @@ See the documentation for `calendar-holidays' for details." "Oriental holidays. See the documentation for `calendar-holidays' for details." :version "23.1" ; added more holidays - :type 'sexp - :group 'holidays) + :type 'sexp) ;;;###autoload (put 'holiday-oriental-holidays 'risky-local-variable t) @@ -95,8 +93,7 @@ See the documentation for `calendar-holidays' for details." (defcustom holiday-local-holidays nil "Local holidays. See the documentation for `calendar-holidays' for details." - :type 'sexp - :group 'holidays) + :type 'sexp) ;;;###autoload (put 'holiday-local-holidays 'risky-local-variable t) @@ -104,8 +101,7 @@ See the documentation for `calendar-holidays' for details." (defcustom holiday-other-holidays nil "User defined holidays. See the documentation for `calendar-holidays' for details." - :type 'sexp - :group 'holidays) + :type 'sexp) ;;;###autoload (put 'holiday-other-holidays 'risky-local-variable t) @@ -122,8 +118,8 @@ See the documentation for `calendar-holidays' for details." "Jewish holidays. See the documentation for `calendar-holidays' for details." :type 'sexp - :version "23.1" ; removed dependency on hebrew-holidays-N - :group 'holidays) + :version "23.1") ; removed dependency on hebrew-holidays-N + ;;;###autoload (put 'holiday-hebrew-holidays 'risky-local-variable t) @@ -141,8 +137,7 @@ See the documentation for `calendar-holidays' for details." (holiday-advent 0 "Advent"))))) "Christian holidays. See the documentation for `calendar-holidays' for details." - :type 'sexp - :group 'holidays) + :type 'sexp) ;;;###autoload (put 'holiday-christian-holidays 'risky-local-variable t) @@ -162,8 +157,7 @@ See the documentation for `calendar-holidays' for details." (holiday-islamic 12 10 "Id-al-Adha"))))) "Islamic holidays. See the documentation for `calendar-holidays' for details." - :type 'sexp - :group 'holidays) + :type 'sexp) ;;;###autoload (put 'holiday-islamic-holidays 'risky-local-variable t) @@ -183,8 +177,7 @@ See the documentation for `calendar-holidays' for details." (holiday-fixed 11 28 "Ascension of `Abdu’l-Bahá"))))) "Bahá’í holidays. See the documentation for `calendar-holidays' for details." - :type 'sexp - :group 'holidays) + :type 'sexp) ;;;###autoload (put 'holiday-bahai-holidays 'risky-local-variable t) @@ -204,8 +197,7 @@ See the documentation for `calendar-holidays' for details." calendar-daylight-time-zone-name))))) "Sun-related holidays. See the documentation for `calendar-holidays' for details." - :type 'sexp - :group 'holidays) + :type 'sexp) ;;;###autoload (put 'holiday-solar-holidays 'risky-local-variable t) @@ -323,8 +315,7 @@ you've written to return a (possibly empty) list of the relevant VISIBLE dates with descriptive strings such as (((2 6 1989) \"New Moon\") ((2 12 1989) \"First Quarter Moon\") ... )." - :type 'sexp - :group 'holidays) + :type 'sexp) ;;;###autoload (put 'calendar-holidays 'risky-local-variable t) @@ -336,14 +327,14 @@ with descriptive strings such as (defun calendar-holiday-list () "Form the list of holidays that occur on dates in the calendar window. The holidays are those in the list `calendar-holidays'." - (let (res h err) + (let (res h) (sort (dolist (p calendar-holidays res) (if (setq h (if calendar-debug-sexp (let ((debug-on-error t)) - (eval p)) + (eval p t)) (condition-case err - (eval p) + (eval p t) (error (display-warning 'holidays @@ -470,7 +461,7 @@ The optional LABEL is used to label the buffer created." (choice (capitalize (completing-read "List (TAB for choices): " lists nil t))) (which (if (string-equal choice "Ask") - (eval (read-variable "Enter list name: ")) + (symbol-value (read-variable "Enter list name: ")) (cdr (assoc choice lists)))) (name (if (string-equal choice "Equinoxes/Solstices") choice @@ -536,7 +527,7 @@ strings describing those holidays that apply on DATE, or nil if none do." 3))) holidays in-range a) (calendar-increment-month displayed-month displayed-year 1) - (dotimes (_idummy number-of-intervals) + (dotimes (_ number-of-intervals) (setq holidays (append holidays (calendar-holiday-list))) (calendar-increment-month displayed-month displayed-year 3)) (dolist (hol holidays) @@ -690,19 +681,19 @@ the holiday description of `date'. If `date' is visible in the calendar window, the holiday STRING is on that date. If date is nil, or if the date is not visible, there is no holiday." (let ((m displayed-month) - (y displayed-year) - year date) + (y displayed-year)) (calendar-increment-month m y -1) (holiday-filter-visible-calendar - (list - (progn - (setq year y - date (eval sexp)) - (list date (if date (eval string)))) - (progn - (setq year (1+ y) - date (eval sexp)) - (list date (if date (eval string)))))))) + (calendar-dlet* (year date) + (list + (progn + (setq year y + date (eval sexp t)) + (list date (if date (eval string t)))) + (progn + (setq year (1+ y) + date (eval sexp t)) + (list date (if date (eval string t))))))))) (defun holiday-advent (&optional n string) commit c03574b477f7af6919797fde3e9410901c7675e1 Author: Stefan Monnier Date: Sat Dec 1 09:32:57 2018 -0500 * etc/NEWS-*: Fix capitalization of "Emacs" diff --git a/etc/NEWS.1-17 b/etc/NEWS.1-17 index 63ef9a3855..f978a47480 100644 --- a/etc/NEWS.1-17 +++ b/etc/NEWS.1-17 @@ -4,7 +4,7 @@ Copyright (C) 1985-1986, 2006-2018 Free Software Foundation, Inc. See the end of the file for license conditions. -This file is about changes in emacs versions 1 through 17. +This file is about changes in Emacs versions 1 through 17. diff --git a/etc/NEWS.18 b/etc/NEWS.18 index 153c2f7a0a..437f7c7e04 100644 --- a/etc/NEWS.18 +++ b/etc/NEWS.18 @@ -4,7 +4,7 @@ Copyright (C) 1988, 2006-2018 Free Software Foundation, Inc. See the end of the file for license conditions. -This file is about changes in emacs version 18. +This file is about changes in Emacs version 18. diff --git a/etc/NEWS.19 b/etc/NEWS.19 index 12432eacf7..f7f5a8ad22 100644 --- a/etc/NEWS.19 +++ b/etc/NEWS.19 @@ -4,7 +4,7 @@ Copyright (C) 1993-1995, 2001, 2006-2018 Free Software Foundation, Inc. See the end of the file for license conditions. -This file is about changes in emacs versions 19. +This file is about changes in Emacs versions 19. diff --git a/etc/NEWS.20 b/etc/NEWS.20 index 31e640fa94..956e900c28 100644 --- a/etc/NEWS.20 +++ b/etc/NEWS.20 @@ -7,7 +7,7 @@ See the end of the file for license conditions. Please send Emacs bug reports to bug-gnu-emacs@gnu.org. If possible, use M-x report-emacs-bug. -This file is about changes in emacs version 20. +This file is about changes in Emacs version 20. diff --git a/etc/NEWS.21 b/etc/NEWS.21 index ea4f4212ee..4a22109e0b 100644 --- a/etc/NEWS.21 +++ b/etc/NEWS.21 @@ -4,7 +4,7 @@ Copyright (C) 2000-2018 Free Software Foundation, Inc. See the end of the file for license conditions. -This file is about changes in emacs version 21. +This file is about changes in Emacs version 21. commit a8d178816a8926616736f25f0cc2e7aad38ceaf7 Author: Glenn Morris Date: Sat Dec 1 07:23:22 2018 -0500 ; Auto-commit of loaddefs files. diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index a8b206fe3a..f90815dc9b 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -2289,7 +2289,7 @@ a reflection. (define-key ctl-x-r-map "M" 'bookmark-set-no-overwrite) (define-key ctl-x-r-map "l" 'bookmark-bmenu-list) -(defvar bookmark-map (let ((map (make-sparse-keymap))) (define-key map "x" 'bookmark-set) (define-key map "m" 'bookmark-set) (define-key map "M" 'bookmark-set-no-overwrite) (define-key map "j" 'bookmark-jump) (define-key map "g" 'bookmark-jump) (define-key map "o" 'bookmark-jump-other-window) (define-key map "i" 'bookmark-insert) (define-key map "e" 'edit-bookmarks) (define-key map "f" 'bookmark-insert-location) (define-key map "r" 'bookmark-rename) (define-key map "d" 'bookmark-delete) (define-key map "l" 'bookmark-load) (define-key map "w" 'bookmark-write) (define-key map "s" 'bookmark-save) map) "\ +(defvar bookmark-map (let ((map (make-sparse-keymap))) (define-key map "x" 'bookmark-set) (define-key map "m" 'bookmark-set) (define-key map "M" 'bookmark-set-no-overwrite) (define-key map "j" 'bookmark-jump) (define-key map "g" 'bookmark-jump) (define-key map "o" 'bookmark-jump-other-window) (define-key map "5" 'bookmark-jump-other-frame) (define-key map "i" 'bookmark-insert) (define-key map "e" 'edit-bookmarks) (define-key map "f" 'bookmark-insert-location) (define-key map "r" 'bookmark-rename) (define-key map "d" 'bookmark-delete) (define-key map "l" 'bookmark-load) (define-key map "w" 'bookmark-write) (define-key map "s" 'bookmark-save) map) "\ Keymap containing bindings to bookmark functions. It is not bound to any key by default: to bind it so that you have a bookmark prefix, just use `global-set-key' and bind a @@ -2380,6 +2380,11 @@ Jump to BOOKMARK in another window. See `bookmark-jump' for more. \(fn BOOKMARK)" t nil) +(autoload 'bookmark-jump-other-frame "bookmark" "\ +Jump to BOOKMARK in another frame. See `bookmark-jump' for more. + +\(fn BOOKMARK)" t nil) + (autoload 'bookmark-relocate "bookmark" "\ Relocate BOOKMARK-NAME to another file, reading file name with minibuffer. @@ -3086,7 +3091,7 @@ and corresponding effects. \(fn &optional ARG)" nil nil) -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bytecomp" '("batch-byte-compile-file" "byte-" "displaying-byte-compile-warnings" "emacs-lisp-file-regexp" "no-byte-compile"))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bytecomp" '("batch-byte-compile-file" "byte-" "displaying-byte-compile-warnings" "emacs-lisp-" "no-byte-compile"))) ;;;*** @@ -4627,9 +4632,8 @@ a separate buffer. (autoload 'checkdoc-continue "checkdoc" "\ Find the next doc string in the current buffer which has a style error. -Prefix argument TAKE-NOTES means to continue through the whole buffer and -save warnings in a separate buffer. Second optional argument START-POINT -is the starting location. If this is nil, `point-min' is used instead. +Prefix argument TAKE-NOTES means to continue through the whole +buffer and save warnings in a separate buffer. \(fn &optional TAKE-NOTES)" t nil) @@ -7064,13 +7068,22 @@ The position information includes POS; the total size of BUFFER; the region limits, if narrowed; the column number; and the horizontal scroll amount, if the buffer is horizontally scrolled. -The character information includes the character code; charset and -code points in it; syntax; category; how the character is encoded in -BUFFER and in BUFFER's file; character composition information (if -relevant); the font and font glyphs used to display the character; -the character's canonical name and other properties defined by the -Unicode Data Base; and widgets, buttons, overlays, and text properties -relevant to POS. +The character information includes: + its codepoint; + its charset (see `char-charset'), overridden by the `charset' text + property at POS, if any; + the codepoint of the character in the above charset; + the character's script (as defined by `char-script-table') + the character's syntax, as produced by `syntax-after' + and `internal-describe-syntax-value'; + its category (see `char-category-set' and `describe-char-categories'); + how to input the character using the keyboard and input methods; + how the character is encoded in BUFFER and in BUFFER's file; + the font and font glyphs used to display the character; + the composition information for displaying the character (if relevant); + the character's canonical name and other properties defined by the + Unicode Data Base; + and widgets, buttons, overlays, and text properties relevant to POS. \(fn POS &optional BUFFER)" t nil) @@ -9393,6 +9406,7 @@ MERGE-AUTOSTORE-DIR is the directory in which to store merged files. (autoload 'ediff-windows-wordwise "ediff" "\ Compare WIND-A and WIND-B, which are selected by clicking, wordwise. +This compares the portions of text visible in each of the two windows. With prefix argument, DUMB-MODE, or on a non-windowing display, works as follows: If WIND-A is nil, use selected window. @@ -9404,6 +9418,7 @@ arguments after setting up the Ediff buffers. (autoload 'ediff-windows-linewise "ediff" "\ Compare WIND-A and WIND-B, which are selected by clicking, linewise. +This compares the portions of text visible in each of the two windows. With prefix argument, DUMB-MODE, or on a non-windowing display, works as follows: If WIND-A is nil, use selected window. @@ -9417,8 +9432,8 @@ arguments after setting up the Ediff buffers. Run Ediff on a pair of regions in specified buffers. BUFFER-A and BUFFER-B are the buffers to be compared. Regions (i.e., point and mark) can be set in advance or marked interactively. -This function is effective only for relatively small regions, up to 200 -lines. For large regions, use `ediff-regions-linewise'. +This function might be slow for large regions. If you find it slow, +use `ediff-regions-linewise' instead. STARTUP-HOOKS is a list of functions that Emacs calls without arguments after setting up the Ediff buffers. @@ -25052,34 +25067,45 @@ variable name being but a special case of it). (function-put 'pcase-lambda 'lisp-indent-function 'defun) (autoload 'pcase-let* "pcase" "\ -Like `let*' but where you can use `pcase' patterns for bindings. -BODY should be an expression, and BINDINGS should be a list of bindings -of the form (PATTERN EXP). -See `pcase-let' for discussion of how PATTERN is matched. +Like `let*', but supports destructuring BINDINGS using `pcase' patterns. +As with `pcase-let', BINDINGS are of the form (PATTERN EXP), but the +EXP in each binding in BINDINGS can use the results of the destructuring +bindings that precede it in BINDINGS' order. + +Each EXP should match (i.e. be of compatible structure) to its +respective PATTERN; a mismatch may signal an error or may go +undetected, binding variables to arbitrary values, such as nil. \(fn BINDINGS &rest BODY)" nil t) (function-put 'pcase-let* 'lisp-indent-function '1) (autoload 'pcase-let "pcase" "\ -Like `let' but where you can use `pcase' patterns for bindings. -BODY should be a list of expressions, and BINDINGS should be a list of bindings -of the form (PATTERN EXP). -The PATTERNs are only used to extract data, so the code does not test -whether the data does match the corresponding patterns: a mismatch -may signal an error or may go undetected, binding variables to arbitrary -values, such as nil. +Like `let', but supports destructuring BINDINGS using `pcase' patterns. +BODY should be a list of expressions, and BINDINGS should be a list of +bindings of the form (PATTERN EXP). +All EXPs are evaluated first, and then used to perform destructuring +bindings by matching each EXP against its respective PATTERN. Then +BODY is evaluated with those bindings in effect. + +Each EXP should match (i.e. be of compatible structure) to its +respective PATTERN; a mismatch may signal an error or may go +undetected, binding variables to arbitrary values, such as nil. \(fn BINDINGS &rest BODY)" nil t) (function-put 'pcase-let 'lisp-indent-function '1) (autoload 'pcase-dolist "pcase" "\ -Superset of `dolist' where the VAR binding can be a `pcase' PATTERN. -More specifically, this is just a shorthand for the following combination -of `dolist' and `pcase-let': - - (dolist (x LIST) (pcase-let ((PATTERN x)) BODY...)) +Eval BODY once for each set of bindings defined by PATTERN and LIST elements. +PATTERN should be a `pcase' pattern describing the structure of +LIST elements, and LIST is a list of objects that match PATTERN, +i.e. have a structure that is compatible with PATTERN. +For each element of LIST, this macro binds the variables in +PATTERN to the corresponding subfields of the LIST element, and +then evaluates BODY with these bindings in effect. The +destructuring bindings of variables in PATTERN to the subfields +of the elements of LIST is performed as if by `pcase-let'. \(fn (PATTERN LIST) BODY...)" nil t) @@ -34501,8 +34527,10 @@ MENU is like the MENU argument to `x-popup-menu': either a keymap or an alist of alists. DEFAULT-ITEM, if non-nil, specifies an initial default choice. Its value should be an event that has a binding in MENU. +NO-EXECUTE, if non-nil, means to return the command the user selects +instead of executing it. -\(fn MENU &optional IN-POPUP DEFAULT-ITEM)" nil nil) +\(fn MENU &optional IN-POPUP DEFAULT-ITEM NO-EXECUTE)" nil nil) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tmm" '("tmm-"))) @@ -34849,6 +34877,14 @@ Reenable Ange-FTP, when Tramp is unloaded. ;;;*** +;;;### (autoloads nil "tramp-rclone" "net/tramp-rclone.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from net/tramp-rclone.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-rclone" '("tramp-rclone-"))) + +;;;*** + ;;;### (autoloads nil "tramp-sh" "net/tramp-sh.el" (0 0 0 0)) ;;; Generated autoloads from net/tramp-sh.el @@ -38529,7 +38565,8 @@ With no prefix argument, or with prefix argument equal to zero, \"left\" is relative to the position of point in the window; otherwise it is relative to the top edge (for positive ARG) or the bottom edge \(for negative ARG) of the current window. -If no window is at the desired location, an error is signaled. +If no window is at the desired location, an error is signaled +unless `windmove-create-window' is non-nil and a new window is created. \(fn &optional ARG)" t nil) @@ -38539,7 +38576,8 @@ With no prefix argument, or with prefix argument equal to zero, \"up\" is relative to the position of point in the window; otherwise it is relative to the left edge (for positive ARG) or the right edge (for negative ARG) of the current window. -If no window is at the desired location, an error is signaled. +If no window is at the desired location, an error is signaled +unless `windmove-create-window' is non-nil and a new window is created. \(fn &optional ARG)" t nil) @@ -38549,7 +38587,8 @@ With no prefix argument, or with prefix argument equal to zero, \"right\" is relative to the position of point in the window; otherwise it is relative to the top edge (for positive ARG) or the bottom edge (for negative ARG) of the current window. -If no window is at the desired location, an error is signaled. +If no window is at the desired location, an error is signaled +unless `windmove-create-window' is non-nil and a new window is created. \(fn &optional ARG)" t nil) @@ -38559,7 +38598,8 @@ With no prefix argument, or with prefix argument equal to zero, \"down\" is relative to the position of point in the window; otherwise it is relative to the left edge (for positive ARG) or the right edge \(for negative ARG) of the current window. -If no window is at the desired location, an error is signaled. +If no window is at the desired location, an error is signaled +unless `windmove-create-window' is non-nil and a new window is created. \(fn &optional ARG)" t nil) @@ -38571,6 +38611,81 @@ Default value of MODIFIERS is `shift'. \(fn &optional MODIFIERS)" t nil) +(autoload 'windmove-display-left "windmove" "\ +Display the next buffer in window to the left of the current one. +See the logic of the prefix ARG in `windmove-display-in-direction'. + +\(fn &optional ARG)" t nil) + +(autoload 'windmove-display-up "windmove" "\ +Display the next buffer in window above the current one. +See the logic of the prefix ARG in `windmove-display-in-direction'. + +\(fn &optional ARG)" t nil) + +(autoload 'windmove-display-right "windmove" "\ +Display the next buffer in window to the right of the current one. +See the logic of the prefix ARG in `windmove-display-in-direction'. + +\(fn &optional ARG)" t nil) + +(autoload 'windmove-display-down "windmove" "\ +Display the next buffer in window below the current one. +See the logic of the prefix ARG in `windmove-display-in-direction'. + +\(fn &optional ARG)" t nil) + +(autoload 'windmove-display-same-window "windmove" "\ +Display the next buffer in the same window. + +\(fn &optional ARG)" t nil) + +(autoload 'windmove-display-default-keybindings "windmove" "\ +Set up keybindings for directional buffer display. +Keys are bound to commands that display the next buffer in the specified +direction. Keybindings are of the form MODIFIERS-{left,right,up,down}, +where MODIFIERS is either a list of modifiers or a single modifier. +Default value of MODIFIERS is `shift-meta'. + +\(fn &optional MODIFIERS)" t nil) + +(autoload 'windmove-delete-left "windmove" "\ +Delete the window to the left of the current one. +If prefix ARG is `C-u', delete the selected window and +select the window that was to the left of the current one. + +\(fn &optional ARG)" t nil) + +(autoload 'windmove-delete-up "windmove" "\ +Delete the window above the current one. +If prefix ARG is `C-u', delete the selected window and +select the window that was above the current one. + +\(fn &optional ARG)" t nil) + +(autoload 'windmove-delete-right "windmove" "\ +Delete the window to the right of the current one. +If prefix ARG is `C-u', delete the selected window and +select the window that was to the right of the current one. + +\(fn &optional ARG)" t nil) + +(autoload 'windmove-delete-down "windmove" "\ +Delete the window below the current one. +If prefix ARG is `C-u', delete the selected window and +select the window that was below the current one. + +\(fn &optional ARG)" t nil) + +(autoload 'windmove-delete-default-keybindings "windmove" "\ +Set up keybindings for directional window deletion. +Keys are bound to commands that delete windows in the specified +direction. Keybindings are of the form PREFIX MODIFIERS-{left,right,up,down}, +where PREFIX is a prefix key and MODIFIERS is either a list of modifiers or +a single modifier. Default value of PREFIX is `C-x' and MODIFIERS is `shift'. + +\(fn &optional PREFIX MODIFIERS)" t nil) + (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "windmove" '("windmove-"))) ;;;*** commit 42320cc8ca772dbd669bc58b78aa493ddb5f5990 Author: Glenn Morris Date: Sat Dec 1 06:23:51 2018 -0500 ; Auto-commit of loaddefs files. diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 56a6283f70..945bc95439 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -4582,9 +4582,8 @@ a separate buffer. (autoload 'checkdoc-continue "checkdoc" "\ Find the next doc string in the current buffer which has a style error. -Prefix argument TAKE-NOTES means to continue through the whole buffer and -save warnings in a separate buffer. Second optional argument START-POINT -is the starting location. If this is nil, `point-min' is used instead. +Prefix argument TAKE-NOTES means to continue through the whole +buffer and save warnings in a separate buffer. \(fn &optional TAKE-NOTES)" t nil) @@ -6969,13 +6968,22 @@ The position information includes POS; the total size of BUFFER; the region limits, if narrowed; the column number; and the horizontal scroll amount, if the buffer is horizontally scrolled. -The character information includes the character code; charset and -code points in it; syntax; category; how the character is encoded in -BUFFER and in BUFFER's file; character composition information (if -relevant); the font and font glyphs used to display the character; -the character's canonical name and other properties defined by the -Unicode Data Base; and widgets, buttons, overlays, and text properties -relevant to POS. +The character information includes: + its codepoint; + its charset (see `char-charset'), overridden by the `charset' text + property at POS, if any; + the codepoint of the character in the above charset; + the character's script (as defined by `char-script-table') + the character's syntax, as produced by `syntax-after' + and `internal-describe-syntax-value'; + its category (see `char-category-set' and `describe-char-categories'); + how to input the character using the keyboard and input methods; + how the character is encoded in BUFFER and in BUFFER's file; + the font and font glyphs used to display the character; + the composition information for displaying the character (if relevant); + the character's canonical name and other properties defined by the + Unicode Data Base; + and widgets, buttons, overlays, and text properties relevant to POS. \(fn POS &optional BUFFER)" t nil) @@ -9283,6 +9291,7 @@ MERGE-AUTOSTORE-DIR is the directory in which to store merged files. (autoload 'ediff-windows-wordwise "ediff" "\ Compare WIND-A and WIND-B, which are selected by clicking, wordwise. +This compares the portions of text visible in each of the two windows. With prefix argument, DUMB-MODE, or on a non-windowing display, works as follows: If WIND-A is nil, use selected window. @@ -9294,6 +9303,7 @@ arguments after setting up the Ediff buffers. (autoload 'ediff-windows-linewise "ediff" "\ Compare WIND-A and WIND-B, which are selected by clicking, linewise. +This compares the portions of text visible in each of the two windows. With prefix argument, DUMB-MODE, or on a non-windowing display, works as follows: If WIND-A is nil, use selected window. @@ -9307,8 +9317,8 @@ arguments after setting up the Ediff buffers. Run Ediff on a pair of regions in specified buffers. BUFFER-A and BUFFER-B are the buffers to be compared. Regions (i.e., point and mark) can be set in advance or marked interactively. -This function is effective only for relatively small regions, up to 200 -lines. For large regions, use `ediff-regions-linewise'. +This function might be slow for large regions. If you find it slow, +use `ediff-regions-linewise' instead. STARTUP-HOOKS is a list of functions that Emacs calls without arguments after setting up the Ediff buffers. @@ -24950,34 +24960,45 @@ variable name being but a special case of it). (function-put 'pcase-lambda 'lisp-indent-function 'defun) (autoload 'pcase-let* "pcase" "\ -Like `let*' but where you can use `pcase' patterns for bindings. -BODY should be an expression, and BINDINGS should be a list of bindings -of the form (PATTERN EXP). -See `pcase-let' for discussion of how PATTERN is matched. +Like `let*', but supports destructuring BINDINGS using `pcase' patterns. +As with `pcase-let', BINDINGS are of the form (PATTERN EXP), but the +EXP in each binding in BINDINGS can use the results of the destructuring +bindings that precede it in BINDINGS' order. + +Each EXP should match (i.e. be of compatible structure) to its +respective PATTERN; a mismatch may signal an error or may go +undetected, binding variables to arbitrary values, such as nil. \(fn BINDINGS &rest BODY)" nil t) (function-put 'pcase-let* 'lisp-indent-function '1) (autoload 'pcase-let "pcase" "\ -Like `let' but where you can use `pcase' patterns for bindings. -BODY should be a list of expressions, and BINDINGS should be a list of bindings -of the form (PATTERN EXP). -The PATTERNs are only used to extract data, so the code does not test -whether the data does match the corresponding patterns: a mismatch -may signal an error or may go undetected, binding variables to arbitrary -values, such as nil. +Like `let', but supports destructuring BINDINGS using `pcase' patterns. +BODY should be a list of expressions, and BINDINGS should be a list of +bindings of the form (PATTERN EXP). +All EXPs are evaluated first, and then used to perform destructuring +bindings by matching each EXP against its respective PATTERN. Then +BODY is evaluated with those bindings in effect. + +Each EXP should match (i.e. be of compatible structure) to its +respective PATTERN; a mismatch may signal an error or may go +undetected, binding variables to arbitrary values, such as nil. \(fn BINDINGS &rest BODY)" nil t) (function-put 'pcase-let 'lisp-indent-function '1) (autoload 'pcase-dolist "pcase" "\ -Superset of `dolist' where the VAR binding can be a `pcase' PATTERN. -More specifically, this is just a shorthand for the following combination -of `dolist' and `pcase-let': - - (dolist (x LIST) (pcase-let ((PATTERN x)) BODY...)) +Eval BODY once for each set of bindings defined by PATTERN and LIST elements. +PATTERN should be a `pcase' pattern describing the structure of +LIST elements, and LIST is a list of objects that match PATTERN, +i.e. have a structure that is compatible with PATTERN. +For each element of LIST, this macro binds the variables in +PATTERN to the corresponding subfields of the LIST element, and +then evaluates BODY with these bindings in effect. The +destructuring bindings of variables in PATTERN to the subfields +of the elements of LIST is performed as if by `pcase-let'. \(fn (PATTERN LIST) BODY...)" nil t) commit e06562ce7c164fd1f1b93154e34e6edab004719b Author: Eli Zaretskii Date: Sat Dec 1 11:30:41 2018 +0200 Fix "M-x man" when there's no 'man' program on PATH * lisp/man.el (Man-bgproc-sentinel): Make sure the process buffer is not read-only when inserting a message into it. (Bug#33510) diff --git a/lisp/man.el b/lisp/man.el index c62a61c708..3a5fd5d21c 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -1378,7 +1378,8 @@ manpage command." (with-current-buffer Man-buffer (save-excursion - (let ((case-fold-search nil)) + (let ((case-fold-search nil) + (inhibit-read-only t)) (goto-char (point-min)) (cond ((or (looking-at "No \\(manual \\)*entry for") (looking-at "[^\n]*: nothing appropriate$")) commit 7d9fa89fb3f6db0bdc3960bbbf6c0cf34c98d1ca Author: Paul Eggert Date: Fri Nov 30 14:22:54 2018 -0800 Fix infloop in GC mark_kboards * src/keyboard.c (KBD_BUFFER_SIZE): Now a constant, not a macro. (kbd_fetch_ptr, kbd_store_ptr): These now always point somewhere into kbd_buffer, instead of sometimes pointing just past the end which led to serious bugs (Bug#33547). All uses changed. (kbd_store_ptr): No longer volatile. This variable has not been accessed by a signal handler for some time, it seems. (next_kbd_event, prev_kbd_event): New functions. (kbd_buffer_nr_stored, process_special_events): Simplify. diff --git a/src/keyboard.c b/src/keyboard.c index be727a6549..59acb2dd08 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -92,7 +92,7 @@ volatile int interrupt_input_blocked; The maybe_quit function checks this. */ volatile bool pending_signals; -#define KBD_BUFFER_SIZE 4096 +enum { KBD_BUFFER_SIZE = 4096 }; KBOARD *initial_kboard; KBOARD *current_kboard; @@ -286,15 +286,11 @@ static bool input_was_pending; static union buffered_input_event kbd_buffer[KBD_BUFFER_SIZE]; /* Pointer to next available character in kbd_buffer. - If kbd_fetch_ptr == kbd_store_ptr, the buffer is empty. - This may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the - next available char is in kbd_buffer[0]. */ + If kbd_fetch_ptr == kbd_store_ptr, the buffer is empty. */ static union buffered_input_event *kbd_fetch_ptr; -/* Pointer to next place to store character in kbd_buffer. This - may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the next - character should go in kbd_buffer[0]. */ -static union buffered_input_event *volatile kbd_store_ptr; +/* Pointer to next place to store character in kbd_buffer. */ +static union buffered_input_event *kbd_store_ptr; /* The above pair of variables forms a "queue empty" flag. When we enqueue a non-hook event, we increment kbd_store_ptr. When we @@ -302,8 +298,7 @@ static union buffered_input_event *volatile kbd_store_ptr; there is input available if the two pointers are not equal. Why not just have a flag set and cleared by the enqueuing and - dequeuing functions? Such a flag could be screwed up by interrupts - at inopportune times. */ + dequeuing functions? The code is a bit simpler this way. */ static void recursive_edit_unwind (Lisp_Object buffer); static Lisp_Object command_loop (void); @@ -375,6 +370,20 @@ static void deliver_user_signal (int); static char *find_user_signal_name (int); static void store_user_signal_events (void); +/* Advance or retreat a buffered input event pointer. */ + +static union buffered_input_event * +next_kbd_event (union buffered_input_event *ptr) +{ + return ptr == kbd_buffer + KBD_BUFFER_SIZE - 1 ? kbd_buffer : ptr + 1; +} + +static union buffered_input_event * +prev_kbd_event (union buffered_input_event *ptr) +{ + return ptr == kbd_buffer ? kbd_buffer + KBD_BUFFER_SIZE - 1 : ptr - 1; +} + /* Like EVENT_START, but assume EVENT is an event. This pacifies gcc -Wnull-dereference, which might otherwise complain about earlier checks that EVENT is indeed an event. */ @@ -3338,8 +3347,6 @@ readable_events (int flags) do { - if (event == kbd_buffer + KBD_BUFFER_SIZE) - event = kbd_buffer; if (!( #ifdef USE_TOOLKIT_SCROLL_BARS (flags & READABLE_EVENTS_FILTER_EVENTS) && @@ -3356,7 +3363,7 @@ readable_events (int flags) && !((flags & READABLE_EVENTS_FILTER_EVENTS) && event->kind == BUFFER_SWITCH_EVENT)) return 1; - event++; + event = next_kbd_event (event); } while (event != kbd_store_ptr); } @@ -3410,12 +3417,8 @@ event_to_kboard (struct input_event *event) static int kbd_buffer_nr_stored (void) { - return kbd_fetch_ptr == kbd_store_ptr - ? 0 - : (kbd_fetch_ptr < kbd_store_ptr - ? kbd_store_ptr - kbd_fetch_ptr - : ((kbd_buffer + KBD_BUFFER_SIZE) - kbd_fetch_ptr - + (kbd_store_ptr - kbd_buffer))); + int n = kbd_store_ptr - kbd_fetch_ptr; + return n + (n < 0 ? KBD_BUFFER_SIZE : 0); } #endif /* Store an event obtained at interrupt level into kbd_buffer, fifo */ @@ -3466,12 +3469,10 @@ kbd_buffer_store_buffered_event (union buffered_input_event *event, (kb, list2 (make_lispy_switch_frame (event->ie.frame_or_window), make_fixnum (c))); kb->kbd_queue_has_data = true; - union buffered_input_event *sp; - for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++) - { - if (sp == kbd_buffer + KBD_BUFFER_SIZE) - sp = kbd_buffer; + for (union buffered_input_event *sp = kbd_fetch_ptr; + sp != kbd_store_ptr; sp = next_kbd_event (sp)) + { if (event_to_kboard (&sp->ie) == kb) { sp->ie.kind = NO_EVENT; @@ -3516,22 +3517,18 @@ kbd_buffer_store_buffered_event (union buffered_input_event *event, Just ignore the second one. */ else if (event->kind == BUFFER_SWITCH_EVENT && kbd_fetch_ptr != kbd_store_ptr - && ((kbd_store_ptr == kbd_buffer - ? kbd_buffer + KBD_BUFFER_SIZE - 1 - : kbd_store_ptr - 1)->kind) == BUFFER_SWITCH_EVENT) + && prev_kbd_event (kbd_store_ptr)->kind == BUFFER_SWITCH_EVENT) return; - if (kbd_store_ptr - kbd_buffer == KBD_BUFFER_SIZE) - kbd_store_ptr = kbd_buffer; - /* Don't let the very last slot in the buffer become full, since that would make the two pointers equal, and that is indistinguishable from an empty buffer. Discard the event if it would fill the last slot. */ - if (kbd_fetch_ptr - 1 != kbd_store_ptr) + union buffered_input_event *next_slot = next_kbd_event (kbd_store_ptr); + if (kbd_fetch_ptr != next_slot) { *kbd_store_ptr = *event; - ++kbd_store_ptr; + kbd_store_ptr = next_slot; #ifdef subprocesses if (kbd_buffer_nr_stored () > KBD_BUFFER_SIZE / 2 && ! kbd_on_hold_p ()) @@ -3574,11 +3571,8 @@ kbd_buffer_store_buffered_event (union buffered_input_event *event, void kbd_buffer_unget_event (struct selection_input_event *event) { - if (kbd_fetch_ptr == kbd_buffer) - kbd_fetch_ptr = kbd_buffer + KBD_BUFFER_SIZE; - /* Don't let the very last slot in the buffer become full, */ - union buffered_input_event *kp = kbd_fetch_ptr - 1; + union buffered_input_event *kp = prev_kbd_event (kbd_fetch_ptr); if (kp != kbd_store_ptr) { kp->sie = *event; @@ -3666,12 +3660,9 @@ kbd_buffer_store_help_event (Lisp_Object frame, Lisp_Object help) void discard_mouse_events (void) { - union buffered_input_event *sp; - for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++) + for (union buffered_input_event *sp = kbd_fetch_ptr; + sp != kbd_store_ptr; sp = next_kbd_event (sp)) { - if (sp == kbd_buffer + KBD_BUFFER_SIZE) - sp = kbd_buffer; - if (sp->kind == MOUSE_CLICK_EVENT || sp->kind == WHEEL_EVENT || sp->kind == HORIZ_WHEEL_EVENT @@ -3696,18 +3687,13 @@ discard_mouse_events (void) bool kbd_buffer_events_waiting (void) { - union buffered_input_event *sp; - - for (sp = kbd_fetch_ptr; - sp != kbd_store_ptr && sp->kind == NO_EVENT; - ++sp) - { - if (sp == kbd_buffer + KBD_BUFFER_SIZE) - sp = kbd_buffer; - } - - kbd_fetch_ptr = sp; - return sp != kbd_store_ptr && sp->kind != NO_EVENT; + for (union buffered_input_event *sp = kbd_fetch_ptr; + ; sp = next_kbd_event (sp)) + if (sp == kbd_store_ptr || sp->kind != NO_EVENT) + { + kbd_fetch_ptr = sp; + return sp != kbd_store_ptr && sp->kind != NO_EVENT; + } } @@ -3836,11 +3822,7 @@ kbd_buffer_get_event (KBOARD **kbp, mouse movement enabled and available. */ if (kbd_fetch_ptr != kbd_store_ptr) { - union buffered_input_event *event; - - event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE) - ? kbd_fetch_ptr - : kbd_buffer); + union buffered_input_event *event = kbd_fetch_ptr; *kbp = event_to_kboard (&event->ie); if (*kbp == 0) @@ -3861,7 +3843,7 @@ kbd_buffer_get_event (KBOARD **kbp, since otherwise swallow_events will see it and process it again. */ struct selection_input_event copy = event->sie; - kbd_fetch_ptr = event + 1; + kbd_fetch_ptr = next_kbd_event (event); input_pending = readable_events (0); x_handle_selection_event (©); #else @@ -3876,7 +3858,7 @@ kbd_buffer_get_event (KBOARD **kbp, || defined (HAVE_NS) || defined (USE_GTK) case MENU_BAR_ACTIVATE_EVENT: { - kbd_fetch_ptr = event + 1; + kbd_fetch_ptr = next_kbd_event (event); input_pending = readable_events (0); if (FRAME_LIVE_P (XFRAME (event->ie.frame_or_window))) x_activate_menubar (XFRAME (event->ie.frame_or_window)); @@ -3921,7 +3903,7 @@ kbd_buffer_get_event (KBOARD **kbp, case SELECT_WINDOW_EVENT: { obj = make_lispy_event (&event->ie); - kbd_fetch_ptr = event + 1; + kbd_fetch_ptr = next_kbd_event (event); } break; default: @@ -3975,7 +3957,7 @@ kbd_buffer_get_event (KBOARD **kbp, /* Wipe out this event, to catch bugs. */ clear_event (&event->ie); - kbd_fetch_ptr = event + 1; + kbd_fetch_ptr = next_kbd_event (event); } } } @@ -4042,17 +4024,9 @@ kbd_buffer_get_event (KBOARD **kbp, static void process_special_events (void) { - union buffered_input_event *event; - - for (event = kbd_fetch_ptr; event != kbd_store_ptr; ++event) + for (union buffered_input_event *event = kbd_fetch_ptr; + event != kbd_store_ptr; event = next_kbd_event (event)) { - if (event == kbd_buffer + KBD_BUFFER_SIZE) - { - event = kbd_buffer; - if (event == kbd_store_ptr) - break; - } - /* If we find a stored X selection request, handle it now. */ if (event->kind == SELECTION_REQUEST_EVENT || event->kind == SELECTION_CLEAR_EVENT) @@ -4066,28 +4040,21 @@ process_special_events (void) cyclically. */ struct selection_input_event copy = event->sie; - union buffered_input_event *beg - = (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE) - ? kbd_buffer : kbd_fetch_ptr; + int moved_events; - if (event > beg) - memmove (beg + 1, beg, (event - beg) * sizeof *beg); - else if (event < beg) + if (event < kbd_fetch_ptr) { - if (event > kbd_buffer) - memmove (kbd_buffer + 1, kbd_buffer, - (event - kbd_buffer) * sizeof *kbd_buffer); - *kbd_buffer = *(kbd_buffer + KBD_BUFFER_SIZE - 1); - if (beg < kbd_buffer + KBD_BUFFER_SIZE - 1) - memmove (beg + 1, beg, - (kbd_buffer + KBD_BUFFER_SIZE - 1 - beg) * sizeof *beg); + memmove (kbd_buffer + 1, kbd_buffer, + (event - kbd_buffer) * sizeof *kbd_buffer); + kbd_buffer[0] = kbd_buffer[KBD_BUFFER_SIZE - 1]; + moved_events = kbd_buffer + KBD_BUFFER_SIZE - 1 - kbd_fetch_ptr; } - - if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE) - kbd_fetch_ptr = kbd_buffer + 1; else - kbd_fetch_ptr++; + moved_events = event - kbd_fetch_ptr; + memmove (kbd_fetch_ptr + 1, kbd_fetch_ptr, + moved_events * sizeof *kbd_fetch_ptr); + kbd_fetch_ptr = next_kbd_event (kbd_fetch_ptr); input_pending = readable_events (0); x_handle_selection_event (©); #else @@ -10261,11 +10228,10 @@ stuff_buffered_input (Lisp_Object stuffstring) rms: we should stuff everything back into the kboard it came from. */ - for (; kbd_fetch_ptr != kbd_store_ptr; kbd_fetch_ptr++) + for (; kbd_fetch_ptr != kbd_store_ptr; + kbd_fetch_ptr = next_kbd_event (kbd_fetch_ptr)) { - if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE) - kbd_fetch_ptr = kbd_buffer; if (kbd_fetch_ptr->kind == ASCII_KEYSTROKE_EVENT) stuff_char (kbd_fetch_ptr->ie.code); @@ -12003,21 +11969,18 @@ mark_kboards (void) mark_object (KVAR (kb, echo_string)); mark_object (KVAR (kb, echo_prompt)); } - { - union buffered_input_event *event; - for (event = kbd_fetch_ptr; event != kbd_store_ptr; event++) - { - if (event == kbd_buffer + KBD_BUFFER_SIZE) - event = kbd_buffer; - /* These two special event types has no Lisp_Objects to mark. */ - if (event->kind != SELECTION_REQUEST_EVENT - && event->kind != SELECTION_CLEAR_EVENT) - { - mark_object (event->ie.x); - mark_object (event->ie.y); - mark_object (event->ie.frame_or_window); - mark_object (event->ie.arg); - } - } - } + + for (union buffered_input_event *event = kbd_fetch_ptr; + event != kbd_store_ptr; event = next_kbd_event (event)) + { + /* These two special event types have no Lisp_Objects to mark. */ + if (event->kind != SELECTION_REQUEST_EVENT + && event->kind != SELECTION_CLEAR_EVENT) + { + mark_object (event->ie.x); + mark_object (event->ie.y); + mark_object (event->ie.frame_or_window); + mark_object (event->ie.arg); + } + } } commit 7ecf49b5a5741cc4a895c8ff42bbb4577659192c Author: Paul Eggert Date: Fri Nov 30 09:55:37 2018 -0800 Fix core dump in dbus-message-internal Backport from master. * src/dbusbind.c (Fdbus_message_internal): Don’t go past array end (Bug#33530). diff --git a/src/dbusbind.c b/src/dbusbind.c index ec3707d18f..fe922d5429 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -1419,7 +1419,7 @@ usage: (dbus-message-internal &rest REST) */) for (; count < nargs; ++count) { dtype = XD_OBJECT_TO_DBUS_TYPE (args[count]); - if (XD_DBUS_TYPE_P (args[count])) + if (count + 1 < nargs && XD_DBUS_TYPE_P (args[count])) { XD_DEBUG_VALID_LISP_OBJECT_P (args[count]); XD_DEBUG_VALID_LISP_OBJECT_P (args[count+1]); commit cc3ad9a3d1b278852336265e0505e82cc5453778 Author: Eli Zaretskii Date: Fri Nov 30 13:07:40 2018 +0200 ; * CONTRIBUTE: Clarify rules for committing to release branches. diff --git a/CONTRIBUTE b/CONTRIBUTE index 0b68052a0c..efd4bf10ec 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -287,15 +287,23 @@ the current release branch. Periodically, the current release branch is merged into the master, using the gitmerge function described in admin/notes/git-workflow. -If you are fixing a bug that exists in the current release, be sure to -commit it to the release branch; it will be merged to the master -branch later by the gitmerge function. - -Documentation fixes (in doc strings, in manuals, and in comments) -should always go to the release branch, if the documentation to be -fixed exists and is relevant to the release-branch codebase. Doc -fixes are always considered "safe" -- even when a release branch is in -feature freeze, it can still receive doc fixes. +If you are fixing a bug that exists in the current release, you should +generally commit it to the release branch; it will be merged to the +master branch later by the gitmerge function. However, when the +release branch is for Emacs version NN.2 and later, or when it is for +Emacs version NN.1 that is in the very last stages of its pretest, +that branch is considered to be in a feature freeze: only bug fixes +that are "safe" or are fixing major problems should go to the release +branch, the rest should be committed to the master branch. This is so +to avoid destabilizing the next Emacs release. If you are unsure +whether your bug fix is "safe" enough for the release branch, ask on +the emacs-devel mailing list. + +Documentation fixes (in doc strings, in manuals, in NEWS, and in +comments) should always go to the release branch, if the documentation +to be fixed exists and is relevant to the release-branch codebase. +Doc fixes are always considered "safe" -- even when a release branch +is in feature freeze, it can still receive doc fixes. When you know that the change will be difficult to merge to the master (e.g., because the code on master has changed a lot), you can commit c53e7f2c23bf02069469e764bf8563244ef6751a Author: Michael Albinus Date: Fri Nov 30 12:04:57 2018 +0100 Fix Bug#33556 * lisp/autorevert.el (auto-revert-notify-add-watch): Assert that a key in `auto-revert-notify-watch-descriptor-hash-list' is a valid file notification descriptor. (Bug#33556) diff --git a/lisp/autorevert.el b/lisp/autorevert.el index 2cf5b427ea..d4cb823084 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -527,6 +527,7 @@ will use an up-to-date value of `auto-revert-interval'" (maphash (lambda (key _value) (when (and + (file-notify-valid-p key) (equal (file-notify--watch-absolute-filename (gethash key file-notify-descriptors)) (directory-file-name file)) commit a89dbe2af8a8a23e07c1e5cb988f067fe08111d9 Author: Michael Albinus Date: Fri Nov 30 11:31:16 2018 +0100 * doc/misc/dbus.texi (Type Conversion): Fix typo. (Bug#33551) diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi index 5b14382d8b..f55a11d7af 100644 --- a/doc/misc/dbus.texi +++ b/doc/misc/dbus.texi @@ -1015,7 +1015,7 @@ but different to The value for a byte D-Bus type can be any integer in the range 0 through 255. If a character is used as argument, modifiers -represented outside this range are stripped of. For example, +represented outside this range are stripped off. For example, @code{:byte ?x} is equal to @code{:byte ?\M-x}, but it is not equal to @code{:byte ?\C-x} or @code{:byte ?\M-\C-x}. commit 03ee726f98a3810e4f4ef3e01ad411c7782755b0 Author: Michael Albinus Date: Fri Nov 30 11:14:54 2018 +0100 ; Add comment to `customize-package-emacs-version-alist' diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index e4dc7168e4..9c1e9cfc2e 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -60,7 +60,11 @@ (match-string 0 (emacs-version))))))) (unless (string-match "\\`ok\\'" x) (error "%s" x))) -;; Tramp versions integrated into Emacs. +;; Tramp versions integrated into Emacs. If a user option declares a +;; `:package-version' which doesn't belong to an integrated Tramp +;; version, it must be added here as well (see `tramp-syntax', for +;; example). This can be checked by something like +;; (customize-changed "26.1") (add-to-list 'customize-package-emacs-version-alist '(Tramp ("2.0.55" . "22.1") ("2.0.57" . "22.2") ("2.0.58-pre" . "22.3") @@ -69,8 +73,8 @@ ("2.2.3-24.1" . "24.1") ("2.2.3-24.1" . "24.2") ("2.2.6-24.3" . "24.3") ("2.2.9-24.4" . "24.4") ("2.2.11-24.5" . "24.5") ("2.2.13.25.1" . "25.1") ("2.2.13.25.2" . "25.2") - ("2.2.13.25.2" . "25.3") ("2.3.3" . "26.1") - ("2.3.3.26.1" . "26.1") ("2.3.5.26.2" . "26.2"))) + ("2.2.13.25.2" . "25.3") + ("2.3.3" . "26.1") ("2.3.3.26.1" . "26.1") ("2.3.5.26.2" . "26.2"))) (add-hook 'tramp-unload-hook (lambda () commit bce1d1afabe24c8461d56336fb966e819f20a175 Author: Eli Zaretskii Date: Fri Nov 30 10:45:28 2018 +0200 Improve documentation of gdb-mi.el * lisp/progmodes/gdb-mi.el (gdb-show-changed-values) (gdb-max-children): Doc fixes. * doc/emacs/building.texi (Source Buffers, Stack Buffer) (GDB User Interface Layout): Mention some additional customizable variables. (Bug#33548) diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi index 7e250bf425..5cd3221928 100644 --- a/doc/emacs/building.texi +++ b/doc/emacs/building.texi @@ -912,6 +912,7 @@ height and width values during the debugging session. @cindex GDB User Interface layout @vindex gdb-many-windows +@vindex gdb-show-main If the variable @code{gdb-many-windows} is @code{nil} (the default), @kbd{M-x gdb} normally displays only the GUD interaction buffer. However, if the variable @code{gdb-show-main} is also non-@code{nil}, @@ -1011,6 +1012,15 @@ allows you to go backwards, which can be useful for running through code that has already executed, in order to examine its execution in more detail. +@vindex gdb-mi-decode-strings + If the file names of the source files are shown with octal escapes, +set the variable @code{gdb-mi-decode-strings} to the appropriate +coding-system, most probably @code{utf-8}. (This is @code{nil} by +default because GDB may emit octal escapes in situations where +decoding is undesirable, and also because the program being debugged +might use an encoding different from the one used to encode non-ASCII +file names on your system.) + @node Breakpoints Buffer @subsubsection Breakpoints Buffer @@ -1150,6 +1160,11 @@ also updates the Locals buffer (described in the next section). @end iftex +@vindex gdb-stack-buffer-addresses + If you want the frame address to be shown each stack frame, +customize the variable @code{gdb-stack-buffer-addresses} to a +non-@code{nil} value. + @node Other GDB Buffers @subsubsection Other GDB Buffers diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 0506386a75..013a40943b 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -1120,13 +1120,15 @@ line, and no execution takes place." (defcustom gdb-show-changed-values t "If non-nil change the face of out of scope variables and changed values. Out of scope variables are suppressed with `shadow' face. -Changed values are highlighted with the face `font-lock-warning-face'." +Changed values are highlighted with the face `font-lock-warning-face'. +Used by Speedbar." :type 'boolean :group 'gdb :version "22.1") (defcustom gdb-max-children 40 - "Maximum number of children before expansion requires confirmation." + "Maximum number of children before expansion requires confirmation. +Used by Speedbar." :type 'integer :group 'gdb :version "22.1") commit 5f67353da7af3ebb8fdf7bc4953e112fe1a33689 Author: Robert Pluim Date: Thu Nov 29 15:26:44 2018 +0100 Convert NS face colors to RGBA when comparing with frame values The NS port uses indexes into a color table to specify the colors of faces, whereas frames use RGBA pixel values. In extend_face_to_end_of_line the two needed to be compared to ensure that the backgrounds of certain faces are not extended to the edge of the window, which was failing because of this difference, thus causing a visual difference with other platforms. Convert from index to RGBA when doing such comparisons. * src/dispextern.h (FACE_COLOR_TO_PIXEL) [HAVE_NS]: New macro. Call ns_color_index_to_rgba under NS only. * src/nsgui.h: Add prototype for ns_color_index_to_rgba. * src/nsterm.m (ns_color_index_to_rgba): New function. Converts a color_table entry to corresponding RGBA pixel value. * src/xdisp.c (extend_face_to_end_of_line): Call FACE_COLOR_TO_PIXEL on face background color when comparing with frame color. diff --git a/src/dispextern.h b/src/dispextern.h index 579665c2ff..776d14080e 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -74,10 +74,13 @@ typedef HDC XImagePtr_or_DC; #ifdef HAVE_NS #include "nsgui.h" +#define FACE_COLOR_TO_PIXEL(face_color, frame) ns_color_index_to_rgba(face_color, frame) /* Following typedef needed to accommodate the MSDOS port, believe it or not. */ typedef struct ns_display_info Display_Info; typedef Pixmap XImagePtr; typedef XImagePtr XImagePtr_or_DC; +#else +#define FACE_COLOR_TO_PIXEL(face_color, frame) face_color #endif #ifdef HAVE_WINDOW_SYSTEM diff --git a/src/nsgui.h b/src/nsgui.h index 4e7d7d35da..f858fa7a14 100644 --- a/src/nsgui.h +++ b/src/nsgui.h @@ -73,6 +73,8 @@ typedef unichar XChar2b; #define XCHAR2B_BYTE2(chp) \ (*(chp) & 0x00ff) +/* Used in xdisp.c when comparing faces and frame colors. */ +extern unsigned long ns_color_index_to_rgba(int idx, struct frame *f); /* XXX: xfaces requires these structures, but the question is are we forced to use them? */ diff --git a/src/nsterm.m b/src/nsterm.m index 07978c0d3b..6ba867d27c 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -2332,6 +2332,22 @@ so some key presses (TAB) are swallowed by the system. */ return 1; } +/* Convert an index into the color table into an RGBA value. Used in + xdisp.c:extend_face_to_end_of_line when comparing faces and frame + color values. */ + +unsigned long +ns_color_index_to_rgba(int idx, struct frame *f) +{ + NSColor *col; + col = ns_lookup_indexed_color (idx, f); + + EmacsCGFloat r, g, b, a; + [col getRed: &r green: &g blue: &b alpha: &a]; + + return ARGB_TO_ULONG((int)(a*255), + (int)(r*255), (int)(g*255), (int)(b*255)); +} void ns_query_color(void *col, XColor *color_def, int setPixel) diff --git a/src/xdisp.c b/src/xdisp.c index a0113a0519..9a0752f267 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -20287,7 +20287,7 @@ extend_face_to_end_of_line (struct it *it) if (FRAME_WINDOW_P (f) && MATRIX_ROW_DISPLAYS_TEXT_P (it->glyph_row) && face->box == FACE_NO_BOX - && face->background == FRAME_BACKGROUND_PIXEL (f) + && FACE_COLOR_TO_PIXEL (face->background, f) == FRAME_BACKGROUND_PIXEL (f) #ifdef HAVE_WINDOW_SYSTEM && !face->stipple #endif @@ -20432,7 +20432,7 @@ extend_face_to_end_of_line (struct it *it) && (it->glyph_row->used[LEFT_MARGIN_AREA] < WINDOW_LEFT_MARGIN_WIDTH (it->w)) && !it->glyph_row->mode_line_p - && default_face->background != FRAME_BACKGROUND_PIXEL (f)) + && FACE_COLOR_TO_PIXEL (face->background, f) != FRAME_BACKGROUND_PIXEL (f)) { struct glyph *g = it->glyph_row->glyphs[LEFT_MARGIN_AREA]; struct glyph *e = g + it->glyph_row->used[LEFT_MARGIN_AREA]; @@ -20473,7 +20473,7 @@ extend_face_to_end_of_line (struct it *it) && (it->glyph_row->used[RIGHT_MARGIN_AREA] < WINDOW_RIGHT_MARGIN_WIDTH (it->w)) && !it->glyph_row->mode_line_p - && default_face->background != FRAME_BACKGROUND_PIXEL (f)) + && FACE_COLOR_TO_PIXEL (face->background, f) != FRAME_BACKGROUND_PIXEL (f)) { struct glyph *g = it->glyph_row->glyphs[RIGHT_MARGIN_AREA]; struct glyph *e = g + it->glyph_row->used[RIGHT_MARGIN_AREA]; commit 3b852da52fda327302956d263a3f916e3363cdd4 Author: Filipp Gunbin Date: Thu Nov 29 17:00:09 2018 +0300 LDAP: Set process-connection-type to t * lisp/net/ldap.el (ldap-search-internal): Set process-connection-type to t. (Bug#33050) diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index 7b47a54b9f..720c9c178f 100644 --- a/lisp/net/ldap.el +++ b/lisp/net/ldap.el @@ -646,7 +646,7 @@ an alist of attribute/value pairs." (not (equal "" sizelimit))) (setq arglist (nconc arglist (list (format "-z%s" sizelimit))))) (if passwd - (let* ((process-connection-type nil) + (let* ((process-connection-type t) (proc-args (append arglist ldap-ldapsearch-args filter)) (proc (apply #'start-process "ldapsearch" buf commit 809989f79ee4038f50d18765c4b727c8451ae0da Author: Thomas Fitzsimmons Date: Fri Oct 26 16:53:19 2018 -0400 LDAP: Set process-connection-type to t on Darwin * lisp/net/ldap.el (ldap-search-internal): Set process-connection-type to t on Darwin. Do not merge to master. (Bug#33050) diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index 7b47a54b9f..b106de02e9 100644 --- a/lisp/net/ldap.el +++ b/lisp/net/ldap.el @@ -646,7 +646,12 @@ an alist of attribute/value pairs." (not (equal "" sizelimit))) (setq arglist (nconc arglist (list (format "-z%s" sizelimit))))) (if passwd - (let* ((process-connection-type nil) + ;; Work around Bug#33154, see also Bug#33050. Leaving + ;; process-connection-type at its default (typically t) + ;; would probably be fine too, however this is the minimal + ;; change on the release branch that fixes ldap.el on Darwin + ;; and leaves other operating systems unchanged. + (let* ((process-connection-type (eq system-type 'darwin)) (proc-args (append arglist ldap-ldapsearch-args filter)) (proc (apply #'start-process "ldapsearch" buf commit 85ce7168490a0d7b8bb9c575b9c3382d445eae22 Author: Glenn Morris Date: Wed Nov 28 19:45:36 2018 -0800 * lisp/emacs-lisp/bytecomp.el: Don't load compile at runtime. It isn't needed and slows down compiling other files. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index f60ccdae28..d6986cb786 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -124,7 +124,7 @@ (require 'backquote) (require 'macroexp) (require 'cconv) -(require 'compile) +(eval-when-compile (require 'compile)) ;; Refrain from using cl-lib at run-time here, since it otherwise prevents ;; us from emitting warnings when compiling files which use cl-lib without ;; requiring it! (bug#30635) commit e8d7e3a59a05917b94b6803c123be97ccd693f0d Author: Eric Abrahamsen Date: Wed Nov 28 09:31:40 2018 -0800 Further small tweaks to Gnus modes cleanup * lisp/gnus/gnus-sum.el: Remove explicit definition of `gnus-summary-mode-hook', this is now created automatically. * lisp/gnus/nnir.el (nnir-open-server): Attach `nnir-mode' to the `gnus-summary-prepared-hook', instead of `gnus-summary-mode-hook'. The latter no longer has access to the buffer-local value of `gnus-newsgroup-name', which `nnir-mode' needs. diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 7be52717de..4baf4bc826 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -946,13 +946,6 @@ This variable is local to the summary buffers." :type '(choice (const :tag "off" nil) integer)) -(defcustom gnus-summary-mode-hook nil - "A hook for Gnus summary mode. -This hook is run before any variables are set in the summary buffer." - :options '(turn-on-gnus-mailing-list-mode gnus-pick-mode) - :group 'gnus-summary-various - :type 'hook) - (defcustom gnus-summary-menu-hook nil "Hook run after the creation of the summary mode menu." :group 'gnus-summary-visual diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 084b154e8a..62ac504864 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -657,7 +657,7 @@ skips all prompting." (let ((backend (car (gnus-server-to-method server)))) (if backend (nnoo-change-server backend server definitions) - (add-hook 'gnus-summary-mode-hook 'nnir-mode) + (add-hook 'gnus-summary-prepared-hook 'nnir-mode) (nnoo-change-server 'nnir server definitions)))) (deffoo nnir-request-group (group &optional server dont-check _info) commit 415ef4a2b02dac17bf1bb962154633e671e561dd Merge: 2c59cfa831 74a3a795af Author: Glenn Morris Date: Wed Nov 28 07:51:12 2018 -0800 Merge from origin/emacs-26 74a3a79 (origin/emacs-26) Fix a typo in a doc string 911766d Minor markup fix in frames.texi 19ed1e9 * lisp/net/trampver.el (customize-package-emacs-version-alist... d7132ad * lisp/mh-e/mh-e.el (customize-package-emacs-version-alist): ... 5f39260 * lisp/emacs-lisp/map-ynp.el (map-y-or-n-p): Pass format to m... a291f62 Don't call xwidget functions until GTK has been initialized f0531b8 Improve documentation of Ediff wordwise commands 2925ce5 Support Hunspell 1.7.0 in ispell.el 03bb7a8 Avoid clearing echo-area message by auto-save-visited-file-name commit 2c59cfa831f133ca75b513e05aaedeccfe410784 Merge: b58e8b82ed ea624626cc Author: Glenn Morris Date: Wed Nov 28 07:51:12 2018 -0800 ; Merge from origin/emacs-26 The following commit was skipped: ea62462 Set tooltip text color (bug#33452) commit b58e8b82ededfb314e385d97df1efed2ce84f4db Merge: febdedfa8d 094fcf62d2 Author: Glenn Morris Date: Wed Nov 28 07:51:11 2018 -0800 Merge from origin/emacs-26 094fcf6 Fix more drawing bugs in NS port (bug#32932) commit febdedfa8d43258edc4e0f2debd3910e073e9326 Author: Michael Albinus Date: Wed Nov 28 16:46:49 2018 +0100 ; Fix an oversight in tramp-smb.el diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index a49dbbdb39..d1a922813d 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1801,7 +1801,7 @@ Result is the list (LOCALNAME MODE SIZE MTIME)." (if (string-match-p "D" mode) "d" "-") (mapconcat (lambda (_x) "") " " - (concat "r" (if (string-match "R" mode) "-" "w") "x"))) + (concat "r" (if (string-match-p "R" mode) "-" "w") "x"))) line (substring line 0 -6)) (cl-return)) commit 9b9c70b7dbaa001d2f78a15fd1f3aaa8fce44eef Author: Michael Albinus Date: Wed Nov 28 16:38:49 2018 +0100 Tramp cleanup * lisp/net/tramp-sh.el (tramp-sh-handle-file-name-all-completions) * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-name-all-completions): * lisp/net/tramp-smb.el (tramp-smb-read-file-entry): Use `string-match-p'. * lisp/net/tramp-rclone.el (tramp-rclone-maybe-open-connection): Set file properties more robust. * lisp/net/tramp-sh.el (tramp-stat-marker) (tramp-convert-file-attributes): Add tramp-autoload cookie. diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index ebb4254dab..51a8f13c4a 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -28,7 +28,7 @@ ;; An implementation of information caching for remote files. ;; Each connection, identified by a `tramp-file-name' structure or by -;; a process, has a unique cache. We distinguish 3 kind of caches, +;; a process, has a unique cache. We distinguish 4 kind of caches, ;; depending on the key: ;; ;; - localname is NIL. This are reusable properties. Examples: @@ -49,6 +49,16 @@ ;; an open connection. Examples: "scripts" keeps shell script ;; definitions already sent to the remote shell, "last-cmd-time" is ;; the time stamp a command has been sent to the remote process. +;; +;; - The key is `nil'. This are temporary properties related to the +;; local machine. Examples: "parse-passwd" and "parse-group" keep +;; the results of parsing "/etc/passwd" and "/etc/group", "locale" +;; is the used shell locale. + +;; Some properties are handled special: +;; +;; - "process-name", "process-buffer" and "first-password-request" are +;; not saved in the file `tramp-persistency-file-name'. ;;; Code: diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 9d53edd084..76747f7c99 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1143,7 +1143,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." (defun tramp-gvfs-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (unless (save-match-data (string-match "/" filename)) + (unless (string-match-p "/" filename) (all-completions filename (with-parsed-tramp-file-name (expand-file-name directory) nil diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 3ca857dc3b..6c01d7def1 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -518,15 +518,14 @@ connection if a previous connection has died for some reason." ;; In `tramp-check-cached-permissions', the connection properties ;; {uig,gid}-{integer,string} are used. We set them to proper values. - (unless (tramp-get-connection-property vec "uid-integer" nil) - (tramp-set-connection-property - vec "uid-integer" (tramp-get-local-uid 'integer)) - (tramp-set-connection-property - vec "gid-integer" (tramp-get-local-gid 'integer)) - (tramp-set-connection-property - vec "uid-string" (tramp-get-local-uid 'string)) - (tramp-set-connection-property - vec "gid-string" (tramp-get-local-gid 'string)))) + (with-tramp-connection-property + vec "uid-integer" (tramp-get-local-uid 'integer)) + (with-tramp-connection-property + vec "gid-integer" (tramp-get-local-gid 'integer)) + (with-tramp-connection-property + vec "uid-string" (tramp-get-local-uid 'string)) + (with-tramp-connection-property + vec "gid-string" (tramp-get-local-gid 'string))) (defun tramp-rclone-send-command (vec &rest args) "Send the COMMAND to connection VEC." diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index b5d4893580..900b4b3c27 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -945,6 +945,7 @@ od -v -t x1 -A n Date: Wed Nov 28 13:15:50 2018 +0000 Make compilation mode work with warnings from compiled buffer functions In particular, warning messages from compile_defun now contain the source buffer name and line and column numbers. Typing CR on such a warning now moves to the pertinent place in the source buffer. This fixes bug #33475 * lisp/emacs-lisp/bytecomp.el (top-level): Require compile.elc?. (emacs-lisp-compilation-file-name-or-buffer) (emacs-lisp-compilation-parse-errors-filename-function): New variables/constants. (emacs-lisp-compilation-mode): New mode derived from compilation-mode. (byte-compile-log-file): Check byte-compile-current-file for being a string, not merely non-nil. Change wording in message from "buffer" to "in buffer". Go into emacs-lisp-compilation-mode rather than the plain compilation-mode. (compile-defun): Bind byte-compile-current-file to current-buffer, not nil. * lisp/progmodes/compilation-mode (compilation-parse-errors-filename-function): Amend comments to specify that this function may return a buffer, and that it need not save the match data. (Several places): Amend comments to allow for the use of a buffer rather than a file name. (compilation-next-error-function): If the "file name" in file struct is actually a buffer, use it rather than compilation-find-file's result. (compilation-get-file-structure): save-match-data around the call to compilation-parse-errors-filename-function. Only call command-line-normalize-file-name when `filename' is a string. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 15f31dd5f2..f60ccdae28 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -124,6 +124,7 @@ (require 'backquote) (require 'macroexp) (require 'cconv) +(require 'compile) ;; Refrain from using cl-lib at run-time here, since it otherwise prevents ;; us from emitting warnings when compiling files which use cl-lib without ;; requiring it! (bug#30635) @@ -1006,6 +1007,24 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." ;;; byte compiler messages +(defun emacs-lisp-compilation-file-name-or-buffer (str) + "Return file name or buffer given by STR. +If STR is a \"normal\" filename, just return it. +If STR is something like \"Buffer foo.el\", return # +\(if it is still live) or the string \"foo.el\" otherwise." + (if (string-match "Buffer \\(.*\\)\\'" str) + (or (get-buffer (match-string-no-properties 1 str)) + (match-string-no-properties 1 str)) + str)) + +(defconst emacs-lisp-compilation-parse-errors-filename-function + 'emacs-lisp-compilation-file-name-or-buffer + "The value for `compilation-parse-errors-filename-function' for when +we go into emacs-lisp-compilation-mode.") + +(define-compilation-mode emacs-lisp-compilation-mode "elisp-compile" + "The variant of `compilation-mode' used for emacs-lisp error buffers") + (defvar byte-compile-current-form nil) (defvar byte-compile-dest-file nil) (defvar byte-compile-current-file nil) @@ -1160,12 +1179,14 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." ;; Return the position of the start of the page in the log buffer. ;; But do nothing in batch mode. (defun byte-compile-log-file () - (and (not (equal byte-compile-current-file byte-compile-last-logged-file)) + (and (not + (and (get-buffer byte-compile-log-buffer) + (equal byte-compile-current-file byte-compile-last-logged-file))) (not noninteractive) (with-current-buffer (get-buffer-create byte-compile-log-buffer) (goto-char (point-max)) (let* ((inhibit-read-only t) - (dir (and byte-compile-current-file + (dir (and (stringp byte-compile-current-file) (file-name-directory byte-compile-current-file))) (was-same (equal default-directory dir)) pt) @@ -1180,7 +1201,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (insert "\f\nCompiling " (if (stringp byte-compile-current-file) (concat "file " byte-compile-current-file) - (concat "buffer " + (concat "in buffer " (buffer-name byte-compile-current-file))) " at " (current-time-string) "\n") (insert "\f\nCompiling no file at " (current-time-string) "\n")) @@ -1192,7 +1213,8 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (setq byte-compile-last-logged-file byte-compile-current-file byte-compile-last-warned-form nil) ;; Do this after setting default-directory. - (unless (derived-mode-p 'compilation-mode) (compilation-mode)) + (unless (derived-mode-p 'compilation-mode) + (emacs-lisp-compilation-mode)) (compilation-forget-errors) pt)))) @@ -1981,7 +2003,7 @@ With argument ARG, insert value in current buffer after the form." (save-excursion (end-of-defun) (beginning-of-defun) - (let* ((byte-compile-current-file nil) + (let* ((byte-compile-current-file (current-buffer)) (byte-compile-current-buffer (current-buffer)) (byte-compile-read-position (point)) (byte-compile-last-position byte-compile-read-position) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 7e7c18fb30..973d3a0146 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -83,7 +83,10 @@ buffer. This enables a major-mode to specify its own value.") (defvar compilation-parse-errors-filename-function nil "Function to call to post-process filenames while parsing error messages. It takes one arg FILENAME which is the name of a file as found -in the compilation output, and should return a transformed file name.") +in the compilation output, and should return a transformed file name +or a buffer, the one which was compiled.") +;; Note: the compilation-parse-errors-filename-function need not save the +;; match data. ;;;###autoload (defvar compilation-process-setup-function nil @@ -550,7 +553,8 @@ FILE can also have the form (FILE FORMAT...), where the FORMATs \(e.g. \"%s.c\") will be applied in turn to the recognized file name, until a file of that name is found. Or FILE can also be a function that returns (FILENAME) or (RELATIVE-FILENAME . DIRNAME). -In the former case, FILENAME may be relative or absolute. +In the former case, FILENAME may be relative or absolute, or it may +be a buffer. LINE can also be of the form (LINE . END-LINE) meaning a range of lines. COLUMN can also be of the form (COLUMN . END-COLUMN) @@ -944,10 +948,11 @@ from a different message." ;; FILE-STRUCTURE is a list of ;; ((FILENAME DIRECTORY) FORMATS (LINE LOC ...) ...) -;; FILENAME is a string parsed from an error message. DIRECTORY is a string -;; obtained by following directory change messages. DIRECTORY will be nil for -;; an absolute filename. FORMATS is a list of formats to apply to FILENAME if -;; a file of that name can't be found. +;; FILENAME is a string parsed from an error message, or the buffer which was +;; compiled. DIRECTORY is a string obtained by following directory change +;; messages. DIRECTORY will be nil for an absolute filename or a buffer. +;; FORMATS is a list of formats to apply to FILENAME if a file of that name +;; can't be found. ;; The rest of the list is an alist of elements with LINE as key. The keys ;; are either nil or line numbers. If present, nil comes first, followed by ;; the numbers in decreasing order. The LOCs for each line are again an alist @@ -1180,7 +1185,8 @@ just char-counts." "Get the meta-info that will be added as text-properties. LINE, END-LINE, COL, END-COL are integers or nil. TYPE can be 0, 1, or 2, meaning error, warning, or just info. -FILE should be (FILENAME) or (RELATIVE-FILENAME . DIRNAME) or nil. +FILE should be (FILENAME) or (RELATIVE-FILENAME . DIRNAME) or (BUFFER) or +nil. FMTS is a list of format specs for transforming the file name. (See `compilation-error-regexp-alist'.)" (unless file (setq file '("*unknown*"))) @@ -2493,12 +2499,14 @@ This is the value of `next-error-function' in Compilation buffers." ;; (setq timestamp compilation-buffer-modtime))) ) (with-current-buffer - (apply #'compilation-find-file - marker - (caar (compilation--loc->file-struct loc)) - (cadr (car (compilation--loc->file-struct loc))) - (compilation--file-struct->formats - (compilation--loc->file-struct loc))) + (if (bufferp (caar (compilation--loc->file-struct loc))) + (caar (compilation--loc->file-struct loc)) + (apply #'compilation-find-file + marker + (caar (compilation--loc->file-struct loc)) + (cadr (car (compilation--loc->file-struct loc))) + (compilation--file-struct->formats + (compilation--loc->file-struct loc)))) (let ((screen-columns ;; Obey the compilation-error-screen-columns of the target ;; buffer if its major mode set it buffer-locally. @@ -2810,18 +2818,21 @@ TRUE-DIRNAME is the `file-truename' of DIRNAME, if given." (concat comint-file-name-prefix spec-directory)))))) ;; If compilation-parse-errors-filename-function is - ;; defined, use it to process the filename. + ;; defined, use it to process the filename. The result might be a + ;; buffer. (when compilation-parse-errors-filename-function - (setq filename - (funcall compilation-parse-errors-filename-function - filename))) + (save-match-data + (setq filename + (funcall compilation-parse-errors-filename-function + filename)))) ;; Some compilers (e.g. Sun's java compiler, reportedly) produce bogus ;; file names like "./bar//foo.c" for file "bar/foo.c"; ;; expand-file-name will collapse these into "/foo.c" and fail to find ;; the appropriate file. So we look for doubled slashes in the file ;; name and fix them. - (setq filename (command-line-normalize-file-name filename)) + (if (stringp filename) + (setq filename (command-line-normalize-file-name filename))) ;; Store it for the possibly unnormalized name (puthash file commit 74a3a795afbf092d4086e5ebb4dcf0254e7c8b46 Author: Eli Zaretskii Date: Wed Nov 28 09:28:36 2018 +0200 Fix a typo in a doc string * lisp/emacs-lisp/map-ynp.el (read-answer-short): Fix typo. (Bug#33528) diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el index 5b1786af51..906f6c96a5 100644 --- a/lisp/emacs-lisp/map-ynp.el +++ b/lisp/emacs-lisp/map-ynp.el @@ -269,7 +269,7 @@ the current %s and exit." "If non-nil, `read-answer' accepts single-character answers. If t, accept short (single key-press) answers to the question. If nil, require long answers. If `auto', accept short answers if -the function cell of `yes-or-no-p' is set to `y-or-on-p'." +the function cell of `yes-or-no-p' is set to `y-or-n-p'." :type '(choice (const :tag "Accept short answers" t) (const :tag "Require long answer" nil) (const :tag "Guess preference" auto)) commit 911766d419ad9d36c01371ac88cefb415bd77919 Author: Eli Zaretskii Date: Wed Nov 28 09:22:00 2018 +0200 Minor markup fix in frames.texi * doc/lispref/frames.texi (Frame Layout): Fix markup of @table entries. (Bug#33531) diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index e95a684912..3795f425e7 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -497,7 +497,7 @@ Height | | | Height | | | Height In practice not all of the areas shown in the drawing will or may be present. The meaning of these areas is described below. -@table @samp +@table @asis @item Outer Frame @cindex outer frame @cindex outer edges commit cef3f8fbf98296eaa59f80716db33b4f8689889a Author: Paul Eggert Date: Tue Nov 27 21:36:18 2018 -0800 Fix core dump in dbus-message-internal * src/dbusbind.c (Fdbus_message_internal): Don’t go past array end (Bug#33530). diff --git a/src/dbusbind.c b/src/dbusbind.c index 9bc344e961..403fc598c0 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -1423,7 +1423,7 @@ usage: (dbus-message-internal &rest REST) */) for (; count < nargs; ++count) { dtype = XD_OBJECT_TO_DBUS_TYPE (args[count]); - if (XD_DBUS_TYPE_P (args[count])) + if (count + 1 < nargs && XD_DBUS_TYPE_P (args[count])) { XD_DEBUG_VALID_LISP_OBJECT_P (args[count]); XD_DEBUG_VALID_LISP_OBJECT_P (args[count+1]); commit 19ed1e9a5f51fc27d60062bd70432c41cd08b3c1 Author: Glenn Morris Date: Tue Nov 27 20:24:05 2018 -0800 * lisp/net/trampver.el (customize-package-emacs-version-alist): Add 2.3.3. diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 7badcd19f8..e4dc7168e4 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -69,7 +69,7 @@ ("2.2.3-24.1" . "24.1") ("2.2.3-24.1" . "24.2") ("2.2.6-24.3" . "24.3") ("2.2.9-24.4" . "24.4") ("2.2.11-24.5" . "24.5") ("2.2.13.25.1" . "25.1") ("2.2.13.25.2" . "25.2") - ("2.2.13.25.2" . "25.3") + ("2.2.13.25.2" . "25.3") ("2.3.3" . "26.1") ("2.3.3.26.1" . "26.1") ("2.3.5.26.2" . "26.2"))) (add-hook 'tramp-unload-hook commit d7132ad870c13932bd58b24d0b124799aa49a277 Author: Glenn Morris Date: Tue Nov 27 20:19:59 2018 -0800 * lisp/mh-e/mh-e.el (customize-package-emacs-version-alist): Additions. diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index 05ff672da5..78fa2af52c 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -1022,12 +1022,13 @@ windows in the frame are removed." (when delete-other-windows-flag (delete-other-windows))) -;; FIXME: Maybe out of date? --xfq (if (boundp 'customize-package-emacs-version-alist) (add-to-list 'customize-package-emacs-version-alist '(MH-E ("6.0" . "22.1") ("6.1" . "22.1") ("7.0" . "22.1") ("7.1" . "22.1") ("7.2" . "22.1") ("7.3" . "22.1") - ("7.4" . "22.1") ("8.0" . "22.1")))) + ("7.4" . "22.1") ("8.0" . "22.1") ("8.1" . "23.1") + ("8.2" . "23.1") ("8.3" . "24.1") ("8.4" . "24.4") + ("8.5" . "24.4") ("8.6" . "24.4")))) commit 5f3926053eaebc8ebff696abfd5a8d4365d8671d Author: Glenn Morris Date: Tue Nov 27 08:24:33 2018 -0800 * lisp/emacs-lisp/map-ynp.el (map-y-or-n-p): Pass format to message. diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el index 93235bd9ec..5b1786af51 100644 --- a/lisp/emacs-lisp/map-ynp.el +++ b/lisp/emacs-lisp/map-ynp.el @@ -254,7 +254,9 @@ the current %s and exit." ;; Clear the last prompt from the minibuffer, and restore the ;; previous echo-area message, if any. (let ((message-log-max nil)) - (message (or msg ""))) + (if msg + (message "%s" msg) + (message ""))) ;; Return the number of actions that were taken. actions)) commit e02d375cb6670e2306b9c67d7f6fd2dd1d1b2711 Author: Michael Albinus Date: Tue Nov 27 14:52:58 2018 +0100 Fixes in tramp-clone.el * lisp/net/tramp-rclone.el (tramp-rclone-parse-device-names): Wrap by connection property "rclone-device-names". (tramp-rclone-maybe-open-connection): Do not check for `non-essential'. diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index a1767ab3a1..3ca857dc3b 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -170,26 +170,27 @@ pass to the OPERATION." ;;;###tramp-autoload (defun tramp-rclone-parse-device-names (_ignore) "Return a list of (nil host) tuples allowed to access." - (with-timeout (10) - (with-temp-buffer - ;; `call-process' does not react on timer under MS Windows. - ;; That's why we use `start-process'. - (let ((p (start-process - tramp-rclone-program (current-buffer) - tramp-rclone-program "listremotes")) - (v (make-tramp-file-name :method tramp-rclone-method)) - result) - (tramp-message v 6 "%s" (mapconcat 'identity (process-command p) " ")) - (process-put p 'adjust-window-size-function 'ignore) - (set-process-query-on-exit-flag p nil) - (while (process-live-p p) - (accept-process-output p 0.1)) - (accept-process-output p 0.1) - (tramp-message v 6 "\n%s" (buffer-string)) - (goto-char (point-min)) - (while (search-forward-regexp "^\\(\\S-+\\):$" nil t) - (push (list nil (match-string 1)) result)) - result)))) + (with-tramp-connection-property nil "rclone-device-names" + (with-timeout (10) + (with-temp-buffer + ;; `call-process' does not react on timer under MS Windows. + ;; That's why we use `start-process'. + (let ((p (start-process + tramp-rclone-program (current-buffer) + tramp-rclone-program "listremotes")) + (v (make-tramp-file-name :method tramp-rclone-method)) + result) + (tramp-message v 6 "%s" (mapconcat 'identity (process-command p) " ")) + (process-put p 'adjust-window-size-function 'ignore) + (set-process-query-on-exit-flag p nil) + (while (process-live-p p) + (accept-process-output p 0.1)) + (accept-process-output p 0.1) + (tramp-message v 6 "\n%s" (buffer-string)) + (goto-char (point-min)) + (while (search-forward-regexp "^\\(\\S-+\\):$" nil t) + (push (list nil (match-string 1)) result)) + result))))) ;; File name primitives. @@ -489,7 +490,7 @@ file names." "Maybe open a connection VEC. Does not do anything if a connection is already open, but re-opens the connection if a previous connection has died for some reason." - (unless (or (null non-essential) (tramp-rclone-mounted-p vec)) + (unless (tramp-rclone-mounted-p vec) (let ((host (tramp-file-name-host vec))) (if (zerop (length host)) (tramp-error vec 'file-error "Storage %s not connected" host)) commit a291f624289bd2009b7fa230d62b5940e0484c83 Author: Robert Pluim Date: Tue Nov 27 09:39:30 2018 +0100 Don't call xwidget functions until GTK has been initialized Follow up fix to Bug#33294. * src/gtkutil.c: Define xg_gtk_initialized. (xg_initialize): Set it when GTK has finished initializing. * src/gtkutil.h: Declare xg_gtk_initialized. * src/xwidget.c (Fmake_xwidget): Error out if GTK has not been initialized. (xwidget_init_view): Likewise. diff --git a/src/gtkutil.c b/src/gtkutil.c index 5879ab683e..9540bd9072 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -147,6 +147,8 @@ struct xg_frame_tb_info GtkTextDirection dir; }; +bool xg_gtk_initialized; /* Used to make sure xwidget calls are possible */ + static GtkWidget * xg_get_widget_from_map (ptrdiff_t idx); @@ -5306,6 +5308,8 @@ xg_initialize (void) #ifdef HAVE_FREETYPE x_last_font_name = NULL; #endif + + xg_gtk_initialized = true; } #endif /* USE_GTK */ diff --git a/src/gtkutil.h b/src/gtkutil.h index 7dcd549f5c..3b074073e4 100644 --- a/src/gtkutil.h +++ b/src/gtkutil.h @@ -202,5 +202,6 @@ extern void xg_initialize (void); to indicate that the callback should do nothing. */ extern bool xg_ignore_gtk_scrollbar; +extern bool xg_gtk_initialized; #endif /* USE_GTK */ #endif /* GTKUTIL_H */ diff --git a/src/xwidget.c b/src/xwidget.c index bcc450bac6..09c65d0d3e 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -78,6 +78,8 @@ Returns the newly constructed xwidget, or nil if construction fails. */) Lisp_Object title, Lisp_Object width, Lisp_Object height, Lisp_Object arguments, Lisp_Object buffer) { + if (!xg_gtk_initialized) + error ("make-xwidget: GTK has not been initialized"); CHECK_SYMBOL (type); CHECK_NATNUM (width); CHECK_NATNUM (height); @@ -508,6 +510,10 @@ xwidget_init_view (struct xwidget *xww, struct glyph_string *s, int x, int y) { + + if (!xg_gtk_initialized) + error ("xwidget_init_view: GTK has not been initialized"); + struct xwidget_view *xv = allocate_xwidget_view (); Lisp_Object val; commit f0531b8e64250414baf1c0d2dde3fbfc55a748a0 Author: Eli Zaretskii Date: Tue Nov 27 10:09:55 2018 +0200 Improve documentation of Ediff wordwise commands * lisp/vc/ediff.el (ediff-windows-wordwise) (ediff-windows-linewise, ediff-regions-wordwise): Update and clarify the doc strings. * doc/misc/ediff.texi (Major Entry Points): Update and clarify the documentation of 'ediff-windows-wordwise' and 'ediff-regions-wordwise'. See the discussion starting at https://lists.gnu.org/archive/html/help-gnu-emacs/2018-11/msg00197.html for the details. diff --git a/doc/misc/ediff.texi b/doc/misc/ediff.texi index 746c4c829d..cce8321d9e 100644 --- a/doc/misc/ediff.texi +++ b/doc/misc/ediff.texi @@ -210,11 +210,11 @@ ancestors. Ediff selects only the files that are under version control. @item ediff-windows-wordwise @findex ediff-windows-wordwise -Compare windows word-by-word. +Compare text visible in 2 windows word-by-word. @item ediff-windows-linewise @findex ediff-windows-linewise -Compare windows line-by-line. +Compare text visible in 2 windows line-by-line. @item ediff-regions-wordwise @findex ediff-regions-wordwise @@ -373,13 +373,12 @@ The commands @code{ediff-windows-wordwise}, @code{ediff-windows-linewise}, @code{ediff-regions-wordwise} and @code{ediff-regions-linewise} do comparison on parts of existing Emacs buffers. The commands @code{ediff-windows-wordwise} and -@code{ediff-regions-wordwise} are intended for relatively small segments -of buffers (e.g., up to 100 lines, depending on the speed of your machine), +@code{ediff-regions-wordwise} could be slow on very large buffers, as they perform comparison on the basis of words rather than lines. -(Word-wise comparison of large chunks of text can be slow.) +(Word-wise comparison of large chunks of text is relatively expensive.) -To compare large regions, use @code{ediff-regions-linewise}. This -command displays differences much like @code{ediff-files} and +To compare very large regions, use @code{ediff-regions-linewise}. +This command displays differences much like @code{ediff-files} and @code{ediff-buffers}. The functions @code{ediff-patch-file} and @code{ediff-patch-buffer} apply a diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el index cd2b2c4e62..da7b0f1291 100644 --- a/lisp/vc/ediff.el +++ b/lisp/vc/ediff.el @@ -927,6 +927,7 @@ MERGE-AUTOSTORE-DIR is the directory in which to store merged files." ;;;###autoload (defun ediff-windows-wordwise (dumb-mode &optional wind-A wind-B startup-hooks) "Compare WIND-A and WIND-B, which are selected by clicking, wordwise. +This compares the portions of text visible in each of the two windows. With prefix argument, DUMB-MODE, or on a non-windowing display, works as follows: If WIND-A is nil, use selected window. @@ -940,6 +941,7 @@ arguments after setting up the Ediff buffers." ;;;###autoload (defun ediff-windows-linewise (dumb-mode &optional wind-A wind-B startup-hooks) "Compare WIND-A and WIND-B, which are selected by clicking, linewise. +This compares the portions of text visible in each of the two windows. With prefix argument, DUMB-MODE, or on a non-windowing display, works as follows: If WIND-A is nil, use selected window. @@ -950,7 +952,8 @@ arguments after setting up the Ediff buffers." (ediff-windows dumb-mode wind-A wind-B startup-hooks 'ediff-windows-linewise nil)) -;; Compare WIND-A and WIND-B, which are selected by clicking. +;; Compare visible portions of text in WIND-A and WIND-B, which are +;; selected by clicking. ;; With prefix argument, DUMB-MODE, or on a non-windowing display, ;; works as follows: ;; If WIND-A is nil, use selected window. @@ -991,8 +994,8 @@ arguments after setting up the Ediff buffers." "Run Ediff on a pair of regions in specified buffers. BUFFER-A and BUFFER-B are the buffers to be compared. Regions (i.e., point and mark) can be set in advance or marked interactively. -This function is effective only for relatively small regions, up to 200 -lines. For large regions, use `ediff-regions-linewise'. +This function might be slow for large regions. If you find it slow, +use `ediff-regions-linewise' instead. STARTUP-HOOKS is a list of functions that Emacs calls without arguments after setting up the Ediff buffers." (interactive commit d28118940ccdd8772b948880011dd4158ed20463 Author: Michael Heerdegen Date: Mon Nov 26 13:39:26 2018 +0100 Revert "Replace insignificant backquotes" for Org files Revert everything of commit 1808d254a5 "Replace insignificant backquotes" that touches Org source files since these should not have been changed. * lisp/org/ob-C.el: * lisp/org/ob-core.el: * lisp/org/ob-exp.el: * lisp/org/ob-groovy.el: * lisp/org/ob-haskell.el: * lisp/org/ob-io.el: * lisp/org/ob-lisp.el: * lisp/org/ob-lob.el: * lisp/org/ob-lua.el: * lisp/org/ob-octave.el: * lisp/org/ob-perl.el: * lisp/org/ob-python.el: * lisp/org/ob-ref.el: * lisp/org/ob-ruby.el: * lisp/org/ob-sql.el: * lisp/org/org-agenda.el: * lisp/org/org-capture.el: * lisp/org/org-clock.el: * lisp/org/org-colview.el: * lisp/org/org-duration.el: * lisp/org/org-element.el: * lisp/org/org-entities.el: * lisp/org/org-gnus.el: * lisp/org/org-indent.el: * lisp/org/org-info.el: * lisp/org/org-inlinetask.el: * lisp/org/org-lint.el: * lisp/org/org-list.el: * lisp/org/org-mouse.el: * lisp/org/org-plot.el: * lisp/org/org-src.el: * lisp/org/org-table.el: * lisp/org/org.el: * lisp/org/ox-ascii.el: * lisp/org/ox-html.el: * lisp/org/ox-latex.el: * lisp/org/ox-man.el: * lisp/org/ox-md.el: * lisp/org/ox-org.el: * lisp/org/ox-publish.el: * lisp/org/ox-texinfo.el: * lisp/org/ox.el: Undo changes made by commit "Replace insignificant backquotes". diff --git a/lisp/org/ob-C.el b/lisp/org/ob-C.el index a99f0fcb85..ff5be34967 100644 --- a/lisp/org/ob-C.el +++ b/lisp/org/ob-C.el @@ -136,7 +136,7 @@ or `org-babel-execute:C++' or `org-babel-execute:D'." (let* ((tmp-src-file (org-babel-temp-file "C-src-" (pcase org-babel-c-variant - ('c ".c") ('cpp ".cpp") ('d ".d")))) + (`c ".c") (`cpp ".cpp") (`d ".d")))) (tmp-bin-file ;not used for D (org-babel-process-file-name (org-babel-temp-file "C-bin-" org-babel-exeext))) @@ -154,29 +154,29 @@ or `org-babel-execute:C++' or `org-babel-execute:D'." " ")) (full-body (pcase org-babel-c-variant - ('c (org-babel-C-expand-C body params)) - ('cpp (org-babel-C-expand-C++ body params)) - ('d (org-babel-C-expand-D body params))))) + (`c (org-babel-C-expand-C body params)) + (`cpp (org-babel-C-expand-C++ body params)) + (`d (org-babel-C-expand-D body params))))) (with-temp-file tmp-src-file (insert full-body)) (pcase org-babel-c-variant - ((or 'c 'cpp) + ((or `c `cpp) (org-babel-eval (format "%s -o %s %s %s %s" (pcase org-babel-c-variant - ('c org-babel-C-compiler) - ('cpp org-babel-C++-compiler)) + (`c org-babel-C-compiler) + (`cpp org-babel-C++-compiler)) tmp-bin-file flags (org-babel-process-file-name tmp-src-file) libs) "")) - ('d nil)) ;; no separate compilation for D + (`d nil)) ;; no separate compilation for D (let ((results (org-babel-eval (pcase org-babel-c-variant - ((or 'c 'cpp) + ((or `c `cpp) (concat tmp-bin-file cmdline)) - ('d + (`d (format "%s %s %s %s" org-babel-D-compiler flags @@ -323,9 +323,9 @@ FORMAT can be either a format string or a function which is called with VAL." (let* ((basetype (org-babel-C-val-to-base-type val)) (type (pcase basetype - ('integerp '("int" "%d")) - ('floatp '("double" "%f")) - ('stringp + (`integerp '("int" "%d")) + (`floatp '("double" "%f")) + (`stringp (list (if (eq org-babel-c-variant 'd) "string" "const char*") "\"%s\"")) @@ -373,11 +373,11 @@ FORMAT can be either a format string or a function which is called with VAL." (let ((type nil)) (mapc (lambda (v) (pcase (org-babel-C-val-to-base-type v) - ('stringp (setq type 'stringp)) - ('floatp + (`stringp (setq type 'stringp)) + (`floatp (if (or (not type) (eq type 'integerp)) (setq type 'floatp))) - ('integerp + (`integerp (unless type (setq type 'integerp))))) val) type)) @@ -420,7 +420,7 @@ of the same value." "Generate a utility function to convert a column name into a column number." (pcase org-babel-c-variant - ((or 'c 'cpp) + ((or `c `cpp) "int get_column_num (int nbcols, const char** header, const char* column) { int c; @@ -430,7 +430,7 @@ into a column number." return -1; } ") - ('d + (`d "int get_column_num (string[] header, string column) { foreach (c, h; header) @@ -448,18 +448,18 @@ specifying a variable with the name of the table." (concat (format (pcase org-babel-c-variant - ((or 'c 'cpp) "const char* %s_header[%d] = {%s};") - ('d "string %s_header[%d] = [%s];")) + ((or `c `cpp) "const char* %s_header[%d] = {%s};") + (`d "string %s_header[%d] = [%s];")) table (length headers) (mapconcat (lambda (h) (format "%S" h)) headers ",")) "\n" (pcase org-babel-c-variant - ((or 'c 'cpp) + ((or `c `cpp) (format "const char* %s_h (int row, const char* col) { return %s[row][get_column_num(%d,%s_header,col)]; }" table table (length headers) table)) - ('d + (`d (format "string %s_h (size_t row, string col) { return %s[row][get_column_num(%s_header,col)]; }" table table table)))))) diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el index ddf756c915..a5449fe35e 100644 --- a/lisp/org/ob-core.el +++ b/lisp/org/ob-core.el @@ -283,9 +283,9 @@ environment, to override this check." (name (nth 4 info)) (name-string (if name (format " (%s) " name) " "))) (pcase evalp - ('nil nil) - ('t t) - ('query (or + (`nil nil) + (`t t) + (`query (or (and (not (bound-and-true-p org-babel-confirm-evaluate-answer-no)) (yes-or-no-p @@ -1991,7 +1991,7 @@ to HASH." (catch :found (org-with-wide-buffer (pcase (org-element-type context) - ((or 'inline-babel-call 'inline-src-block) + ((or `inline-babel-call `inline-src-block) ;; Results for inline objects are located right after them. ;; There is no RESULTS line to insert either. (let ((limit (org-element-property @@ -2013,7 +2013,7 @@ to HASH." (skip-chars-backward " \t") (point))) (point)))))))) - ((or 'babel-call 'src-block) + ((or `babel-call `src-block) (let* ((name (org-element-property :name context)) (named-results (and name (org-babel-find-named-result name)))) (goto-char (or named-results (org-element-property :end context))) @@ -2067,20 +2067,20 @@ Return nil if ELEMENT cannot be read." (org-with-wide-buffer (goto-char (org-element-property :post-affiliated element)) (pcase (org-element-type element) - ('fixed-width + (`fixed-width (let ((v (org-trim (org-element-property :value element)))) (or (org-babel--string-to-number v) v))) - ('table (org-babel-read-table)) - ('plain-list (org-babel-read-list)) - ('example-block + (`table (org-babel-read-table)) + (`plain-list (org-babel-read-list)) + (`example-block (let ((v (org-element-property :value element))) (if (or org-src-preserve-indentation (org-element-property :preserve-indent element)) v (org-remove-indentation v)))) - ('export-block + (`export-block (org-remove-indentation (org-element-property :value element))) - ('paragraph + (`paragraph ;; Treat paragraphs containing a single link specially. (skip-chars-forward " \t") (if (and (looking-at org-bracket-link-regexp) @@ -2093,7 +2093,7 @@ Return nil if ELEMENT cannot be read." (buffer-substring-no-properties (org-element-property :contents-begin element) (org-element-property :contents-end element)))) - ((or 'center-block 'quote-block 'verse-block 'special-block) + ((or `center-block `quote-block `verse-block `special-block) (org-remove-indentation (buffer-substring-no-properties (org-element-property :contents-begin element) diff --git a/lisp/org/ob-exp.el b/lisp/org/ob-exp.el index bb4ef1b77f..264dc0ed06 100644 --- a/lisp/org/ob-exp.el +++ b/lisp/org/ob-exp.el @@ -175,7 +175,7 @@ this template." ;; ;; #+name: call_src ;; #+begin_src ... - ((and (or 'babel-call 'src-block) (guard object?)) + ((and (or `babel-call `src-block) (guard object?)) nil) (type type))) (begin @@ -187,7 +187,7 @@ this template." (skip-chars-backward " \r\t\n") (point))))) (pcase type - ('inline-src-block + (`inline-src-block (let* ((info (org-babel-get-src-block-info nil element)) (params (nth 2 info))) @@ -215,7 +215,7 @@ this template." ;; insert value. (delete-region begin end) (insert replacement))))) - ((or 'babel-call 'inline-babel-call) + ((or `babel-call `inline-babel-call) (org-babel-exp-do-export (org-babel-lob-get-info element) 'lob) (let ((rep @@ -242,7 +242,7 @@ this template." (goto-char begin) (delete-region begin end) (insert rep)))) - ('src-block + (`src-block (let ((match-start (copy-marker (match-beginning 0))) (ind (org-get-indentation))) ;; Take care of matched block: compute @@ -394,14 +394,14 @@ inhibit insertion of results into the buffer." (nth 2 info) `((:results . ,(if silent "silent" "replace"))))))) (pcase type - ('block (org-babel-execute-src-block nil info)) - ('inline + (`block (org-babel-execute-src-block nil info)) + (`inline ;; Position the point on the inline source block ;; allowing `org-babel-insert-result' to check that the ;; block is inline. (goto-char (nth 5 info)) (org-babel-execute-src-block nil info)) - ('lob + (`lob (save-excursion (goto-char (nth 5 info)) (let (org-confirm-babel-evaluate) diff --git a/lisp/org/ob-groovy.el b/lisp/org/ob-groovy.el index 44470dd1a1..565b09754b 100644 --- a/lisp/org/ob-groovy.el +++ b/lisp/org/ob-groovy.el @@ -83,12 +83,12 @@ If RESULT-TYPE equals `value' then return the value of the last statement in BODY as elisp." (when session (error "Sessions are not (yet) supported for Groovy")) (pcase result-type - ('output + (`output (let ((src-file (org-babel-temp-file "groovy_"))) (progn (with-temp-file src-file (insert body)) (org-babel-eval (concat org-babel-groovy-command " " src-file) "")))) - ('value + (`value (let* ((src-file (org-babel-temp-file "groovy_")) (wrapper (format org-babel-groovy-wrapper-method body))) (with-temp-file src-file (insert wrapper)) diff --git a/lisp/org/ob-haskell.el b/lisp/org/ob-haskell.el index ba1b4d00fc..e607ee0c55 100644 --- a/lisp/org/ob-haskell.el +++ b/lisp/org/ob-haskell.el @@ -89,8 +89,8 @@ (org-babel-reassemble-table (let ((result (pcase result-type - ('output (mapconcat #'identity (reverse (cdr results)) "\n")) - ('value (car results))))) + (`output (mapconcat #'identity (reverse (cdr results)) "\n")) + (`value (car results))))) (org-babel-result-cond (cdr (assq :result-params params)) result (org-babel-script-escape result))) (org-babel-pick-name (cdr (assq :colname-names params)) diff --git a/lisp/org/ob-io.el b/lisp/org/ob-io.el index 07746aaac7..4f407cc52c 100644 --- a/lisp/org/ob-io.el +++ b/lisp/org/ob-io.el @@ -74,14 +74,14 @@ If RESULT-TYPE equals `value' then return the value of the last statement in BODY as elisp." (when session (error "Sessions are not (yet) supported for Io")) (pcase result-type - ('output + (`output (if (member "repl" result-params) (org-babel-eval org-babel-io-command body) (let ((src-file (org-babel-temp-file "io-"))) (progn (with-temp-file src-file (insert body)) (org-babel-eval (concat org-babel-io-command " " src-file) ""))))) - ('value (let* ((src-file (org-babel-temp-file "io-")) + (`value (let* ((src-file (org-babel-temp-file "io-")) (wrapper (format org-babel-io-wrapper-method body))) (with-temp-file src-file (insert wrapper)) (let ((raw (org-babel-eval diff --git a/lisp/org/ob-lisp.el b/lisp/org/ob-lisp.el index 8fc691ed61..b846138f7a 100644 --- a/lisp/org/ob-lisp.el +++ b/lisp/org/ob-lisp.el @@ -87,8 +87,8 @@ current directory string." BODY is the contents of the block, as a string. PARAMS is a property list containing the parameters of the block." (require (pcase org-babel-lisp-eval-fn - ('slime-eval 'slime) - ('sly-eval 'sly))) + (`slime-eval 'slime) + (`sly-eval 'sly))) (org-babel-reassemble-table (let ((result (funcall (if (member "output" (cdr (assq :result-params params))) diff --git a/lisp/org/ob-lob.el b/lisp/org/ob-lob.el index 6668ccd8ba..6af6bf07e8 100644 --- a/lisp/org/ob-lob.el +++ b/lisp/org/ob-lob.el @@ -105,8 +105,8 @@ after REF in the Library of Babel." (when (equal name (org-element-property :name element)) (throw :found (pcase (org-element-type element) - ('src-block (org-babel-get-src-block-info t element)) - ('babel-call (org-babel-lob-get-info element)) + (`src-block (org-babel-get-src-block-info t element)) + (`babel-call (org-babel-lob-get-info element)) ;; Non-executable data found. Since names ;; are supposed to be unique throughout ;; a document, bail out. diff --git a/lisp/org/ob-lua.el b/lisp/org/ob-lua.el index 7750afdffc..6ae72c7e56 100644 --- a/lisp/org/ob-lua.el +++ b/lisp/org/ob-lua.el @@ -290,10 +290,10 @@ string. If RESULT-TYPE equals 'value then return the value of the last statement in BODY, as elisp." (let ((raw (pcase result-type - ('output (org-babel-eval org-babel-lua-command + (`output (org-babel-eval org-babel-lua-command (concat (if preamble (concat preamble "\n")) body))) - ('value (let ((tmp-file (org-babel-temp-file "lua-"))) + (`value (let ((tmp-file (org-babel-temp-file "lua-"))) (org-babel-eval org-babel-lua-command (concat @@ -364,7 +364,7 @@ fd:close()" (funcall send-wait))) (results (pcase result-type - ('output + (`output (mapconcat #'org-trim (butlast @@ -375,7 +375,7 @@ fd:close()" (insert org-babel-lua-eoe-indicator) (funcall send-wait)) 2) "\n")) - ('value + (`value (let ((tmp-file (org-babel-temp-file "lua-"))) (org-babel-comint-with-output (session org-babel-lua-eoe-indicator nil body) diff --git a/lisp/org/ob-octave.el b/lisp/org/ob-octave.el index f19b6ccf25..c7339cf992 100644 --- a/lisp/org/ob-octave.el +++ b/lisp/org/ob-octave.el @@ -178,14 +178,14 @@ value of the last statement in BODY, as elisp." org-babel-matlab-shell-command org-babel-octave-shell-command))) (pcase result-type - ('output (org-babel-eval cmd body)) - ('value (let ((tmp-file (org-babel-temp-file "octave-"))) - (org-babel-eval - cmd - (format org-babel-octave-wrapper-method body - (org-babel-process-file-name tmp-file 'noquote) - (org-babel-process-file-name tmp-file 'noquote))) - (org-babel-octave-import-elisp-from-file tmp-file)))))) + (`output (org-babel-eval cmd body)) + (`value (let ((tmp-file (org-babel-temp-file "octave-"))) + (org-babel-eval + cmd + (format org-babel-octave-wrapper-method body + (org-babel-process-file-name tmp-file 'noquote) + (org-babel-process-file-name tmp-file 'noquote))) + (org-babel-octave-import-elisp-from-file tmp-file)))))) (defun org-babel-octave-evaluate-session (session body result-type &optional matlabp) @@ -194,11 +194,11 @@ value of the last statement in BODY, as elisp." (wait-file (org-babel-temp-file "matlab-emacs-link-wait-signal-")) (full-body (pcase result-type - ('output + (`output (mapconcat #'org-babel-chomp (list body org-babel-octave-eoe-indicator) "\n")) - ('value + (`value (if (and matlabp org-babel-matlab-with-emacs-link) (concat (format org-babel-matlab-emacs-link-wrapper-method @@ -232,9 +232,9 @@ value of the last statement in BODY, as elisp." t full-body) (insert full-body) (comint-send-input nil t)))) results) (pcase result-type - ('value + (`value (org-babel-octave-import-elisp-from-file tmp-file)) - ('output + (`output (setq results (if matlabp (cdr (reverse (delq "" (mapcar diff --git a/lisp/org/ob-perl.el b/lisp/org/ob-perl.el index adb62ce50b..85806fd533 100644 --- a/lisp/org/ob-perl.el +++ b/lisp/org/ob-perl.el @@ -136,12 +136,12 @@ return the value of the last statement in BODY, as elisp." tmp-file 'noquote))) (let ((results (pcase result-type - ('output + (`output (with-temp-file tmp-file (insert (org-babel-eval org-babel-perl-command body)) (buffer-string))) - ('value + (`value (org-babel-eval org-babel-perl-command (format org-babel-perl-wrapper-method body tmp-babel-file)))))) diff --git a/lisp/org/ob-python.el b/lisp/org/ob-python.el index 3f1bbf1cb3..9f1234bac5 100644 --- a/lisp/org/ob-python.el +++ b/lisp/org/ob-python.el @@ -265,10 +265,10 @@ string. If RESULT-TYPE equals `value' then return the value of the last statement in BODY, as elisp." (let ((raw (pcase result-type - ('output (org-babel-eval org-babel-python-command + (`output (org-babel-eval org-babel-python-command (concat (if preamble (concat preamble "\n")) body))) - ('value (let ((tmp-file (org-babel-temp-file "python-"))) + (`value (let ((tmp-file (org-babel-temp-file "python-"))) (org-babel-eval org-babel-python-command (concat @@ -314,7 +314,7 @@ last statement in BODY, as elisp." (funcall send-wait))) (results (pcase result-type - ('output + (`output (let ((body (if (string-match-p ".\n+." body) ; Multiline (let ((tmp-src-file (org-babel-temp-file "python-"))) @@ -332,7 +332,7 @@ last statement in BODY, as elisp." (insert org-babel-python-eoe-indicator) (funcall send-wait)) 2) "\n"))) - ('value + (`value (let ((tmp-file (org-babel-temp-file "python-"))) (org-babel-comint-with-output (session org-babel-python-eoe-indicator nil body) diff --git a/lisp/org/ob-ref.el b/lisp/org/ob-ref.el index 88a93294db..3efa17f960 100644 --- a/lisp/org/ob-ref.el +++ b/lisp/org/ob-ref.el @@ -166,11 +166,11 @@ Emacs Lisp representation of the value of the variable." (goto-char (org-element-property :post-affiliated e)) (pcase (org-element-type e) - ('babel-call + (`babel-call (throw :found (org-babel-execute-src-block nil (org-babel-lob-get-info e) params))) - ('src-block + (`src-block (throw :found (org-babel-execute-src-block nil nil diff --git a/lisp/org/ob-ruby.el b/lisp/org/ob-ruby.el index bb06b008a6..7686ac4e80 100644 --- a/lisp/org/ob-ruby.el +++ b/lisp/org/ob-ruby.el @@ -200,8 +200,8 @@ return the value of the last statement in BODY, as elisp." (if (not buffer) ;; external process evaluation (pcase result-type - ('output (org-babel-eval org-babel-ruby-command body)) - ('value (let ((tmp-file (org-babel-temp-file "ruby-"))) + (`output (org-babel-eval org-babel-ruby-command body)) + (`value (let ((tmp-file (org-babel-temp-file "ruby-"))) (org-babel-eval org-babel-ruby-command (format (if (member "pp" result-params) @@ -211,7 +211,7 @@ return the value of the last statement in BODY, as elisp." (org-babel-eval-read-file tmp-file)))) ;; comint session evaluation (pcase result-type - ('output + (`output (let ((eoe-string (format "puts \"%s\"" org-babel-ruby-eoe-indicator))) ;; Force the session to be ready before the actual session ;; code is run. There is some problem in comint that will @@ -238,7 +238,7 @@ return the value of the last statement in BODY, as elisp." "conf.prompt_mode=_org_prompt_mode;conf.echo=true" eoe-string))) "\n") "[\r\n]") 4) "\n"))) - ('value + (`value (let* ((tmp-file (org-babel-temp-file "ruby-")) (ppp (or (member "code" result-params) (member "pp" result-params)))) diff --git a/lisp/org/ob-sql.el b/lisp/org/ob-sql.el index cdedf7edfb..959ede3dec 100644 --- a/lisp/org/ob-sql.el +++ b/lisp/org/ob-sql.el @@ -175,16 +175,16 @@ This function is called by `org-babel-execute-src-block'." (org-babel-temp-file "sql-out-"))) (header-delim "") (command (pcase (intern engine) - ('dbi (format "dbish --batch %s < %s | sed '%s' > %s" + (`dbi (format "dbish --batch %s < %s | sed '%s' > %s" (or cmdline "") (org-babel-process-file-name in-file) "/^+/d;s/^|//;s/(NULL)/ /g;$d" (org-babel-process-file-name out-file))) - ('monetdb (format "mclient -f tab %s < %s > %s" + (`monetdb (format "mclient -f tab %s < %s > %s" (or cmdline "") (org-babel-process-file-name in-file) (org-babel-process-file-name out-file))) - ('mssql (format "sqlcmd %s -s \"\t\" %s -i %s -o %s" + (`mssql (format "sqlcmd %s -s \"\t\" %s -i %s -o %s" (or cmdline "") (org-babel-sql-dbstring-mssql dbhost dbuser dbpassword database) @@ -192,14 +192,14 @@ This function is called by `org-babel-execute-src-block'." (org-babel-process-file-name in-file)) (org-babel-sql-convert-standard-filename (org-babel-process-file-name out-file)))) - ('mysql (format "mysql %s %s %s < %s > %s" + (`mysql (format "mysql %s %s %s < %s > %s" (org-babel-sql-dbstring-mysql dbhost dbport dbuser dbpassword database) (if colnames-p "" "-N") (or cmdline "") (org-babel-process-file-name in-file) (org-babel-process-file-name out-file))) - ('postgresql (format + (`postgresql (format "%spsql --set=\"ON_ERROR_STOP=1\" %s -A -P \ footer=off -F \"\t\" %s -f %s -o %s %s" (if dbpassword @@ -211,7 +211,7 @@ footer=off -F \"\t\" %s -f %s -o %s %s" (org-babel-process-file-name in-file) (org-babel-process-file-name out-file) (or cmdline ""))) - ('sqsh (format "sqsh %s %s -i %s -o %s -m csv" + (`sqsh (format "sqsh %s %s -i %s -o %s -m csv" (or cmdline "") (org-babel-sql-dbstring-sqsh dbhost dbuser dbpassword database) @@ -219,13 +219,13 @@ footer=off -F \"\t\" %s -f %s -o %s %s" (org-babel-process-file-name in-file)) (org-babel-sql-convert-standard-filename (org-babel-process-file-name out-file)))) - ('vertica (format "vsql %s -f %s -o %s %s" - (org-babel-sql-dbstring-vertica - dbhost dbport dbuser dbpassword database) - (org-babel-process-file-name in-file) - (org-babel-process-file-name out-file) - (or cmdline ""))) - ('oracle (format + (`vertica (format "vsql %s -f %s -o %s %s" + (org-babel-sql-dbstring-vertica + dbhost dbport dbuser dbpassword database) + (org-babel-process-file-name in-file) + (org-babel-process-file-name out-file) + (or cmdline ""))) + (`oracle (format "sqlplus -s %s < %s > %s" (org-babel-sql-dbstring-oracle dbhost dbport dbuser dbpassword database) @@ -235,8 +235,8 @@ footer=off -F \"\t\" %s -f %s -o %s %s" (with-temp-file in-file (insert (pcase (intern engine) - ('dbi "/format partbox\n") - ('oracle "SET PAGESIZE 50000 + (`dbi "/format partbox\n") + (`oracle "SET PAGESIZE 50000 SET NEWPAGE 0 SET TAB OFF SET SPACE 0 @@ -249,10 +249,10 @@ SET MARKUP HTML OFF SPOOL OFF SET COLSEP '|' ") - ((or 'mssql 'sqsh) "SET NOCOUNT ON + ((or `mssql `sqsh) "SET NOCOUNT ON ") - ('vertica "\\a\n") + (`vertica "\\a\n") (_ "")) (org-babel-expand-body:sql body params) ;; "sqsh" requires "go" inserted at EOF. diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index d92fbaf897..98e89eb1c4 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -6213,12 +6213,12 @@ scheduled items with an hour specification like [h]h:mm." (or (not (memq (line-beginning-position 0) deadline-pos)) habitp)) nil) - ('repeated-after-deadline + (`repeated-after-deadline (let ((deadline (time-to-days (org-get-deadline-time (point))))) (and (<= schedule deadline) (> current deadline)))) - ('not-today pastschedp) - ('t t) + (`not-today pastschedp) + (`t t) (_ nil)) (throw :skip nil)) ;; Skip habits if `org-habit-show-habits' is nil, or if we diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el index f51eee56b7..3de386c69d 100644 --- a/lisp/org/org-capture.el +++ b/lisp/org/org-capture.el @@ -1042,7 +1042,7 @@ Store them in the capture property list." (org-capture-put :exact-position (point)) (setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p)))) - ('(clock) + (`(clock) (if (and (markerp org-clock-hd-marker) (marker-buffer org-clock-hd-marker)) (progn (set-buffer (marker-buffer org-clock-hd-marker)) @@ -1101,11 +1101,11 @@ may have been stored before." (goto-char (org-capture-get :pos)) (setq-local outline-level 'org-outline-level) (pcase (org-capture-get :type) - ((or 'nil 'entry) (org-capture-place-entry)) - ('table-line (org-capture-place-table-line)) - ('plain (org-capture-place-plain-text)) - ('item (org-capture-place-item)) - ('checkitem (org-capture-place-item))) + ((or `nil `entry) (org-capture-place-entry)) + (`table-line (org-capture-place-table-line)) + (`plain (org-capture-place-plain-text)) + (`item (org-capture-place-item)) + (`checkitem (org-capture-place-item))) (org-capture-mode 1) (setq-local org-capture-current-plist org-capture-plist)) @@ -1791,7 +1791,7 @@ The template may still contain \"%?\" for cursor positioning." (let ((insert-fun (if (equal key "C") #'insert (lambda (s) (org-insert-link 0 s))))) (pcase org-capture--clipboards - ('nil nil) + (`nil nil) (`(,value) (funcall insert-fun value)) (`(,first-value . ,_) (funcall insert-fun @@ -1811,7 +1811,7 @@ The template may still contain \"%?\" for cursor positioning." time (or org-time-was-given upcase?) (member key '("u" "U")) nil nil (list org-end-time-was-given)))) - ('nil + (`nil ;; Load history list for current prompt. (setq org-capture--prompt-history (gethash prompt org-capture--prompt-history-table)) diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el index 0940c12147..9be0d5bc1f 100644 --- a/lisp/org/org-clock.el +++ b/lisp/org/org-clock.el @@ -1692,11 +1692,11 @@ Optional argument N tells to change by that many units." (org-timestamp-change (round (/ (float-time tdiff) (pcase timestamp? - ('minute 60) - ('hour 3600) - ('day (* 24 3600)) - ('month (* 24 3600 31)) - ('year (* 24 3600 365.2))))) + (`minute 60) + (`hour 3600) + (`day (* 24 3600)) + (`month (* 24 3600 31)) + (`year (* 24 3600 365.2))))) timestamp? 'updown))))))) ;;;###autoload @@ -2045,7 +2045,7 @@ in the buffer and update it." (org-find-dblock "clocktable") (org-show-entry)) (pcase (org-in-clocktable-p) - ('nil + (`nil (org-create-dblock (org-combine-plists (list :scope (if (org-before-first-heading-p) 'file 'subtree)) @@ -2194,21 +2194,21 @@ have priority." (error "Looking forward with quarters isn't implemented")))) (when (= shift 0) (pcase key - ('yesterday (setq key 'today shift -1)) - ('lastweek (setq key 'week shift -1)) - ('lastmonth (setq key 'month shift -1)) - ('lastyear (setq key 'year shift -1)) - ('lastq (setq key 'quarter shift -1)))) + (`yesterday (setq key 'today shift -1)) + (`lastweek (setq key 'week shift -1)) + (`lastmonth (setq key 'month shift -1)) + (`lastyear (setq key 'year shift -1)) + (`lastq (setq key 'quarter shift -1)))) ;; Prepare start and end times depending on KEY's type. (pcase key - ((or 'day 'today) (setq m 0 h 0 h1 24 d (+ d shift))) - ((or 'week 'thisweek) + ((or `day `today) (setq m 0 h 0 h1 24 d (+ d shift))) + ((or `week `thisweek) (let* ((ws (or wstart 1)) (diff (+ (* -7 shift) (if (= dow 0) (- 7 ws) (- dow ws))))) (setq m 0 h 0 d (- d diff) d1 (+ 7 d)))) - ((or 'month 'thismonth) + ((or `month `thismonth) (setq h 0 m 0 d (or mstart 1) month (+ month shift) month1 (1+ month))) - ((or 'quarter 'thisq) + ((or `quarter `thisq) ;; Compute if this shift remains in this year. If not, compute ;; how many years and quarters we have to shift (via floor*) and ;; compute the shifted years, months and quarters. @@ -2231,13 +2231,13 @@ have priority." (setq shiftedy y) (let ((qshift (* 3 (1- (+ q shift))))) (setq m 0 h 0 d 1 month (+ 1 qshift) month1 (+ 4 qshift)))))) - ((or 'year 'thisyear) + ((or `year `thisyear) (setq m 0 h 0 d 1 month 1 y (+ y shift) y1 (1+ y))) - ((or 'interactive 'untilnow)) ; Special cases, ignore them. + ((or `interactive `untilnow)) ; Special cases, ignore them. (_ (user-error "No such time block %s" key))) ;; Format start and end times according to AS-STRINGS. (let* ((start (pcase key - ('interactive (org-read-date nil t nil "Range start? ")) + (`interactive (org-read-date nil t nil "Range start? ")) ;; In theory, all clocks started after the dawn of ;; humanity. However, the platform's clock ;; support might not go back that far. Choose the @@ -2246,15 +2246,15 @@ have priority." ;; that works, otherwise 0 (1970). Going back ;; billions of years would loop forever on Mac OS ;; X 10.6 with Emacs 26 and earlier (Bug#27736). - ('untilnow + (`untilnow (let ((old 0)) (dolist (older '((-32768 0) (-33554432 0)) old) (when (ignore-errors (decode-time older)) (setq old older))))) (_ (encode-time 0 m h d month y)))) (end (pcase key - ('interactive (org-read-date nil t nil "Range end? ")) - ('untilnow (current-time)) + (`interactive (org-read-date nil t nil "Range end? ")) + (`untilnow (current-time)) (_ (encode-time 0 (or m1 m) (or h1 h) @@ -2263,15 +2263,15 @@ have priority." (or y1 y))))) (text (pcase key - ((or 'day 'today) (format-time-string "%A, %B %d, %Y" start)) - ((or 'week 'thisweek) (format-time-string "week %G-W%V" start)) - ((or 'month 'thismonth) (format-time-string "%B %Y" start)) - ((or 'year 'thisyear) (format-time-string "the year %Y" start)) - ((or 'quarter 'thisq) + ((or `day `today) (format-time-string "%A, %B %d, %Y" start)) + ((or `week `thisweek) (format-time-string "week %G-W%V" start)) + ((or `month `thismonth) (format-time-string "%B %Y" start)) + ((or `year `thisyear) (format-time-string "the year %Y" start)) + ((or `quarter `thisq) (concat (org-count-quarter shiftedq) " quarter of " (number-to-string shiftedy))) - ('interactive "(Range interactively set)") - ('untilnow "now")))) + (`interactive "(Range interactively set)") + (`untilnow "now")))) (if (not as-strings) (list start end text) (let ((f (cdr org-time-stamp-formats))) (list (format-time-string f start) @@ -2375,11 +2375,11 @@ the currently selected interval size." (catch 'exit (let* ((scope (plist-get params :scope)) (files (pcase scope - ('agenda + (`agenda (org-agenda-files t)) - ('agenda-with-archives + (`agenda-with-archives (org-add-archive-files (org-agenda-files t))) - ('file-with-archives + (`file-with-archives (and buffer-file-name (org-add-archive-files (list buffer-file-name)))) ((pred functionp) (funcall scope)) @@ -2502,7 +2502,7 @@ from the dynamic block definition." (setq narrow (intern (format "%d!" narrow)))) (pcase narrow - ((or 'nil (pred integerp)) nil) ;nothing to do + ((or `nil (pred integerp)) nil) ;nothing to do ((and (pred symbolp) (guard (string-match-p "\\`[0-9]+!\\'" (symbol-name narrow)))) (setq narrow-cut-p t) diff --git a/lisp/org/org-colview.el b/lisp/org/org-colview.el index e6464ab8a1..cb5c091d0a 100644 --- a/lisp/org/org-colview.el +++ b/lisp/org/org-colview.el @@ -1379,8 +1379,8 @@ PARAMS is a property list of parameters: (let ((id (plist-get params :id)) view-file view-pos) (pcase id - ('global nil) - ((or 'local 'nil) (setq view-pos (point))) + (`global nil) + ((or `local `nil) (setq view-pos (point))) ((and (let id-string (format "%s" id)) (guard (string-match "^file:\\(.*\\)" id-string))) (setq view-file (match-string-no-properties 1 id-string)) diff --git a/lisp/org/org-duration.el b/lisp/org/org-duration.el index fed864a545..1c962ba94e 100644 --- a/lisp/org/org-duration.el +++ b/lisp/org/org-duration.el @@ -316,10 +316,10 @@ When optional argument CANONICAL is non-nil, ignore Raise an error if expected format is unknown." (pcase (or fmt org-duration-format) - ('h:mm + (`h:mm (let ((minutes (floor minutes))) (format "%d:%02d" (/ minutes 60) (mod minutes 60)))) - ('h:mm:ss + (`h:mm:ss (let* ((whole-minutes (floor minutes)) (seconds (floor (* 60 (- minutes whole-minutes))))) (format "%s:%02d" @@ -328,7 +328,7 @@ Raise an error if expected format is unknown." ((pred atom) (error "Invalid duration format specification: %S" fmt)) ;; Mixed format. Call recursively the function on both parts. ((and duration-format - (let `(special . ,(and mode (or 'h:mm:ss 'h:mm))) + (let `(special . ,(and mode (or `h:mm:ss `h:mm))) (assq 'special duration-format))) (let* ((truncated-format ;; Remove "special" mode from duration format in order to diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el index 09840cc44f..b8f1467022 100644 --- a/lisp/org/org-element.el +++ b/lisp/org/org-element.el @@ -588,9 +588,9 @@ is cleared and contents are removed in the process." (when datum (let ((type (org-element-type datum))) (pcase type - ('org-data (list 'org-data nil)) - ('plain-text (substring-no-properties datum)) - ('nil (copy-sequence datum)) + (`org-data (list 'org-data nil)) + (`plain-text (substring-no-properties datum)) + (`nil (copy-sequence datum)) (_ (list type (plist-put (copy-sequence (nth 1 datum)) :parent nil))))))) @@ -1285,9 +1285,9 @@ CONTENTS is the contents of the element." bullet (and counter (format "[@%d] " counter)) (pcase checkbox - ('on "[X] ") - ('off "[ ] ") - ('trans "[-] ") + (`on "[X] ") + (`off "[ ] ") + (`trans "[-] ") (_ nil)) (and tag (format "%s :: " tag)) (when contents @@ -3185,13 +3185,13 @@ CONTENTS is the contents of the object, or nil." ;; a format string, escape percent signs ;; in description. (replace-regexp-in-string "%" "%%" contents))) - ((or 'bracket - 'nil + ((or `bracket + `nil (guard (member type '("coderef" "custom-id" "fuzzy")))) "[[%s]]") ;; Otherwise, just obey to `:format'. - ('angle "<%s>") - ('plain "%s") + (`angle "<%s>") + (`plain "%s") (f (error "Wrong `:format' value: %s" f))))) (format fmt (pcase type @@ -3581,19 +3581,19 @@ Assume point is at the beginning of the timestamp." (let* ((repeat-string (concat (pcase (org-element-property :repeater-type timestamp) - ('cumulate "+") ('catch-up "++") ('restart ".+")) + (`cumulate "+") (`catch-up "++") (`restart ".+")) (let ((val (org-element-property :repeater-value timestamp))) (and val (number-to-string val))) (pcase (org-element-property :repeater-unit timestamp) - ('hour "h") ('day "d") ('week "w") ('month "m") ('year "y")))) + (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y")))) (warning-string (concat (pcase (org-element-property :warning-type timestamp) - ('first "--") ('all "-")) + (`first "--") (`all "-")) (let ((val (org-element-property :warning-value timestamp))) (and val (number-to-string val))) (pcase (org-element-property :warning-unit timestamp) - ('hour "h") ('day "d") ('week "w") ('month "m") ('year "y")))) + (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y")))) (build-ts-string ;; Build an Org timestamp string from TIME. ACTIVEP is ;; non-nil when time stamp is active. If WITH-TIME-P is @@ -3622,7 +3622,7 @@ Assume point is at the beginning of the timestamp." ts))) (type (org-element-property :type timestamp))) (pcase type - ((or 'active 'inactive) + ((or `active `inactive) (let* ((minute-start (org-element-property :minute-start timestamp)) (minute-end (org-element-property :minute-end timestamp)) (hour-start (org-element-property :hour-start timestamp)) @@ -3642,7 +3642,7 @@ Assume point is at the beginning of the timestamp." (and hour-start minute-start) (and time-range-p hour-end) (and time-range-p minute-end)))) - ((or 'active-range 'inactive-range) + ((or `active-range `inactive-range) (let ((minute-start (org-element-property :minute-start timestamp)) (minute-end (org-element-property :minute-end timestamp)) (hour-start (org-element-property :hour-start timestamp)) @@ -4227,17 +4227,17 @@ otherwise. Modes can be either `first-section', `item', `table-row' or nil." (if parentp (pcase type - ('headline 'section) - ('inlinetask 'planning) - ('plain-list 'item) - ('property-drawer 'node-property) - ('section 'planning) - ('table 'table-row)) + (`headline 'section) + (`inlinetask 'planning) + (`plain-list 'item) + (`property-drawer 'node-property) + (`section 'planning) + (`table 'table-row)) (pcase type - ('item 'item) - ('node-property 'node-property) - ('planning 'property-drawer) - ('table-row 'table-row)))) + (`item 'item) + (`node-property 'node-property) + (`planning 'property-drawer) + (`table-row 'table-row)))) (defun org-element--parse-elements (beg end mode structure granularity visible-only acc) @@ -5018,8 +5018,8 @@ the cache." lower element upper element))))) (pcase side - ('both (cons lower upper)) - ('nil lower) + (`both (cons lower upper)) + (`nil lower) (_ upper)))) (defun org-element--cache-put (element) @@ -5513,8 +5513,8 @@ that range. See `after-change-functions' for more information." ;; case for headline editing: if a headline is modified but ;; not removed, do not extend. (when (pcase org-element--cache-change-warning - ('t t) - ('headline + (`t t) + (`headline (not (and (org-with-limited-levels (org-at-heading-p)) (= (line-end-position) bottom)))) (_ diff --git a/lisp/org/org-entities.el b/lisp/org/org-entities.el index 0dae849511..e291b521f9 100644 --- a/lisp/org/org-entities.el +++ b/lisp/org/org-entities.el @@ -38,7 +38,7 @@ (defun org-entities--user-safe-p (v) "Non-nil if V is a safe value for `org-entities-user'." (pcase v - ('nil t) + (`nil t) (`(,(and (pred stringp) (pred (string-match-p "\\`[a-zA-Z][a-zA-Z0-9]*\\'"))) ,(pred stringp) ,(pred booleanp) ,(pred stringp) diff --git a/lisp/org/org-gnus.el b/lisp/org/org-gnus.el index 34087bf21b..a53b343efb 100644 --- a/lisp/org/org-gnus.el +++ b/lisp/org/org-gnus.el @@ -126,14 +126,14 @@ If `org-store-link' was called with a prefix arg the meaning of (defun org-gnus-store-link () "Store a link to a Gnus folder or message." (pcase major-mode - ('gnus-group-mode + (`gnus-group-mode (let ((group (gnus-group-group-name))) (when group (org-store-link-props :type "gnus" :group group) (let ((description (org-gnus-group-link group))) (org-add-link-props :link description :description description) description)))) - ((or 'gnus-summary-mode 'gnus-article-mode) + ((or `gnus-summary-mode `gnus-article-mode) (let* ((group (pcase (gnus-find-method-for-group gnus-newsgroup-name) (`(nnvirtual . ,_) @@ -176,7 +176,7 @@ If `org-store-link' was called with a prefix arg the meaning of (description (org-email-link-description))) (org-add-link-props :link link :description description) link))) - ('message-mode + (`message-mode (setq org-store-link-plist nil) ;reset (save-excursion (save-restriction diff --git a/lisp/org/org-indent.el b/lisp/org/org-indent.el index a0bf7b7379..bf4e998199 100644 --- a/lisp/org/org-indent.el +++ b/lisp/org/org-indent.el @@ -301,8 +301,8 @@ When optional argument HEADING is non-nil, assume line is at a heading. Moreover, if is is `inlinetask', the first star will have `org-warning' face." (let* ((line (aref (pcase heading - ('nil org-indent--text-line-prefixes) - ('inlinetask org-indent--inlinetask-line-prefixes) + (`nil org-indent--text-line-prefixes) + (`inlinetask org-indent--inlinetask-line-prefixes) (_ org-indent--heading-line-prefixes)) level)) (wrap diff --git a/lisp/org/org-info.el b/lisp/org/org-info.el index 390db209d3..6dde36ceba 100644 --- a/lisp/org/org-info.el +++ b/lisp/org/org-info.el @@ -133,12 +133,12 @@ See `org-link-parameters' for details about PATH, DESC and FORMAT." (manual (car parts)) (node (or (nth 1 parts) "Top"))) (pcase format - ('html + (`html (format "%s" (org-info-map-html-url manual) (org-info--expand-node-name node) (or desc path))) - ('texinfo + (`texinfo (let ((title (or desc ""))) (format "@ref{%s,%s,,%s,}" node title manual))) (_ nil)))) diff --git a/lisp/org/org-inlinetask.el b/lisp/org/org-inlinetask.el index 8604e28e22..08fc268d0d 100644 --- a/lisp/org/org-inlinetask.el +++ b/lisp/org/org-inlinetask.el @@ -325,14 +325,14 @@ If the task has an end part, also demote it." "Hide inline tasks in buffer when STATE is `contents' or `children'. This function is meant to be used in `org-cycle-hook'." (pcase state - ('contents + (`contents (let ((regexp (org-inlinetask-outline-regexp))) (save-excursion (goto-char (point-min)) (while (re-search-forward regexp nil t) (org-inlinetask-toggle-visibility) (org-inlinetask-goto-end))))) - ('children + (`children (save-excursion (while (or (org-inlinetask-at-task-p) diff --git a/lisp/org/org-lint.el b/lisp/org/org-lint.el index e719ef8a5b..9fcb17a2db 100644 --- a/lisp/org/org-lint.el +++ b/lisp/org/org-lint.el @@ -427,7 +427,7 @@ instead" (lambda (datum) (let ((key (org-element-property :key datum))) (pcase (org-element-type datum) - ('keyword + (`keyword (let ((value (org-element-property :value datum))) (and (string= key "PROPERTY") (string-match deprecated-re value) @@ -435,7 +435,7 @@ instead" (format "Deprecated syntax for \"%s\". \ Use header-args instead" (match-string-no-properties 1 value)))))) - ('node-property + (`node-property (and (member-ignore-case key deprecated-babel-properties) (list (org-element-property :begin datum) @@ -789,11 +789,11 @@ Use \"export %s\" instead" (let ((name (org-trim (match-string-no-properties 0))) (element (org-element-at-point))) (pcase (org-element-type element) - ((or 'drawer 'property-drawer) + ((or `drawer `property-drawer) (goto-char (org-element-property :end element)) nil) - ((or 'comment-block 'example-block 'export-block 'src-block - 'verse-block) + ((or `comment-block `example-block `export-block `src-block + `verse-block) nil) (_ (push (list (line-beginning-position) @@ -920,7 +920,7 @@ Use \"export %s\" instead" node-property src-block) (lambda (datum) (pcase (org-element-type datum) - ((or 'babel-call 'inline-babel-call) + ((or `babel-call `inline-babel-call) (funcall verify datum nil @@ -928,13 +928,13 @@ Use \"export %s\" instead" (list (org-element-property :inside-header datum) (org-element-property :end-header datum))))) - ('inline-src-block + (`inline-src-block (funcall verify datum (org-element-property :language datum) (org-babel-parse-header-arguments (org-element-property :parameters datum)))) - ('keyword + (`keyword (when (string= (org-element-property :key datum) "PROPERTY") (let ((value (org-element-property :value datum))) (when (string-match "\\`header-args\\(?::\\(\\S-+\\)\\)?\\+? *" @@ -944,7 +944,7 @@ Use \"export %s\" instead" (match-string 1 value) (org-babel-parse-header-arguments (substring value (match-end 0)))))))) - ('node-property + (`node-property (let ((key (org-element-property :key datum))) (when (let ((case-fold-search t)) (string-match "\\`HEADER-ARGS\\(?::\\(\\S-+\\)\\)?\\+?" @@ -954,7 +954,7 @@ Use \"export %s\" instead" (match-string 1 key) (org-babel-parse-header-arguments (org-element-property :value datum)))))) - ('src-block + (`src-block (funcall verify datum (org-element-property :language datum) @@ -980,13 +980,13 @@ Use \"export %s\" instead" (org-babel-parse-header-arguments (org-trim (pcase type - ('src-block + (`src-block (mapconcat #'identity (cons (org-element-property :parameters datum) (org-element-property :header datum)) " ")) - ('inline-src-block + (`inline-src-block (or (org-element-property :parameters datum) "")) (_ (concat @@ -1065,9 +1065,9 @@ Use \"export %s\" instead" \\{org-lint--report-mode-map}" (setf tabulated-list-format `[("Line" 6 - ,(lambda (a b) - (< (string-to-number (aref (cadr a) 0)) - (string-to-number (aref (cadr b) 0)))) + (lambda (a b) + (< (string-to-number (aref (cadr a) 0)) + (string-to-number (aref (cadr b) 0)))) :right-align t) ("Trust" 5 t) ("Warning" 0 t)]) @@ -1207,8 +1207,8 @@ ARG can also be a list of checker names, as symbols, to run." (message "Org linting process starting...")) (let ((checkers (pcase arg - ('nil org-lint--checkers) - ('(4) + (`nil org-lint--checkers) + (`(4) (let ((category (completing-read "Checker category: " @@ -1218,7 +1218,7 @@ ARG can also be a list of checker names, as symbols, to run." (lambda (c) (assoc-string (org-lint-checker-categories c) category)) org-lint--checkers))) - ('(16) + (`(16) (list (let ((name (completing-read "Checker name: " diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el index b54d4aa2e5..1f51809f1c 100644 --- a/lisp/org/org-list.el +++ b/lisp/org/org-list.el @@ -3438,15 +3438,15 @@ PARAMS is a plist used to tweak the behavior of the transcoder." (start (and (not splice) (org-list--generic-eval (pcase type - ('ordered ostart) - ('unordered ustart) + (`ordered ostart) + (`unordered ustart) (_ dstart)) depth))) (end (and (not splice) (org-list--generic-eval (pcase type - ('ordered oend) - ('unordered uend) + (`ordered oend) + (`unordered uend) (_ dend)) depth)))) ;; Make sure trailing newlines in END appear in the output by @@ -3485,7 +3485,7 @@ PARAMS is a plist used to tweak the behavior of the transcoder." (separator (and (org-export-get-next-element item info) (org-list--generic-eval isep type depth))) (closing (pcase (org-list--generic-eval iend type depth) - ((or 'nil "") "\n") + ((or `nil "") "\n") ((and (guard separator) s) (if (equal (substring s -1) "\n") s (concat s "\n"))) (s s)))) @@ -3510,9 +3510,9 @@ PARAMS is a plist used to tweak the behavior of the transcoder." (or dtstart dtend ddstart ddend))) (concat (pcase (org-element-property :checkbox item) - ('on cbon) - ('off cboff) - ('trans cbtrans)) + (`on cbon) + (`off cboff) + (`trans cbtrans)) (and tag (concat dtstart (if backend @@ -3582,8 +3582,8 @@ with overruling parameters for `org-list-to-generic'." LIST is as returned by `org-list-to-lisp'. PARAMS is a property list with overruling parameters for `org-list-to-generic'." (let* ((blank (pcase (cdr (assq 'heading org-blank-before-new-entry)) - ('t t) - ('auto (save-excursion + (`t t) + (`auto (save-excursion (org-with-limited-levels (outline-previous-heading)) (org-previous-line-empty-p))))) (level (org-reduced-level (or (org-current-level) 0))) diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el index 74de498e88..5a10b59b1e 100644 --- a/lisp/org/org-mouse.el +++ b/lisp/org/org-mouse.el @@ -416,7 +416,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (let ((kwds org-todo-keywords-1)) (org-mouse-keyword-menu kwds - (lambda (kwd) (org-todo kwd)) + `(lambda (kwd) (org-todo kwd)) (lambda (kwd) (equal state kwd)))))) (defun org-mouse-tag-menu () ;todo @@ -461,11 +461,11 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (defun org-mouse-agenda-type (type) (pcase type - ('tags "Tags: ") - ('todo "TODO: ") - ('tags-tree "Tags tree: ") - ('todo-tree "TODO tree: ") - ('occur-tree "Occur tree: ") + (`tags "Tags: ") + (`todo "TODO: ") + (`tags-tree "Tags tree: ") + (`todo-tree "TODO tree: ") + (`occur-tree "Occur tree: ") (_ "Agenda command ???"))) (defun org-mouse-list-options-menu (alloptions &optional function) diff --git a/lisp/org/org-plot.el b/lisp/org/org-plot.el index 38a81f68b1..ebd7af42a8 100644 --- a/lisp/org/org-plot.el +++ b/lisp/org/org-plot.el @@ -200,9 +200,9 @@ manner suitable for prepending to a user-specified script." (y-labels (plist-get params :ylabels)) (plot-str "'%s' using %s%d%s with %s title '%s'") (plot-cmd (pcase type - ('2d "plot") - ('3d "splot") - ('grid "splot"))) + (`2d "plot") + (`3d "splot") + (`grid "splot"))) (script "reset") ;; ats = add-to-script (ats (lambda (line) (setf script (concat script "\n" line)))) @@ -211,9 +211,9 @@ manner suitable for prepending to a user-specified script." (funcall ats (format "set term %s" (file-name-extension file))) (funcall ats (format "set output '%s'" file))) (pcase type ; type - ('2d ()) - ('3d (when map (funcall ats "set map"))) - ('grid (funcall ats (if map "set pm3d map" "set pm3d")))) + (`2d ()) + (`3d (when map (funcall ats "set map"))) + (`grid (funcall ats (if map "set pm3d map" "set pm3d")))) (when title (funcall ats (format "set title '%s'" title))) ; title (mapc ats lines) ; line (dolist (el sets) (funcall ats (format "set %s" el))) ; set @@ -239,7 +239,7 @@ manner suitable for prepending to a user-specified script." "%Y-%m-%d-%H:%M:%S") "\""))) (unless preface (pcase type ; plot command - ('2d (dotimes (col num-cols) + (`2d (dotimes (col num-cols) (unless (and (eq type '2d) (or (and ind (equal (1+ col) ind)) (and deps (not (member (1+ col) deps))))) @@ -255,10 +255,10 @@ manner suitable for prepending to a user-specified script." (or (nth col col-labels) (format "%d" (1+ col)))) plot-lines))))) - ('3d + (`3d (setq plot-lines (list (format "'%s' matrix with %s title ''" data-file with)))) - ('grid + (`grid (setq plot-lines (list (format "'%s' with %s title ''" data-file with))))) (funcall ats @@ -303,9 +303,9 @@ line directly before or after the table." (setf params (org-plot/collect-options params)))) ;; Dump table to datafile (very different for grid). (pcase (plist-get params :plot-type) - ('2d (org-plot/gnuplot-to-data table data-file params)) - ('3d (org-plot/gnuplot-to-data table data-file params)) - ('grid (let ((y-labels (org-plot/gnuplot-to-grid-data + (`2d (org-plot/gnuplot-to-data table data-file params)) + (`3d (org-plot/gnuplot-to-data table data-file params)) + (`grid (let ((y-labels (org-plot/gnuplot-to-grid-data table data-file params))) (when y-labels (plist-put params :ylabels y-labels))))) ;; Check for timestamp ind column. diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el index cf746a48bc..829354c0d5 100644 --- a/lisp/org/org-src.el +++ b/lisp/org/org-src.el @@ -742,24 +742,24 @@ If BUFFER is non-nil, test it instead." (defun org-src-switch-to-buffer (buffer context) (pcase org-src-window-setup - ('current-window (pop-to-buffer-same-window buffer)) - ('other-window + (`current-window (pop-to-buffer-same-window buffer)) + (`other-window (switch-to-buffer-other-window buffer)) - ('other-frame + (`other-frame (pcase context - ('exit + (`exit (let ((frame (selected-frame))) (switch-to-buffer-other-frame buffer) (delete-frame frame))) - ('save + (`save (kill-buffer (current-buffer)) (pop-to-buffer-same-window buffer)) (_ (switch-to-buffer-other-frame buffer)))) - ('reorganize-frame + (`reorganize-frame (when (eq context 'edit) (delete-other-windows)) (org-switch-to-buffer-other-window buffer) (when (eq context 'exit) (delete-other-windows))) - ('switch-invisibly (set-buffer buffer)) + (`switch-invisibly (set-buffer buffer)) (_ (message "Invalid value %s for `org-src-window-setup'" org-src-window-setup) diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index f8559d04ef..dcf7430363 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -5127,7 +5127,7 @@ information." ;; Make sure that contents are exported as Org data when :raw ;; parameter is non-nil. ,(when (and backend (plist-get params :raw)) - '(setq contents + `(setq contents ;; Since we don't know what are the pseudo object ;; types defined in backend, we cannot pass them to ;; `org-element-interpret-data'. As a consequence, diff --git a/lisp/org/org.el b/lisp/org/org.el index 4ead31b499..873ae6b820 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -5236,12 +5236,12 @@ When optional argument SKIP-KEY is non-nil, skip selection keys next to tags." (mapconcat (lambda (token) (pcase token - ('(:startgroup) "{") - ('(:endgroup) "}") - ('(:startgrouptag) "[") - ('(:endgrouptag) "]") - ('(:grouptags) ":") - ('(:newline) "\\n") + (`(:startgroup) "{") + (`(:endgroup) "}") + (`(:startgrouptag) "[") + (`(:endgrouptag) "]") + (`(:grouptags) ":") + (`(:newline) "\\n") ((and (guard (not skip-key)) `(,(and tag (pred stringp)) . ,(and key (pred characterp)))) @@ -5266,7 +5266,7 @@ a string, summarizing TAGS, as a list of strings." (when (eq group-status 'append) (push (nreverse current-group) groups)) (setq group-status nil current-group nil)) - ('(:grouptags) (setq group-status 'append)) + (`(:grouptags) (setq group-status 'append)) ((and `(,tag . ,_) (guard group-status)) (if (eq group-status 'append) (push tag current-group) (setq current-group (list tag)))) @@ -7744,7 +7744,7 @@ When NEXT is non-nil, check the next line instead." When optional argument PARENT is non-nil, consider parent headline instead of current one." (pcase (assq 'heading org-blank-before-new-entry) - ('(heading . auto) + (`(heading . auto) (save-excursion (org-with-limited-levels (unless (and (org-before-first-heading-p) @@ -7884,7 +7884,7 @@ When NO-COMMENT is non-nil, don't include COMMENT string." (let ((todo (and (not no-todo) (match-string 2))) (priority (and (not no-priority) (match-string 3))) (headline (pcase (match-string 4) - ('nil "") + (`nil "") ((and (guard no-comment) h) (replace-regexp-in-string (eval-when-compile @@ -8768,7 +8768,7 @@ with the original repeater." (template (buffer-substring beg end)) (shift-n (and doshift (string-to-number (match-string 1 shift)))) (shift-what (pcase (and doshift (match-string 2 shift)) - ('nil nil) + (`nil nil) ("d" 'day) ("w" (setq shift-n (* 7 shift-n)) 'day) ("m" 'month) @@ -9690,7 +9690,7 @@ active region." (push (cons f (copy-sequence org-store-link-plist)) results-alist))) (pcase results-alist - ('nil nil) + (`nil nil) (`((,_ . ,_)) t) ;single choice: nothing to do (`((,name . ,_) . ,_) ;; Reinstate link plist associated to the chosen @@ -11552,13 +11552,13 @@ order.") #'identity (append (pcase org-refile-use-outline-path - ('file (list (file-name-nondirectory + (`file (list (file-name-nondirectory (buffer-file-name (buffer-base-buffer))))) - ('full-file-path + (`full-file-path (list (buffer-file-name (buffer-base-buffer)))) - ('buffer-name + (`buffer-name (list (buffer-name (buffer-base-buffer)))) (_ nil)) @@ -13251,14 +13251,14 @@ TYPE is either `deadline' or `scheduled'. See `org-deadline' or old-date) (match-string 1 old-date))))) (pcase arg - ('(4) + (`(4) (when (and old-date log) (org-add-log-setup (if deadline? 'deldeadline 'delschedule) nil old-date log)) (org-remove-timestamp-with-keyword keyword) (message (if deadline? "Item no longer has a deadline." "Item is no longer scheduled."))) - ('(16) + (`(16) (save-excursion (org-back-to-heading t) (let ((regexp (if deadline? org-deadline-time-regexp @@ -14779,8 +14779,8 @@ If ONOFF is `on' or `off', don't toggle but set to this state." (nreverse (org-split-string tags ":"))))) res) (pcase onoff - ('off (setq current (delete tag current))) - ((or 'on (guard (not (member tag current)))) + (`off (setq current (delete tag current))) + ((or `on (guard (not (member tag current)))) (setq res t) (cl-pushnew tag current :test #'equal)) (_ (setq current (delete tag current)))) @@ -14830,7 +14830,7 @@ If DATA is nil or the empty string, all tags are removed." (interactive "sTags: ") (let ((data (pcase (if (stringp data) (org-trim data) data) - ((or 'nil "") nil) + ((or `nil "") nil) ((pred listp) (format ":%s:" (mapconcat #'identity data ":"))) ((pred stringp) (format ":%s:" @@ -17207,9 +17207,9 @@ The internal representation needed by the calendar is (month day year). This is a wrapper to handle the brain-dead convention in calendar that user function argument order change dependent on argument order." (pcase calendar-date-style - ('american (list arg1 arg2 arg3)) - ('european (list arg2 arg1 arg3)) - ('iso (list arg2 arg3 arg1)))) + (`american (list arg1 arg2 arg3)) + (`european (list arg2 arg1 arg3)) + (`iso (list arg2 arg3 arg1)))) (defun org-eval-in-calendar (form &optional keepdate) "Eval FORM in the calendar window and return to current window. @@ -18015,14 +18015,14 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." (pcase origin-cat ;; `day' category ends before `hour' if any, or at the end ;; of the day name. - ('day (min (or (match-beginning 7) (1- (match-end 5))) origin)) - ('hour (min (match-end 7) origin)) - ('minute (min (1- (match-end 8)) origin)) + (`day (min (or (match-beginning 7) (1- (match-end 5))) origin)) + (`hour (min (match-end 7) origin)) + (`minute (min (1- (match-end 8)) origin)) ((pred integerp) (min (1- (match-end 0)) origin)) ;; Point was right after the time-stamp. However, the ;; time-stamp length might have changed, so refer to ;; (match-end 0) instead. - ('after (match-end 0)) + (`after (match-end 0)) ;; `year' and `month' have both fixed size: point couldn't ;; have moved into another part. (_ origin)))) @@ -20709,7 +20709,7 @@ Otherwise, return a user error." (let ((element (org-element-at-point))) (barf-if-buffer-read-only) (pcase (org-element-type element) - ('src-block + (`src-block (if (not arg) (org-edit-src-code) (let* ((info (org-babel-get-src-block-info)) (lang (nth 0 info)) @@ -20722,7 +20722,7 @@ Otherwise, return a user error." (switch-to-buffer (funcall (intern (concat "org-babel-prep-session:" lang)) session params)))))) - ('keyword + (`keyword (if (member (org-element-property :key element) '("INCLUDE" "SETUPFILE")) (org-open-link-from-string (format "[[%s]]" @@ -20738,24 +20738,24 @@ Otherwise, return a user error." (match-string 0 value)) (t (user-error "No valid file specified"))))))) (user-error "No special environment to edit here"))) - ('table + (`table (if (eq (org-element-property :type element) 'table.el) (org-edit-table.el) (call-interactively 'org-table-edit-formulas))) ;; Only Org tables contain `table-row' type elements. - ('table-row (call-interactively 'org-table-edit-formulas)) - ('example-block (org-edit-src-code)) - ('export-block (org-edit-export-block)) - ('fixed-width (org-edit-fixed-width-region)) - ('latex-environment (org-edit-latex-environment)) + (`table-row (call-interactively 'org-table-edit-formulas)) + (`example-block (org-edit-src-code)) + (`export-block (org-edit-export-block)) + (`fixed-width (org-edit-fixed-width-region)) + (`latex-environment (org-edit-latex-environment)) (_ ;; No notable element at point. Though, we may be at a link or ;; a footnote reference, which are objects. Thus, scan deeper. (let ((context (org-element-context element))) (pcase (org-element-type context) - ('footnote-reference (org-edit-footnote-reference)) - ('inline-src-block (org-edit-inline-src-code)) - ('link (call-interactively #'ffap)) + (`footnote-reference (org-edit-footnote-reference)) + (`inline-src-block (org-edit-inline-src-code)) + (`link (call-interactively #'ffap)) (_ (user-error "No special environment to edit here")))))))) (defvar org-table-coordinate-overlays) ; defined in org-table.el @@ -20842,7 +20842,7 @@ This command does many different things, depending on context: ;; a src block. Hence, we first check if point is in such ;; a block and then if it is at a blank line. (pcase type - ((or 'inline-src-block 'src-block) + ((or `inline-src-block `src-block) (unless org-babel-no-eval-on-ctrl-c-ctrl-c (org-babel-eval-wipe-error-buffer) (org-babel-execute-src-block @@ -20852,22 +20852,22 @@ This command does many different things, depending on context: (user-error (substitute-command-keys "`\\[org-ctrl-c-ctrl-c]' can do nothing useful here")))) - ((or 'babel-call 'inline-babel-call) + ((or `babel-call `inline-babel-call) (let ((info (org-babel-lob-get-info context))) (when info (org-babel-execute-src-block nil info)))) - ('clock (org-clock-update-time-maybe)) - ('dynamic-block + (`clock (org-clock-update-time-maybe)) + (`dynamic-block (save-excursion (goto-char (org-element-property :post-affiliated context)) (org-update-dblock))) - ('footnote-definition + (`footnote-definition (goto-char (org-element-property :post-affiliated context)) (call-interactively 'org-footnote-action)) - ('footnote-reference (call-interactively #'org-footnote-action)) - ((or 'headline 'inlinetask) + (`footnote-reference (call-interactively #'org-footnote-action)) + ((or `headline `inlinetask) (save-excursion (goto-char (org-element-property :begin context)) (call-interactively #'org-set-tags))) - ('item + (`item ;; At an item: `C-u C-u' sets checkbox to "[-]" ;; unconditionally, whereas `C-u' will toggle its presence. ;; Without a universal argument, if the item has a checkbox, @@ -20905,7 +20905,7 @@ This command does many different things, depending on context: (when block-item (message "Checkboxes were removed due to empty box at line %d" (org-current-line block-item)))))) - ('keyword + (`keyword (let ((org-inhibit-startup-visibility-stuff t) (org-startup-align-all-tables nil)) (when (boundp 'org-table-coordinate-overlays) @@ -20913,7 +20913,7 @@ This command does many different things, depending on context: (setq org-table-coordinate-overlays nil)) (org-save-outline-visibility 'use-markers (org-mode-restart))) (message "Local setup has been refreshed")) - ('plain-list + (`plain-list ;; At a plain list, with a double C-u argument, set ;; checkboxes of each item to "[-]", whereas a single one ;; will toggle their presence according to the state of the @@ -20946,13 +20946,13 @@ This command does many different things, depending on context: struct (org-list-parents-alist struct) old-struct) (org-update-checkbox-count-maybe) (save-excursion (goto-char beginm) (org-list-send-list 'maybe)))) - ((or 'property-drawer 'node-property) + ((or `property-drawer `node-property) (call-interactively #'org-property-action)) - ('radio-target + (`radio-target (call-interactively #'org-update-radio-target-regexp)) - ('statistics-cookie + (`statistics-cookie (call-interactively #'org-update-statistics-cookies)) - ((or 'table 'table-cell 'table-row) + ((or `table `table-cell `table-row) ;; At a table, recalculate every field and align it. Also ;; send the table if necessary. If the table has ;; a `table.el' type, just give up. At a table row or cell, @@ -20975,9 +20975,9 @@ Use `\\[org-edit-special]' to edit table.el tables")) (cond (arg (call-interactively #'org-table-recalculate)) ((org-table-maybe-recalculate-line)) (t (org-table-align)))))) - ((or 'timestamp (and 'planning (guard (org-at-timestamp-p 'lax)))) + ((or `timestamp (and `planning (guard (org-at-timestamp-p 'lax)))) (org-timestamp-change 0 'day)) - ((and 'nil (guard (org-at-heading-p))) + ((and `nil (guard (org-at-heading-p))) ;; When point is on an unsupported object type, we can miss ;; the fact that it also is at a heading. Handle it here. (call-interactively #'org-set-tags)) diff --git a/lisp/org/ox-ascii.el b/lisp/org/ox-ascii.el index 5b9db49715..c3ccb596aa 100644 --- a/lisp/org/ox-ascii.el +++ b/lisp/org/ox-ascii.el @@ -549,8 +549,8 @@ INFO is a plist used as a communication channel." INFO is a plist used as a communication channel." (pcase (org-element-type element) ;; Elements with an absolute width: `headline' and `inlinetask'. - ('inlinetask (plist-get info :ascii-inlinetask-width)) - ('headline + (`inlinetask (plist-get info :ascii-inlinetask-width)) + (`headline (- (plist-get info :ascii-text-width) (let ((low-level-rank (org-export-low-level-p element info))) (if low-level-rank (* low-level-rank 2) @@ -624,8 +624,8 @@ Return value is a symbol among `left', `center', `right' and (while (and (not justification) (setq element (org-element-property :parent element))) (pcase (org-element-type element) - ('center-block (setq justification 'center)) - ('special-block + (`center-block (setq justification 'center)) + (`special-block (let ((name (org-element-property :type element))) (cond ((string= name "JUSTIFYRIGHT") (setq justification 'right)) ((string= name "JUSTIFYLEFT") (setq justification 'left))))))) @@ -724,8 +724,8 @@ caption keyword." element info nil 'org-ascii--has-caption-p)) (title-fmt (org-ascii--translate (pcase (org-element-type element) - ('table "Table %d:") - ('src-block "Listing %d:")) + (`table "Table %d:") + (`src-block "Listing %d:")) info))) (org-ascii--fill-string (concat (format title-fmt reference) @@ -890,8 +890,8 @@ If DATUM is a string, consider it to be a file name, per `org-export-resolve-id-link'. INFO is the communication channel, as a plist." (pcase (org-element-type datum) - ('plain-text (format "See file %s" datum)) ;External file - ('headline + (`plain-text (format "See file %s" datum)) ;External file + (`headline (format (org-ascii--translate "See section %s" info) (if (org-export-numbered-headline-p datum info) (mapconcat #'number-to-string @@ -907,7 +907,7 @@ as a plist." (org-element-lineage datum '(headline paragraph src-block table) t))) (pcase (org-element-type enumerable) - ('headline + (`headline (format (org-ascii--translate "See section %s" info) (if (org-export-numbered-headline-p enumerable info) (mapconcat #'number-to-string number ".") @@ -915,11 +915,11 @@ as a plist." (org-element-property :title enumerable) info)))) ((guard (not number)) (org-ascii--translate "Unknown reference" info)) - ('paragraph + (`paragraph (format (org-ascii--translate "See figure %s" info) number)) - ('src-block + (`src-block (format (org-ascii--translate "See listing %s" info) number)) - ('table + (`table (format (org-ascii--translate "See table %s" info) number)) (_ (org-ascii--translate "Unknown reference" info))))))) @@ -970,9 +970,9 @@ channel." INFO is a plist used as a communication channel." (let ((utf8p (eq (plist-get info :ascii-charset) 'utf-8))) (pcase (org-element-property :checkbox item) - ('on (if utf8p "â‘ " "[X] ")) - ('off (if utf8p "â " "[ ] ")) - ('trans (if utf8p "â’ " "[-] "))))) + (`on (if utf8p "â‘ " "[X] ")) + (`off (if utf8p "â " "[ ] ")) + (`trans (if utf8p "â’ " "[-] "))))) @@ -1450,11 +1450,11 @@ contextual information." ;; First parent of ITEM is always the plain-list. Get ;; `:type' property from it. (pcase list-type - ('descriptive + (`descriptive (concat checkbox (org-export-data (org-element-property :tag item) info))) - ('ordered + (`ordered ;; Return correct number for ITEM, paying attention to ;; counters. (let* ((struct (org-element-property :structure item)) @@ -1586,8 +1586,8 @@ INFO is a plist holding contextual information." (format " (%s)" (org-ascii--describe-datum destination info))))) ;; External file. - ('plain-text destination) - ('headline + (`plain-text destination) + (`headline (if (org-export-numbered-headline-p destination info) (mapconcat #'number-to-string (org-export-get-headline-number destination info) diff --git a/lisp/org/ox-html.el b/lisp/org/ox-html.el index dd61ad926c..6166a4ad01 100644 --- a/lisp/org/ox-html.el +++ b/lisp/org/ox-html.el @@ -624,12 +624,12 @@ export back-end currently used." (match-string 1 options) default))) (pcase opt - ('path (setq template + (`path (setq template (replace-regexp-in-string "%SCRIPT_PATH" val template t t))) - ('sdepth (when (integerp (read val)) + (`sdepth (when (integerp (read val)) (setq sdepth (min (read val) sdepth)))) - ('tdepth (when (integerp (read val)) + (`tdepth (when (integerp (read val)) (setq tdepth (min (read val) tdepth)))) (_ (setq val (cond @@ -2739,19 +2739,19 @@ INFO is a plist holding contextual information. See (extra-newline (if (and (org-string-nw-p contents) headline) "\n" ""))) (concat (pcase type - ('ordered + (`ordered (let* ((counter term-counter-id) (extra (if counter (format " value=\"%s\"" counter) ""))) (concat (format "" class extra) (when headline (concat headline br))))) - ('unordered + (`unordered (let* ((id term-counter-id) (extra (if id (format " id=\"%s\"" id) ""))) (concat (format "" class extra) (when headline (concat headline br))))) - ('descriptive + (`descriptive (let* ((term term-counter-id)) (setq term (or term "(no term)")) ;; Check-boxes in descriptive lists are associated to tag. @@ -2763,9 +2763,9 @@ INFO is a plist holding contextual information. See (and (org-string-nw-p contents) (org-trim contents)) extra-newline (pcase type - ('ordered "") - ('unordered "") - ('descriptive ""))))) + (`ordered "") + (`unordered "") + (`descriptive ""))))) (defun org-html-item (item contents info) "Transcode an ITEM element from Org to HTML. @@ -2902,8 +2902,8 @@ if its description is a single link targeting an image file." (cons 'plain-text org-element-all-objects) (lambda (obj) (pcase (org-element-type obj) - ('plain-text (org-string-nw-p obj)) - ('link (if (= link-count 1) t + (`plain-text (org-string-nw-p obj)) + (`link (if (= link-count 1) t (cl-incf link-count) (not (org-export-inline-image-p obj (plist-get info :html-inline-image-rules))))) @@ -2930,8 +2930,8 @@ images, set it to: (lambda (paragraph) (org-element-property :caption paragraph))" (let ((paragraph (pcase (org-element-type element) - ('paragraph element) - ('link (org-export-get-parent element))))) + (`paragraph element) + (`link (org-export-get-parent element))))) (and (eq (org-element-type paragraph) 'paragraph) (or (not (fboundp 'org-html-standalone-image-predicate)) (funcall org-html-standalone-image-predicate paragraph)) @@ -2941,8 +2941,8 @@ images, set it to: (cons 'plain-text org-element-all-objects) (lambda (obj) (when (pcase (org-element-type obj) - ('plain-text (org-string-nw-p obj)) - ('link (or (> (cl-incf link-count) 1) + (`plain-text (org-string-nw-p obj)) + (`link (or (> (cl-incf link-count) 1) (not (org-html-inline-image-p obj info)))) (_ t)) (throw 'exit nil))) @@ -3046,7 +3046,7 @@ INFO is a plist holding contextual information. See (org-export-resolve-id-link link info)))) (pcase (org-element-type destination) ;; ID link points to an external file. - ('plain-text + (`plain-text (let ((fragment (concat "ID-" path)) ;; Treat links to ".org" files as ".html", if needed. (path (funcall link-org-files-as-html-maybe @@ -3054,13 +3054,13 @@ INFO is a plist holding contextual information. See (format "%s" path fragment attributes (or desc destination)))) ;; Fuzzy link points nowhere. - ('nil + (`nil (format "%s" (or desc (org-export-data (org-element-property :raw-link link) info)))) ;; Link points to a headline. - ('headline + (`headline (let ((href (or (org-element-property :CUSTOM_ID destination) (org-export-get-reference destination info))) ;; What description to use? @@ -3189,9 +3189,9 @@ the plist used as a communication channel." CONTENTS is the contents of the list. INFO is a plist holding contextual information." (let* ((type (pcase (org-element-property :type plain-list) - ('ordered "ol") - ('unordered "ul") - ('descriptive "dl") + (`ordered "ol") + (`unordered "ul") + (`descriptive "dl") (other (error "Unknown HTML list type: %s" other)))) (class (format "org-%s" type)) (attributes (org-export-read-attribute :attr_html plain-list))) diff --git a/lisp/org/ox-latex.el b/lisp/org/ox-latex.el index 332e42b7b9..5aaaf991fd 100644 --- a/lisp/org/ox-latex.el +++ b/lisp/org/ox-latex.el @@ -2434,7 +2434,7 @@ used as a communication channel." nil t)))) ;; Return proper string, depending on FLOAT. (pcase float - ('wrap (format "\\begin{wrapfigure}%s + (`wrap (format "\\begin{wrapfigure}%s %s%s %s%s %s\\end{wrapfigure}" @@ -2443,7 +2443,7 @@ used as a communication channel." (if center "\\centering" "") comment-include image-code (if caption-above-p "" caption))) - ('sideways (format "\\begin{sidewaysfigure} + (`sideways (format "\\begin{sidewaysfigure} %s%s %s%s %s\\end{sidewaysfigure}" @@ -2451,7 +2451,7 @@ used as a communication channel." (if center "\\centering" "") comment-include image-code (if caption-above-p "" caption))) - ('multicolumn (format "\\begin{figure*}%s + (`multicolumn (format "\\begin{figure*}%s %s%s %s%s %s\\end{figure*}" @@ -2460,7 +2460,7 @@ used as a communication channel." (if center "\\centering" "") comment-include image-code (if caption-above-p "" caption))) - ('figure (format "\\begin{figure}%s + (`figure (format "\\begin{figure}%s %s%s %s%s %s\\end{figure}" @@ -2767,12 +2767,12 @@ containing export options. Modify DATA by side-effect and return it." ;; Non-nil when OBJ can be added to the latex math block B. (lambda (obj b) (pcase (org-element-type obj) - ('entity (org-element-property :latex-math-p obj)) - ('latex-fragment + (`entity (org-element-property :latex-math-p obj)) + (`latex-fragment (let ((value (org-element-property :value obj))) (or (string-prefix-p "\\(" value) (string-match-p "\\`\\$[^$]" value)))) - ((and type (or 'subscript 'superscript)) + ((and type (or `subscript `superscript)) (not (memq type (mapcar #'org-element-type (org-element-contents b))))))))) (org-element-map data '(entity latex-fragment subscript superscript) diff --git a/lisp/org/ox-man.el b/lisp/org/ox-man.el index aae9c5838e..2bc6392dab 100644 --- a/lisp/org/ox-man.el +++ b/lisp/org/ox-man.el @@ -552,9 +552,9 @@ contextual information." (let* ((bullet (org-element-property :bullet item)) (type (org-element-property :type (org-element-property :parent item))) (checkbox (pcase (org-element-property :checkbox item) - ('on "\\o'\\(sq\\(mu'") - ('off "\\(sq ") - ('trans "\\o'\\(sq\\(mi'"))) + (`on "\\o'\\(sq\\(mu'") + (`off "\\(sq ") + (`trans "\\o'\\(sq\\(mi'"))) (tag (let ((tag (org-element-property :tag item))) ;; Check-boxes must belong to the tag. @@ -861,7 +861,7 @@ a communication channel." (push "|" alignment)) (push (concat (pcase (org-export-table-cell-alignment cell info) - ('left "l") ('right "r") ('center "c")) + (`left "l") (`right "r") (`center "c")) width divider) alignment) diff --git a/lisp/org/ox-md.el b/lisp/org/ox-md.el index a34b955dac..c4da8fcb14 100644 --- a/lisp/org/ox-md.el +++ b/lisp/org/ox-md.el @@ -339,9 +339,9 @@ a communication channel." (concat bullet (make-string (- 4 (length bullet)) ? ) (pcase (org-element-property :checkbox item) - ('on "[X] ") - ('trans "[-] ") - ('off "[ ] ")) + (`on "[X] ") + (`trans "[-] ") + (`off "[ ] ")) (let ((tag (org-element-property :tag item))) (and tag (format "**%s:** "(org-export-data tag info)))) (and contents @@ -400,11 +400,11 @@ a communication channel." (org-export-resolve-fuzzy-link link info) (org-export-resolve-id-link link info)))) (pcase (org-element-type destination) - ('plain-text ; External file. + (`plain-text ; External file. (let ((path (funcall link-org-files-as-md destination))) (if (not contents) (format "<%s>" path) (format "[%s](%s)" contents path)))) - ('headline + (`headline (format "[%s](#%s)" ;; Description. diff --git a/lisp/org/ox-org.el b/lisp/org/ox-org.el index b673d49899..1b5a7cc0c2 100644 --- a/lisp/org/ox-org.el +++ b/lisp/org/ox-org.el @@ -124,8 +124,8 @@ we make sure it is always called." (let ((first-child (car (org-element-contents h))) (new-section (org-element-create 'section))) (pcase (org-element-type first-child) - ('section nil) - ('nil (org-element-adopt-elements h new-section)) + (`section nil) + (`nil (org-element-adopt-elements h new-section)) (_ (org-element-insert-before new-section first-child)))))) tree) diff --git a/lisp/org/ox-publish.el b/lisp/org/ox-publish.el index ff6723f407..80ef239b67 100644 --- a/lisp/org/ox-publish.el +++ b/lisp/org/ox-publish.el @@ -618,7 +618,7 @@ files, when entire projects are published (see (project-plist (cdr project)) (publishing-function (pcase (org-publish-property :publishing-function project) - ('nil (user-error "No publishing function chosen")) + (`nil (user-error "No publishing function chosen")) ((and f (pred listp)) f) (f (list f)))) (base-dir @@ -703,7 +703,7 @@ return a string. Return value is a list as returned by (file-name-as-directory (org-publish-property :base-directory project))))) (pcase style - ('list + (`list (cons 'unordered (mapcar (lambda (f) @@ -712,7 +712,7 @@ return a string. Return value is a list as returned by style project))) files))) - ('tree + (`tree (letrec ((files-only (cl-remove-if #'directory-name-p files)) (directories (cl-remove-if-not #'directory-name-p files)) (subtree-to-list @@ -778,7 +778,7 @@ Default for SITEMAP-FILENAME is `sitemap.org'." (let ((retval t)) ;; First we sort files: (pcase sort-files - ('alphabetically + (`alphabetically (let ((A (if (funcall org-file-p a) (concat (file-name-directory a) (org-publish-find-title a project)) @@ -791,7 +791,7 @@ Default for SITEMAP-FILENAME is `sitemap.org'." (if ignore-case (not (string-lessp (upcase B) (upcase A))) (not (string-lessp B A)))))) - ((or 'anti-chronologically 'chronologically) + ((or `anti-chronologically `chronologically) (let* ((adate (org-publish-find-date a project)) (bdate (org-publish-find-date b project)) (A (+ (ash (car adate) 16) (cadr adate))) @@ -800,7 +800,7 @@ Default for SITEMAP-FILENAME is `sitemap.org'." (if (eq sort-files 'chronologically) (<= A B) (>= A B))))) - ('nil nil) + (`nil nil) (_ (user-error "Invalid sort value %s" sort-files))) ;; Directory-wise wins: (when (memq sort-folders '(first last)) @@ -1104,9 +1104,9 @@ publishing directory." "[[%s][%s]]" ;; Destination. (pcase (car target) - ('nil (format "file:%s" file)) - ('id (format "id:%s" (cdr target))) - ('custom-id (format "file:%s::#%s" file (cdr target))) + (`nil (format "file:%s" file)) + (`id (format "id:%s" (cdr target))) + (`custom-id (format "file:%s::#%s" file (cdr target))) (_ (format "file:%s::*%s" file (cdr target)))) ;; Description. (car (last entry))))) diff --git a/lisp/org/ox-texinfo.el b/lisp/org/ox-texinfo.el index 624d13aa06..d877c9c63a 100644 --- a/lisp/org/ox-texinfo.el +++ b/lisp/org/ox-texinfo.el @@ -452,10 +452,10 @@ This is used to choose a separator for constructs like \\verb." INFO is a plist used as a communication channel. See `org-texinfo-text-markup-alist' for details." (pcase (cdr (assq markup org-texinfo-text-markup-alist)) - ('nil text) ;no markup: return raw text - ('code (format "@code{%s}" (org-texinfo--sanitize-content text))) - ('samp (format "@samp{%s}" (org-texinfo--sanitize-content text))) - ('verb + (`nil text) ;no markup: return raw text + (`code (format "@code{%s}" (org-texinfo--sanitize-content text))) + (`samp (format "@samp{%s}" (org-texinfo--sanitize-content text))) + (`verb (let ((separator (org-texinfo--find-verb-separator text))) (format "@verb{%s%s%s}" separator text separator))) ;; Else use format string. @@ -872,7 +872,7 @@ contextual information." unnumbered) ((org-export-numbered-headline-p headline info) numbered) (t unnumbered))) - ('nil 'plain-list) + (`nil 'plain-list) (_ (user-error "Invalid Texinfo class specification: %S" class)))) (_ (user-error "Invalid Texinfo class specification: %S" class))))))) @@ -993,7 +993,7 @@ contextual information." (list tag)))))) (format "%s\n%s" (pcase items - ('nil "@item") + (`nil "@item") (`(,item) (concat "@item " item)) (`(,item . ,items) (concat "@item " item "\n" @@ -1077,18 +1077,18 @@ INFO is a plist holding contextual information. See (org-export-resolve-fuzzy-link link info) (org-export-resolve-id-link link info)))) (pcase (org-element-type destination) - ('nil + (`nil (format org-texinfo-link-with-unknown-path-format (org-texinfo--sanitize-content path))) ;; Id link points to an external file. - ('plain-text + (`plain-text (if desc (format "@uref{file://%s,%s}" destination desc) (format "@uref{file://%s}" destination))) - ((or 'headline + ((or `headline ;; Targets within headlines cannot be turned into ;; @anchor{}, so we refer to the headline parent ;; directly. - (and 'target + (and `target (guard (eq 'headline (org-element-type (org-element-property :parent destination)))))) @@ -1547,9 +1547,9 @@ information." (let ((value (org-texinfo-plain-text (org-timestamp-translate timestamp) info))) (pcase (org-element-property :type timestamp) - ((or 'active 'active-range) + ((or `active `active-range) (format (plist-get info :texinfo-active-timestamp-format) value)) - ((or 'inactive 'inactive-range) + ((or `inactive `inactive-range) (format (plist-get info :texinfo-inactive-timestamp-format) value)) (_ (format (plist-get info :texinfo-diary-timestamp-format) value))))) diff --git a/lisp/org/ox.el b/lisp/org/ox.el index 91637dd635..ea7d1dc81f 100644 --- a/lisp/org/ox.el +++ b/lisp/org/ox.el @@ -1954,8 +1954,8 @@ Return a string." (progn ,@body) (org-link-broken (pcase (plist-get info :with-broken-links) - ('nil (user-error "Unable to resolve link: %S" (nth 1 err))) - ('mark (org-export-data + (`nil (user-error "Unable to resolve link: %S" (nth 1 err))) + (`mark (org-export-data (format "[BROKEN LINK: %s]" (nth 1 err)) info)) (_ nil)))))) (let* ((type (org-element-type data)) @@ -4278,7 +4278,7 @@ A search cell follows the pattern (TYPE . SEARCH) where A search cell is the internal representation of a fuzzy link. It ignores white spaces and statistics cookies, if applicable." (pcase (org-element-type datum) - ('headline + (`headline (let ((title (split-string (replace-regexp-in-string "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]" "" @@ -4289,7 +4289,7 @@ ignores white spaces and statistics cookies, if applicable." (cons 'other title) (let ((custom-id (org-element-property :custom-id datum))) (and custom-id (cons 'custom-id custom-id))))))) - ('target + (`target (list (cons 'target (split-string (org-element-property :value datum))))) ((and (let name (org-element-property :name datum)) (guard name)) commit 038b425cf0fe6efea615e01c4828304721b99c75 Author: Eli Zaretskii Date: Mon Nov 26 22:41:03 2018 +0200 Unbreak compilation of emacsclient on MS-Windows * lib-src/emacsclient.c (main): Make "-suspend" handling conditional on !WINDOWSNT, as there's no SIGSTOP nor 'kill' there. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index e72c5e8cf1..c67d34f77f 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -1995,6 +1995,7 @@ main (int argc, char **argv) skiplf = str[strlen (str) - 1] == '\n'; exit_status = EXIT_FAILURE; } +#ifndef WINDOWSNT else if (strprefix ("-suspend ", p)) { /* -suspend: Suspend this terminal, i.e., stop the process. */ @@ -2003,6 +2004,7 @@ main (int argc, char **argv) skiplf = true; kill (0, SIGSTOP); } +#endif else { /* Unknown command. */ commit ed3ae3fc58c12bb413f52026c06320a5fff84084 Author: Paul Eggert Date: Mon Nov 26 11:36:51 2018 -0800 emacsclient: assume HAVE_INET_SOCKETS * configure.ac (HAVE_INET_SOCKETS): Remove. * lib-src/emacsclient.c: Simplify by assuming HAVE_SOCKETS and HAVE_INET_SOCKETS, which are always true nowadays, except perhaps for MS-DOS and if so this program shouldn’t be built there anyway. Don’t bother including sys/types.h, as it’s not needed on modern systems (and syswait.h does it for us anyway). (main): Simplify by assuming SIGSTOP (which is always defined if SIGCONT is), and by assuming HAVE_SOCKETS && HAVE_INET_SOCKETS. diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES index 04d1ff76f3..0e75b4d7dd 100644 --- a/admin/CPP-DEFINES +++ b/admin/CPP-DEFINES @@ -181,7 +181,6 @@ HAVE_GTK_WINDOW_SET_HAS_RESIZE_GRIP HAVE_G_TYPE_INIT HAVE_IFADDRS_H HAVE_IMAGEMAGICK -HAVE_INET_SOCKETS HAVE_INTTYPES_H HAVE_JPEG HAVE_KERBEROSIV_KRB_H diff --git a/configure.ac b/configure.ac index 4a80eb442f..8b34c3b658 100644 --- a/configure.ac +++ b/configure.ac @@ -4370,20 +4370,6 @@ AC_CHECK_MEMBERS([struct unipair.unicode], [], [], [[#include ]]) AC_CHECK_FUNCS_ONCE([sbrk]) -ok_so_far=yes -AC_CHECK_FUNC(socket, , ok_so_far=no) -if test $ok_so_far = yes; then - AC_CHECK_HEADER(netinet/in.h, , ok_so_far=no) -fi -if test $ok_so_far = yes; then - AC_CHECK_HEADER(arpa/inet.h, , ok_so_far=no) -fi -if test $ok_so_far = yes; then -dnl Fixme: Not used. Should this be HAVE_SOCKETS? - AC_DEFINE(HAVE_INET_SOCKETS, 1, - [Define to 1 if you have inet sockets.]) -fi - AC_FUNC_FORK AC_CHECK_FUNCS(snprintf) @@ -4461,7 +4447,6 @@ fi dnl Everybody supports this, except MS-DOS. dnl Seems like the kind of thing we should be testing for, though. -dnl Compare with HAVE_INET_SOCKETS (which is unused...) above. AC_DEFINE(HAVE_SOCKETS, 1, [Define if the system supports 4.2-compatible sockets.]) diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 084de792eb..e72c5e8cf1 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -44,20 +44,15 @@ char *w32_getenv (const char *); #else /* !WINDOWSNT */ # ifdef HAVE_NTGUI -# include -# endif /* HAVE_NTGUI */ +# include +# endif # include "syswait.h" -# ifdef HAVE_INET_SOCKETS -# include -# ifdef HAVE_SOCKETS -# include -# include -# include -# endif /* HAVE_SOCKETS */ -# endif # include +# include +# include +# include # define SOCKETS_IN_FILE_SYSTEM @@ -732,21 +727,19 @@ fail (void) } -#if defined HAVE_SOCKETS && defined HAVE_INET_SOCKETS - -# ifdef SOCKETS_IN_FILE_SYSTEM +#ifdef SOCKETS_IN_FILE_SYSTEM static void act_on_signals (HSOCKET); -# else +#else static void act_on_signals (HSOCKET s) {} static void init_signals (void) {} -# endif +#endif enum { AUTH_KEY_LENGTH = 64 }; static void sock_err_message (const char *function_name) { -# ifdef WINDOWSNT +#ifdef WINDOWSNT /* On Windows, the socket library was historically separate from the standard C library, so errors are handled differently. */ @@ -763,9 +756,9 @@ sock_err_message (const char *function_name) message (true, "%s: %s: %s\n", progname, function_name, msg); LocalFree (msg); -# else +#else message (true, "%s: %s: %s\n", progname, function_name, strerror (errno)); -# endif +#endif } @@ -877,7 +870,7 @@ unquote_argument (char *str) } -# ifdef WINDOWSNT +#ifdef WINDOWSNT /* Wrapper to make WSACleanup a cdecl, as required by atexit. */ void __cdecl close_winsock (void); void __cdecl @@ -901,7 +894,7 @@ initialize_sockets (void) atexit (close_winsock); } -# endif /* WINDOWSNT */ +#endif /* WINDOWSNT */ /* If the home directory is HOME, return the configuration file with @@ -940,10 +933,10 @@ get_server_config (const char *config_file, struct sockaddr_in *server, else { config = open_config (egetenv ("HOME"), config_file); -# ifdef WINDOWSNT +#ifdef WINDOWSNT if (!config) config = open_config (egetenv ("APPDATA"), config_file); -# endif +#endif } if (! config) @@ -1079,7 +1072,7 @@ find_tty (const char **tty_type, const char **tty_name, bool noabort) } -# ifdef SOCKETS_IN_FILE_SYSTEM +#ifdef SOCKETS_IN_FILE_SYSTEM /* Three possibilities: >0 - 'stat' failed with this errno value @@ -1117,10 +1110,10 @@ socket_status (const char *name) static void reinstall_handler_if_needed (int sig, void (*handler) (int)) { -# ifndef SA_RESETHAND +# ifndef SA_RESETHAND /* This is a platform without POSIX's sigaction. */ signal (sig, handler); -# endif +# endif } /* Flags for each signal, and handlers that set the flags. */ @@ -1160,7 +1153,7 @@ handle_sigwinch (int sig) static void install_handler (int sig, void (*handler) (int), sig_atomic_t volatile *flag) { -# ifdef SA_RESETHAND +# ifdef SA_RESETHAND if (flag) { struct sigaction oact; @@ -1170,7 +1163,7 @@ install_handler (int sig, void (*handler) (int), sig_atomic_t volatile *flag) struct sigaction act = { .sa_handler = handler }; sigemptyset (&act.sa_mask); sigaction (sig, &act, NULL); -# else +# else void (*ohandler) (int) = signal (sig, handler); if (flag) { @@ -1182,7 +1175,7 @@ install_handler (int sig, void (*handler) (int), sig_atomic_t volatile *flag) *flag = 0; } } -# endif +# endif } /* Initial installation of signal handlers. */ @@ -1311,10 +1304,10 @@ set_local_socket (const char *local_socket_name) tmpdir = egetenv ("TMPDIR"); if (!tmpdir) { -# ifdef DARWIN_OS -# ifndef _CS_DARWIN_USER_TEMP_DIR -# define _CS_DARWIN_USER_TEMP_DIR 65537 -# endif +# ifdef DARWIN_OS +# ifndef _CS_DARWIN_USER_TEMP_DIR +# define _CS_DARWIN_USER_TEMP_DIR 65537 +# endif size_t n = confstr (_CS_DARWIN_USER_TEMP_DIR, NULL, 0); if (n > 0) { @@ -1322,7 +1315,7 @@ set_local_socket (const char *local_socket_name) confstr (_CS_DARWIN_USER_TEMP_DIR, tmpdir_storage, n); } else -# endif +# endif tmpdir = "/tmp"; } socket_name_storage = @@ -1417,7 +1410,7 @@ set_local_socket (const char *local_socket_name) CLOSE_SOCKET (s); return INVALID_SOCKET; } -# endif /* SOCKETS_IN_FILE_SYSTEM */ +#endif /* SOCKETS_IN_FILE_SYSTEM */ static HSOCKET set_socket (bool no_exit_if_error) @@ -1427,7 +1420,7 @@ set_socket (bool no_exit_if_error) INITIALIZE (); -# ifdef SOCKETS_IN_FILE_SYSTEM +#ifdef SOCKETS_IN_FILE_SYSTEM /* Explicit --socket-name argument. */ if (!socket_name) socket_name = egetenv ("EMACS_SOCKET_NAME"); @@ -1441,7 +1434,7 @@ set_socket (bool no_exit_if_error) progname, socket_name); exit (EXIT_FAILURE); } -# endif +#endif /* Explicit --server-file arg or EMACS_SERVER_FILE variable. */ if (!local_server_file) @@ -1458,12 +1451,12 @@ set_socket (bool no_exit_if_error) exit (EXIT_FAILURE); } -# ifdef SOCKETS_IN_FILE_SYSTEM +#ifdef SOCKETS_IN_FILE_SYSTEM /* Implicit local socket. */ s = set_local_socket ("server"); if (s != INVALID_SOCKET) return s; -# endif +#endif /* Implicit server file. */ s = set_tcp_socket ("server"); @@ -1472,16 +1465,16 @@ set_socket (bool no_exit_if_error) /* No implicit or explicit socket, and no alternate editor. */ message (true, "%s: No socket or alternate editor. Please use:\n\n" -# ifdef SOCKETS_IN_FILE_SYSTEM +#ifdef SOCKETS_IN_FILE_SYSTEM "\t--socket-name\n" -# endif +#endif "\t--server-file (or environment variable EMACS_SERVER_FILE)\n\ \t--alternate-editor (or environment variable ALTERNATE_EDITOR)\n", progname); exit (EXIT_FAILURE); } -# ifdef HAVE_NTGUI +#ifdef HAVE_NTGUI FARPROC set_fg; /* Pointer to AllowSetForegroundWindow. */ FARPROC get_wc; /* Pointer to RealGetWindowClassA. */ @@ -1565,14 +1558,14 @@ w32_give_focus (void) && (get_wc = GetProcAddress (user32, "RealGetWindowClassA"))) EnumWindows (w32_find_emacs_process, (LPARAM) 0); } -# endif /* HAVE_NTGUI */ +#endif /* HAVE_NTGUI */ /* Start the emacs daemon and try to connect to it. */ static HSOCKET start_daemon_and_retry_set_socket (void) { -# ifndef WINDOWSNT +#ifndef WINDOWSNT pid_t dpid; int status; @@ -1605,7 +1598,7 @@ start_daemon_and_retry_set_socket (void) d_argv[0] = emacs; d_argv[1] = daemon_option; d_argv[2] = 0; -# ifdef SOCKETS_IN_FILE_SYSTEM +# ifdef SOCKETS_IN_FILE_SYSTEM if (socket_name != NULL) { /* Pass --daemon=socket_name as argument. */ @@ -1615,12 +1608,12 @@ start_daemon_and_retry_set_socket (void) strcpy (stpcpy (daemon_arg, deq), socket_name); d_argv[1] = daemon_arg; } -# endif +# endif execvp ("emacs", d_argv); message (true, "%s: error starting emacs daemon\n", progname); exit (EXIT_FAILURE); } -# else /* WINDOWSNT */ +#else /* WINDOWSNT */ DWORD wait_result; HANDLE w32_daemon_event; STARTUPINFO si; @@ -1684,7 +1677,7 @@ start_daemon_and_retry_set_socket (void) if (!w32_window_app ()) message (true, "Emacs daemon should have started, trying to connect again\n"); -# endif /* WINDOWSNT */ +#endif /* WINDOWSNT */ HSOCKET emacs_socket = set_socket (true); if (emacs_socket == INVALID_SOCKET) @@ -1704,7 +1697,6 @@ flush_stdout (HSOCKET emacs_socket) while (fdatasync (STDOUT_FILENO) != 0 && errno == EINTR) act_on_signals (emacs_socket); } -#endif /* HAVE_SOCKETS && HAVE_INET_SOCKETS */ int main (int argc, char **argv) @@ -1713,23 +1705,18 @@ main (int argc, char **argv) main_argv = argv; progname = argv[0] ? argv[0] : "emacsclient"; -#if ! (defined HAVE_SOCKETS && defined HAVE_INET_SOCKETS) - message (true, "%s: Sorry, support for Berkeley sockets is required.\n", - progname); - fail (); -#else /* HAVE_SOCKETS && HAVE_INET_SOCKETS */ int rl = 0; bool skiplf = true; char string[BUFSIZ + 1]; int exit_status = EXIT_SUCCESS; -# ifdef HAVE_NTGUI +#ifdef HAVE_NTGUI /* On Windows 7 and later, we need to explicitly associate emacsclient with emacs so the UI behaves sensibly. This association does no harm if we're not actually connecting to an Emacs using a window display. */ w32_set_user_model_id (); -# endif /* HAVE_NTGUI */ +#endif /* Process options. */ decode_options (argc, argv); @@ -1742,7 +1729,7 @@ main (int argc, char **argv) exit (EXIT_FAILURE); } -# ifndef WINDOWSNT +#ifndef WINDOWSNT if (tty) { pid_t pgrp = getpgrp (); @@ -1750,7 +1737,7 @@ main (int argc, char **argv) if (0 <= tcpgrp && tcpgrp != pgrp) kill (-pgrp, SIGTTIN); } -# endif /* !WINDOWSNT */ +#endif /* If alternate_editor is the empty string, start the emacs daemon in case of failure to connect. */ @@ -1774,10 +1761,10 @@ main (int argc, char **argv) fail (); } -# ifdef HAVE_NTGUI +#ifdef HAVE_NTGUI if (display && !strcmp (display, "w32")) w32_give_focus (); -# endif /* HAVE_NTGUI */ +#endif /* Send over our environment and current directory. */ if (create_frame) @@ -1879,7 +1866,7 @@ main (int argc, char **argv) continue; } } -# ifdef WINDOWSNT +#ifdef WINDOWSNT else if (! IS_ABSOLUTE_FILE_NAME (argv[i]) && (isalpha (argv[i][0]) && argv[i][1] == ':')) /* Windows can have a different default directory for each @@ -1898,7 +1885,7 @@ main (int argc, char **argv) else free (filename); } -# endif +#endif send_to_emacs (emacs_socket, "-file "); if (tramp_prefix && IS_ABSOLUTE_FILE_NAME (argv[i])) @@ -2008,7 +1995,6 @@ main (int argc, char **argv) skiplf = str[strlen (str) - 1] == '\n'; exit_status = EXIT_FAILURE; } -# ifdef SIGSTOP else if (strprefix ("-suspend ", p)) { /* -suspend: Suspend this terminal, i.e., stop the process. */ @@ -2017,7 +2003,6 @@ main (int argc, char **argv) skiplf = true; kill (0, SIGSTOP); } -# endif else { /* Unknown command. */ @@ -2036,5 +2021,4 @@ main (int argc, char **argv) CLOSE_SOCKET (emacs_socket); return exit_status; -#endif /* HAVE_SOCKETS && HAVE_INET_SOCKETS */ } commit 5c1bf59658997eef5bbd7dd10f406d92e3aeb3a5 Author: Paul Eggert Date: Mon Nov 26 10:32:35 2018 -0800 emacsclient: negate NO_SOCKETS_IN_FILE_SYSTEM * lib-src/emacsclient.c (SOCKETS_IN_FILE_SYSTEM): Rename from NO_SOCKETS_IN_FILE_SYSTEM, with inverted sense. All uses changed. All uses were of the form â€#ifndef NO_SOCKETS_IN_FILE_SYSTEM’, and it’s easier to read â€#ifdef SOCKETS_IN_FILE_SYSTEM’. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index d544fa6335..084de792eb 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -32,8 +32,6 @@ along with GNU Emacs. If not, see . */ # include # include -# define NO_SOCKETS_IN_FILE_SYSTEM - # define HSOCKET SOCKET # define CLOSE_SOCKET closesocket # define INITIALIZE() initialize_sockets () @@ -61,6 +59,8 @@ char *w32_getenv (const char *); # endif # include +# define SOCKETS_IN_FILE_SYSTEM + # define INVALID_SOCKET (-1) # define HSOCKET int # define CLOSE_SOCKET close @@ -133,7 +133,7 @@ static bool tty; is not running. --alternate-editor. */ static char *alternate_editor; -#ifndef NO_SOCKETS_IN_FILE_SYSTEM +#ifdef SOCKETS_IN_FILE_SYSTEM /* If non-NULL, the filename of the UNIX socket. */ static char const *socket_name; #endif @@ -168,7 +168,7 @@ static struct option const longopts[] = { "create-frame", no_argument, NULL, 'c' }, { "alternate-editor", required_argument, NULL, 'a' }, { "frame-parameters", required_argument, NULL, 'F' }, -#ifndef NO_SOCKETS_IN_FILE_SYSTEM +#ifdef SOCKETS_IN_FILE_SYSTEM { "socket-name", required_argument, NULL, 's' }, #endif { "server-file", required_argument, NULL, 'f' }, @@ -182,7 +182,7 @@ static struct option const longopts[] = There is no '-p' short option. */ static char const shortopts[] = "nqueHVtca:F:" -#ifndef NO_SOCKETS_IN_FILE_SYSTEM +#ifdef SOCKETS_IN_FILE_SYSTEM "s:" #endif "f:d:T:"; @@ -510,7 +510,7 @@ decode_options (int argc, char **argv) alternate_editor = optarg; break; -#ifndef NO_SOCKETS_IN_FILE_SYSTEM +#ifdef SOCKETS_IN_FILE_SYSTEM case 's': socket_name = optarg; break; @@ -665,7 +665,7 @@ The following OPTIONS are accepted:\n\ Visit the file in the given display\n\ ", "\ --parent-id=ID Open in parent window ID, via XEmbed\n" -#ifndef NO_SOCKETS_IN_FILE_SYSTEM +#ifdef SOCKETS_IN_FILE_SYSTEM "-s SOCKET, --socket-name=SOCKET\n\ Set filename of the UNIX socket for communication\n" #endif @@ -734,10 +734,11 @@ fail (void) #if defined HAVE_SOCKETS && defined HAVE_INET_SOCKETS -# ifndef NO_SOCKETS_IN_FILE_SYSTEM +# ifdef SOCKETS_IN_FILE_SYSTEM static void act_on_signals (HSOCKET); # else static void act_on_signals (HSOCKET s) {} +static void init_signals (void) {} # endif enum { AUTH_KEY_LENGTH = 64 }; @@ -1078,7 +1079,7 @@ find_tty (const char **tty_type, const char **tty_name, bool noabort) } -# ifndef NO_SOCKETS_IN_FILE_SYSTEM +# ifdef SOCKETS_IN_FILE_SYSTEM /* Three possibilities: >0 - 'stat' failed with this errno value @@ -1416,7 +1417,7 @@ set_local_socket (const char *local_socket_name) CLOSE_SOCKET (s); return INVALID_SOCKET; } -# endif /* ! NO_SOCKETS_IN_FILE_SYSTEM */ +# endif /* SOCKETS_IN_FILE_SYSTEM */ static HSOCKET set_socket (bool no_exit_if_error) @@ -1426,7 +1427,7 @@ set_socket (bool no_exit_if_error) INITIALIZE (); -# ifndef NO_SOCKETS_IN_FILE_SYSTEM +# ifdef SOCKETS_IN_FILE_SYSTEM /* Explicit --socket-name argument. */ if (!socket_name) socket_name = egetenv ("EMACS_SOCKET_NAME"); @@ -1457,7 +1458,7 @@ set_socket (bool no_exit_if_error) exit (EXIT_FAILURE); } -# ifndef NO_SOCKETS_IN_FILE_SYSTEM +# ifdef SOCKETS_IN_FILE_SYSTEM /* Implicit local socket. */ s = set_local_socket ("server"); if (s != INVALID_SOCKET) @@ -1471,7 +1472,7 @@ set_socket (bool no_exit_if_error) /* No implicit or explicit socket, and no alternate editor. */ message (true, "%s: No socket or alternate editor. Please use:\n\n" -# ifndef NO_SOCKETS_IN_FILE_SYSTEM +# ifdef SOCKETS_IN_FILE_SYSTEM "\t--socket-name\n" # endif "\t--server-file (or environment variable EMACS_SERVER_FILE)\n\ @@ -1604,7 +1605,7 @@ start_daemon_and_retry_set_socket (void) d_argv[0] = emacs; d_argv[1] = daemon_option; d_argv[2] = 0; -# ifndef NO_SOCKETS_IN_FILE_SYSTEM +# ifdef SOCKETS_IN_FILE_SYSTEM if (socket_name != NULL) { /* Pass --daemon=socket_name as argument. */ @@ -1833,11 +1834,10 @@ main (int argc, char **argv) if (find_tty (&tty_type, &tty_name, !tty)) { -# ifndef NO_SOCKETS_IN_FILE_SYSTEM /* Install signal handlers before opening a frame on the current tty. */ init_signals (); -# endif + send_to_emacs (emacs_socket, "-tty "); quote_argument (emacs_socket, tty_name); send_to_emacs (emacs_socket, " "); commit 0331f2f4c5d7d9221522e231ebd5e4f20868c2b7 Author: Paul Eggert Date: Mon Nov 26 08:25:36 2018 -0800 emacsclient: fix some races on POSIX systems Fix some longstanding race conditions due to emacsclient’s use of â€signal’ instead of â€sigaction’ and its use of nested signal handlers. These races could cause premature exit or incorrect commands sent to Emacs. * lib-src/emacsclient.c (signal) [!WINDOWSNT]: Do not undef. (emacs_socket): Remove this static variable. It is now a parameter. (send_to_emacs): Do not exit merely because â€send’ was interrupted. Instead, act on the signal if possible, and then retry the â€send’. (pass_signal_to_emacs): Remove; now done by act_on_signals. (reinstall_handler_if_needed, handle_sigttou, handle_sigwinch) (install_handler): New functions. (got_sigcont, got_sigtstp, got_sigttou, got_sigwinch): New globals, used for more-portable signal handling. (handle_sigcont, handle_sigtstp): Just set the static var; other actions are now done later by act_on_signals. (install_handler): New function that arranges for signals to never be reset to default, on modern POSIX platforms. This fixes some races. (act_on_signals): New function. When acting on SIGCONT, don’t bother calling getpgrp if tcgetpgrp fails. (start_daemon_and_retry_set_socket): Return the socket rather than setting a global variable. All uses changed. (flush_stdout): New function that acts on signals received while flushing. (main): Use it. emacs_socket is now a local var. Act on signals received during recv. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 3c6215a014..d544fa6335 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -41,6 +41,8 @@ along with GNU Emacs. If not, see . */ char *w32_getenv (const char *); # define egetenv(VAR) w32_getenv (VAR) +# undef signal + #else /* !WINDOWSNT */ # ifdef HAVE_NTGUI @@ -68,8 +70,6 @@ char *w32_getenv (const char *); #endif /* !WINDOWSNT */ -#undef signal - #include #include #include @@ -144,7 +144,7 @@ static char const *server_file; /* If non-NULL, the tramp prefix emacs must use to find the files. */ static char const *tramp_prefix; -/* PID of the Emacs server process. */ +/* If nonzero, PID of the Emacs server process. */ static pid_t emacs_pid; /* If non-NULL, a string that should form a frame parameter alist to @@ -734,10 +734,13 @@ fail (void) #if defined HAVE_SOCKETS && defined HAVE_INET_SOCKETS -enum { AUTH_KEY_LENGTH = 64 }; +# ifndef NO_SOCKETS_IN_FILE_SYSTEM +static void act_on_signals (HSOCKET); +# else +static void act_on_signals (HSOCKET s) {} +# endif -/* Socket used to communicate with the Emacs server process. */ -static HSOCKET emacs_socket = 0; +enum { AUTH_KEY_LENGTH = 64 }; static void sock_err_message (const char *function_name) @@ -790,16 +793,22 @@ send_to_emacs (HSOCKET s, const char *data) if (sblen == SEND_BUFFER_SIZE || (0 < sblen && send_buffer[sblen - 1] == '\n')) { - int sent = send (s, send_buffer, sblen, 0); - if (sent < 0) + int sent; + while ((sent = send (s, send_buffer, sblen, 0)) < 0) { - message (true, "%s: failed to send %d bytes to socket: %s\n", - progname, sblen, strerror (errno)); - fail (); + if (errno != EINTR) + { + message (true, "%s: failed to send %d bytes to socket: %s\n", + progname, sblen, strerror (errno)); + fail (); + } + /* Act on signals not requiring communication to Emacs, + but defer action on the others to avoid confusing the + communication currently in progress. */ + act_on_signals (INVALID_SOCKET); } - if (sent != sblen) - memmove (send_buffer, &send_buffer[sent], sblen - sent); sblen -= sent; + memmove (send_buffer, &send_buffer[sent], sblen); } dlen -= part; @@ -1091,86 +1100,181 @@ socket_status (const char *name) } -/* A signal handler that passes the signal to the Emacs process. - Useful for SIGWINCH. */ - +/* Signal handlers merely set a flag, to avoid race conditions on + POSIXish systems. Non-POSIX platforms lacking sigaction make do + with traditional calls to 'signal'; races are rare so this usually + works. Although this approach may treat multiple deliveries of SIG + as a single delivery and may act on signals in a different order + than received, that is OK for emacsclient. Also, this approach may + omit output if a printf call is interrupted by a signal, but printf + output is not that important (emacsclient does not check for printf + errors, after all) so this is also OK for emacsclient. */ + +/* Reinstall for SIG the signal handler HANDLER if needed. It is + needed on a non-POSIX or traditional platform where an interrupt + resets the signal handler to SIG_DFL. */ static void -pass_signal_to_emacs (int signalnum) +reinstall_handler_if_needed (int sig, void (*handler) (int)) { - int old_errno = errno; +# ifndef SA_RESETHAND + /* This is a platform without POSIX's sigaction. */ + signal (sig, handler); +# endif +} - if (emacs_pid) - kill (emacs_pid, signalnum); +/* Flags for each signal, and handlers that set the flags. */ - signal (signalnum, pass_signal_to_emacs); - errno = old_errno; +static sig_atomic_t volatile + got_sigcont, got_sigtstp, got_sigttou, got_sigwinch; + +static void +handle_sigcont (int sig) +{ + got_sigcont = 1; + reinstall_handler_if_needed (sig, handle_sigcont); +} +static void +handle_sigtstp (int sig) +{ + got_sigtstp = 1; + reinstall_handler_if_needed (sig, handle_sigtstp); +} +static void +handle_sigttou (int sig) +{ + got_sigttou = 1; + reinstall_handler_if_needed (sig, handle_sigttou); +} +static void +handle_sigwinch (int sig) +{ + got_sigwinch = 1; + reinstall_handler_if_needed (sig, handle_sigwinch); } -/* Signal handler for SIGCONT; notify the Emacs process that it can - now resume our tty frame. */ +/* Install for signal SIG the handler HANDLER. However, if FLAG is + non-null and if the signal is currently being ignored, do not + install the handler and keep *FLAG zero. */ static void -handle_sigcont (int signalnum) +install_handler (int sig, void (*handler) (int), sig_atomic_t volatile *flag) { - int old_errno = errno; - pid_t pgrp = getpgrp (); - pid_t tcpgrp = tcgetpgrp (STDOUT_FILENO); - - if (tcpgrp == pgrp) +# ifdef SA_RESETHAND + if (flag) { - /* We are in the foreground. */ - send_to_emacs (emacs_socket, "-resume \n"); + struct sigaction oact; + if (sigaction (sig, NULL, &oact) == 0 && oact.sa_handler == SIG_IGN) + return; } - else if (0 <= tcpgrp && tty) + struct sigaction act = { .sa_handler = handler }; + sigemptyset (&act.sa_mask); + sigaction (sig, &act, NULL); +# else + void (*ohandler) (int) = signal (sig, handler); + if (flag) { - /* We are in the background; cancel the continue. */ - kill (-pgrp, SIGTTIN); + if (ohandler == SIG_IGN) + { + signal (sig, SIG_IGN); + /* While HANDLER was mistakenly installed a signal may have + arrived and set *FLAG, so clear *FLAG now. */ + *flag = 0; + } } - - signal (signalnum, handle_sigcont); - errno = old_errno; +# endif } -/* Signal handler for SIGTSTP; notify the Emacs process that we are - going to sleep. Normally the suspend is initiated by Emacs via - server-handle-suspend-tty, but if the server gets out of sync with - reality, we may get a SIGTSTP on C-z. Handling this signal and - notifying Emacs about it should get things under control again. */ +/* Initial installation of signal handlers. */ static void -handle_sigtstp (int signalnum) +init_signals (void) { - int old_errno = errno; - sigset_t set; - - if (emacs_socket) - send_to_emacs (emacs_socket, "-suspend \n"); - - /* Unblock this signal and call the default handler by temporarily - changing the handler and resignaling. */ - sigprocmask (SIG_BLOCK, NULL, &set); - sigdelset (&set, signalnum); - signal (signalnum, SIG_DFL); - raise (signalnum); - sigprocmask (SIG_SETMASK, &set, NULL); /* Let's the above signal through. */ - signal (signalnum, handle_sigtstp); - - errno = old_errno; + install_handler (SIGCONT, handle_sigcont, &got_sigcont); + install_handler (SIGTSTP, handle_sigtstp, &got_sigtstp); + install_handler (SIGTTOU, handle_sigttou, &got_sigttou); + install_handler (SIGWINCH, handle_sigwinch, &got_sigwinch); + /* Don't mess with SIGINT and SIGQUIT, as Emacs has no way to + determine which terminal the signal came from. C-g is a normal + input event on secondary terminals. */ } +/* Act on delivered tty-related signal SIG that normally has handler + HANDLER. EMACS_SOCKET connects to Emacs. */ -/* Set up signal handlers before opening a frame on the current tty. */ +static void +act_on_tty_signal (int sig, void (*handler) (int), HSOCKET emacs_socket) +{ + /* Notify Emacs that we are going to sleep. Normally the suspend is + initiated by Emacs via server-handle-suspend-tty, but if the + server gets out of sync with reality, we may get a SIGTSTP on + C-z. Handling this signal and notifying Emacs about it should + get things under control again. */ + send_to_emacs (emacs_socket, "-suspend \n"); + + /* Execute the default action by temporarily changing handling to + the default and resignaling. */ + install_handler (sig, SIG_DFL, NULL); + raise (sig); + install_handler (sig, handler, NULL); +} + +/* Act on delivered signals if possible. If EMACS_SOCKET is valid, + use it to communicate to Emacs. */ static void -init_signals (void) +act_on_signals (HSOCKET emacs_socket) { - /* Don't pass SIGINT and SIGQUIT to Emacs, because it has no way of - deciding which terminal the signal came from. C-g is now a - normal input event on secondary terminals. */ - signal (SIGWINCH, pass_signal_to_emacs); - signal (SIGCONT, handle_sigcont); - signal (SIGTSTP, handle_sigtstp); - signal (SIGTTOU, handle_sigtstp); + while (true) + { + bool took_action = false; + + if (emacs_socket != INVALID_SOCKET) + { + if (got_sigcont) + { + got_sigcont = 0; + took_action = true; + pid_t tcpgrp = tcgetpgrp (STDOUT_FILENO); + if (0 <= tcpgrp) + { + pid_t pgrp = getpgrp (); + if (tcpgrp == pgrp) + { + /* We are in the foreground. */ + send_to_emacs (emacs_socket, "-resume \n"); + } + else if (tty) + { + /* We are in the background; cancel the continue. */ + kill (-pgrp, SIGTTIN); + } + } + } + + if (got_sigtstp) + { + got_sigtstp = 0; + took_action = true; + act_on_tty_signal (SIGTSTP, handle_sigtstp, emacs_socket); + } + if (got_sigttou) + { + got_sigttou = 0; + took_action = true; + act_on_tty_signal (SIGTTOU, handle_sigttou, emacs_socket); + } + } + + if (emacs_pid && got_sigwinch) + { + got_sigwinch = 0; + took_action = true; + kill (emacs_pid, SIGWINCH); + } + + if (!took_action) + break; + } } /* Create a local socket and connect it to Emacs. */ @@ -1464,7 +1568,7 @@ w32_give_focus (void) /* Start the emacs daemon and try to connect to it. */ -static void +static HSOCKET start_daemon_and_retry_set_socket (void) { # ifndef WINDOWSNT @@ -1581,13 +1685,23 @@ start_daemon_and_retry_set_socket (void) "Emacs daemon should have started, trying to connect again\n"); # endif /* WINDOWSNT */ - emacs_socket = set_socket (true); + HSOCKET emacs_socket = set_socket (true); if (emacs_socket == INVALID_SOCKET) { message (true, "Error: Cannot connect even after starting the Emacs daemon\n"); exit (EXIT_FAILURE); } + return emacs_socket; +} + +/* Flush standard output and its underlying file descriptor. */ +static void +flush_stdout (HSOCKET emacs_socket) +{ + fflush (stdout); + while (fdatasync (STDOUT_FILENO) != 0 && errno == EINTR) + act_on_signals (emacs_socket); } #endif /* HAVE_SOCKETS && HAVE_INET_SOCKETS */ @@ -1641,13 +1755,14 @@ main (int argc, char **argv) in case of failure to connect. */ bool start_daemon_if_needed = alternate_editor && !alternate_editor[0]; - emacs_socket = set_socket (alternate_editor || start_daemon_if_needed); + HSOCKET emacs_socket = set_socket (alternate_editor + || start_daemon_if_needed); if (emacs_socket == INVALID_SOCKET) { if (! start_daemon_if_needed) fail (); - start_daemon_and_retry_set_socket (); + emacs_socket = start_daemon_and_retry_set_socket (); } char *cwd = get_current_dir_name (); @@ -1719,6 +1834,8 @@ main (int argc, char **argv) if (find_tty (&tty_type, &tty_name, !tty)) { # ifndef NO_SOCKETS_IN_FILE_SYSTEM + /* Install signal handlers before opening a frame on the + current tty. */ init_signals (); # endif send_to_emacs (emacs_socket, "-tty "); @@ -1809,20 +1926,16 @@ main (int argc, char **argv) printf ("Waiting for Emacs..."); skiplf = false; } - fflush (stdout); - while (fdatasync (STDOUT_FILENO) != 0 && errno == EINTR) - continue; + flush_stdout (emacs_socket); /* Now, wait for an answer and print any messages. */ while (exit_status == EXIT_SUCCESS) { do - { - errno = 0; - rl = recv (emacs_socket, string, BUFSIZ, 0); - } - /* If we receive a signal (e.g. SIGWINCH, which we pass - through to Emacs), on some OSes we get EINTR and must retry. */ + { + act_on_signals (emacs_socket); + rl = recv (emacs_socket, string, BUFSIZ, 0); + } while (rl < 0 && errno == EINTR); if (rl <= 0) @@ -1916,9 +2029,7 @@ main (int argc, char **argv) if (!skiplf) printf ("\n"); - fflush (stdout); - while (fdatasync (STDOUT_FILENO) != 0 && errno == EINTR) - continue; + flush_stdout (emacs_socket); if (rl < 0) exit_status = EXIT_FAILURE; commit f3328f995ee316cffa1a86117e6da2ba299d2c90 Author: Michael Albinus Date: Mon Nov 26 19:48:37 2018 +0100 Rework tramp-rclone-mounted-p * lisp/net/tramp-rclone.el (tramp-rclone-mounted-p): Rewrite. (tramp-rclone-maybe-open-connection): Set "mounted" file property. diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 725a6f153a..a1767ab3a1 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -435,15 +435,10 @@ file names." (defun tramp-rclone-mounted-p (vec) "Check, whether storage system determined by VEC is mounted." - (or - ;; We set this property at the end of - ;; `tramp-rclone-maybe-open-connection'. Let's use it as - ;; indicator. - (tramp-get-connection-property vec "uid-integer" nil) - ;; If it is mounted, "." is not shown. If the endpoint is not - ;; connected, `directory-files' returns an error. - (ignore-errors - (not (member "." (directory-files (tramp-rclone-mount-point vec))))))) + (with-tramp-file-property vec "/" "mounted" + (string-match + (format "^%s:" (regexp-quote (tramp-file-name-host vec))) + (shell-command-to-string "mount")))) (defun tramp-rclone-flush-mount (vec) "Flush directory cache of VEC mount." @@ -511,6 +506,7 @@ connection if a previous connection has died for some reason." (tramp-compat-temporary-file-directory))) (apply 'start-process (tramp-get-connection-name vec) buf tramp-rclone-program (delq nil args))))) + (tramp-set-file-property vec "/" "mounted" t) (tramp-message vec 6 "%s" (mapconcat 'identity (process-command p) " ")) (process-put p 'adjust-window-size-function 'ignore) commit 2925ce5a7ec1424cfaea9f2f86bd3cab27832584 Author: Eli Zaretskii Date: Mon Nov 26 19:31:24 2018 +0200 Support Hunspell 1.7.0 in ispell.el * lisp/textmodes/ispell.el (ispell-find-hunspell-dictionaries): Invoke Hunspell with an additional command-line argument, to work around a misfeature in Hunspell 1.7.0 that prevents it from reporting the loaded dictionary. (Bug#33493) diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index e77bc7e112..9789968b15 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -1113,7 +1113,12 @@ dictionary from that list was found." null-device t nil - "-D") + ;; Hunspell 1.7.0 (and later?) won't + ;; show LOADED DICTIONARY unless + ;; there's at least one file argument + ;; on the command line. So we feed + ;; it with the null device. + "-D" null-device) (buffer-string)) "[\n\r]+" t)) commit 03bb7a8da9d16dd3dbd5a3ce56adb449e808bf2a Author: Eli Zaretskii Date: Mon Nov 26 19:27:45 2018 +0200 Avoid clearing echo-area message by auto-save-visited-file-name * lisp/emacs-lisp/map-ynp.el (map-y-or-n-p): Record the previous echo-area message, if any, and restore it before exiting. (Bug#33490) diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el index 8260af5727..93235bd9ec 100644 --- a/lisp/emacs-lisp/map-ynp.el +++ b/lisp/emacs-lisp/map-ynp.el @@ -79,6 +79,7 @@ are meaningful here. Returns the number of actions taken." (let* ((actions 0) + (msg (current-message)) user-keys mouse-event map prompt char elt def ;; Non-nil means we should use mouse menus to ask. use-menus @@ -250,9 +251,10 @@ the current %s and exit." (if delayed-switch-frame (setq unread-command-events (cons delayed-switch-frame unread-command-events)))) - ;; Clear the last prompt from the minibuffer. + ;; Clear the last prompt from the minibuffer, and restore the + ;; previous echo-area message, if any. (let ((message-log-max nil)) - (message "")) + (message (or msg ""))) ;; Return the number of actions that were taken. actions)) commit 82941e44f3ae58349143db5c57af91dad43c1e5e Author: Wilson Snyder Date: Mon Nov 26 07:11:55 2018 -0500 Update verilog-mode with upstream patches. * lisp/progmodes/verilog-mode.el (verilog-auto-templated-rel) (verilog-load-file-at-point, verilog-read-arg-pins) (verilog-read-auto-constants, verilog-read-auto-params) (verilog-read-auto-template-middle, verilog-read-decls) (verilog-read-includes, verilog-read-inst-pins) (verilog-read-instants, verilog-read-sub-decls-gate): Don't copy properties when parsing AUTOs. (verilog-font-lock-keywords): Fix SystemVerilog font lock keywords to be more consistent with IEEE 1364 keywords. Reported by Jeff Riley. (verilog-highlight-p1800-keywords): Now ignored. (verilog-simplify-range-expression): Simplify shifts in auto wire declarations, bug1346. Reported by Maghawan Punde. (verilog-read-always-signals-recurse): Fix AUTORESET with pattern assignments. Reported by Bhargava Narumanchi. (verilog-at-constraint-p): Fix indentation of replicate with parameter. Reported by Yun He. (verilog-read-defines, verilog-read-includes) (verilog-substitute-include-name): Fix handling define names in includes, bug1324. Reported by John DeRoo. (verilog-imenu-generic-expression): Fix speedbar for signed functions, bug1312. Reported by Ian Perryman. (verilog-indent-buffer): Fix verilog-batch-indent not honoring top mode line. Reported by James Claffey. (verilog-set-auto-endcomments): Fix end comments when have variables starting with class_, bug1259. Reported by Andrea Fedeli. (verilog-read-decls): Fix AUTOINST for parameterized interfaces, bug1253. Reported by David Rogoff. (verilog-read-sub-decls-line, verilog-signals-combine-bus): Fix AUTOOUTPUT not including nested array references, msg2417. (verilog-at-constraint-p): begin/end are illegal inside constraint blocks, so use that knowledge to make smarter indentation decisions. (verilog-auto-simplify-expressions, verilog-simplify-range-expression): Add `verilog-auto-simplify-expressions' to disable range simplifications. (verilog-auto-save-check, verilog-batch-execute-func): Fix .* causing Emacs batch to always re-save files with no changes, bug1239. Reported by Brian Etscheid. diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index f26576722c..509a1a2ef9 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -108,7 +108,6 @@ ;; verilog-minimum-comment-distance 40 ;; verilog-indent-begin-after-if t ;; verilog-auto-lineup 'declarations -;; verilog-highlight-p1800-keywords nil ;; verilog-linter "my_lint_shell_command" ;; ) @@ -122,7 +121,7 @@ ;; ;; This variable will always hold the version number of the mode -(defconst verilog-mode-version "2017-08-07-c085e50-vpo-GNU" +(defconst verilog-mode-version "2018-11-26-bb3814b-vpo-GNU" "Version of this Verilog mode.") (defconst verilog-mode-release-emacs t "If non-nil, this version of Verilog mode was released with Emacs itself.") @@ -719,15 +718,13 @@ default avoids too many redundant comments in tight quarters." (put 'verilog-minimum-comment-distance 'safe-local-variable 'integerp) (defcustom verilog-highlight-p1800-keywords nil - "Non-nil means highlight words newly reserved by IEEE-1800. -These will appear in `verilog-font-lock-p1800-face' in order to gently -suggest changing where these words are used as variables to something else. -A nil value means highlight these words as appropriate for the SystemVerilog -IEEE-1800 standard. Note that changing this will require restarting Emacs -to see the effect as font color choices are cached by Emacs." + "Obsolete. +Was non-nil means highlight SystemVerilog IEEE-1800 differently. +All code is now highlighted as if SystemVerilog IEEE-1800." :group 'verilog-mode-indent :type 'boolean) (put 'verilog-highlight-p1800-keywords 'safe-local-variable 'verilog-booleanp) +(make-obsolete-variable 'verilog-highlight-p1800-keywords nil "27.1") (defcustom verilog-highlight-grouping-keywords nil "Non-nil means highlight grouping keywords more dramatically. @@ -1070,6 +1067,18 @@ of each Verilog file that requires it, rather than being set globally." :type 'boolean) (put 'verilog-auto-sense-defines-constant 'safe-local-variable 'verilog-booleanp) +(defcustom verilog-auto-simplify-expressions t + "Non-nil means AUTOs will simplify expressions when calculating bit ranges. +When nil, do not simply ranges, which may simplify the output, +but may cause problems when there are multiple instantiations +outputting to the same wire. To maintain compatibility with +other sites, this should be set at the bottom of each Verilog +file that requires it, rather than being set globally." + :version "27.1" + :group 'verilog-mode-auto + :type 'boolean) +(put 'verilog-auto-simplify-expressions 'safe-local-variable 'verilog-booleanp) + (defcustom verilog-auto-reset-blocking-in-non t "Non-nil means AUTORESET will reset blocking statements. When true, AUTORESET will reset in blocking statements those @@ -1389,7 +1398,7 @@ See also `verilog-case-fold'." ("*Variables*" "^\\s-*\\(reg\\|wire\\|logic\\)\\s-+\\(\\|\\[[^]]+\\]\\s-+\\)\\([A-Za-z0-9_]+\\)" 3) ("*Classes*" "^\\s-*\\(?:\\(?:virtual\\|interface\\)\\s-+\\)?class\\s-+\\([A-Za-z_][A-Za-z0-9_]+\\)" 1) ("*Tasks*" "^\\s-*\\(?:\\(?:static\\|pure\\|virtual\\|local\\|protected\\)\\s-+\\)*task\\s-+\\(?:\\(?:static\\|automatic\\)\\s-+\\)?\\([A-Za-z_][A-Za-z0-9_:]+\\)" 1) - ("*Functions*" "^\\s-*\\(?:\\(?:static\\|pure\\|virtual\\|local\\|protected\\)\\s-+\\)*function\\s-+\\(?:\\(?:static\\|automatic\\)\\s-+\\)?\\(?:\\w+\\s-+\\)?\\([A-Za-z_][A-Za-z0-9_:]+\\)" 1) + ("*Functions*" "^\\s-*\\(?:\\(?:static\\|pure\\|virtual\\|local\\|protected\\)\\s-+\\)*function\\s-+\\(?:\\(?:static\\|automatic\\)\\s-+\\)?\\(?:\\w+\\s-+\\)?\\(?:\\(?:un\\)signed\\s-+\\)?\\([A-Za-z_][A-Za-z0-9_:]+\\)" 1) ("*Interfaces*" "^\\s-*interface\\s-+\\([a-zA-Z_0-9]+\\)" 1) ("*Types*" "^\\s-*typedef\\s-+.*\\s-+\\([a-zA-Z_0-9]+\\)\\s-*;" 1)) "Imenu expression for Verilog mode. See `imenu-generic-expression'.") @@ -2718,6 +2727,8 @@ find the errors." "localparam" "parameter" "var" ;; type creation "typedef" + ;; randomness + "rand" )))) (defconst verilog-declaration-core-re (eval-when-compile @@ -3096,7 +3107,7 @@ See also `verilog-font-lock-extra-types'.") (defvar verilog-font-lock-p1800-face 'verilog-font-lock-p1800-face - "Font to use for p1800 keywords.") + "Obsolete font to use for p1800 keywords.") (defface verilog-font-lock-p1800-face '((((class color) (background light)) @@ -3107,6 +3118,7 @@ See also `verilog-font-lock-extra-types'.") (t (:italic t))) "Font lock mode face used to highlight P1800 keywords." :group 'font-lock-highlighting-faces) +(make-obsolete-variable 'verilog-font-lock-p1800-face nil "27.1") (defvar verilog-font-lock-ams-face 'verilog-font-lock-ams-face @@ -3137,133 +3149,110 @@ See also `verilog-font-lock-extra-types'.") :group 'font-lock-highlighting-faces) (let* ((verilog-type-font-keywords - (eval-when-compile - (verilog-regexp-opt - '( - "and" "bit" "buf" "bufif0" "bufif1" "cmos" "defparam" - "event" "genvar" "inout" "input" "integer" "localparam" - "logic" "mailbox" "nand" "nmos" "nor" "not" "notif0" "notif1" "or" - "output" "parameter" "pmos" "pull0" "pull1" "pulldown" "pullup" - "rcmos" "real" "realtime" "reg" "rnmos" "rpmos" "rtran" - "rtranif0" "rtranif1" "semaphore" "signed" "struct" "supply" - "supply0" "supply1" "time" "tran" "tranif0" "tranif1" - "tri" "tri0" "tri1" "triand" "trior" "trireg" "typedef" - "uwire" "vectored" "wand" "wire" "wor" "xnor" "xor" - ) nil ))) + (eval-when-compile + (verilog-regexp-opt + '("and" "buf" "bufif0" "bufif1" "cmos" "defparam" "event" + "genvar" "highz0" "highz1" "inout" "input" "integer" + "localparam" "mailbox" "nand" "nmos" "nor" "not" "notif0" + "notif1" "or" "output" "parameter" "pmos" "pull0" "pull1" + "pulldown" "pullup" "rcmos" "real" "realtime" "reg" "rnmos" + "rpmos" "rtran" "rtranif0" "rtranif1" "semaphore" "signed" + "specparam" "strong0" "strong1" "supply" "supply0" "supply1" + "time" "tran" "tranif0" "tranif1" "tri" "tri0" "tri1" "triand" + "trior" "trireg" "unsigned" "uwire" "vectored" "wand" "weak0" + "weak1" "wire" "wor" "xnor" "xor" + ;; 1800-2005 + "bit" "byte" "chandle" "const" "enum" "int" "logic" "longint" + "packed" "ref" "shortint" "shortreal" "static" "string" + "struct" "type" "typedef" "union" "var" + ;; 1800-2009 + ;; 1800-2012 + "interconnect" "nettype" ) nil))) (verilog-pragma-keywords - (eval-when-compile - (verilog-regexp-opt - '("surefire" "auto" "synopsys" "rtl_synthesis" "verilint" "leda" "0in" - ) nil ))) - - (verilog-1800-2005-keywords - (eval-when-compile - (verilog-regexp-opt - '("alias" "assert" "assume" "automatic" "before" "bind" - "bins" "binsof" "break" "byte" "cell" "chandle" "class" - "clocking" "config" "const" "constraint" "context" "continue" - "cover" "covergroup" "coverpoint" "cross" "deassign" "design" - "dist" "do" "edge" "endclass" "endclocking" "endconfig" - "endgroup" "endprogram" "endproperty" "endsequence" "enum" - "expect" "export" "extends" "extern" "first_match" "foreach" - "forkjoin" "genvar" "highz0" "highz1" "ifnone" "ignore_bins" - "illegal_bins" "import" "incdir" "include" "inside" "instance" - "int" "intersect" "large" "liblist" "library" "local" "longint" - "matches" "medium" "modport" "new" "noshowcancelled" "null" - "packed" "program" "property" "protected" "pull0" "pull1" - "pulsestyle_onevent" "pulsestyle_ondetect" "pure" "rand" "randc" - "randcase" "randsequence" "ref" "release" "return" "scalared" - "sequence" "shortint" "shortreal" "showcancelled" "small" "solve" - "specparam" "static" "string" "strong0" "strong1" "struct" - "super" "tagged" "this" "throughout" "timeprecision" "timeunit" - "type" "union" "unsigned" "use" "var" "virtual" "void" - "wait_order" "weak0" "weak1" "wildcard" "with" "within" - ) nil ))) - - (verilog-1800-2009-keywords - (eval-when-compile - (verilog-regexp-opt - '("accept_on" "checker" "endchecker" "eventually" "global" - "implies" "let" "nexttime" "reject_on" "restrict" "s_always" - "s_eventually" "s_nexttime" "s_until" "s_until_with" "strong" - "sync_accept_on" "sync_reject_on" "unique0" "until" - "until_with" "untyped" "weak" ) nil ))) - - (verilog-1800-2012-keywords - (eval-when-compile - (verilog-regexp-opt - '("implements" "interconnect" "nettype" "soft" ) nil ))) + (eval-when-compile + (verilog-regexp-opt + '("surefire" "0in" "auto" "leda" "rtl_synthesis" "synopsys" + "verilint" ) nil))) (verilog-ams-keywords - (eval-when-compile - (verilog-regexp-opt - '("above" "abs" "absdelay" "acos" "acosh" "ac_stim" - "aliasparam" "analog" "analysis" "asin" "asinh" "atan" "atan2" "atanh" - "branch" "ceil" "connectmodule" "connectrules" "cos" "cosh" "ddt" - "ddx" "discipline" "driver_update" "enddiscipline" "endconnectrules" - "endnature" "endparamset" "exclude" "exp" "final_step" "flicker_noise" - "floor" "flow" "from" "ground" "hypot" "idt" "idtmod" "inf" - "initial_step" "laplace_nd" "laplace_np" "laplace_zd" "laplace_zp" - "last_crossing" "limexp" "ln" "log" "max" "min" "nature" - "net_resolution" "noise_table" "paramset" "potential" "pow" "sin" - "sinh" "slew" "sqrt" "tan" "tanh" "timer" "transition" "white_noise" - "wreal" "zi_nd" "zi_np" "zi_zd" ) nil ))) - - (verilog-font-keywords - (eval-when-compile - (verilog-regexp-opt - '( - "assign" "case" "casex" "casez" "randcase" "deassign" - "default" "disable" "else" "endcase" "endfunction" - "endgenerate" "endinterface" "endmodule" "endprimitive" - "endspecify" "endtable" "endtask" "final" "for" "force" "return" "break" - "continue" "forever" "fork" "function" "generate" "if" "iff" "initial" - "interface" "join" "join_any" "join_none" "macromodule" "module" "negedge" - "package" "endpackage" "always" "always_comb" "always_ff" - "always_latch" "posedge" "primitive" "priority" "release" - "repeat" "specify" "table" "task" "unique" "wait" "while" - "class" "program" "endclass" "endprogram" - ) nil ))) + (eval-when-compile + (verilog-regexp-opt + '("above" "abs" "absdelay" "abstol" "ac_stim" "access" "acos" + "acosh" "aliasparam" "analog" "analysis" "asin" "asinh" "atan" + "atan2" "atanh" "branch" "ceil" "connect" "connectmodule" + "connectrules" "continuous" "cos" "cosh" "ddt" "ddt_nature" + "ddx" "discipline" "discrete" "domain" "driver_update" + "endconnectrules" "enddiscipline" "endnature" "endparamset" + "exclude" "exp" "final_step" "flicker_noise" "floor" "flow" + "from" "ground" "hypot" "idt" "idt_nature" "idtmod" "inf" + "initial_step" "laplace_nd" "laplace_np" "laplace_zd" + "laplace_zp" "last_crossing" "limexp" "ln" "log" "max" + "merged" "min" "nature" "net_resolution" "noise_table" + "paramset" "potential" "pow" "resolveto" "sin" "sinh" "slew" + "split" "sqrt" "tan" "tanh" "timer" "transition" "units" + "white_noise" "wreal" "zi_nd" "zi_np" "zi_zd" "zi_zp" + ;; Excluded AMS keywords: "assert" "cross" "string" + ) nil))) + + (verilog-font-general-keywords + (eval-when-compile + (verilog-regexp-opt + '("always" "assign" "automatic" "case" "casex" "casez" "cell" + "config" "deassign" "default" "design" "disable" "edge" "else" + "endcase" "endconfig" "endfunction" "endgenerate" "endmodule" + "endprimitive" "endspecify" "endtable" "endtask" "for" "force" + "forever" "fork" "function" "generate" "if" "ifnone" "incdir" + "include" "initial" "instance" "join" "large" "liblist" + "library" "macromodule" "medium" "module" "negedge" + "noshowcancelled" "posedge" "primitive" "pulsestyle_ondetect" + "pulsestyle_onevent" "release" "repeat" "scalared" + "showcancelled" "small" "specify" "strength" "table" "task" + "use" "wait" "while" + ;; 1800-2005 + "alias" "always_comb" "always_ff" "always_latch" "assert" + "assume" "before" "bind" "bins" "binsof" "break" "class" + "clocking" "constraint" "context" "continue" "cover" + "covergroup" "coverpoint" "cross" "dist" "do" "endclass" + "endclocking" "endgroup" "endinterface" "endpackage" + "endprogram" "endproperty" "endsequence" "expect" "export" + "extends" "extern" "final" "first_match" "foreach" "forkjoin" + "iff" "ignore_bins" "illegal_bins" "import" "inside" + "interface" "intersect" "join_any" "join_none" "local" + "matches" "modport" "new" "null" "package" "priority" + "program" "property" "protected" "pure" "rand" "randc" + "randcase" "randsequence" "return" "sequence" "solve" "super" + "tagged" "this" "throughout" "timeprecision" "timeunit" + "unique" "virtual" "void" "wait_order" "wildcard" "with" + "within" + ;; 1800-2009 + "accept_on" "checker" "endchecker" "eventually" "global" + "implies" "let" "nexttime" "reject_on" "restrict" "s_always" + "s_eventually" "s_nexttime" "s_until" "s_until_with" "strong" + "sync_accept_on" "sync_reject_on" "unique0" "until" + "until_with" "untyped" "weak" + ;; 1800-2012 + "implements" "soft" ) nil))) (verilog-font-grouping-keywords - (eval-when-compile - (verilog-regexp-opt - '( "begin" "end" ) nil )))) + (eval-when-compile + (verilog-regexp-opt + '( "begin" "end" ) nil)))) (setq verilog-font-lock-keywords (list ;; Fontify all builtin keywords - (concat "\\<\\(" verilog-font-keywords "\\|" + (concat "\\<\\(" verilog-font-general-keywords "\\|" ;; And user/system tasks and functions "\\$[a-zA-Z][a-zA-Z0-9_\\$]*" "\\)\\>") ;; Fontify all types - (if verilog-highlight-grouping-keywords - (cons (concat "\\<\\(" verilog-font-grouping-keywords "\\)\\>") - 'verilog-font-lock-grouping-keywords-face) - (cons (concat "\\<\\(" verilog-font-grouping-keywords "\\)\\>") + (cons (concat "\\<\\(" verilog-font-grouping-keywords "\\)\\>") + (if verilog-highlight-grouping-keywords + 'verilog-font-lock-grouping-keywords-face 'font-lock-type-face)) (cons (concat "\\<\\(" verilog-type-font-keywords "\\)\\>") 'font-lock-type-face) - ;; Fontify IEEE-1800-2005 keywords appropriately - (if verilog-highlight-p1800-keywords - (cons (concat "\\<\\(" verilog-1800-2005-keywords "\\)\\>") - 'verilog-font-lock-p1800-face) - (cons (concat "\\<\\(" verilog-1800-2005-keywords "\\)\\>") - 'font-lock-type-face)) - ;; Fontify IEEE-1800-2009 keywords appropriately - (if verilog-highlight-p1800-keywords - (cons (concat "\\<\\(" verilog-1800-2009-keywords "\\)\\>") - 'verilog-font-lock-p1800-face) - (cons (concat "\\<\\(" verilog-1800-2009-keywords "\\)\\>") - 'font-lock-type-face)) - ;; Fontify IEEE-1800-2012 keywords appropriately - (if verilog-highlight-p1800-keywords - (cons (concat "\\<\\(" verilog-1800-2012-keywords "\\)\\>") - 'verilog-font-lock-p1800-face) - (cons (concat "\\<\\(" verilog-1800-2012-keywords "\\)\\>") - 'font-lock-type-face)) ;; Fontify Verilog-AMS keywords (cons (concat "\\<\\(" verilog-ams-keywords "\\)\\>") 'verilog-font-lock-ams-face))) @@ -3960,15 +3949,15 @@ Key bindings specific to `verilog-mode-map' are: (setq hs-special-modes-alist (cons '(verilog-mode "\\" "\\" nil verilog-forward-sexp-function) - hs-special-modes-alist)))) + hs-special-modes-alist)))) (add-hook 'completion-at-point-functions #'verilog-completion-at-point nil 'local) ;; Stuff for autos (add-hook (if (boundp 'write-contents-hooks) 'write-contents-hooks - 'write-contents-functions) ; Emacs >= 22.1 - 'verilog-auto-save-check nil 'local) + 'write-contents-functions) ; Emacs >= 22.1 + 'verilog-auto-save-check nil 'local) ;; verilog-mode-hook call added by define-derived-mode ) @@ -4164,6 +4153,7 @@ With optional ARG, remove existing end of line comments." To call this from the command line, see \\[verilog-batch-indent]." (interactive) (verilog-mode) + (verilog-auto-reeval-locals) (indent-region (point-min) (point-max) nil)) (defun verilog-insert-block () @@ -4985,21 +4975,21 @@ primitive or interface named NAME." (match-end 11) ; of verilog-end-block-ordered-re ;;(goto-char there) (let ((nest 0) - (reg "\\<\\(class\\)\\|\\(endclass\\)\\|\\(package\\|primitive\\|\\(macro\\)?module\\)\\>") + (reg "\\<\\(\\(class\\)\\|\\(endclass\\)\\|\\(package\\|primitive\\|\\(macro\\)?module\\)\\)\\>") string) (save-excursion (catch 'skip (while (verilog-re-search-backward reg nil 'move) (cond - ((match-end 3) ; endclass + ((match-end 4) ; endclass (ding 't) (setq string "unmatched endclass") (throw 'skip 1)) - ((match-end 2) ; endclass + ((match-end 3) ; endclass (setq nest (1+ nest))) - ((match-end 1) ; class + ((match-end 2) ; class (setq nest (1- nest)) (if (< nest 0) (progn @@ -5407,6 +5397,9 @@ This lets programs calling batch mode to easily extract error messages." (error "%%Error: %s%s" (error-message-string err) (if (featurep 'xemacs) "\n" "")))))) ; XEmacs forgets to add a newline +;; Eliminate compile warning +(defvar verilog-batch-orig-buffer-string) + (defun verilog-batch-execute-func (funref &optional no-save) "Internal processing of a batch command. Runs FUNREF on all command arguments. @@ -5428,26 +5421,31 @@ Save the result unless optional NO-SAVE is t." ;; Remember buffer list, so don't later pickup any verilog-getopt files (let ((orig-buffer-list (buffer-list))) (mapc (lambda (buf) - (when (buffer-file-name buf) - (with-current-buffer buf - (verilog-mode) - (verilog-auto-reeval-locals) - (verilog-getopt-flags)))) - orig-buffer-list) + (when (buffer-file-name buf) + (with-current-buffer buf + (set (make-local-variable 'verilog-batch-orig-buffer-string) + (buffer-string)) + (put 'verilog-batch-orig-buffer-string 'permanent-local t) + (verilog-mode) + (verilog-auto-reeval-locals) + (verilog-getopt-flags)))) + orig-buffer-list) ;; Process the files - (mapcar (lambda (buf) - (when (buffer-file-name buf) - (save-excursion - (if (not (file-exists-p (buffer-file-name buf))) - (error - "File not found: %s" (buffer-file-name buf))) - (message "Processing %s" (buffer-file-name buf)) - (set-buffer buf) - (funcall funref) - (when (and (not no-save) - (buffer-modified-p)) ; Avoid "no changes to be saved" - (save-buffer))))) - orig-buffer-list)))) + (mapc (lambda (buf) + (when (buffer-file-name buf) + (save-excursion + (if (not (file-exists-p (buffer-file-name buf))) + (error + "File not found: %s" (buffer-file-name buf))) + (message "Processing %s" (buffer-file-name buf)) + (set-buffer buf) + (funcall funref) + (verilog-star-cleanup) + (when (and (not no-save) + (buffer-modified-p) + (not (equal verilog-batch-orig-buffer-string (buffer-string)))) + (save-buffer))))) + orig-buffer-list)))) (defun verilog-batch-auto () "For use with --batch, perform automatic expansions as a stand-alone tool. @@ -6408,7 +6406,7 @@ Return >0 for nested struct." (equal (char-before) ?\;) (equal (char-before) ?\})) ;; skip what looks like bus repetition operator {#{ - (not (string-match "^{\\s-*[0-9]+\\s-*{" (buffer-substring p (point))))))))) + (not (string-match "^{\\s-*[0-9a-zA-Z_]+\\s-*{" (buffer-substring p (point))))))))) (progn (let ( (pt (point)) (pass 0)) (verilog-backward-ws&directives) @@ -6426,9 +6424,11 @@ Return >0 for nested struct." ;; check next word token (if (looking-at "\\<\\w+\\>\\|\\s-*(\\s-*\\S-+") (progn (verilog-beg-of-statement) - (if (looking-at (concat "\\<\\(constraint\\|" + (if (and + (not (string-match verilog-named-block-re (buffer-substring pt (point)))) ;; Abort if 'begin' keyword is found + (looking-at (concat "\\<\\(constraint\\|" "\\(?:\\w+\\s-*:\\s-*\\)?\\(coverpoint\\|cross\\)" - "\\|with\\)\\>\\|" verilog-in-constraint-re)) + "\\|with\\)\\>\\|" verilog-in-constraint-re))) (setq pass 1))))) (if (eq pass 0) (progn (goto-char pt) nil) 1))) @@ -8193,11 +8193,11 @@ Duplicate signals are also removed. For example A[2] and A[1] become A[2:1]." (setq bus (verilog-sig-bits sig)) (setq bus (and bus (verilog-simplify-range-expression bus))) (cond ((and bus - (or (and (string-match "\\[\\([0-9]+\\):\\([0-9]+\\)\\]" bus) + (or (and (string-match "^\\[\\([0-9]+\\):\\([0-9]+\\)\\]$" bus) (setq highbit (string-to-number (match-string 1 bus)) lowbit (string-to-number (match-string 2 bus)))) - (and (string-match "\\[\\([0-9]+\\)\\]" bus) + (and (string-match "^\\[\\([0-9]+\\)\\]$" bus) (setq highbit (string-to-number (match-string 1 bus)) lowbit highbit)))) ;; Combine bits in bus @@ -8431,7 +8431,7 @@ Optional NUM-PARAM and MAX-PARAM check for a specific number of parameters." ;; /*AUTOPUNT("parameter", "parameter")*/ (backward-sexp 1) (while (looking-at "(?\\s *\"\\([^\"]*\\)\"\\s *,?") - (setq olist (cons (match-string 1) olist)) + (setq olist (cons (match-string-no-properties 1) olist)) (goto-char (match-end 0)))) (or (eq nil num-param) (<= num-param (length olist)) @@ -8463,12 +8463,12 @@ Return an array of [outputs inouts inputs wire reg assign const]." (cond ((looking-at "//") (when (looking-at "[^\n]*\\(auto\\|synopsys\\)\\s +enum\\s +\\([a-zA-Z0-9_]+\\)") - (setq enum (match-string 2))) + (setq enum (match-string-no-properties 2))) (search-forward "\n")) ((looking-at "/\\*") (forward-char 2) (when (looking-at "[^\n]*\\(auto\\|synopsys\\)\\s +enum\\s +\\([a-zA-Z0-9_]+\\)") - (setq enum (match-string 2))) + (setq enum (match-string-no-properties 2))) (or (search-forward "*/") (error "%s: Unmatched /* */, at char %d" (verilog-point-text) (point)))) ((looking-at "(\\*") @@ -8520,7 +8520,8 @@ Return an array of [outputs inouts inputs wire reg assign const]." (cond (newsig ; Memory, not just width. Patch last signal added's memory (nth 3) (setcar (cdr (cdr (cdr newsig))) (if (verilog-sig-memory newsig) - (concat (verilog-sig-memory newsig) (match-string 1)) + (concat (verilog-sig-memory newsig) + (match-string-no-properties 1)) (match-string-no-properties 1)))) (vec ; Multidimensional (setq multidim (cons vec multidim)) @@ -8534,14 +8535,14 @@ Return an array of [outputs inouts inputs wire reg assign const]." (goto-char (match-end 0)) (setq last-keywd keywd keywd (match-string-no-properties 1)) - (when (string-match "^\\\\" (match-string 1)) + (when (string-match "^\\\\" (match-string-no-properties 1)) (setq keywd (concat keywd " "))) ; Escaped ID needs space at end ;; Add any :: package names to same identifier ;; '*' here is for "import x::*" (while (looking-at "\\s-*::\\s-*\\(\\*\\|[a-zA-Z0-9`_$]+\\|\\\\[^ \t\n\f]+\\)") (goto-char (match-end 0)) - (setq keywd (concat keywd "::" (match-string 1))) - (when (string-match "^\\\\" (match-string 1)) + (setq keywd (concat keywd "::" (match-string-no-properties 1))) + (when (string-match "^\\\\" (match-string-no-properties 1)) (setq keywd (concat keywd " ")))) ; Escaped ID needs space at end (cond ((equal keywd "input") (setq vec nil enum nil rvalue nil newsig nil signed nil @@ -8626,10 +8627,12 @@ Return an array of [outputs inouts inputs wire reg assign const]." ((and v2kargs-ok (eq paren 1) (not rvalue) - (looking-at "\\s-*\\(\\.\\(\\s-*[a-zA-Z`_$][a-zA-Z0-9`_$]*\\)\\|\\)\\s-*[a-zA-Z`_$][a-zA-Z0-9`_$]*")) + (or (looking-at "\\s-*#") + (looking-at "\\s-*\\(\\.\\(\\s-*[a-zA-Z`_$][a-zA-Z0-9`_$]*\\)\\|\\)\\s-*[a-zA-Z`_$][a-zA-Z0-9`_$]*"))) (when (match-end 2) (goto-char (match-end 2))) (setq vec nil enum nil rvalue nil signed nil - typedefed keywd multidim nil ptype nil modport (match-string 2) + typedefed keywd multidim nil ptype nil + modport (match-string-no-properties 2) newsig nil sig-paren paren expect-signal 'sigs-intf io t )) ;; Ignore dotted LHS assignments: "assign foo.bar = z;" @@ -8678,7 +8681,8 @@ Return an array of [outputs inouts inputs wire reg assign const]." ((and expect-signal (not rvalue) (eq functask 0) - (not (member keywd verilog-keywords))) + (not (member keywd verilog-keywords)) + (or (not io) (eq paren sig-paren))) ;; Add new signal to expect-signal's variable ;;(if dbg (setq dbg (concat dbg (format "Pt %s New sig %s'\n" (point) keywd)))) (setq newsig (verilog-sig-new keywd vec nil nil enum signed typedefed multidim modport)) @@ -8851,8 +8855,9 @@ Return an array of [outputs inouts inputs wire reg assign const]." ;;(message "vrsde-s: `%s'" (match-string 1 expr)) (setq sig (verilog-string-remove-spaces (match-string 1 expr)) expr (substring expr (match-end 0))))) - ;; Find [vector] or [multi][multi][multi][vector] - (while (string-match "^\\s-*\\(\\[[^]]+\\]\\)" expr) + ;; Find [vector] or [multi][multi][multi][vector] or [vector[VEC2]] + ;; Unfortunately Emacs regexps don't allow matching bracket searches, so just 2 deep. + (while (string-match "^\\s-*\\(\\[\\([^][]+\\|\\[[^][]+\\]\\)*\\]\\)" expr) ;;(message "vrsde-v: `%s'" (match-string 1 expr)) (when vec (setq multidim (cons vec multidim))) (setq vec (match-string 1 expr) @@ -8910,7 +8915,7 @@ Inserts the list of signals found, using submodi to look up each port." (verilog-string-remove-spaces (match-string-no-properties 1)) ; sig nil nil nil)) ; vec multidim mem ;; - ((looking-at "\\([a-zA-Z_][a-zA-Z_0-9]*\\)\\s-*\\(\\[[^]]+\\]\\)\\s-*)") + ((looking-at "\\([a-zA-Z_][a-zA-Z_0-9]*\\)\\s-*\\(\\[[^][]+\\]\\)\\s-*)") (verilog-read-sub-decls-sig submoddecls par-values comment port (verilog-string-remove-spaces (match-string-no-properties 1)) ; sig @@ -8926,7 +8931,7 @@ Inserts the list of signals found, using submodi to look up each port." (point)))))))) ; expr ;; (forward-line 1))))) -;;(verilog-read-sub-decls-line (verilog-subdecls-new nil nil nil nil nil) nil "Cmt") +;;(verilog-read-sub-decls-line (verilog-decls-new nil nil nil nil nil nil nil nil nil) nil "Cmt") (defun verilog-read-sub-decls-gate (submoddecls par-values comment submod end-inst-point) "For `verilog-read-sub-decls', read lines of UDP gate decl until none match. @@ -8953,7 +8958,7 @@ Inserts the list of signals found." iolist (cdr iolist)) (verilog-read-sub-decls-expr submoddecls par-values comment "primitive_port" - (match-string 0))) + (match-string-no-properties 0))) (t (forward-char 1) (skip-syntax-forward " "))))))) @@ -9050,7 +9055,7 @@ For example if declare A A (.B(SIG)) then B will be included in the list." pins pin) (verilog-backward-open-paren) (while (re-search-forward "\\.\\([^(,) \t\n\f]*\\)\\s-*" end-mod-point t) - (setq pin (match-string 1)) + (setq pin (match-string-no-properties 1)) (unless (verilog-inside-comment-or-string-p) (setq pins (cons (list pin) pins)) (when (looking-at "(") @@ -9064,7 +9069,7 @@ For example if declare A A (.B(SIG)) then B will be included in the list." pins pin) (verilog-backward-open-paren) (while (re-search-forward "\\([a-zA-Z0-9$_.%`]+\\)" end-mod-point t) - (setq pin (match-string 1)) + (setq pin (match-string-no-properties 1)) (unless (verilog-inside-comment-or-string-p) (setq pins (cons (list pin) pins)))) (vector pins)))) @@ -9085,7 +9090,7 @@ For example if declare A A (.B(SIG)) then B will be included in the list." (backward-char 1) (point))) (while (re-search-forward "\\s-*\\([\"a-zA-Z0-9$_.%`]+\\)\\s-*,*" tpl-end-pt t) - (setq sig-list (cons (list (match-string 1) nil nil) sig-list)))) + (setq sig-list (cons (list (match-string-no-properties 1) nil nil) sig-list)))) sig-list))) (defvar verilog-cache-has-lisp nil "True if any AUTO_LISP in buffer.") @@ -9117,7 +9122,7 @@ Must call `verilog-read-auto-lisp-present' before this function." "Recursive routine for parentheses/bracket matching. EXIT-KEYWD is expression to stop at, nil if top level. RVALUE is true if at right hand side of equal. -IGNORE-NEXT is true to ignore next token, fake from inside case statement." +TEMP-NEXT is true to ignore next token, fake from inside case statement." (let* ((semi-rvalue (equal "endcase" exit-keywd)) ; true if after a ; we are looking for rvalue keywd last-keywd sig-tolk sig-last-tolk gotend got-sig got-list end-else-check ignore-next) @@ -9156,7 +9161,9 @@ IGNORE-NEXT is true to ignore next token, fake from inside case statement." ;;(if dbg (setq dbg (concat dbg (format "\tif-check-else-other %s\n" keywd)))) (setq gotend t)) ;; Final statement? - ((and exit-keywd (and (equal keywd exit-keywd) + ((and exit-keywd (and (or (equal keywd exit-keywd) + (and (equal exit-keywd "'}") + (equal keywd "}"))) (not (looking-at "::")))) (setq gotend t) (forward-char (length keywd))) @@ -9169,9 +9176,13 @@ IGNORE-NEXT is true to ignore next token, fake from inside case statement." (setq end-else-check t)) (forward-char 1)) ((equal keywd "'") - (if (looking-at "'[sS]?[hdxboHDXBO]?[ \t]*[0-9a-fA-F_xzXZ?]+") - (goto-char (match-end 0)) - (forward-char 1))) + (cond ((looking-at "'[sS]?[hdxboHDXBO]?[ \t]*[0-9a-fA-F_xzXZ?]+") + (goto-char (match-end 0))) + ((looking-at "'{") + (forward-char 2) + (verilog-read-always-signals-recurse "'}" t nil)) + (t + (forward-char 1)))) ((equal keywd ":") ; Case statement, begin/end label, x?y:z (cond ((looking-at "::") (forward-char 1)) ; Another forward-char below @@ -9181,6 +9192,8 @@ IGNORE-NEXT is true to ignore next token, fake from inside case statement." ) ; NOP ((equal "]" exit-keywd) ; [x:y] rvalue ) ; NOP + ((equal "'}" exit-keywd) ; Pattern assignment + ) ; NOP (got-sig ; label: statement (setq ignore-next nil rvalue semi-rvalue got-sig nil)) ((not rvalue) ; begin label @@ -9291,9 +9304,8 @@ IGNORE-NEXT is true to ignore next token, fake from inside case statement." (forward-line 1)) (beginning-of-line) (if (looking-at "^\\s-*\\([a-zA-Z0-9`_$]+\\)\\s-+\\([a-zA-Z0-9`_$]+\\)\\s-*(") - ;;(if (looking-at "^\\(.+\\)$") - (let ((module (match-string 1)) - (instant (match-string 2))) + (let ((module (match-string-no-properties 1)) + (instant (match-string-no-properties 2))) (if (not (member module verilog-keywords)) (setq instants-list (cons (list module instant) instants-list))))) (forward-line 1))) @@ -9313,7 +9325,7 @@ Returns REGEXP and list of ( (signal_name connection_name)... )." ;; We reserve @"..." for future lisp expressions that evaluate ;; once-per-AUTOINST (when (looking-at "\\s-*\"\\([^\"]*\\)\"") - (setq tpl-regexp (match-string 1)) + (setq tpl-regexp (match-string-no-properties 1)) (goto-char (match-end 0))) (search-forward "(") ;; Parse lines in the template @@ -9510,8 +9522,8 @@ warning message, you need to add to your init file: (when recurse (goto-char (point-min)) (while (re-search-forward "^\\s-*`include\\s-+\\([^ \t\n\f]+\\)" nil t) - (let ((inc (verilog-string-replace-matches - "\"" "" nil nil (match-string-no-properties 1)))) + (let ((inc (verilog-substitute-include-name + (match-string-no-properties 1)))) (unless (verilog-inside-comment-or-string-p) (verilog-read-defines inc recurse t))))) ;; Read `defines @@ -9583,7 +9595,8 @@ foo.v (an include file): (verilog-getopt-flags) (goto-char (point-min)) (while (re-search-forward "^\\s-*`include\\s-+\\([^ \t\n\f]+\\)" nil t) - (let ((inc (verilog-string-replace-matches "\"" "" nil nil (match-string 1)))) + (let ((inc (verilog-substitute-include-name + (match-string-no-properties 1)))) (verilog-read-defines inc nil t))))) (defun verilog-read-signals (&optional start end) @@ -9735,6 +9748,12 @@ Use DEFAULT-DIR to anchor paths if non-nil." (expand-file-name (substitute-in-file-name filename) default-dir) (substitute-in-file-name filename))) +(defun verilog-substitute-include-name (filename) + "Return FILENAME for include with define substituted." + (setq filename (verilog-string-replace-matches "\"" "" nil nil filename)) + (verilog-string-replace-matches "\"" "" nil nil + (verilog-symbol-detick filename t))) + (defun verilog-add-list-unique (varref object) "Append to VARREF list the given OBJECT, unless it is already a member of the variable's list." @@ -9888,7 +9907,8 @@ If undefined, and WING-IT, return just SYMBOL without the tick, else nil." (defun verilog-symbol-detick-text (text) "Return TEXT without any known defines. -If the variable vh-{symbol} is defined, substitute that value." +If the variable vh-{symbol} is defined, substitute that value. +This function is intended for use in AUTO_TEMPLATE Lisp expressions." (let ((ok t) symbol val) (while (and ok (string-match "`\\([a-zA-Z0-9_]+\\)" text)) (setq symbol (match-string 1 text)) @@ -10520,67 +10540,96 @@ This repairs those mis-inserted by an AUTOARG." (defun verilog-simplify-range-expression (expr) "Return a simplified range expression with constants eliminated from EXPR." ;; Note this is always called with brackets; ie [z] or [z:z] - (if (not (string-match "[---+*()]" expr)) - expr ; short-circuit + (if (or (not verilog-auto-simplify-expressions) + (not (string-match "[---+*/<>()]" expr))) + expr ; disabled or short-circuited (let ((out expr) (last-pass "")) (while (not (equal last-pass out)) - (setq last-pass out) - ;; Prefix regexp needs beginning of match, or some symbol of - ;; lesser or equal precedence. We assume the [:]'s exist in expr. - ;; Ditto the end. - (while (string-match - (concat "\\([[({:*+-]\\)" ; - must be last - "(\\<\\([0-9A-Za-z_]+\\))" - "\\([])}:*+-]\\)") - out) - (setq out (replace-match "\\1\\2\\3" nil nil out))) - (while (string-match - (concat "\\([[({:*+-]\\)" ; - must be last - "\\$clog2\\s *(\\<\\([0-9]+\\))" - "\\([])}:*+-]\\)") - out) - (setq out (replace-match - (concat - (match-string 1 out) - (int-to-string (verilog-clog2 (string-to-number (match-string 2 out)))) - (match-string 3 out)) - nil nil out))) - ;; For precedence do * before +/- - (while (string-match - (concat "\\([[({:*+-]\\)" - "\\([0-9]+\\)\\s *\\([*]\\)\\s *\\([0-9]+\\)" - "\\([])}:*+-]\\)") - out) - (setq out (replace-match - (concat (match-string 1 out) - (int-to-string (* (string-to-number (match-string 2 out)) - (string-to-number (match-string 4 out)))) - (match-string 5 out)) - nil nil out))) - (while (string-match - (concat "\\([[({:+-]\\)" ; No * here as higher prec - "\\([0-9]+\\)\\s *\\([---+]\\)\\s *\\([0-9]+\\)" - "\\([])}:+-]\\)") - out) - (let ((pre (match-string 1 out)) - (lhs (string-to-number (match-string 2 out))) - (rhs (string-to-number (match-string 4 out))) - (post (match-string 5 out)) - val) - (when (equal pre "-") - (setq lhs (- lhs))) - (setq val (if (equal (match-string 3 out) "-") - (- lhs rhs) - (+ lhs rhs)) - out (replace-match - (concat (if (and (equal pre "-") - (< val 0)) - "" ; Not "--20" but just "-20" - pre) - (int-to-string val) - post) - nil nil out)) ))) + (while (not (equal last-pass out)) + (setq last-pass out) + ;; Prefix regexp needs beginning of match, or some symbol of + ;; lesser or equal precedence. We assume the [:]'s exist in expr. + ;; Ditto the end. + (while (string-match + (concat "\\([[({:*/<>+-]\\)" ; - must be last + "(\\<\\([0-9A-Za-z_]+\\))" + "\\([])}:*/<>+-]\\)") + out) + (setq out (replace-match "\\1\\2\\3" nil nil out))) + (while (string-match + (concat "\\([[({:*/<>+-]\\)" ; - must be last + "\\$clog2\\s *(\\<\\([0-9]+\\))" + "\\([])}:*/<>+-]\\)") + out) + (setq out (replace-match + (concat + (match-string 1 out) + (int-to-string (verilog-clog2 (string-to-number (match-string 2 out)))) + (match-string 3 out)) + nil nil out))) + ;; For precedence do *,/ before +,-,>>,<< + (while (string-match + (concat "\\([[({:*/<>+-]\\)" + "\\([0-9]+\\)\\s *\\([*/]\\)\\s *\\([0-9]+\\)" + "\\([])}:*/<>+-]\\)") + out) + (setq out (replace-match + (concat (match-string 1 out) + (if (equal (match-string 3 out) "/") + (int-to-string (/ (string-to-number (match-string 2 out)) + (string-to-number (match-string 4 out))))) + (if (equal (match-string 3 out) "*") + (int-to-string (* (string-to-number (match-string 2 out)) + (string-to-number (match-string 4 out))))) + (match-string 5 out)) + nil nil out))) + ;; Next precedence is +,- + (while (string-match + (concat "\\([[({:<>+-]\\)" ; No *,/ here as higher prec + "\\([0-9]+\\)\\s *\\([---+]\\)\\s *\\([0-9]+\\)" + "\\([])}:<>+-]\\)") + out) + (let ((pre (match-string 1 out)) + (lhs (string-to-number (match-string 2 out))) + (rhs (string-to-number (match-string 4 out))) + (post (match-string 5 out)) + val) + (when (equal pre "-") + (setq lhs (- lhs))) + (setq val (if (equal (match-string 3 out) "-") + (- lhs rhs) + (+ lhs rhs)) + out (replace-match + (concat (if (and (equal pre "-") + (< val 0)) + "" ; Not "--20" but just "-20" + pre) + (int-to-string val) + post) + nil nil out)) )) + ;; Next precedence is >>,<< + (while (string-match + (concat "\\([[({:]\\)" ;; No << as not transitive + "\\([0-9]+\\)\\s *\\([<]\\{2,3\\}\\|[>]\\{2,3\\}\\)\\s *\\([0-9]+\\)" + "\\([])}:<>]\\)") + out) + (setq out (replace-match + (concat (match-string 1 out) + (if (equal (match-string 3 out) ">>") + (int-to-string (lsh (string-to-number (match-string 2 out)) + (* -1 (string-to-number (match-string 4 out)))))) + (if (equal (match-string 3 out) "<<") + (int-to-string (lsh (string-to-number (match-string 2 out)) + (string-to-number (match-string 4 out))))) + (if (equal (match-string 3 out) ">>>") + (int-to-string (ash (string-to-number (match-string 2 out)) + (* -1 (string-to-number (match-string 4 out)))))) + (if (equal (match-string 3 out) "<<<") + (int-to-string (ash (string-to-number (match-string 2 out)) + (string-to-number (match-string 4 out))))) + (match-string 5 out)) + nil nil out))))) out))) ;;(verilog-simplify-range-expression "[1:3]") ; 1 @@ -10593,6 +10642,9 @@ This repairs those mis-inserted by an AUTOARG." ;;(verilog-simplify-range-expression "[FOO-1+1-1+1]") ; FOO-0 ;;(verilog-simplify-range-expression "[$clog2(2)]") ; 1 ;;(verilog-simplify-range-expression "[$clog2(7)]") ; 3 +;;(verilog-simplify-range-expression "[(TEST[1])-1:0]") +;;(verilog-simplify-range-expression "[1<<2:8>>2]") ; [4:2] +;;(verilog-simplify-range-expression "[2*4/(4-2) +2+4 <<4 >>2]") (defun verilog-clog2 (value) "Compute $clog2 - ceiling log2 of VALUE." @@ -11020,8 +11072,7 @@ or `diff' in batch mode." (progn (with-current-buffer b1 (setq buffer-file-name nil)) (verilog-auto) - (when (not verilog-auto-star-save) - (verilog-delete-auto-star-implicit))) + (verilog-star-cleanup)) ;; Restore name if unwind (with-current-buffer b1 (setq buffer-file-name name1))))) ;; @@ -11038,6 +11089,11 @@ or `diff' in batch mode." ;; Auto save ;; +(defun verilog-star-cleanup () + "On saving or diff, cleanup .* expansions." + (when (not verilog-auto-star-save) + (verilog-delete-auto-star-implicit))) + (defun verilog-auto-save-check () "On saving see if we need auto update." (cond ((not verilog-auto-save-policy)) ; disabled @@ -11057,8 +11113,7 @@ or `diff' in batch mode." (verilog-auto)) ;; Don't ask again if didn't update (set (make-local-variable 'verilog-auto-update-tick) (buffer-chars-modified-tick)))) - (when (not verilog-auto-star-save) - (verilog-delete-auto-star-implicit)) + (verilog-star-cleanup) nil) ; Always return nil -- we don't write the file ourselves (defun verilog-auto-read-locals () @@ -12254,7 +12309,7 @@ same expansion will result from only extracting outputs starting with ov: "Expand AUTOOUTPUTEVERY statements, as part of \\[verilog-auto]. Make output statements for any signals that aren't primary inputs or outputs already. This makes every signal in the design an output. This is -useful to get Synopsys to preserve every signal in the design, since it +useful to get synthesis to preserve every signal in the design, since it won't optimize away the outputs. An example: @@ -13512,19 +13567,19 @@ Finally, an AUTOASCIIENUM command is used. `verilog-auto-wire-type' may be used to change the datatype of the declarations. - \"auto enum\" may be used in place of \"synopsys enum\". + \"synopsys enum\" may be used in place of \"auto enum\". An example: //== State enumeration - parameter [2:0] // synopsys enum state_info + parameter [2:0] // auto enum state_info SM_IDLE = 3\\='b000, SM_SEND = 3\\='b001, SM_WAIT1 = 3\\='b010; //== State variables - reg [2:0] /* synopsys enum state_info */ - state_r; /* synopsys state_vector state_r */ - reg [2:0] /* synopsys enum state_info */ + reg [2:0] /* auto enum state_info */ + state_r; /* auto state_vector state_r */ + reg [2:0] /* auto enum state_info */ state_e1; /*AUTOASCIIENUM(\"state_r\", \"state_ascii_r\", \"SM_\")*/ @@ -13656,9 +13711,11 @@ being different from the final output's line numbering." (while (re-search-forward " Templated T\\([0-9]+\\) L\\([0-9]+\\)" nil t) (replace-match (concat " Templated " - (int-to-string (+ (nth (string-to-number (match-string 1)) + (int-to-string (+ (nth (string-to-number + (match-string-no-properties 1)) template-line) - (string-to-number (match-string 2))))) + (string-to-number + (match-string-no-properties 2))))) t t)))) (defun verilog-auto-template-lint () @@ -14420,11 +14477,14 @@ Files are checked based on `verilog-library-flags'." (when (and (not hit) (looking-at verilog-include-file-regexp)) (if (and (car (verilog-library-filenames - (match-string 1) (buffer-file-name))) + (match-string-no-properties 1) + (buffer-file-name))) (file-readable-p (car (verilog-library-filenames - (match-string 1) (buffer-file-name))))) + (match-string-no-properties 1) + (buffer-file-name))))) (find-file (car (verilog-library-filenames - (match-string 1) (buffer-file-name)))) + (match-string-no-properties 1) + (buffer-file-name)))) (when warn (message "File `%s' isn't readable, use shift-mouse2 to paste in this field" @@ -14509,7 +14569,6 @@ Files are checked based on `verilog-library-flags'." verilog-highlight-grouping-keywords verilog-highlight-includes verilog-highlight-modules - verilog-highlight-p1800-keywords verilog-highlight-translate-off verilog-indent-begin-after-if verilog-indent-declaration-macros commit df108bf927494909ad3df206814fe688cd332db5 Author: Juri Linkov Date: Sun Nov 25 23:40:00 2018 +0200 * lisp/windmove.el: Directional window deletion (bug#32790) * lisp/windmove.el (windmove-delete-in-direction) (windmove-delete-left, windmove-delete-up) (windmove-delete-right, windmove-delete-down) (windmove-delete-default-keybindings): New functions. diff --git a/etc/NEWS b/etc/NEWS index eb3f314ccf..1ddc565b8b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -304,6 +304,9 @@ back, customize 'follow-hide-ghost-cursors' to nil. ** Windmove +*** 'windmove-create-window' when non-nil makes a new window on moving off +the edge of the frame. + *** Windmove supports directional window display and selection. The new command 'windmove-display-default-keybindings' binds default keys with provided modifiers (by default, Shift-Meta) to the commands @@ -316,8 +319,13 @@ creating the window if necessary. A special key can be customized to display the buffer in the same window, for example, 'S-M-0 C-h e' displays the *Messages* buffer in the same window. -*** 'windmove-create-window' when non-nil makes a new window on moving off -the edge of the frame. +*** Windmove also supports directional window deletion. +The new command 'windmove-delete-default-keybindings' binds default +keys with provided prefix (by default, C-x) and modifiers (by default, +Shift) to the commands that delete the window in the specified +direction. For example, 'C-x S-down' deletes the window below. +With a prefix arg 'C-u', deletes the selected window and selects +the window that was in the specified direction. ** Octave mode The mode is automatically enabled in files that start with the diff --git a/lisp/windmove.el b/lisp/windmove.el index 898f87e2db..6d61806a83 100644 --- a/lisp/windmove.el +++ b/lisp/windmove.el @@ -678,6 +678,73 @@ Default value of MODIFIERS is `shift-meta'." (global-set-key (vector (append modifiers '(down))) 'windmove-display-down) (global-set-key (vector (append modifiers '(?0))) 'windmove-display-same-window)) +;;; Directional window deletion + +(defun windmove-delete-in-direction (dir &optional arg) + "Delete the window at direction DIR. +If prefix ARG is `C-u', delete the selected window and +select the window at direction DIR. +When `windmove-wrap-around' is non-nil, takes the window +from the opposite side of the frame." + (let ((other-window (window-in-direction dir nil nil arg + windmove-wrap-around t))) + (cond ((null other-window) + (user-error "No window %s from selected window" dir)) + (t + (if (not (consp arg)) + (delete-window other-window) + (delete-window (selected-window)) + (select-window other-window)))))) + +;;;###autoload +(defun windmove-delete-left (&optional arg) + "Delete the window to the left of the current one. +If prefix ARG is `C-u', delete the selected window and +select the window that was to the left of the current one." + (interactive "P") + (windmove-delete-in-direction 'left arg)) + +;;;###autoload +(defun windmove-delete-up (&optional arg) + "Delete the window above the current one. +If prefix ARG is `C-u', delete the selected window and +select the window that was above the current one." + (interactive "P") + (windmove-delete-in-direction 'up arg)) + +;;;###autoload +(defun windmove-delete-right (&optional arg) + "Delete the window to the right of the current one. +If prefix ARG is `C-u', delete the selected window and +select the window that was to the right of the current one." + (interactive "P") + (windmove-delete-in-direction 'right arg)) + +;;;###autoload +(defun windmove-delete-down (&optional arg) + "Delete the window below the current one. +If prefix ARG is `C-u', delete the selected window and +select the window that was below the current one." + (interactive "P") + (windmove-delete-in-direction 'down arg)) + +;;;###autoload +(defun windmove-delete-default-keybindings (&optional prefix modifiers) + "Set up keybindings for directional window deletion. +Keys are bound to commands that delete windows in the specified +direction. Keybindings are of the form PREFIX MODIFIERS-{left,right,up,down}, +where PREFIX is a prefix key and MODIFIERS is either a list of modifiers or +a single modifier. Default value of PREFIX is `C-x' and MODIFIERS is `shift'." + (interactive) + (unless prefix (setq prefix '(?\C-x))) + (unless (listp prefix) (setq prefix (list prefix))) + (unless modifiers (setq modifiers '(shift))) + (unless (listp modifiers) (setq modifiers (list modifiers))) + (global-set-key (vector prefix (append modifiers '(left))) 'windmove-delete-left) + (global-set-key (vector prefix (append modifiers '(right))) 'windmove-delete-right) + (global-set-key (vector prefix (append modifiers '(up))) 'windmove-delete-up) + (global-set-key (vector prefix (append modifiers '(down))) 'windmove-delete-down)) + (provide 'windmove) ;;; windmove.el ends here commit 1b8c5961ea6816db9d1bd725c3815ed3dcbd3643 Author: Michael Albinus Date: Sun Nov 25 21:49:41 2018 +0100 ; * lisp/net/tramp-archive.el (tramp-archive-autoload-file-name-regexp): ; Keep indentation. diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index fd29ca8fd1..4c9439102a 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -176,10 +176,10 @@ It must be supported by libarchive(3).") "Regular expression matching archive file names." '(concat "\\`" "\\(" ".+" "\\." - ;; Default suffixes ... - (regexp-opt tramp-archive-suffixes) - ;; ... with compression. - "\\(?:" "\\." (regexp-opt tramp-archive-compression-suffixes) "\\)*" + ;; Default suffixes ... + (regexp-opt tramp-archive-suffixes) + ;; ... with compression. + "\\(?:" "\\." (regexp-opt tramp-archive-compression-suffixes) "\\)*" "\\)" ;; \1 "\\(" "/" ".*" "\\)" "\\'"))) ;; \2 commit 1808d254a5820e8c650013033f800ca2990cd239 Author: Michael Heerdegen Date: Mon Nov 5 01:22:15 2018 +0100 Replace insignificant backquotes Replace most insignificant occurrences of '`' with a straight quote, sharp quote or nothing. This includes backquotes in 'pcase' patterns. * admin/admin.el: * lisp/apropos.el: * lisp/arc-mode.el: * lisp/auth-source.el: * lisp/avoid.el: * lisp/bindings.el: * lisp/bs.el: * lisp/calculator.el: * lisp/calendar/todo-mode.el: * lisp/cedet/semantic.el: * lisp/cedet/semantic/analyze/debug.el: * lisp/cedet/semantic/bovine.el: * lisp/cedet/semantic/dep.el: * lisp/cedet/semantic/grammar.el: * lisp/cedet/semantic/wisent/comp.el: * lisp/cedet/semantic/wisent/grammar.el: * lisp/cedet/srecode/mode.el: * lisp/cus-edit.el: * lisp/doc-view.el: * lisp/elec-pair.el: * lisp/electric.el: * lisp/emacs-lisp/autoload.el: * lisp/emacs-lisp/benchmark.el: * lisp/emacs-lisp/byte-opt.el: * lisp/emacs-lisp/bytecomp.el: * lisp/emacs-lisp/cconv.el: * lisp/emacs-lisp/cl-extra.el: * lisp/emacs-lisp/cl-generic.el: * lisp/emacs-lisp/cl-macs.el: * lisp/emacs-lisp/copyright.el: * lisp/emacs-lisp/debug.el: * lisp/emacs-lisp/eieio-compat.el: * lisp/emacs-lisp/ert.el: * lisp/emacs-lisp/generator.el: * lisp/emacs-lisp/inline.el: * lisp/emacs-lisp/macroexp.el: * lisp/emacs-lisp/map.el: * lisp/emacs-lisp/package-x.el: * lisp/emacs-lisp/package.el: * lisp/emacs-lisp/radix-tree.el: * lisp/emacs-lisp/smie.el: * lisp/epa.el: * lisp/erc/erc-dcc.el: * lisp/erc/erc-track.el: * lisp/erc/erc.el: * lisp/eshell/em-ls.el: * lisp/eshell/esh-cmd.el: * lisp/files.el: * lisp/filesets.el: * lisp/font-lock.el: * lisp/frameset.el: * lisp/gnus/gnus-agent.el: * lisp/gnus/gnus-art.el: * lisp/gnus/gnus-cite.el: * lisp/gnus/gnus-group.el: * lisp/gnus/gnus-msg.el: * lisp/gnus/gnus-salt.el: * lisp/gnus/gnus-srvr.el: * lisp/gnus/gnus-sum.el: * lisp/gnus/gnus-topic.el: * lisp/gnus/gnus-util.el: * lisp/gnus/gnus.el: * lisp/gnus/message.el: * lisp/gnus/mm-util.el: * lisp/gnus/mml.el: * lisp/gnus/nnheader.el: * lisp/gnus/nnimap.el: * lisp/gnus/nnmairix.el: * lisp/gnus/spam.el: * lisp/hexl.el: * lisp/hi-lock.el: * lisp/ibuf-ext.el: * lisp/ibuffer.el: * lisp/ido.el: * lisp/info.el: * lisp/international/mule-cmds.el: * lisp/international/mule-util.el: * lisp/json.el: * lisp/jsonrpc.el: * lisp/language/cyrillic.el: * lisp/language/european.el: * lisp/language/georgian.el: * lisp/language/tibetan.el: * lisp/language/utf-8-lang.el: * lisp/language/vietnamese.el: * lisp/ldefs-boot.el: * lisp/mail/mail-extr.el: * lisp/man.el: * lisp/menu-bar.el: * lisp/mh-e/mh-acros.el: * lisp/mh-e/mh-folder.el: * lisp/mh-e/mh-mime.el: * lisp/mh-e/mh-show.el: * lisp/mh-e/mh-speed.el: * lisp/minibuffer.el: * lisp/mpc.el: * lisp/net/ange-ftp.el: * lisp/net/hmac-def.el: * lisp/net/newst-backend.el: * lisp/net/quickurl.el: * lisp/net/tramp-archive.el: * lisp/net/tramp-compat.el: * lisp/notifications.el: * lisp/obsolete/pgg-parse.el: * lisp/obsolete/vc-arch.el: * lisp/obsolete/xesam.el: * lisp/org/ob-C.el: * lisp/org/ob-core.el: * lisp/org/ob-exp.el: * lisp/org/ob-groovy.el: * lisp/org/ob-haskell.el: * lisp/org/ob-io.el: * lisp/org/ob-lisp.el: * lisp/org/ob-lob.el: * lisp/org/ob-lua.el: * lisp/org/ob-octave.el: * lisp/org/ob-perl.el: * lisp/org/ob-python.el: * lisp/org/ob-ref.el: * lisp/org/ob-ruby.el: * lisp/org/ob-sql.el: * lisp/org/org-agenda.el: * lisp/org/org-capture.el: * lisp/org/org-clock.el: * lisp/org/org-colview.el: * lisp/org/org-duration.el: * lisp/org/org-element.el: * lisp/org/org-entities.el: * lisp/org/org-gnus.el: * lisp/org/org-indent.el: * lisp/org/org-info.el: * lisp/org/org-inlinetask.el: * lisp/org/org-lint.el: * lisp/org/org-list.el: * lisp/org/org-mouse.el: * lisp/org/org-plot.el: * lisp/org/org-src.el: * lisp/org/org-table.el: * lisp/org/org.el: * lisp/org/ox-ascii.el: * lisp/org/ox-html.el: * lisp/org/ox-latex.el: * lisp/org/ox-man.el: * lisp/org/ox-md.el: * lisp/org/ox-org.el: * lisp/org/ox-publish.el: * lisp/org/ox-texinfo.el: * lisp/org/ox.el: * lisp/play/bubbles.el: * lisp/play/gamegrid.el: * lisp/progmodes/autoconf.el: * lisp/progmodes/cc-defs.el: * lisp/progmodes/cc-engine.el: * lisp/progmodes/cc-fonts.el: * lisp/progmodes/cc-langs.el: * lisp/progmodes/cperl-mode.el: * lisp/progmodes/ebrowse.el: * lisp/progmodes/elisp-mode.el: * lisp/progmodes/flymake-cc.el: * lisp/progmodes/flymake.el: * lisp/progmodes/fortran.el: * lisp/progmodes/grep.el: * lisp/progmodes/gud.el: * lisp/progmodes/idlwave.el: * lisp/progmodes/js.el: * lisp/progmodes/m4-mode.el: * lisp/progmodes/make-mode.el: * lisp/progmodes/mixal-mode.el: * lisp/progmodes/modula2.el: * lisp/progmodes/octave.el: * lisp/progmodes/opascal.el: * lisp/progmodes/prolog.el: * lisp/progmodes/ps-mode.el: * lisp/progmodes/python.el: * lisp/progmodes/ruby-mode.el: * lisp/progmodes/sh-script.el: * lisp/progmodes/sql.el: * lisp/progmodes/verilog-mode.el: * lisp/ps-mule.el: * lisp/rtree.el: * lisp/ruler-mode.el: * lisp/ses.el: * lisp/simple.el: * lisp/startup.el: * lisp/subr.el: * lisp/term/ns-win.el: * lisp/textmodes/bibtex.el: * lisp/textmodes/conf-mode.el: * lisp/textmodes/css-mode.el: * lisp/textmodes/refill.el: * lisp/textmodes/sgml-mode.el: * lisp/textmodes/tex-mode.el: * lisp/tutorial.el: * lisp/url/url-dav.el: * lisp/url/url-gw.el: * lisp/url/url-http.el: * lisp/url/url-methods.el: * lisp/url/url-privacy.el: * lisp/vc/cvs-status.el: * lisp/vc/diff-mode.el: * lisp/vc/ediff-init.el: * lisp/vc/ediff-ptch.el: * lisp/vc/log-edit.el: * lisp/vc/log-view.el: * lisp/vc/pcvs-info.el: * lisp/vc/pcvs.el: * lisp/vc/smerge-mode.el: * lisp/vc/vc-git.el: * lisp/vc/vc-hg.el: * lisp/vc/vc-mtn.el: * lisp/vc/vc-rcs.el: * lisp/whitespace.el: * lisp/window.el: * test/lisp/electric-tests.el: * test/lisp/emacs-lisp/cl-lib-tests.el: * test/lisp/emacs-lisp/ert-tests.el: * test/lisp/epg-tests.el: * test/lisp/jsonrpc-tests.el: * test/src/data-tests.el: * test/src/json-tests.el: Replace most insignificant backquotes. diff --git a/admin/admin.el b/admin/admin.el index 1cad7ae277..3fc50afe9f 100644 --- a/admin/admin.el +++ b/admin/admin.el @@ -657,7 +657,7 @@ style=\"text-align:left\">") (defconst make-manuals-dist-output-variables - `(("@\\(top_\\)?srcdir@" . ".") ; top_srcdir is wrong, but not used + '(("@\\(top_\\)?srcdir@" . ".") ; top_srcdir is wrong, but not used ("^\\(\\(?:texinfo\\|buildinfo\\|emacs\\)dir *=\\).*" . "\\1 .") ("^\\(clean:.*\\)" . "\\1 infoclean") ("@MAKEINFO@" . "makeinfo") diff --git a/lisp/apropos.el b/lisp/apropos.el index b774036261..a13a0c2535 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -688,12 +688,12 @@ the output includes key-bindings of commands." (dolist (x (cdr lh-entry)) (pcase (car-safe x) ;; (autoload (push (cdr x) autoloads)) - (`require (push (cdr x) requires)) - (`provide (push (cdr x) provides)) - (`t nil) ; Skip "was an autoload" entries. + ('require (push (cdr x) requires)) + ('provide (push (cdr x) provides)) + ('t nil) ; Skip "was an autoload" entries. ;; FIXME: Print information about each individual method: both ;; its docstring and specializers (bug#21422). - (`cl-defmethod (push (cadr x) provides)) + ('cl-defmethod (push (cadr x) provides)) (_ (push (or (cdr-safe x) x) symbols)))) (let ((apropos-pattern "")) ;Dummy binding for apropos-symbols-internal. (apropos-symbols-internal diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 50048c0cb3..068702bc71 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -2066,7 +2066,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ;; The code below assumes the name is relative and may do undesirable ;; things otherwise. (error "Can't extract files with non-relative names") - (archive-extract-by-file archive name `("unar" "-no-directory" "-o") "Successfully extracted"))) + (archive-extract-by-file archive name '("unar" "-no-directory" "-o") "Successfully extracted"))) ;;; Section: Rar self-extracting .exe archives. diff --git a/lisp/auth-source.el b/lisp/auth-source.el index fd529b392a..fda6cfc34b 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -167,7 +167,7 @@ let-binding." (defcustom auth-source-save-behavior 'ask "If set, auth-source will respect it for save behavior." :version "23.2" ;; No Gnus - :type `(choice + :type '(choice :tag "auth-source new token save behavior" (const :tag "Always save" t) (const :tag "Never save" nil) @@ -200,7 +200,7 @@ Note that if EPA/EPG is not available, this should NOT be used." (defcustom auth-source-do-cache t "Whether auth-source should cache information with `password-cache'." :version "23.2" ;; No Gnus - :type `boolean) + :type 'boolean) (defcustom auth-source-debug nil "Whether auth-source should log debug messages. @@ -214,7 +214,7 @@ for passwords). If the value is a function, debug messages are logged by calling that function using the same arguments as `message'." :version "23.2" ;; No Gnus - :type `(choice + :type '(choice :tag "auth-source debugging mode" (const :tag "Log using `message' to the *Messages* buffer" t) (const :tag "Log all trivia with `message' to the *Messages* buffer" diff --git a/lisp/avoid.el b/lisp/avoid.el index 5e99dd8eba..f5519e9493 100644 --- a/lisp/avoid.el +++ b/lisp/avoid.el @@ -205,8 +205,8 @@ If you want the mouse banished to a different corner set 'frame-or-window mouse-avoidance-banish-position 'eq)) (list-values (pcase fra-or-win - (`frame (list 0 0 (frame-width) (frame-height))) - (`window (window-edges)))) + ('frame (list 0 0 (frame-width) (frame-height))) + ('window (window-edges)))) (alist (cl-loop for v in list-values for k in '(left top right bottom) collect (cons k v))) @@ -223,11 +223,11 @@ If you want the mouse banished to a different corner set 'top-or-bottom-pos mouse-avoidance-banish-position #'eq)) (side-fn (pcase side - (`left '+) - (`right '-))) + ('left '+) + ('right '-))) (top-or-bottom-fn (pcase top-or-bottom - (`top '+) - (`bottom '-)))) + ('top '+) + ('bottom '-)))) (cons (funcall side-fn ; -/+ (assoc-default side alist 'eq) ; right or left side-dist) ; distance from side diff --git a/lisp/bindings.el b/lisp/bindings.el index bc4e741d01..10c4ae50a9 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -417,7 +417,7 @@ zero, otherwise they start from one." This option specifies both the field width and the type of offset displayed in `mode-line-position', a component of the default `mode-line-format'." - :type `(radio + :type '(radio (const :tag "nil: No offset is displayed" nil) (const :tag "\"%o\": Proportion of \"travel\" of the window through the buffer" (-3 "%o")) @@ -724,11 +724,11 @@ okay. See `mode-line-format'.") ;; FIXME: Maybe beginning-of-line, beginning-of-buffer, end-of-line, ;; end-of-buffer, end-of-file, buffer-read-only, and ;; file-supersession should all be user-errors! - `(beginning-of-line beginning-of-buffer end-of-line - end-of-buffer end-of-file buffer-read-only - file-supersession mark-inactive - user-error ;; That's the main one! - )) + '(beginning-of-line beginning-of-buffer end-of-line + end-of-buffer end-of-file buffer-read-only + file-supersession mark-inactive + user-error ;; That's the main one! + )) (make-variable-buffer-local 'indent-tabs-mode) diff --git a/lisp/bs.el b/lisp/bs.el index 32431ba446..1021e82430 100644 --- a/lisp/bs.el +++ b/lisp/bs.el @@ -828,8 +828,8 @@ See `visit-tags-table'." (let ((res (with-current-buffer (bs--current-buffer) (setq bs-buffer-show-mark (pcase bs-buffer-show-mark - (`nil 'never) - (`never 'always) + ('nil 'never) + ('never 'always) (_ nil)))))) (bs--update-current-line) (bs--set-window-height) diff --git a/lisp/calculator.el b/lisp/calculator.el index f559fb4828..c3fb68931e 100644 --- a/lisp/calculator.el +++ b/lisp/calculator.el @@ -1184,7 +1184,7 @@ arguments." (DX (if (and X calculator-deg) (degrees-to-radians X) X)) (L calculator-saved-list) (fF `(calculator-funcall ',f x y)) - (fD `(if calculator-deg (radians-to-degrees x) x))) + (fD '(if calculator-deg (radians-to-degrees x) x))) (eval `(cl-flet ((F (&optional x y) ,fF) (D (x) ,fD)) (let ((X ,X) (Y ,Y) (DX ,DX) (TX ,TX) (TY ,TY) (L ',L)) ,f)) @@ -1226,7 +1226,7 @@ OP is the operator (if any) that caused this call." (when (and (or calculator-display-fragile (not (numberp (car calculator-stack)))) (<= inp (pcase calculator-input-radix - (`nil ?9) (`bin ?1) (`oct ?7) (_ 999)))) + ('nil ?9) ('bin ?1) ('oct ?7) (_ 999)))) (calculator-clear-fragile) (setq calculator-curnum (concat (if (equal calculator-curnum "0") "" diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index 7d01fe31fb..41fe57e60c 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -6389,8 +6389,7 @@ Filtered Items mode following todo (not done) items." ;; ----------------------------------------------------------------------------- (defvar todo-key-bindings-t - `( - ("Af" todo-find-archive) + '(("Af" todo-find-archive) ("Ac" todo-choose-archive) ("Ad" todo-archive-done-item) ("Cv" todo-toggle-view-done-items) @@ -6421,13 +6420,11 @@ Filtered Items mode following todo (not done) items." ("k" todo-delete-item) ("m" todo-move-item) ("u" todo-item-undone) - ([remap newline] newline-and-indent) - ) + ([remap newline] newline-and-indent)) "List of key bindings for Todo mode only.") (defvar todo-key-bindings-t+a+f - `( - ("C*" todo-mark-category) + '(("C*" todo-mark-category) ("Cu" todo-unmark-category) ("Fh" todo-toggle-item-header) ("h" todo-toggle-item-header) @@ -6444,27 +6441,22 @@ Filtered Items mode following todo (not done) items." ("p" todo-previous-item) ("q" todo-quit) ("s" todo-save) - ("t" todo-show) - ) + ("t" todo-show)) "List of key bindings for Todo, Archive, and Filtered Items modes.") (defvar todo-key-bindings-t+a - `( - ("Fc" todo-show-categories-table) + '(("Fc" todo-show-categories-table) ("S" todo-search) ("X" todo-clear-matches) ("b" todo-backward-category) ("f" todo-forward-category) - ("*" todo-toggle-mark-item) - ) + ("*" todo-toggle-mark-item)) "List of key bindings for Todo and Todo Archive modes.") (defvar todo-key-bindings-t+f - `( - ("l" todo-lower-item-priority) + '(("l" todo-lower-item-priority) ("r" todo-raise-item-priority) - ("#" todo-set-item-priority) - ) + ("#" todo-set-item-priority)) "List of key bindings for Todo and Todo Filtered Items modes.") (defvar todo-mode-map diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el index f0a1e6bb5a..08a827ffa2 100644 --- a/lisp/cedet/semantic.el +++ b/lisp/cedet/semantic.el @@ -225,37 +225,37 @@ during a flush when the cache is given a new value of nil.") "Indicate that the current buffer is unparseable. It is also true that the parse tree will need either updating or a rebuild. This state will be changed when the user edits the buffer." - `(setq semantic-parse-tree-state 'unparseable)) + '(setq semantic-parse-tree-state 'unparseable)) (defmacro semantic-parse-tree-unparseable-p () "Return non-nil if the current buffer has been marked unparseable." - `(eq semantic-parse-tree-state 'unparseable)) + '(eq semantic-parse-tree-state 'unparseable)) (defmacro semantic-parse-tree-set-needs-update () "Indicate that the current parse tree needs to be updated. The parse tree can be updated by `semantic-parse-changes'." - `(setq semantic-parse-tree-state 'needs-update)) + '(setq semantic-parse-tree-state 'needs-update)) (defmacro semantic-parse-tree-needs-update-p () "Return non-nil if the current parse tree needs to be updated." - `(eq semantic-parse-tree-state 'needs-update)) + '(eq semantic-parse-tree-state 'needs-update)) (defmacro semantic-parse-tree-set-needs-rebuild () "Indicate that the current parse tree needs to be rebuilt. The parse tree must be rebuilt by `semantic-parse-region'." - `(setq semantic-parse-tree-state 'needs-rebuild)) + '(setq semantic-parse-tree-state 'needs-rebuild)) (defmacro semantic-parse-tree-needs-rebuild-p () "Return non-nil if the current parse tree needs to be rebuilt." - `(eq semantic-parse-tree-state 'needs-rebuild)) + '(eq semantic-parse-tree-state 'needs-rebuild)) (defmacro semantic-parse-tree-set-up-to-date () "Indicate that the current parse tree is up to date." - `(setq semantic-parse-tree-state nil)) + '(setq semantic-parse-tree-state nil)) (defmacro semantic-parse-tree-up-to-date-p () "Return non-nil if the current parse tree is up to date." - `(null semantic-parse-tree-state)) + '(null semantic-parse-tree-state)) ;;; Interfacing with the system ;; diff --git a/lisp/cedet/semantic/analyze/debug.el b/lisp/cedet/semantic/analyze/debug.el index 6041556934..cff20a549b 100644 --- a/lisp/cedet/semantic/analyze/debug.el +++ b/lisp/cedet/semantic/analyze/debug.el @@ -558,19 +558,19 @@ PARENT is a possible parent (by nesting) tag." 'mouse-face 'custom-button-pressed-face 'tag tag 'action - `(lambda (button) - (let ((buff nil) - (pnt nil)) - (save-excursion - (semantic-go-to-tag - (button-get button 'tag)) - (setq buff (current-buffer)) - (setq pnt (point))) - (if (get-buffer-window buff) - (select-window (get-buffer-window buff)) - (pop-to-buffer buff t)) - (goto-char pnt) - (pulse-line-hook-function))) + (lambda (button) + (let ((buff nil) + (pnt nil)) + (save-excursion + (semantic-go-to-tag + (button-get button 'tag)) + (setq buff (current-buffer)) + (setq pnt (point))) + (if (get-buffer-window buff) + (select-window (get-buffer-window buff)) + (pop-to-buffer buff t)) + (goto-char pnt) + (pulse-line-hook-function))) )) (princ "\"") (princ str) diff --git a/lisp/cedet/semantic/bovine.el b/lisp/cedet/semantic/bovine.el index 2e37289600..dbd7c3e211 100644 --- a/lisp/cedet/semantic/bovine.el +++ b/lisp/cedet/semantic/bovine.el @@ -72,7 +72,7 @@ The return list is a lambda expression to be used in a bovine table." "Return the current nonterminal symbol. Part of the grammar source debugger. Depends on the existing environment of `semantic-bovinate-stream'." - `(if nt-stack + '(if nt-stack (car (aref (car nt-stack) 2)) nonterminal)) diff --git a/lisp/cedet/semantic/dep.el b/lisp/cedet/semantic/dep.el index 640884d014..3f19f51658 100644 --- a/lisp/cedet/semantic/dep.el +++ b/lisp/cedet/semantic/dep.el @@ -56,7 +56,7 @@ reparsed, the cache will be reset. TODO: use ffap.el to locate such items? NOTE: Obsolete this, or use as special user") -(make-variable-buffer-local `semantic-dependency-include-path) +(make-variable-buffer-local 'semantic-dependency-include-path) (defvar semantic-dependency-system-include-path nil "Defines the system include path. @@ -71,7 +71,7 @@ When searching for a file associated with a name found in a tag of class include, this path will be inspected for includes of type `system'. Some include tags are agnostic to this setting and will check both the project and system directories.") -(make-variable-buffer-local `semantic-dependency-system-include-path) +(make-variable-buffer-local 'semantic-dependency-system-include-path) (defmacro defcustom-mode-local-semantic-dependency-system-include-path (mode name value &optional docstring) diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el index ccfb4ecf8e..e4dfd5c4c5 100644 --- a/lisp/cedet/semantic/grammar.el +++ b/lisp/cedet/semantic/grammar.el @@ -1611,7 +1611,7 @@ Select the buffer containing the tag's definition, and move point there." ;; (defvar semantic-grammar-syntax-help - `( + '( ;; Lexical Symbols ("symbol" . "Syntax: A symbol of alpha numeric and symbol characters") ("number" . "Syntax: Numeric characters.") diff --git a/lisp/cedet/semantic/wisent/comp.el b/lisp/cedet/semantic/wisent/comp.el index 21ea7ed066..479b07c429 100644 --- a/lisp/cedet/semantic/wisent/comp.el +++ b/lisp/cedet/semantic/wisent/comp.el @@ -196,11 +196,11 @@ If optional LEFT is non-nil insert spaces on left." (defmacro wisent-log-buffer () "Return the log buffer. Its name is defined in constant `wisent-log-buffer-name'." - `(get-buffer-create wisent-log-buffer-name)) + '(get-buffer-create wisent-log-buffer-name)) (defmacro wisent-clear-log () "Delete the entire contents of the log buffer." - `(with-current-buffer (wisent-log-buffer) + '(with-current-buffer (wisent-log-buffer) (erase-buffer))) (defvar byte-compile-current-file) diff --git a/lisp/cedet/semantic/wisent/grammar.el b/lisp/cedet/semantic/wisent/grammar.el index d55b38aac4..4b5cc0be89 100644 --- a/lisp/cedet/semantic/wisent/grammar.el +++ b/lisp/cedet/semantic/wisent/grammar.el @@ -194,7 +194,7 @@ See also the function `wisent-skip-block'." "Expand call to SKIP-TOKEN grammar macro. Return the form to skip the lookahead token. See also the function `wisent-skip-token'." - `(wisent-skip-token)) + '(wisent-skip-token)) (defun wisent-grammar-assocs () "Return associativity and precedence level definitions." diff --git a/lisp/cedet/srecode/mode.el b/lisp/cedet/srecode/mode.el index 28e8b3b64e..2bdc58a70e 100644 --- a/lisp/cedet/srecode/mode.el +++ b/lisp/cedet/srecode/mode.el @@ -89,14 +89,14 @@ ]) "---" '( "Insert ..." :filter srecode-minor-mode-templates-menu ) - `( "Generate ..." :filter srecode-minor-mode-generate-menu ) + '( "Generate ..." :filter srecode-minor-mode-generate-menu ) "---" - (semantic-menu-item - ["Customize..." - (customize-group "srecode") - :active t - :help "Customize SRecode options" - ]) + (semantic-menu-item + ["Customize..." + (customize-group "srecode") + :active t + :help "Customize SRecode options" + ]) (list "Debugging Tools..." (semantic-menu-item diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index b69a63b80f..9aac0fba35 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -2444,7 +2444,7 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." :group 'custom-faces) (defface custom-variable-tag - `((((class color) (background dark)) + '((((class color) (background dark)) :foreground "light blue" :weight bold) (((min-colors 88) (class color) (background light)) :foreground "blue1" :weight bold) @@ -3920,7 +3920,7 @@ restoring it to the state of a face that has never been customized." (defun custom-hook-convert-widget (widget) ;; Handle `:options'. (let* ((options (widget-get widget :options)) - (other `(editable-list :inline t + (other '(editable-list :inline t :entry-format "%i %d%v" (function :format " %v"))) (args (if options diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 6f1143ba85..48d0c080c1 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -494,10 +494,10 @@ Typically \"page-%s.png\".") (defmacro doc-view-current-page (&optional win) `(image-mode-window-get 'page ,win)) -(defmacro doc-view-current-info () `(image-mode-window-get 'info)) -(defmacro doc-view-current-overlay () `(image-mode-window-get 'overlay)) -(defmacro doc-view-current-image () `(image-mode-window-get 'image)) -(defmacro doc-view-current-slice () `(image-mode-window-get 'slice)) +(defmacro doc-view-current-info () '(image-mode-window-get 'info)) +(defmacro doc-view-current-overlay () '(image-mode-window-get 'overlay)) +(defmacro doc-view-current-image () '(image-mode-window-get 'image)) +(defmacro doc-view-current-slice () '(image-mode-window-get 'slice)) (defun doc-view-last-page-number () (length doc-view--current-files)) @@ -1004,8 +1004,8 @@ is named like ODF with the extension turned to pdf." "Convert PDF-PS to PNG asynchronously." (funcall (pcase doc-view-doc-type - (`pdf doc-view-pdf->png-converter-function) - (`djvu #'doc-view-djvu->tiff-converter-ddjvu) + ('pdf doc-view-pdf->png-converter-function) + ('djvu #'doc-view-djvu->tiff-converter-ddjvu) (_ #'doc-view-ps->png-converter-ghostscript)) pdf-ps png nil (let ((resolution doc-view-resolution)) @@ -1074,20 +1074,20 @@ Start by converting PAGES, and then the rest." "Convert the current document to text and call CALLBACK when done." (make-directory (doc-view--current-cache-dir) t) (pcase doc-view-doc-type - (`pdf + ('pdf ;; Doc is a PDF, so convert it to TXT (doc-view-pdf->txt doc-view--buffer-file-name txt callback)) - (`ps + ('ps ;; Doc is a PS, so convert it to PDF (which will be converted to ;; TXT thereafter). (let ((pdf (doc-view-current-cache-doc-pdf))) (doc-view-ps->pdf doc-view--buffer-file-name pdf (lambda () (doc-view-pdf->txt pdf txt callback))))) - (`dvi + ('dvi ;; Doc is a DVI. This means that a doc.pdf already exists in its ;; cache subdirectory. (doc-view-pdf->txt (doc-view-current-cache-doc-pdf) txt callback)) - (`odf + ('odf ;; Doc is some ODF (or MS Office) doc. This means that a doc.pdf ;; already exists in its cache subdirectory. (doc-view-pdf->txt (doc-view-current-cache-doc-pdf) txt callback)) @@ -1128,13 +1128,13 @@ Those files are saved in the directory given by the function (doc-view--current-cache-dir)))) (make-directory (doc-view--current-cache-dir) t) (pcase doc-view-doc-type - (`dvi + ('dvi ;; DVI files have to be converted to PDF before Ghostscript can process ;; it. (let ((pdf (doc-view-current-cache-doc-pdf))) (doc-view-dvi->pdf doc-view--buffer-file-name pdf (lambda () (doc-view-pdf/ps->png pdf png-file))))) - (`odf + ('odf ;; ODF files have to be converted to PDF before Ghostscript can ;; process it. (let ((pdf (doc-view-current-cache-doc-pdf)) @@ -1147,11 +1147,11 @@ Those files are saved in the directory given by the function ;; file name. It's named like the input file with the ;; extension replaced by pdf. (funcall doc-view-odf->pdf-converter-function doc-view--buffer-file-name - (lambda () - ;; Rename to doc.pdf - (rename-file opdf pdf) - (doc-view-pdf/ps->png pdf png-file))))) - ((or `pdf `djvu) + (lambda () + ;; Rename to doc.pdf + (rename-file opdf pdf) + (doc-view-pdf/ps->png pdf png-file))))) + ((or 'pdf 'djvu) (let ((pages (doc-view-active-pages))) ;; Convert doc to bitmap images starting with the active pages. (doc-view-document->bitmap doc-view--buffer-file-name png-file pages))) @@ -1695,7 +1695,7 @@ If BACKWARD is non-nil, jump to the previous match." "Find the right single-page converter for the current document type" (pcase-let ((`(,conv-function ,type ,extension) (pcase doc-view-doc-type - (`djvu (list #'doc-view-djvu->tiff-converter-ddjvu 'tiff "tif")) + ('djvu (list #'doc-view-djvu->tiff-converter-ddjvu 'tiff "tif")) (_ (list doc-view-pdf->png-converter-function 'png "png"))))) (setq-local doc-view-single-page-converter-function conv-function) (setq-local doc-view--image-type type) diff --git a/lisp/elec-pair.el b/lisp/elec-pair.el index 7df7098295..64ed0f6be5 100644 --- a/lisp/elec-pair.el +++ b/lisp/elec-pair.el @@ -522,7 +522,7 @@ happened." pos)) (forward-char)) ;; Insert matching pair. - ((and (memq syntax `(?\( ?\" ?\$)) + ((and (memq syntax '(?\( ?\" ?\$)) (not overwrite-mode) (or unconditional (not (funcall electric-pair-inhibit-predicate diff --git a/lisp/electric.el b/lisp/electric.el index 8730b0752c..6dbf46b80c 100644 --- a/lisp/electric.el +++ b/lisp/electric.el @@ -391,13 +391,13 @@ newline after CHAR but stay in the same place.") ;; multiple times), but I'm not sure it's what we want. ;; ;; FIXME: check eolp before inserting \n? - (`before (goto-char (1- pos)) (skip-chars-backward " \t") + ('before (goto-char (1- pos)) (skip-chars-backward " \t") (unless (bolp) (insert "\n"))) - (`after (insert "\n")) - (`after-stay (save-excursion + ('after (insert "\n")) + ('after-stay (save-excursion (let ((electric-layout-rules nil)) (newline 1 t)))) - (`around (save-excursion + ('around (save-excursion (goto-char (1- pos)) (skip-chars-backward " \t") (unless (bolp) (insert "\n"))) (insert "\n"))) ; FIXME: check eolp before inserting \n? diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 22aac954d1..e4290baee9 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -182,13 +182,13 @@ expression, in which case we want to handle forms differently." (let* ((macrop (memq car '(defmacro cl-defmacro defmacro*))) (name (nth 1 form)) (args (pcase car - ((or `defun `defmacro - `defun* `defmacro* `cl-defun `cl-defmacro - `define-overloadable-function) + ((or 'defun 'defmacro + 'defun* 'defmacro* 'cl-defun 'cl-defmacro + 'define-overloadable-function) (nth 2 form)) - (`define-skeleton '(&optional str arg)) - ((or `define-generic-mode `define-derived-mode - `define-compilation-mode) + ('define-skeleton '(&optional str arg)) + ((or 'define-generic-mode 'define-derived-mode + 'define-compilation-mode) nil) (_ t))) (body (nthcdr (or (function-get car 'doc-string-elt) 3) form)) diff --git a/lisp/emacs-lisp/benchmark.el b/lisp/emacs-lisp/benchmark.el index e062a1867a..a9fa7c44c2 100644 --- a/lisp/emacs-lisp/benchmark.el +++ b/lisp/emacs-lisp/benchmark.el @@ -81,7 +81,7 @@ result. The overhead of the `lambda's is accounted for." (gcs (make-symbol "gcs")) (gc (make-symbol "gc")) (code (byte-compile `(lambda () ,@forms))) - (lambda-code (byte-compile `(lambda ())))) + (lambda-code (byte-compile '(lambda ())))) `(let ((,gc gc-elapsed) (,gcs gcs-done)) (list ,(if (or (symbolp repetitions) (> repetitions 1)) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 4854808fd0..8d9779ea83 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -255,7 +255,7 @@ (setq fn (or (symbol-function name) (cdr (assq name byte-compile-function-environment))))) (pcase fn - (`nil + ('nil (byte-compile-warn "attempt to inline `%s' before it was defined" name) form) @@ -635,7 +635,7 @@ (setq form (car (last (cdr form))))) (cond ((consp form) (pcase (car form) - (`quote (cadr form)) + ('quote (cadr form)) ;; Can't use recursion in a defsubst. ;; (`progn (byte-compile-trueconstp (car (last (cdr form))))) )) @@ -649,7 +649,7 @@ (setq form (car (last (cdr form))))) (cond ((consp form) (pcase (car form) - (`quote (null (cadr form))) + ('quote (null (cadr form))) ;; Can't use recursion in a defsubst. ;; (`progn (byte-compile-nilconstp (car (last (cdr form))))) )) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 0b8f8824b4..15f31dd5f2 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1730,8 +1730,8 @@ that already has a `.elc' file." (file-name-nondirectory source)))) (progn (cl-incf (pcase (byte-recompile-file source force arg) - (`no-byte-compile skip-count) - (`t file-count) + ('no-byte-compile skip-count) + ('t file-count) (_ fail-count))) (or noninteractive (message "Checking %s..." directory)) @@ -3277,8 +3277,8 @@ for symbols generated by the byte compiler itself." (cl-assert (listp fargs)) (while fargs (pcase (car fargs) - (`&optional (setq fargs (cdr fargs))) - (`&rest (setq fmax2 (+ (* 2 (length dynbinds)) 1)) + ('&optional (setq fargs (cdr fargs))) + ('&rest (setq fmax2 (+ (* 2 (length dynbinds)) 1)) (push (cadr fargs) dynbinds) (setq fargs nil)) (_ (push (pop fargs) dynbinds)))) @@ -3325,8 +3325,8 @@ for symbols generated by the byte compiler itself." (not (memq var byte-compile-not-obsolete-vars)) (not (memq var byte-compile-global-not-obsolete-vars)) (or (pcase (nth 1 od) - (`set (not (eq access-type 'reference))) - (`get (eq access-type 'reference)) + ('set (not (eq access-type 'reference))) + ('get (eq access-type 'reference)) (_ t))))) (byte-compile-warn-obsolete var)))) @@ -4731,7 +4731,7 @@ binding slots have been popped." arg) ;; `lam' is the lambda expression in `fun' (or nil if not ;; recognized). - ((or `(,(or `quote `function) ,lam) (let lam nil)) + ((or `(,(or 'quote 'function) ,lam) (let lam nil)) fun) ;; `arglist' is the list of arguments (or t if not recognized). ;; `body' is the body of `lam' (or t if not recognized). @@ -4918,18 +4918,18 @@ invoked interactively." (setq byte-compile-call-tree (sort byte-compile-call-tree (pcase byte-compile-call-tree-sort - (`callers + ('callers (lambda (x y) (< (length (nth 1 x)) - (length (nth 1 y))))) - (`calls + (length (nth 1 y))))) + ('calls (lambda (x y) (< (length (nth 2 x)) - (length (nth 2 y))))) - (`calls+callers + (length (nth 2 y))))) + ('calls+callers (lambda (x y) (< (+ (length (nth 1 x)) - (length (nth 2 x))) - (+ (length (nth 1 y)) - (length (nth 2 y)))))) - (`name + (length (nth 2 x))) + (+ (length (nth 1 y)) + (length (nth 2 y)))))) + ('name (lambda (x y) (string< (car x) (car y)))) (_ (error "`byte-compile-call-tree-sort': `%s' - unknown sort mode" byte-compile-call-tree-sort)))))) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 010026b416..d776297fd0 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -322,7 +322,7 @@ places where they originally did not directly appear." ;; so we never touch it(unless we enter to the other closure). ;;(if (listp form) (print (car form)) form) (pcase form - (`(,(and letsym (or `let* `let)) ,binders . ,body) + (`(,(and letsym (or 'let* 'let)) ,binders . ,body) ; let and let* special forms (let ((binders-new '()) @@ -454,7 +454,7 @@ places where they originally did not directly appear." (`(function . ,_) form) ;defconst, defvar - (`(,(and sym (or `defconst `defvar)) ,definedsymbol . ,forms) + (`(,(and sym (or 'defconst 'defvar)) ,definedsymbol . ,forms) `(,sym ,definedsymbol . ,(when (consp forms) (cons (cconv-convert (car forms) env extend) @@ -496,8 +496,8 @@ places where they originally did not directly appear." `((let ((,var (list ,var))) ,@body)))))) handlers)))) - (`(,(and head (or (and `catch (guard byte-compile--use-old-handlers)) - `unwind-protect)) + (`(,(and head (or (and 'catch (guard byte-compile--use-old-handlers)) + 'unwind-protect)) ,form . ,body) `(,head ,(cconv-convert form env extend) :fun-body ,(cconv--convert-function () body env form))) @@ -526,7 +526,7 @@ places where they originally did not directly appear." `(progn . ,(nreverse prognlist)) (car prognlist))))) - (`(,(and (or `funcall `apply) callsym) ,fun . ,args) + (`(,(and (or 'funcall 'apply) callsym) ,fun . ,args) ;; These are not special forms but we treat them separately for the needs ;; of lambda lifting. (let ((mapping (cdr (assq fun env)))) @@ -655,7 +655,7 @@ This function does not return anything but instead fills the and updates the data stored in ENV." (pcase form ; let special form - (`(,(and (or `let* `let) letsym) ,binders . ,body-forms) + (`(,(and (or 'let* 'let) letsym) ,binders . ,body-forms) (let ((orig-env env) (newvars nil) @@ -739,18 +739,18 @@ and updates the data stored in ENV." form "variable")))) ;; FIXME: The bytecode for unwind-protect forces us to wrap the unwind. - (`(,(or (and `catch (guard byte-compile--use-old-handlers)) - `unwind-protect) + (`(,(or (and 'catch (guard byte-compile--use-old-handlers)) + 'unwind-protect) ,form . ,body) (cconv-analyze-form form env) (cconv--analyze-function () body env form)) (`(defvar ,var) (push var byte-compile-bound-variables)) - (`(,(or `defconst `defvar) ,var ,value . ,_) + (`(,(or 'defconst 'defvar) ,var ,value . ,_) (push var byte-compile-bound-variables) (cconv-analyze-form value env)) - (`(,(or `funcall `apply) ,fun . ,args) + (`(,(or 'funcall 'apply) ,fun . ,args) ;; Here we ignore fun because funcall and apply are the only two ;; functions where we can pass a candidate for lambda lifting as ;; argument. So, if we see fun elsewhere, we'll delete it from diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index bea38a0509..13988db9a8 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -576,9 +576,9 @@ too large if positive or too small if negative)." "Concatenate, into a sequence of type TYPE, the argument SEQUENCEs. \n(fn TYPE SEQUENCE...)" (pcase type - (`vector (apply #'vconcat sequences)) - (`string (apply #'concat sequences)) - (`list (apply #'append (append sequences '(nil)))) + ('vector (apply #'vconcat sequences)) + ('string (apply #'concat sequences)) + ('list (apply #'append (append sequences '(nil)))) (_ (error "Not a sequence type name: %S" type)))) ;;; List functions. @@ -742,7 +742,7 @@ including `cl-block' and `cl-eval-when'." (with-eval-after-load 'find-func (defvar find-function-regexp-alist) (add-to-list 'find-function-regexp-alist - `(define-type . cl--typedef-regexp))) + '(define-type . cl--typedef-regexp))) (define-button-type 'cl-help-type :supertype 'help-function-def diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index c7f0c48f85..cad629d949 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -938,7 +938,7 @@ MET-NAME is as returned by `cl--generic-load-hist-format'." (add-to-list 'find-function-regexp-alist `(cl-defmethod . ,#'cl--generic-search-method)) (add-to-list 'find-function-regexp-alist - `(cl-defgeneric . cl--generic-find-defgeneric-regexp))) + '(cl-defgeneric . cl--generic-find-defgeneric-regexp))) (defun cl--generic-method-info (method) (let* ((specializers (cl--generic-method-specializers method)) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 29ddd491af..bc78d80c67 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -1902,7 +1902,7 @@ Labels have lexical scope and dynamic extent." (push (nreverse block) blocks) (setq block (list label-or-stmt)))) (unless (eq 'go (car-safe (car-safe block))) - (push `(go cl--exit) block)) + (push '(go cl--exit) block)) (push (nreverse block) blocks)) (let ((catch-tag (make-symbol "cl--tagbody-tag")) (cl--tagbody-alist cl--tagbody-alist)) @@ -2185,7 +2185,7 @@ of `cl-symbol-macrolet' to additionally expand symbol macros." ;; The behavior of CL made sense in a dynamically scoped ;; language, but nowadays, lexical scoping semantics is more often ;; expected. - (`(,(or `let `let*) . ,(or `(,bindings . ,body) dontcare)) + (`(,(or 'let 'let*) . ,(or `(,bindings . ,body) dontcare)) (let ((nbs ()) (found nil)) (dolist (binding bindings) (let* ((var (if (symbolp binding) binding (car binding))) @@ -3021,7 +3021,7 @@ the form NAME which is a shorthand for (NAME NAME)." (defun cl--defstruct-predicate (type) (let ((cons (assq (cl-struct-sequence-type type) - `((list . consp) + '((list . consp) (vector . vectorp) (nil . recordp))))) (if cons @@ -3355,7 +3355,7 @@ The type name can then be used in `cl-typecase', `cl-check-type', etc." (put ',name 'cl-deftype-handler (cl-function (lambda (&cl-defs ('*) ,@arglist) ,@body))))) -(cl-deftype extended-char () `(and character (not base-char))) +(cl-deftype extended-char () '(and character (not base-char))) ;;; Additional functions that we can now define because we've defined ;;; `cl-defsubst' and `cl-typep'. diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el index 2f29c19696..54d9aa0118 100644 --- a/lisp/emacs-lisp/copyright.el +++ b/lisp/emacs-lisp/copyright.el @@ -347,7 +347,7 @@ independently replaces consecutive years with a range." "Insert a copyright by $ORGANIZATION notice at cursor." "Company: " comment-start - "Copyright (C) " `(format-time-string "%Y") " by " + "Copyright (C) " '(format-time-string "%Y") " by " (or (getenv "ORGANIZATION") str) '(if (copyright-offset-too-large-p) diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 7fc2b41c70..34a2a1336d 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -354,26 +354,26 @@ Include the reason for debugger entry from ARGS." (pcase (car args) ;; lambda is for debug-on-call when a function call is next. ;; debug is for debug-on-entry function called. - ((or `lambda `debug) + ((or 'lambda 'debug) (insert "--entering a function:\n")) ;; Exiting a function. - (`exit + ('exit (insert "--returning value: ") (insert (backtrace-print-to-string debugger-value)) (insert ?\n)) ;; Watchpoint triggered. - ((and `watchpoint (let `(,symbol ,newval . ,details) (cdr args))) + ((and 'watchpoint (let `(,symbol ,newval . ,details) (cdr args))) (insert "--" (pcase details - (`(makunbound nil) (format "making %s void" symbol)) + ('(makunbound nil) (format "making %s void" symbol)) (`(makunbound ,buffer) (format "killing local value of %s in buffer %s" symbol buffer)) (`(defvaralias ,_) (format "aliasing %s to %s" symbol newval)) (`(let ,_) (format "let-binding %s to %s" symbol (backtrace-print-to-string newval))) (`(unlet ,_) (format "ending let-binding of %s" symbol)) - (`(set nil) (format "setting %s to %s" symbol + ('(set nil) (format "setting %s to %s" symbol (backtrace-print-to-string newval))) (`(set ,buffer) (format "setting %s in buffer %s to %s" symbol buffer @@ -382,12 +382,12 @@ Include the reason for debugger entry from ARGS." ": ") (insert ?\n)) ;; Debugger entered for an error. - (`error + ('error (insert "--Lisp error: ") (insert (backtrace-print-to-string (nth 1 args))) (insert ?\n)) ;; debug-on-call, when the next thing is an eval. - (`t + ('t (insert "--beginning evaluation of function call form:\n")) ;; User calls debug directly. (_ diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el index e048d0e9ad..e343dcf37f 100644 --- a/lisp/emacs-lisp/eieio-compat.el +++ b/lisp/emacs-lisp/eieio-compat.el @@ -182,11 +182,11 @@ Summary: ;; `no-applicable-method', which have slightly different calling ;; convention than their cl-generic counterpart. (pcase method - (`no-next-method + ('no-next-method (setq method 'cl-no-next-method) (setq specializers `(generic method ,@specializers)) (lambda (_generic _method &rest args) (apply code args))) - (`no-applicable-method + ('no-applicable-method (setq method 'cl-no-applicable-method) (setq specializers `(generic ,@specializers)) (lambda (generic arg &rest args) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index eb9695d0c1..9702a11998 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -971,7 +971,7 @@ contained in UNIVERSE." test (ert-test-most-recent-result test)))) universe)) - (:unexpected (ert-select-tests `(not :expected) universe)) + (:unexpected (ert-select-tests '(not :expected) universe)) ((pred stringp) (pcase-exhaustive universe (`t (mapcar #'ert-get-test diff --git a/lisp/emacs-lisp/generator.el b/lisp/emacs-lisp/generator.el index e38c7d9109..63783219fa 100644 --- a/lisp/emacs-lisp/generator.el +++ b/lisp/emacs-lisp/generator.el @@ -213,8 +213,8 @@ don't yield.") ;; Process `and'. - (`(and) ; (and) -> t - (cps--transform-1 t next-state)) + ('(and) ; (and) -> t + (cps--transform-1 t next-state)) (`(and ,condition) ; (and CONDITION) -> CONDITION (cps--transform-1 condition next-state)) (`(and ,condition . ,rest) @@ -246,8 +246,8 @@ don't yield.") ;; Process `cond': transform into `if' or `or' depending on the ;; precise kind of the condition we're looking at. - (`(cond) ; (cond) -> nil - (cps--transform-1 nil next-state)) + ('(cond) ; (cond) -> nil + (cps--transform-1 nil next-state)) (`(cond (,condition) . ,rest) (cps--transform-1 `(or ,condition (cond ,@rest)) next-state)) @@ -281,14 +281,14 @@ don't yield.") ;; Process `progn' and `inline': they are identical except for the ;; name, which has some significance to the byte compiler. - (`(inline) (cps--transform-1 nil next-state)) + ('(inline) (cps--transform-1 nil next-state)) (`(inline ,form) (cps--transform-1 form next-state)) (`(inline ,form . ,rest) (cps--transform-1 form (cps--transform-1 `(inline ,@rest) next-state))) - (`(progn) (cps--transform-1 nil next-state)) + ('(progn) (cps--transform-1 nil next-state)) (`(progn ,form) (cps--transform-1 form next-state)) (`(progn ,form . ,rest) (cps--transform-1 form @@ -345,7 +345,7 @@ don't yield.") ;; Process `or'. - (`(or) (cps--transform-1 nil next-state)) + ('(or) (cps--transform-1 nil next-state)) (`(or ,condition) (cps--transform-1 condition next-state)) (`(or ,condition . ,rest) (cps--transform-1 @@ -646,11 +646,11 @@ modified copy." ,(cps--make-close-iterator-form terminal-state))))) (t (error "unknown iterator operation %S" op)))))) ,(when finalizer-symbol - `(funcall iterator - :stash-finalizer - (make-finalizer - (lambda () - (iter-close iterator))))) + '(funcall iterator + :stash-finalizer + (make-finalizer + (lambda () + (iter-close iterator))))) iterator)))) (defun iter-yield (value) diff --git a/lisp/emacs-lisp/inline.el b/lisp/emacs-lisp/inline.el index 865e17e3d7..b6afcc0db9 100644 --- a/lisp/emacs-lisp/inline.el +++ b/lisp/emacs-lisp/inline.el @@ -259,7 +259,7 @@ See Info node `(elisp)Defining Functions' for more details." `(error ,@args)) (defun inline--warning (&rest _args) - `(throw 'inline--just-use + '(throw 'inline--just-use ;; FIXME: This would inf-loop by calling us right back when ;; macroexpand-all recurses to expand inline--form. ;; (macroexp--warn-and-return (format ,@args) diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 93678bad7a..2418264bdb 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -222,15 +222,15 @@ Assumes the caller has bound `macroexpand-all-environment'." (cddr form)) (cdr form)) form)) - (`(,(or `defvar `defconst) . ,_) (macroexp--all-forms form 2)) + (`(,(or 'defvar 'defconst) . ,_) (macroexp--all-forms form 2)) (`(function ,(and f `(lambda . ,_))) (macroexp--cons 'function (macroexp--cons (macroexp--all-forms f 2) nil (cdr form)) form)) - (`(,(or `function `quote) . ,_) form) - (`(,(and fun (or `let `let*)) . ,(or `(,bindings . ,body) dontcare)) + (`(,(or 'function 'quote) . ,_) form) + (`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body) dontcare)) (macroexp--cons fun (macroexp--cons (macroexp--all-clauses bindings 1) (macroexp--all-forms body) @@ -249,14 +249,14 @@ Assumes the caller has bound `macroexpand-all-environment'." ;; here, so that any code that cares about the difference will ;; see the same transformation. ;; First arg is a function: - (`(,(and fun (or `funcall `apply `mapcar `mapatoms `mapconcat `mapc)) + (`(,(and fun (or 'funcall 'apply 'mapcar 'mapatoms 'mapconcat 'mapc)) ',(and f `(lambda . ,_)) . ,args) (macroexp--warn-and-return (format "%s quoted with ' rather than with #'" (list 'lambda (nth 1 f) '...)) (macroexp--expand-all `(,fun ,f . ,args)))) ;; Second arg is a function: - (`(,(and fun (or `sort)) ,arg1 ',(and f `(lambda . ,_)) . ,args) + (`(,(and fun (or 'sort)) ,arg1 ',(and f `(lambda . ,_)) . ,args) (macroexp--warn-and-return (format "%s quoted with ' rather than with #'" (list 'lambda (nth 1 f) '...)) @@ -406,7 +406,7 @@ cases where EXP is a constant." "Bind each binding in BINDINGS as `macroexp-let2' does." (declare (indent 2) (debug (sexp (&rest (sexp form)) body))) (pcase-exhaustive bindings - (`nil (macroexp-progn body)) + ('nil (macroexp-progn body)) (`((,var ,exp) . ,tl) `(macroexp-let2 ,test ,var ,exp (macroexp-let2* ,test ,tl ,@body))))) diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index 1f6f1ffbcd..987521d9d8 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -331,8 +331,8 @@ MAP can be a list, hash-table or array." TYPE can be one of the following symbols: list or hash-table. MAP can be a list, hash-table or array." (pcase type - (`list (map-pairs map)) - (`hash-table (map--into-hash-table map)) + ('list (map-pairs map)) + ('hash-table (map--into-hash-table map)) (_ (error "Not a map type name: %S" type)))) (defun map--put (map key v) diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el index 3ec214a2af..d3120ac146 100644 --- a/lisp/emacs-lisp/package-x.el +++ b/lisp/emacs-lisp/package-x.el @@ -202,8 +202,8 @@ if it exists." (split-version (package-desc-version pkg-desc)) (commentary (pcase file-type - (`single (lm-commentary)) - (`tar nil))) ;; FIXME: Get it from the README file. + ('single (lm-commentary)) + ('tar nil))) ;; FIXME: Get it from the README file. (extras (package-desc-extras pkg-desc)) (pkg-version (package-version-join split-version)) (pkg-buffer (current-buffer))) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index f2ffef8da7..dcede1a5b2 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -496,9 +496,9 @@ This is, approximately, the inverse of `version-to-list'. (defun package-desc-suffix (pkg-desc) (pcase (package-desc-kind pkg-desc) - (`single ".el") - (`tar ".tar") - (`dir "") + ('single ".el") + ('tar ".tar") + ('dir "") (kind (error "Unknown package kind: %s" kind)))) (defun package-desc--keywords (pkg-desc) @@ -846,7 +846,7 @@ untar into a directory named DIR; otherwise, signal an error." (dirname (package-desc-full-name pkg-desc)) (pkg-dir (expand-file-name dirname package-user-dir))) (pcase (package-desc-kind pkg-desc) - (`dir + ('dir (make-directory pkg-dir t) (let ((file-list (directory-files @@ -860,12 +860,12 @@ untar into a directory named DIR; otherwise, signal an error." ;; things simple by ensuring we're one of them. (setf (package-desc-kind pkg-desc) (if (> (length file-list) 1) 'tar 'single)))) - (`tar + ('tar (make-directory package-user-dir t) ;; FIXME: should we delete PKG-DIR if it exists? (let* ((default-directory (file-name-as-directory package-user-dir))) (package-untar-buffer dirname))) - (`single + ('single (let ((el-file (expand-file-name (format "%s.el" name) pkg-dir))) (make-directory pkg-dir t) (package--write-file-no-coding el-file))) @@ -2494,7 +2494,7 @@ Otherwise no newline is inserted." (easy-menu-define package-menu-mode-menu package-menu-mode-map "Menu for `package-menu-mode'." - `("Package" + '("Package" ["Describe Package" package-menu-describe-package :help "Display information about this package"] ["Help" package-menu-quick-help :help "Show short key binding help for package-menu-mode"] "--" diff --git a/lisp/emacs-lisp/radix-tree.el b/lisp/emacs-lisp/radix-tree.el index 2491ccea95..f4184e8700 100644 --- a/lisp/emacs-lisp/radix-tree.el +++ b/lisp/emacs-lisp/radix-tree.el @@ -74,7 +74,7 @@ (cmp (compare-strings prefix nil nil key i ni))) (if (eq t cmp) (pcase (radix-tree--remove ptree key ni) - (`nil rtree) + ('nil rtree) (`((,pprefix . ,pptree)) `((,(concat prefix pprefix) . ,pptree) . ,rtree)) (nptree `((,prefix . ,nptree) . ,rtree))) diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index 4b82172984..be4031946e 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -533,9 +533,9 @@ PREC2 is a table as returned by `smie-precs->prec2' or (setq y (cons nil (cons nil nil))) (push (cons (cdr k) y) table)) (pcase v - (`= (push (cons x y) eqs)) - (`< (push (cons x y) csts)) - (`> (push (cons y x) csts)) + ('= (push (cons x y) eqs)) + ('< (push (cons x y) csts)) + ('> (push (cons y x) csts)) (_ (error "SMIE error: prec2 has %S↦%S which ≠{<,+,>}" k v)))))) prec2) @@ -612,8 +612,8 @@ PREC2 is a table as returned by `smie-precs->prec2' or (dolist (x (gethash :smie-open/close-alist prec2)) (let* ((token (car x)) (cons (pcase (cdr x) - (`closer (cddr (assoc token table))) - (`opener (cdr (assoc token table)))))) + ('closer (cddr (assoc token table))) + ('opener (cdr (assoc token table)))))) ;; `cons' can be nil for openers/closers which only contain ;; "atomic" elements. (when cons diff --git a/lisp/epa.el b/lisp/epa.el index c3938e90a7..9f09128888 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -597,12 +597,12 @@ If SECRET is non-nil, list secret keys instead of public keys." (erase-buffer) (insert (format (pcase (epg-context-operation context) - (`decrypt "Error while decrypting with \"%s\":") - (`verify "Error while verifying with \"%s\":") - (`sign "Error while signing with \"%s\":") - (`encrypt "Error while encrypting with \"%s\":") - (`import-keys "Error while importing keys with \"%s\":") - (`export-keys "Error while exporting keys with \"%s\":") + ('decrypt "Error while decrypting with \"%s\":") + ('verify "Error while verifying with \"%s\":") + ('sign "Error while signing with \"%s\":") + ('encrypt "Error while encrypting with \"%s\":") + ('import-keys "Error while importing keys with \"%s\":") + ('export-keys "Error while exporting keys with \"%s\":") (_ "Error while executing \"%s\":\n\n")) (epg-context-program context)) "\n\n" diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 8de0007058..0ad73785a8 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -422,23 +422,23 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc." (when (fboundp 'make-network-process) '("send")))) (pcomplete-here (pcase (intern (downcase (pcomplete-arg 1))) - (`chat (mapcar (lambda (elt) (plist-get elt :nick)) + ('chat (mapcar (lambda (elt) (plist-get elt :nick)) (erc-remove-if-not #'(lambda (elt) (eq (plist-get elt :type) 'CHAT)) erc-dcc-list))) - (`close (erc-delete-dups + ('close (erc-delete-dups (mapcar (lambda (elt) (symbol-name (plist-get elt :type))) erc-dcc-list))) - (`get (mapcar #'erc-dcc-nick + ('get (mapcar #'erc-dcc-nick (erc-remove-if-not #'(lambda (elt) (eq (plist-get elt :type) 'GET)) erc-dcc-list))) - (`send (pcomplete-erc-all-nicks)))) + ('send (pcomplete-erc-all-nicks)))) (pcomplete-here (pcase (intern (downcase (pcomplete-arg 2))) - (`get (mapcar (lambda (elt) (plist-get elt :file)) + ('get (mapcar (lambda (elt) (plist-get elt :file)) (erc-remove-if-not #'(lambda (elt) (and (eq (plist-get elt :type) 'GET) @@ -446,13 +446,13 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc." (plist-get elt :nick)) (pcomplete-arg 1)))) erc-dcc-list))) - (`close (mapcar #'erc-dcc-nick + ('close (mapcar #'erc-dcc-nick (erc-remove-if-not #'(lambda (elt) (eq (plist-get elt :type) (intern (upcase (pcomplete-arg 1))))) erc-dcc-list))) - (`send (pcomplete-entries))))) + ('send (pcomplete-entries))))) (defun erc-dcc-do-CHAT-command (proc &optional nick) (when nick diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index cae18f6093..d1f4d4acae 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -929,14 +929,14 @@ relative to `erc-track-switch-direction'" offset) (when (< arg 0) (setq dir (pcase dir - (`oldest 'newest) - (`newest 'oldest) - (`mostactive 'leastactive) - (`leastactive 'mostactive) - (`importance 'oldest))) + ('oldest 'newest) + ('newest 'oldest) + ('mostactive 'leastactive) + ('leastactive 'mostactive) + ('importance 'oldest))) (setq arg (- arg))) (setq offset (pcase dir - ((or `oldest `leastactive) + ((or 'oldest 'leastactive) (- (length erc-modified-channels-alist) arg)) (_ (1- arg)))) ;; normalize out of range user input diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index a7e27424f2..60f877fe37 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1943,15 +1943,15 @@ removed from the list will be disabled." (defun erc-setup-buffer (buffer) "Consults `erc-join-buffer' to find out how to display `BUFFER'." (pcase erc-join-buffer - (`window + ('window (if (active-minibuffer-window) (display-buffer buffer) (switch-to-buffer-other-window buffer))) - (`window-noselect + ('window-noselect (display-buffer buffer)) - (`bury + ('bury nil) - (`frame + ('frame (when (or (not erc-reuse-frames) (not (get-buffer-window buffer t))) (let ((frame (make-frame (or erc-frame-alist diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el index 53de7f7ec6..1e09ed6178 100644 --- a/lisp/eshell/em-ls.el +++ b/lisp/eshell/em-ls.el @@ -346,7 +346,7 @@ instead." "ls" (if eshell-ls-initial-args (list eshell-ls-initial-args args) args) - `((?a "all" nil show-all + '((?a "all" nil show-all "do not ignore entries starting with .") (?A "almost-all" nil show-almost-all "do not list implied . and ..") diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 92cac612d4..8daaa0e0d3 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -816,7 +816,7 @@ This is used on systems where async subprocesses are not supported." ;; The last process in the pipe should get its handles ;; redirected as we found them before running the pipe. ,(if (null (cdr pipeline)) - `(progn + '(progn (setq eshell-current-handles tail-handles) (setq eshell-in-pipeline-p nil))) (let ((result ,(car pipeline))) diff --git a/lisp/files.el b/lisp/files.el index dbac6f614f..fb6cf0193a 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1158,7 +1158,7 @@ consecutive checks. For example: (file-attributes (file-chase-links file)))))))" :group 'files :version "24.1" - :type `(choice + :type '(choice (const :tag "Do not inhibit file name cache" nil) (const :tag "Do not use file name cache" t) (integer :tag "Do not use file name cache" @@ -3837,13 +3837,13 @@ It is dangerous if either of these conditions are met: If VAR is `mode', call `VAL-mode' as a function unless it's already the major mode." (pcase var - (`mode + ('mode (let ((mode (intern (concat (downcase (symbol-name val)) "-mode")))) (unless (eq (indirect-function mode) (indirect-function major-mode)) (funcall mode)))) - (`eval + ('eval (pcase val (`(add-hook ',hook . ,_) (hack-one-local-variable--obsolete hook))) (save-excursion (eval val))) @@ -7168,18 +7168,18 @@ only these files will be asked to be saved." (setcar pair (file-name-unquote (car pair) t)))) (setq file-arg-indices (cdr file-arg-indices)))) (pcase method - (`identity (car arguments)) - (`add (file-name-quote (apply operation arguments) t)) - (`buffer-file-name + ('identity (car arguments)) + ('add (file-name-quote (apply operation arguments) t)) + ('buffer-file-name (let ((buffer-file-name (file-name-unquote buffer-file-name t))) (apply operation arguments))) - (`insert-file-contents + ('insert-file-contents (let ((visit (nth 1 arguments))) (unwind-protect (apply operation arguments) (when (and visit buffer-file-name) (setq buffer-file-name (file-name-quote buffer-file-name t)))))) - (`unquote-then-quote + ('unquote-then-quote ;; We can't use `cl-letf' with `(buffer-local-value)' here ;; because it wouldn't work during bootstrapping. (let ((buffer (current-buffer))) @@ -7192,7 +7192,7 @@ only these files will be asked to be saved." ;; underlying operation. (with-current-buffer buffer (apply operation arguments)))))) - (`local-copy + ('local-copy (let* ((file-name-handler-alist saved-file-name-handler-alist) (source (car arguments)) (target (car (cdr arguments))) diff --git a/lisp/filesets.el b/lisp/filesets.el index 8ccfa570e3..8243b4045c 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -565,7 +565,7 @@ including directory trees to the menu can take a lot of memory." :group 'filesets) (defcustom filesets-commands - `(("Isearch" + '(("Isearch" multi-isearch-files (filesets-cmd-isearch-getargs)) ("Isearch (regexp)" @@ -1286,10 +1286,10 @@ on-close-all ... Not used" (filesets-get-external-viewer filename))))) (filesets-alist-get def (pcase event - (`on-open-all ':ignore-on-open-all) - (`on-grep ':ignore-on-read-text) - (`on-cmd nil) - (`on-close-all nil)) + ('on-open-all ':ignore-on-open-all) + ('on-grep ':ignore-on-read-text) + ('on-cmd nil) + ('on-close-all nil)) nil t))) (defun filesets-filetype-get-prop (property filename &optional entry) diff --git a/lisp/font-lock.el b/lisp/font-lock.el index be9fb4dc93..b4cf5b0387 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -926,9 +926,9 @@ The value of this variable is used when Font Lock mode is turned on." (defun font-lock-turn-on-thing-lock () (pcase (font-lock-value-in-major-mode font-lock-support-mode) - (`fast-lock-mode (fast-lock-mode t)) - (`lazy-lock-mode (lazy-lock-mode t)) - (`jit-lock-mode + ('fast-lock-mode (fast-lock-mode t)) + ('lazy-lock-mode (lazy-lock-mode t)) + ('jit-lock-mode ;; Prepare for jit-lock (remove-hook 'after-change-functions #'font-lock-after-change-function t) diff --git a/lisp/frameset.el b/lisp/frameset.el index 0d7e8025ab..aa392be280 100644 --- a/lisp/frameset.el +++ b/lisp/frameset.el @@ -675,7 +675,7 @@ nil while the filtering is done to restore it." ;; of a frameset, so we must copy parameters to avoid inadvertent ;; modifications. (pcase (cdr (assq (car current) filter-alist)) - (`nil + ('nil (push (if saving current (copy-tree current)) filtered)) (:never nil) @@ -903,7 +903,7 @@ NOTE: This only works for non-iconified frames." (< fr-right left) (> fr-right right) (< fr-top top) (> fr-top bottom))) ;; Displaced to the left, right, above or below the screen. - (`t (or (> fr-left right) + ('t (or (> fr-left right) (< fr-right left) (> fr-top bottom) (< fr-bottom top))) @@ -1195,11 +1195,11 @@ All keyword parameters default to nil." ;; will decide which ones can be reused, and how to deal with any leftover. (frameset--reuse-list (pcase reuse-frames - (`t + ('t frames) - (`nil + ('nil nil) - (`match + ('match (cl-loop for (state) in (frameset-states frameset) when (frameset-frame-with-id (frameset-cfg-id state) frames) collect it)) @@ -1364,11 +1364,11 @@ Called from `jump-to-register'. Internal use only." ;; iconify frames (lambda (frame action) (pcase action - (`rejected (iconify-frame frame)) + ('rejected (iconify-frame frame)) ;; In the unexpected case that a frame was a candidate ;; (matching frame id) and yet not restored, remove it ;; because it is in fact a duplicate. - (`ignored (delete-frame frame)))))) + ('ignored (delete-frame frame)))))) ;; Restore selected frame, buffer and point. (let ((frame (frameset-frame-with-id (aref data 1))) diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 93a675584f..28d8ac6d97 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -2600,11 +2600,11 @@ General format specifiers can also be used. See Info node (defvar gnus-tmp-groups) (defvar gnus-category-line-format-alist - `((?c gnus-tmp-name ?s) + '((?c gnus-tmp-name ?s) (?g gnus-tmp-groups ?d))) (defvar gnus-category-mode-line-format-alist - `((?u user-defined ?s))) + '((?u user-defined ?s))) (defvar gnus-category-line-format-spec nil) (defvar gnus-category-mode-line-format-spec nil) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index c78bb3325f..28ee174597 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -278,7 +278,7 @@ This can also be a list of the above values." "String or function to be executed to display an X-Face header. If it is a string, the command will be executed in a sub-shell asynchronously. The compressed face will be piped to this command." - :type `(choice string + :type '(choice string (function-item gnus-display-x-face-in-from) function) :version "21.1" @@ -5155,7 +5155,7 @@ Deleting parts may malfunction or destroy the article; continue? ")) "`----\n")) (setcdr data (cdr (mm-make-handle - nil `("text/plain" (charset . gnus-decoded)) nil nil + nil '("text/plain" (charset . gnus-decoded)) nil nil (list "attachment") (format "Deleted attachment (%s bytes)" bsize)))))) ;; (set-buffer gnus-summary-buffer) diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el index bbf9e527db..b48815bc0a 100644 --- a/lisp/gnus/gnus-cite.el +++ b/lisp/gnus/gnus-cite.el @@ -340,7 +340,7 @@ in a boring face, then the pages will be skipped." ;; TAG: Is a Supercite tag, if any. (defvar gnus-cited-opened-text-button-line-format-alist - `((?b (marker-position beg) ?d) + '((?b (marker-position beg) ?d) (?e (marker-position end) ?d) (?n (count-lines beg end) ?d) (?l (- end beg) ?d))) @@ -625,7 +625,7 @@ always hide." (point) (progn (eval gnus-cited-closed-text-button-line-format-spec) (point)) - `gnus-article-toggle-cited-text + 'gnus-article-toggle-cited-text (list (cons beg end) start)) (point)) 'article-type 'annotation) @@ -675,7 +675,7 @@ means show, nil means toggle." gnus-cited-opened-text-button-line-format-spec gnus-cited-closed-text-button-line-format-spec)) (point)) - `gnus-article-toggle-cited-text + 'gnus-article-toggle-cited-text args) (point)) 'article-type 'annotation))))) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index d526894b3a..c4ec9c1d32 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -496,7 +496,7 @@ simple manner." (defvar gnus-tmp-number-of-unread) (defvar gnus-group-line-format-alist - `((?M gnus-tmp-marked-mark ?c) + '((?M gnus-tmp-marked-mark ?c) (?S gnus-tmp-subscribed ?c) (?L gnus-tmp-level ?d) (?N (cond ((eq number t) "*" ) @@ -544,7 +544,7 @@ simple manner." )) (defvar gnus-group-mode-line-format-alist - `((?S gnus-tmp-news-server ?s) + '((?S gnus-tmp-news-server ?s) (?M gnus-tmp-news-method ?s) (?u gnus-tmp-user-defined ?s) (?: gnus-tmp-colon ?s))) @@ -780,7 +780,7 @@ simple manner." (easy-menu-define gnus-group-reading-menu gnus-group-mode-map "" - `("Group" + '("Group" ["Read" gnus-group-read-group :included (not (gnus-topic-mode-p)) :active (gnus-group-group-name)] @@ -947,7 +947,7 @@ simple manner." (easy-menu-define gnus-group-misc-menu gnus-group-mode-map "" - `("Gnus" + '("Gnus" ["Send a mail" gnus-group-mail t] ["Send a message (mail or news)" gnus-group-post-news t] ["Create a local message" gnus-group-news t] diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index 660bdf73cd..f469afd41b 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -1542,7 +1542,7 @@ If YANK is non-nil, include the original article." (X-Debbugs-Version . ,(format "%s" (gnus-continuum-version)))))) (when gnus-bug-create-help-buffer - (push `(gnus-bug-kill-buffer) message-send-actions)) + (push '(gnus-bug-kill-buffer) message-send-actions)) (goto-char (point-min)) (message-goto-body) (insert "\n\n\n\n\n") diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el index 0504465de3..5690c67906 100644 --- a/lisp/gnus/gnus-salt.el +++ b/lisp/gnus/gnus-salt.el @@ -406,7 +406,7 @@ Two predefined functions are available: (defvar gnus-tmp-subject) (defvar gnus-tree-line-format-alist - `((?n gnus-tmp-name ?s) + '((?n gnus-tmp-name ?s) (?f gnus-tmp-from ?s) (?N gnus-tmp-number ?d) (?\[ gnus-tmp-open-bracket ?c) diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index 4d15f36ffc..5bdf358dad 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -87,7 +87,7 @@ If nil, a faster, but more primitive, buffer is used instead." (defvar gnus-inserted-opened-servers nil) (defvar gnus-server-line-format-alist - `((?h gnus-tmp-how ?s) + '((?h gnus-tmp-how ?s) (?n gnus-tmp-name ?s) (?w gnus-tmp-where ?s) (?s gnus-tmp-status ?s) @@ -95,7 +95,7 @@ If nil, a faster, but more primitive, buffer is used instead." (?c gnus-tmp-cloud ?s))) (defvar gnus-server-mode-line-format-alist - `((?S gnus-tmp-news-server ?s) + '((?S gnus-tmp-news-server ?s) (?M gnus-tmp-news-method ?s) (?u gnus-tmp-user-defined ?s))) @@ -626,8 +626,8 @@ The following commands are available: (let ((info (gnus-server-to-method server))) (gnus-edit-form info "Showing the server." - `(lambda (form) - (gnus-server-position-point)) + (lambda (form) + (gnus-server-position-point)) 'edit-server))) (defun gnus-server-scan-server (server) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 1c4be09e2e..7be52717de 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -1430,12 +1430,12 @@ These are paired with what variables they correspond with, along with the type of the variable (string, integer, character, etc).") (defvar gnus-summary-dummy-line-format-alist - `((?S gnus-tmp-subject ?s) + '((?S gnus-tmp-subject ?s) (?N gnus-tmp-number ?d) (?u gnus-tmp-user-defined ?s))) (defvar gnus-summary-mode-line-format-alist - `((?G gnus-tmp-group-name ?s) + '((?G gnus-tmp-group-name ?s) (?g (gnus-short-group-name gnus-tmp-group-name) ?s) (?p (gnus-group-real-name gnus-tmp-group-name) ?s) (?A gnus-tmp-article-number ?d) @@ -2602,7 +2602,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) (easy-menu-define gnus-summary-post-menu gnus-summary-mode-map "" - `("Post" + '("Post" ["Send a message (mail or news)" gnus-summary-post-news :help "Compose a new message (mail or news)"] ["Followup" gnus-summary-followup @@ -2663,7 +2663,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) (easy-menu-define gnus-summary-misc-menu gnus-summary-mode-map "" - `("Gnus" + '("Gnus" ("Mark Read" ["Mark as read" gnus-summary-mark-as-read-forward t] ["Mark same subject and select" diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index 111f2ae28a..06ffe9571f 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -85,7 +85,7 @@ See Info node `(gnus)Formatting Variables'." (defvar gnus-topic-inhibit-change-level nil) (defconst gnus-topic-line-format-alist - `((?n name ?s) + '((?n name ?s) (?v visible ?s) (?i indentation ?s) (?g number-of-groups ?d) diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 2e4b054a9f..e69aa2cc6a 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -40,7 +40,7 @@ "Function use to do completing read." :version "24.1" :group 'gnus-meta - :type `(radio (function-item + :type '(radio (function-item :doc "Use Emacs standard `completing-read' function." gnus-emacs-completing-read) (function-item diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 6c59b13574..1ac02b4531 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -2770,7 +2770,7 @@ See Info node `(gnus)Formatting Variables'." (defun gnus-suppress-keymap (keymap) (suppress-keymap keymap) - (let ((keys `([delete] "\177" "\M-u"))) ;[mouse-2] + (let ((keys '([delete] "\177" "\M-u"))) ;[mouse-2] (while keys (define-key keymap (pop keys) 'undefined)))) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 66356b6fda..fdaa4e8272 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -1853,7 +1853,7 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'." "Alist of header names/filler functions.") (defvar message-header-format-alist - `((From) + '((From) (Newsgroups) (To) (Cc) @@ -2716,7 +2716,7 @@ systematically send encrypted emails when possible." (easy-menu-define message-mode-menu message-mode-map "Message Menu." - `("Message" + '("Message" ["Yank Original" message-yank-original message-reply-buffer] ["Fill Yanked Message" message-fill-yanked-message t] ["Insert Signature" message-insert-signature t] @@ -2750,7 +2750,7 @@ systematically send encrypted emails when possible." (easy-menu-define message-mode-field-menu message-mode-map "" - `("Field" + '("Field" ["To" message-goto-to t] ["From" message-goto-from t] ["Subject" message-goto-subject t] @@ -7459,7 +7459,7 @@ Optional DIGEST will use digest to forward." ;; Consider there is no illegible text. (add-text-properties b (point) - `(no-illegible-text t rear-nonsticky t start-open t)))) + '(no-illegible-text t rear-nonsticky t start-open t)))) (defun message-forward-make-body-mml (forward-buffer) (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n") diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index 14a232f706..ba54b4e707 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -241,7 +241,7 @@ superset of iso-8859-1." (widget-convert 'list `(set :inline t :format "%v" ,@(nreverse rest)) - `(repeat :inline t :tag "Other options" + '(repeat :inline t :tag "Other options" (cons :format "%v" (symbol :size 3 :format "(%v") (symbol :size 3 :format " . %v)\n"))))))) diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 9fd72a93d5..e232128245 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -1152,7 +1152,7 @@ If HANDLES is non-nil, use it instead reparsing the buffer." (easy-menu-define mml-menu mml-mode-map "" - `("Attachments" + '("Attachments" ["Attach File..." mml-attach-file :help "Attach a file at point"] ["Attach Buffer..." mml-attach-buffer :help "Attach a buffer to the outgoing message"] diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index 83a9c3f3e1..ca9f804036 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -408,7 +408,7 @@ on your system, you could say something like: `(let ((id (nnheader-nov-field))) (if (string-match "^<[^>]+>$" id) ,(if nnheader-uniquify-message-id - `(if (string-match "__[^@]+@" id) + '(if (string-match "__[^@]+@" id) (concat (substring id 0 (match-beginning 0)) (substring id (1- (match-end 0)))) id) diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 12892c516a..1a3b05ddb3 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -1203,8 +1203,8 @@ If LIMIT, first try to limit the search to the N last articles." ;; We don't really care about the article number, because ;; that's determined by the IMAP server later. So just ;; return the group name. - `(lambda (group) - (list (list group))))))) + (lambda (group) + (list (list group))))))) (setq group (nnimap-decode-gnus-group group)) (when (nnimap-change-group nil server) (nnmail-check-syntax) diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el index 24188f5c74..c8cf2d64d2 100644 --- a/lisp/gnus/nnmairix.el +++ b/lisp/gnus/nnmairix.el @@ -1774,7 +1774,7 @@ If VERSION is a string: must be contained in mairix version output." (setq versionstring (let* ((commandsplit (split-string nnmairix-mairix-command)) (args (append (list (car commandsplit)) - `(nil t nil) (cdr commandsplit) '("-V")))) + '(nil t nil) (cdr commandsplit) '("-V")))) (apply 'call-process args) (goto-char (point-min)) (re-search-forward "mairix.*") diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el index 710e0e83cf..e4731f3677 100644 --- a/lisp/gnus/spam.el +++ b/lisp/gnus/spam.el @@ -2137,7 +2137,7 @@ See `spam-ifile-database'." (apply 'call-process-region (point-min) (point-max) spam-ifile-program nil temp-buffer-name nil "-c" - (if db-param `(,db-param "-q") `("-q")))) + (if db-param `(,db-param "-q") '("-q")))) ;; check the return now (we're back in the temp buffer) (goto-char (point-min)) (if (not (eobp)) @@ -2166,7 +2166,7 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." (point-min) (point-max) spam-ifile-program nil nil nil add-or-delete-option category - (if db `(,db "-h") `("-h")))))) + (if db `(,db "-h") '("-h")))))) (defun spam-ifile-register-spam-routine (articles &optional unregister) (spam-ifile-register-with-ifile articles spam-ifile-spam-category unregister)) @@ -2473,7 +2473,7 @@ With a non-nil REMOVE, remove the ADDRESSES." (point-min) (point-max) spam-bogofilter-program nil temp-buffer-name nil - (if db `("-d" ,db "-v") `("-v")))) + (if db `("-d" ,db "-v") '("-v")))) (setq return (spam-check-bogofilter-headers score)))) return) (gnus-error 5 "`spam.el' doesn't support obsolete bogofilter versions"))) @@ -2501,7 +2501,7 @@ With a non-nil REMOVE, remove the ADDRESSES." (point-min) (point-max) spam-bogofilter-program nil nil nil switch - (if db `("-d" ,db "-v") `("-v"))))))) + (if db `("-d" ,db "-v") '("-v"))))))) (gnus-error 5 "`spam.el' doesn't support obsolete bogofilter versions"))) (defun spam-bogofilter-register-spam-routine (articles &optional unregister) diff --git a/lisp/hexl.el b/lisp/hexl.el index 230b64d9f2..4070da885c 100644 --- a/lisp/hexl.el +++ b/lisp/hexl.el @@ -1089,7 +1089,7 @@ This function is assumed to be used as callback function for `hl-line-mode'." ;; startup stuff. (easy-menu-define hexl-menu hexl-mode-map "Hexl Mode menu" - `("Hexl" + '("Hexl" :help "Hexl-specific Features" ["Backward short" hexl-backward-short diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index 08b58117dd..f503c2764b 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -559,7 +559,7 @@ then remove all hi-lock highlighting." (x-popup-menu t (cons - `keymap + 'keymap (cons "Select Pattern to Unhighlight" (mapcar (lambda (pattern) (list (car pattern) diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index 32ec91db97..57ca9b0433 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el @@ -723,7 +723,7 @@ specification, with the same structure as an element of the list (not (not (pcase (car filter) - (`or + ('or ;;; ATTN: Short-circuiting alternative with parallel structure w/`and ;;(catch 'has-match ;; (dolist (filter-spec (cdr filter) nil) @@ -732,12 +732,12 @@ specification, with the same structure as an element of the list (memq t (mapcar #'(lambda (x) (ibuffer-included-in-filter-p buf x)) (cdr filter)))) - (`and + ('and (catch 'no-match (dolist (filter-spec (cdr filter) t) (unless (ibuffer-included-in-filter-p buf filter-spec) (throw 'no-match nil))))) - (`saved + ('saved (let ((data (assoc (cdr filter) ibuffer-saved-filters))) (unless data (ibuffer-filter-disable t) @@ -1051,14 +1051,14 @@ turned into separate filters, like [name: foo] and [mode: bar-mode]." (tail (cdr filters)) (value (pcase (caar filters) - ((or `or 'and) (nconc head tail)) - (`saved + ((or 'or 'and) (nconc head tail)) + ('saved (let ((data (assoc head ibuffer-saved-filters))) (unless data (ibuffer-filter-disable) (error "Unknown saved filter %s" head)) (append (cdr data) tail))) - (`not (cons (ibuffer-unary-operand (car filters)) tail)) + ('not (cons (ibuffer-unary-operand (car filters)) tail)) (_ (error "Filter type %s is not compound" (caar filters)))))) (setq ibuffer-filtering-qualifiers value)) @@ -1197,12 +1197,12 @@ Interactively, prompt for NAME, and use the current filters." (defun ibuffer-format-qualifier-1 (qualifier) (pcase (car qualifier) - (`saved + ('saved (concat " [filter: " (cdr qualifier) "]")) - (`or + ('or (concat " [OR" (mapconcat #'ibuffer-format-qualifier (cdr qualifier) "") "]")) - (`and + ('and (concat " [AND" (mapconcat #'ibuffer-format-qualifier (cdr qualifier) "") "]")) (_ diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 78dab1c93e..b0c4b504ae 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -150,7 +150,7 @@ elisp byte-compiler." :group 'ibuffer) (defcustom ibuffer-fontification-alist - `((10 buffer-read-only font-lock-constant-face) + '((10 buffer-read-only font-lock-constant-face) (15 (and buffer-file-name (string-match ibuffer-compressed-file-name-regexp buffer-file-name)) @@ -1613,8 +1613,8 @@ If point is on a group name, this function operates on that group." `(truncate-string-to-width ,strvar ,maxvar nil ?\s))) (defun ibuffer-compile-make-format-form (strvar widthform alignment) - (let* ((left `(make-string tmp2 ?\s)) - (right `(make-string (- tmp1 tmp2) ?\s))) + (let* ((left '(make-string tmp2 ?\s)) + (right '(make-string (- tmp1 tmp2) ?\s))) `(progn (setq tmp1 ,widthform tmp2 (/ tmp1 2)) @@ -1737,7 +1737,7 @@ If point is on a group name, this function operates on that group." outforms) (push `(setq str ,callform ,@(when strlen-used - `(strlen (string-width str)))) + '(strlen (string-width str)))) outforms) (setq outforms (append outforms @@ -2205,7 +2205,7 @@ the value of point at the beginning of the line for that buffer." strname (propertize strname 'mouse-face 'highlight 'keymap hmap))) strname))))) - (add-text-properties opos (point) `(ibuffer-title-header t)) + (add-text-properties opos (point) '(ibuffer-title-header t)) (insert "\n") ;; Add the underlines (let ((str (save-excursion @@ -2255,7 +2255,7 @@ the value of point at the beginning of the line for that buffer." align) summary)))))) (point)) - `(ibuffer-summary t))))) + '(ibuffer-summary t))))) (defun ibuffer-redisplay (&optional silent) diff --git a/lisp/ido.el b/lisp/ido.el index 7bf4a92b22..69326d4fc4 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -1688,27 +1688,27 @@ is enabled then some keybindings are changed in the keymap." (when viper-p (define-key map [remap viper-intercept-ESC-key] 'ignore)) (pcase ido-cur-item - ((or `file `dir) - (when ido-context-switch-command - (define-key map "\C-x\C-b" ido-context-switch-command) - (define-key map "\C-x\C-d" 'ignore)) - (when viper-p - (define-key map [remap viper-backward-char] - 'ido-delete-backward-updir) - (define-key map [remap viper-del-backward-char-in-insert] - 'ido-delete-backward-updir) - (define-key map [remap viper-delete-backward-word] - 'ido-delete-backward-word-updir)) - (set-keymap-parent map - (if (eq ido-cur-item 'file) - ido-file-completion-map - ido-file-dir-completion-map))) - (`buffer - (when ido-context-switch-command - (define-key map "\C-x\C-f" ido-context-switch-command)) - (set-keymap-parent map ido-buffer-completion-map)) - (_ - (set-keymap-parent map ido-common-completion-map))) + ((or 'file 'dir) + (when ido-context-switch-command + (define-key map "\C-x\C-b" ido-context-switch-command) + (define-key map "\C-x\C-d" 'ignore)) + (when viper-p + (define-key map [remap viper-backward-char] + 'ido-delete-backward-updir) + (define-key map [remap viper-del-backward-char-in-insert] + 'ido-delete-backward-updir) + (define-key map [remap viper-delete-backward-word] + 'ido-delete-backward-word-updir)) + (set-keymap-parent map + (if (eq ido-cur-item 'file) + ido-file-completion-map + ido-file-dir-completion-map))) + ('buffer + (when ido-context-switch-command + (define-key map "\C-x\C-f" ido-context-switch-command)) + (set-keymap-parent map ido-buffer-completion-map)) + (_ + (set-keymap-parent map ido-common-completion-map))) (setq ido-completion-map map))) (defun ido-final-slash (dir &optional fix-it) diff --git a/lisp/info.el b/lisp/info.el index f2e29578f8..d2d315daa0 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -2734,7 +2734,7 @@ Because of ambiguities, this should be concatenated with something like (user-error "No menu in this node")) (cond ((eq (car-safe action) 'boundaries) nil) - ((eq action 'metadata) `(metadata (category . info-menu))) + ((eq action 'metadata) '(metadata (category . info-menu))) ((eq action 'lambda) (re-search-forward (concat "\n\\* +" (regexp-quote string) ":") nil t)) diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index b755ae07d3..933554925f 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -1330,7 +1330,7 @@ This is the input method activated automatically by the command `toggle-input-method' (\\[toggle-input-method])." :link '(custom-manual "(emacs)Input Methods") :group 'mule - :type `(choice (const nil) + :type '(choice (const nil) mule-input-method-string) :set-after '(current-language-environment)) @@ -1943,7 +1943,7 @@ See `set-language-info-alist' for use in programs." (set-language-info-alist (car elt) (cdr elt))) ;; re-set the environment in case its parameters changed (set-language-environment current-language-environment))) - :type `(alist + :type '(alist :key-type (string :tag "Language environment" :completions (lambda (string pred action) diff --git a/lisp/international/mule-util.el b/lisp/international/mule-util.el index cf2b29c04c..17bea5483b 100644 --- a/lisp/international/mule-util.el +++ b/lisp/international/mule-util.el @@ -393,17 +393,17 @@ QUALITY can be: japanese-cp932 korean-cp949))) (setq type 'single-byte)) (pcase type - (`utf-8 + ('utf-8 (when (coding-system-get coding-system :bom) (setq byte (max 0 (- byte 3)))) (if (= eol 1) (filepos-to-bufferpos--dos (+ pm byte) #'byte-to-position) (byte-to-position (+ pm byte)))) - (`single-byte + ('single-byte (if (= eol 1) (filepos-to-bufferpos--dos (+ pm byte) #'identity) (+ pm byte))) - ((and `utf-16 + ((and 'utf-16 ;; FIXME: For utf-16, we could use the same approach as used for ;; dos EOLs (counting the number of non-BMP chars instead of the ;; number of lines). @@ -419,8 +419,8 @@ QUALITY can be: (+ pm byte))) (_ (pcase quality - (`approximate (byte-to-position (+ pm byte))) - (`exact + ('approximate (byte-to-position (+ pm byte))) + ('exact ;; Rather than assume that the file exists and still holds the right ;; data, we reconstruct it based on the buffer's content. (let ((buf (current-buffer))) @@ -470,7 +470,7 @@ QUALITY can be: japanese-cp932 korean-cp949))) (setq type 'single-byte)) (pcase type - (`utf-8 + ('utf-8 (setq byte (position-bytes position)) (when (null byte) (if (<= position 0) @@ -482,9 +482,9 @@ QUALITY can be: (if (coding-system-get coding-system :bom) 3 0) ;; Account for CR in CRLF pairs. lineno)) - (`single-byte + ('single-byte (+ position -1 lineno)) - ((and `utf-16 + ((and 'utf-16 ;; FIXME: For utf-16, we could use the same approach as used for ;; dos EOLs (counting the number of non-BMP chars instead of the ;; number of lines). @@ -498,8 +498,8 @@ QUALITY can be: lineno)) (_ (pcase quality - (`approximate (+ (position-bytes position) -1 lineno)) - (`exact + ('approximate (+ (position-bytes position) -1 lineno)) + ('exact ;; Rather than assume that the file exists and still holds the right ;; data, we reconstruct its relevant portion. (let ((buf (current-buffer))) diff --git a/lisp/json.el b/lisp/json.el index 112f26944b..18409723da 100644 --- a/lisp/json.el +++ b/lisp/json.el @@ -523,8 +523,8 @@ Please see the documentation of `json-object-type' and `json-key-type'." ;; Skip over the "}" (json-advance) (pcase json-object-type - (`alist (nreverse elements)) - (`plist (json--plist-reverse elements)) + ('alist (nreverse elements)) + ('plist (json--plist-reverse elements)) (_ elements)))) ;; Hash table encoding @@ -641,8 +641,8 @@ become JSON objects." ;; Skip over the "]" (json-advance) (pcase json-array-type - (`vector (nreverse (vconcat elements))) - (`list (nreverse elements))))) + ('vector (nreverse (vconcat elements))) + ('list (nreverse elements))))) ;; Array encoding diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 14d730abb2..020d7f56cc 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -184,7 +184,7 @@ dispatcher in CONNECTION." (cdr oops)) "Internal error"))))) (error - `(:error (:code -32603 :message "Internal error")))))) + '(:error (:code -32603 :message "Internal error")))))) (apply #'jsonrpc--reply connection id reply))) (;; A remote notification method @@ -490,7 +490,7 @@ With optional CLEANUP, kill any associated buffers. " ;; Call all outstanding error handlers (maphash (lambda (_id triplet) (pcase-let ((`(,_success ,error ,_timeout) triplet)) - (funcall error `(:code -1 :message "Server died")))) + (funcall error '(:code -1 :message "Server died")))) (jsonrpc--request-continuations connection)) (jsonrpc--message "Server exited with status %s" (process-exit-status proc)) (process-put proc 'jsonrpc-sentinel-done t) diff --git a/lisp/language/cyrillic.el b/lisp/language/cyrillic.el index 0fcabef858..3d007d1494 100644 --- a/lisp/language/cyrillic.el +++ b/lisp/language/cyrillic.el @@ -95,7 +95,7 @@ (define-coding-system-alias 'cp878 'cyrillic-koi8) (set-language-info-alist - "Cyrillic-KOI8" `((charset koi8) + "Cyrillic-KOI8" '((charset koi8) (coding-system cyrillic-koi8) (coding-priority cyrillic-koi8 cyrillic-iso-8bit) (ctext-non-standard-encodings "koi8-r") @@ -131,7 +131,7 @@ Support for Russian using koi8-r and the russian-computer input method.") :mime-charset 'koi8-u) (set-language-info-alist - "Ukrainian" `((charset koi8-u) + "Ukrainian" '((charset koi8-u) (coding-system koi8-u) (coding-priority koi8-u) (nonascii-translation . koi8-u) @@ -151,7 +151,7 @@ Support for Russian using koi8-r and the russian-computer input method.") (define-coding-system-alias 'alternativnyj 'cyrillic-alternativnyj) (set-language-info-alist - "Cyrillic-ALT" `((charset alternativnyj) + "Cyrillic-ALT" '((charset alternativnyj) (coding-system cyrillic-alternativnyj) (coding-priority cyrillic-alternativnyj) (nonascii-translation . alternativnyj) @@ -229,7 +229,7 @@ Support for Russian using koi8-r and the russian-computer input method.") ;; '("Cyrillic")) (set-language-info-alist - "Tajik" `((coding-system koi8-t) + "Tajik" '((coding-system koi8-t) (coding-priority koi8-t) (nonascii-translation . cyrillic-koi8-t) (charset koi8-t) @@ -239,7 +239,7 @@ Support for Russian using koi8-r and the russian-computer input method.") '("Cyrillic")) (set-language-info-alist - "Bulgarian" `((coding-system windows-1251) + "Bulgarian" '((coding-system windows-1251) (coding-priority windows-1251) (nonascii-translation . windows-1251) (charset windows-1251) @@ -250,7 +250,7 @@ Support for Russian using koi8-r and the russian-computer input method.") '("Cyrillic")) (set-language-info-alist - "Belarusian" `((coding-system windows-1251) + "Belarusian" '((coding-system windows-1251) (coding-priority windows-1251) (nonascii-translation . windows-1251) (charset windows-1251) @@ -262,7 +262,7 @@ Support for Russian using koi8-r and the russian-computer input method.") '("Cyrillic")) (set-language-info-alist - "Ukrainian" `((coding-system koi8-u) + "Ukrainian" '((coding-system koi8-u) (coding-priority koi8-u) (input-method . "ukrainian-computer") (documentation diff --git a/lisp/language/european.el b/lisp/language/european.el index 4a89770e72..cd98aad8ca 100644 --- a/lisp/language/european.el +++ b/lisp/language/european.el @@ -541,7 +541,7 @@ method and applying Turkish case rules for the characters i, I, ı, Ä°."))) '("European")) (set-language-info-alist - "Welsh" `((coding-system utf-8 latin-8) ; the input method is Unicode-based + "Welsh" '((coding-system utf-8 latin-8) ; the input method is Unicode-based (coding-priority utf-8 latin-8) (nonascii-translation . iso-8859-14) (input-method . "welsh") @@ -558,7 +558,7 @@ method and applying Turkish case rules for the characters i, I, ı, Ä°."))) '("European")) (set-language-info-alist - "Latin-7" `((coding-system latin-7) + "Latin-7" '((coding-system latin-7) (coding-priority latin-7) (nonascii-translation . iso-8859-13) (input-method . "latin-prefix") @@ -566,7 +566,7 @@ method and applying Turkish case rules for the characters i, I, ı, Ä°."))) '("European")) (set-language-info-alist - "Lithuanian" `((coding-system latin-7 windows-1257) + "Lithuanian" '((coding-system latin-7 windows-1257) (coding-priority latin-7) (nonascii-translation . iso-8859-13) (input-method . "lithuanian-keyboard") @@ -574,7 +574,7 @@ method and applying Turkish case rules for the characters i, I, ı, Ä°."))) '("European")) (set-language-info-alist - "Latvian" `((coding-system latin-7 windows-1257) + "Latvian" '((coding-system latin-7 windows-1257) (coding-priority latin-7) (nonascii-translation . iso-8859-13) (input-method . "latvian-keyboard") diff --git a/lisp/language/georgian.el b/lisp/language/georgian.el index e50ebce98d..34304e7585 100644 --- a/lisp/language/georgian.el +++ b/lisp/language/georgian.el @@ -37,7 +37,7 @@ :charset-list '(georgian-academy)) (set-language-info-alist - "Georgian" `((coding-system georgian-ps) + "Georgian" '((coding-system georgian-ps) (coding-priority georgian-ps) (input-method . "georgian") (nonascii-translation . georgian-ps) diff --git a/lisp/language/tibetan.el b/lisp/language/tibetan.el index cf14d644e2..3d1df3d87f 100644 --- a/lisp/language/tibetan.el +++ b/lisp/language/tibetan.el @@ -451,7 +451,7 @@ ;;; (includes some punctuation conversion rules) ;;; (defconst tibetan-precomposition-rule-alist - `(("ཕྱྭ" . "ö…€") + '(("ཕྱྭ" . "ö…€") ("གྲྭ" . "ö…") ("ཚྭ" . "ö„˘") ("རྩྭ" . "ö†…") diff --git a/lisp/language/utf-8-lang.el b/lisp/language/utf-8-lang.el index 4b8718f9b8..5d8a044e39 100644 --- a/lisp/language/utf-8-lang.el +++ b/lisp/language/utf-8-lang.el @@ -25,24 +25,24 @@ ;;; Code: (set-language-info-alist - "UTF-8" `((coding-system utf-8) + "UTF-8" '((coding-system utf-8) (coding-priority utf-8) (charset unicode-bmp unicode) -;; Presumably not relevant now. -;; (setup-function -;; . (lambda () -;; ;; Use Unicode font under Windows. Jason Rumney fecit. -;; (if (and (fboundp 'w32-add-charset-info) -;; (not (boundp 'w32-unicode-charset-defined))) -;; (w32-add-charset-info "iso10646-1" 'w32-charset-ansi t)))) -;; Is this appropriate? -;; (exit-function -;; . (lambda () -;; (if (and (fboundp 'w32-add-charset-info) -;; (not (boundp 'w32-unicode-charset-defined))) -;; (setq w32-charset-info-alist -;; (delete (assoc "iso10646-1") -;; w32-charset-info-alist))))) + ;; Presumably not relevant now. + ;; (setup-function + ;; . (lambda () + ;; ;; Use Unicode font under Windows. Jason Rumney fecit. + ;; (if (and (fboundp 'w32-add-charset-info) + ;; (not (boundp 'w32-unicode-charset-defined))) + ;; (w32-add-charset-info "iso10646-1" 'w32-charset-ansi t)))) + ;; Is this appropriate? + ;; (exit-function + ;; . (lambda () + ;; (if (and (fboundp 'w32-add-charset-info) + ;; (not (boundp 'w32-unicode-charset-defined))) + ;; (setq w32-charset-info-alist + ;; (delete (assoc "iso10646-1") + ;; w32-charset-info-alist))))) (input-method . "rfc1345") ; maybe not the best choice (documentation . "\ This language environment is a generic one for the Unicode character set diff --git a/lisp/language/vietnamese.el b/lisp/language/vietnamese.el index 31c375589a..9524349ec7 100644 --- a/lisp/language/vietnamese.el +++ b/lisp/language/vietnamese.el @@ -72,9 +72,9 @@ (define-coding-system-alias 'viqr 'vietnamese-viqr) (set-language-info-alist - "Vietnamese" `((charset viscii) + "Vietnamese" '((charset viscii) (coding-system vietnamese-viscii vietnamese-vscii - vietnamese-tcvn vietnamese-viqr windows-1258) + vietnamese-tcvn vietnamese-viqr windows-1258) (nonascii-translation . viscii) (coding-priority vietnamese-viscii) (input-method . "vietnamese-viqr") diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index eda67cdac8..a8b206fe3a 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -34793,7 +34793,7 @@ List of suffixes which indicate a compressed file. It must be supported by libarchive(3).") (defmacro tramp-archive-autoload-file-name-regexp nil "\ -Regular expression matching archive file names." `(concat "\\`" "\\(" ".+" "\\." (regexp-opt tramp-archive-suffixes) "\\(?:" "\\." (regexp-opt tramp-archive-compression-suffixes) "\\)*" "\\)" "\\(" "/" ".*" "\\)" "\\'")) +Regular expression matching archive file names." '(concat "\\`" "\\(" ".+" "\\." (regexp-opt tramp-archive-suffixes) "\\(?:" "\\." (regexp-opt tramp-archive-compression-suffixes) "\\)*" "\\)" "\\(" "/" ".*" "\\)" "\\'")) (defalias 'tramp-archive-autoload-file-name-handler 'tramp-autoload-file-name-handler) diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el index 0175c687b2..72194648f4 100644 --- a/lisp/mail/mail-extr.el +++ b/lisp/mail/mail-extr.el @@ -652,7 +652,7 @@ Unless NO-REPLACE is true, at each of the positions in LIST-SYMBOL (< ch ,beg-symbol)) ,@(if no-replace nil - `((mail-extr-nuke-char-at ch))) + '((mail-extr-nuke-char-at ch))) (setcar temp nil)) (setq temp (cdr temp))) (setq ,list-symbol (delq nil ,list-symbol)))) diff --git a/lisp/man.el b/lisp/man.el index 1a6eda13b7..abba4879db 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -1146,7 +1146,7 @@ See the variable `Man-notify-method' for the different notification behaviors." (let ((saved-frame (with-current-buffer man-buffer Man-original-frame))) (pcase Man-notify-method - (`newframe + ('newframe ;; Since we run asynchronously, perhaps while Emacs is waiting ;; for input, we must not leave a different buffer current. We ;; can't rely on the editor command loop to reselect the @@ -1157,25 +1157,25 @@ See the variable `Man-notify-method' for the different notification behaviors." (set-window-dedicated-p (frame-selected-window frame) t) (or (display-multi-frame-p frame) (select-frame frame))))) - (`pushy + ('pushy (switch-to-buffer man-buffer)) - (`bully + ('bully (and (frame-live-p saved-frame) (select-frame saved-frame)) (pop-to-buffer man-buffer) (delete-other-windows)) - (`aggressive + ('aggressive (and (frame-live-p saved-frame) (select-frame saved-frame)) (pop-to-buffer man-buffer)) - (`friendly + ('friendly (and (frame-live-p saved-frame) (select-frame saved-frame)) (display-buffer man-buffer 'not-this-window)) - (`polite + ('polite (beep) (message "Manual buffer %s is ready" (buffer-name man-buffer))) - (`quiet + ('quiet (message "Manual buffer %s is ready" (buffer-name man-buffer))) (_ ;; meek (message "")) diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 7f3698850d..6de0a62bc2 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -423,15 +423,15 @@ (let ((menu (make-sparse-keymap "Edit"))) (bindings--define-key menu [props] - `(menu-item "Text Properties" facemenu-menu)) + '(menu-item "Text Properties" facemenu-menu)) ;; ns-win.el said: Add spell for platform consistency. (if (featurep 'ns) (bindings--define-key menu [spell] - `(menu-item "Spell" ispell-menu-map))) + '(menu-item "Spell" ispell-menu-map))) (bindings--define-key menu [fill] - `(menu-item "Fill" fill-region + '(menu-item "Fill" fill-region :enable (and mark-active (not buffer-read-only)) :help "Fill text in region to fit between left and right margin")) @@ -440,7 +440,7 @@ menu-bar-separator) (bindings--define-key menu [bookmark] - `(menu-item "Bookmarks" menu-bar-bookmark-map)) + '(menu-item "Bookmarks" menu-bar-bookmark-map)) (bindings--define-key menu [goto] `(menu-item "Go To" ,menu-bar-goto-menu)) @@ -2421,7 +2421,7 @@ form ((XOFFSET YOFFSET) WINDOW), or nil. If nil, the current mouse position is used, or nil if there is no mouse." (pcase position ;; nil -> mouse cursor position - (`nil + ('nil (let ((mp (mouse-pixel-position))) (list (list (cadr mp) (cddr mp)) (car mp)))) ;; Value returned from `event-end' or `posn-at-point'. diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el index fb8a16bd81..76e4ef711a 100644 --- a/lisp/mh-e/mh-acros.el +++ b/lisp/mh-e/mh-acros.el @@ -61,8 +61,8 @@ particular, the expansion of (setf (gethash ...) ...) used functions in \"cl\" at run time. This macro recognizes that and loads \"cl\" appropriately." (if (eq (car (macroexpand '(setf (gethash foo bar) baz))) 'cl-puthash) - `(require 'cl) - `(eval-when-compile (require 'cl)))) + '(require 'cl) + '(eval-when-compile (require 'cl)))) ;;;###mh-autoload (defmacro mh-do-in-gnu-emacs (&rest body) @@ -128,11 +128,11 @@ XEmacs and versions of GNU Emacs before 21.1 require In GNU Emacs if CHECK-TRANSIENT-MARK-MODE-FLAG is non-nil then check if variable `transient-mark-mode' is active." (cond ((featurep 'xemacs) ;XEmacs - `(and (boundp 'zmacs-regions) zmacs-regions (region-active-p))) + '(and (boundp 'zmacs-regions) zmacs-regions (region-active-p))) ((not check-transient-mark-mode-flag) ;GNU Emacs - `(and (boundp 'mark-active) mark-active)) + '(and (boundp 'mark-active) mark-active)) (t ;GNU Emacs - `(and (boundp 'transient-mark-mode) transient-mark-mode + '(and (boundp 'transient-mark-mode) transient-mark-mode (boundp 'mark-active) mark-active)))) ;; Shush compiler. diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el index 82e28e8741..1d4291cef4 100644 --- a/lisp/mh-e/mh-folder.el +++ b/lisp/mh-e/mh-folder.el @@ -519,7 +519,7 @@ font-lock is done highlighting.") (defmacro mh-remove-xemacs-horizontal-scrollbar () "Get rid of the horizontal scrollbar that XEmacs insists on putting in." (when (featurep 'xemacs) - `(if (and (featurep 'scrollbar) + '(if (and (featurep 'scrollbar) (fboundp 'set-specifier)) (set-specifier horizontal-scrollbar-visible-p nil (cons (current-buffer) nil))))) diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el index e2c682a399..0385e5f5f7 100644 --- a/lisp/mh-e/mh-mime.el +++ b/lisp/mh-e/mh-mime.el @@ -75,7 +75,7 @@ ;;;###mh-autoload (defmacro mh-buffer-data () "Convenience macro to get the MIME data structures of the current buffer." - `(gethash (current-buffer) mh-globals-hash)) + '(gethash (current-buffer) mh-globals-hash)) ;; Structure to keep track of MIME handles on a per buffer basis. (mh-defstruct (mh-buffer-data (:conc-name mh-mime-) diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el index dae8de00bb..4eebd0677d 100644 --- a/lisp/mh-e/mh-show.el +++ b/lisp/mh-e/mh-show.el @@ -375,8 +375,8 @@ still visible.\n") (cond ((not normal-exit) (set-window-configuration config)) ,(if dont-return - `(t (setq mh-previous-window-config config)) - `((and (get-buffer cur-buffer-name) + '(t (setq mh-previous-window-config config)) + '((and (get-buffer cur-buffer-name) (window-live-p (get-buffer-window (get-buffer cur-buffer-name)))) (pop-to-buffer (get-buffer cur-buffer-name) nil))))))))) diff --git a/lisp/mh-e/mh-speed.el b/lisp/mh-e/mh-speed.el index d6361180f7..539e39af00 100644 --- a/lisp/mh-e/mh-speed.el +++ b/lisp/mh-e/mh-speed.el @@ -163,7 +163,7 @@ The optional arguments from speedbar are IGNORED." (speedbar-change-expand-button-char ?-) (add-text-properties (mh-line-beginning-position) (1+ (line-beginning-position)) - `(mh-expanded t))))))) + '(mh-expanded t))))))) (defun mh-speed-view (&rest ignored) "Visits the selected folder just as if you had used \\\\[mh-visit-folder]. @@ -199,7 +199,7 @@ created." (1+ (mh-line-beginning-position)))) (add-text-properties (mh-line-beginning-position) (1+ (line-beginning-position)) - `(mh-folder nil mh-expanded nil mh-children-p t mh-level 0)) + '(mh-folder nil mh-expanded nil mh-children-p t mh-level 0)) (mh-speed-stealth-update t) (when (> mh-speed-update-interval 0) (mh-speed-flists nil)))) @@ -568,7 +568,7 @@ The function invalidates the latest ancestor that is present." (mh-speedbar-change-expand-button-char ?+) (add-text-properties (mh-line-beginning-position) (1+ (mh-line-beginning-position)) - `(mh-children-p t))) + '(mh-children-p t))) (when (get-text-property (mh-line-beginning-position) 'mh-expanded) (mh-speed-toggle)) (setq mh-speed-refresh-flag t)))) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index a7e6a8761f..f8e328f615 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1128,7 +1128,7 @@ when the buffer's text is already an exact match." ;; Show the completion table, if requested. ((not exact) (if (pcase completion-auto-help - (`lazy (eq this-command last-command)) + ('lazy (eq this-command last-command)) (_ completion-auto-help)) (minibuffer-completion-help beg end) (completion--message "Next char not unique"))) @@ -2095,9 +2095,9 @@ a completion function or god knows what else.") ;; like comint-completion-at-point or mh-letter-completion-at-point, which ;; could be sometimes safe and sometimes misbehaving (and sometimes neither). (if (pcase which - (`all t) - (`safe (member fun completion--capf-safe-funs)) - (`optimist (not (member fun completion--capf-misbehave-funs)))) + ('all t) + ('safe (member fun completion--capf-safe-funs)) + ('optimist (not (member fun completion--capf-misbehave-funs)))) (let ((res (funcall fun))) (cond ((and (consp res) (not (functionp res))) @@ -2955,9 +2955,9 @@ or a symbol, see `completion-pcm--merge-completions'." (setq p (cdr p))) (`(star ,(pred symbolp) . ,rest) (setq p `(star . ,rest))) (`(,(pred symbolp) star . ,rest) (setq p `(star . ,rest))) - (`(point ,(or `any `any-delim) . ,rest) (setq p `(point . ,rest))) - (`(,(or `any `any-delim) point . ,rest) (setq p `(point . ,rest))) - (`(any ,(or `any `any-delim) . ,rest) (setq p `(any . ,rest))) + (`(point ,(or 'any 'any-delim) . ,rest) (setq p `(point . ,rest))) + (`(,(or 'any 'any-delim) point . ,rest) (setq p `(point . ,rest))) + (`(any ,(or 'any 'any-delim) . ,rest) (setq p `(any . ,rest))) (`(,(pred symbolp)) (setq p nil)) ;Implicit terminating `any'. (_ (push (pop p) n)))) (nreverse n))) diff --git a/lisp/mpc.el b/lisp/mpc.el index 81bb5ac35a..ebd2abb37c 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -1017,7 +1017,7 @@ If PLAYLIST is t or nil or missing, use the main playlist." (text (if (eq info 'self) (symbol-name tag) (pcase tag - ((or `Time `Duration) + ((or 'Time 'Duration) (let ((time (cdr (or (assq 'time info) (assq 'Time info))))) (setq pred (list nil)) ;Just assume it's never eq. (when time @@ -1025,7 +1025,7 @@ If PLAYLIST is t or nil or missing, use the main playlist." (string-match ":" time)) (substring time (match-end 0)) time))))) - (`Cover + ('Cover (let ((dir (file-name-directory (cdr (assq 'file info))))) ;; (debug) (push `(equal ',dir (file-name-directory (cdr (assq 'file info)))) pred) diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index 1aa794477a..37df793046 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -2679,7 +2679,7 @@ The main reason for this alist is to deal with file versions in VMS.") (defmacro ange-ftp-parse-filename () ;;Extract the filename from the current line of a dired-like listing. - `(save-match-data + '(save-match-data (let ((eol (progn (end-of-line) (point)))) (beginning-of-line) (if (re-search-forward directory-listing-before-filename-regexp eol t) @@ -2761,7 +2761,7 @@ match subdirectories as well.") (defmacro ange-ftp-dl-parser () ;; Parse the current buffer, which is assumed to be a descriptive ;; listing, and return a hashtable. - `(let ((tbl (make-hash-table :test 'equal))) + '(let ((tbl (make-hash-table :test 'equal))) (while (not (eobp)) (puthash (buffer-substring (point) diff --git a/lisp/net/hmac-def.el b/lisp/net/hmac-def.el index f493d2d169..d087d55c56 100644 --- a/lisp/net/hmac-def.el +++ b/lisp/net/hmac-def.el @@ -73,7 +73,7 @@ If BIT is non-nil, truncate output to specified bits." ,(if (and bit (< (/ bit 8) L)) `(substring key-xor-opad 0 ,(/ bit 8)) ;; return a copy of `key-xor-opad'. - `(concat key-xor-opad))) + '(concat key-xor-opad))) ;; cleanup. (fillarray key-xor-ipad 0) (fillarray key-xor-opad 0))))) diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el index b6fbdfb766..40096ca4c1 100644 --- a/lisp/net/newst-backend.el +++ b/lisp/net/newst-backend.el @@ -170,7 +170,7 @@ These were mostly extracted from the Radio Community Server at http://subhonker6.userland.com/rcsPublic/rssHotlist. You may add other entries in `newsticker-url-list'." - :type `(set ,@(mapcar `newsticker--splicer + :type `(set ,@(mapcar #'newsticker--splicer newsticker--raw-url-list-defaults)) :set 'newsticker--set-customvar-retrieval :group 'newsticker-retrieval) diff --git a/lisp/net/quickurl.el b/lisp/net/quickurl.el index a5ba26bcdc..ff14d20bc3 100644 --- a/lisp/net/quickurl.el +++ b/lisp/net/quickurl.el @@ -504,15 +504,15 @@ TYPE dictates what will be inserted, options are: (with-current-buffer quickurl-list-last-buffer (insert (pcase type - (`url (funcall quickurl-format-function url)) - (`naked-url (quickurl-url-url url)) - (`with-lookup (format "%s " + ('url (funcall quickurl-format-function url)) + ('naked-url (quickurl-url-url url)) + ('with-lookup (format "%s " (quickurl-url-keyword url) (quickurl-url-url url))) - (`with-desc (format "%S " + ('with-desc (format "%S " (quickurl-url-description url) (quickurl-url-url url))) - (`lookup (quickurl-url-keyword url))))) + ('lookup (quickurl-url-keyword url))))) (error "No URL details on that line")) url)) diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 47f15cef5f..fd29ca8fd1 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -174,12 +174,12 @@ It must be supported by libarchive(3).") ;;;###autoload (progn (defmacro tramp-archive-autoload-file-name-regexp () "Regular expression matching archive file names." - `(concat + '(concat "\\`" "\\(" ".+" "\\." - ;; Default suffixes ... - (regexp-opt tramp-archive-suffixes) - ;; ... with compression. - "\\(?:" "\\." (regexp-opt tramp-archive-compression-suffixes) "\\)*" + ;; Default suffixes ... + (regexp-opt tramp-archive-suffixes) + ;; ... with compression. + "\\(?:" "\\." (regexp-opt tramp-archive-compression-suffixes) "\\)*" "\\)" ;; \1 "\\(" "/" ".*" "\\)" "\\'"))) ;; \2 diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 15b5a4958c..4db45f3c40 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -232,8 +232,8 @@ If NAME is a remote file name, the local part of NAME is unquoted." ;; `cl-struct-slot-info' has been introduced with Emacs 25. (defmacro tramp-compat-tramp-file-name-slots () (if (fboundp 'cl-struct-slot-info) - `(cdr (mapcar 'car (cl-struct-slot-info 'tramp-file-name))) - `(cdr (mapcar 'car (get 'tramp-file-name 'cl-struct-slots))))) + '(cdr (mapcar 'car (cl-struct-slot-info 'tramp-file-name))) + '(cdr (mapcar 'car (get 'tramp-file-name 'cl-struct-slots))))) ;; The signature of `tramp-make-tramp-file-name' has been changed. ;; Therefore, we cannot us `url-tramp-convert-url-to-tramp' prior diff --git a/lisp/notifications.el b/lisp/notifications.el index e19e0eee3a..2358b52c09 100644 --- a/lisp/notifications.el +++ b/lisp/notifications.el @@ -232,8 +232,8 @@ of another `notifications-notify' call." (add-to-list 'hints `(:dict-entry "urgency" (:variant :byte ,(pcase urgency - (`low 0) - (`critical 2) + ('low 0) + ('critical 2) (_ 1)))) t)) (when category (add-to-list 'hints `(:dict-entry diff --git a/lisp/obsolete/pgg-parse.el b/lisp/obsolete/pgg-parse.el index a747024649..7ae2e67399 100644 --- a/lisp/obsolete/pgg-parse.el +++ b/lisp/obsolete/pgg-parse.el @@ -123,10 +123,10 @@ 0)) (defmacro pgg-byte-after (&optional pos) - `(pgg-char-int (char-after ,(or pos `(point))))) + `(pgg-char-int (char-after ,(or pos '(point))))) (defmacro pgg-read-byte () - `(pgg-char-int (char-after (prog1 (point) (forward-char))))) + '(pgg-char-int (char-after (prog1 (point) (forward-char))))) (defmacro pgg-read-bytes-string (nbytes) `(buffer-substring diff --git a/lisp/obsolete/vc-arch.el b/lisp/obsolete/vc-arch.el index e4c52d5146..056c2709e3 100644 --- a/lisp/obsolete/vc-arch.el +++ b/lisp/obsolete/vc-arch.el @@ -397,8 +397,8 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see (setq rev (replace-match (cdr rule) t nil rev)))) (format "Arch%c%s" (pcase (vc-state file) - ((or `up-to-date `needs-update) ?-) - (`added ?@) + ((or 'up-to-date 'needs-update) ?-) + ('added ?@) (_ ?:)) rev))) diff --git a/lisp/obsolete/xesam.el b/lisp/obsolete/xesam.el index 3e91b2c8df..c5c7fa7d68 100644 --- a/lisp/obsolete/xesam.el +++ b/lisp/obsolete/xesam.el @@ -410,18 +410,18 @@ If there is no registered search engine at all, the function returns nil." ;; Hopefully, this will change later. (setq hit-fields (pcase (intern vendor-id) - (`Beagle + ('Beagle '("xesam:mimeType" "xesam:url")) - (`Strigi + ('Strigi '("xesam:author" "xesam:cc" "xesam:charset" "xesam:contentType" "xesam:fileExtension" "xesam:id" "xesam:lineCount" "xesam:links" "xesam:mimeType" "xesam:name" "xesam:size" "xesam:sourceModified" "xesam:subject" "xesam:to" "xesam:url")) - (`TrackerXesamSession + ('TrackerXesamSession '("xesam:relevancyRating" "xesam:url")) - (`Debbugs + ('Debbugs '("xesam:keyword" "xesam:owner" "xesam:title" "xesam:url" "xesam:sourceModified" "xesam:mimeType" "debbugs:key")) diff --git a/lisp/org/ob-C.el b/lisp/org/ob-C.el index ff5be34967..a99f0fcb85 100644 --- a/lisp/org/ob-C.el +++ b/lisp/org/ob-C.el @@ -136,7 +136,7 @@ or `org-babel-execute:C++' or `org-babel-execute:D'." (let* ((tmp-src-file (org-babel-temp-file "C-src-" (pcase org-babel-c-variant - (`c ".c") (`cpp ".cpp") (`d ".d")))) + ('c ".c") ('cpp ".cpp") ('d ".d")))) (tmp-bin-file ;not used for D (org-babel-process-file-name (org-babel-temp-file "C-bin-" org-babel-exeext))) @@ -154,29 +154,29 @@ or `org-babel-execute:C++' or `org-babel-execute:D'." " ")) (full-body (pcase org-babel-c-variant - (`c (org-babel-C-expand-C body params)) - (`cpp (org-babel-C-expand-C++ body params)) - (`d (org-babel-C-expand-D body params))))) + ('c (org-babel-C-expand-C body params)) + ('cpp (org-babel-C-expand-C++ body params)) + ('d (org-babel-C-expand-D body params))))) (with-temp-file tmp-src-file (insert full-body)) (pcase org-babel-c-variant - ((or `c `cpp) + ((or 'c 'cpp) (org-babel-eval (format "%s -o %s %s %s %s" (pcase org-babel-c-variant - (`c org-babel-C-compiler) - (`cpp org-babel-C++-compiler)) + ('c org-babel-C-compiler) + ('cpp org-babel-C++-compiler)) tmp-bin-file flags (org-babel-process-file-name tmp-src-file) libs) "")) - (`d nil)) ;; no separate compilation for D + ('d nil)) ;; no separate compilation for D (let ((results (org-babel-eval (pcase org-babel-c-variant - ((or `c `cpp) + ((or 'c 'cpp) (concat tmp-bin-file cmdline)) - (`d + ('d (format "%s %s %s %s" org-babel-D-compiler flags @@ -323,9 +323,9 @@ FORMAT can be either a format string or a function which is called with VAL." (let* ((basetype (org-babel-C-val-to-base-type val)) (type (pcase basetype - (`integerp '("int" "%d")) - (`floatp '("double" "%f")) - (`stringp + ('integerp '("int" "%d")) + ('floatp '("double" "%f")) + ('stringp (list (if (eq org-babel-c-variant 'd) "string" "const char*") "\"%s\"")) @@ -373,11 +373,11 @@ FORMAT can be either a format string or a function which is called with VAL." (let ((type nil)) (mapc (lambda (v) (pcase (org-babel-C-val-to-base-type v) - (`stringp (setq type 'stringp)) - (`floatp + ('stringp (setq type 'stringp)) + ('floatp (if (or (not type) (eq type 'integerp)) (setq type 'floatp))) - (`integerp + ('integerp (unless type (setq type 'integerp))))) val) type)) @@ -420,7 +420,7 @@ of the same value." "Generate a utility function to convert a column name into a column number." (pcase org-babel-c-variant - ((or `c `cpp) + ((or 'c 'cpp) "int get_column_num (int nbcols, const char** header, const char* column) { int c; @@ -430,7 +430,7 @@ into a column number." return -1; } ") - (`d + ('d "int get_column_num (string[] header, string column) { foreach (c, h; header) @@ -448,18 +448,18 @@ specifying a variable with the name of the table." (concat (format (pcase org-babel-c-variant - ((or `c `cpp) "const char* %s_header[%d] = {%s};") - (`d "string %s_header[%d] = [%s];")) + ((or 'c 'cpp) "const char* %s_header[%d] = {%s};") + ('d "string %s_header[%d] = [%s];")) table (length headers) (mapconcat (lambda (h) (format "%S" h)) headers ",")) "\n" (pcase org-babel-c-variant - ((or `c `cpp) + ((or 'c 'cpp) (format "const char* %s_h (int row, const char* col) { return %s[row][get_column_num(%d,%s_header,col)]; }" table table (length headers) table)) - (`d + ('d (format "string %s_h (size_t row, string col) { return %s[row][get_column_num(%s_header,col)]; }" table table table)))))) diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el index a5449fe35e..ddf756c915 100644 --- a/lisp/org/ob-core.el +++ b/lisp/org/ob-core.el @@ -283,9 +283,9 @@ environment, to override this check." (name (nth 4 info)) (name-string (if name (format " (%s) " name) " "))) (pcase evalp - (`nil nil) - (`t t) - (`query (or + ('nil nil) + ('t t) + ('query (or (and (not (bound-and-true-p org-babel-confirm-evaluate-answer-no)) (yes-or-no-p @@ -1991,7 +1991,7 @@ to HASH." (catch :found (org-with-wide-buffer (pcase (org-element-type context) - ((or `inline-babel-call `inline-src-block) + ((or 'inline-babel-call 'inline-src-block) ;; Results for inline objects are located right after them. ;; There is no RESULTS line to insert either. (let ((limit (org-element-property @@ -2013,7 +2013,7 @@ to HASH." (skip-chars-backward " \t") (point))) (point)))))))) - ((or `babel-call `src-block) + ((or 'babel-call 'src-block) (let* ((name (org-element-property :name context)) (named-results (and name (org-babel-find-named-result name)))) (goto-char (or named-results (org-element-property :end context))) @@ -2067,20 +2067,20 @@ Return nil if ELEMENT cannot be read." (org-with-wide-buffer (goto-char (org-element-property :post-affiliated element)) (pcase (org-element-type element) - (`fixed-width + ('fixed-width (let ((v (org-trim (org-element-property :value element)))) (or (org-babel--string-to-number v) v))) - (`table (org-babel-read-table)) - (`plain-list (org-babel-read-list)) - (`example-block + ('table (org-babel-read-table)) + ('plain-list (org-babel-read-list)) + ('example-block (let ((v (org-element-property :value element))) (if (or org-src-preserve-indentation (org-element-property :preserve-indent element)) v (org-remove-indentation v)))) - (`export-block + ('export-block (org-remove-indentation (org-element-property :value element))) - (`paragraph + ('paragraph ;; Treat paragraphs containing a single link specially. (skip-chars-forward " \t") (if (and (looking-at org-bracket-link-regexp) @@ -2093,7 +2093,7 @@ Return nil if ELEMENT cannot be read." (buffer-substring-no-properties (org-element-property :contents-begin element) (org-element-property :contents-end element)))) - ((or `center-block `quote-block `verse-block `special-block) + ((or 'center-block 'quote-block 'verse-block 'special-block) (org-remove-indentation (buffer-substring-no-properties (org-element-property :contents-begin element) diff --git a/lisp/org/ob-exp.el b/lisp/org/ob-exp.el index 264dc0ed06..bb4ef1b77f 100644 --- a/lisp/org/ob-exp.el +++ b/lisp/org/ob-exp.el @@ -175,7 +175,7 @@ this template." ;; ;; #+name: call_src ;; #+begin_src ... - ((and (or `babel-call `src-block) (guard object?)) + ((and (or 'babel-call 'src-block) (guard object?)) nil) (type type))) (begin @@ -187,7 +187,7 @@ this template." (skip-chars-backward " \r\t\n") (point))))) (pcase type - (`inline-src-block + ('inline-src-block (let* ((info (org-babel-get-src-block-info nil element)) (params (nth 2 info))) @@ -215,7 +215,7 @@ this template." ;; insert value. (delete-region begin end) (insert replacement))))) - ((or `babel-call `inline-babel-call) + ((or 'babel-call 'inline-babel-call) (org-babel-exp-do-export (org-babel-lob-get-info element) 'lob) (let ((rep @@ -242,7 +242,7 @@ this template." (goto-char begin) (delete-region begin end) (insert rep)))) - (`src-block + ('src-block (let ((match-start (copy-marker (match-beginning 0))) (ind (org-get-indentation))) ;; Take care of matched block: compute @@ -394,14 +394,14 @@ inhibit insertion of results into the buffer." (nth 2 info) `((:results . ,(if silent "silent" "replace"))))))) (pcase type - (`block (org-babel-execute-src-block nil info)) - (`inline + ('block (org-babel-execute-src-block nil info)) + ('inline ;; Position the point on the inline source block ;; allowing `org-babel-insert-result' to check that the ;; block is inline. (goto-char (nth 5 info)) (org-babel-execute-src-block nil info)) - (`lob + ('lob (save-excursion (goto-char (nth 5 info)) (let (org-confirm-babel-evaluate) diff --git a/lisp/org/ob-groovy.el b/lisp/org/ob-groovy.el index 565b09754b..44470dd1a1 100644 --- a/lisp/org/ob-groovy.el +++ b/lisp/org/ob-groovy.el @@ -83,12 +83,12 @@ If RESULT-TYPE equals `value' then return the value of the last statement in BODY as elisp." (when session (error "Sessions are not (yet) supported for Groovy")) (pcase result-type - (`output + ('output (let ((src-file (org-babel-temp-file "groovy_"))) (progn (with-temp-file src-file (insert body)) (org-babel-eval (concat org-babel-groovy-command " " src-file) "")))) - (`value + ('value (let* ((src-file (org-babel-temp-file "groovy_")) (wrapper (format org-babel-groovy-wrapper-method body))) (with-temp-file src-file (insert wrapper)) diff --git a/lisp/org/ob-haskell.el b/lisp/org/ob-haskell.el index e607ee0c55..ba1b4d00fc 100644 --- a/lisp/org/ob-haskell.el +++ b/lisp/org/ob-haskell.el @@ -89,8 +89,8 @@ (org-babel-reassemble-table (let ((result (pcase result-type - (`output (mapconcat #'identity (reverse (cdr results)) "\n")) - (`value (car results))))) + ('output (mapconcat #'identity (reverse (cdr results)) "\n")) + ('value (car results))))) (org-babel-result-cond (cdr (assq :result-params params)) result (org-babel-script-escape result))) (org-babel-pick-name (cdr (assq :colname-names params)) diff --git a/lisp/org/ob-io.el b/lisp/org/ob-io.el index 4f407cc52c..07746aaac7 100644 --- a/lisp/org/ob-io.el +++ b/lisp/org/ob-io.el @@ -74,14 +74,14 @@ If RESULT-TYPE equals `value' then return the value of the last statement in BODY as elisp." (when session (error "Sessions are not (yet) supported for Io")) (pcase result-type - (`output + ('output (if (member "repl" result-params) (org-babel-eval org-babel-io-command body) (let ((src-file (org-babel-temp-file "io-"))) (progn (with-temp-file src-file (insert body)) (org-babel-eval (concat org-babel-io-command " " src-file) ""))))) - (`value (let* ((src-file (org-babel-temp-file "io-")) + ('value (let* ((src-file (org-babel-temp-file "io-")) (wrapper (format org-babel-io-wrapper-method body))) (with-temp-file src-file (insert wrapper)) (let ((raw (org-babel-eval diff --git a/lisp/org/ob-lisp.el b/lisp/org/ob-lisp.el index b846138f7a..8fc691ed61 100644 --- a/lisp/org/ob-lisp.el +++ b/lisp/org/ob-lisp.el @@ -87,8 +87,8 @@ current directory string." BODY is the contents of the block, as a string. PARAMS is a property list containing the parameters of the block." (require (pcase org-babel-lisp-eval-fn - (`slime-eval 'slime) - (`sly-eval 'sly))) + ('slime-eval 'slime) + ('sly-eval 'sly))) (org-babel-reassemble-table (let ((result (funcall (if (member "output" (cdr (assq :result-params params))) diff --git a/lisp/org/ob-lob.el b/lisp/org/ob-lob.el index 6af6bf07e8..6668ccd8ba 100644 --- a/lisp/org/ob-lob.el +++ b/lisp/org/ob-lob.el @@ -105,8 +105,8 @@ after REF in the Library of Babel." (when (equal name (org-element-property :name element)) (throw :found (pcase (org-element-type element) - (`src-block (org-babel-get-src-block-info t element)) - (`babel-call (org-babel-lob-get-info element)) + ('src-block (org-babel-get-src-block-info t element)) + ('babel-call (org-babel-lob-get-info element)) ;; Non-executable data found. Since names ;; are supposed to be unique throughout ;; a document, bail out. diff --git a/lisp/org/ob-lua.el b/lisp/org/ob-lua.el index 6ae72c7e56..7750afdffc 100644 --- a/lisp/org/ob-lua.el +++ b/lisp/org/ob-lua.el @@ -290,10 +290,10 @@ string. If RESULT-TYPE equals 'value then return the value of the last statement in BODY, as elisp." (let ((raw (pcase result-type - (`output (org-babel-eval org-babel-lua-command + ('output (org-babel-eval org-babel-lua-command (concat (if preamble (concat preamble "\n")) body))) - (`value (let ((tmp-file (org-babel-temp-file "lua-"))) + ('value (let ((tmp-file (org-babel-temp-file "lua-"))) (org-babel-eval org-babel-lua-command (concat @@ -364,7 +364,7 @@ fd:close()" (funcall send-wait))) (results (pcase result-type - (`output + ('output (mapconcat #'org-trim (butlast @@ -375,7 +375,7 @@ fd:close()" (insert org-babel-lua-eoe-indicator) (funcall send-wait)) 2) "\n")) - (`value + ('value (let ((tmp-file (org-babel-temp-file "lua-"))) (org-babel-comint-with-output (session org-babel-lua-eoe-indicator nil body) diff --git a/lisp/org/ob-octave.el b/lisp/org/ob-octave.el index c7339cf992..f19b6ccf25 100644 --- a/lisp/org/ob-octave.el +++ b/lisp/org/ob-octave.el @@ -178,14 +178,14 @@ value of the last statement in BODY, as elisp." org-babel-matlab-shell-command org-babel-octave-shell-command))) (pcase result-type - (`output (org-babel-eval cmd body)) - (`value (let ((tmp-file (org-babel-temp-file "octave-"))) - (org-babel-eval - cmd - (format org-babel-octave-wrapper-method body - (org-babel-process-file-name tmp-file 'noquote) - (org-babel-process-file-name tmp-file 'noquote))) - (org-babel-octave-import-elisp-from-file tmp-file)))))) + ('output (org-babel-eval cmd body)) + ('value (let ((tmp-file (org-babel-temp-file "octave-"))) + (org-babel-eval + cmd + (format org-babel-octave-wrapper-method body + (org-babel-process-file-name tmp-file 'noquote) + (org-babel-process-file-name tmp-file 'noquote))) + (org-babel-octave-import-elisp-from-file tmp-file)))))) (defun org-babel-octave-evaluate-session (session body result-type &optional matlabp) @@ -194,11 +194,11 @@ value of the last statement in BODY, as elisp." (wait-file (org-babel-temp-file "matlab-emacs-link-wait-signal-")) (full-body (pcase result-type - (`output + ('output (mapconcat #'org-babel-chomp (list body org-babel-octave-eoe-indicator) "\n")) - (`value + ('value (if (and matlabp org-babel-matlab-with-emacs-link) (concat (format org-babel-matlab-emacs-link-wrapper-method @@ -232,9 +232,9 @@ value of the last statement in BODY, as elisp." t full-body) (insert full-body) (comint-send-input nil t)))) results) (pcase result-type - (`value + ('value (org-babel-octave-import-elisp-from-file tmp-file)) - (`output + ('output (setq results (if matlabp (cdr (reverse (delq "" (mapcar diff --git a/lisp/org/ob-perl.el b/lisp/org/ob-perl.el index 85806fd533..adb62ce50b 100644 --- a/lisp/org/ob-perl.el +++ b/lisp/org/ob-perl.el @@ -136,12 +136,12 @@ return the value of the last statement in BODY, as elisp." tmp-file 'noquote))) (let ((results (pcase result-type - (`output + ('output (with-temp-file tmp-file (insert (org-babel-eval org-babel-perl-command body)) (buffer-string))) - (`value + ('value (org-babel-eval org-babel-perl-command (format org-babel-perl-wrapper-method body tmp-babel-file)))))) diff --git a/lisp/org/ob-python.el b/lisp/org/ob-python.el index 9f1234bac5..3f1bbf1cb3 100644 --- a/lisp/org/ob-python.el +++ b/lisp/org/ob-python.el @@ -265,10 +265,10 @@ string. If RESULT-TYPE equals `value' then return the value of the last statement in BODY, as elisp." (let ((raw (pcase result-type - (`output (org-babel-eval org-babel-python-command + ('output (org-babel-eval org-babel-python-command (concat (if preamble (concat preamble "\n")) body))) - (`value (let ((tmp-file (org-babel-temp-file "python-"))) + ('value (let ((tmp-file (org-babel-temp-file "python-"))) (org-babel-eval org-babel-python-command (concat @@ -314,7 +314,7 @@ last statement in BODY, as elisp." (funcall send-wait))) (results (pcase result-type - (`output + ('output (let ((body (if (string-match-p ".\n+." body) ; Multiline (let ((tmp-src-file (org-babel-temp-file "python-"))) @@ -332,7 +332,7 @@ last statement in BODY, as elisp." (insert org-babel-python-eoe-indicator) (funcall send-wait)) 2) "\n"))) - (`value + ('value (let ((tmp-file (org-babel-temp-file "python-"))) (org-babel-comint-with-output (session org-babel-python-eoe-indicator nil body) diff --git a/lisp/org/ob-ref.el b/lisp/org/ob-ref.el index 3efa17f960..88a93294db 100644 --- a/lisp/org/ob-ref.el +++ b/lisp/org/ob-ref.el @@ -166,11 +166,11 @@ Emacs Lisp representation of the value of the variable." (goto-char (org-element-property :post-affiliated e)) (pcase (org-element-type e) - (`babel-call + ('babel-call (throw :found (org-babel-execute-src-block nil (org-babel-lob-get-info e) params))) - (`src-block + ('src-block (throw :found (org-babel-execute-src-block nil nil diff --git a/lisp/org/ob-ruby.el b/lisp/org/ob-ruby.el index 7686ac4e80..bb06b008a6 100644 --- a/lisp/org/ob-ruby.el +++ b/lisp/org/ob-ruby.el @@ -200,8 +200,8 @@ return the value of the last statement in BODY, as elisp." (if (not buffer) ;; external process evaluation (pcase result-type - (`output (org-babel-eval org-babel-ruby-command body)) - (`value (let ((tmp-file (org-babel-temp-file "ruby-"))) + ('output (org-babel-eval org-babel-ruby-command body)) + ('value (let ((tmp-file (org-babel-temp-file "ruby-"))) (org-babel-eval org-babel-ruby-command (format (if (member "pp" result-params) @@ -211,7 +211,7 @@ return the value of the last statement in BODY, as elisp." (org-babel-eval-read-file tmp-file)))) ;; comint session evaluation (pcase result-type - (`output + ('output (let ((eoe-string (format "puts \"%s\"" org-babel-ruby-eoe-indicator))) ;; Force the session to be ready before the actual session ;; code is run. There is some problem in comint that will @@ -238,7 +238,7 @@ return the value of the last statement in BODY, as elisp." "conf.prompt_mode=_org_prompt_mode;conf.echo=true" eoe-string))) "\n") "[\r\n]") 4) "\n"))) - (`value + ('value (let* ((tmp-file (org-babel-temp-file "ruby-")) (ppp (or (member "code" result-params) (member "pp" result-params)))) diff --git a/lisp/org/ob-sql.el b/lisp/org/ob-sql.el index 959ede3dec..cdedf7edfb 100644 --- a/lisp/org/ob-sql.el +++ b/lisp/org/ob-sql.el @@ -175,16 +175,16 @@ This function is called by `org-babel-execute-src-block'." (org-babel-temp-file "sql-out-"))) (header-delim "") (command (pcase (intern engine) - (`dbi (format "dbish --batch %s < %s | sed '%s' > %s" + ('dbi (format "dbish --batch %s < %s | sed '%s' > %s" (or cmdline "") (org-babel-process-file-name in-file) "/^+/d;s/^|//;s/(NULL)/ /g;$d" (org-babel-process-file-name out-file))) - (`monetdb (format "mclient -f tab %s < %s > %s" + ('monetdb (format "mclient -f tab %s < %s > %s" (or cmdline "") (org-babel-process-file-name in-file) (org-babel-process-file-name out-file))) - (`mssql (format "sqlcmd %s -s \"\t\" %s -i %s -o %s" + ('mssql (format "sqlcmd %s -s \"\t\" %s -i %s -o %s" (or cmdline "") (org-babel-sql-dbstring-mssql dbhost dbuser dbpassword database) @@ -192,14 +192,14 @@ This function is called by `org-babel-execute-src-block'." (org-babel-process-file-name in-file)) (org-babel-sql-convert-standard-filename (org-babel-process-file-name out-file)))) - (`mysql (format "mysql %s %s %s < %s > %s" + ('mysql (format "mysql %s %s %s < %s > %s" (org-babel-sql-dbstring-mysql dbhost dbport dbuser dbpassword database) (if colnames-p "" "-N") (or cmdline "") (org-babel-process-file-name in-file) (org-babel-process-file-name out-file))) - (`postgresql (format + ('postgresql (format "%spsql --set=\"ON_ERROR_STOP=1\" %s -A -P \ footer=off -F \"\t\" %s -f %s -o %s %s" (if dbpassword @@ -211,7 +211,7 @@ footer=off -F \"\t\" %s -f %s -o %s %s" (org-babel-process-file-name in-file) (org-babel-process-file-name out-file) (or cmdline ""))) - (`sqsh (format "sqsh %s %s -i %s -o %s -m csv" + ('sqsh (format "sqsh %s %s -i %s -o %s -m csv" (or cmdline "") (org-babel-sql-dbstring-sqsh dbhost dbuser dbpassword database) @@ -219,13 +219,13 @@ footer=off -F \"\t\" %s -f %s -o %s %s" (org-babel-process-file-name in-file)) (org-babel-sql-convert-standard-filename (org-babel-process-file-name out-file)))) - (`vertica (format "vsql %s -f %s -o %s %s" - (org-babel-sql-dbstring-vertica - dbhost dbport dbuser dbpassword database) - (org-babel-process-file-name in-file) - (org-babel-process-file-name out-file) - (or cmdline ""))) - (`oracle (format + ('vertica (format "vsql %s -f %s -o %s %s" + (org-babel-sql-dbstring-vertica + dbhost dbport dbuser dbpassword database) + (org-babel-process-file-name in-file) + (org-babel-process-file-name out-file) + (or cmdline ""))) + ('oracle (format "sqlplus -s %s < %s > %s" (org-babel-sql-dbstring-oracle dbhost dbport dbuser dbpassword database) @@ -235,8 +235,8 @@ footer=off -F \"\t\" %s -f %s -o %s %s" (with-temp-file in-file (insert (pcase (intern engine) - (`dbi "/format partbox\n") - (`oracle "SET PAGESIZE 50000 + ('dbi "/format partbox\n") + ('oracle "SET PAGESIZE 50000 SET NEWPAGE 0 SET TAB OFF SET SPACE 0 @@ -249,10 +249,10 @@ SET MARKUP HTML OFF SPOOL OFF SET COLSEP '|' ") - ((or `mssql `sqsh) "SET NOCOUNT ON + ((or 'mssql 'sqsh) "SET NOCOUNT ON ") - (`vertica "\\a\n") + ('vertica "\\a\n") (_ "")) (org-babel-expand-body:sql body params) ;; "sqsh" requires "go" inserted at EOF. diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index 98e89eb1c4..d92fbaf897 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -6213,12 +6213,12 @@ scheduled items with an hour specification like [h]h:mm." (or (not (memq (line-beginning-position 0) deadline-pos)) habitp)) nil) - (`repeated-after-deadline + ('repeated-after-deadline (let ((deadline (time-to-days (org-get-deadline-time (point))))) (and (<= schedule deadline) (> current deadline)))) - (`not-today pastschedp) - (`t t) + ('not-today pastschedp) + ('t t) (_ nil)) (throw :skip nil)) ;; Skip habits if `org-habit-show-habits' is nil, or if we diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el index 3de386c69d..f51eee56b7 100644 --- a/lisp/org/org-capture.el +++ b/lisp/org/org-capture.el @@ -1042,7 +1042,7 @@ Store them in the capture property list." (org-capture-put :exact-position (point)) (setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p)))) - (`(clock) + ('(clock) (if (and (markerp org-clock-hd-marker) (marker-buffer org-clock-hd-marker)) (progn (set-buffer (marker-buffer org-clock-hd-marker)) @@ -1101,11 +1101,11 @@ may have been stored before." (goto-char (org-capture-get :pos)) (setq-local outline-level 'org-outline-level) (pcase (org-capture-get :type) - ((or `nil `entry) (org-capture-place-entry)) - (`table-line (org-capture-place-table-line)) - (`plain (org-capture-place-plain-text)) - (`item (org-capture-place-item)) - (`checkitem (org-capture-place-item))) + ((or 'nil 'entry) (org-capture-place-entry)) + ('table-line (org-capture-place-table-line)) + ('plain (org-capture-place-plain-text)) + ('item (org-capture-place-item)) + ('checkitem (org-capture-place-item))) (org-capture-mode 1) (setq-local org-capture-current-plist org-capture-plist)) @@ -1791,7 +1791,7 @@ The template may still contain \"%?\" for cursor positioning." (let ((insert-fun (if (equal key "C") #'insert (lambda (s) (org-insert-link 0 s))))) (pcase org-capture--clipboards - (`nil nil) + ('nil nil) (`(,value) (funcall insert-fun value)) (`(,first-value . ,_) (funcall insert-fun @@ -1811,7 +1811,7 @@ The template may still contain \"%?\" for cursor positioning." time (or org-time-was-given upcase?) (member key '("u" "U")) nil nil (list org-end-time-was-given)))) - (`nil + ('nil ;; Load history list for current prompt. (setq org-capture--prompt-history (gethash prompt org-capture--prompt-history-table)) diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el index 9be0d5bc1f..0940c12147 100644 --- a/lisp/org/org-clock.el +++ b/lisp/org/org-clock.el @@ -1692,11 +1692,11 @@ Optional argument N tells to change by that many units." (org-timestamp-change (round (/ (float-time tdiff) (pcase timestamp? - (`minute 60) - (`hour 3600) - (`day (* 24 3600)) - (`month (* 24 3600 31)) - (`year (* 24 3600 365.2))))) + ('minute 60) + ('hour 3600) + ('day (* 24 3600)) + ('month (* 24 3600 31)) + ('year (* 24 3600 365.2))))) timestamp? 'updown))))))) ;;;###autoload @@ -2045,7 +2045,7 @@ in the buffer and update it." (org-find-dblock "clocktable") (org-show-entry)) (pcase (org-in-clocktable-p) - (`nil + ('nil (org-create-dblock (org-combine-plists (list :scope (if (org-before-first-heading-p) 'file 'subtree)) @@ -2194,21 +2194,21 @@ have priority." (error "Looking forward with quarters isn't implemented")))) (when (= shift 0) (pcase key - (`yesterday (setq key 'today shift -1)) - (`lastweek (setq key 'week shift -1)) - (`lastmonth (setq key 'month shift -1)) - (`lastyear (setq key 'year shift -1)) - (`lastq (setq key 'quarter shift -1)))) + ('yesterday (setq key 'today shift -1)) + ('lastweek (setq key 'week shift -1)) + ('lastmonth (setq key 'month shift -1)) + ('lastyear (setq key 'year shift -1)) + ('lastq (setq key 'quarter shift -1)))) ;; Prepare start and end times depending on KEY's type. (pcase key - ((or `day `today) (setq m 0 h 0 h1 24 d (+ d shift))) - ((or `week `thisweek) + ((or 'day 'today) (setq m 0 h 0 h1 24 d (+ d shift))) + ((or 'week 'thisweek) (let* ((ws (or wstart 1)) (diff (+ (* -7 shift) (if (= dow 0) (- 7 ws) (- dow ws))))) (setq m 0 h 0 d (- d diff) d1 (+ 7 d)))) - ((or `month `thismonth) + ((or 'month 'thismonth) (setq h 0 m 0 d (or mstart 1) month (+ month shift) month1 (1+ month))) - ((or `quarter `thisq) + ((or 'quarter 'thisq) ;; Compute if this shift remains in this year. If not, compute ;; how many years and quarters we have to shift (via floor*) and ;; compute the shifted years, months and quarters. @@ -2231,13 +2231,13 @@ have priority." (setq shiftedy y) (let ((qshift (* 3 (1- (+ q shift))))) (setq m 0 h 0 d 1 month (+ 1 qshift) month1 (+ 4 qshift)))))) - ((or `year `thisyear) + ((or 'year 'thisyear) (setq m 0 h 0 d 1 month 1 y (+ y shift) y1 (1+ y))) - ((or `interactive `untilnow)) ; Special cases, ignore them. + ((or 'interactive 'untilnow)) ; Special cases, ignore them. (_ (user-error "No such time block %s" key))) ;; Format start and end times according to AS-STRINGS. (let* ((start (pcase key - (`interactive (org-read-date nil t nil "Range start? ")) + ('interactive (org-read-date nil t nil "Range start? ")) ;; In theory, all clocks started after the dawn of ;; humanity. However, the platform's clock ;; support might not go back that far. Choose the @@ -2246,15 +2246,15 @@ have priority." ;; that works, otherwise 0 (1970). Going back ;; billions of years would loop forever on Mac OS ;; X 10.6 with Emacs 26 and earlier (Bug#27736). - (`untilnow + ('untilnow (let ((old 0)) (dolist (older '((-32768 0) (-33554432 0)) old) (when (ignore-errors (decode-time older)) (setq old older))))) (_ (encode-time 0 m h d month y)))) (end (pcase key - (`interactive (org-read-date nil t nil "Range end? ")) - (`untilnow (current-time)) + ('interactive (org-read-date nil t nil "Range end? ")) + ('untilnow (current-time)) (_ (encode-time 0 (or m1 m) (or h1 h) @@ -2263,15 +2263,15 @@ have priority." (or y1 y))))) (text (pcase key - ((or `day `today) (format-time-string "%A, %B %d, %Y" start)) - ((or `week `thisweek) (format-time-string "week %G-W%V" start)) - ((or `month `thismonth) (format-time-string "%B %Y" start)) - ((or `year `thisyear) (format-time-string "the year %Y" start)) - ((or `quarter `thisq) + ((or 'day 'today) (format-time-string "%A, %B %d, %Y" start)) + ((or 'week 'thisweek) (format-time-string "week %G-W%V" start)) + ((or 'month 'thismonth) (format-time-string "%B %Y" start)) + ((or 'year 'thisyear) (format-time-string "the year %Y" start)) + ((or 'quarter 'thisq) (concat (org-count-quarter shiftedq) " quarter of " (number-to-string shiftedy))) - (`interactive "(Range interactively set)") - (`untilnow "now")))) + ('interactive "(Range interactively set)") + ('untilnow "now")))) (if (not as-strings) (list start end text) (let ((f (cdr org-time-stamp-formats))) (list (format-time-string f start) @@ -2375,11 +2375,11 @@ the currently selected interval size." (catch 'exit (let* ((scope (plist-get params :scope)) (files (pcase scope - (`agenda + ('agenda (org-agenda-files t)) - (`agenda-with-archives + ('agenda-with-archives (org-add-archive-files (org-agenda-files t))) - (`file-with-archives + ('file-with-archives (and buffer-file-name (org-add-archive-files (list buffer-file-name)))) ((pred functionp) (funcall scope)) @@ -2502,7 +2502,7 @@ from the dynamic block definition." (setq narrow (intern (format "%d!" narrow)))) (pcase narrow - ((or `nil (pred integerp)) nil) ;nothing to do + ((or 'nil (pred integerp)) nil) ;nothing to do ((and (pred symbolp) (guard (string-match-p "\\`[0-9]+!\\'" (symbol-name narrow)))) (setq narrow-cut-p t) diff --git a/lisp/org/org-colview.el b/lisp/org/org-colview.el index cb5c091d0a..e6464ab8a1 100644 --- a/lisp/org/org-colview.el +++ b/lisp/org/org-colview.el @@ -1379,8 +1379,8 @@ PARAMS is a property list of parameters: (let ((id (plist-get params :id)) view-file view-pos) (pcase id - (`global nil) - ((or `local `nil) (setq view-pos (point))) + ('global nil) + ((or 'local 'nil) (setq view-pos (point))) ((and (let id-string (format "%s" id)) (guard (string-match "^file:\\(.*\\)" id-string))) (setq view-file (match-string-no-properties 1 id-string)) diff --git a/lisp/org/org-duration.el b/lisp/org/org-duration.el index 1c962ba94e..fed864a545 100644 --- a/lisp/org/org-duration.el +++ b/lisp/org/org-duration.el @@ -316,10 +316,10 @@ When optional argument CANONICAL is non-nil, ignore Raise an error if expected format is unknown." (pcase (or fmt org-duration-format) - (`h:mm + ('h:mm (let ((minutes (floor minutes))) (format "%d:%02d" (/ minutes 60) (mod minutes 60)))) - (`h:mm:ss + ('h:mm:ss (let* ((whole-minutes (floor minutes)) (seconds (floor (* 60 (- minutes whole-minutes))))) (format "%s:%02d" @@ -328,7 +328,7 @@ Raise an error if expected format is unknown." ((pred atom) (error "Invalid duration format specification: %S" fmt)) ;; Mixed format. Call recursively the function on both parts. ((and duration-format - (let `(special . ,(and mode (or `h:mm:ss `h:mm))) + (let `(special . ,(and mode (or 'h:mm:ss 'h:mm))) (assq 'special duration-format))) (let* ((truncated-format ;; Remove "special" mode from duration format in order to diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el index b8f1467022..09840cc44f 100644 --- a/lisp/org/org-element.el +++ b/lisp/org/org-element.el @@ -588,9 +588,9 @@ is cleared and contents are removed in the process." (when datum (let ((type (org-element-type datum))) (pcase type - (`org-data (list 'org-data nil)) - (`plain-text (substring-no-properties datum)) - (`nil (copy-sequence datum)) + ('org-data (list 'org-data nil)) + ('plain-text (substring-no-properties datum)) + ('nil (copy-sequence datum)) (_ (list type (plist-put (copy-sequence (nth 1 datum)) :parent nil))))))) @@ -1285,9 +1285,9 @@ CONTENTS is the contents of the element." bullet (and counter (format "[@%d] " counter)) (pcase checkbox - (`on "[X] ") - (`off "[ ] ") - (`trans "[-] ") + ('on "[X] ") + ('off "[ ] ") + ('trans "[-] ") (_ nil)) (and tag (format "%s :: " tag)) (when contents @@ -3185,13 +3185,13 @@ CONTENTS is the contents of the object, or nil." ;; a format string, escape percent signs ;; in description. (replace-regexp-in-string "%" "%%" contents))) - ((or `bracket - `nil + ((or 'bracket + 'nil (guard (member type '("coderef" "custom-id" "fuzzy")))) "[[%s]]") ;; Otherwise, just obey to `:format'. - (`angle "<%s>") - (`plain "%s") + ('angle "<%s>") + ('plain "%s") (f (error "Wrong `:format' value: %s" f))))) (format fmt (pcase type @@ -3581,19 +3581,19 @@ Assume point is at the beginning of the timestamp." (let* ((repeat-string (concat (pcase (org-element-property :repeater-type timestamp) - (`cumulate "+") (`catch-up "++") (`restart ".+")) + ('cumulate "+") ('catch-up "++") ('restart ".+")) (let ((val (org-element-property :repeater-value timestamp))) (and val (number-to-string val))) (pcase (org-element-property :repeater-unit timestamp) - (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y")))) + ('hour "h") ('day "d") ('week "w") ('month "m") ('year "y")))) (warning-string (concat (pcase (org-element-property :warning-type timestamp) - (`first "--") (`all "-")) + ('first "--") ('all "-")) (let ((val (org-element-property :warning-value timestamp))) (and val (number-to-string val))) (pcase (org-element-property :warning-unit timestamp) - (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y")))) + ('hour "h") ('day "d") ('week "w") ('month "m") ('year "y")))) (build-ts-string ;; Build an Org timestamp string from TIME. ACTIVEP is ;; non-nil when time stamp is active. If WITH-TIME-P is @@ -3622,7 +3622,7 @@ Assume point is at the beginning of the timestamp." ts))) (type (org-element-property :type timestamp))) (pcase type - ((or `active `inactive) + ((or 'active 'inactive) (let* ((minute-start (org-element-property :minute-start timestamp)) (minute-end (org-element-property :minute-end timestamp)) (hour-start (org-element-property :hour-start timestamp)) @@ -3642,7 +3642,7 @@ Assume point is at the beginning of the timestamp." (and hour-start minute-start) (and time-range-p hour-end) (and time-range-p minute-end)))) - ((or `active-range `inactive-range) + ((or 'active-range 'inactive-range) (let ((minute-start (org-element-property :minute-start timestamp)) (minute-end (org-element-property :minute-end timestamp)) (hour-start (org-element-property :hour-start timestamp)) @@ -4227,17 +4227,17 @@ otherwise. Modes can be either `first-section', `item', `table-row' or nil." (if parentp (pcase type - (`headline 'section) - (`inlinetask 'planning) - (`plain-list 'item) - (`property-drawer 'node-property) - (`section 'planning) - (`table 'table-row)) + ('headline 'section) + ('inlinetask 'planning) + ('plain-list 'item) + ('property-drawer 'node-property) + ('section 'planning) + ('table 'table-row)) (pcase type - (`item 'item) - (`node-property 'node-property) - (`planning 'property-drawer) - (`table-row 'table-row)))) + ('item 'item) + ('node-property 'node-property) + ('planning 'property-drawer) + ('table-row 'table-row)))) (defun org-element--parse-elements (beg end mode structure granularity visible-only acc) @@ -5018,8 +5018,8 @@ the cache." lower element upper element))))) (pcase side - (`both (cons lower upper)) - (`nil lower) + ('both (cons lower upper)) + ('nil lower) (_ upper)))) (defun org-element--cache-put (element) @@ -5513,8 +5513,8 @@ that range. See `after-change-functions' for more information." ;; case for headline editing: if a headline is modified but ;; not removed, do not extend. (when (pcase org-element--cache-change-warning - (`t t) - (`headline + ('t t) + ('headline (not (and (org-with-limited-levels (org-at-heading-p)) (= (line-end-position) bottom)))) (_ diff --git a/lisp/org/org-entities.el b/lisp/org/org-entities.el index e291b521f9..0dae849511 100644 --- a/lisp/org/org-entities.el +++ b/lisp/org/org-entities.el @@ -38,7 +38,7 @@ (defun org-entities--user-safe-p (v) "Non-nil if V is a safe value for `org-entities-user'." (pcase v - (`nil t) + ('nil t) (`(,(and (pred stringp) (pred (string-match-p "\\`[a-zA-Z][a-zA-Z0-9]*\\'"))) ,(pred stringp) ,(pred booleanp) ,(pred stringp) diff --git a/lisp/org/org-gnus.el b/lisp/org/org-gnus.el index a53b343efb..34087bf21b 100644 --- a/lisp/org/org-gnus.el +++ b/lisp/org/org-gnus.el @@ -126,14 +126,14 @@ If `org-store-link' was called with a prefix arg the meaning of (defun org-gnus-store-link () "Store a link to a Gnus folder or message." (pcase major-mode - (`gnus-group-mode + ('gnus-group-mode (let ((group (gnus-group-group-name))) (when group (org-store-link-props :type "gnus" :group group) (let ((description (org-gnus-group-link group))) (org-add-link-props :link description :description description) description)))) - ((or `gnus-summary-mode `gnus-article-mode) + ((or 'gnus-summary-mode 'gnus-article-mode) (let* ((group (pcase (gnus-find-method-for-group gnus-newsgroup-name) (`(nnvirtual . ,_) @@ -176,7 +176,7 @@ If `org-store-link' was called with a prefix arg the meaning of (description (org-email-link-description))) (org-add-link-props :link link :description description) link))) - (`message-mode + ('message-mode (setq org-store-link-plist nil) ;reset (save-excursion (save-restriction diff --git a/lisp/org/org-indent.el b/lisp/org/org-indent.el index bf4e998199..a0bf7b7379 100644 --- a/lisp/org/org-indent.el +++ b/lisp/org/org-indent.el @@ -301,8 +301,8 @@ When optional argument HEADING is non-nil, assume line is at a heading. Moreover, if is is `inlinetask', the first star will have `org-warning' face." (let* ((line (aref (pcase heading - (`nil org-indent--text-line-prefixes) - (`inlinetask org-indent--inlinetask-line-prefixes) + ('nil org-indent--text-line-prefixes) + ('inlinetask org-indent--inlinetask-line-prefixes) (_ org-indent--heading-line-prefixes)) level)) (wrap diff --git a/lisp/org/org-info.el b/lisp/org/org-info.el index 6dde36ceba..390db209d3 100644 --- a/lisp/org/org-info.el +++ b/lisp/org/org-info.el @@ -133,12 +133,12 @@ See `org-link-parameters' for details about PATH, DESC and FORMAT." (manual (car parts)) (node (or (nth 1 parts) "Top"))) (pcase format - (`html + ('html (format "%s" (org-info-map-html-url manual) (org-info--expand-node-name node) (or desc path))) - (`texinfo + ('texinfo (let ((title (or desc ""))) (format "@ref{%s,%s,,%s,}" node title manual))) (_ nil)))) diff --git a/lisp/org/org-inlinetask.el b/lisp/org/org-inlinetask.el index 08fc268d0d..8604e28e22 100644 --- a/lisp/org/org-inlinetask.el +++ b/lisp/org/org-inlinetask.el @@ -325,14 +325,14 @@ If the task has an end part, also demote it." "Hide inline tasks in buffer when STATE is `contents' or `children'. This function is meant to be used in `org-cycle-hook'." (pcase state - (`contents + ('contents (let ((regexp (org-inlinetask-outline-regexp))) (save-excursion (goto-char (point-min)) (while (re-search-forward regexp nil t) (org-inlinetask-toggle-visibility) (org-inlinetask-goto-end))))) - (`children + ('children (save-excursion (while (or (org-inlinetask-at-task-p) diff --git a/lisp/org/org-lint.el b/lisp/org/org-lint.el index 9fcb17a2db..e719ef8a5b 100644 --- a/lisp/org/org-lint.el +++ b/lisp/org/org-lint.el @@ -427,7 +427,7 @@ instead" (lambda (datum) (let ((key (org-element-property :key datum))) (pcase (org-element-type datum) - (`keyword + ('keyword (let ((value (org-element-property :value datum))) (and (string= key "PROPERTY") (string-match deprecated-re value) @@ -435,7 +435,7 @@ instead" (format "Deprecated syntax for \"%s\". \ Use header-args instead" (match-string-no-properties 1 value)))))) - (`node-property + ('node-property (and (member-ignore-case key deprecated-babel-properties) (list (org-element-property :begin datum) @@ -789,11 +789,11 @@ Use \"export %s\" instead" (let ((name (org-trim (match-string-no-properties 0))) (element (org-element-at-point))) (pcase (org-element-type element) - ((or `drawer `property-drawer) + ((or 'drawer 'property-drawer) (goto-char (org-element-property :end element)) nil) - ((or `comment-block `example-block `export-block `src-block - `verse-block) + ((or 'comment-block 'example-block 'export-block 'src-block + 'verse-block) nil) (_ (push (list (line-beginning-position) @@ -920,7 +920,7 @@ Use \"export %s\" instead" node-property src-block) (lambda (datum) (pcase (org-element-type datum) - ((or `babel-call `inline-babel-call) + ((or 'babel-call 'inline-babel-call) (funcall verify datum nil @@ -928,13 +928,13 @@ Use \"export %s\" instead" (list (org-element-property :inside-header datum) (org-element-property :end-header datum))))) - (`inline-src-block + ('inline-src-block (funcall verify datum (org-element-property :language datum) (org-babel-parse-header-arguments (org-element-property :parameters datum)))) - (`keyword + ('keyword (when (string= (org-element-property :key datum) "PROPERTY") (let ((value (org-element-property :value datum))) (when (string-match "\\`header-args\\(?::\\(\\S-+\\)\\)?\\+? *" @@ -944,7 +944,7 @@ Use \"export %s\" instead" (match-string 1 value) (org-babel-parse-header-arguments (substring value (match-end 0)))))))) - (`node-property + ('node-property (let ((key (org-element-property :key datum))) (when (let ((case-fold-search t)) (string-match "\\`HEADER-ARGS\\(?::\\(\\S-+\\)\\)?\\+?" @@ -954,7 +954,7 @@ Use \"export %s\" instead" (match-string 1 key) (org-babel-parse-header-arguments (org-element-property :value datum)))))) - (`src-block + ('src-block (funcall verify datum (org-element-property :language datum) @@ -980,13 +980,13 @@ Use \"export %s\" instead" (org-babel-parse-header-arguments (org-trim (pcase type - (`src-block + ('src-block (mapconcat #'identity (cons (org-element-property :parameters datum) (org-element-property :header datum)) " ")) - (`inline-src-block + ('inline-src-block (or (org-element-property :parameters datum) "")) (_ (concat @@ -1065,9 +1065,9 @@ Use \"export %s\" instead" \\{org-lint--report-mode-map}" (setf tabulated-list-format `[("Line" 6 - (lambda (a b) - (< (string-to-number (aref (cadr a) 0)) - (string-to-number (aref (cadr b) 0)))) + ,(lambda (a b) + (< (string-to-number (aref (cadr a) 0)) + (string-to-number (aref (cadr b) 0)))) :right-align t) ("Trust" 5 t) ("Warning" 0 t)]) @@ -1207,8 +1207,8 @@ ARG can also be a list of checker names, as symbols, to run." (message "Org linting process starting...")) (let ((checkers (pcase arg - (`nil org-lint--checkers) - (`(4) + ('nil org-lint--checkers) + ('(4) (let ((category (completing-read "Checker category: " @@ -1218,7 +1218,7 @@ ARG can also be a list of checker names, as symbols, to run." (lambda (c) (assoc-string (org-lint-checker-categories c) category)) org-lint--checkers))) - (`(16) + ('(16) (list (let ((name (completing-read "Checker name: " diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el index 1f51809f1c..b54d4aa2e5 100644 --- a/lisp/org/org-list.el +++ b/lisp/org/org-list.el @@ -3438,15 +3438,15 @@ PARAMS is a plist used to tweak the behavior of the transcoder." (start (and (not splice) (org-list--generic-eval (pcase type - (`ordered ostart) - (`unordered ustart) + ('ordered ostart) + ('unordered ustart) (_ dstart)) depth))) (end (and (not splice) (org-list--generic-eval (pcase type - (`ordered oend) - (`unordered uend) + ('ordered oend) + ('unordered uend) (_ dend)) depth)))) ;; Make sure trailing newlines in END appear in the output by @@ -3485,7 +3485,7 @@ PARAMS is a plist used to tweak the behavior of the transcoder." (separator (and (org-export-get-next-element item info) (org-list--generic-eval isep type depth))) (closing (pcase (org-list--generic-eval iend type depth) - ((or `nil "") "\n") + ((or 'nil "") "\n") ((and (guard separator) s) (if (equal (substring s -1) "\n") s (concat s "\n"))) (s s)))) @@ -3510,9 +3510,9 @@ PARAMS is a plist used to tweak the behavior of the transcoder." (or dtstart dtend ddstart ddend))) (concat (pcase (org-element-property :checkbox item) - (`on cbon) - (`off cboff) - (`trans cbtrans)) + ('on cbon) + ('off cboff) + ('trans cbtrans)) (and tag (concat dtstart (if backend @@ -3582,8 +3582,8 @@ with overruling parameters for `org-list-to-generic'." LIST is as returned by `org-list-to-lisp'. PARAMS is a property list with overruling parameters for `org-list-to-generic'." (let* ((blank (pcase (cdr (assq 'heading org-blank-before-new-entry)) - (`t t) - (`auto (save-excursion + ('t t) + ('auto (save-excursion (org-with-limited-levels (outline-previous-heading)) (org-previous-line-empty-p))))) (level (org-reduced-level (or (org-current-level) 0))) diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el index 5a10b59b1e..74de498e88 100644 --- a/lisp/org/org-mouse.el +++ b/lisp/org/org-mouse.el @@ -416,7 +416,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (let ((kwds org-todo-keywords-1)) (org-mouse-keyword-menu kwds - `(lambda (kwd) (org-todo kwd)) + (lambda (kwd) (org-todo kwd)) (lambda (kwd) (equal state kwd)))))) (defun org-mouse-tag-menu () ;todo @@ -461,11 +461,11 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (defun org-mouse-agenda-type (type) (pcase type - (`tags "Tags: ") - (`todo "TODO: ") - (`tags-tree "Tags tree: ") - (`todo-tree "TODO tree: ") - (`occur-tree "Occur tree: ") + ('tags "Tags: ") + ('todo "TODO: ") + ('tags-tree "Tags tree: ") + ('todo-tree "TODO tree: ") + ('occur-tree "Occur tree: ") (_ "Agenda command ???"))) (defun org-mouse-list-options-menu (alloptions &optional function) diff --git a/lisp/org/org-plot.el b/lisp/org/org-plot.el index ebd7af42a8..38a81f68b1 100644 --- a/lisp/org/org-plot.el +++ b/lisp/org/org-plot.el @@ -200,9 +200,9 @@ manner suitable for prepending to a user-specified script." (y-labels (plist-get params :ylabels)) (plot-str "'%s' using %s%d%s with %s title '%s'") (plot-cmd (pcase type - (`2d "plot") - (`3d "splot") - (`grid "splot"))) + ('2d "plot") + ('3d "splot") + ('grid "splot"))) (script "reset") ;; ats = add-to-script (ats (lambda (line) (setf script (concat script "\n" line)))) @@ -211,9 +211,9 @@ manner suitable for prepending to a user-specified script." (funcall ats (format "set term %s" (file-name-extension file))) (funcall ats (format "set output '%s'" file))) (pcase type ; type - (`2d ()) - (`3d (when map (funcall ats "set map"))) - (`grid (funcall ats (if map "set pm3d map" "set pm3d")))) + ('2d ()) + ('3d (when map (funcall ats "set map"))) + ('grid (funcall ats (if map "set pm3d map" "set pm3d")))) (when title (funcall ats (format "set title '%s'" title))) ; title (mapc ats lines) ; line (dolist (el sets) (funcall ats (format "set %s" el))) ; set @@ -239,7 +239,7 @@ manner suitable for prepending to a user-specified script." "%Y-%m-%d-%H:%M:%S") "\""))) (unless preface (pcase type ; plot command - (`2d (dotimes (col num-cols) + ('2d (dotimes (col num-cols) (unless (and (eq type '2d) (or (and ind (equal (1+ col) ind)) (and deps (not (member (1+ col) deps))))) @@ -255,10 +255,10 @@ manner suitable for prepending to a user-specified script." (or (nth col col-labels) (format "%d" (1+ col)))) plot-lines))))) - (`3d + ('3d (setq plot-lines (list (format "'%s' matrix with %s title ''" data-file with)))) - (`grid + ('grid (setq plot-lines (list (format "'%s' with %s title ''" data-file with))))) (funcall ats @@ -303,9 +303,9 @@ line directly before or after the table." (setf params (org-plot/collect-options params)))) ;; Dump table to datafile (very different for grid). (pcase (plist-get params :plot-type) - (`2d (org-plot/gnuplot-to-data table data-file params)) - (`3d (org-plot/gnuplot-to-data table data-file params)) - (`grid (let ((y-labels (org-plot/gnuplot-to-grid-data + ('2d (org-plot/gnuplot-to-data table data-file params)) + ('3d (org-plot/gnuplot-to-data table data-file params)) + ('grid (let ((y-labels (org-plot/gnuplot-to-grid-data table data-file params))) (when y-labels (plist-put params :ylabels y-labels))))) ;; Check for timestamp ind column. diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el index 829354c0d5..cf746a48bc 100644 --- a/lisp/org/org-src.el +++ b/lisp/org/org-src.el @@ -742,24 +742,24 @@ If BUFFER is non-nil, test it instead." (defun org-src-switch-to-buffer (buffer context) (pcase org-src-window-setup - (`current-window (pop-to-buffer-same-window buffer)) - (`other-window + ('current-window (pop-to-buffer-same-window buffer)) + ('other-window (switch-to-buffer-other-window buffer)) - (`other-frame + ('other-frame (pcase context - (`exit + ('exit (let ((frame (selected-frame))) (switch-to-buffer-other-frame buffer) (delete-frame frame))) - (`save + ('save (kill-buffer (current-buffer)) (pop-to-buffer-same-window buffer)) (_ (switch-to-buffer-other-frame buffer)))) - (`reorganize-frame + ('reorganize-frame (when (eq context 'edit) (delete-other-windows)) (org-switch-to-buffer-other-window buffer) (when (eq context 'exit) (delete-other-windows))) - (`switch-invisibly (set-buffer buffer)) + ('switch-invisibly (set-buffer buffer)) (_ (message "Invalid value %s for `org-src-window-setup'" org-src-window-setup) diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index dcf7430363..f8559d04ef 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -5127,7 +5127,7 @@ information." ;; Make sure that contents are exported as Org data when :raw ;; parameter is non-nil. ,(when (and backend (plist-get params :raw)) - `(setq contents + '(setq contents ;; Since we don't know what are the pseudo object ;; types defined in backend, we cannot pass them to ;; `org-element-interpret-data'. As a consequence, diff --git a/lisp/org/org.el b/lisp/org/org.el index 873ae6b820..4ead31b499 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -5236,12 +5236,12 @@ When optional argument SKIP-KEY is non-nil, skip selection keys next to tags." (mapconcat (lambda (token) (pcase token - (`(:startgroup) "{") - (`(:endgroup) "}") - (`(:startgrouptag) "[") - (`(:endgrouptag) "]") - (`(:grouptags) ":") - (`(:newline) "\\n") + ('(:startgroup) "{") + ('(:endgroup) "}") + ('(:startgrouptag) "[") + ('(:endgrouptag) "]") + ('(:grouptags) ":") + ('(:newline) "\\n") ((and (guard (not skip-key)) `(,(and tag (pred stringp)) . ,(and key (pred characterp)))) @@ -5266,7 +5266,7 @@ a string, summarizing TAGS, as a list of strings." (when (eq group-status 'append) (push (nreverse current-group) groups)) (setq group-status nil current-group nil)) - (`(:grouptags) (setq group-status 'append)) + ('(:grouptags) (setq group-status 'append)) ((and `(,tag . ,_) (guard group-status)) (if (eq group-status 'append) (push tag current-group) (setq current-group (list tag)))) @@ -7744,7 +7744,7 @@ When NEXT is non-nil, check the next line instead." When optional argument PARENT is non-nil, consider parent headline instead of current one." (pcase (assq 'heading org-blank-before-new-entry) - (`(heading . auto) + ('(heading . auto) (save-excursion (org-with-limited-levels (unless (and (org-before-first-heading-p) @@ -7884,7 +7884,7 @@ When NO-COMMENT is non-nil, don't include COMMENT string." (let ((todo (and (not no-todo) (match-string 2))) (priority (and (not no-priority) (match-string 3))) (headline (pcase (match-string 4) - (`nil "") + ('nil "") ((and (guard no-comment) h) (replace-regexp-in-string (eval-when-compile @@ -8768,7 +8768,7 @@ with the original repeater." (template (buffer-substring beg end)) (shift-n (and doshift (string-to-number (match-string 1 shift)))) (shift-what (pcase (and doshift (match-string 2 shift)) - (`nil nil) + ('nil nil) ("d" 'day) ("w" (setq shift-n (* 7 shift-n)) 'day) ("m" 'month) @@ -9690,7 +9690,7 @@ active region." (push (cons f (copy-sequence org-store-link-plist)) results-alist))) (pcase results-alist - (`nil nil) + ('nil nil) (`((,_ . ,_)) t) ;single choice: nothing to do (`((,name . ,_) . ,_) ;; Reinstate link plist associated to the chosen @@ -11552,13 +11552,13 @@ order.") #'identity (append (pcase org-refile-use-outline-path - (`file (list (file-name-nondirectory + ('file (list (file-name-nondirectory (buffer-file-name (buffer-base-buffer))))) - (`full-file-path + ('full-file-path (list (buffer-file-name (buffer-base-buffer)))) - (`buffer-name + ('buffer-name (list (buffer-name (buffer-base-buffer)))) (_ nil)) @@ -13251,14 +13251,14 @@ TYPE is either `deadline' or `scheduled'. See `org-deadline' or old-date) (match-string 1 old-date))))) (pcase arg - (`(4) + ('(4) (when (and old-date log) (org-add-log-setup (if deadline? 'deldeadline 'delschedule) nil old-date log)) (org-remove-timestamp-with-keyword keyword) (message (if deadline? "Item no longer has a deadline." "Item is no longer scheduled."))) - (`(16) + ('(16) (save-excursion (org-back-to-heading t) (let ((regexp (if deadline? org-deadline-time-regexp @@ -14779,8 +14779,8 @@ If ONOFF is `on' or `off', don't toggle but set to this state." (nreverse (org-split-string tags ":"))))) res) (pcase onoff - (`off (setq current (delete tag current))) - ((or `on (guard (not (member tag current)))) + ('off (setq current (delete tag current))) + ((or 'on (guard (not (member tag current)))) (setq res t) (cl-pushnew tag current :test #'equal)) (_ (setq current (delete tag current)))) @@ -14830,7 +14830,7 @@ If DATA is nil or the empty string, all tags are removed." (interactive "sTags: ") (let ((data (pcase (if (stringp data) (org-trim data) data) - ((or `nil "") nil) + ((or 'nil "") nil) ((pred listp) (format ":%s:" (mapconcat #'identity data ":"))) ((pred stringp) (format ":%s:" @@ -17207,9 +17207,9 @@ The internal representation needed by the calendar is (month day year). This is a wrapper to handle the brain-dead convention in calendar that user function argument order change dependent on argument order." (pcase calendar-date-style - (`american (list arg1 arg2 arg3)) - (`european (list arg2 arg1 arg3)) - (`iso (list arg2 arg3 arg1)))) + ('american (list arg1 arg2 arg3)) + ('european (list arg2 arg1 arg3)) + ('iso (list arg2 arg3 arg1)))) (defun org-eval-in-calendar (form &optional keepdate) "Eval FORM in the calendar window and return to current window. @@ -18015,14 +18015,14 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." (pcase origin-cat ;; `day' category ends before `hour' if any, or at the end ;; of the day name. - (`day (min (or (match-beginning 7) (1- (match-end 5))) origin)) - (`hour (min (match-end 7) origin)) - (`minute (min (1- (match-end 8)) origin)) + ('day (min (or (match-beginning 7) (1- (match-end 5))) origin)) + ('hour (min (match-end 7) origin)) + ('minute (min (1- (match-end 8)) origin)) ((pred integerp) (min (1- (match-end 0)) origin)) ;; Point was right after the time-stamp. However, the ;; time-stamp length might have changed, so refer to ;; (match-end 0) instead. - (`after (match-end 0)) + ('after (match-end 0)) ;; `year' and `month' have both fixed size: point couldn't ;; have moved into another part. (_ origin)))) @@ -20709,7 +20709,7 @@ Otherwise, return a user error." (let ((element (org-element-at-point))) (barf-if-buffer-read-only) (pcase (org-element-type element) - (`src-block + ('src-block (if (not arg) (org-edit-src-code) (let* ((info (org-babel-get-src-block-info)) (lang (nth 0 info)) @@ -20722,7 +20722,7 @@ Otherwise, return a user error." (switch-to-buffer (funcall (intern (concat "org-babel-prep-session:" lang)) session params)))))) - (`keyword + ('keyword (if (member (org-element-property :key element) '("INCLUDE" "SETUPFILE")) (org-open-link-from-string (format "[[%s]]" @@ -20738,24 +20738,24 @@ Otherwise, return a user error." (match-string 0 value)) (t (user-error "No valid file specified"))))))) (user-error "No special environment to edit here"))) - (`table + ('table (if (eq (org-element-property :type element) 'table.el) (org-edit-table.el) (call-interactively 'org-table-edit-formulas))) ;; Only Org tables contain `table-row' type elements. - (`table-row (call-interactively 'org-table-edit-formulas)) - (`example-block (org-edit-src-code)) - (`export-block (org-edit-export-block)) - (`fixed-width (org-edit-fixed-width-region)) - (`latex-environment (org-edit-latex-environment)) + ('table-row (call-interactively 'org-table-edit-formulas)) + ('example-block (org-edit-src-code)) + ('export-block (org-edit-export-block)) + ('fixed-width (org-edit-fixed-width-region)) + ('latex-environment (org-edit-latex-environment)) (_ ;; No notable element at point. Though, we may be at a link or ;; a footnote reference, which are objects. Thus, scan deeper. (let ((context (org-element-context element))) (pcase (org-element-type context) - (`footnote-reference (org-edit-footnote-reference)) - (`inline-src-block (org-edit-inline-src-code)) - (`link (call-interactively #'ffap)) + ('footnote-reference (org-edit-footnote-reference)) + ('inline-src-block (org-edit-inline-src-code)) + ('link (call-interactively #'ffap)) (_ (user-error "No special environment to edit here")))))))) (defvar org-table-coordinate-overlays) ; defined in org-table.el @@ -20842,7 +20842,7 @@ This command does many different things, depending on context: ;; a src block. Hence, we first check if point is in such ;; a block and then if it is at a blank line. (pcase type - ((or `inline-src-block `src-block) + ((or 'inline-src-block 'src-block) (unless org-babel-no-eval-on-ctrl-c-ctrl-c (org-babel-eval-wipe-error-buffer) (org-babel-execute-src-block @@ -20852,22 +20852,22 @@ This command does many different things, depending on context: (user-error (substitute-command-keys "`\\[org-ctrl-c-ctrl-c]' can do nothing useful here")))) - ((or `babel-call `inline-babel-call) + ((or 'babel-call 'inline-babel-call) (let ((info (org-babel-lob-get-info context))) (when info (org-babel-execute-src-block nil info)))) - (`clock (org-clock-update-time-maybe)) - (`dynamic-block + ('clock (org-clock-update-time-maybe)) + ('dynamic-block (save-excursion (goto-char (org-element-property :post-affiliated context)) (org-update-dblock))) - (`footnote-definition + ('footnote-definition (goto-char (org-element-property :post-affiliated context)) (call-interactively 'org-footnote-action)) - (`footnote-reference (call-interactively #'org-footnote-action)) - ((or `headline `inlinetask) + ('footnote-reference (call-interactively #'org-footnote-action)) + ((or 'headline 'inlinetask) (save-excursion (goto-char (org-element-property :begin context)) (call-interactively #'org-set-tags))) - (`item + ('item ;; At an item: `C-u C-u' sets checkbox to "[-]" ;; unconditionally, whereas `C-u' will toggle its presence. ;; Without a universal argument, if the item has a checkbox, @@ -20905,7 +20905,7 @@ This command does many different things, depending on context: (when block-item (message "Checkboxes were removed due to empty box at line %d" (org-current-line block-item)))))) - (`keyword + ('keyword (let ((org-inhibit-startup-visibility-stuff t) (org-startup-align-all-tables nil)) (when (boundp 'org-table-coordinate-overlays) @@ -20913,7 +20913,7 @@ This command does many different things, depending on context: (setq org-table-coordinate-overlays nil)) (org-save-outline-visibility 'use-markers (org-mode-restart))) (message "Local setup has been refreshed")) - (`plain-list + ('plain-list ;; At a plain list, with a double C-u argument, set ;; checkboxes of each item to "[-]", whereas a single one ;; will toggle their presence according to the state of the @@ -20946,13 +20946,13 @@ This command does many different things, depending on context: struct (org-list-parents-alist struct) old-struct) (org-update-checkbox-count-maybe) (save-excursion (goto-char beginm) (org-list-send-list 'maybe)))) - ((or `property-drawer `node-property) + ((or 'property-drawer 'node-property) (call-interactively #'org-property-action)) - (`radio-target + ('radio-target (call-interactively #'org-update-radio-target-regexp)) - (`statistics-cookie + ('statistics-cookie (call-interactively #'org-update-statistics-cookies)) - ((or `table `table-cell `table-row) + ((or 'table 'table-cell 'table-row) ;; At a table, recalculate every field and align it. Also ;; send the table if necessary. If the table has ;; a `table.el' type, just give up. At a table row or cell, @@ -20975,9 +20975,9 @@ Use `\\[org-edit-special]' to edit table.el tables")) (cond (arg (call-interactively #'org-table-recalculate)) ((org-table-maybe-recalculate-line)) (t (org-table-align)))))) - ((or `timestamp (and `planning (guard (org-at-timestamp-p 'lax)))) + ((or 'timestamp (and 'planning (guard (org-at-timestamp-p 'lax)))) (org-timestamp-change 0 'day)) - ((and `nil (guard (org-at-heading-p))) + ((and 'nil (guard (org-at-heading-p))) ;; When point is on an unsupported object type, we can miss ;; the fact that it also is at a heading. Handle it here. (call-interactively #'org-set-tags)) diff --git a/lisp/org/ox-ascii.el b/lisp/org/ox-ascii.el index c3ccb596aa..5b9db49715 100644 --- a/lisp/org/ox-ascii.el +++ b/lisp/org/ox-ascii.el @@ -549,8 +549,8 @@ INFO is a plist used as a communication channel." INFO is a plist used as a communication channel." (pcase (org-element-type element) ;; Elements with an absolute width: `headline' and `inlinetask'. - (`inlinetask (plist-get info :ascii-inlinetask-width)) - (`headline + ('inlinetask (plist-get info :ascii-inlinetask-width)) + ('headline (- (plist-get info :ascii-text-width) (let ((low-level-rank (org-export-low-level-p element info))) (if low-level-rank (* low-level-rank 2) @@ -624,8 +624,8 @@ Return value is a symbol among `left', `center', `right' and (while (and (not justification) (setq element (org-element-property :parent element))) (pcase (org-element-type element) - (`center-block (setq justification 'center)) - (`special-block + ('center-block (setq justification 'center)) + ('special-block (let ((name (org-element-property :type element))) (cond ((string= name "JUSTIFYRIGHT") (setq justification 'right)) ((string= name "JUSTIFYLEFT") (setq justification 'left))))))) @@ -724,8 +724,8 @@ caption keyword." element info nil 'org-ascii--has-caption-p)) (title-fmt (org-ascii--translate (pcase (org-element-type element) - (`table "Table %d:") - (`src-block "Listing %d:")) + ('table "Table %d:") + ('src-block "Listing %d:")) info))) (org-ascii--fill-string (concat (format title-fmt reference) @@ -890,8 +890,8 @@ If DATUM is a string, consider it to be a file name, per `org-export-resolve-id-link'. INFO is the communication channel, as a plist." (pcase (org-element-type datum) - (`plain-text (format "See file %s" datum)) ;External file - (`headline + ('plain-text (format "See file %s" datum)) ;External file + ('headline (format (org-ascii--translate "See section %s" info) (if (org-export-numbered-headline-p datum info) (mapconcat #'number-to-string @@ -907,7 +907,7 @@ as a plist." (org-element-lineage datum '(headline paragraph src-block table) t))) (pcase (org-element-type enumerable) - (`headline + ('headline (format (org-ascii--translate "See section %s" info) (if (org-export-numbered-headline-p enumerable info) (mapconcat #'number-to-string number ".") @@ -915,11 +915,11 @@ as a plist." (org-element-property :title enumerable) info)))) ((guard (not number)) (org-ascii--translate "Unknown reference" info)) - (`paragraph + ('paragraph (format (org-ascii--translate "See figure %s" info) number)) - (`src-block + ('src-block (format (org-ascii--translate "See listing %s" info) number)) - (`table + ('table (format (org-ascii--translate "See table %s" info) number)) (_ (org-ascii--translate "Unknown reference" info))))))) @@ -970,9 +970,9 @@ channel." INFO is a plist used as a communication channel." (let ((utf8p (eq (plist-get info :ascii-charset) 'utf-8))) (pcase (org-element-property :checkbox item) - (`on (if utf8p "â‘ " "[X] ")) - (`off (if utf8p "â " "[ ] ")) - (`trans (if utf8p "â’ " "[-] "))))) + ('on (if utf8p "â‘ " "[X] ")) + ('off (if utf8p "â " "[ ] ")) + ('trans (if utf8p "â’ " "[-] "))))) @@ -1450,11 +1450,11 @@ contextual information." ;; First parent of ITEM is always the plain-list. Get ;; `:type' property from it. (pcase list-type - (`descriptive + ('descriptive (concat checkbox (org-export-data (org-element-property :tag item) info))) - (`ordered + ('ordered ;; Return correct number for ITEM, paying attention to ;; counters. (let* ((struct (org-element-property :structure item)) @@ -1586,8 +1586,8 @@ INFO is a plist holding contextual information." (format " (%s)" (org-ascii--describe-datum destination info))))) ;; External file. - (`plain-text destination) - (`headline + ('plain-text destination) + ('headline (if (org-export-numbered-headline-p destination info) (mapconcat #'number-to-string (org-export-get-headline-number destination info) diff --git a/lisp/org/ox-html.el b/lisp/org/ox-html.el index 6166a4ad01..dd61ad926c 100644 --- a/lisp/org/ox-html.el +++ b/lisp/org/ox-html.el @@ -624,12 +624,12 @@ export back-end currently used." (match-string 1 options) default))) (pcase opt - (`path (setq template + ('path (setq template (replace-regexp-in-string "%SCRIPT_PATH" val template t t))) - (`sdepth (when (integerp (read val)) + ('sdepth (when (integerp (read val)) (setq sdepth (min (read val) sdepth)))) - (`tdepth (when (integerp (read val)) + ('tdepth (when (integerp (read val)) (setq tdepth (min (read val) tdepth)))) (_ (setq val (cond @@ -2739,19 +2739,19 @@ INFO is a plist holding contextual information. See (extra-newline (if (and (org-string-nw-p contents) headline) "\n" ""))) (concat (pcase type - (`ordered + ('ordered (let* ((counter term-counter-id) (extra (if counter (format " value=\"%s\"" counter) ""))) (concat (format "" class extra) (when headline (concat headline br))))) - (`unordered + ('unordered (let* ((id term-counter-id) (extra (if id (format " id=\"%s\"" id) ""))) (concat (format "" class extra) (when headline (concat headline br))))) - (`descriptive + ('descriptive (let* ((term term-counter-id)) (setq term (or term "(no term)")) ;; Check-boxes in descriptive lists are associated to tag. @@ -2763,9 +2763,9 @@ INFO is a plist holding contextual information. See (and (org-string-nw-p contents) (org-trim contents)) extra-newline (pcase type - (`ordered "") - (`unordered "") - (`descriptive ""))))) + ('ordered "") + ('unordered "") + ('descriptive ""))))) (defun org-html-item (item contents info) "Transcode an ITEM element from Org to HTML. @@ -2902,8 +2902,8 @@ if its description is a single link targeting an image file." (cons 'plain-text org-element-all-objects) (lambda (obj) (pcase (org-element-type obj) - (`plain-text (org-string-nw-p obj)) - (`link (if (= link-count 1) t + ('plain-text (org-string-nw-p obj)) + ('link (if (= link-count 1) t (cl-incf link-count) (not (org-export-inline-image-p obj (plist-get info :html-inline-image-rules))))) @@ -2930,8 +2930,8 @@ images, set it to: (lambda (paragraph) (org-element-property :caption paragraph))" (let ((paragraph (pcase (org-element-type element) - (`paragraph element) - (`link (org-export-get-parent element))))) + ('paragraph element) + ('link (org-export-get-parent element))))) (and (eq (org-element-type paragraph) 'paragraph) (or (not (fboundp 'org-html-standalone-image-predicate)) (funcall org-html-standalone-image-predicate paragraph)) @@ -2941,8 +2941,8 @@ images, set it to: (cons 'plain-text org-element-all-objects) (lambda (obj) (when (pcase (org-element-type obj) - (`plain-text (org-string-nw-p obj)) - (`link (or (> (cl-incf link-count) 1) + ('plain-text (org-string-nw-p obj)) + ('link (or (> (cl-incf link-count) 1) (not (org-html-inline-image-p obj info)))) (_ t)) (throw 'exit nil))) @@ -3046,7 +3046,7 @@ INFO is a plist holding contextual information. See (org-export-resolve-id-link link info)))) (pcase (org-element-type destination) ;; ID link points to an external file. - (`plain-text + ('plain-text (let ((fragment (concat "ID-" path)) ;; Treat links to ".org" files as ".html", if needed. (path (funcall link-org-files-as-html-maybe @@ -3054,13 +3054,13 @@ INFO is a plist holding contextual information. See (format "%s" path fragment attributes (or desc destination)))) ;; Fuzzy link points nowhere. - (`nil + ('nil (format "%s" (or desc (org-export-data (org-element-property :raw-link link) info)))) ;; Link points to a headline. - (`headline + ('headline (let ((href (or (org-element-property :CUSTOM_ID destination) (org-export-get-reference destination info))) ;; What description to use? @@ -3189,9 +3189,9 @@ the plist used as a communication channel." CONTENTS is the contents of the list. INFO is a plist holding contextual information." (let* ((type (pcase (org-element-property :type plain-list) - (`ordered "ol") - (`unordered "ul") - (`descriptive "dl") + ('ordered "ol") + ('unordered "ul") + ('descriptive "dl") (other (error "Unknown HTML list type: %s" other)))) (class (format "org-%s" type)) (attributes (org-export-read-attribute :attr_html plain-list))) diff --git a/lisp/org/ox-latex.el b/lisp/org/ox-latex.el index 5aaaf991fd..332e42b7b9 100644 --- a/lisp/org/ox-latex.el +++ b/lisp/org/ox-latex.el @@ -2434,7 +2434,7 @@ used as a communication channel." nil t)))) ;; Return proper string, depending on FLOAT. (pcase float - (`wrap (format "\\begin{wrapfigure}%s + ('wrap (format "\\begin{wrapfigure}%s %s%s %s%s %s\\end{wrapfigure}" @@ -2443,7 +2443,7 @@ used as a communication channel." (if center "\\centering" "") comment-include image-code (if caption-above-p "" caption))) - (`sideways (format "\\begin{sidewaysfigure} + ('sideways (format "\\begin{sidewaysfigure} %s%s %s%s %s\\end{sidewaysfigure}" @@ -2451,7 +2451,7 @@ used as a communication channel." (if center "\\centering" "") comment-include image-code (if caption-above-p "" caption))) - (`multicolumn (format "\\begin{figure*}%s + ('multicolumn (format "\\begin{figure*}%s %s%s %s%s %s\\end{figure*}" @@ -2460,7 +2460,7 @@ used as a communication channel." (if center "\\centering" "") comment-include image-code (if caption-above-p "" caption))) - (`figure (format "\\begin{figure}%s + ('figure (format "\\begin{figure}%s %s%s %s%s %s\\end{figure}" @@ -2767,12 +2767,12 @@ containing export options. Modify DATA by side-effect and return it." ;; Non-nil when OBJ can be added to the latex math block B. (lambda (obj b) (pcase (org-element-type obj) - (`entity (org-element-property :latex-math-p obj)) - (`latex-fragment + ('entity (org-element-property :latex-math-p obj)) + ('latex-fragment (let ((value (org-element-property :value obj))) (or (string-prefix-p "\\(" value) (string-match-p "\\`\\$[^$]" value)))) - ((and type (or `subscript `superscript)) + ((and type (or 'subscript 'superscript)) (not (memq type (mapcar #'org-element-type (org-element-contents b))))))))) (org-element-map data '(entity latex-fragment subscript superscript) diff --git a/lisp/org/ox-man.el b/lisp/org/ox-man.el index 2bc6392dab..aae9c5838e 100644 --- a/lisp/org/ox-man.el +++ b/lisp/org/ox-man.el @@ -552,9 +552,9 @@ contextual information." (let* ((bullet (org-element-property :bullet item)) (type (org-element-property :type (org-element-property :parent item))) (checkbox (pcase (org-element-property :checkbox item) - (`on "\\o'\\(sq\\(mu'") - (`off "\\(sq ") - (`trans "\\o'\\(sq\\(mi'"))) + ('on "\\o'\\(sq\\(mu'") + ('off "\\(sq ") + ('trans "\\o'\\(sq\\(mi'"))) (tag (let ((tag (org-element-property :tag item))) ;; Check-boxes must belong to the tag. @@ -861,7 +861,7 @@ a communication channel." (push "|" alignment)) (push (concat (pcase (org-export-table-cell-alignment cell info) - (`left "l") (`right "r") (`center "c")) + ('left "l") ('right "r") ('center "c")) width divider) alignment) diff --git a/lisp/org/ox-md.el b/lisp/org/ox-md.el index c4da8fcb14..a34b955dac 100644 --- a/lisp/org/ox-md.el +++ b/lisp/org/ox-md.el @@ -339,9 +339,9 @@ a communication channel." (concat bullet (make-string (- 4 (length bullet)) ? ) (pcase (org-element-property :checkbox item) - (`on "[X] ") - (`trans "[-] ") - (`off "[ ] ")) + ('on "[X] ") + ('trans "[-] ") + ('off "[ ] ")) (let ((tag (org-element-property :tag item))) (and tag (format "**%s:** "(org-export-data tag info)))) (and contents @@ -400,11 +400,11 @@ a communication channel." (org-export-resolve-fuzzy-link link info) (org-export-resolve-id-link link info)))) (pcase (org-element-type destination) - (`plain-text ; External file. + ('plain-text ; External file. (let ((path (funcall link-org-files-as-md destination))) (if (not contents) (format "<%s>" path) (format "[%s](%s)" contents path)))) - (`headline + ('headline (format "[%s](#%s)" ;; Description. diff --git a/lisp/org/ox-org.el b/lisp/org/ox-org.el index 1b5a7cc0c2..b673d49899 100644 --- a/lisp/org/ox-org.el +++ b/lisp/org/ox-org.el @@ -124,8 +124,8 @@ we make sure it is always called." (let ((first-child (car (org-element-contents h))) (new-section (org-element-create 'section))) (pcase (org-element-type first-child) - (`section nil) - (`nil (org-element-adopt-elements h new-section)) + ('section nil) + ('nil (org-element-adopt-elements h new-section)) (_ (org-element-insert-before new-section first-child)))))) tree) diff --git a/lisp/org/ox-publish.el b/lisp/org/ox-publish.el index 80ef239b67..ff6723f407 100644 --- a/lisp/org/ox-publish.el +++ b/lisp/org/ox-publish.el @@ -618,7 +618,7 @@ files, when entire projects are published (see (project-plist (cdr project)) (publishing-function (pcase (org-publish-property :publishing-function project) - (`nil (user-error "No publishing function chosen")) + ('nil (user-error "No publishing function chosen")) ((and f (pred listp)) f) (f (list f)))) (base-dir @@ -703,7 +703,7 @@ return a string. Return value is a list as returned by (file-name-as-directory (org-publish-property :base-directory project))))) (pcase style - (`list + ('list (cons 'unordered (mapcar (lambda (f) @@ -712,7 +712,7 @@ return a string. Return value is a list as returned by style project))) files))) - (`tree + ('tree (letrec ((files-only (cl-remove-if #'directory-name-p files)) (directories (cl-remove-if-not #'directory-name-p files)) (subtree-to-list @@ -778,7 +778,7 @@ Default for SITEMAP-FILENAME is `sitemap.org'." (let ((retval t)) ;; First we sort files: (pcase sort-files - (`alphabetically + ('alphabetically (let ((A (if (funcall org-file-p a) (concat (file-name-directory a) (org-publish-find-title a project)) @@ -791,7 +791,7 @@ Default for SITEMAP-FILENAME is `sitemap.org'." (if ignore-case (not (string-lessp (upcase B) (upcase A))) (not (string-lessp B A)))))) - ((or `anti-chronologically `chronologically) + ((or 'anti-chronologically 'chronologically) (let* ((adate (org-publish-find-date a project)) (bdate (org-publish-find-date b project)) (A (+ (ash (car adate) 16) (cadr adate))) @@ -800,7 +800,7 @@ Default for SITEMAP-FILENAME is `sitemap.org'." (if (eq sort-files 'chronologically) (<= A B) (>= A B))))) - (`nil nil) + ('nil nil) (_ (user-error "Invalid sort value %s" sort-files))) ;; Directory-wise wins: (when (memq sort-folders '(first last)) @@ -1104,9 +1104,9 @@ publishing directory." "[[%s][%s]]" ;; Destination. (pcase (car target) - (`nil (format "file:%s" file)) - (`id (format "id:%s" (cdr target))) - (`custom-id (format "file:%s::#%s" file (cdr target))) + ('nil (format "file:%s" file)) + ('id (format "id:%s" (cdr target))) + ('custom-id (format "file:%s::#%s" file (cdr target))) (_ (format "file:%s::*%s" file (cdr target)))) ;; Description. (car (last entry))))) diff --git a/lisp/org/ox-texinfo.el b/lisp/org/ox-texinfo.el index d877c9c63a..624d13aa06 100644 --- a/lisp/org/ox-texinfo.el +++ b/lisp/org/ox-texinfo.el @@ -452,10 +452,10 @@ This is used to choose a separator for constructs like \\verb." INFO is a plist used as a communication channel. See `org-texinfo-text-markup-alist' for details." (pcase (cdr (assq markup org-texinfo-text-markup-alist)) - (`nil text) ;no markup: return raw text - (`code (format "@code{%s}" (org-texinfo--sanitize-content text))) - (`samp (format "@samp{%s}" (org-texinfo--sanitize-content text))) - (`verb + ('nil text) ;no markup: return raw text + ('code (format "@code{%s}" (org-texinfo--sanitize-content text))) + ('samp (format "@samp{%s}" (org-texinfo--sanitize-content text))) + ('verb (let ((separator (org-texinfo--find-verb-separator text))) (format "@verb{%s%s%s}" separator text separator))) ;; Else use format string. @@ -872,7 +872,7 @@ contextual information." unnumbered) ((org-export-numbered-headline-p headline info) numbered) (t unnumbered))) - (`nil 'plain-list) + ('nil 'plain-list) (_ (user-error "Invalid Texinfo class specification: %S" class)))) (_ (user-error "Invalid Texinfo class specification: %S" class))))))) @@ -993,7 +993,7 @@ contextual information." (list tag)))))) (format "%s\n%s" (pcase items - (`nil "@item") + ('nil "@item") (`(,item) (concat "@item " item)) (`(,item . ,items) (concat "@item " item "\n" @@ -1077,18 +1077,18 @@ INFO is a plist holding contextual information. See (org-export-resolve-fuzzy-link link info) (org-export-resolve-id-link link info)))) (pcase (org-element-type destination) - (`nil + ('nil (format org-texinfo-link-with-unknown-path-format (org-texinfo--sanitize-content path))) ;; Id link points to an external file. - (`plain-text + ('plain-text (if desc (format "@uref{file://%s,%s}" destination desc) (format "@uref{file://%s}" destination))) - ((or `headline + ((or 'headline ;; Targets within headlines cannot be turned into ;; @anchor{}, so we refer to the headline parent ;; directly. - (and `target + (and 'target (guard (eq 'headline (org-element-type (org-element-property :parent destination)))))) @@ -1547,9 +1547,9 @@ information." (let ((value (org-texinfo-plain-text (org-timestamp-translate timestamp) info))) (pcase (org-element-property :type timestamp) - ((or `active `active-range) + ((or 'active 'active-range) (format (plist-get info :texinfo-active-timestamp-format) value)) - ((or `inactive `inactive-range) + ((or 'inactive 'inactive-range) (format (plist-get info :texinfo-inactive-timestamp-format) value)) (_ (format (plist-get info :texinfo-diary-timestamp-format) value))))) diff --git a/lisp/org/ox.el b/lisp/org/ox.el index ea7d1dc81f..91637dd635 100644 --- a/lisp/org/ox.el +++ b/lisp/org/ox.el @@ -1954,8 +1954,8 @@ Return a string." (progn ,@body) (org-link-broken (pcase (plist-get info :with-broken-links) - (`nil (user-error "Unable to resolve link: %S" (nth 1 err))) - (`mark (org-export-data + ('nil (user-error "Unable to resolve link: %S" (nth 1 err))) + ('mark (org-export-data (format "[BROKEN LINK: %s]" (nth 1 err)) info)) (_ nil)))))) (let* ((type (org-element-type data)) @@ -4278,7 +4278,7 @@ A search cell follows the pattern (TYPE . SEARCH) where A search cell is the internal representation of a fuzzy link. It ignores white spaces and statistics cookies, if applicable." (pcase (org-element-type datum) - (`headline + ('headline (let ((title (split-string (replace-regexp-in-string "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]" "" @@ -4289,7 +4289,7 @@ ignores white spaces and statistics cookies, if applicable." (cons 'other title) (let ((custom-id (org-element-property :custom-id datum))) (and custom-id (cons 'custom-id custom-id))))))) - (`target + ('target (list (cons 'target (split-string (org-element-property :value datum))))) ((and (let name (org-element-property :name datum)) (guard name)) diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el index a54682fff2..6379c708be 100644 --- a/lisp/play/bubbles.el +++ b/lisp/play/bubbles.el @@ -712,57 +712,57 @@ static char * dot3d_xpm[] = { (defsubst bubbles--grid-width () "Return the grid width for the current game theme." (car (pcase bubbles-game-theme - (`easy + ('easy bubbles--grid-small) - (`medium + ('medium bubbles--grid-medium) - (`difficult + ('difficult bubbles--grid-large) - (`hard + ('hard bubbles--grid-huge) - (`user-defined + ('user-defined bubbles-grid-size)))) (defsubst bubbles--grid-height () "Return the grid height for the current game theme." (cdr (pcase bubbles-game-theme - (`easy + ('easy bubbles--grid-small) - (`medium + ('medium bubbles--grid-medium) - (`difficult + ('difficult bubbles--grid-large) - (`hard + ('hard bubbles--grid-huge) - (`user-defined + ('user-defined bubbles-grid-size)))) (defsubst bubbles--colors () "Return the color list for the current game theme." (pcase bubbles-game-theme - (`easy + ('easy bubbles--colors-2) - (`medium + ('medium bubbles--colors-3) - (`difficult + ('difficult bubbles--colors-4) - (`hard + ('hard bubbles--colors-5) - (`user-defined + ('user-defined bubbles-colors))) (defsubst bubbles--shift-mode () "Return the shift mode for the current game theme." (pcase bubbles-game-theme - (`easy + ('easy 'default) - (`medium + ('medium 'default) - (`difficult + ('difficult 'always) - (`hard + ('hard 'always) - (`user-defined + ('user-defined bubbles-shift-mode))) (defun bubbles-save-settings () @@ -1328,11 +1328,11 @@ Return t if new char is non-empty." (when (and (display-images-p) (not (eq bubbles-graphics-theme 'ascii))) (let ((template (pcase bubbles-graphics-theme - (`circles bubbles--image-template-circle) - (`balls bubbles--image-template-ball) - (`squares bubbles--image-template-square) - (`diamonds bubbles--image-template-diamond) - (`emacs bubbles--image-template-emacs)))) + ('circles bubbles--image-template-circle) + ('balls bubbles--image-template-ball) + ('squares bubbles--image-template-square) + ('diamonds bubbles--image-template-diamond) + ('emacs bubbles--image-template-emacs)))) (setq bubbles--empty-image (create-image (replace-regexp-in-string "^\"\\(.*\\)\t.*c .*\",$" diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el index 6edd085b59..79825c4aaa 100644 --- a/lisp/play/gamegrid.el +++ b/lisp/play/gamegrid.el @@ -318,19 +318,19 @@ format." (let ((data (gamegrid-match-spec-list data-spec-list)) (color (gamegrid-match-spec-list color-spec-list))) (pcase data - (`color-x + ('color-x (gamegrid-make-color-x-face color)) - (`grid-x + ('grid-x (unless gamegrid-grid-x-face (setq gamegrid-grid-x-face (gamegrid-make-grid-x-face))) gamegrid-grid-x-face) - (`mono-x + ('mono-x (unless gamegrid-mono-x-face (setq gamegrid-mono-x-face (gamegrid-make-mono-x-face))) gamegrid-mono-x-face) - (`color-tty + ('color-tty (gamegrid-make-color-tty-face color)) - (`mono-tty + ('mono-tty (unless gamegrid-mono-tty-face (setq gamegrid-mono-tty-face (gamegrid-make-mono-tty-face))) gamegrid-mono-tty-face)))) @@ -557,7 +557,7 @@ On non-POSIX systems Emacs searches for FILE in the directory specified by the variable `temporary-file-directory'. If necessary, FILE is created there." (pcase system-type - ((or `ms-dos `windows-nt) + ((or 'ms-dos 'windows-nt) (gamegrid-add-score-insecure file score)) (_ (gamegrid-add-score-with-update-game-score file score)))) diff --git a/lisp/progmodes/autoconf.el b/lisp/progmodes/autoconf.el index 59f4b07f13..c6e60a130f 100644 --- a/lisp/progmodes/autoconf.el +++ b/lisp/progmodes/autoconf.el @@ -84,7 +84,7 @@ searching backwards at another AC_... command." (setq-local syntax-propertize-function (syntax-propertize-rules ("\\" (0 "<")))) (setq-local font-lock-defaults - `(autoconf-font-lock-keywords nil nil)) + '(autoconf-font-lock-keywords nil nil)) (setq-local imenu-generic-expression autoconf-imenu-generic-expression) (setq-local indent-line-function #'indent-relative) (setq-local add-log-current-defun-function diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 972d214c0c..83b27ef16c 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -241,7 +241,7 @@ to it is returned. This function does not modify the point or the mark." ((eq position 'bol) (if (and (cc-bytecomp-fboundp 'line-beginning-position) (not point)) - `(line-beginning-position) + '(line-beginning-position) `(save-excursion ,@(if point `((goto-char ,point))) (beginning-of-line) @@ -249,7 +249,7 @@ to it is returned. This function does not modify the point or the mark." ((eq position 'eol) (if (and (cc-bytecomp-fboundp 'line-end-position) (not point)) - `(line-end-position) + '(line-end-position) `(save-excursion ,@(if point `((goto-char ,point))) (end-of-line) @@ -285,7 +285,7 @@ to it is returned. This function does not modify the point or the mark." ((eq position 'bopl) (if (and (cc-bytecomp-fboundp 'line-beginning-position) (not point)) - `(line-beginning-position 0) + '(line-beginning-position 0) `(save-excursion ,@(if point `((goto-char ,point))) (forward-line -1) @@ -293,7 +293,7 @@ to it is returned. This function does not modify the point or the mark." ((eq position 'bonl) (if (and (cc-bytecomp-fboundp 'line-beginning-position) (not point)) - `(line-beginning-position 2) + '(line-beginning-position 2) `(save-excursion ,@(if point `((goto-char ,point))) (forward-line 1) @@ -301,7 +301,7 @@ to it is returned. This function does not modify the point or the mark." ((eq position 'eopl) (if (and (cc-bytecomp-fboundp 'line-end-position) (not point)) - `(line-end-position 0) + '(line-end-position 0) `(save-excursion ,@(if point `((goto-char ,point))) (beginning-of-line) @@ -310,7 +310,7 @@ to it is returned. This function does not modify the point or the mark." ((eq position 'eonl) (if (and (cc-bytecomp-fboundp 'line-end-position) (not point)) - `(line-end-position 2) + '(line-end-position 2) `(save-excursion ,@(if point `((goto-char ,point))) (forward-line 1) @@ -482,17 +482,17 @@ to it is returned. This function does not modify the point or the mark." ;; Get the regular expression `sentence-end'. (if (cc-bytecomp-fboundp 'sentence-end) ;; Emacs 22: - `(sentence-end) + '(sentence-end) ;; Emacs <22 + XEmacs - `sentence-end)) + 'sentence-end)) (defmacro c-default-value-sentence-end () ;; Get the default value of the variable sentence end. (if (cc-bytecomp-fboundp 'sentence-end) ;; Emacs 22: - `(let (sentence-end) (sentence-end)) + '(let (sentence-end) (sentence-end)) ;; Emacs <22 + XEmacs - `(default-value 'sentence-end))) + '(default-value 'sentence-end))) ;; The following is essentially `save-buffer-state' from lazy-lock.el. ;; It ought to be a standard macro. @@ -691,7 +691,7 @@ leave point unmoved. A LIMIT for the search may be given. The start position is assumed to be before it." - `(let ((dest (c-safe-scan-lists ,(or pos `(point)) 1 0 ,limit))) + `(let ((dest (c-safe-scan-lists ,(or pos '(point)) 1 0 ,limit))) (when dest (goto-char dest) dest))) (defmacro c-go-list-backward (&optional pos limit) @@ -701,7 +701,7 @@ leave point unmoved. A LIMIT for the search may be given. The start position is assumed to be after it." - `(let ((dest (c-safe-scan-lists ,(or pos `(point)) -1 0 ,limit))) + `(let ((dest (c-safe-scan-lists ,(or pos '(point)) -1 0 ,limit))) (when dest (goto-char dest) dest))) (defmacro c-up-list-forward (&optional pos limit) @@ -710,7 +710,7 @@ or nil if no such position exists. The point is used if POS is left out. A limit for the search may be given. The start position is assumed to be before it." - `(c-safe-scan-lists ,(or pos `(point)) 1 1 ,limit)) + `(c-safe-scan-lists ,(or pos '(point)) 1 1 ,limit)) (defmacro c-up-list-backward (&optional pos limit) "Return the position of the start of the list sexp containing POS, @@ -718,7 +718,7 @@ or nil if no such position exists. The point is used if POS is left out. A limit for the search may be given. The start position is assumed to be after it." - `(c-safe-scan-lists ,(or pos `(point)) -1 1 ,limit)) + `(c-safe-scan-lists ,(or pos '(point)) -1 1 ,limit)) (defmacro c-down-list-forward (&optional pos limit) "Return the first position inside the first list sexp after POS, @@ -726,7 +726,7 @@ or nil if no such position exists. The point is used if POS is left out. A limit for the search may be given. The start position is assumed to be before it." - `(c-safe-scan-lists ,(or pos `(point)) 1 -1 ,limit)) + `(c-safe-scan-lists ,(or pos '(point)) 1 -1 ,limit)) (defmacro c-down-list-backward (&optional pos limit) "Return the last position inside the last list sexp before POS, @@ -734,7 +734,7 @@ or nil if no such position exists. The point is used if POS is left out. A limit for the search may be given. The start position is assumed to be after it." - `(c-safe-scan-lists ,(or pos `(point)) -1 -1 ,limit)) + `(c-safe-scan-lists ,(or pos '(point)) -1 -1 ,limit)) (defmacro c-go-up-list-forward (&optional pos limit) "Move the point to the first position after the list sexp containing POS, @@ -895,7 +895,7 @@ be after it." ;; c-beginning-of-statement-1. ;; Languages which don't have EOL terminated statements always return NIL ;; (they _know_ there's no vsemi ;-). - `(if c-vsemi-status-unknown-p-fn (funcall c-vsemi-status-unknown-p-fn))) + '(if c-vsemi-status-unknown-p-fn (funcall c-vsemi-status-unknown-p-fn))) (defmacro c-benign-error (format &rest args) @@ -1607,12 +1607,12 @@ with value CHAR in the region [FROM to)." (defmacro c-looking-at-non-alphnumspace () "Are we looking at a character which isn't alphanumeric or space?" (if (memq 'gen-comment-delim c-emacs-features) - `(looking-at -"\\([;#]\\|\\'\\|\\s(\\|\\s)\\|\\s\"\\|\\s\\\\|\\s$\\|\\s<\\|\\s>\\|\\s!\\)") - `(or (looking-at -"\\([;#]\\|\\'\\|\\s(\\|\\s)\\|\\s\"\\|\\s\\\\|\\s$\\|\\s<\\|\\s>\\)" - (let ((prop (c-get-char-property (point) 'syntax-table))) - (eq prop '(14))))))) ; '(14) is generic comment delimiter. + '(looking-at + "\\([;#]\\|\\'\\|\\s(\\|\\s)\\|\\s\"\\|\\s\\\\|\\s$\\|\\s<\\|\\s>\\|\\s!\\)") + '(or (looking-at + "\\([;#]\\|\\'\\|\\s(\\|\\s)\\|\\s\"\\|\\s\\\\|\\s$\\|\\s<\\|\\s>\\)" + (let ((prop (c-get-char-property (point) 'syntax-table))) + (eq prop '(14))))))) ; '(14) is generic comment delimiter. (defsubst c-intersect-lists (list alist) @@ -1836,7 +1836,7 @@ The returned string is of the type that can be used with non-nil, a caret is prepended to invert the set." ;; This function ought to be in the elisp core somewhere. (let ((str (if inverted "^" "")) char char2) - (setq chars (sort (append chars nil) `<)) + (setq chars (sort (append chars nil) #'<)) (while chars (setq char (pop chars)) (if (memq char '(?\\ ?^ ?-)) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 7a6cfdd1b7..9cd2174b66 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -1699,35 +1699,35 @@ comment at the start of cc-engine.el for more info." `(let ((beg ,beg) (end ,end)) (put-text-property beg end 'c-is-sws t) ,@(when (facep 'c-debug-is-sws-face) - `((c-debug-add-face beg end 'c-debug-is-sws-face))))) + '((c-debug-add-face beg end 'c-debug-is-sws-face))))) (defmacro c-put-in-sws (beg end) ;; This macro does a hidden buffer change. `(let ((beg ,beg) (end ,end)) (put-text-property beg end 'c-in-sws t) ,@(when (facep 'c-debug-is-sws-face) - `((c-debug-add-face beg end 'c-debug-in-sws-face))))) + '((c-debug-add-face beg end 'c-debug-in-sws-face))))) (defmacro c-remove-is-sws (beg end) ;; This macro does a hidden buffer change. `(let ((beg ,beg) (end ,end)) (remove-text-properties beg end '(c-is-sws nil)) ,@(when (facep 'c-debug-is-sws-face) - `((c-debug-remove-face beg end 'c-debug-is-sws-face))))) + '((c-debug-remove-face beg end 'c-debug-is-sws-face))))) (defmacro c-remove-in-sws (beg end) ;; This macro does a hidden buffer change. `(let ((beg ,beg) (end ,end)) (remove-text-properties beg end '(c-in-sws nil)) ,@(when (facep 'c-debug-is-sws-face) - `((c-debug-remove-face beg end 'c-debug-in-sws-face))))) + '((c-debug-remove-face beg end 'c-debug-in-sws-face))))) (defmacro c-remove-is-and-in-sws (beg end) ;; This macro does a hidden buffer change. `(let ((beg ,beg) (end ,end)) (remove-text-properties beg end '(c-is-sws nil c-in-sws nil)) ,@(when (facep 'c-debug-is-sws-face) - `((c-debug-remove-face beg end 'c-debug-is-sws-face) + '((c-debug-remove-face beg end 'c-debug-is-sws-face) (c-debug-remove-face beg end 'c-debug-in-sws-face))))) ;; The type of literal position `end' is in a `before-change-functions' @@ -6873,8 +6873,8 @@ comment at the start of cc-engine.el for more info." `(let (res) (setq c-last-identifier-range nil) (while (if (setq res ,(if (eq type 'type) - `(c-forward-type) - `(c-forward-name))) + '(c-forward-type) + '(c-forward-name))) nil (cond ((looking-at c-keywords-regexp) (c-forward-keyword-clause 1)) @@ -6884,8 +6884,8 @@ comment at the start of cc-engine.el for more info." (when (memq res '(t known found prefix maybe)) (when c-record-type-identifiers ,(if (eq type 'type) - `(c-record-type-id c-last-identifier-range) - `(c-record-ref-id c-last-identifier-range))) + '(c-record-type-id c-last-identifier-range) + '(c-record-ref-id c-last-identifier-range))) t))) (defmacro c-forward-id-comma-list (type update-safe-pos) @@ -6896,7 +6896,7 @@ comment at the start of cc-engine.el for more info." ;; This macro might do hidden buffer changes. `(while (and (progn ,(when update-safe-pos - `(setq safe-pos (point))) + '(setq safe-pos (point))) (eq (char-after) ?,)) (progn (forward-char) @@ -7917,7 +7917,7 @@ comment at the start of cc-engine.el for more info." ;; a comma. If either of or bracketed is missing, ;; throw nil to 'level. If the terminating } or ) is unmatched, throw nil ;; to 'done. This is not a general purpose macro! - `(while (eq (char-before) ?,) + '(while (eq (char-before) ?,) (backward-char) (c-backward-syntactic-ws) (when (not (memq (char-before) '(?\) ?}))) diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 79254ff755..a216061426 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -672,7 +672,7 @@ stuff. Used on level 1 and higher." ,@(when (c-major-mode-is 'pike-mode) ;; Recognize hashbangs in Pike. - `((eval . (list "\\`#![^\n\r]*" + '((eval . (list "\\`#![^\n\r]*" 0 c-preprocessor-face-name)))) ;; Make hard spaces visible through an inverted `font-lock-warning-face'. @@ -1937,7 +1937,7 @@ on level 2 only and so aren't combined with `c-complex-decl-matchers'." ;; Fontify generic colon labels in languages that support them. ,@(when (c-lang-const c-recognize-colon-labels) - `(c-font-lock-labels)))) + '(c-font-lock-labels)))) (c-lang-defconst c-complex-decl-matchers "Complex font lock matchers for types and declarations. Used on level @@ -1983,10 +1983,10 @@ on level 2 only and so aren't combined with `c-complex-decl-matchers'." ;; Fontify angle bracket arglists like templates in C++. ,@(when (c-lang-const c-recognize-<>-arglists) - `(c-font-lock-<>-arglists)) + '(c-font-lock-<>-arglists)) ,@(when (c-major-mode-is 'c++-mode) - `(c-font-lock-c++-lambda-captures)) + '(c-font-lock-c++-lambda-captures)) ;; The first two rules here mostly find occurrences that ;; `c-font-lock-declarations' has found already, but not @@ -2008,7 +2008,7 @@ on level 2 only and so aren't combined with `c-complex-decl-matchers'." ,@(when (c-major-mode-is 'c++-mode) ;; This pattern is a probably a "(MATCHER . ANCHORED-HIGHLIGHTER)" ;; (see Elisp page "Search-based Fontification"). - `(("\\" + '(("\\" (c-font-lock-c++-new)))) )) @@ -2076,10 +2076,10 @@ higher." t `(,@(when (c-lang-const c-brace-list-decl-kwds) ;; Fontify the remaining identifiers inside an enum list when we start ;; inside it. - `(c-font-lock-enum-tail - ;; Fontify the identifiers inside enum lists. (The enum type - ;; name is handled by `c-simple-decl-matchers' or - ;; `c-complex-decl-matchers' below. + '(c-font-lock-enum-tail + ;; Fontify the identifiers inside enum lists. (The enum type + ;; name is handled by `c-simple-decl-matchers' or + ;; `c-complex-decl-matchers' below. c-font-lock-enum-body)) ;; Fontify labels after goto etc. @@ -2130,7 +2130,7 @@ higher." (if (> (point) limit) (goto-char limit)))))))) ,@(when (c-major-mode-is 'java-mode) - `((eval . (list "\\<\\(@[a-zA-Z0-9]+\\)\\>" 1 c-annotation-face)))) + '((eval . (list "\\<\\(@[a-zA-Z0-9]+\\)\\>" 1 c-annotation-face)))) )) (c-lang-defconst c-matchers-1 diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index de49ad75d3..8c148e5e53 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -293,7 +293,7 @@ the evaluated constant value at compile time." ["Forward Statement" c-end-of-statement t] ,@(when (c-lang-const c-opt-cpp-prefix) ;; Only applicable if there's a cpp preprocessor. - `(["Up Conditional" c-up-conditional t] + '(["Up Conditional" c-up-conditional t] ["Backward Conditional" c-backward-conditional t] ["Forward Conditional" c-forward-conditional t] "----" @@ -383,9 +383,9 @@ The syntax tables aren't stored directly since they're quite large." ;; its compiler directives as single keyword tokens. ;; This is then necessary since it's assumed that ;; every keyword is a single symbol. - `(modify-syntax-entry ?@ "_" table)) + '(modify-syntax-entry ?@ "_" table)) ((c-major-mode-is 'pike-mode) - `(modify-syntax-entry ?@ "." table))) + '(modify-syntax-entry ?@ "." table))) table))) (c-lang-defconst c-mode-syntax-table @@ -1046,16 +1046,16 @@ since CC Mode treats every identifier as an expression." ;; Primary. ,@(c-lang-const c-identifier-ops) ,@(cond ((or (c-major-mode-is 'c++-mode) (c-major-mode-is 'java-mode)) - `((postfix-if-paren "<" ">"))) ; Templates. + '((postfix-if-paren "<" ">"))) ; Templates. ((c-major-mode-is 'pike-mode) - `((prefix "global" "predef"))) + '((prefix "global" "predef"))) ((c-major-mode-is 'java-mode) - `((prefix "super")))) + '((prefix "super")))) ;; Postfix. ,@(when (c-major-mode-is 'c++-mode) ;; The following need special treatment. - `((prefix "dynamic_cast" "static_cast" + '((prefix "dynamic_cast" "static_cast" "reinterpret_cast" "const_cast" "typeid" "alignof"))) (left-assoc "." @@ -1085,7 +1085,7 @@ since CC Mode treats every identifier as an expression." ;; Member selection. ,@(when (c-major-mode-is 'c++-mode) - `((left-assoc ".*" "->*"))) + '((left-assoc ".*" "->*"))) ;; Multiplicative. (left-assoc "*" "/" "%") diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 7d0884389e..f9c390cd72 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -119,7 +119,7 @@ (beginning-of-line 2) (list ,file ,line))) (defmacro cperl-etags-snarf-tag (_file _line) - `(etags-snarf-tag))) + '(etags-snarf-tag))) (if (featurep 'xemacs) (defmacro cperl-etags-goto-tag-location (elt) ;;(progn diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el index 07b58b5382..2837230752 100644 --- a/lisp/progmodes/ebrowse.el +++ b/lisp/progmodes/ebrowse.el @@ -907,8 +907,8 @@ Return the buffer created." (ebrowse-redraw-tree) (set-buffer-modified-p nil) (pcase pop - (`switch (switch-to-buffer name)) - (`pop (pop-to-buffer name))) + ('switch (switch-to-buffer name)) + ('pop (pop-to-buffer name))) (current-buffer))) @@ -1614,13 +1614,13 @@ specifies where to find/view the result." (setq view-mode-hook nil)) (push 'ebrowse-find-pattern view-mode-hook) (pcase where - (`other-window (view-file-other-window file)) - (`other-frame (ebrowse-view-file-other-frame file)) + ('other-window (view-file-other-window file)) + ('other-frame (ebrowse-view-file-other-frame file)) (_ (view-file file)))) (t (pcase where - (`other-window (find-file-other-window file)) - (`other-frame (find-file-other-frame file)) + ('other-window (find-file-other-window file)) + ('other-frame (find-file-other-frame file)) (_ (find-file file))) (ebrowse-find-pattern struc info)))) @@ -1695,9 +1695,9 @@ INFO is a list (TREE-HEADER TREE-OR-MEMBER MEMBER-LIST)." (ebrowse-ms (setf pattern (pcase member-list - ((or `ebrowse-ts-member-variables - `ebrowse-ts-static-variables - `ebrowse-ts-types) + ((or 'ebrowse-ts-member-variables + 'ebrowse-ts-static-variables + 'ebrowse-ts-types) (ebrowse-variable-declaration-regexp (ebrowse-bs-name position))) (_ @@ -3172,9 +3172,9 @@ EVENT is the mouse event." (2 (ebrowse-find-member-definition)) (1 (pcase (get-text-property (posn-point (event-start event)) 'ebrowse-what) - (`member-name + ('member-name (ebrowse-popup-menu ebrowse-member-name-object-menu event)) - (`class-name + ('class-name (ebrowse-popup-menu ebrowse-member-class-name-object-menu event)) (_ (ebrowse-popup-menu ebrowse-member-buffer-object-menu event)))))) @@ -3189,7 +3189,7 @@ EVENT is the mouse event." (2 (ebrowse-find-member-definition)) (1 (pcase (get-text-property (posn-point (event-start event)) 'ebrowse-what) - (`member-name + ('member-name (ebrowse-view-member-definition 0)))))) @@ -3522,12 +3522,12 @@ KIND is an additional string printed in the buffer." (insert kind) (indent-to 50) (insert (pcase (cl-second info) - (`ebrowse-ts-member-functions "member function") - (`ebrowse-ts-member-variables "member variable") - (`ebrowse-ts-static-functions "static function") - (`ebrowse-ts-static-variables "static variable") - (`ebrowse-ts-friends (if globals-p "define" "friend")) - (`ebrowse-ts-types "type") + ('ebrowse-ts-member-functions "member function") + ('ebrowse-ts-member-variables "member variable") + ('ebrowse-ts-static-functions "static function") + ('ebrowse-ts-static-variables "static variable") + ('ebrowse-ts-friends (if globals-p "define" "friend")) + ('ebrowse-ts-types "type") (_ "unknown")) "\n"))) @@ -4371,7 +4371,7 @@ EVENT is the mouse event." (pcase (event-click-count event) (1 (pcase property - (`class-name + ('class-name (ebrowse-popup-menu ebrowse-tree-buffer-class-object-menu event)) (_ (ebrowse-popup-menu ebrowse-tree-buffer-object-menu event))))))) @@ -4386,7 +4386,7 @@ EVENT is the mouse event." (property (get-text-property where 'ebrowse-what))) (pcase (event-click-count event) (1 (pcase property - (`class-name + ('class-name (ebrowse-tree-command:show-member-functions))))))) @@ -4399,11 +4399,11 @@ EVENT is the mouse event." (property (get-text-property where 'ebrowse-what))) (pcase (event-click-count event) (2 (pcase property - (`class-name + ('class-name (let ((collapsed (save-excursion (skip-chars-forward "^\r\n") (looking-at "\r")))) (ebrowse-collapse-fn (not collapsed)))) - (`mark + ('mark (ebrowse-toggle-mark-at-point 1))))))) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index f694252c40..39df9efda2 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -271,14 +271,14 @@ Blank lines separate paragraphs. Semicolons start comments. (unless (setq res (pcase sexp - (`(,(or `let `let*) ,bindings) + (`(,(or 'let 'let*) ,bindings) (let ((vars vars)) (when (eq 'let* (car sexp)) (dolist (binding (cdr (reverse bindings))) (push (or (car-safe binding) binding) vars))) (elisp--local-variables-1 vars (car (cdr-safe (car (last bindings))))))) - (`(,(or `let `let*) ,bindings . ,body) + (`(,(or 'let 'let*) ,bindings . ,body) (let ((vars vars)) (dolist (binding bindings) (push (or (car-safe binding) binding) vars)) @@ -300,7 +300,7 @@ Blank lines separate paragraphs. Semicolons start comments. ;; FIXME: Handle `cond'. (`(,_ . ,_) (elisp--local-variables-1 vars (car (last sexp)))) - (`elisp--witness--lisp (or vars '(nil))) + ('elisp--witness--lisp (or vars '(nil))) (_ nil))) ;; We didn't find the witness in the last element so we try to ;; backtrack to the last-but-one. @@ -541,7 +541,7 @@ functions are annotated with \"\" via the (pcase parent ;; FIXME: Rather than hardcode special cases here, ;; we should use something like a symbol-property. - (`declare + ('declare (list t (mapcar (lambda (x) (symbol-name (car x))) (delete-dups ;; FIXME: We should include some @@ -549,14 +549,14 @@ functions are annotated with \"\" via the (append macro-declarations-alist defun-declarations-alist nil))))) ; Copy both alists. - ((and (or `condition-case `condition-case-unless-debug) + ((and (or 'condition-case 'condition-case-unless-debug) (guard (save-excursion (ignore-errors (forward-sexp 2) (< (point) beg))))) (list t obarray :predicate (lambda (sym) (get sym 'error-conditions)))) - ((and (or ?\( `let `let*) + ((and (or ?\( 'let 'let*) (guard (save-excursion (goto-char (1- beg)) (when (eq parent ?\() diff --git a/lisp/progmodes/flymake-cc.el b/lisp/progmodes/flymake-cc.el index ebcfd7d1f6..c95d32668f 100644 --- a/lisp/progmodes/flymake-cc.el +++ b/lisp/progmodes/flymake-cc.el @@ -78,7 +78,7 @@ SOURCE." (defun flymake-cc-use-special-make-target () "Command for checking a file via a CHK_SOURCES Make target." (unless (executable-find "make") (error "Make not found")) - `("make" "check-syntax" "CHK_SOURCES=-x c -")) + '("make" "check-syntax" "CHK_SOURCES=-x c -")) (defvar-local flymake-cc--proc nil "Internal variable for `flymake-gcc'") diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index f0f93f1087..5352cc3fe6 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -518,7 +518,7 @@ Currently accepted REPORT-KEY arguments are: (put :warning 'flymake-category 'flymake-warning) (put :note 'flymake-category 'flymake-note) -(defvar flymake-diagnostic-types-alist `() "") +(defvar flymake-diagnostic-types-alist '() "") (make-obsolete-variable 'flymake-diagnostic-types-alist "Set properties on the diagnostic symbols instead. See Info @@ -1112,7 +1112,7 @@ default) no filter is applied." ;;; Mode-line and menu ;;; (easy-menu-define flymake-menu flymake-mode-map "Flymake" - `("Flymake" + '("Flymake" [ "Go to next problem" flymake-goto-next-error t ] [ "Go to previous problem" flymake-goto-prev-error t ] [ "Check now" flymake-start t ] @@ -1121,7 +1121,7 @@ default) no filter is applied." [ "Go to log buffer" flymake-switch-to-log-buffer t ] [ "Turn off Flymake" flymake-mode t ])) -(defvar flymake--mode-line-format `(:eval (flymake--mode-line-format))) +(defvar flymake--mode-line-format '(:eval (flymake--mode-line-format))) (put 'flymake--mode-line-format 'risky-local-variable t) @@ -1160,16 +1160,16 @@ default) no filter is applied." map)) ,@(pcase-let ((`(,ind ,face ,explain) (cond ((null known) - `("?" mode-line "No known backends")) + '("?" mode-line "No known backends")) (some-waiting `("Wait" compilation-mode-line-run ,(format "Waiting for %s running backend(s)" (length some-waiting)))) (all-disabled - `("!" compilation-mode-line-run + '("!" compilation-mode-line-run "All backends disabled")) (t - `(nil nil nil))))) + '(nil nil nil))))) (when ind `((":" (:propertize ,ind @@ -1297,14 +1297,14 @@ POS can be a buffer position or a button" "Flymake diagnostics" "A mode for listing Flymake diagnostics." (setq tabulated-list-format - `[("Line" 5 (lambda (l1 l2) - (< (plist-get (car l1) :line) - (plist-get (car l2) :line))) + `[("Line" 5 ,(lambda (l1 l2) + (< (plist-get (car l1) :line) + (plist-get (car l2) :line))) :right-align t) ("Col" 3 nil :right-align t) - ("Type" 8 (lambda (l1 l2) - (< (plist-get (car l1) :severity) - (plist-get (car l2) :severity)))) + ("Type" 8 ,(lambda (l1 l2) + (< (plist-get (car l1) :severity) + (plist-get (car l2) :severity)))) ("Message" 0 t)]) (setq tabulated-list-entries 'flymake--diagnostics-buffer-entries) diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el index bfbf6c09b2..9c91843450 100644 --- a/lisp/progmodes/fortran.el +++ b/lisp/progmodes/fortran.el @@ -495,7 +495,7 @@ This is used to fontify fixed-format Fortran comments." ;; `byte-compile', but simple benchmarks indicate that it's probably not ;; worth the trouble (about 0.5% of slow down). (eval ;I hate `eval', but it's hard to avoid it here. - `(syntax-propertize-rules + '(syntax-propertize-rules ("^[CcDd\\*]" (0 "<")) ;; We mark all chars after line-length as "comment-start", rather than ;; just the first one. This is so that a closing ' that's past the diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 0ededb1b15..b79eaf031e 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -704,7 +704,7 @@ This function is called from `compilation-filter-hook'." 'exec-plus) ((and (grep-probe find-program `(nil nil nil ,null-device "-print0")) - (grep-probe xargs-program `(nil nil nil "-0" "echo"))) + (grep-probe xargs-program '(nil nil nil "-0" "echo"))) 'gnu) (t 'exec)))) diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 91b4a65edd..af5b97a4f8 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -545,8 +545,8 @@ required by the caller." nil (if gdb-show-changed-values (or parent (pcase status - (`changed 'font-lock-warning-face) - (`out-of-scope 'shadow) + ('changed 'font-lock-warning-face) + ('out-of-scope 'shadow) (_ t))) t) depth) @@ -566,8 +566,8 @@ required by the caller." nil (if gdb-show-changed-values (or parent (pcase status - (`changed 'font-lock-warning-face) - (`out-of-scope 'shadow) + ('changed 'font-lock-warning-face) + ('out-of-scope 'shadow) (_ t))) t) depth) @@ -3516,11 +3516,11 @@ With arg, dereference expr if ARG is positive, otherwise do not dereference." (defun gud-tooltip-print-command (expr) "Return a suitable command to print the expression EXPR." (pcase gud-minor-mode - (`gdbmi (concat "-data-evaluate-expression \"" expr "\"")) - (`guiler expr) - (`dbx (concat "print " expr)) - ((or `xdb `pdb) (concat "p " expr)) - (`sdb (concat expr "/")))) + ('gdbmi (concat "-data-evaluate-expression \"" expr "\"")) + ('guiler expr) + ('dbx (concat "print " expr)) + ((or 'xdb 'pdb) (concat "p " expr)) + ('sdb (concat expr "/")))) (declare-function gdb-input "gdb-mi" (command handler &optional trigger)) (declare-function tooltip-expr-to-print "tooltip" (event)) diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index 540931c9f2..f9ea14e350 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -9074,7 +9074,7 @@ Assumes that point is at the beginning of the unit as found by ;; Menus - using easymenu.el (defvar idlwave-mode-menu-def - `("IDLWAVE" + '("IDLWAVE" ["PRO/FUNC menu" idlwave-function-menu t] ("Motion" ["Subprogram Start" idlwave-beginning-of-subprogram t] @@ -9151,7 +9151,7 @@ Assumes that point is at the beginning of the unit as found by ["Kill auto-created buffers" idlwave-kill-autoloaded-buffers t] "--" ["Insert TAB character" idlwave-hard-tab t]) - "--" + "--" ("External" ["Start IDL shell" idlwave-shell t] ["Edit file in IDLDE" idlwave-edit-in-idlde t] diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 3ce5af4c49..cec48a82a2 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -1013,7 +1013,7 @@ BEG defaults to `point-min', meaning to flush the entire cache." Update parsing information up to point, referring to parse, prev-parse-point, goal-point, and open-items bound lexically in the body of `js--ensure-cache'." - `(progn + '(progn (setq goal-point (point)) (goto-char prev-parse-point) (while (progn @@ -1023,7 +1023,7 @@ the body of `js--ensure-cache'." ;; the given depth -- i.e., make sure we're deeper than the target ;; depth. (cl-assert (> (nth 0 parse) - (js--pitem-paren-depth (car open-items)))) + (js--pitem-paren-depth (car open-items)))) (setq parse (parse-partial-sexp prev-parse-point goal-point (js--pitem-paren-depth (car open-items)) @@ -3322,11 +3322,11 @@ If nil, the whole Array is treated as a JS symbol.") (defun js--js-decode-retval (result) (pcase (intern (cl-first result)) - (`atom (cl-second result)) - (`special (intern (cl-second result))) - (`array + ('atom (cl-second result)) + ('special (intern (cl-second result))) + ('array (mapcar #'js--js-decode-retval (cl-second result))) - (`objid + ('objid (or (gethash (cl-second result) js--js-references) (puthash (cl-second result) @@ -3335,7 +3335,7 @@ If nil, the whole Array is treated as a JS symbol.") :process (inferior-moz-process)) js--js-references))) - (`error (signal 'js-js-error (list (cl-second result)))) + ('error (signal 'js-js-error (list (cl-second result)))) (x (error "Unmatched case in js--js-decode-retval: %S" x)))) (defvar comint-last-input-end) @@ -3720,8 +3720,8 @@ If one hasn't been set, or if it's stale, prompt for a new one." (when (or (null js--js-context) (js--js-handle-expired-p (cdr js--js-context)) (pcase (car js--js-context) - (`window (js? (js< (cdr js--js-context) "closed"))) - (`browser (not (js? (js< (cdr js--js-context) + ('window (js? (js< (cdr js--js-context) "closed"))) + ('browser (not (js? (js< (cdr js--js-context) "contentDocument")))) (x (error "Unmatched case in js--get-js-context: %S" x)))) (setq js--js-context (js--read-tab "JavaScript Context: "))) @@ -3730,8 +3730,8 @@ If one hasn't been set, or if it's stale, prompt for a new one." (defun js--js-content-window (context) (with-js (pcase (car context) - (`window (cdr context)) - (`browser (js< (cdr context) + ('window (cdr context)) + ('browser (js< (cdr context) "contentWindow" "wrappedJSObject")) (x (error "Unmatched case in js--js-content-window: %S" x))))) diff --git a/lisp/progmodes/m4-mode.el b/lisp/progmodes/m4-mode.el index bb75f57579..46568f15bd 100644 --- a/lisp/progmodes/m4-mode.el +++ b/lisp/progmodes/m4-mode.el @@ -63,8 +63,7 @@ If m4 is not in your PATH, set this to an absolute file name." ;;(defconst m4-program-options '("--prefix-builtins")) (defvar m4-font-lock-keywords - `( - ("\\(\\_<\\(m4_\\)?dnl\\_>\\).*$" . font-lock-comment-face) + '(("\\(\\_<\\(m4_\\)?dnl\\_>\\).*$" . font-lock-comment-face) ("\\$[*#@0-9]" . font-lock-variable-name-face) ("\\$\\@" . font-lock-variable-name-face) ("\\$\\*" . font-lock-variable-name-face) diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index f67407f48e..ed4e69dc51 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -343,7 +343,7 @@ not be enclosed in { } or ( )." "List of keywords understood by gmake.") (defconst makefile-bsdmake-statements - `(".elif" ".elifdef" ".elifmake" ".elifndef" ".elifnmake" ".else" ".endfor" + '(".elif" ".elifdef" ".elifmake" ".elifndef" ".elifnmake" ".else" ".endfor" ".endif" ".for" ".if" ".ifdef" ".ifmake" ".ifndef" ".ifnmake" ".undef") "List of keywords understood by BSD make.") diff --git a/lisp/progmodes/mixal-mode.el b/lisp/progmodes/mixal-mode.el index 22d6342087..a8c5c39b53 100644 --- a/lisp/progmodes/mixal-mode.el +++ b/lisp/progmodes/mixal-mode.el @@ -1108,7 +1108,7 @@ Assumes that file has been compiled with debugging support." (set (make-local-variable 'comment-start) "*") (set (make-local-variable 'comment-start-skip) "^\\*[ \t]*") (set (make-local-variable 'font-lock-defaults) - `(mixal-font-lock-keywords)) + '(mixal-font-lock-keywords)) (set (make-local-variable 'syntax-propertize-function) mixal-syntax-propertize-function) ;; might add an indent function in the future diff --git a/lisp/progmodes/modula2.el b/lisp/progmodes/modula2.el index ef12352457..aa412304c5 100644 --- a/lisp/progmodes/modula2.el +++ b/lisp/progmodes/modula2.el @@ -270,16 +270,16 @@ ;; - The inner VAR/TYPE are indented just like the outer VAR/TYPE. ;; - The inner PROCEDURE is not aligned with its VAR/TYPE siblings. (pcase (cons kind token) - (`(:elem . basic) m2-indent) - (`(:after . ":=") (or m2-indent smie-indent-basic)) + ('(:elem . basic) m2-indent) + ('(:after . ":=") (or m2-indent smie-indent-basic)) (`(:after . ,(or "CONST" "VAR" "TYPE")) (or m2-indent smie-indent-basic)) ;; (`(:before . ,(or `"VAR" `"TYPE" `"CONST")) ;; (if (smie-rule-parent-p "PROCEDURE") 0)) - (`(:after . ";-block") + ('(:after . ";-block") (if (smie-rule-parent-p "PROCEDURE") (smie-rule-parent (or m2-indent smie-indent-basic)))) - (`(:before . "|") (smie-rule-separator kind)) + ('(:before . "|") (smie-rule-separator kind)) )) ;;;###autoload diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index cce5e17e79..69cf600ecf 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -442,12 +442,12 @@ Non-nil means always go to the next Octave code line after sending." ;; disadvantages: ;; - changes to octave-block-offset wouldn't take effect immediately. ;; - edebug wouldn't show the use of this variable. - (`(:elem . basic) octave-block-offset) + ('(:elem . basic) octave-block-offset) (`(:list-intro . ,(or "global" "persistent")) t) ;; Since "case" is in the same BNF rules as switch..end, SMIE by default ;; aligns it with "switch". - (`(:before . "case") (if (not (smie-rule-sibling-p)) octave-block-offset)) - (`(:after . ";") + ('(:before . "case") (if (not (smie-rule-sibling-p)) octave-block-offset)) + ('(:after . ";") (if (apply #'smie-rule-parent-p octave--block-offset-keywords) (smie-rule-parent octave-block-offset) ;; For (invalid) code between switch and case. @@ -1652,11 +1652,11 @@ code line." ;; ;; Return the value according to style. (pcase octave-eldoc-message-style - (`auto (if (< (length oneline) (window-width (minibuffer-window))) + ('auto (if (< (length oneline) (window-width (minibuffer-window))) oneline multiline)) - (`oneline oneline) - (`multiline multiline))))) + ('oneline oneline) + ('multiline multiline))))) (defcustom octave-help-buffer "*Octave Help*" "Buffer name for `octave-help'." diff --git a/lisp/progmodes/opascal.el b/lisp/progmodes/opascal.el index 7d055b735d..5d3aa3cb84 100644 --- a/lisp/progmodes/opascal.el +++ b/lisp/progmodes/opascal.el @@ -140,7 +140,7 @@ That is, regardless of where in the line point is at the time." opascal-directives) "OPascal4 keywords.") -(defconst opascal-previous-terminators `(semicolon comma) +(defconst opascal-previous-terminators '(semicolon comma) "Expression/statement terminators that denote a previous expression.") (defconst opascal-comments @@ -186,7 +186,7 @@ are followed by an expression.") `(except finally ,@opascal-visibilities) "Statements that mark mid sections of the enclosing block.") -(defconst opascal-end-block-statements `(end until) +(defconst opascal-end-block-statements '(end until) "Statements that end block sections.") (defconst opascal-match-block-statements @@ -210,7 +210,7 @@ are followed by an expression.") '(interface implementation program library package) "Unit sections within which the indent is 0.") -(defconst opascal-use-clauses `(uses requires exports contains) +(defconst opascal-use-clauses '(uses requires exports contains) "Statements that refer to foreign symbols.") (defconst opascal-unit-statements diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index b530c61f97..6a818542cf 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -942,13 +942,13 @@ This is really kludgy, and unneeded (i.e. obsolete) in Emacs>=24." (defun prolog-smie-rules (kind token) (pcase (cons kind token) - (`(:elem . basic) prolog-indent-width) + ('(:elem . basic) prolog-indent-width) ;; The list of arguments can never be on a separate line! (`(:list-intro . ,_) t) ;; When we don't know how to indent an empty line, assume the most ;; likely token will be ";". - (`(:elem . empty-line-token) ";") - (`(:after . ".") '(column . 0)) ;; To work around smie-closer-alist. + ('(:elem . empty-line-token) ";") + ('(:after . ".") '(column . 0)) ;; To work around smie-closer-alist. ;; Allow indentation of if-then-else as: ;; ( test ;; -> thenrule @@ -977,7 +977,7 @@ This is really kludgy, and unneeded (i.e. obsolete) in Emacs>=24." (smie-indent-backward-token) (smie-rule-bolp)))) prolog-indent-width)) - (`(:after . ";") + ('(:after . ";") ;; Align with same-line comment as in: ;; ; %% Toto ;; foo @@ -989,7 +989,7 @@ This is really kludgy, and unneeded (i.e. obsolete) in Emacs>=24." ;; Only do it for small offsets, since the comment may actually be ;; an "end-of-line" comment at comment-column! (if (<= offset prolog-indent-width) offset)))) - (`(:after . ",") + ('(:after . ",") ;; Special indent for: ;; foopredicate(x) :- !, ;; toto. @@ -998,7 +998,7 @@ This is really kludgy, and unneeded (i.e. obsolete) in Emacs>=24." (smie-indent-backward-token) ;Skip ! (equal ":-" (car (smie-indent-backward-token)))) (smie-rule-parent prolog-indent-width))) - (`(:after . ":-") + ('(:after . ":-") (if (bolp) (save-excursion (smie-indent-forward-token) @@ -1007,7 +1007,7 @@ This is really kludgy, and unneeded (i.e. obsolete) in Emacs>=24." prolog-indent-width (min prolog-indent-width (current-column)))) prolog-indent-width)) - (`(:after . "-->") prolog-indent-width))) + ('(:after . "-->") prolog-indent-width))) ;;------------------------------------------------------------------- diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el index 92d673d449..5f29e26ab4 100644 --- a/lisp/progmodes/ps-mode.el +++ b/lisp/progmodes/ps-mode.el @@ -458,9 +458,9 @@ If nil, use `temporary-file-directory'." (defun ps-mode-smie-rules (kind token) (pcase (cons kind token) - (`(:after . "<") (when (smie-rule-next-p "<") 0)) - (`(:elem . basic) ps-mode-tab) - (`(:close-all . ">") t) + ('(:after . "<") (when (smie-rule-next-p "<") 0)) + ('(:elem . basic) ps-mode-tab) + ('(:close-all . ">") t) (`(:list-intro . ,_) t))) ;;;###autoload diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index c55b69e33e..654a0d3aea 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -342,7 +342,7 @@ It returns a file name which can be used directly as argument of (substitute-key-definition 'complete-symbol 'completion-at-point map global-map) (easy-menu-define python-menu map "Python Mode menu" - `("Python" + '("Python" :help "Python-specific Features" ["Shift region left" python-indent-shift-left :active mark-active :help "Shift region left by a single indentation step"] @@ -469,13 +469,13 @@ This variant of `rx' supports common Python named REGEXPS." (eval-and-compile (defun python-syntax--context-compiler-macro (form type &optional syntax-ppss) (pcase type - (`'comment + (''comment `(let ((ppss (or ,syntax-ppss (syntax-ppss)))) (and (nth 4 ppss) (nth 8 ppss)))) - (`'string + (''string `(let ((ppss (or ,syntax-ppss (syntax-ppss)))) (and (nth 3 ppss) (nth 8 ppss)))) - (`'paren + (''paren `(nth 1 (or ,syntax-ppss (syntax-ppss)))) (_ form)))) @@ -486,9 +486,9 @@ character address of the specified TYPE." (declare (compiler-macro python-syntax--context-compiler-macro)) (let ((ppss (or syntax-ppss (syntax-ppss)))) (pcase type - (`comment (and (nth 4 ppss) (nth 8 ppss))) - (`string (and (nth 3 ppss) (nth 8 ppss))) - (`paren (nth 1 ppss)) + ('comment (and (nth 4 ppss) (nth 8 ppss))) + ('string (and (nth 3 ppss) (nth 8 ppss))) + ('paren (nth 1 ppss)) (_ nil)))) (defun python-syntax-context-type (&optional syntax-ppss) @@ -4015,11 +4015,11 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'." ;; is NIL means to not add any newlines for start or end ;; of docstring. See `python-fill-docstring-style' for a ;; graphic idea of each style. - (`django (cons 1 1)) - (`onetwo (and multi-line-p (cons 1 2))) - (`pep-257 (and multi-line-p (cons nil 2))) - (`pep-257-nn (and multi-line-p (cons nil 1))) - (`symmetric (and multi-line-p (cons 1 1))))) + ('django (cons 1 1)) + ('onetwo (and multi-line-p (cons 1 2))) + ('pep-257 (and multi-line-p (cons nil 2))) + ('pep-257-nn (and multi-line-p (cons nil 1))) + ('symmetric (and multi-line-p (cons 1 1))))) (fill-paragraph-function)) (save-restriction (narrow-to-region str-start-pos str-end-pos) @@ -5252,7 +5252,7 @@ configuration could be: By default messages are considered errors." :version "26.1" :group 'python-flymake - :type `(alist :key-type (regexp) + :type '(alist :key-type (regexp) :value-type (symbol))) (defvar-local python--flymake-proc nil) @@ -5414,7 +5414,7 @@ REPORT-FN is Flymake's callback function." (add-to-list 'hs-special-modes-alist - `(python-mode + '(python-mode "\\s-*\\_<\\(?:def\\|class\\)\\_>" ;; Use the empty string as end regexp so it doesn't default to ;; "\\s)". This way parens at end of defun are properly hidden. diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 9256dfc17b..2f68f004e7 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -586,12 +586,12 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'." (defun ruby-smie-rules (kind token) (pcase (cons kind token) - (`(:elem . basic) ruby-indent-level) + ('(:elem . basic) ruby-indent-level) ;; "foo" "bar" is the concatenation of the two strings, so the second ;; should be aligned with the first. - (`(:elem . args) (if (looking-at "\\s\"") 0)) + ('(:elem . args) (if (looking-at "\\s\"") 0)) ;; (`(:after . ",") (smie-rule-separator kind)) - (`(:before . ";") + ('(:before . ";") (cond ((smie-rule-parent-p "def" "begin" "do" "class" "module" "for" "while" "until" "unless" @@ -638,12 +638,12 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'." ;; because we want to reject hanging tokens at bol, too. (unless (or (eolp) (forward-comment 1)) (cons 'column (current-column))))) - (`(:before . " @ ") + ('(:before . " @ ") (save-excursion (skip-chars-forward " \t") (cons 'column (current-column)))) - (`(:before . "do") (ruby-smie--indent-to-stmt)) - (`(:before . ".") + ('(:before . "do") (ruby-smie--indent-to-stmt)) + ('(:before . ".") (if (smie-rule-sibling-p) (and ruby-align-chained-calls 0) (smie-backward-sexp ".") @@ -651,7 +651,7 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'." ruby-indent-level)))) (`(:before . ,(or "else" "then" "elsif" "rescue" "ensure")) (smie-rule-parent)) - (`(:before . "when") + ('(:before . "when") ;; Align to the previous `when', but look up the virtual ;; indentation of `case'. (if (smie-rule-sibling-p) 0 (smie-rule-parent))) @@ -668,7 +668,7 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'." (if (ruby-smie--indent-to-stmt-p token) (ruby-smie--indent-to-stmt) (cons 'column (current-column))))) - (`(:before . "iuwu-mod") + ('(:before . "iuwu-mod") (smie-rule-parent ruby-indent-level)) )) @@ -756,9 +756,9 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'." The style of the comment is controlled by `ruby-encoding-magic-comment-style'." (let ((encoding-magic-comment-template (pcase ruby-encoding-magic-comment-style - (`ruby "# coding: %s") - (`emacs "# -*- coding: %s -*-") - (`custom + ('ruby "# coding: %s") + ('emacs "# -*- coding: %s -*-") + ('custom ruby-custom-encoding-magic-comment-template)))) (insert (format encoding-magic-comment-template encoding) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 46c9e6ee65..6ec05299e3 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -345,7 +345,7 @@ naming the shell." :group 'sh-script) (defcustom sh-imenu-generic-expression - `((sh + '((sh . ((nil ;; function FOO ;; function FOO() @@ -1022,7 +1022,7 @@ subshells can nest." ;; unescape " inside a $( ... ) construct. (pcase (char-after) (?\' (pcase state - (`double-quote nil) + ('double-quote nil) (_ (forward-char 1) ;; FIXME: mark skipped double quotes as punctuation syntax. (let ((spos (point))) @@ -1035,12 +1035,12 @@ subshells can nest." 'syntax-table '(1))))))))) (?\\ (forward-char 1)) (?\" (pcase state - (`double-quote (setq state (pop states))) + ('double-quote (setq state (pop states))) (_ (push state states) (setq state 'double-quote))) (if state (put-text-property (point) (1+ (point)) 'syntax-table '(1)))) (?\` (pcase state - (`backquote (setq state (pop states))) + ('backquote (setq state (pop states))) (_ (push state states) (setq state 'backquote)))) (?\$ (if (not (eq (char-after (1+ (point))) ?\()) nil @@ -1048,10 +1048,10 @@ subshells can nest." (pcase state (_ (push state states) (setq state 'code))))) (?\( (pcase state - (`double-quote nil) + ('double-quote nil) (_ (push state states) (setq state 'code)))) (?\) (pcase state - (`double-quote nil) + ('double-quote nil) (_ (setq state (pop states))))) (_ (error "Internal error in sh-font-lock-quoted-subshell"))) (forward-char 1)) @@ -1601,7 +1601,7 @@ with your script for an edit-interpret-debug cycle." (setq-local comint-prompt-regexp "^[ \t]*") (setq-local imenu-case-fold-search nil) (setq font-lock-defaults - `((sh-font-lock-keywords + '((sh-font-lock-keywords sh-font-lock-keywords-1 sh-font-lock-keywords-2) nil nil ((?/ . "w") (?~ . "w") (?. . "w") (?- . "w") (?_ . "w")) nil @@ -2035,8 +2035,8 @@ May return nil if the line should not be treated as continued." (defun sh-smie-sh-rules (kind token) (pcase (cons kind token) - (`(:elem . basic) sh-basic-offset) - (`(:after . "case-)") (- (sh-var-value 'sh-indent-for-case-alt) + ('(:elem . basic) sh-basic-offset) + ('(:after . "case-)") (- (sh-var-value 'sh-indent-for-case-alt) (sh-var-value 'sh-indent-for-case-label))) (`(:before . ,(or "(" "{" "[" "while" "if" "for" "case")) (if (not (smie-rule-prev-p "&&" "||" "|")) @@ -2069,17 +2069,17 @@ May return nil if the line should not be treated as continued." (smie-indent-virtual))))) ;; Attempt at backward compatibility with the old config variables. - (`(:before . "fi") (sh-var-value 'sh-indent-for-fi)) - (`(:before . "done") (sh-var-value 'sh-indent-for-done)) - (`(:after . "else") (sh-var-value 'sh-indent-after-else)) - (`(:after . "if") (sh-var-value 'sh-indent-after-if)) - (`(:before . "then") (sh-var-value 'sh-indent-for-then)) - (`(:before . "do") (sh-var-value 'sh-indent-for-do)) - (`(:after . "do") + ('(:before . "fi") (sh-var-value 'sh-indent-for-fi)) + ('(:before . "done") (sh-var-value 'sh-indent-for-done)) + ('(:after . "else") (sh-var-value 'sh-indent-after-else)) + ('(:after . "if") (sh-var-value 'sh-indent-after-if)) + ('(:before . "then") (sh-var-value 'sh-indent-for-then)) + ('(:before . "do") (sh-var-value 'sh-indent-for-do)) + ('(:after . "do") (sh-var-value (if (smie-rule-hanging-p) 'sh-indent-after-loop-construct 'sh-indent-after-do))) ;; sh-indent-after-done: aligned completely differently. - (`(:after . "in") (sh-var-value 'sh-indent-for-case-label)) + ('(:after . "in") (sh-var-value 'sh-indent-for-case-label)) ;; sh-indent-for-continuation: Line continuations are handled differently. (`(:after . ,(or "(" "{" "[")) (if (not (looking-at ".[ \t]*[^\n \t#]")) @@ -2244,12 +2244,12 @@ Point should be before the newline." (defun sh-smie-rc-rules (kind token) (pcase (cons kind token) - (`(:elem . basic) sh-basic-offset) + ('(:elem . basic) sh-basic-offset) ;; (`(:after . "case") (or sh-basic-offset smie-indent-basic)) - (`(:after . ";") + ('(:after . ";") (if (smie-rule-parent-p "case") (smie-rule-parent (sh-var-value 'sh-indent-after-case)))) - (`(:before . "{") + ('(:before . "{") (save-excursion (when (sh-smie--rc-after-special-arg-p) `(column . ,(current-column))))) diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 1cdae35ac3..51f78bd840 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -3209,21 +3209,21 @@ function like this: (sql-get-login \\='user \\='password \\='database)." (dolist (w what) (let ((plist (cdr-safe w))) (pcase (or (car-safe w) w) - (`user + ('user (sql-get-login-ext 'sql-user "User: " 'sql-user-history plist)) - (`password + ('password (setq-default sql-password (read-passwd "Password: " nil (sql-default-value 'sql-password)))) - (`server + ('server (sql-get-login-ext 'sql-server "Server: " 'sql-server-history plist)) - (`database + ('database (sql-get-login-ext 'sql-database "Database: " 'sql-database-history plist)) - (`port + ('port (sql-get-login-ext 'sql-port "Port: " nil (append '(:number t) plist))))))) @@ -3332,20 +3332,20 @@ server/database name." (sql-get-product-feature (or product sql-product) :sqli-login) (lambda (token plist) (pcase token - (`user + ('user (unless (string= "" sql-user) (list "/" sql-user))) - (`port + ('port (unless (or (not (numberp sql-port)) (= 0 sql-port)) (list ":" (number-to-string sql-port)))) - (`server + ('server (unless (string= "" sql-server) (list "." (if (plist-member plist :file) (file-name-nondirectory sql-server) sql-server)))) - (`database + ('database (unless (string= "" sql-database) (list "@" (if (plist-member plist :file) @@ -4314,11 +4314,11 @@ is specified in the connection settings." (mapcar (lambda (v) (pcase (car v) - (`sql-user 'user) - (`sql-password 'password) - (`sql-server 'server) - (`sql-database 'database) - (`sql-port 'port) + ('sql-user 'user) + ('sql-password 'password) + ('sql-server 'server) + ('sql-database 'database) + ('sql-port 'port) (s s))) connect-set)) @@ -4382,11 +4382,11 @@ optionally is saved to the user's init file." `(product ,@login) (lambda (token _plist) (pcase token - (`product `(sql-product ',product)) - (`user `(sql-user ,user)) - (`database `(sql-database ,database)) - (`server `(sql-server ,server)) - (`port `(sql-port ,port))))))) + ('product `(sql-product ',product)) + ('user `(sql-user ,user)) + ('database `(sql-database ,database)) + ('server `(sql-server ,server)) + ('port `(sql-port ,port))))))) (setq alist (append alist (list connect))) diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 6657761902..f26576722c 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -238,7 +238,7 @@ STRING should be given if the last search was by `string-match' on STRING." (unless (featurep 'xemacs) (unless (fboundp 'region-active-p) (defmacro region-active-p () - `(and transient-mark-mode mark-active)))) + '(and transient-mark-mode mark-active)))) ) ;; Provide a regular expression optimization routine, using regexp-opt @@ -250,7 +250,7 @@ STRING should be given if the last search was by `string-match' on STRING." (if (fboundp 'regexp-opt) ;; regexp-opt is defined, does it take 3 or 2 arguments? (if (fboundp 'function-max-args) - (let ((args (function-max-args `regexp-opt))) + (let ((args (function-max-args 'regexp-opt))) (cond ((eq args 3) ; It takes 3 (condition-case nil ; Hide this defun from emacses @@ -382,7 +382,7 @@ wherever possible, since it is slow." ((vectorp menu) (let ((i 0) (out [])) (while (< i (length menu)) - (if (equal `:help (aref menu i)) + (if (equal :help (aref menu i)) (setq i (+ 2 i)) (setq out (vconcat out (vector (aref menu i))) i (1+ i)))) @@ -1432,7 +1432,7 @@ If set will become buffer local.") (define-key map [(meta delete)] 'kill-word)) (define-key map "\M-\C-b" 'electric-verilog-backward-sexp) (define-key map "\M-\C-f" 'electric-verilog-forward-sexp) - (define-key map "\M-\r" `electric-verilog-terminate-and-indent) + (define-key map "\M-\r" 'electric-verilog-terminate-and-indent) (define-key map "\M-\t" (if (fboundp 'completion-at-point) 'completion-at-point 'verilog-complete-word)) (define-key map "\M-?" (if (fboundp 'completion-help-at-point) @@ -1481,35 +1481,35 @@ If set will become buffer local.") (setq verilog-tool 'verilog-linter) (verilog-set-compile-command)) :style radio - :selected (equal verilog-tool `verilog-linter) + :selected (equal verilog-tool 'verilog-linter) :help "When invoking compilation, use lint checker"] ["Coverage" (progn (setq verilog-tool 'verilog-coverage) (verilog-set-compile-command)) :style radio - :selected (equal verilog-tool `verilog-coverage) + :selected (equal verilog-tool 'verilog-coverage) :help "When invoking compilation, annotate for coverage"] ["Simulator" (progn (setq verilog-tool 'verilog-simulator) (verilog-set-compile-command)) :style radio - :selected (equal verilog-tool `verilog-simulator) + :selected (equal verilog-tool 'verilog-simulator) :help "When invoking compilation, interpret Verilog source"] ["Compiler" (progn (setq verilog-tool 'verilog-compiler) (verilog-set-compile-command)) :style radio - :selected (equal verilog-tool `verilog-compiler) + :selected (equal verilog-tool 'verilog-compiler) :help "When invoking compilation, compile Verilog source"] ["Preprocessor" (progn (setq verilog-tool 'verilog-preprocessor) (verilog-set-compile-command)) :style radio - :selected (equal verilog-tool `verilog-preprocessor) + :selected (equal verilog-tool 'verilog-preprocessor) :help "When invoking compilation, preprocess Verilog source, see also `verilog-preprocess'"] ) ("Move" @@ -1728,29 +1728,29 @@ If set will become buffer local.") :enable-function (lambda () (not (verilog-in-comment-or-string-p)))) (verilog-define-abbrev verilog-mode-abbrev-table "class" "" 'verilog-sk-ovm-class) (verilog-define-abbrev verilog-mode-abbrev-table "always" "" 'verilog-sk-always) -(verilog-define-abbrev verilog-mode-abbrev-table "begin" nil `verilog-sk-begin) -(verilog-define-abbrev verilog-mode-abbrev-table "case" "" `verilog-sk-case) -(verilog-define-abbrev verilog-mode-abbrev-table "for" "" `verilog-sk-for) -(verilog-define-abbrev verilog-mode-abbrev-table "generate" "" `verilog-sk-generate) -(verilog-define-abbrev verilog-mode-abbrev-table "initial" "" `verilog-sk-initial) -(verilog-define-abbrev verilog-mode-abbrev-table "fork" "" `verilog-sk-fork) -(verilog-define-abbrev verilog-mode-abbrev-table "module" "" `verilog-sk-module) -(verilog-define-abbrev verilog-mode-abbrev-table "primitive" "" `verilog-sk-primitive) -(verilog-define-abbrev verilog-mode-abbrev-table "repeat" "" `verilog-sk-repeat) -(verilog-define-abbrev verilog-mode-abbrev-table "specify" "" `verilog-sk-specify) -(verilog-define-abbrev verilog-mode-abbrev-table "task" "" `verilog-sk-task) -(verilog-define-abbrev verilog-mode-abbrev-table "while" "" `verilog-sk-while) -(verilog-define-abbrev verilog-mode-abbrev-table "casex" "" `verilog-sk-casex) -(verilog-define-abbrev verilog-mode-abbrev-table "casez" "" `verilog-sk-casez) -(verilog-define-abbrev verilog-mode-abbrev-table "if" "" `verilog-sk-if) -(verilog-define-abbrev verilog-mode-abbrev-table "else if" "" `verilog-sk-else-if) -(verilog-define-abbrev verilog-mode-abbrev-table "assign" "" `verilog-sk-assign) -(verilog-define-abbrev verilog-mode-abbrev-table "function" "" `verilog-sk-function) -(verilog-define-abbrev verilog-mode-abbrev-table "input" "" `verilog-sk-input) -(verilog-define-abbrev verilog-mode-abbrev-table "output" "" `verilog-sk-output) -(verilog-define-abbrev verilog-mode-abbrev-table "inout" "" `verilog-sk-inout) -(verilog-define-abbrev verilog-mode-abbrev-table "wire" "" `verilog-sk-wire) -(verilog-define-abbrev verilog-mode-abbrev-table "reg" "" `verilog-sk-reg) +(verilog-define-abbrev verilog-mode-abbrev-table "begin" nil 'verilog-sk-begin) +(verilog-define-abbrev verilog-mode-abbrev-table "case" "" 'verilog-sk-case) +(verilog-define-abbrev verilog-mode-abbrev-table "for" "" 'verilog-sk-for) +(verilog-define-abbrev verilog-mode-abbrev-table "generate" "" 'verilog-sk-generate) +(verilog-define-abbrev verilog-mode-abbrev-table "initial" "" 'verilog-sk-initial) +(verilog-define-abbrev verilog-mode-abbrev-table "fork" "" 'verilog-sk-fork) +(verilog-define-abbrev verilog-mode-abbrev-table "module" "" 'verilog-sk-module) +(verilog-define-abbrev verilog-mode-abbrev-table "primitive" "" 'verilog-sk-primitive) +(verilog-define-abbrev verilog-mode-abbrev-table "repeat" "" 'verilog-sk-repeat) +(verilog-define-abbrev verilog-mode-abbrev-table "specify" "" 'verilog-sk-specify) +(verilog-define-abbrev verilog-mode-abbrev-table "task" "" 'verilog-sk-task) +(verilog-define-abbrev verilog-mode-abbrev-table "while" "" 'verilog-sk-while) +(verilog-define-abbrev verilog-mode-abbrev-table "casex" "" 'verilog-sk-casex) +(verilog-define-abbrev verilog-mode-abbrev-table "casez" "" 'verilog-sk-casez) +(verilog-define-abbrev verilog-mode-abbrev-table "if" "" 'verilog-sk-if) +(verilog-define-abbrev verilog-mode-abbrev-table "else if" "" 'verilog-sk-else-if) +(verilog-define-abbrev verilog-mode-abbrev-table "assign" "" 'verilog-sk-assign) +(verilog-define-abbrev verilog-mode-abbrev-table "function" "" 'verilog-sk-function) +(verilog-define-abbrev verilog-mode-abbrev-table "input" "" 'verilog-sk-input) +(verilog-define-abbrev verilog-mode-abbrev-table "output" "" 'verilog-sk-output) +(verilog-define-abbrev verilog-mode-abbrev-table "inout" "" 'verilog-sk-inout) +(verilog-define-abbrev verilog-mode-abbrev-table "wire" "" 'verilog-sk-wire) +(verilog-define-abbrev verilog-mode-abbrev-table "reg" "" 'verilog-sk-reg) ;; ;; Macros @@ -2402,7 +2402,7 @@ find the errors." (defconst verilog-assignment-operator-re (eval-when-compile (verilog-regexp-opt - `( + '( ;; blocking assignment_operator "=" "+=" "-=" "*=" "/=" "%=" "&=" "|=" "^=" "<<=" ">>=" "<<<=" ">>>=" ;; non blocking assignment operator @@ -2478,7 +2478,7 @@ find the errors." verilog-directive-re "\\)\\|\\(" (eval-when-compile (verilog-regexp-words - `( "begin" + '( "begin" "else" "end" "endcase" @@ -2531,7 +2531,7 @@ find the errors." (eval-when-compile (verilog-regexp-words - `("end" ; closes begin + '("end" ; closes begin "endcase" ; closes any of case, casex casez or randcase "join" "join_any" "join_none" ; closes fork "endclass" @@ -2601,7 +2601,7 @@ find the errors." (defconst verilog-beg-block-re (eval-when-compile (verilog-regexp-words - `("begin" + '("begin" "case" "casex" "casez" "randcase" "clocking" "generate" @@ -2677,7 +2677,7 @@ find the errors." (defconst verilog-nameable-item-re (eval-when-compile (verilog-regexp-words - `("begin" + '("begin" "fork" "join" "join_any" "join_none" "end" @@ -2704,12 +2704,12 @@ find the errors." (defconst verilog-declaration-opener (eval-when-compile (verilog-regexp-words - `("module" "begin" "task" "function")))) + '("module" "begin" "task" "function")))) (defconst verilog-declaration-prefix-re (eval-when-compile (verilog-regexp-words - `( + '( ;; port direction "inout" "input" "output" "ref" ;; changeableness @@ -2722,7 +2722,7 @@ find the errors." (defconst verilog-declaration-core-re (eval-when-compile (verilog-regexp-words - `( + '( ;; port direction (by themselves) "inout" "input" "output" ;; integer_atom_type @@ -2764,25 +2764,25 @@ find the errors." (defconst verilog-declaration-re-1-no-macro (concat "^" verilog-declaration-re-2-no-macro)) (defconst verilog-defun-re - (eval-when-compile (verilog-regexp-words `("macromodule" "module" "class" "program" "interface" "package" "primitive" "config")))) + (eval-when-compile (verilog-regexp-words '("macromodule" "module" "class" "program" "interface" "package" "primitive" "config")))) (defconst verilog-end-defun-re - (eval-when-compile (verilog-regexp-words `("endmodule" "endclass" "endprogram" "endinterface" "endpackage" "endprimitive" "endconfig")))) + (eval-when-compile (verilog-regexp-words '("endmodule" "endclass" "endprogram" "endinterface" "endpackage" "endprimitive" "endconfig")))) (defconst verilog-zero-indent-re (concat verilog-defun-re "\\|" verilog-end-defun-re)) (defconst verilog-inst-comment-re - (eval-when-compile (verilog-regexp-words `("Outputs" "Inouts" "Inputs" "Interfaces" "Interfaced")))) + (eval-when-compile (verilog-regexp-words '("Outputs" "Inouts" "Inputs" "Interfaces" "Interfaced")))) (defconst verilog-behavioral-block-beg-re - (eval-when-compile (verilog-regexp-words `("initial" "final" "always" "always_comb" "always_latch" "always_ff" - "function" "task")))) + (eval-when-compile (verilog-regexp-words '("initial" "final" "always" "always_comb" "always_latch" "always_ff" + "function" "task")))) (defconst verilog-coverpoint-re "\\w+\\s*:\\s*\\(coverpoint\\|cross\\constraint\\)" ) (defconst verilog-in-constraint-re ; keywords legal in constraint blocks starting a statement/block - (eval-when-compile (verilog-regexp-words `("if" "else" "solve" "foreach")))) + (eval-when-compile (verilog-regexp-words '("if" "else" "solve" "foreach")))) (defconst verilog-indent-re (eval-when-compile (verilog-regexp-words - `( + '( "{" "always" "always_latch" "always_ff" "always_comb" "begin" "end" @@ -2866,28 +2866,28 @@ find the errors." (defconst verilog-defun-level-not-generate-re (eval-when-compile (verilog-regexp-words - `( "module" "macromodule" "primitive" "class" "program" - "interface" "package" "config")))) + '( "module" "macromodule" "primitive" "class" "program" + "interface" "package" "config")))) (defconst verilog-defun-level-re (eval-when-compile (verilog-regexp-words (append - `( "module" "macromodule" "primitive" "class" "program" - "interface" "package" "config") - `( "initial" "final" "always" "always_comb" "always_ff" - "always_latch" "endtask" "endfunction" ))))) + '( "module" "macromodule" "primitive" "class" "program" + "interface" "package" "config") + '( "initial" "final" "always" "always_comb" "always_ff" + "always_latch" "endtask" "endfunction" ))))) (defconst verilog-defun-level-generate-only-re (eval-when-compile (verilog-regexp-words - `( "initial" "final" "always" "always_comb" "always_ff" - "always_latch" "endtask" "endfunction" )))) + '( "initial" "final" "always" "always_comb" "always_ff" + "always_latch" "endtask" "endfunction" )))) (defconst verilog-cpp-level-re (eval-when-compile (verilog-regexp-words - `( + '( "endmodule" "endprimitive" "endinterface" "endpackage" "endprogram" "endclass" )))) @@ -2908,7 +2908,7 @@ find the errors." (defconst verilog-basic-complete-re (eval-when-compile (verilog-regexp-words - `( + '( "always" "assign" "always_latch" "always_ff" "always_comb" "constraint" "import" "initial" "final" "module" "macromodule" "repeat" "randcase" "while" "if" "for" "forever" "foreach" "else" "parameter" "do" "localparam" "assert" @@ -2937,7 +2937,7 @@ find the errors." ;; single words "\\(?:" (verilog-regexp-words - `("`__FILE__" + '("`__FILE__" "`__LINE__" "`celldefine" "`else" @@ -3492,7 +3492,7 @@ either is ok to parse as a non-comment, or `verilog-insert' was used." (remove-text-properties (point-min) (point-max) '(face nil)) (while (not (eobp)) (cond ((get-text-property (point) 'v-cmts) - (put-text-property (point) (1+ (point)) `face 'underline) + (put-text-property (point) (1+ (point)) 'face 'underline) ;;(if dbg (setq dbg (concat dbg (format " v-cmts at %S\n" (point))))) (forward-char 1)) (t @@ -5237,11 +5237,11 @@ Useful for creating tri's and other expanded fields." compile-command)) (lint-word1 (verilog-string-replace-matches "\\s .*$" "" nil nil verilog-linter))) - (cond ((equal compile-word1 "surelint") `surelint) - ((equal compile-word1 "verilint") `verilint) - ((equal lint-word1 "surelint") `surelint) - ((equal lint-word1 "verilint") `verilint) - (t `surelint)))) ; back compatibility + (cond ((equal compile-word1 "surelint") 'surelint) + ((equal compile-word1 "verilint") 'verilint) + ((equal lint-word1 "surelint") 'surelint) + ((equal lint-word1 "verilint") 'verilint) + (t 'surelint)))) ; back compatibility (defun verilog-lint-off () "Convert a Verilog linter warning line into a disable statement. @@ -5255,9 +5255,9 @@ variables is used to determine which product is being used. See \\[verilog-surelint-off] and \\[verilog-verilint-off]." (interactive) (let ((linter (verilog-linter-name))) - (cond ((equal linter `surelint) + (cond ((equal linter 'surelint) (verilog-surelint-off)) - ((equal linter `verilint) + ((equal linter 'verilint) (verilog-verilint-off)) (t (error "Linter name not set"))))) @@ -5361,7 +5361,7 @@ FILENAME to find directory to run in, or defaults to `buffer-file-name'." (interactive (list (let ((default (verilog-expand-command verilog-preprocessor))) - (set (make-local-variable `verilog-preprocessor) + (set (make-local-variable 'verilog-preprocessor) (read-from-minibuffer "Run Preprocessor (like this): " default nil nil 'verilog-preprocess-history default))))) @@ -5457,7 +5457,7 @@ For proper results, multiple filenames need to be passed on the command line in bottom-up order." (unless noninteractive (error "Use verilog-batch-auto only with --batch")) ; Otherwise we'd mess up buffer modes - (verilog-batch-execute-func `verilog-auto)) + (verilog-batch-execute-func 'verilog-auto)) (defun verilog-batch-delete-auto () "For use with --batch, perform automatic deletion as a stand-alone tool. @@ -5465,7 +5465,7 @@ This sets up the appropriate Verilog mode environment, deletes automatics with \\[verilog-delete-auto] on all command-line files, and saves the buffers." (unless noninteractive (error "Use verilog-batch-delete-auto only with --batch")) ; Otherwise we'd mess up buffer modes - (verilog-batch-execute-func `verilog-delete-auto)) + (verilog-batch-execute-func 'verilog-delete-auto)) (defun verilog-batch-delete-trailing-whitespace () "For use with --batch, perform whitespace deletion as a stand-alone tool. @@ -5474,7 +5474,7 @@ whitespace with \\[verilog-delete-trailing-whitespace] on all command-line files, and saves the buffers." (unless noninteractive (error "Use verilog-batch-delete-trailing-whitespace only with --batch")) ; Otherwise we'd mess up buffer modes - (verilog-batch-execute-func `verilog-delete-trailing-whitespace)) + (verilog-batch-execute-func 'verilog-delete-trailing-whitespace)) (defun verilog-batch-diff-auto () "For use with --batch, perform automatic differences as a stand-alone tool. @@ -5484,7 +5484,7 @@ if any differences are observed. This is appropriate for adding to regressions to insure automatics are always properly maintained." (unless noninteractive (error "Use verilog-batch-diff-auto only with --batch")) ; Otherwise we'd mess up buffer modes - (verilog-batch-execute-func `verilog-diff-auto t)) + (verilog-batch-execute-func 'verilog-diff-auto t)) (defun verilog-batch-inject-auto () "For use with --batch, perform automatic injection as a stand-alone tool. @@ -5494,7 +5494,7 @@ For proper results, multiple filenames need to be passed on the command line in bottom-up order." (unless noninteractive (error "Use verilog-batch-inject-auto only with --batch")) ; Otherwise we'd mess up buffer modes - (verilog-batch-execute-func `verilog-inject-auto)) + (verilog-batch-execute-func 'verilog-inject-auto)) (defun verilog-batch-indent () "For use with --batch, reindent an entire file as a stand-alone tool. @@ -5502,7 +5502,7 @@ This sets up the appropriate Verilog mode environment, calls \\[verilog-indent-buffer] on all command-line files, and saves the buffers." (unless noninteractive (error "Use verilog-batch-indent only with --batch")) ; Otherwise we'd mess up buffer modes - (verilog-batch-execute-func `verilog-indent-buffer)) + (verilog-batch-execute-func 'verilog-indent-buffer)) ;;; Indentation: ;; @@ -7339,7 +7339,7 @@ will be completed at runtime and should not be added to this list.") ("xor" "output")) "Map of direction for each positional argument to each gate primitive.") -(defvar verilog-gate-keywords (mapcar `car verilog-gate-ios) +(defvar verilog-gate-keywords (mapcar #'car verilog-gate-ios) "Keywords for gate primitives.") (defun verilog-string-diff (str1 str2) @@ -8172,7 +8172,7 @@ Duplicate signals are also removed. For example A[2] and A[1] become A[2:1]." sv-modport bus) ;; Shove signals so duplicated signals will be adjacent - (setq in-list (sort in-list `verilog-signals-sort-compare)) + (setq in-list (sort in-list #'verilog-signals-sort-compare)) (while in-list (setq sig (car in-list)) ;; No current signal; form from existing details @@ -8743,7 +8743,7 @@ Return an array of [outputs inouts inputs wire reg assign const]." (setq port (verilog-symbol-detick-denumber port)) (setq sig (if dotname port (verilog-symbol-detick-denumber sig))) (if vec (setq vec (verilog-symbol-detick-denumber vec))) - (if multidim (setq multidim (mapcar `verilog-symbol-detick-denumber multidim))) + (if multidim (setq multidim (mapcar #'verilog-symbol-detick-denumber multidim))) (if mem (setq mem (verilog-symbol-detick-denumber mem))) (unless (or (not sig) (equal sig "")) ; Ignore .foo(1'b1) assignments @@ -8997,7 +8997,7 @@ Outputs comments above subcell signals, for example: submodi submoddecls) (cond (subprim - (setq submodi `primitive + (setq submodi 'primitive submoddecls (verilog-decls-new nil nil nil nil nil nil nil nil nil) comment (concat inst " of " submod)) (verilog-backward-open-paren) @@ -9652,7 +9652,7 @@ Use DEFAULT-DIR to anchor paths if non-nil." ((string-match "^\\+libext\\+\\(.*\\)" arg) (setq arg (match-string 1 arg)) (while (string-match "\\([^+]+\\)\\+?\\(.*\\)" arg) - (verilog-add-list-unique `verilog-library-extensions + (verilog-add-list-unique 'verilog-library-extensions (match-string 1 arg)) (setq arg (match-string 2 arg)))) ;; @@ -9664,7 +9664,7 @@ Use DEFAULT-DIR to anchor paths if non-nil." ;; ((or (string-match "^\\+incdir\\+\\(.*\\)" arg) ; +incdir+dir (string-match "^-I\\(.*\\)" arg)) ; -Idir - (verilog-add-list-unique `verilog-library-directories + (verilog-add-list-unique 'verilog-library-directories (substitute-in-file-name (match-string 1 arg)))) ;; Ignore ((equal "+librescan" arg)) @@ -9679,15 +9679,15 @@ Use DEFAULT-DIR to anchor paths if non-nil." (verilog-getopt-file (verilog-substitute-file-name-path arg default-dir) nil)) ((equal next-param "-v") (setq next-param nil) - (verilog-add-list-unique `verilog-library-files + (verilog-add-list-unique 'verilog-library-files (verilog-substitute-file-name-path arg default-dir))) ((equal next-param "-y") (setq next-param nil) - (verilog-add-list-unique `verilog-library-directories + (verilog-add-list-unique 'verilog-library-directories (verilog-substitute-file-name-path arg default-dir))) ;; Filename ((string-match "^[^-+]" arg) - (verilog-add-list-unique `verilog-library-files + (verilog-add-list-unique 'verilog-library-files (verilog-substitute-file-name-path arg default-dir))) ;; Default - ignore; no warning )))) @@ -9716,7 +9716,7 @@ Use DEFAULT-DIR to anchor paths if non-nil." (defun verilog-getopt-flags () "Convert `verilog-library-flags' into standard library variables." ;; If the flags are local, then all the outputs should be local also - (when (local-variable-p `verilog-library-flags (current-buffer)) + (when (local-variable-p 'verilog-library-flags (current-buffer)) (mapc 'make-local-variable '(verilog-library-extensions verilog-library-directories verilog-library-files @@ -9746,10 +9746,10 @@ unless it is already a member of the variable's list." (defun verilog-current-flags () "Convert `verilog-library-flags' and similar variables to command line. Used for __FLAGS__ in `verilog-expand-command'." - (let ((cmd (mapconcat `concat verilog-library-flags " "))) + (let ((cmd (mapconcat #'concat verilog-library-flags " "))) (when (equal cmd "") (setq cmd (concat - "+libext+" (mapconcat `concat verilog-library-extensions "+") + "+libext+" (mapconcat #'concat verilog-library-extensions "+") (mapconcat (lambda (i) (concat " -y " i " +incdir+" i)) verilog-library-directories "") (mapconcat (lambda (i) (concat " -v " i)) @@ -9974,7 +9974,7 @@ variables to build the path. With optional CHECK-EXT also check (while chkdirs (setq chkdir (expand-file-name (car chkdirs) (file-name-directory current)) - chkexts (if check-ext verilog-library-extensions `(""))) + chkexts (if check-ext verilog-library-extensions '(""))) (while chkexts (setq fn (expand-file-name (concat filename (car chkexts)) chkdir)) @@ -10133,7 +10133,7 @@ Return modi if successful, else print message unless IGNORE-ERROR is true." (set-buffer (if (bufferp (verilog-modi-file-or-buffer modi)) (verilog-modi-file-or-buffer modi) (find-file-noselect (verilog-modi-file-or-buffer modi)))) - (or (equal major-mode `verilog-mode) ; Put into Verilog mode to get syntax + (or (equal major-mode 'verilog-mode) ; Put into Verilog mode to get syntax (verilog-mode)) (goto-char (verilog-modi-get-point modi))) @@ -10404,7 +10404,7 @@ When MODI is non-null, also add to modi-cache, for tracking." (t (error "Unsupported verilog-insert-definition direction: `%s'" direction)))) (or dont-sort - (setq sigs (sort (copy-alist sigs) `verilog-signals-sort-compare))) + (setq sigs (sort (copy-alist sigs) #'verilog-signals-sort-compare))) (while sigs (let ((sig (car sigs))) (verilog-insert-one-definition @@ -10748,7 +10748,7 @@ Intended for internal use inside a `verilog-save-font-no-change-functions' block (concat "/\\*" (eval-when-compile (verilog-regexp-words - `("AS" "AUTOARG" "AUTOCONCATWIDTH" "AUTOINST" "AUTOINSTPARAM" + '("AS" "AUTOARG" "AUTOCONCATWIDTH" "AUTOINST" "AUTOINSTPARAM" "AUTOSENSE"))) "\\*/") 'verilog-delete-to-paren) @@ -11089,7 +11089,7 @@ If FORCE, always reread it." Takes SIGS list, adds MESSAGE to front and inserts each at INDENT-PT." (when sigs (when verilog-auto-arg-sort - (setq sigs (sort (copy-alist sigs) `verilog-signals-sort-compare))) + (setq sigs (sort (copy-alist sigs) #'verilog-signals-sort-compare))) (insert "\n") (indent-to indent-pt) (insert message) @@ -11243,8 +11243,8 @@ See the example in `verilog-auto-inout-modport'." (verilog-signals-matching-dir-re (verilog-signals-matching-regexp sig-list-o regexp) "output" direction-re))) - (setq sig-list-i (sort (copy-alist sig-list-i) `verilog-signals-sort-compare)) - (setq sig-list-o (sort (copy-alist sig-list-o) `verilog-signals-sort-compare)) + (setq sig-list-i (sort (copy-alist sig-list-i) #'verilog-signals-sort-compare)) + (setq sig-list-o (sort (copy-alist sig-list-o) #'verilog-signals-sort-compare)) (when (or sig-list-i sig-list-o) (verilog-insert-indent "// Beginning of automatic assignments from modport\n") ;; Don't sort them so an upper AUTOINST will match the main module @@ -11388,7 +11388,7 @@ If PAR-VALUES replace final strings with these parameter values." (indent-to (+ (if (< verilog-auto-inst-column 48) 24 16) verilog-auto-inst-column)) ;; verilog-insert requires the complete comment in one call - including the newline - (cond ((equal verilog-auto-inst-template-numbers `lhs) + (cond ((equal verilog-auto-inst-template-numbers 'lhs) (verilog-insert " // Templated" " LHS: " (nth 0 tpl-ass) "\n")) @@ -11412,7 +11412,7 @@ If PAR-VALUES replace final strings with these parameter values." (defun verilog-auto-inst-port-list (sig-list indent-pt moddecls tpl-list tpl-num for-star par-values) "For `verilog-auto-inst' print a list of ports using `verilog-auto-inst-port'." (when verilog-auto-inst-sort - (setq sig-list (sort (copy-alist sig-list) `verilog-signals-sort-compare))) + (setq sig-list (sort (copy-alist sig-list) #'verilog-signals-sort-compare))) (mapc (lambda (port) (verilog-auto-inst-port port indent-pt moddecls tpl-list tpl-num for-star par-values)) @@ -13110,7 +13110,7 @@ operator. (This was added to the language in part due to AUTOSENSE!) (verilog-re-search-backward-quick "\\s-" start-pt t)) (not (looking-at "\\s-or\\b")))) (setq not-first t)) - (setq sig-list (sort sig-list `verilog-signals-sort-compare)) + (setq sig-list (sort sig-list #'verilog-signals-sort-compare)) (while sig-list (cond ((> (+ 4 (current-column) (length (verilog-sig-name (car sig-list)))) fill-column) ;+4 for width of or (insert "\n") @@ -13219,7 +13219,7 @@ Typing \\[verilog-auto] will make this into: (append (verilog-alw-get-temps sigss) prereset-sigs))) - (setq sig-list (sort sig-list `verilog-signals-sort-compare)) + (setq sig-list (sort sig-list #'verilog-signals-sort-compare)) (when sig-list (insert "\n"); (verilog-insert-indent "// Beginning of autoreset for uninitialized flops\n"); @@ -13310,7 +13310,7 @@ Typing \\[verilog-auto] will make this into: (when sig-list (verilog-forward-or-insert-line) (verilog-insert-indent "// Beginning of automatic tieoffs (for this module's unterminated outputs)\n") - (setq sig-list (sort (copy-alist sig-list) `verilog-signals-sort-compare)) + (setq sig-list (sort (copy-alist sig-list) #'verilog-signals-sort-compare)) (verilog-modi-cache-add-vars modi sig-list) ; Before we trash list (while sig-list (let ((sig (car sig-list))) @@ -13463,7 +13463,7 @@ Typing \\[verilog-auto] will make this into: (when sig-list (verilog-forward-or-insert-line) (verilog-insert-indent "// Beginning of automatic unused inputs\n") - (setq sig-list (sort (copy-alist sig-list) `verilog-signals-sort-compare)) + (setq sig-list (sort (copy-alist sig-list) #'verilog-signals-sort-compare)) (while sig-list (let ((sig (car sig-list))) (indent-to indent-pt) @@ -13789,7 +13789,7 @@ Wilson Snyder (wsnyder@wsnyder.org)." ;; Local state (verilog-read-auto-template-init) ;; If we're not in verilog-mode, change syntax table so parsing works right - (unless (eq major-mode `verilog-mode) (verilog-mode)) + (unless (eq major-mode 'verilog-mode) (verilog-mode)) ;; Allow user to customize (verilog-run-hooks 'verilog-before-auto-hook) ;; Try to save the user from needing to revert-file to reread file local-variables diff --git a/lisp/ps-mule.el b/lisp/ps-mule.el index ae2dd19d2f..2658aec5e6 100644 --- a/lisp/ps-mule.el +++ b/lisp/ps-mule.el @@ -1031,7 +1031,7 @@ the sequence." (setq ps-mule-prologue-generated nil ps-mule-composition-prologue-generated nil ps-mule-bitmap-prologue-generated nil) - (mapcar `(lambda (x) (setcar (nthcdr 2 x) nil)) + (mapcar (lambda (x) (setcar (nthcdr 2 x) nil)) ps-mule-external-libraries)) (defun ps-mule-encode-header-string (string fonttag) diff --git a/lisp/rtree.el b/lisp/rtree.el index ee2fca612f..fe24cd1871 100644 --- a/lisp/rtree.el +++ b/lisp/rtree.el @@ -44,7 +44,7 @@ ;;; Code: (defmacro rtree-make-node () - `(list (list nil) nil)) + '(list (list nil) nil)) (defmacro rtree-set-left (node left) `(setcar (cdr ,node) ,left)) diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el index 366bd15041..709599b4fb 100644 --- a/lisp/ruler-mode.el +++ b/lisp/ruler-mode.el @@ -613,7 +613,7 @@ format first." ;; Add ruler-mode to the minor mode menu in the mode line (define-key mode-line-mode-menu [ruler-mode] - `(menu-item "Ruler" ruler-mode + '(menu-item "Ruler" ruler-mode :button (:toggle . ruler-mode))) (defconst ruler-mode-ruler-help-echo diff --git a/lisp/ses.el b/lisp/ses.el index bcf8bdb636..1608d56d66 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -858,7 +858,7 @@ cell (ROW,COL). This is undoable. The cell's data will be updated through ,(let ((field (progn (cl-assert (eq (car field) 'quote)) (cadr field)))) (if (eq field 'value) - `(ses-set-with-undo (ses-cell-symbol cell) val) + '(ses-set-with-undo (ses-cell-symbol cell) val) ;; (let* ((slots (get 'ses-cell 'cl-struct-slots)) ;; (slot (or (assq field slots) ;; (error "Unknown field %S" field))) @@ -3956,17 +3956,17 @@ Use `math-format-value' as a printer for Calc objects." (while rest (let ((x (pop rest))) (pcase x - (`>v (setq transpose nil reorient-x nil reorient-y nil)) - (`>^ (setq transpose nil reorient-x nil reorient-y t)) - (`<^ (setq transpose nil reorient-x t reorient-y t)) - (` (setq transpose t reorient-x nil reorient-y t)) - (`^> (setq transpose t reorient-x nil reorient-y nil)) - (`^< (setq transpose t reorient-x t reorient-y nil)) - (`v< (setq transpose t reorient-x t reorient-y t)) - ((or `* `*2 `*1) (setq vectorize x)) - (`! (setq clean 'ses--clean-!)) - (`_ (setq clean `(lambda (&rest x) + ('>v (setq transpose nil reorient-x nil reorient-y nil)) + ('>^ (setq transpose nil reorient-x nil reorient-y t)) + ('<^ (setq transpose nil reorient-x t reorient-y t)) + (' (setq transpose t reorient-x nil reorient-y t)) + ('^> (setq transpose t reorient-x nil reorient-y nil)) + ('^< (setq transpose t reorient-x t reorient-y nil)) + ('v< (setq transpose t reorient-x t reorient-y t)) + ((or '* '*2 '*1) (setq vectorize x)) + ('! (setq clean 'ses--clean-!)) + ('_ (setq clean `(lambda (&rest x) (ses--clean-_ x ,(if rest (pop rest) 0))))) (_ (cond @@ -4001,10 +4001,10 @@ Use `math-format-value' as a printer for Calc objects." (cons clean (cons (quote 'vec) x))) result))))) (pcase vectorize - (`nil (cons clean (apply #'append result))) - (`*1 (vectorize-*1 clean result)) - (`*2 (vectorize-*2 clean result)) - (`* (funcall (if (cdr result) + ('nil (cons clean (apply #'append result))) + ('*1 (vectorize-*1 clean result)) + ('*2 (vectorize-*2 clean result)) + ('* (funcall (if (cdr result) #'vectorize-*2 #'vectorize-*1) clean result)))))) diff --git a/lisp/simple.el b/lisp/simple.el index 245675504a..e1922384f2 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -4118,7 +4118,7 @@ Runs `prefix-command-preserve-state-hook'." (when prefix-arg (concat "C-u" (pcase prefix-arg - (`(-) " -") + ('(-) " -") (`(,(and (pred integerp) n)) (let ((str "")) (while (and (> n 4) (= (mod n 4) 0)) @@ -8699,7 +8699,7 @@ See also `normal-erase-is-backspace'." (cond ((or (memq window-system '(x w32 ns pc)) (memq system-type '(ms-dos windows-nt))) (let ((bindings - `(([M-delete] [M-backspace]) + '(([M-delete] [M-backspace]) ([C-M-delete] [C-M-backspace]) ([?\e C-delete] [?\e C-backspace])))) diff --git a/lisp/startup.el b/lisp/startup.el index 4eb71abaac..a7b40b7b9c 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1755,7 +1755,7 @@ a face or button specification." :face 'variable-pitch "To quit a partially entered command, type " :face 'default "Control-g" :face 'variable-pitch ".\n") - (fancy-splash-insert :face `(variable-pitch font-lock-builtin-face) + (fancy-splash-insert :face '(variable-pitch font-lock-builtin-face) "\nThis is " (emacs-version) "\n" diff --git a/lisp/subr.el b/lisp/subr.el index 1fd86fd749..d3bc007293 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -4815,7 +4815,7 @@ command is called from a keyboard macro?" 'called-interactively-p-functions i frame nextframe))) (pcase skip - (`nil nil) + ('nil nil) (0 t) (_ (setq i (+ i skip -1)) (funcall get-next-frame))))))) ;; Now `frame' should be "the function from which we were called". diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index 8b23cab010..09bbc7be63 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -623,7 +623,7 @@ the last file dropped is selected." (let ((last-nonmenu-event (if (listp last-nonmenu-event) last-nonmenu-event ;; Fake it: - `(mouse-1 POSITION 1)))) + '(mouse-1 POSITION 1)))) (if (y-or-n-p (format "Print buffer %s? " (buffer-name))) (print-buffer) (error "Canceled"))) diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 57e5ef8017..eec40429cd 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -5095,7 +5095,7 @@ entries from minibuffer." (list beg end (lambda (s p a) (cond - ((eq a 'metadata) `(metadata (category . bibtex-key))) + ((eq a 'metadata) '(metadata (category . bibtex-key))) (t (let ((completion-ignore-case nil)) (complete-with-action a (bibtex-global-key-alist) s p))))) @@ -5113,7 +5113,7 @@ entries from minibuffer." (list beg end (lambda (s p a) (cond - ((eq a 'metadata) `(metadata (category . bibtex-string))) + ((eq a 'metadata) '(metadata (category . bibtex-string))) (t (let ((completion-ignore-case t)) (complete-with-action a compl s p))))) :exit-function (bibtex-complete-string-cleanup compl)))))) diff --git a/lisp/textmodes/conf-mode.el b/lisp/textmodes/conf-mode.el index 45fd040d10..0363b927da 100644 --- a/lisp/textmodes/conf-mode.el +++ b/lisp/textmodes/conf-mode.el @@ -230,7 +230,7 @@ This variable is best set in the file local variables, or through (put 'conf-space-keywords 'safe-local-variable 'stringp) (defvar conf-space-font-lock-keywords - `(;; [section] (do this first because it may look like a parameter) + '(;; [section] (do this first because it may look like a parameter) ("^[ \t]*\\[\\(.+\\)\\]" 1 'font-lock-type-face) ;; section { ... } (do this first because it looks like a parameter) ("^[ \t]*\\(.+?\\)[ \t\n]*{[^{}]*?$" 1 'font-lock-type-face) @@ -243,7 +243,7 @@ This variable is best set in the file local variables, or through "Keywords to highlight in Conf Space mode.") (defvar conf-colon-font-lock-keywords - `(;; [section] (do this first because it may look like a parameter) + '(;; [section] (do this first because it may look like a parameter) ("^[ \t]*\\[\\(.+\\)\\]" 1 'font-lock-type-face) ;; var: val ("^[ \t]*\\(.+?\\)[ \t]*:" diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 2de6455a6a..f87d6219fd 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -1250,20 +1250,20 @@ for determining whether point is within a selector." (defun css-smie-rules (kind token) (pcase (cons kind token) - (`(:elem . basic) css-indent-offset) - (`(:elem . arg) 0) + ('(:elem . basic) css-indent-offset) + ('(:elem . arg) 0) ;; "" stands for BOB (bug#15467). (`(:list-intro . ,(or ";" "" ":-property")) t) - (`(:before . "{") + ('(:before . "{") (when (or (smie-rule-hanging-p) (smie-rule-bolp)) (smie-backward-sexp ";") (unless (eq (char-after) ?\{) (smie-indent-virtual)))) - (`(:before . "(") + ('(:before . "(") (cond ((smie-rule-hanging-p) (smie-rule-parent 0)) ((not (smie-rule-bolp)) 0))) - (`(:after . ":-property") + ('(:after . ":-property") (when (smie-rule-hanging-p) css-indent-offset)))) diff --git a/lisp/textmodes/refill.el b/lisp/textmodes/refill.el index 229d6a24dd..06709a8cc2 100644 --- a/lisp/textmodes/refill.el +++ b/lisp/textmodes/refill.el @@ -169,7 +169,7 @@ complex processing.") (when refill-doit ; there was a change ;; There's probably scope for more special cases here... (pcase this-command - (`self-insert-command + ('self-insert-command ;; Treat self-insertion commands specially, since they don't ;; always reset `refill-doit' -- for self-insertion commands that ;; *don't* cause a refill, we want to leave it turned on so that @@ -179,9 +179,9 @@ complex processing.") ;; newline, covered below). (refill-fill-paragraph-at refill-doit) (setq refill-doit nil))) - ((or `quoted-insert `fill-paragraph `fill-region) nil) - ((or `newline `newline-and-indent `open-line `indent-new-comment-line - `reindent-then-newline-and-indent) + ((or 'quoted-insert 'fill-paragraph 'fill-region) nil) + ((or 'newline 'newline-and-indent 'open-line 'indent-new-comment-line + 'reindent-then-newline-and-indent) ;; Don't zap what was just inserted. (save-excursion (beginning-of-line) ; for newline-and-indent diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 470f4a348a..21b7082b85 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -1524,12 +1524,12 @@ Depending on context, inserts a matching close-tag, or closes the current start-tag or the current comment or the current cdata, ..." (interactive) (pcase (car (sgml-lexical-context)) - (`comment (insert " -->")) - (`cdata (insert "]]>")) - (`pi (insert " ?>")) - (`jsp (insert " %>")) - (`tag (insert " />")) - (`text + ('comment (insert " -->")) + ('cdata (insert "]]>")) + ('pi (insert " ?>")) + ('jsp (insert " %>")) + ('tag (insert " />")) + ('text (let ((context (save-excursion (sgml-get-context)))) (if context (progn @@ -1562,7 +1562,7 @@ LCON is the lexical context, if any." (pcase (car lcon) - (`string + ('string ;; Go back to previous non-empty line. (while (and (> (point) (cdr lcon)) (zerop (forward-line -1)) @@ -1573,7 +1573,7 @@ LCON is the lexical context, if any." (goto-char (cdr lcon)) (1+ (current-column)))) - (`comment + ('comment (let ((mark (looking-at "--"))) ;; Go back to previous non-empty line. (while (and (> (point) (cdr lcon)) @@ -1592,11 +1592,11 @@ LCON is the lexical context, if any." (current-column))) ;; We don't know how to indent it. Let's be honest about it. - (`cdata nil) + ('cdata nil) ;; We don't know how to indent it. Let's be honest about it. - (`pi nil) + ('pi nil) - (`tag + ('tag (goto-char (+ (cdr lcon) sgml-attribute-offset)) (skip-chars-forward "^ \t\n") ;Skip tag name. (skip-chars-forward " \t") @@ -1606,7 +1606,7 @@ LCON is the lexical context, if any." (goto-char (+ (cdr lcon) sgml-attribute-offset)) (+ (current-column) sgml-basic-offset))) - (`text + ('text (while (looking-at "{]+" ;a bit pessimistic - (regexp-opt `("''" "\">" "\"'" ">>" "»") t)) + (regexp-opt '("''" "\">" "\"'" ">>" "»") t)) 'font-lock-string-face) ;; ;; Command names, special and general. @@ -1656,7 +1656,7 @@ Puts point on a blank line between them." (let ((pt (point))) (skip-chars-backward "^ {}\n\t\\\\") (pcase (char-before) - ((or `nil ?\s ?\n ?\t ?\}) nil) + ((or 'nil ?\s ?\n ?\t ?\}) nil) (?\\ ;; TODO: Complete commands. nil) @@ -2994,7 +2994,7 @@ There might be text before point." (mapcar (lambda (x) (pcase (car-safe x) - (`font-lock-syntactic-face-function + ('font-lock-syntactic-face-function (cons (car x) #'doctex-font-lock-syntactic-face-function)) (_ x))) (cdr font-lock-defaults)))) diff --git a/lisp/tutorial.el b/lisp/tutorial.el index 1ddf7a8b79..e3fbdf019c 100644 --- a/lisp/tutorial.el +++ b/lisp/tutorial.el @@ -476,8 +476,8 @@ where ((and cua-mode (or (and (eq def-fun 'ESC-prefix) (equal key-fun - `(keymap - (118 . cua-repeat-replace-region))) + '(keymap + (118 . cua-repeat-replace-region))) (setq def-fun-txt "\"ESC prefix\"")) (and (eq def-fun 'mode-specific-command-prefix) (equal key-fun diff --git a/lisp/url/url-dav.el b/lisp/url/url-dav.el index 9c8c0526ba..1402432fb2 100644 --- a/lisp/url/url-dav.el +++ b/lisp/url/url-dav.el @@ -204,22 +204,22 @@ Returns nil if WebDAV is not supported." value nil) (pcase node-type - ((or `dateTime.iso8601tz - `dateTime.iso8601 - `dateTime.tz - `dateTime.rfc1123 - `dateTime - `date) ; date is our 'special' one... + ((or 'dateTime.iso8601tz + 'dateTime.iso8601 + 'dateTime.tz + 'dateTime.rfc1123 + 'dateTime + 'date) ; date is our 'special' one... ;; Some type of date/time string. (setq value (url-dav-process-date-property node))) - (`int + ('int ;; Integer type... (setq value (url-dav-process-integer-property node))) - ((or `number `float) + ((or 'number 'float) (setq value (url-dav-process-number-property node))) - (`boolean + ('boolean (setq value (url-dav-process-boolean-property node))) - (`uri + ('uri (setq value (url-dav-process-uri-property node))) (_ (if (not (eq node-type 'unknown)) @@ -611,11 +611,11 @@ Returns t if the lock was successfully released." (setq lock (car supported-locks) supported-locks (cdr supported-locks)) (pcase (car lock) - (`DAV:write + ('DAV:write (pcase (cdr lock) - (`DAV:shared ; group permissions (possibly world) + ('DAV:shared ; group permissions (possibly world) (aset modes 5 ?w)) - (`DAV:exclusive + ('DAV:exclusive (aset modes 2 ?w)) ; owner permissions? (_ (url-debug 'dav "Unrecognized DAV:lockscope (%S)" (cdr lock))))) diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el index e1750361a6..0fc7200219 100644 --- a/lisp/url/url-gw.el +++ b/lisp/url/url-gw.el @@ -239,7 +239,7 @@ overriding the value of `url-gateway-method'." (let ((coding-system-for-read 'binary) (coding-system-for-write 'binary)) (setq conn (pcase gw-method - ((or `tls `ssl `native) + ((or 'tls 'ssl 'native) (if (eq gw-method 'native) (setq gw-method 'plain)) (open-network-stream @@ -249,11 +249,11 @@ overriding the value of `url-gateway-method'." :nowait (and (featurep 'make-network-process) (url-asynchronous url-current-object) '(:nowait t)))) - (`socks + ('socks (socks-open-network-stream name buffer host service)) - (`telnet + ('telnet (url-open-telnet name buffer host service)) - (`rlogin + ('rlogin (url-open-rlogin name buffer host service)) (_ (error "Bad setting of url-gateway-method: %s" diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index 6b5749e1bc..036ff8005e 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -613,7 +613,7 @@ should be shown to the user." ;; 206 Partial content ;; 207 Multi-status (Added by DAV) (pcase status-symbol - ((or `no-content `reset-content) + ((or 'no-content 'reset-content) ;; No new data, just stay at the same document (url-mark-buffer-as-dead buffer)) (_ @@ -634,7 +634,7 @@ should be shown to the user." (let ((redirect-uri (or (mail-fetch-field "Location") (mail-fetch-field "URI")))) (pcase status-symbol - (`multiple-choices ; 300 + ('multiple-choices ; 300 ;; Quoth the spec (section 10.3.1) ;; ------------------------------- ;; The requested resource corresponds to any one of a set of @@ -651,26 +651,26 @@ should be shown to the user." ;; We do not support agent-driven negotiation, so we just ;; redirect to the preferred URI if one is provided. nil) - (`found ; 302 + ('found ; 302 ;; 302 Found was ambiguously defined in the standards, but ;; it's now recommended that it's treated like 303 instead ;; of 307, since that's what most servers expect. (setq url-http-method "GET" url-http-data nil)) - (`see-other ; 303 + ('see-other ; 303 ;; The response to the request can be found under a different ;; URI and SHOULD be retrieved using a GET method on that ;; resource. (setq url-http-method "GET" url-http-data nil)) - (`not-modified ; 304 + ('not-modified ; 304 ;; The 304 response MUST NOT contain a message-body. (url-http-debug "Extracting document from cache... (%s)" (url-cache-create-filename (url-view-url t))) (url-cache-extract (url-cache-create-filename (url-view-url t))) (setq redirect-uri nil success t)) - (`use-proxy ; 305 + ('use-proxy ; 305 ;; The requested resource MUST be accessed through the ;; proxy given by the Location field. The Location field ;; gives the URI of the proxy. The recipient is expected @@ -768,50 +768,50 @@ should be shown to the user." ;; 424 Failed Dependency (setq success (pcase status-symbol - (`unauthorized ; 401 + ('unauthorized ; 401 ;; The request requires user authentication. The response ;; MUST include a WWW-Authenticate header field containing a ;; challenge applicable to the requested resource. The ;; client MAY repeat the request with a suitable ;; Authorization header field. (url-http-handle-authentication nil)) - (`payment-required ; 402 + ('payment-required ; 402 ;; This code is reserved for future use (url-mark-buffer-as-dead buffer) (error "Somebody wants you to give them money")) - (`forbidden ; 403 + ('forbidden ; 403 ;; The server understood the request, but is refusing to ;; fulfill it. Authorization will not help and the request ;; SHOULD NOT be repeated. t) - (`not-found ; 404 + ('not-found ; 404 ;; Not found t) - (`method-not-allowed ; 405 + ('method-not-allowed ; 405 ;; The method specified in the Request-Line is not allowed ;; for the resource identified by the Request-URI. The ;; response MUST include an Allow header containing a list of ;; valid methods for the requested resource. t) - (`not-acceptable ; 406 + ('not-acceptable ; 406 ;; The resource identified by the request is only capable of ;; generating response entities which have content ;; characteristics not acceptable according to the accept ;; headers sent in the request. t) - (`proxy-authentication-required ; 407 + ('proxy-authentication-required ; 407 ;; This code is similar to 401 (Unauthorized), but indicates ;; that the client must first authenticate itself with the ;; proxy. The proxy MUST return a Proxy-Authenticate header ;; field containing a challenge applicable to the proxy for ;; the requested resource. (url-http-handle-authentication t)) - (`request-timeout ; 408 + ('request-timeout ; 408 ;; The client did not produce a request within the time that ;; the server was prepared to wait. The client MAY repeat ;; the request without modifications at any later time. t) - (`conflict ; 409 + ('conflict ; 409 ;; The request could not be completed due to a conflict with ;; the current state of the resource. This code is only ;; allowed in situations where it is expected that the user @@ -820,11 +820,11 @@ should be shown to the user." ;; information for the user to recognize the source of the ;; conflict. t) - (`gone ; 410 + ('gone ; 410 ;; The requested resource is no longer available at the ;; server and no forwarding address is known. t) - (`length-required ; 411 + ('length-required ; 411 ;; The server refuses to accept the request without a defined ;; Content-Length. The client MAY repeat the request if it ;; adds a valid Content-Length header field containing the @@ -834,29 +834,29 @@ should be shown to the user." ;; `url-http-create-request' automatically calculates the ;; content-length. t) - (`precondition-failed ; 412 + ('precondition-failed ; 412 ;; The precondition given in one or more of the ;; request-header fields evaluated to false when it was ;; tested on the server. t) - ((or `request-entity-too-large `request-uri-too-large) ; 413 414 + ((or 'request-entity-too-large 'request-uri-too-large) ; 413 414 ;; The server is refusing to process a request because the ;; request entity|URI is larger than the server is willing or ;; able to process. t) - (`unsupported-media-type ; 415 + ('unsupported-media-type ; 415 ;; The server is refusing to service the request because the ;; entity of the request is in a format not supported by the ;; requested resource for the requested method. t) - (`requested-range-not-satisfiable ; 416 + ('requested-range-not-satisfiable ; 416 ;; A server SHOULD return a response with this status code if ;; a request included a Range request-header field, and none ;; of the range-specifier values in this field overlap the ;; current extent of the selected resource, and the request ;; did not include an If-Range request-header field. t) - (`expectation-failed ; 417 + ('expectation-failed ; 417 ;; The expectation given in an Expect request-header field ;; could not be met by this server, or, if the server is a ;; proxy, the server has unambiguous evidence that the @@ -883,16 +883,16 @@ should be shown to the user." ;; 507 Insufficient storage (setq success t) (pcase url-http-response-status - (`not-implemented ; 501 + ('not-implemented ; 501 ;; The server does not support the functionality required to ;; fulfill the request. nil) - (`bad-gateway ; 502 + ('bad-gateway ; 502 ;; The server, while acting as a gateway or proxy, received ;; an invalid response from the upstream server it accessed ;; in attempting to fulfill the request. nil) - (`service-unavailable ; 503 + ('service-unavailable ; 503 ;; The server is currently unable to handle the request due ;; to a temporary overloading or maintenance of the server. ;; The implication is that this is a temporary condition @@ -901,19 +901,19 @@ should be shown to the user." ;; header. If no Retry-After is given, the client SHOULD ;; handle the response as it would for a 500 response. nil) - (`gateway-timeout ; 504 + ('gateway-timeout ; 504 ;; The server, while acting as a gateway or proxy, did not ;; receive a timely response from the upstream server ;; specified by the URI (e.g. HTTP, FTP, LDAP) or some other ;; auxiliary server (e.g. DNS) it needed to access in ;; attempting to complete the request. nil) - (`http-version-not-supported ; 505 + ('http-version-not-supported ; 505 ;; The server does not support, or refuses to support, the ;; HTTP protocol version that was used in the request ;; message. nil) - (`insufficient-storage ; 507 (DAV) + ('insufficient-storage ; 507 (DAV) ;; The method could not be performed on the resource ;; because the server is unable to store the representation ;; needed to successfully complete the request. This @@ -1353,10 +1353,10 @@ The return value of this function is the retrieval buffer." (set-process-buffer connection buffer) (set-process-filter connection 'url-http-generic-filter) (pcase (process-status connection) - (`connect + ('connect ;; Asynchronous connection (set-process-sentinel connection 'url-http-async-sentinel)) - (`failed + ('failed ;; Asynchronous connection failed (error "Could not create connection to %s:%d" (url-host url) (url-port url))) diff --git a/lisp/url/url-methods.el b/lisp/url/url-methods.el index db6ef7283d..b728212d23 100644 --- a/lisp/url/url-methods.el +++ b/lisp/url/url-methods.el @@ -134,11 +134,11 @@ it has not already been loaded." (type (cdr cell))) (if symbol (pcase type - (`function + ('function ;; Store the symbol name of a function (if (fboundp symbol) (setq desc (plist-put desc (car cell) symbol)))) - (`variable + ('variable ;; Store the VALUE of a variable (if (boundp symbol) (setq desc (plist-put desc (car cell) diff --git a/lisp/url/url-privacy.el b/lisp/url/url-privacy.el index 92523a62ca..9edca7e334 100644 --- a/lisp/url/url-privacy.el +++ b/lisp/url/url-privacy.el @@ -45,9 +45,9 @@ ((memq (url-device-type) '(win32 w32)) "Windows; 32bit") (t (pcase (url-device-type) - (`x "X11") - (`ns "OpenStep") - (`tty "TTY") + ('x "X11") + ('ns "OpenStep") + ('tty "TTY") (_ nil))))) (setq url-personal-mail-address (or url-personal-mail-address diff --git a/lisp/vc/cvs-status.el b/lisp/vc/cvs-status.el index 13b876273f..b65b91c517 100644 --- a/lisp/vc/cvs-status.el +++ b/lisp/vc/cvs-status.el @@ -269,9 +269,9 @@ BEWARE: because of stability issues, this is not a symmetric operation." (cond ((= l1 l2) (pcase (cvs-tag-compare tag1 tag2) - (`more1 (cons rev2 (cvs-tree-merge tree1 (cdr tree2)))) - (`more2 (cons rev1 (cvs-tree-merge (cdr tree1) tree2))) - (`equal + ('more1 (cons rev2 (cvs-tree-merge tree1 (cdr tree2)))) + ('more2 (cons rev1 (cvs-tree-merge (cdr tree1) tree2))) + ('equal (cons (cons (cvs-tag-merge tag1 tag2) (cvs-tree-merge (cvs-cdr rev1) (cvs-cdr rev2))) (cvs-tree-merge (cdr tree1) (cdr tree2)))))) @@ -395,33 +395,33 @@ Otherwise, default to ASCII chars like +, - and |.") (defconst cvs-tree-char-space (pcase cvs-tree-use-charset - (`jisx0208 (make-char 'japanese-jisx0208 33 33)) - (`unicode " ") + ('jisx0208 (make-char 'japanese-jisx0208 33 33)) + ('unicode " ") (_ " "))) (defconst cvs-tree-char-hbar (pcase cvs-tree-use-charset - (`jisx0208 (make-char 'japanese-jisx0208 40 44)) - (`unicode "â”") + ('jisx0208 (make-char 'japanese-jisx0208 40 44)) + ('unicode "â”") (_ "--"))) (defconst cvs-tree-char-vbar (pcase cvs-tree-use-charset - (`jisx0208 (make-char 'japanese-jisx0208 40 45)) - (`unicode "â”") + ('jisx0208 (make-char 'japanese-jisx0208 40 45)) + ('unicode "â”") (_ "| "))) (defconst cvs-tree-char-branch (pcase cvs-tree-use-charset - (`jisx0208 (make-char 'japanese-jisx0208 40 50)) - (`unicode "┣") + ('jisx0208 (make-char 'japanese-jisx0208 40 50)) + ('unicode "┣") (_ "+-"))) (defconst cvs-tree-char-eob ;end of branch (pcase cvs-tree-use-charset - (`jisx0208 (make-char 'japanese-jisx0208 40 49)) - (`unicode "â”—") + ('jisx0208 (make-char 'japanese-jisx0208 40 49)) + ('unicode "â”—") (_ "`-"))) (defconst cvs-tree-char-bob ;beginning of branch (pcase cvs-tree-use-charset - (`jisx0208 (make-char 'japanese-jisx0208 40 51)) - (`unicode "┳") + ('jisx0208 (make-char 'japanese-jisx0208 40 51)) + ('unicode "┳") (_ "+-"))) (defun cvs-tag-lessp (tag1 tag2) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index f200680968..4adef02984 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -476,13 +476,13 @@ See https://lists.gnu.org/r/emacs-devel/2007-11/msg01990.html") (unless end (setq end (and (re-search-forward (pcase style - (`unified + ('unified (concat (if diff-valid-unified-empty-line "^[^-+# \\\n]\\|" "^[^-+# \\]\\|") ;; A `unified' header is ambiguous. diff-file-header-re)) - (`context "^[^-+#! \\]") - (`normal "^[^<>#\\]") + ('context "^[^-+#! \\]") + ('normal "^[^<>#\\]") (_ "^[^-+#!<> \\]")) nil t) (match-beginning 0))) @@ -2048,7 +2048,7 @@ Return new point, if it was moved." (goto-char beg) (pcase style - (`unified + ('unified (while (re-search-forward "^-" end t) (let ((beg-del (progn (beginning-of-line) (point))) beg-add end-add) @@ -2061,7 +2061,7 @@ Return new point, if it was moved." (setq end-add (point)))) (smerge-refine-regions beg-del beg-add beg-add end-add nil #'diff-refine-preproc props-r props-a))))) - (`context + ('context (let* ((middle (save-excursion (re-search-forward "^---"))) (other middle)) (while (re-search-forward "^\\(?:!.*\n\\)+" middle t) diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el index e5e2a04230..ee36a82033 100644 --- a/lisp/vc/ediff-init.el +++ b/lisp/vc/ediff-init.el @@ -267,17 +267,17 @@ It needs to be killed when we quit the session.") (and (ediff-window-display-p) ediff-multiframe)) (defmacro ediff-narrow-control-frame-p () - `(and (ediff-multiframe-setup-p) - (equal ediff-help-message ediff-brief-message-string))) + '(and (ediff-multiframe-setup-p) + (equal ediff-help-message ediff-brief-message-string))) (defmacro ediff-3way-comparison-job () - `(memq + '(memq ediff-job-name '(ediff-files3 ediff-buffers3))) (ediff-defvar-local ediff-3way-comparison-job nil "") (defmacro ediff-merge-job () - `(memq + '(memq ediff-job-name '(ediff-merge-files ediff-merge-buffers @@ -288,10 +288,10 @@ It needs to be killed when we quit the session.") (ediff-defvar-local ediff-merge-job nil "") (defmacro ediff-patch-job () - `(eq ediff-job-name 'epatch)) + '(eq ediff-job-name 'epatch)) (defmacro ediff-merge-with-ancestor-job () - `(memq + '(memq ediff-job-name '(ediff-merge-files-with-ancestor ediff-merge-buffers-with-ancestor @@ -299,26 +299,26 @@ It needs to be killed when we quit the session.") (ediff-defvar-local ediff-merge-with-ancestor-job nil "") (defmacro ediff-3way-job () - `(or ediff-3way-comparison-job ediff-merge-job)) + '(or ediff-3way-comparison-job ediff-merge-job)) (ediff-defvar-local ediff-3way-job nil "") ;; A diff3 job is like a 3way job, but ediff-merge doesn't require the use ;; of diff3. (defmacro ediff-diff3-job () - `(or ediff-3way-comparison-job + '(or ediff-3way-comparison-job ediff-merge-with-ancestor-job)) (ediff-defvar-local ediff-diff3-job nil "") (defmacro ediff-windows-job () - `(memq ediff-job-name '(ediff-windows-wordwise ediff-windows-linewise))) + '(memq ediff-job-name '(ediff-windows-wordwise ediff-windows-linewise))) (ediff-defvar-local ediff-windows-job nil "") (defmacro ediff-word-mode-job () - `(memq ediff-job-name '(ediff-windows-wordwise ediff-regions-wordwise))) + '(memq ediff-job-name '(ediff-windows-wordwise ediff-regions-wordwise))) (ediff-defvar-local ediff-word-mode-job nil "") (defmacro ediff-narrow-job () - `(memq ediff-job-name '(ediff-windows-wordwise + '(memq ediff-job-name '(ediff-windows-wordwise ediff-regions-wordwise ediff-windows-linewise ediff-regions-linewise))) diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el index b3cf2fee97..03f5421913 100644 --- a/lisp/vc/ediff-ptch.el +++ b/lisp/vc/ediff-ptch.el @@ -823,11 +823,11 @@ you can still examine the changes via M-x ediff-files" (setq startup-hooks ;; this sets various vars in the meta buffer inside ;; ediff-prepare-meta-buffer - (cons `(lambda () - ;; tell what to do if the user clicks on a session record - (setq ediff-session-action-function - 'ediff-patch-file-form-meta - ediff-meta-patchbufer patch-buf) ) + (cons (lambda () + ;; tell what to do if the user clicks on a session record + (setq ediff-session-action-function + 'ediff-patch-file-form-meta + ediff-meta-patchbufer patch-buf) ) startup-hooks)) (setq meta-buf (ediff-prepare-meta-buffer 'ediff-filegroup-action diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index 90860fbdcf..d407aab11d 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -52,7 +52,7 @@ ;; The main keymap (easy-mmode-defmap log-edit-mode-map - `(("\C-c\C-c" . log-edit-done) + '(("\C-c\C-c" . log-edit-done) ("\C-c\C-a" . log-edit-insert-changelog) ("\C-c\C-d" . log-edit-show-diff) ("\C-c\C-f" . log-edit-show-files) diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el index bfb31ccdab..e3ae8fa0ba 100644 --- a/lisp/vc/log-view.el +++ b/lisp/vc/log-view.el @@ -157,7 +157,7 @@ (easy-menu-define log-view-mode-menu log-view-mode-map "Log-View Display Menu" - `("Log-View" + '("Log-View" ;; XXX Do we need menu entries for these? ;; ["Quit" quit-window] ;; ["Kill This Buffer" kill-this-buffer] diff --git a/lisp/vc/pcvs-info.el b/lisp/vc/pcvs-info.el index 2947733a24..7609f987f6 100644 --- a/lisp/vc/pcvs-info.el +++ b/lisp/vc/pcvs-info.el @@ -263,9 +263,9 @@ to confuse some users sometimes." (setq check 'type) (symbolp type) (setq check 'consistency) (pcase type - (`DIRCHANGE (and (null subtype) (string= "." file))) - ((or `NEED-UPDATE `ADDED `MISSING `DEAD `MODIFIED `MESSAGE - `UP-TO-DATE `REMOVED `NEED-MERGE `CONFLICT `UNKNOWN) + ('DIRCHANGE (and (null subtype) (string= "." file))) + ((or 'NEED-UPDATE 'ADDED 'MISSING 'DEAD 'MODIFIED 'MESSAGE + 'UP-TO-DATE 'REMOVED 'NEED-MERGE 'CONFLICT 'UNKNOWN) t))) fi (error "Invalid :%s in cvs-fileinfo %s" check fi)))) @@ -326,11 +326,11 @@ For use by the ewoc package." (subtype (cvs-fileinfo->subtype fileinfo))) (insert (pcase type - (`DIRCHANGE (concat "In directory " + ('DIRCHANGE (concat "In directory " (cvs-add-face (cvs-fileinfo->full-name fileinfo) 'cvs-header t 'cvs-goal-column t) ":")) - (`MESSAGE + ('MESSAGE (cvs-add-face (format "Message: %s" (cvs-fileinfo->full-log fileinfo)) 'cvs-msg)) (_ @@ -344,7 +344,7 @@ For use by the ewoc package." (type (let ((str (pcase type ;;(MOD-CONFLICT "Not Removed") - (`DEAD "") + ('DEAD "") (_ (capitalize (symbol-name type))))) (face (let ((sym (intern-soft (concat "cvs-fi-" diff --git a/lisp/vc/pcvs.el b/lisp/vc/pcvs.el index 501666a499..9933e3682e 100644 --- a/lisp/vc/pcvs.el +++ b/lisp/vc/pcvs.el @@ -430,11 +430,11 @@ If non-nil, NEW means to create a new buffer no matter what." (set-buffer buffer) (and (cvs-buffer-p) (pcase cvs-reuse-cvs-buffer - (`always t) - (`subdir + ('always t) + ('subdir (or (string-prefix-p default-directory dir) (string-prefix-p dir default-directory))) - (`samedir (string= default-directory dir))) + ('samedir (string= default-directory dir))) (cl-return buffer))))) ;; we really have to create a new buffer: ;; we temporarily bind cwd to "" to prevent @@ -876,11 +876,11 @@ RM-MSGS if non-nil means remove messages." (keep (pcase type ;; Remove temp messages and keep the others. - (`MESSAGE (not (or rm-msgs (eq subtype 'TEMP)))) + ('MESSAGE (not (or rm-msgs (eq subtype 'TEMP)))) ;; Remove dead entries. - (`DEAD nil) + ('DEAD nil) ;; Handled also? - (`UP-TO-DATE + ('UP-TO-DATE (not (if (find-buffer-visiting (cvs-fileinfo->full-name fi)) (eq rm-handled 'all) diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index ff41473435..fd655e435f 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -363,9 +363,9 @@ function should only apply safe heuristics) and with the match data set according to `smerge-match-conflict'.") (defvar smerge-text-properties - `(help-echo "merge conflict: mouse-3 shows a menu" - ;; mouse-face highlight - keymap (keymap (down-mouse-3 . smerge-popup-context-menu)))) + '(help-echo "merge conflict: mouse-3 shows a menu" + ;; mouse-face highlight + keymap (keymap (down-mouse-3 . smerge-popup-context-menu)))) (defun smerge-remove-props (beg end) (remove-overlays beg end 'smerge 'refine) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 4ea7ea5344..e406660d2f 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -289,7 +289,7 @@ in the order given by 'git status'." ;; 2. When a file A is renamed to B in the index and then back to A ;; in the working tree. ;; In both of these instances, `unregistered' is a reasonable response. - (`("D " "??") 'unregistered) + ('("D " "??") 'unregistered) ;; In other cases, let us return `edited'. (_ 'edited))) @@ -486,9 +486,9 @@ or an empty string if none." (files (vc-git-dir-status-state->files git-state))) (goto-char (point-min)) (pcase (vc-git-dir-status-state->stage git-state) - (`update-index + ('update-index (setq next-stage (if (vc-git--empty-db-p) 'ls-files-added 'diff-index))) - (`ls-files-added + ('ls-files-added (setq next-stage 'ls-files-unknown) (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t) (let ((new-perm (string-to-number (match-string 1) 8)) @@ -496,7 +496,7 @@ or an empty string if none." (vc-git-dir-status-update-file git-state name 'added (vc-git-create-extra-fileinfo 0 new-perm))))) - (`ls-files-up-to-date + ('ls-files-up-to-date (setq next-stage 'ls-files-unknown) (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} \\([0-3]\\)\t\\([^\0]+\\)\0" nil t) (let ((perm (string-to-number (match-string 1) 8)) @@ -507,7 +507,7 @@ or an empty string if none." 'up-to-date 'conflict) (vc-git-create-extra-fileinfo perm perm))))) - (`ls-files-conflict + ('ls-files-conflict (setq next-stage 'ls-files-unknown) ;; It's enough to look for "3" to notice a conflict. (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 3\t\\([^\0]+\\)\0" nil t) @@ -516,16 +516,16 @@ or an empty string if none." (vc-git-dir-status-update-file git-state name 'conflict (vc-git-create-extra-fileinfo perm perm))))) - (`ls-files-unknown + ('ls-files-unknown (when files (setq next-stage 'ls-files-ignored)) (while (re-search-forward "\\([^\0]*?\\)\0" nil t 1) (vc-git-dir-status-update-file git-state (match-string 1) 'unregistered (vc-git-create-extra-fileinfo 0 0)))) - (`ls-files-ignored + ('ls-files-ignored (while (re-search-forward "\\([^\0]*?\\)\0" nil t 1) (vc-git-dir-status-update-file git-state (match-string 1) 'ignored (vc-git-create-extra-fileinfo 0 0)))) - (`diff-index + ('diff-index (setq next-stage (if files 'ls-files-up-to-date 'ls-files-conflict)) (while (re-search-forward ":\\([0-7]\\{6\\}\\) \\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} \\(\\([ADMUT]\\)\0\\([^\0]+\\)\\|\\([CR]\\)[0-9]*\0\\([^\0]+\\)\0\\([^\0]+\\)\\)\0" @@ -577,30 +577,30 @@ or an empty string if none." (let ((files (vc-git-dir-status-state->files git-state))) (erase-buffer) (pcase (vc-git-dir-status-state->stage git-state) - (`update-index + ('update-index (if files (vc-git-command (current-buffer) 'async files "add" "--refresh" "--") (vc-git-command (current-buffer) 'async nil "update-index" "--refresh"))) - (`ls-files-added + ('ls-files-added (vc-git-command (current-buffer) 'async files "ls-files" "-z" "-c" "-s" "--")) - (`ls-files-up-to-date + ('ls-files-up-to-date (vc-git-command (current-buffer) 'async files "ls-files" "-z" "-c" "-s" "--")) - (`ls-files-conflict + ('ls-files-conflict (vc-git-command (current-buffer) 'async files "ls-files" "-z" "-u" "--")) - (`ls-files-unknown + ('ls-files-unknown (vc-git-command (current-buffer) 'async files "ls-files" "-z" "-o" "--directory" "--no-empty-directory" "--exclude-standard" "--")) - (`ls-files-ignored + ('ls-files-ignored (vc-git-command (current-buffer) 'async files "ls-files" "-z" "-o" "-i" "--directory" "--no-empty-directory" "--exclude-standard" "--")) ;; --relative added in Git 1.5.5. - (`diff-index + ('diff-index (vc-git-command (current-buffer) 'async files "diff-index" "--relative" "-z" "-M" "HEAD" "--"))) (vc-run-delayed @@ -1189,7 +1189,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." (defvar vc-git--log-view-long-font-lock-keywords nil) (defvar font-lock-keywords) (defvar vc-git-region-history-font-lock-keywords - `((vc-git-region-history-font-lock))) + '((vc-git-region-history-font-lock))) (defun vc-git-region-history-font-lock (limit) (let ((in-diff (save-excursion diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index d528813bc0..d6227d6782 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -1192,9 +1192,9 @@ REV is the revision to check out into WORKFILE." (insert (propertize (format " (%s %s)" (pcase (vc-hg-extra-fileinfo->rename-state extra) - (`copied "copied from") - (`renamed-from "renamed from") - (`renamed-to "renamed to")) + ('copied "copied from") + ('renamed-from "renamed from") + ('renamed-to "renamed to")) (vc-hg-extra-fileinfo->extra-name extra)) 'face 'font-lock-comment-face))))) diff --git a/lisp/vc/vc-mtn.el b/lisp/vc/vc-mtn.el index 94cf7691e3..efb141b997 100644 --- a/lisp/vc/vc-mtn.el +++ b/lisp/vc/vc-mtn.el @@ -190,8 +190,8 @@ switches." (setq branch (replace-match (cdr rule) t nil branch)))) (format "Mtn%c%s" (pcase (vc-state file) - ((or `up-to-date `needs-update) ?-) - (`added ?@) + ((or 'up-to-date 'needs-update) ?-) + ('added ?@) (_ ?:)) branch)) ""))) diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el index 51a4443962..7970fce637 100644 --- a/lisp/vc/vc-rcs.el +++ b/lisp/vc/vc-rcs.el @@ -684,13 +684,13 @@ Optional arg REVISION is a revision to annotate from." (forward-line (1- (pop insn))) (setq p (point)) (pcase (pop insn) - (`k (setq s (buffer-substring-no-properties + ('k (setq s (buffer-substring-no-properties p (progn (forward-line (car insn)) (point)))) (when prda (push `(,p . ,(propertize s :vc-rcs-r/d/a prda)) path)) (delete-region p (point))) - (`i (setq s (car insn)) + ('i (setq s (car insn)) (when prda (push `(,p . ,(length s)) path)) (insert s))))) @@ -716,10 +716,10 @@ Optional arg REVISION is a revision to annotate from." (goto-char (point-min)) (forward-line (1- (pop insn))) (pcase (pop insn) - (`k (delete-region + ('k (delete-region (point) (progn (forward-line (car insn)) (point)))) - (`i (insert (propertize + ('i (insert (propertize (car insn) :vc-rcs-r/d/a (or prda (setq prda (r/d/a)))))))) diff --git a/lisp/whitespace.el b/lisp/whitespace.el index d8249316e4..af06f7ccb1 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -1708,7 +1708,7 @@ cleaning up these problems." (setq has-bogus (memq (car option) style))) t))) whitespace-report-list))) - (when (pcase report-if-bogus (`nil t) (`never nil) (_ has-bogus)) + (when (pcase report-if-bogus ('nil t) ('never nil) (_ has-bogus)) (whitespace-kill-buffer whitespace-report-buffer-name) ;; `indent-tabs-mode' may be local to current buffer ;; `tab-width' may be local to current buffer diff --git a/lisp/window.el b/lisp/window.el index 43a742b2d8..2634955a75 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -5562,7 +5562,7 @@ specific buffers." (window-prev-buffers window))))) (head `(,type - ,@(unless (window-next-sibling window) `((last . t))) + ,@(unless (window-next-sibling window) '((last . t))) (pixel-width . ,(window-pixel-width window)) (pixel-height . ,(window-pixel-height window)) (total-width . ,(window-total-width window)) @@ -7824,9 +7824,9 @@ Return the buffer switched to." ((window-minibuffer-p) nil) ((not (eq (window-dedicated-p) t)) 'force-same-window) ((pcase switch-to-buffer-in-dedicated-window - (`nil (user-error + ('nil (user-error "Cannot switch buffers in a dedicated window")) - (`prompt + ('prompt (if (y-or-n-p (format "Window is dedicated to %s; undedicate it" (window-buffer))) @@ -7835,7 +7835,7 @@ Return the buffer switched to." 'force-same-window) (user-error "Cannot switch buffers in a dedicated window"))) - (`pop nil) + ('pop nil) (_ (set-window-dedicated-p nil nil) 'force-same-window)))))) (list (read-buffer-to-switch "Switch to buffer: ") nil force-same-window))) (let ((buffer (window-normalize-buffer-to-switch-to buffer-or-name))) diff --git a/test/lisp/electric-tests.el b/test/lisp/electric-tests.el index 7e94dfa496..a665d2eb28 100644 --- a/test/lisp/electric-tests.el +++ b/test/lisp/electric-tests.el @@ -179,9 +179,9 @@ The buffer's contents should %s: "" "-in-comments"))) (if test-in-strings - `(("\"" "\"" "-in-strings"))) + '(("\"" "\"" "-in-strings"))) (if test-in-code - `(("" "" "")))) + '(("" "" "")))) append (cl-loop for char across input diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el index f100e8c6c5..a338e16f7b 100644 --- a/test/lisp/emacs-lisp/cl-lib-tests.el +++ b/test/lisp/emacs-lisp/cl-lib-tests.el @@ -220,7 +220,7 @@ (should-error (cl-struct-slot-offset 'mystruct 'marypoppins)) (should (pcase (cl-struct-slot-info 'mystruct) (`((cl-tag-slot) (abc 5 :readonly t) - (def . ,(or `nil `(nil)))) + (def . ,(or 'nil '(nil)))) t))))) (ert-deftest cl-lib-struct-constructors () (should (string-match "\\`Constructor docstring." diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index 1fe5b79ef3..06e3fb292b 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -188,7 +188,7 @@ failed or if there was a problem." (ert-deftest ert-test-should-with-macrolet () (let ((test (make-ert-test :body (lambda () - (cl-macrolet ((foo () `(progn t nil))) + (cl-macrolet ((foo () '(progn t nil))) (should (foo))))))) (let ((result (let ((ert-debug-on-error nil)) (ert-run-test test)))) @@ -490,9 +490,9 @@ This macro is used to test if macroexpansion in `should' works." :name nil :body nil :tags '(a b)))) - (should (equal (ert-select-tests `(tag a) (list test)) (list test))) - (should (equal (ert-select-tests `(tag b) (list test)) (list test))) - (should (equal (ert-select-tests `(tag c) (list test)) '())))) + (should (equal (ert-select-tests '(tag a) (list test)) (list test))) + (should (equal (ert-select-tests '(tag b) (list test)) (list test))) + (should (equal (ert-select-tests '(tag c) (list test)) '())))) ;;; Tests for utility functions. diff --git a/test/lisp/epg-tests.el b/test/lisp/epg-tests.el index c1e98a6935..69c3838f0a 100644 --- a/test/lisp/epg-tests.el +++ b/test/lisp/epg-tests.el @@ -82,7 +82,7 @@ (setf (epg-context-home-directory context) epg-tests-home-directory) ,(if require-passphrase - `(with-temp-file (expand-file-name + '(with-temp-file (expand-file-name "gpg-agent.conf" epg-tests-home-directory) (insert "pinentry-program " (expand-file-name "dummy-pinentry" @@ -92,11 +92,11 @@ context #'epg-tests-passphrase-callback))) ,(if require-public-key - `(epg-import-keys-from-file + '(epg-import-keys-from-file context (expand-file-name "pubkey.asc" epg-tests-data-directory))) ,(if require-secret-key - `(epg-import-keys-from-file + '(epg-import-keys-from-file context (expand-file-name "seckey.asc" epg-tests-data-directory))) (with-temp-buffer diff --git a/test/lisp/jsonrpc-tests.el b/test/lisp/jsonrpc-tests.el index 1a84c30e33..585eb20bfe 100644 --- a/test/lisp/jsonrpc-tests.el +++ b/test/lisp/jsonrpc-tests.el @@ -64,7 +64,7 @@ (unless (memq method '(+ - * / vconcat append sit-for ignore)) (signal 'jsonrpc-error - `((jsonrpc-error-message + '((jsonrpc-error-message . "Sorry, this isn't allowed") (jsonrpc-error-code . -32601)))) (apply method (append params nil))) diff --git a/test/src/data-tests.el b/test/src/data-tests.el index 3cd4802a98..d41c762328 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -484,7 +484,7 @@ comparing the subr with a much slower lisp implementation." (should-have-watch-data `(data-tests-lvar 3 set ,buf1))) (should-have-watch-data `(data-tests-lvar 1 unlet ,buf1)) (setq-default data-tests-lvar 4) - (should-have-watch-data `(data-tests-lvar 4 set nil)) + (should-have-watch-data '(data-tests-lvar 4 set nil)) (with-temp-buffer (setq buf2 (current-buffer)) (setq data-tests-lvar 1) @@ -501,7 +501,7 @@ comparing the subr with a much slower lisp implementation." (kill-all-local-variables) (should-have-watch-data `(data-tests-lvar nil makunbound ,buf2))) (setq-default data-tests-lvar 4) - (should-have-watch-data `(data-tests-lvar 4 set nil)) + (should-have-watch-data '(data-tests-lvar 4 set nil)) (makunbound 'data-tests-lvar) (should-have-watch-data '(data-tests-lvar nil makunbound nil)) (setq data-tests-lvar 5) diff --git a/test/src/json-tests.el b/test/src/json-tests.el index bffee8f39d..651b0a0bb7 100644 --- a/test/src/json-tests.el +++ b/test/src/json-tests.el @@ -86,8 +86,8 @@ (should (equal (json-serialize (list :detect-hash-table #s(hash-table test equal data ("bla" "ble")) - :detect-alist `((bla . "ble")) - :detect-plist `(:bla "ble"))) + :detect-alist '((bla . "ble")) + :detect-plist '(:bla "ble"))) "\ {\ \"detect-hash-table\":{\"bla\":\"ble\"},\ commit 3826ecc795ec2fc11d82432e1b55818c0e2ef685 Author: Stephen Berman Date: Sun Nov 25 18:21:14 2018 +0100 ; Remove wrongly committed file nt/gnulib.mk diff --git a/nt/gnulib.mk b/nt/gnulib.mk deleted file mode 100644 index 192f29f845..0000000000 --- a/nt/gnulib.mk +++ /dev/null @@ -1,1153 +0,0 @@ -## DO NOT EDIT! GENERATED AUTOMATICALLY! -## Process this file with automake to produce Makefile.in. -# Copyright (C) 2002-2017 Free Software Foundation, Inc. -# -# This file 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. -# -# This file 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 this file. If not, see . -# -# As a special exception to the GNU General Public License, -# this file may be distributed as part of a program that -# contains a configuration script generated by Autoconf, under -# the same distribution terms as the rest of that program. -# -# Generated by gnulib-tool. -# Reproduce by: gnulib-tool --import --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=close --avoid=dup --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=setenv --avoid=sigprocmask --avoid=stdarg --avoid=stdbool --avoid=threadlib --avoid=unsetenv --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt binary-io byteswap c-ctype c-strcase careadlinkat close-stream count-one-bits count-trailing-zeros crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ execinfo faccessat fcntl fcntl-h fdatasync fdopendir filemode filevercmp flexmember fstatat fsync getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog ignore-value intprops largefile lstat manywarnings memrchr mkostemp mktime pipe2 pselect pthread_sigmask putenv qcopy-acl readlink readlinkat sig2str socklen stat-time std-gnu11 stdalign stddef stdio stpcpy strftime strtoimax strtoumax symlink sys_stat sys_time time time_r time_rz timegm timer-time timespec-add timespec-sub unsetenv update-copyright utimens vla warnings - - -MOSTLYCLEANFILES += core *.stackdump - -noinst_LIBRARIES += libgnu.a - -libgnu_a_SOURCES = -libgnu_a_LIBADD = $(gl_LIBOBJS) -libgnu_a_DEPENDENCIES = $(gl_LIBOBJS) -EXTRA_libgnu_a_SOURCES = - -## begin gnulib module absolute-header - -# Use this preprocessor expression to decide whether #include_next works. -# Do not rely on a 'configure'-time test for this, since the expression -# might appear in an installed header, which is used by some other compiler. -HAVE_INCLUDE_NEXT = (__GNUC__ || 60000000 <= __DECC_VER) - -## end gnulib module absolute-header - - -## begin gnulib module alloca-opt - -BUILT_SOURCES += $(ALLOCA_H) - -# We need the following in order to create when the system -# doesn't have one that works with the given compiler. -if GL_GENERATE_ALLOCA_H -alloca.h: alloca.in.h $(top_builddir)/config.status - $(AM_V_GEN)rm -f $@-t $@ && \ - { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ - cat $(srcdir)/alloca.in.h; \ - } > $@-t && \ - mv -f $@-t $@ -else -alloca.h: $(top_builddir)/config.status - rm -f $@ -endif -MOSTLYCLEANFILES += alloca.h alloca.h-t - -EXTRA_DIST += alloca.in.h - -## end gnulib module alloca-opt - - - -## begin gnulib module binary-io - -libgnu_a_SOURCES += binary-io.h binary-io.c - -## end gnulib module binary-io - -## begin gnulib module byteswap - -BUILT_SOURCES += $(BYTESWAP_H) - -# We need the following in order to create when the system -# doesn't have one. -if GL_GENERATE_BYTESWAP_H -byteswap.h: byteswap.in.h $(top_builddir)/config.status - $(AM_V_GEN)rm -f $@-t $@ && \ - { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ - cat $(srcdir)/byteswap.in.h; \ - } > $@-t && \ - mv -f $@-t $@ -else -byteswap.h: $(top_builddir)/config.status - rm -f $@ -endif -MOSTLYCLEANFILES += byteswap.h byteswap.h-t - -EXTRA_DIST += byteswap.in.h - -## end gnulib module byteswap - -## begin gnulib module c-ctype - -libgnu_a_SOURCES += c-ctype.h c-ctype.c - -## end gnulib module c-ctype - -## begin gnulib module c-strcase - -libgnu_a_SOURCES += c-strcase.h c-strcasecmp.c c-strncasecmp.c - -## end gnulib module c-strcase - - -## begin gnulib module close-stream - -libgnu_a_SOURCES += close-stream.c - -EXTRA_DIST += close-stream.h - -## end gnulib module close-stream - -## begin gnulib module count-one-bits - -libgnu_a_SOURCES += count-one-bits.c - -EXTRA_DIST += count-one-bits.h - -## end gnulib module count-one-bits - -## begin gnulib module count-trailing-zeros - -libgnu_a_SOURCES += count-trailing-zeros.c - -EXTRA_DIST += count-trailing-zeros.h - -## end gnulib module count-trailing-zeros - -## begin gnulib module crypto/md5 - -libgnu_a_SOURCES += md5.c - -EXTRA_DIST += gl_openssl.h md5.h - -## end gnulib module crypto/md5 - -## begin gnulib module crypto/sha1 - -libgnu_a_SOURCES += sha1.c - -EXTRA_DIST += gl_openssl.h sha1.h - -## end gnulib module crypto/sha1 - -## begin gnulib module crypto/sha256 - -libgnu_a_SOURCES += sha256.c - -EXTRA_DIST += gl_openssl.h sha256.h - -## end gnulib module crypto/sha256 - -## begin gnulib module crypto/sha512 - -libgnu_a_SOURCES += sha512.c - -EXTRA_DIST += gl_openssl.h sha512.h - -## end gnulib module crypto/sha512 - - - -## begin gnulib module dosname - -if gl_GNULIB_ENABLED_dosname - -endif -EXTRA_DIST += dosname.h - -## end gnulib module dosname - -## begin gnulib module dtoastr - -libgnu_a_SOURCES += dtoastr.c - -EXTRA_DIST += ftoastr.c ftoastr.h - -EXTRA_libgnu_a_SOURCES += ftoastr.c - -## end gnulib module dtoastr - -## begin gnulib module dtotimespec - -libgnu_a_SOURCES += dtotimespec.c - -## end gnulib module dtotimespec - -## begin gnulib module dup2 - - -EXTRA_DIST += dup2.c - -EXTRA_libgnu_a_SOURCES += dup2.c - -## end gnulib module dup2 - -## begin gnulib module errno - -BUILT_SOURCES += $(ERRNO_H) - -# We need the following in order to create when the system -# doesn't have one that is POSIX compliant. -if GL_GENERATE_ERRNO_H -errno.h: errno.in.h $(top_builddir)/config.status - $(AM_V_GEN)rm -f $@-t $@ && \ - { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ - sed -e 's|@''GUARD_PREFIX''@|GL|g' \ - -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ - -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ - -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ - -e 's|@''NEXT_ERRNO_H''@|$(NEXT_ERRNO_H)|g' \ - -e 's|@''EMULTIHOP_HIDDEN''@|$(EMULTIHOP_HIDDEN)|g' \ - -e 's|@''EMULTIHOP_VALUE''@|$(EMULTIHOP_VALUE)|g' \ - -e 's|@''ENOLINK_HIDDEN''@|$(ENOLINK_HIDDEN)|g' \ - -e 's|@''ENOLINK_VALUE''@|$(ENOLINK_VALUE)|g' \ - -e 's|@''EOVERFLOW_HIDDEN''@|$(EOVERFLOW_HIDDEN)|g' \ - -e 's|@''EOVERFLOW_VALUE''@|$(EOVERFLOW_VALUE)|g' \ - < $(srcdir)/errno.in.h; \ - } > $@-t && \ - mv $@-t $@ -else -errno.h: $(top_builddir)/config.status - rm -f $@ -endif -MOSTLYCLEANFILES += errno.h errno.h-t - -EXTRA_DIST += errno.in.h - -## end gnulib module errno - -## begin gnulib module euidaccess - -if gl_GNULIB_ENABLED_euidaccess - -endif -EXTRA_DIST += euidaccess.c - -EXTRA_libgnu_a_SOURCES += euidaccess.c - -## end gnulib module euidaccess - -## begin gnulib module execinfo - -BUILT_SOURCES += $(EXECINFO_H) - -# We need the following in order to create when the system -# doesn't have one that works. -if GL_GENERATE_EXECINFO_H -execinfo.h: execinfo.in.h $(top_builddir)/config.status - $(AM_V_GEN)rm -f $@-t $@ && \ - { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ - cat $(srcdir)/execinfo.in.h; \ - } > $@-t && \ - mv $@-t $@ -else -execinfo.h: $(top_builddir)/config.status - rm -f $@ -endif -MOSTLYCLEANFILES += execinfo.h execinfo.h-t - -EXTRA_DIST += execinfo.c execinfo.in.h - -EXTRA_libgnu_a_SOURCES += execinfo.c - -## end gnulib module execinfo - -## begin gnulib module faccessat - - -EXTRA_DIST += at-func.c faccessat.c - -EXTRA_libgnu_a_SOURCES += at-func.c faccessat.c - -## end gnulib module faccessat - - - -## begin gnulib module fdatasync - - -EXTRA_DIST += fdatasync.c - -EXTRA_libgnu_a_SOURCES += fdatasync.c - -## end gnulib module fdatasync - -## begin gnulib module fdopendir - - -EXTRA_DIST += fdopendir.c - -EXTRA_libgnu_a_SOURCES += fdopendir.c - -## end gnulib module fdopendir - -## begin gnulib module filemode - -libgnu_a_SOURCES += filemode.c - -EXTRA_DIST += filemode.h - -## end gnulib module filemode - -## begin gnulib module filevercmp - -libgnu_a_SOURCES += filevercmp.c - -EXTRA_DIST += filevercmp.h - -## end gnulib module filevercmp - -## begin gnulib module flexmember - - -EXTRA_DIST += flexmember.h - -## end gnulib module flexmember - -## begin gnulib module fpending - - -EXTRA_DIST += fpending.c fpending.h stdio-impl.h - -EXTRA_libgnu_a_SOURCES += fpending.c - -## end gnulib module fpending - -## begin gnulib module fstatat - - -EXTRA_DIST += at-func.c fstatat.c - -EXTRA_libgnu_a_SOURCES += at-func.c fstatat.c - -## end gnulib module fstatat - -## begin gnulib module fsync - - -EXTRA_DIST += fsync.c - -EXTRA_libgnu_a_SOURCES += fsync.c - -## end gnulib module fsync - -## begin gnulib module getdtablesize - -if gl_GNULIB_ENABLED_getdtablesize - -endif -EXTRA_DIST += getdtablesize.c - -EXTRA_libgnu_a_SOURCES += getdtablesize.c - -## end gnulib module getdtablesize - -## begin gnulib module getgroups - -if gl_GNULIB_ENABLED_getgroups - -endif -EXTRA_DIST += getgroups.c - -EXTRA_libgnu_a_SOURCES += getgroups.c - -## end gnulib module getgroups - -## begin gnulib module getloadavg - - -EXTRA_DIST += getloadavg.c - -EXTRA_libgnu_a_SOURCES += getloadavg.c - -## end gnulib module getloadavg - -## begin gnulib module getopt-posix - -BUILT_SOURCES += $(GETOPT_H) - -# We need the following in order to create when the system -# doesn't have one that works with the given compiler. -getopt.h: getopt.in.h $(top_builddir)/config.status $(ARG_NONNULL_H) - $(AM_V_GEN)rm -f $@-t $@ && \ - { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ - sed -e 's|@''GUARD_PREFIX''@|GL|g' \ - -e 's|@''HAVE_GETOPT_H''@|$(HAVE_GETOPT_H)|g' \ - -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ - -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ - -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ - -e 's|@''NEXT_GETOPT_H''@|$(NEXT_GETOPT_H)|g' \ - -e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \ - < $(srcdir)/getopt.in.h; \ - } > $@-t && \ - mv -f $@-t $@ -MOSTLYCLEANFILES += getopt.h getopt.h-t - -EXTRA_DIST += getopt.c getopt.in.h getopt1.c getopt_int.h - -EXTRA_libgnu_a_SOURCES += getopt.c getopt1.c - -## end gnulib module getopt-posix - -## begin gnulib module gettext-h - -if gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36 -libgnu_a_SOURCES += gettext.h - -endif -## end gnulib module gettext-h - -## begin gnulib module gettime - -libgnu_a_SOURCES += gettime.c - -## end gnulib module gettime - -## begin gnulib module gettimeofday - - -EXTRA_DIST += gettimeofday.c - -EXTRA_libgnu_a_SOURCES += gettimeofday.c - -## end gnulib module gettimeofday - -## begin gnulib module gitlog-to-changelog - - -EXTRA_DIST += $(top_srcdir)/build-aux/gitlog-to-changelog - -## end gnulib module gitlog-to-changelog - -## begin gnulib module group-member - -if gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1 - -endif -EXTRA_DIST += group-member.c - -EXTRA_libgnu_a_SOURCES += group-member.c - -## end gnulib module group-member - -## begin gnulib module ignore-value - - -EXTRA_DIST += ignore-value.h - -## end gnulib module ignore-value - -## begin gnulib module intprops - - -EXTRA_DIST += intprops.h - -## end gnulib module intprops - - -## begin gnulib module limits-h - -BUILT_SOURCES += $(LIMITS_H) - -# We need the following in order to create when the system -# doesn't have one that is compatible with GNU. -if GL_GENERATE_LIMITS_H -limits.h: limits.in.h $(top_builddir)/config.status - $(AM_V_GEN)rm -f $@-t $@ && \ - { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ - sed -e 's|@''GUARD_PREFIX''@|GL|g' \ - -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ - -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ - -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ - -e 's|@''NEXT_LIMITS_H''@|$(NEXT_LIMITS_H)|g' \ - < $(srcdir)/limits.in.h; \ - } > $@-t && \ - mv $@-t $@ -else -limits.h: $(top_builddir)/config.status - rm -f $@ -endif -MOSTLYCLEANFILES += limits.h limits.h-t - -EXTRA_DIST += limits.in.h - -## end gnulib module limits-h - -## begin gnulib module lstat - - -EXTRA_DIST += lstat.c - -EXTRA_libgnu_a_SOURCES += lstat.c - -## end gnulib module lstat - -## begin gnulib module memrchr - - -EXTRA_DIST += memrchr.c - -EXTRA_libgnu_a_SOURCES += memrchr.c - -## end gnulib module memrchr - - -## begin gnulib module mktime - - -EXTRA_DIST += mktime-internal.h mktime.c - -EXTRA_libgnu_a_SOURCES += mktime.c - -## end gnulib module mktime - -## begin gnulib module mktime-internal - -if gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31 - -endif -EXTRA_DIST += mktime-internal.h mktime.c - -EXTRA_libgnu_a_SOURCES += mktime.c - -## end gnulib module mktime-internal - -## begin gnulib module openat-h - -if gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7 - -endif -EXTRA_DIST += openat.h - -## end gnulib module openat-h - -## begin gnulib module pathmax - -if gl_GNULIB_ENABLED_pathmax - -endif -EXTRA_DIST += pathmax.h - -## end gnulib module pathmax - - -## begin gnulib module pselect - - -EXTRA_DIST += pselect.c - -EXTRA_libgnu_a_SOURCES += pselect.c - -## end gnulib module pselect - -## begin gnulib module pthread_sigmask - - -EXTRA_DIST += pthread_sigmask.c - -EXTRA_libgnu_a_SOURCES += pthread_sigmask.c - -## end gnulib module pthread_sigmask - -## begin gnulib module putenv - - -EXTRA_DIST += putenv.c - -EXTRA_libgnu_a_SOURCES += putenv.c - -## end gnulib module putenv - -## begin gnulib module qcopy-acl - -libgnu_a_SOURCES += qcopy-acl.c - -## end gnulib module qcopy-acl - -## begin gnulib module readlink - - -EXTRA_DIST += readlink.c - -EXTRA_libgnu_a_SOURCES += readlink.c - -## end gnulib module readlink - -## begin gnulib module readlinkat - - -EXTRA_DIST += at-func.c readlinkat.c - -EXTRA_libgnu_a_SOURCES += at-func.c readlinkat.c - -## end gnulib module readlinkat - -## begin gnulib module root-uid - -if gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c - -endif -EXTRA_DIST += root-uid.h - -## end gnulib module root-uid - - -## begin gnulib module sig2str - - -EXTRA_DIST += sig2str.c sig2str.h - -EXTRA_libgnu_a_SOURCES += sig2str.c - -## end gnulib module sig2str - - -## begin gnulib module snippet/_Noreturn - -# Because this Makefile snippet defines a variable used by other -# gnulib Makefile snippets, it must be present in all Makefile.am that -# need it. This is ensured by the applicability 'all' defined above. - -_NORETURN_H=$(top_srcdir)/build-aux/snippet/_Noreturn.h - -EXTRA_DIST += $(top_srcdir)/build-aux/snippet/_Noreturn.h - -## end gnulib module snippet/_Noreturn - -## begin gnulib module snippet/arg-nonnull - -# The BUILT_SOURCES created by this Makefile snippet are not used via #include -# statements but through direct file reference. Therefore this snippet must be -# present in all Makefile.am that need it. This is ensured by the applicability -# 'all' defined above. - -BUILT_SOURCES += arg-nonnull.h -# The arg-nonnull.h that gets inserted into generated .h files is the same as -# build-aux/snippet/arg-nonnull.h, except that it has the copyright header cut -# off. -arg-nonnull.h: $(top_srcdir)/build-aux/snippet/arg-nonnull.h - $(AM_V_GEN)rm -f $@-t $@ && \ - sed -n -e '/GL_ARG_NONNULL/,$$p' \ - < $(top_srcdir)/build-aux/snippet/arg-nonnull.h \ - > $@-t && \ - mv $@-t $@ -MOSTLYCLEANFILES += arg-nonnull.h arg-nonnull.h-t - -ARG_NONNULL_H=arg-nonnull.h - -EXTRA_DIST += $(top_srcdir)/build-aux/snippet/arg-nonnull.h - -## end gnulib module snippet/arg-nonnull - -## begin gnulib module snippet/c++defs - -# The BUILT_SOURCES created by this Makefile snippet are not used via #include -# statements but through direct file reference. Therefore this snippet must be -# present in all Makefile.am that need it. This is ensured by the applicability -# 'all' defined above. - -BUILT_SOURCES += c++defs.h -# The c++defs.h that gets inserted into generated .h files is the same as -# build-aux/snippet/c++defs.h, except that it has the copyright header cut off. -c++defs.h: $(top_srcdir)/build-aux/snippet/c++defs.h - $(AM_V_GEN)rm -f $@-t $@ && \ - sed -n -e '/_GL_CXXDEFS/,$$p' \ - < $(top_srcdir)/build-aux/snippet/c++defs.h \ - > $@-t && \ - mv $@-t $@ -MOSTLYCLEANFILES += c++defs.h c++defs.h-t - -CXXDEFS_H=c++defs.h - -EXTRA_DIST += $(top_srcdir)/build-aux/snippet/c++defs.h - -## end gnulib module snippet/c++defs - -## begin gnulib module snippet/warn-on-use - -BUILT_SOURCES += warn-on-use.h -# The warn-on-use.h that gets inserted into generated .h files is the same as -# build-aux/snippet/warn-on-use.h, except that it has the copyright header cut -# off. -warn-on-use.h: $(top_srcdir)/build-aux/snippet/warn-on-use.h - $(AM_V_GEN)rm -f $@-t $@ && \ - sed -n -e '/^.ifndef/,$$p' \ - < $(top_srcdir)/build-aux/snippet/warn-on-use.h \ - > $@-t && \ - mv $@-t $@ -MOSTLYCLEANFILES += warn-on-use.h warn-on-use.h-t - -WARN_ON_USE_H=warn-on-use.h - -EXTRA_DIST += $(top_srcdir)/build-aux/snippet/warn-on-use.h - -## end gnulib module snippet/warn-on-use - -## begin gnulib module stat - -if gl_GNULIB_ENABLED_stat - -endif -EXTRA_DIST += stat.c - -EXTRA_libgnu_a_SOURCES += stat.c - -## end gnulib module stat - -## begin gnulib module stat-time - -libgnu_a_SOURCES += stat-time.c - -EXTRA_DIST += stat-time.h - -## end gnulib module stat-time - -## begin gnulib module stdalign - -BUILT_SOURCES += $(STDALIGN_H) - -# We need the following in order to create when the system -# doesn't have one that works. -if GL_GENERATE_STDALIGN_H -stdalign.h: stdalign.in.h $(top_builddir)/config.status - $(AM_V_GEN)rm -f $@-t $@ && \ - { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ - cat $(srcdir)/stdalign.in.h; \ - } > $@-t && \ - mv $@-t $@ -else -stdalign.h: $(top_builddir)/config.status - rm -f $@ -endif -MOSTLYCLEANFILES += stdalign.h stdalign.h-t - -EXTRA_DIST += stdalign.in.h - -## end gnulib module stdalign - -## begin gnulib module stddef - -BUILT_SOURCES += $(STDDEF_H) - -# We need the following in order to create when the system -# doesn't have one that works with the given compiler. -if GL_GENERATE_STDDEF_H -stddef.h: stddef.in.h $(top_builddir)/config.status - $(AM_V_GEN)rm -f $@-t $@ && \ - { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ - sed -e 's|@''GUARD_PREFIX''@|GL|g' \ - -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ - -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ - -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ - -e 's|@''NEXT_STDDEF_H''@|$(NEXT_STDDEF_H)|g' \ - -e 's|@''HAVE_MAX_ALIGN_T''@|$(HAVE_MAX_ALIGN_T)|g' \ - -e 's|@''HAVE_WCHAR_T''@|$(HAVE_WCHAR_T)|g' \ - -e 's|@''REPLACE_NULL''@|$(REPLACE_NULL)|g' \ - < $(srcdir)/stddef.in.h; \ - } > $@-t && \ - mv $@-t $@ -else -stddef.h: $(top_builddir)/config.status - rm -f $@ -endif -MOSTLYCLEANFILES += stddef.h stddef.h-t - -EXTRA_DIST += stddef.in.h - -## end gnulib module stddef - -## begin gnulib module stdint - -BUILT_SOURCES += $(STDINT_H) - -# We need the following in order to create when the system -# doesn't have one that works with the given compiler. -if GL_GENERATE_STDINT_H -stdint.h: stdint.in.h $(top_builddir)/config.status - $(AM_V_GEN)rm -f $@-t $@ && \ - { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ - sed -e 's|@''GUARD_PREFIX''@|GL|g' \ - -e 's/@''HAVE_STDINT_H''@/$(HAVE_STDINT_H)/g' \ - -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ - -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ - -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ - -e 's|@''NEXT_STDINT_H''@|$(NEXT_STDINT_H)|g' \ - -e 's/@''HAVE_C99_STDINT_H''@/$(HAVE_C99_STDINT_H)/g' \ - -e 's/@''HAVE_SYS_TYPES_H''@/$(HAVE_SYS_TYPES_H)/g' \ - -e 's/@''HAVE_INTTYPES_H''@/$(HAVE_INTTYPES_H)/g' \ - -e 's/@''HAVE_SYS_INTTYPES_H''@/$(HAVE_SYS_INTTYPES_H)/g' \ - -e 's/@''HAVE_SYS_BITYPES_H''@/$(HAVE_SYS_BITYPES_H)/g' \ - -e 's/@''HAVE_WCHAR_H''@/$(HAVE_WCHAR_H)/g' \ - -e 's/@''HAVE_LONG_LONG_INT''@/$(HAVE_LONG_LONG_INT)/g' \ - -e 's/@''HAVE_UNSIGNED_LONG_LONG_INT''@/$(HAVE_UNSIGNED_LONG_LONG_INT)/g' \ - -e 's/@''APPLE_UNIVERSAL_BUILD''@/$(APPLE_UNIVERSAL_BUILD)/g' \ - -e 's/@''BITSIZEOF_PTRDIFF_T''@/$(BITSIZEOF_PTRDIFF_T)/g' \ - -e 's/@''PTRDIFF_T_SUFFIX''@/$(PTRDIFF_T_SUFFIX)/g' \ - -e 's/@''BITSIZEOF_SIG_ATOMIC_T''@/$(BITSIZEOF_SIG_ATOMIC_T)/g' \ - -e 's/@''HAVE_SIGNED_SIG_ATOMIC_T''@/$(HAVE_SIGNED_SIG_ATOMIC_T)/g' \ - -e 's/@''SIG_ATOMIC_T_SUFFIX''@/$(SIG_ATOMIC_T_SUFFIX)/g' \ - -e 's/@''BITSIZEOF_SIZE_T''@/$(BITSIZEOF_SIZE_T)/g' \ - -e 's/@''SIZE_T_SUFFIX''@/$(SIZE_T_SUFFIX)/g' \ - -e 's/@''BITSIZEOF_WCHAR_T''@/$(BITSIZEOF_WCHAR_T)/g' \ - -e 's/@''HAVE_SIGNED_WCHAR_T''@/$(HAVE_SIGNED_WCHAR_T)/g' \ - -e 's/@''WCHAR_T_SUFFIX''@/$(WCHAR_T_SUFFIX)/g' \ - -e 's/@''BITSIZEOF_WINT_T''@/$(BITSIZEOF_WINT_T)/g' \ - -e 's/@''HAVE_SIGNED_WINT_T''@/$(HAVE_SIGNED_WINT_T)/g' \ - -e 's/@''WINT_T_SUFFIX''@/$(WINT_T_SUFFIX)/g' \ - -e 's/@''GNULIB_OVERRIDES_WINT_T''@/$(GNULIB_OVERRIDES_WINT_T)/g' \ - < $(srcdir)/stdint.in.h; \ - } > $@-t && \ - mv $@-t $@ -else -stdint.h: $(top_builddir)/config.status - rm -f $@ -endif -MOSTLYCLEANFILES += stdint.h stdint.h-t - -EXTRA_DIST += stdint.in.h - -## end gnulib module stdint - - - -## begin gnulib module stpcpy - - -EXTRA_DIST += stpcpy.c - -EXTRA_libgnu_a_SOURCES += stpcpy.c - -## end gnulib module stpcpy - -## begin gnulib module strftime - -libgnu_a_SOURCES += strftime.c - -EXTRA_DIST += strftime.h - -## end gnulib module strftime - -## begin gnulib module string - -BUILT_SOURCES += string.h - -# We need the following in order to create when the system -# doesn't have one that works with the given compiler. -string.h: string.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) - $(AM_V_GEN)rm -f $@-t $@ && \ - { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ - sed -e 's|@''GUARD_PREFIX''@|GL|g' \ - -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ - -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ - -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ - -e 's|@''NEXT_STRING_H''@|$(NEXT_STRING_H)|g' \ - -e 's/@''GNULIB_FFSL''@/$(GNULIB_FFSL)/g' \ - -e 's/@''GNULIB_FFSLL''@/$(GNULIB_FFSLL)/g' \ - -e 's/@''GNULIB_MBSLEN''@/$(GNULIB_MBSLEN)/g' \ - -e 's/@''GNULIB_MBSNLEN''@/$(GNULIB_MBSNLEN)/g' \ - -e 's/@''GNULIB_MBSCHR''@/$(GNULIB_MBSCHR)/g' \ - -e 's/@''GNULIB_MBSRCHR''@/$(GNULIB_MBSRCHR)/g' \ - -e 's/@''GNULIB_MBSSTR''@/$(GNULIB_MBSSTR)/g' \ - -e 's/@''GNULIB_MBSCASECMP''@/$(GNULIB_MBSCASECMP)/g' \ - -e 's/@''GNULIB_MBSNCASECMP''@/$(GNULIB_MBSNCASECMP)/g' \ - -e 's/@''GNULIB_MBSPCASECMP''@/$(GNULIB_MBSPCASECMP)/g' \ - -e 's/@''GNULIB_MBSCASESTR''@/$(GNULIB_MBSCASESTR)/g' \ - -e 's/@''GNULIB_MBSCSPN''@/$(GNULIB_MBSCSPN)/g' \ - -e 's/@''GNULIB_MBSPBRK''@/$(GNULIB_MBSPBRK)/g' \ - -e 's/@''GNULIB_MBSSPN''@/$(GNULIB_MBSSPN)/g' \ - -e 's/@''GNULIB_MBSSEP''@/$(GNULIB_MBSSEP)/g' \ - -e 's/@''GNULIB_MBSTOK_R''@/$(GNULIB_MBSTOK_R)/g' \ - -e 's/@''GNULIB_MEMCHR''@/$(GNULIB_MEMCHR)/g' \ - -e 's/@''GNULIB_MEMMEM''@/$(GNULIB_MEMMEM)/g' \ - -e 's/@''GNULIB_MEMPCPY''@/$(GNULIB_MEMPCPY)/g' \ - -e 's/@''GNULIB_MEMRCHR''@/$(GNULIB_MEMRCHR)/g' \ - -e 's/@''GNULIB_RAWMEMCHR''@/$(GNULIB_RAWMEMCHR)/g' \ - -e 's/@''GNULIB_STPCPY''@/$(GNULIB_STPCPY)/g' \ - -e 's/@''GNULIB_STPNCPY''@/$(GNULIB_STPNCPY)/g' \ - -e 's/@''GNULIB_STRCHRNUL''@/$(GNULIB_STRCHRNUL)/g' \ - -e 's/@''GNULIB_STRDUP''@/$(GNULIB_STRDUP)/g' \ - -e 's/@''GNULIB_STRNCAT''@/$(GNULIB_STRNCAT)/g' \ - -e 's/@''GNULIB_STRNDUP''@/$(GNULIB_STRNDUP)/g' \ - -e 's/@''GNULIB_STRNLEN''@/$(GNULIB_STRNLEN)/g' \ - -e 's/@''GNULIB_STRPBRK''@/$(GNULIB_STRPBRK)/g' \ - -e 's/@''GNULIB_STRSEP''@/$(GNULIB_STRSEP)/g' \ - -e 's/@''GNULIB_STRSTR''@/$(GNULIB_STRSTR)/g' \ - -e 's/@''GNULIB_STRCASESTR''@/$(GNULIB_STRCASESTR)/g' \ - -e 's/@''GNULIB_STRTOK_R''@/$(GNULIB_STRTOK_R)/g' \ - -e 's/@''GNULIB_STRERROR''@/$(GNULIB_STRERROR)/g' \ - -e 's/@''GNULIB_STRERROR_R''@/$(GNULIB_STRERROR_R)/g' \ - -e 's/@''GNULIB_STRSIGNAL''@/$(GNULIB_STRSIGNAL)/g' \ - -e 's/@''GNULIB_STRVERSCMP''@/$(GNULIB_STRVERSCMP)/g' \ - < $(srcdir)/string.in.h | \ - sed -e 's|@''HAVE_FFSL''@|$(HAVE_FFSL)|g' \ - -e 's|@''HAVE_FFSLL''@|$(HAVE_FFSLL)|g' \ - -e 's|@''HAVE_MBSLEN''@|$(HAVE_MBSLEN)|g' \ - -e 's|@''HAVE_MEMCHR''@|$(HAVE_MEMCHR)|g' \ - -e 's|@''HAVE_DECL_MEMMEM''@|$(HAVE_DECL_MEMMEM)|g' \ - -e 's|@''HAVE_MEMPCPY''@|$(HAVE_MEMPCPY)|g' \ - -e 's|@''HAVE_DECL_MEMRCHR''@|$(HAVE_DECL_MEMRCHR)|g' \ - -e 's|@''HAVE_RAWMEMCHR''@|$(HAVE_RAWMEMCHR)|g' \ - -e 's|@''HAVE_STPCPY''@|$(HAVE_STPCPY)|g' \ - -e 's|@''HAVE_STPNCPY''@|$(HAVE_STPNCPY)|g' \ - -e 's|@''HAVE_STRCHRNUL''@|$(HAVE_STRCHRNUL)|g' \ - -e 's|@''HAVE_DECL_STRDUP''@|$(HAVE_DECL_STRDUP)|g' \ - -e 's|@''HAVE_DECL_STRNDUP''@|$(HAVE_DECL_STRNDUP)|g' \ - -e 's|@''HAVE_DECL_STRNLEN''@|$(HAVE_DECL_STRNLEN)|g' \ - -e 's|@''HAVE_STRPBRK''@|$(HAVE_STRPBRK)|g' \ - -e 's|@''HAVE_STRSEP''@|$(HAVE_STRSEP)|g' \ - -e 's|@''HAVE_STRCASESTR''@|$(HAVE_STRCASESTR)|g' \ - -e 's|@''HAVE_DECL_STRTOK_R''@|$(HAVE_DECL_STRTOK_R)|g' \ - -e 's|@''HAVE_DECL_STRERROR_R''@|$(HAVE_DECL_STRERROR_R)|g' \ - -e 's|@''HAVE_DECL_STRSIGNAL''@|$(HAVE_DECL_STRSIGNAL)|g' \ - -e 's|@''HAVE_STRVERSCMP''@|$(HAVE_STRVERSCMP)|g' \ - -e 's|@''REPLACE_STPNCPY''@|$(REPLACE_STPNCPY)|g' \ - -e 's|@''REPLACE_MEMCHR''@|$(REPLACE_MEMCHR)|g' \ - -e 's|@''REPLACE_MEMMEM''@|$(REPLACE_MEMMEM)|g' \ - -e 's|@''REPLACE_STRCASESTR''@|$(REPLACE_STRCASESTR)|g' \ - -e 's|@''REPLACE_STRCHRNUL''@|$(REPLACE_STRCHRNUL)|g' \ - -e 's|@''REPLACE_STRDUP''@|$(REPLACE_STRDUP)|g' \ - -e 's|@''REPLACE_STRSTR''@|$(REPLACE_STRSTR)|g' \ - -e 's|@''REPLACE_STRERROR''@|$(REPLACE_STRERROR)|g' \ - -e 's|@''REPLACE_STRERROR_R''@|$(REPLACE_STRERROR_R)|g' \ - -e 's|@''REPLACE_STRNCAT''@|$(REPLACE_STRNCAT)|g' \ - -e 's|@''REPLACE_STRNDUP''@|$(REPLACE_STRNDUP)|g' \ - -e 's|@''REPLACE_STRNLEN''@|$(REPLACE_STRNLEN)|g' \ - -e 's|@''REPLACE_STRSIGNAL''@|$(REPLACE_STRSIGNAL)|g' \ - -e 's|@''REPLACE_STRTOK_R''@|$(REPLACE_STRTOK_R)|g' \ - -e 's|@''UNDEFINE_STRTOK_R''@|$(UNDEFINE_STRTOK_R)|g' \ - -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \ - -e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \ - -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)'; \ - < $(srcdir)/string.in.h; \ - } > $@-t && \ - mv $@-t $@ -MOSTLYCLEANFILES += string.h string.h-t - -EXTRA_DIST += string.in.h - -## end gnulib module string - -## begin gnulib module strtoimax - - -EXTRA_DIST += strtoimax.c - -EXTRA_libgnu_a_SOURCES += strtoimax.c - -## end gnulib module strtoimax - -## begin gnulib module strtoll - -if gl_GNULIB_ENABLED_strtoll - -endif -EXTRA_DIST += strtol.c strtoll.c - -EXTRA_libgnu_a_SOURCES += strtol.c strtoll.c - -## end gnulib module strtoll - -## begin gnulib module strtoull - -if gl_GNULIB_ENABLED_strtoull - -endif -EXTRA_DIST += strtol.c strtoul.c strtoull.c - -EXTRA_libgnu_a_SOURCES += strtol.c strtoul.c strtoull.c - -## end gnulib module strtoull - -## begin gnulib module strtoumax - - -EXTRA_DIST += strtoimax.c strtoumax.c - -EXTRA_libgnu_a_SOURCES += strtoimax.c strtoumax.c - -## end gnulib module strtoumax - -## begin gnulib module symlink - - -EXTRA_DIST += symlink.c - -EXTRA_libgnu_a_SOURCES += symlink.c - -## end gnulib module symlink - - - - - - -## begin gnulib module time - -BUILT_SOURCES += time.h - -# We need the following in order to create when the system -# doesn't have one that works with the given compiler. -time.h: time.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) - $(AM_V_GEN)rm -f $@-t $@ && \ - { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ - sed -e 's|@''GUARD_PREFIX''@|GL|g' \ - -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ - -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ - -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ - -e 's|@''NEXT_TIME_H''@|$(NEXT_TIME_H)|g' \ - -e 's/@''GNULIB_GETTIMEOFDAY''@/$(GNULIB_GETTIMEOFDAY)/g' \ - -e 's/@''GNULIB_MKTIME''@/$(GNULIB_MKTIME)/g' \ - -e 's/@''GNULIB_NANOSLEEP''@/$(GNULIB_NANOSLEEP)/g' \ - -e 's/@''GNULIB_STRPTIME''@/$(GNULIB_STRPTIME)/g' \ - -e 's/@''GNULIB_TIMEGM''@/$(GNULIB_TIMEGM)/g' \ - -e 's/@''GNULIB_TIME_R''@/$(GNULIB_TIME_R)/g' \ - -e 's/@''GNULIB_TIME_RZ''@/$(GNULIB_TIME_RZ)/g' \ - -e 's|@''HAVE_DECL_LOCALTIME_R''@|$(HAVE_DECL_LOCALTIME_R)|g' \ - -e 's|@''HAVE_NANOSLEEP''@|$(HAVE_NANOSLEEP)|g' \ - -e 's|@''HAVE_STRPTIME''@|$(HAVE_STRPTIME)|g' \ - -e 's|@''HAVE_TIMEGM''@|$(HAVE_TIMEGM)|g' \ - -e 's|@''HAVE_TIMEZONE_T''@|$(HAVE_TIMEZONE_T)|g' \ - -e 's|@''REPLACE_GMTIME''@|$(REPLACE_GMTIME)|g' \ - -e 's|@''REPLACE_LOCALTIME''@|$(REPLACE_LOCALTIME)|g' \ - -e 's|@''REPLACE_LOCALTIME_R''@|$(REPLACE_LOCALTIME_R)|g' \ - -e 's|@''REPLACE_MKTIME''@|$(REPLACE_MKTIME)|g' \ - -e 's|@''REPLACE_NANOSLEEP''@|$(REPLACE_NANOSLEEP)|g' \ - -e 's|@''REPLACE_TIMEGM''@|$(REPLACE_TIMEGM)|g' \ - -e 's|@''PTHREAD_H_DEFINES_STRUCT_TIMESPEC''@|$(PTHREAD_H_DEFINES_STRUCT_TIMESPEC)|g' \ - -e 's|@''SYS_TIME_H_DEFINES_STRUCT_TIMESPEC''@|$(SYS_TIME_H_DEFINES_STRUCT_TIMESPEC)|g' \ - -e 's|@''TIME_H_DEFINES_STRUCT_TIMESPEC''@|$(TIME_H_DEFINES_STRUCT_TIMESPEC)|g' \ - -e 's|@''UNISTD_H_DEFINES_STRUCT_TIMESPEC''@|$(UNISTD_H_DEFINES_STRUCT_TIMESPEC)|g' \ - -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \ - -e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \ - -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)' \ - < $(srcdir)/time.in.h; \ - } > $@-t && \ - mv $@-t $@ -MOSTLYCLEANFILES += time.h time.h-t - -EXTRA_DIST += time.in.h - -## end gnulib module time - -## begin gnulib module time_r - - -EXTRA_DIST += time_r.c - -EXTRA_libgnu_a_SOURCES += time_r.c - -## end gnulib module time_r - -## begin gnulib module time_rz - - -EXTRA_DIST += time-internal.h time_rz.c - -EXTRA_libgnu_a_SOURCES += time_rz.c - -## end gnulib module time_rz - -## begin gnulib module timegm - - -EXTRA_DIST += mktime-internal.h timegm.c - -EXTRA_libgnu_a_SOURCES += timegm.c - -## end gnulib module timegm - -## begin gnulib module timespec - -libgnu_a_SOURCES += timespec.c - -EXTRA_DIST += timespec.h - -## end gnulib module timespec - -## begin gnulib module timespec-add - -libgnu_a_SOURCES += timespec-add.c - -## end gnulib module timespec-add - -## begin gnulib module timespec-sub - -libgnu_a_SOURCES += timespec-sub.c - -## end gnulib module timespec-sub - -## begin gnulib module u64 - -libgnu_a_SOURCES += u64.c - -EXTRA_DIST += u64.h - -## end gnulib module u64 - - -## begin gnulib module update-copyright - - -EXTRA_DIST += $(top_srcdir)/build-aux/update-copyright - -## end gnulib module update-copyright - -## begin gnulib module utimens - -libgnu_a_SOURCES += utimens.c - -EXTRA_DIST += utimens.h - -## end gnulib module utimens - -## begin gnulib module verify - - -EXTRA_DIST += verify.h - -## end gnulib module verify - -## begin gnulib module vla - - -EXTRA_DIST += vla.h - -## end gnulib module vla - -## begin gnulib module xalloc-oversized - -if gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec - -endif -EXTRA_DIST += xalloc-oversized.h - -## end gnulib module xalloc-oversized - - -mostlyclean-local: mostlyclean-generic - @for dir in '' $(MOSTLYCLEANDIRS); do \ - if test -n "$$dir" && test -d $$dir; then \ - echo "rmdir $$dir"; rmdir $$dir; \ - fi; \ - done; \ - : commit 29ef7d1395b955c68f12791163ce210ed7a021ca Author: Stephen Berman Date: Sun Nov 25 14:04:58 2018 +0100 Handle narrowing when marking entries of included diary files * lisp/calendar/diary-lib.el (diary-mark-entries): Widen before marking entries (bug#33423). diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index acf4b20d77..1cc59784c8 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el @@ -1412,13 +1412,15 @@ marks. This is intended to deal with deleted diary entries." (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))) (with-syntax-table diary-syntax-table (save-excursion - (diary-mark-entries-1 'calendar-mark-date-pattern) - (diary-mark-sexp-entries) - ;; Although it looks like mark-entries-hook runs every time, - ;; diary-mark-included-diary-files binds it to nil - ;; (essentially) when it runs in included files. - (run-hooks 'diary-nongregorian-marking-hook - 'diary-mark-entries-hook)))) + (save-restriction + (widen) ; bug#33423 + (diary-mark-entries-1 'calendar-mark-date-pattern) + (diary-mark-sexp-entries) + ;; Although it looks like mark-entries-hook runs every time, + ;; diary-mark-included-diary-files binds it to nil + ;; (essentially) when it runs in included files. + (run-hooks 'diary-nongregorian-marking-hook + 'diary-mark-entries-hook))))) (and temp-buff (buffer-name temp-buff) (kill-buffer temp-buff))) (or d-incp (message "Marking diary entries...done")))) diff --git a/nt/gnulib.mk b/nt/gnulib.mk new file mode 100644 index 0000000000..192f29f845 --- /dev/null +++ b/nt/gnulib.mk @@ -0,0 +1,1153 @@ +## DO NOT EDIT! GENERATED AUTOMATICALLY! +## Process this file with automake to produce Makefile.in. +# Copyright (C) 2002-2017 Free Software Foundation, Inc. +# +# This file 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. +# +# This file 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 this file. If not, see . +# +# As a special exception to the GNU General Public License, +# this file may be distributed as part of a program that +# contains a configuration script generated by Autoconf, under +# the same distribution terms as the rest of that program. +# +# Generated by gnulib-tool. +# Reproduce by: gnulib-tool --import --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=close --avoid=dup --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=setenv --avoid=sigprocmask --avoid=stdarg --avoid=stdbool --avoid=threadlib --avoid=unsetenv --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt binary-io byteswap c-ctype c-strcase careadlinkat close-stream count-one-bits count-trailing-zeros crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ execinfo faccessat fcntl fcntl-h fdatasync fdopendir filemode filevercmp flexmember fstatat fsync getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog ignore-value intprops largefile lstat manywarnings memrchr mkostemp mktime pipe2 pselect pthread_sigmask putenv qcopy-acl readlink readlinkat sig2str socklen stat-time std-gnu11 stdalign stddef stdio stpcpy strftime strtoimax strtoumax symlink sys_stat sys_time time time_r time_rz timegm timer-time timespec-add timespec-sub unsetenv update-copyright utimens vla warnings + + +MOSTLYCLEANFILES += core *.stackdump + +noinst_LIBRARIES += libgnu.a + +libgnu_a_SOURCES = +libgnu_a_LIBADD = $(gl_LIBOBJS) +libgnu_a_DEPENDENCIES = $(gl_LIBOBJS) +EXTRA_libgnu_a_SOURCES = + +## begin gnulib module absolute-header + +# Use this preprocessor expression to decide whether #include_next works. +# Do not rely on a 'configure'-time test for this, since the expression +# might appear in an installed header, which is used by some other compiler. +HAVE_INCLUDE_NEXT = (__GNUC__ || 60000000 <= __DECC_VER) + +## end gnulib module absolute-header + + +## begin gnulib module alloca-opt + +BUILT_SOURCES += $(ALLOCA_H) + +# We need the following in order to create when the system +# doesn't have one that works with the given compiler. +if GL_GENERATE_ALLOCA_H +alloca.h: alloca.in.h $(top_builddir)/config.status + $(AM_V_GEN)rm -f $@-t $@ && \ + { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ + cat $(srcdir)/alloca.in.h; \ + } > $@-t && \ + mv -f $@-t $@ +else +alloca.h: $(top_builddir)/config.status + rm -f $@ +endif +MOSTLYCLEANFILES += alloca.h alloca.h-t + +EXTRA_DIST += alloca.in.h + +## end gnulib module alloca-opt + + + +## begin gnulib module binary-io + +libgnu_a_SOURCES += binary-io.h binary-io.c + +## end gnulib module binary-io + +## begin gnulib module byteswap + +BUILT_SOURCES += $(BYTESWAP_H) + +# We need the following in order to create when the system +# doesn't have one. +if GL_GENERATE_BYTESWAP_H +byteswap.h: byteswap.in.h $(top_builddir)/config.status + $(AM_V_GEN)rm -f $@-t $@ && \ + { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ + cat $(srcdir)/byteswap.in.h; \ + } > $@-t && \ + mv -f $@-t $@ +else +byteswap.h: $(top_builddir)/config.status + rm -f $@ +endif +MOSTLYCLEANFILES += byteswap.h byteswap.h-t + +EXTRA_DIST += byteswap.in.h + +## end gnulib module byteswap + +## begin gnulib module c-ctype + +libgnu_a_SOURCES += c-ctype.h c-ctype.c + +## end gnulib module c-ctype + +## begin gnulib module c-strcase + +libgnu_a_SOURCES += c-strcase.h c-strcasecmp.c c-strncasecmp.c + +## end gnulib module c-strcase + + +## begin gnulib module close-stream + +libgnu_a_SOURCES += close-stream.c + +EXTRA_DIST += close-stream.h + +## end gnulib module close-stream + +## begin gnulib module count-one-bits + +libgnu_a_SOURCES += count-one-bits.c + +EXTRA_DIST += count-one-bits.h + +## end gnulib module count-one-bits + +## begin gnulib module count-trailing-zeros + +libgnu_a_SOURCES += count-trailing-zeros.c + +EXTRA_DIST += count-trailing-zeros.h + +## end gnulib module count-trailing-zeros + +## begin gnulib module crypto/md5 + +libgnu_a_SOURCES += md5.c + +EXTRA_DIST += gl_openssl.h md5.h + +## end gnulib module crypto/md5 + +## begin gnulib module crypto/sha1 + +libgnu_a_SOURCES += sha1.c + +EXTRA_DIST += gl_openssl.h sha1.h + +## end gnulib module crypto/sha1 + +## begin gnulib module crypto/sha256 + +libgnu_a_SOURCES += sha256.c + +EXTRA_DIST += gl_openssl.h sha256.h + +## end gnulib module crypto/sha256 + +## begin gnulib module crypto/sha512 + +libgnu_a_SOURCES += sha512.c + +EXTRA_DIST += gl_openssl.h sha512.h + +## end gnulib module crypto/sha512 + + + +## begin gnulib module dosname + +if gl_GNULIB_ENABLED_dosname + +endif +EXTRA_DIST += dosname.h + +## end gnulib module dosname + +## begin gnulib module dtoastr + +libgnu_a_SOURCES += dtoastr.c + +EXTRA_DIST += ftoastr.c ftoastr.h + +EXTRA_libgnu_a_SOURCES += ftoastr.c + +## end gnulib module dtoastr + +## begin gnulib module dtotimespec + +libgnu_a_SOURCES += dtotimespec.c + +## end gnulib module dtotimespec + +## begin gnulib module dup2 + + +EXTRA_DIST += dup2.c + +EXTRA_libgnu_a_SOURCES += dup2.c + +## end gnulib module dup2 + +## begin gnulib module errno + +BUILT_SOURCES += $(ERRNO_H) + +# We need the following in order to create when the system +# doesn't have one that is POSIX compliant. +if GL_GENERATE_ERRNO_H +errno.h: errno.in.h $(top_builddir)/config.status + $(AM_V_GEN)rm -f $@-t $@ && \ + { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ + sed -e 's|@''GUARD_PREFIX''@|GL|g' \ + -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ + -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ + -e 's|@''NEXT_ERRNO_H''@|$(NEXT_ERRNO_H)|g' \ + -e 's|@''EMULTIHOP_HIDDEN''@|$(EMULTIHOP_HIDDEN)|g' \ + -e 's|@''EMULTIHOP_VALUE''@|$(EMULTIHOP_VALUE)|g' \ + -e 's|@''ENOLINK_HIDDEN''@|$(ENOLINK_HIDDEN)|g' \ + -e 's|@''ENOLINK_VALUE''@|$(ENOLINK_VALUE)|g' \ + -e 's|@''EOVERFLOW_HIDDEN''@|$(EOVERFLOW_HIDDEN)|g' \ + -e 's|@''EOVERFLOW_VALUE''@|$(EOVERFLOW_VALUE)|g' \ + < $(srcdir)/errno.in.h; \ + } > $@-t && \ + mv $@-t $@ +else +errno.h: $(top_builddir)/config.status + rm -f $@ +endif +MOSTLYCLEANFILES += errno.h errno.h-t + +EXTRA_DIST += errno.in.h + +## end gnulib module errno + +## begin gnulib module euidaccess + +if gl_GNULIB_ENABLED_euidaccess + +endif +EXTRA_DIST += euidaccess.c + +EXTRA_libgnu_a_SOURCES += euidaccess.c + +## end gnulib module euidaccess + +## begin gnulib module execinfo + +BUILT_SOURCES += $(EXECINFO_H) + +# We need the following in order to create when the system +# doesn't have one that works. +if GL_GENERATE_EXECINFO_H +execinfo.h: execinfo.in.h $(top_builddir)/config.status + $(AM_V_GEN)rm -f $@-t $@ && \ + { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ + cat $(srcdir)/execinfo.in.h; \ + } > $@-t && \ + mv $@-t $@ +else +execinfo.h: $(top_builddir)/config.status + rm -f $@ +endif +MOSTLYCLEANFILES += execinfo.h execinfo.h-t + +EXTRA_DIST += execinfo.c execinfo.in.h + +EXTRA_libgnu_a_SOURCES += execinfo.c + +## end gnulib module execinfo + +## begin gnulib module faccessat + + +EXTRA_DIST += at-func.c faccessat.c + +EXTRA_libgnu_a_SOURCES += at-func.c faccessat.c + +## end gnulib module faccessat + + + +## begin gnulib module fdatasync + + +EXTRA_DIST += fdatasync.c + +EXTRA_libgnu_a_SOURCES += fdatasync.c + +## end gnulib module fdatasync + +## begin gnulib module fdopendir + + +EXTRA_DIST += fdopendir.c + +EXTRA_libgnu_a_SOURCES += fdopendir.c + +## end gnulib module fdopendir + +## begin gnulib module filemode + +libgnu_a_SOURCES += filemode.c + +EXTRA_DIST += filemode.h + +## end gnulib module filemode + +## begin gnulib module filevercmp + +libgnu_a_SOURCES += filevercmp.c + +EXTRA_DIST += filevercmp.h + +## end gnulib module filevercmp + +## begin gnulib module flexmember + + +EXTRA_DIST += flexmember.h + +## end gnulib module flexmember + +## begin gnulib module fpending + + +EXTRA_DIST += fpending.c fpending.h stdio-impl.h + +EXTRA_libgnu_a_SOURCES += fpending.c + +## end gnulib module fpending + +## begin gnulib module fstatat + + +EXTRA_DIST += at-func.c fstatat.c + +EXTRA_libgnu_a_SOURCES += at-func.c fstatat.c + +## end gnulib module fstatat + +## begin gnulib module fsync + + +EXTRA_DIST += fsync.c + +EXTRA_libgnu_a_SOURCES += fsync.c + +## end gnulib module fsync + +## begin gnulib module getdtablesize + +if gl_GNULIB_ENABLED_getdtablesize + +endif +EXTRA_DIST += getdtablesize.c + +EXTRA_libgnu_a_SOURCES += getdtablesize.c + +## end gnulib module getdtablesize + +## begin gnulib module getgroups + +if gl_GNULIB_ENABLED_getgroups + +endif +EXTRA_DIST += getgroups.c + +EXTRA_libgnu_a_SOURCES += getgroups.c + +## end gnulib module getgroups + +## begin gnulib module getloadavg + + +EXTRA_DIST += getloadavg.c + +EXTRA_libgnu_a_SOURCES += getloadavg.c + +## end gnulib module getloadavg + +## begin gnulib module getopt-posix + +BUILT_SOURCES += $(GETOPT_H) + +# We need the following in order to create when the system +# doesn't have one that works with the given compiler. +getopt.h: getopt.in.h $(top_builddir)/config.status $(ARG_NONNULL_H) + $(AM_V_GEN)rm -f $@-t $@ && \ + { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ + sed -e 's|@''GUARD_PREFIX''@|GL|g' \ + -e 's|@''HAVE_GETOPT_H''@|$(HAVE_GETOPT_H)|g' \ + -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ + -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ + -e 's|@''NEXT_GETOPT_H''@|$(NEXT_GETOPT_H)|g' \ + -e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \ + < $(srcdir)/getopt.in.h; \ + } > $@-t && \ + mv -f $@-t $@ +MOSTLYCLEANFILES += getopt.h getopt.h-t + +EXTRA_DIST += getopt.c getopt.in.h getopt1.c getopt_int.h + +EXTRA_libgnu_a_SOURCES += getopt.c getopt1.c + +## end gnulib module getopt-posix + +## begin gnulib module gettext-h + +if gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36 +libgnu_a_SOURCES += gettext.h + +endif +## end gnulib module gettext-h + +## begin gnulib module gettime + +libgnu_a_SOURCES += gettime.c + +## end gnulib module gettime + +## begin gnulib module gettimeofday + + +EXTRA_DIST += gettimeofday.c + +EXTRA_libgnu_a_SOURCES += gettimeofday.c + +## end gnulib module gettimeofday + +## begin gnulib module gitlog-to-changelog + + +EXTRA_DIST += $(top_srcdir)/build-aux/gitlog-to-changelog + +## end gnulib module gitlog-to-changelog + +## begin gnulib module group-member + +if gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1 + +endif +EXTRA_DIST += group-member.c + +EXTRA_libgnu_a_SOURCES += group-member.c + +## end gnulib module group-member + +## begin gnulib module ignore-value + + +EXTRA_DIST += ignore-value.h + +## end gnulib module ignore-value + +## begin gnulib module intprops + + +EXTRA_DIST += intprops.h + +## end gnulib module intprops + + +## begin gnulib module limits-h + +BUILT_SOURCES += $(LIMITS_H) + +# We need the following in order to create when the system +# doesn't have one that is compatible with GNU. +if GL_GENERATE_LIMITS_H +limits.h: limits.in.h $(top_builddir)/config.status + $(AM_V_GEN)rm -f $@-t $@ && \ + { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ + sed -e 's|@''GUARD_PREFIX''@|GL|g' \ + -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ + -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ + -e 's|@''NEXT_LIMITS_H''@|$(NEXT_LIMITS_H)|g' \ + < $(srcdir)/limits.in.h; \ + } > $@-t && \ + mv $@-t $@ +else +limits.h: $(top_builddir)/config.status + rm -f $@ +endif +MOSTLYCLEANFILES += limits.h limits.h-t + +EXTRA_DIST += limits.in.h + +## end gnulib module limits-h + +## begin gnulib module lstat + + +EXTRA_DIST += lstat.c + +EXTRA_libgnu_a_SOURCES += lstat.c + +## end gnulib module lstat + +## begin gnulib module memrchr + + +EXTRA_DIST += memrchr.c + +EXTRA_libgnu_a_SOURCES += memrchr.c + +## end gnulib module memrchr + + +## begin gnulib module mktime + + +EXTRA_DIST += mktime-internal.h mktime.c + +EXTRA_libgnu_a_SOURCES += mktime.c + +## end gnulib module mktime + +## begin gnulib module mktime-internal + +if gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31 + +endif +EXTRA_DIST += mktime-internal.h mktime.c + +EXTRA_libgnu_a_SOURCES += mktime.c + +## end gnulib module mktime-internal + +## begin gnulib module openat-h + +if gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7 + +endif +EXTRA_DIST += openat.h + +## end gnulib module openat-h + +## begin gnulib module pathmax + +if gl_GNULIB_ENABLED_pathmax + +endif +EXTRA_DIST += pathmax.h + +## end gnulib module pathmax + + +## begin gnulib module pselect + + +EXTRA_DIST += pselect.c + +EXTRA_libgnu_a_SOURCES += pselect.c + +## end gnulib module pselect + +## begin gnulib module pthread_sigmask + + +EXTRA_DIST += pthread_sigmask.c + +EXTRA_libgnu_a_SOURCES += pthread_sigmask.c + +## end gnulib module pthread_sigmask + +## begin gnulib module putenv + + +EXTRA_DIST += putenv.c + +EXTRA_libgnu_a_SOURCES += putenv.c + +## end gnulib module putenv + +## begin gnulib module qcopy-acl + +libgnu_a_SOURCES += qcopy-acl.c + +## end gnulib module qcopy-acl + +## begin gnulib module readlink + + +EXTRA_DIST += readlink.c + +EXTRA_libgnu_a_SOURCES += readlink.c + +## end gnulib module readlink + +## begin gnulib module readlinkat + + +EXTRA_DIST += at-func.c readlinkat.c + +EXTRA_libgnu_a_SOURCES += at-func.c readlinkat.c + +## end gnulib module readlinkat + +## begin gnulib module root-uid + +if gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c + +endif +EXTRA_DIST += root-uid.h + +## end gnulib module root-uid + + +## begin gnulib module sig2str + + +EXTRA_DIST += sig2str.c sig2str.h + +EXTRA_libgnu_a_SOURCES += sig2str.c + +## end gnulib module sig2str + + +## begin gnulib module snippet/_Noreturn + +# Because this Makefile snippet defines a variable used by other +# gnulib Makefile snippets, it must be present in all Makefile.am that +# need it. This is ensured by the applicability 'all' defined above. + +_NORETURN_H=$(top_srcdir)/build-aux/snippet/_Noreturn.h + +EXTRA_DIST += $(top_srcdir)/build-aux/snippet/_Noreturn.h + +## end gnulib module snippet/_Noreturn + +## begin gnulib module snippet/arg-nonnull + +# The BUILT_SOURCES created by this Makefile snippet are not used via #include +# statements but through direct file reference. Therefore this snippet must be +# present in all Makefile.am that need it. This is ensured by the applicability +# 'all' defined above. + +BUILT_SOURCES += arg-nonnull.h +# The arg-nonnull.h that gets inserted into generated .h files is the same as +# build-aux/snippet/arg-nonnull.h, except that it has the copyright header cut +# off. +arg-nonnull.h: $(top_srcdir)/build-aux/snippet/arg-nonnull.h + $(AM_V_GEN)rm -f $@-t $@ && \ + sed -n -e '/GL_ARG_NONNULL/,$$p' \ + < $(top_srcdir)/build-aux/snippet/arg-nonnull.h \ + > $@-t && \ + mv $@-t $@ +MOSTLYCLEANFILES += arg-nonnull.h arg-nonnull.h-t + +ARG_NONNULL_H=arg-nonnull.h + +EXTRA_DIST += $(top_srcdir)/build-aux/snippet/arg-nonnull.h + +## end gnulib module snippet/arg-nonnull + +## begin gnulib module snippet/c++defs + +# The BUILT_SOURCES created by this Makefile snippet are not used via #include +# statements but through direct file reference. Therefore this snippet must be +# present in all Makefile.am that need it. This is ensured by the applicability +# 'all' defined above. + +BUILT_SOURCES += c++defs.h +# The c++defs.h that gets inserted into generated .h files is the same as +# build-aux/snippet/c++defs.h, except that it has the copyright header cut off. +c++defs.h: $(top_srcdir)/build-aux/snippet/c++defs.h + $(AM_V_GEN)rm -f $@-t $@ && \ + sed -n -e '/_GL_CXXDEFS/,$$p' \ + < $(top_srcdir)/build-aux/snippet/c++defs.h \ + > $@-t && \ + mv $@-t $@ +MOSTLYCLEANFILES += c++defs.h c++defs.h-t + +CXXDEFS_H=c++defs.h + +EXTRA_DIST += $(top_srcdir)/build-aux/snippet/c++defs.h + +## end gnulib module snippet/c++defs + +## begin gnulib module snippet/warn-on-use + +BUILT_SOURCES += warn-on-use.h +# The warn-on-use.h that gets inserted into generated .h files is the same as +# build-aux/snippet/warn-on-use.h, except that it has the copyright header cut +# off. +warn-on-use.h: $(top_srcdir)/build-aux/snippet/warn-on-use.h + $(AM_V_GEN)rm -f $@-t $@ && \ + sed -n -e '/^.ifndef/,$$p' \ + < $(top_srcdir)/build-aux/snippet/warn-on-use.h \ + > $@-t && \ + mv $@-t $@ +MOSTLYCLEANFILES += warn-on-use.h warn-on-use.h-t + +WARN_ON_USE_H=warn-on-use.h + +EXTRA_DIST += $(top_srcdir)/build-aux/snippet/warn-on-use.h + +## end gnulib module snippet/warn-on-use + +## begin gnulib module stat + +if gl_GNULIB_ENABLED_stat + +endif +EXTRA_DIST += stat.c + +EXTRA_libgnu_a_SOURCES += stat.c + +## end gnulib module stat + +## begin gnulib module stat-time + +libgnu_a_SOURCES += stat-time.c + +EXTRA_DIST += stat-time.h + +## end gnulib module stat-time + +## begin gnulib module stdalign + +BUILT_SOURCES += $(STDALIGN_H) + +# We need the following in order to create when the system +# doesn't have one that works. +if GL_GENERATE_STDALIGN_H +stdalign.h: stdalign.in.h $(top_builddir)/config.status + $(AM_V_GEN)rm -f $@-t $@ && \ + { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ + cat $(srcdir)/stdalign.in.h; \ + } > $@-t && \ + mv $@-t $@ +else +stdalign.h: $(top_builddir)/config.status + rm -f $@ +endif +MOSTLYCLEANFILES += stdalign.h stdalign.h-t + +EXTRA_DIST += stdalign.in.h + +## end gnulib module stdalign + +## begin gnulib module stddef + +BUILT_SOURCES += $(STDDEF_H) + +# We need the following in order to create when the system +# doesn't have one that works with the given compiler. +if GL_GENERATE_STDDEF_H +stddef.h: stddef.in.h $(top_builddir)/config.status + $(AM_V_GEN)rm -f $@-t $@ && \ + { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ + sed -e 's|@''GUARD_PREFIX''@|GL|g' \ + -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ + -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ + -e 's|@''NEXT_STDDEF_H''@|$(NEXT_STDDEF_H)|g' \ + -e 's|@''HAVE_MAX_ALIGN_T''@|$(HAVE_MAX_ALIGN_T)|g' \ + -e 's|@''HAVE_WCHAR_T''@|$(HAVE_WCHAR_T)|g' \ + -e 's|@''REPLACE_NULL''@|$(REPLACE_NULL)|g' \ + < $(srcdir)/stddef.in.h; \ + } > $@-t && \ + mv $@-t $@ +else +stddef.h: $(top_builddir)/config.status + rm -f $@ +endif +MOSTLYCLEANFILES += stddef.h stddef.h-t + +EXTRA_DIST += stddef.in.h + +## end gnulib module stddef + +## begin gnulib module stdint + +BUILT_SOURCES += $(STDINT_H) + +# We need the following in order to create when the system +# doesn't have one that works with the given compiler. +if GL_GENERATE_STDINT_H +stdint.h: stdint.in.h $(top_builddir)/config.status + $(AM_V_GEN)rm -f $@-t $@ && \ + { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ + sed -e 's|@''GUARD_PREFIX''@|GL|g' \ + -e 's/@''HAVE_STDINT_H''@/$(HAVE_STDINT_H)/g' \ + -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ + -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ + -e 's|@''NEXT_STDINT_H''@|$(NEXT_STDINT_H)|g' \ + -e 's/@''HAVE_C99_STDINT_H''@/$(HAVE_C99_STDINT_H)/g' \ + -e 's/@''HAVE_SYS_TYPES_H''@/$(HAVE_SYS_TYPES_H)/g' \ + -e 's/@''HAVE_INTTYPES_H''@/$(HAVE_INTTYPES_H)/g' \ + -e 's/@''HAVE_SYS_INTTYPES_H''@/$(HAVE_SYS_INTTYPES_H)/g' \ + -e 's/@''HAVE_SYS_BITYPES_H''@/$(HAVE_SYS_BITYPES_H)/g' \ + -e 's/@''HAVE_WCHAR_H''@/$(HAVE_WCHAR_H)/g' \ + -e 's/@''HAVE_LONG_LONG_INT''@/$(HAVE_LONG_LONG_INT)/g' \ + -e 's/@''HAVE_UNSIGNED_LONG_LONG_INT''@/$(HAVE_UNSIGNED_LONG_LONG_INT)/g' \ + -e 's/@''APPLE_UNIVERSAL_BUILD''@/$(APPLE_UNIVERSAL_BUILD)/g' \ + -e 's/@''BITSIZEOF_PTRDIFF_T''@/$(BITSIZEOF_PTRDIFF_T)/g' \ + -e 's/@''PTRDIFF_T_SUFFIX''@/$(PTRDIFF_T_SUFFIX)/g' \ + -e 's/@''BITSIZEOF_SIG_ATOMIC_T''@/$(BITSIZEOF_SIG_ATOMIC_T)/g' \ + -e 's/@''HAVE_SIGNED_SIG_ATOMIC_T''@/$(HAVE_SIGNED_SIG_ATOMIC_T)/g' \ + -e 's/@''SIG_ATOMIC_T_SUFFIX''@/$(SIG_ATOMIC_T_SUFFIX)/g' \ + -e 's/@''BITSIZEOF_SIZE_T''@/$(BITSIZEOF_SIZE_T)/g' \ + -e 's/@''SIZE_T_SUFFIX''@/$(SIZE_T_SUFFIX)/g' \ + -e 's/@''BITSIZEOF_WCHAR_T''@/$(BITSIZEOF_WCHAR_T)/g' \ + -e 's/@''HAVE_SIGNED_WCHAR_T''@/$(HAVE_SIGNED_WCHAR_T)/g' \ + -e 's/@''WCHAR_T_SUFFIX''@/$(WCHAR_T_SUFFIX)/g' \ + -e 's/@''BITSIZEOF_WINT_T''@/$(BITSIZEOF_WINT_T)/g' \ + -e 's/@''HAVE_SIGNED_WINT_T''@/$(HAVE_SIGNED_WINT_T)/g' \ + -e 's/@''WINT_T_SUFFIX''@/$(WINT_T_SUFFIX)/g' \ + -e 's/@''GNULIB_OVERRIDES_WINT_T''@/$(GNULIB_OVERRIDES_WINT_T)/g' \ + < $(srcdir)/stdint.in.h; \ + } > $@-t && \ + mv $@-t $@ +else +stdint.h: $(top_builddir)/config.status + rm -f $@ +endif +MOSTLYCLEANFILES += stdint.h stdint.h-t + +EXTRA_DIST += stdint.in.h + +## end gnulib module stdint + + + +## begin gnulib module stpcpy + + +EXTRA_DIST += stpcpy.c + +EXTRA_libgnu_a_SOURCES += stpcpy.c + +## end gnulib module stpcpy + +## begin gnulib module strftime + +libgnu_a_SOURCES += strftime.c + +EXTRA_DIST += strftime.h + +## end gnulib module strftime + +## begin gnulib module string + +BUILT_SOURCES += string.h + +# We need the following in order to create when the system +# doesn't have one that works with the given compiler. +string.h: string.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) + $(AM_V_GEN)rm -f $@-t $@ && \ + { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ + sed -e 's|@''GUARD_PREFIX''@|GL|g' \ + -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ + -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ + -e 's|@''NEXT_STRING_H''@|$(NEXT_STRING_H)|g' \ + -e 's/@''GNULIB_FFSL''@/$(GNULIB_FFSL)/g' \ + -e 's/@''GNULIB_FFSLL''@/$(GNULIB_FFSLL)/g' \ + -e 's/@''GNULIB_MBSLEN''@/$(GNULIB_MBSLEN)/g' \ + -e 's/@''GNULIB_MBSNLEN''@/$(GNULIB_MBSNLEN)/g' \ + -e 's/@''GNULIB_MBSCHR''@/$(GNULIB_MBSCHR)/g' \ + -e 's/@''GNULIB_MBSRCHR''@/$(GNULIB_MBSRCHR)/g' \ + -e 's/@''GNULIB_MBSSTR''@/$(GNULIB_MBSSTR)/g' \ + -e 's/@''GNULIB_MBSCASECMP''@/$(GNULIB_MBSCASECMP)/g' \ + -e 's/@''GNULIB_MBSNCASECMP''@/$(GNULIB_MBSNCASECMP)/g' \ + -e 's/@''GNULIB_MBSPCASECMP''@/$(GNULIB_MBSPCASECMP)/g' \ + -e 's/@''GNULIB_MBSCASESTR''@/$(GNULIB_MBSCASESTR)/g' \ + -e 's/@''GNULIB_MBSCSPN''@/$(GNULIB_MBSCSPN)/g' \ + -e 's/@''GNULIB_MBSPBRK''@/$(GNULIB_MBSPBRK)/g' \ + -e 's/@''GNULIB_MBSSPN''@/$(GNULIB_MBSSPN)/g' \ + -e 's/@''GNULIB_MBSSEP''@/$(GNULIB_MBSSEP)/g' \ + -e 's/@''GNULIB_MBSTOK_R''@/$(GNULIB_MBSTOK_R)/g' \ + -e 's/@''GNULIB_MEMCHR''@/$(GNULIB_MEMCHR)/g' \ + -e 's/@''GNULIB_MEMMEM''@/$(GNULIB_MEMMEM)/g' \ + -e 's/@''GNULIB_MEMPCPY''@/$(GNULIB_MEMPCPY)/g' \ + -e 's/@''GNULIB_MEMRCHR''@/$(GNULIB_MEMRCHR)/g' \ + -e 's/@''GNULIB_RAWMEMCHR''@/$(GNULIB_RAWMEMCHR)/g' \ + -e 's/@''GNULIB_STPCPY''@/$(GNULIB_STPCPY)/g' \ + -e 's/@''GNULIB_STPNCPY''@/$(GNULIB_STPNCPY)/g' \ + -e 's/@''GNULIB_STRCHRNUL''@/$(GNULIB_STRCHRNUL)/g' \ + -e 's/@''GNULIB_STRDUP''@/$(GNULIB_STRDUP)/g' \ + -e 's/@''GNULIB_STRNCAT''@/$(GNULIB_STRNCAT)/g' \ + -e 's/@''GNULIB_STRNDUP''@/$(GNULIB_STRNDUP)/g' \ + -e 's/@''GNULIB_STRNLEN''@/$(GNULIB_STRNLEN)/g' \ + -e 's/@''GNULIB_STRPBRK''@/$(GNULIB_STRPBRK)/g' \ + -e 's/@''GNULIB_STRSEP''@/$(GNULIB_STRSEP)/g' \ + -e 's/@''GNULIB_STRSTR''@/$(GNULIB_STRSTR)/g' \ + -e 's/@''GNULIB_STRCASESTR''@/$(GNULIB_STRCASESTR)/g' \ + -e 's/@''GNULIB_STRTOK_R''@/$(GNULIB_STRTOK_R)/g' \ + -e 's/@''GNULIB_STRERROR''@/$(GNULIB_STRERROR)/g' \ + -e 's/@''GNULIB_STRERROR_R''@/$(GNULIB_STRERROR_R)/g' \ + -e 's/@''GNULIB_STRSIGNAL''@/$(GNULIB_STRSIGNAL)/g' \ + -e 's/@''GNULIB_STRVERSCMP''@/$(GNULIB_STRVERSCMP)/g' \ + < $(srcdir)/string.in.h | \ + sed -e 's|@''HAVE_FFSL''@|$(HAVE_FFSL)|g' \ + -e 's|@''HAVE_FFSLL''@|$(HAVE_FFSLL)|g' \ + -e 's|@''HAVE_MBSLEN''@|$(HAVE_MBSLEN)|g' \ + -e 's|@''HAVE_MEMCHR''@|$(HAVE_MEMCHR)|g' \ + -e 's|@''HAVE_DECL_MEMMEM''@|$(HAVE_DECL_MEMMEM)|g' \ + -e 's|@''HAVE_MEMPCPY''@|$(HAVE_MEMPCPY)|g' \ + -e 's|@''HAVE_DECL_MEMRCHR''@|$(HAVE_DECL_MEMRCHR)|g' \ + -e 's|@''HAVE_RAWMEMCHR''@|$(HAVE_RAWMEMCHR)|g' \ + -e 's|@''HAVE_STPCPY''@|$(HAVE_STPCPY)|g' \ + -e 's|@''HAVE_STPNCPY''@|$(HAVE_STPNCPY)|g' \ + -e 's|@''HAVE_STRCHRNUL''@|$(HAVE_STRCHRNUL)|g' \ + -e 's|@''HAVE_DECL_STRDUP''@|$(HAVE_DECL_STRDUP)|g' \ + -e 's|@''HAVE_DECL_STRNDUP''@|$(HAVE_DECL_STRNDUP)|g' \ + -e 's|@''HAVE_DECL_STRNLEN''@|$(HAVE_DECL_STRNLEN)|g' \ + -e 's|@''HAVE_STRPBRK''@|$(HAVE_STRPBRK)|g' \ + -e 's|@''HAVE_STRSEP''@|$(HAVE_STRSEP)|g' \ + -e 's|@''HAVE_STRCASESTR''@|$(HAVE_STRCASESTR)|g' \ + -e 's|@''HAVE_DECL_STRTOK_R''@|$(HAVE_DECL_STRTOK_R)|g' \ + -e 's|@''HAVE_DECL_STRERROR_R''@|$(HAVE_DECL_STRERROR_R)|g' \ + -e 's|@''HAVE_DECL_STRSIGNAL''@|$(HAVE_DECL_STRSIGNAL)|g' \ + -e 's|@''HAVE_STRVERSCMP''@|$(HAVE_STRVERSCMP)|g' \ + -e 's|@''REPLACE_STPNCPY''@|$(REPLACE_STPNCPY)|g' \ + -e 's|@''REPLACE_MEMCHR''@|$(REPLACE_MEMCHR)|g' \ + -e 's|@''REPLACE_MEMMEM''@|$(REPLACE_MEMMEM)|g' \ + -e 's|@''REPLACE_STRCASESTR''@|$(REPLACE_STRCASESTR)|g' \ + -e 's|@''REPLACE_STRCHRNUL''@|$(REPLACE_STRCHRNUL)|g' \ + -e 's|@''REPLACE_STRDUP''@|$(REPLACE_STRDUP)|g' \ + -e 's|@''REPLACE_STRSTR''@|$(REPLACE_STRSTR)|g' \ + -e 's|@''REPLACE_STRERROR''@|$(REPLACE_STRERROR)|g' \ + -e 's|@''REPLACE_STRERROR_R''@|$(REPLACE_STRERROR_R)|g' \ + -e 's|@''REPLACE_STRNCAT''@|$(REPLACE_STRNCAT)|g' \ + -e 's|@''REPLACE_STRNDUP''@|$(REPLACE_STRNDUP)|g' \ + -e 's|@''REPLACE_STRNLEN''@|$(REPLACE_STRNLEN)|g' \ + -e 's|@''REPLACE_STRSIGNAL''@|$(REPLACE_STRSIGNAL)|g' \ + -e 's|@''REPLACE_STRTOK_R''@|$(REPLACE_STRTOK_R)|g' \ + -e 's|@''UNDEFINE_STRTOK_R''@|$(UNDEFINE_STRTOK_R)|g' \ + -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \ + -e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \ + -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)'; \ + < $(srcdir)/string.in.h; \ + } > $@-t && \ + mv $@-t $@ +MOSTLYCLEANFILES += string.h string.h-t + +EXTRA_DIST += string.in.h + +## end gnulib module string + +## begin gnulib module strtoimax + + +EXTRA_DIST += strtoimax.c + +EXTRA_libgnu_a_SOURCES += strtoimax.c + +## end gnulib module strtoimax + +## begin gnulib module strtoll + +if gl_GNULIB_ENABLED_strtoll + +endif +EXTRA_DIST += strtol.c strtoll.c + +EXTRA_libgnu_a_SOURCES += strtol.c strtoll.c + +## end gnulib module strtoll + +## begin gnulib module strtoull + +if gl_GNULIB_ENABLED_strtoull + +endif +EXTRA_DIST += strtol.c strtoul.c strtoull.c + +EXTRA_libgnu_a_SOURCES += strtol.c strtoul.c strtoull.c + +## end gnulib module strtoull + +## begin gnulib module strtoumax + + +EXTRA_DIST += strtoimax.c strtoumax.c + +EXTRA_libgnu_a_SOURCES += strtoimax.c strtoumax.c + +## end gnulib module strtoumax + +## begin gnulib module symlink + + +EXTRA_DIST += symlink.c + +EXTRA_libgnu_a_SOURCES += symlink.c + +## end gnulib module symlink + + + + + + +## begin gnulib module time + +BUILT_SOURCES += time.h + +# We need the following in order to create when the system +# doesn't have one that works with the given compiler. +time.h: time.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) + $(AM_V_GEN)rm -f $@-t $@ && \ + { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ + sed -e 's|@''GUARD_PREFIX''@|GL|g' \ + -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ + -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ + -e 's|@''NEXT_TIME_H''@|$(NEXT_TIME_H)|g' \ + -e 's/@''GNULIB_GETTIMEOFDAY''@/$(GNULIB_GETTIMEOFDAY)/g' \ + -e 's/@''GNULIB_MKTIME''@/$(GNULIB_MKTIME)/g' \ + -e 's/@''GNULIB_NANOSLEEP''@/$(GNULIB_NANOSLEEP)/g' \ + -e 's/@''GNULIB_STRPTIME''@/$(GNULIB_STRPTIME)/g' \ + -e 's/@''GNULIB_TIMEGM''@/$(GNULIB_TIMEGM)/g' \ + -e 's/@''GNULIB_TIME_R''@/$(GNULIB_TIME_R)/g' \ + -e 's/@''GNULIB_TIME_RZ''@/$(GNULIB_TIME_RZ)/g' \ + -e 's|@''HAVE_DECL_LOCALTIME_R''@|$(HAVE_DECL_LOCALTIME_R)|g' \ + -e 's|@''HAVE_NANOSLEEP''@|$(HAVE_NANOSLEEP)|g' \ + -e 's|@''HAVE_STRPTIME''@|$(HAVE_STRPTIME)|g' \ + -e 's|@''HAVE_TIMEGM''@|$(HAVE_TIMEGM)|g' \ + -e 's|@''HAVE_TIMEZONE_T''@|$(HAVE_TIMEZONE_T)|g' \ + -e 's|@''REPLACE_GMTIME''@|$(REPLACE_GMTIME)|g' \ + -e 's|@''REPLACE_LOCALTIME''@|$(REPLACE_LOCALTIME)|g' \ + -e 's|@''REPLACE_LOCALTIME_R''@|$(REPLACE_LOCALTIME_R)|g' \ + -e 's|@''REPLACE_MKTIME''@|$(REPLACE_MKTIME)|g' \ + -e 's|@''REPLACE_NANOSLEEP''@|$(REPLACE_NANOSLEEP)|g' \ + -e 's|@''REPLACE_TIMEGM''@|$(REPLACE_TIMEGM)|g' \ + -e 's|@''PTHREAD_H_DEFINES_STRUCT_TIMESPEC''@|$(PTHREAD_H_DEFINES_STRUCT_TIMESPEC)|g' \ + -e 's|@''SYS_TIME_H_DEFINES_STRUCT_TIMESPEC''@|$(SYS_TIME_H_DEFINES_STRUCT_TIMESPEC)|g' \ + -e 's|@''TIME_H_DEFINES_STRUCT_TIMESPEC''@|$(TIME_H_DEFINES_STRUCT_TIMESPEC)|g' \ + -e 's|@''UNISTD_H_DEFINES_STRUCT_TIMESPEC''@|$(UNISTD_H_DEFINES_STRUCT_TIMESPEC)|g' \ + -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \ + -e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \ + -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)' \ + < $(srcdir)/time.in.h; \ + } > $@-t && \ + mv $@-t $@ +MOSTLYCLEANFILES += time.h time.h-t + +EXTRA_DIST += time.in.h + +## end gnulib module time + +## begin gnulib module time_r + + +EXTRA_DIST += time_r.c + +EXTRA_libgnu_a_SOURCES += time_r.c + +## end gnulib module time_r + +## begin gnulib module time_rz + + +EXTRA_DIST += time-internal.h time_rz.c + +EXTRA_libgnu_a_SOURCES += time_rz.c + +## end gnulib module time_rz + +## begin gnulib module timegm + + +EXTRA_DIST += mktime-internal.h timegm.c + +EXTRA_libgnu_a_SOURCES += timegm.c + +## end gnulib module timegm + +## begin gnulib module timespec + +libgnu_a_SOURCES += timespec.c + +EXTRA_DIST += timespec.h + +## end gnulib module timespec + +## begin gnulib module timespec-add + +libgnu_a_SOURCES += timespec-add.c + +## end gnulib module timespec-add + +## begin gnulib module timespec-sub + +libgnu_a_SOURCES += timespec-sub.c + +## end gnulib module timespec-sub + +## begin gnulib module u64 + +libgnu_a_SOURCES += u64.c + +EXTRA_DIST += u64.h + +## end gnulib module u64 + + +## begin gnulib module update-copyright + + +EXTRA_DIST += $(top_srcdir)/build-aux/update-copyright + +## end gnulib module update-copyright + +## begin gnulib module utimens + +libgnu_a_SOURCES += utimens.c + +EXTRA_DIST += utimens.h + +## end gnulib module utimens + +## begin gnulib module verify + + +EXTRA_DIST += verify.h + +## end gnulib module verify + +## begin gnulib module vla + + +EXTRA_DIST += vla.h + +## end gnulib module vla + +## begin gnulib module xalloc-oversized + +if gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec + +endif +EXTRA_DIST += xalloc-oversized.h + +## end gnulib module xalloc-oversized + + +mostlyclean-local: mostlyclean-generic + @for dir in '' $(MOSTLYCLEANDIRS); do \ + if test -n "$$dir" && test -d $$dir; then \ + echo "rmdir $$dir"; rmdir $$dir; \ + fi; \ + done; \ + : commit ea624626ccc2a108c3d6420d4f7ed3edae185425 Author: Alan Third Date: Sat Nov 24 09:30:17 2018 +0000 Set tooltip text color (bug#33452) ; Do not merge into master * src/nsmenu.m: ([EmacsTooltip init]): Set text color to black. diff --git a/src/nsmenu.m b/src/nsmenu.m index 604adcf40b..52a7d52e8e 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -1318,8 +1318,9 @@ @implementation EmacsTooltip - (instancetype)init { - NSColor *col = [NSColor colorWithCalibratedRed: 1.0 green: 1.0 + NSColor *bgcol = [NSColor colorWithCalibratedRed: 1.0 green: 1.0 blue: 0.792 alpha: 0.95]; + NSColor *fgcol = [NSColor blackColor]; NSFont *font = [NSFont toolTipsFontOfSize: 0]; NSFont *sfont = [font screenFont]; int height = [sfont ascender] - [sfont descender]; @@ -1328,7 +1329,8 @@ - (instancetype)init textField = [[NSTextField alloc] initWithFrame: r]; [textField setFont: font]; - [textField setBackgroundColor: col]; + [textField setTextColor: fgcol]; + [textField setBackgroundColor: bgcol]; [textField setEditable: NO]; [textField setSelectable: NO]; @@ -1345,7 +1347,7 @@ - (instancetype)init [win setReleasedWhenClosed: NO]; [win setDelegate: self]; [[win contentView] addSubview: textField]; -/* [win setBackgroundColor: col]; */ +/* [win setBackgroundColor: bgcol]; */ [win setOpaque: NO]; return self; commit 094fcf62d289f19a4633275812e9e5e500463e91 Author: Alan Third Date: Mon Oct 29 15:37:35 2018 +0000 Fix more drawing bugs in NS port (bug#32932) * src/nsterm.m (ns_row_rect): New function. (ns_clip_to_row): Remove function. (ns_copy_bits): Fix mistake. (ns_shift_glyphs_for_insert): Mark the frame as dirty instead of directly copying. (ns_draw_fringe_bitmap): Stop using ns_clip_to_row. (ns_draw_window_cursor): Stop using ns_clip_to_row and perform a display when not in redisplay. (ns_update_window_begin): Remove redundant code that never executes. ([EmacsView drawRect:]): Show the rectangle being exposed in NSTRACE. * src/xdisp.c (expose_window_tree) [HAVE_NS]: (expose_frame) [HAVE_NS]: Redraw even if the frame is garbaged. diff --git a/src/nsterm.m b/src/nsterm.m index 4b5d025ee3..948dd1da2e 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -796,6 +796,27 @@ Free a pool and temporary objects it refers to (callable from C) } +static NSRect +ns_row_rect (struct window *w, struct glyph_row *row, + enum glyph_row_area area) +/* Get the row as an NSRect. */ +{ + struct frame *f = XFRAME (WINDOW_FRAME (w)); + NSRect rect; + int window_x, window_y, window_width; + + window_box (w, area, &window_x, &window_y, &window_width, 0); + + rect.origin.x = window_x; + rect.origin.y = WINDOW_TO_FRAME_PIXEL_Y (w, max (0, row->y)); + rect.origin.y = max (rect.origin.y, window_y); + rect.size.width = window_width; + rect.size.height = row->visible_height; + + return rect; +} + + /* ========================================================================== Focus (clipping) and screen update @@ -1048,29 +1069,6 @@ static NSRect constrain_frame_rect(NSRect frameRect, bool isFullscreen) if (! tbar_visible != ! [toolbar isVisible]) [toolbar setVisible: tbar_visible]; } - - /* drawRect may have been called for say the minibuffer, and then clip path - is for the minibuffer. But the display engine may draw more because - we have set the frame as garbaged. So reset clip path to the whole - view. */ - /* FIXME: I don't think we need to do this. */ - if ([NSView focusView] == FRAME_NS_VIEW (f)) - { - NSBezierPath *bp; - NSRect r = [view frame]; - NSRect cr = [[view window] frame]; - /* If a large frame size is set, r may be larger than the window frame - before constrained. In that case don't change the clip path, as we - will clear in to the tool bar and title bar. */ - if (r.size.height - + FRAME_NS_TITLEBAR_HEIGHT (f) - + FRAME_TOOLBAR_HEIGHT (f) <= cr.size.height) - { - bp = [[NSBezierPath bezierPathWithRect: r] retain]; - [bp setClip]; - [bp release]; - } - } #endif } @@ -1206,28 +1204,6 @@ static NSRect constrain_frame_rect(NSRect frameRect, bool isFullscreen) } -static BOOL -ns_clip_to_row (struct window *w, struct glyph_row *row, - enum glyph_row_area area, BOOL gc) -/* -------------------------------------------------------------------------- - Internal (but parallels other terms): Focus drawing on given row - -------------------------------------------------------------------------- */ -{ - struct frame *f = XFRAME (WINDOW_FRAME (w)); - NSRect clip_rect; - int window_x, window_y, window_width; - - window_box (w, area, &window_x, &window_y, &window_width, 0); - - clip_rect.origin.x = window_x; - clip_rect.origin.y = WINDOW_TO_FRAME_PIXEL_Y (w, max (0, row->y)); - clip_rect.origin.y = max (clip_rect.origin.y, window_y); - clip_rect.size.width = window_width; - clip_rect.size.height = row->visible_height; - - return ns_clip_to_rect (f, &clip_rect, 1); -} - /* ========================================================================== Visible bell and beep. @@ -2692,7 +2668,7 @@ so some key presses (TAB) are swallowed by the system. */ ns_copy_bits (struct frame *f, NSRect src, NSRect dest) { NSSize delta = NSMakeSize (dest.origin.x - src.origin.x, - dest.origin.y - src.origin.y) + dest.origin.y - src.origin.y); NSTRACE ("ns_copy_bits"); if (FRAME_NS_VIEW (f)) @@ -2825,12 +2801,20 @@ so some key presses (TAB) are swallowed by the system. */ External (RIF): copy an area horizontally, don't worry about clearing src -------------------------------------------------------------------------- */ { - NSRect srcRect = NSMakeRect (x, y, width, height); + //NSRect srcRect = NSMakeRect (x, y, width, height); NSRect dstRect = NSMakeRect (x+shift_by, y, width, height); NSTRACE ("ns_shift_glyphs_for_insert"); - ns_copy_bits (f, srcRect, dstRect); + /* This doesn't work now as we copy the "bits" before we've had a + chance to actually draw any changes to the screen. This means in + certain circumstances we end up with copies of the cursor all + over the place. Just mark the area dirty so it is redrawn later. + + FIXME: Work out how to do this properly. */ + // ns_copy_bits (f, srcRect, dstRect); + + [FRAME_NS_VIEW (f) setNeedsDisplayInRect:dstRect]; } @@ -2911,6 +2895,9 @@ so some key presses (TAB) are swallowed by the system. */ struct face *face = p->face; static EmacsImage **bimgs = NULL; static int nBimgs = 0; + NSRect clearRect = NSZeroRect; + NSRect imageRect = NSZeroRect; + NSRect rowRect = ns_row_rect (w, row, ANY_AREA); NSTRACE_WHEN (NSTRACE_GROUP_FRINGE, "ns_draw_fringe_bitmap"); NSTRACE_MSG ("which:%d cursor:%d overlay:%d width:%d height:%d period:%d", @@ -2925,25 +2912,40 @@ so some key presses (TAB) are swallowed by the system. */ nBimgs = max_used_fringe_bitmap; } - /* Must clip because of partially visible lines. */ - if (ns_clip_to_row (w, row, ANY_AREA, YES)) + /* Work out the rectangle we will composite into. */ + if (p->which) + imageRect = NSMakeRect (p->x, p->y, p->wd, p->h); + + /* Work out the rectangle we will need to clear. Because we're + compositing rather than blitting, we need to clear the area under + the image regardless of anything else. */ + if (!p->overlay_p) + { + clearRect = NSMakeRect (p->bx, p->by, p->nx, p->ny); + clearRect = NSUnionRect (clearRect, imageRect); + } + else + { + clearRect = imageRect; + } + + /* Handle partially visible rows. */ + clearRect = NSIntersectionRect (clearRect, rowRect); + + /* The visible portion of imageRect will always be contained within + clearRect. */ + if (ns_clip_to_rect (f, &clearRect, 1)) { - if (!p->overlay_p) + if (! NSIsEmptyRect (clearRect)) { - int bx = p->bx, by = p->by, nx = p->nx, ny = p->ny; + NSTRACE_RECT ("clearRect", clearRect); - if (bx >= 0 && nx > 0) - { - NSRect r = NSMakeRect (bx, by, nx, ny); - NSRectClip (r); - [ns_lookup_indexed_color (face->background, f) set]; - NSRectFill (r); - } + [ns_lookup_indexed_color(face->background, f) set]; + NSRectFill (clearRect); } if (p->which) { - NSRect r = NSMakeRect (p->x, p->y, p->wd, p->h); EmacsImage *img = bimgs[p->which - 1]; if (!img) @@ -2964,13 +2966,6 @@ so some key presses (TAB) are swallowed by the system. */ xfree (cbits); } - NSTRACE_RECT ("r", r); - - NSRectClip (r); - /* Since we composite the bitmap instead of just blitting it, we need - to erase the whole background. */ - [ns_lookup_indexed_color(face->background, f) set]; - NSRectFill (r); { NSColor *bm_color; @@ -2990,7 +2985,7 @@ so some key presses (TAB) are swallowed by the system. */ NSTRACE_RECT ("fromRect", fromRect); - [img drawInRect: r + [img drawInRect: imageRect fromRect: fromRect operation: NSCompositingOperationSourceOver fraction: 1.0 @@ -2998,7 +2993,7 @@ so some key presses (TAB) are swallowed by the system. */ hints: nil]; #else { - NSPoint pt = r.origin; + NSPoint pt = imageRect.origin; pt.y += p->h; [img compositeToPoint: pt operation: NSCompositingOperationSourceOver]; } @@ -3088,7 +3083,9 @@ Note that CURSOR_WIDTH is meaningful only for (h)bar cursors. r.size.width = w->phys_cursor_width; /* Prevent the cursor from being drawn outside the text area. */ - if (ns_clip_to_row (w, glyph_row, TEXT_AREA, NO)) + r = NSIntersectionRect (r, ns_row_rect (w, glyph_row, TEXT_AREA)); + + if (ns_clip_to_rect (f, &r, 1)) { face = FACE_FROM_ID_OR_NULL (f, phys_cursor_glyph->face_id); if (face && NS_FACE_BACKGROUND (face) @@ -3128,11 +3125,18 @@ Note that CURSOR_WIDTH is meaningful only for (h)bar cursors. NSRectFill (s); break; } - ns_reset_clipping (f); /* draw the character under the cursor */ if (cursor_type != NO_CURSOR) draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); + + ns_reset_clipping (f); + } + else if (! redisplaying_p) + { + /* If this function is called outside redisplay, it probably + means we need an immediate update. */ + [FRAME_NS_VIEW (f) display]; } } @@ -8096,6 +8100,9 @@ - (void)drawRect: (NSRect)rect for (int i = 0 ; i < numRects ; i++) { NSRect r = rectList[i]; + + NSTRACE_RECT ("r", r); + expose_frame (emacsframe, NSMinX (r), NSMinY (r), NSWidth (r), NSHeight (r)); diff --git a/src/xdisp.c b/src/xdisp.c index 357f0fb30c..808eab7e53 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -32258,7 +32258,14 @@ expose_window_tree (struct window *w, XRectangle *r) struct frame *f = XFRAME (w->frame); bool mouse_face_overwritten_p = false; - while (w && !FRAME_GARBAGED_P (f)) + /* NS toolkits may have aleady modified the frame in expectation of + a successful redraw, so don't bail out here if the frame is + garbaged. */ + while (w +#if !defined (HAVE_NS) + && !FRAME_GARBAGED_P (f) +#endif + ) { mouse_face_overwritten_p |= (WINDOWP (w->contents) @@ -32286,12 +32293,16 @@ expose_frame (struct frame *f, int x, int y, int w, int h) TRACE ((stderr, "expose_frame ")); - /* No need to redraw if frame will be redrawn soon. */ +#if !defined (HAVE_NS) + /* No need to redraw if frame will be redrawn soon except under NS + where the toolkit may have already modified the frame in + expectation of us redrawing it. */ if (FRAME_GARBAGED_P (f)) { TRACE ((stderr, " garbaged\n")); return; } +#endif /* If basic faces haven't been realized yet, there is no point in trying to redraw anything. This can happen when we get an expose commit 7559c6a8ba3964a8b1c7a699e39453d538e1c5f6 Author: Juri Linkov Date: Sun Nov 25 00:59:15 2018 +0200 Add new Isearch commands to new Isearch menu (bug#29321, bug#32990) * lisp/isearch.el (isearch-menu-bar-map): Add menu items for isearch-beginning-of-buffer and isearch-end-of-buffer. (isearch-forward): Add them to docstring. diff --git a/lisp/isearch.el b/lisp/isearch.el index 5913ea8a6b..eb0b25f9b1 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -623,6 +623,12 @@ This is like `describe-bindings', but displays only Isearch keys." (define-key map [isearch-delete-char] '(menu-item "Undo last input item" isearch-delete-char :help "Undo the effect of the last Isearch command")) + (define-key map [isearch-end-of-buffer] + '(menu-item "Go to last match" isearch-end-of-buffer + :help "Go to last occurrence of current search string")) + (define-key map [isearch-beginning-of-buffer] + '(menu-item "Go to first match" isearch-beginning-of-buffer + :help "Go to first occurrence of current search string")) (define-key map [isearch-repeat-backward] '(menu-item "Repeat search backward" isearch-repeat-backward :help "Repeat current search backward")) @@ -978,6 +984,8 @@ Type \\[isearch-exit] to exit, leaving point at location found. Type LFD (C-j) to match end of line. Type \\[isearch-repeat-forward] to search again forward,\ \\[isearch-repeat-backward] to search again backward. +Type \\[isearch-beginning-of-buffer] to go to the first match,\ + \\[isearch-end-of-buffer] to go to the last match. Type \\[isearch-yank-word-or-char] to yank next word or character in buffer onto the end of the search string, and search for it. Type \\[isearch-del-char] to delete character from end of search string. commit 3aa22e6ec615c5dadb134f1e45ee9bb3034518b7 Merge: 0525b49511 9877c03293 Author: Glenn Morris Date: Sat Nov 24 07:51:04 2018 -0800 Merge from origin/emacs-26 9877c03 (origin/emacs-26) Fix bug #33416, where typing a ) in a comme... commit 0525b495112f7ca1c356166db65576c717e88eec Merge: 023502af45 25a4205271 Author: Glenn Morris Date: Sat Nov 24 07:51:04 2018 -0800 ; Merge from origin/emacs-26 The following commit was skipped: 25a4205 Update the calc units table commit 023502af450f9af3ab80747e5be4812cbc750f45 Merge: dcacff4195 56e3e4fe68 Author: Glenn Morris Date: Sat Nov 24 07:51:04 2018 -0800 Merge from origin/emacs-26 56e3e4f Improve indexing in the ELisp manual 7a4992a More Symbola-related extensions for default fontset 4ae0a75 Better support for display of U+1F900..U+1F9FF block 8f0c788 Improve documentation of 'edit-abbrevs-mode' 3c643e7 ; NEWS tweak 477414a Improve documentation of 'dired-do-compress' 9c09b1d ; * etc/NES: Minor change in the description of Dired's 'Z'. 52715e3 Improve doc string and display of 'describe-character' 93242b1 * etc/NEWS: Clarify what 'Z' does in Dired. (Bug#33450) 0d59ae3 Update the docs of object internals Conflicts: etc/NEWS commit dcacff41958d6dc12baf05e7e9de13d1ab5b09ae Merge: a7d9c38da5 57b14370cd Author: Michael Albinus Date: Sat Nov 24 14:01:53 2018 +0100 Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs commit a7d9c38da52f413410e17a65d1e90b89edb6cbc4 Author: Michael Albinus Date: Sat Nov 24 14:01:36 2018 +0100 Add Tramp rclone method * doc/misc/tramp.texi (Top): Remove "History". (History): Remove node. (Quick Start Guide): New section "Using rclone". (External methods) : Describe. * etc/NEWS: Mention Tramp rclone method. * lisp/net/tramp-rclone.el: New file. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 5a375b120d..d5a45ad27c 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -86,7 +86,6 @@ Archive}. For the end user: * Obtaining @value{tramp}:: How to obtain @value{tramp}. -* History:: History of @value{tramp}. @ifset installchapter * Installation:: Installing @value{tramp} with your Emacs. @end ifset @@ -379,32 +378,6 @@ $ autoconf @end example -@node History -@chapter History of @value{tramp} -@cindex history -@cindex development history - -@value{tramp} development started at the end of November 1998 as -@file{rssh.el}. It provided only one method of access. It used -@command{ssh} for login and @command{scp} to transfer file contents. -The name was changed to @file{rcp.el} before it got its present name -@value{tramp}. New methods of remote access were added, so was support -for version control. - -April 2000 was the first time when multi-hop methods were added. In -July 2002, @value{tramp} unified file names with Ange FTP@. In July -2004, proxy hosts replaced multi-hop methods. Running commands on -remote hosts was introduced in December 2005. Support for gateways -since April 2007 (and removed in December 2016). GVFS integration -started in February 2009. Remote commands on MS Windows hosts since -September 2011. Ad-hoc multi-hop methods (with a changed syntax) -re-enabled in November 2011. In November 2012, added Juergen -Hoetzel's @file{tramp-adb.el}. Archive file names are supported since -December 2017. - -XEmacs support was stopped in January 2016. Since March 2017, -@value{tramp} syntax mandates a method. - @c Installation chapter is necessary only in case of standalone @c installation. Text taken from trampinst.texi. @ifset installchapter @@ -562,6 +535,18 @@ be accessed via the @command{adb} command. No user or host name is needed. The file name syntax is @file{@trampfn{adb,,/path/to/file}}. +@anchor{Quick Start Guide: @option{rclone} method} +@section Using @command{rclone} +@cindex method @option{rclone} +@cindex @option{rclone} method + +A convenient way to access system storages is the @command{rclone} +program. If you have configured a storage in @command{rclone} under a +name @samp{storage} (for example), you could access it via the remote +file name syntax @file{@trampfn{rclone,storage,/path/to/file}}. User +names are not needed. + + @node Configuration @chapter Configuring @value{tramp} @cindex configuration @@ -1054,6 +1039,48 @@ specified using @file{device#42} host name syntax or @value{tramp} can use the default value as declared in @command{adb} command. Port numbers are not applicable to Android devices connected through USB@. + +@item @option{rclone} +@cindex method @option{rclone} +@cindex @option{rclone} method + +@vindex tramp-rclone-program +The program @command{rclone} allows to access different system +storages in the cloud, see @url{https://rclone.org/} for a list of +supported systems. If the @command{rclone} program isn't found in +your @env{PATH} environment variable, you can tell Tramp its absolute +path via the user option @code{tramp-rclone-program}. + +A system storage must be configured via the @command{rclone config} +command, outside Emacs. If you have configured a storage in +@command{rclone} under a name @samp{storage} (for example), you could +access it via the remote file name + +@example +@trampfn{rclone,storage,/path/to/file} +@end example + +User names are part of the @command{rclone} configuration, and not +needed in the remote file name. If a user name is contained in the +remote file name, it is ignored. + +Internally, Tramp mounts the remote system storage at location +@file{/tmp/tramp.rclone.storage}, with @file{storage} being the name +of the configured system storage. + +Optional flags to the different @option{rclone} operations could be +passed as connection property, @xref{Predefined connection +information}. Supported properties are @samp{mount-args}, +@samp{copyto-args} and @samp{moveto-args}. + +Access via @option{rclone} is slow. If you have an alternative method +for accessing the system storage, you shall prefer this. @ref{GVFS +based methods} for example, methods @option{gdrive} and +@option{nextcloud}. + +@strong{Note}: The @option{rclone} method is experimental, don't use +it in production systems! + @end table diff --git a/etc/NEWS b/etc/NEWS index f413bbea06..7036c78c3d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -822,6 +822,10 @@ process. It now accepts signals specified either by name or by its number. *** New connection method "nextcloud", which allows to access OwnCloud or NextCloud hosted files and directories. ++++ +*** New connection method "rclone", which allows to access system +storages via the 'rclone' program. This feature is experimental. + +++ *** Connection methods "obex" and "synce" are removed, because they are obsoleted in GVFS. diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el new file mode 100644 index 0000000000..725a6f153a --- /dev/null +++ b/lisp/net/tramp-rclone.el @@ -0,0 +1,558 @@ +;;; tramp-rclone.el --- Tramp access functions to cloud storages -*- lexical-binding:t -*- + +;; Copyright (C) 2018 Free Software Foundation, Inc. + +;; Author: Michael Albinus +;; Keywords: comm, processes +;; Package: tramp + +;; 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 . + +;;; Commentary: + +;; rclone is a command line program to sync files and directories to +;; and from cloud storages. Tramp uses its mount utility to access +;; files and directories there. The configuration of rclone for +;; different storage systems is performed outside Tramp, see rclone(1). + +;; A remote file under rclone control has the form +;; "/rclone::/path/to/file". is the name of a +;; storage system in rclone's configuration. Therefore, such a remote +;; file name does not know any user or port specification. + +;;; Code: + +(eval-when-compile (require 'cl-lib)) +(require 'tramp) + +;; TODDDDDDDDDO: REPLACE +(require 'tramp-gvfs) + +;;;###tramp-autoload +(defconst tramp-rclone-method "rclone" + "When this method name is used, forward all calls to rclone mounts.") + +;;;###tramp-autoload +(defcustom tramp-rclone-program "rclone" + "Name of the rclone program." + :group 'tramp + :version "27.1" + :type 'string) + +;;;###tramp-autoload +(add-to-list + 'tramp-methods + `(,tramp-rclone-method + (tramp-mount-args nil) + (tramp-copyto-args nil) + (tramp-moveto-args nil) + (tramp-about-args ("--full")))) + +;;;###tramp-autoload +(eval-after-load 'tramp + '(tramp-set-completion-function + tramp-rclone-method '((tramp-rclone-parse-device-names "")))) + + +;; New handlers should be added here. +;;;###tramp-autoload +(defconst tramp-rclone-file-name-handler-alist + '((access-file . ignore) + (add-name-to-file . tramp-handle-add-name-to-file) + ;; `byte-compiler-base-file-name' performed by default handler. + ;; `copy-directory' performed by default handler. + (copy-file . tramp-rclone-handle-copy-file) + (delete-directory . tramp-rclone-handle-delete-directory) + (delete-file . tramp-rclone-handle-delete-file) + ;; `diff-latest-backup-file' performed by default handler. + (directory-file-name . tramp-handle-directory-file-name) + (directory-files . tramp-rclone-handle-directory-files) + (directory-files-and-attributes + . tramp-handle-directory-files-and-attributes) + (dired-compress-file . ignore) + (dired-uncache . tramp-handle-dired-uncache) + (exec-path . ignore) + ;; `expand-file-name' performed by default handler. + (file-accessible-directory-p . tramp-handle-file-accessible-directory-p) + (file-acl . ignore) + (file-attributes . tramp-rclone-handle-file-attributes) + (file-directory-p . tramp-handle-file-directory-p) + (file-equal-p . tramp-handle-file-equal-p) + (file-executable-p . tramp-rclone-handle-file-executable-p) + (file-exists-p . tramp-handle-file-exists-p) + (file-in-directory-p . tramp-handle-file-in-directory-p) + (file-local-copy . tramp-gvfs-handle-file-local-copy) + (file-modes . tramp-handle-file-modes) + (file-name-all-completions . tramp-rclone-handle-file-name-all-completions) + (file-name-as-directory . tramp-handle-file-name-as-directory) + (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p) + (file-name-completion . tramp-handle-file-name-completion) + (file-name-directory . tramp-handle-file-name-directory) + (file-name-nondirectory . tramp-handle-file-name-nondirectory) + ;; `file-name-sans-versions' performed by default handler. + (file-newer-than-file-p . tramp-handle-file-newer-than-file-p) + (file-notify-add-watch . ignore) + (file-notify-rm-watch . ignore) + (file-notify-valid-p . ignore) + (file-ownership-preserved-p . ignore) + (file-readable-p . tramp-rclone-handle-file-readable-p) + (file-regular-p . tramp-handle-file-regular-p) + (file-remote-p . tramp-handle-file-remote-p) + (file-selinux-context . tramp-handle-file-selinux-context) + (file-symlink-p . tramp-handle-file-symlink-p) + (file-system-info . tramp-rclone-handle-file-system-info) + (file-truename . tramp-handle-file-truename) + (file-writable-p . tramp-gvfs-handle-file-writable-p) + (find-backup-file-name . tramp-handle-find-backup-file-name) + ;; `get-file-buffer' performed by default handler. + (insert-directory . tramp-handle-insert-directory) + (insert-file-contents . tramp-handle-insert-file-contents) + (load . tramp-handle-load) + (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) + (make-directory . tramp-rclone-handle-make-directory) + (make-directory-internal . ignore) + (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) + (make-symbolic-link . tramp-handle-make-symbolic-link) + (process-file . ignore) + (rename-file . tramp-rclone-handle-rename-file) + (set-file-acl . ignore) + (set-file-modes . ignore) + (set-file-selinux-context . ignore) + (set-file-times . ignore) + (set-visited-file-modtime . tramp-handle-set-visited-file-modtime) + (shell-command . ignore) + (start-file-process . ignore) + (substitute-in-file-name . tramp-handle-substitute-in-file-name) + (temporary-file-directory . tramp-handle-temporary-file-directory) + (unhandled-file-name-directory . ignore) + (vc-registered . ignore) + (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) + (write-region . tramp-gvfs-handle-write-region)) + "Alist of handler functions for Tramp RCLONE method. +Operations not mentioned here will be handled by the default Emacs primitives.") + +;; It must be a `defsubst' in order to push the whole code into +;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading. +;;;###tramp-autoload +(defsubst tramp-rclone-file-name-p (filename) + "Check if it's a filename for rclone." + (and (tramp-tramp-file-p filename) + (string= (tramp-file-name-method (tramp-dissect-file-name filename)) + tramp-rclone-method))) + +;;;###tramp-autoload +(defun tramp-rclone-file-name-handler (operation &rest args) + "Invoke the rclone handler for OPERATION. +First arg specifies the OPERATION, second arg is a list of arguments to +pass to the OPERATION." + (let ((fn (assoc operation tramp-rclone-file-name-handler-alist))) + (if fn + (save-match-data (apply (cdr fn) args)) + (tramp-run-real-handler operation args)))) + +;;;###tramp-autoload +(tramp-register-foreign-file-name-handler + 'tramp-rclone-file-name-p 'tramp-rclone-file-name-handler) + +;;;###tramp-autoload +(defun tramp-rclone-parse-device-names (_ignore) + "Return a list of (nil host) tuples allowed to access." + (with-timeout (10) + (with-temp-buffer + ;; `call-process' does not react on timer under MS Windows. + ;; That's why we use `start-process'. + (let ((p (start-process + tramp-rclone-program (current-buffer) + tramp-rclone-program "listremotes")) + (v (make-tramp-file-name :method tramp-rclone-method)) + result) + (tramp-message v 6 "%s" (mapconcat 'identity (process-command p) " ")) + (process-put p 'adjust-window-size-function 'ignore) + (set-process-query-on-exit-flag p nil) + (while (process-live-p p) + (accept-process-output p 0.1)) + (accept-process-output p 0.1) + (tramp-message v 6 "\n%s" (buffer-string)) + (goto-char (point-min)) + (while (search-forward-regexp "^\\(\\S-+\\):$" nil t) + (push (list nil (match-string 1)) result)) + result)))) + + +;; File name primitives. + +(defun tramp-rclone-do-copy-or-rename-file + (op filename newname &optional ok-if-already-exists keep-date + preserve-uid-gid preserve-extended-attributes) + "Copy or rename a remote file. +OP must be `copy' or `rename' and indicates the operation to perform. +FILENAME specifies the file to copy or rename, NEWNAME is the name of +the new file (for copy) or the new name of the file (for rename). +OK-IF-ALREADY-EXISTS means don't barf if NEWNAME exists already. +KEEP-DATE means to make sure that NEWNAME has the same timestamp +as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep +the uid and gid if both files are on the same host. +PRESERVE-EXTENDED-ATTRIBUTES is ignored. + +This function is invoked by `tramp-rclone-handle-copy-file' and +`tramp-rclone-handle-rename-file'. It is an error if OP is neither +of `copy' and `rename'. FILENAME and NEWNAME must be absolute +file names." + (unless (memq op '(copy rename)) + (error "Unknown operation `%s', must be `copy' or `rename'" op)) + + (setq filename (file-truename filename)) + (if (file-directory-p filename) + (progn + (copy-directory filename newname keep-date t) + (when (eq op 'rename) (delete-directory filename 'recursive))) + + (let ((t1 (tramp-tramp-file-p filename)) + (t2 (tramp-tramp-file-p newname)) + (rclone-operation (if (eq op 'copy) "copyto" "moveto")) + (msg-operation (if (eq op 'copy) "Copying" "Renaming"))) + + (with-parsed-tramp-file-name (if t1 filename newname) nil + (when (and (not ok-if-already-exists) (file-exists-p newname)) + (tramp-error v 'file-already-exists newname)) + + (if (or (and t1 (not (tramp-rclone-file-name-p filename))) + (and t2 (not (tramp-rclone-file-name-p newname)))) + + ;; We cannot copy or rename directly. + (let ((tmpfile (tramp-compat-make-temp-file filename))) + (if (eq op 'copy) + (copy-file + filename tmpfile t keep-date preserve-uid-gid + preserve-extended-attributes) + (rename-file filename tmpfile t)) + (rename-file tmpfile newname ok-if-already-exists)) + + ;; Direct action. + (with-tramp-progress-reporter + v 0 (format "%s %s to %s" msg-operation filename newname) + (unless (zerop + (tramp-rclone-send-command + v rclone-operation + (tramp-rclone-remote-file-name filename) + (tramp-rclone-remote-file-name newname))) + (tramp-error + v 'file-error + "Error %s `%s' `%s'" msg-operation filename newname))) + + (when (and t1 (eq op 'rename)) + (with-parsed-tramp-file-name filename v1 + (tramp-flush-file-properties + v1 (file-name-directory v1-localname)) + (tramp-flush-file-properties v1 v1-localname))) + + (when t2 + (with-parsed-tramp-file-name newname v2 + (tramp-flush-file-properties + v2 (file-name-directory v2-localname)) + (tramp-flush-file-properties v2 v2-localname) + (when (tramp-rclone-file-name-p newname) + (tramp-rclone-flush-mount v2))))))))) + +(defun tramp-rclone-handle-copy-file + (filename newname &optional ok-if-already-exists keep-date + preserve-uid-gid preserve-extended-attributes) + "Like `copy-file' for Tramp files." + (setq filename (expand-file-name filename)) + (setq newname (expand-file-name newname)) + ;; At least one file a Tramp file? + (if (or (tramp-tramp-file-p filename) + (tramp-tramp-file-p newname)) + (tramp-rclone-do-copy-or-rename-file + 'copy filename newname ok-if-already-exists keep-date + preserve-uid-gid preserve-extended-attributes) + (tramp-run-real-handler + 'copy-file + (list filename newname ok-if-already-exists keep-date + preserve-uid-gid preserve-extended-attributes)))) + +(defun tramp-rclone-handle-delete-directory + (directory &optional recursive trash) + "Like `delete-directory' for Tramp files." + (with-parsed-tramp-file-name (expand-file-name directory) nil + (tramp-flush-file-properties v (file-name-directory localname)) + (tramp-flush-directory-properties v localname) + (delete-directory + (tramp-rclone-local-file-name directory) recursive trash))) + +(defun tramp-rclone-handle-delete-file (filename &optional trash) + "Like `delete-file' for Tramp files." + (with-parsed-tramp-file-name (expand-file-name filename) nil + (tramp-flush-file-properties v (file-name-directory localname)) + (tramp-flush-file-properties v localname) + (delete-file (tramp-rclone-local-file-name filename) trash))) + +(defun tramp-rclone-handle-directory-files + (directory &optional full match nosort) + "Like `directory-files' for Tramp files." + (when (file-directory-p directory) + (setq directory (file-name-as-directory (expand-file-name directory))) + (with-parsed-tramp-file-name directory nil + (let ((result + (directory-files + (tramp-rclone-local-file-name directory) full match))) + ;; Massage the result. + (when full + (let* ((quoted (file-name-quoted-p directory)) + (local + (concat "^" (regexp-quote (tramp-rclone-mount-point v)))) + (remote + (funcall (if quoted 'file-name-quote 'identity) + (file-remote-p directory)))) + (setq result + (mapcar + (lambda (x) (replace-regexp-in-string local remote x)) + result)))) + ;; Some storage systems do not return "." and "..". + (dolist (item '(".." ".")) + (when (and (string-match-p (or match (regexp-quote item)) item) + (not + (member (if full (setq item (concat directory item)) item) + result))) + (setq result (cons item result)))) + ;; Return result. + (if nosort result (sort result 'string<)))))) + +(defun tramp-rclone-handle-file-attributes (filename &optional id-format) + "Like `file-attributes' for Tramp files." + (with-parsed-tramp-file-name (expand-file-name filename) nil + (with-tramp-file-property + v localname (format "file-attributes-%s" id-format) + (file-attributes (tramp-rclone-local-file-name filename) id-format)))) + +(defun tramp-rclone-handle-file-executable-p (filename) + "Like `file-executable-p' for Tramp files." + (file-executable-p (tramp-rclone-local-file-name filename))) + +(defun tramp-rclone-handle-file-name-all-completions (filename directory) + "Like `file-name-all-completions' for Tramp files." + (file-name-all-completions filename (tramp-rclone-local-file-name directory))) + +(defun tramp-rclone-handle-file-readable-p (filename) + "Like `file-readable-p' for Tramp files." + (file-readable-p (tramp-rclone-local-file-name filename))) + +(defun tramp-rclone-handle-file-system-info (filename) + "Like `file-system-info' for Tramp files." + (ignore-errors + (unless (file-directory-p filename) + (setq filename (file-name-directory filename))) + (with-parsed-tramp-file-name (expand-file-name filename) nil + (tramp-message v 5 "file system info: %s" localname) + (tramp-rclone-send-command v "about" (concat host ":")) + (with-current-buffer (tramp-get-connection-buffer v) + (let (total used free) + (goto-char (point-min)) + (while (not (eobp)) + (when (looking-at "Total: [[:space:]]+\\([[:digit:]]+\\)") + (setq total (string-to-number (match-string 1)))) + (when (looking-at "Used: [[:space:]]+\\([[:digit:]]+\\)") + (setq used (string-to-number (match-string 1)))) + (when (looking-at "Free: [[:space:]]+\\([[:digit:]]+\\)") + (setq free (string-to-number (match-string 1)))) + (forward-line)) + (when used + ;; The used number of bytes is not part of the result. As + ;; side effect, we store it as file property. + (tramp-set-file-property v localname "used-bytes" used)) + ;; Result. + (when (and total free) + (list total free (- total free)))))))) + +(defun tramp-rclone-handle-insert-directory + (filename switches &optional wildcard full-directory-p) + "Like `insert-directory' for Tramp files." + (insert-directory + (tramp-rclone-local-file-name filename) switches wildcard full-directory-p) + (goto-char (point-min)) + (while (search-forward (tramp-rclone-local-file-name filename) nil 'noerror) + (replace-match filename))) + +(defun tramp-rclone-handle-insert-file-contents + (filename &optional visit beg end replace) + "Like `insert-file-contents' for Tramp files." + (let ((result + (insert-file-contents + (tramp-rclone-local-file-name filename) visit beg end replace))) + (prog1 + (list (expand-file-name filename) + (cadr result)) + (when visit (setq buffer-file-name filename))))) + +(defun tramp-rclone-handle-make-directory (dir &optional parents) + "Like `make-directory' for Tramp files." + (with-parsed-tramp-file-name (expand-file-name dir) nil + ;; When PARENTS is non-nil, DIR could be a chain of non-existent + ;; directories a/b/c/... Instead of checking, we simply flush the + ;; whole cache. + (tramp-flush-file-properties v localname) + (tramp-flush-directory-properties + v (if parents "/" (file-name-directory localname))) + (make-directory (tramp-rclone-local-file-name dir) parents))) + +(defun tramp-rclone-handle-rename-file + (filename newname &optional ok-if-already-exists) + "Like `rename-file' for Tramp files." + (setq filename (expand-file-name filename)) + (setq newname (expand-file-name newname)) + ;; At least one file a Tramp file? + (if (or (tramp-tramp-file-p filename) + (tramp-tramp-file-p newname)) + (tramp-rclone-do-copy-or-rename-file + 'rename filename newname ok-if-already-exists + 'keep-date 'preserve-uid-gid) + (tramp-run-real-handler + 'rename-file (list filename newname ok-if-already-exists)))) + + +;; File name conversions. + +(defun tramp-rclone-mount-point (vec) + "Return local mount point of VEC." + (expand-file-name + (concat + tramp-temp-name-prefix (tramp-file-name-method vec) + "." (tramp-file-name-host vec)) + (tramp-compat-temporary-file-directory))) + +(defun tramp-rclone-mounted-p (vec) + "Check, whether storage system determined by VEC is mounted." + (or + ;; We set this property at the end of + ;; `tramp-rclone-maybe-open-connection'. Let's use it as + ;; indicator. + (tramp-get-connection-property vec "uid-integer" nil) + ;; If it is mounted, "." is not shown. If the endpoint is not + ;; connected, `directory-files' returns an error. + (ignore-errors + (not (member "." (directory-files (tramp-rclone-mount-point vec))))))) + +(defun tramp-rclone-flush-mount (vec) + "Flush directory cache of VEC mount." + (let ((rclone-pid + ;; Identify rclone process. + (with-tramp-file-property vec "/" "rclone-pid" + (catch 'pid + (dolist (pid (list-system-processes)) ;; "pidof rclone" ? + (and (string-match + (regexp-quote + (format "rclone mount %s:" (tramp-file-name-host vec))) + (or (cdr (assoc 'args (process-attributes pid))) "")) + (throw 'pid pid))))))) + ;; Send a SIGHUP in order to flush directory caches. + (when rclone-pid + (tramp-message + vec 6 "Send SIGHUP %d: %s" + rclone-pid (cdr (assoc 'args (process-attributes rclone-pid)))) + (signal-process rclone-pid 'SIGHUP)))) + +(defun tramp-rclone-local-file-name (filename) + "Return local mount name of FILENAME." + (with-parsed-tramp-file-name (expand-file-name filename) nil + ;; As long as we call `tramp-rclone-maybe-open-connection' here, + ;; we cache the result. + (with-tramp-file-property v localname "local-file-name" + (tramp-rclone-maybe-open-connection v) + (let ((quoted (file-name-quoted-p localname)) + (localname (file-name-unquote localname))) + (funcall + (if quoted 'file-name-quote 'identity) + (expand-file-name + (if (file-name-absolute-p localname) + (substring localname 1) localname) + (tramp-rclone-mount-point v))))))) + +(defun tramp-rclone-remote-file-name (filename) + "Return FILENAME as used in the `rclone' command." + (setq filename (file-name-unquote (expand-file-name filename))) + (if (tramp-rclone-file-name-p filename) + (with-parsed-tramp-file-name filename nil + ;; TODO: This shall be handled by `expand-file-name'. + (setq localname (replace-regexp-in-string "^\\." "" (or localname ""))) + (format "%s:%s" host localname)) + filename)) + +(defun tramp-rclone-maybe-open-connection (vec) + "Maybe open a connection VEC. +Does not do anything if a connection is already open, but re-opens the +connection if a previous connection has died for some reason." + (unless (or (null non-essential) (tramp-rclone-mounted-p vec)) + (let ((host (tramp-file-name-host vec))) + (if (zerop (length host)) + (tramp-error vec 'file-error "Storage %s not connected" host)) + (with-tramp-progress-reporter vec 3 "Mounting rclone storage" + (unless (file-directory-p (tramp-rclone-mount-point vec)) + (make-directory (tramp-rclone-mount-point vec) 'parents)) + (let* ((buf (tramp-get-connection-buffer vec)) + (coding-system-for-read 'utf-8-dos) ;is this correct? + (process-connection-type tramp-process-connection-type) + (args `("mount" ,(concat host ":") + ,(tramp-rclone-mount-point vec) + ,(tramp-get-method-parameter vec 'tramp-mount-args))) + (p (let ((default-directory + (tramp-compat-temporary-file-directory))) + (apply 'start-process (tramp-get-connection-name vec) buf + tramp-rclone-program (delq nil args))))) + (tramp-message + vec 6 "%s" (mapconcat 'identity (process-command p) " ")) + (process-put p 'adjust-window-size-function 'ignore) + (set-process-query-on-exit-flag p nil) + + ;; Set connection-local variables. + (tramp-set-connection-local-variables vec))))) + + ;; In `tramp-check-cached-permissions', the connection properties + ;; {uig,gid}-{integer,string} are used. We set them to proper values. + (unless (tramp-get-connection-property vec "uid-integer" nil) + (tramp-set-connection-property + vec "uid-integer" (tramp-get-local-uid 'integer)) + (tramp-set-connection-property + vec "gid-integer" (tramp-get-local-gid 'integer)) + (tramp-set-connection-property + vec "uid-string" (tramp-get-local-uid 'string)) + (tramp-set-connection-property + vec "gid-string" (tramp-get-local-gid 'string)))) + +(defun tramp-rclone-send-command (vec &rest args) + "Send the COMMAND to connection VEC." +; (tramp-rclone-maybe-open-connection vec) + (with-current-buffer (tramp-get-connection-buffer vec) + (erase-buffer) + (let ((flags (tramp-get-method-parameter + vec (intern (format "tramp-%s-args" (car args)))))) + (apply 'tramp-call-process + vec tramp-rclone-program nil t nil (append args flags))))) + +(add-hook 'tramp-unload-hook + (lambda () + (unload-feature 'tramp-rclone 'force))) + +(provide 'tramp-rclone) + +;;; TODO: + +;; * Refactor tramp-gvfs.el in order to move used functions to +;; tramp.el. +;; +;; * If possible, get rid of rclone mount. Maybe it is more +;; performant then. + +;;; tramp-rclone.el ends here commit 5f9b29673fa29d27b7c165ecd5bbc7c3c06b138b Author: Michael Albinus Date: Sat Nov 24 13:56:10 2018 +0100 Revert patch in tramp-equal-remote * lisp/net/tramp-sh.el (tramp-timeout-session): Use `tramp-file-name-equal-p'. * lisp/net/tramp.el (tramp-equal-remote): Revert patch. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 462ad83317..b5d4893580 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -4704,7 +4704,7 @@ Goes through the list `tramp-inline-compress-commands'." "Close the connection VEC after a session timeout. If there is just some editing, retry it after 5 seconds." (if (and tramp-locked tramp-locker - (tramp-equal-remote vec tramp-current-connection)) + (tramp-file-name-equal-p vec (car tramp-current-connection))) (progn (tramp-message vec 5 "Cannot timeout session, trying it again in %s seconds." 5) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 3fbc45f8c8..fe0ba94f4c 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1230,6 +1230,7 @@ If nil, return `tramp-default-port'." (or (tramp-file-name-port vec) (tramp-get-method-parameter vec 'tramp-default-port))) +;; Comparision of file names is performed by `tramp-equal-remote'. (defun tramp-file-name-equal-p (vec1 vec2) "Check, whether VEC1 and VEC2 denote the same `tramp-file-name'." (and (tramp-file-name-p vec1) (tramp-file-name-p vec2) @@ -4068,6 +4069,7 @@ If it doesn't exist, generate a new one." (with-tramp-connection-property (tramp-get-connection-process vec) "device" (cons -1 (setq tramp-devices (1+ tramp-devices))))) +;; Comparision of vectors is performed by `tramp-file-name-equal-p'. (defun tramp-equal-remote (file1 file2) "Check, whether the remote parts of FILE1 and FILE2 are identical. The check depends on method, user and host name of the files. If @@ -4077,20 +4079,14 @@ account. Example: - (tramp-equal-remote \"/ssh::/etc\" \"/:/home\") + (tramp-equal-remote \"/ssh::/etc\" \"/-::/home\") would yield t. On the other hand, the following check results in nil: - (tramp-equal-remote \"/sudo::/etc\" \"/su::/etc\") - -FILE1 and FILE2 could also be Tramp vectors." - (or (and (tramp-tramp-file-p file1) - (tramp-tramp-file-p file2) - (string-equal (file-remote-p file1) (file-remote-p file2))) - (and (tramp-file-name-p file1) - (tramp-file-name-p file2) - (string-equal (tramp-make-tramp-file-name file1 'localname) - (tramp-make-tramp-file-name file2 'localname))))) + (tramp-equal-remote \"/sudo::/etc\" \"/su::/etc\")" + (and (tramp-tramp-file-p file1) + (tramp-tramp-file-p file2) + (string-equal (file-remote-p file1) (file-remote-p file2)))) ;;;###tramp-autoload (defun tramp-mode-string-to-int (mode-string) commit 57b14370cd6d221b123eab98adfed8d12229057f Author: Charles A. Roelli Date: Sat Nov 24 13:48:57 2018 +0100 Add tool-bar and menu-bar menu for Isearch (Bug#32990) * etc/NEWS (Search and Replace): Mention this change. * lisp/isearch.el: Declare the new, non-autoloaded function 'tmm-menubar-keymap'. (isearch-tmm-menubar): New function. (isearch-menu-bar-commands): New variable. (isearch-menu-bar-yank-map, isearch-menu-bar-map): New variables. (isearch-mode-map): Define a menu-bar search menu and remap 'tmm-menubar' bindings to point to 'isearch-tmm-menubar'. (isearch-tool-bar-old-map): New variable. (isearch-tool-bar-image): New function. (isearch-tool-bar-map): New variable. (minor-mode-map-alist): Add an entry for Isearch so that 'isearch-menu-bar-map' shows during search. (isearch-mode, isearch-done): Save and restore possible buffer-local 'tool-bar-map' using 'isearch-tool-bar-old-map'. (iseacrh-mouse-commands): New variable. (isearch-mouse-leave-buffer): Allow commands in isearch-mouse-commands. (with-isearch-suspended): Only push changed states of Isearch after running the body argument of this macro. (isearch-pre-command-hook): Additionally allow bindings in 'isearch-tool-bar-map' to pass through, as well as commands in isearch-menu-bar-commands. (isearch-post-command-hook): Call 'force-mode-line-update' at its end to make sure the menu- and tool-bars are up-to-date. * lisp/tmm.el (tmm-menubar-keymap): New function factored out from 'tmm-menubar'. (tmm-menubar): Use 'tmm-menubar-keymap'. (tmm-prompt): New optional argument 'no-execute'. diff --git a/etc/NEWS b/etc/NEWS index f413bbea06..a822704c83 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -687,6 +687,9 @@ the shift key. *** Isearch now remembers the regexp-based search mode for words/symbols and case-sensitivity together with search strings in the search ring. +--- +*** Isearch now has its own tool-bar and menu-bar menu. + ** Debugger +++ diff --git a/lisp/isearch.el b/lisp/isearch.el index 5099fb39f6..5913ea8a6b 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -54,6 +54,7 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) +(declare-function tmm-menubar-keymap "tmm.el") ;; Some additional options and constants. @@ -489,6 +490,164 @@ This is like `describe-bindings', but displays only Isearch keys." ;; Define isearch-mode keymap. +(defun isearch-tmm-menubar () + "Run `tmm-menubar' while `isearch-mode' is enabled." + (interactive) + (require 'tmm) + (run-hooks 'menu-bar-update-hook) + (let ((command nil)) + (let ((menu-bar (tmm-menubar-keymap))) + (with-isearch-suspended + (setq command (let ((isearch-mode t)) ; Show bindings from + ; `isearch-mode-map' in + ; tmm's prompt. + (tmm-prompt menu-bar nil nil t))))) + (call-interactively command))) + +(defvar isearch-menu-bar-commands + '(isearch-tmm-menubar menu-bar-open mouse-minor-mode-menu) + "List of commands that can open a menu during Isearch.") + +(defvar isearch-menu-bar-yank-map + (let ((map (make-sparse-keymap))) + (define-key map [isearch-yank-pop] + '(menu-item "Previous kill" isearch-yank-pop + :help "Replace previous yanked kill on search string")) + (define-key map [isearch-yank-kill] + '(menu-item "Current kill" isearch-yank-kill + :help "Append current kill to search string")) + (define-key map [isearch-yank-line] + '(menu-item "Rest of line" isearch-yank-line + :help "Yank the rest of the current line on search string")) + (define-key map [isearch-yank-symbol-or-char] + '(menu-item "Symbol/char" + isearch-yank-symbol-or-char + :help "Yank next symbol or char on search string")) + (define-key map [isearch-yank-word-or-char] + '(menu-item "Word/char" + isearch-yank-word-or-char + :help "Yank next word or char on search string")) + (define-key map [isearch-yank-char] + '(menu-item "Char" isearch-yank-char + :help "Yank char at point on search string")) + map)) + +(defvar isearch-menu-bar-map + (let ((map (make-sparse-keymap "Isearch"))) + (define-key map [isearch-complete] + '(menu-item "Complete current search string" isearch-complete + :help "Complete current search string over search history")) + (define-key map [isearch-complete-separator] + '(menu-item "--")) + (define-key map [isearch-query-replace-regexp] + '(menu-item "Replace search string as regexp" isearch-query-replace-regexp + :help "Replace matches for current search string as regexp")) + (define-key map [isearch-query-replace] + '(menu-item "Replace search string" isearch-query-replace + :help "Replace matches for current search string")) + (define-key map [isearch-occur] + '(menu-item "Show all matches for search string" isearch-occur + :help "Show all matches for current search string")) + (define-key map [isearch-highlight-regexp] + '(menu-item "Highlight all matches for search string" + isearch-highlight-regexp + :help "Highlight all matches for current search string")) + (define-key map [isearch-search-replace-separator] + '(menu-item "--")) + (define-key map [isearch-toggle-specified-input-method] + '(menu-item "Turn on specific input method" + isearch-toggle-specified-input-method + :help "Turn on specific input method for search")) + (define-key map [isearch-toggle-input-method] + '(menu-item "Toggle input method" isearch-toggle-input-method + :help "Toggle input method for search")) + (define-key map [isearch-input-method-separator] + '(menu-item "--")) + (define-key map [isearch-char-by-name] + '(menu-item "Search for char by name" isearch-char-by-name + :help "Search for character by name")) + (define-key map [isearch-quote-char] + '(menu-item "Search for literal char" isearch-quote-char + :help "Search for literal char")) + (define-key map [isearch-special-char-separator] + '(menu-item "--")) + (define-key map [isearch-toggle-word] + '(menu-item "Word matching" isearch-toggle-word + :help "Word matching" + :button (:toggle + . (eq isearch-regexp-function 'word-search-regexp)))) + (define-key map [isearch-toggle-symbol] + '(menu-item "Symbol matching" isearch-toggle-symbol + :help "Symbol matching" + :button (:toggle + . (eq isearch-regexp-function + 'isearch-symbol-regexp)))) + (define-key map [isearch-toggle-regexp] + '(menu-item "Regexp matching" isearch-toggle-regexp + :help "Regexp matching" + :button (:toggle . isearch-regexp))) + (define-key map [isearch-toggle-invisible] + '(menu-item "Invisible text matching" isearch-toggle-invisible + :help "Invisible text matching" + :button (:toggle . isearch-invisible))) + (define-key map [isearch-toggle-char-fold] + '(menu-item "Character folding matching" isearch-toggle-char-fold + :help "Character folding matching" + :button (:toggle + . (eq isearch-regexp-function + 'char-fold-to-regexp)))) + (define-key map [isearch-toggle-case-fold] + '(menu-item "Case folding matching" isearch-toggle-case-fold + :help "Case folding matching" + :button (:toggle . isearch-case-fold-search))) + (define-key map [isearch-toggle-lax-whitespace] + '(menu-item "Lax whitespace matching" isearch-toggle-lax-whitespace + :help "Lax whitespace matching" + :button (:toggle . isearch-lax-whitespace))) + (define-key map [isearch-toggle-separator] + '(menu-item "--")) + (define-key map [isearch-yank-menu] + `(menu-item "Yank on search string" ,isearch-menu-bar-yank-map)) + (define-key map [isearch-edit-string] + '(menu-item "Edit current search string" isearch-edit-string + :help "Edit current search string")) + (define-key map [isearch-ring-retreat] + '(menu-item "Edit previous search string" isearch-ring-retreat + :help "Edit previous search string in Isearch history")) + (define-key map [isearch-ring-advance] + '(menu-item "Edit next search string" isearch-ring-advance + :help "Edit next search string in Isearch history")) + (define-key map [isearch-del-char] + '(menu-item "Delete last char from search string" isearch-del-char + :help "Delete last character from search string")) + (define-key map [isearch-delete-char] + '(menu-item "Undo last input item" isearch-delete-char + :help "Undo the effect of the last Isearch command")) + (define-key map [isearch-repeat-backward] + '(menu-item "Repeat search backward" isearch-repeat-backward + :help "Repeat current search backward")) + (define-key map [isearch-repeat-forward] + '(menu-item "Repeat search forward" isearch-repeat-forward + :help "Repeat current search forward")) + (define-key map [isearch-nonincremental] + '(menu-item "Nonincremental search" isearch-exit + :help "Start nonincremental search" + :visible (string-equal isearch-string ""))) + (define-key map [isearch-exit] + '(menu-item "Finish search" isearch-exit + :help "Finish search leaving point where it is" + :visible (not (string-equal isearch-string "")))) + (define-key map [isearch-abort] + '(menu-item "Remove characters not found" isearch-abort + :help "Quit current search" + :visible (not isearch-success))) + (define-key map [isearch-cancel] + `(menu-item "Cancel search" isearch-cancel + :help "Cancel current search and return to starting point" + :filter ,(lambda (binding) + (if isearch-success 'isearch-abort binding)))) + map)) + (defvar isearch-mode-map (let ((i 0) (map (make-keymap))) @@ -598,9 +757,59 @@ This is like `describe-bindings', but displays only Isearch keys." ;; characters to the search string. See iso-transl.el. (define-key map "\C-x8\r" 'isearch-char-by-name) + (define-key map [menu-bar search-menu] + (list 'menu-item "Isearch" isearch-menu-bar-map)) + (define-key map [remap tmm-menubar] 'isearch-tmm-menubar) + map) "Keymap for `isearch-mode'.") +(defvar isearch-tool-bar-old-map nil + "Variable holding the old local value of `tool-bar-map', if any.") + +(defun isearch-tool-bar-image (image-name) + "Return an image specification for IMAGE-NAME." + (eval (tool-bar--image-expression image-name))) + +(defvar isearch-tool-bar-map + (let ((map (make-sparse-keymap))) + (define-key map [isearch-describe-mode] + (list 'menu-item "Help" 'isearch-describe-mode + :help "Get help for Isearch" + :image '(isearch-tool-bar-image "help"))) + (define-key map [isearch-occur] + (list 'menu-item "Show hits" 'isearch-occur + :help "Show each search hit" + :image '(isearch-tool-bar-image "index"))) + (define-key map [isearch-query-replace] + (list 'menu-item "Replace" 'isearch-query-replace + :help "Replace search string" + :image '(isearch-tool-bar-image "search-replace"))) + (define-key map [isearch-delete-char] + (list 'menu-item "Undo" 'isearch-delete-char + :help "Undo last input item" + :image '(isearch-tool-bar-image "undo"))) + (define-key map [isearch-exit] + (list 'menu-item "Finish" 'isearch-exit + :help "Finish search leaving point where it is" + :image '(isearch-tool-bar-image "exit") + :visible '(not (string-equal isearch-string "")))) + (define-key map [isearch-cancel] + (list 'menu-item "Abort" 'isearch-cancel + :help "Abort search" + :image '(isearch-tool-bar-image "close") + :filter (lambda (binding) + (if isearch-success 'isearch-abort binding)))) + (define-key map [isearch-repeat-forward] + (list 'menu-item "Repeat forward" 'isearch-repeat-forward + :help "Repeat search forward" + :image '(isearch-tool-bar-image "right-arrow"))) + (define-key map [isearch-repeat-backward] + (list 'menu-item "Repeat backward" 'isearch-repeat-backward + :help "Repeat search backward" + :image '(isearch-tool-bar-image "left-arrow"))) + map)) + (defvar minibuffer-local-isearch-map (let ((map (make-sparse-keymap))) (set-keymap-parent map minibuffer-local-map) @@ -731,11 +940,19 @@ Each element is an `isearch--state' struct where the slots are ;; Minor-mode-alist changes - kind of redundant with the ;; echo area, but if isearching in multiple windows, it can be useful. +;; Also, clicking the mode-line indicator pops up +;; `isearch-menu-bar-map'. (or (assq 'isearch-mode minor-mode-alist) (nconc minor-mode-alist (list '(isearch-mode isearch-mode)))) +;; We add an entry for `isearch-mode' to `minor-mode-map-alist' so +;; that `isearch-menu-bar-map' can show on the menu bar. +(or (assq 'isearch-mode minor-mode-map-alist) + (nconc minor-mode-map-alist + (list (cons 'isearch-mode isearch-mode-map)))) + (defvar-local isearch-mode nil) ;; Name of the minor mode, if non-nil. (define-key global-map "\C-s" 'isearch-forward) @@ -989,6 +1206,10 @@ used to set the value of `isearch-regexp-function'." isearch-original-minibuffer-message-timeout minibuffer-message-timeout minibuffer-message-timeout nil) + (if (local-variable-p 'tool-bar-map) + (setq isearch-tool-bar-old-map tool-bar-map)) + (setq-local tool-bar-map isearch-tool-bar-map) + ;; We must bypass input method while reading key. When a user type ;; printable character, appropriate input method is turned on in ;; minibuffer to read multibyte characters. @@ -1155,6 +1376,12 @@ NOPUSH is t and EDIT is t." (setq input-method-function isearch-input-method-function) (kill-local-variable 'input-method-function)) + (if isearch-tool-bar-old-map + (progn + (setq-local tool-bar-map isearch-tool-bar-old-map) + (setq isearch-tool-bar-old-map nil)) + (kill-local-variable 'tool-bar-map)) + (force-mode-line-update) ;; If we ended in the middle of some intangible text, @@ -1187,9 +1414,17 @@ NOPUSH is t and EDIT is t." (and (not edit) isearch-recursive-edit (exit-recursive-edit))) +(defvar isearch-mouse-commands '(mouse-minor-mode-menu) + "List of mouse commands that are allowed during Isearch.") + (defun isearch-mouse-leave-buffer () - "Exit Isearch unless the mouse command is allowed in Isearch." - (unless (eq (get this-command 'isearch-scroll) t) + "Exit Isearch unless the mouse command is allowed in Isearch. + +Mouse commands are allowed in Isearch if they have a non-nil +`isearch-scroll' property or if they are listed in +`isearch-mouse-commands'." + (unless (or (memq this-command isearch-mouse-commands) + (eq (get this-command 'isearch-scroll) t)) (isearch-done))) (defun isearch-update-ring (string &optional regexp) @@ -1457,7 +1692,11 @@ You can update the global isearch variables by setting new values to ;; Reinvoke the pending search. (isearch-search) - (isearch-push-state) ; this pushes the correct state + ;; If no code has changed the search parameters, then pushing + ;; a new state of Isearch should not be necessary. + (unless (and isearch-cmds + (equal (car isearch-cmds) (isearch--get-state))) + (isearch-push-state)) ; this pushes the correct state (isearch-update) (if isearch-nonincremental (progn @@ -2581,7 +2820,12 @@ See more for options in `search-exit-option'." ;; `set-transient-map' thingy like `universal-argument--mode'. ((not (eq overriding-terminal-local-map isearch--saved-overriding-local-map))) ;; Don't exit Isearch for isearch key bindings. - ((commandp (lookup-key isearch-mode-map key nil))) + ((or (commandp (lookup-key isearch-mode-map key nil)) + (commandp + (lookup-key + `(keymap (tool-bar menu-item nil ,isearch-tool-bar-map)) key)))) + ;; Allow key bindings that open a menubar. + ((memq this-command isearch-menu-bar-commands)) ;; Optionally edit the search string instead of exiting. ((eq search-exit-option 'edit) (setq this-command 'isearch-edit-string)) @@ -2645,7 +2889,8 @@ See more for options in `search-exit-option'." (when isearch-forward (goto-char isearch-pre-move-point)) (isearch-search-and-update))) - (setq isearch-pre-move-point nil)))) + (setq isearch-pre-move-point nil))) + (force-mode-line-update)) (defun isearch-quote-char (&optional count) "Quote special characters for incremental search. diff --git a/lisp/tmm.el b/lisp/tmm.el index ff6277419d..4e3f25441c 100644 --- a/lisp/tmm.el +++ b/lisp/tmm.el @@ -42,6 +42,23 @@ (defvar tmm-next-shortcut-digit) (defvar tmm-table-undef) +(defun tmm-menubar-keymap () + "Return the current menu-bar keymap. + +The ordering of the return value respects `menu-bar-final-items'." + (let ((menu-bar '()) + (menu-end '())) + (map-keymap + (lambda (key binding) + (push (cons key binding) + ;; If KEY is the name of an item that we want to put last, + ;; move it to the end. + (if (memq key menu-bar-final-items) + menu-end + menu-bar))) + (tmm-get-keybind [menu-bar])) + `(keymap ,@(nreverse menu-bar) ,@(nreverse menu-end)))) + ;;;###autoload (define-key global-map "\M-`" 'tmm-menubar) ;;;###autoload (define-key global-map [menu-bar mouse-1] 'tmm-menubar-mouse) @@ -58,19 +75,8 @@ to invoke `tmm-menubar' instead, customize the variable (interactive) (run-hooks 'menu-bar-update-hook) ;; Obey menu-bar-final-items; put those items last. - (let ((menu-bar '()) - (menu-end '()) + (let ((menu-bar (tmm-menubar-keymap)) menu-bar-item) - (map-keymap - (lambda (key binding) - (push (cons key binding) - ;; If KEY is the name of an item that we want to put last, - ;; move it to the end. - (if (memq key menu-bar-final-items) - menu-end - menu-bar))) - (tmm-get-keybind [menu-bar])) - (setq menu-bar `(keymap ,@(nreverse menu-bar) ,@(nreverse menu-end))) (if x-position (let ((column 0) prev-key) @@ -154,7 +160,7 @@ specify nil for this variable." (defvar tmm--history nil) ;;;###autoload -(defun tmm-prompt (menu &optional in-popup default-item) +(defun tmm-prompt (menu &optional in-popup default-item no-execute) "Text-mode emulation of calling the bindings in keymap. Creates a text-mode menu of possible choices. You can access the elements in the menu in two ways: @@ -165,7 +171,9 @@ The last alternative is currently a hack, you cannot use mouse reliably. MENU is like the MENU argument to `x-popup-menu': either a keymap or an alist of alists. DEFAULT-ITEM, if non-nil, specifies an initial default choice. -Its value should be an event that has a binding in MENU." +Its value should be an event that has a binding in MENU. +NO-EXECUTE, if non-nil, means to return the command the user selects +instead of executing it." ;; If the optional argument IN-POPUP is t, ;; then MENU is an alist of elements of the form (STRING . VALUE). ;; That is used for recursive calls only. @@ -268,7 +276,7 @@ Its value should be an event that has a binding in MENU." ;; We just did the inner level of a -popup menu. choice) ;; We just did the outer level. Do the inner level now. - (not-menu (tmm-prompt choice t)) + (not-menu (tmm-prompt choice t nil no-execute)) ;; We just handled a menu keymap and found another keymap. ((keymapp choice) (if (symbolp choice) @@ -276,11 +284,11 @@ Its value should be an event that has a binding in MENU." (condition-case nil (require 'mouse) (error nil)) - (tmm-prompt choice)) + (tmm-prompt choice nil nil no-execute)) ;; We just handled a menu keymap and found a command. (choice (if chosen-string - (progn + (if no-execute choice (setq last-command-event chosen-string) (call-interactively choice)) choice))))) commit 1342cccd4bcd606cf8fdb477e4b28001a88cc065 Author: Michael Albinus Date: Sat Nov 24 13:48:25 2018 +0100 Remove find-file-noselect in Tramp, it was handled in XEmacs * lisp/net/tramp.el (tramp-file-name-for-operation): Remove `find-file-noselect'. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 00c6ad43ea..d0cead2b88 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -141,7 +141,6 @@ It is used for TCP/IP devices." (file-truename . tramp-adb-handle-file-truename) (file-writable-p . tramp-adb-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) - ;; `find-file-noselect' performed by default handler. ;; `get-file-buffer' performed by default handler. (insert-directory . tramp-handle-insert-directory) (insert-file-contents . tramp-handle-insert-file-contents) diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index bb87a83f10..47f15cef5f 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -253,7 +253,6 @@ It must be supported by libarchive(3).") (file-truename . tramp-archive-handle-file-truename) (file-writable-p . ignore) (find-backup-file-name . ignore) - ;; `find-file-noselect' performed by default handler. ;; `get-file-buffer' performed by default handler. (insert-directory . tramp-archive-handle-insert-directory) (insert-file-contents . tramp-archive-handle-insert-file-contents) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index fb687f0d7b..9d53edd084 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -569,7 +569,6 @@ It has been changed in GVFS 1.14.") (file-truename . tramp-handle-file-truename) (file-writable-p . tramp-gvfs-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) - ;; `find-file-noselect' performed by default handler. ;; `get-file-buffer' performed by default handler. (insert-directory . tramp-handle-insert-directory) (insert-file-contents . tramp-handle-insert-file-contents) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 4965f835b0..462ad83317 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1023,7 +1023,6 @@ of command line.") (file-truename . tramp-sh-handle-file-truename) (file-writable-p . tramp-sh-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) - ;; `find-file-noselect' performed by default handler. ;; `get-file-buffer' performed by default handler. (insert-directory . tramp-sh-handle-insert-directory) (insert-file-contents . tramp-handle-insert-file-contents) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index eadb4029b5..23b5176b52 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -262,7 +262,6 @@ See `tramp-actions-before-shell' for more info.") (file-truename . tramp-handle-file-truename) (file-writable-p . tramp-smb-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) - ;; `find-file-noselect' performed by default handler. ;; `get-file-buffer' performed by default handler. (insert-directory . tramp-smb-handle-insert-directory) (insert-file-contents . tramp-handle-insert-file-contents) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 97f931a4a4..3fbc45f8c8 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2175,7 +2175,7 @@ ARGS are the arguments OPERATION has been called with." file-ownership-preserved-p file-readable-p file-regular-p file-remote-p file-selinux-context file-symlink-p file-truename file-writable-p - find-backup-file-name find-file-noselect get-file-buffer + find-backup-file-name get-file-buffer insert-directory insert-file-contents load make-directory make-directory-internal set-file-acl set-file-modes set-file-selinux-context set-file-times @@ -4445,7 +4445,7 @@ ALIST is of the form ((FROM . TO) ...)." It always returns a return code. The Lisp error raised when PROGRAM is nil is trapped also, returning 1. Furthermore, traces are written with verbosity of 6." - (let ((default-directory (tramp-compat-temporary-file-directory)) + (let ((default-directory (tramp-compat-temporary-file-directory)) (destination (if (eq destination t) (current-buffer) destination)) output error result) (tramp-message commit 9877c03293241091ba4069002d4dc4d74b557414 Author: Alan Mackenzie Date: Sat Nov 24 10:31:53 2018 +0000 Fix bug #33416, where typing a ) in a comment at EOB caused a loop (CC Mode). * lisp/progmodes/cc-mode.el (c-fl-decl-start): A c-forward-syntactic-ws leaves point inside whitespace when moving over a comment at EOB which has no terminating LF. Check this possibility and correct for it. diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 664f01012b..424cde5247 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1512,7 +1512,10 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") (c-syntactic-skip-backward "^;{}" bod-lim t) (> (point) bod-lim) (progn (c-forward-syntactic-ws) - (setq bo-decl (point)) + ;; Have we got stuck in a comment at EOB? + (not (and (eobp) + (c-literal-start)))) + (progn (setq bo-decl (point)) (or (not (looking-at c-protection-key)) (c-forward-keyword-clause 1))) (progn commit 25a4205271f5550a34b5cfbf484fe7f16410d1f6 Author: Ulrich MĂĽller Date: Sat Nov 17 11:43:06 2018 +0100 Update the calc units table On 2018-11-16, the 26th meeting of the General Conference on Weights and Measures (CGPM) has redefined the International System of Units by adopting fixed values for the Planck constant, the elementary charge, the Boltzmann constant, and the Avogadro constant: https://www.bipm.org/utils/en/pdf/CGPM/Draft-Resolution-A-EN.pdf * lisp/calc/calc-units.el (math-standard-units): Update according to redefinition of the SI in 2018. (Bug#33412) diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index ab76ded818..17d16acee0 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el @@ -46,6 +46,9 @@ ;; CODATA values updated February 2016, using 2014 adjustment ;; http://arxiv.org/pdf/1507.07956.pdf +;; Updated November 2018 for the redefinition of the SI +;; https://www.bipm.org/utils/en/pdf/CGPM/Draft-Resolution-A-EN.pdf + (defvar math-standard-units '( ;; Length ( m nil "*Meter" ) @@ -118,7 +121,7 @@ ( mph "mi/hr" "*Miles per hour" ) ( kph "km/hr" "Kilometers per hour" ) ( knot "nmi/hr" "Knot" ) - ( c "299792458 m/s" "Speed of light" ) ;;; CODATA + ( c "299792458 m/s" "Speed of light" ) ;; SI definition ;; Acceleration ( ga "980665*10^(-5) m/s^2" "*\"g\" acceleration" nil @@ -207,8 +210,8 @@ ( C "A s" "Coulomb" ) ( Fdy "ech Nav" "Faraday" ) ( e "ech" "Elementary charge" ) - ( ech "1.6021766208*10^(-19) C" "Elementary charge" nil - "1.6021766208 10^-19 C (*)") ;;(approx) CODATA + ( ech "1.602176634*10^(-19) C" "Elementary charge" nil + "1.602176634 10^-19 C") ;; SI definition ( V "W/A" "Volt" ) ( ohm "V/A" "Ohm" ) ( Ω "ohm" "Ohm" ) @@ -256,18 +259,21 @@ ( sr nil "*Steradian" ) ;; Other physical quantities - ;; The values are from CODATA, and are approximate. - ( h "6.626070040*10^(-34) J s" "*Planck's constant" nil - "6.626070040 10^-34 J s (*)") + ;; Unless otherwise mentioned, the values are from CODATA, + ;; and are approximate. + ( h "6.62607015*10^(-34) J s" "*Planck's constant" nil + "6.62607015 10^-34 J s") ;; SI definition ( hbar "h / (2 pi)" "Planck's constant" ) ;; Exact - ( mu0 "4 pi 10^(-7) H/m" "Permeability of vacuum") ;; Exact - ( ÎĽ0 "mu0" "Permeability of vacuum") ;; Exact - ( eps0 "1 / (mu0 c^2)" "Permittivity of vacuum" ) + ;; After the 2018 SI redefinition, eps0 and mu0 are measured quantities, + ;; and mu0 no longer has the previous exact value of 4 pi 10^(-7) H/m. + ( eps0 "ech^2 / (2 alpha h c)" "Permittivity of vacuum" ) ( ε0 "eps0" "Permittivity of vacuum" ) + ( mu0 "1 / (eps0 c^2)" "Permeability of vacuum") ;; Exact + ( ÎĽ0 "mu0" "Permeability of vacuum") ;; Exact ( G "6.67408*10^(-11) m^3/(kg s^2)" "Gravitational constant" nil "6.67408 10^-11 m^3/(kg s^2) (*)") - ( Nav "6.022140857*10^(23) / mol" "Avogadro's constant" nil - "6.022140857 10^23 / mol (*)") + ( Nav "6.02214076*10^(23) / mol" "Avogadro's constant" nil + "6.02214076 10^23 / mol") ;; SI definition ( me "9.10938356*10^(-31) kg" "Electron rest mass" nil "9.10938356 10^-31 kg (*)") ( mp "1.672621898*10^(-27) kg" "Proton rest mass" nil @@ -280,12 +286,10 @@ "1.883531594 10^-28 kg (*)") ( Ryd "10973731.568508 /m" "Rydberg's constant" nil "10973731.568508 /m (*)") - ( k "1.38064852*10^(-23) J/K" "Boltzmann's constant" nil - "1.38064852 10^-23 J/K (*)") - ( sigma "5.670367*10^(-8) W/(m^2 K^4)" "Stefan-Boltzmann constant" nil - "5.670367 10^-8 W/(m^2 K^4) (*)") - ( Ď "sigma" "Stefan-Boltzmann constant" nil - "5.670367 10^-8 W/(m^2 K^4) (*)") + ( k "1.380649*10^(-23) J/K" "Boltzmann's constant" nil + "1.380649 10^-23 J/K") ;; SI definition + ( sigma "2 pi^5 k^4 / (15 h^3 c^2)" "Stefan-Boltzmann constant") + ( Ď "sigma" "Stefan-Boltzmann constant") ( alpha "7.2973525664*10^(-3)" "Fine structure constant" nil "7.2973525664 10^-3 (*)") ( α "alpha" "Fine structure constant" nil @@ -298,8 +302,7 @@ "-928.4764620 10^-26 J/T (*)") ( mup "1.4106067873*10^(-26) J/T" "Proton magnetic moment" nil "1.4106067873 10^-26 J/T (*)") - ( R0 "8.3144598 J/(mol K)" "Molar gas constant" nil - "8.3144598 J/(mol K) (*)") + ( R0 "Nav k" "Molar gas constant") ;; Exact ( V0 "22.710947*10^(-3) m^3/mol" "Standard volume of ideal gas" nil "22.710947 10^-3 m^3/mol (*)") ;; Logarithmic units commit 56e3e4fe6816b5f13c410300e2bf5a0c1fcbe03a Author: Eli Zaretskii Date: Sat Nov 24 10:00:55 2018 +0200 Improve indexing in the ELisp manual * doc/lispref/control.texi (Control Structures, Sequencing) (Conditionals, Iteration, Catch and Throw, Handling Errors) (Cleanups): * doc/lispref/eval.texi (Self-Evaluating Forms) (Symbol Forms, Function Forms, Macro Forms, Special Forms) (Quoting, Backquote): Add index entries that begin with "forms". (Bug#33440) diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index 8989b7de91..4e5422aaa7 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -6,6 +6,7 @@ @node Control Structures @chapter Control Structures @cindex special forms for control structures +@cindex forms for control structures @cindex control structures A Lisp program consists of a set of @dfn{expressions}, or @@ -48,6 +49,7 @@ structure constructs (@pxref{Macros}). @section Sequencing @cindex sequencing @cindex sequential execution +@cindex forms for sequential execution Evaluating forms in the order they appear is the most common way control passes from one form to another. In some contexts, such as in a @@ -146,6 +148,7 @@ following @var{forms}, in textual order, returning the result of @node Conditionals @section Conditionals @cindex conditional evaluation +@cindex forms, conditional Conditional control structures choose among alternatives. Emacs Lisp has five conditional forms: @code{if}, which is much the same as in @@ -1273,6 +1276,7 @@ up being equivalent to @code{dolist} (@pxref{Iteration}). @section Iteration @cindex iteration @cindex recursion +@cindex forms, iteration Iteration means executing part of a program repetitively. For example, you might want to repeat some computation once for each element @@ -1496,6 +1500,7 @@ exited. @node Catch and Throw @subsection Explicit Nonlocal Exits: @code{catch} and @code{throw} +@cindex forms for nonlocal exits Most control constructs affect only the flow of control within the construct itself. The function @code{throw} is the exception to this @@ -1867,6 +1872,7 @@ variables precisely as they were at the time of the error. @subsubsection Writing Code to Handle Errors @cindex error handler @cindex handling errors +@cindex forms for handling errors The usual effect of signaling an error is to terminate the command that is running and return immediately to the Emacs editor command loop. @@ -2235,6 +2241,7 @@ and their conditions. @node Cleanups @subsection Cleaning Up from Nonlocal Exits @cindex nonlocal exits, cleaning up +@cindex forms for cleanup The @code{unwind-protect} construct is essential whenever you temporarily put a data structure in an inconsistent state; it permits diff --git a/doc/lispref/eval.texi b/doc/lispref/eval.texi index 373b12e79d..416815e190 100644 --- a/doc/lispref/eval.texi +++ b/doc/lispref/eval.texi @@ -127,6 +127,7 @@ with the other types, which are self-evaluating forms. @cindex vector evaluation @cindex literal evaluation @cindex self-evaluating form +@cindex form, self-evaluating A @dfn{self-evaluating form} is any form that is not a list or symbol. Self-evaluating forms evaluate to themselves: the result of @@ -179,6 +180,8 @@ program. Here is an example: @node Symbol Forms @subsection Symbol Forms @cindex symbol evaluation +@cindex symbol forms +@cindex forms, symbol When a symbol is evaluated, it is treated as a variable. The result is the variable's value, if it has one. If the symbol has no value as @@ -215,6 +218,7 @@ its value ordinarily cannot be changed. @xref{Constant Variables}. @node Classifying Lists @subsection Classification of List Forms @cindex list form evaluation +@cindex forms, list A form that is a nonempty list is either a function call, a macro call, or a special form, according to its first element. These three @@ -349,6 +353,7 @@ Here is how you could define @code{indirect-function} in Lisp: @subsection Evaluation of Function Forms @cindex function form evaluation @cindex function call +@cindex forms, function call If the first element of a list being evaluated is a Lisp function object, byte-code object or primitive function object, then that list is @@ -372,6 +377,7 @@ body form becomes the value of the function call. @node Macro Forms @subsection Lisp Macro Evaluation @cindex macro call evaluation +@cindex forms, macro call If the first element of a list being evaluated is a macro object, then the list is a @dfn{macro call}. When a macro call is evaluated, the @@ -418,6 +424,7 @@ expansion. @node Special Forms @subsection Special Forms @cindex special forms +@cindex forms, special @cindex evaluation of special forms A @dfn{special form} is a primitive function specially marked so that @@ -539,6 +546,7 @@ described in @ref{Autoload}. @node Quoting @section Quoting +@cindex forms, quote The special form @code{quote} returns its single argument, as written, without evaluating it. This provides a way to include constant symbols @@ -598,6 +606,7 @@ only part of a list, while computing and substituting other parts. @cindex backquote (list substitution) @cindex ` (list substitution) @findex ` +@cindex forms, backquote @dfn{Backquote constructs} allow you to quote a list, but selectively evaluate elements of that list. In the simplest case, it commit 7a4992a0d392843c0f13709a575a08ecaf56b51c Author: Eli Zaretskii Date: Fri Nov 23 23:33:31 2018 +0200 More Symbola-related extensions for default fontset * lisp/international/fontset.el (setup-default-fontset): Add few more blocks of symbols and punctuation supported by latest Symbola. diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index 63452b3db5..f17b126b1f 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -815,9 +815,16 @@ (#x4DC0 . #x4DFF) ;; Yijing Hexagram Symbols (#xFE10 . #xFE1F) ;; Vertical Forms (#x10100 . #x1013F) ;; Aegean Numbers + (#x10190 . #x101CF) ;; Ancient Symbols + (#x101D0 . #x101FF) ;; Phaistos Disc (#x102E0 . #x102FF) ;; Coptic Epact Numbers (#x1D000 . #x1D0FF) ;; Byzantine Musical Symbols (#x1D200 . #x1D24F) ;; Ancient Greek Musical Notation + (#x1D2E0 . #x1D2FF) ;; Mayan Numerals + (#x1D300 . #x1D35F) ;; Tai Xuan Jing Symbols + (#x1D360 . #x1D37F) ;; Counting Rod Numerals + (#x1F000 . #x1F02F) ;; Mahjong Tiles + (#x1F030 . #x1F09F) ;; Domino Tiles (#x1F0A0 . #x1F0FF) ;; Playing Cards (#x1F100 . #x1F1FF) ;; Enclosed Alphanumeric Suppl (#x1F300 . #x1F5FF) ;; Misc Symbols and Pictographs @@ -827,7 +834,8 @@ (#x1F700 . #x1F77F) ;; Alchemical Symbols (#x1F780 . #x1F7FF) ;; Geometric Shapes Extended (#x1F800 . #x1F8FF) ;; Supplemental Arrows-C - (#x1F900 . #x1F9FF))) ;; Supplemental Symbols and Pictographs + (#x1F900 . #x1F9FF) ;; Supplemental Symbols and Pictographs + (#x1FA00 . #x1FA6F))) ;; Chess Symbols (set-fontset-font "fontset-default" symbol-subgroup '("Symbola" . "iso10646-1") nil 'prepend)) ;; Box Drawing and Block Elements commit 4ae0a75435cefd8f673011c58a09b8cc6302a04b Author: Eli Zaretskii Date: Fri Nov 23 22:59:54 2018 +0200 Better support for display of U+1F900..U+1F9FF block * lisp/international/fontset.el (setup-default-fontset): Add the [#x1F900..#x1F9FF] block to those supported by Symbola. diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index 23db54a4a3..63452b3db5 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -826,7 +826,8 @@ (#x1F680 . #x1F6FF) ;; Transport and Map Symbols (#x1F700 . #x1F77F) ;; Alchemical Symbols (#x1F780 . #x1F7FF) ;; Geometric Shapes Extended - (#x1F800 . #x1F8FF))) ;; Supplemental Arrows-C + (#x1F800 . #x1F8FF) ;; Supplemental Arrows-C + (#x1F900 . #x1F9FF))) ;; Supplemental Symbols and Pictographs (set-fontset-font "fontset-default" symbol-subgroup '("Symbola" . "iso10646-1") nil 'prepend)) ;; Box Drawing and Block Elements commit 4ef9bcd0ff0eccb0c0810f43370eaa76aef2f4ec Author: Eric Abrahamsen Date: Mon Jun 25 17:40:19 2018 -0700 Provide new gnus-mode, derive all gnus major modes from this * lisp/gnus/gnus.el (gnus-mode): New do-nothing major mode, derived from special mode. * lisp/gnus/gnus-sum.el (gnus-summary-mode): Change from a function to a major mode, derive from gnus-mode. (gnus-summary-setup-buffer): Change call a bit -- can no longer pass an argument to the mode function. * lisp/gnus/gnus-srvr.el (gnus-browse-mode): Derive from gnus-mode. (gnus-server-setup-buffer): Remove unnecessary function. (gnus-enter-server-buffer): Call gnus-server-mode here, and call it whether the server buffer already existed or not. (gnus-server-mode): Change from a function to a major mode. (gnus-server-mode-hook): Delete custom option, this is automatically created. * lisp/gnus/gnus-salt.el (gnus-tree-mode): Derive from gnus-mode. (gnus-tree-mode-hook): Delete custom option, this is automatically created. * lisp/gnus/gnus-kill.el (gnus-kill-file-mode-hook): Delete custom option. * lisp/gnus/gnus-group.el (gnus-group-mode): * lisp/gnus/gnus-art.el (gnus-article-mode): * lisp/gnus/gnus-agent.el (gnus-category-mode): Derive from gnus-mode. (gnus-category-mode-hook): Delete custom option. (Bug#33263) diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 18e6174fa0..93a675584f 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -2575,9 +2575,6 @@ modified) original contents, they are first saved to their own file." ;;; Agent Category Mode ;;; -(defvar gnus-category-mode-hook nil - "Hook run in `gnus-category-mode' buffers.") - (defvar gnus-category-line-format " %(%20c%): %g\n" "Format of category lines. @@ -2613,7 +2610,6 @@ General format specifiers can also be used. See Info node (defvar gnus-category-mode-line-format-spec nil) (defvar gnus-category-mode-map nil) -(put 'gnus-category-mode 'mode-class 'special) (unless gnus-category-mode-map (setq gnus-category-mode-map (make-sparse-keymap)) @@ -2655,9 +2651,8 @@ General format specifiers can also be used. See Info node (gnus-run-hooks 'gnus-category-menu-hook))) -(define-derived-mode gnus-category-mode fundamental-mode "Category" +(define-derived-mode gnus-category-mode gnus-mode "Category" "Major mode for listing and editing agent categories. - All normal editing commands are switched off. \\ For more in-depth information on this mode, read the manual @@ -2672,8 +2667,7 @@ The following commands are available: (gnus-set-default-directory) (setq mode-line-process nil) (buffer-disable-undo) - (setq truncate-lines t) - (setq buffer-read-only t)) + (setq truncate-lines t)) (defalias 'gnus-category-position-point 'gnus-goto-colon) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index f28e6db3c7..c78bb3325f 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -4388,8 +4388,6 @@ If variable `gnus-use-long-file-name' is non-nil, it is ;;; Gnus article mode ;;; -(put 'gnus-article-mode 'mode-class 'special) - (set-keymap-parent gnus-article-mode-map widget-keymap) (gnus-define-keys gnus-article-mode-map @@ -4467,9 +4465,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is (defvar bookmark-make-record-function) (defvar shr-put-image-function) -(define-derived-mode gnus-article-mode fundamental-mode "Article" +(define-derived-mode gnus-article-mode gnus-mode "Article" "Major mode for displaying an article. - All normal editing commands are switched off. The following commands are available in addition to all summary mode @@ -4510,8 +4507,7 @@ commands: (setq cursor-in-non-selected-windows nil)) (gnus-set-default-directory) (buffer-disable-undo) - (setq buffer-read-only t - show-trailing-whitespace nil) + (setq show-trailing-whitespace nil) (mm-enable-multibyte)) (defun gnus-article-setup-buffer () diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 6af27afbfa..d526894b3a 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -567,8 +567,6 @@ simple manner." ;;; Gnus group mode ;;; -(put 'gnus-group-mode 'mode-class 'special) - (gnus-define-keys gnus-group-mode-map " " gnus-group-read-group "=" gnus-group-select-group @@ -1106,9 +1104,8 @@ When FORCE, rebuild the tool bar." (set (make-local-variable 'tool-bar-map) map)))) gnus-group-tool-bar-map) -(define-derived-mode gnus-group-mode fundamental-mode "Group" +(define-derived-mode gnus-group-mode gnus-mode "Group" "Major mode for reading news. - All normal editing commands are switched off. \\ The group buffer lists (some of) the groups available. For instance, @@ -1131,8 +1128,7 @@ The following commands are available: (setq mode-line-process nil) (buffer-disable-undo) (setq truncate-lines t) - (setq buffer-read-only t - show-trailing-whitespace nil) + (setq show-trailing-whitespace nil) (gnus-set-default-directory) (gnus-update-format-specifications nil 'group 'group-mode) (gnus-update-group-mark-positions) diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el index 60732c11d5..e65ff51ce7 100644 --- a/lisp/gnus/gnus-kill.el +++ b/lisp/gnus/gnus-kill.el @@ -29,11 +29,6 @@ (require 'gnus-art) (require 'gnus-range) -(defcustom gnus-kill-file-mode-hook nil - "Hook for Gnus kill file mode." - :group 'gnus-score-kill - :type 'hook) - (defcustom gnus-kill-expiry-days 7 "Number of days before expiring unused kill file entries." :group 'gnus-score-kill diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el index aff841760a..0504465de3 100644 --- a/lisp/gnus/gnus-salt.el +++ b/lisp/gnus/gnus-salt.el @@ -396,11 +396,6 @@ Two predefined functions are available: (function :tag "Other" nil)) :group 'gnus-summary-tree) -(defcustom gnus-tree-mode-hook nil - "Hook run in tree mode buffers." - :type 'hook - :group 'gnus-summary-tree) - ;;; Internal variables. (defvar gnus-tmp-name) @@ -445,8 +440,6 @@ Two predefined functions are available: 'undefined 'gnus-tree-read-summary-keys map) map)) -(put 'gnus-tree-mode 'mode-class 'special) - (defun gnus-tree-make-menu-bar () (unless (boundp 'gnus-tree-menu) (easy-menu-define @@ -454,7 +447,7 @@ Two predefined functions are available: '("Tree" ["Select article" gnus-tree-select-article t])))) -(define-derived-mode gnus-tree-mode fundamental-mode "Tree" +(define-derived-mode gnus-tree-mode gnus-mode "Tree" "Major mode for displaying thread trees." (gnus-set-format 'tree-mode) (gnus-set-format 'tree t) diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index 34ebd00ef2..4d15f36ffc 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -36,11 +36,6 @@ (autoload 'gnus-group-make-nnir-group "nnir") -(defcustom gnus-server-mode-hook nil - "Hook run in `gnus-server-mode' buffers." - :group 'gnus-server - :type 'hook) - (defcustom gnus-server-exit-hook nil "Hook run when exiting the server buffer." :group 'gnus-server @@ -108,7 +103,7 @@ If nil, a faster, but more primitive, buffer is used instead." (defvar gnus-server-mode-line-format-spec nil) (defvar gnus-server-killed-servers nil) -(defvar gnus-server-mode-map) +(defvar gnus-server-mode-map nil) (defcustom gnus-server-menu-hook nil "Hook run after the creation of the server mode menu." @@ -150,11 +145,8 @@ If nil, a faster, but more primitive, buffer is used instead." (gnus-run-hooks 'gnus-server-menu-hook))) -(defvar gnus-server-mode-map nil) -(put 'gnus-server-mode 'mode-class 'special) - (unless gnus-server-mode-map - (setq gnus-server-mode-map (make-sparse-keymap)) + (setq gnus-server-mode-map (make-keymap)) (suppress-keymap gnus-server-mode-map) (gnus-define-keys gnus-server-mode-map @@ -253,9 +245,8 @@ If nil, a faster, but more primitive, buffer is used instead." ("(\\(offline\\))" 1 'gnus-server-offline) ("(\\(denied\\))" 1 'gnus-server-denied))) -(defun gnus-server-mode () +(define-derived-mode gnus-server-mode gnus-mode "Server" "Major mode for listing and editing servers. - All normal editing commands are switched off. \\ For more in-depth information on this mode, read the manual @@ -264,23 +255,16 @@ For more in-depth information on this mode, read the manual The following commands are available: \\{gnus-server-mode-map}" - ;; FIXME: Use define-derived-mode. - (interactive) (when (gnus-visual-p 'server-menu 'menu) (gnus-server-make-menu-bar)) - (kill-all-local-variables) (gnus-simplify-mode-line) - (setq major-mode 'gnus-server-mode) - (setq mode-name "Server") (gnus-set-default-directory) (setq mode-line-process nil) - (use-local-map gnus-server-mode-map) (buffer-disable-undo) (setq truncate-lines t) - (setq buffer-read-only t) (set (make-local-variable 'font-lock-defaults) - '(gnus-server-font-lock-keywords t)) - (gnus-run-mode-hooks 'gnus-server-mode-hook)) + '(gnus-server-font-lock-keywords t))) + (defun gnus-server-insert-server-line (name method) (let* ((gnus-tmp-name name) @@ -320,21 +304,15 @@ The following commands are available: (defun gnus-enter-server-buffer () "Set up the server buffer." - (gnus-server-setup-buffer) (gnus-configure-windows 'server) ;; Usually `gnus-configure-windows' will finish with the ;; `gnus-server-buffer' selected as the current buffer, but not always (I ;; bumped into it when starting from a dedicated *Group* frame, and ;; gnus-configure-windows opened *Server* into its own dedicated frame). - (with-current-buffer (get-buffer gnus-server-buffer) + (with-current-buffer (get-buffer-create gnus-server-buffer) + (gnus-server-mode) (gnus-server-prepare))) -(defun gnus-server-setup-buffer () - "Initialize the server buffer." - (unless (get-buffer gnus-server-buffer) - (with-current-buffer (gnus-get-buffer-create gnus-server-buffer) - (gnus-server-mode)))) - (defun gnus-server-prepare () (gnus-set-format 'server-mode) (gnus-set-format 'server t) @@ -717,9 +695,7 @@ claim them." function (repeat function))) -(defvar gnus-browse-mode-hook nil) (defvar gnus-browse-mode-map nil) -(put 'gnus-browse-mode 'mode-class 'special) (unless gnus-browse-mode-map (setq gnus-browse-mode-map (make-keymap)) @@ -897,9 +873,8 @@ claim them." (gnus-message 5 "Connecting to %s...done" (nth 1 method)) t)))) -(define-derived-mode gnus-browse-mode fundamental-mode "Browse Server" +(define-derived-mode gnus-browse-mode gnus-mode "Browse Server" "Major mode for browsing a foreign server. - All normal editing commands are switched off. \\ @@ -918,8 +893,7 @@ buffer. (setq mode-line-process nil) (buffer-disable-undo) (setq truncate-lines t) - (gnus-set-default-directory) - (setq buffer-read-only t)) + (gnus-set-default-directory)) (defun gnus-browse-read-group (&optional no-article number) "Enter the group at the current line. diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index f9fae3792b..1c4be09e2e 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -1842,8 +1842,6 @@ increase the score of each group you read." ;;; Gnus summary mode ;;; -(put 'gnus-summary-mode 'mode-class 'special) - (defvar gnus-article-commands-menu) ;; Non-orthogonal keys @@ -3052,10 +3050,8 @@ When FORCE, rebuild the tool bar." (defvar bidi-paragraph-direction) -(defun gnus-summary-mode (&optional group) +(define-derived-mode gnus-summary-mode gnus-mode "Summary" "Major mode for reading articles. - -All normal editing commands are switched off. \\ Each line in this buffer represents one article. To read an article, you can, for instance, type `\\[gnus-summary-next-page]'. To move forwards @@ -3072,24 +3068,16 @@ buffer; read the info pages for more information (`\\[gnus-info-find-node]'). The following commands are available: \\{gnus-summary-mode-map}" - ;; FIXME: Use define-derived-mode. - (interactive) - (kill-all-local-variables) (let ((gnus-summary-local-variables gnus-newsgroup-variables)) (gnus-summary-make-local-variables)) (gnus-summary-make-local-variables) - (setq gnus-newsgroup-name group) (when (gnus-visual-p 'summary-menu 'menu) (gnus-summary-make-menu-bar) (gnus-summary-make-tool-bar)) (gnus-make-thread-indent-array) (gnus-simplify-mode-line) - (setq major-mode 'gnus-summary-mode) - (setq mode-name "Summary") - (use-local-map gnus-summary-mode-map) (buffer-disable-undo) - (setq buffer-read-only t - show-trailing-whitespace nil + (setq show-trailing-whitespace nil truncate-lines t bidi-paragraph-direction 'left-to-right) (add-to-invisibility-spec '(gnus-sum . t)) @@ -3100,14 +3088,13 @@ The following commands are available: (make-local-variable 'gnus-summary-dummy-line-format) (make-local-variable 'gnus-summary-dummy-line-format-spec) (make-local-variable 'gnus-summary-mark-positions) + (make-local-variable 'gnus-article-buffer) + (make-local-variable 'gnus-article-current) + (make-local-variable 'gnus-original-article-buffer) (add-hook 'pre-command-hook 'gnus-set-global-variables nil t) - (gnus-run-mode-hooks 'gnus-summary-mode-hook) - (turn-on-gnus-mailing-list-mode) (mm-enable-multibyte) (set (make-local-variable 'bookmark-make-record-function) - 'gnus-summary-bookmark-make-record) - (gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy) - (gnus-update-summary-mark-positions)) + 'gnus-summary-bookmark-make-record)) (defun gnus-summary-make-local-variables () "Make all the local summary buffer variables." @@ -3478,8 +3465,11 @@ display only a single character." (current-buffer)))))) (defun gnus-summary-setup-buffer (group) - "Initialize summary buffer. -If the setup was successful, non-nil is returned." + "Initialize summary buffer for GROUP. +This function does all setup work that relies on the specific +value of GROUP, and puts the buffer in `gnus-summary-mode'. + +Returns non-nil if the setup was successful." (let ((buffer (gnus-summary-buffer-name group)) (dead-name (concat "*Dead Summary " (gnus-group-decoded-name group) "*"))) @@ -3493,13 +3483,15 @@ If the setup was successful, non-nil is returned." (not gnus-newsgroup-prepared)) (set-buffer (gnus-get-buffer-create buffer)) (setq gnus-summary-buffer (current-buffer)) - (gnus-summary-mode group) + (gnus-summary-mode) (when (gnus-group-quit-config group) (set (make-local-variable 'gnus-single-article-buffer) nil)) - (make-local-variable 'gnus-article-buffer) - (make-local-variable 'gnus-article-current) - (make-local-variable 'gnus-original-article-buffer) (setq gnus-newsgroup-name group) + (turn-on-gnus-mailing-list-mode) + ;; These functions don't currently depend on GROUP, but might in + ;; the future. + (gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy) + (gnus-update-summary-mark-positions) ;; Set any local variables in the group parameters. (gnus-summary-set-local-parameters gnus-newsgroup-name) t))) @@ -3935,6 +3927,15 @@ If SELECT-ARTICLES, only select those articles from GROUP." (defun gnus-summary-read-group-1 (group show-all no-article kill-buffer no-display &optional select-articles) + "Display articles and threads in a Summary buffer for GROUP." + ;; This function calls `gnus-summary-setup-buffer' to create the + ;; buffer, put it in `gnus-summary-mode', and set local variables; + ;; `gnus-select-newsgroup' to update the group's active and marks + ;; from the server; and `gnus-summary-prepare' to actually insert + ;; lines for articles. The rest of the function is mostly concerned + ;; with limiting and positioning and windowing and other visual + ;; effects. + ;; Killed foreign groups can't be entered. ;; (when (and (not (gnus-group-native-p group)) ;; (not (gnus-gethash group gnus-newsrc-hashtb))) diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 2786323f67..6c59b13574 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -637,6 +637,12 @@ be set in `.emacs' instead." "Face used for low interest read articles." :group 'gnus-summary) +;;; Base gnus-mode + +(define-derived-mode gnus-mode special-mode nil + "Base mode from which all other gnus modes derive. +This does nothing but derive from `special-mode', and should not +be used directly.") ;;; ;;; Gnus buffers commit efccd13c1fa451249886df696fd484c413c261ff Author: Filipp Gunbin Date: Fri Nov 23 16:39:25 2018 +0300 search.texi fix for leftover from C-M-w to C-M-d change * doc/emacs/search.texi: Replace C-M-w with C-M-d. diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index 801e8bb33e..35e2bfbb62 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -315,7 +315,7 @@ string that failed to match is highlighted using the face At this point, there are several things you can do. If your string was mistyped, use @key{DEL} to cancel a previous input item -(@pxref{Basic Isearch}), @kbd{C-M-w} to erase one character at a time, +(@pxref{Basic Isearch}), @kbd{C-M-d} to erase one character at a time, or @kbd{M-e} to edit it. If you like the place you have found, you can type @key{RET} to remain there. Or you can type @kbd{C-g}, which removes from the search string the characters that could not be found commit 8f0c7887ef7dc8f25326d6476fa025e13caa1981 Author: Eli Zaretskii Date: Fri Nov 23 12:16:48 2018 +0200 Improve documentation of 'edit-abbrevs-mode' * lisp/abbrev.el (edit-abbrevs-mode): Refer to 'edit-abbrevs' for more detailed usage information. (Bug#33443) (edit-abbrevs): Doc fix. diff --git a/lisp/abbrev.el b/lisp/abbrev.el index 734cefbb7b..f0fc59f31e 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -150,11 +150,12 @@ Otherwise display all abbrevs." (defun edit-abbrevs () "Alter abbrev definitions by editing a list of them. Selects a buffer containing a list of abbrev definitions with -point located in the abbrev table of current buffer. +point located in the abbrev table for the current buffer, and +turns on `edit-abbrevs-mode' in that buffer. You can edit them and type \\\\[edit-abbrevs-redefine] to redefine abbrevs according to your editing. -Buffer contains a header line for each abbrev table, - which is the abbrev table name in parentheses. +The abbrevs editing buffer contains a header line for each +abbrev table, which is the abbrev table name in parentheses. This is followed by one line per abbrev in that table: NAME USECOUNT EXPANSION HOOK where NAME and EXPANSION are strings with quotes, @@ -1022,7 +1023,9 @@ SORTFUN is passed to `sort' to change the default ordering." ;; Keep it after define-abbrev-table, since define-derived-mode uses ;; define-abbrev-table. (define-derived-mode edit-abbrevs-mode fundamental-mode "Edit-Abbrevs" - "Major mode for editing the list of abbrev definitions.") + "Major mode for editing the list of abbrev definitions. +This mode is for editing abbrevs in a buffer prepared by `edit-abbrevs', +which see.") (provide 'abbrev) commit 2b1bc701052767beff77a7d6f60dea80b30ba8de Author: Eli Zaretskii Date: Fri Nov 23 11:12:40 2018 +0200 Avoid compilation warning in emacsclient.c * lib-src/emacsclient.c (set_tcp_socket): Avoid compilation warning in MS-Windows build. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 9830eaecc6..3c6215a014 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -1001,7 +1001,9 @@ set_tcp_socket (const char *local_server_file) return INVALID_SOCKET; } - setsockopt (s, SOL_SOCKET, SO_LINGER, &l_arg, sizeof l_arg); + /* The cast to 'const char *' is to avoid a compiler warning when + compiling for MS-Windows sockets. */ + setsockopt (s, SOL_SOCKET, SO_LINGER, (const char *) &l_arg, sizeof l_arg); /* Send the authentication. */ auth_string[AUTH_KEY_LENGTH] = '\0'; commit 652dabfff6f99631f8f3d6c3a658f0b8895d48b0 Author: Paul Eggert Date: Fri Nov 23 00:33:37 2018 -0800 emacsclient: fix child exit when exec fails * lib-src/emacsclient.c (start_daemon_and_retry_set_socket): If the execvp of Emacs fails exit instead of having the child run on and do the work of the parent. Coalesce duplicate code. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index b5ed2e0435..9830eaecc6 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -1484,13 +1484,6 @@ start_daemon_and_retry_set_socket (void) /* Try connecting, the daemon should have started by now. */ message (true, "Emacs daemon should have started, trying to connect again\n"); - - if ((emacs_socket = set_socket (1)) == INVALID_SOCKET) - { - message (true, ("Error: Cannot connect " - "even after starting the Emacs daemon\n")); - exit (EXIT_FAILURE); - } } else if (dpid < 0) { @@ -1518,6 +1511,7 @@ start_daemon_and_retry_set_socket (void) # endif execvp ("emacs", d_argv); message (true, "%s: error starting emacs daemon\n", progname); + exit (EXIT_FAILURE); } # else /* WINDOWSNT */ DWORD wait_result; @@ -1583,13 +1577,15 @@ start_daemon_and_retry_set_socket (void) if (!w32_window_app ()) message (true, "Emacs daemon should have started, trying to connect again\n"); - if ((emacs_socket = set_socket (1)) == INVALID_SOCKET) +# endif /* WINDOWSNT */ + + emacs_socket = set_socket (true); + if (emacs_socket == INVALID_SOCKET) { message (true, "Error: Cannot connect even after starting the Emacs daemon\n"); exit (EXIT_FAILURE); } -# endif /* WINDOWSNT */ } #endif /* HAVE_SOCKETS && HAVE_INET_SOCKETS */ commit ef1f60301aabbcfc940bf8a826cd174ba2d0439c Author: Paul Eggert Date: Fri Nov 23 00:12:54 2018 -0800 emacsclient: one â€main’ function * lib-src/emacsclient.c (main): Simplify by having just one â€main’ function instead of two. Don’t assume argc is positive (!). diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index ef510b1f8b..b5ed2e0435 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -732,21 +732,7 @@ fail (void) } -#if !defined (HAVE_SOCKETS) || !defined (HAVE_INET_SOCKETS) - -int -main (int argc, char **argv) -{ - main_argc = argc; - main_argv = argv; - progname = argv[0]; - message (true, ("%s: Sorry, the Emacs server is supported only\n" - "on systems with Berkeley sockets.\n"), - argv[0]); - fail (); -} - -#else /* HAVE_SOCKETS && HAVE_INET_SOCKETS */ +#if defined HAVE_SOCKETS && defined HAVE_INET_SOCKETS enum { AUTH_KEY_LENGTH = 64 }; @@ -1519,7 +1505,7 @@ start_daemon_and_retry_set_socket (void) d_argv[0] = emacs; d_argv[1] = daemon_option; d_argv[2] = 0; -#ifndef NO_SOCKETS_IN_FILE_SYSTEM +# ifndef NO_SOCKETS_IN_FILE_SYSTEM if (socket_name != NULL) { /* Pass --daemon=socket_name as argument. */ @@ -1529,7 +1515,7 @@ start_daemon_and_retry_set_socket (void) strcpy (stpcpy (daemon_arg, deq), socket_name); d_argv[1] = daemon_arg; } -#endif +# endif execvp ("emacs", d_argv); message (true, "%s: error starting emacs daemon\n", progname); } @@ -1605,26 +1591,32 @@ start_daemon_and_retry_set_socket (void) } # endif /* WINDOWSNT */ } +#endif /* HAVE_SOCKETS && HAVE_INET_SOCKETS */ int main (int argc, char **argv) { + main_argc = argc; + main_argv = argv; + progname = argv[0] ? argv[0] : "emacsclient"; + +#if ! (defined HAVE_SOCKETS && defined HAVE_INET_SOCKETS) + message (true, "%s: Sorry, support for Berkeley sockets is required.\n", + progname); + fail (); +#else /* HAVE_SOCKETS && HAVE_INET_SOCKETS */ int rl = 0; bool skiplf = true; - char string[BUFSIZ+1]; + char string[BUFSIZ + 1]; int exit_status = EXIT_SUCCESS; - main_argc = argc; - main_argv = argv; - progname = argv[0]; - -#ifdef HAVE_NTGUI +# ifdef HAVE_NTGUI /* On Windows 7 and later, we need to explicitly associate emacsclient with emacs so the UI behaves sensibly. This association does no harm if we're not actually connecting to an Emacs using a window display. */ w32_set_user_model_id (); -#endif /* HAVE_NTGUI */ +# endif /* HAVE_NTGUI */ /* Process options. */ decode_options (argc, argv); @@ -1637,7 +1629,7 @@ main (int argc, char **argv) exit (EXIT_FAILURE); } -#ifndef WINDOWSNT +# ifndef WINDOWSNT if (tty) { pid_t pgrp = getpgrp (); @@ -1645,7 +1637,7 @@ main (int argc, char **argv) if (0 <= tcpgrp && tcpgrp != pgrp) kill (-pgrp, SIGTTIN); } -#endif /* !WINDOWSNT */ +# endif /* !WINDOWSNT */ /* If alternate_editor is the empty string, start the emacs daemon in case of failure to connect. */ @@ -1935,6 +1927,5 @@ main (int argc, char **argv) CLOSE_SOCKET (emacs_socket); return exit_status; -} - #endif /* HAVE_SOCKETS && HAVE_INET_SOCKETS */ +} commit 5daba9d8a55d4fa28600f097490bc675eb848957 Author: Paul Eggert Date: Thu Nov 22 23:42:50 2018 -0800 emacsclient: tidy socket failure cleanup * lib-src/emacsclient.c (set_tcp_socket, set_local_socket): Close socket (instead of leaking it) when â€connect’ fails. (socket_status): Return errno if stat fails and -1 if we don’t own. (set_local_socket): Simplify based on socket_status change. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 6f2fb20ae5..ef510b1f8b 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -485,7 +485,7 @@ message (bool is_error, const char *format, ...) } /* Decode the options from argv and argc. - The global variable `optind' will say how many arguments we used up. */ + The global variable 'optind' will say how many arguments we used up. */ static void decode_options (int argc, char **argv) @@ -584,7 +584,7 @@ decode_options (int argc, char **argv) /* If the -c option is used (without -t) and no --display argument is provided, try $DISPLAY. - Without the -c option, we used to set `display' to $DISPLAY by + Without the -c option, we used to set 'display' to $DISPLAY by default, but this changed the default behavior and is sometimes inconvenient. So we force users to use "--display $DISPLAY" if they want Emacs to connect to their current display. @@ -1011,6 +1011,7 @@ set_tcp_socket (const char *local_server_file) if (connect (s, &server.sa, sizeof server.in) != 0) { sock_err_message ("connect"); + CLOSE_SOCKET (s); return INVALID_SOCKET; } @@ -1083,8 +1084,8 @@ find_tty (const char **tty_type, const char **tty_name, bool noabort) # ifndef NO_SOCKETS_IN_FILE_SYSTEM /* Three possibilities: - 2 - can't be `stat'ed (sets errno) - 1 - isn't owned by us + >0 - 'stat' failed with this errno value + -1 - isn't owned by us 0 - success: none of the above */ static int @@ -1092,11 +1093,11 @@ socket_status (const char *name) { struct stat statbfr; - if (stat (name, &statbfr) == -1) - return 2; + if (stat (name, &statbfr) != 0) + return errno; if (statbfr.st_uid != geteuid ()) - return 1; + return -1; return 0; } @@ -1201,8 +1202,6 @@ set_local_socket (const char *local_socket_name) return INVALID_SOCKET; } - int sock_status; - int saved_errno; char const *server_name = local_socket_name; char const *tmpdir = NULL; char *tmpdir_storage = NULL; @@ -1250,8 +1249,7 @@ set_local_socket (const char *local_socket_name) } /* See if the socket exists, and if it's owned by us. */ - sock_status = socket_status (server.un.sun_path); - saved_errno = errno; + int sock_status = socket_status (server.un.sun_path); if (sock_status && tmpdir) { /* Failing that, see if LOGNAME or USER exist and differ from @@ -1289,10 +1287,7 @@ set_local_socket (const char *local_socket_name) free (user_socket_name); sock_status = socket_status (server.un.sun_path); - saved_errno = errno; } - else - errno = saved_errno; } } @@ -1301,14 +1296,20 @@ set_local_socket (const char *local_socket_name) switch (sock_status) { - case 1: + case -1: /* There's a socket, but it isn't owned by us. */ message (true, "%s: Invalid socket owner\n", progname); - return INVALID_SOCKET; + break; + + case 0: + if (connect (s, &server.sa, sizeof server.un) == 0) + return s; + message (true, "%s: connect: %s\n", progname, strerror (errno)); + break; - case 2: - /* `stat' failed */ - if (saved_errno == ENOENT) + default: + /* 'stat' failed. */ + if (sock_status == ENOENT) message (true, ("%s: can't find socket; have you started the server?\n" "%s: To start the server in Emacs," @@ -1317,16 +1318,11 @@ set_local_socket (const char *local_socket_name) else message (true, "%s: can't stat %s: %s\n", progname, server.un.sun_path, strerror (sock_status)); - return INVALID_SOCKET; + break; } - if (connect (s, &server.sa, sizeof server.un) != 0) - { - message (true, "%s: connect: %s\n", progname, strerror (errno)); - return INVALID_SOCKET; - } - - return s; + CLOSE_SOCKET (s); + return INVALID_SOCKET; } # endif /* ! NO_SOCKETS_IN_FILE_SYSTEM */ commit 3c643e73b276acaa33759af5eea5feebf2c00339 Author: Glenn Morris Date: Thu Nov 22 15:34:48 2018 -0800 ; NEWS tweak diff --git a/etc/NEWS b/etc/NEWS index 0cc6a29f0d..399508cacc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -59,9 +59,9 @@ directory and all of its subdirectories. For symmetry, 'Z' on a '.tar.gz' or a '.tgz' archive extracts all the archived files into the current directory; thus, typing 'Z' on a '.tar.gz' archive created by a previous 'Z' command will extract the archived files into a -directory whose name is the archive name sans the '.tar.gz' or '.tgz' -extension. (This change was actually made in Emacs 25.1 and 26.1, but -was only partially called out in their NEWS.) +directory whose name is the archive name sans the '.tar.gz' extension. +(This change was actually made in Emacs 25.1 but was only +partially called out in its NEWS; 'tgz' handling was added in 26.1.) ** Ibuffer commit 4dc73269561237d04280b0a212eee603f1e73c9f Author: Juri Linkov Date: Fri Nov 23 00:02:56 2018 +0200 Add Isearch commands for going to absolute occurrence of matches (bug#29321) * lisp/isearch.el (isearch-mode-map): Bind 'M-s M-<' to 'isearch-beginning-of-buffer' and 'isearch-end-of-buffer' to 'M-s M->'. (isearch-beginning-of-buffer, isearch-end-of-buffer): New commands. diff --git a/etc/NEWS b/etc/NEWS index dc08e1caf2..f413bbea06 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -647,6 +647,14 @@ A negative argument repeats the search in the opposite direction. This makes possible also to use a prefix argument for 'M-s .' ('isearch-forward-symbol-at-point') to find the next Nth symbol. +*** To go to the first/last occurrence of the current search string +is possible now with new commands 'isearch-beginning-of-buffer' and +'isearch-end-of-buffer' bound to 'M-s M-<' and 'M-s M->' in Isearch. +With a numeric argument, they go to the Nth absolute occurrence +counting from the beginning/end of the buffer. This complements +'C-s'/'C-r' that searches for the next Nth relative occurrence +with a numeric argument. + *** 'isearch-lazy-count' shows the current match number and total number of matches in the Isearch prompt. Customizable variables 'lazy-count-prefix-format' and 'lazy-count-suffix-format' define the diff --git a/lisp/isearch.el b/lisp/isearch.el index b05805ccd6..5099fb39f6 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -544,6 +544,9 @@ This is like `describe-bindings', but displays only Isearch keys." (define-key map "\C-y" 'isearch-yank-kill) (define-key map "\M-s\C-e" 'isearch-yank-line) + (define-key map "\M-s\M-<" 'isearch-beginning-of-buffer) + (define-key map "\M-s\M->" 'isearch-end-of-buffer) + (define-key map (char-to-string help-char) isearch-help-map) (define-key map [help] isearch-help-map) (define-key map [f1] isearch-help-map) @@ -1622,8 +1625,12 @@ Use `isearch-exit' to quit without signaling." (defun isearch-repeat-forward (&optional arg) "Repeat incremental search forwards. -With a prefix argument, repeat the search ARG times. -A negative argument searches backwards." +With a numeric argument, repeat the search ARG times. +A negative argument searches backwards. +\\ +This command finds the next relative occurrence of the current +search string. To find the absolute occurrence from the beginning +of the buffer, type \\[isearch-beginning-of-buffer] with a numeric argument." (interactive "P") (if arg (let ((count (prefix-numeric-value arg))) @@ -1639,8 +1646,12 @@ A negative argument searches backwards." (defun isearch-repeat-backward (&optional arg) "Repeat incremental search backwards. -With a prefix argument, repeat the search ARG times. -A negative argument searches forwards." +With a numeric argument, repeat the search ARG times. +A negative argument searches forwards. +\\ +This command finds the next relative occurrence of the current +search string. To find the absolute occurrence from the end +of the buffer, type \\[isearch-end-of-buffer] with a numeric argument." (interactive "P") (if arg (let ((count (prefix-numeric-value arg))) @@ -1654,6 +1665,36 @@ A negative argument searches forwards." (isearch-repeat 'backward count)))) (isearch-repeat 'backward))) +(defun isearch-beginning-of-buffer (&optional arg) + "Go to the first occurrence of the current search string. +Move point to the beginning of the buffer and search forwards from the top. +\\ +With a numeric argument, go to the ARGth absolute occurrence counting from +the beginning of the buffer. To find the next relative occurrence forwards, +type \\[isearch-repeat-forward] with a numeric argument." + (interactive "p") + (if (and arg (< arg 0)) + (isearch-end-of-buffer (abs arg)) + ;; For the case when the match is at bobp, + ;; don't forward char in isearch-repeat + (setq isearch-just-started t) + (goto-char (point-min)) + (isearch-repeat 'forward arg))) + +(defun isearch-end-of-buffer (&optional arg) + "Go to the last occurrence of the current search string. +Move point to the end of the buffer and search backwards from the bottom. +\\ +With a numeric argument, go to the ARGth absolute occurrence counting from +the end of the buffer. To find the next relative occurrence backwards, +type \\[isearch-repeat-backward] with a numeric argument." + (interactive "p") + (if (and arg (< arg 0)) + (isearch-beginning-of-buffer (abs arg)) + (setq isearch-just-started t) + (goto-char (point-max)) + (isearch-repeat 'backward arg))) + ;;; Toggles for `isearch-regexp-function' and `search-default-mode'. (defmacro isearch-define-mode-toggle (mode key function &optional docstring &rest body) commit 477414ac38399a63fd69f3b2457f5716a02b3eae Author: Eli Zaretskii Date: Thu Nov 22 21:05:14 2018 +0200 Improve documentation of 'dired-do-compress' * lisp/dired-aux.el (dired-do-compress): Describe in the doc string the effect on directories and on compressed archive. (Bug#33450) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index eaf5f25701..2800bbe902 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1225,7 +1225,12 @@ return t; if SYM is q or ESC, return nil." ;;;###autoload (defun dired-do-compress (&optional arg) - "Compress or uncompress marked (or next ARG) files." + "Compress or uncompress marked (or next ARG) files. +If invoked on a directory, compress all of the files in +the directory and all of its subdirectories, recursively, +into a .tar.gz archive. +If invoked on a .tar.gz or a .tgz or a .zip or a .7z archive, +uncompress and unpack all the files in the archive." (interactive "P") (dired-map-over-marks-check #'dired-compress arg 'compress t)) commit 9c09b1d23124cc3fc27deb476994b288e66bcad0 Author: Eli Zaretskii Date: Thu Nov 22 20:54:05 2018 +0200 ; * etc/NES: Minor change in the description of Dired's 'Z'. diff --git a/etc/NEWS b/etc/NEWS index dab43024f2..0cc6a29f0d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -56,12 +56,12 @@ often cause crashes. Set it to nil if you really need those fonts. *** The 'Z' command on a directory name compresses all of its files. It produces a compressed '.tar.gz' archive with all the files in the directory and all of its subdirectories. For symmetry, 'Z' on a -'.tar.gz' or a '.tgz' archive extracts all the archived files into -the current directory; thus, typing 'Z' on a '.tar.gz' archive created -by a previous 'Z' command will extract the archived files into a +'.tar.gz' or a '.tgz' archive extracts all the archived files into the +current directory; thus, typing 'Z' on a '.tar.gz' archive created by +a previous 'Z' command will extract the archived files into a directory whose name is the archive name sans the '.tar.gz' or '.tgz' -extension. (This change was actually made in Emacs 26.1, but was not -called out in its NEWS.) +extension. (This change was actually made in Emacs 25.1 and 26.1, but +was only partially called out in their NEWS.) ** Ibuffer commit 7a85753d35b9b010baed7e297f72b308318c3b67 Author: Paul Eggert Date: Thu Nov 22 09:32:33 2018 -0800 emacsclient: coalesce WINDOWSNT-specific code * lib-src/emacsclient.c (sock_err_message) [WINDOWSNT]: Do nothing if w32_window_app () && alternate_editor. Both callers changed. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index e6eb3c74cf..6f2fb20ae5 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -753,14 +753,17 @@ enum { AUTH_KEY_LENGTH = 64 }; /* Socket used to communicate with the Emacs server process. */ static HSOCKET emacs_socket = 0; -/* On Windows, the socket library was historically separate from the - standard C library, so errors are handled differently. */ - static void sock_err_message (const char *function_name) { # ifdef WINDOWSNT - char* msg = NULL; + /* On Windows, the socket library was historically separate from the + standard C library, so errors are handled differently. */ + + if (w32_window_app () && alternate_editor) + return; + + char *msg = NULL; FormatMessage (FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER @@ -1000,9 +1003,6 @@ set_tcp_socket (const char *local_server_file) yet; popping out a modal dialog at this stage would make -a option totally useless for emacsclientw -- the user will still get an error message if the alternate editor fails. */ -# ifdef WINDOWSNT - if(!(w32_window_app () && alternate_editor)) -# endif sock_err_message ("socket"); return INVALID_SOCKET; } @@ -1010,9 +1010,6 @@ set_tcp_socket (const char *local_server_file) /* Set up the socket. */ if (connect (s, &server.sa, sizeof server.in) != 0) { -# ifdef WINDOWSNT - if(!(w32_window_app () && alternate_editor)) -# endif sock_err_message ("connect"); return INVALID_SOCKET; } commit 5773470ff3a85640fbaeab1a88edc3fa395184bd Author: Paul Eggert Date: Thu Nov 22 09:21:22 2018 -0800 emacsclient: sockaddr portability fixes * lib-src/emacsclient.c (get_server_config, set_tcp_socket) (set_local_socket): Initialize any platform-specific extensions of struct to zero, just in case. (set_tcp_socket, set_local_socket): Don’t assume struct layout details that POSIX does not specify. Use union to sidestep some problems with strict aliasing. Remove unnecessary casts. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 4ab97c3c50..e6eb3c74cf 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -959,6 +959,7 @@ get_server_config (const char *config_file, struct sockaddr_in *server, exit (EXIT_FAILURE); } + memset (server, 0, sizeof *server); server->sin_family = AF_INET; server->sin_addr.s_addr = inet_addr (dotted); server->sin_port = htons (atoi (port)); @@ -977,16 +978,19 @@ get_server_config (const char *config_file, struct sockaddr_in *server, static HSOCKET set_tcp_socket (const char *local_server_file) { - struct sockaddr_in server; - struct linger l_arg = {1, 1}; + union { + struct sockaddr_in in; + struct sockaddr sa; + } server; + struct linger l_arg = { .l_onoff = 1, .l_linger = 1 }; char auth_string[AUTH_KEY_LENGTH + 1]; - if (! get_server_config (local_server_file, &server, auth_string)) + if (! get_server_config (local_server_file, &server.in, auth_string)) return INVALID_SOCKET; - if (server.sin_addr.s_addr != inet_addr ("127.0.0.1") && !quiet) + if (server.in.sin_addr.s_addr != inet_addr ("127.0.0.1") && !quiet) message (false, "%s: connected to remote socket at %s\n", - progname, inet_ntoa (server.sin_addr)); + progname, inet_ntoa (server.in.sin_addr)); /* Open up an AF_INET socket. */ HSOCKET s = socket (AF_INET, SOCK_STREAM, IPPROTO_TCP); @@ -1004,7 +1008,7 @@ set_tcp_socket (const char *local_server_file) } /* Set up the socket. */ - if (connect (s, (struct sockaddr *) &server, sizeof server) < 0) + if (connect (s, &server.sa, sizeof server.in) != 0) { # ifdef WINDOWSNT if(!(w32_window_app () && alternate_editor)) @@ -1013,7 +1017,7 @@ set_tcp_socket (const char *local_server_file) return INVALID_SOCKET; } - setsockopt (s, SOL_SOCKET, SO_LINGER, (char *) &l_arg, sizeof l_arg); + setsockopt (s, SOL_SOCKET, SO_LINGER, &l_arg, sizeof l_arg); /* Send the authentication. */ auth_string[AUTH_KEY_LENGTH] = '\0'; @@ -1183,13 +1187,16 @@ init_signals (void) signal (SIGTTOU, handle_sigtstp); } +/* Create a local socket and connect it to Emacs. */ static HSOCKET set_local_socket (const char *local_socket_name) { - struct sockaddr_un server; + union { + struct sockaddr_un un; + struct sockaddr sa; + } server = {{ .sun_family = AF_UNIX }}; - /* Open up an AF_UNIX socket in this person's home directory. */ HSOCKET s = socket (AF_UNIX, SOCK_STREAM, 0); if (s < 0) { @@ -1197,8 +1204,6 @@ set_local_socket (const char *local_socket_name) return INVALID_SOCKET; } - server.sun_family = AF_UNIX; - int sock_status; int saved_errno; char const *server_name = local_socket_name; @@ -1221,7 +1226,7 @@ set_local_socket (const char *local_socket_name) # ifndef _CS_DARWIN_USER_TEMP_DIR # define _CS_DARWIN_USER_TEMP_DIR 65537 # endif - size_t n = confstr (_CS_DARWIN_USER_TEMP_DIR, NULL, (size_t) 0); + size_t n = confstr (_CS_DARWIN_USER_TEMP_DIR, NULL, 0); if (n > 0) { tmpdir = tmpdir_storage = xmalloc (n); @@ -1238,8 +1243,8 @@ set_local_socket (const char *local_socket_name) local_socket_name = socket_name_storage; } - if (strlen (local_socket_name) < sizeof (server.sun_path)) - strcpy (server.sun_path, local_socket_name); + if (strlen (local_socket_name) < sizeof server.un.sun_path) + strcpy (server.un.sun_path, local_socket_name); else { message (true, "%s: socket-name %s too long\n", @@ -1248,7 +1253,7 @@ set_local_socket (const char *local_socket_name) } /* See if the socket exists, and if it's owned by us. */ - sock_status = socket_status (server.sun_path); + sock_status = socket_status (server.un.sun_path); saved_errno = errno; if (sock_status && tmpdir) { @@ -1276,8 +1281,8 @@ set_local_socket (const char *local_socket_name) char *z = stpcpy (user_socket_name, tmpdir); strcpy (z + sprintf (z, subdir_format, uid), server_name); - if (strlen (user_socket_name) < sizeof (server.sun_path)) - strcpy (server.sun_path, user_socket_name); + if (strlen (user_socket_name) < sizeof server.un.sun_path) + strcpy (server.un.sun_path, user_socket_name); else { message (true, "%s: socket-name %s too long\n", @@ -1286,7 +1291,7 @@ set_local_socket (const char *local_socket_name) } free (user_socket_name); - sock_status = socket_status (server.sun_path); + sock_status = socket_status (server.un.sun_path); saved_errno = errno; } else @@ -1314,12 +1319,11 @@ set_local_socket (const char *local_socket_name) progname, progname); else message (true, "%s: can't stat %s: %s\n", - progname, server.sun_path, strerror (saved_errno)); + progname, server.un.sun_path, strerror (sock_status)); return INVALID_SOCKET; } - if (connect (s, (struct sockaddr *) &server, strlen (server.sun_path) + 2) - < 0) + if (connect (s, &server.sa, sizeof server.un) != 0) { message (true, "%s: connect: %s\n", progname, strerror (errno)); return INVALID_SOCKET; commit a344d9937bb7edfbfbea13dca1569fcdcad25ac2 Author: Michael Albinus Date: Thu Nov 22 16:29:25 2018 +0100 Some minor Tramp cleanups * lisp/net/tramp-adb.el (tramp-adb-file-name-p): * lisp/net/tramp-ftp.el (tramp-ftp-file-name-p): * lisp/net/tramp-smb.el (tramp-smb-file-name-p): Make it more robust. * lisp/net/tramp.el (tramp-handle-file-truename): Cache only the localname. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 36374f88e0..00c6ad43ea 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -173,8 +173,9 @@ It is used for TCP/IP devices." ;;;###tramp-autoload (defsubst tramp-adb-file-name-p (filename) "Check if it's a filename for ADB." - (let ((v (tramp-dissect-file-name filename))) - (string= (tramp-file-name-method v) tramp-adb-method))) + (and (tramp-tramp-file-p filename) + (string= (tramp-file-name-method (tramp-dissect-file-name filename)) + tramp-adb-method))) ;;;###tramp-autoload (defun tramp-adb-file-name-handler (operation &rest args) diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el index 983f168ddb..5d8b56e218 100644 --- a/lisp/net/tramp-ftp.el +++ b/lisp/net/tramp-ftp.el @@ -183,8 +183,9 @@ pass to the OPERATION." ;;;###tramp-autoload (defsubst tramp-ftp-file-name-p (filename) "Check if it's a filename that should be forwarded to Ange-FTP." - (string= (tramp-file-name-method (tramp-dissect-file-name filename)) - tramp-ftp-method)) + (and (tramp-tramp-file-p filename) + (string= (tramp-file-name-method (tramp-dissect-file-name filename)) + tramp-ftp-method))) ;;;###tramp-autoload (add-to-list 'tramp-foreign-file-name-handler-alist diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index c150edf3f1..fb687f0d7b 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -2088,7 +2088,7 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi." ;;; TODO: ;; * (Customizable) unmount when exiting Emacs. See tramp-archive.el. - +;; ;; * Host name completion for existing mount points (afp-server, ;; smb-server, google-drive, nextcloud) or via smb-network or network. ;; diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index a97b801730..eadb4029b5 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -321,8 +321,9 @@ This can be used to disable echo etc." ;;;###tramp-autoload (defsubst tramp-smb-file-name-p (filename) "Check if it's a filename for SMB servers." - (string= (tramp-file-name-method (tramp-dissect-file-name filename)) - tramp-smb-method)) + (and (tramp-tramp-file-p filename) + (string= (tramp-file-name-method (tramp-dissect-file-name filename)) + tramp-smb-method))) ;;;###tramp-autoload (defun tramp-smb-file-name-handler (operation &rest args) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 8362d78752..97f931a4a4 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3301,31 +3301,34 @@ User is always nil." (numchase-limit 20) symlink-target) (with-parsed-tramp-file-name result v1 - (with-tramp-file-property v1 v1-localname "file-truename" - (while (and (setq symlink-target (file-symlink-p result)) - (< numchase numchase-limit)) - (setq numchase (1+ numchase) - result - (with-parsed-tramp-file-name (expand-file-name result) v2 - (tramp-make-tramp-file-name - v2 - (funcall - (if (tramp-compat-file-name-quoted-p v2-localname) - 'tramp-compat-file-name-quote 'identity) - - (if (stringp symlink-target) - (if (file-remote-p symlink-target) - (let (file-name-handler-alist) - (tramp-compat-file-name-quote symlink-target)) - (expand-file-name - symlink-target (file-name-directory v2-localname))) - v2-localname)) - 'nohop))) - (when (>= numchase numchase-limit) - (tramp-error - v1 'file-error - "Maximum number (%d) of symlinks exceeded" numchase-limit))) - (directory-file-name result)))))) + ;; We cache only the localname. + (tramp-make-tramp-file-name + v1 + (with-tramp-file-property v1 v1-localname "file-truename" + (while (and (setq symlink-target (file-symlink-p result)) + (< numchase numchase-limit)) + (setq numchase (1+ numchase) + result + (with-parsed-tramp-file-name (expand-file-name result) v2 + (tramp-make-tramp-file-name + v2 + (funcall + (if (tramp-compat-file-name-quoted-p v2-localname) + 'tramp-compat-file-name-quote 'identity) + + (if (stringp symlink-target) + (if (file-remote-p symlink-target) + (let (file-name-handler-alist) + (tramp-compat-file-name-quote symlink-target)) + (expand-file-name + symlink-target (file-name-directory v2-localname))) + v2-localname)) + 'nohop))) + (when (>= numchase numchase-limit) + (tramp-error + v1 'file-error + "Maximum number (%d) of symlinks exceeded" numchase-limit))) + (file-local-name (directory-file-name result)))))))) (defun tramp-handle-find-backup-file-name (filename) "Like `find-backup-file-name' for Tramp files." commit 52715e36dead5b1514930045045796b221b3ed39 Author: Eli Zaretskii Date: Thu Nov 22 17:28:51 2018 +0200 Improve doc string and display of 'describe-character' * lisp/descr-text.el (describe-char): Explain how does the function obtain the various data about the character. Don't display "preferred" before "charset": it tends to confuse people. diff --git a/lisp/descr-text.el b/lisp/descr-text.el index 00b40826f4..517e2895cb 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el @@ -386,13 +386,22 @@ The position information includes POS; the total size of BUFFER; the region limits, if narrowed; the column number; and the horizontal scroll amount, if the buffer is horizontally scrolled. -The character information includes the character code; charset and -code points in it; syntax; category; how the character is encoded in -BUFFER and in BUFFER's file; character composition information (if -relevant); the font and font glyphs used to display the character; -the character's canonical name and other properties defined by the -Unicode Data Base; and widgets, buttons, overlays, and text properties -relevant to POS." +The character information includes: + its codepoint; + its charset (see `char-charset'), overridden by the `charset' text + property at POS, if any; + the codepoint of the character in the above charset; + the character's script (as defined by `char-script-table') + the character's syntax, as produced by `syntax-after' + and `internal-describe-syntax-value'; + its category (see `char-category-set' and `describe-char-categories'); + how to input the character using the keyboard and input methods; + how the character is encoded in BUFFER and in BUFFER's file; + the font and font glyphs used to display the character; + the composition information for displaying the character (if relevant); + the character's canonical name and other properties defined by the + Unicode Data Base; + and widgets, buttons, overlays, and text properties relevant to POS." (interactive "d") (unless (buffer-live-p buffer) (setq buffer (current-buffer))) (let ((src-buf (current-buffer))) @@ -562,7 +571,7 @@ relevant to POS." (apply 'propertize char-description (text-properties-at pos)) char char char)) - ("preferred charset" + ("charset" ,`(insert-text-button ,(symbol-name charset) 'type 'help-character-set 'help-args '(,charset)) commit ad063d2552d4d31fa668fa5f15a91aec18c010f6 Author: Paul Eggert Date: Wed Nov 21 18:37:44 2018 -0800 emacsclient: getopt minor cleanup * lib-src/emacsclient.c (shortopts): New constant. (decode_options): Use it. Do not assume EOF == -1. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 908602ec25..4ab97c3c50 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -153,6 +153,7 @@ static char const *frame_parameters; static _Noreturn void print_help_and_exit (void); +/* Long command-line options. */ static struct option const longopts[] = { @@ -177,6 +178,15 @@ static struct option const longopts[] = { 0, 0, 0, 0 } }; +/* Short options, in the same order as the corresponding long options. + There is no '-p' short option. */ +static char const shortopts[] = + "nqueHVtca:F:" +#ifndef NO_SOCKETS_IN_FILE_SYSTEM + "s:" +#endif + "f:d:T:"; + /* Like malloc but get fatal error if memory is exhausted. */ @@ -485,15 +495,8 @@ decode_options (int argc, char **argv) while (true) { - int opt = getopt_long_only (argc, argv, -#ifndef NO_SOCKETS_IN_FILE_SYSTEM - "VHnequa:s:f:d:F:tcT:", -#else - "VHnequa:f:d:F:tcT:", -#endif - longopts, 0); - - if (opt == EOF) + int opt = getopt_long_only (argc, argv, shortopts, longopts, NULL); + if (opt < 0) break; switch (opt) commit 0f22bf099e569790fe6bb830522b5e41be41bbb6 Author: Paul Eggert Date: Wed Nov 21 14:47:53 2018 -0800 emacsclient: omit EXTRA_SPACE guesswork * lib-src/emacsclient.c: Include . (EXTRA_SPACE): Remove; code no longer guesses this is enough. (open_config): New function. (get_server_config): Use it. (set_local_socket): Compute upper bound of buffer size instead of guessing via EXTRA_SPACE. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index b7d4e81376..908602ec25 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -84,6 +84,7 @@ char *w32_getenv (const char *); #include #include +#include #include #include @@ -91,8 +92,6 @@ char *w32_getenv (const char *); #define VERSION "unspecified" #endif -/* Additional space when allocating buffers for filenames, etc. */ -#define EXTRA_SPACE 100 /* Name used to invoke this program. */ static char const *progname; @@ -903,6 +902,26 @@ initialize_sockets (void) # endif /* WINDOWSNT */ +/* If the home directory is HOME, return the configuration file with + basename CONFIG_FILE. Fail if there is no home directory or if the + configuration file could not be opened. */ + +static FILE * +open_config (char const *home, char const *config_file) +{ + if (!home) + return NULL; + ptrdiff_t homelen = strlen (home); + static char const emacs_d_server[] = "/.emacs.d/server/"; + ptrdiff_t suffixsize = sizeof emacs_d_server + strlen (config_file); + char *configname = xmalloc (homelen + suffixsize); + strcpy (stpcpy (stpcpy (configname, home), emacs_d_server), config_file); + + FILE *config = fopen (configname, "rb"); + free (configname); + return config; +} + /* Read the information needed to set up a TCP comm channel with the Emacs server: host, port, and authentication string. */ @@ -912,35 +931,16 @@ get_server_config (const char *config_file, struct sockaddr_in *server, { char dotted[32]; char *port; - FILE *config = NULL; + FILE *config; if (IS_ABSOLUTE_FILE_NAME (config_file)) config = fopen (config_file, "rb"); else { - const char *home = egetenv ("HOME"); - - if (home) - { - char *path = xmalloc (strlen (home) + strlen (config_file) - + EXTRA_SPACE); - char *z = stpcpy (path, home); - z = stpcpy (z, "/.emacs.d/server/"); - strcpy (z, config_file); - config = fopen (path, "rb"); - free (path); - } + config = open_config (egetenv ("HOME"), config_file); # ifdef WINDOWSNT - if (!config && (home = egetenv ("APPDATA"))) - { - char *path = xmalloc (strlen (home) + strlen (config_file) - + EXTRA_SPACE); - char *z = stpcpy (path, home); - z = stpcpy (z, "/.emacs.d/server/"); - strcpy (z, config_file); - config = fopen (path, "rb"); - free (path); - } + if (!config) + config = open_config (egetenv ("APPDATA"), config_file); # endif } @@ -1203,6 +1203,8 @@ set_local_socket (const char *local_socket_name) char *tmpdir_storage = NULL; char *socket_name_storage = NULL; static char const subdir_format[] = "/emacs%"PRIuMAX"/"; + int subdir_size_bound = (sizeof subdir_format - sizeof "%"PRIuMAX + + INT_STRLEN_BOUND (uid_t) + 1); if (! (strchr (local_socket_name, '/') || (ISSLASH ('\\') && strchr (local_socket_name, '\\')))) @@ -1227,10 +1229,9 @@ set_local_socket (const char *local_socket_name) tmpdir = "/tmp"; } socket_name_storage = - xmalloc (strlen (tmpdir) + strlen (server_name) + EXTRA_SPACE); + xmalloc (strlen (tmpdir) + strlen (server_name) + subdir_size_bound); char *z = stpcpy (socket_name_storage, tmpdir); - z += sprintf (z, subdir_format, uid); - strcpy (z, server_name); + strcpy (z + sprintf (z, subdir_format, uid), server_name); local_socket_name = socket_name_storage; } @@ -1268,10 +1269,9 @@ set_local_socket (const char *local_socket_name) uintmax_t uid = pw->pw_uid; char *user_socket_name = xmalloc (strlen (tmpdir) + strlen (server_name) - + EXTRA_SPACE); + + subdir_size_bound); char *z = stpcpy (user_socket_name, tmpdir); - z += sprintf (z, subdir_format, uid); - strcpy (z, server_name); + strcpy (z + sprintf (z, subdir_format, uid), server_name); if (strlen (user_socket_name) < sizeof (server.sun_path)) strcpy (server.sun_path, user_socket_name); commit cdb0d080f1bb2239ccb828d989d6bb73409d5f59 Author: Juri Linkov Date: Wed Nov 21 23:33:22 2018 +0200 Add prefix arg to isearch-forward-symbol-at-point (bug#29321) * lisp/isearch.el (isearch-forward-symbol-at-point): Add optional arg. diff --git a/etc/NEWS b/etc/NEWS index 13d660812d..dc08e1caf2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -644,6 +644,8 @@ can now be searched via 'C-s'. and 'C-r' ('isearch-repeat-backward'). With a prefix argument, these commands repeat the search for the specified occurrence of the search string. A negative argument repeats the search in the opposite direction. +This makes possible also to use a prefix argument for 'M-s .' +('isearch-forward-symbol-at-point') to find the next Nth symbol. *** 'isearch-lazy-count' shows the current match number and total number of matches in the Isearch prompt. Customizable variables diff --git a/lisp/isearch.el b/lisp/isearch.el index 6d94ef6693..b05805ccd6 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -887,21 +887,26 @@ as a regexp. See the command `isearch-forward-regexp' for more information." (interactive "P\np") (isearch-mode nil (null not-regexp) nil (not no-recursive-edit))) -(defun isearch-forward-symbol-at-point () +(defun isearch-forward-symbol-at-point (&optional arg) "Do incremental search forward for a symbol found near point. Like ordinary incremental search except that the symbol found at point is added to the search string initially as a regexp surrounded by symbol boundary constructs \\_< and \\_>. -See the command `isearch-forward-symbol' for more information." - (interactive) +See the command `isearch-forward-symbol' for more information. +With a prefix argument, search for ARGth symbol forward if ARG is +positive, or search for ARGth symbol backward if ARG is negative." + (interactive "P") (isearch-forward-symbol nil 1) - (let ((bounds (find-tag-default-bounds))) + (let ((bounds (find-tag-default-bounds)) + (count (and arg (prefix-numeric-value arg)))) (cond (bounds (when (< (car bounds) (point)) (goto-char (car bounds))) (isearch-yank-string - (buffer-substring-no-properties (car bounds) (cdr bounds)))) + (buffer-substring-no-properties (car bounds) (cdr bounds))) + (when count + (isearch-repeat-forward count))) (t (setq isearch-error "No symbol at point") (isearch-push-state) commit 8f49cb00d06e06c2db67305433e743e706645bb2 Author: Paul Eggert Date: Wed Nov 21 11:35:44 2018 -0800 emacsclient: take more care with int width * lib-src/emacsclient.c: Include inttypes.h, stddef.h. (emacs_pid, main): Don’t assume pid fits in int. (fail): Don’t assume pointer difference fits in int. (set_local_socket): Don’t assume uid fits in long. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 2097fece00..b7d4e81376 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -73,9 +73,11 @@ char *w32_getenv (const char *); #include #include #include +#include #include #include #include +#include #include #include #include @@ -144,7 +146,7 @@ static char const *server_file; static char const *tramp_prefix; /* PID of the Emacs server process. */ -static int emacs_pid; +static pid_t emacs_pid; /* If non-NULL, a string that should form a frame parameter alist to be used for the new frame. */ @@ -692,7 +694,7 @@ fail (void) size_t new_argv_size = extra_args_size; char **new_argv = xmalloc (new_argv_size); char *s = xstrdup (alternate_editor); - unsigned toks = 0; + ptrdiff_t toks = 0; /* Unpack alternate_editor's space-separated tokens into new_argv. */ for (char *tok = s; tok != NULL && *tok != '\0';) @@ -1200,12 +1202,13 @@ set_local_socket (const char *local_socket_name) char const *tmpdir = NULL; char *tmpdir_storage = NULL; char *socket_name_storage = NULL; + static char const subdir_format[] = "/emacs%"PRIuMAX"/"; if (! (strchr (local_socket_name, '/') || (ISSLASH ('\\') && strchr (local_socket_name, '\\')))) { /* socket_name is a file name component. */ - long uid = geteuid (); + uintmax_t uid = geteuid (); tmpdir = egetenv ("TMPDIR"); if (!tmpdir) { @@ -1226,7 +1229,7 @@ set_local_socket (const char *local_socket_name) socket_name_storage = xmalloc (strlen (tmpdir) + strlen (server_name) + EXTRA_SPACE); char *z = stpcpy (socket_name_storage, tmpdir); - z += sprintf (z, "/emacs%ld/", uid); + z += sprintf (z, subdir_format, uid); strcpy (z, server_name); local_socket_name = socket_name_storage; } @@ -1262,12 +1265,12 @@ set_local_socket (const char *local_socket_name) if (pw && (pw->pw_uid != geteuid ())) { /* We're running under su, apparently. */ - long uid = pw->pw_uid; + uintmax_t uid = pw->pw_uid; char *user_socket_name = xmalloc (strlen (tmpdir) + strlen (server_name) + EXTRA_SPACE); char *z = stpcpy (user_socket_name, tmpdir); - z += sprintf (z, "/emacs%ld/", uid); + z += sprintf (z, subdir_format, uid); strcpy (z, server_name); if (strlen (user_socket_name) < sizeof (server.sun_path)) @@ -1848,7 +1851,7 @@ main (int argc, char **argv) if (strprefix ("-emacs-pid ", p)) { /* -emacs-pid PID: The process id of the Emacs process. */ - emacs_pid = strtol (p + strlen ("-emacs-pid"), NULL, 10); + emacs_pid = strtoumax (p + strlen ("-emacs-pid"), NULL, 10); } else if (strprefix ("-window-system-unsupported ", p)) { commit c0870736ff4546a28afd7ccc1a2f254c7ef6743e Author: Paul Eggert Date: Wed Nov 21 11:08:29 2018 -0800 emacsclient.c: use C99 to avoid {} * lib-src/emacsclient.c (set_local_socket): Assume C99 decl-after-statement and reindent. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index eb128bc6e5..2097fece00 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -1194,125 +1194,123 @@ set_local_socket (const char *local_socket_name) server.sun_family = AF_UNIX; - { - int sock_status; - int saved_errno; - const char *server_name = local_socket_name; - const char *tmpdir = NULL; - char *tmpdir_storage = NULL; - char *socket_name_storage = NULL; - - if (! (strchr (local_socket_name, '/') - || (ISSLASH ('\\') && strchr (local_socket_name, '\\')))) - { - /* socket_name is a file name component. */ - long uid = geteuid (); - tmpdir = egetenv ("TMPDIR"); - if (!tmpdir) - { + int sock_status; + int saved_errno; + char const *server_name = local_socket_name; + char const *tmpdir = NULL; + char *tmpdir_storage = NULL; + char *socket_name_storage = NULL; + + if (! (strchr (local_socket_name, '/') + || (ISSLASH ('\\') && strchr (local_socket_name, '\\')))) + { + /* socket_name is a file name component. */ + long uid = geteuid (); + tmpdir = egetenv ("TMPDIR"); + if (!tmpdir) + { # ifdef DARWIN_OS # ifndef _CS_DARWIN_USER_TEMP_DIR # define _CS_DARWIN_USER_TEMP_DIR 65537 # endif - size_t n = confstr (_CS_DARWIN_USER_TEMP_DIR, NULL, (size_t) 0); - if (n > 0) - { - tmpdir = tmpdir_storage = xmalloc (n); - confstr (_CS_DARWIN_USER_TEMP_DIR, tmpdir_storage, n); - } - else + size_t n = confstr (_CS_DARWIN_USER_TEMP_DIR, NULL, (size_t) 0); + if (n > 0) + { + tmpdir = tmpdir_storage = xmalloc (n); + confstr (_CS_DARWIN_USER_TEMP_DIR, tmpdir_storage, n); + } + else # endif - tmpdir = "/tmp"; - } - socket_name_storage = - xmalloc (strlen (tmpdir) + strlen (server_name) + EXTRA_SPACE); - char *z = stpcpy (socket_name_storage, tmpdir); - z += sprintf (z, "/emacs%ld/", uid); - strcpy (z, server_name); - local_socket_name = socket_name_storage; - } + tmpdir = "/tmp"; + } + socket_name_storage = + xmalloc (strlen (tmpdir) + strlen (server_name) + EXTRA_SPACE); + char *z = stpcpy (socket_name_storage, tmpdir); + z += sprintf (z, "/emacs%ld/", uid); + strcpy (z, server_name); + local_socket_name = socket_name_storage; + } - if (strlen (local_socket_name) < sizeof (server.sun_path)) - strcpy (server.sun_path, local_socket_name); - else - { - message (true, "%s: socket-name %s too long\n", - progname, local_socket_name); - fail (); - } + if (strlen (local_socket_name) < sizeof (server.sun_path)) + strcpy (server.sun_path, local_socket_name); + else + { + message (true, "%s: socket-name %s too long\n", + progname, local_socket_name); + fail (); + } - /* See if the socket exists, and if it's owned by us. */ - sock_status = socket_status (server.sun_path); - saved_errno = errno; - if (sock_status && tmpdir) - { - /* Failing that, see if LOGNAME or USER exist and differ from - our euid. If so, look for a socket based on the UID - associated with the name. This is reminiscent of the logic - that init_editfns uses to set the global Vuser_full_name. */ - - const char *user_name = egetenv ("LOGNAME"); - - if (!user_name) - user_name = egetenv ("USER"); - - if (user_name) - { - struct passwd *pw = getpwnam (user_name); - - if (pw && (pw->pw_uid != geteuid ())) - { - /* We're running under su, apparently. */ - long uid = pw->pw_uid; - char *user_socket_name - = xmalloc (strlen (tmpdir) + strlen (server_name) - + EXTRA_SPACE); - char *z = stpcpy (user_socket_name, tmpdir); - z += sprintf (z, "/emacs%ld/", uid); - strcpy (z, server_name); - - if (strlen (user_socket_name) < sizeof (server.sun_path)) - strcpy (server.sun_path, user_socket_name); - else - { - message (true, "%s: socket-name %s too long\n", - progname, user_socket_name); - exit (EXIT_FAILURE); - } - free (user_socket_name); - - sock_status = socket_status (server.sun_path); - saved_errno = errno; - } - else - errno = saved_errno; - } - } + /* See if the socket exists, and if it's owned by us. */ + sock_status = socket_status (server.sun_path); + saved_errno = errno; + if (sock_status && tmpdir) + { + /* Failing that, see if LOGNAME or USER exist and differ from + our euid. If so, look for a socket based on the UID + associated with the name. This is reminiscent of the logic + that init_editfns uses to set the global Vuser_full_name. */ - free (socket_name_storage); - free (tmpdir_storage); + char const *user_name = egetenv ("LOGNAME"); - switch (sock_status) - { - case 1: - /* There's a socket, but it isn't owned by us. */ - message (true, "%s: Invalid socket owner\n", progname); - return INVALID_SOCKET; - - case 2: - /* `stat' failed */ - if (saved_errno == ENOENT) - message (true, - ("%s: can't find socket; have you started the server?\n" - "%s: To start the server in Emacs," - " type \"M-x server-start\".\n"), - progname, progname); - else - message (true, "%s: can't stat %s: %s\n", - progname, server.sun_path, strerror (saved_errno)); - return INVALID_SOCKET; - } - } + if (!user_name) + user_name = egetenv ("USER"); + + if (user_name) + { + struct passwd *pw = getpwnam (user_name); + + if (pw && (pw->pw_uid != geteuid ())) + { + /* We're running under su, apparently. */ + long uid = pw->pw_uid; + char *user_socket_name + = xmalloc (strlen (tmpdir) + strlen (server_name) + + EXTRA_SPACE); + char *z = stpcpy (user_socket_name, tmpdir); + z += sprintf (z, "/emacs%ld/", uid); + strcpy (z, server_name); + + if (strlen (user_socket_name) < sizeof (server.sun_path)) + strcpy (server.sun_path, user_socket_name); + else + { + message (true, "%s: socket-name %s too long\n", + progname, user_socket_name); + exit (EXIT_FAILURE); + } + free (user_socket_name); + + sock_status = socket_status (server.sun_path); + saved_errno = errno; + } + else + errno = saved_errno; + } + } + + free (socket_name_storage); + free (tmpdir_storage); + + switch (sock_status) + { + case 1: + /* There's a socket, but it isn't owned by us. */ + message (true, "%s: Invalid socket owner\n", progname); + return INVALID_SOCKET; + + case 2: + /* `stat' failed */ + if (saved_errno == ENOENT) + message (true, + ("%s: can't find socket; have you started the server?\n" + "%s: To start the server in Emacs," + " type \"M-x server-start\".\n"), + progname, progname); + else + message (true, "%s: can't stat %s: %s\n", + progname, server.sun_path, strerror (saved_errno)); + return INVALID_SOCKET; + } if (connect (s, (struct sockaddr *) &server, strlen (server.sun_path) + 2) < 0) commit 3fe110d31a0e5cbae54c5404df06400c817fe350 Author: Paul Eggert Date: Wed Nov 21 10:52:29 2018 -0800 emacsclient: improve use of locals * lib-src/emacsclient.c (main): Use smaller scopes for some locals. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index e3e1d9b16d..eb128bc6e5 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -1610,7 +1610,6 @@ main (int argc, char **argv) { int rl = 0; bool skiplf = true; - char *cwd, *str; char string[BUFSIZ+1]; int exit_status = EXIT_SUCCESS; @@ -1660,7 +1659,7 @@ main (int argc, char **argv) start_daemon_and_retry_set_socket (); } - cwd = get_current_dir_name (); + char *cwd = get_current_dir_name (); if (cwd == 0) { message (true, "%s: %s\n", progname, @@ -1803,10 +1802,10 @@ main (int argc, char **argv) else if (eval) { /* Read expressions interactively. */ - while ((str = fgets (string, BUFSIZ, stdin))) + while (fgets (string, BUFSIZ, stdin)) { send_to_emacs (emacs_socket, "-eval "); - quote_argument (emacs_socket, str); + quote_argument (emacs_socket, string); } send_to_emacs (emacs_socket, " "); } @@ -1876,7 +1875,7 @@ main (int argc, char **argv) /* -print STRING: Print STRING on the terminal. */ if (!suppress_output) { - str = unquote_argument (p + strlen ("-print ")); + char *str = unquote_argument (p + strlen ("-print ")); printf (&"\n%s"[skiplf], str); if (str[0]) skiplf = str[strlen (str) - 1] == '\n'; @@ -1888,7 +1887,7 @@ main (int argc, char **argv) Used to continue a preceding -print command. */ if (!suppress_output) { - str = unquote_argument (p + strlen ("-print-nonl ")); + char *str = unquote_argument (p + strlen ("-print-nonl ")); printf ("%s", str); if (str[0]) skiplf = str[strlen (str) - 1] == '\n'; @@ -1897,7 +1896,7 @@ main (int argc, char **argv) else if (strprefix ("-error ", p)) { /* -error DESCRIPTION: Signal an error on the terminal. */ - str = unquote_argument (p + strlen ("-error ")); + char *str = unquote_argument (p + strlen ("-error ")); if (!skiplf) printf ("\n"); fprintf (stderr, "*ERROR*: %s", str); commit 7a85a40ef402460eafe3254df4f916369829ea21 Author: Paul Eggert Date: Wed Nov 21 10:50:38 2018 -0800 emacsclient: fix unlikely crash with "&" * lib-src/emacsclient.c (quote_argument): Mention *DATA in comment so it’s clear DATA must be non-null. (quote_argument, unquote_argument): Simplify. (unquote_argument): Don’t crash if the string ends in "&". diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 66ada43908..e3e1d9b16d 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -772,10 +772,10 @@ sock_err_message (const char *function_name) } -/* Let's send the data to Emacs when either - - the data ends in "\n", or +/* Send to S the data in *DATA when either + - the data's last byte is '\n', or - the buffer is full (but this shouldn't happen) - Otherwise, we just accumulate it. */ + Otherwise, just accumulate the data. */ static void send_to_emacs (HSOCKET s, const char *data) { @@ -823,33 +823,21 @@ static void quote_argument (HSOCKET s, const char *str) { char *copy = xmalloc (strlen (str) * 2 + 1); - const char *p; - char *q; - - p = str; - q = copy; - while (*p) + char *q = copy; + if (*str == '-') + *q++ = '&', *q++ = *str++; + for (; *str; str++) { - if (*p == ' ') - { - *q++ = '&'; - *q++ = '_'; - p++; - } - else if (*p == '\n') - { - *q++ = '&'; - *q++ = 'n'; - p++; - } - else - { - if (*p == '&' || (*p == '-' && p == str)) - *q++ = '&'; - *q++ = *p++; - } + char c = *str; + if (c == ' ') + *q++ = '&', c = '_'; + else if (c == '\n') + *q++ = '&', c = 'n'; + else if (c == '&') + *q++ = '&'; + *q++ = c; } - *q++ = 0; + *q = 0; send_to_emacs (s, copy); @@ -857,36 +845,31 @@ quote_argument (HSOCKET s, const char *str) } -/* The inverse of quote_argument. Removes quoting in string STR by - modifying the string in place. Returns STR. */ +/* The inverse of quote_argument. Remove quoting in string STR by + modifying the addressed string in place. Return STR. */ static char * unquote_argument (char *str) { - char *p, *q; - - if (! str) - return str; + char const *p = str; + char *q = str; + char c; - p = str; - q = str; - while (*p) + do { - if (*p == '&') - { - p++; - if (*p == '&') - *p = '&'; - else if (*p == '_') - *p = ' '; - else if (*p == 'n') - *p = '\n'; - else if (*p == '-') - *p = '-'; - } - *q++ = *p++; + c = *p++; + if (c == '&') + { + c = *p++; + if (c == '_') + c = ' '; + else if (c == 'n') + c = '\n'; + } + *q++ = c; } - *q = 0; + while (c); + return str; } commit e01d030723aef2f90a2fc53a0b5251f29df94527 Author: Eric Abrahamsen Date: Mon Nov 19 10:03:16 2018 -0800 Fix "Allow use of Gnus search groups as notmuch path: search term" * lisp/gnus/nnir.el (nnir-notmuch-filter-group-names-function): Default to nil -- getting correct behavior requires user intervention too often to have this enabled by default. * lisp/gnus/nnir.el (nnir-run-notmuch): If the user has turned this on, then also hardcode `gnus-group-short-name' as a filter -- things will never work without it. Also move leading space to before the opening parenthesis. * doc/misc/gnus.texi: Document option. (Bug#33122) diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index fb9113f460..d1c746c2e5 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -21468,6 +21468,18 @@ The prefix to remove from each file name returned by notmuch in order to get a group name (albeit with @samp{/} instead of @samp{.}). This is a regular expression. +@item nnir-notmuch-filter-group-names-function +A function used to transform the names of groups being searched in, +for use as a ``path:'' search keyword for notmuch. If nil, the +default, ``path:'' keywords are not used. Otherwise, this should be a +callable which accepts a single group name and returns a transformed +name as notmuch expects to see it. In many mail backends, for +instance, dots in group names must be converted to forward slashes: to +achieve this, set this option to +@example +(lambda (g) (replace-regexp-in-string "\\." "/" g)) +@end example + @end table diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index ea7257d0c9..084b154e8a 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -518,18 +518,16 @@ that it is for notmuch, not Namazu." :type '(regexp) :group 'nnir) -(defcustom nnir-notmuch-filter-group-names-function - #'gnus-group-short-name +(defcustom nnir-notmuch-filter-group-names-function nil "Whether and how to use Gnus group names as \"path:\" search terms. When nil, the groups being searched in are not used as notmuch :path search terms. It's still possible to use \"path:\" terms manually within the search query, however. -When a function, map this function over all the group names. By -default this runs them through `gnus-group-short-name', and it is -recommended to use this transform, at least. Further -transforms (for instance, converting \".\" to \"/\") can be -added like so: +When a function, map this function over all the group names. To +use the group names unchanged, set to (lambda (g) g). Multiple +transforms (for instance, converting \".\" to \"/\") can be added +like so: \(add-function :filter-return nnir-notmuch-filter-group-names-function @@ -1541,14 +1539,15 @@ construct path: search terms (see the variable ":[0-9]+" "^[0-9]+$")) (groups (when nnir-notmuch-filter-group-names-function - (mapcar nnir-notmuch-filter-group-names-function - groups))) + (delq nil + (mapcar nnir-notmuch-filter-group-names-function + (mapcar #'gnus-group-short-name groups))))) (pathquery (when groups - (concat "(" - (mapconcat (lambda (g) - (format " path:%s" g)) - groups " or") - ")"))) + (concat " (" + (mapconcat (lambda (g) + (format "path:%s" g)) + groups " or") + ")"))) artno dirnam filenam) (when (equal "" qstring) commit d15d72b27de3db2f7e49398c7d3da9465b774398 Author: Eric Abrahamsen Date: Tue Nov 20 10:28:10 2018 -0800 Check Gnus group names when reading from browse server * lisp/gnus/gnus-srvr.el (gnus-browse-read-group): If the group in question belongs to the native server, the name has to be shortened before we check it with `gnus-get-info'. It might work otherwise with nntp, but for backends like nnmaildir that have their own accounting system, creating an ephemeral group won't work. diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index dfca5e9d2c..34ebd00ef2 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -925,7 +925,11 @@ buffer. "Enter the group at the current line. If NUMBER, fetch this number of articles." (interactive "P") - (let ((group (gnus-browse-group-name))) + (let* ((full-name (gnus-browse-group-name)) + (group (if (gnus-native-method-p + (gnus-find-method-for-group full-name)) + (gnus-group-short-name full-name) + full-name))) (if (or (not (gnus-get-info group)) (gnus-ephemeral-group-p group)) (unless (gnus-group-read-ephemeral-group commit e0799e6713d10f6650318c34dde8bee6c2a399ea Author: Michael Albinus Date: Wed Nov 21 16:53:09 2018 +0100 * doc/misc/tramp.texi: Fix last commit. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 7918528562..5a375b120d 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -721,16 +721,16 @@ the host returned by the function @command{(system-name)}. See Similar to @option{su} method, @option{sudo} uses @command{sudo}. @command{sudo} must have sufficient rights to start a shell. -Due to security reasons, a @option{sudo} connection is disabled after -a predefined timeout (5 minutes per default). This can be changed, -see @ref{Predefined connection information}. +For security reasons, a @option{sudo} connection is disabled after a +predefined timeout (5 minutes per default). This can be changed, see +@ref{Predefined connection information}. @item @option{doas} @cindex method @option{doas} @cindex @option{doas} method This method is used on OpenBSD like the @command{sudo} command. Like -the @option{sudo} method, a @option{sudo} connection is disabled after +the @option{sudo} method, a @option{doas} connection is disabled after a predefined timeout. @item @option{sg} commit 93242b14769ed40ae58e89d0ea45df8872f59869 Author: Eli Zaretskii Date: Wed Nov 21 17:11:43 2018 +0200 * etc/NEWS: Clarify what 'Z' does in Dired. (Bug#33450) diff --git a/etc/NEWS b/etc/NEWS index 4197317fdd..dab43024f2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -56,7 +56,9 @@ often cause crashes. Set it to nil if you really need those fonts. *** The 'Z' command on a directory name compresses all of its files. It produces a compressed '.tar.gz' archive with all the files in the directory and all of its subdirectories. For symmetry, 'Z' on a -'.tar.gz' or a '.tgz' archive extracts all the archived files into a +'.tar.gz' or a '.tgz' archive extracts all the archived files into +the current directory; thus, typing 'Z' on a '.tar.gz' archive created +by a previous 'Z' command will extract the archived files into a directory whose name is the archive name sans the '.tar.gz' or '.tgz' extension. (This change was actually made in Emacs 26.1, but was not called out in its NEWS.) commit fb200f3e5775fa2811ba270c2a7b0295b42539a0 Author: Michael Albinus Date: Wed Nov 21 13:23:01 2018 +0100 Let Tramp sudo sessions expire after a timeout * doc/misc/tramp.texi (Inline methods) : Both methods expire the underlying session per default. (Predefined connection information): Explain "session-timeout". * etc/NEWS: Mention Tramp session expiration. * lisp/net/tramp-sh.el (tramp-methods) : Add `tramp-session-timeout'. (tramp-timeout-session): New defun. (tramp-maybe-open-connection): Handle session timeout. * lisp/net/tramp.el (tramp-methods): Adapt docstring. (tramp-equal-remote): Extend. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 8cd0a72fc8..7918528562 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -721,11 +721,17 @@ the host returned by the function @command{(system-name)}. See Similar to @option{su} method, @option{sudo} uses @command{sudo}. @command{sudo} must have sufficient rights to start a shell. +Due to security reasons, a @option{sudo} connection is disabled after +a predefined timeout (5 minutes per default). This can be changed, +see @ref{Predefined connection information}. + @item @option{doas} @cindex method @option{doas} @cindex @option{doas} method -This method is used on OpenBSD like the @command{sudo} command. +This method is used on OpenBSD like the @command{sudo} command. Like +the @option{sudo} method, a @option{sudo} connection is disabled after +a predefined timeout. @item @option{sg} @cindex method @option{sg} @@ -1826,6 +1832,24 @@ The parameters @code{tramp-remote-shell} and @code{tramp-remote-shell-login} in @code{tramp-methods} now have new values for the remote host. +A common use case is to override the session timeout of a connection, +that is the time (in seconds) after a connection is disabled, and must +be reestablished. This can be set for any connection; for the +@option{sudo} and @option{doas} methods there exist predefined values. +A value of @code{nil} disables this feature. For example: + +@lisp +@group +(add-to-list 'tramp-connection-properties + (list (regexp-quote "@trampfn{sudo,root@@system-name,}") + "session-timeout" 30)) +@end group +@end lisp + +@noindent +@samp{system-name} stands here for the host returned by the function +@command{(system-name)}. + @var{property} could also be any property found in @code{tramp-persistency-file-name}. diff --git a/etc/NEWS b/etc/NEWS index 4ed312c721..13d660812d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -832,6 +832,11 @@ Tramp for some look-alike remote file names. *** For some connection methods, like "su" or "sudo", the host name in ad-hoc multi-hop file names must match the previous hop. ++++ +*** For the connection methods "sudo" and "doas" there exists a +timeout, after which the underlying session is disabled. This is for +security reasons. + ** Rcirc --- diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 4fb011b342..4965f835b0 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -271,14 +271,13 @@ The string is used in `tramp-methods'.") (tramp-remote-shell-args ("-c")) (tramp-connection-timeout 10))) ;;;###tramp-autoload -(add-to-list - 'tramp-methods - '("sg" - (tramp-login-program "sg") - (tramp-login-args (("-") ("%u"))) - (tramp-remote-shell "/bin/sh") - (tramp-remote-shell-args ("-c")) - (tramp-connection-timeout 10))) +(add-to-list 'tramp-methods + '("sg" + (tramp-login-program "sg") + (tramp-login-args (("-") ("%u"))) + (tramp-remote-shell "/bin/sh") + (tramp-remote-shell-args ("-c")) + (tramp-connection-timeout 10))) ;;;###tramp-autoload (add-to-list 'tramp-methods '("sudo" @@ -292,7 +291,8 @@ The string is used in `tramp-methods'.") (tramp-remote-shell "/bin/sh") (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-c")) - (tramp-connection-timeout 10))) + (tramp-connection-timeout 10) + (tramp-session-timeout 300))) ;;;###tramp-autoload (add-to-list 'tramp-methods '("doas" @@ -300,7 +300,8 @@ The string is used in `tramp-methods'.") (tramp-login-args (("-u" "%u") ("-s"))) (tramp-remote-shell "/bin/sh") (tramp-remote-shell-args ("-c")) - (tramp-connection-timeout 10))) + (tramp-connection-timeout 10) + (tramp-session-timeout 300))) ;;;###tramp-autoload (add-to-list 'tramp-methods '("ksu" @@ -4371,16 +4372,14 @@ Goes through the list `tramp-local-coding-commands' and vec 5 "Checking local encoding function `%s'" loc-enc) (tramp-message vec 5 "Checking local encoding command `%s' for sanity" loc-enc) - (unless (zerop (tramp-call-local-coding-command - loc-enc nil nil)) + (unless (zerop (tramp-call-local-coding-command loc-enc nil nil)) (throw 'wont-work-local nil))) (if (not (stringp loc-dec)) (tramp-message vec 5 "Checking local decoding function `%s'" loc-dec) (tramp-message vec 5 "Checking local decoding command `%s' for sanity" loc-dec) - (unless (zerop (tramp-call-local-coding-command - loc-dec nil nil)) + (unless (zerop (tramp-call-local-coding-command loc-dec nil nil)) (throw 'wont-work-local nil))) ;; Search for remote coding commands with the same format (while (and remote-commands (not found)) @@ -4702,6 +4701,19 @@ Goes through the list `tramp-inline-compress-commands'." " -o ControlPersist=no"))))))))) tramp-ssh-controlmaster-options))) +(defun tramp-timeout-session (vec) + "Close the connection VEC after a session timeout. +If there is just some editing, retry it after 5 seconds." + (if (and tramp-locked tramp-locker + (tramp-equal-remote vec tramp-current-connection)) + (progn + (tramp-message + vec 5 "Cannot timeout session, trying it again in %s seconds." 5) + (run-at-time 5 nil 'tramp-timeout-session vec)) + (tramp-message + vec 3 "Timeout session %s" (tramp-make-tramp-file-name vec 'localname)) + (tramp-cleanup-connection vec 'keep-debug))) + (defun tramp-maybe-open-connection (vec) "Maybe open a connection VEC. Does not do anything if a connection is already open, but re-opens the @@ -4878,6 +4890,14 @@ connection if a previous connection has died for some reason." :method l-method :user l-user :domain l-domain :host l-host :port l-port)) + ;; Set session timeout. + (when (tramp-get-method-parameter + hop 'tramp-session-timeout) + (tramp-set-connection-property + p "session-timeout" + (tramp-get-method-parameter + hop 'tramp-session-timeout))) + ;; Add login environment. (when login-env (setq @@ -4941,6 +4961,12 @@ connection if a previous connection has died for some reason." ;; Set connection-local variables. (tramp-set-connection-local-variables vec) + ;; Activate session timeout. + (when (tramp-get-connection-property p "session-timeout" nil) + (run-at-time + (tramp-get-connection-property p "session-timeout" nil) nil + 'tramp-timeout-session vec)) + ;; Make initial shell settings. (tramp-open-connection-setup-interactive-shell p vec) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index f16bb67efb..8362d78752 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -248,6 +248,10 @@ pair of the form (KEY VALUE). The following KEYs are defined: In general, the global default value shall be used, but for some methods, like \"su\" or \"sudo\", a shorter timeout might be desirable. + * `tramp-session-timeout' + How long a Tramp connection keeps open before being disconnected. + This is useful for methods like \"su\" or \"sudo\", which + shouldn't run an open connection in the background forever. * `tramp-case-insensitive' Whether the remote file system handles file names case insensitive. Only a non-nil value counts, the default value nil means to @@ -4074,10 +4078,16 @@ Example: would yield t. On the other hand, the following check results in nil: - (tramp-equal-remote \"/sudo::/etc\" \"/su::/etc\")" - (and (tramp-tramp-file-p file1) - (tramp-tramp-file-p file2) - (string-equal (file-remote-p file1) (file-remote-p file2)))) + (tramp-equal-remote \"/sudo::/etc\" \"/su::/etc\") + +FILE1 and FILE2 could also be Tramp vectors." + (or (and (tramp-tramp-file-p file1) + (tramp-tramp-file-p file2) + (string-equal (file-remote-p file1) (file-remote-p file2))) + (and (tramp-file-name-p file1) + (tramp-file-name-p file2) + (string-equal (tramp-make-tramp-file-name file1 'localname) + (tramp-make-tramp-file-name file2 'localname))))) ;;;###tramp-autoload (defun tramp-mode-string-to-int (mode-string) commit 166f6274b4118344612e60fba831e223728f3e89 Author: Juri Linkov Date: Wed Nov 21 01:43:21 2018 +0200 Add prefix arg to isearch-repeat-forward/backward (bug#14563, bug#29321) * lisp/isearch.el (isearch-repeat): Add optional arg COUNT. Add a while-loop that calls `isearch-search' COUNT times. (isearch-repeat-forward, isearch-repeat-backward): Add optional prefix ARG passed down to `isearch-repeat'. Handle reversed directions. diff --git a/etc/NEWS b/etc/NEWS index 1382b4d81e..4ed312c721 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -640,6 +640,11 @@ can now be searched via 'C-s'. ** Search and Replace +*** Isearch supports a prefix argument for 'C-s' ('isearch-repeat-forward') +and 'C-r' ('isearch-repeat-backward'). With a prefix argument, these +commands repeat the search for the specified occurrence of the search string. +A negative argument repeats the search in the opposite direction. + *** 'isearch-lazy-count' shows the current match number and total number of matches in the Isearch prompt. Customizable variables 'lazy-count-prefix-format' and 'lazy-count-suffix-format' define the diff --git a/lisp/isearch.el b/lisp/isearch.el index 87f4d495f4..6d94ef6693 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -1555,8 +1555,8 @@ Use `isearch-exit' to quit without signaling." (isearch-pop-state)) (isearch-update))) -(defun isearch-repeat (direction) - ;; Utility for isearch-repeat-forward and -backward. +(defun isearch-repeat (direction &optional count) + ;; Utility for isearch-repeat-forward and isearch-repeat-backward. (if (eq isearch-forward (eq direction 'forward)) ;; C-s in forward or C-r in reverse. (if (equal isearch-string "") @@ -1587,32 +1587,67 @@ Use `isearch-exit' to quit without signaling." (if (equal isearch-string "") (setq isearch-success t) - (if (and isearch-success - (equal (point) isearch-other-end) - (not isearch-just-started)) - ;; If repeating a search that found - ;; an empty string, ensure we advance. - (if (if isearch-forward (eobp) (bobp)) - ;; If there's nowhere to advance to, fail (and wrap next time). - (progn - (setq isearch-success nil) - (ding)) - (forward-char (if isearch-forward 1 -1)) + ;; For the case when count > 1, don't keep intermediate states + ;; added to isearch-cmds by isearch-push-state in this loop. + (let ((isearch-cmds isearch-cmds)) + (while (<= 0 (setq count (1- (or count 1)))) + (if (and isearch-success + (equal (point) isearch-other-end) + (not isearch-just-started)) + ;; If repeating a search that found + ;; an empty string, ensure we advance. + (if (if isearch-forward (eobp) (bobp)) + ;; If there's nowhere to advance to, fail (and wrap next time). + (progn + (setq isearch-success nil) + (ding)) + (forward-char (if isearch-forward 1 -1)) + (isearch-search)) (isearch-search)) - (isearch-search))) + (when (> count 0) + ;; Update isearch-cmds, so if isearch-search fails later, + ;; it can restore old successful state from isearch-cmds. + (isearch-push-state)) + ;; Stop looping on failure. + (when (or (not isearch-success) isearch-error) + (setq count 0))))) (isearch-push-state) (isearch-update)) -(defun isearch-repeat-forward () - "Repeat incremental search forwards." - (interactive) - (isearch-repeat 'forward)) - -(defun isearch-repeat-backward () - "Repeat incremental search backwards." - (interactive) - (isearch-repeat 'backward)) +(defun isearch-repeat-forward (&optional arg) + "Repeat incremental search forwards. +With a prefix argument, repeat the search ARG times. +A negative argument searches backwards." + (interactive "P") + (if arg + (let ((count (prefix-numeric-value arg))) + (cond ((< count 0) + (isearch-repeat-backward (abs count)) + ;; Reverse the direction back + (isearch-repeat 'forward)) + (t + ;; Take into account one iteration to reverse direction + (when (not isearch-forward) (setq count (1+ count))) + (isearch-repeat 'forward count)))) + (isearch-repeat 'forward))) + +(defun isearch-repeat-backward (&optional arg) + "Repeat incremental search backwards. +With a prefix argument, repeat the search ARG times. +A negative argument searches forwards." + (interactive "P") + (if arg + (let ((count (prefix-numeric-value arg))) + (cond ((< count 0) + (isearch-repeat-forward (abs count)) + ;; Reverse the direction back + (isearch-repeat 'backward)) + (t + ;; Take into account one iteration to reverse direction + (when isearch-forward (setq count (1+ count))) + (isearch-repeat 'backward count)))) + (isearch-repeat 'backward))) ;;; Toggles for `isearch-regexp-function' and `search-default-mode'. commit 11c9343fe63fdc8bfef3246d95f42523d73fb733 Author: Stefan Monnier Date: Tue Nov 20 16:09:35 2018 -0500 calc.el, calc-(ext|poly), calccomp: Use lexical-binding * lisp/calc/calc-ext.el: Use lexical-binding, silence warnings. (calc-init-extensions): Remove a few functions which can't be called directly since they depend on dynamically scoped vars. (calc-embedded-quiet): Declare. (math-defcache): Use 'declare'. (math-normalize-a): Remove declaration. (math-normalize-nonstandard): Receive 'a' as arg instead. (math-defintegral): Use 'declare'. (math-exp-pos, math-exp-old-pos, math-exp-keep-spaces, math-rb-h2) (math-read-big-baseline, math-read-big-h2, math-read-big-err-msg) (math-exp-token, math-expr-data, math-exp-str): Declare. (math-map-tree, math-read-expr): Avoid dynvars as formal arguments. * lisp/calc/calc-poly.el: Use lexical-binding, silence warnings. Turn some comments into docstrings. (math-poly-div): Avoid dynvars as formal arguments. (math-poly-base-top-expr): Move declaration before first use. (calcFunc-factors, math-factor-expr, math-factor-expr-try) (calcFunc-factor): Avoid dynvars as formal arguments. * lisp/calc/calc.el: Use lexical-binding, silence warnings. (math-normalize-a): Remove. (math-normalize): Use lexical var 'a' instead. (math-svo-c): Remove. (math-stack-value-offset): Pass 'c' explicitly as arg to math-stack-value-offset-fancy instead. * lisp/calc/calccomp.el: Use lexical-binding, silence warnings. (math-svo-c): Remove. (math-stack-value-offset-fancy): Use new arg 'c' instead. (math-comp-to-string-flat): Avoid dynvars as formal arguments. diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index 821a709434..761eb97a81 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el @@ -1,4 +1,4 @@ -;;; calc-ext.el --- various extension functions for Calc +;;; calc-ext.el --- various extension functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2018 Free Software Foundation, Inc. @@ -88,7 +88,7 @@ (defvar calc-alg-map) (defvar calc-alg-esc-map) -;;; The following was made a function so that it could be byte-compiled. +;; The following was made a function so that it could be byte-compiled. (defun calc-init-extensions () (define-key calc-mode-map ":" 'calc-fdiv) @@ -894,8 +894,8 @@ calcFunc-pcont calcFunc-pdeg calcFunc-pdiv calcFunc-pdivide calcFunc-pdivrem calcFunc-pgcd calcFunc-plead calcFunc-pprim calcFunc-prem math-accum-factors math-atomic-factorp math-div-poly-const math-div-thru math-expand-power math-expand-term -math-factor-contains math-factor-expr math-factor-expr-part -math-factor-expr-try math-factor-finish math-factor-poly-coefs +math-factor-contains math-factor-expr +math-factor-finish math-factor-protect math-mul-thru math-padded-polynomial math-partial-fractions math-poly-degree math-poly-deriv-coefs math-poly-gcd-frac-list math-poly-modulus-rec math-ratpoly-p @@ -984,8 +984,8 @@ calc-force-refresh calc-locate-cursor-element calc-show-edit-buffer) )) (mapcar (function (lambda (x) - (mapcar (function (lambda (cmd) - (autoload cmd (car x) nil t))) (cdr x)))) + (mapcar (function (lambda (cmd) (autoload cmd (car x) nil t))) + (cdr x)))) '( ("calc-alg" calc-alg-evaluate calc-apart calc-collect calc-expand @@ -1307,8 +1307,9 @@ calc-kill calc-kill-region calc-yank)))) (message "%s" (if msg (concat group ": " msg ":" (make-string - (- (apply 'max (mapcar 'length msgs)) - (length msg)) 32) + (- (apply #'max (mapcar #'length msgs)) + (length msg)) + ?\s) " [MORE]" (if key (concat " " (char-to-string key) @@ -1334,6 +1335,8 @@ calc-kill calc-kill-region calc-yank)))) ;;; General. +(defvar calc-embedded-quiet) + (defun calc-reset (arg) (interactive "P") (setq arg (if arg (prefix-numeric-value arg) nil)) @@ -1398,7 +1401,7 @@ calc-kill calc-kill-region calc-yank)))) (defun calc-scroll-up (n) (interactive "P") - (condition-case err + (condition-case nil (scroll-up (or n (/ (window-height) 2))) (error nil)) (if (pos-visible-in-window-p (max 1 (- (point-max) 2))) @@ -1657,7 +1660,7 @@ calc-kill calc-kill-region calc-yank)))) (let ((entries (calc-top-list n 1 'entry)) (calc-undo-list nil) (calc-redo-list nil)) (calc-pop-stack n 1 t) - (calc-push-list (mapcar 'car entries) + (calc-push-list (mapcar #'car entries) 1 (mapcar (function (lambda (x) (nth 2 x))) entries))))))) @@ -1707,7 +1710,7 @@ calc-kill calc-kill-region calc-yank)))) (calc-pop-push-record-list 1 "eval" (math-evaluate-expr (calc-top (- n))) (- n)) - (calc-pop-push-record-list n "eval" (mapcar 'math-evaluate-expr + (calc-pop-push-record-list n "eval" (mapcar #'math-evaluate-expr (calc-top-list n))))) (calc-handle-whys))) @@ -1928,7 +1931,7 @@ calc-kill calc-kill-region calc-yank)))) (calc-z-prefix-buf "") (kmap (sort (copy-sequence (calc-user-key-map)) (function (lambda (x y) (< (car x) (car y)))))) - (flags (apply 'logior + (flags (apply #'logior (mapcar (function (lambda (k) (calc-user-function-classify (car k)))) @@ -2003,12 +2006,13 @@ calc-kill calc-kill-region calc-yank)))) ;;;; Caches. (defmacro math-defcache (name init form) + (declare (indent 2) (debug (symbolp sexp form))) (let ((cache-prec (intern (concat (symbol-name name) "-cache-prec"))) (cache-val (intern (concat (symbol-name name) "-cache"))) (last-prec (intern (concat (symbol-name name) "-last-prec"))) (last-val (intern (concat (symbol-name name) "-last")))) `(progn -; (defvar ,cache-prec ,(if init (math-numdigs (nth 1 init)) -100)) + ;; (defvar ,cache-prec ,(if init (math-numdigs (nth 1 init)) -100)) (defvar ,cache-prec (cond ((consp ,init) (math-numdigs (nth 1 ,init))) (,init @@ -2037,7 +2041,6 @@ calc-kill calc-kill-region calc-yank)))) ,cache-val)) ,last-prec calc-internal-prec)) ,last-val)))) -(put 'math-defcache 'lisp-indent-hook 2) ;;; Betcha didn't know that pi = 16 atan(1/5) - 4 atan(1/239). [F] [Public] (defconst math-approx-pi @@ -2400,7 +2403,7 @@ If X is not an error form, return 1." (list 'calcFunc-intv mask lo hi) (math-make-intv mask lo hi)))) ((eq (car a) 'vec) - (cons 'vec (mapcar 'math-normalize (cdr a)))) + (cons 'vec (mapcar #'math-normalize (cdr a)))) ((eq (car a) 'quote) (math-normalize (nth 1 a))) ((eq (car a) 'special-const) @@ -2412,7 +2415,7 @@ If X is not an error form, return 1." (math-normalize-logical-op a)) ((memq (car a) '(calcFunc-lambda calcFunc-quote calcFunc-condition)) (let ((calc-simplify-mode 'none)) - (cons (car a) (mapcar 'math-normalize (cdr a))))) + (cons (car a) (mapcar #'math-normalize (cdr a))))) ((eq (car a) 'calcFunc-evalto) (setq a (or (nth 1 a) 0)) (or calc-refreshing-evaltos @@ -2435,27 +2438,25 @@ If X is not an error form, return 1." ;; The variable math-normalize-a is local to math-normalize in calc.el, ;; but is used by math-normalize-nonstandard, which is called by ;; math-normalize. -(defvar math-normalize-a) - -(defun math-normalize-nonstandard () +(defun math-normalize-nonstandard (a) (if (consp calc-simplify-mode) (progn (setq calc-simplify-mode 'none - math-simplify-only (car-safe (cdr-safe math-normalize-a))) + math-simplify-only (car-safe (cdr-safe a))) nil) - (and (symbolp (car math-normalize-a)) + (and (symbolp (car a)) (or (eq calc-simplify-mode 'none) (and (eq calc-simplify-mode 'num) - (let ((aptr (setq math-normalize-a + (let ((aptr (setq a (cons - (car math-normalize-a) - (mapcar 'math-normalize - (cdr math-normalize-a)))))) + (car a) + (mapcar #'math-normalize + (cdr a)))))) (while (and aptr (math-constp (car aptr))) (setq aptr (cdr aptr))) aptr))) - (cons (car math-normalize-a) - (mapcar 'math-normalize (cdr math-normalize-a)))))) + (cons (car a) + (mapcar #'math-normalize (cdr a)))))) ;;; Normalize a bignum digit list by trimming high-end zeros. [L l] @@ -2808,7 +2809,7 @@ If X is not an error form, return 1." x) (if (Math-primp x) x - (cons (car x) (mapcar 'math-evaluate-expr-rec (cdr x)))))) + (cons (car x) (mapcar #'math-evaluate-expr-rec (cdr x)))))) x)) (defun math-any-floats (expr) @@ -2822,9 +2823,10 @@ If X is not an error form, return 1." (defvar math-mt-many nil) (defvar math-mt-func nil) -(defun math-map-tree (math-mt-func mmt-expr &optional math-mt-many) - (or math-mt-many (setq math-mt-many 1000000)) - (math-map-tree-rec mmt-expr)) +(defun math-map-tree (func mmt-expr &optional many) + (let ((math-mt-func func) + (math-mt-many (or many 1000000))) + (math-map-tree-rec mmt-expr))) (defun math-map-tree-rec (mmt-expr) (or (= math-mt-many 0) @@ -2842,7 +2844,7 @@ If X is not an error form, return 1." (<= math-mt-many 0)) (setq mmt-done t) (setq mmt-nextval (cons (car mmt-expr) - (mapcar 'math-map-tree-rec + (mapcar #'math-map-tree-rec (cdr mmt-expr)))) (if (equal mmt-nextval mmt-expr) (setq mmt-done t) @@ -2867,6 +2869,7 @@ If X is not an error form, return 1." (defvar math-integral-cache) (defmacro math-defintegral (funcs &rest code) + (declare (indent 1) (debug (sexp body))) (setq math-integral-cache nil) (cons 'progn (mapcar #'(lambda (func) @@ -2876,9 +2879,9 @@ If X is not an error form, return 1." (list #'(lambda (u) ,@code))))) (if (symbolp funcs) (list funcs) funcs)))) -(put 'math-defintegral 'lisp-indent-hook 1) (defmacro math-defintegral-2 (funcs &rest code) + (declare (indent 1) (debug (sexp body))) (setq math-integral-cache nil) (cons 'progn (mapcar #'(lambda (func) @@ -2887,7 +2890,6 @@ If X is not an error form, return 1." (get ',func 'math-integral-2) (list #'(lambda (u v) ,@code))))) (if (symbolp funcs) (list funcs) funcs)))) -(put 'math-defintegral-2 'lisp-indent-hook 1) (defvar var-IntegAfterRules 'calc-IntegAfterRules) @@ -3097,9 +3099,16 @@ If X is not an error form, return 1." ;;; Expression parsing. (defvar math-expr-data) +(defvar math-exp-pos) +(defvar math-exp-old-pos) +(defvar math-exp-keep-spaces) +(defvar math-exp-token) +(defvar math-expr-data) +(defvar math-exp-str) -(defun math-read-expr (math-exp-str) +(defun math-read-expr (str) (let ((math-exp-pos 0) + (math-exp-str str) (math-exp-old-pos 0) (math-exp-keep-spaces nil) math-exp-token math-expr-data) @@ -3138,6 +3147,10 @@ If X is not an error form, return 1." ;;; They said it couldn't be done... +(defvar math-read-big-baseline) +(defvar math-read-big-h2) +(defvar math-read-big-err-msg) + (defun math-read-big-expr (str) (and (> (length calc-left-label) 0) (string-match (concat "^" (regexp-quote calc-left-label)) str) @@ -3179,6 +3192,8 @@ If X is not an error form, return 1." '(error 0 "Syntax error")) (math-read-expr str))))) +(defvar math-rb-h2) + (defun math-read-big-bigp (math-read-big-lines) (and (cdr math-read-big-lines) (let ((matrix nil) diff --git a/lisp/calc/calc-poly.el b/lisp/calc/calc-poly.el index 4092aeec52..41083b7748 100644 --- a/lisp/calc/calc-poly.el +++ b/lisp/calc/calc-poly.el @@ -1,4 +1,4 @@ -;;; calc-poly.el --- polynomial functions for Calc +;;; calc-poly.el --- polynomial functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2018 Free Software Foundation, Inc. @@ -177,8 +177,8 @@ (math-add (car res) (math-div (cdr res) pd)))) -;;; Multiply two terms, expanding out products of sums. (defun math-mul-thru (lhs rhs) + "Multiply two terms, expanding out products of sums." (if (memq (car-safe lhs) '(+ -)) (list (car lhs) (math-mul-thru (nth 1 lhs) rhs) @@ -197,8 +197,8 @@ (math-div num den))) -;;; Sort the terms of a sum into canonical order. (defun math-sort-terms (expr) + "Sort the terms of a sum into canonical order." (if (memq (car-safe expr) '(+ -)) (math-list-to-sum (sort (math-sum-to-list expr) @@ -223,8 +223,8 @@ (math-sum-to-list (nth 2 tree) (not neg)))) (t (list (cons tree neg))))) -;;; Check if the polynomial coefficients are modulo forms. (defun math-poly-modulus (expr &optional expr2) + "Check if the polynomial coefficients are modulo forms." (or (math-poly-modulus-rec expr) (and expr2 (math-poly-modulus-rec expr2)) 1)) @@ -237,12 +237,13 @@ (math-poly-modulus-rec (nth 2 expr)))))) -;;; Divide two polynomials. Return (quotient . remainder). (defvar math-poly-div-base nil) -(defun math-poly-div (u v &optional math-poly-div-base) - (if math-poly-div-base - (math-do-poly-div u v) - (math-do-poly-div (calcFunc-expand u) (calcFunc-expand v)))) +(defun math-poly-div (u v &optional div-base) + "Divide two polynomials. Return (quotient . remainder)." + (let ((math-poly-div-base div-base)) + (if div-base + (math-do-poly-div u v) + (math-do-poly-div (calcFunc-expand u) (calcFunc-expand v))))) (defun math-poly-div-exact (u v &optional base) (let ((res (math-poly-div u v base))) @@ -308,8 +309,8 @@ (math-div (math-build-polynomial-expr (cdr res) base) v))))))) -;;; Divide two polynomials in coefficient-list form. Return (quot . rem). (defun math-poly-div-coefs (u v) + "Divide two polynomials in coefficient-list form. Return (quot . rem)." (cond ((null v) (math-reject-arg nil "Division by zero")) ((< (length u) (length v)) (cons nil u)) ((cdr u) @@ -334,9 +335,9 @@ (cons (list (math-poly-div-rec (car u) (car v))) nil)))) -;;; Perform a pseudo-division of polynomials. (See Knuth section 4.6.1.) -;;; This returns only the remainder from the pseudo-division. (defun math-poly-pseudo-div (u v) + "Perform a pseudo-division of polynomials. (See Knuth section 4.6.1.) +This returns only the remainder from the pseudo-division." (cond ((null v) nil) ((< (length u) (length v)) u) ((or (cdr u) (cdr v)) @@ -359,8 +360,8 @@ (nreverse (mapcar 'math-simplify urev)))) (t nil))) -;;; Compute the GCD of two multivariate polynomials. (defun math-poly-gcd (u v) + "Compute the GCD of two multivariate polynomials." (cond ((Math-equal u v) u) ((math-constp u) (if (Math-zerop u) @@ -423,7 +424,7 @@ (defun math-poly-gcd-coefs (u v) (let ((d (math-poly-gcd (math-poly-gcd-list u) (math-poly-gcd-list v))) - (g 1) (h 1) (z 0) hh r delta ghd) + (g 1) (h 1) (z 0) r delta) (while (and u v (Math-zerop (car u)) (Math-zerop (car v))) (setq u (cdr u) v (cdr v) z (1+ z))) (or (eq d 1) @@ -452,8 +453,8 @@ v)) -;;; Return true if is a factor containing no sums or quotients. (defun math-atomic-factorp (expr) + "Return true if is a factor containing no sums or quotients." (cond ((eq (car-safe expr) '*) (and (math-atomic-factorp (nth 1 expr)) (math-atomic-factorp (nth 2 expr)))) @@ -463,14 +464,13 @@ (math-atomic-factorp (nth 1 expr))) (t t))) -;;; Find a suitable base for dividing a by b. -;;; The base must exist in both expressions. -;;; The degree in the numerator must be higher or equal than the -;;; degree in the denominator. -;;; If the above conditions are not met the quotient is just a remainder. -;;; Return nil if this is the case. - (defun math-poly-div-base (a b) + "Find a suitable base for dividing a by b. +The base must exist in both expressions. +The degree in the numerator must be higher or equal than the +degree in the denominator. +If the above conditions are not met the quotient is just a remainder. +Return nil if this is the case." (let (a-base b-base) (and (setq a-base (math-total-polynomial-base a)) (setq b-base (math-total-polynomial-base b)) @@ -482,12 +482,11 @@ (throw 'return (car (car a-base)))))) (setq a-base (cdr a-base))))))) -;;; Same as above but for gcd algorithm. -;;; Here there is no requirement that degree(a) > degree(b). -;;; Take the base that has the highest degree considering both a and b. -;;; ("a^20+b^21+x^3+a+b", "a+b^2+x^5+a^22+b^10") --> (a 22) - (defun math-poly-gcd-base (a b) + "Same as `math-poly-div-base' but for gcd algorithm. +Here there is no requirement that degree(a) > degree(b). +Take the base that has the highest degree considering both a and b. + (\"a^20+b^21+x^3+a+b\", \"a+b^2+x^5+a^22+b^10\") --> (a 22)" (let (a-base b-base) (and (setq a-base (math-total-polynomial-base a)) (setq b-base (math-total-polynomial-base b)) @@ -501,8 +500,8 @@ (throw 'return (car (car b-base))) (setq b-base (cdr b-base))))))))) -;;; Sort a list of polynomial bases. (defun math-sort-poly-base-list (lst) + "Sort a list of polynomial bases." (sort lst (function (lambda (a b) (or (> (nth 1 a) (nth 1 b)) (and (= (nth 1 a) (nth 1 b)) @@ -511,10 +510,11 @@ ;;; Given an expression find all variables that are polynomial bases. ;;; Return list in the form '( (var1 degree1) (var2 degree2) ... ). -;; The variable math-poly-base-total-base is local to -;; math-total-polynomial-base, but is used by math-polynomial-p1, -;; which is called by math-total-polynomial-base. +;; The variable math-poly-base-total-base and math-poly-base-top-expr are local +;; to math-total-polynomial-base, but used by math-polynomial-p1, which is +;; called by math-total-polynomial-base. (defvar math-poly-base-total-base) +(defvar math-poly-base-top-expr) (defun math-total-polynomial-base (expr) (let ((math-poly-base-total-base nil) @@ -522,11 +522,6 @@ (math-polynomial-base expr #'math-polynomial-p1) (math-sort-poly-base-list math-poly-base-total-base))) -;; The variable math-poly-base-top-expr is local to math-polynomial-base -;; in calc-alg.el, but is used by math-polynomial-p1 which is called -;; by math-polynomial-base. -(defvar math-poly-base-top-expr) - (defun math-polynomial-p1 (subexpr) (or (assoc subexpr math-poly-base-total-base) (memq (car subexpr) '(+ - * / neg)) @@ -555,28 +550,30 @@ ;; called (indirectly) by calcFunc-factors and calcFunc-factor. (defvar math-to-list) -(defun calcFunc-factors (math-fact-expr &optional var) +(defun calcFunc-factors (expr &optional var) (let ((math-factored-vars (if var t nil)) (math-to-list t) (calc-prefer-frac t)) (or var - (setq var (math-polynomial-base math-fact-expr))) + (setq var (math-polynomial-base expr))) (let ((res (math-factor-finish - (or (catch 'factor (math-factor-expr-try var)) - math-fact-expr)))) + (or (catch 'factor + (let ((math-fact-expr expr)) (math-factor-expr-try var))) + expr)))) (math-simplify (if (math-vectorp res) res (list 'vec (list 'vec res 1))))))) -(defun calcFunc-factor (math-fact-expr &optional var) +(defun calcFunc-factor (expr &optional var) (let ((math-factored-vars nil) (math-to-list nil) (calc-prefer-frac t)) (math-simplify (math-factor-finish (if var - (let ((math-factored-vars t)) - (or (catch 'factor (math-factor-expr-try var)) math-fact-expr)) - (math-factor-expr math-fact-expr)))))) + (let ((math-factored-vars t) + (math-fact-expr expr)) + (or (catch 'factor (math-factor-expr-try var)) expr)) + (math-factor-expr expr)))))) (defun math-factor-finish (x) (if (Math-primp x) @@ -590,18 +587,19 @@ (list 'calcFunc-Fac-Prot x) x)) -(defun math-factor-expr (math-fact-expr) - (cond ((eq math-factored-vars t) math-fact-expr) - ((or (memq (car-safe math-fact-expr) '(* / ^ neg)) - (assq (car-safe math-fact-expr) calc-tweak-eqn-table)) - (cons (car math-fact-expr) (mapcar 'math-factor-expr (cdr math-fact-expr)))) - ((memq (car-safe math-fact-expr) '(+ -)) +(defun math-factor-expr (expr) + (cond ((eq math-factored-vars t) expr) + ((or (memq (car-safe expr) '(* / ^ neg)) + (assq (car-safe expr) calc-tweak-eqn-table)) + (cons (car expr) (mapcar 'math-factor-expr (cdr expr)))) + ((memq (car-safe expr) '(+ -)) (let* ((math-factored-vars math-factored-vars) - (y (catch 'factor (math-factor-expr-part math-fact-expr)))) + (y (catch 'factor (let ((math-fact-expr expr)) + (math-factor-expr-part expr))))) (if y (math-factor-expr y) - math-fact-expr))) - (t math-fact-expr))) + expr))) + (t expr))) (defun math-factor-expr-part (x) ; uses "expr" (if (memq (car-safe x) '(+ - * / ^ neg)) @@ -617,20 +615,20 @@ ;; used by math-factor-poly-coefs, which is called by math-factor-expr-try. (defvar math-fet-x) -(defun math-factor-expr-try (math-fet-x) +(defun math-factor-expr-try (x) (if (eq (car-safe math-fact-expr) '*) (let ((res1 (catch 'factor (let ((math-fact-expr (nth 1 math-fact-expr))) - (math-factor-expr-try math-fet-x)))) + (math-factor-expr-try x)))) (res2 (catch 'factor (let ((math-fact-expr (nth 2 math-fact-expr))) - (math-factor-expr-try math-fet-x))))) + (math-factor-expr-try x))))) (and (or res1 res2) (throw 'factor (math-accum-factors (or res1 (nth 1 math-fact-expr)) 1 (or res2 (nth 2 math-fact-expr)))))) - (let* ((p (math-is-polynomial math-fact-expr math-fet-x 30 'gen)) + (let* ((p (math-is-polynomial math-fact-expr x 30 'gen)) (math-poly-modulus (math-poly-modulus math-fact-expr)) res) (and (cdr p) - (setq res (math-factor-poly-coefs p)) + (setq res (let ((math-fet-x x)) (math-factor-poly-coefs p))) (throw 'factor res))))) (defun math-accum-factors (fac pow facs) @@ -736,7 +734,6 @@ (let ((roots (car t1)) (csign (if (math-negp (nth (1- (length p)) p)) -1 1)) (expr 1) - (unfac (nth 1 t1)) (scale (nth 2 t1))) (while roots (let ((coef0 (car (car roots))) @@ -1109,7 +1106,7 @@ If no partial fraction representation can be found, return nil." (t expr))) (defun calcFunc-expand (expr &optional many) - (math-normalize (math-map-tree 'math-expand-term expr many))) + (math-normalize (math-map-tree #'math-expand-term expr many))) (defun math-expand-power (x n &optional var else-nil) (or (and (natnump n) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index c79db821eb..f155b8283b 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -1,4 +1,4 @@ -;;; calc.el --- the GNU Emacs calculator +;;; calc.el --- the GNU Emacs calculator -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2018 Free Software Foundation, Inc. @@ -178,7 +178,7 @@ (declare-function math-read-radix-digit "calc-misc" (dig)) (declare-function calc-digit-dots "calc-incom" ()) (declare-function math-normalize-fancy "calc-ext" (a)) -(declare-function math-normalize-nonstandard "calc-ext" ()) +(declare-function math-normalize-nonstandard "calc-ext" (a)) (declare-function math-recompile-eval-rules "calc-alg" ()) (declare-function math-apply-rewrites "calc-rewr" (expr rules &optional heads math-apply-rw-ruleset)) (declare-function calc-record-why "calc-misc" (&rest stuff)) @@ -203,7 +203,7 @@ (declare-function math-compose-expr "calccomp" (a prec &optional div)) (declare-function math-comp-width "calccomp" (c)) (declare-function math-composition-to-string "calccomp" (c &optional width)) -(declare-function math-stack-value-offset-fancy "calccomp" ()) +(declare-function math-stack-value-offset-fancy "calccomp" (c)) (declare-function math-format-flat-expr-fancy "calc-ext" (a prec)) (declare-function math-adjust-fraction "calc-ext" (a)) (declare-function math-format-binary "calc-bin" (a)) @@ -1331,16 +1331,17 @@ Notations: 3.14e6 3.14 * 10^6 " (interactive) (mapc (function ;FIXME: Why (set-default v (symbol-value v)) ?!?!? - (lambda (v) (set-default v (symbol-value v)))) calc-local-var-list) + (lambda (v) (set-default v (symbol-value v)))) + calc-local-var-list) (kill-all-local-variables) (use-local-map (if (eq calc-algebraic-mode 'total) (progn (require 'calc-ext) calc-alg-map) calc-mode-map)) (mapc #'make-local-variable calc-local-var-list) (make-local-variable 'overlay-arrow-position) (make-local-variable 'overlay-arrow-string) - (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) + (add-hook 'change-major-mode-hook #'font-lock-defontify nil t) (add-hook 'kill-buffer-query-functions - 'calc-kill-stack-buffer + #'calc-kill-stack-buffer t t) (setq truncate-lines t) (setq buffer-read-only t) @@ -1795,7 +1796,7 @@ See calc-keypad for details." (if calc-hyperbolic-flag "Hyp " "") (if calc-keep-args-flag "Keep " "") (if (/= calc-stack-top 1) "Narrow " "") - (apply 'concat calc-other-modes))))) + (apply #'concat calc-other-modes))))) (if (equal new-mode-string mode-line-buffer-identification) nil (setq mode-line-buffer-identification new-mode-string) @@ -1869,7 +1870,7 @@ See calc-keypad for details." (if (and (consp vals) (or (integerp (car vals)) (consp (car vals)))) - (setq vals (mapcar 'calc-normalize vals)) + (setq vals (mapcar #'calc-normalize vals)) (setq vals (calc-normalize vals))) (or (and (consp vals) (or (integerp (car vals)) @@ -1952,8 +1953,8 @@ See calc-keypad for details." (mapcar (lambda (x) (calc-get-stack-element x sel-mode)) top))))) (defun calc-top-list-n (&optional n m sel-mode) - (mapcar 'math-check-complete - (mapcar 'calc-normalize (calc-top-list n m sel-mode)))) + (mapcar #'math-check-complete + (mapcar #'calc-normalize (calc-top-list n m sel-mode)))) (defun calc-renumber-stack () @@ -2207,7 +2208,7 @@ the United States." (setq calc-aborted-prefix name) (if (null arg) (calc-enter-result 2 name (cons (or func2 func) - (mapcar 'math-check-complete + (mapcar #'math-check-complete (calc-top-list 2)))) (require 'calc-ext) (calc-binary-op-fancy name func arg ident unary))) @@ -2619,78 +2620,78 @@ largest Emacs integer.") (defvar math-eval-rules-cache-other) ;;; Reduce an object to canonical (normalized) form. [O o; Z Z] [Public] -(defvar math-normalize-a) (defvar math-normalize-error nil "Non-nil if the last call the `math-normalize' returned an error.") -(defun math-normalize (math-normalize-a) +(defun math-normalize (a) (setq math-normalize-error nil) (cond - ((not (consp math-normalize-a)) - (if (integerp math-normalize-a) - (if (or (>= math-normalize-a math-small-integer-size) - (<= math-normalize-a (- math-small-integer-size))) - (math-bignum math-normalize-a) - math-normalize-a) - math-normalize-a)) - ((eq (car math-normalize-a) 'bigpos) - (if (eq (nth (1- (length math-normalize-a)) math-normalize-a) 0) - (let* ((last (setq math-normalize-a - (copy-sequence math-normalize-a))) (digs math-normalize-a)) + ((not (consp a)) + (if (integerp a) + (if (or (>= a math-small-integer-size) + (<= a (- math-small-integer-size))) + (math-bignum a) + a) + a)) + ((eq (car a) 'bigpos) + (if (eq (nth (1- (length a)) a) 0) + (let* ((last (setq a + (copy-sequence a))) + (digs a)) (while (setq digs (cdr digs)) (or (eq (car digs) 0) (setq last digs))) (setcdr last nil))) - (if (cdr (cdr (cdr math-normalize-a))) - math-normalize-a + (if (cdr (cdr (cdr a))) + a (cond - ((cdr (cdr math-normalize-a)) (+ (nth 1 math-normalize-a) - (* (nth 2 math-normalize-a) + ((cdr (cdr a)) (+ (nth 1 a) + (* (nth 2 a) math-bignum-digit-size))) - ((cdr math-normalize-a) (nth 1 math-normalize-a)) + ((cdr a) (nth 1 a)) (t 0)))) - ((eq (car math-normalize-a) 'bigneg) - (if (eq (nth (1- (length math-normalize-a)) math-normalize-a) 0) - (let* ((last (setq math-normalize-a (copy-sequence math-normalize-a))) - (digs math-normalize-a)) + ((eq (car a) 'bigneg) + (if (eq (nth (1- (length a)) a) 0) + (let* ((last (setq a (copy-sequence a))) + (digs a)) (while (setq digs (cdr digs)) (or (eq (car digs) 0) (setq last digs))) (setcdr last nil))) - (if (cdr (cdr (cdr math-normalize-a))) - math-normalize-a + (if (cdr (cdr (cdr a))) + a (cond - ((cdr (cdr math-normalize-a)) (- (+ (nth 1 math-normalize-a) - (* (nth 2 math-normalize-a) + ((cdr (cdr a)) (- (+ (nth 1 a) + (* (nth 2 a) math-bignum-digit-size)))) - ((cdr math-normalize-a) (- (nth 1 math-normalize-a))) + ((cdr a) (- (nth 1 a))) (t 0)))) - ((eq (car math-normalize-a) 'float) - (math-make-float (math-normalize (nth 1 math-normalize-a)) - (nth 2 math-normalize-a))) - ((or (memq (car math-normalize-a) + ((eq (car a) 'float) + (math-make-float (math-normalize (nth 1 a)) + (nth 2 a))) + ((or (memq (car a) '(frac cplx polar hms date mod sdev intv vec var quote special-const calcFunc-if calcFunc-lambda calcFunc-quote calcFunc-condition calcFunc-evalto)) - (integerp (car math-normalize-a)) - (and (consp (car math-normalize-a)) - (not (eq (car (car math-normalize-a)) 'lambda)))) + (integerp (car a)) + (and (consp (car a)) + (not (eq (car (car a)) 'lambda)))) (require 'calc-ext) - (math-normalize-fancy math-normalize-a)) + (math-normalize-fancy a)) (t (or (and calc-simplify-mode (require 'calc-ext) - (math-normalize-nonstandard)) - (let ((args (mapcar 'math-normalize (cdr math-normalize-a)))) + (math-normalize-nonstandard a)) + (let ((args (mapcar #'math-normalize (cdr a)))) (or (condition-case err (let ((func - (assq (car math-normalize-a) '( ( + . math-add ) - ( - . math-sub ) - ( * . math-mul ) - ( / . math-div ) - ( % . math-mod ) - ( ^ . math-pow ) - ( neg . math-neg ) - ( | . math-concat ) )))) + (assq (car a) '( ( + . math-add ) + ( - . math-sub ) + ( * . math-mul ) + ( / . math-div ) + ( % . math-mod ) + ( ^ . math-pow ) + ( neg . math-neg ) + ( | . math-concat ) )))) (or (and var-EvalRules (progn (or (eq var-EvalRules math-eval-rules-cache-tag) @@ -2698,59 +2699,59 @@ largest Emacs integer.") (require 'calc-ext) (math-recompile-eval-rules))) (and (or math-eval-rules-cache-other - (assq (car math-normalize-a) + (assq (car a) math-eval-rules-cache)) (math-apply-rewrites - (cons (car math-normalize-a) args) + (cons (car a) args) (cdr math-eval-rules-cache) nil math-eval-rules-cache)))) (if func (apply (cdr func) args) - (and (or (consp (car math-normalize-a)) - (fboundp (car math-normalize-a)) + (and (or (consp (car a)) + (fboundp (car a)) (and (not (featurep 'calc-ext)) (require 'calc-ext) - (fboundp (car math-normalize-a)))) - (apply (car math-normalize-a) args))))) + (fboundp (car a)))) + (apply (car a) args))))) (wrong-number-of-arguments (setq math-normalize-error t) (calc-record-why "*Wrong number of arguments" - (cons (car math-normalize-a) args)) + (cons (car a) args)) nil) (wrong-type-argument (or calc-next-why (calc-record-why "Wrong type of argument" - (cons (car math-normalize-a) args))) + (cons (car a) args))) nil) (args-out-of-range (setq math-normalize-error t) (calc-record-why "*Argument out of range" - (cons (car math-normalize-a) args)) + (cons (car a) args)) nil) (inexact-result (calc-record-why "No exact representation for result" - (cons (car math-normalize-a) args)) + (cons (car a) args)) nil) (math-overflow (setq math-normalize-error t) (calc-record-why "*Floating-point overflow occurred" - (cons (car math-normalize-a) args)) + (cons (car a) args)) nil) (math-underflow (setq math-normalize-error t) (calc-record-why "*Floating-point underflow occurred" - (cons (car math-normalize-a) args)) + (cons (car a) args)) nil) (void-variable (setq math-normalize-error t) (if (eq (nth 1 err) 'var-EvalRules) (progn (setq var-EvalRules nil) - (math-normalize (cons (car math-normalize-a) args))) + (math-normalize (cons (car a) args))) (calc-record-why "*Variable is void" (nth 1 err))))) - (if (consp (car math-normalize-a)) + (if (consp (car a)) (math-dimension-error) - (cons (car math-normalize-a) args)))))))) + (cons (car a) args)))))))) @@ -2834,7 +2835,7 @@ largest Emacs integer.") ((eq (car a) 'frac) (math-div (math-float (nth 1 a)) (nth 2 a))) ((eq (car a) 'float) a) ((memq (car a) '(cplx polar vec hms date sdev mod)) - (cons (car a) (mapcar 'math-float (cdr a)))) + (cons (car a) (mapcar #'math-float (cdr a)))) (t (math-float-fancy a)))) @@ -2845,7 +2846,7 @@ largest Emacs integer.") ((memq (car a) '(frac float)) (list (car a) (Math-integer-neg (nth 1 a)) (nth 2 a))) ((memq (car a) '(cplx vec hms date calcFunc-idn)) - (cons (car a) (mapcar 'math-neg (cdr a)))) + (cons (car a) (mapcar #'math-neg (cdr a)))) (t (math-neg-fancy a)))) @@ -3425,22 +3426,21 @@ largest Emacs integer.") (setcar (cdr entry) (calc-count-lines s)) s)) -;; The variables math-svo-c, math-svo-wid and math-svo-off are local +;; The variables math-svo-wid and math-svo-off are local ;; to math-stack-value-offset, but are used by math-stack-value-offset-fancy ;; in calccomp.el. -(defvar math-svo-c) (defvar math-svo-wid) (defvar math-svo-off) -(defun math-stack-value-offset (math-svo-c) +(defun math-stack-value-offset (c) (let* ((num (if calc-line-numbering 4 0)) (math-svo-wid (calc-window-width)) math-svo-off) (if calc-display-just (progn (require 'calc-ext) - (math-stack-value-offset-fancy)) + (math-stack-value-offset-fancy c)) (setq math-svo-off (or calc-display-origin 0)) (when (integerp calc-line-breaking) (setq math-svo-wid calc-line-breaking))) @@ -3873,7 +3873,7 @@ The prefix `calcFunc-' is added to the specified name to get the actual Lisp function name. See Info node `(calc)Defining Functions'." - (declare (doc-string 3)) + (declare (doc-string 3)) ;; FIXME: Edebug spec? (require 'calc-ext) (math-do-defmath func args body)) diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el index 858343aae9..75c7adc59e 100644 --- a/lisp/calc/calccomp.el +++ b/lisp/calc/calccomp.el @@ -1,4 +1,4 @@ -;;; calccomp.el --- composition functions for Calc +;;; calccomp.el --- composition functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2018 Free Software Foundation, Inc. @@ -121,7 +121,8 @@ calc-lang-slash-idiv) (math-float (nth 1 aa)) (nth 1 aa)) - (nth 2 aa)) prec)) + (nth 2 aa)) + prec)) (if (and (eq calc-language 'big) (= (length (car calc-frac-format)) 1)) (let* ((aa (math-adjust-fraction a)) @@ -202,8 +203,9 @@ (math-comp-comma-spc (or calc-vector-commas " ")) (math-comp-comma (or calc-vector-commas "")) (math-comp-vector-prec (if (or (and calc-vector-commas - (math-vector-no-parens a)) - (memq 'P calc-matrix-brackets)) 0 1000)) + (math-vector-no-parens a)) + (memq 'P calc-matrix-brackets)) + 0 1000)) (math-comp-just (cond ((eq calc-matrix-just 'right) 'vright) ((eq calc-matrix-just 'center) 'vcent) (t 'vleft))) @@ -803,8 +805,7 @@ ( % . calcFunc-mod ) ( ^ . calcFunc-pow ) ( neg . calcFunc-neg ) - ( | . calcFunc-vconcat )))) - left right args) + ( | . calcFunc-vconcat ))))) (if func2 (setq func (cdr func2))) (if (setq func2 (rassq func math-expr-function-mapping)) @@ -858,7 +859,7 @@ (or (cdr (cdr a)) (not (eq (car-safe (nth 1 a)) '*)))) -(defun math-compose-matrix (a col cols base) +(defun math-compose-matrix (a _col cols base) (let ((col 0) (res nil)) (while (<= (setq col (1+ col)) cols) @@ -968,8 +969,8 @@ (and (memq (car a) '(^ calcFunc-subscr)) (math-tex-expr-is-flat (nth 1 a))))) -(put 'calcFunc-log 'math-compose-big 'math-compose-log) -(defun math-compose-log (a prec) +(put 'calcFunc-log 'math-compose-big #'math-compose-log) +(defun math-compose-log (a _prec) (and (= (length a) 3) (list 'horiz (list 'subscr "log" @@ -979,8 +980,8 @@ (math-compose-expr (nth 1 a) 1000) ")"))) -(put 'calcFunc-log10 'math-compose-big 'math-compose-log10) -(defun math-compose-log10 (a prec) +(put 'calcFunc-log10 'math-compose-big #'math-compose-log10) +(defun math-compose-log10 (a _prec) (and (= (length a) 2) (list 'horiz (list 'subscr "log" "10") @@ -988,8 +989,8 @@ (math-compose-expr (nth 1 a) 1000) ")"))) -(put 'calcFunc-deriv 'math-compose-big 'math-compose-deriv) -(put 'calcFunc-tderiv 'math-compose-big 'math-compose-deriv) +(put 'calcFunc-deriv 'math-compose-big #'math-compose-deriv) +(put 'calcFunc-tderiv 'math-compose-big #'math-compose-deriv) (defun math-compose-deriv (a prec) (when (= (length a) 3) (math-compose-expr (list '/ @@ -1003,8 +1004,8 @@ (nth 2 a)))) prec))) -(put 'calcFunc-sqrt 'math-compose-big 'math-compose-sqrt) -(defun math-compose-sqrt (a prec) +(put 'calcFunc-sqrt 'math-compose-big #'math-compose-sqrt) +(defun math-compose-sqrt (a _prec) (when (= (length a) 2) (let* ((c (math-compose-expr (nth 1 a) 0)) (a (math-comp-ascent c)) @@ -1024,8 +1025,8 @@ " " c))))) -(put 'calcFunc-choose 'math-compose-big 'math-compose-choose) -(defun math-compose-choose (a prec) +(put 'calcFunc-choose 'math-compose-big #'math-compose-choose) +(defun math-compose-choose (a _prec) (let ((a1 (math-compose-expr (nth 1 a) 0)) (a2 (math-compose-expr (nth 2 a) 0))) (list 'horiz @@ -1035,7 +1036,7 @@ a1 " " a2) ")"))) -(put 'calcFunc-integ 'math-compose-big 'math-compose-integ) +(put 'calcFunc-integ 'math-compose-big #'math-compose-integ) (defun math-compose-integ (a prec) (and (memq (length a) '(3 5)) (eq (car-safe (nth 2 a)) 'var) @@ -1072,7 +1073,7 @@ (list 'horiz " d" var)) (if parens ")" ""))))) -(put 'calcFunc-sum 'math-compose-big 'math-compose-sum) +(put 'calcFunc-sum 'math-compose-big #'math-compose-sum) (defun math-compose-sum (a prec) (and (memq (length a) '(3 5 6)) (let* ((expr (math-compose-expr (nth 1 a) 185)) @@ -1097,7 +1098,7 @@ expr (if (memq prec '(180 201)) ")" ""))))) -(put 'calcFunc-prod 'math-compose-big 'math-compose-prod) +(put 'calcFunc-prod 'math-compose-big #'math-compose-prod) (defun math-compose-prod (a prec) (and (memq (length a) '(3 5 6)) (let* ((expr (math-compose-expr (nth 1 a) 198)) @@ -1124,12 +1125,11 @@ ;; The variables math-svo-c, math-svo-wid and math-svo-off are local ;; to math-stack-value-offset in calc.el, but are used by ;; math-stack-value-offset-fancy, which is called by math-stack-value-offset.. -(defvar math-svo-c) (defvar math-svo-wid) (defvar math-svo-off) -(defun math-stack-value-offset-fancy () - (let ((cwid (+ (math-comp-width math-svo-c)))) +(defun math-stack-value-offset-fancy (c) + (let ((cwid (+ (math-comp-width c)))) (cond ((eq calc-display-just 'right) (if calc-display-origin (setq math-svo-wid (max calc-display-origin 5)) @@ -1215,7 +1215,7 @@ ;; which are called by math-comp-to-string-flat. (defvar math-comp-pos) -(defun math-comp-to-string-flat (c math-comp-full-width) +(defun math-comp-to-string-flat (c full-width) (if math-comp-sel-hpos (let ((math-comp-pos 0)) (math-comp-sel-flat-term c)) @@ -1224,6 +1224,7 @@ (math-comp-pos 0) (math-comp-margin 0) (math-comp-highlight (and math-comp-selected calc-show-selections)) + (math-comp-full-width full-width) (math-comp-level -1)) (math-comp-to-string-flat-term '(set -1 0)) (math-comp-to-string-flat-term c) @@ -1387,7 +1388,7 @@ (defvar math-comp-hpos) (defvar math-comp-vpos) -(defun math-comp-simplify (c full-width) +(defun math-comp-simplify (c _full-width) (let ((math-comp-buf (list "")) (math-comp-base 0) (math-comp-hgt 1) commit 0d59ae3f49ac122203d94aa02acc9c7ae920aeef Author: Eli Zaretskii Date: Tue Nov 20 20:45:07 2018 +0200 Update the docs of object internals * doc/lispref/internals.texi (Buffer Internals) (Window Internals, Process Internals): Update the descriptions of Lisp objects. diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index b68c94d5c7..6c9bba126e 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -1746,7 +1746,7 @@ and form the set of subtypes of @code{Lisp_Misc}. Below there is a description of a few subtypes of @code{Lisp_Vectorlike}. Buffer object represents the text to display and edit. Window is the part -of display structure which shows the buffer or used as a container to +of display structure which shows the buffer or is used as a container to recursively place other windows on the same frame. (Do not confuse Emacs Lisp window object with the window as an entity managed by the user interface system like X; in Emacs terminology, the latter is called frame.) Finally, @@ -1773,7 +1773,8 @@ Here are some of the fields in @code{struct buffer_text}: @table @code @item beg -The address of the buffer contents. +The address of the buffer contents. The buffer contents is a linear C +array of @code{char}, with the gap somewhere in its midst. @item gpt @itemx gpt_byte @@ -1797,8 +1798,8 @@ buffer-modification event, and is never otherwise changed; @code{save_modiff} contains the value of @code{modiff} the last time the buffer was visited or saved; @code{chars_modiff} counts only modifications to the characters in the buffer, ignoring all other -kinds of changes; and @code{overlay_modiff} counts only modifications -to the overlays. +kinds of changes (such as text properties); and @code{overlay_modiff} +counts only modifications to the buffer's overlays. @item beg_unchanged @itemx end_unchanged @@ -1906,13 +1907,22 @@ position. @item name A Lisp string that names the buffer. It is guaranteed to be unique. -@xref{Buffer Names}. +@xref{Buffer Names}. This and the following fields have their names +in the C struct definition end in a @code{_} to indicate that they +should not be accessed directly, but via the @code{BVAR} macro, like +this: + +@example + Lisp_Object buf_name = BVAR (buffer, name); +@end example @item save_length The length of the file this buffer is visiting, when last read or -saved. This and other fields concerned with saving are not kept in -the @code{buffer_text} structure because indirect buffers are never -saved. +saved. It can have 2 special values: @minus{}1 means auto-saving was +turned off in this buffer, and @minus{}2 means don't turn off +auto-saving if buffer text shrinks a lot. This and other fields +concerned with saving are not kept in the @code{buffer_text} structure +because indirect buffers are never saved. @item directory The directory for expanding relative file names. This is the value of @@ -2036,37 +2046,29 @@ if that window no longer displays this buffer. @table @code @item frame -The frame that this window is on. +The frame that this window is on, as a Lisp object. -@item mini_p -Non-@code{nil} if this window is a minibuffer window. +@item mini +Non-zero if this window is a minibuffer window. @item parent Internally, Emacs arranges windows in a tree; each group of siblings has a parent window whose area includes all the siblings. This field points -to a window's parent. +to a window's parent, as a Lisp object. Parent windows do not display buffers, and play little role in display except to shape their child windows. Emacs Lisp programs usually have no access to the parent windows; they operate on the windows at the leaves of the tree, which actually display buffers. -@c FIXME: These two slots and the 'buffer' slot below were replaced -@c with a single slot 'contents' on 2013-03-28. --xfq -@item hchild -@itemx vchild -These fields contain the window's leftmost child and its topmost child -respectively. @code{hchild} is used if the window is subdivided -horizontally by child windows, and @code{vchild} if it is subdivided -vertically. In a live window, only one of @code{hchild}, @code{vchild}, -and @code{buffer} (q.v.@:) is non-@code{nil}. - @item next @itemx prev The next sibling and previous sibling of this window. @code{next} is @code{nil} if the window is the right-most or bottom-most in its group; @code{prev} is @code{nil} if it is the left-most or top-most in its -group. +group. Whether the sibling is left/right or up/down is determined by +the @code{horizontal} field: if it's non-zero, the siblings are +arranged horizontally. @item left_col The left-hand edge of the window, measured in columns, relative to the @@ -2082,29 +2084,35 @@ The width and height of the window, measured in columns and lines respectively. The width includes the scroll bar and fringes, and/or the separator line on the right of the window (if any). -@item buffer -The buffer that the window is displaying. +@item contents +For leaf windows, this is the buffer, as a Lisp object, that the +window is displaying. For an internal (``parent'') window, this is +its child window. It can also be @code{nil}, for a pseudo-window. @item start A marker pointing to the position in the buffer that is the first -character displayed in the window. +character (in the logical order, @pxref{Bidirectional Display}) +displayed in the window. @item pointm @cindex window point internals This is the value of point in the current buffer when this window is selected; when it is not selected, it retains its previous value. +@item old_pointm +The value of @code{pointm} at the last redisplay time. + @item force_start If this flag is non-@code{nil}, it says that the window has been -scrolled explicitly by the Lisp program. This affects what the next -redisplay does if point is off the screen: instead of scrolling the -window to show the text around point, it moves point to a location that -is on the screen. +scrolled explicitly by the Lisp program, and the value of the the +window's @code{start} was set for redisplay to honor. This affects +what the next redisplay does if point is off the screen: instead of +scrolling the window to show the text around point, it moves point to +a location that is on the screen. -@item frozen_window_start_p -This field is set temporarily to 1 to indicate to redisplay that -@code{start} of this window should not be changed, even if point -gets invisible. +@item optional_new_start +This is similar to @code{force_start}, but the next redisplay will +only obey it if point stays visible. @item start_at_line_beg Non-@code{nil} means current value of @code{start} was the beginning of a line @@ -2130,30 +2138,30 @@ The buffer's value of point, as of the last time a redisplay completed in this window. @item last_had_star -A non-@code{nil} value means the window's buffer was modified when the +A non-zero value means the window's buffer was modified when the window was last updated. @item vertical_scroll_bar -This window's vertical scroll bar. +This window's vertical scroll bar, a Lisp object. @item left_margin_cols @itemx right_margin_cols The widths of the left and right margins in this window. A value of -@code{nil} means no margin. +zero means no margin. @item left_fringe_width @itemx right_fringe_width -The widths of the left and right fringes in this window. A value of -@code{nil} or @code{t} means use the values of the frame. +The pixel widths of the left and right fringes in this window. A +value of @minus{}1 means use the values of the frame. @item fringes_outside_margins -A non-@code{nil} value means the fringes outside the display margins; +A non-zero value means the fringes outside the display margins; othersize they are between the margin and the text. @item window_end_pos This is computed as @code{z} minus the buffer position of the last glyph in the current matrix of the window. The value is only valid if -@code{window_end_valid} is not @code{nil}. +@code{window_end_valid} is non-zero. @item window_end_bytepos The byte position corresponding to @code{window_end_pos}. @@ -2163,16 +2171,17 @@ The window-relative vertical position of the line containing @code{window_end_pos}. @item window_end_valid -This field is set to a non-@code{nil} value if @code{window_end_pos} is truly -valid. This is @code{nil} if nontrivial redisplay is pre-empted, since in that -case the display that @code{window_end_pos} was computed for did not get -onto the screen. +This field is set to a non-zero value if @code{window_end_pos} and +@code{window_end_vpos} are truly valid. This is zero if nontrivial +redisplay is pre-empted, since in that case the display that +@code{window_end_pos} was computed for did not get onto the screen. @item cursor A structure describing where the cursor is in this window. -@item last_cursor -The value of @code{cursor} as of the last redisplay that finished. +@item last_cursor_vpos +The window-relative vertical position of the line showing the cursor +as of the last redisplay that finished. @item phys_cursor A structure describing where the cursor of this window physically is. @@ -2200,8 +2209,16 @@ the last redisplay. This is set to 1 during redisplay when this window must be updated. @item hscroll -This is the number of columns that the display in the window is scrolled -horizontally to the left. Normally, this is 0. +This is the number of columns that the display in the window is +scrolled horizontally to the left. Normally, this is 0. When only +the current line is hscrolled, this describes how much the current +line is scrolled. + +@item min_hscroll +Minimum value of @code{hscroll}, set by the user via +@code{set-window-hscroll} (@pxref{Horizontal Scrolling}). When only +the current line is hscrolled, this describes the horizontal scrolling +of lines other than the current one. @item vscroll Vertical scroll amount, in pixels. Normally, this is 0. @@ -2213,20 +2230,30 @@ Non-@code{nil} if this window is dedicated to its buffer. The window's display table, or @code{nil} if none is specified for it. @item update_mode_line -Non-@code{nil} means this window's mode line needs to be updated. +Non-zero means this window's mode line needs to be updated. + +@item mode_line_height +@itemx header_line_height +The height in pixels of the mode line and the header line, or +@minus{}1 if not known. @item base_line_number -The line number of a certain position in the buffer, or @code{nil}. +The line number of a certain position in the buffer, or zero. This is used for displaying the line number of point in the mode line. @item base_line_pos The position in the buffer for which the line number is known, or -@code{nil} meaning none is known. If it is a buffer, don't display +zero meaning none is known. If it is @minus{}1, don't display the line number as long as the window shows that buffer. @item column_number_displayed -The column number currently displayed in this window's mode line, or @code{nil} -if column numbers are not being displayed. +The column number currently displayed in this window's mode line, or +@minus{}1 if column numbers are not being displayed. + +@item pseudo_window_p +This is non-zero for windows that display the menu bar and the tool +bar (when Emacs uses toolkits that don't display their own menu bar +and tool bar). @item current_matrix @itemx desired_matrix @@ -2243,7 +2270,7 @@ Glyph matrices describing the current and desired display of this window. @table @code @item name -A string, the name of the process. +A Lisp string, the name of the process. @item command A list containing the command arguments that were used to start this @@ -2251,10 +2278,10 @@ process. For a network or serial process, it is @code{nil} if the process is running or @code{t} if the process is stopped. @item filter -A function used to accept output from the process. +A Lisp function used to accept output from the process. @item sentinel -A function called whenever the state of the process changes. +A Lisp function called whenever the state of the process changes. @item buffer The associated buffer of the process. @@ -2281,7 +2308,8 @@ does not ask for confirmation about killing the process. The raw process status, as returned by the @code{wait} system call. @item status -The process status, as @code{process-status} should return it. +The process status, as @code{process-status} should return it. This +is a Lisp symbol, a cons cell, or a list. @item tick @itemx update_tick @@ -2290,8 +2318,8 @@ needs to be reported, either by running the sentinel or by inserting a message in the process buffer. @item pty_flag -Non-@code{nil} if communication with the subprocess uses a pty; -@code{nil} if it uses a pipe. +Non-zero if communication with the subprocess uses a pty; zero if it +uses a pipe. @item infd The file descriptor for input from the process. commit 336681f35bf23f442a7159eb86d1c5d8a6269c7f Merge: feea5c6489 d667318a7f Author: Glenn Morris Date: Tue Nov 20 09:38:43 2018 -0800 Merge from origin/emacs-26 d667318 (origin/emacs-26) Fix two Edebug defcustoms (bug#33428) commit feea5c6489a52e4a26114cb6cf735c63fc1f70ee Merge: bb7b75d711 b8b42c2315 Author: Glenn Morris Date: Tue Nov 20 09:38:43 2018 -0800 ; Merge from origin/emacs-26 The following commit was skipped: b8b42c2 Fix Bug#33141 commit bb7b75d7110c7a46407aa4efc33446ace0cba631 Merge: e1b2c21b43 070e82b96b Author: Glenn Morris Date: Tue Nov 20 09:38:42 2018 -0800 Merge from origin/emacs-26 070e82b ; * src/window.c (window_scroll): Improve commentary. 60457d7 Improve documentation of the window tree ea1a014 Fix window scrolling on TTY frames when there's no mode line df7ed10 Fix decoding XML files encoded in ISO-8859 7851ae8 (tag: emacs-26.1.90) ; ChangeLog.3 update 1958808 * etc/AUTHORS: Update. 7252507 Fix description of some window hooks 88762b4 Run 'window--adjust-process-windows' when frame size changes ... d6542ea Avoid errors in zone.el when there's overlay at EOB commit e1b2c21b431accc397219b432a76a716acc6dbc2 Author: Stefan Monnier Date: Tue Nov 20 10:37:46 2018 -0500 * lisp/calc/calc-alg.el: Use lexical-binding and silence warnings * lisp/calc/calc-alg.el: Use lexical-binding and silence warnings. (math-defsimplify): Let-bind 'expr' instead of math-simplify-expr. Adjust all users. (math-simplify-expr): Don't declare any more. (math--simplify-divide-expr): New dynbound var. (math-simplify-divide): Bind it when needed. (math-simplify-divisor): Use it instead of math-simplify-expr. (math-simplify-divisor): Only bind math-simplify-divisor-[nd]over around the calls to math-simplify-one-divisor. (math-expr-subst, math-is-polynomial): Don't use dynbound vars as formal arguments. (math-polynomial-base): Move binding of math-poly-base-pred. Don't bind math-poly-base-top-expr any more... * lisp/calc/calc-poly.el (math-total-polynomial-base): Bind it here instead! * lisp/calc/calc-units.el: Use lexical-binding and silence warnings. Adjust to the new 'expr' name in math-defsimplify. (math-find-base-units, math-to-standard-units, math-convert-units): Don't use dynbound vars as formal arguments. (math-simplify-expr): Don't declare any more. diff --git a/lisp/calc/calc-alg.el b/lisp/calc/calc-alg.el index 7a448d20ec..2f23399841 100644 --- a/lisp/calc/calc-alg.el +++ b/lisp/calc/calc-alg.el @@ -1,4 +1,4 @@ -;;; calc-alg.el --- algebraic functions for Calc +;;; calc-alg.el --- algebraic functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2018 Free Software Foundation, Inc. @@ -308,7 +308,7 @@ (let ((math-living-dangerously t)) (math-simplify a))) -(defalias 'calcFunc-esimplify 'math-simplify-extended) +(defalias 'calcFunc-esimplify #'math-simplify-extended) ;;; Rewrite the trig functions in a form easier to simplify. (defun math-trig-rewrite (fn) @@ -329,7 +329,7 @@ (list '/ (cons 'calcFunc-cos newfn) (cons 'calcFunc-sin newfn)))) (t - (mapcar 'math-trig-rewrite fn)))) + (mapcar #'math-trig-rewrite fn)))) (defun math-hyperbolic-trig-rewrite (fn) "Rewrite hyperbolic functions in terms of sinhs and coshs." @@ -349,7 +349,7 @@ (list '/ (cons 'calcFunc-cosh newfn) (cons 'calcFunc-sinh newfn)))) (t - (mapcar 'math-hyperbolic-trig-rewrite fn)))) + (mapcar #'math-hyperbolic-trig-rewrite fn)))) ;; math-top-only is local to math-simplify, but is used by ;; math-simplify-step, which is called by math-simplify. @@ -402,11 +402,11 @@ (setq top-expr res))))) top-expr) -(defalias 'calcFunc-simplify 'math-simplify) +(defalias 'calcFunc-simplify #'math-simplify) -;;; The following has a "bug" in that if any recursive simplifications -;;; occur only the first handler will be tried; this doesn't really -;;; matter, since math-simplify-step is iterated to a fixed point anyway. +;; The following has a "bug" in that if any recursive simplifications +;; occur only the first handler will be tried; this doesn't really +;; matter, since math-simplify-step is iterated to a fixed point anyway. (defun math-simplify-step (a) (if (Math-primp a) a @@ -414,7 +414,7 @@ (memq (car a) '(calcFunc-quote calcFunc-condition calcFunc-evalto))) a - (cons (car a) (mapcar 'math-simplify-step (cdr a)))))) + (cons (car a) (mapcar #'math-simplify-step (cdr a)))))) (and (symbolp (car aa)) (let ((handler (get (car aa) 'math-simplify))) (and handler @@ -427,159 +427,155 @@ (defmacro math-defsimplify (funcs &rest code) + "Define the simplification code for functions FUNCS. +Code can refer to the expression to simplify via lexical variable `expr' +and should return the simplified expression to use (or nil)." + (declare (indent 1) (debug (sexp body))) (cons 'progn (mapcar #'(lambda (func) `(put ',func 'math-simplify (nconc (get ',func 'math-simplify) (list - #'(lambda (math-simplify-expr) ,@code))))) + #'(lambda (expr) ,@code))))) (if (symbolp funcs) (list funcs) funcs)))) -(put 'math-defsimplify 'lisp-indent-hook 1) - -;; The function created by math-defsimplify uses the variable -;; math-simplify-expr, and so is used by functions in math-defsimplify -(defvar math-simplify-expr) (math-defsimplify (+ -) - (math-simplify-plus)) - -(defun math-simplify-plus () - (cond ((and (memq (car-safe (nth 1 math-simplify-expr)) '(+ -)) - (Math-numberp (nth 2 (nth 1 math-simplify-expr))) - (not (Math-numberp (nth 2 math-simplify-expr)))) - (let ((x (nth 2 math-simplify-expr)) - (op (car math-simplify-expr))) - (setcar (cdr (cdr math-simplify-expr)) (nth 2 (nth 1 math-simplify-expr))) - (setcar math-simplify-expr (car (nth 1 math-simplify-expr))) - (setcar (cdr (cdr (nth 1 math-simplify-expr))) x) - (setcar (nth 1 math-simplify-expr) op))) - ((and (eq (car math-simplify-expr) '+) - (Math-numberp (nth 1 math-simplify-expr)) - (not (Math-numberp (nth 2 math-simplify-expr)))) - (let ((x (nth 2 math-simplify-expr))) - (setcar (cdr (cdr math-simplify-expr)) (nth 1 math-simplify-expr)) - (setcar (cdr math-simplify-expr) x)))) - (let ((aa math-simplify-expr) + (cond ((and (memq (car-safe (nth 1 expr)) '(+ -)) + (Math-numberp (nth 2 (nth 1 expr))) + (not (Math-numberp (nth 2 expr)))) + (let ((x (nth 2 expr)) + (op (car expr))) + (setcar (cdr (cdr expr)) (nth 2 (nth 1 expr))) + (setcar expr (car (nth 1 expr))) + (setcar (cdr (cdr (nth 1 expr))) x) + (setcar (nth 1 expr) op))) + ((and (eq (car expr) '+) + (Math-numberp (nth 1 expr)) + (not (Math-numberp (nth 2 expr)))) + (let ((x (nth 2 expr))) + (setcar (cdr (cdr expr)) (nth 1 expr)) + (setcar (cdr expr) x)))) + (let ((aa expr) aaa temp) (while (memq (car-safe (setq aaa (nth 1 aa))) '(+ -)) - (if (setq temp (math-combine-sum (nth 2 aaa) (nth 2 math-simplify-expr) + (if (setq temp (math-combine-sum (nth 2 aaa) (nth 2 expr) (eq (car aaa) '-) - (eq (car math-simplify-expr) '-) t)) + (eq (car expr) '-) t)) (progn - (setcar (cdr (cdr math-simplify-expr)) temp) - (setcar math-simplify-expr '+) + (setcar (cdr (cdr expr)) temp) + (setcar expr '+) (setcar (cdr (cdr aaa)) 0))) (setq aa (nth 1 aa))) - (if (setq temp (math-combine-sum aaa (nth 2 math-simplify-expr) - nil (eq (car math-simplify-expr) '-) t)) + (if (setq temp (math-combine-sum aaa (nth 2 expr) + nil (eq (car expr) '-) t)) (progn - (setcar (cdr (cdr math-simplify-expr)) temp) - (setcar math-simplify-expr '+) + (setcar (cdr (cdr expr)) temp) + (setcar expr '+) (setcar (cdr aa) 0))) - math-simplify-expr)) + expr)) (math-defsimplify * - (math-simplify-times)) - -(defun math-simplify-times () - (if (eq (car-safe (nth 2 math-simplify-expr)) '*) - (and (math-beforep (nth 1 (nth 2 math-simplify-expr)) (nth 1 math-simplify-expr)) - (or (math-known-scalarp (nth 1 math-simplify-expr) t) - (math-known-scalarp (nth 1 (nth 2 math-simplify-expr)) t)) - (let ((x (nth 1 math-simplify-expr))) - (setcar (cdr math-simplify-expr) (nth 1 (nth 2 math-simplify-expr))) - (setcar (cdr (nth 2 math-simplify-expr)) x))) - (and (math-beforep (nth 2 math-simplify-expr) (nth 1 math-simplify-expr)) - (or (math-known-scalarp (nth 1 math-simplify-expr) t) - (math-known-scalarp (nth 2 math-simplify-expr) t)) - (let ((x (nth 2 math-simplify-expr))) - (setcar (cdr (cdr math-simplify-expr)) (nth 1 math-simplify-expr)) - (setcar (cdr math-simplify-expr) x)))) - (let ((aa math-simplify-expr) + (if (eq (car-safe (nth 2 expr)) '*) + (and (math-beforep (nth 1 (nth 2 expr)) (nth 1 expr)) + (or (math-known-scalarp (nth 1 expr) t) + (math-known-scalarp (nth 1 (nth 2 expr)) t)) + (let ((x (nth 1 expr))) + (setcar (cdr expr) (nth 1 (nth 2 expr))) + (setcar (cdr (nth 2 expr)) x))) + (and (math-beforep (nth 2 expr) (nth 1 expr)) + (or (math-known-scalarp (nth 1 expr) t) + (math-known-scalarp (nth 2 expr) t)) + (let ((x (nth 2 expr))) + (setcar (cdr (cdr expr)) (nth 1 expr)) + (setcar (cdr expr) x)))) + (let ((aa expr) aaa temp - (safe t) (scalar (math-known-scalarp (nth 1 math-simplify-expr)))) - (if (and (Math-ratp (nth 1 math-simplify-expr)) - (setq temp (math-common-constant-factor (nth 2 math-simplify-expr)))) + (safe t) (scalar (math-known-scalarp (nth 1 expr)))) + (if (and (Math-ratp (nth 1 expr)) + (setq temp (math-common-constant-factor (nth 2 expr)))) (progn - (setcar (cdr (cdr math-simplify-expr)) - (math-cancel-common-factor (nth 2 math-simplify-expr) temp)) - (setcar (cdr math-simplify-expr) (math-mul (nth 1 math-simplify-expr) temp)))) + (setcar (cdr (cdr expr)) + (math-cancel-common-factor (nth 2 expr) temp)) + (setcar (cdr expr) (math-mul (nth 1 expr) temp)))) (while (and (eq (car-safe (setq aaa (nth 2 aa))) '*) safe) - (if (setq temp (math-combine-prod (nth 1 math-simplify-expr) + (if (setq temp (math-combine-prod (nth 1 expr) (nth 1 aaa) nil nil t)) (progn - (setcar (cdr math-simplify-expr) temp) + (setcar (cdr expr) temp) (setcar (cdr aaa) 1))) (setq safe (or scalar (math-known-scalarp (nth 1 aaa) t)) aa (nth 2 aa))) - (if (and (setq temp (math-combine-prod aaa (nth 1 math-simplify-expr) nil nil t)) + (if (and (setq temp (math-combine-prod aaa (nth 1 expr) nil nil t)) safe) (progn - (setcar (cdr math-simplify-expr) temp) + (setcar (cdr expr) temp) (setcar (cdr (cdr aa)) 1))) - (if (and (eq (car-safe (nth 1 math-simplify-expr)) 'frac) - (memq (nth 1 (nth 1 math-simplify-expr)) '(1 -1))) - (math-div (math-mul (nth 2 math-simplify-expr) - (nth 1 (nth 1 math-simplify-expr))) - (nth 2 (nth 1 math-simplify-expr))) - math-simplify-expr))) + (if (and (eq (car-safe (nth 1 expr)) 'frac) + (memq (nth 1 (nth 1 expr)) '(1 -1))) + (math-div (math-mul (nth 2 expr) + (nth 1 (nth 1 expr))) + (nth 2 (nth 1 expr))) + expr))) (math-defsimplify / - (math-simplify-divide)) + (math-simplify-divide expr)) -(defun math-simplify-divide () - (let ((np (cdr math-simplify-expr)) +(defvar math--simplify-divide-expr) + +(defun math-simplify-divide (expr) + (let ((np (cdr expr)) (nover nil) - (nn (and (or (eq (car math-simplify-expr) '/) - (not (Math-realp (nth 2 math-simplify-expr)))) - (math-common-constant-factor (nth 2 math-simplify-expr)))) + (nn (and (or (eq (car expr) '/) + (not (Math-realp (nth 2 expr)))) + (math-common-constant-factor (nth 2 expr)))) n op) (if nn (progn - (setq n (and (or (eq (car math-simplify-expr) '/) - (not (Math-realp (nth 1 math-simplify-expr)))) - (math-common-constant-factor (nth 1 math-simplify-expr)))) + (setq n (and (or (eq (car expr) '/) + (not (Math-realp (nth 1 expr)))) + (math-common-constant-factor (nth 1 expr)))) (if (and (eq (car-safe nn) 'frac) (eq (nth 1 nn) 1) (not n)) - (unless (and (eq (car-safe math-simplify-expr) 'calcFunc-eq) - (eq (car-safe (nth 1 math-simplify-expr)) 'var) - (not (math-expr-contains (nth 2 math-simplify-expr) - (nth 1 math-simplify-expr)))) - (setcar (cdr math-simplify-expr) - (math-mul (nth 2 nn) (nth 1 math-simplify-expr))) - (setcar (cdr (cdr math-simplify-expr)) - (math-cancel-common-factor (nth 2 math-simplify-expr) nn)) + (unless (and (eq (car-safe expr) 'calcFunc-eq) + (eq (car-safe (nth 1 expr)) 'var) + (not (math-expr-contains (nth 2 expr) + (nth 1 expr)))) + (setcar (cdr expr) + (math-mul (nth 2 nn) (nth 1 expr))) + (setcar (cdr (cdr expr)) + (math-cancel-common-factor (nth 2 expr) nn)) (if (and (math-negp nn) - (setq op (assq (car math-simplify-expr) calc-tweak-eqn-table))) - (setcar math-simplify-expr (nth 1 op)))) + (setq op (assq (car expr) calc-tweak-eqn-table))) + (setcar expr (nth 1 op)))) (if (and n (not (eq (setq n (math-frac-gcd n nn)) 1))) (progn - (setcar (cdr math-simplify-expr) - (math-cancel-common-factor (nth 1 math-simplify-expr) n)) - (setcar (cdr (cdr math-simplify-expr)) - (math-cancel-common-factor (nth 2 math-simplify-expr) n)) + (setcar (cdr expr) + (math-cancel-common-factor (nth 1 expr) n)) + (setcar (cdr (cdr expr)) + (math-cancel-common-factor (nth 2 expr) n)) (if (and (math-negp n) - (setq op (assq (car math-simplify-expr) + (setq op (assq (car expr) calc-tweak-eqn-table))) - (setcar math-simplify-expr (nth 1 op)))))))) - (if (and (eq (car-safe (car np)) '/) - (math-known-scalarp (nth 2 math-simplify-expr) t)) - (progn - (setq np (cdr (nth 1 math-simplify-expr))) - (while (eq (car-safe (setq n (car np))) '*) - (and (math-known-scalarp (nth 2 n) t) - (math-simplify-divisor (cdr n) (cdr (cdr math-simplify-expr)) nil t)) - (setq np (cdr (cdr n)))) - (math-simplify-divisor np (cdr (cdr math-simplify-expr)) nil t) - (setq nover t - np (cdr (cdr (nth 1 math-simplify-expr)))))) - (while (eq (car-safe (setq n (car np))) '*) - (and (math-known-scalarp (nth 2 n) t) - (math-simplify-divisor (cdr n) (cdr (cdr math-simplify-expr)) nover t)) - (setq np (cdr (cdr n)))) - (math-simplify-divisor np (cdr (cdr math-simplify-expr)) nover t) - math-simplify-expr)) + (setcar expr (nth 1 op)))))))) + (let ((math--simplify-divide-expr expr)) ;For use in math-simplify-divisor + (if (and (eq (car-safe (car np)) '/) + (math-known-scalarp (nth 2 expr) t)) + (progn + (setq np (cdr (nth 1 expr))) + (while (eq (car-safe (setq n (car np))) '*) + (and (math-known-scalarp (nth 2 n) t) + (math-simplify-divisor (cdr n) (cdr (cdr expr)) nil t)) + (setq np (cdr (cdr n)))) + (math-simplify-divisor np (cdr (cdr expr)) nil t) + (setq nover t + np (cdr (cdr (nth 1 expr)))))) + (while (eq (car-safe (setq n (car np))) '*) + (and (math-known-scalarp (nth 2 n) t) + (math-simplify-divisor (cdr n) (cdr (cdr expr)) nover t)) + (setq np (cdr (cdr n)))) + (math-simplify-divisor np (cdr (cdr expr)) nover t) + expr))) ;; The variables math-simplify-divisor-nover and math-simplify-divisor-dover ;; are local variables for math-simplify-divisor, but are used by @@ -587,25 +583,25 @@ (defvar math-simplify-divisor-nover) (defvar math-simplify-divisor-dover) -(defun math-simplify-divisor (np dp math-simplify-divisor-nover - math-simplify-divisor-dover) +(defun math-simplify-divisor (np dp nover dover) (cond ((eq (car-safe (car dp)) '/) (math-simplify-divisor np (cdr (car dp)) - math-simplify-divisor-nover - math-simplify-divisor-dover) + nover dover) (and (math-known-scalarp (nth 1 (car dp)) t) (math-simplify-divisor np (cdr (cdr (car dp))) - math-simplify-divisor-nover - (not math-simplify-divisor-dover)))) - ((or (or (eq (car math-simplify-expr) '/) + nover (not dover)))) + ((or (or (eq (car math--simplify-divide-expr) '/) (let ((signs (math-possible-signs (car np)))) (or (memq signs '(1 4)) - (and (memq (car math-simplify-expr) '(calcFunc-eq calcFunc-neq)) + (and (memq (car math--simplify-divide-expr) + '(calcFunc-eq calcFunc-neq)) (eq signs 5)) math-living-dangerously))) (math-numberp (car np))) (let (d (safe t) + (math-simplify-divisor-nover nover) + (math-simplify-divisor-dover dover) (scalar (math-known-scalarp (car np)))) (while (and (eq (car-safe (setq d (car dp))) '*) safe) @@ -621,14 +617,16 @@ op) (if temp (progn - (and (not (memq (car math-simplify-expr) '(/ calcFunc-eq calcFunc-neq))) + (and (not (memq (car math--simplify-divide-expr) + '(/ calcFunc-eq calcFunc-neq))) (math-known-negp (car dp)) - (setq op (assq (car math-simplify-expr) calc-tweak-eqn-table)) - (setcar math-simplify-expr (nth 1 op))) + (setq op (assq (car math--simplify-divide-expr) + calc-tweak-eqn-table)) + (setcar math--simplify-divide-expr (nth 1 op))) (setcar np (if math-simplify-divisor-nover (math-div 1 temp) temp)) (setcar dp 1)) (and math-simplify-divisor-dover (not math-simplify-divisor-nover) - (eq (car math-simplify-expr) '/) + (eq (car math--simplify-divide-expr) '/) (eq (car-safe (car dp)) 'calcFunc-sqrt) (Math-integerp (nth 1 (car dp))) (progn @@ -680,26 +678,23 @@ (math-gcd (nth 2 a) (nth 2 b))))))) (math-defsimplify % - (math-simplify-mod)) - -(defun math-simplify-mod () - (and (Math-realp (nth 2 math-simplify-expr)) - (Math-posp (nth 2 math-simplify-expr)) - (let ((lin (math-is-linear (nth 1 math-simplify-expr))) - t1 t2 t3) + (and (Math-realp (nth 2 expr)) + (Math-posp (nth 2 expr)) + (let ((lin (math-is-linear (nth 1 expr))) + t1) (or (and lin (or (math-negp (car lin)) - (not (Math-lessp (car lin) (nth 2 math-simplify-expr)))) + (not (Math-lessp (car lin) (nth 2 expr)))) (list '% (list '+ (math-mul (nth 1 lin) (nth 2 lin)) - (math-mod (car lin) (nth 2 math-simplify-expr))) - (nth 2 math-simplify-expr))) + (math-mod (car lin) (nth 2 expr))) + (nth 2 expr))) (and lin (not (math-equal-int (nth 1 lin) 1)) (math-num-integerp (nth 1 lin)) - (math-num-integerp (nth 2 math-simplify-expr)) - (setq t1 (calcFunc-gcd (nth 1 lin) (nth 2 math-simplify-expr))) + (math-num-integerp (nth 2 expr)) + (setq t1 (calcFunc-gcd (nth 1 lin) (nth 2 expr))) (not (math-equal-int t1 1)) (list '* t1 @@ -709,53 +704,53 @@ (nth 2 lin)) (let ((calc-prefer-frac t)) (math-div (car lin) t1))) - (math-div (nth 2 math-simplify-expr) t1)))) - (and (math-equal-int (nth 2 math-simplify-expr) 1) + (math-div (nth 2 expr) t1)))) + (and (math-equal-int (nth 2 expr) 1) (math-known-integerp (if lin (math-mul (nth 1 lin) (nth 2 lin)) - (nth 1 math-simplify-expr))) + (nth 1 expr))) (if lin (math-mod (car lin) 1) 0)))))) (math-defsimplify (calcFunc-eq calcFunc-neq calcFunc-lt calcFunc-gt calcFunc-leq calcFunc-geq) - (if (= (length math-simplify-expr) 3) - (math-simplify-ineq))) + (if (= (length expr) 3) + (math-simplify-ineq expr))) -(defun math-simplify-ineq () - (let ((np (cdr math-simplify-expr)) +(defun math-simplify-ineq (expr) + (let ((np (cdr expr)) n) (while (memq (car-safe (setq n (car np))) '(+ -)) - (math-simplify-add-term (cdr (cdr n)) (cdr (cdr math-simplify-expr)) + (math-simplify-add-term (cdr (cdr n)) (cdr (cdr expr)) (eq (car n) '-) nil) (setq np (cdr n))) - (math-simplify-add-term np (cdr (cdr math-simplify-expr)) nil - (eq np (cdr math-simplify-expr))) - (math-simplify-divide) - (let ((signs (math-possible-signs (cons '- (cdr math-simplify-expr))))) - (or (cond ((eq (car math-simplify-expr) 'calcFunc-eq) + (math-simplify-add-term np (cdr (cdr expr)) nil + (eq np (cdr expr))) + (math-simplify-divide expr) + (let ((signs (math-possible-signs (cons '- (cdr expr))))) + (or (cond ((eq (car expr) 'calcFunc-eq) (or (and (eq signs 2) 1) (and (memq signs '(1 4 5)) 0))) - ((eq (car math-simplify-expr) 'calcFunc-neq) + ((eq (car expr) 'calcFunc-neq) (or (and (eq signs 2) 0) (and (memq signs '(1 4 5)) 1))) - ((eq (car math-simplify-expr) 'calcFunc-lt) + ((eq (car expr) 'calcFunc-lt) (or (and (eq signs 1) 1) (and (memq signs '(2 4 6)) 0))) - ((eq (car math-simplify-expr) 'calcFunc-gt) + ((eq (car expr) 'calcFunc-gt) (or (and (eq signs 4) 1) (and (memq signs '(1 2 3)) 0))) - ((eq (car math-simplify-expr) 'calcFunc-leq) + ((eq (car expr) 'calcFunc-leq) (or (and (eq signs 4) 0) (and (memq signs '(1 2 3)) 1))) - ((eq (car math-simplify-expr) 'calcFunc-geq) + ((eq (car expr) 'calcFunc-geq) (or (and (eq signs 1) 0) (and (memq signs '(2 4 6)) 1)))) - math-simplify-expr)))) + expr)))) (defun math-simplify-add-term (np dp minus lplain) (or (math-vectorp (car np)) (let ((rplain t) - n d dd temp) + n d temp) (while (memq (car-safe (setq n (car np) d (car dp))) '(+ -)) (setq rplain nil) (if (setq temp (math-combine-sum n (nth 2 d) @@ -782,27 +777,27 @@ (setcar dp (setq n (math-neg temp))))))))) (math-defsimplify calcFunc-sin - (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin) - (nth 1 (nth 1 math-simplify-expr))) - (and (math-looks-negp (nth 1 math-simplify-expr)) - (math-neg (list 'calcFunc-sin (math-neg (nth 1 math-simplify-expr))))) + (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsin) + (nth 1 (nth 1 expr))) + (and (math-looks-negp (nth 1 expr)) + (math-neg (list 'calcFunc-sin (math-neg (nth 1 expr))))) (and (eq calc-angle-mode 'rad) - (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi)))) + (let ((n (math-linear-in (nth 1 expr) '(var pi var-pi)))) (and n (math-known-sin (car n) (nth 1 n) 120 0)))) (and (eq calc-angle-mode 'deg) - (let ((n (math-integer-plus (nth 1 math-simplify-expr)))) + (let ((n (math-integer-plus (nth 1 expr)))) (and n (math-known-sin (car n) (nth 1 n) '(frac 2 3) 0)))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccos) (list 'calcFunc-sqrt (math-sub 1 (math-sqr - (nth 1 (nth 1 math-simplify-expr)))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan) - (math-div (nth 1 (nth 1 math-simplify-expr)) + (nth 1 (nth 1 expr)))))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctan) + (math-div (nth 1 (nth 1 expr)) (list 'calcFunc-sqrt (math-add 1 (math-sqr - (nth 1 (nth 1 math-simplify-expr))))))) - (let ((m (math-should-expand-trig (nth 1 math-simplify-expr)))) + (nth 1 (nth 1 expr))))))) + (let ((m (math-should-expand-trig (nth 1 expr)))) (and m (integerp (car m)) (let ((n (car m)) (a (nth 1 m))) (list '+ @@ -812,27 +807,27 @@ (list 'calcFunc-sin a)))))))) (math-defsimplify calcFunc-cos - (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos) - (nth 1 (nth 1 math-simplify-expr))) - (and (math-looks-negp (nth 1 math-simplify-expr)) - (list 'calcFunc-cos (math-neg (nth 1 math-simplify-expr)))) + (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccos) + (nth 1 (nth 1 expr))) + (and (math-looks-negp (nth 1 expr)) + (list 'calcFunc-cos (math-neg (nth 1 expr)))) (and (eq calc-angle-mode 'rad) - (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi)))) + (let ((n (math-linear-in (nth 1 expr) '(var pi var-pi)))) (and n (math-known-sin (car n) (nth 1 n) 120 300)))) (and (eq calc-angle-mode 'deg) - (let ((n (math-integer-plus (nth 1 math-simplify-expr)))) + (let ((n (math-integer-plus (nth 1 expr)))) (and n (math-known-sin (car n) (nth 1 n) '(frac 2 3) 300)))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsin) (list 'calcFunc-sqrt - (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan) + (math-sub 1 (math-sqr (nth 1 (nth 1 expr)))))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctan) (math-div 1 (list 'calcFunc-sqrt (math-add 1 - (math-sqr (nth 1 (nth 1 math-simplify-expr))))))) - (let ((m (math-should-expand-trig (nth 1 math-simplify-expr)))) + (math-sqr (nth 1 (nth 1 expr))))))) + (let ((m (math-should-expand-trig (nth 1 expr)))) (and m (integerp (car m)) (let ((n (car m)) (a (nth 1 m))) (list '- @@ -842,53 +837,53 @@ (list 'calcFunc-sin a)))))))) (math-defsimplify calcFunc-sec - (or (and (math-looks-negp (nth 1 math-simplify-expr)) - (list 'calcFunc-sec (math-neg (nth 1 math-simplify-expr)))) + (or (and (math-looks-negp (nth 1 expr)) + (list 'calcFunc-sec (math-neg (nth 1 expr)))) (and (eq calc-angle-mode 'rad) - (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi)))) + (let ((n (math-linear-in (nth 1 expr) '(var pi var-pi)))) (and n (math-div 1 (math-known-sin (car n) (nth 1 n) 120 300))))) (and (eq calc-angle-mode 'deg) - (let ((n (math-integer-plus (nth 1 math-simplify-expr)))) + (let ((n (math-integer-plus (nth 1 expr)))) (and n (math-div 1 (math-known-sin (car n) (nth 1 n) '(frac 2 3) 300))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsin) (math-div 1 (list 'calcFunc-sqrt - (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos) + (math-sub 1 (math-sqr (nth 1 (nth 1 expr))))))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccos) (math-div 1 - (nth 1 (nth 1 math-simplify-expr)))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan) + (nth 1 (nth 1 expr)))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctan) (list 'calcFunc-sqrt (math-add 1 - (math-sqr (nth 1 (nth 1 math-simplify-expr)))))))) + (math-sqr (nth 1 (nth 1 expr)))))))) (math-defsimplify calcFunc-csc - (or (and (math-looks-negp (nth 1 math-simplify-expr)) - (math-neg (list 'calcFunc-csc (math-neg (nth 1 math-simplify-expr))))) + (or (and (math-looks-negp (nth 1 expr)) + (math-neg (list 'calcFunc-csc (math-neg (nth 1 expr))))) (and (eq calc-angle-mode 'rad) - (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi)))) + (let ((n (math-linear-in (nth 1 expr) '(var pi var-pi)))) (and n (math-div 1 (math-known-sin (car n) (nth 1 n) 120 0))))) (and (eq calc-angle-mode 'deg) - (let ((n (math-integer-plus (nth 1 math-simplify-expr)))) + (let ((n (math-integer-plus (nth 1 expr)))) (and n (math-div 1 (math-known-sin (car n) (nth 1 n) '(frac 2 3) 0))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin) - (math-div 1 (nth 1 (nth 1 math-simplify-expr)))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsin) + (math-div 1 (nth 1 (nth 1 expr)))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccos) (math-div 1 (list 'calcFunc-sqrt (math-sub 1 (math-sqr - (nth 1 (nth 1 math-simplify-expr))))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan) + (nth 1 (nth 1 expr))))))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctan) (math-div (list 'calcFunc-sqrt (math-add 1 (math-sqr - (nth 1 (nth 1 math-simplify-expr))))) - (nth 1 (nth 1 math-simplify-expr)))))) + (nth 1 (nth 1 expr))))) + (nth 1 (nth 1 expr)))))) (defun math-should-expand-trig (x &optional hyperbolic) (let ((m (math-is-multiple x))) @@ -943,55 +938,55 @@ (t nil)))))) (math-defsimplify calcFunc-tan - (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan) - (nth 1 (nth 1 math-simplify-expr))) - (and (math-looks-negp (nth 1 math-simplify-expr)) - (math-neg (list 'calcFunc-tan (math-neg (nth 1 math-simplify-expr))))) + (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctan) + (nth 1 (nth 1 expr))) + (and (math-looks-negp (nth 1 expr)) + (math-neg (list 'calcFunc-tan (math-neg (nth 1 expr))))) (and (eq calc-angle-mode 'rad) - (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi)))) + (let ((n (math-linear-in (nth 1 expr) '(var pi var-pi)))) (and n (math-known-tan (car n) (nth 1 n) 120)))) (and (eq calc-angle-mode 'deg) - (let ((n (math-integer-plus (nth 1 math-simplify-expr)))) + (let ((n (math-integer-plus (nth 1 expr)))) (and n (math-known-tan (car n) (nth 1 n) '(frac 2 3))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin) - (math-div (nth 1 (nth 1 math-simplify-expr)) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsin) + (math-div (nth 1 (nth 1 expr)) (list 'calcFunc-sqrt - (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos) + (math-sub 1 (math-sqr (nth 1 (nth 1 expr))))))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccos) (math-div (list 'calcFunc-sqrt - (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))) - (nth 1 (nth 1 math-simplify-expr)))) - (let ((m (math-should-expand-trig (nth 1 math-simplify-expr)))) + (math-sub 1 (math-sqr (nth 1 (nth 1 expr))))) + (nth 1 (nth 1 expr)))) + (let ((m (math-should-expand-trig (nth 1 expr)))) (and m (if (equal (car m) '(frac 1 2)) (math-div (math-sub 1 (list 'calcFunc-cos (nth 1 m))) (list 'calcFunc-sin (nth 1 m))) - (math-div (list 'calcFunc-sin (nth 1 math-simplify-expr)) - (list 'calcFunc-cos (nth 1 math-simplify-expr)))))))) + (math-div (list 'calcFunc-sin (nth 1 expr)) + (list 'calcFunc-cos (nth 1 expr)))))))) (math-defsimplify calcFunc-cot - (or (and (math-looks-negp (nth 1 math-simplify-expr)) - (math-neg (list 'calcFunc-cot (math-neg (nth 1 math-simplify-expr))))) + (or (and (math-looks-negp (nth 1 expr)) + (math-neg (list 'calcFunc-cot (math-neg (nth 1 expr))))) (and (eq calc-angle-mode 'rad) - (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi)))) + (let ((n (math-linear-in (nth 1 expr) '(var pi var-pi)))) (and n (math-div 1 (math-known-tan (car n) (nth 1 n) 120))))) (and (eq calc-angle-mode 'deg) - (let ((n (math-integer-plus (nth 1 math-simplify-expr)))) + (let ((n (math-integer-plus (nth 1 expr)))) (and n (math-div 1 (math-known-tan (car n) (nth 1 n) '(frac 2 3)))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsin) (math-div (list 'calcFunc-sqrt - (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))) - (nth 1 (nth 1 math-simplify-expr)))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos) - (math-div (nth 1 (nth 1 math-simplify-expr)) + (math-sub 1 (math-sqr (nth 1 (nth 1 expr))))) + (nth 1 (nth 1 expr)))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccos) + (math-div (nth 1 (nth 1 expr)) (list 'calcFunc-sqrt - (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan) - (math-div 1 (nth 1 (nth 1 math-simplify-expr)))))) + (math-sub 1 (math-sqr (nth 1 (nth 1 expr))))))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctan) + (math-div 1 (nth 1 (nth 1 expr)))))) (defun math-known-tan (plus n mul) (setq n (math-mul n mul)) @@ -1026,20 +1021,20 @@ (t nil)))))) (math-defsimplify calcFunc-sinh - (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh) - (nth 1 (nth 1 math-simplify-expr))) - (and (math-looks-negp (nth 1 math-simplify-expr)) - (math-neg (list 'calcFunc-sinh (math-neg (nth 1 math-simplify-expr))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh) + (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsinh) + (nth 1 (nth 1 expr))) + (and (math-looks-negp (nth 1 expr)) + (math-neg (list 'calcFunc-sinh (math-neg (nth 1 expr))))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccosh) math-living-dangerously (list 'calcFunc-sqrt - (math-sub (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh) + (math-sub (math-sqr (nth 1 (nth 1 expr))) 1))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctanh) math-living-dangerously - (math-div (nth 1 (nth 1 math-simplify-expr)) + (math-div (nth 1 (nth 1 expr)) (list 'calcFunc-sqrt - (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))))) - (let ((m (math-should-expand-trig (nth 1 math-simplify-expr) t))) + (math-sub 1 (math-sqr (nth 1 (nth 1 expr))))))) + (let ((m (math-should-expand-trig (nth 1 expr) t))) (and m (integerp (car m)) (let ((n (car m)) (a (nth 1 m))) (if (> n 1) @@ -1050,20 +1045,20 @@ (list 'calcFunc-sinh a))))))))) (math-defsimplify calcFunc-cosh - (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh) - (nth 1 (nth 1 math-simplify-expr))) - (and (math-looks-negp (nth 1 math-simplify-expr)) - (list 'calcFunc-cosh (math-neg (nth 1 math-simplify-expr)))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh) + (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccosh) + (nth 1 (nth 1 expr))) + (and (math-looks-negp (nth 1 expr)) + (list 'calcFunc-cosh (math-neg (nth 1 expr)))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsinh) math-living-dangerously (list 'calcFunc-sqrt - (math-add (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh) + (math-add (math-sqr (nth 1 (nth 1 expr))) 1))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctanh) math-living-dangerously (math-div 1 (list 'calcFunc-sqrt - (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))))) - (let ((m (math-should-expand-trig (nth 1 math-simplify-expr) t))) + (math-sub 1 (math-sqr (nth 1 (nth 1 expr))))))) + (let ((m (math-should-expand-trig (nth 1 expr) t))) (and m (integerp (car m)) (let ((n (car m)) (a (nth 1 m))) (if (> n 1) @@ -1074,188 +1069,188 @@ (list 'calcFunc-sinh a))))))))) (math-defsimplify calcFunc-tanh - (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh) - (nth 1 (nth 1 math-simplify-expr))) - (and (math-looks-negp (nth 1 math-simplify-expr)) - (math-neg (list 'calcFunc-tanh (math-neg (nth 1 math-simplify-expr))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh) + (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctanh) + (nth 1 (nth 1 expr))) + (and (math-looks-negp (nth 1 expr)) + (math-neg (list 'calcFunc-tanh (math-neg (nth 1 expr))))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsinh) math-living-dangerously - (math-div (nth 1 (nth 1 math-simplify-expr)) + (math-div (nth 1 (nth 1 expr)) (list 'calcFunc-sqrt - (math-add (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1)))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh) + (math-add (math-sqr (nth 1 (nth 1 expr))) 1)))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccosh) math-living-dangerously (math-div (list 'calcFunc-sqrt - (math-sub (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1)) - (nth 1 (nth 1 math-simplify-expr)))) - (let ((m (math-should-expand-trig (nth 1 math-simplify-expr) t))) + (math-sub (math-sqr (nth 1 (nth 1 expr))) 1)) + (nth 1 (nth 1 expr)))) + (let ((m (math-should-expand-trig (nth 1 expr) t))) (and m (if (equal (car m) '(frac 1 2)) (math-div (math-sub (list 'calcFunc-cosh (nth 1 m)) 1) (list 'calcFunc-sinh (nth 1 m))) - (math-div (list 'calcFunc-sinh (nth 1 math-simplify-expr)) - (list 'calcFunc-cosh (nth 1 math-simplify-expr)))))))) + (math-div (list 'calcFunc-sinh (nth 1 expr)) + (list 'calcFunc-cosh (nth 1 expr)))))))) (math-defsimplify calcFunc-sech - (or (and (math-looks-negp (nth 1 math-simplify-expr)) - (list 'calcFunc-sech (math-neg (nth 1 math-simplify-expr)))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh) + (or (and (math-looks-negp (nth 1 expr)) + (list 'calcFunc-sech (math-neg (nth 1 expr)))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsinh) math-living-dangerously (math-div 1 (list 'calcFunc-sqrt - (math-add (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1)))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh) + (math-add (math-sqr (nth 1 (nth 1 expr))) 1)))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccosh) math-living-dangerously - (math-div 1 (nth 1 (nth 1 math-simplify-expr))) 1) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh) + (math-div 1 (nth 1 (nth 1 expr))) 1) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctanh) math-living-dangerously (list 'calcFunc-sqrt - (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))))) + (math-sub 1 (math-sqr (nth 1 (nth 1 expr)))))))) (math-defsimplify calcFunc-csch - (or (and (math-looks-negp (nth 1 math-simplify-expr)) - (math-neg (list 'calcFunc-csch (math-neg (nth 1 math-simplify-expr))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh) + (or (and (math-looks-negp (nth 1 expr)) + (math-neg (list 'calcFunc-csch (math-neg (nth 1 expr))))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsinh) math-living-dangerously - (math-div 1 (nth 1 (nth 1 math-simplify-expr)))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh) + (math-div 1 (nth 1 (nth 1 expr)))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccosh) math-living-dangerously (math-div 1 (list 'calcFunc-sqrt - (math-sub (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1)))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh) + (math-sub (math-sqr (nth 1 (nth 1 expr))) 1)))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctanh) math-living-dangerously (math-div (list 'calcFunc-sqrt - (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))) - (nth 1 (nth 1 math-simplify-expr)))))) + (math-sub 1 (math-sqr (nth 1 (nth 1 expr))))) + (nth 1 (nth 1 expr)))))) (math-defsimplify calcFunc-coth - (or (and (math-looks-negp (nth 1 math-simplify-expr)) - (math-neg (list 'calcFunc-coth (math-neg (nth 1 math-simplify-expr))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh) + (or (and (math-looks-negp (nth 1 expr)) + (math-neg (list 'calcFunc-coth (math-neg (nth 1 expr))))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsinh) math-living-dangerously (math-div (list 'calcFunc-sqrt - (math-add (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1)) - (nth 1 (nth 1 math-simplify-expr)))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh) + (math-add (math-sqr (nth 1 (nth 1 expr))) 1)) + (nth 1 (nth 1 expr)))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccosh) math-living-dangerously - (math-div (nth 1 (nth 1 math-simplify-expr)) + (math-div (nth 1 (nth 1 expr)) (list 'calcFunc-sqrt - (math-sub (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1)))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh) + (math-sub (math-sqr (nth 1 (nth 1 expr))) 1)))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctanh) math-living-dangerously - (math-div 1 (nth 1 (nth 1 math-simplify-expr)))))) + (math-div 1 (nth 1 (nth 1 expr)))))) (math-defsimplify calcFunc-arcsin - (or (and (math-looks-negp (nth 1 math-simplify-expr)) - (math-neg (list 'calcFunc-arcsin (math-neg (nth 1 math-simplify-expr))))) - (and (eq (nth 1 math-simplify-expr) 1) + (or (and (math-looks-negp (nth 1 expr)) + (math-neg (list 'calcFunc-arcsin (math-neg (nth 1 expr))))) + (and (eq (nth 1 expr) 1) (math-quarter-circle t)) - (and (equal (nth 1 math-simplify-expr) '(frac 1 2)) + (and (equal (nth 1 expr) '(frac 1 2)) (math-div (math-half-circle t) 6)) (and math-living-dangerously - (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sin) - (nth 1 (nth 1 math-simplify-expr))) + (eq (car-safe (nth 1 expr)) 'calcFunc-sin) + (nth 1 (nth 1 expr))) (and math-living-dangerously - (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cos) + (eq (car-safe (nth 1 expr)) 'calcFunc-cos) (math-sub (math-quarter-circle t) - (nth 1 (nth 1 math-simplify-expr)))))) + (nth 1 (nth 1 expr)))))) (math-defsimplify calcFunc-arccos - (or (and (eq (nth 1 math-simplify-expr) 0) + (or (and (eq (nth 1 expr) 0) (math-quarter-circle t)) - (and (eq (nth 1 math-simplify-expr) -1) + (and (eq (nth 1 expr) -1) (math-half-circle t)) - (and (equal (nth 1 math-simplify-expr) '(frac 1 2)) + (and (equal (nth 1 expr) '(frac 1 2)) (math-div (math-half-circle t) 3)) - (and (equal (nth 1 math-simplify-expr) '(frac -1 2)) + (and (equal (nth 1 expr) '(frac -1 2)) (math-div (math-mul (math-half-circle t) 2) 3)) (and math-living-dangerously - (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cos) - (nth 1 (nth 1 math-simplify-expr))) + (eq (car-safe (nth 1 expr)) 'calcFunc-cos) + (nth 1 (nth 1 expr))) (and math-living-dangerously - (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sin) + (eq (car-safe (nth 1 expr)) 'calcFunc-sin) (math-sub (math-quarter-circle t) - (nth 1 (nth 1 math-simplify-expr)))))) + (nth 1 (nth 1 expr)))))) (math-defsimplify calcFunc-arctan - (or (and (math-looks-negp (nth 1 math-simplify-expr)) - (math-neg (list 'calcFunc-arctan (math-neg (nth 1 math-simplify-expr))))) - (and (eq (nth 1 math-simplify-expr) 1) + (or (and (math-looks-negp (nth 1 expr)) + (math-neg (list 'calcFunc-arctan (math-neg (nth 1 expr))))) + (and (eq (nth 1 expr) 1) (math-div (math-half-circle t) 4)) (and math-living-dangerously - (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-tan) - (nth 1 (nth 1 math-simplify-expr))))) + (eq (car-safe (nth 1 expr)) 'calcFunc-tan) + (nth 1 (nth 1 expr))))) (math-defsimplify calcFunc-arcsinh - (or (and (math-looks-negp (nth 1 math-simplify-expr)) - (math-neg (list 'calcFunc-arcsinh (math-neg (nth 1 math-simplify-expr))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sinh) + (or (and (math-looks-negp (nth 1 expr)) + (math-neg (list 'calcFunc-arcsinh (math-neg (nth 1 expr))))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-sinh) (or math-living-dangerously - (math-known-realp (nth 1 (nth 1 math-simplify-expr)))) - (nth 1 (nth 1 math-simplify-expr))))) + (math-known-realp (nth 1 (nth 1 expr)))) + (nth 1 (nth 1 expr))))) (math-defsimplify calcFunc-arccosh - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cosh) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-cosh) (or math-living-dangerously - (math-known-realp (nth 1 (nth 1 math-simplify-expr)))) - (nth 1 (nth 1 math-simplify-expr)))) + (math-known-realp (nth 1 (nth 1 expr)))) + (nth 1 (nth 1 expr)))) (math-defsimplify calcFunc-arctanh - (or (and (math-looks-negp (nth 1 math-simplify-expr)) - (math-neg (list 'calcFunc-arctanh (math-neg (nth 1 math-simplify-expr))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-tanh) + (or (and (math-looks-negp (nth 1 expr)) + (math-neg (list 'calcFunc-arctanh (math-neg (nth 1 expr))))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-tanh) (or math-living-dangerously - (math-known-realp (nth 1 (nth 1 math-simplify-expr)))) - (nth 1 (nth 1 math-simplify-expr))))) + (math-known-realp (nth 1 (nth 1 expr)))) + (nth 1 (nth 1 expr))))) (math-defsimplify calcFunc-sqrt - (math-simplify-sqrt)) + (math-simplify-sqrt expr)) -(defun math-simplify-sqrt () - (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'frac) +(defun math-simplify-sqrt (expr) + (or (and (eq (car-safe (nth 1 expr)) 'frac) (math-div (list 'calcFunc-sqrt - (math-mul (nth 1 (nth 1 math-simplify-expr)) - (nth 2 (nth 1 math-simplify-expr)))) - (nth 2 (nth 1 math-simplify-expr)))) - (let ((fac (if (math-objectp (nth 1 math-simplify-expr)) - (math-squared-factor (nth 1 math-simplify-expr)) - (math-common-constant-factor (nth 1 math-simplify-expr))))) + (math-mul (nth 1 (nth 1 expr)) + (nth 2 (nth 1 expr)))) + (nth 2 (nth 1 expr)))) + (let ((fac (if (math-objectp (nth 1 expr)) + (math-squared-factor (nth 1 expr)) + (math-common-constant-factor (nth 1 expr))))) (and fac (not (eq fac 1)) (math-mul (math-normalize (list 'calcFunc-sqrt fac)) (math-normalize (list 'calcFunc-sqrt (math-cancel-common-factor - (nth 1 math-simplify-expr) fac)))))) + (nth 1 expr) fac)))))) (and math-living-dangerously - (or (and (eq (car-safe (nth 1 math-simplify-expr)) '-) - (math-equal-int (nth 1 (nth 1 math-simplify-expr)) 1) - (eq (car-safe (nth 2 (nth 1 math-simplify-expr))) '^) - (math-equal-int (nth 2 (nth 2 (nth 1 math-simplify-expr))) 2) - (or (and (eq (car-safe (nth 1 (nth 2 (nth 1 math-simplify-expr)))) + (or (and (eq (car-safe (nth 1 expr)) '-) + (math-equal-int (nth 1 (nth 1 expr)) 1) + (eq (car-safe (nth 2 (nth 1 expr))) '^) + (math-equal-int (nth 2 (nth 2 (nth 1 expr))) 2) + (or (and (eq (car-safe (nth 1 (nth 2 (nth 1 expr)))) 'calcFunc-sin) (list 'calcFunc-cos - (nth 1 (nth 1 (nth 2 (nth 1 math-simplify-expr)))))) - (and (eq (car-safe (nth 1 (nth 2 (nth 1 math-simplify-expr)))) + (nth 1 (nth 1 (nth 2 (nth 1 expr)))))) + (and (eq (car-safe (nth 1 (nth 2 (nth 1 expr)))) 'calcFunc-cos) (list 'calcFunc-sin (nth 1 (nth 1 (nth 2 - (nth 1 math-simplify-expr)))))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) '-) - (math-equal-int (nth 2 (nth 1 math-simplify-expr)) 1) - (eq (car-safe (nth 1 (nth 1 math-simplify-expr))) '^) - (math-equal-int (nth 2 (nth 1 (nth 1 math-simplify-expr))) 2) - (and (eq (car-safe (nth 1 (nth 1 (nth 1 math-simplify-expr)))) + (nth 1 expr)))))))) + (and (eq (car-safe (nth 1 expr)) '-) + (math-equal-int (nth 2 (nth 1 expr)) 1) + (eq (car-safe (nth 1 (nth 1 expr))) '^) + (math-equal-int (nth 2 (nth 1 (nth 1 expr))) 2) + (and (eq (car-safe (nth 1 (nth 1 (nth 1 expr)))) 'calcFunc-cosh) (list 'calcFunc-sinh - (nth 1 (nth 1 (nth 1 (nth 1 math-simplify-expr))))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) '+) - (let ((a (nth 1 (nth 1 math-simplify-expr))) - (b (nth 2 (nth 1 math-simplify-expr)))) + (nth 1 (nth 1 (nth 1 (nth 1 expr))))))) + (and (eq (car-safe (nth 1 expr)) '+) + (let ((a (nth 1 (nth 1 expr))) + (b (nth 2 (nth 1 expr)))) (and (or (and (math-equal-int a 1) - (setq a b b (nth 1 (nth 1 math-simplify-expr)))) + (setq a b b (nth 1 (nth 1 expr)))) (math-equal-int b 1)) (eq (car-safe a) '^) (math-equal-int (nth 2 a) 2) @@ -1269,20 +1264,20 @@ (and (eq (car-safe (nth 1 a)) 'calcFunc-cot) (list '/ 1 (list 'calcFunc-sin (nth 1 (nth 1 a))))))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) '^) + (and (eq (car-safe (nth 1 expr)) '^) (list '^ - (nth 1 (nth 1 math-simplify-expr)) - (math-div (nth 2 (nth 1 math-simplify-expr)) 2))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sqrt) - (list '^ (nth 1 (nth 1 math-simplify-expr)) (math-div 1 4))) - (and (memq (car-safe (nth 1 math-simplify-expr)) '(* /)) - (list (car (nth 1 math-simplify-expr)) - (list 'calcFunc-sqrt (nth 1 (nth 1 math-simplify-expr))) - (list 'calcFunc-sqrt (nth 2 (nth 1 math-simplify-expr))))) - (and (memq (car-safe (nth 1 math-simplify-expr)) '(+ -)) - (not (math-any-floats (nth 1 math-simplify-expr))) + (nth 1 (nth 1 expr)) + (math-div (nth 2 (nth 1 expr)) 2))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-sqrt) + (list '^ (nth 1 (nth 1 expr)) (math-div 1 4))) + (and (memq (car-safe (nth 1 expr)) '(* /)) + (list (car (nth 1 expr)) + (list 'calcFunc-sqrt (nth 1 (nth 1 expr))) + (list 'calcFunc-sqrt (nth 2 (nth 1 expr))))) + (and (memq (car-safe (nth 1 expr)) '(+ -)) + (not (math-any-floats (nth 1 expr))) (let ((f (calcFunc-factors (calcFunc-expand - (nth 1 math-simplify-expr))))) + (nth 1 expr))))) (and (math-vectorp f) (or (> (length f) 2) (> (nth 2 (nth 1 f)) 1)) @@ -1318,7 +1313,7 @@ fac))) (math-defsimplify calcFunc-exp - (math-simplify-exp (nth 1 math-simplify-expr))) + (math-simplify-exp (nth 1 expr))) (defun math-simplify-exp (x) (or (and (eq (car-safe x) 'calcFunc-ln) @@ -1349,22 +1344,22 @@ (list '+ c (list '* s '(var i var-i)))))))) (math-defsimplify calcFunc-ln - (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-exp) + (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-exp) (or math-living-dangerously - (math-known-realp (nth 1 (nth 1 math-simplify-expr)))) - (nth 1 (nth 1 math-simplify-expr))) - (and (eq (car-safe (nth 1 math-simplify-expr)) '^) - (equal (nth 1 (nth 1 math-simplify-expr)) '(var e var-e)) + (math-known-realp (nth 1 (nth 1 expr)))) + (nth 1 (nth 1 expr))) + (and (eq (car-safe (nth 1 expr)) '^) + (equal (nth 1 (nth 1 expr)) '(var e var-e)) (or math-living-dangerously - (math-known-realp (nth 2 (nth 1 math-simplify-expr)))) - (nth 2 (nth 1 math-simplify-expr))) + (math-known-realp (nth 2 (nth 1 expr)))) + (nth 2 (nth 1 expr))) (and calc-symbolic-mode - (math-known-negp (nth 1 math-simplify-expr)) - (math-add (list 'calcFunc-ln (math-neg (nth 1 math-simplify-expr))) + (math-known-negp (nth 1 expr)) + (math-add (list 'calcFunc-ln (math-neg (nth 1 expr))) '(* (var pi var-pi) (var i var-i)))) (and calc-symbolic-mode - (math-known-imagp (nth 1 math-simplify-expr)) - (let* ((ip (calcFunc-im (nth 1 math-simplify-expr))) + (math-known-imagp (nth 1 expr)) + (let* ((ip (calcFunc-im (nth 1 expr))) (ips (math-possible-signs ip))) (or (and (memq ips '(4 6)) (math-add (list 'calcFunc-ln ip) @@ -1374,95 +1369,92 @@ '(/ (* (var pi var-pi) (var i var-i)) 2)))))))) (math-defsimplify ^ - (math-simplify-pow)) - -(defun math-simplify-pow () (or (and math-living-dangerously - (or (and (eq (car-safe (nth 1 math-simplify-expr)) '^) + (or (and (eq (car-safe (nth 1 expr)) '^) (list '^ - (nth 1 (nth 1 math-simplify-expr)) - (math-mul (nth 2 math-simplify-expr) - (nth 2 (nth 1 math-simplify-expr))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sqrt) + (nth 1 (nth 1 expr)) + (math-mul (nth 2 expr) + (nth 2 (nth 1 expr))))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-sqrt) (list '^ - (nth 1 (nth 1 math-simplify-expr)) - (math-div (nth 2 math-simplify-expr) 2))) - (and (memq (car-safe (nth 1 math-simplify-expr)) '(* /)) - (list (car (nth 1 math-simplify-expr)) - (list '^ (nth 1 (nth 1 math-simplify-expr)) - (nth 2 math-simplify-expr)) - (list '^ (nth 2 (nth 1 math-simplify-expr)) - (nth 2 math-simplify-expr)))))) - (and (math-equal-int (nth 1 math-simplify-expr) 10) - (eq (car-safe (nth 2 math-simplify-expr)) 'calcFunc-log10) - (nth 1 (nth 2 math-simplify-expr))) - (and (equal (nth 1 math-simplify-expr) '(var e var-e)) - (math-simplify-exp (nth 2 math-simplify-expr))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-exp) + (nth 1 (nth 1 expr)) + (math-div (nth 2 expr) 2))) + (and (memq (car-safe (nth 1 expr)) '(* /)) + (list (car (nth 1 expr)) + (list '^ (nth 1 (nth 1 expr)) + (nth 2 expr)) + (list '^ (nth 2 (nth 1 expr)) + (nth 2 expr)))))) + (and (math-equal-int (nth 1 expr) 10) + (eq (car-safe (nth 2 expr)) 'calcFunc-log10) + (nth 1 (nth 2 expr))) + (and (equal (nth 1 expr) '(var e var-e)) + (math-simplify-exp (nth 2 expr))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-exp) (not math-integrating) - (list 'calcFunc-exp (math-mul (nth 1 (nth 1 math-simplify-expr)) - (nth 2 math-simplify-expr)))) - (and (equal (nth 1 math-simplify-expr) '(var i var-i)) + (list 'calcFunc-exp (math-mul (nth 1 (nth 1 expr)) + (nth 2 expr)))) + (and (equal (nth 1 expr) '(var i var-i)) (math-imaginary-i) - (math-num-integerp (nth 2 math-simplify-expr)) - (let ((x (math-mod (math-trunc (nth 2 math-simplify-expr)) 4))) + (math-num-integerp (nth 2 expr)) + (let ((x (math-mod (math-trunc (nth 2 expr)) 4))) (cond ((eq x 0) 1) - ((eq x 1) (nth 1 math-simplify-expr)) + ((eq x 1) (nth 1 expr)) ((eq x 2) -1) - ((eq x 3) (math-neg (nth 1 math-simplify-expr)))))) + ((eq x 3) (math-neg (nth 1 expr)))))) (and math-integrating - (integerp (nth 2 math-simplify-expr)) - (>= (nth 2 math-simplify-expr) 2) - (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cos) - (math-mul (math-pow (nth 1 math-simplify-expr) - (- (nth 2 math-simplify-expr) 2)) + (integerp (nth 2 expr)) + (>= (nth 2 expr) 2) + (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-cos) + (math-mul (math-pow (nth 1 expr) + (- (nth 2 expr) 2)) (math-sub 1 (math-sqr (list 'calcFunc-sin - (nth 1 (nth 1 math-simplify-expr))))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cosh) - (math-mul (math-pow (nth 1 math-simplify-expr) - (- (nth 2 math-simplify-expr) 2)) + (nth 1 (nth 1 expr))))))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-cosh) + (math-mul (math-pow (nth 1 expr) + (- (nth 2 expr) 2)) (math-add 1 (math-sqr (list 'calcFunc-sinh - (nth 1 (nth 1 math-simplify-expr))))))))) - (and (eq (car-safe (nth 2 math-simplify-expr)) 'frac) - (Math-ratp (nth 1 math-simplify-expr)) - (Math-posp (nth 1 math-simplify-expr)) - (if (equal (nth 2 math-simplify-expr) '(frac 1 2)) - (list 'calcFunc-sqrt (nth 1 math-simplify-expr)) - (let ((flr (math-floor (nth 2 math-simplify-expr)))) + (nth 1 (nth 1 expr))))))))) + (and (eq (car-safe (nth 2 expr)) 'frac) + (Math-ratp (nth 1 expr)) + (Math-posp (nth 1 expr)) + (if (equal (nth 2 expr) '(frac 1 2)) + (list 'calcFunc-sqrt (nth 1 expr)) + (let ((flr (math-floor (nth 2 expr)))) (and (not (Math-zerop flr)) - (list '* (list '^ (nth 1 math-simplify-expr) flr) - (list '^ (nth 1 math-simplify-expr) - (math-sub (nth 2 math-simplify-expr) flr))))))) - (and (eq (math-quarter-integer (nth 2 math-simplify-expr)) 2) - (let ((temp (math-simplify-sqrt))) + (list '* (list '^ (nth 1 expr) flr) + (list '^ (nth 1 expr) + (math-sub (nth 2 expr) flr))))))) + (and (eq (math-quarter-integer (nth 2 expr)) 2) + (let ((temp (math-simplify-sqrt expr))) (and temp - (list '^ temp (math-mul (nth 2 math-simplify-expr) 2))))))) + (list '^ temp (math-mul (nth 2 expr) 2))))))) (math-defsimplify calcFunc-log10 - (and (eq (car-safe (nth 1 math-simplify-expr)) '^) - (math-equal-int (nth 1 (nth 1 math-simplify-expr)) 10) + (and (eq (car-safe (nth 1 expr)) '^) + (math-equal-int (nth 1 (nth 1 expr)) 10) (or math-living-dangerously - (math-known-realp (nth 2 (nth 1 math-simplify-expr)))) - (nth 2 (nth 1 math-simplify-expr)))) + (math-known-realp (nth 2 (nth 1 expr)))) + (nth 2 (nth 1 expr)))) (math-defsimplify calcFunc-erf - (or (and (math-looks-negp (nth 1 math-simplify-expr)) - (math-neg (list 'calcFunc-erf (math-neg (nth 1 math-simplify-expr))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-conj) + (or (and (math-looks-negp (nth 1 expr)) + (math-neg (list 'calcFunc-erf (math-neg (nth 1 expr))))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-conj) (list 'calcFunc-conj - (list 'calcFunc-erf (nth 1 (nth 1 math-simplify-expr))))))) + (list 'calcFunc-erf (nth 1 (nth 1 expr))))))) (math-defsimplify calcFunc-erfc - (or (and (math-looks-negp (nth 1 math-simplify-expr)) - (math-sub 2 (list 'calcFunc-erfc (math-neg (nth 1 math-simplify-expr))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-conj) + (or (and (math-looks-negp (nth 1 expr)) + (math-sub 2 (list 'calcFunc-erfc (math-neg (nth 1 expr))))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-conj) (list 'calcFunc-conj - (list 'calcFunc-erfc (nth 1 (nth 1 math-simplify-expr))))))) + (list 'calcFunc-erfc (nth 1 (nth 1 expr))))))) (defun math-linear-in (expr term &optional always) @@ -1614,10 +1606,12 @@ (defvar math-expr-subst-old) (defvar math-expr-subst-new) -(defun math-expr-subst (expr math-expr-subst-old math-expr-subst-new) - (math-expr-subst-rec expr)) +(defun math-expr-subst (expr old new) + (let ((math-expr-subst-old old) + (math-expr-subst-new new)) + (math-expr-subst-rec expr))) -(defalias 'calcFunc-subst 'math-expr-subst) +(defalias 'calcFunc-subst #'math-expr-subst) (defun math-expr-subst-rec (expr) (cond ((equal expr math-expr-subst-old) math-expr-subst-new) @@ -1632,7 +1626,7 @@ (math-expr-subst-rec (nth 2 expr))))) (t (cons (car expr) - (mapcar 'math-expr-subst-rec (cdr expr)))))) + (mapcar #'math-expr-subst-rec (cdr expr)))))) ;;; Various measures of the size of an expression. (defun math-expr-weight (expr) @@ -1659,7 +1653,7 @@ (defun calcFunc-collect (expr base) (let ((p (math-is-polynomial expr base 50 t))) (if (cdr p) - (math-build-polynomial-expr (mapcar 'math-normalize p) base) + (math-build-polynomial-expr (mapcar #'math-normalize p) base) (car p)))) ;;; If expr is of the form "a + bx + cx^2 + ...", return the list (a b c ...), @@ -1672,13 +1666,16 @@ (defvar math-is-poly-loose) (defvar math-var) -(defun math-is-polynomial (expr math-var &optional math-is-poly-degree math-is-poly-loose) - (let* ((math-poly-base-variable (if math-is-poly-loose - (if (eq math-is-poly-loose 'gen) math-var '(var XXX XXX)) +(defun math-is-polynomial (expr var &optional degree loose) + (let* ((math-poly-base-variable (if loose + (if (eq loose 'gen) var '(var XXX XXX)) math-poly-base-variable)) + (math-var var) + (math-is-poly-loose loose) + (math-is-poly-degree degree) (poly (math-is-poly-rec expr math-poly-neg-powers))) - (and (or (null math-is-poly-degree) - (<= (length poly) (1+ math-is-poly-degree))) + (and (or (null degree) + (<= (length poly) (1+ degree))) poly))) (defun math-is-poly-rec (expr negpow) @@ -1749,7 +1746,7 @@ (math-poly-mix p1 1 p2 (if (eq (car expr) '+) 1 -1))))))) ((eq (car expr) 'neg) - (mapcar 'math-neg (math-is-poly-rec (nth 1 expr) negpow))) + (mapcar #'math-neg (math-is-poly-rec (nth 1 expr) negpow))) ((eq (car expr) '*) (let ((p1 (math-is-poly-rec (nth 1 expr) negpow))) (and p1 @@ -1812,24 +1809,20 @@ (math-expr-contains expr math-poly-base-variable) (math-expr-depends expr var))) -;;; Find the variable (or sub-expression) which is the base of polynomial expr. ;; The variables math-poly-base-const-ok and math-poly-base-pred are ;; local to math-polynomial-base, but are used by math-polynomial-base-rec. (defvar math-poly-base-const-ok) (defvar math-poly-base-pred) -;; The variable math-poly-base-top-expr is local to math-polynomial-base, -;; but is used by math-polynomial-p1 in calc-poly.el, which is called -;; by math-polynomial-base. - -(defun math-polynomial-base (math-poly-base-top-expr &optional math-poly-base-pred) - (or math-poly-base-pred - (setq math-poly-base-pred (function (lambda (base) (math-polynomial-p - math-poly-base-top-expr base))))) +(defun math-polynomial-base (top-expr &optional pred) + "Find the variable (or sub-expression) which is the base of polynomial expr." + (let ((math-poly-base-pred + (or pred (function (lambda (base) (math-polynomial-p + top-expr base)))))) (or (let ((math-poly-base-const-ok nil)) - (math-polynomial-base-rec math-poly-base-top-expr)) + (math-polynomial-base-rec top-expr)) (let ((math-poly-base-const-ok t)) - (math-polynomial-base-rec math-poly-base-top-expr)))) + (math-polynomial-base-rec top-expr))))) (defun math-polynomial-base-rec (mpb-expr) (and (not (Math-objvecp mpb-expr)) @@ -1846,8 +1839,8 @@ (funcall math-poly-base-pred mpb-expr) mpb-expr)))) -;;; Return non-nil if expr refers to any variables. (defun math-expr-contains-vars (expr) + "Return non-nil if expr refers to any variables." (or (eq (car-safe expr) 'var) (and (not (Math-primp expr)) (progn @@ -1855,9 +1848,9 @@ (not (math-expr-contains-vars (car expr))))) expr)))) -;;; Simplify a polynomial in list form by stripping off high-end zeros. -;;; This always leaves the constant part, i.e., nil->nil and non-nil->non-nil. (defun math-poly-simplify (p) + "Simplify a polynomial in list form by stripping off high-end zeros. +This always leaves the constant part, i.e., nil->nil and non-nil->non-nil." (and p (if (Math-zerop (nth (1- (length p)) p)) (let ((pp (copy-sequence p))) @@ -1879,14 +1872,14 @@ (or (null a) (and (null (cdr a)) (Math-zerop (car a))))) -;;; Multiply two polynomials in list form. (defun math-poly-mul (a b) + "Multiply two polynomials in list form." (and a b (math-poly-mix b (car a) (math-poly-mul (cdr a) (cons 0 b)) 1))) -;;; Build an expression from a polynomial list. (defun math-build-polynomial-expr (p var) + "Build an expression from a polynomial list." (if p (if (Math-numberp var) (math-with-extra-prec 1 @@ -1897,8 +1890,7 @@ accum)) (let* ((rp (reverse p)) (n (1- (length rp))) - (accum (math-mul (car rp) (math-pow var n))) - term) + (accum (math-mul (car rp) (math-pow var n)))) (while (setq rp (cdr rp)) (setq n (1- n)) (or (math-zerop (car rp)) diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index f983ebe414..821a709434 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el @@ -714,8 +714,8 @@ ;;;; (Autoloads here) (mapc (function (lambda (x) - (mapcar (function (lambda (func) - (autoload func (car x)))) (cdr x)))) + (mapcar (function (lambda (func) (autoload func (car x)))) + (cdr x)))) '( ("calc-alg" calc-has-rules math-defsimplify diff --git a/lisp/calc/calc-poly.el b/lisp/calc/calc-poly.el index 64f221e7a0..4092aeec52 100644 --- a/lisp/calc/calc-poly.el +++ b/lisp/calc/calc-poly.el @@ -517,8 +517,9 @@ (defvar math-poly-base-total-base) (defun math-total-polynomial-base (expr) - (let ((math-poly-base-total-base nil)) - (math-polynomial-base expr 'math-polynomial-p1) + (let ((math-poly-base-total-base nil) + (math-poly-base-top-expr expr)) + (math-polynomial-base expr #'math-polynomial-p1) (math-sort-poly-base-list math-poly-base-total-base))) ;; The variable math-poly-base-top-expr is local to math-polynomial-base diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index 17d16acee0..6e58eaf225 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el @@ -1,4 +1,4 @@ -;;; calc-units.el --- unit conversion functions for Calc +;;; calc-units.el --- unit conversion functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2018 Free Software Foundation, Inc. @@ -455,7 +455,6 @@ If COMP or STD is non-nil, put that in the units table instead." (uoldname nil) (unitscancel nil) (nouold nil) - unew units defunits) (if (or (not (math-units-in-expr-p expr t)) @@ -672,8 +671,8 @@ If COMP or STD is non-nil, put that in the units table instead." (substring name (1+ pos))))) (setq name (concat "(" name ")")))) (or (eq (nth 1 expr) (car u)) - (setq name (concat (nth 2 (assq (aref (symbol-name - (nth 1 expr)) 0) + (setq name (concat (nth 2 (assq (aref (symbol-name (nth 1 expr)) + 0) math-unit-prefixes)) (if (and (string-match "[^a-zA-Zα-ωΑ-Ω0-9']" name) (not (memq (car u) '(mHg gf)))) @@ -857,7 +856,7 @@ If COMP or STD is non-nil, put that in the units table instead." (or math-units-table (let* ((combined-units (append math-additional-units math-standard-units)) - (math-cu-unit-list (mapcar 'car combined-units)) + (math-cu-unit-list (mapcar #'car combined-units)) tab) (message "Building units table...") (setq math-units-table-buffer-valid nil) @@ -880,7 +879,7 @@ If COMP or STD is non-nil, put that in the units table instead." (nth 4 x)))) combined-units)) (let ((math-units-table tab)) - (mapc 'math-find-base-units tab)) + (mapc #'math-find-base-units tab)) (message "Building units table...done") (setq math-units-table tab)))) @@ -890,15 +889,16 @@ If COMP or STD is non-nil, put that in the units table instead." (defvar math-fbu-base) (defvar math-fbu-entry) -(defun math-find-base-units (math-fbu-entry) - (if (eq (nth 4 math-fbu-entry) 'boom) - (error "Circular definition involving unit %s" (car math-fbu-entry))) - (or (nth 4 math-fbu-entry) - (let (math-fbu-base) - (setcar (nthcdr 4 math-fbu-entry) 'boom) - (math-find-base-units-rec (nth 1 math-fbu-entry) 1) +(defun math-find-base-units (entry) + (if (eq (nth 4 entry) 'boom) + (error "Circular definition involving unit %s" (car entry))) + (or (nth 4 entry) + (let (math-fbu-base + (math-fbu-entry entry)) + (setcar (nthcdr 4 entry) 'boom) + (math-find-base-units-rec (nth 1 entry) 1) '(or math-fbu-base - (error "Dimensionless definition for unit %s" (car math-fbu-entry))) + (error "Dimensionless definition for unit %s" (car entry))) (while (eq (cdr (car math-fbu-base)) 0) (setq math-fbu-base (cdr math-fbu-base))) (let ((b math-fbu-base)) @@ -907,7 +907,7 @@ If COMP or STD is non-nil, put that in the units table instead." (setcdr b (cdr (cdr b))) (setq b (cdr b))))) (setq math-fbu-base (sort math-fbu-base 'math-compare-unit-names)) - (setcar (nthcdr 4 math-fbu-entry) math-fbu-base) + (setcar (nthcdr 4 entry) math-fbu-base) math-fbu-base))) (defun math-compare-unit-names (a b) @@ -942,7 +942,8 @@ If COMP or STD is non-nil, put that in the units table instead." (error "Unknown name %s in defining expression for unit %s" (nth 1 expr) (car math-fbu-entry)))) ((equal expr '(calcFunc-ln 10))) - (t (error "Malformed defining expression for unit %s" (car math-fbu-entry)))))) + (t (error "Malformed defining expression for unit %s" + (car math-fbu-entry)))))) (defun math-units-in-expr-p (expr sub-exprs) @@ -1018,8 +1019,9 @@ If COMP or STD is non-nil, put that in the units table instead." ;; math-to-standard-units. (defvar math-which-standard) -(defun math-to-standard-units (expr math-which-standard) - (math-to-standard-rec expr)) +(defun math-to-standard-units (expr which-standard) + (let ((math-which-standard which-standard)) + (math-to-standard-rec expr))) (defun math-to-standard-rec (expr) (if (eq (car-safe expr) 'var) @@ -1052,7 +1054,7 @@ If COMP or STD is non-nil, put that in the units table instead." (eq (car-safe (nth 1 expr)) 'var))) expr (cons (car expr) - (mapcar 'math-to-standard-rec (cdr expr)))))) + (mapcar #'math-to-standard-rec (cdr expr)))))) (defun math-apply-units (expr units ulist &optional pure) (setq expr (math-simplify-units expr)) @@ -1085,8 +1087,7 @@ If COMP or STD is non-nil, put that in the units table instead." (let ((entry (list units calc-internal-prec calc-prefer-frac))) (or (equal entry (car math-decompose-units-cache)) (let ((ulist nil) - (utemp units) - qty unit) + (utemp units)) (while (eq (car-safe utemp) '+) (setq ulist (cons (math-decompose-unit-part (nth 2 utemp)) ulist) @@ -1144,15 +1145,15 @@ If COMP or STD is non-nil, put that in the units table instead." (defvar math-cu-new-units) (defvar math-cu-pure) -(defun math-convert-units (expr math-cu-new-units &optional math-cu-pure) - (if (eq (car-safe math-cu-new-units) 'var) - (let ((unew (assq (nth 1 math-cu-new-units) +(defun math-convert-units (expr new-units &optional pure) + (if (eq (car-safe new-units) 'var) + (let ((unew (assq (nth 1 new-units) (math-build-units-table)))) (if (eq (car-safe (nth 1 unew)) '+) - (setq math-cu-new-units (nth 1 unew))))) + (setq new-units (nth 1 unew))))) (math-with-extra-prec 2 - (let ((compat (and (not math-cu-pure) - (math-find-compatible-unit expr math-cu-new-units))) + (let ((compat (and (not pure) + (math-find-compatible-unit expr new-units))) (math-cu-unit-list nil) (math-combining-units nil)) (if compat @@ -1160,21 +1161,23 @@ If COMP or STD is non-nil, put that in the units table instead." (math-mul (math-mul (math-simplify-units (math-div expr (math-pow (car compat) (cdr compat)))) - (math-pow math-cu-new-units (cdr compat))) + (math-pow new-units (cdr compat))) (math-simplify-units (math-to-standard-units - (math-pow (math-div (car compat) math-cu-new-units) + (math-pow (math-div (car compat) new-units) (cdr compat)) nil)))) - (when (setq math-cu-unit-list (math-decompose-units math-cu-new-units)) - (setq math-cu-new-units (nth 2 (car math-cu-unit-list)))) + (when (setq math-cu-unit-list (math-decompose-units new-units)) + (setq new-units (nth 2 (car math-cu-unit-list)))) (when (eq (car-safe expr) '+) (setq expr (math-simplify-units expr))) (if (math-units-in-expr-p expr t) - (math-convert-units-rec expr) + (let ((math-cu-new-units new-units) + (math-cu-pure pure)) + (math-convert-units-rec expr)) (math-apply-units (math-to-standard-units - (list '/ expr math-cu-new-units) nil) - math-cu-new-units math-cu-unit-list math-cu-pure)))))) + (list '/ expr new-units) nil) + new-units math-cu-unit-list pure)))))) (defun math-convert-units-rec (expr) (if (math-units-in-expr-p expr nil) @@ -1184,7 +1187,7 @@ If COMP or STD is non-nil, put that in the units table instead." (if (Math-primp expr) expr (cons (car expr) - (mapcar 'math-convert-units-rec (cdr expr)))))) + (mapcar #'math-convert-units-rec (cdr expr)))))) (defun math-convert-temperature (expr old new &optional pure) (let* ((units (math-single-units-in-expr-p expr)) @@ -1228,37 +1231,34 @@ If COMP or STD is non-nil, put that in the units table instead." (math-simplify a))) (defalias 'calcFunc-usimplify 'math-simplify-units) -;; The function created by math-defsimplify uses the variable -;; math-simplify-expr, and so is used by functions in math-defsimplify -(defvar math-simplify-expr) - +;; The function created by math-defsimplify uses the variable `expr'. (math-defsimplify (+ -) (and math-simplifying-units - (math-units-in-expr-p (nth 1 math-simplify-expr) nil) - (let* ((units (math-extract-units (nth 1 math-simplify-expr))) + (math-units-in-expr-p (nth 1 expr) nil) + (let* ((units (math-extract-units (nth 1 expr))) (ratio (math-simplify (math-to-standard-units - (list '/ (nth 2 math-simplify-expr) units) nil)))) + (list '/ (nth 2 expr) units) nil)))) (if (math-units-in-expr-p ratio nil) (progn - (calc-record-why "*Inconsistent units" math-simplify-expr) - math-simplify-expr) - (list '* (math-add (math-remove-units (nth 1 math-simplify-expr)) - (if (eq (car math-simplify-expr) '-) + (calc-record-why "*Inconsistent units" expr) + expr) + (list '* (math-add (math-remove-units (nth 1 expr)) + (if (eq (car expr) '-) (math-neg ratio) ratio)) units))))) (math-defsimplify * - (math-simplify-units-prod)) + (math-simplify-units-prod expr)) -(defun math-simplify-units-prod () +(defun math-simplify-units-prod (expr) (and math-simplifying-units calc-autorange-units - (Math-realp (nth 1 math-simplify-expr)) - (let* ((num (math-float (nth 1 math-simplify-expr))) + (Math-realp (nth 1 expr)) + (let* ((num (math-float (nth 1 expr))) (xpon (calcFunc-xpon num)) - (unitp (cdr (cdr math-simplify-expr))) + (unitp (cdr (cdr expr))) (unit (car unitp)) - (pow (if (eq (car math-simplify-expr) '*) 1 -1)) + (pow (if (eq (car expr) '*) 1 -1)) u) (and (eq (car-safe unit) '*) (setq unitp (cdr unit) @@ -1308,46 +1308,46 @@ If COMP or STD is non-nil, put that in the units table instead." (or (not (eq p pref)) (< xpon (+ pxpon (* (math-abs pow) 3)))) (progn - (setcar (cdr math-simplify-expr) + (setcar (cdr expr) (let ((calc-prefer-frac nil)) - (calcFunc-scf (nth 1 math-simplify-expr) + (calcFunc-scf (nth 1 expr) (- uxpon pxpon)))) (setcar unitp pname) - math-simplify-expr))))))) + expr))))))) (defvar math-try-cancel-units) (math-defsimplify / (and math-simplifying-units - (let ((np (cdr math-simplify-expr)) + (let ((np (cdr expr)) (math-try-cancel-units 0) - n nn) - (setq n (if (eq (car-safe (nth 2 math-simplify-expr)) '*) - (cdr (nth 2 math-simplify-expr)) - (nthcdr 2 math-simplify-expr))) + n) + (setq n (if (eq (car-safe (nth 2 expr)) '*) + (cdr (nth 2 expr)) + (nthcdr 2 expr))) (if (math-realp (car n)) (progn - (setcar (cdr math-simplify-expr) (math-mul (nth 1 math-simplify-expr) + (setcar (cdr expr) (math-mul (nth 1 expr) (let ((calc-prefer-frac nil)) (math-div 1 (car n))))) (setcar n 1))) (while (eq (car-safe (setq n (car np))) '*) - (math-simplify-units-divisor (cdr n) (cdr (cdr math-simplify-expr))) + (math-simplify-units-divisor (cdr n) (cdr (cdr expr))) (setq np (cdr (cdr n)))) - (math-simplify-units-divisor np (cdr (cdr math-simplify-expr))) + (math-simplify-units-divisor np (cdr (cdr expr))) (if (eq math-try-cancel-units 0) (let* ((math-simplifying-units nil) (base (math-simplify - (math-to-standard-units math-simplify-expr nil)))) + (math-to-standard-units expr nil)))) (if (Math-numberp base) - (setq math-simplify-expr base)))) - (if (eq (car-safe math-simplify-expr) '/) - (math-simplify-units-prod)) - math-simplify-expr))) + (setq expr base)))) + (if (eq (car-safe expr) '/) + (math-simplify-units-prod expr)) + expr))) (defun math-simplify-units-divisor (np dp) (let ((n (car np)) - d dd temp) + d temp) (while (eq (car-safe (setq d (car dp))) '*) (when (setq temp (math-simplify-units-quotient n (nth 1 d))) (setcar np (setq n temp)) @@ -1387,23 +1387,23 @@ If COMP or STD is non-nil, put that in the units table instead." (math-defsimplify ^ (and math-simplifying-units - (math-realp (nth 2 math-simplify-expr)) - (if (memq (car-safe (nth 1 math-simplify-expr)) '(* /)) - (list (car (nth 1 math-simplify-expr)) - (list '^ (nth 1 (nth 1 math-simplify-expr)) - (nth 2 math-simplify-expr)) - (list '^ (nth 2 (nth 1 math-simplify-expr)) - (nth 2 math-simplify-expr))) - (math-simplify-units-pow (nth 1 math-simplify-expr) - (nth 2 math-simplify-expr))))) + (math-realp (nth 2 expr)) + (if (memq (car-safe (nth 1 expr)) '(* /)) + (list (car (nth 1 expr)) + (list '^ (nth 1 (nth 1 expr)) + (nth 2 expr)) + (list '^ (nth 2 (nth 1 expr)) + (nth 2 expr))) + (math-simplify-units-pow (nth 1 expr) + (nth 2 expr))))) (math-defsimplify calcFunc-sqrt (and math-simplifying-units - (if (memq (car-safe (nth 1 math-simplify-expr)) '(* /)) - (list (car (nth 1 math-simplify-expr)) - (list 'calcFunc-sqrt (nth 1 (nth 1 math-simplify-expr))) - (list 'calcFunc-sqrt (nth 2 (nth 1 math-simplify-expr)))) - (math-simplify-units-pow (nth 1 math-simplify-expr) '(frac 1 2))))) + (if (memq (car-safe (nth 1 expr)) '(* /)) + (list (car (nth 1 expr)) + (list 'calcFunc-sqrt (nth 1 (nth 1 expr))) + (list 'calcFunc-sqrt (nth 2 (nth 1 expr)))) + (math-simplify-units-pow (nth 1 expr) '(frac 1 2))))) (math-defsimplify (calcFunc-floor calcFunc-ceil @@ -1416,21 +1416,21 @@ If COMP or STD is non-nil, put that in the units table instead." calcFunc-abs calcFunc-clean) (and math-simplifying-units - (= (length math-simplify-expr) 2) - (if (math-only-units-in-expr-p (nth 1 math-simplify-expr)) - (nth 1 math-simplify-expr) - (if (and (memq (car-safe (nth 1 math-simplify-expr)) '(* /)) + (= (length expr) 2) + (if (math-only-units-in-expr-p (nth 1 expr)) + (nth 1 expr) + (if (and (memq (car-safe (nth 1 expr)) '(* /)) (or (math-only-units-in-expr-p - (nth 1 (nth 1 math-simplify-expr))) + (nth 1 (nth 1 expr))) (math-only-units-in-expr-p - (nth 2 (nth 1 math-simplify-expr))))) - (list (car (nth 1 math-simplify-expr)) - (cons (car math-simplify-expr) - (cons (nth 1 (nth 1 math-simplify-expr)) - (cdr (cdr math-simplify-expr)))) - (cons (car math-simplify-expr) - (cons (nth 2 (nth 1 math-simplify-expr)) - (cdr (cdr math-simplify-expr))))))))) + (nth 2 (nth 1 expr))))) + (list (car (nth 1 expr)) + (cons (car expr) + (cons (nth 1 (nth 1 expr)) + (cdr (cdr expr)))) + (cons (car expr) + (cons (nth 2 (nth 1 expr)) + (cdr (cdr expr))))))))) (defun math-simplify-units-pow (a pow) (if (and (eq (car-safe a) '^) @@ -1453,10 +1453,10 @@ If COMP or STD is non-nil, put that in the units table instead." (math-defsimplify calcFunc-sin (and math-simplifying-units - (math-units-in-expr-p (nth 1 math-simplify-expr) nil) + (math-units-in-expr-p (nth 1 expr) nil) (let ((rad (math-simplify-units (math-evaluate-expr - (math-to-standard-units (nth 1 math-simplify-expr) nil)))) + (math-to-standard-units (nth 1 expr) nil)))) (calc-angle-mode 'rad)) (and (eq (car-safe rad) '*) (math-realp (nth 1 rad)) @@ -1466,10 +1466,10 @@ If COMP or STD is non-nil, put that in the units table instead." (math-defsimplify calcFunc-cos (and math-simplifying-units - (math-units-in-expr-p (nth 1 math-simplify-expr) nil) + (math-units-in-expr-p (nth 1 expr) nil) (let ((rad (math-simplify-units (math-evaluate-expr - (math-to-standard-units (nth 1 math-simplify-expr) nil)))) + (math-to-standard-units (nth 1 expr) nil)))) (calc-angle-mode 'rad)) (and (eq (car-safe rad) '*) (math-realp (nth 1 rad)) @@ -1479,10 +1479,10 @@ If COMP or STD is non-nil, put that in the units table instead." (math-defsimplify calcFunc-tan (and math-simplifying-units - (math-units-in-expr-p (nth 1 math-simplify-expr) nil) + (math-units-in-expr-p (nth 1 expr) nil) (let ((rad (math-simplify-units (math-evaluate-expr - (math-to-standard-units (nth 1 math-simplify-expr) nil)))) + (math-to-standard-units (nth 1 expr) nil)))) (calc-angle-mode 'rad)) (and (eq (car-safe rad) '*) (math-realp (nth 1 rad)) @@ -1492,10 +1492,10 @@ If COMP or STD is non-nil, put that in the units table instead." (math-defsimplify calcFunc-sec (and math-simplifying-units - (math-units-in-expr-p (nth 1 math-simplify-expr) nil) + (math-units-in-expr-p (nth 1 expr) nil) (let ((rad (math-simplify-units (math-evaluate-expr - (math-to-standard-units (nth 1 math-simplify-expr) nil)))) + (math-to-standard-units (nth 1 expr) nil)))) (calc-angle-mode 'rad)) (and (eq (car-safe rad) '*) (math-realp (nth 1 rad)) @@ -1505,10 +1505,10 @@ If COMP or STD is non-nil, put that in the units table instead." (math-defsimplify calcFunc-csc (and math-simplifying-units - (math-units-in-expr-p (nth 1 math-simplify-expr) nil) + (math-units-in-expr-p (nth 1 expr) nil) (let ((rad (math-simplify-units (math-evaluate-expr - (math-to-standard-units (nth 1 math-simplify-expr) nil)))) + (math-to-standard-units (nth 1 expr) nil)))) (calc-angle-mode 'rad)) (and (eq (car-safe rad) '*) (math-realp (nth 1 rad)) @@ -1518,10 +1518,10 @@ If COMP or STD is non-nil, put that in the units table instead." (math-defsimplify calcFunc-cot (and math-simplifying-units - (math-units-in-expr-p (nth 1 math-simplify-expr) nil) + (math-units-in-expr-p (nth 1 expr) nil) (let ((rad (math-simplify-units (math-evaluate-expr - (math-to-standard-units (nth 1 math-simplify-expr) nil)))) + (math-to-standard-units (nth 1 expr) nil)))) (calc-angle-mode 'rad)) (and (eq (car-safe rad) '*) (math-realp (nth 1 rad)) @@ -1536,13 +1536,13 @@ If COMP or STD is non-nil, put that in the units table instead." (if (Math-primp expr) expr (cons (car expr) - (mapcar 'math-remove-units (cdr expr)))))) + (mapcar #'math-remove-units (cdr expr)))))) (defun math-extract-units (expr) (cond ((memq (car-safe expr) '(* /)) (cons (car expr) - (mapcar 'math-extract-units (cdr expr)))) + (mapcar #'math-extract-units (cdr expr)))) ((eq (car-safe expr) 'neg) (math-extract-units (nth 1 expr))) ((eq (car-safe expr) '^) @@ -1669,7 +1669,7 @@ In symbolic mode, return the list (^ a b)." (defun math-extract-logunits (expr) (if (memq (car-safe expr) '(* /)) (cons (car expr) - (mapcar 'math-extract-logunits (cdr expr))) + (mapcar #'math-extract-logunits (cdr expr))) (if (memq (car-safe expr) '(^)) (list '^ (math-extract-logunits (nth 1 expr)) (nth 2 expr)) (if (member expr math-logunits) expr 1)))) commit 5007c23a6d1f05d3270e7247b263f8bc73a211fd Author: Robert Pluim Date: Tue Nov 20 10:48:16 2018 +0100 Remove space from end of coding cookie * lisp/bookmark.el (bookmark-insert-file-format-version-stamp): Remove unnecessary space from end of coding cookie. diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 15a841e208..1f06d672e9 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -735,7 +735,7 @@ CODING is the symbol of the coding-system in which the file is encoded." (if (memq (coding-system-base coding) '(undecided prefer-utf-8)) (setq coding 'utf-8-emacs)) (insert - (format ";;;; Emacs Bookmark Format Version %d ;;;; -*- coding: %S -*- \n" + (format ";;;; Emacs Bookmark Format Version %d ;;;; -*- coding: %S -*-\n" bookmark-file-format-version (coding-system-base coding))) (insert ";;; This format is meant to be slightly human-readable;\n" ";;; nevertheless, you probably don't want to edit it.\n" commit d667318a7f89a9daeffca6fb47503889bd23f3bd Author: Stephen Berman Date: Mon Nov 19 23:12:52 2018 +0100 Fix two Edebug defcustoms (bug#33428) * lisp/emacs-lisp/edebug.el (edebug-print-length) (edebug-print-level): Fix customization type to allow setting the documented valid value nil via the Customize interface. diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 7e4d244f5e..939b3b82ea 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -191,11 +191,11 @@ Use this with caution since it is not debugged." (defcustom edebug-print-length 50 "If non-nil, default value of `print-length' for printing results in Edebug." - :type 'integer + :type '(choice integer (const nil)) :group 'edebug) (defcustom edebug-print-level 50 "If non-nil, default value of `print-level' for printing results in Edebug." - :type 'integer + :type '(choice integer (const nil)) :group 'edebug) (defcustom edebug-print-circle t "If non-nil, default value of `print-circle' for printing results in Edebug." commit b8b42c23151298565e4354b38d7060e91465daed Author: Michael Albinus Date: Wed Oct 24 20:56:40 2018 +0200 Fix Bug#33141 * lisp/net/tramp.el (tramp-make-tramp-file-name): Avoid check for empty method with simplified `tramp-syntax'. (Bug#33141) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index e9f5f7d434..5fa9f9a44d 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1374,7 +1374,9 @@ default values are used." (method user domain host port localname &optional hop) "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME. When not nil, optional DOMAIN, PORT and HOP are used." - (when (zerop (length method)) + ;; Unless `tramp-syntax' is `simplified', we need a method. + (when (and (not (zerop (length tramp-postfix-method-format))) + (zerop (length method))) (signal 'wrong-type-argument (list 'stringp method))) (concat tramp-prefix-format hop (unless (zerop (length tramp-postfix-method-format)) commit 008bc1cbc85ac8c95fd0cbd1b41a98f877dae838 Author: Eli Zaretskii Date: Mon Nov 19 21:51:51 2018 +0200 Fix last change * lib-src/emacsclient.c (start_daemon_and_retry_set_socket) [!WINDOWSNT]: Condition usage of socket_name on NO_SOCKETS_IN_FILE_SYSTEM being undefined. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 187d2d7b5b..66ada43908 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -1535,6 +1535,7 @@ start_daemon_and_retry_set_socket (void) d_argv[0] = emacs; d_argv[1] = daemon_option; d_argv[2] = 0; +#ifndef NO_SOCKETS_IN_FILE_SYSTEM if (socket_name != NULL) { /* Pass --daemon=socket_name as argument. */ @@ -1544,6 +1545,7 @@ start_daemon_and_retry_set_socket (void) strcpy (stpcpy (daemon_arg, deq), socket_name); d_argv[1] = daemon_arg; } +#endif execvp ("emacs", d_argv); message (true, "%s: error starting emacs daemon\n", progname); } commit 57d5c14d2a390ca9a0a4d9fa934446150ecd16fc Author: Eli Zaretskii Date: Mon Nov 19 21:47:40 2018 +0200 Avoid compiler warning in emacsclient.c * lib-src/emacsclient.c (socket_name): Define only if NO_SOCKETS_IN_FILE_SYSTEM is not defined, to avoid a compiler warning. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 808755ef60..187d2d7b5b 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -132,8 +132,10 @@ static bool tty; is not running. --alternate-editor. */ static char *alternate_editor; +#ifndef NO_SOCKETS_IN_FILE_SYSTEM /* If non-NULL, the filename of the UNIX socket. */ static char const *socket_name; +#endif /* If non-NULL, the filename of the authentication file. */ static char const *server_file; commit 0e3b24586202fc60e7d8a9bff4640e76e6d54e9c Author: Paul Eggert Date: Mon Nov 19 11:36:50 2018 -0800 emacsclient.c: file name component fixes * lib-src/emacsclient.c: Include . (file_name_absolute_p): Remove, as a code duplicate. All uses replaced by IS_ABSOLUTE_FILE_NAME. (set_local_socket): Don’t treat \ as a file name separator on GNU and POSIX hosts. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 5c4e71a492..808755ef60 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -81,6 +81,7 @@ char *w32_getenv (const char *); #include #include +#include #include #include @@ -888,31 +889,6 @@ unquote_argument (char *str) } -static bool -file_name_absolute_p (const char *filename) -{ - /* Sanity check, it shouldn't happen. */ - if (! filename) return false; - - /* /xxx is always an absolute path. */ - if (filename[0] == '/') return true; - - /* Empty filenames (which shouldn't happen) are relative. */ - if (filename[0] == '\0') return false; - -# ifdef WINDOWSNT - /* X:\xxx is always absolute. */ - if (isalpha ((unsigned char) filename[0]) - && filename[1] == ':' && (filename[2] == '\\' || filename[2] == '/')) - return true; - - /* Both \xxx and \\xxx\yyy are absolute. */ - if (filename[0] == '\\') return true; -# endif - - return false; -} - # ifdef WINDOWSNT /* Wrapper to make WSACleanup a cdecl, as required by atexit. */ void __cdecl close_winsock (void); @@ -951,7 +927,7 @@ get_server_config (const char *config_file, struct sockaddr_in *server, char *port; FILE *config = NULL; - if (file_name_absolute_p (config_file)) + if (IS_ABSOLUTE_FILE_NAME (config_file)) config = fopen (config_file, "rb"); else { @@ -1241,7 +1217,8 @@ set_local_socket (const char *local_socket_name) char *tmpdir_storage = NULL; char *socket_name_storage = NULL; - if (!strchr (local_socket_name, '/') && !strchr (local_socket_name, '\\')) + if (! (strchr (local_socket_name, '/') + || (ISSLASH ('\\') && strchr (local_socket_name, '\\')))) { /* socket_name is a file name component. */ long uid = geteuid (); @@ -1809,7 +1786,7 @@ main (int argc, char **argv) } } # ifdef WINDOWSNT - else if (! file_name_absolute_p (argv[i]) + else if (! IS_ABSOLUTE_FILE_NAME (argv[i]) && (isalpha (argv[i][0]) && argv[i][1] == ':')) /* Windows can have a different default directory for each drive, so the cwd passed via "-dir" is not sufficient @@ -1830,7 +1807,7 @@ main (int argc, char **argv) # endif send_to_emacs (emacs_socket, "-file "); - if (tramp_prefix && file_name_absolute_p (argv[i])) + if (tramp_prefix && IS_ABSOLUTE_FILE_NAME (argv[i])) quote_argument (emacs_socket, tramp_prefix); quote_argument (emacs_socket, argv[i]); send_to_emacs (emacs_socket, " "); commit 736f1b364f8d57f7f0ea358d9c024ca628a0dbec Author: Paul Eggert Date: Mon Nov 19 11:24:19 2018 -0800 emacsclient.c: reindent to fit in 80 * lib-src/emacsclient.c: Reindent slightly. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 153f65fc91..5c4e71a492 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -293,7 +293,8 @@ w32_get_resource (HKEY predefined, const char *key, LPDWORD type) char *result = NULL; DWORD cbData; - if (RegOpenKeyEx (predefined, REG_ROOT, 0, KEY_READ, &hrootkey) == ERROR_SUCCESS) + if (RegOpenKeyEx (predefined, REG_ROOT, 0, KEY_READ, &hrootkey) + == ERROR_SUCCESS) { if (RegQueryValueEx (hrootkey, key, NULL, NULL, NULL, &cbData) == ERROR_SUCCESS) @@ -695,7 +696,8 @@ fail (void) { /* Allocate new token. */ ++toks; - new_argv = xrealloc (new_argv, new_argv_size + toks * sizeof (char *)); + new_argv = xrealloc (new_argv, + new_argv_size + toks * sizeof (char *)); /* Skip leading delimiters, and set separator, skipping any opening quote. */ @@ -731,8 +733,8 @@ main (int argc, char **argv) main_argc = argc; main_argv = argv; progname = argv[0]; - message (true, "%s: Sorry, the Emacs server is supported only\n" - "on systems with Berkeley sockets.\n", + message (true, ("%s: Sorry, the Emacs server is supported only\n" + "on systems with Berkeley sockets.\n"), argv[0]); fail (); } @@ -1339,9 +1341,10 @@ set_local_socket (const char *local_socket_name) /* `stat' failed */ if (saved_errno == ENOENT) message (true, - "%s: can't find socket; have you started the server?\n\ -To start the server in Emacs, type \"M-x server-start\".\n", - progname); + ("%s: can't find socket; have you started the server?\n" + "%s: To start the server in Emacs," + " type \"M-x server-start\".\n"), + progname, progname); else message (true, "%s: can't stat %s: %s\n", progname, server.sun_path, strerror (saved_errno)); @@ -1530,10 +1533,13 @@ start_daemon_and_retry_set_socket (void) } /* Try connecting, the daemon should have started by now. */ - message (true, "Emacs daemon should have started, trying to connect again\n"); + message (true, + "Emacs daemon should have started, trying to connect again\n"); + if ((emacs_socket = set_socket (1)) == INVALID_SOCKET) { - message (true, "Error: Cannot connect even after starting the Emacs daemon\n"); + message (true, ("Error: Cannot connect " + "even after starting the Emacs daemon\n")); exit (EXIT_FAILURE); } } @@ -1661,8 +1667,8 @@ main (int argc, char **argv) if (! (optind < argc || eval || create_frame)) { - message (true, "%s: file name or argument required\n" - "Try '%s --help' for more information\n", + message (true, ("%s: file name or argument required\n" + "Try '%s --help' for more information\n"), progname, progname); exit (EXIT_FAILURE); } commit b944e88663c0c3086976188e1b3da6fc7f21261e Author: Paul Eggert Date: Mon Nov 19 11:07:08 2018 -0800 emacsclient.c: use C99 better * lib-src/emacsclient.c (get_current_dir_name) (send_to_emacs, set_tcp_socket, set_local_socket, main): Take advantage of C99 stmt before decl. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 7e7b2a3b0c..153f65fc91 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -228,12 +228,12 @@ char * get_current_dir_name (void) { char *buf; - const char *pwd; struct stat dotstat, pwdstat; /* If PWD is accurate, use it instead of calling getcwd. PWD is sometimes a nicer name, and using it may avoid a fatal error if a parent directory is searchable but not readable. */ - if ((pwd = egetenv ("PWD")) != 0 + char const *pwd = egetenv ("PWD"); + if (pwd && (IS_DIRECTORY_SEP (*pwd) || (*pwd && IS_DEVICE_SEP (pwd[1]))) && stat (pwd, &pwdstat) == 0 && stat (".", &dotstat) == 0 @@ -782,21 +782,15 @@ send_to_emacs (HSOCKET s, const char *data) /* Fill pointer for the send buffer. */ static int sblen; - size_t dlen; - - if (!data) - return; - - dlen = strlen (data); - while (*data) + for (ptrdiff_t dlen = strlen (data); dlen != 0; ) { - size_t part = min (dlen, SEND_BUFFER_SIZE - sblen); + int part = min (dlen, SEND_BUFFER_SIZE - sblen); memcpy (&send_buffer[sblen], data, part); data += part; sblen += part; if (sblen == SEND_BUFFER_SIZE - || (sblen > 0 && send_buffer[sblen-1] == '\n')) + || (0 < sblen && send_buffer[sblen - 1] == '\n')) { int sent = send (s, send_buffer, sblen, 0); if (sent < 0) @@ -1015,7 +1009,6 @@ get_server_config (const char *config_file, struct sockaddr_in *server, static HSOCKET set_tcp_socket (const char *local_server_file) { - HSOCKET s; struct sockaddr_in server; struct linger l_arg = {1, 1}; char auth_string[AUTH_KEY_LENGTH + 1]; @@ -1028,7 +1021,8 @@ set_tcp_socket (const char *local_server_file) progname, inet_ntoa (server.sin_addr)); /* Open up an AF_INET socket. */ - if ((s = socket (AF_INET, SOCK_STREAM, IPPROTO_TCP)) < 0) + HSOCKET s = socket (AF_INET, SOCK_STREAM, IPPROTO_TCP); + if (s < 0) { /* Since we have an alternate to try out, this is not an error yet; popping out a modal dialog at this stage would make -a @@ -1225,11 +1219,11 @@ init_signals (void) static HSOCKET set_local_socket (const char *local_socket_name) { - HSOCKET s; struct sockaddr_un server; /* Open up an AF_UNIX socket in this person's home directory. */ - if ((s = socket (AF_UNIX, SOCK_STREAM, 0)) < 0) + HSOCKET s = socket (AF_UNIX, SOCK_STREAM, 0); + if (s < 0) { message (true, "%s: socket: %s\n", progname, strerror (errno)); return INVALID_SOCKET; @@ -1712,11 +1706,10 @@ main (int argc, char **argv) /* Send over our environment and current directory. */ if (create_frame) { - int i; - for (i = 0; environ[i]; i++) + for (char *const *e = environ; *e; e++) { send_to_emacs (emacs_socket, "-env "); - quote_argument (emacs_socket, environ[i]); + quote_argument (emacs_socket, *e); send_to_emacs (emacs_socket, " "); } } @@ -1781,8 +1774,7 @@ main (int argc, char **argv) if (optind < argc) { - int i; - for (i = optind; i < argc; i++) + for (int i = optind; i < argc; i++) { if (eval) @@ -1794,11 +1786,15 @@ main (int argc, char **argv) continue; } - if (*argv[i] == '+') + char *p = argv[i]; + if (*p == '+') { - char *p = argv[i] + 1; - while (isdigit ((unsigned char) *p) || *p == ':') p++; - if (*p == 0) + unsigned char c; + do + c = *++p; + while (isdigit (c) || c == ':'); + + if (c == 0) { send_to_emacs (emacs_socket, "-position "); quote_argument (emacs_socket, argv[i]); @@ -1860,7 +1856,6 @@ main (int argc, char **argv) /* Now, wait for an answer and print any messages. */ while (exit_status == EXIT_SUCCESS) { - char *p, *end_p; do { errno = 0; @@ -1876,7 +1871,8 @@ main (int argc, char **argv) string[rl] = '\0'; /* Loop over all NL-terminated messages. */ - for (end_p = p = string; end_p != NULL && *end_p != '\0'; p = end_p) + char *p = string; + for (char *end_p = p; end_p && *end_p != '\0'; p = end_p) { end_p = strchr (p, '\n'); if (end_p != NULL) commit 95ea5c257cde5e692ff3adc2b1f75c9f583b91a6 Author: Paul Eggert Date: Mon Nov 19 10:05:11 2018 -0800 emacsclient.c: use STDOUT_FILENO * lib-src/emacsclient.c (find_tty, handle_sigcont, main): Use STDOUT_FILENO instead of fileno (stdout) or magic 1. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index c0721c049d..7e7b2a3b0c 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -1079,7 +1079,7 @@ static bool find_tty (const char **tty_type, const char **tty_name, bool noabort) { const char *type = egetenv ("TERM"); - const char *name = ttyname (fileno (stdout)); + const char *name = ttyname (STDOUT_FILENO); if (!name) { @@ -1162,7 +1162,7 @@ handle_sigcont (int signalnum) { int old_errno = errno; pid_t pgrp = getpgrp (); - pid_t tcpgrp = tcgetpgrp (1); + pid_t tcpgrp = tcgetpgrp (STDOUT_FILENO); if (tcpgrp == pgrp) { @@ -1677,7 +1677,7 @@ main (int argc, char **argv) if (tty) { pid_t pgrp = getpgrp (); - pid_t tcpgrp = tcgetpgrp (1); + pid_t tcpgrp = tcgetpgrp (STDOUT_FILENO); if (0 <= tcpgrp && tcpgrp != pgrp) kill (-pgrp, SIGTTIN); } @@ -1854,7 +1854,7 @@ main (int argc, char **argv) skiplf = false; } fflush (stdout); - while (fdatasync (1) != 0 && errno == EINTR) + while (fdatasync (STDOUT_FILENO) != 0 && errno == EINTR) continue; /* Now, wait for an answer and print any messages. */ @@ -1961,7 +1961,7 @@ main (int argc, char **argv) if (!skiplf) printf ("\n"); fflush (stdout); - while (fdatasync (1) != 0 && errno == EINTR) + while (fdatasync (STDOUT_FILENO) != 0 && errno == EINTR) continue; if (rl < 0) commit 51f9c5a6d16bcba6182cb9bbb9b09330cd6d0a86 Author: Paul Eggert Date: Mon Nov 19 09:51:57 2018 -0800 emacsclient.c: use bool for boolean * lib-src/emacsclient.c (nowait, quiet, suppress_output, eval, tty) (decode_options, file_name_absolute_p, get_server_config) (strprefix, find_tty, set_socket, main): Use bool for boolean. (create_frame): New static var, replacing the old current_frame and with inverted sense, as this is clearer. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index f2771445d8..c0721c049d 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -101,19 +101,19 @@ static int main_argc; static char *const *main_argv; /* True means don't wait for a response from Emacs. --no-wait. */ -static int nowait; +static bool nowait; /* True means don't print messages for successful operations. --quiet. */ -static int quiet; +static bool quiet; /* True means don't print values returned from emacs. --suppress-output. */ -static int suppress_output; +static bool suppress_output; /* True means args are expressions to be evaluated. --eval. */ -static int eval; +static bool eval; -/* Nonzero means don't open a new frame. Inverse of --create-frame. */ -static int current_frame = 1; +/* True means open a new frame. --create-frame etc. */ +static bool create_frame; /* The display on which Emacs should work. --display. */ static char const *display; @@ -125,7 +125,7 @@ static char const *alt_display; static char *parent_id; /* True means open a new Emacs frame on the current terminal. */ -static int tty; +static bool tty; /* If non-NULL, the name of an editor to fallback to if the server is not running. --alternate-editor. */ @@ -478,7 +478,7 @@ decode_options (int argc, char **argv) alternate_editor = egetenv ("ALTERNATE_EDITOR"); tramp_prefix = egetenv ("EMACSCLIENT_TRAMP"); - while (1) + while (true) { int opt = getopt_long_only (argc, argv, #ifndef NO_SOCKETS_IN_FILE_SYSTEM @@ -521,19 +521,19 @@ decode_options (int argc, char **argv) break; case 'n': - nowait = 1; + nowait = true; break; case 'e': - eval = 1; + eval = true; break; case 'q': - quiet = 1; + quiet = true; break; case 'u': - suppress_output = 1; + suppress_output = true; break; case 'V': @@ -542,17 +542,17 @@ decode_options (int argc, char **argv) break; case 't': - tty = 1; - current_frame = 0; + tty = true; + create_frame = true; break; case 'c': - current_frame = 0; + create_frame = true; break; case 'p': parent_id = optarg; - current_frame = 0; + create_frame = true; break; case 'H': @@ -585,7 +585,7 @@ decode_options (int argc, char **argv) reflected in the DISPLAY variable. If the user didn't give us an explicit display, try this platform-specific after trying the display in DISPLAY (if any). */ - if (!current_frame && !tty && !display) + if (create_frame && !tty && !display) { /* Set these here so we use a default_display only when the user didn't give us an explicit display. */ @@ -605,24 +605,24 @@ decode_options (int argc, char **argv) } /* A null-string display is invalid. */ - if (display && strlen (display) == 0) + if (display && !display[0]) display = NULL; /* If no display is available, new frames are tty frames. */ - if (!current_frame && !display) - tty = 1; + if (create_frame && !display) + tty = true; #ifdef WINDOWSNT /* Emacs on Windows does not support graphical and text terminal frames in the same instance. So, treat the -t and -c options as equivalent, and open a new frame on the server's terminal. - Ideally, we would only set tty = 1 when the serve is running in a + Ideally, we would set tty = true only if the server is running in a console, but alas we don't know that. As a workaround, always ask for a tty frame, and let server.el figure it out. */ - if (!current_frame) + if (create_frame) { display = NULL; - tty = 1; + tty = true; } #endif /* WINDOWSNT */ } @@ -892,7 +892,7 @@ unquote_argument (char *str) } -static int +static bool file_name_absolute_p (const char *filename) { /* Sanity check, it shouldn't happen. */ @@ -947,7 +947,7 @@ initialize_sockets (void) /* Read the information needed to set up a TCP comm channel with the Emacs server: host, port, and authentication string. */ -static int +static bool get_server_config (const char *config_file, struct sockaddr_in *server, char *authentication) { @@ -1064,19 +1064,19 @@ set_tcp_socket (const char *local_server_file) } -/* Returns 1 if PREFIX is a prefix of STRING. */ -static int +/* Return true if PREFIX is a prefix of STRING. */ +static bool strprefix (const char *prefix, const char *string) { return !strncmp (prefix, string, strlen (prefix)); } -/* Get tty name and type. If successful, return the type in TTY_TYPE - and the name in TTY_NAME, and return 1. Otherwise, fail if NOABORT - is zero, or return 0 if NOABORT is non-zero. */ +/* Get tty name and type. If successful, store the type into + *TTY_TYPE and the name into *TTY_NAME, and return true. + Otherwise, fail if NOABORT is zero, or return false if NOABORT. */ -static int -find_tty (const char **tty_type, const char **tty_name, int noabort) +static bool +find_tty (const char **tty_type, const char **tty_name, bool noabort) { const char *type = egetenv ("TERM"); const char *name = ttyname (fileno (stdout)); @@ -1084,24 +1084,18 @@ find_tty (const char **tty_type, const char **tty_name, int noabort) if (!name) { if (noabort) - return 0; - else - { - message (true, "%s: could not get terminal name\n", progname); - fail (); - } + return false; + message (true, "%s: could not get terminal name\n", progname); + fail (); } if (!type) { if (noabort) - return 0; - else - { - message (true, "%s: please set the TERM variable to your terminal type\n", - progname); - fail (); - } + return false; + message (true, "%s: please set the TERM variable to your terminal type\n", + progname); + fail (); } const char *inside_emacs = egetenv ("INSIDE_EMACS"); @@ -1109,19 +1103,17 @@ find_tty (const char **tty_type, const char **tty_name, int noabort) && strprefix ("eterm", type)) { if (noabort) - return 0; - else - { - /* This causes nasty, MULTI_KBOARD-related input lockouts. */ - message (true, "%s: opening a frame in an Emacs term buffer" - " is not supported\n", progname); - fail (); - } + return false; + /* This causes nasty, MULTI_KBOARD-related input lockouts. */ + message (true, ("%s: opening a frame in an Emacs term buffer" + " is not supported\n"), + progname); + fail (); } *tty_name = name; *tty_type = type; - return 1; + return true; } @@ -1375,7 +1367,7 @@ To start the server in Emacs, type \"M-x server-start\".\n", # endif /* ! NO_SOCKETS_IN_FILE_SYSTEM */ static HSOCKET -set_socket (int no_exit_if_error) +set_socket (bool no_exit_if_error) { HSOCKET s; const char *local_server_file = server_file; @@ -1390,7 +1382,7 @@ set_socket (int no_exit_if_error) if (socket_name) { s = set_local_socket (socket_name); - if ((s != INVALID_SOCKET) || no_exit_if_error) + if (s != INVALID_SOCKET || no_exit_if_error) return s; message (true, "%s: error accessing socket \"%s\"\n", progname, socket_name); @@ -1405,7 +1397,7 @@ set_socket (int no_exit_if_error) if (local_server_file) { s = set_tcp_socket (local_server_file); - if ((s != INVALID_SOCKET) || no_exit_if_error) + if (s != INVALID_SOCKET || no_exit_if_error) return s; message (true, "%s: error accessing server file \"%s\"\n", @@ -1422,7 +1414,7 @@ set_socket (int no_exit_if_error) /* Implicit server file. */ s = set_tcp_socket ("server"); - if ((s != INVALID_SOCKET) || no_exit_if_error) + if (s != INVALID_SOCKET || no_exit_if_error) return s; /* No implicit or explicit socket, and no alternate editor. */ @@ -1535,10 +1527,9 @@ start_daemon_and_retry_set_socket (void) if (dpid > 0) { - pid_t w; - w = waitpid (dpid, &status, WUNTRACED | WCONTINUED); + pid_t w = waitpid (dpid, &status, WUNTRACED | WCONTINUED); - if ((w == -1) || !WIFEXITED (status) || WEXITSTATUS (status)) + if (w < 0 || !WIFEXITED (status) || WEXITSTATUS (status)) { message (true, "Error: Could not start the Emacs daemon\n"); exit (EXIT_FAILURE); @@ -1653,10 +1644,10 @@ start_daemon_and_retry_set_socket (void) int main (int argc, char **argv) { - int rl = 0, needlf = 0; + int rl = 0; + bool skiplf = true; char *cwd, *str; char string[BUFSIZ+1]; - int start_daemon_if_needed; int exit_status = EXIT_SUCCESS; main_argc = argc; @@ -1674,7 +1665,7 @@ main (int argc, char **argv) /* Process options. */ decode_options (argc, argv); - if ((argc - optind < 1) && !eval && current_frame) + if (! (optind < argc || eval || create_frame)) { message (true, "%s: file name or argument required\n" "Try '%s --help' for more information\n", @@ -1694,8 +1685,7 @@ main (int argc, char **argv) /* If alternate_editor is the empty string, start the emacs daemon in case of failure to connect. */ - start_daemon_if_needed = (alternate_editor - && (alternate_editor[0] == '\0')); + bool start_daemon_if_needed = alternate_editor && !alternate_editor[0]; emacs_socket = set_socket (alternate_editor || start_daemon_if_needed); if (emacs_socket == INVALID_SOCKET) @@ -1720,7 +1710,7 @@ main (int argc, char **argv) # endif /* HAVE_NTGUI */ /* Send over our environment and current directory. */ - if (!current_frame) + if (create_frame) { int i; for (i = 0; environ[i]; i++) @@ -1742,7 +1732,7 @@ main (int argc, char **argv) if (nowait) send_to_emacs (emacs_socket, "-nowait "); - if (current_frame) + if (!create_frame) send_to_emacs (emacs_socket, "-current-frame "); if (display) @@ -1759,7 +1749,7 @@ main (int argc, char **argv) send_to_emacs (emacs_socket, " "); } - if (frame_parameters && !current_frame) + if (frame_parameters && create_frame) { send_to_emacs (emacs_socket, "-frame-parameters "); quote_argument (emacs_socket, frame_parameters); @@ -1769,7 +1759,7 @@ main (int argc, char **argv) /* Unless we are certain we don't want to occupy the tty, send our tty information to Emacs. For example, in daemon mode Emacs may need to occupy this tty if no other frame is available. */ - if (!current_frame || !eval) + if (create_frame || !eval) { const char *tty_type, *tty_name; @@ -1786,10 +1776,10 @@ main (int argc, char **argv) } } - if (!current_frame && !tty) + if (create_frame && !tty) send_to_emacs (emacs_socket, "-window-system "); - if ((argc - optind > 0)) + if (optind < argc) { int i; for (i = optind; i < argc; i++) @@ -1861,7 +1851,7 @@ main (int argc, char **argv) if (!eval && !tty && !nowait && !quiet) { printf ("Waiting for Emacs..."); - needlf = 2; + skiplf = false; } fflush (stdout); while (fdatasync (1) != 0 && errno == EINTR) @@ -1909,8 +1899,8 @@ main (int argc, char **argv) } else { - nowait = 0; - tty = 1; + nowait = false; + tty = true; } goto retry; @@ -1921,10 +1911,9 @@ main (int argc, char **argv) if (!suppress_output) { str = unquote_argument (p + strlen ("-print ")); - if (needlf) - printf ("\n"); - printf ("%s", str); - needlf = str[0] == '\0' ? needlf : str[strlen (str) - 1] != '\n'; + printf (&"\n%s"[skiplf], str); + if (str[0]) + skiplf = str[strlen (str) - 1] == '\n'; } } else if (strprefix ("-print-nonl ", p)) @@ -1935,41 +1924,41 @@ main (int argc, char **argv) { str = unquote_argument (p + strlen ("-print-nonl ")); printf ("%s", str); - needlf = str[0] == '\0' ? needlf : str[strlen (str) - 1] != '\n'; + if (str[0]) + skiplf = str[strlen (str) - 1] == '\n'; } } else if (strprefix ("-error ", p)) { /* -error DESCRIPTION: Signal an error on the terminal. */ str = unquote_argument (p + strlen ("-error ")); - if (needlf) + if (!skiplf) printf ("\n"); fprintf (stderr, "*ERROR*: %s", str); - needlf = str[0] == '\0' ? needlf : str[strlen (str) - 1] != '\n'; + if (str[0]) + skiplf = str[strlen (str) - 1] == '\n'; exit_status = EXIT_FAILURE; } # ifdef SIGSTOP else if (strprefix ("-suspend ", p)) { /* -suspend: Suspend this terminal, i.e., stop the process. */ - if (needlf) + if (!skiplf) printf ("\n"); - needlf = 0; + skiplf = true; kill (0, SIGSTOP); } # endif else { /* Unknown command. */ - if (needlf) - printf ("\n"); - needlf = 0; - printf ("*ERROR*: Unknown message: %s\n", p); + printf (&"\n*ERROR*: Unknown message: %s\n"[skiplf], p); + skiplf = true; } } } - if (needlf) + if (!skiplf) printf ("\n"); fflush (stdout); while (fdatasync (1) != 0 && errno == EINTR) commit 9f47bb229dfc31716f58dd5587bf3b45cb855135 Author: Paul Eggert Date: Mon Nov 19 08:47:11 2018 -0800 emacsclient.c: make identifiers more local * lib-src/emacsclient.c (progname, main_argc, main_argv): (nowait, quiet, suppress_output, eval, current_frame, display): (alt_display, parent_id, tty, alternate_editor, socket_name): (server_file, tramp_prefix, emacs_pid, frame_parameters): (longopts, xstrdup, send_bufffer, sblen, emacs_socket): Now static. (SEND_BUFFER_SIZE, send_buffer, sblen): Now local to send_to_emacs. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 5110b4cc9f..f2771445d8 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -92,65 +92,65 @@ char *w32_getenv (const char *); #define EXTRA_SPACE 100 /* Name used to invoke this program. */ -const char *progname; +static char const *progname; /* The first argument to main. */ -int main_argc; +static int main_argc; /* The second argument to main. */ -char **main_argv; +static char *const *main_argv; -/* Nonzero means don't wait for a response from Emacs. --no-wait. */ -int nowait = 0; +/* True means don't wait for a response from Emacs. --no-wait. */ +static int nowait; -/* Nonzero means don't print messages for successful operations. --quiet. */ -int quiet = 0; +/* True means don't print messages for successful operations. --quiet. */ +static int quiet; -/* Nonzero means don't print values returned from emacs. --suppress-output. */ -int suppress_output = 0; +/* True means don't print values returned from emacs. --suppress-output. */ +static int suppress_output; -/* Nonzero means args are expressions to be evaluated. --eval. */ -int eval = 0; +/* True means args are expressions to be evaluated. --eval. */ +static int eval; /* Nonzero means don't open a new frame. Inverse of --create-frame. */ -int current_frame = 1; +static int current_frame = 1; /* The display on which Emacs should work. --display. */ -const char *display = NULL; +static char const *display; /* The alternate display we should try if Emacs does not support display. */ -const char *alt_display = NULL; +static char const *alt_display; /* The parent window ID, if we are opening a frame via XEmbed. */ -char *parent_id = NULL; +static char *parent_id; -/* Nonzero means open a new Emacs frame on the current terminal. */ -int tty = 0; +/* True means open a new Emacs frame on the current terminal. */ +static int tty; /* If non-NULL, the name of an editor to fallback to if the server is not running. --alternate-editor. */ -const char *alternate_editor = NULL; +static char *alternate_editor; /* If non-NULL, the filename of the UNIX socket. */ -const char *socket_name = NULL; +static char const *socket_name; /* If non-NULL, the filename of the authentication file. */ -const char *server_file = NULL; +static char const *server_file; /* If non-NULL, the tramp prefix emacs must use to find the files. */ -const char *tramp_prefix = NULL; +static char const *tramp_prefix; /* PID of the Emacs server process. */ -int emacs_pid = 0; +static int emacs_pid; /* If non-NULL, a string that should form a frame parameter alist to be used for the new frame. */ -const char *frame_parameters = NULL; +static char const *frame_parameters; static _Noreturn void print_help_and_exit (void); -struct option longopts[] = +static struct option const longopts[] = { { "no-wait", no_argument, NULL, 'n' }, { "quiet", no_argument, NULL, 'q' }, @@ -203,9 +203,8 @@ xrealloc (void *ptr, size_t size) } /* Like strdup but get a fatal error if memory is exhausted. */ -char *xstrdup (const char *) ATTRIBUTE_MALLOC; -char * +static char * ATTRIBUTE_MALLOC xstrdup (const char *s) { char *result = strdup (s); @@ -741,13 +740,9 @@ main (int argc, char **argv) #else /* HAVE_SOCKETS && HAVE_INET_SOCKETS */ enum { AUTH_KEY_LENGTH = 64 }; -enum { SEND_BUFFER_SIZE = 4096 }; -/* Buffer to accumulate data to send in TCP connections. */ -char send_buffer[SEND_BUFFER_SIZE + 1]; -int sblen = 0; /* Fill pointer for the send buffer. */ /* Socket used to communicate with the Emacs server process. */ -HSOCKET emacs_socket = 0; +static HSOCKET emacs_socket = 0; /* On Windows, the socket library was historically separate from the standard C library, so errors are handled differently. */ @@ -779,6 +774,14 @@ sock_err_message (const char *function_name) static void send_to_emacs (HSOCKET s, const char *data) { + enum { SEND_BUFFER_SIZE = 4096 }; + + /* Buffer to accumulate data to send in TCP connections. */ + static char send_buffer[SEND_BUFFER_SIZE + 1]; + + /* Fill pointer for the send buffer. */ + static int sblen; + size_t dlen; if (!data) commit 4a5034d84edfc34c1264388ef7cccbd90bdd7d9d Author: Paul Eggert Date: Mon Nov 19 08:32:26 2018 -0800 emacsclient.c: clean up preprocessing directives * lib-src/emacsclient.c [WINDOWSNT]: Omit duplicate stdlib.h include. Include min-max.h. (EXIT_SUCCESS, EXIT_FAILURE, min): Remove; no longer needed. (AUTH_KEY_LENGTH, SEND_BUFFER_SIZE): Now constants instead of macros. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 6fbc230095..5110b4cc9f 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -27,7 +27,6 @@ along with GNU Emacs. If not, see . */ # undef _WINSOCK_H # include -# include # include # include # include @@ -37,10 +36,10 @@ along with GNU Emacs. If not, see . */ # define HSOCKET SOCKET # define CLOSE_SOCKET closesocket -# define INITIALIZE() (initialize_sockets ()) +# define INITIALIZE() initialize_sockets () char *w32_getenv (const char *); -#define egetenv(VAR) w32_getenv(VAR) +# define egetenv(VAR) w32_getenv (VAR) #else /* !WINDOWSNT */ @@ -60,52 +59,37 @@ char *w32_getenv (const char *); # endif # include -# define INVALID_SOCKET -1 +# define INVALID_SOCKET (-1) # define HSOCKET int # define CLOSE_SOCKET close # define INITIALIZE() -#define egetenv(VAR) getenv(VAR) +# define egetenv(VAR) getenv (VAR) #endif /* !WINDOWSNT */ #undef signal -#include #include -#include -#include +#include #include -#include - #include -#include #include -#include +#include +#include +#include +#include +#include +#include #include #ifndef VERSION #define VERSION "unspecified" #endif - - -#ifndef EXIT_SUCCESS -#define EXIT_SUCCESS 0 -#endif - -#ifndef EXIT_FAILURE -#define EXIT_FAILURE 1 -#endif /* Additional space when allocating buffers for filenames, etc. */ #define EXTRA_SPACE 100 - -#ifdef min -#undef min -#endif -#define min(x, y) (((x) < (y)) ? (x) : (y)) - /* Name used to invoke this program. */ const char *progname; @@ -234,7 +218,7 @@ xstrdup (const char *s) } /* From sysdep.c */ -#if !defined (HAVE_GET_CURRENT_DIR_NAME) || defined (BROKEN_GET_CURRENT_DIR_NAME) +#if !defined HAVE_GET_CURRENT_DIR_NAME || defined BROKEN_GET_CURRENT_DIR_NAME char *get_current_dir_name (void); @@ -256,9 +240,9 @@ get_current_dir_name (void) && stat (".", &dotstat) == 0 && dotstat.st_ino == pwdstat.st_ino && dotstat.st_dev == pwdstat.st_dev -#ifdef MAXPATHLEN +# ifdef MAXPATHLEN && strlen (pwd) < MAXPATHLEN -#endif +# endif ) { buf = xmalloc (strlen (pwd) + 1); @@ -296,7 +280,7 @@ get_current_dir_name (void) #ifdef WINDOWSNT -#define REG_ROOT "SOFTWARE\\GNU\\Emacs" +# define REG_ROOT "SOFTWARE\\GNU\\Emacs" char *w32_get_resource (HKEY, const char *, LPDWORD); @@ -439,8 +423,8 @@ w32_execvp (const char *path, char **argv) return execvp (path, argv); } -#undef execvp -#define execvp w32_execvp +# undef execvp +# define execvp w32_execvp /* Emulation of ttyname for Windows. */ const char *ttyname (int); @@ -756,8 +740,8 @@ main (int argc, char **argv) #else /* HAVE_SOCKETS && HAVE_INET_SOCKETS */ -#define AUTH_KEY_LENGTH 64 -#define SEND_BUFFER_SIZE 4096 +enum { AUTH_KEY_LENGTH = 64 }; +enum { SEND_BUFFER_SIZE = 4096 }; /* Buffer to accumulate data to send in TCP connections. */ char send_buffer[SEND_BUFFER_SIZE + 1]; @@ -771,7 +755,7 @@ HSOCKET emacs_socket = 0; static void sock_err_message (const char *function_name) { -#ifdef WINDOWSNT +# ifdef WINDOWSNT char* msg = NULL; FormatMessage (FORMAT_MESSAGE_FROM_SYSTEM @@ -782,9 +766,9 @@ sock_err_message (const char *function_name) message (true, "%s: %s: %s\n", progname, function_name, msg); LocalFree (msg); -#else +# else message (true, "%s: %s: %s\n", progname, function_name, strerror (errno)); -#endif +# endif } @@ -917,7 +901,7 @@ file_name_absolute_p (const char *filename) /* Empty filenames (which shouldn't happen) are relative. */ if (filename[0] == '\0') return false; -#ifdef WINDOWSNT +# ifdef WINDOWSNT /* X:\xxx is always absolute. */ if (isalpha ((unsigned char) filename[0]) && filename[1] == ':' && (filename[2] == '\\' || filename[2] == '/')) @@ -925,12 +909,12 @@ file_name_absolute_p (const char *filename) /* Both \xxx and \\xxx\yyy are absolute. */ if (filename[0] == '\\') return true; -#endif +# endif return false; } -#ifdef WINDOWSNT +# ifdef WINDOWSNT /* Wrapper to make WSACleanup a cdecl, as required by atexit. */ void __cdecl close_winsock (void); void __cdecl @@ -954,7 +938,7 @@ initialize_sockets (void) atexit (close_winsock); } -#endif /* WINDOWSNT */ +# endif /* WINDOWSNT */ /* Read the information needed to set up a TCP comm channel with @@ -984,7 +968,7 @@ get_server_config (const char *config_file, struct sockaddr_in *server, config = fopen (path, "rb"); free (path); } -#ifdef WINDOWSNT +# ifdef WINDOWSNT if (!config && (home = egetenv ("APPDATA"))) { char *path = xmalloc (strlen (home) + strlen (config_file) @@ -995,7 +979,7 @@ get_server_config (const char *config_file, struct sockaddr_in *server, config = fopen (path, "rb"); free (path); } -#endif +# endif } if (! config) @@ -1047,9 +1031,9 @@ set_tcp_socket (const char *local_server_file) yet; popping out a modal dialog at this stage would make -a option totally useless for emacsclientw -- the user will still get an error message if the alternate editor fails. */ -#ifdef WINDOWSNT +# ifdef WINDOWSNT if(!(w32_window_app () && alternate_editor)) -#endif +# endif sock_err_message ("socket"); return INVALID_SOCKET; } @@ -1057,9 +1041,9 @@ set_tcp_socket (const char *local_server_file) /* Set up the socket. */ if (connect (s, (struct sockaddr *) &server, sizeof server) < 0) { -#ifdef WINDOWSNT +# ifdef WINDOWSNT if(!(w32_window_app () && alternate_editor)) -#endif +# endif sock_err_message ("connect"); return INVALID_SOCKET; } @@ -1138,7 +1122,7 @@ find_tty (const char **tty_type, const char **tty_name, int noabort) } -#if !defined (NO_SOCKETS_IN_FILE_SYSTEM) +# ifndef NO_SOCKETS_IN_FILE_SYSTEM /* Three possibilities: 2 - can't be `stat'ed (sets errno) @@ -1233,17 +1217,10 @@ handle_sigtstp (int signalnum) static void init_signals (void) { - /* Set up signal handlers. */ - signal (SIGWINCH, pass_signal_to_emacs); - /* Don't pass SIGINT and SIGQUIT to Emacs, because it has no way of deciding which terminal the signal came from. C-g is now a normal input event on secondary terminals. */ -#if 0 - signal (SIGINT, pass_signal_to_emacs); - signal (SIGQUIT, pass_signal_to_emacs); -#endif - + signal (SIGWINCH, pass_signal_to_emacs); signal (SIGCONT, handle_sigcont); signal (SIGTSTP, handle_sigtstp); signal (SIGTTOU, handle_sigtstp); @@ -1280,10 +1257,10 @@ set_local_socket (const char *local_socket_name) tmpdir = egetenv ("TMPDIR"); if (!tmpdir) { -#ifdef DARWIN_OS -#ifndef _CS_DARWIN_USER_TEMP_DIR -#define _CS_DARWIN_USER_TEMP_DIR 65537 -#endif +# ifdef DARWIN_OS +# ifndef _CS_DARWIN_USER_TEMP_DIR +# define _CS_DARWIN_USER_TEMP_DIR 65537 +# endif size_t n = confstr (_CS_DARWIN_USER_TEMP_DIR, NULL, (size_t) 0); if (n > 0) { @@ -1291,7 +1268,7 @@ set_local_socket (const char *local_socket_name) confstr (_CS_DARWIN_USER_TEMP_DIR, tmpdir_storage, n); } else -#endif +# endif tmpdir = "/tmp"; } socket_name_storage = @@ -1392,7 +1369,7 @@ To start the server in Emacs, type \"M-x server-start\".\n", return s; } -#endif /* ! NO_SOCKETS_IN_FILE_SYSTEM */ +# endif /* ! NO_SOCKETS_IN_FILE_SYSTEM */ static HSOCKET set_socket (int no_exit_if_error) @@ -1402,7 +1379,7 @@ set_socket (int no_exit_if_error) INITIALIZE (); -#ifndef NO_SOCKETS_IN_FILE_SYSTEM +# ifndef NO_SOCKETS_IN_FILE_SYSTEM /* Explicit --socket-name argument. */ if (!socket_name) socket_name = egetenv ("EMACS_SOCKET_NAME"); @@ -1416,7 +1393,7 @@ set_socket (int no_exit_if_error) progname, socket_name); exit (EXIT_FAILURE); } -#endif +# endif /* Explicit --server-file arg or EMACS_SERVER_FILE variable. */ if (!local_server_file) @@ -1433,12 +1410,12 @@ set_socket (int no_exit_if_error) exit (EXIT_FAILURE); } -#ifndef NO_SOCKETS_IN_FILE_SYSTEM +# ifndef NO_SOCKETS_IN_FILE_SYSTEM /* Implicit local socket. */ s = set_local_socket ("server"); if (s != INVALID_SOCKET) return s; -#endif +# endif /* Implicit server file. */ s = set_tcp_socket ("server"); @@ -1447,16 +1424,16 @@ set_socket (int no_exit_if_error) /* No implicit or explicit socket, and no alternate editor. */ message (true, "%s: No socket or alternate editor. Please use:\n\n" -#ifndef NO_SOCKETS_IN_FILE_SYSTEM +# ifndef NO_SOCKETS_IN_FILE_SYSTEM "\t--socket-name\n" -#endif +# endif "\t--server-file (or environment variable EMACS_SERVER_FILE)\n\ \t--alternate-editor (or environment variable ALTERNATE_EDITOR)\n", progname); exit (EXIT_FAILURE); } -#ifdef HAVE_NTGUI +# ifdef HAVE_NTGUI FARPROC set_fg; /* Pointer to AllowSetForegroundWindow. */ FARPROC get_wc; /* Pointer to RealGetWindowClassA. */ @@ -1540,14 +1517,14 @@ w32_give_focus (void) && (get_wc = GetProcAddress (user32, "RealGetWindowClassA"))) EnumWindows (w32_find_emacs_process, (LPARAM) 0); } -#endif /* HAVE_NTGUI */ +# endif /* HAVE_NTGUI */ /* Start the emacs daemon and try to connect to it. */ static void start_daemon_and_retry_set_socket (void) { -#ifndef WINDOWSNT +# ifndef WINDOWSNT pid_t dpid; int status; @@ -1597,7 +1574,7 @@ start_daemon_and_retry_set_socket (void) execvp ("emacs", d_argv); message (true, "%s: error starting emacs daemon\n", progname); } -#else /* WINDOWSNT */ +# else /* WINDOWSNT */ DWORD wait_result; HANDLE w32_daemon_event; STARTUPINFO si; @@ -1667,7 +1644,7 @@ start_daemon_and_retry_set_socket (void) "Error: Cannot connect even after starting the Emacs daemon\n"); exit (EXIT_FAILURE); } -#endif /* WINDOWSNT */ +# endif /* WINDOWSNT */ } int @@ -1734,10 +1711,10 @@ main (int argc, char **argv) fail (); } -#ifdef HAVE_NTGUI +# ifdef HAVE_NTGUI if (display && !strcmp (display, "w32")) w32_give_focus (); -#endif /* HAVE_NTGUI */ +# endif /* HAVE_NTGUI */ /* Send over our environment and current directory. */ if (!current_frame) @@ -1795,9 +1772,9 @@ main (int argc, char **argv) if (find_tty (&tty_type, &tty_name, !tty)) { -#if !defined (NO_SOCKETS_IN_FILE_SYSTEM) +# ifndef NO_SOCKETS_IN_FILE_SYSTEM init_signals (); -#endif +# endif send_to_emacs (emacs_socket, "-tty "); quote_argument (emacs_socket, tty_name); send_to_emacs (emacs_socket, " "); @@ -1836,7 +1813,7 @@ main (int argc, char **argv) continue; } } -#ifdef WINDOWSNT +# ifdef WINDOWSNT else if (! file_name_absolute_p (argv[i]) && (isalpha (argv[i][0]) && argv[i][1] == ':')) /* Windows can have a different default directory for each @@ -1855,7 +1832,7 @@ main (int argc, char **argv) else free (filename); } -#endif +# endif send_to_emacs (emacs_socket, "-file "); if (tramp_prefix && file_name_absolute_p (argv[i])) @@ -1968,7 +1945,7 @@ main (int argc, char **argv) needlf = str[0] == '\0' ? needlf : str[strlen (str) - 1] != '\n'; exit_status = EXIT_FAILURE; } -#ifdef SIGSTOP +# ifdef SIGSTOP else if (strprefix ("-suspend ", p)) { /* -suspend: Suspend this terminal, i.e., stop the process. */ @@ -1977,7 +1954,7 @@ main (int argc, char **argv) needlf = 0; kill (0, SIGSTOP); } -#endif +# endif else { /* Unknown command. */ commit 070e82b96bfadb5a3622607a8c5c97c127ec62db Author: Eli Zaretskii Date: Mon Nov 19 20:35:28 2018 +0200 ; * src/window.c (window_scroll): Improve commentary. diff --git a/src/window.c b/src/window.c index 9cde2c5ecc..5d99098cba 100644 --- a/src/window.c +++ b/src/window.c @@ -4977,8 +4977,8 @@ window_scroll (Lisp_Object window, EMACS_INT n, bool whole, bool noerror) if (whole && Vfast_but_imprecise_scrolling) specbind (Qfontification_functions, Qnil); - /* If we must, use the pixel-based version which is much slower than - the line-based one but can handle varying line heights. */ + /* On GUI frames, use the pixel-based version which is much slower + than the line-based one but can handle varying line heights. */ if (FRAME_WINDOW_P (XFRAME (XWINDOW (window)->frame))) window_scroll_pixel_based (window, n, whole, noerror); else commit 60457d7ae0cc560115d3e8c83bb308f015e7088d Author: Eli Zaretskii Date: Mon Nov 19 20:31:49 2018 +0200 Improve documentation of the window tree * doc/lispref/windows.texi (Windows and Frames): More accurate wording regarding the relation of a mini-window to its frame's window tree. * src/window.h (struct window): Improve commentary to some fields. diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 46f106838a..04689f1c5e 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -198,12 +198,13 @@ relationships between live windows. The root node of a window tree is called the @dfn{root window}. It can be either a live window (if the frame has just one window), or an internal window. - A minibuffer window (@pxref{Minibuffer Windows}) is not part of its -frame's window tree unless the frame is a minibuffer-only frame. -Nonetheless, most of the functions in this section accept the -minibuffer window as an argument. Also, the function -@code{window-tree} described at the end of this section lists the -minibuffer window alongside the actual window tree. + A minibuffer window (@pxref{Minibuffer Windows}) that is not alone +on its frame does not have a parent window, so it strictly speaking is +not part of its frame's window tree. Nonetheless, it is a sibling +window of the frame's root window, and thus can be reached via +@code{window-next-sibling}. Also, the function @code{window-tree} +described at the end of this section lists the minibuffer window +alongside the actual window tree. @defun frame-root-window &optional frame-or-window This function returns the root window for @var{frame-or-window}. The diff --git a/src/window.h b/src/window.h index 629283ac40..c7f525e270 100644 --- a/src/window.h +++ b/src/window.h @@ -93,12 +93,14 @@ struct window /* The frame this window is on. */ Lisp_Object frame; - /* Following (to right or down) and preceding (to left or up) child - at same level of tree. */ + /* Following (to right or down) and preceding (to left or up) + child at same level of tree. Whether this is left/right or + up/down is determined by the 'horizontal' flag, see below. + A minibuffer window has the frame's root window pointed by 'prev'. */ Lisp_Object next; Lisp_Object prev; - /* The window this one is a child of. */ + /* The window this one is a child of. For a minibuffer window: nil. */ Lisp_Object parent; /* The normal size of the window. These are fractions, but we do @@ -113,7 +115,9 @@ struct window Lisp_Object new_normal; Lisp_Object new_pixel; - /* May be buffer, window, or nil. */ + /* For a leaf window: a buffer; for an internal window: a window; + for a pseudo-window (such as menu bar or tool bar): nil. It is + a buffer for a minibuffer window as well. */ Lisp_Object contents; /* A marker pointing to where in the text to start displaying. commit ea1a0149825048da940365b79948e71cfc366385 Author: Eli Zaretskii Date: Mon Nov 19 20:12:04 2018 +0200 Fix window scrolling on TTY frames when there's no mode line * src/window.c (window_internal_height): Remove tests for next, prev, and parent pointers, as they are unrelated to whether a window has a mode line. (Bug#33363) diff --git a/src/window.c b/src/window.c index 9026a7b5f2..9cde2c5ecc 100644 --- a/src/window.c +++ b/src/window.c @@ -4934,25 +4934,21 @@ window_wants_header_line (struct window *w) : 0); } -/* Return number of lines of text (not counting mode lines) in W. */ +/* Return number of lines of text in window W, not counting the mode + line and header line, if any. Do NOT use this for windows on GUI + frames; use window_body_height instead. This function is only for + windows on TTY frames, where it is much more efficient. */ int window_internal_height (struct window *w) { int ht = w->total_lines; - if (!MINI_WINDOW_P (w)) - { - if (!NILP (w->parent) - || WINDOWP (w->contents) - || !NILP (w->next) - || !NILP (w->prev) - || window_wants_mode_line (w)) - --ht; + if (window_wants_mode_line (w)) + --ht; - if (window_wants_header_line (w)) - --ht; - } + if (window_wants_header_line (w)) + --ht; return ht; } commit df7ed10e4f15d3ea8b4426f7721bafe60bf8deeb Author: Eli Zaretskii Date: Mon Nov 19 18:36:42 2018 +0200 Fix decoding XML files encoded in ISO-8859 * lisp/international/mule.el (sgml-xml-auto-coding-function): Avoid signaling an error from coding-system-equal when the XML encoding tag specifies an encoding whose type is 'charset'. (Bug#33429) diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 1488810002..979845b723 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -2500,7 +2500,11 @@ This function is intended to be added to `auto-coding-functions'." (let ((sym-type (coding-system-type sym)) (bfcs-type (coding-system-type buffer-file-coding-system))) - (if (and (coding-system-equal 'utf-8 sym-type) + ;; 'charset' will signal an error in + ;; coding-system-equal, since it isn't a + ;; coding-system. So test that up front. + (if (and (not (equal sym-type 'charset)) + (coding-system-equal 'utf-8 sym-type) (coding-system-equal 'utf-8 bfcs-type)) buffer-file-coding-system sym)) commit d3b1d5d262aa9a32ecdf3b1e38539997df5d740d Author: Ulrich MĂĽller Date: Mon Nov 19 07:29:56 2018 -0800 Update the calc units table On 2018-11-16, the 26th meeting of the General Conference on Weights and Measures (CGPM) has redefined the International System of Units by adopting fixed values for the Planck constant, the elementary charge, the Boltzmann constant, and the Avogadro constant: https://www.bipm.org/utils/en/pdf/CGPM/Draft-Resolution-A-EN.pdf * lisp/calc/calc-units.el (math-standard-units): Update according to redefinition of the SI in 2018. diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index ab76ded818..17d16acee0 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el @@ -46,6 +46,9 @@ ;; CODATA values updated February 2016, using 2014 adjustment ;; http://arxiv.org/pdf/1507.07956.pdf +;; Updated November 2018 for the redefinition of the SI +;; https://www.bipm.org/utils/en/pdf/CGPM/Draft-Resolution-A-EN.pdf + (defvar math-standard-units '( ;; Length ( m nil "*Meter" ) @@ -118,7 +121,7 @@ ( mph "mi/hr" "*Miles per hour" ) ( kph "km/hr" "Kilometers per hour" ) ( knot "nmi/hr" "Knot" ) - ( c "299792458 m/s" "Speed of light" ) ;;; CODATA + ( c "299792458 m/s" "Speed of light" ) ;; SI definition ;; Acceleration ( ga "980665*10^(-5) m/s^2" "*\"g\" acceleration" nil @@ -207,8 +210,8 @@ ( C "A s" "Coulomb" ) ( Fdy "ech Nav" "Faraday" ) ( e "ech" "Elementary charge" ) - ( ech "1.6021766208*10^(-19) C" "Elementary charge" nil - "1.6021766208 10^-19 C (*)") ;;(approx) CODATA + ( ech "1.602176634*10^(-19) C" "Elementary charge" nil + "1.602176634 10^-19 C") ;; SI definition ( V "W/A" "Volt" ) ( ohm "V/A" "Ohm" ) ( Ω "ohm" "Ohm" ) @@ -256,18 +259,21 @@ ( sr nil "*Steradian" ) ;; Other physical quantities - ;; The values are from CODATA, and are approximate. - ( h "6.626070040*10^(-34) J s" "*Planck's constant" nil - "6.626070040 10^-34 J s (*)") + ;; Unless otherwise mentioned, the values are from CODATA, + ;; and are approximate. + ( h "6.62607015*10^(-34) J s" "*Planck's constant" nil + "6.62607015 10^-34 J s") ;; SI definition ( hbar "h / (2 pi)" "Planck's constant" ) ;; Exact - ( mu0 "4 pi 10^(-7) H/m" "Permeability of vacuum") ;; Exact - ( ÎĽ0 "mu0" "Permeability of vacuum") ;; Exact - ( eps0 "1 / (mu0 c^2)" "Permittivity of vacuum" ) + ;; After the 2018 SI redefinition, eps0 and mu0 are measured quantities, + ;; and mu0 no longer has the previous exact value of 4 pi 10^(-7) H/m. + ( eps0 "ech^2 / (2 alpha h c)" "Permittivity of vacuum" ) ( ε0 "eps0" "Permittivity of vacuum" ) + ( mu0 "1 / (eps0 c^2)" "Permeability of vacuum") ;; Exact + ( ÎĽ0 "mu0" "Permeability of vacuum") ;; Exact ( G "6.67408*10^(-11) m^3/(kg s^2)" "Gravitational constant" nil "6.67408 10^-11 m^3/(kg s^2) (*)") - ( Nav "6.022140857*10^(23) / mol" "Avogadro's constant" nil - "6.022140857 10^23 / mol (*)") + ( Nav "6.02214076*10^(23) / mol" "Avogadro's constant" nil + "6.02214076 10^23 / mol") ;; SI definition ( me "9.10938356*10^(-31) kg" "Electron rest mass" nil "9.10938356 10^-31 kg (*)") ( mp "1.672621898*10^(-27) kg" "Proton rest mass" nil @@ -280,12 +286,10 @@ "1.883531594 10^-28 kg (*)") ( Ryd "10973731.568508 /m" "Rydberg's constant" nil "10973731.568508 /m (*)") - ( k "1.38064852*10^(-23) J/K" "Boltzmann's constant" nil - "1.38064852 10^-23 J/K (*)") - ( sigma "5.670367*10^(-8) W/(m^2 K^4)" "Stefan-Boltzmann constant" nil - "5.670367 10^-8 W/(m^2 K^4) (*)") - ( Ď "sigma" "Stefan-Boltzmann constant" nil - "5.670367 10^-8 W/(m^2 K^4) (*)") + ( k "1.380649*10^(-23) J/K" "Boltzmann's constant" nil + "1.380649 10^-23 J/K") ;; SI definition + ( sigma "2 pi^5 k^4 / (15 h^3 c^2)" "Stefan-Boltzmann constant") + ( Ď "sigma" "Stefan-Boltzmann constant") ( alpha "7.2973525664*10^(-3)" "Fine structure constant" nil "7.2973525664 10^-3 (*)") ( α "alpha" "Fine structure constant" nil @@ -298,8 +302,7 @@ "-928.4764620 10^-26 J/T (*)") ( mup "1.4106067873*10^(-26) J/T" "Proton magnetic moment" nil "1.4106067873 10^-26 J/T (*)") - ( R0 "8.3144598 J/(mol K)" "Molar gas constant" nil - "8.3144598 J/(mol K) (*)") + ( R0 "Nav k" "Molar gas constant") ;; Exact ( V0 "22.710947*10^(-3) m^3/mol" "Standard volume of ideal gas" nil "22.710947 10^-3 m^3/mol (*)") ;; Logarithmic units commit 7851ae8b443c62a41ea4f4440512aa56cc87b9b7 (tag: refs/tags/emacs-26.1.90) Author: Nicolas Petton Date: Mon Nov 19 16:22:16 2018 +0100 ; ChangeLog.3 update diff --git a/ChangeLog.3 b/ChangeLog.3 index 6e1f68fe99..194fa685c9 100644 --- a/ChangeLog.3 +++ b/ChangeLog.3 @@ -1,3 +1,104 @@ +2018-11-18 Martin Rudalics + + Fix description of some window hooks + + * doc/lispref/windows.texi (Window Hooks): Remove text that + warns against using 'save-window-excursion' while running + 'window-size-change-functions', it's no more relevant. + Clarify description of 'window-configuration-change-hook'. + +2018-11-18 Gary Fredericks (tiny change) + + Run 'window--adjust-process-windows' when frame size changes (Bug#32720) + + * lisp/window.el (window-size-change-functions): Run + 'window--adjust-process-windows' from + 'window-size-change-functions' too (Bug#32720, "another issue" + in Bug#33230). + +2018-11-16 Eli Zaretskii + + Avoid errors in zone.el when there's overlay at EOB + + * lisp/play/zone.el (zone): Make sure the window-end position + is calculated accurately, to avoid errors from + buffer-substring. (Bug#33384) + +2018-11-16 Eli Zaretskii + + Document Emacs 26 behavior of Dired's 'Z' on directories + + * doc/emacs/dired.texi (Operating on Files): Document behavior + of 'Z' on directories. + + * etc/NEWS: Belatedly announce the new behavior of Dired's 'Z' + on directory names and on .tar.gz archives. + +2018-11-15 Eli Zaretskii + + Fix a typo in the Emacs manual + + * doc/emacs/rmail.texi (Rmail Deletion): Fix a typo. + Reported by Jorge P. de Morais Neto + in emacs-manual-bugs@gnu.org + +2018-11-15 Paul Eggert + + Fix tempfile creation when byte compiling + + This improves on the recent fix for master failing to build + on FreeBSD. Suggested by Stefan Monnier in: + https://lists.gnu.org/r/emacs-devel/2018-01/msg00600.html + * lisp/emacs-lisp/bytecomp.el (byte-compile-file): + Put tempfile next to the target file, as was the original intent. + + (cherry picked from commit 64c846738617d1d037eac0cefb6586c04317b0a1) + +2018-11-14 Markus Triska + + Small documentation correction. + + * doc/lispref/windows.texi (Textual Scrolling): In the description of + scroll-up-aggressively, refer to scroll-down-aggressively instead of + a recursive reference to scroll-up-aggressively. (Bug#33369) + +2018-11-14 Eli Zaretskii + + * src/coding.c (Fcheck_coding_systems_region): Doc fix. (Bug#33372) + +2018-11-14 Michael Albinus + + Fix Bug#33364 + + * lisp/net/tramp.el (tramp-parse-sconfig-group): Support also + "Host host1 host2 ..." syntax. (Bug#33364) + +2018-11-13 Michael Albinus + + * test/README: Explain $REMOTE_TEMPORARY_FILE_DIRECTORY. + +2018-11-12 Glenn Morris + + Avoid kill-emacs-hook errors hanging batch mode + + * src/emacs.c (Fkill_emacs): Prevent errors from kill-emacs-hook + hanging Emacs in batch mode. (Bug#29955) + + (cherry picked from commit 109da684c5124e22505917fe0255ca66f2a6bfc9) + +2018-11-12 Nicolas Petton + + Bump Emacs version to 26.1.90 + + * README: + * configure.ac: + * msdos/sed2v2.inp: + * nt/README.W32: Bump Emacs version to 26.1.90. + +2018-11-12 Nicolas Petton + + * etc/AUTHORS: Update. + 2018-11-12 Paul Eggert Work around dumping bug on GNU/Linux ppc64le @@ -63347,7 +63448,7 @@ This file records repository revisions from commit 9d56a21e6a696ad19ac65c4b405aeca44785884a (exclusive) to -commit 1d79c2ebd9bd9aa36586e57463502373c0296d11 (inclusive). +commit 72525076996cd709086b1afb47ab0d095322e9b7 (inclusive). See ChangeLog.1 for earlier changes. ;; Local Variables: commit 195880834db3cf3dad2a1e184cb3fdaccf2dea4d Author: Nicolas Petton Date: Mon Nov 19 16:21:41 2018 +0100 * etc/AUTHORS: Update. diff --git a/etc/AUTHORS b/etc/AUTHORS index 23c88d5590..07cdf0acfc 100644 --- a/etc/AUTHORS +++ b/etc/AUTHORS @@ -1658,6 +1658,8 @@ Gary Delp: wrote mailpost.el (public domain) Gary D. Foster: wrote crisp.el scroll-all.el and changed gnus-group.el gnus-topic.el +Gary Fredericks: changed window.el + Gary Howell: changed server.el Gary Oberbrunner: changed gud.el @@ -3124,7 +3126,7 @@ Markus Triska: wrote linum.el and changed bytecomp.el byte-opt.el doctor.el image-mode.el processes.texi calc-math.el emacs.c expand.el flymake.el flymake.texi flyspell.el handwrite.el internals.texi proced.el prolog.el ps-mode.el - speedbar.el subr.el tumme.el widget.texi xterm.c + speedbar.el subr.el tumme.el widget.texi windows.texi xterm.c Mark W. Eichin: changed keyboard.c xterm.c @@ -3584,8 +3586,8 @@ Nicolas Graner: changed message.el Nicolas Petton: wrote map-tests.el map.el seq-tests.el seq.el thunk-tests.el thunk.el and co-wrote auth-source-pass.el auth-source-tests.el subr-tests.el -and changed sequences.texi README configure.ac sed2v2.inp authors.el - emacs.png README.W32 emacs23.png arc-mode.el cl-extra.el emacs.svg +and changed README sequences.texi configure.ac sed2v2.inp authors.el + README.W32 emacs.png emacs23.png arc-mode.el cl-extra.el emacs.svg manoj-dark-theme.el Emacs.icns HISTORY Makefile.in auth-source.el emacs.ico fns.c make-tarball.txt obarray-tests.el obarray.el and 35 other files commit ca0f86e60aeceacef7b7ed9fc108a00db314b5d8 Author: Stefan Monnier Date: Mon Nov 19 09:12:15 2018 -0500 * mouse.el (mouse-posn-property): Add comment diff --git a/lisp/mouse.el b/lisp/mouse.el index ca61e36440..e25b664a93 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -1114,6 +1114,10 @@ its value is returned." (if (consp pos) (let ((w (posn-window pos)) (pt (posn-point pos)) (str (posn-string pos))) + ;; FIXME: When STR has a `category' property and there's another + ;; `category' property at PT, we should probably disregard the + ;; `category' property at PT while doing the (get-char-property + ;; pt property w)! (or (and str (get-text-property (cdr str) property (car str))) ;; Mouse clicks in the fringe come with a position in commit 450beba338ffbe4da05062536445727846510057 Author: Stefan Monnier Date: Sun Nov 18 21:15:06 2018 -0500 Remove uses of obsolete 'CUA' symbol property * lisp/emulation/cua-base.el (cua-scroll-up, cua-scroll-down): * lisp/progmodes/subword.el (subword-forward, subword-backward): * lisp/obsolete/crisp.el (crisp-home, crisp-end): Remove 'CUA' prop; not used any more. diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index f1143425eb..f9a3fb0fb4 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@ -39,7 +39,7 @@ ;; C-v -> paste ;; ;; The tricky part is the handling of the C-x and C-c keys which -;; are normally used as prefix keys for most of emacs' built-in +;; are normally used as prefix keys for most of Emacs' built-in ;; commands. With CUA they still do!!! ;; ;; Only when the region is currently active (and highlighted since @@ -69,7 +69,7 @@ ;; [C-space] to start the region and use unshifted movement keys to extend ;; it. To cancel the region, use [C-space] or [C-g]. -;; If you prefer to use the standard emacs cut, copy, paste, and undo +;; If you prefer to use the standard Emacs cut, copy, paste, and undo ;; bindings, customize cua-enable-cua-keys to nil. @@ -138,7 +138,7 @@ ;; cua-mode's superior rectangle support uses a true visual ;; representation of the selected rectangle, i.e. it highlights the ;; actual part of the buffer that is currently selected as part of the -;; rectangle. Unlike emacs' traditional rectangle commands, the +;; rectangle. Unlike Emacs' traditional rectangle commands, the ;; selected rectangle always as straight left and right edges, even ;; when those are in the middle of a TAB character or beyond the end ;; of the current line. And it does this without actually modifying @@ -1047,7 +1047,6 @@ If ARG is the atom `-', scroll downward by nearly full screen." (scroll-up arg) (end-of-buffer (goto-char (point-max))))))) -(put 'cua-scroll-up 'CUA 'move) (put 'cua-scroll-up 'isearch-scroll t) (defun cua-scroll-down (&optional arg) @@ -1068,7 +1067,6 @@ If ARG is the atom `-', scroll upward by nearly full screen." (scroll-down arg) (beginning-of-buffer (goto-char (point-min))))))) -(put 'cua-scroll-down 'CUA 'move) (put 'cua-scroll-down 'isearch-scroll t) ;;; Cursor indications diff --git a/lisp/obsolete/crisp.el b/lisp/obsolete/crisp.el index 4bd555a72e..944c6c0119 100644 --- a/lisp/obsolete/crisp.el +++ b/lisp/obsolete/crisp.el @@ -376,10 +376,6 @@ normal CRiSP binding) and when it is nil M-x will run ;;;###autoload (defalias 'brief-mode 'crisp-mode) -;; Interaction with other packages. -(put 'crisp-home 'CUA 'move) -(put 'crisp-end 'CUA 'move) - (run-hooks 'crisp-load-hook) (provide 'crisp) diff --git a/lisp/progmodes/subword.el b/lisp/progmodes/subword.el index 685e171dd6..d5346d3afd 100644 --- a/lisp/progmodes/subword.el +++ b/lisp/progmodes/subword.el @@ -145,8 +145,6 @@ Optional argument ARG is the same as for `forward-word'." (t (point)))) -(put 'subword-forward 'CUA 'move) - (defun subword-backward (&optional arg) "Do the same as `backward-word' but on subwords. See the command `subword-mode' for a description of subwords. @@ -187,8 +185,6 @@ Optional argument ARG is the same as for `mark-word'." (point)) nil t)))) -(put 'subword-backward 'CUA 'move) - (defun subword-kill (arg) "Do the same as `kill-word' but on subwords. See the command `subword-mode' for a description of subwords. commit 72525076996cd709086b1afb47ab0d095322e9b7 Author: Martin Rudalics Date: Sun Nov 18 09:24:10 2018 +0100 Fix description of some window hooks * doc/lispref/windows.texi (Window Hooks): Remove text that warns against using 'save-window-excursion' while running 'window-size-change-functions', it's no more relevant. Clarify description of 'window-configuration-change-hook'. diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index e9bd0c7d83..46f106838a 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -6016,26 +6016,24 @@ whether a specific window has changed size, compare the return values of @code{window-pixel-height} for that window (@pxref{Window Sizes}). These function are usually only called when at least one window was -added or has changed size since the last time this hook was run for the -associated frame. In some rare cases this hook also runs when a window -that was added intermittently has been deleted afterwards. In these -cases none of the windows on the frame will appear to have changed its -size. - -You may use @code{save-selected-window} in these functions -(@pxref{Selecting Windows}). However, do not use -@code{save-window-excursion} (@pxref{Window Configurations}); exiting -that macro counts as a size change, which would cause these functions to -be called again. +added or has changed size since the last time this hook was run for +the associated frame. In some rare cases this hook also runs when a +window that was added intermittently has been deleted afterwards. In +these cases none of the windows on the frame will appear to have +changed its size. @end defvar @defvar window-configuration-change-hook -A normal hook that is run every time the window configuration of a frame -changes. Window configuration changes include splitting and deleting -windows, and the display of a different buffer in a window. Resizing the -frame or individual windows do not count as configuration changes. Use -@code{window-size-change-functions}, see above, when you want to track -size changes that are not caused by the deletion or creation of windows. +A normal hook that is run every time the window configuration of a +frame changes. Window configuration changes include splitting and +deleting windows, and the display of a different buffer in a window. + +The hook can be also used for tracking changes of window sizes. It +is, however, not run when the size of a frame changes or automatic +resizing of a minibuffer window (@pxref{Minibuffer Windows}) changes +the size of another window. As a rule, adding a function to +@code{window-size-change-functions}, see above, is the recommended way +for reliably tracking size changes of any window. The buffer-local value of this hook is run once for each window on the affected frame, with the relevant window selected and its buffer diff --git a/lisp/window.el b/lisp/window.el index 94ac65cfc5..f252b0e041 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -9287,10 +9287,15 @@ displaying that processes's buffer." (when size (set-process-window-size process (cdr size) (car size)))))))))) +;; Remove the following call in Emacs 27, running +;; 'window-size-change-functions' should suffice. (add-hook 'window-configuration-change-hook 'window--adjust-process-windows) + +;; Catch any size changes not handled by +;; 'window-configuration-change-hook' (Bug#32720, "another issue" in +;; Bug#33230). (add-hook 'window-size-change-functions (lambda (_frame) (window--adjust-process-windows))) - ;; Some of these are in tutorial--default-keys, so update that if you ;; change these. commit 88762b4063a42a69234bda74b1626b646734715a Author: Gary Fredericks Date: Sun Nov 18 09:15:00 2018 +0100 Run 'window--adjust-process-windows' when frame size changes (Bug#32720) * lisp/window.el (window-size-change-functions): Run 'window--adjust-process-windows' from 'window-size-change-functions' too (Bug#32720, "another issue" in Bug#33230). Copyright-paperwork-exempt: yes diff --git a/lisp/window.el b/lisp/window.el index 92cd8c2738..94ac65cfc5 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -9288,6 +9288,8 @@ displaying that processes's buffer." (set-process-window-size process (cdr size) (car size)))))))))) (add-hook 'window-configuration-change-hook 'window--adjust-process-windows) +(add-hook 'window-size-change-functions (lambda (_frame) + (window--adjust-process-windows))) ;; Some of these are in tutorial--default-keys, so update that if you commit 5d140800398287c20230dda79162a7c40016d88e Author: Juri Linkov Date: Sat Nov 17 23:52:05 2018 +0200 * lisp/vc/diff-mode.el (diff-find-source-location): Use vc-working-revision when diff shows changes in working revision. (Bug#33319) (diff-goto-source): Rename variables to avoid ambiguity. diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index b86c17fe36..f200680968 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -1742,7 +1742,10 @@ NOPROMPT, if non-nil, means not to prompt the user." (file (or (diff-find-file-name other noprompt) (error "Can't find the file"))) (revision (and other diff-vc-backend - (nth (if reverse 1 0) diff-vc-revisions))) + (if reverse (nth 1 diff-vc-revisions) + (or (nth 0 diff-vc-revisions) + ;; When diff shows changes in working revision + (vc-working-revision file))))) (buf (if revision (let ((vc-find-revision-no-save t)) (vc-find-revision file revision diff-vc-backend)) @@ -1883,13 +1886,13 @@ revision of the file otherwise." ;; This is a convenient detail when using smerge-diff. (if event (posn-set-point (event-end event))) (let ((buffer (when event (current-buffer))) - (rev (not (save-excursion (beginning-of-line) (looking-at "[-<]"))))) + (reverse (not (save-excursion (beginning-of-line) (looking-at "[-<]"))))) (pcase-let ((`(,buf ,line-offset ,pos ,src ,_dst ,switched) - (diff-find-source-location other-file rev))) + (diff-find-source-location other-file reverse))) (pop-to-buffer buf) (goto-char (+ (car pos) (cdr src))) (when buffer (next-error-found buffer (current-buffer))) - (diff-hunk-status-msg line-offset (diff-xor rev switched) t)))) + (diff-hunk-status-msg line-offset (diff-xor reverse switched) t)))) (defun diff-current-defun () commit 8a481d29706eaf023ca786e3b905d397fbcfd685 Author: Juri Linkov Date: Sat Nov 17 23:31:52 2018 +0200 Don't exit Isearch while resizing windows with mouse (bug#32990) * lisp/isearch.el (isearch-mouse-leave-buffer): New function. (isearch-mode): Use isearch-mouse-leave-buffer instead of isearch-done for mouse-leave-buffer-hook. (isearch-done): Remove isearch-mouse-leave-buffer from mouse-leave-buffer-hook. (enlarge-window-horizontally, shrink-window-horizontally) (shrink-window, mouse-drag-mode-line, mouse-drag-vertical-line): Put property isearch-scroll with t. (isearch-mode): Reset isearch-pre-scroll-point and isearch-pre-move-point to nil for the case when Isearch exits between isearch-pre-command-hook (that sets these values) and isearch-post-command-hook (that used to reset them). diff --git a/lisp/isearch.el b/lisp/isearch.el index 035ff69327..87f4d495f4 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -973,6 +973,9 @@ used to set the value of `isearch-regexp-function'." isearch-input-method-local-p (local-variable-p 'input-method-function) regexp-search-ring-yank-pointer nil + isearch-pre-scroll-point nil + isearch-pre-move-point nil + ;; Save the original value of `minibuffer-message-timeout', and ;; set it to nil so that isearch's messages don't get timed out. isearch-original-minibuffer-message-timeout minibuffer-message-timeout @@ -1015,7 +1018,7 @@ used to set the value of `isearch-regexp-function'." (add-hook 'pre-command-hook 'isearch-pre-command-hook) (add-hook 'post-command-hook 'isearch-post-command-hook) - (add-hook 'mouse-leave-buffer-hook 'isearch-done) + (add-hook 'mouse-leave-buffer-hook 'isearch-mouse-leave-buffer) (add-hook 'kbd-macro-termination-hook 'isearch-done) ;; isearch-mode can be made modal (in the sense of not returning to @@ -1112,7 +1115,7 @@ NOPUSH is t and EDIT is t." (remove-hook 'pre-command-hook 'isearch-pre-command-hook) (remove-hook 'post-command-hook 'isearch-post-command-hook) - (remove-hook 'mouse-leave-buffer-hook 'isearch-done) + (remove-hook 'mouse-leave-buffer-hook 'isearch-mouse-leave-buffer) (remove-hook 'kbd-macro-termination-hook 'isearch-done) (setq isearch-lazy-highlight-start nil) (when (buffer-live-p isearch--current-buffer) @@ -1176,6 +1179,11 @@ NOPUSH is t and EDIT is t." (and (not edit) isearch-recursive-edit (exit-recursive-edit))) +(defun isearch-mouse-leave-buffer () + "Exit Isearch unless the mouse command is allowed in Isearch." + (unless (eq (get this-command 'isearch-scroll) t) + (isearch-done))) + (defun isearch-update-ring (string &optional regexp) "Add STRING to the beginning of the search ring. REGEXP if non-nil says use the regexp search ring." @@ -2390,6 +2398,12 @@ to the barrier." (put 'split-window-right 'isearch-scroll t) (put 'split-window-below 'isearch-scroll t) (put 'enlarge-window 'isearch-scroll t) +(put 'enlarge-window-horizontally 'isearch-scroll t) +(put 'shrink-window-horizontally 'isearch-scroll t) +(put 'shrink-window 'isearch-scroll t) +;; The next two commands don't exit Isearch in isearch-mouse-leave-buffer +(put 'mouse-drag-mode-line 'isearch-scroll t) +(put 'mouse-drag-vertical-line 'isearch-scroll t) ;; Aliases for split-window-* (put 'split-window-vertically 'isearch-scroll t) commit 81f0e05a02013bd1c9ea177e234561348b108578 Author: Stefan Monnier Date: Sat Nov 17 10:47:48 2018 -0500 * src/cmds.c (Fself_insert_command): Get last-command-event via (new) arg. diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 6c38d8eed0..51d2753f40 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -500,14 +500,14 @@ after point. It leaves the mark after the inserted text. The value is @code{nil}. @end deffn -@deffn Command self-insert-command count +@deffn Command self-insert-command count &optional char @cindex character insertion @cindex self-insertion -This command inserts the last character typed; it does so @var{count} -times, before point, and returns @code{nil}. Most printing characters -are bound to this command. In routine use, @code{self-insert-command} -is the most frequently called function in Emacs, but programs rarely use -it except to install it on a keymap. +This command inserts the character @var{char} (the last character typed); +it does so @var{count} times, before point, and returns @code{nil}. +Most printing characters are bound to this command. In routine use, +@code{self-insert-command} is the most frequently called function in Emacs, +but programs rarely use it except to install it on a keymap. In an interactive call, @var{count} is the numeric prefix argument. diff --git a/etc/NEWS b/etc/NEWS index 92b20c700a..1382b4d81e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1065,6 +1065,9 @@ removed. * Lisp Changes in Emacs 27.1 ++++ +** self-insert-command takes the char to insert as (optional) argument + ** 'lookup-key' can take a list of keymaps as argument. +++ diff --git a/src/cmds.c b/src/cmds.c index 1616efbb44..f6803f460a 100644 --- a/src/cmds.c +++ b/src/cmds.c @@ -260,11 +260,10 @@ because it respects values of `delete-active-region' and `overwrite-mode'. */) return Qnil; } -/* Note that there's code in command_loop_1 which typically avoids - calling this. */ -DEFUN ("self-insert-command", Fself_insert_command, Sself_insert_command, 1, 1, "p", +DEFUN ("self-insert-command", Fself_insert_command, Sself_insert_command, 1, 2, + "(list (prefix-numeric-value current-prefix-arg) last-command-event)", doc: /* Insert the character you type. -Whichever character you type to run this command is inserted. +Whichever character C you type to run this command is inserted. The numeric prefix argument N says how many times to repeat the insertion. Before insertion, `expand-abbrev' is executed if the inserted character does not have word syntax and the previous character in the buffer does. @@ -272,10 +271,14 @@ After insertion, `internal-auto-fill' is called if `auto-fill-function' is non-nil and if the `auto-fill-chars' table has a non-nil value for the inserted character. At the end, it runs `post-self-insert-hook'. */) - (Lisp_Object n) + (Lisp_Object n, Lisp_Object c) { CHECK_FIXNUM (n); + /* Backward compatibility. */ + if (NILP (c)) + c = last_command_event; + if (XFIXNUM (n) < 0) error ("Negative repetition argument %"pI"d", XFIXNUM (n)); @@ -283,11 +286,11 @@ a non-nil value for the inserted character. At the end, it runs call0 (Qundo_auto_amalgamate); /* Barf if the key that invoked this was not a character. */ - if (!CHARACTERP (last_command_event)) + if (!CHARACTERP (c)) bitch_at_user (); else { int character = translate_char (Vtranslation_table_for_input, - XFIXNUM (last_command_event)); + XFIXNUM (c)); int val = internal_self_insert (character, XFIXNAT (n)); if (val == 2) Fset (Qundo_auto__this_command_amalgamating, Qnil); commit d6542ea0f032d154da5a6e896a860adc9176a00a Author: Eli Zaretskii Date: Fri Nov 16 21:52:34 2018 +0200 Avoid errors in zone.el when there's overlay at EOB * lisp/play/zone.el (zone): Make sure the window-end position is calculated accurately, to avoid errors from buffer-substring. (Bug#33384) diff --git a/lisp/play/zone.el b/lisp/play/zone.el index 4584d26f38..75f1364619 100644 --- a/lisp/play/zone.el +++ b/lisp/play/zone.el @@ -109,7 +109,7 @@ If the element is a function or a list of a function and a number, (save-window-excursion (let ((f (selected-frame)) (outbuf (get-buffer-create "*zone*")) - (text (buffer-substring (window-start) (window-end))) + (text (buffer-substring (window-start) (window-end nil t))) (wp (1+ (- (window-point) (window-start))))) (put 'zone 'orig-buffer (current-buffer)) commit 644a308b4e1513e04be9360e1586e14b32ec0159 Merge: 37b8213afd 936a8f3093 Author: Glenn Morris Date: Fri Nov 16 08:30:20 2018 -0800 Merge from origin/emacs-26 936a8f3 (origin/emacs-26) Document Emacs 26 behavior of Dired's 'Z' o... 99f99a1 ; Minor editing change in windows.texi 13bb665 Fix a typo in the Emacs manual # Conflicts: # etc/NEWS commit 37b8213afda3550cb84c09b5718a019f2799bc8a Merge: 166f1400b4 a306d03974 Author: Glenn Morris Date: Fri Nov 16 08:30:19 2018 -0800 ; Merge from origin/emacs-26 The following commit was skipped: a306d03 Fix tempfile creation when byte compiling commit 166f1400b402fa2275be398fe818e4514dfd8fe9 Merge: 372225ef02 edcd6b722c Author: Glenn Morris Date: Fri Nov 16 08:30:19 2018 -0800 Merge from origin/emacs-26 edcd6b7 Small documentation correction. 168a8c2 * src/coding.c (Fcheck_coding_systems_region): Doc fix. (Bug... 3287a7c Fix Bug#33364 acee0a8 ; Cosmetic changes in etc/NEWS a6ef167 * test/README: Explain $REMOTE_TEMPORARY_FILE_DIRECTORY. # Conflicts: # etc/NEWS commit 372225ef0268a03fe8edad66817d2ecbc9cfa305 Merge: 7382f64bd0 b8bbbe54dd Author: Glenn Morris Date: Fri Nov 16 08:30:19 2018 -0800 ; Merge from origin/emacs-26 The following commit was skipped: b8bbbe5 Avoid kill-emacs-hook errors hanging batch mode commit 7382f64bd074de59b30c88dd4056186645085a2e Author: Paul Eggert Date: Fri Nov 16 08:24:54 2018 -0800 Update from glibc and Gnulib This incorporates: 2018-11-15 mktime: DEBUG_MKTIME cleanup 2018-11-15 mktime: fix non-EOVERFLOW errno handling 2018-11-15 mktime: fix bug with Y2038 DST transition 2018-11-15 mktime: make more room for overflow 2018-11-15 mktime: simplify offset guess 2018-11-15 mktime: new test for mktime failure 2018-11-15 mktime: fix EOVERFLOW bug 2018-11-13 longlong: fix comment typo * lib/gnulib.mk.in: Regenerate. * lib/mktime.c, m4/longlong.m4: Copy from Gnulib. diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index c87a15e019..eca073d0e5 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -1051,7 +1051,6 @@ gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1 = @gl_GNULIB_ENABLED_a9786850 gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36 = @gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36@ gl_GNULIB_ENABLED_cloexec = @gl_GNULIB_ENABLED_cloexec@ gl_GNULIB_ENABLED_dirfd = @gl_GNULIB_ENABLED_dirfd@ -gl_GNULIB_ENABLED_dosname = @gl_GNULIB_ENABLED_dosname@ gl_GNULIB_ENABLED_euidaccess = @gl_GNULIB_ENABLED_euidaccess@ gl_GNULIB_ENABLED_getdtablesize = @gl_GNULIB_ENABLED_getdtablesize@ gl_GNULIB_ENABLED_getgroups = @gl_GNULIB_ENABLED_getgroups@ diff --git a/lib/mktime.c b/lib/mktime.c index 557712fdaa..9c3fb20f79 100644 --- a/lib/mktime.c +++ b/lib/mktime.c @@ -17,12 +17,6 @@ License along with the GNU C Library; if not, see . */ -/* Define this to 1 to have a standalone program to test this implementation of - mktime. */ -#ifndef DEBUG_MKTIME -# define DEBUG_MKTIME 0 -#endif - /* The following macros influence what gets defined when this file is compiled: Macro/expression Which gnulib module This compilation unit @@ -34,12 +28,10 @@ || NEED_MKTIME_WINDOWS NEED_MKTIME_INTERNAL mktime-internal mktime_internal - - DEBUG_MKTIME (defined manually) my_mktime, main */ -#if !defined _LIBC && !DEBUG_MKTIME -# include +#ifndef _LIBC +# include #endif /* Assume that leap seconds are possible, unless told otherwise. @@ -51,6 +43,7 @@ #include +#include #include #include #include @@ -59,13 +52,6 @@ #include #include -#if DEBUG_MKTIME -# include -/* Make it work even if the system's libc has its own mktime routine. */ -# undef mktime -# define mktime my_mktime -#endif /* DEBUG_MKTIME */ - #ifndef NEED_MKTIME_INTERNAL # define NEED_MKTIME_INTERNAL 0 #endif @@ -73,7 +59,7 @@ # define NEED_MKTIME_WINDOWS 0 #endif #ifndef NEED_MKTIME_WORKING -# define NEED_MKTIME_WORKING DEBUG_MKTIME +# define NEED_MKTIME_WORKING 0 #endif #include "mktime-internal.h" @@ -119,11 +105,12 @@ my_tzset (void) #if defined _LIBC || NEED_MKTIME_WORKING || NEED_MKTIME_INTERNAL /* A signed type that can represent an integer number of years - multiplied by three times the number of seconds in a year. It is + multiplied by four times the number of seconds in a year. It is needed when converting a tm_year value times the number of seconds - in a year. The factor of three comes because these products need + in a year. The factor of four comes because these products need to be subtracted from each other, and sometimes with an offset - added to them, without worrying about overflow. + added to them, and then with another timestamp added, without + worrying about overflow. Much of the code uses long_int to represent time_t values, to lessen the hassle of dealing with platforms where time_t is @@ -131,12 +118,12 @@ my_tzset (void) time_t values that mktime can generate even on platforms where time_t is excessively wide. */ -#if INT_MAX <= LONG_MAX / 3 / 366 / 24 / 60 / 60 +#if INT_MAX <= LONG_MAX / 4 / 366 / 24 / 60 / 60 typedef long int long_int; #else typedef long long int long_int; #endif -verify (INT_MAX <= TYPE_MAXIMUM (long_int) / 3 / 366 / 24 / 60 / 60); +verify (INT_MAX <= TYPE_MAXIMUM (long_int) / 4 / 366 / 24 / 60 / 60); /* Shift A right by B bits portably, by dividing A by 2**B and truncating towards minus infinity. B should be in the range 0 <= B @@ -210,9 +197,10 @@ isdst_differ (int a, int b) were not adjusted between the timestamps. The YEAR values uses the same numbering as TP->tm_year. Values - need not be in the usual range. However, YEAR1 must not overflow - when multiplied by three times the number of seconds in a year, and - likewise for YDAY1 and three times the number of seconds in a day. */ + need not be in the usual range. However, YEAR1 - YEAR0 must not + overflow even when multiplied by three times the number of seconds + in a year, and likewise for YDAY1 - YDAY0 and three times the + number of seconds in a day. */ static long_int ydhms_diff (long_int year1, long_int yday1, int hour1, int min1, int sec1, @@ -247,43 +235,25 @@ long_int_avg (long_int a, long_int b) return shr (a, 1) + shr (b, 1) + ((a | b) & 1); } -/* Return a time_t value corresponding to (YEAR-YDAY HOUR:MIN:SEC), - assuming that T corresponds to *TP and that no clock adjustments - occurred between *TP and the desired time. - Although T and the returned value are of type long_int, - they represent time_t values and must be in time_t range. - If TP is null, return a value not equal to T; this avoids false matches. +/* Return a long_int value corresponding to (YEAR-YDAY HOUR:MIN:SEC) + minus *TP seconds, assuming no clock adjustments occurred between + the two timestamps. + YEAR and YDAY must not be so large that multiplying them by three times the number of seconds in a year (or day, respectively) would overflow long_int. - If the returned value would be out of range, yield the minimal or - maximal in-range value, except do not yield a value equal to T. */ + *TP should be in the usual range. */ static long_int -guess_time_tm (long_int year, long_int yday, int hour, int min, int sec, - long_int t, const struct tm *tp) +tm_diff (long_int year, long_int yday, int hour, int min, int sec, + struct tm const *tp) { - if (tp) - { - long_int result; - long_int d = ydhms_diff (year, yday, hour, min, sec, - tp->tm_year, tp->tm_yday, - tp->tm_hour, tp->tm_min, tp->tm_sec); - if (! INT_ADD_WRAPV (t, d, &result)) - return result; - } - - /* Overflow occurred one way or another. Return the nearest result - that is actually in range, except don't report a zero difference - if the actual difference is nonzero, as that would cause a false - match; and don't oscillate between two values, as that would - confuse the spring-forward gap detector. */ - return (t < long_int_avg (mktime_min, mktime_max) - ? (t <= mktime_min + 1 ? t + 1 : mktime_min) - : (mktime_max - 1 <= t ? t - 1 : mktime_max)); + return ydhms_diff (year, yday, hour, min, sec, + tp->tm_year, tp->tm_yday, + tp->tm_hour, tp->tm_min, tp->tm_sec); } /* Use CONVERT to convert T to a struct tm value in *TM. T must be in - range for time_t. Return TM if successful, NULL if T is out of - range for CONVERT. */ + range for time_t. Return TM if successful, NULL (setting errno) on + failure. */ static struct tm * convert_time (struct tm *(*convert) (const time_t *, struct tm *), long_int t, struct tm *tm) @@ -295,47 +265,48 @@ convert_time (struct tm *(*convert) (const time_t *, struct tm *), /* Use CONVERT to convert *T to a broken down time in *TP. If *T is out of range for conversion, adjust it so that it is the nearest in-range value and then convert that. - A value is in range if it fits in both time_t and long_int. */ + A value is in range if it fits in both time_t and long_int. + Return TP on success, NULL (setting errno) on failure. */ static struct tm * ranged_convert (struct tm *(*convert) (const time_t *, struct tm *), long_int *t, struct tm *tp) { - struct tm *r; - if (*t < mktime_min) - *t = mktime_min; - else if (mktime_max < *t) - *t = mktime_max; - r = convert_time (convert, *t, tp); - - if (!r && *t) + long_int t1 = (*t < mktime_min ? mktime_min + : *t <= mktime_max ? *t : mktime_max); + struct tm *r = convert_time (convert, t1, tp); + if (r) { - long_int bad = *t; - long_int ok = 0; + *t = t1; + return r; + } + if (errno != EOVERFLOW) + return NULL; - /* BAD is a known unconvertible value, and OK is a known good one. - Use binary search to narrow the range between BAD and OK until - they differ by 1. */ - while (true) - { - long_int mid = long_int_avg (ok, bad); - if (mid != ok && mid != bad) - break; - r = convert_time (convert, mid, tp); - if (r) - ok = mid; - else - bad = mid; - } + long_int bad = t1; + long_int ok = 0; + struct tm oktm; oktm.tm_sec = -1; - if (!r && ok) - { - /* The last conversion attempt failed; - revert to the most recent successful attempt. */ - r = convert_time (convert, ok, tp); - } + /* BAD is a known out-of-range value, and OK is a known in-range one. + Use binary search to narrow the range between BAD and OK until + they differ by 1. */ + while (true) + { + long_int mid = long_int_avg (ok, bad); + if (mid == ok || mid == bad) + break; + if (convert_time (convert, mid, tp)) + ok = mid, oktm = *tp; + else if (errno != EOVERFLOW) + return NULL; + else + bad = mid; } - return r; + if (oktm.tm_sec < 0) + return NULL; + *t = ok; + *tp = oktm; + return tp; } @@ -344,13 +315,14 @@ ranged_convert (struct tm *(*convert) (const time_t *, struct tm *), Use *OFFSET to keep track of a guess at the offset of the result, compared to what the result would be for UTC without leap seconds. If *OFFSET's guess is correct, only one CONVERT call is needed. + If successful, set *TP to the canonicalized struct tm; + otherwise leave *TP alone, return ((time_t) -1) and set errno. This function is external because it is used also by timegm.c. */ time_t __mktime_internal (struct tm *tp, struct tm *(*convert) (const time_t *, struct tm *), mktime_offset_t *offset) { - long_int t, gt, t0, t1, t2, dt; struct tm tm; /* The maximum number of probes (calls to CONVERT) should be enough @@ -370,7 +342,7 @@ __mktime_internal (struct tm *tp, int isdst = tp->tm_isdst; /* 1 if the previous probe was DST. */ - int dst2; + int dst2 = 0; /* Ensure that mon is in range, and set year accordingly. */ int mon_remainder = mon % 12; @@ -398,7 +370,7 @@ __mktime_internal (struct tm *tp, if (LEAP_SECONDS_POSSIBLE) { /* Handle out-of-range seconds specially, - since ydhms_tm_diff assumes every minute has 60 seconds. */ + since ydhms_diff assumes every minute has 60 seconds. */ if (sec < 0) sec = 0; if (59 < sec) @@ -409,33 +381,46 @@ __mktime_internal (struct tm *tp, time. */ INT_SUBTRACT_WRAPV (0, off, &negative_offset_guess); - t0 = ydhms_diff (year, yday, hour, min, sec, - EPOCH_YEAR - TM_YEAR_BASE, 0, 0, 0, negative_offset_guess); + long_int t0 = ydhms_diff (year, yday, hour, min, sec, + EPOCH_YEAR - TM_YEAR_BASE, 0, 0, 0, + negative_offset_guess); + long_int t = t0, t1 = t0, t2 = t0; /* Repeatedly use the error to improve the guess. */ - for (t = t1 = t2 = t0, dst2 = 0; - (gt = guess_time_tm (year, yday, hour, min, sec, t, - ranged_convert (convert, &t, &tm)), - t != gt); - t1 = t2, t2 = t, t = gt, dst2 = tm.tm_isdst != 0) - if (t == t1 && t != t2 - && (tm.tm_isdst < 0 - || (isdst < 0 - ? dst2 <= (tm.tm_isdst != 0) - : (isdst != 0) != (tm.tm_isdst != 0)))) - /* We can't possibly find a match, as we are oscillating - between two values. The requested time probably falls - within a spring-forward gap of size GT - T. Follow the common - practice in this case, which is to return a time that is GT - T - away from the requested time, preferring a time whose - tm_isdst differs from the requested value. (If no tm_isdst - was requested and only one of the two values has a nonzero - tm_isdst, prefer that value.) In practice, this is more - useful than returning -1. */ - goto offset_found; - else if (--remaining_probes == 0) - return -1; + while (true) + { + if (! ranged_convert (convert, &t, &tm)) + return -1; + long_int dt = tm_diff (year, yday, hour, min, sec, &tm); + if (dt == 0) + break; + + if (t == t1 && t != t2 + && (tm.tm_isdst < 0 + || (isdst < 0 + ? dst2 <= (tm.tm_isdst != 0) + : (isdst != 0) != (tm.tm_isdst != 0)))) + /* We can't possibly find a match, as we are oscillating + between two values. The requested time probably falls + within a spring-forward gap of size DT. Follow the common + practice in this case, which is to return a time that is DT + away from the requested time, preferring a time whose + tm_isdst differs from the requested value. (If no tm_isdst + was requested and only one of the two values has a nonzero + tm_isdst, prefer that value.) In practice, this is more + useful than returning -1. */ + goto offset_found; + + remaining_probes--; + if (remaining_probes == 0) + { + __set_errno (EOVERFLOW); + return -1; + } + + t1 = t2, t2 = t, t += dt, dst2 = tm.tm_isdst != 0; + } /* We have a match. Check whether tm.tm_isdst has the requested value, if any. */ @@ -477,25 +462,38 @@ __mktime_internal (struct tm *tp, if (! INT_ADD_WRAPV (t, delta * direction, &ot)) { struct tm otm; - ranged_convert (convert, &ot, &otm); + if (! ranged_convert (convert, &ot, &otm)) + return -1; if (! isdst_differ (isdst, otm.tm_isdst)) { /* We found the desired tm_isdst. Extrapolate back to the desired time. */ - t = guess_time_tm (year, yday, hour, min, sec, ot, &otm); - ranged_convert (convert, &t, &tm); - goto offset_found; + long_int gt = ot + tm_diff (year, yday, hour, min, sec, + &otm); + if (mktime_min <= gt && gt <= mktime_max) + { + if (convert_time (convert, gt, &tm)) + { + t = gt; + goto offset_found; + } + if (errno != EOVERFLOW) + return -1; + } } } } + + __set_errno (EOVERFLOW); + return -1; } offset_found: /* Set *OFFSET to the low-order bits of T - T0 - NEGATIVE_OFFSET_GUESS. This is just a heuristic to speed up the next mktime call, and correctness is unaffected if integer overflow occurs here. */ - INT_SUBTRACT_WRAPV (t, t0, &dt); - INT_SUBTRACT_WRAPV (dt, negative_offset_guess, offset); + INT_SUBTRACT_WRAPV (t, t0, offset); + INT_SUBTRACT_WRAPV (*offset, negative_offset_guess, offset); if (LEAP_SECONDS_POSSIBLE && sec_requested != tm.tm_sec) { @@ -505,8 +503,12 @@ __mktime_internal (struct tm *tp, sec_adjustment -= sec; sec_adjustment += sec_requested; if (INT_ADD_WRAPV (t, sec_adjustment, &t) - || ! (mktime_min <= t && t <= mktime_max) - || ! convert_time (convert, t, &tm)) + || ! (mktime_min <= t && t <= mktime_max)) + { + __set_errno (EOVERFLOW); + return -1; + } + if (! convert_time (convert, t, &tm)) return -1; } @@ -545,146 +547,3 @@ weak_alias (mktime, timelocal) libc_hidden_def (mktime) libc_hidden_weak (timelocal) #endif - -#if DEBUG_MKTIME - -static int -not_equal_tm (const struct tm *a, const struct tm *b) -{ - return ((a->tm_sec ^ b->tm_sec) - | (a->tm_min ^ b->tm_min) - | (a->tm_hour ^ b->tm_hour) - | (a->tm_mday ^ b->tm_mday) - | (a->tm_mon ^ b->tm_mon) - | (a->tm_year ^ b->tm_year) - | (a->tm_yday ^ b->tm_yday) - | isdst_differ (a->tm_isdst, b->tm_isdst)); -} - -static void -print_tm (const struct tm *tp) -{ - if (tp) - printf ("%04d-%02d-%02d %02d:%02d:%02d yday %03d wday %d isdst %d", - tp->tm_year + TM_YEAR_BASE, tp->tm_mon + 1, tp->tm_mday, - tp->tm_hour, tp->tm_min, tp->tm_sec, - tp->tm_yday, tp->tm_wday, tp->tm_isdst); - else - printf ("0"); -} - -static int -check_result (time_t tk, struct tm tmk, time_t tl, const struct tm *lt) -{ - if (tk != tl || !lt || not_equal_tm (&tmk, lt)) - { - printf ("mktime ("); - print_tm (lt); - printf (")\nyields ("); - print_tm (&tmk); - printf (") == %ld, should be %ld\n", (long int) tk, (long int) tl); - return 1; - } - - return 0; -} - -int -main (int argc, char **argv) -{ - int status = 0; - struct tm tm, tmk, tml; - struct tm *lt; - time_t tk, tl, tl1; - char trailer; - - /* Sanity check, plus call tzset. */ - tl = 0; - if (! localtime (&tl)) - { - printf ("localtime (0) fails\n"); - status = 1; - } - - if ((argc == 3 || argc == 4) - && (sscanf (argv[1], "%d-%d-%d%c", - &tm.tm_year, &tm.tm_mon, &tm.tm_mday, &trailer) - == 3) - && (sscanf (argv[2], "%d:%d:%d%c", - &tm.tm_hour, &tm.tm_min, &tm.tm_sec, &trailer) - == 3)) - { - tm.tm_year -= TM_YEAR_BASE; - tm.tm_mon--; - tm.tm_isdst = argc == 3 ? -1 : atoi (argv[3]); - tmk = tm; - tl = mktime (&tmk); - lt = localtime_r (&tl, &tml); - printf ("mktime returns %ld == ", (long int) tl); - print_tm (&tmk); - printf ("\n"); - status = check_result (tl, tmk, tl, lt); - } - else if (argc == 4 || (argc == 5 && strcmp (argv[4], "-") == 0)) - { - time_t from = atol (argv[1]); - time_t by = atol (argv[2]); - time_t to = atol (argv[3]); - - if (argc == 4) - for (tl = from; by < 0 ? to <= tl : tl <= to; tl = tl1) - { - lt = localtime_r (&tl, &tml); - if (lt) - { - tmk = tml; - tk = mktime (&tmk); - status |= check_result (tk, tmk, tl, &tml); - } - else - { - printf ("localtime_r (%ld) yields 0\n", (long int) tl); - status = 1; - } - tl1 = tl + by; - if ((tl1 < tl) != (by < 0)) - break; - } - else - for (tl = from; by < 0 ? to <= tl : tl <= to; tl = tl1) - { - /* Null benchmark. */ - lt = localtime_r (&tl, &tml); - if (lt) - { - tmk = tml; - tk = tl; - status |= check_result (tk, tmk, tl, &tml); - } - else - { - printf ("localtime_r (%ld) yields 0\n", (long int) tl); - status = 1; - } - tl1 = tl + by; - if ((tl1 < tl) != (by < 0)) - break; - } - } - else - printf ("Usage:\ -\t%s YYYY-MM-DD HH:MM:SS [ISDST] # Test given time.\n\ -\t%s FROM BY TO # Test values FROM, FROM+BY, ..., TO.\n\ -\t%s FROM BY TO - # Do not test those values (for benchmark).\n", - argv[0], argv[0], argv[0]); - - return status; -} - -#endif /* DEBUG_MKTIME */ - -/* -Local Variables: -compile-command: "gcc -DDEBUG_MKTIME -I. -Wall -W -O2 -g mktime.c -o mktime" -End: -*/ diff --git a/m4/longlong.m4 b/m4/longlong.m4 index 322d79b66c..582af53f6c 100644 --- a/m4/longlong.m4 +++ b/m4/longlong.m4 @@ -57,7 +57,7 @@ AC_DEFUN([AC_TYPE_LONG_LONG_INT], ]) # Define HAVE_UNSIGNED_LONG_LONG_INT if 'unsigned long long int' works. -# This fixes can be faster than what's in Autoconf 2.62 through 2.68. +# This can be faster than what's in Autoconf 2.62 through 2.68. # Note: If the type 'unsigned long long int' exists but is only 32 bits # large (as on some very old compilers), AC_TYPE_UNSIGNED_LONG_LONG_INT commit f7cbe83e3b37d2faa56947490e8eaa348565b1af Author: Michael Albinus Date: Fri Nov 16 13:47:51 2018 +0100 ; Further cosmetic changes in etc/NEWS diff --git a/etc/NEWS b/etc/NEWS index 6e52f6cd1f..92b20c700a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -89,7 +89,7 @@ We recommend against putting any customizations in this file that don't need to be set up before initializing installed add-on packages, because the early init file is read too early into the startup process, and some important parts of the Emacs session, such as -window-system and other GUI features, are not yet set up, which could +'window-system' and other GUI features, are not yet set up, which could make some customization fail to work. +++ @@ -300,15 +300,15 @@ the node "(emacs) Directory Variables" of the user manual. ** Follow mode In the current follow group of windows, "ghost" cursors are no longer displayed in the non-selected follow windows. To get the old behavior -back, customize follow-hide-ghost-cursors to nil. +back, customize 'follow-hide-ghost-cursors' to nil. ** Windmove *** Windmove supports directional window display and selection. -The new command windmove-display-default-keybindings binds default -keys with provided modifiers (by default, shift-meta) to the commands +The new command 'windmove-display-default-keybindings' binds default +keys with provided modifiers (by default, Shift-Meta) to the commands that display the next buffer in the window at the specified direction. -This is like windmove-default-keybindings that binds keys to commands +This is like 'windmove-default-keybindings' that binds keys to commands that select the window in the specified direction, but additionally it displays the buffer from the next command in that window. For example, 'S-M-right C-h i' displays the *Info* buffer in the right window, @@ -316,7 +316,7 @@ creating the window if necessary. A special key can be customized to display the buffer in the same window, for example, 'S-M-0 C-h e' displays the *Messages* buffer in the same window. -*** windmove-create-window when non-nil makes a new window on moving off +*** 'windmove-create-window' when non-nil makes a new window on moving off the edge of the frame. ** Octave mode @@ -324,25 +324,31 @@ The mode is automatically enabled in files that start with the 'function' keyword. ** project.el -*** New commands project-search and project-query-replace +*** New commands 'project-search' and 'project-query-replace'. ** Etags + +++ -*** 'next-file' is now an obsolete alias of tags-next-file -*** tags-loop-revert-buffers is an obsolete alias of multifile-revert-buffers -*** The tags-loop-continue function along with the tags-loop-operate and -tags-loop-scan variables are now obsolete; use the new multifile-initialize and -multifile-continue functions instead. +*** 'next-file' is now an obsolete alias of 'tags-next-file'. + +*** 'tags-loop-revert-buffers' is an obsolete alias of +'multifile-revert-buffers'. + +*** The 'tags-loop-continue' function along with the +'tags-loop-operate' and 'tags-loop-scan' variables are now obsolete; +use the new 'multifile-initialize' and 'multifile-continue' functions +instead. ---- ** bibtex + +--- *** New commands 'bibtex-next-entry' and 'bibtex-previous-entry'. -In bibtex-mode-map, forward-paragraph and backward-paragraph are +In 'bibtex-mode-map', 'forward-paragraph' and 'backward-paragraph' are remapped to these, respectively. -+++ ** Dired ++++ *** New command 'dired-create-empty-file'. ** Change Logs and VC @@ -361,7 +367,7 @@ With non-nil, 'vc-find-revision' doesn't write the created buffer to file. *** New customizable variable 'vc-git-grep-template'. This new variable allows customizing the default arguments passed to -git-grep when 'vc-git-grep' is used. +'git-grep' when 'vc-git-grep' is used. *** Command 'vc-git-stash' now respects marks in the '*vc-dir*' buffer. When some files are marked, only those are stashed. @@ -376,12 +382,12 @@ with conflicts existed in earlier versions of Emacs, but incorrectly never detected a conflict due to invalid assumptions about cached values. -** diff-mode +** Diff mode *** Hunks are now automatically refined by default. To disable it, set the new defcustom 'diff-font-lock-refine' to nil. *** File headers can be shortened, mimicking Magit's diff format. -To enable it, set the new defcustom 'diff-font-lock-prettify to t. +To enable it, set the new defcustom 'diff-font-lock-prettify' to t. +++ *** Prefix arg of 'diff-goto-source' means jump to the old revision @@ -401,7 +407,7 @@ shown in the currently selected window. Also, 'shell-strip-ctrl-m' is declared obsolete. +++ -*** 'C-c .' (comint-insert-previous-argument) no longer interprets '&'. +*** 'C-c .' ('comint-insert-previous-argument') no longer interprets '&'. This feature caused problems when '&&' was present in the previous command. Since this command emulates 'M-.' in Bash and zsh, neither of which treats '&' specially, the feature was removed for @@ -462,13 +468,13 @@ This enables more efficient backends. See the docstring of ** Package *** New function 'package-get-version' lets packages query their own version. -Example use in auctex.el: (defconst auctex-version (package-get-version)) +Example use in auctex.el: '(defconst auctex-version (package-get-version))' *** New 'package-quickstart' feature. When 'package-quickstart' is non-nil, package.el precomputes a big autoloads file so that activation of packages can be done much faster, which can speed up your startup significantly. -It also causes variables like package-user-dir and package-load-list to be +It also causes variables like 'package-user-dir' and 'package-load-list' to be consulted when 'package-quickstart-refresh' is run rather than at startup so you don't need to set them in your early init file. @@ -566,7 +572,7 @@ and 'hfy-rgb-txt-color-map' have been renamed from names that used +++ ** Enriched mode supports the 'charset' text property. You can add or modify the 'charset' text properties of text using the -Edit->Text Properties->Special Properties menu, or by invoking the +'Edit->Text Properties->Special Properties' menu, or by invoking the 'facemenu-set-charset' command. Documents in Enriched mode will be saved with the charset properties, and those properties will be restored when the file is visited. @@ -574,9 +580,9 @@ restored when the file is visited. ** Smtpmail Authentication mechanisms can be added via external packages, by -defining new cl-defmethod of smtpmail-try-auth-method. +defining new 'cl-defmethod' of 'smtpmail-try-auth-method'. -** Footnote-mode +** Footnote mode *** Support Hebrew-style footnotes *** Footnote text lines are now aligned. @@ -616,7 +622,7 @@ directories in the destination. ** Help --- -*** Output format of 'C-h l' (view-lossage) has changed. +*** Output format of 'C-h l' ('view-lossage') has changed. For convenience, 'view-lossage' now displays the last keystrokes and commands in the same format as the edit buffer of 'edit-last-kbd-macro'. This makes it possible to copy the lines from @@ -630,29 +636,29 @@ can now be searched via 'C-s'. ** Ibuffer --- -*** New filter ibuffer-filter-by-process; bound to '/E'. +*** New filter 'ibuffer-filter-by-process'; bound to '/E'. ** Search and Replace -*** isearch-lazy-count shows the current match number and total number +*** 'isearch-lazy-count' shows the current match number and total number of matches in the Isearch prompt. Customizable variables -lazy-count-prefix-format and lazy-count-suffix-format define the +'lazy-count-prefix-format' and 'lazy-count-suffix-format' define the format of the current and the total number of matches in the prompt's prefix and suffix respectively. -*** lazy-highlight-buffer highlights matches in the full buffer. -It is useful in combination with lazy-highlight-cleanup customized to nil +*** 'lazy-highlight-buffer' highlights matches in the full buffer. +It is useful in combination with 'lazy-highlight-cleanup' customized to nil to leave matches highlighted in the whole buffer after exiting isearch. -Also when lazy-highlight-buffer prepares highlighting in the buffer, +Also when 'lazy-highlight-buffer' prepares highlighting in the buffer, navigation through the matches without flickering is more smooth. -lazy-highlight-buffer-max-at-a-time controls the number of matches to +'lazy-highlight-buffer-max-at-a-time' controls the number of matches to highlight in one iteration while processing the full buffer. +++ *** New isearch bindings. -'C-M-w' in isearch changed from isearch-del-char to the new function -isearch-yank-symbol-or-char. isearch-del-char is now bound to +'C-M-w' in isearch changed from 'isearch-del-char' to the new function +'isearch-yank-symbol-or-char'. 'isearch-del-char' is now bound to 'C-M-d'. +++ @@ -983,7 +989,7 @@ its default value changed in Emacs 27.1. ** Interpretation of relative HOME directory has changed. If $HOME is set to a relative file name, 'expand-file-name' now interprets it relative to the directory where Emacs was started, not -relative to the default-directory of the current buffer. We recommend +relative to the 'default-directory' of the current buffer. We recommend always setting $HOME to an absolute file name, so that its meaning is independent of where Emacs was started. @@ -1112,7 +1118,7 @@ by hand. This can convert decoded times and Lisp time values to Lisp timestamps of various forms, including a new timestamp form '(TICKS . HZ)', where TICKS is an integer and HZ is a positive integer denoting a clock -frequency. The old encode-time API is still supported. +frequency. The old 'encode-time' API is still supported. +++ ** 'time-add', 'time-subtract', and 'time-less-p' now accept commit cf7f44d07ed643848b89b03e517efe913250d2ef Author: Michael Albinus Date: Fri Nov 16 13:05:49 2018 +0100 Mention ELPA packages which add new methods to Tramp * doc/misc/tramp.texi (Customizing Methods): Mention ELPA packages which add new methods to Tramp. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 874c1da1d9..8cd0a72fc8 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -1491,6 +1491,74 @@ predefined methods. Any part of this list can be modified with more suitable settings. Refer to the Lisp documentation of that variable, accessible with @kbd{C-h v tramp-methods @key{RET}}. +In the ELPA archives, there are several examples of such extensions. +They can be installed with Emacs' Package Manager. This includes + +@table @samp +@c @item anything-tramp +@c @item counsel-tramp +@c @item helm-tramp +@c Contact MasashĂ­ MĂ­yaura + +@c @item ibuffer-tramp.el +@c Contact Svend Sorensen + +@item docker-tramp +@cindex method @option{docker} +@cindex @option{docker} method +Integration for Docker containers. A container is accessed via +@file{@trampfn{docker,user@@container,/path/to/file}}, where +@samp{user} is the (optional) user that you want to use, and +@samp{container} is the id or name of the container. + +@item kubernetes-tramp +@cindex method @option{kubectl} +@cindex @option{kubectl} method +Integration for Docker containers deployed in a Kubernetes cluster. +It is derived from @samp{docker-tramp}. A container is accessed via +@file{@trampfn{kubectl,user@@container,/path/to/file}}, @samp{user} +and @samp{container} have the same meaning as in @samp{docker-tramp}. + +@item lxc-tramp +@cindex method @option{lxc} +@cindex @option{lxc} method +Integration for LXC containers. A container is accessed via +@file{@trampfn{lxc,container,/path/to/file}}, @samp{container} has the +same meaning as in @samp{docker-tramp}. A @samp{user} specification +is ignored. + +@item lxd-tramp +@cindex method @option{lxd} +@cindex @option{lxd} method +Integration for LXD containers. A container is accessed via +@file{@trampfn{lxd,user@@container,/path/to/file}}, @samp{user} and +@samp{container} have the same meaning as in @samp{docker-tramp}. + +@item magit-tramp +@cindex method @option{git} +@cindex @option{git} method +Browing git repositories with @code{magit}. A versioned file is accessed via +@file{@trampfn{git,rev@@root-dir,/path/to/file}}. @samp{rev} is a git +revision, and @samp{root-dir} is a virtual host name for the root +directory, specified in @code{magit-tramp-hosts-alist}. + +@item tramp-hdfs +@cindex method @option{hdfs} +@cindex @option{hdfs} method +Access of a hadoop/hdfs file system. A file is accessed via +@file{@trampfn{hdfs,user@@node,/path/to/file}}, where @samp{user} is +the user that you want to use, and @samp{node} is the name of the +hadoop server. + +@item vagrant-tramp +@cindex method @option{vagrant} +@cindex @option{vagrant} method +Convenience method to access vagrant boxes. It is often used in +multi-hop file names like +@file{@value{prefix}vagrant@value{postfixhop}box|sudo@value{postfixhop}box@value{postfix}/path/to/file}, +where @samp{box} is the name of the vagrant box. +@end table + @node Customizing Completion @section Selecting config files for user/host name completion @@ -1671,7 +1739,7 @@ Set @code{auth-source-debug} to @code{t} to debug messages. @vindex ange-ftp-netrc-filename @strong{Note} that @file{auth-source.el} is not used for @option{ftp} -connections, because @value{tramp} passes the work to Ange FTP. If +connections, because @value{tramp} passes the work to Ange FTP@. If you want, for example, use your @file{~/.authinfo.gpg} authentication file, you must customize @code{ange-ftp-netrc-filename}: commit 936a8f3093f53442bb759880c8cddd5f4eb539a5 Author: Eli Zaretskii Date: Fri Nov 16 10:19:22 2018 +0200 Document Emacs 26 behavior of Dired's 'Z' on directories * doc/emacs/dired.texi (Operating on Files): Document behavior of 'Z' on directories. * etc/NEWS: Belatedly announce the new behavior of Dired's 'Z' on directory names and on .tar.gz archives. diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index fba9d31406..9c408e13ae 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -768,9 +768,15 @@ suitable guess made using the variables @code{lpr-command} and @item Z Compress the specified files (@code{dired-do-compress}). If the file appears to be a compressed file already, uncompress it instead. Each -marked file is compressed into its own archive. This uses the +marked file is compressed into its own archive; this uses the @command{gzip} program if it is available, otherwise it uses -@command{compress}. +@command{compress}. On a directory name, this command produces a +compressed @file{.tar.gz} archive containing all of the directory's +files, by running the @command{tar} command with output piped to +@command{gzip}. To allow decompression of compressed directories, +typing @kbd{Z} on a @file{.tar.gz} or @file{.tgz} archive file unpacks +all the files in the archive into a directory whose name is the +archive name with the extension removed. @findex dired-do-compress-to @kindex c @r{(Dired)} diff --git a/etc/NEWS b/etc/NEWS index 6dba2a950b..4197317fdd 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -51,6 +51,16 @@ often cause crashes. Set it to nil if you really need those fonts. * Changes in Specialized Modes and Packages in Emacs 26.2 +** Dired ++++ +*** The 'Z' command on a directory name compresses all of its files. +It produces a compressed '.tar.gz' archive with all the files in the +directory and all of its subdirectories. For symmetry, 'Z' on a +'.tar.gz' or a '.tgz' archive extracts all the archived files into a +directory whose name is the archive name sans the '.tar.gz' or '.tgz' +extension. (This change was actually made in Emacs 26.1, but was not +called out in its NEWS.) + ** Ibuffer --- commit 99f99a1fb227ec48f5325b6ccef5815c357b4792 Author: Eli Zaretskii Date: Fri Nov 16 09:54:56 2018 +0200 ; Minor editing change in windows.texi * doc/emacs/windows.texi (Window Convenience): Avoid breaking line in the middle of a key sequence. diff --git a/doc/emacs/windows.texi b/doc/emacs/windows.texi index 3369e986f9..0a05c37703 100644 --- a/doc/emacs/windows.texi +++ b/doc/emacs/windows.texi @@ -546,7 +546,7 @@ buffer. @xref{Follow Mode}. between neighboring windows in a frame. @kbd{M-x windmove-right} selects the window immediately to the right of the currently selected one, and similarly for the left, up, and down -counterparts. @kbd{M-x windmove-default-keybindings} binds these +counterparts. @w{@kbd{M-x windmove-default-keybindings}} binds these commands to @kbd{S-right} etc.; doing so disables shift selection for those keys (@pxref{Shift Selection}). commit 2cf9d9fed7de87a7b78fbc75a67a71fff00e8ffc Author: Juri Linkov Date: Fri Nov 16 01:40:15 2018 +0200 * lisp/windmove.el: Directional window display (bug#32790) * lisp/windmove.el (windmove-display-no-select): New defcustom. (windmove-display-in-direction, windmove-display-left) (windmove-display-up, windmove-display-right) (windmove-display-down, windmove-display-same-window) (windmove-display-default-keybindings): New functions. diff --git a/etc/NEWS b/etc/NEWS index 4f3b9a9a06..6e52f6cd1f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -304,6 +304,18 @@ back, customize follow-hide-ghost-cursors to nil. ** Windmove +*** Windmove supports directional window display and selection. +The new command windmove-display-default-keybindings binds default +keys with provided modifiers (by default, shift-meta) to the commands +that display the next buffer in the window at the specified direction. +This is like windmove-default-keybindings that binds keys to commands +that select the window in the specified direction, but additionally it +displays the buffer from the next command in that window. For example, +'S-M-right C-h i' displays the *Info* buffer in the right window, +creating the window if necessary. A special key can be customized to +display the buffer in the same window, for example, 'S-M-0 C-h e' +displays the *Messages* buffer in the same window. + *** windmove-create-window when non-nil makes a new window on moving off the edge of the frame. diff --git a/lisp/windmove.el b/lisp/windmove.el index c38524fede..898f87e2db 100644 --- a/lisp/windmove.el +++ b/lisp/windmove.el @@ -1,4 +1,4 @@ -;;; windmove.el --- directional window-selection routines +;;; windmove.el --- directional window-selection routines -*- lexical-binding:t -*- ;; ;; Copyright (C) 1998-2018 Free Software Foundation, Inc. ;; @@ -571,6 +571,112 @@ Default value of MODIFIERS is `shift'." (global-set-key (vector (append modifiers '(up))) 'windmove-up) (global-set-key (vector (append modifiers '(down))) 'windmove-down)) +;;; Directional window display and selection + +(defcustom windmove-display-no-select nil + "Whether the window should be selected after displaying the buffer in it." + :type 'boolean + :group 'windmove + :version "27.1") + +(defun windmove-display-in-direction (dir &optional arg) + "Display the next buffer in the window at direction DIR. +The next buffer is the buffer displayed by the next command invoked +immediately after this command (ignoring reading from the minibuffer). +Create a new window if there is no window in that direction. +By default, select the window with a displayed buffer. +If prefix ARG is `C-u', reselect a previously selected window. +If `windmove-display-no-select' is non-nil, this command doesn't +select the window with a displayed buffer, and the meaning of +the prefix argument is reversed." + (let* ((no-select (not (eq (consp arg) windmove-display-no-select))) ; xor + (old-window (or (minibuffer-selected-window) (selected-window))) + (new-window) + (minibuffer-depth (minibuffer-depth)) + (action display-buffer-overriding-action) + (command this-command) + (clearfun (make-symbol "clear-display-buffer-overriding-action")) + (exitfun + (lambda () + (setq display-buffer-overriding-action action) + (when (window-live-p (if no-select old-window new-window)) + (select-window (if no-select old-window new-window))) + (remove-hook 'post-command-hook clearfun)))) + (fset clearfun + (lambda () + (unless (or + ;; Remove the hook immediately + ;; after exiting the minibuffer. + (> (minibuffer-depth) minibuffer-depth) + ;; But don't remove immediately after + ;; adding the hook by the same command below. + (eq this-command command)) + (funcall exitfun)))) + (add-hook 'post-command-hook clearfun) + (push (lambda (buffer alist) + (unless (> (minibuffer-depth) minibuffer-depth) + (let ((window (if (eq dir 'same-window) + (selected-window) + (window-in-direction + dir nil nil + (and arg (prefix-numeric-value arg)) + windmove-wrap-around))) + (type 'reuse)) + (unless window + (setq window (split-window nil nil dir) type 'window)) + (setq new-window (window--display-buffer buffer window type alist))))) + display-buffer-overriding-action) + (message "[display-%s]" dir))) + +;;;###autoload +(defun windmove-display-left (&optional arg) + "Display the next buffer in window to the left of the current one. +See the logic of the prefix ARG in `windmove-display-in-direction'." + (interactive "P") + (windmove-display-in-direction 'left arg)) + +;;;###autoload +(defun windmove-display-up (&optional arg) + "Display the next buffer in window above the current one. +See the logic of the prefix ARG in `windmove-display-in-direction'." + (interactive "P") + (windmove-display-in-direction 'up arg)) + +;;;###autoload +(defun windmove-display-right (&optional arg) + "Display the next buffer in window to the right of the current one. +See the logic of the prefix ARG in `windmove-display-in-direction'." + (interactive "P") + (windmove-display-in-direction 'right arg)) + +;;;###autoload +(defun windmove-display-down (&optional arg) + "Display the next buffer in window below the current one. +See the logic of the prefix ARG in `windmove-display-in-direction'." + (interactive "P") + (windmove-display-in-direction 'down arg)) + +;;;###autoload +(defun windmove-display-same-window (&optional arg) + "Display the next buffer in the same window." + (interactive "P") + (windmove-display-in-direction 'same-window arg)) + +;;;###autoload +(defun windmove-display-default-keybindings (&optional modifiers) + "Set up keybindings for directional buffer display. +Keys are bound to commands that display the next buffer in the specified +direction. Keybindings are of the form MODIFIERS-{left,right,up,down}, +where MODIFIERS is either a list of modifiers or a single modifier. +Default value of MODIFIERS is `shift-meta'." + (interactive) + (unless modifiers (setq modifiers '(shift meta))) + (unless (listp modifiers) (setq modifiers (list modifiers))) + (global-set-key (vector (append modifiers '(left))) 'windmove-display-left) + (global-set-key (vector (append modifiers '(right))) 'windmove-display-right) + (global-set-key (vector (append modifiers '(up))) 'windmove-display-up) + (global-set-key (vector (append modifiers '(down))) 'windmove-display-down) + (global-set-key (vector (append modifiers '(?0))) 'windmove-display-same-window)) (provide 'windmove) commit f22a16ae066cc512322f115c2098837d74feeff8 Author: Juri Linkov Date: Fri Nov 16 01:09:54 2018 +0200 * lisp/windmove.el: Support more prefix args (bug#32790) * lisp/windmove.el (windmove-left, windmove-up, windmove-right) (windmove-down): Use prefix-numeric-value to support more prefix args like 'C-u' and 'M--'. Doc fix. diff --git a/etc/NEWS b/etc/NEWS index 76531f288f..4f3b9a9a06 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -371,6 +371,7 @@ To disable it, set the new defcustom 'diff-font-lock-refine' to nil. *** File headers can be shortened, mimicking Magit's diff format. To enable it, set the new defcustom 'diff-font-lock-prettify to t. ++++ *** Prefix arg of 'diff-goto-source' means jump to the old revision of the file under version control if point is on an old changed line, or to the new revision of the file otherwise. diff --git a/lisp/windmove.el b/lisp/windmove.el index 598e495c7a..c38524fede 100644 --- a/lisp/windmove.el +++ b/lisp/windmove.el @@ -481,8 +481,8 @@ DIR, ARG, and WINDOW are handled as by `windmove-other-window-loc'." "Move to the window at direction DIR. DIR, ARG, and WINDOW are handled as by `windmove-other-window-loc'. If no window is at direction DIR, an error is signaled. -If `windmove-create-window' is non-nil, instead of signalling an error -it creates a new window at direction DIR ." +If `windmove-create-window' is non-nil, try to create a new window +in direction DIR instead." (let ((other-window (windmove-find-other-window dir arg window))) (when (and windmove-create-window (or (null other-window) @@ -510,9 +510,9 @@ With no prefix argument, or with prefix argument equal to zero, it is relative to the top edge (for positive ARG) or the bottom edge \(for negative ARG) of the current window. If no window is at the desired location, an error is signaled -unless `windmove-create-window' is non-nil that creates a new window." +unless `windmove-create-window' is non-nil and a new window is created." (interactive "P") - (windmove-do-window-select 'left arg)) + (windmove-do-window-select 'left (and arg (prefix-numeric-value arg)))) ;;;###autoload (defun windmove-up (&optional arg) @@ -522,9 +522,9 @@ is relative to the position of point in the window; otherwise it is relative to the left edge (for positive ARG) or the right edge (for negative ARG) of the current window. If no window is at the desired location, an error is signaled -unless `windmove-create-window' is non-nil that creates a new window." +unless `windmove-create-window' is non-nil and a new window is created." (interactive "P") - (windmove-do-window-select 'up arg)) + (windmove-do-window-select 'up (and arg (prefix-numeric-value arg)))) ;;;###autoload (defun windmove-right (&optional arg) @@ -534,9 +534,9 @@ With no prefix argument, or with prefix argument equal to zero, otherwise it is relative to the top edge (for positive ARG) or the bottom edge (for negative ARG) of the current window. If no window is at the desired location, an error is signaled -unless `windmove-create-window' is non-nil that creates a new window." +unless `windmove-create-window' is non-nil and a new window is created." (interactive "P") - (windmove-do-window-select 'right arg)) + (windmove-do-window-select 'right (and arg (prefix-numeric-value arg)))) ;;;###autoload (defun windmove-down (&optional arg) @@ -546,9 +546,9 @@ With no prefix argument, or with prefix argument equal to zero, it is relative to the left edge (for positive ARG) or the right edge \(for negative ARG) of the current window. If no window is at the desired location, an error is signaled -unless `windmove-create-window' is non-nil that creates a new window." +unless `windmove-create-window' is non-nil and a new window is created." (interactive "P") - (windmove-do-window-select 'down arg)) + (windmove-do-window-select 'down (and arg (prefix-numeric-value arg)))) ;;; set up keybindings commit 13bb66537210aacd9841d592c94e2514f7c5aa3a Author: Eli Zaretskii Date: Thu Nov 15 21:59:32 2018 +0200 Fix a typo in the Emacs manual * doc/emacs/rmail.texi (Rmail Deletion): Fix a typo. Reported by Jorge P. de Morais Neto in emacs-manual-bugs@gnu.org diff --git a/doc/emacs/rmail.texi b/doc/emacs/rmail.texi index c0ea12f622..5241686cab 100644 --- a/doc/emacs/rmail.texi +++ b/doc/emacs/rmail.texi @@ -318,7 +318,7 @@ effect of a @kbd{d} command in most cases. It undeletes the current message if the current message is deleted. Otherwise it moves backward to previous messages until a deleted message is found, and undeletes that message. A numeric prefix argument serves as a repeat count, to -allow deletion of several messages in a single command. +allow undeletion of several messages in a single command. You can usually undo a @kbd{d} with a @kbd{u} because the @kbd{u} moves back to and undeletes the message that the @kbd{d} deleted. But commit a306d0397427870afea584233942e40cd78d16f7 Author: Paul Eggert Date: Sat Jan 20 19:12:05 2018 -0800 Fix tempfile creation when byte compiling This improves on the recent fix for master failing to build on FreeBSD. Suggested by Stefan Monnier in: https://lists.gnu.org/r/emacs-devel/2018-01/msg00600.html * lisp/emacs-lisp/bytecomp.el (byte-compile-file): Put tempfile next to the target file, as was the original intent. (cherry picked from commit 64c846738617d1d037eac0cefb6586c04317b0a1) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 68e2fd1d10..bc65f2cfaf 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1938,17 +1938,7 @@ The value is non-nil if there were no errors, nil if errors." ;; parallel bootstrap), it does not risk getting a ;; half-finished file. (Bug#4196) (tempfile - (if (file-name-absolute-p target-file) - (make-temp-file target-file) - ;; If target-file is relative and includes - ;; leading directories, make-temp-file will - ;; assume those leading directories exist - ;; under temporary-file-directory, which might - ;; not be true. So strip leading directories - ;; from relative file names before calling - ;; make-temp-file. - (make-temp-file - (file-name-nondirectory target-file)))) + (make-temp-file (expand-file-name target-file))) (default-modes (default-file-modes)) (temp-modes (logand default-modes #o600)) (desired-modes (logand default-modes #o666)) commit ce915653df74166fe6eb5783d57619b73cd74681 Author: Michael Albinus Date: Thu Nov 15 13:55:23 2018 +0100 Fix Bug#33394 * lisp/net/trampver.el (tramp-repository-branch) (tramp-repository-version): Handle out-of-tree builds. (Bug#33394) diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index f93e538084..d9b152e2bf 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -40,20 +40,26 @@ (defconst tramp-repository-branch (ignore-errors - ;; Suppress message from `emacs-repository-get-branch'. - (let ((inhibit-message t)) + ;; Suppress message from `emacs-repository-get-branch'. We must + ;; also handle out-of-tree builds. + (let ((inhibit-message t) + (dir (or (locate-dominating-file (locate-library "tramp") ".git") + source-directory))) ;; `emacs-repository-get-branch' has been introduced with Emacs 27.1. (with-no-warnings - (emacs-repository-get-branch - (locate-dominating-file (locate-library "tramp") ".git"))))) + (and (stringp dir) (file-directory-p dir) + (emacs-repository-get-branch dir))))) "The repository branch of the Tramp sources.") (defconst tramp-repository-version (ignore-errors - ;; Suppress message from `emacs-repository-get-version'. - (let ((inhibit-message t)) - (emacs-repository-get-version - (locate-dominating-file (locate-library "tramp") ".git")))) + ;; Suppress message from `emacs-repository-get-version'. We must + ;; also handle out-of-tree builds. + (let ((inhibit-message t) + (dir (or (locate-dominating-file (locate-library "tramp") ".git") + source-directory))) + (and (stringp dir) (file-directory-p dir) + (emacs-repository-get-version dir)))) "The repository revision of the Tramp sources.") ;; Check for Emacs version. commit 35a88c809e9eb5a32dd8d7f0dae960021f4cd707 Author: Juri Linkov Date: Thu Nov 15 00:23:47 2018 +0200 Isearch hit count. (Bug#29321) * lisp/isearch.el (isearch-lazy-count): New defcustom. (lazy-count): New defgroup. (lazy-count-prefix-format, lazy-count-suffix-format): New defcustom. (isearch-lazy-count-format): New function. (isearch-message-prefix, isearch-message-suffix): Use it. (isearch-lazy-highlight-window-start-changed) (isearch-lazy-highlight-window-end-changed) (isearch-lazy-count-current, isearch-lazy-count-total) (isearch-lazy-count-hash): New variables. (isearch-lazy-highlight-new-loop): Reset isearch-lazy-count-total and update isearch-lazy-count-current for isearch-message. (isearch-lazy-highlight-update): Run full-buffer loop for isearch-lazy-count. (isearch-lazy-highlight-buffer-update): Count isearch-lazy-count-total. Set isearch-lazy-count-current at the end. diff --git a/etc/NEWS b/etc/NEWS index dff7c5d0d5..76531f288f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -621,6 +621,12 @@ can now be searched via 'C-s'. ** Search and Replace +*** isearch-lazy-count shows the current match number and total number +of matches in the Isearch prompt. Customizable variables +lazy-count-prefix-format and lazy-count-suffix-format define the +format of the current and the total number of matches in the prompt's +prefix and suffix respectively. + *** lazy-highlight-buffer highlights matches in the full buffer. It is useful in combination with lazy-highlight-cleanup customized to nil to leave matches highlighted in the whole buffer after exiting isearch. diff --git a/lisp/isearch.el b/lisp/isearch.el index 42b3aa42ba..035ff69327 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -316,6 +316,16 @@ this variable is set to the symbol `all-windows'." :group 'lazy-highlight :group 'isearch) +(defcustom isearch-lazy-count nil + "Show match numbers in the search prompt. +When both this option and `isearch-lazy-highlight' are non-nil, +show the current match number and the total number of matches +in the buffer (or its restriction)." + :type 'boolean + :group 'lazy-count + :group 'isearch + :version "27.1") + ;;; Lazy highlight customization. (defgroup lazy-highlight nil @@ -386,6 +396,29 @@ and doesn't remove full-buffer highlighting after a search." :group 'lazy-highlight :group 'basic-faces) +;;; Lazy count customization. + +(defgroup lazy-count nil + "Lazy counting feature for reporting the number of matches." + :prefix "lazy-count-" + :version "27.1" + :group 'isearch + :group 'matching) + +(defcustom lazy-count-prefix-format "%s/%s " + "Format of the current/total number of matches for the prompt prefix." + :type '(choice (const :tag "No prefix" nil) + (string :tag "Prefix format string" "%s/%s ")) + :group 'lazy-count + :version "27.1") + +(defcustom lazy-count-suffix-format nil + "Format of the current/total number of matches for the prompt suffix." + :type '(choice (const :tag "No suffix" nil) + (string :tag "Suffix format string" " [%s of %s]")) + :group 'lazy-count + :version "27.1") + ;; Define isearch help map. @@ -2794,7 +2827,8 @@ the word mode." (concat " [" current-input-method-title "]: ")) ": ") ))) - (propertize (concat (upcase (substring m 0 1)) (substring m 1)) + (propertize (concat (isearch-lazy-count-format) + (upcase (substring m 0 1)) (substring m 1)) 'face 'minibuffer-prompt))) (defun isearch-message-suffix (&optional c-q-hack) @@ -2802,9 +2836,33 @@ the word mode." (if isearch-error (concat " [" isearch-error "]") "") + (isearch-lazy-count-format 'suffix) (or isearch-message-suffix-add "")) 'face 'minibuffer-prompt)) +(defun isearch-lazy-count-format (&optional suffix-p) + "Format the current match number and the total number of matches. +When SUFFIX-P is non-nil, the returned string is indended for +isearch-message-suffix prompt. Otherwise, for isearch-message-prefix." + (let ((format-string (if suffix-p + lazy-count-suffix-format + lazy-count-prefix-format))) + (if (and format-string + isearch-lazy-count + isearch-lazy-count-current + (not isearch-error) + (not isearch-suspended)) + (format format-string + (if isearch-forward + isearch-lazy-count-current + (if (eq isearch-lazy-count-current 0) + 0 + (- isearch-lazy-count-total + isearch-lazy-count-current + -1))) + (or isearch-lazy-count-total "?")) + ""))) + ;; Searching @@ -3202,6 +3260,8 @@ since they have special meaning in a regexp." (defvar isearch-lazy-highlight-window-group nil) (defvar isearch-lazy-highlight-window-start nil) (defvar isearch-lazy-highlight-window-end nil) +(defvar isearch-lazy-highlight-window-start-changed nil) +(defvar isearch-lazy-highlight-window-end-changed nil) (defvar isearch-lazy-highlight-point-min nil) (defvar isearch-lazy-highlight-point-max nil) (defvar isearch-lazy-highlight-buffer nil) @@ -3214,6 +3274,9 @@ since they have special meaning in a regexp." (defvar isearch-lazy-highlight-regexp-function nil) (defvar isearch-lazy-highlight-forward nil) (defvar isearch-lazy-highlight-error nil) +(defvar isearch-lazy-count-current nil) +(defvar isearch-lazy-count-total nil) +(defvar isearch-lazy-count-hash (make-hash-table)) (defun lazy-highlight-cleanup (&optional force procrastinate) "Stop lazy highlighting and remove extra highlighting from current buffer. @@ -3258,18 +3321,41 @@ by other Emacs features." ;; In case we are recovering from an error. (not (equal isearch-error isearch-lazy-highlight-error)) - (not (if lazy-highlight-buffer - (= (point-min) - isearch-lazy-highlight-point-min) - (= (window-group-start) - isearch-lazy-highlight-window-start))) - (not (if lazy-highlight-buffer - (= (point-max) - isearch-lazy-highlight-point-max) - (= (window-group-end) ; Window may have been split/joined. - isearch-lazy-highlight-window-end))))) + (if lazy-highlight-buffer + (not (= (point-min) + isearch-lazy-highlight-point-min)) + (setq isearch-lazy-highlight-window-start-changed + (not (= (window-group-start) + isearch-lazy-highlight-window-start)))) + (if lazy-highlight-buffer + (not (= (point-max) + isearch-lazy-highlight-point-max)) + (setq isearch-lazy-highlight-window-end-changed + (not (= (window-group-end) ; Window may have been split/joined. + isearch-lazy-highlight-window-end)))))) ;; something important did indeed change (lazy-highlight-cleanup t (not (equal isearch-string ""))) ;stop old timer + (when isearch-lazy-count + (when (or (equal isearch-string "") + ;; Check if this place was reached by a condition above + ;; other than changed window boundaries (that shouldn't + ;; reset the counter) + (and (not isearch-lazy-highlight-window-start-changed) + (not isearch-lazy-highlight-window-end-changed)) + ;; Also check for changes in buffer boundaries in + ;; a possibly narrowed buffer in case lazy-highlight-buffer + ;; is nil, thus the same check was not performed above + (not (= (point-min) + isearch-lazy-highlight-point-min)) + (not (= (point-max) + isearch-lazy-highlight-point-max))) + ;; Reset old counter before going to count new numbers + (clrhash isearch-lazy-count-hash) + (setq isearch-lazy-count-current nil + isearch-lazy-count-total nil) + (funcall (or isearch-message-function #'isearch-message)))) + (setq isearch-lazy-highlight-window-start-changed nil) + (setq isearch-lazy-highlight-window-end-changed nil) (setq isearch-lazy-highlight-error isearch-error) ;; It used to check for `(not isearch-error)' here, but actually ;; lazy-highlighting might find matches to highlight even when @@ -3313,7 +3399,16 @@ by other Emacs features." (unless (equal isearch-string "") (setq isearch-lazy-highlight-timer (run-with-idle-timer lazy-highlight-initial-delay nil - 'isearch-lazy-highlight-start))))) + 'isearch-lazy-highlight-start)))) + ;; Update the current match number only in isearch-mode and + ;; unless isearch-mode is used specially with isearch-message-function + (when (and isearch-lazy-count isearch-mode (null isearch-message-function)) + ;; Update isearch-lazy-count-current only when it was already set + ;; at the end of isearch-lazy-highlight-buffer-update + (when isearch-lazy-count-current + (setq isearch-lazy-count-current + (gethash (point) isearch-lazy-count-hash 0)) + (isearch-message nil t)))) (defun isearch-lazy-highlight-search (string bound) "Search ahead for the next or previous match, for lazy highlighting. @@ -3434,7 +3529,8 @@ Attempt to do the search exactly the way the pending Isearch would." (goto-char (min (or isearch-lazy-highlight-end-limit (point-max)) window-end))))))) (if nomore - (when isearch-lazy-highlight-buffer + (when (or isearch-lazy-highlight-buffer + (and isearch-lazy-count (null isearch-lazy-count-current))) (if isearch-lazy-highlight-forward (setq isearch-lazy-highlight-end (point-min)) (setq isearch-lazy-highlight-start (point-max))) @@ -3448,7 +3544,8 @@ Attempt to do the search exactly the way the pending Isearch would." "Update highlighting of other matches in the full buffer." (let ((max lazy-highlight-buffer-max-at-a-time) (looping t) - nomore window-start window-end) + nomore window-start window-end + (opoint (point))) (with-local-quit (save-selected-window (if (and (window-live-p isearch-lazy-highlight-window) @@ -3483,8 +3580,18 @@ Attempt to do the search exactly the way the pending Isearch would." (if (= mb (point-min)) (setq found nil) (forward-char -1))) - ;; Already highlighted by isearch-lazy-highlight-update - (unless (and (>= mb window-start) (<= me window-end)) + (when isearch-lazy-count + (setq isearch-lazy-count-total + (1+ (or isearch-lazy-count-total 0))) + (puthash (if isearch-lazy-highlight-forward me mb) + isearch-lazy-count-total + isearch-lazy-count-hash)) + ;; Don't highlight the match when this loop is used + ;; only to count matches or when matches were already + ;; highlighted within the current window boundaries + ;; by isearch-lazy-highlight-update + (unless (or (not isearch-lazy-highlight-buffer) + (and (>= mb window-start) (<= me window-end))) ;; non-zero-length match (isearch-lazy-highlight-match mb me))) ;; Remember the current position of point for @@ -3498,7 +3605,13 @@ Attempt to do the search exactly the way the pending Isearch would." (if (not found) (setq looping nil nomore t)))) - (unless nomore + (if nomore + (when (and isearch-lazy-count isearch-mode (null isearch-message-function)) + (unless isearch-lazy-count-total + (setq isearch-lazy-count-total 0)) + (setq isearch-lazy-count-current + (gethash opoint isearch-lazy-count-hash 0)) + (isearch-message nil t)) (setq isearch-lazy-highlight-timer (run-at-time lazy-highlight-interval nil 'isearch-lazy-highlight-buffer-update))))))))) commit 5fe81ebbb52a82ed13635df4861039ac7ed42022 Author: Eli Zaretskii Date: Wed Nov 14 21:45:41 2018 +0200 Minor copyedits in documentation of HOME handling * etc/NEWS: Reword the recent entry regarding the change in how relative file names are interpreted in $HOME. * doc/emacs/cmdargs.texi (General Variables): Advise against using relative directory names in $HOME. diff --git a/doc/emacs/cmdargs.texi b/doc/emacs/cmdargs.texi index 25a2526888..960398df08 100644 --- a/doc/emacs/cmdargs.texi +++ b/doc/emacs/cmdargs.texi @@ -528,16 +528,17 @@ This variable defaults to @file{~/.bash_history} if you use Bash, to otherwise. @item HOME @vindex HOME@r{, environment variable} -The location of your files in the directory tree; used for -expansion of file names starting with a tilde (@file{~}). -If set to a relative file name, Emacs expands @file{~} to the -corresponding absolute file name. If unset, it normally defaults to -the home directory of the user given by @env{LOGNAME}, @env{USER} or -your user ID, or to @file{/} if all else fails. On MS-DOS, -it defaults to the directory from which Emacs was started, with -@samp{/bin} removed from the end if it was present. On Windows, the -default value of @env{HOME} is the @file{Application Data} -subdirectory of the user profile directory (normally, this is +The location of your files in the directory tree; used for expansion +of file names starting with a tilde (@file{~}). If set, it should be +set to an absolute file name. (If set to a relative file name, Emacs +interprets it relative to the directory where Emacs was started, but +we don't recommend to use this feature.) If unset, @env{HOME} +normally defaults to the home directory of the user given by +@env{LOGNAME}, @env{USER} or your user ID, or to @file{/} if all else +fails. On MS-DOS, it defaults to the directory from which Emacs was +started, with @samp{/bin} removed from the end if it was present. On +Windows, the default value of @env{HOME} is the @file{Application +Data} subdirectory of the user profile directory (normally, this is @file{C:/Documents and Settings/@var{username}/Application Data}, where @var{username} is your user name), though for backwards compatibility @file{C:/} will be used instead if a @file{.emacs} file diff --git a/etc/NEWS b/etc/NEWS index 6577c82252..dff7c5d0d5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -961,9 +961,12 @@ its default value changed in Emacs 27.1. ** The REPETITIONS argument of 'benchmark-run' can now also be a variable. -** If $HOME is a relative file name, 'expand-file-name' now expands -"~" and leading "~/" to the corresponding absolute file name. -Formerly, it incorrectly expanded them to a relative file name. +** Interpretation of relative HOME directory has changed. +If $HOME is set to a relative file name, 'expand-file-name' now +interprets it relative to the directory where Emacs was started, not +relative to the default-directory of the current buffer. We recommend +always setting $HOME to an absolute file name, so that its meaning is +independent of where Emacs was started. ** The FILENAME argument to 'file-name-base' is now mandatory and no longer defaults to 'buffer-file-name'. commit b1bb7917c15f880dc1c913a1e7c150396af873dc Author: Paul Eggert Date: Wed Nov 14 11:42:59 2018 -0800 Fix probing for pre-1970 DST * lisp/calendar/cal-dst.el (calendar-next-time-zone-transition): Fix recently-introduced rounding bug when probing for DST transitions before 1970 (Bug#33380). diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el index 25264bda09..8392e81b16 100644 --- a/lisp/calendar/cal-dst.el +++ b/lisp/calendar/cal-dst.el @@ -154,7 +154,7 @@ Return nil if no such transition can be found." (while ;; Set PROBE to halfway between LO and HI, rounding down. ;; If PROBE equals LO, we are done. - (not (= lo (setq probe (/ (+ lo hi) 2)))) + (not (= lo (setq probe (floor (+ lo hi) 2)))) ;; Set either LO or HI to PROBE, depending on probe results. (if (eq (car (current-time-zone probe)) hi-utc-diff) (setq hi probe) commit 454f7923a7de9f65f55050dfab48eefc40d0ce29 Author: Paul Eggert Date: Wed Nov 14 09:31:28 2018 -0800 Document recent change to HOME handling * doc/emacs/cmdargs.texi (General Variables): * doc/emacs/custom.texi (Find Init): * doc/lispref/files.texi (File Name Expansion): * etc/NEWS: Document behavior when HOME is a relative file name. diff --git a/doc/emacs/cmdargs.texi b/doc/emacs/cmdargs.texi index 2e2767ccad..25a2526888 100644 --- a/doc/emacs/cmdargs.texi +++ b/doc/emacs/cmdargs.texi @@ -529,7 +529,11 @@ otherwise. @item HOME @vindex HOME@r{, environment variable} The location of your files in the directory tree; used for -expansion of file names starting with a tilde (@file{~}). On MS-DOS, +expansion of file names starting with a tilde (@file{~}). +If set to a relative file name, Emacs expands @file{~} to the +corresponding absolute file name. If unset, it normally defaults to +the home directory of the user given by @env{LOGNAME}, @env{USER} or +your user ID, or to @file{/} if all else fails. On MS-DOS, it defaults to the directory from which Emacs was started, with @samp{/bin} removed from the end if it was present. On Windows, the default value of @env{HOME} is the @file{Application Data} diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index ddde5b22e6..3dbe8f8003 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -2557,10 +2557,9 @@ library. @xref{Hooks}. @node Find Init @subsection How Emacs Finds Your Init File - Normally Emacs uses the environment variable @env{HOME} -(@pxref{General Variables, HOME}) to find @file{.emacs}; that's what -@samp{~} means in a file name. If @file{.emacs} is not found inside -@file{~/} (nor @file{.emacs.el}), Emacs looks for + Normally Emacs uses your home directory to find @file{~/.emacs}; +that's what @samp{~} means in a file name. @xref{General Variables, HOME}. +If neither @file{~/.emacs} nor @file{~/.emacs.el} is found, Emacs looks for @file{~/.emacs.d/init.el} (which, like @file{~/.emacs.el}, can be byte-compiled). diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 5682919b64..b795864815 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -2367,8 +2367,10 @@ start with @samp{~}.) Otherwise, the current buffer's value of @end example If the part of @var{filename} before the first slash is -@samp{~}, it expands to the value of the @env{HOME} environment -variable (usually your home directory). If the part before the first +@samp{~}, it expands to your home directory, which is typically +specified by the value of the @env{HOME} environment variable +(@pxref{General Variables,,, emacs, The GNU Emacs Manual}). +If the part before the first slash is @samp{~@var{user}} and if @var{user} is a valid login name, it expands to @var{user}'s home directory. If you do not want this expansion for a relative @var{filename} that diff --git a/etc/NEWS b/etc/NEWS index 44f54894cd..6577c82252 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -961,6 +961,10 @@ its default value changed in Emacs 27.1. ** The REPETITIONS argument of 'benchmark-run' can now also be a variable. +** If $HOME is a relative file name, 'expand-file-name' now expands +"~" and leading "~/" to the corresponding absolute file name. +Formerly, it incorrectly expanded them to a relative file name. + ** The FILENAME argument to 'file-name-base' is now mandatory and no longer defaults to 'buffer-file-name'. commit edcd6b722c8e495498b1619e4d073962b8a8f3e8 Author: Markus Triska Date: Tue Nov 13 22:42:01 2018 +0100 Small documentation correction. * doc/lispref/windows.texi (Textual Scrolling): In the description of scroll-up-aggressively, refer to scroll-down-aggressively instead of a recursive reference to scroll-up-aggressively. (Bug#33369) diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 106074e13d..e9bd0c7d83 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -4908,7 +4908,8 @@ fashion. @defopt scroll-up-aggressively Likewise, for scrolling up. The value, @var{f}, specifies how far point should be placed from the bottom of the window; thus, as with -@code{scroll-up-aggressively}, a larger value scrolls more aggressively. +@code{scroll-down-aggressively}, a larger value scrolls more +aggressively. @end defopt @defopt scroll-step commit 168a8c258c820804d7a57db59b7e0d986312f227 Author: Eli Zaretskii Date: Wed Nov 14 17:59:05 2018 +0200 * src/coding.c (Fcheck_coding_systems_region): Doc fix. (Bug#33372) diff --git a/src/coding.c b/src/coding.c index 867f84de60..3b1d8c9504 100644 --- a/src/coding.c +++ b/src/coding.c @@ -9207,22 +9207,22 @@ to the string and treated as in `substring'. */) DEFUN ("check-coding-systems-region", Fcheck_coding_systems_region, Scheck_coding_systems_region, 3, 3, 0, - doc: /* Check if the region is encodable by coding systems. + doc: /* Check if text between START and END is encodable by CODING-SYSTEM-LIST. START and END are buffer positions specifying the region. CODING-SYSTEM-LIST is a list of coding systems to check. -The value is an alist ((CODING-SYSTEM POS0 POS1 ...) ...), where -CODING-SYSTEM is a member of CODING-SYSTEM-LIST and can't encode the -whole region, POS0, POS1, ... are buffer positions where non-encodable -characters are found. - If all coding systems in CODING-SYSTEM-LIST can encode the region, the -value is nil. +function returns nil. + +If some of the coding systems cannot encode the whole region, value is +an alist, each element of which has the form (CODING-SYSTEM POS1 POS2 ...), +which means that CODING-SYSTEM cannot encode the text at buffer positions +POS1, POS2, ... START may be a string. In that case, check if the string is -encodable, and the value contains indices to the string instead of -buffer positions. END is ignored. +encodable, and the value contains character indices into the string +instead of buffer positions. END is ignored in this case. If the current buffer (or START if it is a string) is unibyte, the value is nil. */) commit fb2514f3e29c140735e2ffccda4affffdb5b253d Author: Eli Zaretskii Date: Wed Nov 14 17:28:13 2018 +0200 Fix a thinko in fileio.c * src/fileio.c (get_homedir): Fix last change. Suggested by Paul Eggert . diff --git a/src/fileio.c b/src/fileio.c index 59446ac183..d9795715f9 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -1663,7 +1663,7 @@ get_homedir (void) /* getpw* functions return UTF-8 encoded file names, whereas egetenv returns strings in locale encoding, so we need to convert for consistency. */ - char homedir_utf8[MAX_UTF8_PATH]; + static char homedir_utf8[MAX_UTF8_PATH]; if (home) { filename_from_ansi (home, homedir_utf8); commit 3287a7c048c0c2efc9da59ecd4a12f56f42bb044 Author: Michael Albinus Date: Wed Nov 14 16:19:39 2018 +0100 Fix Bug#33364 * lisp/net/tramp.el (tramp-parse-sconfig-group): Support also "Host host1 host2 ..." syntax. (Bug#33364) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 98ec8415c7..e9f5f7d434 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2739,7 +2739,9 @@ User is always nil." "Return a (user host) tuple allowed to access. User is always nil." (tramp-parse-group - (concat "^[ \t]*Host[ \t]+" "\\(" tramp-host-regexp "\\)") 1 ",")) + (concat "\\(?:^[ \t]*Host\\)" "\\|" "\\(?:^.+\\)" + "\\|" "\\(" tramp-host-regexp "\\)") + 1 "[ \t]+")) ;; Generic function. (defun tramp-parse-shostkeys-sknownhosts (dirname regexp) commit f561c6a1124d4a1d79c264a9cb79ac0e7cb1650f Author: Juri Linkov Date: Wed Nov 14 02:23:04 2018 +0200 New option vc-find-revision-no-save to not write revision to file * lisp/vc/vc.el (vc-find-revision-no-save): New defcustom (bug#33319). (vc-find-revision): Depending on vc-find-revision-no-save, call either vc-find-revision-no-save or vc-find-revision-save. (vc-find-revision-save): Rename from vc-find-revision. (vc-find-revision-no-save): New function. * lisp/vc/diff-mode.el (diff-find-source-location): Let-bind vc-find-revision-no-save to t. diff --git a/etc/NEWS b/etc/NEWS index 2a2010e9d3..44f54894cd 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -344,6 +344,9 @@ still be used if it exists.) Set the variable to nil to get the previous behavior of always creating a buffer that visits a ChangeLog file. +*** New customizable variable 'vc-find-revision-no-save'. +With non-nil, 'vc-find-revision' doesn't write the created buffer to file. + *** New customizable variable 'vc-git-grep-template'. This new variable allows customizing the default arguments passed to git-grep when 'vc-git-grep' is used. diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 8539423eed..b86c17fe36 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -56,6 +56,7 @@ (eval-when-compile (require 'cl-lib)) (autoload 'vc-find-revision "vc") +(defvar vc-find-revision-no-save) (defvar add-log-buffer-file-name-function) @@ -1743,7 +1744,8 @@ NOPROMPT, if non-nil, means not to prompt the user." (revision (and other diff-vc-backend (nth (if reverse 1 0) diff-vc-revisions))) (buf (if revision - (vc-find-revision file revision diff-vc-backend) + (let ((vc-find-revision-no-save t)) + (vc-find-revision file revision diff-vc-backend)) (find-file-noselect file)))) ;; Update the user preference if he so wished. (when (> (prefix-numeric-value other-file) 8) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 6b7ca02440..de43544864 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -871,6 +871,12 @@ is sensitive to blank lines." (string :tag "Comment End"))) :group 'vc) +(defcustom vc-find-revision-no-save nil + "If non-nil, `vc-find-revision' doesn't write the created buffer to file." + :type 'boolean + :group 'vc + :version "27.1") + ;; File property caching @@ -1953,6 +1959,13 @@ If `F.~REV~' already exists, use it instead of checking it out again." (defun vc-find-revision (file revision &optional backend) "Read REVISION of FILE into a buffer and return the buffer. Use BACKEND as the VC backend if specified." + (if vc-find-revision-no-save + (vc-find-revision-no-save file revision backend) + (vc-find-revision-save file revision backend))) + +(defun vc-find-revision-save (file revision &optional backend) + "Read REVISION of FILE into a buffer and return the buffer. +Saves the buffer to the file." (let ((automatic-backup (vc-version-backup-file-name file revision)) (filebuf (or (get-file-buffer file) (current-buffer))) (filename (vc-version-backup-file-name file revision 'manual))) @@ -1985,6 +1998,38 @@ Use BACKEND as the VC backend if specified." (set (make-local-variable 'vc-parent-buffer) filebuf)) result-buf))) +(defun vc-find-revision-no-save (file revision &optional backend) + "Read REVISION of FILE into a buffer and return the buffer. +Unlike `vc-find-revision-save', doesn't save the created buffer to file." + (let ((filebuf (or (get-file-buffer file) (current-buffer))) + (filename (vc-version-backup-file-name file revision 'manual))) + (unless (or (get-file-buffer filename) + (file-exists-p filename)) + (with-current-buffer filebuf + (let ((failed t)) + (unwind-protect + (let ((coding-system-for-read 'no-conversion) + (coding-system-for-write 'no-conversion)) + (with-current-buffer (create-file-buffer filename) + (setq buffer-file-name filename) + (let ((outbuf (current-buffer))) + (with-current-buffer filebuf + (if backend + (vc-call-backend backend 'find-revision file revision outbuf) + (vc-call find-revision file revision outbuf)))) + (goto-char (point-min)) + (normal-mode) + (set-buffer-modified-p nil) + (setq buffer-read-only t)) + (setq failed nil)) + (when (and failed (get-file-buffer filename)) + (kill-buffer (get-file-buffer filename))))))) + (let ((result-buf (or (get-file-buffer filename) + (find-file-noselect filename)))) + (with-current-buffer result-buf + (set (make-local-variable 'vc-parent-buffer) filebuf)) + result-buf))) + ;; Header-insertion code ;;;###autoload commit 2ccfb4b5f43b7592af4efe943c24741370f3eb86 Author: Juri Linkov Date: Wed Nov 14 02:14:52 2018 +0200 Support VC revisions in diff-goto-source (bug#33319) * lisp/vc/diff-mode.el (diff-vc-revisions): New defvar. (diff-find-source-location): Call vc-find-revision for non-nil values of 'other', diff-vc-backend, diff-vc-revisions. * lisp/vc/vc.el (vc-diff-internal): Set buffer-local diff-vc-revisions to the list of used revisions. * doc/emacs/files.texi (Diff Mode): Update diff-goto-source for VC-related prefix argument. diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 649fa8bcb4..b47be51e24 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -1530,6 +1530,10 @@ default jumps to the ``old'' file, and the meaning of the prefix argument is reversed. If the prefix argument is a number greater than 8 (e.g., if you type @kbd{C-u C-u C-c C-c}), then this command also sets @code{diff-jump-to-old-file} for the next invocation. +If the source file is under version control (@pxref{Version Control}), +this jumps to the work file by default. With a prefix argument, jump +to the ``old'' revision of the file (@pxref{Old Revisions}), when +point is on the old line, or otherwise jump to the ``new'' revision. @item C-c C-e @findex diff-ediff-patch diff --git a/etc/NEWS b/etc/NEWS index 2f07abb4eb..2a2010e9d3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -368,6 +368,10 @@ To disable it, set the new defcustom 'diff-font-lock-refine' to nil. *** File headers can be shortened, mimicking Magit's diff format. To enable it, set the new defcustom 'diff-font-lock-prettify to t. +*** Prefix arg of 'diff-goto-source' means jump to the old revision +of the file under version control if point is on an old changed line, +or to the new revision of the file otherwise. + ** Browse-url *** The function 'browse-url-emacs' can now visit a URL in selected window. diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index cf52368508..8539423eed 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -55,6 +55,7 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) +(autoload 'vc-find-revision "vc") (defvar add-log-buffer-file-name-function) @@ -104,6 +105,9 @@ when editing big diffs)." (defvar diff-vc-backend nil "The VC backend that created the current Diff buffer, if any.") +(defvar diff-vc-revisions nil + "The VC revisions compared in the current Diff buffer, if any.") + (defvar diff-outline-regexp "\\([*+][*+][*+] [^0-9]\\|@@ ...\\|\\*\\*\\* [0-9].\\|--- [0-9]..\\)") @@ -1736,7 +1740,11 @@ NOPROMPT, if non-nil, means not to prompt the user." (match-string 1))))) (file (or (diff-find-file-name other noprompt) (error "Can't find the file"))) - (buf (find-file-noselect file))) + (revision (and other diff-vc-backend + (nth (if reverse 1 0) diff-vc-revisions))) + (buf (if revision + (vc-find-revision file revision diff-vc-backend) + (find-file-noselect file)))) ;; Update the user preference if he so wished. (when (> (prefix-numeric-value other-file) 8) (setq diff-jump-to-old-file other)) @@ -1862,7 +1870,11 @@ With a prefix argument, try to REVERSE the hunk." `diff-jump-to-old-file' (or its opposite if the OTHER-FILE prefix arg is given) determines whether to jump to the old or the new file. If the prefix arg is bigger than 8 (for example with \\[universal-argument] \\[universal-argument]) -then `diff-jump-to-old-file' is also set, for the next invocations." +then `diff-jump-to-old-file' is also set, for the next invocations. + +Under version control, the OTHER-FILE prefix arg means jump to the old +revision of the file if point is on an old changed line, or to the new +revision of the file otherwise." (interactive (list current-prefix-arg last-input-event)) ;; When pointing at a removal line, we probably want to jump to ;; the old location, and else to the new (i.e. as if reverting). diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index dcfbf26e86..6b7ca02440 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -987,6 +987,7 @@ Within directories, only files already under version control are noticed." (defvar log-view-vc-backend) (defvar log-edit-vc-backend) (defvar diff-vc-backend) +(defvar diff-vc-revisions) (defun vc-deduce-backend () (cond ((derived-mode-p 'vc-dir-mode) vc-dir-backend) @@ -1728,6 +1729,7 @@ Return t if the buffer had changes, nil otherwise." (set-buffer buffer) (diff-mode) (set (make-local-variable 'diff-vc-backend) (car vc-fileset)) + (set (make-local-variable 'diff-vc-revisions) (list rev1 rev2)) (set (make-local-variable 'revert-buffer-function) (lambda (_ignore-auto _noconfirm) (vc-diff-internal async vc-fileset rev1 rev2 verbose))) commit 4a5a17507fe1e12ee02c174350edc479fb01ac01 Author: Eli Zaretskii Date: Tue Nov 13 22:01:57 2018 +0200 Fix recent change in fileio.c * src/fileio.c (get_homedir) [WINDOWSNT]: Convert $HOME to UTF-8. (Fexpand_file_name): Don't convert it here. diff --git a/src/fileio.c b/src/fileio.c index e178c39fc1..59446ac183 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -1096,18 +1096,7 @@ the root directory. */) newdir = get_homedir (); nm++; -#ifdef WINDOWSNT - if (newdir[0]) - { - char newdir_utf8[MAX_UTF8_PATH]; - - filename_from_ansi (newdir, newdir_utf8); - tem = make_unibyte_string (newdir_utf8, strlen (newdir_utf8)); - newdir = SSDATA (tem); - } - else -#endif - tem = build_string (newdir); + tem = build_string (newdir); newdirlim = newdir + SBYTES (tem); /* get_homedir may return a unibyte string, which will bite us if we expect the directory to be multibyte. */ @@ -1669,6 +1658,19 @@ char const * get_homedir (void) { char const *home = egetenv ("HOME"); + +#ifdef WINDOWSNT + /* getpw* functions return UTF-8 encoded file names, whereas egetenv + returns strings in locale encoding, so we need to convert for + consistency. */ + char homedir_utf8[MAX_UTF8_PATH]; + if (home) + { + filename_from_ansi (home, homedir_utf8); + home = homedir_utf8; + } +#endif + if (!home) { static char const *userenv[] = {"LOGNAME", "USER"}; commit 1b27c4890d68882ef27eabe9984b6f5cfcc1b265 Author: Glenn Morris Date: Tue Nov 13 14:47:35 2018 -0500 No need to pass absolute program name to call-process * lisp/doc-view.el (doc-view-revert-buffer): * lisp/net/eudcb-mab.el (eudc-mab-query-internal): Remove superfluous executable-find. diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 31e266fb50..6f1143ba85 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -452,7 +452,7 @@ Typically \"page-%s.png\".") ;; file. (TODO: We'd like to have something like that also ;; for other types, at least PS, but I don't know a good way ;; to test if a PS file is complete.) - (if (= 0 (call-process (executable-find "pdfinfo") nil nil nil + (if (= 0 (call-process "pdfinfo" nil nil nil doc-view--buffer-file-name)) (revert) (when (called-interactively-p 'interactive) diff --git a/lisp/net/eudcb-mab.el b/lisp/net/eudcb-mab.el index a69c77b723..4d517c1995 100644 --- a/lisp/net/eudcb-mab.el +++ b/lisp/net/eudcb-mab.el @@ -61,8 +61,7 @@ RETURN-ATTRS is a list of attributes to return, defaulting to (goto-char (point-min)) (when (or (eobp) (time-less-p eudc-buffer-time modified)) (erase-buffer) - (call-process (executable-find "contacts") nil t nil - "-H" "-l" "-f" fmt-string) + (call-process "contacts" nil t nil "-H" "-l" "-f" fmt-string) (setq eudc-buffer-time modified)) (goto-char (point-min)) (while (not (eobp)) commit 7e2a1543985a770c93c9825c661bbb9b51b5e36f Author: Paul Eggert Date: Tue Nov 13 10:56:26 2018 -0800 Update from Gnulib This incorporates: 2018-11-03 nstrftime: simplify test for mktime failure 2018-11-02 gnulib-common.m4: port _Noreturn to C++ 2018-10-22 std-gnu11: Support Autoconf versions < 2.64 2018-10-22 Assume Autoconf >= 2.63 2018-10-16 Remove support for Ultrix 2018-10-16 getloadavg: Remove support for ConvexOS 2018-10-16 getloadavg: Remove support for Sony NEWS 2018-10-16 Remove support for Dynix/ptx 2018-10-16 fsusage: Remove support for AIX 3 2018-10-16 fsusage, stat-size, getloadavg: Remove support for AIX PS/2 2018-10-16 getloadavg: Remove support for HP-UX on m68k 2018-10-16 fsusage, mountlist: Remove support for DolphinOS 2018-10-16 getloadavg: Remove support for Alliant FX/2800 2018-10-16 getloadavg: Remove support for tek4300 2018-10-16 getloadavg: Remove support for Ardent * build-aux/config.guess, build-aux/config.sub, lib/_Noreturn.h: * lib/fsusage.c, lib/getgroups.c, lib/getloadavg.c: * lib/nstrftime.c, lib/time.in.h, m4/errno_h.m4: * m4/fsusage.m4, m4/getgroups.m4, m4/gnulib-common.m4, m4/longlong.m4: * m4/std-gnu11.m4, m4/stdint.m4: Copy from Gnulib. * lib/gnulib.mk.in, m4/gnulib-comp.m4: Regenerate: diff --git a/build-aux/config.guess b/build-aux/config.guess index b33c9e890e..18f8edc0ff 100755 --- a/build-aux/config.guess +++ b/build-aux/config.guess @@ -890,7 +890,7 @@ EOF echo "$UNAME_MACHINE"-pc-uwin exit ;; amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*) - echo x86_64-unknown-cygwin + echo x86_64-pc-cygwin exit ;; prep*:SunOS:5.*:*) echo powerpcle-unknown-solaris2"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`" diff --git a/build-aux/config.sub b/build-aux/config.sub index b51fb8cdb6..f208558ec2 100755 --- a/build-aux/config.sub +++ b/build-aux/config.sub @@ -89,7 +89,7 @@ while test $# -gt 0 ; do - ) # Use stdin as input. break ;; -* ) - echo "$me: invalid option $1$help" + echo "$me: invalid option $1$help" >&2 exit 1 ;; *local*) @@ -149,7 +149,7 @@ case $1 in esac ;; *-*) - # A lone config we happen to match not fitting any patern + # A lone config we happen to match not fitting any pattern case $field1-$field2 in decstation-3100) basic_machine=mips-dec @@ -950,7 +950,7 @@ unset -v basic_machine # Decode basic machines in the full and proper CPU-Company form. case $cpu-$vendor in - # Here we handle the default manufacturer of certain CPU types in cannonical form. It is in + # Here we handle the default manufacturer of certain CPU types in canonical form. It is in # some cases the only manufacturer, in others, it is the most popular. craynv-unknown) vendor=cray @@ -1101,7 +1101,7 @@ case $cpu-$vendor in cpu=`echo "$cpu" | sed 's/^xscale/arm/'` ;; - # Recognize the cannonical CPU Types that limit and/or modify the + # Recognize the canonical CPU Types that limit and/or modify the # company names they are paired with. cr16-*) os=${os:-elf} @@ -1150,7 +1150,7 @@ case $cpu-$vendor in ;; *) - # Recognize the cannonical CPU types that are allowed with any + # Recognize the canonical CPU types that are allowed with any # company name. case $cpu in 1750a | 580 \ diff --git a/lib/_Noreturn.h b/lib/_Noreturn.h index c44ad89b7c..94fdfaf022 100644 --- a/lib/_Noreturn.h +++ b/lib/_Noreturn.h @@ -1,8 +1,12 @@ -#if !defined _Noreturn && __STDC_VERSION__ < 201112 -# if (3 <= __GNUC__ || (__GNUC__ == 2 && 8 <= __GNUC_MINOR__) \ - || 0x5110 <= __SUNPRO_C) +#ifndef _Noreturn +# if 201103 <= (defined __cplusplus ? __cplusplus : 0) +# define _Noreturn [[noreturn]] +# elif (201112 <= (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) \ + || 4 < __GNUC__ + (7 <= __GNUC_MINOR__)) + /* _Noreturn works as-is. */ +# elif 2 < __GNUC__ + (8 <= __GNUC_MINOR__) || 0x5110 <= __SUNPRO_C # define _Noreturn __attribute__ ((__noreturn__)) -# elif 1200 <= _MSC_VER +# elif 1200 <= (defined _MSC_VER ? _MSC_VER : 0) # define _Noreturn __declspec (noreturn) # else # define _Noreturn diff --git a/lib/fsusage.c b/lib/fsusage.c index 6920f8530a..17daf9144a 100644 --- a/lib/fsusage.c +++ b/lib/fsusage.c @@ -46,9 +46,6 @@ # if HAVE_SYS_STATFS_H # include # endif -# if HAVE_DUSTAT_H /* AIX PS/2 */ -# include -# endif #endif /* Many space usage primitives use all 1 bits to denote a value that is @@ -151,21 +148,6 @@ get_fs_usage (char const *file, char const *disk, struct fs_usage *fsp) ? PROPAGATE_ALL_ONES (fsd.f_frsize) : PROPAGATE_ALL_ONES (fsd.f_bsize)); -#elif defined STAT_STATFS2_FS_DATA /* Ultrix */ - - struct fs_data fsd; - - if (statfs (file, &fsd) != 1) - return -1; - - fsp->fsu_blocksize = 1024; - fsp->fsu_blocks = PROPAGATE_ALL_ONES (fsd.fd_req.btot); - fsp->fsu_bfree = PROPAGATE_ALL_ONES (fsd.fd_req.bfree); - fsp->fsu_bavail = PROPAGATE_TOP_BIT (fsd.fd_req.bfreen); - fsp->fsu_bavail_top_bit_set = EXTRACT_TOP_BIT (fsd.fd_req.bfreen) != 0; - fsp->fsu_files = PROPAGATE_ALL_ONES (fsd.fd_req.gtot); - fsp->fsu_ffree = PROPAGATE_ALL_ONES (fsd.fd_req.gfree); - #elif defined STAT_STATFS3_OSF1 /* OSF/1 */ struct statfs fsd; @@ -219,12 +201,7 @@ get_fs_usage (char const *file, char const *disk, struct fs_usage *fsp) fsp->fsu_blocksize = PROPAGATE_ALL_ONES (fsd.f_fsize); -#elif defined STAT_STATFS4 /* SVR3, Dynix, old Irix, old AIX, \ - Dolphin */ - -# if !_AIX && !defined _SEQUENT_ && !defined DOLPHIN -# define f_bavail f_bfree -# endif +#elif defined STAT_STATFS4 /* SVR3, old Irix */ struct statfs fsd; @@ -234,7 +211,7 @@ get_fs_usage (char const *file, char const *disk, struct fs_usage *fsp) /* Empirically, the block counts on most SVR3 and SVR3-derived systems seem to always be in terms of 512-byte blocks, no matter what value f_bsize has. */ -# if _AIX || defined _CRAY +# if defined _CRAY fsp->fsu_blocksize = PROPAGATE_ALL_ONES (fsd.f_bsize); # else fsp->fsu_blocksize = 512; @@ -258,30 +235,3 @@ get_fs_usage (char const *file, char const *disk, struct fs_usage *fsp) (void) disk; /* avoid argument-unused warning */ return 0; } - -#if defined _AIX && defined _I386 -/* AIX PS/2 does not supply statfs. */ - -int -statfs (char *file, struct statfs *fsb) -{ - struct stat stats; - struct dustat fsd; - - if (stat (file, &stats) != 0) - return -1; - if (dustat (stats.st_dev, 0, &fsd, sizeof (fsd))) - return -1; - fsb->f_type = 0; - fsb->f_bsize = fsd.du_bsize; - fsb->f_blocks = fsd.du_fsize - fsd.du_isize; - fsb->f_bfree = fsd.du_tfree; - fsb->f_bavail = fsd.du_tfree; - fsb->f_files = (fsd.du_isize - 2) * fsd.du_inopb; - fsb->f_ffree = fsd.du_tinode; - fsb->f_fsid.val[0] = fsd.du_site; - fsb->f_fsid.val[1] = fsd.du_pckno; - return 0; -} - -#endif /* _AIX && _I386 */ diff --git a/lib/getgroups.c b/lib/getgroups.c index ec137c158a..cd6f4d7000 100644 --- a/lib/getgroups.c +++ b/lib/getgroups.c @@ -58,8 +58,8 @@ int posix_getgroups (int, gid_t []) __asm ("_getgroups"); # define getgroups posix_getgroups # endif -/* On at least Ultrix 4.3 and NextStep 3.2, getgroups (0, NULL) always - fails. On other systems, it returns the number of supplemental +/* On at least NeXTstep 3.2, getgroups (0, NULL) always fails. + On other systems, it returns the number of supplemental groups for the process. This function handles that special case and lets the system-provided function handle all others. However, it can fail with ENOMEM if memory is tight. It is unspecified diff --git a/lib/getloadavg.c b/lib/getloadavg.c index 578316e34d..4e7eb0d233 100644 --- a/lib/getloadavg.c +++ b/lib/getloadavg.c @@ -55,16 +55,12 @@ apollo BSD Real BSD, not just BSD-like. - convex DGUX eunice UNIX emulator under VMS. hpux __MSDOS__ No-op for MSDOS. NeXT sgi - sequent Sequent Dynix 3.x.x (BSD) - _SEQUENT_ Sequent DYNIX/ptx 1.x.x (SYSV) - sony_news NEWS-OS (works at least for 4.1C) UMAX UMAX4_3 VMS @@ -101,11 +97,6 @@ # define WINDOWS32 # endif -# if !defined (BSD) && defined (ultrix) -/* Ultrix behaves like BSD on Vaxen. */ -# define BSD -# endif - # ifdef NeXT /* NeXT in the 2.{0,1,2} releases defines BSD in , which conflicts with the definition understood in this file, that this @@ -145,10 +136,6 @@ # define MORE_BSD # endif -# if defined (ultrix) && defined (mips) -# define decstation -# endif - # if defined (__SVR4) && !defined (SVR4) # define SVR4 # endif @@ -172,13 +159,6 @@ # include # endif -/* UTek's /bin/cc on the 4300 has no architecture specific cpp define by - default, but _MACH_IND_SYS_TYPES is defined in . Combine - that with a couple of other things and we'll have a unique match. */ -# if !defined (tek4300) && defined (unix) && defined (m68k) && defined (mc68000) && defined (mc68020) && defined (_MACH_IND_SYS_TYPES) -# define tek4300 /* Define by emacs, but not by other users. */ -# endif - /* VAX C can't handle multi-line #ifs, or lines longer than 256 chars. */ # ifndef LOAD_AVE_TYPE @@ -191,14 +171,6 @@ # define LOAD_AVE_TYPE long # endif -# ifdef decstation -# define LOAD_AVE_TYPE long -# endif - -# ifdef _SEQUENT_ -# define LOAD_AVE_TYPE long -# endif - # ifdef sgi # define LOAD_AVE_TYPE long # endif @@ -207,41 +179,14 @@ # define LOAD_AVE_TYPE long # endif -# ifdef sony_news -# define LOAD_AVE_TYPE long -# endif - -# ifdef sequent -# define LOAD_AVE_TYPE long -# endif - # ifdef OSF_ALPHA # define LOAD_AVE_TYPE long # endif -# if defined (ardent) && defined (titan) -# define LOAD_AVE_TYPE long -# endif - -# ifdef tek4300 -# define LOAD_AVE_TYPE long -# endif - -# if defined (alliant) && defined (i860) /* Alliant FX/2800 */ -# define LOAD_AVE_TYPE long -# endif - # if defined _AIX && ! defined HAVE_LIBPERFSTAT # define LOAD_AVE_TYPE long # endif -# ifdef convex -# define LOAD_AVE_TYPE double -# ifndef LDAV_CVT -# define LDAV_CVT(n) (n) -# endif -# endif - # endif /* No LOAD_AVE_TYPE. */ # ifdef OSF_ALPHA @@ -251,13 +196,6 @@ # define FSCALE 1024.0 # endif -# if defined (alliant) && defined (i860) /* Alliant FX/2800 */ -/* defines an incorrect value for FSCALE on an - Alliant FX/2800 Concentrix 2.2, according to ghazi@noc.rutgers.edu. */ -# undef FSCALE -# define FSCALE 100.0 -# endif - # ifndef FSCALE @@ -267,25 +205,17 @@ # define FSCALE 2048.0 # endif -# if defined (MIPS) || defined (SVR4) || defined (decstation) +# if defined (MIPS) || defined (SVR4) # define FSCALE 256 # endif -# if defined (sgi) || defined (sequent) +# if defined (sgi) /* Sometimes both MIPS and sgi are defined, so FSCALE was just defined above under #ifdef MIPS. But we want the sgi value. */ # undef FSCALE # define FSCALE 1000.0 # endif -# if defined (ardent) && defined (titan) -# define FSCALE 65536.0 -# endif - -# ifdef tek4300 -# define FSCALE 100.0 -# endif - # if defined _AIX && !defined HAVE_LIBPERFSTAT # define FSCALE 65536.0 # endif @@ -307,24 +237,16 @@ # endif -# if !defined (KERNEL_FILE) && defined (sequent) -# define KERNEL_FILE "/dynix" -# endif - # if !defined (KERNEL_FILE) && defined (hpux) # define KERNEL_FILE "/hp-ux" # endif -# if !defined (KERNEL_FILE) && (defined (_SEQUENT_) || defined (MIPS) || defined (SVR4) || defined (ISC) || defined (sgi) || (defined (ardent) && defined (titan))) +# if !defined (KERNEL_FILE) && (defined (MIPS) || defined (SVR4) || defined (ISC) || defined (sgi)) # define KERNEL_FILE "/unix" # endif -# if !defined (LDAV_SYMBOL) && defined (alliant) -# define LDAV_SYMBOL "_Loadavg" -# endif - -# if !defined (LDAV_SYMBOL) && ((defined (hpux) && !defined (hp9000s300)) || defined (_SEQUENT_) || defined (SVR4) || defined (ISC) || defined (sgi) || (defined (ardent) && defined (titan)) || (defined (_AIX) && !defined(HAVE_LIBPERFSTAT))) +# if !defined (LDAV_SYMBOL) && (defined (hpux) || defined (SVR4) || defined (ISC) || defined (sgi) || (defined (_AIX) && !defined(HAVE_LIBPERFSTAT))) # define LDAV_SYMBOL "avenrun" # endif @@ -921,7 +843,7 @@ getloadavg (double loadavg[], int nelem) # ifndef SUNOS_5 if ( -# if !(defined (_AIX) && !defined (ps2)) +# if !defined (_AIX) nlist (KERNEL_FILE, name_list) # else /* _AIX */ knlist (name_list, 1, sizeof (name_list[0])) diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 982d3c5c29..c87a15e019 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -82,6 +82,7 @@ # crypto/sha512-buffer \ # d-type \ # diffseq \ +# dosname \ # dtoastr \ # dtotimespec \ # dup2 \ @@ -1403,9 +1404,7 @@ endif ## begin gnulib module dosname ifeq (,$(OMIT_GNULIB_MODULE_dosname)) -ifneq (,$(gl_GNULIB_ENABLED_dosname)) -endif EXTRA_DIST += dosname.h endif diff --git a/lib/nstrftime.c b/lib/nstrftime.c index 46e806e604..1dd49c0f78 100644 --- a/lib/nstrftime.c +++ b/lib/nstrftime.c @@ -1438,28 +1438,10 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) # endif ltm = *tp; + ltm.tm_wday = -1; lt = mktime_z (tz, <m); - - if (lt == (time_t) -1) - { - /* mktime returns -1 for errors, but -1 is also a - valid time_t value. Check whether an error really - occurred. */ - struct tm tm; - - if (! localtime_rz (tz, <, &tm) - || ((ltm.tm_sec ^ tm.tm_sec) - | (ltm.tm_min ^ tm.tm_min) - | (ltm.tm_hour ^ tm.tm_hour) - | (ltm.tm_mday ^ tm.tm_mday) - | (ltm.tm_mon ^ tm.tm_mon) - | (ltm.tm_year ^ tm.tm_year))) - break; - } - - if (! localtime_rz (0, <, >m)) + if (ltm.tm_wday < 0 || ! localtime_rz (0, <, >m)) break; - diff = tm_diff (<m, >m); } #endif diff --git a/lib/time.in.h b/lib/time.in.h index cda16c69d2..3128f44a6f 100644 --- a/lib/time.in.h +++ b/lib/time.in.h @@ -48,7 +48,7 @@ /* The definition of _GL_WARN_ON_USE is copied here. */ -/* Some systems don't define struct timespec (e.g., AIX 4.1, Ultrix 4.3). +/* Some systems don't define struct timespec (e.g., AIX 4.1). Or they define it with the wrong member names or define it in (e.g., FreeBSD circa 1997). Stock Mingw prior to 3.0 does not define it, but the pthreads-win32 library defines it in . */ diff --git a/m4/errno_h.m4 b/m4/errno_h.m4 index 9dbdedd505..e1ae295126 100644 --- a/m4/errno_h.m4 +++ b/m4/errno_h.m4 @@ -1,9 +1,11 @@ -# errno_h.m4 serial 12 +# errno_h.m4 serial 13 dnl Copyright (C) 2004, 2006, 2008-2018 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. +AC_PREREQ([2.61]) + AC_DEFUN_ONCE([gl_HEADER_ERRNO_H], [ AC_REQUIRE([AC_PROG_CC]) @@ -129,9 +131,3 @@ yes AC_SUBST($1[_VALUE]) fi ]) - -dnl Autoconf >= 2.61 has AC_COMPUTE_INT built-in. -dnl Remove this when we can assume autoconf >= 2.61. -m4_ifdef([AC_COMPUTE_INT], [], [ - AC_DEFUN([AC_COMPUTE_INT], [_AC_COMPUTE_INT([$2],[$1],[$3],[$4])]) -]) diff --git a/m4/fsusage.m4 b/m4/fsusage.m4 index aab4024a97..c3ba4391ae 100644 --- a/m4/fsusage.m4 +++ b/m4/fsusage.m4 @@ -1,4 +1,4 @@ -# serial 33 +# serial 34 # Obtaining file system usage information. # Copyright (C) 1997-1998, 2000-2001, 2003-2018 Free Software Foundation, Inc. @@ -199,14 +199,14 @@ int check_f_blocks_size[sizeof fsd.f_blocks * CHAR_BIT <= 32 ? -1 : 1]; ac_fsusage_space=yes AC_DEFINE([STAT_STATFS2_BSIZE], [1], [Define if statfs takes 2 args and struct statfs has a field named f_bsize. - (4.3BSD, SunOS 4, HP-UX, AIX PS/2)]) + (4.3BSD, SunOS 4, HP-UX)]) fi fi if test $ac_fsusage_space = no; then # SVR3 # (Solaris already handled above.) - AC_CACHE_CHECK([for four-argument statfs (AIX-3.2.5, SVR3)], + AC_CACHE_CHECK([for four-argument statfs (SVR3)], [fu_cv_sys_stat_statfs4], [AC_RUN_IFELSE([AC_LANG_SOURCE([[ #include @@ -224,7 +224,7 @@ int check_f_blocks_size[sizeof fsd.f_blocks * CHAR_BIT <= 32 ? -1 : 1]; if test $fu_cv_sys_stat_statfs4 = yes; then ac_fsusage_space=yes AC_DEFINE([STAT_STATFS4], [1], - [Define if statfs takes 4 args. (SVR3, Dynix, old Irix, old AIX, Dolphin)]) + [Define if statfs takes 4 args. (SVR3, old Irix)]) fi fi @@ -263,41 +263,6 @@ int check_f_blocks_size[sizeof fsd.f_blocks * CHAR_BIT <= 32 ? -1 : 1]; fi fi - if test $ac_fsusage_space = no; then - # Ultrix - AC_CACHE_CHECK([for two-argument statfs with struct fs_data (Ultrix)], - [fu_cv_sys_stat_fs_data], - [AC_RUN_IFELSE([AC_LANG_SOURCE([[ -#include -#ifdef HAVE_SYS_PARAM_H -#include -#endif -#ifdef HAVE_SYS_MOUNT_H -#include -#endif -#ifdef HAVE_SYS_FS_TYPES_H -#include -#endif - int - main () - { - struct fs_data fsd; - /* Ultrix's statfs returns 1 for success, - 0 for not mounted, -1 for failure. */ - return statfs (".", &fsd) != 1; - }]])], - [fu_cv_sys_stat_fs_data=yes], - [fu_cv_sys_stat_fs_data=no], - [fu_cv_sys_stat_fs_data=no]) - ]) - if test $fu_cv_sys_stat_fs_data = yes; then - ac_fsusage_space=yes - AC_DEFINE([STAT_STATFS2_FS_DATA], [1], - [Define if statfs takes 2 args and the second argument has - type struct fs_data. (Ultrix)]) - fi - fi - AS_IF([test $ac_fsusage_space = yes], [$1], [$2]) ]) @@ -337,6 +302,6 @@ choke -- this is a workaround for a Sun-specific problem # Prerequisites of lib/fsusage.c not done by gl_FILE_SYSTEM_USAGE. AC_DEFUN([gl_PREREQ_FSUSAGE_EXTRA], [ - AC_CHECK_HEADERS([dustat.h sys/fs/s5param.h sys/statfs.h]) + AC_CHECK_HEADERS([sys/fs/s5param.h sys/statfs.h]) gl_STATFS_TRUNCATES ]) diff --git a/m4/getgroups.m4 b/m4/getgroups.m4 index d38240259f..8cddb6ccdc 100644 --- a/m4/getgroups.m4 +++ b/m4/getgroups.m4 @@ -1,4 +1,4 @@ -# serial 20 +# serial 21 dnl From Jim Meyering. dnl A wrapper around AC_FUNC_GETGROUPS. @@ -34,7 +34,7 @@ AC_DEFUN([AC_FUNC_GETGROUPS], [AC_RUN_IFELSE( [AC_LANG_PROGRAM( [AC_INCLUDES_DEFAULT], - [[/* On Ultrix 4.3, getgroups (0, 0) always fails. */ + [[/* On NeXTstep 3.2, getgroups (0, 0) always fails. */ return getgroups (0, 0) == -1;]]) ], [ac_cv_func_getgroups_works=yes], diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4 index 5f07855acf..2b253dabf5 100644 --- a/m4/gnulib-common.m4 +++ b/m4/gnulib-common.m4 @@ -1,9 +1,11 @@ -# gnulib-common.m4 serial 39 +# gnulib-common.m4 serial 41 dnl Copyright (C) 2007-2018 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. +AC_PREREQ([2.62]) + # gl_COMMON # is expanded unconditionally through gnulib-tool magic. AC_DEFUN([gl_COMMON], [ @@ -14,12 +16,15 @@ AC_DEFUN([gl_COMMON], [ AC_DEFUN([gl_COMMON_BODY], [ AH_VERBATIM([_Noreturn], [/* The _Noreturn keyword of C11. */ -#if ! (defined _Noreturn \ - || (defined __STDC_VERSION__ && 201112 <= __STDC_VERSION__)) -# if (3 <= __GNUC__ || (__GNUC__ == 2 && 8 <= __GNUC_MINOR__) \ - || 0x5110 <= __SUNPRO_C) +#ifndef _Noreturn +# if 201103 <= (defined __cplusplus ? __cplusplus : 0) +# define _Noreturn [[noreturn]] +# elif (201112 <= (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) \ + || 4 < __GNUC__ + (7 <= __GNUC_MINOR__)) + /* _Noreturn works as-is. */ +# elif 2 < __GNUC__ + (8 <= __GNUC_MINOR__) || 0x5110 <= __SUNPRO_C # define _Noreturn __attribute__ ((__noreturn__)) -# elif defined _MSC_VER && 1200 <= _MSC_VER +# elif 1200 <= (defined _MSC_VER ? _MSC_VER : 0) # define _Noreturn __declspec (noreturn) # else # define _Noreturn @@ -214,13 +219,6 @@ AC_DEFUN([gl_FEATURES_H], AC_SUBST([HAVE_FEATURES_H]) ]) -# m4_foreach_w -# is a backport of autoconf-2.59c's m4_foreach_w. -# Remove this macro when we can assume autoconf >= 2.60. -m4_ifndef([m4_foreach_w], - [m4_define([m4_foreach_w], - [m4_foreach([$1], m4_split(m4_normalize([$2]), [ ]), [$3])])]) - # AS_VAR_IF(VAR, VALUE, [IF-MATCH], [IF-NOT-MATCH]) # ---------------------------------------------------- # Backport of autoconf-2.63b's macro. @@ -233,7 +231,6 @@ m4_ifndef([AS_VAR_IF], # Modifies the value of the shell variable CC in an attempt to make $CC # understand ISO C99 source code. # This is like AC_PROG_CC_C99, except that -# - AC_PROG_CC_C99 did not exist in Autoconf versions < 2.60, # - AC_PROG_CC_C99 does not mix well with AC_PROG_CC_STDC # , # but many more packages use AC_PROG_CC_STDC than AC_PROG_CC_C99 @@ -322,25 +319,6 @@ Amsterdam AC_SUBST([RANLIB]) ]) -# AC_PROG_MKDIR_P -# is a backport of autoconf-2.60's AC_PROG_MKDIR_P, with a fix -# for interoperability with automake-1.9.6 from autoconf-2.62. -# Remove this macro when we can assume autoconf >= 2.62 or -# autoconf >= 2.60 && automake >= 1.10. -# AC_AUTOCONF_VERSION was introduced in 2.62, so use that as the witness. -m4_ifndef([AC_AUTOCONF_VERSION],[ -m4_ifdef([AC_PROG_MKDIR_P], [ - dnl For automake-1.9.6 && autoconf < 2.62: Ensure MKDIR_P is AC_SUBSTed. - m4_define([AC_PROG_MKDIR_P], - m4_defn([AC_PROG_MKDIR_P])[ - AC_SUBST([MKDIR_P])])], [ - dnl For autoconf < 2.60: Backport of AC_PROG_MKDIR_P. - AC_DEFUN_ONCE([AC_PROG_MKDIR_P], - [AC_REQUIRE([AM_PROG_MKDIR_P])dnl defined by automake - MKDIR_P='$(mkdir_p)' - AC_SUBST([MKDIR_P])])]) -]) - # AC_C_RESTRICT # This definition is copied from post-2.69 Autoconf and overrides the # AC_C_RESTRICT macro from autoconf 2.60..2.69. It can be removed @@ -414,61 +392,3 @@ AC_DEFUN([gl_CACHE_VAL_SILENT], # AS_VAR_COPY was added in autoconf 2.63b m4_define_default([AS_VAR_COPY], [AS_LITERAL_IF([$1[]$2], [$1=$$2], [eval $1=\$$2])]) - -# AC_PROG_SED was added in autoconf 2.59b -m4_ifndef([AC_PROG_SED], -[AC_DEFUN([AC_PROG_SED], -[AC_CACHE_CHECK([for a sed that does not truncate output], ac_cv_path_SED, - [dnl ac_script should not contain more than 99 commands (for HP-UX sed), - dnl but more than about 7000 bytes, to catch a limit in Solaris 8 /usr/ucb/sed. - ac_script=s/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa/bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb/ - for ac_i in 1 2 3 4 5 6 7; do - ac_script="$ac_script$as_nl$ac_script" - done - echo "$ac_script" 2>/dev/null | sed 99q >conftest.sed - AS_UNSET([ac_script]) - if test -z "$SED"; then - ac_path_SED_found=false - _AS_PATH_WALK([], [ - for ac_prog in sed gsed; do - for ac_exec_ext in '' $ac_executable_extensions; do - ac_path_SED="$as_dir/$ac_prog$ac_exec_ext" - AS_EXECUTABLE_P(["$ac_path_SED"]) || continue - case `"$ac_path_SED" --version 2>&1` in - *GNU*) ac_cv_path_SED=$ac_path_SED ac_path_SED_found=:;; - *) - ac_count=0 - _AS_ECHO_N([0123456789]) >conftest.in - while : - do - cat conftest.in conftest.in >conftest.tmp - mv conftest.tmp conftest.in - cp conftest.in conftest.nl - echo >> conftest.nl - "$ac_path_SED" -f conftest.sed conftest.out 2>/dev/null || break - diff conftest.out conftest.nl >/dev/null 2>&1 || break - ac_count=`expr $ac_count + 1` - if test $ac_count -gt ${ac_path_SED_max-0}; then - # Best so far, but keep looking for better - ac_cv_path_SED=$ac_path_SED - ac_path_SED_max=$ac_count - fi - test $ac_count -gt 10 && break - done - rm -f conftest.in conftest.tmp conftest.nl conftest.out;; - esac - $ac_path_SED_found && break 3 - done - done]) - if test -z "$ac_cv_path_SED"; then - AC_ERROR([no acceptable sed could be found in \$PATH]) - fi - else - ac_cv_path_SED=$SED - fi - ]) - SED="$ac_cv_path_SED" - AC_SUBST([SED])dnl - rm -f conftest.sed -]) -]) diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 74f28178ff..5618befebf 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -436,7 +436,6 @@ AC_DEFUN([gl_INIT], gl_gnulib_enabled_37f71b604aa9c54446783d80f42fe547=false gl_gnulib_enabled_cloexec=false gl_gnulib_enabled_dirfd=false - gl_gnulib_enabled_dosname=false gl_gnulib_enabled_euidaccess=false gl_gnulib_enabled_getdtablesize=false gl_gnulib_enabled_getgroups=false @@ -485,12 +484,6 @@ AC_DEFUN([gl_INIT], gl_gnulib_enabled_dirfd=true fi } - func_gl_gnulib_m4code_dosname () - { - if ! $gl_gnulib_enabled_dosname; then - gl_gnulib_enabled_dosname=true - fi - } func_gl_gnulib_m4code_euidaccess () { if ! $gl_gnulib_enabled_euidaccess; then @@ -630,9 +623,6 @@ AC_DEFUN([gl_INIT], if test $HAVE_FACCESSAT = 0 || test $REPLACE_FACCESSAT = 1; then func_gl_gnulib_m4code_260941c0e5dc67ec9e87d1fb321c300b fi - if test $HAVE_FACCESSAT = 0 || test $REPLACE_FACCESSAT = 1; then - func_gl_gnulib_m4code_dosname - fi if test $HAVE_FACCESSAT = 0 || test $REPLACE_FACCESSAT = 1; then func_gl_gnulib_m4code_euidaccess fi @@ -651,9 +641,6 @@ AC_DEFUN([gl_INIT], if test $HAVE_FSTATAT = 0 || test $REPLACE_FSTATAT = 1; then func_gl_gnulib_m4code_260941c0e5dc67ec9e87d1fb321c300b fi - if test $HAVE_FSTATAT = 0 || test $REPLACE_FSTATAT = 1; then - func_gl_gnulib_m4code_dosname - fi if test $HAVE_FSTATAT = 0 || test $REPLACE_FSTATAT = 1; then func_gl_gnulib_m4code_03e0aaad4cb89ca757653bd367a6ccb7 fi @@ -663,15 +650,9 @@ AC_DEFUN([gl_INIT], if test $NEED_LOCALTIME_BUFFER = 1; then func_gl_gnulib_m4code_2049e887c7e5308faad27b3f894bb8c9 fi - if test $REPLACE_LSTAT = 1; then - func_gl_gnulib_m4code_dosname - fi if test $HAVE_READLINKAT = 0; then func_gl_gnulib_m4code_260941c0e5dc67ec9e87d1fb321c300b fi - if test $HAVE_READLINKAT = 0; then - func_gl_gnulib_m4code_dosname - fi if test $HAVE_READLINKAT = 0; then func_gl_gnulib_m4code_03e0aaad4cb89ca757653bd367a6ccb7 fi @@ -692,7 +673,6 @@ AC_DEFUN([gl_INIT], AM_CONDITIONAL([gl_GNULIB_ENABLED_37f71b604aa9c54446783d80f42fe547], [$gl_gnulib_enabled_37f71b604aa9c54446783d80f42fe547]) AM_CONDITIONAL([gl_GNULIB_ENABLED_cloexec], [$gl_gnulib_enabled_cloexec]) AM_CONDITIONAL([gl_GNULIB_ENABLED_dirfd], [$gl_gnulib_enabled_dirfd]) - AM_CONDITIONAL([gl_GNULIB_ENABLED_dosname], [$gl_gnulib_enabled_dosname]) AM_CONDITIONAL([gl_GNULIB_ENABLED_euidaccess], [$gl_gnulib_enabled_euidaccess]) AM_CONDITIONAL([gl_GNULIB_ENABLED_getdtablesize], [$gl_gnulib_enabled_getdtablesize]) AM_CONDITIONAL([gl_GNULIB_ENABLED_getgroups], [$gl_gnulib_enabled_getgroups]) diff --git a/m4/longlong.m4 b/m4/longlong.m4 index 27e63265a8..322d79b66c 100644 --- a/m4/longlong.m4 +++ b/m4/longlong.m4 @@ -1,4 +1,4 @@ -# longlong.m4 serial 17 +# longlong.m4 serial 18 dnl Copyright (C) 1999-2007, 2009-2018 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -6,9 +6,10 @@ dnl with or without modifications, as long as this notice is preserved. dnl From Paul Eggert. +AC_PREREQ([2.62]) + # Define HAVE_LONG_LONG_INT if 'long long int' works. -# This fixes a bug in Autoconf 2.61, and can be faster -# than what's in Autoconf 2.62 through 2.68. +# This can be faster than what's in Autoconf 2.62 through 2.68. # Note: If the type 'long long int' exists but is only 32 bits large # (as on some very old compilers), HAVE_LONG_LONG_INT will not be @@ -56,8 +57,7 @@ AC_DEFUN([AC_TYPE_LONG_LONG_INT], ]) # Define HAVE_UNSIGNED_LONG_LONG_INT if 'unsigned long long int' works. -# This fixes a bug in Autoconf 2.61, and can be faster -# than what's in Autoconf 2.62 through 2.68. +# This fixes can be faster than what's in Autoconf 2.62 through 2.68. # Note: If the type 'unsigned long long int' exists but is only 32 bits # large (as on some very old compilers), AC_TYPE_UNSIGNED_LONG_LONG_INT diff --git a/m4/std-gnu11.m4 b/m4/std-gnu11.m4 index c85ac43015..bae4ed1390 100644 --- a/m4/std-gnu11.m4 +++ b/m4/std-gnu11.m4 @@ -70,7 +70,7 @@ _AS_ECHO_LOG([checking for _AC_LANG compiler version]) set X $ac_compile ac_compiler=$[2] for ac_option in --version -v -V -qversion -version; do - _AC_DO_LIMIT([$ac_compiler $ac_option >&AS_MESSAGE_LOG_FD]) + m4_ifdef([_AC_DO_LIMIT],[_AC_DO_LIMIT],[_AC_DO])([$ac_compiler $ac_option >&AS_MESSAGE_LOG_FD]) done m4_expand_once([_AC_COMPILER_EXEEXT])[]dnl @@ -135,7 +135,7 @@ _AS_ECHO_LOG([checking for _AC_LANG compiler version]) set X $ac_compile ac_compiler=$[2] for ac_option in --version -v -V -qversion; do - _AC_DO_LIMIT([$ac_compiler $ac_option >&AS_MESSAGE_LOG_FD]) + m4_ifdef([_AC_DO_LIMIT],[_AC_DO_LIMIT],[_AC_DO])([$ac_compiler $ac_option >&AS_MESSAGE_LOG_FD]) done m4_expand_once([_AC_COMPILER_EXEEXT])[]dnl diff --git a/m4/stdint.m4 b/m4/stdint.m4 index 38dbbedffe..81d065f655 100644 --- a/m4/stdint.m4 +++ b/m4/stdint.m4 @@ -1,4 +1,4 @@ -# stdint.m4 serial 52 +# stdint.m4 serial 53 dnl Copyright (C) 2001-2018 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -7,6 +7,8 @@ dnl with or without modifications, as long as this notice is preserved. dnl From Paul Eggert and Bruno Haible. dnl Test whether is supported or must be substituted. +AC_PREREQ([2.61]) + AC_DEFUN_ONCE([gl_STDINT_H], [ AC_PREREQ([2.59])dnl @@ -540,9 +542,3 @@ AC_DEFUN([gl_STDINT_TYPE_PROPERTIES], BITSIZEOF_WINT_T=32 fi ]) - -dnl Autoconf >= 2.61 has AC_COMPUTE_INT built-in. -dnl Remove this when we can assume autoconf >= 2.61. -m4_ifdef([AC_COMPUTE_INT], [], [ - AC_DEFUN([AC_COMPUTE_INT], [_AC_COMPUTE_INT([$2],[$1],[$3],[$4])]) -]) commit 5c0d8bb95bbd5354e6b2cd2e56a91afe4e780759 Author: Glenn Morris Date: Tue Nov 13 13:15:39 2018 -0500 Root emacsclient no longer connects to non-root sockets * lib-src/emacsclient.c (set_local_socket): Don't ignore socket ownership when run by root. Ref: http://lists.gnu.org/r/emacs-devel/2018-11/msg00019.html diff --git a/etc/NEWS b/etc/NEWS index bbcd7a5747..2f07abb4eb 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -119,13 +119,19 @@ the new version of the file again.) * Changes in Emacs 27.1 +** emacsclient + +++ -** emacsclient now supports the 'EMACS_SOCKET_NAME' environment variable. +*** emacsclient now supports the 'EMACS_SOCKET_NAME' environment variable. The behavior is identical to 'EMACS_SERVER_FILE', in that the command-line value specified via '--socket-name' will override the environment, and the natural default to TMPDIR, then "/tmp", continues to apply. +--- +*** When run by root, emacsclient no longer connects to non-root sockets. +(Instead you can use Tramp methods to run root commands in a non-root Emacs.) + +++ ** The function 'read-passwd' uses '*' as default character to hide passwords. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 42b8dd6227..6fbc230095 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -1365,14 +1365,9 @@ set_local_socket (const char *local_socket_name) switch (sock_status) { case 1: - /* There's a socket, but it isn't owned by us. This is OK if - we are root. */ - if (0 != geteuid ()) - { - message (true, "%s: Invalid socket owner\n", progname); - return INVALID_SOCKET; - } - break; + /* There's a socket, but it isn't owned by us. */ + message (true, "%s: Invalid socket owner\n", progname); + return INVALID_SOCKET; case 2: /* `stat' failed */ commit 578c905ac758de41145a2e080da1e1c1c5c6b1ee Author: Eli Zaretskii Date: Tue Nov 13 19:46:08 2018 +0200 Avoid byte-compilation warning in emacsbug.el * lisp/mail/emacsbug.el (w32--os-description): Declare it, to avoid byte-compilation warning. Reported by Live System User . diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index e55f950aac..795516737d 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -69,6 +69,7 @@ (declare-function x-server-vendor "xfns.c" (&optional terminal)) (declare-function x-server-version "xfns.c" (&optional terminal)) (declare-function message-sort-headers "message" ()) +(declare-function w32--os-description "w32-fns" ()) (defvar message-strip-special-text-properties) (defun report-emacs-bug-can-use-osx-open () commit 900276502fbb4dcabdabc5d7d24b4bc5645f2cf3 Author: Paul Eggert Date: Tue Nov 13 09:29:14 2018 -0800 Act like POSIX sh if $HOME is relative POSIX says sh ~/foo should act like $HOME/foo even if $HOME is relative, so be consistent with that (Bug#33255). * admin/merge-gnulib (GNULIB_MODULES): Add dosname. * src/buffer.c (init_buffer): Use emacs_wd to get initial working directory with slash appended if needed. (default-directory): Say it must be absolute. * src/emacs.c (emacs_wd): New global variable. (init_cmdargs): Dir arg is now char const *. (main): Set emacs_wd. * src/emacs.c (main) [NS_IMPL_COCOA]: * src/fileio.c (Fexpand_file_name): Use get_homedir instead of egetenv ("HOME"). * src/fileio.c: Include dosname.h, for IS_ABSOLUTE_FILE_NAME. (splice_dir_file, get_homedir): New functions. * src/xrdb.c (gethomedir): Remove. All callers changed to use get_homedir and splice_dir_file. * test/src/fileio-tests.el (fileio-tests--relative-HOME): New test. diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 575e3fa74a..84dcb0b875 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -30,7 +30,7 @@ GNULIB_MODULES=' careadlinkat close-stream count-leading-zeros count-one-bits count-trailing-zeros crypto/md5-buffer crypto/sha1-buffer crypto/sha256-buffer crypto/sha512-buffer - d-type diffseq dtoastr dtotimespec dup2 + d-type diffseq dosname dtoastr dtotimespec dup2 environ execinfo explicit_bzero faccessat fcntl fcntl-h fdatasync fdopendir filemode filevercmp flexmember fpieee fstatat fsusage fsync diff --git a/src/buffer.c b/src/buffer.c index ac2de7d19f..90ef886b22 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -5268,9 +5268,7 @@ init_buffer_once (void) void init_buffer (int initialized) { - char *pwd; Lisp_Object temp; - ptrdiff_t len; #ifdef USE_MMAP_FOR_BUFFERS if (initialized) @@ -5324,7 +5322,7 @@ init_buffer (int initialized) if (NILP (BVAR (&buffer_defaults, enable_multibyte_characters))) Fset_buffer_multibyte (Qnil); - pwd = emacs_get_current_dir_name (); + char const *pwd = emacs_wd; if (!pwd) { @@ -5336,22 +5334,16 @@ init_buffer (int initialized) { /* Maybe this should really use some standard subroutine whose definition is filename syntax dependent. */ - len = strlen (pwd); - if (!(IS_DIRECTORY_SEP (pwd[len - 1]))) - { - /* Grow buffer to add directory separator and '\0'. */ - pwd = realloc (pwd, len + 2); - if (!pwd) - fatal ("get_current_dir_name: %s\n", strerror (errno)); - pwd[len] = DIRECTORY_SEP; - pwd[len + 1] = '\0'; - len++; - } + ptrdiff_t len = strlen (pwd); + bool add_slash = ! IS_DIRECTORY_SEP (pwd[len - 1]); /* At this moment, we still don't know how to decode the directory name. So, we keep the bytes in unibyte form so that file I/O routines correctly get the original bytes. */ - bset_directory (current_buffer, make_unibyte_string (pwd, len)); + Lisp_Object dirname = make_unibyte_string (pwd, len + add_slash); + if (add_slash) + SSET (dirname, len, DIRECTORY_SEP); + bset_directory (current_buffer, dirname); /* Add /: to the front of the name if it would otherwise be treated as magic. */ @@ -5372,8 +5364,6 @@ init_buffer (int initialized) temp = get_minibuffer (0); bset_directory (XBUFFER (temp), BVAR (current_buffer, directory)); - - free (pwd); } /* Similar to defvar_lisp but define a variable whose value is the @@ -5706,8 +5696,8 @@ visual lines rather than logical lines. See the documentation of DEFVAR_PER_BUFFER ("default-directory", &BVAR (current_buffer, directory), Qstringp, doc: /* Name of default directory of current buffer. -It should be a directory name (as opposed to a directory file-name). -On GNU and Unix systems, directory names end in a slash `/'. +It should be an absolute directory name; on GNU and Unix systems, +these names start with `/' or `~' and end with `/'. To interactively change the default directory, use command `cd'. */); DEFVAR_PER_BUFFER ("auto-fill-function", &BVAR (current_buffer, auto_fill_function), diff --git a/src/emacs.c b/src/emacs.c index 512174d562..acb4959bfe 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -204,6 +204,9 @@ HANDLE w32_daemon_event; char **initial_argv; int initial_argc; +/* The name of the working directory, or NULL if this info is unavailable. */ +char const *emacs_wd; + static void sort_args (int argc, char **argv); static void syms_of_emacs (void); @@ -406,7 +409,7 @@ terminate_due_to_signal (int sig, int backtrace_limit) /* Code for dealing with Lisp access to the Unix command line. */ static void -init_cmdargs (int argc, char **argv, int skip_args, char *original_pwd) +init_cmdargs (int argc, char **argv, int skip_args, char const *original_pwd) { int i; Lisp_Object name, dir, handler; @@ -694,7 +697,7 @@ main (int argc, char **argv) char *ch_to_dir = 0; /* If we use --chdir, this records the original directory. */ - char *original_pwd = 0; + char const *original_pwd = 0; /* Record (approximately) where the stack begins. */ stack_bottom = (char *) &stack_bottom_variable; @@ -794,6 +797,8 @@ main (int argc, char **argv) exit (0); } + emacs_wd = emacs_get_current_dir_name (); + if (argmatch (argv, argc, "-chdir", "--chdir", 4, &ch_to_dir, &skip_args)) { #ifdef WINDOWSNT @@ -804,13 +809,14 @@ main (int argc, char **argv) filename_from_ansi (ch_to_dir, newdir); ch_to_dir = newdir; #endif - original_pwd = emacs_get_current_dir_name (); if (chdir (ch_to_dir) != 0) { fprintf (stderr, "%s: Can't chdir to %s: %s\n", argv[0], ch_to_dir, strerror (errno)); exit (1); } + original_pwd = emacs_wd; + emacs_wd = emacs_get_current_dir_name (); } #if defined (HAVE_SETRLIMIT) && defined (RLIMIT_STACK) && !defined (CYGWIN) @@ -1289,21 +1295,21 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem { #ifdef NS_IMPL_COCOA /* Started from GUI? */ - /* FIXME: Do the right thing if getenv returns NULL, or if + /* FIXME: Do the right thing if get_homedir returns "", or if chdir fails. */ if (! inhibit_window_system && ! isatty (STDIN_FILENO) && ! ch_to_dir) - chdir (getenv ("HOME")); + chdir (get_homedir ()); if (skip_args < argc) { if (!strncmp (argv[skip_args], "-psn", 4)) { skip_args += 1; - if (! ch_to_dir) chdir (getenv ("HOME")); + if (! ch_to_dir) chdir (get_homedir ()); } else if (skip_args+1 < argc && !strncmp (argv[skip_args+1], "-psn", 4)) { skip_args += 2; - if (! ch_to_dir) chdir (getenv ("HOME")); + if (! ch_to_dir) chdir (get_homedir ()); } } #endif /* COCOA */ diff --git a/src/fileio.c b/src/fileio.c index 7fb865809f..e178c39fc1 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -96,6 +96,7 @@ along with GNU Emacs. If not, see . */ #include #include #include +#include #include #include #include @@ -1093,8 +1094,7 @@ the root directory. */) { Lisp_Object tem; - if (!(newdir = egetenv ("HOME"))) - newdir = newdirlim = ""; + newdir = get_homedir (); nm++; #ifdef WINDOWSNT if (newdir[0]) @@ -1109,7 +1109,7 @@ the root directory. */) #endif tem = build_string (newdir); newdirlim = newdir + SBYTES (tem); - /* `egetenv' may return a unibyte string, which will bite us + /* get_homedir may return a unibyte string, which will bite us if we expect the directory to be multibyte. */ if (multibyte && !STRING_MULTIBYTE (tem)) { @@ -1637,7 +1637,6 @@ See also the function `substitute-in-file-name'.") } #endif -/* If /~ or // appears, discard everything through first slash. */ static bool file_name_absolute_p (const char *filename) { @@ -1650,6 +1649,61 @@ file_name_absolute_p (const char *filename) ); } +/* Put into BUF the concatenation of DIR and FILE, with an intervening + directory separator if needed. Return a pointer to the null byte + at the end of the concatenated string. */ +char * +splice_dir_file (char *buf, char const *dir, char const *file) +{ + char *e = stpcpy (buf, dir); + *e = DIRECTORY_SEP; + e += ! (buf < e && IS_DIRECTORY_SEP (e[-1])); + return stpcpy (e, file); +} + +/* Get the home directory, an absolute file name. Return the empty + string on failure. The returned value does not survive garbage + collection, calls to this function, or calls to the getpwnam class + of functions. */ +char const * +get_homedir (void) +{ + char const *home = egetenv ("HOME"); + if (!home) + { + static char const *userenv[] = {"LOGNAME", "USER"}; + struct passwd *pw = NULL; + for (int i = 0; i < ARRAYELTS (userenv); i++) + { + char *user = egetenv (userenv[i]); + if (user) + { + pw = getpwnam (user); + if (pw) + break; + } + } + if (!pw) + pw = getpwuid (getuid ()); + if (pw) + home = pw->pw_dir; + if (!home) + return ""; + } + if (IS_ABSOLUTE_FILE_NAME (home)) + return home; + if (!emacs_wd) + error ("$HOME is relative to unknown directory"); + static char *ahome; + static ptrdiff_t ahomesize; + ptrdiff_t ahomelenbound = strlen (emacs_wd) + 1 + strlen (home) + 1; + if (ahomesize <= ahomelenbound) + ahome = xpalloc (ahome, &ahomesize, ahomelenbound + 1 - ahomesize, -1, 1); + splice_dir_file (ahome, emacs_wd, home); + return ahome; +} + +/* If /~ or // appears, discard everything through first slash. */ static char * search_embedded_absfilename (char *nm, char *endp) { diff --git a/src/lisp.h b/src/lisp.h index f8ffb33a64..7e7dba631f 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4061,6 +4061,8 @@ extern void syms_of_marker (void); /* Defined in fileio.c. */ +extern char *splice_dir_file (char *, char const *, char const *); +extern char const *get_homedir (void); extern Lisp_Object expand_and_dir_to_file (Lisp_Object); extern Lisp_Object write_region (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, @@ -4185,6 +4187,7 @@ extern void syms_of_frame (void); /* Defined in emacs.c. */ extern char **initial_argv; extern int initial_argc; +extern char const *emacs_wd; #if defined (HAVE_X_WINDOWS) || defined (HAVE_NS) extern bool display_arg; #endif diff --git a/src/xrdb.c b/src/xrdb.c index 4abf1ad84e..87c2faf659 100644 --- a/src/xrdb.c +++ b/src/xrdb.c @@ -202,35 +202,6 @@ magic_db (const char *string, ptrdiff_t string_len, const char *class, } -static char * -gethomedir (void) -{ - struct passwd *pw; - char *ptr; - char *copy; - - if ((ptr = getenv ("HOME")) == NULL) - { - if ((ptr = getenv ("LOGNAME")) != NULL - || (ptr = getenv ("USER")) != NULL) - pw = getpwnam (ptr); - else - pw = getpwuid (getuid ()); - - if (pw) - ptr = pw->pw_dir; - } - - if (ptr == NULL) - return xstrdup ("/"); - - ptrdiff_t len = strlen (ptr); - copy = xmalloc (len + 2); - strcpy (copy + len, "/"); - return memcpy (copy, ptr, len); -} - - /* Find the first element of SEARCH_PATH which exists and is readable, after expanding the %-escapes. Return 0 if we didn't find any, and the path name of the one we found otherwise. */ @@ -316,12 +287,11 @@ get_user_app (const char *class) if (! db) { /* Check in the home directory. This is a bit of a hack; let's - hope one's home directory doesn't contain any %-escapes. */ - char *home = gethomedir (); + hope one's home directory doesn't contain ':' or '%'. */ + char const *home = get_homedir (); db = search_magic_path (home, class, "%L/%N"); if (! db) db = search_magic_path (home, class, "%N"); - xfree (home); } return db; @@ -346,10 +316,9 @@ get_user_db (Display *display) else { /* Use ~/.Xdefaults. */ - char *home = gethomedir (); - ptrdiff_t homelen = strlen (home); - char *filename = xrealloc (home, homelen + sizeof xdefaults); - strcpy (filename + homelen, xdefaults); + char const *home = get_homedir (); + char *filename = xmalloc (strlen (home) + 1 + sizeof xdefaults); + splice_dir_file (filename, home, xdefaults); db = XrmGetFileDatabase (filename); xfree (filename); } @@ -380,13 +349,12 @@ get_environ_db (void) if (STRINGP (system_name)) { /* Use ~/.Xdefaults-HOSTNAME. */ - char *home = gethomedir (); - ptrdiff_t homelen = strlen (home); - ptrdiff_t filenamesize = (homelen + sizeof xdefaults - + 1 + SBYTES (system_name)); - p = filename = xrealloc (home, filenamesize); - lispstpcpy (stpcpy (stpcpy (filename + homelen, xdefaults), "-"), - system_name); + char const *home = get_homedir (); + p = filename = xmalloc (strlen (home) + 1 + sizeof xdefaults + + 1 + SBYTES (system_name)); + char *e = splice_dir_file (p, home, xdefaults); + *e++ = '/'; + lispstpcpy (e, system_name); } } diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el index 5d12685fa1..b7b78bbda0 100644 --- a/test/src/fileio-tests.el +++ b/test/src/fileio-tests.el @@ -95,3 +95,11 @@ Also check that an encoding error can appear in a symlink." (should (equal (file-name-as-directory "d:/abc/") "d:/abc/")) (should (equal (file-name-as-directory "D:\\abc/") "d:/abc/")) (should (equal (file-name-as-directory "D:/abc//") "d:/abc//"))) + +(ert-deftest fileio-tests--relative-HOME () + "Test that expand-file-name works even when HOME is relative." + (let ((old-home (getenv "HOME"))) + (setenv "HOME" "a/b/c") + (should (equal (expand-file-name "~/foo") + (expand-file-name "a/b/c/foo"))) + (setenv "HOME" old-home))) commit ce1fb157e840fd292c3db4632831c4514a663890 Author: Stefan Monnier Date: Tue Nov 13 09:03:12 2018 -0500 * lisp/files.el: Justify binding of read-circle with comments diff --git a/lisp/files.el b/lisp/files.el index cfc178738c..dbac6f614f 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -758,9 +758,10 @@ nil (meaning `default-directory') as the associated list element." ;; do end up using a superficially different directory. (setq dir (expand-file-name dir)) (if (not (file-directory-p dir)) - (if (file-exists-p dir) - (error "%s is not a directory" dir) - (error "%s: no such directory" dir)) + (error (if (file-exists-p dir) + "%s is not a directory" + "%s: no such directory") + dir) (unless (file-accessible-directory-p dir) (error "Cannot cd to %s: Permission denied" dir)) (setq default-directory dir) @@ -1895,7 +1896,7 @@ afterwards (so long as the home directory does not change; if you want to permanently change your home directory after having started Emacs, set `abbreviated-home-dir' to nil so it will be recalculated)." ;; Get rid of the prefixes added by the automounter. - (save-match-data + (save-match-data ;FIXME: Why? (if (and automount-dir-prefix (string-match automount-dir-prefix filename) (file-exists-p (file-name-directory @@ -3456,6 +3457,8 @@ return as the symbol specifying the mode." (let* ((key (intern (match-string 1))) (val (save-restriction (narrow-to-region (point) end) + ;; As a defensive measure, we do not allow + ;; circular data in the file-local data. (let ((read-circle nil)) (read (current-buffer))))) ;; It is traditional to ignore @@ -3665,6 +3668,8 @@ local variables, but directory-local variables may still be applied." ;; Read the variable value. (skip-chars-forward "^:") (forward-char 1) + ;; As a defensive measure, we do not allow + ;; circular data in the file-local data. (let ((read-circle nil)) (setq val (read (current-buffer)))) (if (eq handle-mode t) @@ -4110,6 +4115,8 @@ Return the new class name, which is a symbol named DIR." (insert-file-contents file) (let ((newvars (condition-case-unless-debug nil + ;; As a defensive measure, we do not allow + ;; circular data in the file/dir-local data. (let ((read-circle nil)) (read (current-buffer))) (end-of-file nil)))) @@ -7154,7 +7161,7 @@ only these files will be asked to be saved." (if (symbolp (car file-arg-indices)) (setq method (pop file-arg-indices))) ;; Strip off the /: from the file names that have it. - (save-match-data + (save-match-data ;FIXME: Why? (while (consp file-arg-indices) (let ((pair (nthcdr (car file-arg-indices) arguments))) (when (car pair) commit 197bf4eaac0ed98549f4343a653ba21aac47c855 Author: Noam Postavsky Date: Tue Nov 13 08:25:35 2018 -0500 Fix build fail on files.el change (Bug#32352) * lisp/files.el (dir-locals-read-from-dir): Reduce scope of `read-circle' let-binding to go around the `read' call only. Otherwise it can interfere with loading of files which use the circular read syntax (e.g., executing the setf expression in `dir-locals-set-class-variables' may require loading gv.elc). diff --git a/lisp/files.el b/lisp/files.el index 47f7acf92c..cfc178738c 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -4096,7 +4096,6 @@ apply). Return the new class name, which is a symbol named DIR." (let* ((class-name (intern dir)) (files (dir-locals--all-files dir)) - (read-circle nil) ;; If there was a problem, use the values we could get but ;; don't let the cache prevent future reads. (latest 0) (success 0) @@ -4111,7 +4110,8 @@ Return the new class name, which is a symbol named DIR." (insert-file-contents file) (let ((newvars (condition-case-unless-debug nil - (read (current-buffer)) + (let ((read-circle nil)) + (read (current-buffer))) (end-of-file nil)))) (setq variables ;; Try and avoid loading `map' since that also loads cl-lib commit b8d50754767e4d2d82b1b5d46c21d7a0584a4d93 Author: Michael Albinus Date: Tue Nov 13 11:04:20 2018 +0100 ; Cosmetic changes in etc/NEWS diff --git a/etc/NEWS b/etc/NEWS index b8073dd175..bbcd7a5747 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3,8 +3,8 @@ GNU Emacs NEWS -- history of user-visible changes. Copyright (C) 2017-2018 Free Software Foundation, Inc. See the end of the file for license conditions. -Please send Emacs bug reports to bug-gnu-emacs@gnu.org. -If possible, use M-x report-emacs-bug. +Please send Emacs bug reports to 'bug-gnu-emacs@gnu.org'. +If possible, use 'M-x report-emacs-bug'. This file is about changes in Emacs version 27. @@ -13,7 +13,7 @@ See files NEWS.26, NEWS.25, ..., NEWS.18, and NEWS.1-17 for changes in older Emacs versions. You can narrow news to a specific version by calling 'view-emacs-news' -with a prefix argument or by typing C-u C-h C-n. +with a prefix argument or by typing 'C-u C-h C-n'. Temporary note: +++ indicates that all necessary documentation updates are complete. @@ -27,11 +27,11 @@ When you add a new item, use the appropriate mark if you are sure it applies, ** Emacs now uses GMP, the GNU Multiple Precision library. By default, if 'configure' does not find a suitable libgmp, it arranges for the included mini-gmp library to be built and used. -The new 'configure' option --without-libgmp uses mini-gmp even if a +The new 'configure' option '--without-libgmp' uses mini-gmp even if a suitable libgmp is available. ** The new configure option '--with-json' adds support for JSON using -the Jansson library. It is on by default; use 'configure +the Jansson library. It is on by default; use './configure --with-json=no' to build without Jansson support. The new JSON functions 'json-serialize', 'json-insert', 'json-parse-string', and 'json-parse-buffer' are typically much faster than their Lisp @@ -44,7 +44,7 @@ support other programs. The new configure option '--without-included-regex' forces etags to use the C library's regex matcher even if the regex substitute ordinarily would be used to work around compatibility problems. -** Emacs has been ported to the -fcheck-pointer-bounds option of GCC. +** Emacs has been ported to the '-fcheck-pointer-bounds' option of GCC. This causes Emacs to check bounds of some arrays addressed by its internal pointers, which can be helpful when debugging the Emacs interpreter or modules that it uses. If your platform supports it you @@ -54,8 +54,8 @@ can enable it when configuring, e.g., './configure CFLAGS="-g3 -O2 ** Emacs now normally uses a C pointer type instead of a C integer type to implement Lisp_Object, which is the fundamental machine word type internal to the Emacs Lisp interpreter. This change aims to -catch typos and support -fcheck-pointer-bounds. The 'configure' -option --enable-check-lisp-object-type is therefore no longer as +catch typos and supports '-fcheck-pointer-bounds'. The 'configure' +option '--enable-check-lisp-object-type' is therefore no longer as useful and so is no longer enabled by default in developer builds, to reduce differences between developer and production builds. @@ -113,7 +113,7 @@ work right without some adjustment: Units that are ordered after 'emacs.service' will only be started after Emacs has finished initialization and is ready for use. (If your Emacs is installed in a non-standard location and you copied the -emacs.service file to eg ~/.config/systemd/user/, you will need to copy +emacs.service file to eg "~/.config/systemd/user/", you will need to copy the new version of the file again.) @@ -123,7 +123,7 @@ the new version of the file again.) ** emacsclient now supports the 'EMACS_SOCKET_NAME' environment variable. The behavior is identical to 'EMACS_SERVER_FILE', in that the command-line value specified via '--socket-name' will override the -environment, and the natural default to TMPDIR, then '/tmp', continues +environment, and the natural default to TMPDIR, then "/tmp", continues to apply. +++ @@ -136,7 +136,7 @@ it resizes the echo area as needed to accommodate the full tool-tip text. --- -** Show modeline tooltips only if the corresponding action applies. +** Show mode line tooltips only if the corresponding action applies. Customize the option 'mode-line-default-help-echo' to restore the old behavior where the tooltip text is also shown when the corresponding action does not apply. @@ -201,7 +201,7 @@ regular expression was previously invalid, but is now accepted: ** The German prefix and postfix input methods now support Capital sharp S. --- -** New input methods hawaiian-postfix and hawaiian-prefix. +** New input methods 'hawaiian-postfix' and 'hawaiian-prefix'. +++ ** New function 'exec-path'. @@ -268,7 +268,7 @@ tables which do not have any non-system abbrevs to save. +++ ** The new functions and commands 'text-property-search-forward' and 'text-property-search-backward' have been added. These provide an -interface that's more like functions like @code{search-forward}. +interface that's more like functions like 'search-forward'. --- ** More commands support noncontiguous rectangular regions, namely @@ -282,10 +282,10 @@ file literally, as in 'find-file-literally', which speeds up navigation and editing of large files. --- -** add-dir-local-variable now uses dotted pair notation syntax -to write alists of variables to .dir-locals.el. This is the same -syntax that you can see in the example of a .dir-locals.el file -in (info "(emacs) Directory Variables") +** 'add-dir-local-variable' now uses dotted pair notation syntax to +write alists of variables to ".dir-locals.el". This is the same +syntax that you can see in the example of a ".dir-locals.el" file in +the node "(emacs) Directory Variables" of the user manual. * Changes in Specialized Modes and Packages in Emacs 27.1 @@ -639,8 +639,8 @@ and case-sensitivity together with search strings in the search ring. +++ *** The Lisp Debugger is now based on 'backtrace-mode'. Backtrace mode adds fontification and commands for changing the -appearance of backtrace frames. See the node "Backtraces" in the Elisp -manual for documentation of the new mode and its commands. +appearance of backtrace frames. See the node "(elisp) Backtraces" in +the Elisp manual for documentation of the new mode and its commands. ** Edebug @@ -654,8 +654,8 @@ globally or for individual definitions. +++ *** Edebug's backtrace buffer now uses 'backtrace-mode'. Backtrace mode adds fontification, links and commands for changing the -appearance of backtrace frames. See the node "Backtraces" in the Elisp -manual for documentation of the new mode and its commands. +appearance of backtrace frames. See the node "(elisp) Backtraces" in +the Elisp manual for documentation of the new mode and its commands. The binding of 'd' in Edebug's keymap is now 'edebug-pop-to-backtrace' which replaces 'edebug-backtrace'. Consequently Edebug's backtrace @@ -691,8 +691,8 @@ less verbose by removing non-essential information. +++ *** ERT's backtrace buffer now uses 'backtrace-mode'. Backtrace mode adds fontification and commands for changing the -appearance of backtrace frames. See the node "Backtraces" in the Elisp -manual for documentation of the new mode and its commands. +appearance of backtrace frames. See the node "(elisp) Backtraces" in +the Elisp manual for documentation of the new mode and its commands. ** Gamegrid @@ -729,7 +729,7 @@ It can be used to set any buffer as the next one to be used by --- *** The default value of 'nxml-sexp-element-flag' is now t. -This means that pressing C-M-SPACE now selects the entire tree by +This means that pressing 'C-M-SPACE' now selects the entire tree by default, and not just the opening element. ** Eshell @@ -745,8 +745,8 @@ To restore the old behavior, use *** The function 'eshell-uniquify-list' has been renamed from 'eshell-uniqify-list'. -*** The function eshell/kill is now able to handle signal switches. -Previously eshell/kill would fail if provided a kill signal to send to the +*** The function 'eshell/kill' is now able to handle signal switches. +Previously 'eshell/kill' would fail if provided a kill signal to send to the process. It now accepts signals specified either by name or by its number. ** Shell @@ -761,7 +761,7 @@ process. It now accepts signals specified either by name or by its number. ** Auth-source --- -*** The Secret Service backend supports the :create key now. +*** The Secret Service backend supports the ':create' key now. ** Tramp @@ -779,7 +779,7 @@ are obsoleted in GVFS. +++ *** During user and host name completion in the minibuffer, results from auth-source search are taken into account. This can be disabled -by setting user option 'tramp-completion-use-auth-sources' to nil. +by setting the user option 'tramp-completion-use-auth-sources' to nil. +++ *** The user option 'tramp-ignored-file-name-regexp' allows to disable @@ -880,36 +880,36 @@ backtrace with 'b'. --- ** thingatpt.el supports a new "thing" called 'uuid'. -A symbol 'uuid' can be passed to thing-at-point and it returns the +A symbol 'uuid' can be passed to 'thing-at-point' and it returns the UUID at point. - ** Interactive automatic highlighting + +++ *** 'highlight-regexp' can now highlight subexpressions. -The now command accepts a prefix numeric argument to choose the +The new command accepts a prefix numeric argument to choose the subexpression. ** Mouse display of minor mode menu --- -*** 'minor-mode-menu-from-indicator' now display full minor mode name. +*** 'minor-mode-menu-from-indicator' now displays full minor mode name. When there is no menu for a mode, display the mode name after the indicator instead of just the indicator (which is sometimes cryptic). * New Modes and Packages in Emacs 27.1 -** multifile.el lets one setup multifile operations like search&replace +** multifile.el lets one setup multifile operations like search&replace. +++ ** Emacs can now visit files in archives as if they were directories. This feature uses Tramp and works only on systems which support GVFS, -i.e. GNU/Linux, roughly spoken. See the chapter "(tramp) Archive file +i.e. GNU/Linux, roughly spoken. See the node "(tramp) Archive file names" in the Tramp manual for full documentation of these facilities. +++ -** New library for writing JSONRPC applications (https://jsonrpc.org) +** New library for writing JSONRPC applications (https://jsonrpc.org). The 'jsonrpc' library enables writing Emacs Lisp applications that rely on this protocol. Since the protocol is designed to be transport-agnostic, the library provides an API to implement new @@ -921,19 +921,19 @@ used by the Language Server Protocol (LSP), is readily available. ** Backtrace mode improves viewing of Elisp backtraces. Backtrace mode adds pretty printing, fontification and ellipsis expansion to backtrace buffers produced by the Lisp debugger, Edebug -and ERT. See the node "Backtraces" in the Elisp manual for +and ERT. See the node "(elisp) Backtraces" in the Elisp manual for documentation of the new mode and its commands. * Incompatible Lisp Changes in Emacs 27.1 -** define-fringe-bitmap is always defined, even when Emacs is built +** 'define-fringe-bitmap' is always defined, even when Emacs is built without any GUI support. --- ** Just loading a theme's file no longer activates the theme's settings. Loading a theme with 'M-x load-theme' still activates the theme, as it -did before. However, loading the theme's file with "M-x load-file", +did before. However, loading the theme's file with 'M-x load-file', or using 'require' or 'load' in a Lisp program, doesn't actually apply the theme's settings until you either invoke 'M-x enable-theme' or type 'M-x load-theme'. (In a Lisp program, calling 'enable-theme' or @@ -946,7 +946,7 @@ default applied immediately. The variable 'custom--inhibit-theme-enable' controls this behavior; its default value changed in Emacs 27.1. -** The 'repetitions' argument of 'benchmark-run' can now also be a variable. +** The REPETITIONS argument of 'benchmark-run' can now also be a variable. ** The FILENAME argument to 'file-name-base' is now mandatory and no longer defaults to 'buffer-file-name'. @@ -1011,7 +1011,7 @@ default-directory-alist, dired-default-directory, dired-default-directory-alist, dired-enable-local-variables, dired-hack-local-variables, dired-local-variables-file, dired-omit-here-always. -** garbage collection no longer treats miscellaneous objects specially; +** Garbage collection no longer treats miscellaneous objects specially; they are now allocated like any other pseudovector. As a result, the 'garbage-collect' and 'memory-use-count' functions no longer return a 'misc' component, and the 'misc-objects-consed' variable has been @@ -1020,7 +1020,7 @@ removed. * Lisp Changes in Emacs 27.1 -** lookup-key can take a list of keymaps as argument. +** 'lookup-key' can take a list of keymaps as argument. +++ ** 'condition-case' now accepts 't' to match any error symbol. @@ -1054,23 +1054,24 @@ overflow error if this limit is exceeded. Several primitive functions formerly returned floats or lists of integers to represent integers that did not fit into fixnums. These functions now simply return integers instead. Affected functions -include functions like encode-char that compute code-points, functions -like file-attributes that compute file sizes and other attributes, -functions like process-id that compute process IDs, and functions like -user-uid and group-gid that compute user and group IDs. +include functions like 'encode-char' that compute code-points, functions +like 'file-attributes' that compute file sizes and other attributes, +functions like 'process-id' that compute process IDs, and functions like +'user-uid' and 'group-gid' that compute user and group IDs. +++ ** Although the default timestamp format is still (HI LO US PS), it is planned to change in a future Emacs version, to exploit bignums. The documentation has been updated to mention that the timestamp format may change and that programs should use functions like -format-time-string, decode-time, and encode-time rather than probing -the innards of a timestamp directly, or creating a timestamp by hand. +'format-time-string', 'decode-time', and 'encode-time' rather than +probing the innards of a timestamp directly, or creating a timestamp +by hand. +++ -** encode-time supports a new API (encode-time TIME &optional FORM). +** 'encode-time' supports a new API '(encode-time TIME &optional FORM)'. This can convert decoded times and Lisp time values to Lisp timestamps -of various forms, including a new timestamp form (TICKS . HZ), where +of various forms, including a new timestamp form '(TICKS . HZ)', where TICKS is an integer and HZ is a positive integer denoting a clock frequency. The old encode-time API is still supported. @@ -1082,7 +1083,7 @@ floating-point operators do. +++ ** New function 'time-equal-p' compares time values for equality. -** define-minor-mode automatically documents the meaning of ARG. +** 'define-minor-mode' automatically documents the meaning of ARG. +++ ** The function 'recenter' now accepts an additional optional argument. @@ -1125,8 +1126,8 @@ On terminal emulators that support the feature, Emacs can now support ** Window-specific face remapping. Face specifications (of the kind used in 'face-remapping-alist') now support filters, allowing faces to vary between different windows -displaying the same buffer. See the Info node "Face Remapping" of the -Emacs Lisp Reference manual for more detail. +displaying the same buffer. See the node "(elisp) Face Remapping" +of the Emacs Lisp Reference manual for more detail. +++ ** Special handling of buffer-local 'window-size-change-functions'. @@ -1134,23 +1135,23 @@ A buffer-local value of this hook is now run only if at least one window showing the buffer has changed its size. +++ -** The function assoc-delete-all now takes an optional predicate argument. +** The function 'assoc-delete-all' now takes an optional predicate argument. +++ ** New function 'string-distance' to calculate the Levenshtein distance between two strings. ** 'print-quoted' now defaults to t, so if you want to see -(quote x) instead of 'x you will have to bind it to nil where applicable. +'(quote x)' instead of 'x you will have to bind it to nil where applicable. +++ -** Numbers formatted via %o or %x may now be formatted as signed integers. -This avoids problems in calls like (read (format "#x%x" -1)), and is +** Numbers formatted via '%o' or '%x' may now be formatted as signed integers. +This avoids problems in calls like '(read (format "#x%x" -1))', and is more compatible with bignums, a planned feature. To get this -behavior, set the experimental variable binary-as-unsigned to nil, +behavior, set the experimental variable 'binary-as-unsigned' to nil, and if the new behavior breaks your code please email -32252@debbugs.gnu.org. Because %o and %x can now format signed -integers, they now support the + and space flags. +32252@debbugs.gnu.org. Because '%o' and '%x' can now format signed +integers, they now support the '+' and space flags. ** To avoid confusion caused by "smart quotes", the reader signals an error when reading Lisp symbols which begin with one of the following @@ -1163,7 +1164,7 @@ backslash. For example: +++ ** Omitting variables after '&optional' and '&rest' is now allowed. -For example (defun foo (&optional)) is no longer an error. This is +For example '(defun foo (&optional))' is no longer an error. This is sometimes convenient when writing macros. See the ChangeLog entry titled "Allow '&rest' or '&optional' without following variable (Bug#29165)" for a full listing of which arglists are accepted across @@ -1172,8 +1173,8 @@ versions. ** Internal parsing commands now use 'syntax-ppss' and disregard 'open-paren-in-column-0-is-defun-start'. This affects mostly things like 'forward-comment', 'scan-sexps', and 'forward-sexp' when parsing backward. -The new variable 'comment-use-syntax-ppss' can be set to nil to recover the old -behavior if needed. +The new variable 'comment-use-syntax-ppss' can be set to nil to recover +the old behavior if needed. ** The 'server-name' and 'server-socket-dir' variables are set when a socket has been passed to Emacs. @@ -1183,6 +1184,10 @@ socket has been passed to Emacs. instead of just Microsoft platforms. This fixes a 'get-free-disk-space' bug on OS X 10.8 and later. +--- +** The function 'get-free-disk-space' returns now a non-nil value for +remote systems, which support this check. + +++ ** 'memory-limit' now returns a better estimate of memory consumption. @@ -1193,18 +1198,14 @@ each around a sequence of lisp forms, given a region. This is useful when a function makes a possibly large number of repetitive changes and the change hooks are time consuming. ---- -** The function 'get-free-disk-space' returns now a non-nil value for -remote systems, which support this check. - +++ ** 'eql', 'make-hash-table', etc. now treat NaNs consistently. Formerly, some of these functions ignored signs and significands of NaNs. Now, all these functions treat NaN signs and significands as -significant. For example, (eql 0.0e+NaN -0.0e+NaN) now returns nil +significant. For example, '(eql 0.0e+NaN -0.0e+NaN)' now returns nil because the two NaNs have different signs; formerly it returned t. Also, Emacs now reads and prints NaN significands; e.g., if X is a -NaN, (format "%s" X) now returns "0.0e+NaN", "1.0e+NaN", etc., +NaN, '(format "%s" X)' now returns "0.0e+NaN", "1.0e+NaN", etc., depending on X's significand. +++ @@ -1212,14 +1213,14 @@ depending on X's significand. If the optional third argument is non-nil, 'make-string' will produce a multibyte string even if its second argument is an ASCII character. -** (format "%d" X) no longer mishandles a floating-point number X that +** '(format "%d" X)' no longer mishandles a floating-point number X that does not fit in a machine integer. +++ -** In the DST slot, encode-time and parse-time-string now return -1 +** In the DST slot, 'encode-time' and 'parse-time-string' now return -1 if it is not known whether daylight saving time is in effect. -Formerly they were inconsistent: encode-time returned t in this -situation, whereas parse-time-string returned nil. Now they +Formerly they were inconsistent: 'encode-time' returned t in this +situation, whereas 'parse-time-string' returned nil. Now they consistently use use nil to mean that DST is not in effect, and use -1 to mean that it is not known whether DST is in effect. @@ -1240,23 +1241,23 @@ file name extensions. *** The default way the list of possible external viewers for MIME types is sorted and chosen has changed. Earlier, the most specific -viewer was chosen, even if there was a general override in ~/.mailcap. -For instance, if /etc/mailcap has an entry for image/gif, that one -will be chosen even if you have an entry for image/* in your -~/.mailcap file. But with the new method, entries from ~/.mailcap +viewer was chosen, even if there was a general override in "~/.mailcap". +For instance, if "/etc/mailcap" has an entry for "image/gif", that one +will be chosen even if you have an entry for "image/*" in your +"~/.mailcap" file. But with the new method, entries from "~/.mailcap" overrides all system and Emacs-provided defaults. To get the old method back, set 'mailcap-prefer-mailcap-viewers' to nil. ** URL -*** The file: handler no longer looks for index.html in directories if -you ask it for a file:///dir URL. Since this is a low-level library, -such decisions (if they are to be made at all) are left to -higher-level functions. +*** The 'file:' handler no longer looks for "index.html" in +directories if you ask it for a "file:///dir" URL. Since this is a +low-level library, such decisions (if they are to be made at all) are +left to higher-level functions. -** image-mode +** Image mode -*** image-mode started using ImageMagick by default for all images +*** 'image-mode' started using ImageMagick by default for all images some years back. It now respects 'imagemagick-types-inhibit' as a way to disable that. commit acee0a8f2052abb9aacb8d782afcc5cd64363f04 Author: Michael Albinus Date: Tue Nov 13 09:45:42 2018 +0100 ; Cosmetic changes in etc/NEWS diff --git a/etc/NEWS b/etc/NEWS index dfafe7c5c9..6dba2a950b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3,8 +3,8 @@ GNU Emacs NEWS -- history of user-visible changes. Copyright (C) 2016-2018 Free Software Foundation, Inc. See the end of the file for license conditions. -Please send Emacs bug reports to bug-gnu-emacs@gnu.org. -If possible, use M-x report-emacs-bug. +Please send Emacs bug reports to 'bug-gnu-emacs@gnu.org'. +If possible, use 'M-x report-emacs-bug'. This file is about changes in Emacs version 26. @@ -13,7 +13,7 @@ See files NEWS.25, NEWS.24, ..., NEWS.18, and NEWS.1-17 for changes in older Emacs versions. You can narrow news to a specific version by calling 'view-emacs-news' -with a prefix argument or by typing C-u C-h C-n. +with a prefix argument or by typing 'C-u C-h C-n'. * Installation Changes in Emacs 26.2 @@ -65,12 +65,17 @@ often cause crashes. Set it to nil if you really need those fonts. --- *** Mailutils movemail will now be used if found at runtime. -The default value of mail-source-movemail-program is now "movemail". +The default value of 'mail-source-movemail-program' is now "movemail". This ensures that the movemail program from GNU Mailutils will be used if found in 'exec-path', even if it was not found at build time. To -use a different program, customize mail-source-movemail-program to the +use a different program, customize 'mail-source-movemail-program' to the absolute file name of the desired executable. +** Shadowfile + +--- +*** shadowfile.el has been rewritten to support Tramp file names. + ** Shell mode --- @@ -103,16 +108,13 @@ whether the version shown on the mode line is that of the visited file or of the repository working copy. --- -**** Display of Mercurial revisions in the mode-line has changed. +**** Display of Mercurial revisions in the mode line has changed. Previously, the mode line displayed the local number (1, 2, 3, ...) of the revision. Starting with Emacs 26.1, the default has changed, and it now shows the global revision number, in the form of its changeset hash value. To get back the previous behavior, customize the new option 'vc-hg-symbolic-revision-styles' to the value '("{rev}")'. ---- -** shadowfile.el has been rewritten to support Tramp file names. - * New Modes and Packages in Emacs 26.2 @@ -175,11 +177,11 @@ version 2.6.6 or later. ** The new option 'configure --with-mailutils' causes Emacs to rely on GNU Mailutils to retrieve email. It is recommended, and is the -default if GNU Mailutils is installed. When --with-mailutils is not +default if GNU Mailutils is installed. When '--with-mailutils' is not in effect, the Emacs build procedure by default continues to build and install a limited 'movemail' substitute that retrieves POP3 email only via insecure channels. To avoid this problem, use either ---with-mailutils or --without-pop when configuring; --without-pop +'--with-mailutils' or '--without-pop' when configuring; '--without-pop' is the default on platforms other than native MS-Windows. ** The new option 'configure --enable-gcc-warnings=warn-only' causes commit a6ef167b8dbcfbe5e5792d19737957b030597609 Author: Michael Albinus Date: Tue Nov 13 09:44:06 2018 +0100 * test/README: Explain $REMOTE_TEMPORARY_FILE_DIRECTORY. diff --git a/test/README b/test/README index e473248c9e..ef5f53cba5 100644 --- a/test/README +++ b/test/README @@ -59,6 +59,15 @@ debugging. To do that, use make TEST_INTERACTIVE=yes ... +Some of the tests require a remote temporary directory +(filenotify-tests.el, shadowfile-tests.el and tramp-tests.el). Per +default, a mock-up connection method is used (this might not be +possible when running on MS Windows). If you want to test a real +remote connection, set $REMOTE_TEMPORARY_FILE_DIRECTORY to a suitable +value in order to overwrite the default value: + + env REMOTE_TEMPORARY_FILE_DIRECTORY=/ssh:host:/tmp make ... + (Also, see etc/compilation.txt for compilation mode font lock tests.) commit b8bbbe54ddb7dc49cd28bb03a7f9f1a059501d1e Author: Glenn Morris Date: Tue Jan 23 20:55:09 2018 -0500 Avoid kill-emacs-hook errors hanging batch mode * src/emacs.c (Fkill_emacs): Prevent errors from kill-emacs-hook hanging Emacs in batch mode. (Bug#29955) (cherry picked from commit 109da684c5124e22505917fe0255ca66f2a6bfc9) diff --git a/src/emacs.c b/src/emacs.c index f80047e89e..7a918b8bdf 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -2017,7 +2017,10 @@ all of which are called before Emacs is actually killed. */ /* Fsignal calls emacs_abort () if it sees that waiting_for_input is set. */ waiting_for_input = 0; - run_hook (Qkill_emacs_hook); + if (noninteractive) + safe_run_hooks (Qkill_emacs_hook); + else + run_hook (Qkill_emacs_hook); #ifdef HAVE_X_WINDOWS /* Transfer any clipboards we own to the clipboard manager. */ commit 73ba6f16d1fe95d7535c8e20f19d11275b8356c4 Merge: f8e4a8b260 e3b3683660 Author: Glenn Morris Date: Mon Nov 12 09:38:27 2018 -0800 ; Merge from origin/emacs-26 The following commit was skipped: e3b3683 (origin/emacs-26) Bump Emacs version to 26.1.90 commit f8e4a8b260398e4d3b4d50a21ccd72ea43e2a7f9 Merge: db80043fb6 189c49ebd8 Author: Glenn Morris Date: Mon Nov 12 09:38:27 2018 -0800 Merge from origin/emacs-26 189c49e * etc/AUTHORS: Update. 9723c21 ; ChangeLog.3 update commit db80043fb6c6d9ede2c45668b00e75aaf3b9ce3e Merge: 23209e2c19 1d79c2ebd9 Author: Glenn Morris Date: Mon Nov 12 09:38:27 2018 -0800 ; Merge from origin/emacs-26 The following commit was skipped: 1d79c2e Work around dumping bug on GNU/Linux ppc64le commit 23209e2c194f20deba26d8894a25f0ac4a607fe3 Merge: db711687c3 913c001f43 Author: Glenn Morris Date: Mon Nov 12 09:38:27 2018 -0800 Merge from origin/emacs-26 913c001 * lisp/files.el (write-file): Clarify the doc string. (Bug#3... d614b84 Fix typos in midnight.el 8c2778a Improve documentation of 'move-file-to-trash' c7b8a51 ; * doc/lispref/functions.texi (Anonymous Functions): Fix typo. 92296de * src/data.c (Ftype_of): xwidget objects are possible! (bug#3... a3242cc Improve documentation of Diff mode 39e85a0 Note that lex bound lambda forms are not self-quoting (Bug#33... fa605f2 Rewrite buffer display related doc-strings and doc aa55659 Fix call to GlobalMemoryStatusEx in w32.c # Conflicts: # doc/emacs/files.texi # src/data.c commit e3b36836608cd15c62ffa1413fdf04072f9ae6cd Author: Nicolas Petton Date: Mon Nov 12 16:45:23 2018 +0100 Bump Emacs version to 26.1.90 * README: * configure.ac: * msdos/sed2v2.inp: * nt/README.W32: Bump Emacs version to 26.1.90. diff --git a/README b/README index 8fcbb2f43d..ceaecc25a7 100644 --- a/README +++ b/README @@ -2,7 +2,7 @@ Copyright (C) 2001-2018 Free Software Foundation, Inc. See the end of the file for license conditions. -This directory tree holds version 26.1.50 of GNU Emacs, the extensible, +This directory tree holds version 26.1.90 of GNU Emacs, the extensible, customizable, self-documenting real-time display editor. The file INSTALL in this directory says how to build and install GNU diff --git a/configure.ac b/configure.ac index acea74094d..dc6d776d45 100644 --- a/configure.ac +++ b/configure.ac @@ -23,7 +23,7 @@ dnl along with GNU Emacs. If not, see . AC_PREREQ(2.65) dnl Note this is parsed by (at least) make-dist and lisp/cedet/ede/emacs.el. -AC_INIT(GNU Emacs, 26.1.50, bug-gnu-emacs@gnu.org) +AC_INIT(GNU Emacs, 26.1.90, bug-gnu-emacs@gnu.org) dnl Set emacs_config_options to the options of 'configure', quoted for the shell, dnl and then quoted again for a C string. Separate options with spaces. diff --git a/msdos/sed2v2.inp b/msdos/sed2v2.inp index 89cb7dcdd0..e52c54c6f6 100644 --- a/msdos/sed2v2.inp +++ b/msdos/sed2v2.inp @@ -66,7 +66,7 @@ /^#undef PACKAGE_NAME/s/^.*$/#define PACKAGE_NAME ""/ /^#undef PACKAGE_STRING/s/^.*$/#define PACKAGE_STRING ""/ /^#undef PACKAGE_TARNAME/s/^.*$/#define PACKAGE_TARNAME ""/ -/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION "26.1.50"/ +/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION "26.1.90"/ /^#undef SYSTEM_TYPE/s/^.*$/#define SYSTEM_TYPE "ms-dos"/ /^#undef HAVE_DECL_GETENV/s/^.*$/#define HAVE_DECL_GETENV 1/ /^#undef SYS_SIGLIST_DECLARED/s/^.*$/#define SYS_SIGLIST_DECLARED 1/ diff --git a/nt/README.W32 b/nt/README.W32 index 1d3064c05d..4f19d630b4 100644 --- a/nt/README.W32 +++ b/nt/README.W32 @@ -1,7 +1,7 @@ Copyright (C) 2001-2018 Free Software Foundation, Inc. See the end of the file for license conditions. - Emacs version 26.1.50 for MS-Windows + Emacs version 26.1.90 for MS-Windows This README file describes how to set up and run a precompiled distribution of the latest version of GNU Emacs for MS-Windows. You commit 189c49ebd89c4da6506f6bff931cb23218140ba7 Author: Nicolas Petton Date: Mon Nov 12 16:43:30 2018 +0100 * etc/AUTHORS: Update. diff --git a/etc/AUTHORS b/etc/AUTHORS index a0cd4a7f58..23c88d5590 100644 --- a/etc/AUTHORS +++ b/etc/AUTHORS @@ -9,7 +9,7 @@ Aaron Ecay: changed ob-R.el ob-core.el org-src.el ox-latex.el nsterm.m ob-awk.el ob-exp.el ob-python.el ob-tangle.el org-bibtex.el org-id.el org.el org.texi package.el paren.el -Aaron Jensen: changed frameset.el Info.plist.in nsterm.m +Aaron Jensen: changed frameset.el nsterm.m Info.plist.in mouse.el Aaron Larson: co-wrote bibtex.el @@ -93,10 +93,10 @@ Alakazam Petrofsky: changed hanoi.el Alan Mackenzie: wrote cc-awk.el and co-wrote cc-align.el cc-cmds.el cc-defs.el cc-engine.el cc-fonts.el cc-langs.el cc-mode.el cc-styles.el cc-vars.el -and changed cc-mode.texi bytecomp.el subr.el edebug.el modes.texi - syntax.texi display.texi font-lock.el isearch.el programs.texi - follow.el help.el ispell.el lread.c control.texi cus-start.el doc.c - eval.c frames.texi help-fns.el lisp.el and 133 other files +and changed cc-mode.texi bytecomp.el subr.el edebug.el follow.el + modes.texi syntax.texi display.texi font-lock.el isearch.el + programs.texi help.el ispell.el lread.c windows.texi control.texi + cus-start.el doc.c eval.c frames.texi help-fns.el and 134 other files Alan Modra: changed unexelf.c @@ -108,9 +108,9 @@ Alan Shutko: changed diary-lib.el calendar.el bindings.el cal-hebrew.el Alan Third: wrote dabbrev-tests.el and changed nsterm.m nsfns.m nsterm.h nsmenu.m frame.el macfont.m - nsimage.m ns-win.el conf_post.h frame.c frame.h frames.texi keyboard.c - macfont.h macos.texi picture.el rect.el Info.plist.in battery.el - callproc.c configure.ac and 11 other files + nsimage.m ns-win.el Info.plist.in conf_post.h frame.c frame.h + frames.texi keyboard.c macfont.h macos.texi picture.el rect.el + battery.el callproc.c configure.ac and 12 other files Alastair Burt: changed gnus-art.el smiley.el @@ -128,7 +128,7 @@ Alexander Gramiak: changed faces.el display-line-numbers.el xt-mouse.el CTAGS.good ETAGS.good_1 ETAGS.good_2 ETAGS.good_3 ETAGS.good_4 ETAGS.good_5 ETAGS.good_6 Makefile TAGTEST.EL cl-lib-tests.el cl-macs-tests.el cus-start.el custom.texi display.texi erc-list.el - ert-tests.el ert.el etags.c and 15 other files + ert-tests.el ert.el etags.c and 16 other files Alexander Haeckel: changed getset.el @@ -162,7 +162,8 @@ Alexandre Veyrenc: changed fr-refcard.tex Alexandru Harsanyi: wrote soap-client.el soap-inspect.el and changed emacs3.py vc-hooks.el vc.el xml.el -Alex Branham: changed bibtex.el dired-x.el dired.el eww.el +Alex Branham: changed bibtex.el dired-x.el dired.el em-rebind.el eww.el + imenu.el programs.texi Alex Coventry: changed files.el @@ -203,8 +204,8 @@ Ali Bahrami: changed configure configure.ac sol2-10.h Alin C. Soare: changed lisp-mode.el hexl.el -Allen Li: changed abbrev.el comint.el dired-x.el misc.texi - progmodes/compile.el subr.el +Allen Li: changed abbrev.el bookmark.el comint.el dired-x.el misc.texi + nsm.el progmodes/compile.el subr.el Allen S. Rout: changed org-capture.el @@ -365,8 +366,8 @@ Antonin Houska: changed newcomment.el Arash Esbati: changed reftex-vars.el reftex.el reftex-auc.el reftex-ref.el -Ari Roponen: changed atimer.c doc.c hash.texi mule.texi package.el - startup.el subr.el svg.el time-date.el woman.el +Ari Roponen: changed atimer.c doc.c hash.texi image.c mule.texi + package.el startup.el subr.el svg.el time-date.el woman.el xterm.c Arisawa Akihiro: changed characters.el coding.c epa-file.el japan-util.el language/tibetan.el message.el mm-decode.el mm-view.el ps-print.el @@ -439,8 +440,9 @@ Bartosz Duszel: changed allout.el bib-mode.el cc-cmds.el hexl.el icon.el sendmail.el ses.el simple.el verilog-mode.el vi.el vip.el viper-cmd.el xscheme.el -Basil L. Contovounesios: changed simple.el message.el css-mode-tests.el - css-mode.el customize.texi gnus-art.el json-tests.el json.el man.el +Basil L. Contovounesios: changed simple.el message.el sequences.texi + bibtex.el css-mode-tests.el css-mode.el customize.texi display.texi + gnus-art.el json-tests.el json.el lists.texi man.el rcirc.el shr-color.el text.texi Bastian Beischer: changed include.el mru-bookmark.el refs.el @@ -668,10 +670,10 @@ Changwoo Ryu: changed files.el Chao-Hong Liu: changed TUTORIAL.cn TUTORIAL.zh -Charles A. Roelli: changed nsterm.m display.texi nsfns.m nsterm.h - org-clock.el DEBUG INSTALL add-log.el anti.texi buffers.texi comint.el - data.c diff-mode.el eldoc.el files.el fill.el find-func.el flymake.el - frame.el internals.texi macfont.m and 13 other files +Charles A. Roelli: changed nsterm.m display.texi isearch.el nsfns.m + nsterm.h org-clock.el search.texi simple.el DEBUG INSTALL add-log.el + anti.texi buffers.texi comint.el data.c diff-mode.el eldoc.el files.el + fill.el find-func.el flymake.el and 19 other files Charles Hannum: changed aix3-1.h aix3-2.h configure ibmrs6000.h keyboard.c netbsd.h pop.c sysdep.c systime.h systty.h xrdb.c @@ -778,7 +780,7 @@ Christophe Deleuze: changed icalendar.el Christoph Egger: changed configure.ac -Christophe Junke: changed org-agenda.el org.el +Christophe Junke: changed ido.el org-agenda.el org.el Christopher Allan Webber: changed gamegrid.el org-agenda.el tetris.el @@ -872,7 +874,8 @@ Dale Sedivec: changed sgml-mode.el wisent/python.el Damien Cassou: wrote auth-source-pass-tests.el and co-wrote auth-source-pass.el auth-source-tests.el and changed seq-tests.el seq.el simple-tests.el simple.el auth-source.el - auth.texi imenu-tests.el imenu.el info.el isearch.el sequences.texi + auth.texi imenu-tests.el imenu.el info.el isearch.el rmc.el + sequences.texi Damien Elmes: changed erc.el erc-dcc.el erc-track.el erc-log.el erc-pcomplete.el README erc-button.el erc-nets.el erc-ring.el Makefile @@ -1343,9 +1346,9 @@ Eli Zaretskii: wrote [bidirectional display in xdisp.c] chartab-tests.el coding-tests.el doc-tests.el etags-tests.el rxvt.el tty-colors.el and changed xdisp.c msdos.c w32.c display.texi w32fns.c simple.el - files.el fileio.c w32proc.c keyboard.c w32term.c files.texi text.texi - dispnew.c emacs.c frames.texi lisp.h dispextern.h process.c term.c - window.c and 1111 other files + files.el fileio.c keyboard.c w32proc.c files.texi w32term.c text.texi + dispnew.c emacs.c frames.texi dispextern.h lisp.h process.c term.c + window.c and 1121 other files Emanuele Giaquinta: changed configure.ac rxvt.el charset.c etags.c fontset.c frame.el gnus-faq.texi loadup.el lread.c sh-script.el @@ -1366,11 +1369,11 @@ and changed ada-stmt.el Era Eriksson: changed bibtex.el dired.el json.el ses.el ses.texi shell.el tramp.el tramp.texi -Eric Abrahamsen: changed eieio-base.el nnimap.el registry.el +Eric Abrahamsen: changed eieio-base.el registry.el nnimap.el gnus-registry.el files.el files.texi windows.texi eieio-test-persist.el - eieio.el gnus-start.el nnir.el buffers.texi files-tests.el - gnus-bcklg.el gnus-group.el gnus-sum.el gnus.texi nnmairix.el org.el - org.texi ox-html.el ox-latex.el + eieio.el gnus-start.el gnus-sum.el gnus.texi nnir.el buffers.texi + checkdoc.el files-tests.el gnus-bcklg.el gnus-group.el nnmairix.el + org.el org.texi and 3 other files Eric BĂ©langer: changed image.c @@ -1548,8 +1551,8 @@ Ferenc Wagner: changed nnweb.el Filipe Cabecinhas: changed nsterm.m -Filipp Gunbin: changed autorevert.el shell.el cc-menus.el dired-aux.el - info.el info.texi +Filipp Gunbin: changed autorevert.el shell.el auth-source-tests.el + auth-source.el cc-menus.el dired-aux.el info.el info.texi Flemming Hoejstrup Hansen: changed forms.el @@ -1668,11 +1671,11 @@ G Dinesh Dutt: changed etags.el Geert Kloosterman: changed which-func.el Gemini Lasswell: wrote edebug-tests.el kmacro-tests.el testcover-tests.el -and changed edebug.el cl-macs.el cl-generic.el ert-x.el +and changed edebug.el cl-macs.el cl-generic.el ert-x.el cl-print.el edebug-test-code.el edebug.texi eieio-compat.el generator.el subr.el - autorevert-tests.el filenotify-tests.el generator-tests.el kmacro.el - lread.c map-tests.el map.el pcase.el rst.el ses.el subr-tests.el - subr-x-tests.el and 4 other files + autorevert-tests.el cl-print-tests.el emacs-lisp/debug.el eval-tests.el + eval.c filenotify-tests.el generator-tests.el kmacro.el lread.c + map-tests.el map.el and 9 other files Geoff Gole: changed align.el ibuffer.el whitespace.el @@ -1727,9 +1730,9 @@ Giuseppe Scrivano: changed browse-url.el buffer.c configure.ac sysdep.c Glenn Morris: wrote check-declare.el f90-tests.el vc-bzr-tests.el and changed configure.ac Makefile.in src/Makefile.in calendar.el diary-lib.el lisp/Makefile.in files.el rmail.el make-dist - progmodes/f90.el bytecomp.el simple.el authors.el emacs.texi - misc/Makefile.in admin.el startup.el lib-src/Makefile.in ack.texi - display.texi cal-menu.el and 1675 other files + progmodes/f90.el bytecomp.el simple.el authors.el admin.el emacs.texi + misc/Makefile.in startup.el lib-src/Makefile.in ack.texi display.texi + cal-menu.el and 1680 other files Glynn Clements: wrote gamegrid.el snake.el tetris.el @@ -1974,8 +1977,8 @@ Ivan Radanov Ivanov: changed quail/cyrillic.el Ivan Shmakov: changed eww.el shr.el desktop.el eww.texi faces.el files.el cus-dep.el descr-text.el diff-mode.el enriched.el erc-track.el - facemenu.el files.texi misearch.el nndoc.el simple.el tar-mode.el - tcl.el tex-mode.el url-cookie.el + facemenu.el files.texi iso-transl.el misearch.el nndoc.el simple.el + tar-mode.el tcl.el tex-mode.el url-cookie.el Ivan Vilata i Balaguer: changed org-clock.el org.texi @@ -2122,7 +2125,7 @@ Jay Belanger: changed calc.texi calc.el calc-ext.el calc-units.el Jay K. Adams: wrote jka-cmpr-hook.el jka-compr.el -Jay Kamat: changed erc-goodies.el +Jay Kamat: changed erc-goodies.el esh-opt.el Jay McCarthy: changed org-colview.el @@ -2376,6 +2379,8 @@ John Paul Wallington: changed ibuffer.el ibuf-ext.el subr.el help-fns.el bytecomp.el cus-theme.el font-lock.el hexl.el ibuf-macs.el info.el minibuf.c re-builder.el simple.el startup.el and 135 other files +John Shahid: changed easy-mmode.el term.c termhooks.h terminal.c + John Sullivan: changed window.c John Tobey: changed gud.el @@ -2415,6 +2420,9 @@ Jonathan I. Kamens: changed pop.c movemail.c rmail.el configure.ac b2m.pl vc.el gnus-sum.el jka-compr.el rmailout.el rnewspost.el sendmail.el simple.el timezone.el vc-hooks.el +Jonathan Kyle Mitchell: changed em-dirs.el em-ls.el em-unix.el esh-cmd.el + esh-ext.el + Jonathan Leech-Pepin: wrote ox-texinfo.el Jonathan Marchand: changed cpp-root.el @@ -2438,6 +2446,8 @@ Joost Diepenmaat: changed org.el Joost Kremers: changed reftex-toc.el +Jordan Wilson: changed doc-view.el + Jorge A. Alfaro-Murillo: changed message.el Jorgen Schäfer: wrote erc-autoaway.el erc-goodies.el erc-spelling.el @@ -2531,9 +2541,9 @@ and changed tramp-gvfs.el tramp-sh.el comint.el em-unix.el esh-util.el Juri Linkov: wrote files-x.el misearch.el replace-tests.el and changed isearch.el info.el replace.el simple.el progmodes/grep.el - dired-aux.el dired.el progmodes/compile.el startup.el faces.el files.el + dired.el dired-aux.el progmodes/compile.el startup.el faces.el files.el menu-bar.el bindings.el display.texi descr-text.el desktop.el comint.el - image-mode.el ispell.el man.el cus-edit.el and 357 other files + image-mode.el ispell.el man.el cus-edit.el and 359 other files Jussi Lahdenniemi: changed w32fns.c ms-w32.h msdos.texi w32.c w32.h w32console.c w32heap.c w32inevt.c w32term.h @@ -2590,9 +2600,10 @@ Karl Eichwalder: changed Makefile.in add-log.el bookmark.el dired-aux.el Karl Fogel: wrote bookmark.el mail-hist.el saveplace.el and co-wrote pcvs.el and changed simple.el files.el doc-view.el image-mode.el info.el - vc-svn.el CONTRIBUTE INSTALL autogen.sh isearch.el menu-bar.el - simple-test.el subr.el tex-mode.el thingatpt.el INSTALL.REPO comint.el - configure configure.ac editfns.c electric-tests.el and 17 other files + vc-svn.el CONTRIBUTE INSTALL autogen.sh internals.texi isearch.el + menu-bar.el simple-test.el subr.el tex-mode.el thingatpt.el + INSTALL.REPO comint.el configure configure.ac editfns.c + and 18 other files Karl Heuer: changed keyboard.c lisp.h xdisp.c buffer.c xfns.c xterm.c alloc.c files.el frame.c configure.ac window.c data.c minibuf.c @@ -2622,7 +2633,7 @@ Károly LĹ‘rentey: changed xfns.c bindings.el keyboard.c menu-bar.el Katsuhiro Hermit Endo: changed gnus-group.el gnus-spec.el Katsumi Yamaoka: wrote canlock.el -and changed gnus-art.el gnus-sum.el message.el mm-decode.el gnus.texi +and changed gnus-art.el message.el gnus-sum.el mm-decode.el gnus.texi mm-util.el mm-view.el gnus-util.el gnus-group.el gnus-msg.el shr.el mml.el rfc2047.el gnus-start.el gnus.el nntp.el gnus-agent.el nnrss.el mm-uu.el nnmail.el emacs-mime.texi and 160 other files @@ -2858,7 +2869,7 @@ and co-wrote gnus-kill.el gnus-mh.el gnus-msg.el gnus-score.el rfc2047.el time-date.el and changed gnus.texi process.c gnus-ems.el subr.el gnutls.c gnus-cite.el pop3.el smtpmail.el display.texi files.el url-http.el gnus-xmas.el - simple.el auth-source.el image.c proto-stream.el gnutls.el dired.el + simple.el auth-source.el image.c gnutls.el proto-stream.el dired.el image.el text.texi nnrss.el and 318 other files Lars Rasmusson: changed ebrowse.c @@ -2901,8 +2912,8 @@ Leo Liu: wrote calc-tests.el pcmpl-x.el and changed octave.el ido.el rcirc.el files.el subr.el lisp-mode.el eldoc.el simple.el flymake.el smie.el abbrev.el progmodes/python.el cfengine.el cl-extra.el cl-macs.el emacs-lisp/cl-lib.el fns.c - progmodes/compile.el register.el rng-valid.el window.el - and 164 other files + progmodes/compile.el register.el rng-valid.el thingatpt.el + and 165 other files Leonard H. Tower Jr.: changed rnews.el rnewspost.el emacsbug.el rmailout.el sendmail.el @@ -3040,9 +3051,9 @@ and changed erc.el erc-dcc.el erc-speak.el Makefile erc-bbdb.el Mark A. Hershberger: changed xml.el nnrss.el mm-url.el cperl-mode.el isearch.el vc-bzr.el NXML-NEWS cc-mode.texi compilation.txt ede.texi - eieio.texi esh-mode.el flymake.el gnus-group.el misc/Makefile.in - nxml-mode.texi progmodes/compile.el progmodes/python.el programs.texi - schema and 6 other files + eieio.texi esh-mode.el flymake.el gnus-group.el menu-bar.el + misc/Makefile.in nxml-mode.texi progmodes/compile.el + progmodes/python.el programs.texi and 8 other files Mark Davies: changed amdx86-64.h configure configure.ac hp800.h lib-src/Makefile.in netbsd.h ralloc.c sh3el.h sort.el @@ -3217,7 +3228,7 @@ Matthew Mundell: changed calendar.texi diary-lib.el files.texi objects.texi os.texi positions.texi searching.texi subr.el text.texi and 3 other files -Matthias Dahl: changed faces.el +Matthias Dahl: changed faces.el process.c process.h Matthias Förste: changed files.el @@ -3249,6 +3260,8 @@ Matt Simmons: changed message.el Matt Swift: changed dired.el editfns.c lisp-mode.el mm-decode.el outline.el progmodes/compile.el rx.el simple.el startup.el +Mauro Aranda: changed files.texi os.texi + Maxime Edouard Robert Froumentin: changed gnus-art.el mml.el Max Mikhanosha: changed org-agenda.el org-habit.el org.el @@ -3259,15 +3272,15 @@ Micah Anderson: changed spook.lines Michael Albinus: wrote autorevert-tests.el dbus-tests.el dbus.el filenotify-tests.el filenotify.el files-x-tests.el secrets.el - tramp-cmds.el tramp-compat.el tramp-ftp.el tramp-gvfs.el tramp-smb.el - tramp-tests.el url-tramp-tests.el url-tramp.el vc-tests.el xesam.el - zeroconf.el + shadowfile-tests.el tramp-cmds.el tramp-compat.el tramp-ftp.el + tramp-gvfs.el tramp-smb.el tramp-tests.el url-tramp-tests.el + url-tramp.el vc-tests.el xesam.el zeroconf.el and co-wrote tramp-cache.el tramp-sh.el tramp.el and changed tramp.texi tramp-adb.el trampver.el trampver.texi dbusbind.c file-notify-tests.el ange-ftp.el files.el dbus.texi files.texi autorevert.el tramp-fish.el kqueue.c tramp-gw.el tramp-imap.el os.texi configure.ac lisp.h gfilenotify.c inotify.c keyboard.c - and 217 other files + and 221 other files Michael Ben-Gershon: changed acorn.h configure.ac riscix1-1.h riscix1-2.h unexec.c @@ -3300,8 +3313,8 @@ Michael Gschwind: wrote iso-cvt.el Michael Harnois: changed nnimap.el -Michael Heerdegen: changed subr-x.el control.texi dired.el easy-mmode.el - eldoc.el pcase.el shr.el subr-x-tests.el wdired.el +Michael Heerdegen: changed subr-x.el control.texi dired-aux.el dired.el + easy-mmode.el eldoc.el pcase.el shr.el subr-x-tests.el wdired.el Michael Hoffman: changed term.el xterm.el @@ -3387,6 +3400,8 @@ and changed gnus-score.el Michihito Shigemura: changed sh-script.el +Miciah Masters: changed rcirc.el rcirc.texi + Microelectronics and Computer Technology Corporation: changed emacsclient.c etags.c lisp.h movemail.c rmail.el rmailedit.el rmailkwd.el rmailmsc.el rmailout.el rmailsum.el scribe.el server.el @@ -3410,8 +3425,8 @@ Mike Haertel: changed 7300.h Mike Kazantsev: changed erc-dcc.el -Mike Kupfer: changed mh-e.el emacs-mime.texi gnus-mh.el gnus.texi - mh-acros.el mh-comp.el mh-compat.el mh-e.texi mh-mime.el mh-utils.el +Mike Kupfer: changed mh-comp.el mh-e.el emacs-mime.texi gnus-mh.el + gnus.texi mh-acros.el mh-compat.el mh-e.texi mh-mime.el mh-utils.el Mike Lamb: changed em-unix.el esh-util.el pcmpl-unix.el @@ -3571,9 +3586,9 @@ Nicolas Petton: wrote map-tests.el map.el seq-tests.el seq.el and co-wrote auth-source-pass.el auth-source-tests.el subr-tests.el and changed sequences.texi README configure.ac sed2v2.inp authors.el emacs.png README.W32 emacs23.png arc-mode.el cl-extra.el emacs.svg - manoj-dark-theme.el Emacs.icns Makefile.in auth-source.el emacs.ico - fns.c make-tarball.txt obarray-tests.el obarray.el HISTORY - and 34 other files + manoj-dark-theme.el Emacs.icns HISTORY Makefile.in auth-source.el + emacs.ico fns.c make-tarball.txt obarray-tests.el obarray.el + and 35 other files Nicolas Richard: wrote cl-seq-tests.el cmds-tests.el replace-tests.el and changed ffap.el package.el byte-run.el help.el keyboard.c landmark.el @@ -3616,11 +3631,11 @@ and changed rsz-mini.el emacs-buffer.gdb comint.el files.el Makefile Noah Lavine: changed tramp.el -Noam Postavsky: changed progmodes/python.el lisp-mode.el xdisp.c - cl-macs.el emacs-lisp/debug.el data.c ert.el lisp-mode-tests.el - simple.el help-fns.el subr.el term.el bytecomp.el elisp-mode.el eval.c - ffap.el modes.texi search.c sh-script.el cl-preloaded.el cl-print.el - and 223 other files +Noam Postavsky: changed lisp-mode.el progmodes/python.el xdisp.c + cl-macs.el lisp-mode-tests.el emacs-lisp/debug.el data.c simple.el + term.el ert.el subr.el help-fns.el bytecomp.el cl-print.el + elisp-mode.el eval.c ffap.el modes.texi search.c sh-script.el + cl-preloaded.el and 248 other files Nobuyoshi Nakada: co-wrote ruby-mode.el @@ -3721,10 +3736,10 @@ and changed imenu.el make-mode.el Paul Eggert: wrote rcs2log and co-wrote cal-dst.el -and changed lisp.h configure.ac alloc.c process.c fileio.c xdisp.c - editfns.c sysdep.c image.c keyboard.c emacs.c xterm.c data.c lread.c +and changed lisp.h configure.ac alloc.c process.c fileio.c editfns.c + xdisp.c sysdep.c image.c keyboard.c emacs.c xterm.c data.c lread.c fns.c callproc.c Makefile.in gnulib.mk eval.c buffer.c frame.c - and 1596 other files + and 1598 other files Paul Fisher: changed fns.c @@ -3898,11 +3913,11 @@ Philipp Rumpf: changed electric.el Philipp Stephani: wrote checkdoc-tests.el ediff-diff-tests.el eval-tests.el ido-tests.el lread-tests.el mouse-tests.el xt-mouse-tests.el -and changed emacs-module.c eval.c bytecomp.el emacs-module-tests.el - files.el lread.c nsterm.m configure.ac editfns.c mod-test.c alloc.c - electric.el gtkutil.c lisp.h electric-tests.el emacs.c macfont.m - test/Makefile.in xt-mouse.el Makefile bytecomp-tests.el - and 95 other files +and changed emacs-module.c eval.c bytecomp.el nsterm.m + emacs-module-tests.el files.el lread.c configure.ac editfns.c + mod-test.c alloc.c electric.el gtkutil.c lisp.h electric-tests.el + emacs.c macfont.m test/Makefile.in xt-mouse.el Makefile + bytecomp-tests.el and 96 other files Phillip Lord: wrote ps-print-tests.el and changed lisp/Makefile.in undo.c simple.el test/Makefile.in Makefile @@ -3911,8 +3926,8 @@ and changed lisp/Makefile.in undo.c simple.el test/Makefile.in Makefile dired.el eieio-tests.el fileio.c htmlfontify.el make-test-deps.emacs-lisp reftex-tests.el and 168 other files -Phil Sainty: changed derived.el easy-mmode.el lisp.el package.el - progmodes/grep.el simple.el subword.el term.el +Phil Sainty: changed term.el derived.el easy-mmode.el lisp.el package.el + progmodes/grep.el simple.el subword.el Phil Sung: changed wdired.el dired.texi follow.el progmodes/python.el @@ -3920,7 +3935,7 @@ Pierre Lorenzon: changed eieio-custom.el Pierre Poissinger: changed charset.c -Pierre TĂ©choueyres: changed eieio-test-persist.el tramp-cmds.el +Pierre TĂ©choueyres: changed eieio-test-persist.el epg.el tramp-cmds.el Pieter E.J. Pareit: wrote mixal-mode.el @@ -3959,6 +3974,8 @@ Rafael SepĂşlveda: changed TUTORIAL.es Raffael Mancini: changed misc.el +Raimon Grau: changed thingatpt.el + Rainer Orth: changed gtkutil.c lisp/Makefile.in Rainer Schöpf: changed osf1.h unexalpha.c alloc.c alpha.h buffer.c @@ -4125,10 +4142,10 @@ Roberto RodrĂ­guez: changed ada-mode.texi glossary.texi widget.texi Robert P. Goldman: changed org.texi ob-exp.el org.el ox-latex.el -Robert Pluim: changed gtkutil.c misc.texi vc-git.el xfns.c xterm.c - bindings.el configure.ac desktop.el dired-x.texi epa.texi gnus-agent.el - gnus-demon.el gnus.texi ido.el image-mode.el minibuf.c minibuf.texi - org-agenda.el process.c progmodes/grep.el project.el and 8 other files +Robert Pluim: changed configure.ac files.texi gtkutil.c dired-x.texi + misc.texi vc-git.el xfns.c xterm.c bindings.el desktop.el efaq.texi + epa.texi filelock.c font.c ftfont.c gnus-agent.el gnus-demon.el + gnus.texi ido.el image-mode.el mail-source.el and 15 other files Robert Thorpe: changed cus-start.el indent.el @@ -4245,7 +4262,7 @@ Sam Kendall: changed etags.c etags.el Sam Steingold: wrote gulp.el midnight.el and changed progmodes/compile.el cl-indent.el simple.el vc-cvs.el vc.el - mouse.el files.el font-lock.el tex-mode.el vc-hg.el ange-ftp.el + mouse.el vc-hg.el files.el font-lock.el tex-mode.el ange-ftp.el sgml-mode.el window.el add-log.el bindings.el bookmark.el bug-reference.el calendar.el cperl-mode.el diary-lib.el dired.el and 152 other files @@ -4293,6 +4310,8 @@ Scott Bender: co-wrote ns-win.el Scott Byer: co-wrote nnfolder.el and changed gnus-sum.el +Scott Corley: changed scroll.c + Scott Draves: wrote tq.el Scott Evans: changed rect.el @@ -4354,6 +4373,8 @@ and changed ob-maxima.el ob-octave.el Sergey Poznyakoff: changed rmail.el mh-mime.el rmail.texi smtpmail.el +Sergey Vinokurov: changed emacs-module-tests.el emacs-module.c mod-test.c + Sergio Durigan Junior: changed eudcb-bbdb.el gdb-mi.el Sergio Martinez: changed nnimap.el @@ -4381,8 +4402,8 @@ and changed gnus-art.el message.el gnus-sum.el gnus-msg.el gnus.el and 93 other files Shigeru Fukaya: wrote bytecomp-tests.el -and changed apropos.el byte-opt.el bytecomp.el elint.el rx-new.el ses.el - subr.el texinfmt.el +and changed apropos.el bs.el byte-opt.el bytecomp.el elint.el rx-new.el + ses.el subr.el texinfmt.el Shinichirou Sugou: changed etags.c @@ -4407,7 +4428,8 @@ Simen Heggestøyl: wrote color-tests.el css-mode-tests.el dom-tests.el ring-tests.el rot13-tests.el sql-tests.el and changed css-mode.el json-tests.el json.el sgml-mode.el css-mode.css scss-mode.scss ring.el rot13.el scheme.el sql.el color.el files.el - js.el less-css-mode.el less-css-mode.less maintaining.texi + js.el less-css-mode.el less-css-mode.less maintaining.texi midnight.el + seq.el sequences.texi Simon Josefsson: wrote dig.el dns-mode.el flow-fill.el fringe.el imap.el mml-sec.el mml-smime.el password-cache.el rfc2104.el sieve-mode.el @@ -4471,8 +4493,8 @@ Stefan Monnier: wrote bibtex-style.el bytecomp-tests.el bzrmerge.el and co-wrote font-lock.el gitmerge.el pcvs.el and changed subr.el simple.el keyboard.c lisp.h bytecomp.el files.el vc.el cl-macs.el xdisp.c alloc.c eval.c sh-script.el - progmodes/compile.el keymap.c tex-mode.el newcomment.el window.c - buffer.c lisp-mode.el lread.c vc-hooks.el and 1280 other files + progmodes/compile.el keymap.c tex-mode.el newcomment.el buffer.c + window.c lisp-mode.el lread.c vc-hooks.el and 1282 other files Stefano Facchini: changed gtkutil.c @@ -4503,10 +4525,10 @@ Stephen A. Wood: changed fortran.el Stephen Berman: wrote todo-mode-tests.el and co-wrote todo-mode.el and changed todo-mode.texi diary-lib.el dired-tests.el doc-view.el - files.el minibuffer.el dired.el frames.texi hl-line.el info.el - menu-bar.el mouse.el otodo-mode.el subr.el .gitattributes allout.el - artist.el compile.texi cus-start.el descr-text.el dframe.el - and 39 other files + files.el minibuffer.el wdired-tests.el dired.el frames.texi hl-line.el + info.el menu-bar.el mouse.el otodo-mode.el subr.el .gitattributes + allout.el artist.el compile.texi cus-start.el descr-text.el + and 41 other files Stephen C. Gilardi: changed configure.ac @@ -4702,7 +4724,7 @@ and co-wrote hideshow.el and changed ewoc.el vc.el info.el processes.texi zone.el lisp-mode.el scheme.el text.texi vc-rcs.el display.texi fileio.c files.el vc-git.el MORE.STUFF TUTORIAL.it bindat.el cc-vars.el configure.ac dcl-mode.el - diff-mode.el dired.el and 163 other files + diff-mode.el dired.el and 169 other files Thierry Banel: co-wrote ob-C.el and changed calc-arith.el @@ -4801,9 +4823,9 @@ Tino Calancha: wrote buff-menu-tests.el ediff-ptch-tests.el em-ls-tests.el ffap-tests.el hi-lock-tests.el ls-lisp-tests.el register-tests.el rmc-tests.el and changed ibuffer.el dired-tests.el ibuf-ext.el dired.el dired-aux.el - simple.el ibuffer-tests.el ls-lisp.el diff-mode.el ibuf-macs.el - cl-seq.el dired-x.el dired.texi ediff-ptch.el em-ls.el files.el - replace.el buff-menu.el cl.texi ediff-init.el files-tests.el + simple.el replace.el ibuffer-tests.el ls-lisp.el diff-mode.el + ibuf-macs.el cl-seq.el dired-x.el dired.texi ediff-ptch.el em-ls.el + files.el replace-tests.el buff-menu.el cl.texi ediff-init.el and 82 other files Titus von der Malsburg: changed simple.el window.el @@ -5032,6 +5054,8 @@ Warren Lynn: changed tramp-sh.el Wei-Wei Guo: co-wrote rst.el +Wenjamin Petrenko: changed files-x.el + Werner Benger: changed keyboard.c Werner Lemberg: wrote sisheng.el vntelex.el @@ -5179,7 +5203,7 @@ Yu-ji Hosokawa: changed README.W32 Yukihiro Matsumoto: co-wrote ruby-mode.el -Yuri D'elia: changed message.el +Yuri D'elia: changed message.el package.el Yuri Karaban: changed pop3.el commit 9723c214a58bd6257231ce4d52c884f38f941855 Author: Nicolas Petton Date: Mon Nov 12 16:42:49 2018 +0100 ; ChangeLog.3 update diff --git a/ChangeLog.3 b/ChangeLog.3 index a0a4794b4e..6e1f68fe99 100644 --- a/ChangeLog.3 +++ b/ChangeLog.3 @@ -1,3 +1,2193 @@ +2018-11-12 Paul Eggert + + Work around dumping bug on GNU/Linux ppc64le + + Problem reported by Thomas Fitzsimmons (Bug#33174). + Do not merge to master, as we have a better fix there. + * src/Makefile.in (emacs$(EXEEXT)): + (bootstrap-emacs$(EXEEXT)): + Unset EMACS_HEAP_EXEC before invoking temacs. + +2018-11-11 Eli Zaretskii + + * lisp/files.el (write-file): Clarify the doc string. (Bug#33339) + +2018-11-11 Simen Heggestøyl + + Fix typos in midnight.el + + * lisp/midnight.el (clean-buffer-list-delay-general) + (clean-buffer-list-kill-regexps) + (clean-buffer-list-kill-buffer-names): Fix docstring typos. + +2018-11-10 Eli Zaretskii + + Improve documentation of 'move-file-to-trash' + + * doc/emacs/files.texi (Misc File Ops): Index + move-file-to-trash. State that the way to restore trashed + files is system-dependent. + +2018-11-09 Stefan Monnier + + * src/data.c (Ftype_of): xwidget objects are possible! (bug#33294) + + (syms_of_data): Define Qwidget here. + * src/xwidget.c (syms_of_xwidget): Instead of here. + +2018-11-09 Eli Zaretskii + + Improve documentation of Diff mode + + * doc/emacs/files.texi (Diff Mode): Document the effect of + prefix argument on the Diff mode's commands. Document + 'diff-jump-to-old-file'. + +2018-11-09 Noam Postavsky + + Note that lex bound lambda forms are not self-quoting (Bug#33199) + + * doc/lispref/functions.texi (Anonymous Functions): + * lisp/subr.el (lambda): Note that under lexical binding a lambda form + yields a closure object (Bug#33199). + +2018-11-08 Martin Rudalics + + Rewrite buffer display related doc-strings and doc + + * lisp/window.el (display-buffer-overriding-action) + (display-buffer-alist, display-buffer-base-action) + (display-buffer-fallback-action, display-buffer-assq-regexp) + (display-buffer): Rewrite doc-strings using suggestions by + Alan Mackenzie . + (display-buffer-use-some-frame): Adjust doc-string and + reformat code. + * doc/lispref/windows.texi (Buffer Display Action Alists): + Make docs on 'window-height', 'window-width' and + 'preserve-size' entries more accurate. + +2018-11-06 Eli Zaretskii + + Fix call to GlobalMemoryStatusEx in w32.c + + * src/w32.c (system_process_attributes): Initialize the size + of the data structure passed to GlobalMemoryStatusEx, + otherwise it fails. + +2018-11-04 Eli Zaretskii + + Improve recent changes in documentation of window handling + + * doc/lispref/windows.texi (Displaying Buffers) + (Choosing Window, Buffer Display Action Functions) + (Buffer Display Action Alists, Choosing Window Options) + (Precedence of Action Functions, The Zen of Buffer Display): + Fix wording, punctuation, and markup. Remove redundant + cross-references. + + * doc/emacs/windows.texi (Window Choice, Temporary Displays): + Fix wording and punctuation. + +2018-11-04 Martin Rudalics + + Rewrite documentation of buffer display + + * doc/emacs/windows.texi (Window Choice): Rewrite, replacing + references to older buffer display options with references to + and examples of buffer display actions. + (Temporary Displays): Rewrite display of *Completions* + example. + + * doc/lispref/elisp.texi (Top): New Windows section + 'Displaying Buffers'. + * doc/lispref/frames.texi (Child Frames): Adjust cross + reference. + * doc/lispref/windows.texi (Windows): New section 'Displaying + Buffers'. Move sections 'Choosing Window', 'Display Action + Functions' and 'Choosing Window Options' there and adjust + namings. Preferably write 'Buffer Display Action' instead of + 'Display Action'. More consistently use @w{} to make key + binding specifications unsplittable. + (Displaying Buffers): New section. + (Choosing Window): Make it a subsection of 'Displaying + Buffers'. More explicitly describe how 'display-buffer' + compiles its list of action functions and the action alist. + (Buffer Display Action Functions): Rename from 'Display Action + Functions', make it a subsection of 'Displaying Buffers' and + rewrite it. Elide more detailed descriptions of action alist + entries; these are now in the new section 'Buffer Display + Action Functions'. Remove example. + (Buffer Display Action Alists): New subsection of 'Displaying + Buffers' giving a comprehensive description of recognized + action alist entries with appropriate indexing. Contents were + partially moved here from the old 'Display Action Functions' + section. + (Choosing Window Options): Make it a subsection of 'Displaying + Buffers'. Add examples of how to rewrite old buffer display + options with the help of buffer display actions. + (Precedence of Action Functions): New subsection of + 'Displaying Buffers' explaining the execution order of action + functions with the help of a detailed example. + (The Zen of Buffer Display): New subsection of 'Displaying + Buffers' supplying guidelines on how to write and use buffer + display actions with examples. + (Side Windows, Displaying Buffers in Side Windows) + (Frame Layouts with Side Windows, Atomic Windows): Update + references to the 'Displaying Buffers' subsections. + +2018-11-03 Eli Zaretskii + + Improve documentation of destructuring-binding macros + + * lisp/emacs-lisp/pcase.el (pcase-dolist, pcase-let) + (pcase-let*): Improve the doc strings. + + * doc/lispref/sequences.texi (Sequence Functions): Improve + wording and rename arguments of seq-let to be more + descriptive. Add a cross-reference to "Destructuring with + pcase Patterns". + * doc/lispref/control.texi (Pattern-Matching Conditional): + Improve wording and the menu. + (pcase Macro): Incorporate patch suggested by Paul Eggert + . Reformat text. + (Destructuring with pcase Patterns): Rename from + "Destructuring patterns", and improve wording and indexing. + +2018-11-03 Eli Zaretskii + + Avoid byte compilation warning in rcirc.el + + * lisp/net/rcirc.el (rcirc-prompt-start-marker): Move + definition before 1st use to avoild byte-compiler warning. + +2018-11-03 Basil L. Contovounesios + + Avoid race in rcirc process filter (bug#33145) + + * lisp/net/rcirc.el (rcirc-filter): Clear rcirc-process-output + before processing its constituent lines. Otherwise, if rcirc-filter + runs again before the last rcirc-process-server-response is + finished, the contents of rcirc-process-output could be duplicated. + +2018-11-03 Jordan Wilson (tiny change) + + Avoid file-name errors when viewing PDF from Gnus + + * lisp/doc-view.el (doc-view-mode): Run the output file name + through 'convert-standard-filename', to avoid problems with + characters that are not allowed in file names on some + systems. (Bug#32989) + +2018-11-02 Eli Zaretskii + + Avoid crashes with remapped default face in Org mode + + * src/xfaces.c (face_at_buffer_position): Look up BASE_FACE_ID + anew if it is not in the frame's face cache. This avoids + crashes when Org mode sets up for a new major mode in embedded + code fragment, and the default face is remapped. (Bug#33222) + +2018-11-01 Eric Abrahamsen + + Doc fix for checkdoc-continue + + * lisp/emacs-lisp/checkdoc.el (checkdoc-continue): There is no second + optional argument, and the function always starts from point. + +2018-11-01 Eli Zaretskii + + Fix a typo in autoload.el + + * lisp/emacs-lisp/autoload.el (update-directory-autoloads): + Remove stray backslashes. (Bug#33231) + +2018-10-31 Stefan Monnier + + * doc/lispref/control.texi (Destructuring patterns): New subsection. + +2018-10-31 Gemini Lasswell + + Add regression test for Bug#33014 + + Backport from master. + * test/src/eval-tests.el: + (eval-tests-byte-code-being-evaluated-is-protected-from-gc): New test. + (eval-tests-33014-var): New variable. + (eval-tests-33014-func, eval-tests-33014-redefine): New functions. + +2018-10-31 Paul Eggert + + Refer to bytecode constant vectors (Bug#33014) + + Backport from master. + * src/bytecode.c (exec_byte_code): Save VECTOR into stack slot + so that it survives GC. The stack slot was otherwise unused, + so this doesn’t cost us memory, only a store insn. + +2018-10-30 Stefan Monnier + + * lisp/emacs-lisp/pcase.el: Improve docstrings. + +2018-10-30 Eli Zaretskii + + * lisp/emacs-lisp/rx.el (rx): Fix typo in doc string. (Bug#33205) + +2018-10-30 Eli Zaretskii + + Improve doc string of 'call-process' + + * src/callproc.c (Fcall_process): Clarify DESTINATION in the + doc string. + +2018-10-30 Eli Zaretskii + + Document that generic functions cannot be commands + + * doc/lispref/commands.texi (Defining Commands): + * doc/lispref/functions.texi (Generic Functions): Document + that generic functions cannot be turned into commands. + (Bug#33170) + +2018-10-28 Charles A. Roelli + + * lisp/mail/rmailsum.el (rmail-summary-output): Add lost word to doc. + +2018-10-28 Charles A. Roelli + + Add index entries for more isearch commands/bindings (Bug#32990) + + * doc/emacs/search.texi (Basic Isearch): Index isearch-exit, + isearch-abort, isearch-cancel, isearch-repeat-forward, + isearch-repeat-backward and their bindings. + (Repeat Isearch): Index isearch-ring-advance, + isearch-ring-retreat and isearch-edit-string. + (Special Isearch): Index isearch-quote-char, + isearch-char-by-name and their bindings. Index + isearch-query-replace and isearch-query-replace-regexp, and + the latter's binding. Explain what + isearch-query-replace-regexp does. Index isearch-complete. + (Word Search): Index isearch-toggle-word. + +2018-10-27 Noam Postavsky + + * lisp/simple.el (filter-buffer-substring): Clarify doc (Bug#33179). + +2018-10-27 Eli Zaretskii + + Fix recent change in lispref/processes.texi. + + * doc/lispref/processes.texi (Asynchronous Processes): Clarify + wording. Suggested by Thomas Fitzsimmons . + (Bug#33050) + +2018-10-27 Eli Zaretskii + + * lisp/simple.el (region-extract-function): Doc fix. (Bug#33167) + + * lisp/simple.el (region-bounds): Doc fix. (Bug#33168) + +2018-10-27 Eli Zaretskii + + Improve documentation of 'process-connection-type' + + * doc/lispref/processes.texi (Asynchronous Processes): Clarify + better when it is advisable to use pipes for communicating + with subprocesses. (Bug#33050) + +2018-10-27 Pierre TĂ©choueyres + + Unify prompt for gnupg passphrase between GNU/Linux and MS-Windows. + + * lisp/epg.el (epg--start): Use 'raw-text' for coding system instead + of 'binary', in order to avoid spurious carriage return on Microsoft + Windows and MS-DOS when prompting for a password. (Bug#33040) + +2018-10-27 Eli Zaretskii + + Doc fix of 'gnus-fetch-old-headers' + + * lisp/gnus/gnus-sum.el (gnus-fetch-old-headers): Avoid + treating 'some' and 'invisible' as symbols that need to be + hyperlinked. Reported by Robert Pluim . + (Bug#33090) + +2018-10-27 Eric Abrahamsen + + Deactivate incorrect hyperlinking in gnus-build-sparse-threads doc + + * lisp/gnus/gnus-sum.el (gnus-build-sparse-threads): Add the word + "symbol" so it doesn't link to the `some' function. (Bug#33090) + +2018-10-27 Eli Zaretskii + + Minor copyedits in cmdargs.texi + + * doc/emacs/cmdargs.texi (Initial Options): Document '-nsl'. + Add a cross-reference to "Writing Dynamic Modules". + +2018-10-27 Eli Zaretskii + + Improve documentation of X resource loading + + * doc/emacs/cmdargs.texi (Initial Options): + * doc/emacs/frames.texi (Frame Parameters): + * doc/emacs/xresources.texi (Resources): Document the + '--no-x-resources' command-line option and the fact that X + resources override .emacs settings of frame parameters. + (Bug#32975) + +2018-10-27 Michael Albinus + + * lisp/net/tramp-sh.el (tramp-inline-compress-commands): + + Suppress warnings about obsolete environment variable GZIP. + +2018-10-25 Noam Postavsky + + Don't error when indenting malformed Lisp (Bug#30891) + + * lisp/emacs-lisp/lisp-mode.el (lisp-indent-calc-next): If we run out + of indent stack, reset the parse state. + +2018-10-25 Charles A. Roelli + + Improve 'isearch-delete-char' documentation (Bug#32990) + + * doc/emacs/search.texi (Basic Isearch): Index + 'isearch-delete-char', its keybinding and the isearch "input + item" concept, and define the latter. + (Error in Isearch): Clarify the different uses of DEL and + C-M-w during isearch. + + * lisp/isearch.el (isearch-delete-char): Correct its + documentation and link to the Info node '(emacs)Basic Isearch' + which explains less technically how this function works in + everyday usage. + +2018-10-25 Alan Third + + Improve XPM load failure message (bug#33126) + + * src/image.c (xpm_load_image): Only XPM3 is supported, so make that + explicit. + +2018-10-25 Eli Zaretskii + + Avoid infloop in CPerl mode fontification + + * lisp/progmodes/cperl-mode.el + (cperl-font-lock-fontify-region-function): Stop the loop at + EOB, to avoid inflooping there. (Bug#33114) + +2018-10-25 Andreas Schwab + + Fix minibuffer-help-form for lexical binding + + * lisp/simple.el (set-variable): Substitute var into + minibuffer-help-form. + * lisp/cus-edit.el (custom-prompt-variable): Likewise. + +2018-10-24 Alan Third + + Fix some NS drawing issues (bug#32932) + + * src/nsterm.m (ns_clip_to_rect): + (ns_reset_clipping): Remove gsaved variable and associated code. + (ns_flush_display): Remove function. + (ns_copy_bits): use translateRectsNeedingDisplayInRect:by: to copy any + pending drawing actions along with the image. + ([EmacsView windowWillResize:toSize:]): Remove unneeded call. + ([EmacsView drawRect:]): Remove redundant call to ns_clear_frame_area, + and optimize the exposed rectangles. + (ns_draw_window_cursor): Remove unneeded disabling of screen updates. + +2018-10-24 Katsumi Yamaoka + + * lisp/gnus/mm-util.el (mm-decompress-buffer): Fix split-string args. + +2018-10-24 Noam Postavsky + + * doc/misc/calc.texi (Summary): The +/- key is 'p', not 'P'. + +2018-10-23 Robert Pluim + + Correct typo in GNU ELPA url + + * doc/misc/efaq.texi (Packages that do not come with Emacs): + Correct typo in GNU ELPA url (Bug#33072). Change other url + references to use https scheme. + +2018-10-22 Eli Zaretskii + + * doc/misc/dired-x.texi (Omitting Variables): Fix wording. (Bug#33112) + +2018-10-20 Michael Heerdegen + + Fix help-form binding in dired-create-files + + This fixes Bug#32630: since "dired-aux" moved to lexical binding mode, + the free variable TO in the constructed HELP-FORM got out of scope of + the surrounding 'let'. + + * lisp/dired-aux.el (dired-create-files): Make the binding of + HELP-FORM a string. + +2018-10-20 Eli Zaretskii + + Fix a pasto in a Gnus doc string + + * lisp/gnus/gnus-art.el (gnus-article-treat-fold-newsgroups): + Doc string fix. (Bug#33081) + +2018-10-19 Mauro Aranda (tiny change) + + Update revert-buffer documentation + + * doc/emacs/files.texi (Reverting): Document that revert-buffer + does keep undo history. (Bug#33084) + +2018-10-18 Juri Linkov + + * lisp/mail/smtpmail.el (smtpmail-send-queued-mail): Load file with .el suffix. + + For the case when load-prefer-newer is t, ensure loading the right file + by explicitly adding the .el suffix. Use the same variable names + as in the function smtpmail-send-it. (Bug#33055) + +2018-10-16 Glenn Morris + + Tweak Makefile emacs-module.h handling + + * Makefile.in (install-arch-indep, uninstall): Respect DESTDIR. + Handle whitespace. Remove non-portable mkdir argument. + + (cherry picked from commit c1d0dbd6ca92cb221024382b19654e4fbf1d1ed3) + +2018-10-16 Philipp Stephani + + Install emacs-module.h (Bug#31929) + + * Makefile.in (includedir): New variable. + (install-arch-indep): Install emacs-module.h. + (uninstall): Uninstall emacs-module.h. + + (cherry picked from commit 00ea749f2af44bff6ea8c1259477fbf0ead8a306) + +2018-10-15 Alan Mackenzie + + Clarify documentation of fractional vertical scrolling and some doc strings + + * doc/lispref/windows.texi (vertical scrolling): Clarify the meaning of + vertical scrolling by referring to tall screen lines, images, and the display + action. Clarify an ambiguous English tense. + + * src/window.c (window-vscroll, set-window-vscroll): Amend doc strings to + refer to display. + +2018-10-15 Charles A. Roelli + + * lisp/isearch.el (isearch-cmds): Recall absent isearch--state slot. + +2018-10-14 Alan Mackenzie + + doc/lispref/edebug.texi (Specification List) Remove obstrusive blank line + +2018-10-14 Eli Zaretskii + + Fix wording in module API documentation + + * doc/lispref/internals.texi (Module Functions): Fix confusing + wording. Reported by Basil L. Contovounesios . + +2018-10-13 Eli Zaretskii + + Fix redisplay of glyphless characters + + * src/conf_post.h (bool_bf): Use 'unsigned int' in the MinGW + builds. Suggested by Tom Tromey . (Bug#33017) + * src/dispnew.c (scrolling_window): Update commentary + regarding xwidget builds. + +2018-10-13 Robert Pluim + + Update --without-toolkit-scroll-bars doc + + * configure.ac (--without-toolkit-scroll-bars): Update list of + affected toolkits. + +2018-10-13 Robert Pluim + + Call GTK functions only on GTK scrollbars + + * src/gtkutil.c (xg_set_background_color) [USE_TOOLKIT_SCROLL_BARS]: + Don't call GTK functions on non-GTK scrollbars (Bug#32975). + +2018-10-13 Eli Zaretskii + + Update the description of startup in ELisp manual + + * doc/lispref/os.texi (Startup Summary): Remove stale + reference to window-system-initialization-alist. Reported by + Zhang Haijun . + +2018-10-13 Eli Zaretskii + + Use the 'line-number' face for line-number fields past EOB + + * src/xdisp.c (get_phys_cursor_geometry): Treat rows at and + beyond ZV specially. Don't let the cursor exceed the + vertical dimensions of the row. + (maybe_produce_line_number): Use the 'line-number' face + instead of 'default' for blank fields beyond ZV. Don't update + the IT metrics when displaying blank line-number fields beyond + ZV. (Bug#32337) + +2018-10-12 Alan Third + + Ensure NS frame is redrawn correctly after scroll + + * src/nsterm.m (ns_copy_bits): Set needsDisplay so the previous cursor + position is redrawn. + +2018-10-12 Alex Branham + + Avoid byte-compiler warning in em-rebind.el + + * lisp/eshell/em-rebind.el (eshell-delete-backward-char): Use + 'delete-char' instead of delete-backward-char. (Bug#32945) + +2018-10-12 Eli Zaretskii + + Improve indexing of 'C-SPC C-SPC' + + * doc/emacs/mark.texi (Disabled Transient Mark): Fix + indexing. (Bug#32959) + +2018-10-11 Eric Abrahamsen + + Fix bug with precious entries in Gnus registry + + * lisp/registry.el (registry-collect-prune-candidates): This `cdr' was + an error: it meant that the last key in the precious list, would be + considered a nil. Since the precious list only contains the symbol + 'mark by default, marks were never considered precious. + * doc/misc/gnus.texi (Store arbitrary data): Fix typo: "marks" should + be "mark". + +2018-10-11 Eli Zaretskii + + Document in the ELisp manual how to write loadable modules + + * doc/lispref/internals.texi (Writing Dynamic Modules) + (Module Initialization, Module Functions, Module Values) + (Module Misc, Module Nonlocal): New nodes. + * doc/lispref/loading.texi (Dynamic Modules): Add + cross-reference to the new node. + * doc/lispref/internals.texi (GNU Emacs Internals): + * doc/lispref/elisp.texi (Top): Update menus for the new nodes. + +2018-10-11 Tino Calancha + + dired-do-shell-command: Notify users after abort the command + + * lisp/dired-aux.el (dired-do-shell-command): Notify users that + the command have aborted when they answer 'n' to the prompt (Bug#32969). + +2018-10-11 Michael Albinus + + Adapt Tramp version. Do not merge with master + + * lisp/net/trampver.el: Change version to "2.3.5.26.2". + (customize-package-emacs-version-alist): Add Tramp version + integrated in Emacs 26.2. + +2018-10-10 Alan Third + + Fix Apple Script permissions error + + * nextstep/templates/Info.plist.in: Add NSAppleEventsUsageDescription + message to enable AppleEvents usage. + +2018-10-10 Mauro Aranda (tiny change) + + Fix typo in 'timerp' documentation + + * doc/lispref/os.texi (Timers): Fix typo in 'timerp' documentation. + (Bug#32999) + +2018-10-08 Charles A. Roelli + + * doc/emacs/mark.texi (Mark): Index "(de)activating the mark". + + (Bug#32956) + +2018-10-08 Scott Corley (tiny change) + + Fix overflow lockup with frames > 255 lines + + Backport from master. + * src/scroll.c (struct matrix_elt): Change unsigned char fields to + int to handle frames with more than 255 lines (Bug#32951). + +2018-10-07 Eli Zaretskii + + Avoid assertion violations in nonsensical calls to 'signal' + + * src/eval.c (Fsignal): If both arguments are nil, replace the + first one with 'error', to avoid assertion violations further + down the line. (Bug#32961) + +2018-10-06 Charles A. Roelli + + * lisp/simple.el (transient-mark-mode): Correct documentation. (Bug#32956) + +2018-10-06 Eli Zaretskii + + Update the locale and language database + + * lisp/international/mule-cmds.el (locale-language-names): + Update the list of supported locales. Use existing language + names where available. + +2018-10-05 Eli Zaretskii + + Fix a typo in a doc string. + + * lisp/window.el (display-buffer-alist): Fix a typo in a doc string. + Reported by Michael Heerdegen . + +2018-10-05 Katsumi Yamaoka + + Make nneething allow CRLF-encoded files (bug#32940) + + * lisp/gnus/nneething.el (nneething-request-article): + Bind coding system to raw-text instead of binary when reading a file, + that may be CRLF-encoded (bug#32940). + +2018-10-04 Eric Abrahamsen + + Further fix to eieio-persistent + + * lisp/emacs-lisp/eieio-base.el (eieio-persistent-validate/fix-slot-value): + Make handling of hash tables and vectors recursive. This is + necessary because the write process, in `eieio-override-prin1' is + also recursive. With any luck, this will be the last fix of its + kind. If that's true, cherry-pick to Emacs 26.2 later on. + +2018-10-04 Eli Zaretskii + + Avoid ridiculously high stack limit requests on macOS + + * src/emacs.c (main): Avoid wraparound in subtraction of + rlim_t values, in case rlim_t is an unsigned type. (Bug#32338) + +2018-10-03 Charles A. Roelli + + Improve documentation of 'read-hide-char' + + * src/minibuf.c (syms_of_minibuf) : Clarify + documentation and mention where else the variable is used. + * doc/lispref/minibuf.texi (Reading a Password): Add an index + entry for 'read-hide-char'. + +2018-10-03 Alan Mackenzie + + In follow mode, prevent the cursor resting on a partially displayed line + + Don't merge to master. This fixes bug #32848 + + * lisp/follow.el (follow-adjust-window): If point ends up in a partially + displayed line in a left hand or middle window, move it one line + forward, to + prevent unwanted scrolling should make-cursor-line-fully-visible be + non-nil. + +2018-10-03 Alan Mackenzie + + Revert "Temporary workaround for bug #32848 for branch emacs-26" + + This reverts commit 6650751ce73413d05599df07a9c5bc70744260f3. + +2018-10-03 Alan Mackenzie + + Revert "* etc/NEWS: Note setting make-cursor-line-fully-visible to nil in follow-mode" + + This reverts commit f3c8f4bde2de2b9d42c44f5e44f34c427bebdc58. + +2018-10-03 Alan Mackenzie + + * etc/NEWS: Note setting make-cursor-line-fully-visible to nil in follow-mode + + Also re-insert the "temporary note" explaining --- and +++. + +2018-10-03 Noam Postavsky + + Fix note about interactive advice (Bug#32905) + + * doc/lispref/functions.texi (Core Advising Primitives): Add missing + ':', and finish the sentence fragment. + +2018-10-01 Michael Albinus + + Comple fix for Bug#32550 + + * lisp/net/tramp.el (tramp-rfn-eshadow-update-overlay): + Use `save-excursion'. This completes the fix of Bug#32550. + +2018-10-01 Eli Zaretskii + + * lisp/savehist.el (savehist-mode): Doc fix. (Bug#32889) + +2018-09-30 Nicolas Goaziou + + Org manual: Rewrite the Org Mobile section + + * doc/misc/org.texi (Org Mobile): Rewritten from "MobileOrg" section. + Remove all references to non-free software. + Moved into "Miscellaneous", much like Org Crypt library. No longer an + appendix. + (Footnotes): Remove a reference to "MobileOrg". + (Bug#32722) + +2018-09-30 Alan Mackenzie + + Temporary workaround for bug #32848 for branch emacs-26 + + Do not merge with master. + + * lisp/follow.el (follow-mode): Set make-cursor-line-fully-visible to nil + buffer locally whilst follow-mode is active. + +2018-09-29 Tino Calancha + + Improve cl-do, cl-do* docstrings + + * lisp/emacs-lisp/cl-macs.el(cl-do, cl-do*): + Improve docstring (Bug#32803). + +2018-09-29 Eli Zaretskii + + Avoid returning early in 'while-no-input' due to subprocesses + + * src/keyboard.c (kbd_buffer_store_buffered_event): Support + also the internal buffer-switch events. + (syms_of_keyboard) : New DEFSYM. + + * lisp/subr.el (while-no-input-ignore-events): Ignore + 'buffer-switch' events. Reported by Michael Heerdegen + . + + * etc/NEWS: Mention the change in behavior of 'while-no-input' + +2018-09-29 John Shahid + + Cleanup when opening a new terminal fails. (Bug#32794) + + * src/term.c (init_tty): Call delete_terminal_internal if emacs_open + fail. + * src/terminal.c (delete_terminal): Move some code into + delete_terminal_internal and call it. + (delete_terminal_internal): New function. + * src/termhooks.h: Prototype for delete_terminal_internal. + +2018-09-28 Alan Third + + Fix deprecation warning + + * src/nsterm.m (ns_term_init): Use writeToFile or writeToURL as + required. + +2018-09-28 Alan Third + + Make all NS drawing be done from drawRect + + See bug#31904 and bug#32812. + + * src/nsterm.m (ns_update_begin): Don't lock focus, only clip if there + is already a view focused. + (ns_update_end): Don't mess with view focusing any more. + (ns_focus): Only clip drawing if there is already a focused view, + otherwise mark area dirty for later drawing. Renamed ns_clip_to_rect. + All callers changed. + (ns_unfocus): Don't unfocus the view any more. Renamed + ns_reset_clipping. All callers changed. + (ns_clip_to_row): Update to match ns_clip_to_rect. + (ns_clear_frame): + (ns_clear_frame_area): + (ns_draw_fringe_bitmap): + (ns_draw_window_cursor): + (ns_draw_vertical_window_border): + (ns_draw_window_divider): + (ns_dumpglyphs_stretch): + (ns_draw_glyph_string): Only draw if ns_focus or ns_clip_to_row + return YES. + (ns_copy_bits): Remove superfluous calls to ns_(un)focus. + (ns_flush_display): New function. + +2018-09-28 Michael Albinus + + Fix Bug#32828 + + * lisp/net/dbus.el (dbus-init-bus): Return number of connections, + as promised by the docstring. (Bug#32828) + +2018-09-28 Noam Postavsky + + * lisp/net/shr.el (shr-copy-url): Fix docstring. + +2018-09-27 Eli Zaretskii + + Fix typos in documentation + + * doc/misc/vhdl-mode.texi (Custom Indentation Functions): + * doc/misc/url.texi (Customization): + * doc/misc/tramp.texi (Overview): + * doc/misc/srecode.texi (Developing Template Functions): + * doc/misc/sieve.texi (Sieve Mode): + * doc/misc/reftex.texi (Options - Creating Citations): + * doc/misc/org.texi (Cooperation, Conflicts): + * doc/misc/gnus.texi (Misc Group Stuff): + * doc/misc/eshell.texi (Bugs and ideas): + * doc/misc/calc.texi (Summary): + * doc/man/emacsclient.1: + * doc/lispref/os.texi (Security Considerations): + * doc/lispref/control.texi (pcase Macro): + * CONTRIBUTE: Fix typos. Reported by Mak Kolybabi + (Bug#32853) + +2018-09-24 Stefan Monnier + + * doc/emacs/kmacro.texi (Basic Keyboard Macro): Mention old bindings + + According to Apple gospel, function keys are partly going the way of the dodo + so F3/F4 can, like in the good old days, be hard to reach for some users. + +2018-09-24 Eli Zaretskii + + Improve docs of functions/variables related to 'display-buffer' + + * lisp/window.el (display-buffer, pop-to-buffer-same-window) + (display-buffer-same-window, display-buffer-in-side-window) + (same-window-p, display-buffer-overriding-action) + (display-buffer-base-action) + (display-buffer--same-window-action) + (display-buffer--other-frame-action) + (with-current-buffer-window, with-displayed-buffer-window) + (display-buffer-alist, display-buffer-assq-regexp) + (display-buffer-other-frame): Clarify and improve the doc + strings. (Bug#32798) + +2018-09-23 Stefan Monnier + + * lisp/mouse.el (tear-off-window): Fix non-mouse use (bug#32799) + +2018-09-22 Eli Zaretskii + + Improve documentation of directory-local variables + + * lisp/files.el (hack-local-variables, normal-mode) + (after-find-file, find-file-hook): Mention directory-local + variables in the doc strings. Suggested by Marcin Borkowski + . + + * doc/emacs/custom.texi (File Variables, Directory Variables): + Clarify that directory-local variables are overridden by + file-local ones. + +2018-09-22 Eli Zaretskii + + Don't use obsolete variable 'save-place' in documentation + + * doc/lispref/customize.texi (Variable Definitions): Replace + example of saveplace defcustom with a fictitious one, which + will not bit-rot with time. (Bug#32741) + +2018-09-22 Mark A. Hershberger + + Use save-place-mode instead of save-place + + * lisp/menu-bar.el (menu-bar-options-save, menu-bar-options-menu): + * lisp/saveplace.el (save-place-to-alist, save-places-to-alist) + (save-place-find-file-hook, save-place-dired-hook): Use + save-place-mode instead of the obsolete save-place. + +2018-09-20 Eli Zaretskii + + More accurate docs for 'text-char-description' + + * src/keymap.c (Ftext_char_description): + * doc/lispref/help.texi (Describing Characters): More accurate + description of 'text-char-description'. Remove incorrect + examples from the ELisp manual. (Bug#32743) + +2018-09-20 Noam Postavsky + + Document synchronous behavior of eshell/make (Bug#32513) + + * doc/misc/eshell.texi (Built-ins): + * lisp/eshell/em-unix.el (eshell/make): Mention that it falls back to + the external 'make' command when called synchronously. + +2018-09-20 Shigeru Fukaya + + Fix bs-show with wide characters (Bug#17822) + + * lisp/bs.el (bs--insert-one-entry, bs-show-in-buffer): Use + string-width instead of length. + +2018-09-19 Eli Zaretskii + + Improve Custom menu labels for 2 options + + * lisp/dired.el (dired-use-ls-dired): + * lisp/progmodes/xref.el (xref-prompt-for-identifier): Improve + the doc string and the defcustom menu/tags text. (Bug#32756) + +2018-09-19 Eli Zaretskii + + Improve wording of last change in dired-x.texi + + * doc/misc/dired-x.texi (Shell Command Guessing): Clarify + wording in description of 'dired-guess-shell-alist-user'. + Avoid passive tense. (Bug#32733) + +2018-09-18 Eli Zaretskii + + Fix GnuTLS test suite with GnuTLS versions 3.4.x + + * src/gnutls.c (gnutls_cipher_get_tag_size): Make it return + zero only for versions of GnuTLS < 3.2.2, where + gnutls_cipher_get_tag_size was introduced. This fixes the + GnuTLS test suite, which assumes that any cipher whose tag + size is non-zero is AEAD-capable, and doesn't test such ciphers + if AEAD is not available, i.e. for GnuTLS < 3.5.1. (Bug#32446) + +2018-09-17 Noam Postavsky + + Fix build with gnutls versions 3.0 to 3.2 (Bug#32446) + + We previously used functions available only in 3.2+ for all 3.x + versions. + * src/gnutls.c [GNUTLS_VERSION_NUMBER < 0x030501]: Replace calls to + gnutls_cipher_get_tag_size with 0. + [GNUTLS_VERSION_NUMBER < 0x030200]: Alias gnutls_cipher_get_iv_size + to gnutls_cipher_get_block_size, gnutls_digest_list to + gnutls_mac_list, and gnutls_digest_get_name to gnutls_mac_get_name. + [WINDOWSNT]: Adjust DLL function definitions and declarations + accordingly. + +2018-09-17 Eli Zaretskii + + Fix the Bubbles game on TTY frames + + * lisp/play/bubbles.el (bubbles--col-offset) + (bubbles--row-offset): Doc fixes. + (bubbles--compute-offsets): Conflate the GUI and TTY code into + a single common version. Set the offsets to simple numbers, + not to lists. + (bubbles--initialize, bubbles--show-scores): Wrap offset + values in a list, so that they are interpreted as pixel + values, not as units of character width. This fixes the game + on TTY frames. (Bug#32744) + +2018-09-17 Allen Li + + Add choice to reshow certificate information (Bug#31877) + + In various situations, the window displaying the certificate + information can be hidden (such as if the user accidentally presses ?, + which causes the read-multiple-choice help window to replace it). + Instead of leaving the user to make a choice blindly, add a choice to + reshow the certification information. + + * lisp/net/nsm.el (nsm-query-user): Add reshow choice. + +2018-09-16 Glenn Morris + + * src/alloc.c (Fbool_vector, Flist, Fvector): Doc tweak. + + Use a simpler, consistent form. + +2018-09-15 Alan Mackenzie + + * src/alloc.c (vector): Fix grammatical error in doc string: "are" -> "is". + +2018-09-15 Eli Zaretskii + + Avoid adverse side effects of fixing bug#21824 + + * test/src/buffer-tests.el + (overlay-modification-hooks-deleted-overlay): New test. + + * src/buffer.c (report_overlay_modification): Don't bypass all + the overlay-modification hooks; instead, invoke each function + only if the buffer associated with the overlay is the current + buffer. (Bug#30823) + +2018-09-15 Eli Zaretskii + + Document changes called out in NEWS + + * doc/lispref/lists.texi (Association Lists): Document + 'assoc-delete-all'. + * doc/lispref/minibuf.texi (Minibuffers): Adapt menu. + (Multiple Queries): Document 'read-answer'. + + * etc/NEWS: Reflect the above documentation in the respective + entries. + +2018-09-14 Glenn Morris + + Tiny doc updates re yum/dnf etc + + * INSTALL: Mention dnf and Debian unversioned emacs package. + * doc/misc/efaq.texi (Installing Emacs): Mention dnf. + +2018-09-14 Leo Liu + + Remove unused variable + + * lisp/progmodes/prolog.el (prolog-hungry-delete-key-flag): Remove. + +2018-09-14 Leo Liu + + Fix (thing-at-point 'list) regression (Bug#31772) + + * lisp/thingatpt.el (thing-at-point-bounds-of-list-at-point): Revert + to pre 26.1 behavior. Return whole sexp at point if no enclosing + list. + (list-at-point): New optional arg to ignore comments and strings. + + * test/lisp/thingatpt-tests.el + (thing-at-point-bounds-of-list-at-point): Fix and augment tests. + +2018-09-14 Robert Pluim + + Clarify meaning of '*' + + * doc/misc/dired-x.texi (Shell Command Guessing): Clarify meaning + of '*'. (Bug#32733) + +2018-09-12 Paul Eggert + + * etc/PROBLEMS: Document Ubuntu 16.04 issue. + +2018-09-12 Alex Branham (tiny change) + + Increase default value for imenu-auto-rescan-maxout + + * lisp/imenu.el (imenu-auto-rescan-maxout): Increase default value to + 600000. (Bug#18426) + * doc/emacs/programs.texi (imenu-auto-rescan-maxout): Add + documentation for imenu-auto-rescan-maxout. + +2018-09-11 Eli Zaretskii + + Improve recent change to ELisp manual + + * doc/lispref/commands.texi (Keyboard Events): Add index entry + for "character event". (Bug#32562) + +2018-09-11 Eli Zaretskii + + * doc/lispref/display.texi (SVG Images): Improve wording. + + * doc/lispref/display.texi (SVG Images): Fix a typo. (Bug#32690) + +2018-09-10 Eli Zaretskii + + Clarify completion text in the ELisp manual + + * doc/lispref/minibuf.texi (Programmed Completion): Clarify + text. Suggested by Stefan Monnier . + +2018-09-10 Eli Zaretskii + + Fix handling of abbreviated control command in gdb-mi.el + + * lisp/progmodes/gdb-mi.el (gdb-control-commands-regexp): + Support unambiguous abbreviations of commands. (Bug#32576) + +2018-09-10 Eli Zaretskii + + Clarify documentation of functions reading character events + + * doc/lispref/help.texi (Describing Characters): + * doc/lispref/commands.texi (Keyboard Events) + (Reading One Event, Classifying Events): Make the distinction + between characters and character events more explicit. + + * src/keymap.c (Ftext_char_description) + (Fsingle_key_description): + * src/lread.c (Fread_char, Fread_char_exclusive): Doc fixes, + to make a clear distinction between a character input event + and a character code. (Bug#32562) + +2018-09-07 Eli Zaretskii + + Record :version for built-in variables while dumping + + * lisp/cus-start.el (standard): Record the ':version; of the + symbols when dumping, so that 'describe-variable' could tell + which built-in variables were added/changed in recent + versions. + +2018-09-07 YAMAMOTO Mitsuharu + + * src/process.c (connect_network_socket): Fix memory leak. (Bug#32604) + +2018-09-05 Glenn Morris + + * Makefile.in (appdatadir): Use the non-obsolete location "metainfo". + +2018-09-04 Stefan Monnier + + Better fix for bug#32550 + + * lisp/rfn-eshadow.el (rfn-eshadow-overlay): Give it a global default. + + * lisp/net/tramp.el (rfn-eshadow-overlay): Declare it as dynamically scoped. + (tramp-rfn-eshadow-update-overlay): Revert the corresponding part of + last change. + +2018-09-04 Michael Albinus + + Fix Bug#32550 + + * lisp/net/tramp.el (tramp-rfn-eshadow-setup-minibuffer): Do not + use `symbol-value'. + (tramp-rfn-eshadow-update-overlay): Do not use `symbol-value'. Do + not let-bind `rfn-eshadow-overlay', assign it directly (due to + lexical binding). (Bug#32550) + +2018-09-04 Martin Rudalics + + Don't call XGetGeometry for frames without outer X window (Bug#32615) + + * src/xfns.c (frame_geometry): Don't call XGetGeometry when + FRAME has no outer X window; return nil instead. (Bug#32615) + +2018-09-03 Paul Eggert + + * lisp/calculator.el: Fix doc typo. + +2018-09-03 Glenn Morris + + Standardize calc bug reporting instructions + + * doc/misc/calc.texi (Reporting Bugs): Use standard commands. + * lisp/calc/calc-misc.el (report-calc-bug, calc-report-bug): + * lisp/calc/calc.el (calc-bug-address): Change to be + obsolete aliases for standard Emacs bug reporting items. + +2018-08-31 Michael Albinus + + Rename thread-alive-p to thread-live-p + + * doc/lispref/threads.texi (Basic Thread Functions): Use thread-live-p. + + * etc/NEWS: 'thread-alive-p' has been renamed to 'thread-live-p'. + + * src/thread.c (thread_live_p): Rename from thread_alive_p. Adapt + all callees. + (Fthread_live_p): Rename from Fthread_alive_p. + (syms_of_threads): Make thread-alive-p an alias of thread-live-p. + + * test/src/thread-tests.el (all): Replace `thread-alive-p' by + `thread-live-p'. + (threads-live): Rename from `threads-alive'. + +2018-08-30 Miciah Masters (tiny change) + + rcirc: Document /reconnect as a built-in command (Bug#29656) + + The change "New command rcirc-cmd-reconnect" from 2014-04-09 (shipped + in Emacs 25.1) added a /reconnect command to rcirc but did not + document it and did not delete the example /reconnect command + definition in the manual. + * doc/misc/rcirc.texi (rcirc commands): Document the built-in /reconnect + command. + (Hacking and Tweaking): Delete example reconnect command. + +2018-08-30 Noam Postavsky + + * test/lisp/calc/calc-tests.el (calc-imaginary-i): New test. + +2018-08-28 Glenn Morris + + admin.el: respect environment settings for makeinfo etc + + * admin/admin.el (manual-makeinfo, manual-texi2pdf, manual-texi2dvi): + New variables. + (manual-html-mono, manual-html-node, manual-pdf, manual-ps): Use them. + +2018-08-28 Glenn Morris + + * etc/PROBLEMS: New entry about GTK+ 3 crash with some X servers. + +2018-08-28 Noam Postavsky + + Index profiler commands in elisp manual + + * doc/lispref/debugging.texi (Profiling): Add index entries for + profiler-start, profiler-report, profiler-stop. + +2018-08-28 Noam Postavsky + + Fix math-imaginary-i check + + Reported by Bastian ErdnĂĽĂź at + . + * lisp/calc/calc-cplx.el (math-imaginary-i): Check for a value + of (polar 1 ). + +2018-08-28 Eli Zaretskii + + Avoid infinite hscrolling loops when line numbers are displayed + + * src/xdisp.c (maybe_produce_line_number): Don't produce line + numbers if we don't have enough screen estate. (Bug#32351) + +2018-08-28 Eli Zaretskii + + Avoid crashes in malformed defvar + + * src/eval.c (Fdefvar): Don't call XSYMBOL on something that + might not be a symbol. This avoids crashes due to malformed + 'defvar' forms. (Bug#32552) + +2018-08-28 Glenn Morris + + * configure.ac (emacs_config_features): Add GLIB, XDBE, XIM. + + * configure.ac: Doc fixes related to --with-xim. + +2018-08-28 Glenn Morris + + Small checkdoc quoting fix (bug#32546) + + * lisp/emacs-lisp/checkdoc.el (checkdoc-this-string-valid-engine): + Fix quoting thinko. + +2018-08-26 Sergey Vinokurov + + Fix detection of freed emacs_values (Bug#32479) + + * src/emacs-module.c (module_free_global_ref): Compare a value to be + freed with all entries of the list. + + * test/data/emacs-module/mod-test.c (Fmod_test_globref_free): New + function. + (emacs_module_init): Make it accessible from Lisp. + * test/src/emacs-module-tests.el (mod-test-globref-free-test): New + test which uses it. + +2018-08-25 Eli Zaretskii + + Avoid crashes with very wide TTY frames on MS-Windows + + * src/w32console.c : Reduce the number of elements + to 80. + : New static variables. + (w32con_clear_end_of_line): If the line is wider than the + current size of the "empty row" in 'glyphs', reallocate + 'glyphs' to support the full width of the frame. This + avoids segfaults when the frame is wider than 256 columns. + (Bug#32445) + +2018-08-25 Wenjamin Petrenko (tiny change) + + Prevent `modify-file-local-variable-prop-line' from adding extra ';' + + * lisp/files-x.el (modify-file-local-variable-prop-line): Handle + whitespace when checking if there's already a ';' before the + variable (Bug#23294). + +2018-08-24 Glenn Morris + + Update GNOME bugtracker URLs + + * configure.ac, admin/notes/multi-tty, etc/PROBLEMS: + * src/emacs.c (main): + * src/xterm.c (x_connection_closed): Update GNOME bugtracker URLs. + +2018-08-23 Eli Zaretskii + + Clarify in the Emacs manual that ChangeLog files are not used + + * doc/emacs/trouble.texi (Sending Patches): Use "commit log" + instead of "change log", to avoid the interpretation that we + are talking about literal ChangeLog files. (Bug#32359) + +2018-08-21 Eli Zaretskii + + Recognize codepage 65001 as a valid encoding + + * lisp/international/mule-conf.el (cp65001): Define it as an + alias for UTF-8. + +2018-08-18 Eli Zaretskii + + Avoid compilation warning in nt/addpm.c + + * nt/addpm.c [!MINGW_W64]: Undefine _WIN32_IE before + redefining it, to avoid compilation warnings. + +2018-08-17 Basil L. Contovounesios + + Fix duplicate custom group names in bibtex.el + + * lisp/textmodes/bibtex.el (bibtex-BibTeX-entry-alist): + Change :group from BibTeX to bibtex. (bug#32436) + +2018-08-17 Eli Zaretskii + + Fix outdated text in the Calc manual + + * doc/misc/calc.texi (Internals): Don't advertise + 'calc-extensions' which no longer exists. Reported by Francis + Wright . + +2018-08-13 Paul Eggert + + Port better to x86 -fexcess-precision=fast + + Problem reported by Eli Zaretskii in: + https://lists.gnu.org/r/emacs-devel/2018-08/msg00380.html + * src/data.c (arithcompare): Work around incompatibility + between gcc -fexcess-precision=fast and the C standard on x86, + by capturing the results of floating-point comparisons before + the excess precision spontaneously decays. Although this fix + might not work in general, it does work here and is probably + good enough for the platforms we care about. + + (cherry picked from commit a84cef90957f2379cc0df6bd908317fc441971ce) + +2018-08-13 Paul Eggert + + Add comment about floating point test + + * test/src/data-tests.el (data-tests--float-greater-than-fixnums): + New constant. + (data-tests-=, data-tests-<, data-tests->, data-tests-<=) + (data-tests->=, data-tests-min): Use it. + +2018-08-13 Tino Calancha + + Ibuffer: Add toggle ibuffer-do-toggle-lock + + Toggle the locked status in marked buffers or the buffer + at point (Bug#32421). + * lisp/ibuffer.el (ibuffer-do-toggle-lock): New command. + (ibuffer-mode-map): Bind it to 'L'. + (ibuffer-mode-operate-map): Add entries for + `ibuffer-do-toggle-read-only' and `ibuffer-do-toggle-lock'. + * etc/NEWS (Changes in Specialized Modes and Packages in Emacs 26.2): + Announce the change. + +2018-08-13 Tino Calancha + + Ibuffer: Detect correctly the buffers running a process + + * lisp/ibuffer.el (filename-and-process): Store the process buffer + as a text property; check for such property to detect a buffer + with a process (Bug#32420). + +2018-08-12 Michael Albinus + + Backport fix for Bug#32226 + + * test/lisp/shadowfile-tests.el: Set Tramp variables for hydra. + (shadow-test06-literal-groups, shadow-test07-regexp-groups) + (shadow-test08-shadow-todo, shadow-test09-shadow-copy-files): + Use `set-visited-file-name' instead of setting the value in + `buffer-file-name' directly. + (shadow-test08-shadow-todo, shadow-test09-shadow-copy-files): + Test for writable temporary directory. Suppress errors in + cleanup. (Bug#32226) + +2018-08-12 Yuri D'Elia + + Do not consider external packages to be removable (Bug#27822) + + Packages which are not directly user-installed shouldn't be autoremoved, + since they can be setup through a different path (via + `package-directory-list') where we have no authority over. + * lisp/emacs-lisp/package.el (package--user-installed-p): New + function. + (package--removable-packages): Use it. + +2018-08-11 Paul Eggert + + * src/alloc.c: Remove obsolete comments. + +2018-08-11 Eli Zaretskii + + Better support utf-8-with-signature and utf-8-hfs in HTML + + * lisp/international/mule.el (sgml-html-meta-auto-coding-function): + Support UTF-8 with BOM and utf-8-hfs as variants of UTF-8, and + obey the buffer's encoding if it is one of these variants, instead + of re-encoding in UTF-8 proper. (Bug#20623) + +2018-08-11 Eli Zaretskii + + Don't use -Wabi compiler option + + * configure.ac: Add -Wabi to the list of disabled warning + options. For the details, see + http://lists.gnu.org/archive/html/emacs-devel/2018-08/msg00123.html. + +2018-08-10 Filipp Gunbin + + Fix bugs in `auth-source-netrc-parse-one'. + + * lisp/auth-source.el (auth-source-netrc-parse-one): Ensure that match + data is not overwritten in `auth-source-netrc-parse-next-interesting'. + Ensure that blanks are skipped before and after going over comments + and eols. + * test/lisp/auth-source-tests.el (auth-source-test-netrc-parse-one): New test. + + (cherry picked from commit 60ff8101449eea3a5ca4961299501efd83d011bd) + +2018-08-09 Eli Zaretskii + + Fix copying text properties by 'format' + + * src/editfns.c (styled_format): Add the spec beginning index + to the info recorded for each format spec, and use it to + detect the case that a format spec and its text property end + where the next spec with another property begins. (Bug#32404) + + * test/src/editfns-tests.el (format-properties): Add tests for + bug#32404. + +2018-08-09 Alexander Gramiak + + Improve error messages regarding initial-buffer-choice (Bug#29098) + + * lisp/startup.el (command-line-1) : Make the + messages conform to Emacs conventions, and show the invalid return + value in the message. + +2018-08-09 Glenn Morris + + * test/lisp/wdired-tests.el (wdired-test-unfinished-edit-01): Fix typo. + +2018-08-09 Lars Ingebrigtsen + + Make async :family 'local failures fail correctly again + + * src/fileio.c (get_file_errno_data): Refactor out into its own + function so that we can reuse the error handling from an async + context (bug#31901). + + * src/process.c (connect_network_socket): When an async :family + 'local client fails (with a file error, for instance), mark the + process as failed. + + (cherry picked from commit 92ba34d89ac4f5b5bbb818e1c39a3cc12a405790) + +2018-08-09 Noam Postavsky + + Fix emacsclient check for term.el buffer (Bug#21041) + + * lib-src/emacsclient.c (find_tty): Check for any TERM value with + prefix of "eterm", not just "eterm" itself. Also check for ",term:" + in INSIDE_EMACS value. + +2018-08-08 Eli Zaretskii + + Improve documentation of 'set-fontset-font' + + * doc/lispref/display.texi (Fontsets): Fix description of + 'set-fontset-font'. + * src/fontset.c (Fset_fontset_font): Doc fix. (Bug#32401) + +2018-08-07 Eli Zaretskii + + Improve documentation of M-? + + * doc/emacs/maintaining.texi (Identifier Search): + * lisp/progmodes/xref.el (xref-find-references): Improve + documentation of xref-find-references and + xref-prompt-for-identifier. (Bug#32389) + +2018-08-07 Ivan Shmakov + + Reinterpret Esperanto characters in iso-transl as iso-8859-3. + + * lisp/international/iso-transl.el (iso-transl-language-alist): + Reinterpret Esperanto characters as iso-8859-3 (were: iso-8859-1). + (Bug#32371) + +2018-08-07 Eli Zaretskii + + Fix Flyspell mode when several languages are mixed in a buffer + + * lisp/textmodes/flyspell.el (flyspell-external-point-words): + Handle "misspelled" words that actually belong to a language + unsupported by the current dictionary. (Bug#32280) Fix the test + for Ispell the program. + +2018-08-04 Juri Linkov + + New function read-answer (Bug#31782) + + * lisp/emacs-lisp/map-ynp.el (read-answer-short): New defcustom. + (read-answer): New function. + * lisp/subr.el (assoc-delete-all): New function. + * etc/NEWS: Announce them. + + * lisp/dired.el (dired-delete-file): Use read-answer. + (dired--yes-no-all-quit-help): Remove function. + (dired-delete-help): Remove defconst. + + (backported from master, "New function read-answer (bug#30073)" and + "Respect non-saved value of `read-short-answer' (Bug#31782)") + +2018-08-02 Eli Zaretskii + + Avoid assertion violations in maybe_produce_line_number + + * src/xdisp.c (redisplay_window): Make sure desired_matrix is + cleared before calling try_window. This is important when + display-line-numbers is non-nil, because line-number display code + assumes each glyph row is completely cleared when it is called to + produce a line number. (Bug#32358) + +2018-08-02 Eli Zaretskii + + Avoid assertion violations in set_text_properties_1 + + * src/textprop.c (set_text_properties): If the call to + modify_text_properties modifies the interval tree as side effect, + recalculate the correct interval for START and END. (Bug#32265) + +2018-07-31 Stephen Berman + + Fix wdired test failure when byte compiled (bug#32318) + + * test/lisp/wdired-tests.el: Require wdired. Defvar dired-query + to silence byte-compiler. + +2018-07-30 Stephen Berman + + * test/lisp/wdired-tests.el (wdired-test-symlink-name): New test. + +2018-07-29 Raimon Grau + + Fix url's thing-at-point beginning-op (Bug#32028) + + * lisp/thingatpt.el (url): Fix beginning-op making. + +2018-07-29 Eli Zaretskii + + Fix last change in 'char_width' + + * src/character.c (char_width): Make sure variable C is always + initialized. (Bug#32276) + +2018-07-29 Stephen Berman + + Add initial tests for wdired.el + + * test/lisp/wdired-tests.el: New file. + +2018-07-28 Stephen Berman + + Fix use of non-nil wdired-use-interactive-rename + + This is a fairly minimal fix for the release branch; a more + comprehensive fix is on master, so do not merge this to master. + + * lisp/wdired.el (wdired-search-and-rename): Remove dired-filename + text property in order to find new filename when it only partially + replaces old filename (bug#32173). If user quits before renaming + succeeds, restore the dired-filename text property. + +2018-07-28 Eli Zaretskii + + Fix compilation with mingw.org's MinGW 5.x headers + +2018-07-28 Eli Zaretskii + + Update the list of special forms in the ELisp manual + + * doc/lispref/eval.texi (Special Forms): + * doc/lispref/frames.texi (Mouse Tracking): 'track-mouse' is + nowadays a macro. (Bug#32284) + +2018-07-28 Noam Postavsky + + Don't fail to indent-sexp before a full sexp (Bug#31984) + + * lisp/emacs-lisp/lisp-mode.el (indent-sexp): Only signal error if the + initial forward-sexp fails. Suppress scan-error forn any of the + forward-sexp calls after that. + * test/lisp/emacs-lisp/lisp-mode-tests.el (indent-sexp-cant-go): New + test. + +2018-07-27 Eli Zaretskii + + Fix calls to modifications hooks in replace-buffer-contents + + * src/editfns.c (Freplace_buffer_contents): Call the modification + hooks on the entire region where replacements could have taken + place. The previous attempts of being more accurate just + introduced bugs. (Bug#32278) + +2018-07-27 Eli Zaretskii + + * src/character.c (char_width): Support glyphs with faces. (Bug#32276) + +2018-07-27 Eli Zaretskii + + Display raw bytes as belonging to 'eight-bit' charset + + * lisp/descr-text.el (describe-char): + * lisp/simple.el (what-cursor-position): Display characters in the + range #x3FFF80..#x3FFF9F as belonging to charset 'eight-bit', not + 'tis620-2533'. + * lisp/international/mule-diag.el (describe-character-set): + Improve description of :supplementary-p. + +2018-07-26 Eli Zaretskii + + Fix inaccurate text in the user manual + + * doc/emacs/mule.texi (International Chars): Correct inaccurate + description of raw bytes display by "C-x =". + +2018-07-26 Michael Albinus + + Copyedits in tramp.texi, improved example with bash's readline + + * doc/misc/tramp.texi (all): Unify some wordings. + (Frequently Asked Questions): Update example with bash's readline. + +2018-07-25 Michael Albinus + + Minor Tramp doc update + + * doc/misc/tramp.texi (Frequently Asked Questions): Disable bash's + INPUTRC. + +2018-07-25 Michael Albinus + + File Shadowing is not available on MS Windows + + * doc/emacs/files.texi (File Shadowing): File Shadowing is not + available on MS Windows. + + * test/lisp/shadowfile-tests.el (shadow-test00-clusters) + (shadow-test01-sites, shadow-test02-files) + (shadow-test03-expand-cluster-in-file-name) + (shadow-test04-contract-file-name, shadow-test05-file-match) + (shadow-test06-literal-groups, shadow-test07-regexp-groups) + (shadow-test08-shadow-todo, shadow-test09-shadow-copy-files): + Skip under MS Windows. + +2018-07-24 Noam Postavsky + + Let bookmark-jump override window-point (Bug#31751) + + * lisp/bookmark.el (bookmark-jump): Use pop-to-buffer-same-window + instead of switch-to-buffer, the latter obeys + switch-to-buffer-preserve-window-point and so loses the bookmark's + point. + +2018-07-23 Noam Postavsky + + Omit keymap from subword-mode docstring (Bug#32212) + + * lisp/progmodes/subword.el (subword-mode): Remove listing of + subword-mode-map bindings, since it is empty as of 2014-03-23 "Merge + capitalized-words-mode and subword-mode". + +2018-07-23 Tino Calancha + Noam Postavsky + + Prevent line-mode term from showing user passwords + + For buffers whose mode derive from comint-mode, the user password is + read from the minibuffer and it's hidden. A buffer in term-mode and + line submode, instead shows the passwords. Make buffers in line + term-mode to hide passwords too (Bug#30190). + + * lisp/term.el (term-send-invisible): Prefer the more robust + `read-passwd' instead of `term-read-noecho'. + (term-watch-for-password-prompt): New function. + (term-emulate-terminal): Call it each time we receive non-escape + sequence output. + +2018-07-22 Jonathan Kyle Mitchell + + Check for special filenames in eshell (Bug#30724) + + * lisp/eshell/esh-cmd.el (eshell-lisp-command): Check for "~" + in lisp commands with the eshell-filename-arguments property + (Bug#30724). + + * lisp/eshell/em-dirs.el (eshell/cd, eshell/pushd, eshell/popd): + * lisp/eshell/em-ls.el (eshell/ls): + * lisp/eshell/em-unix.el (eshell/rm, eshell/mkdir, eshell/rmdir) + (eshell/mv, eshell/cp, eshell/ln, eshell/cat, eshell/du, eshell/diff): + * lisp/eshell/esh-ext.el (eshell/addpath): Add + eshell-filename-arguments to symbol plist. + +2018-07-22 Noam Postavsky + + Fix indent-sexp of #s(...) (Bug#31984) + + * lisp/emacs-lisp/lisp-mode.el (indent-sexp): Look for a sexp that + ends after the current line. + * test/lisp/emacs-lisp/lisp-mode-tests.el (indent-sexp-go): New test. + +2018-07-22 Noam Postavsky + + Add save-match-data to abbreviate-file-name (Bug#32201) + + * lisp/files.el (abbreviate-file-name): Save match-data around + expand-file-name; it is not guaranteed to preserve match-data, and may + well do so depending on what file handlers and hooks are in effect. + +2018-07-21 Eli Zaretskii + + Fix last change in editfns.c + + * src/editfns.c (Freplace_buffer_contents): Fix last change: always + call buffer modification hooks, even if nothing was deleted/inserted. + (bug#32237) + +2018-07-21 Eli Zaretskii + + Fix calls to buffer modification hooks from replace-buffer-contents + + * src/editfns.c (Freplace_buffer_contents): Don't call buffer + modification hooks if nothing was deleted/inserted. (Bug#32237) + +2018-07-21 Michael Albinus + + Fix Bug#32226 + + * lisp/shadowfile.el (shadow-site-name, shadow-name-site): + Use "[-.[:word:]]+" as hostname regexp. (Bug#32226) + + * test/lisp/shadowfile-tests.el (shadow-test06-literal-groups) + (shadow-test07-regexp-groups, shadow-test08-shadow-todo) + (shadow-test09-shadow-copy-files): Skip if needed. + +2018-07-21 Eli Zaretskii + + Improve doc strings of several variables in keyboard.c + + * src/keyboard.c (syms_of_keyboard) + + : Make sure the first + sentence of the doc string fits on a single line. + +2018-07-20 Michael Albinus + + Fix (Bug#32218). Do not merge with master + + * doc/misc/trampver.texi: + * lisp/net/trampver.el: Change version to "2.3.4.26.2". + (customize-package-emacs-version-alist): Add Tramp version + integrated in Emacs 26.2. + + * lisp/net/tramp.el (tramp-handle-file-truename): + * lisp/net/tramp-adb.el (tramp-adb-handle-file-truename): + * lisp/net/tramp-sh.el (tramp-sh-handle-file-truename): Fix problem + with trailing slash. (Bug#32218) + + * test/lisp/net/tramp-tests.el (tramp-test21-file-links): + Remove `tramp--test-emacs27-p' check. + +2018-07-20 Eli Zaretskii + + Improve documentation of 'pcase-defmacro rx' + + * lisp/emacs-lisp/rx.el (rx): Clarify and improve the doc string. + For the details, see the discussion starting at + http://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00399.html. + +2018-07-19 Eli Zaretskii + + Fix TTY colors breakage by 'clear-face-cache' + + Without examining the right frame, 'tty-color-24bit' was erroneously + treating a GUI frame as a 24-bit TTY frame. + * lisp/term/tty-colors.el (tty-color-24bit): Accept optional + argument DISPLAY and pass it to display-color-cells. Doc fix. + (tty-color-define, tty-color-desc): Pass the FRAME argument to + tty-color-24bit. (Bug#32072) + +2018-07-18 Michael Albinus + + * admin/MAINTAINERS: Add files maintained by me (Michael Albinus). + +2018-07-18 Michael Albinus + + Adapt shadowfile.el for Tramp (Bug#4526, Bug#4846) + + * etc/NEWS: Mention changes in shadowfile.el. + + * lisp/shadowfile.el (top): Require 'tramp instead of 'ange-ftp. + (shadow-cluster): New defstruct. + (shadow-make-cluster, shadow-cluster-name, shadow-cluster-primary) + (shadow-cluster-regexp, shadow-get-user) + (shadow-parse-fullname): Remove. + (shadow-info-file, shadow-todo-file, shadow-system-name) + (shadow-homedir, shadow-regexp-superquote, shadow-suffix) + (shadow-set-cluster, shadow-get-cluster, shadow-site-name) + (shadow-name-site, shadow-site-primary, shadow-site-cluster) + (shadow-read-site, shadow-parse-name, shadow-make-fullname) + (shadow-replace-name-component, shadow-local-file) + (shadow-expand-cluster-in-file-name, shadow-contract-file-name) + (shadow-same-site, shadow-file-match, shadow-define-cluster) + (shadow-define-literal-group, shadow-define-regexp-group) + (shadow-make-group, shadow-shadows-of-1, shadow-read-files) + (shadow-write-info-file, shadow-write-todo-file) + (shadow-initialize): Adapt variables and functions. + + * test/lisp/shadowfile-tests.el: New file. + +2018-07-18 Noam Postavsky + + Fix auth-source-delete (Bug#26184) + + * lisp/auth-source.el (auth-source-delete): Fix `auth-source-search' + call. + * test/lisp/auth-source-tests.el (auth-source-delete): New test. + +2018-07-17 Eli Zaretskii + + Avoid assertion violations in gnutls.c + + * src/gnutls.c (Fgnutls_hash_digest, gnutls_symmetric) + (Fgnutls_hash_mac): Check CONSP before invoking XCDR. (Bug#32187) + Report values of invalid arguments when signaling an error. + +2018-07-14 Eli Zaretskii + + Don't use a literal "C-u" in ispell.el help message text + + * lisp/textmodes/ispell.el (ispell-command-loop): Use + "\\[universal-argument]" instead of a literal "C-u". (Bug#32142) + +2018-07-14 Eli Zaretskii + + Improve documentation of 'seqp' + + * doc/lispref/sequences.texi (Sequence Functions): Add text to + explain the relation between 'seqp' and 'sequencep'. (Bug#32125) + +2018-07-14 Eli Zaretskii + + Clarify usage and dependencies between several Flyspell features + + * lisp/textmodes/flyspell.el (flyspell-region) + (flyspell-small-region, flyspell-persistent-highlight): + Documentation improvements. (Bug#32142) + +2018-07-13 Michael Albinus + + Use consistent function names in thread-tests.el + + * test/src/thread-tests.el (threads-call-error, threads-custom) + (threads-errors, threads-sticky-point, threads-signal-early): + Rename, using naming convention to prefix with "threads-". + +2018-07-13 Michael Albinus + + Fix format error in Faccept_process_output + + * src/process.c (Faccept_process_output): Do not use format spec + "%p", it isn't valid for error(). + +2018-07-13 Paul Eggert + + Lessen stack consumption in recursive read1 + + * src/lread.c (read1): Shrink local buffer size from + MAX_ALLOCA to 128 (Bug#31995). + +2018-07-13 Noam Postavsky + + Match w32 paths in grep sans --null hits (Bug#32051) + + * lisp/progmodes/grep.el (grep-regexp-alist): Add an optional part to + match paths starting with C: (other drive letters). + * test/lisp/progmodes/compile-tests.el + (compile-tests--grep-regexp-testcases) + (compile-tests--grep-regexp-tricky-testcases) + (compile-test-grep-regexps): New tests. + (compile--test-error-line): Return `compilation-message'. + +2018-07-13 Noam Postavsky + + Fix previous make-network-process change + + * src/process.c (Fmake_network_process): On 2018-07-09 "Explicitly + reject :server and :nowait (Bug#31903)", the sense of the SERVER check + was accidentally reversed so that we ended up looking for the wrong + ADDRESS. Reported by T.V Raman in + . + +2018-07-12 Eli Zaretskii + + Another documentation improvement in flyspell.el + + * lisp/textmodes/flyspell.el (flyspell-persistent-highlight): Doc + fix. + +2018-07-12 Eli Zaretskii + + Improve documentation of Flyspell + + For the background, see + http://lists.gnu.org/archive/html/help-gnu-emacs/2018-07/msg00099.html. + + * doc/emacs/fixit.texi (Spelling): Add a couple of caveats. + * lisp/textmodes/flyspell.el: Update commentary. + +2018-07-12 Michael Albinus + + Provide feature 'threads + + * src/thread.c (syms_of_threads): Provide feature "threads". + + * test/src/thread-tests.el (top): Declare the functions. + (all): Use (featurep 'threads) check. + +2018-07-11 Miciah Masters (tiny change) + + Save the server alias on reconnect (Bug#29657) + + rcirc does not retain the server alias on reconnect. As a result, rcirc + fails to re-use server and channel buffers when an alias is used. Further + problems may ensue when aliases are used to differentiate multiple + connections to the same host, for example when using a single IRC bouncer + or proxy to connect to multiple IRC networks. + + Save the server alias when connecting to a server so that reconnect will + retain the alias. + * lisp/net/rcirc.el (rcirc-connect): Include server-alias when setting + rcirc-connection-info. + +2018-07-11 Basil L. Contovounesios + + Refer to "proper lists" instead of "true lists" + + * doc/lispref/lists.texi (Cons Cells, Building Lists): + * doc/lispref/sequences.texi (Vector Functions): Use the more + popular term "proper", rather than "true", to qualify nil-terminated + lists. + + For discussion, see the following emacs-devel subthreads: + https://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00112.html + https://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00138.html + +2018-07-10 John Shahid + + Avoid turning on the global-minor-mode recursively + + * lisp/emacs-lisp/easy-mmode.el (define-globalized-minor-mode): Clear + the buffer-list inside MODE-enable-in-buffers to avoid enabling the + mode recursively. (Bug#31793) + +2018-07-10 Michael Albinus + + Fix Bug#32085 + + * doc/misc/tramp.texi (GVFS based methods): `dav' and `davs' do + not support paths in the volume name. (Bug#32085) + +2018-07-10 Noam Postavsky + + Stop using indent-line-to in lisp-indent-line (Bug#32014) + + This is partial revert of "Remove ignored argument from + lisp-indent-line", because `indent-line-to' doesn't respect field + boundaries. + * lisp/emacs-lisp/lisp-mode.el (lisp-indent-line): Use delete-region + and indent-to instead of `indent-line-to'. + * test/lisp/emacs-lisp/lisp-mode-tests.el + (lisp-indent-with-read-only-field): Expect to pass. + + Don't merge to master, we will fix indent-line-to there instead. + +2018-07-10 Noam Postavsky + + Explicitly reject :server and :nowait (Bug#31903) + + * src/process.c (Fmake_network_process): Explicitly check for and + signal an error when passed both :server and :nowait non-nil. In + Emacs 25, :nowait would be ignored in this case, but as of Emacs 26.1 + this gives an error, albeit an unclear one. Also remove obsolete + comment regarding configurations lacking non-blocking mode, the + corresponding code was removed in 2012-11-17 "Assume POSIX 1003.1-1988 + or later for fcntl.h." + +2018-07-09 Michael Albinus + + Fix Bug#32090 + + * lisp/files-x.el (connection-local-normalize-criteria): Do not + use PROPERTIES anymore. + (connection-local-get-profiles): Rewrite, in order to accept any + property as optional. (Bug#32090) + (connection-local-set-profiles): + Adapt ´connection-local-normalize-criteria' call. + + * test/lisp/files-x-tests.el + (files-x-test-connection-local-set-profiles) + (files-x-test-hack-connection-local-variables-apply): Extend tests. + +2018-07-08 Paul Eggert + + Fix floating point exceptions on Alpha (Bug#32086) + + Backport from master. + * admin/merge-gnulib (GNULIB_MODULES): Add fpieee. + * m4/fpieee.m4: New file, copied from Gnulib. + * m4/gnulib-comp.m4: Regenerate. + +2018-07-08 Paul Eggert + + Fix bootstrap infloop in GNU/Linux alpha + + * src/emacs.c (main): Do not re-exec if EMACS_HEAP_EXEC + is already set (Bug#32083). + +2018-07-08 Eli Zaretskii + + Minor fix of a recent documentation change + + * lisp/net/gnutls.el (gnutls-algorithm-priority): Clarify the doc + string. + +2018-07-08 Lars Ingebrigtsen + + Mention the NSM in the gnutls variable doc strings + + * lisp/net/gnutls.el (gnutls-algorithm-priority): Mention the Network + Security Manager here since this variable is an obvious place + for people concerned about network security to look. + (gnutls-verify-error): Ditto. + (gnutls-min-prime-bits): Ditto. + +2018-07-08 Michael Albinus + + Remove test code from last commit + +2018-07-08 Michael Albinus + + Fix Bug#32084 + + * test/lisp/net/dbus-tests.el (dbus-test02-register-service-own-bus): + Unset $DISPLAY when calling dbus-launch, in order to avoid + possible X11 authentication errors. (Bug#32084) + +2018-07-07 Basil L. Contovounesios + + Fix (length NON-SEQUENCE) documentation + + Suggested by Eli Zaretskii in the following threads: + https://lists.gnu.org/archive/html/emacs-devel/2018-07/msg00171.html + https://lists.gnu.org/archive/html/emacs-devel/2018-07/msg00206.html + + * doc/lispref/sequences.texi (Sequence Functions): Mention that + 'length' signals a 'wrong-type-argument' also when given a + non-sequencep argument. + +2018-07-07 Eli Zaretskii + + Fix bug #11732 + + * src/w32fns.c (w32_wnd_proc): Fix handling of Windows input + methods. (Bug#11732) + +2018-07-07 Eli Zaretskii + + Improve documentation of 'emacs-lock-mode' + + * lisp/emacs-lock.el (emacs-lock-mode): Mention in the doc string + the special handling of some major modes due to + 'emacs-lock-unlockable-modes'. + +2018-07-07 Eli Zaretskii + + * lisp/imenu.el (imenu-generic-expression): Doc fix. (Bug#32016) + +2018-07-07 Eli Zaretskii + + Improve indexing of 'eval-defun' in ELisp manual + + * doc/lispref/display.texi (Defining Faces): + * doc/lispref/debugging.texi (Explicit Debug): + * doc/lispref/customize.texi (Variable Definitions): + * doc/lispref/variables.texi (Defining Variables): Add index + entries for 'eval-defun'. (Bug#32066) + +2018-07-06 Paul Eggert + + Fix (length CIRCULAR) documentation + + * doc/lispref/sequences.texi (Sequence Functions): + Correct documentation of what (length X) does when + X is a circular list. + +2018-07-06 Michael Albinus + + Tramp editorials + + * doc/misc/tramp.texi (Android shell setup): Mention Termux. + + * lisp/net/tramp-sh.el (tramp-remote-process-environment): + Use proper spelling "Tramp" in docstring. + +2018-07-06 Eli Zaretskii + + Clarify and improve doc strings of 'eval-last-sexp' and friends + + * lisp/simple.el (eval-expression, eval-expression-print-format): + * lisp/progmodes/elisp-mode.el (eval-last-sexp): Doc fixes. + (Bug#32064) + +2018-07-06 Glenn Morris + + Automate upload of Emacs manuals to gnu.org + + * admin/make-manuals, admin/upload-manuals: New scripts. + * admin/admin.el (make-manuals, make-manuals-dist): Handle batch mode. + * admin/make-tarball.txt: Update web-page details. + +2018-07-05 Mike Kupfer + + Fix MH-E mail composition with GNU Mailutils (SF#485) + + * lisp/mh-e/mh-comp.el (mh-bare-components): Recursively delete + the temporary folder. + +2018-07-03 Eli Zaretskii + + Speed up 'replace-buffer-contents' some more + + * src/editfns.c (EXTRA_CONTEXT_FIELDS): New members beg_a and beg_b. + (Freplace_buffer_contents): Set up ctx.beg_a and ctx.beg_b. + (buffer_chars_equal): Use ctx->beg_a and ctx->beg_b instead of + calling BUF_BEGV, which is expensive. This speeds up the recipe + in bug#31888 by 30%. + +2018-07-03 Glenn Morris + + * doc/emacs/docstyle.texi: Avoid messing up the html output. + + Previously the @hyphenation commands somehow caused the + section to go missing, with makeinfo 4.13 at least. + 2018-07-01 Paul Eggert * etc/HISTORY: Cite Brinkhoff on early history. @@ -61157,7 +63347,7 @@ This file records repository revisions from commit 9d56a21e6a696ad19ac65c4b405aeca44785884a (exclusive) to -commit f205928d1f93f4373d755ca91805a88e022ac414 (inclusive). +commit 1d79c2ebd9bd9aa36586e57463502373c0296d11 (inclusive). See ChangeLog.1 for earlier changes. ;; Local Variables: commit db711687c3983eda60275dadcc4dc75119e6c0ae Author: Sam Steingold Date: Mon Nov 12 09:10:11 2018 -0500 maybe_disable_address_randomization always returns "int argc" maybe_disable_address_randomization needs a consistent signature regardless of HAVE_PERSONALITY_ADDR_NO_RANDOMIZE. diff --git a/src/lisp.h b/src/lisp.h index 383d61274c..f8ffb33a64 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4327,9 +4327,10 @@ struct tty_display_info; #ifdef HAVE_PERSONALITY_ADDR_NO_RANDOMIZE extern int maybe_disable_address_randomization (bool, int, char **); #else -INLINE void +INLINE int maybe_disable_address_randomization (bool dumping, int argc, char **argv) { + return argc; } #endif extern int emacs_exec_file (char const *, char *const *, char *const *); commit 1d79c2ebd9bd9aa36586e57463502373c0296d11 Author: Paul Eggert Date: Sun Nov 11 22:34:46 2018 -0800 Work around dumping bug on GNU/Linux ppc64le Problem reported by Thomas Fitzsimmons (Bug#33174). Do not merge to master, as we have a better fix there. * src/Makefile.in (emacs$(EXEEXT)): (bootstrap-emacs$(EXEEXT)): Unset EMACS_HEAP_EXEC before invoking temacs. diff --git a/src/Makefile.in b/src/Makefile.in index 6ed8f3cc91..53c18e7ac0 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -534,6 +534,7 @@ emacs$(EXEEXT): temacs$(EXEEXT) \ ifeq ($(CANNOT_DUMP),yes) ln -f temacs$(EXEEXT) $@ else + unset EMACS_HEAP_EXEC; \ LC_ALL=C $(RUN_TEMACS) -batch $(BUILD_DETAILS) -l loadup dump ifneq ($(PAXCTL_dumped),) $(PAXCTL_dumped) $@ @@ -739,6 +740,7 @@ bootstrap-emacs$(EXEEXT): temacs$(EXEEXT) ifeq ($(CANNOT_DUMP),yes) ln -f temacs$(EXEEXT) $@ else + unset EMACS_HEAP_EXEC; \ $(RUN_TEMACS) --batch $(BUILD_DETAILS) --load loadup bootstrap ifneq ($(PAXCTL_dumped),) $(PAXCTL_dumped) emacs$(EXEEXT) commit c14eab222c5208ec0650292c3771a3ee632fdb0d Author: Paul Eggert Date: Sun Nov 11 22:18:47 2018 -0800 Fix dumping on GNU/Linux ppc64le Problem reported by Thomas Fitzsimmons (Bug#33174). * src/emacs.c (main): Adjust to sysdep.c changes. * src/sysdep.c (exec_personality): New static var. (disable_address_randomization): Remove, replacing with ... (maybe_disable_address_randomization): ... this new function. Do not set or use an environment variable; use a command-line argument instead, and set the new static var. Migrate the emacs.c personality-change code to here, where it belongs. (emacs_exec_file): Simplify by using new static var. diff --git a/src/emacs.c b/src/emacs.c index 07df191035..512174d562 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -706,28 +706,7 @@ main (int argc, char **argv) dumping = false; #endif - /* True if address randomization interferes with memory allocation. */ -# ifdef __PPC64__ - bool disable_aslr = true; -# else - bool disable_aslr = dumping; -# endif - - if (disable_aslr && disable_address_randomization () - && !getenv ("EMACS_HEAP_EXEC")) - { - /* Set this so the personality will be reverted before execs - after this one, and to work around an re-exec loop on buggy - kernels (Bug#32083). */ - xputenv ("EMACS_HEAP_EXEC=true"); - - /* Address randomization was enabled, but is now disabled. - Re-execute Emacs to get a clean slate. */ - execvp (argv[0], argv); - - /* If the exec fails, warn and then try anyway. */ - perror (argv[0]); - } + argc = maybe_disable_address_randomization (dumping, argc, argv); #ifndef CANNOT_DUMP might_dump = !initialized; diff --git a/src/lisp.h b/src/lisp.h index eb6762678c..383d61274c 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4325,9 +4325,12 @@ struct tty_display_info; /* Defined in sysdep.c. */ #ifdef HAVE_PERSONALITY_ADDR_NO_RANDOMIZE -extern bool disable_address_randomization (void); +extern int maybe_disable_address_randomization (bool, int, char **); #else -INLINE bool disable_address_randomization (void) { return false; } +INLINE void +maybe_disable_address_randomization (bool dumping, int argc, char **argv) +{ +} #endif extern int emacs_exec_file (char const *, char *const *, char *const *); extern void init_standard_fds (void); diff --git a/src/sysdep.c b/src/sysdep.c index 7a0c8a8ab8..ddcb594f66 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -150,22 +150,52 @@ static const int baud_convert[] = #ifdef HAVE_PERSONALITY_ADDR_NO_RANDOMIZE # include -/* Disable address randomization in the current process. Return true - if addresses were randomized but this has been disabled, false - otherwise. */ -bool -disable_address_randomization (void) +/* If not -1, the personality that should be restored before exec. */ +static int exec_personality; + +/* Try to disable randomization if the current process needs it and + does not appear to have it already. */ +int +maybe_disable_address_randomization (bool dumping, int argc, char **argv) { - int pers = personality (0xffffffff); - if (pers < 0) - return false; - int desired_pers = pers | ADDR_NO_RANDOMIZE; + /* Undocumented Emacs option used only by this function. */ + static char const aslr_disabled_option[] = "--__aslr-disabled"; - /* Call 'personality' twice, to detect buggy platforms like WSL - where 'personality' always returns 0. */ - return (pers != desired_pers - && personality (desired_pers) == pers - && personality (0xffffffff) == desired_pers); + if (argc < 2 || strcmp (argv[1], aslr_disabled_option) != 0) + { + bool disable_aslr = dumping; +# ifdef __PPC64__ + disable_aslr = true; +# endif + exec_personality = disable_aslr ? personality (0xffffffff) : -1; + if (exec_personality & ADDR_NO_RANDOMIZE) + exec_personality = -1; + if (exec_personality != -1 + && personality (exec_personality | ADDR_NO_RANDOMIZE) != -1) + { + char **newargv = malloc ((argc + 2) * sizeof *newargv); + if (newargv) + { + /* Invoke self with undocumented option. */ + newargv[0] = argv[0]; + newargv[1] = (char *) aslr_disabled_option; + memcpy (&newargv[2], &argv[1], argc * sizeof *newargv); + execvp (newargv[0], newargv); + } + + /* If malloc or execvp fails, warn and then try anyway. */ + perror (argv[0]); + free (newargv); + } + } + else + { + /* Our earlier incarnation already disabled ASLR. */ + argc--; + memmove (&argv[1], &argv[2], argc * sizeof *argv); + } + + return argc; } #endif @@ -177,21 +207,12 @@ int emacs_exec_file (char const *file, char *const *argv, char *const *envp) { #ifdef HAVE_PERSONALITY_ADDR_NO_RANDOMIZE - int pers = getenv ("EMACS_HEAP_EXEC") ? personality (0xffffffff) : -1; - bool change_personality = 0 <= pers && pers & ADDR_NO_RANDOMIZE; - if (change_personality) - personality (pers & ~ADDR_NO_RANDOMIZE); + if (exec_personality != -1) + personality (exec_personality); #endif execve (file, argv, envp); - int err = errno; - -#ifdef HAVE_PERSONALITY_ADDR_NO_RANDOMIZE - if (change_personality) - personality (pers); -#endif - - return err; + return errno; } /* If FD is not already open, arrange for it to be open with FLAGS. */ commit b87c874aa1016939ccbee4cd3bd1384726cb2220 Author: Paul Eggert Date: Sun Nov 11 10:01:40 2018 -0800 Pacify gcc -Wmaybe-uninitialized without X11-XCB I ran into this problem on Ubuntu 18.04.1 LTS. * src/xterm.c (get_current_wm_state) [!USE_XCB]: Mark reply_data as UNINIT here too. diff --git a/src/xterm.c b/src/xterm.c index f8ea787e8d..3a7e31e712 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10644,7 +10644,7 @@ get_current_wm_state (struct frame *f, int rc, actual_format; Atom actual_type; unsigned char *tmp_data = NULL; - Atom *reply_data; + Atom *reply_data UNINIT; #endif *sticky = false; commit 29172387581b3390e4659c18514eaa1e0f45b0c5 Author: Paul Eggert Date: Sun Nov 11 09:58:29 2018 -0800 Pacify gcc -Wunused-macros in older GnuTLS I ran into this problem on Ubuntu 18.04.1 LTS. * src/gnutls.c (HAVE_GNUTLS_CIPHER_GET_IV_SIZE) (HAVE_GNUTLS_CIPHER_GET_TAG_SIZE, HAVE_GNUTLS_DIGEST_LIST): New macros. This uses the same style as the other macros that depend on GnuTLS version, as opposed to trying to do things a bit more cleverly. (gnutls_cipher_get_iv_size, gnutls_cipher_get_tag_size) (gnutls_digest_list, gnutls_digest_get_name): Define these macros only if they will be used. diff --git a/src/gnutls.c b/src/gnutls.c index d36b637044..4b94dbb1ae 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -30,31 +30,17 @@ along with GNU Emacs. If not, see . */ # define HAVE_GNUTLS_X509_SYSTEM_TRUST #endif -/* Although AEAD support started in GnuTLS 3.4.0 and works in 3.5.14, - it was broken through at least GnuTLS 3.4.10; see: - https://lists.gnu.org/r/emacs-devel/2017-07/msg00992.html - The relevant fix seems to have been made in GnuTLS 3.5.1; see: - https://gitlab.com/gnutls/gnutls/commit/568935848dd6b82b9315d8b6c529d00e2605e03d - So, require 3.5.1. */ -#if GNUTLS_VERSION_NUMBER >= 0x030501 -# define HAVE_GNUTLS_AEAD -#elif GNUTLS_VERSION_NUMBER < 0x030202 -/* gnutls_cipher_get_tag_size was introduced in 3.2.2, but it's only - relevant for AEAD ciphers. */ -# define gnutls_cipher_get_tag_size(cipher) 0 +#if GNUTLS_VERSION_NUMBER >= 0x030200 +# define HAVE_GNUTLS_CIPHER_GET_IV_SIZE #endif -#if GNUTLS_VERSION_NUMBER < 0x030200 -/* gnutls_cipher_get_iv_size was introduced in 3.2.0. For the ciphers - available in previous versions, block size is equivalent. */ -#define gnutls_cipher_get_iv_size(cipher) gnutls_cipher_get_block_size (cipher) +#if GNUTLS_VERSION_NUMBER >= 0x030202 +# define HAVE_GNUTLS_CIPHER_GET_TAG_SIZE +# define HAVE_GNUTLS_DIGEST_LIST /* also gnutls_digest_get_name */ #endif -#if GNUTLS_VERSION_NUMBER < 0x030202 -/* gnutls_digest_list and gnutls_digest_get_name were added in 3.2.2. - For previous versions, the mac algorithms are equivalent. */ -# define gnutls_digest_list() ((const gnutls_digest_algorithm_t *) gnutls_mac_list ()) -# define gnutls_digest_get_name(id) gnutls_mac_get_name ((gnutls_mac_algorithm_t) id) +#if GNUTLS_VERSION_NUMBER >= 0x030205 +# define HAVE_GNUTLS_EXT__DUMBFW #endif /* gnutls_mac_get_nonce_size was added in GnuTLS 3.2.0, but was @@ -67,8 +53,14 @@ along with GNU Emacs. If not, see . */ # define HAVE_GNUTLS_EXT_GET_NAME #endif -#if GNUTLS_VERSION_NUMBER >= 0x030205 -# define HAVE_GNUTLS_EXT__DUMBFW +/* Although AEAD support started in GnuTLS 3.4.0 and works in 3.5.14, + it was broken through at least GnuTLS 3.4.10; see: + https://lists.gnu.org/r/emacs-devel/2017-07/msg00992.html + The relevant fix seems to have been made in GnuTLS 3.5.1; see: + https://gitlab.com/gnutls/gnutls/commit/568935848dd6b82b9315d8b6c529d00e2605e03d + So, require 3.5.1. */ +#if GNUTLS_VERSION_NUMBER >= 0x030501 +# define HAVE_GNUTLS_AEAD #endif #ifdef HAVE_GNUTLS @@ -223,19 +215,17 @@ DEF_DLL_FN (const gnutls_mac_algorithm_t *, gnutls_mac_list, (void)); DEF_DLL_FN (size_t, gnutls_mac_get_nonce_size, (gnutls_mac_algorithm_t)); # endif DEF_DLL_FN (size_t, gnutls_mac_get_key_size, (gnutls_mac_algorithm_t)); -# ifndef gnutls_digest_list +# ifdef HAVE_GNUTLS_DIGEST_LIST DEF_DLL_FN (const gnutls_digest_algorithm_t *, gnutls_digest_list, (void)); -# endif -# ifndef gnutls_digest_get_name DEF_DLL_FN (const char *, gnutls_digest_get_name, (gnutls_digest_algorithm_t)); # endif DEF_DLL_FN (gnutls_cipher_algorithm_t *, gnutls_cipher_list, (void)); -# ifndef gnutls_cipher_get_iv_size +# ifdef HAVE_GNUTLS_CIPHER_GET_IV_SIZE DEF_DLL_FN (int, gnutls_cipher_get_iv_size, (gnutls_cipher_algorithm_t)); # endif DEF_DLL_FN (size_t, gnutls_cipher_get_key_size, (gnutls_cipher_algorithm_t)); DEF_DLL_FN (int, gnutls_cipher_get_block_size, (gnutls_cipher_algorithm_t)); -# ifndef gnutls_cipher_get_tag_size +# ifdef HAVE_GNUTLS_CIPHER_GET_TAG_SIZE DEF_DLL_FN (int, gnutls_cipher_get_tag_size, (gnutls_cipher_algorithm_t)); # endif DEF_DLL_FN (int, gnutls_cipher_init, @@ -365,19 +355,17 @@ init_gnutls_functions (void) LOAD_DLL_FN (library, gnutls_mac_get_nonce_size); # endif LOAD_DLL_FN (library, gnutls_mac_get_key_size); -# ifndef gnutls_digest_list +# ifdef HAVE_GNUTLS_DIGEST_LIST LOAD_DLL_FN (library, gnutls_digest_list); -# endif -# ifndef gnutls_digest_get_name LOAD_DLL_FN (library, gnutls_digest_get_name); # endif LOAD_DLL_FN (library, gnutls_cipher_list); -# ifndef gnutls_cipher_get_iv_size +# ifdef HAVE_GNUTLS_CIPHER_GET_IV_SIZE LOAD_DLL_FN (library, gnutls_cipher_get_iv_size); # endif LOAD_DLL_FN (library, gnutls_cipher_get_key_size); LOAD_DLL_FN (library, gnutls_cipher_get_block_size); -# ifndef gnutls_cipher_get_tag_size +# ifdef HAVE_GNUTLS_CIPHER_GET_TAG_SIZE LOAD_DLL_FN (library, gnutls_cipher_get_tag_size); # endif LOAD_DLL_FN (library, gnutls_cipher_init); @@ -489,19 +477,17 @@ init_gnutls_functions (void) # define gnutls_mac_get_nonce_size fn_gnutls_mac_get_nonce_size # endif # define gnutls_mac_get_key_size fn_gnutls_mac_get_key_size -# ifndef gnutls_digest_list +# ifdef HAVE_GNUTLS_DIGEST_LIST # define gnutls_digest_list fn_gnutls_digest_list -# endif -# ifndef gnutls_digest_get_name # define gnutls_digest_get_name fn_gnutls_digest_get_name # endif # define gnutls_cipher_list fn_gnutls_cipher_list -# ifndef gnutls_cipher_get_iv_size +# ifdef HAVE_GNUTLS_CIPHER_GET_IV_SIZE # define gnutls_cipher_get_iv_size fn_gnutls_cipher_get_iv_size # endif # define gnutls_cipher_get_key_size fn_gnutls_cipher_get_key_size # define gnutls_cipher_get_block_size fn_gnutls_cipher_get_block_size -# ifndef gnutls_cipher_get_tag_size +# ifdef HAVE_GNUTLS_CIPHER_GET_TAG_SIZE # define gnutls_cipher_get_tag_size fn_gnutls_cipher_get_tag_size # endif # define gnutls_cipher_init fn_gnutls_cipher_init @@ -1955,6 +1941,24 @@ This function may also return `gnutls-e-again', or #ifdef HAVE_GNUTLS3 +# ifndef HAVE_GNUTLS_CIPHER_GET_IV_SIZE + /* Block size is equivalent. */ +# define gnutls_cipher_get_iv_size(cipher) gnutls_cipher_get_block_size (cipher) +# endif + +# ifndef HAVE_GNUTLS_CIPHER_GET_TAG_SIZE + /* Tag size is irrelevant. */ +# define gnutls_cipher_get_tag_size(cipher) 0 +# endif + +# ifndef HAVE_GNUTLS_DIGEST_LIST + /* The mac algorithms are equivalent. */ +# define gnutls_digest_list() \ + ((gnutls_digest_algorithm_t const *) gnutls_mac_list ()) +# define gnutls_digest_get_name(id) \ + gnutls_mac_get_name ((gnutls_mac_algorithm_t) (id)) +# endif + DEFUN ("gnutls-ciphers", Fgnutls_ciphers, Sgnutls_ciphers, 0, 0, 0, doc: /* Return alist of GnuTLS symmetric cipher descriptions as plists. The alist key is the cipher name. */) @@ -2306,9 +2310,9 @@ name. */) Lisp_Object gma_symbol = intern (gnutls_mac_get_name (gma)); size_t nonce_size = 0; -#ifdef HAVE_GNUTLS_MAC_GET_NONCE_SIZE +# ifdef HAVE_GNUTLS_MAC_GET_NONCE_SIZE nonce_size = gnutls_mac_get_nonce_size (gma); -#endif +# endif Lisp_Object mp = listn (CONSTYPE_HEAP, 11, gma_symbol, QCmac_algorithm_id, make_fixnum (gma), QCtype, Qgnutls_type_mac_algorithm, commit 2523ac9fa3ea01f34f7a2b55e19b9dcd5506c232 Author: Simen Heggestøyl Date: Sun Nov 11 15:18:53 2018 +0100 Add masking module to CSS property list * lisp/textmodes/css-mode.el (css-property-alist) (css-value-class-alist): Add properties and value classes from CSS Masking Module. diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 63c86317ee..2de6455a6a 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -112,7 +112,6 @@ ("bottom" length percentage "auto") ("caption-side" "top" "bottom") ("clear" "none" "left" "right" "both") - ("clip" shape "auto") ("content" "normal" "none" string uri counter "attr()" "open-quote" "close-quote" "no-open-quote" "no-close-quote") ("counter-increment" identifier integer "none") @@ -375,6 +374,31 @@ ("orphans" integer) ("widows" integer) + ;; CSS Masking Module Level 1 + ;; (https://www.w3.org/TR/css-masking-1/#property-index) + ("clip-path" clip-source basic-shape geometry-box "none") + ("clip-rule" "nonzero" "evenodd") + ("mask-image" mask-reference) + ("mask-mode" masking-mode) + ("mask-repeat" repeat-style) + ("mask-position" position) + ("mask-clip" geometry-box "no-clip") + ("mask-origin" geometry-box) + ("mask-size" bg-size) + ("mask-composite" compositing-operator) + ("mask" mask-layer) + ("mask-border-source" "none" image) + ("mask-border-mode" "luminance" "alpha") + ("mask-border-slice" number percentage "fill") + ("mask-border-width" length percentage number "auto") + ("mask-border-outset" length number) + ("mask-border-repeat" "stretch" "repeat" "round" "space") + ("mask-border" mask-border-source mask-border-slice + mask-border-width mask-border-outset mask-border-repeat + mask-border-mode) + ("mask-type" "luminance" "alpha") + ("clip" "rect()" "auto") + ;; CSS Multi-column Layout Module ;; (https://www.w3.org/TR/css3-multicol/#property-index) ;; "break-after", "break-before", and "break-inside" are left out @@ -652,14 +676,17 @@ further value candidates, since that list would be infinite.") (attachment "scroll" "fixed" "local") (auto-repeat "repeat()") (auto-track-list line-names fixed-size fixed-repeat auto-repeat) + (basic-shape "inset()" "circle()" "ellipse()" "polygon()") (bg-image image "none") (bg-layer bg-image position repeat-style attachment box) (bg-size length percentage "auto" "cover" "contain") (box "border-box" "padding-box" "content-box") + (clip-source uri) (color "rgb()" "rgba()" "hsl()" "hsla()" named-color "transparent" "currentColor") (common-lig-values "common-ligatures" "no-common-ligatures") + (compositing-operator "add" "subtract" "intersect" "exclude") (contextual-alt-values "contextual" "no-contextual") (counter "counter()" "counters()") (discretionary-lig-values @@ -685,6 +712,7 @@ further value candidates, since that list would be infinite.") (generic-family "serif" "sans-serif" "cursive" "fantasy" "monospace") (generic-voice "male" "female" "child") + (geometry-box shape-box "fill-box" "stroke-box" "view-box") (gradient linear-gradient radial-gradient repeating-linear-gradient repeating-radial-gradient) @@ -705,6 +733,12 @@ further value candidates, since that list would be infinite.") (line-width length "thin" "medium" "thick") (linear-gradient "linear-gradient()") (margin-width "auto" length percentage) + (mask-layer + mask-reference masking-mode position bg-size repeat-style + geometry-box "no-clip" compositing-operator) + (mask-reference "none" image mask-source) + (mask-source uri) + (masking-mode "alpha" "luminance" "auto") (named-color . ,(mapcar #'car css--color-map)) (number "calc()") (numeric-figure-values "lining-nums" "oldstyle-nums") @@ -720,7 +754,7 @@ further value candidates, since that list would be infinite.") (repeating-linear-gradient "repeating-linear-gradient()") (repeating-radial-gradient "repeating-radial-gradient()") (shadow "inset" length color) - (shape "rect()") + (shape-box box "margin-box") (single-animation-direction "normal" "reverse" "alternate" "alternate-reverse") (single-animation-fill-mode "none" "forwards" "backwards" "both") commit 913c001f43350a70c8fc9d3eb846242eb63c9ae8 Author: Eli Zaretskii Date: Sun Nov 11 18:17:51 2018 +0200 * lisp/files.el (write-file): Clarify the doc string. (Bug#33339) diff --git a/lisp/files.el b/lisp/files.el index 9a8ed64e70..eb09a7c83f 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -4246,12 +4246,15 @@ the old visited file has been renamed to the new name FILENAME." "Write current buffer into file FILENAME. This makes the buffer visit that file, and marks it as not modified. -If you specify just a directory name as FILENAME, that means to use -the default file name but in that directory. You can also yank -the default file name into the minibuffer to edit it, using \\\\[next-history-element]. - -If the buffer is not already visiting a file, the default file name -for the output file is the buffer name. +Interactively, prompt for FILENAME. +If you specify just a directory name as FILENAME, that means to write +to a file in that directory. In this case, the base name of the file +is the same as that of the file visited in the buffer, or the buffer +name sans leading directories, if any, if the buffer is not already +visiting a file. + +You can also yank the file name into the minibuffer to edit it, +using \\\\[next-history-element]. If optional second arg CONFIRM is non-nil, this function asks for confirmation before overwriting an existing file. commit d614b84fa4af512a2caccb950643a08616e14355 Author: Simen Heggestøyl Date: Sun Nov 11 10:21:30 2018 +0100 Fix typos in midnight.el * lisp/midnight.el (clean-buffer-list-delay-general) (clean-buffer-list-kill-regexps) (clean-buffer-list-kill-buffer-names): Fix docstring typos. diff --git a/lisp/midnight.el b/lisp/midnight.el index 82994c579f..7c4096c326 100644 --- a/lisp/midnight.el +++ b/lisp/midnight.el @@ -64,7 +64,7 @@ the time when it is run.") (defcustom clean-buffer-list-delay-general 3 "The number of days before any buffer becomes eligible for autokilling. -The autokilling is done by `clean-buffer-list' when is it in `midnight-hook'. +The autokilling is done by `clean-buffer-list' when it is in `midnight-hook'. Currently displayed and/or modified (unsaved) buffers, as well as buffers matching `clean-buffer-list-kill-never-buffer-names' and `clean-buffer-list-kill-never-regexps' are excluded." @@ -81,7 +81,7 @@ displayed more than this many seconds ago." "List of regexps saying which buffers will be killed at midnight. If buffer name matches a regexp in the list and the buffer was not displayed in the last `clean-buffer-list-delay-special' seconds, it is killed by -`clean-buffer-list' when is it in `midnight-hook'. +`clean-buffer-list' when it is in `midnight-hook'. If a member of the list is a cons, its `car' is the regexp and its `cdr' is the number of seconds to use instead of `clean-buffer-list-delay-special'. See also `clean-buffer-list-kill-buffer-names', @@ -101,7 +101,7 @@ if the buffer should be killed by `clean-buffer-list'." "List of strings saying which buffers will be killed at midnight. Buffers with names in this list, which were not displayed in the last `clean-buffer-list-delay-special' seconds, are killed by `clean-buffer-list' -when is it in `midnight-hook'. +when it is in `midnight-hook'. If a member of the list is a cons, its `car' is the name and its `cdr' is the number of seconds to use instead of `clean-buffer-list-delay-special'. See also `clean-buffer-list-kill-regexps', commit a004d3bbbae6abb033ed7d244252d04911f5c6fd Author: Glenn Morris Date: Sat Nov 10 19:15:59 2018 -0800 ; * test/src/editfns-tests.el (test-group-name): Ignore getent errors. diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index 09584d1694..66375a6433 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -362,8 +362,9 @@ (let (stat name) (dolist (gid (list 0 1212345 (group-gid))) (erase-buffer) - (setq stat (call-process "getent" nil '(t nil) nil "group" - (number-to-string gid))) + (setq stat (ignore-errors + (call-process "getent" nil '(t nil) nil "group" + (number-to-string gid)))) (setq name (group-name gid)) (goto-char (point-min)) (cond ((eq stat 0) commit c30f24d03dbdc730bc4c8fbc0e1309830e8c9767 Author: Glenn Morris Date: Sat Nov 10 19:13:20 2018 -0800 * test/src/editfns-tests.el (test-group-name): Improve test. Make more portable and hopefully more robust using getent. (Bug#33195) diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index 6ce49fdc28..09584d1694 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -352,17 +352,24 @@ "-0x000000003ffffffffffffffe000000000000000 ")))) (ert-deftest test-group-name () + (should (stringp (group-name (group-gid)))) + (should-error (group-name 'foo)) (cond ((memq system-type '(windows-nt ms-dos)) - (should (stringp (group-name (group-gid)))) - (should-not (group-name 123456789)) - (should-error (group-name 'foo))) - (t - (let ((list `((0 . "root") -;;; (1000 . ,(user-login-name 1000)) - (1212345 . nil)))) - (dolist (test list) - (should (equal (group-name (car test)) (cdr test))))) - (should-error (group-name 'foo))))) + (should-not (group-name 123456789))) + ((executable-find "getent") + (with-temp-buffer + (let (stat name) + (dolist (gid (list 0 1212345 (group-gid))) + (erase-buffer) + (setq stat (call-process "getent" nil '(t nil) nil "group" + (number-to-string gid))) + (setq name (group-name gid)) + (goto-char (point-min)) + (cond ((eq stat 0) + (if (looking-at "\\([[:alnum:]_-]+\\):") + (should (string= (match-string 1) name)))) + ((eq stat 2) + (should-not name))))))))) ;;; editfns-tests.el ends here commit 8c2778a9fbb82ed55335404f2b312fcc04bafaea Author: Eli Zaretskii Date: Sat Nov 10 22:22:39 2018 +0200 Improve documentation of 'move-file-to-trash' * doc/emacs/files.texi (Misc File Ops): Index move-file-to-trash. State that the way to restore trashed files is system-dependent. diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 9c57bbe267..e4b97e58fc 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -1697,10 +1697,12 @@ Dired rather than @code{delete-file}. @xref{Dired Deletion}. @cindex trash @cindex recycle bin +@findex move-file-to-trash @kbd{M-x move-file-to-trash} moves a file into the system @dfn{Trash} (or @dfn{Recycle Bin}). This is a facility available on most operating systems; files that are moved into the Trash can be -brought back later if you change your mind. +brought back later if you change your mind. (The way to restore +trashed files is system-dependent.) @vindex delete-by-moving-to-trash By default, Emacs deletion commands do @emph{not} use the Trash. To commit 1a3d471d87ea459bc2c2d704c5578e6977e68e83 Author: Eli Zaretskii Date: Sat Nov 10 22:14:42 2018 +0200 Make 'move-file-to-trash' behave according to the documentation * lisp/files.el (move-file-to-trash): Behave like the doc string says: check whether 'system-move-file-to-trash' is defined before testing that 'trash-directory' is non-nil. (Bug#33335) diff --git a/lisp/files.el b/lisp/files.el index ad032832ec..0f0c7d1559 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -7393,7 +7393,10 @@ Otherwise, trash FILENAME using the freedesktop.org conventions, like the GNOME, KDE and XFCE desktop environments. Emacs only moves files to \"home trash\", ignoring per-volume trashcans." (interactive "fMove file to trash: ") - (cond (trash-directory + ;; If `system-move-file-to-trash' is defined, use it. + (cond ((fboundp 'system-move-file-to-trash) + (system-move-file-to-trash filename)) + (trash-directory ;; If `trash-directory' is non-nil, move the file there. (let* ((trash-dir (expand-file-name trash-directory)) (fn (directory-file-name (expand-file-name filename))) @@ -7412,9 +7415,6 @@ Otherwise, trash FILENAME using the freedesktop.org conventions, (setq new-fn (car (find-backup-file-name new-fn))))) (let (delete-by-moving-to-trash) (rename-file fn new-fn)))) - ;; If `system-move-file-to-trash' is defined, use it. - ((fboundp 'system-move-file-to-trash) - (system-move-file-to-trash filename)) ;; Otherwise, use the freedesktop.org method, as specified at ;; http://freedesktop.org/wiki/Specifications/trash-spec (t commit c7b8a51b79bfe76c03a04fed3d46bc026ba0139a Author: Charles A. Roelli Date: Sat Nov 10 20:32:36 2018 +0100 ; * doc/lispref/functions.texi (Anonymous Functions): Fix typo. diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 216666c713..37c94c1db7 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -1091,8 +1091,8 @@ yields the form itself: @result{} (lambda (x) (* x x)) @end example -Note that when evaluting under lexical binding the result is a closure -object (@pxref{Closures}). +Note that when evaluating under lexical binding the result is a +closure object (@pxref{Closures}). The @code{lambda} form has one other effect: it tells the Emacs evaluator and byte-compiler that its argument is a function, by using commit 663613a1c096080837066ebb8c8b67e85d66d648 Author: Glenn Morris Date: Sat Nov 10 10:37:47 2018 -0800 * test/src/editfns-tests.el (test-group-name): Small fix. Do not assume user 1000 has group name = user name. diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index 7b6c990f35..6ce49fdc28 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -359,7 +359,7 @@ (should-error (group-name 'foo))) (t (let ((list `((0 . "root") - (1000 . ,(user-login-name 1000)) +;;; (1000 . ,(user-login-name 1000)) (1212345 . nil)))) (dolist (test list) (should (equal (group-name (car test)) (cdr test))))) commit 9cd23a29147acb86c860ce11febe24cf837f3f8a Author: Paul Eggert Date: Sat Nov 10 09:00:43 2018 -0800 Dissociate controlling tty better on Darwin * src/process.c (dissociate_controlling_tty): New function. (create_process): Use it to dissociate controlling tty if setsid fails, which happens on Darwin after a vfork (Bug#33154). Do this on all platforms, not just on Darwin, as a similar problem is plausible elsewhere. * src/callproc.c (call_process): Use the new function here, too, for consistency and to avoid duplicate code. diff --git a/src/callproc.c b/src/callproc.c index a2cfd2e94d..9f47c79b81 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -643,19 +643,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, #endif unblock_child_signal (&oldset); - -#ifdef DARWIN_OS - /* Darwin doesn't let us run setsid after a vfork, so use - TIOCNOTTY when necessary. */ - int j = emacs_open (DEV_TTY, O_RDWR, 0); - if (j >= 0) - { - ioctl (j, TIOCNOTTY, 0); - emacs_close (j); - } -#else - setsid (); -#endif + dissociate_controlling_tty (); /* Emacs ignores SIGPIPE, but the child should not. */ signal (SIGPIPE, SIG_DFL); diff --git a/src/process.c b/src/process.c index 6cda4f27ac..7e78e172d3 100644 --- a/src/process.c +++ b/src/process.c @@ -1949,6 +1949,26 @@ close_process_fd (int *fd_addr) } } +void +dissociate_controlling_tty (void) +{ + if (setsid () < 0) + { +#ifdef TIOCNOTTY + /* Needed on Darwin after vfork, since setsid fails in a vforked + child that has not execed. + I wonder: would just ioctl (fd, TIOCNOTTY, 0) work here, for + some fd that the caller already has? */ + int ttyfd = emacs_open (DEV_TTY, O_RDWR, 0); + if (0 <= ttyfd) + { + ioctl (ttyfd, TIOCNOTTY, 0); + emacs_close (ttyfd); + } +#endif + } +} + /* Indexes of file descriptors in open_fds. */ enum { @@ -2097,9 +2117,8 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) { /* Make the pty be the controlling terminal of the process. */ #ifdef HAVE_PTYS - /* First, disconnect its current controlling terminal. - Do this even if !PTY_FLAG; see Bug#30762. */ - setsid (); + dissociate_controlling_tty (); + /* Make the pty's terminal the controlling terminal. */ if (pty_flag && forkin >= 0) { @@ -2128,21 +2147,6 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) } #endif #endif -#ifdef TIOCNOTTY - /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you - can do TIOCSPGRP only to the process's controlling tty. */ - if (pty_flag) - { - /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here? - I can't test it since I don't have 4.3. */ - int j = emacs_open (DEV_TTY, O_RDWR, 0); - if (j >= 0) - { - ioctl (j, TIOCNOTTY, 0); - emacs_close (j); - } - } -#endif /* TIOCNOTTY */ #if !defined (DONT_REOPEN_PTY) /*** There is a suggestion that this ought to be a diff --git a/src/process.h b/src/process.h index 3c6dd7b91f..67b783400d 100644 --- a/src/process.h +++ b/src/process.h @@ -300,6 +300,7 @@ extern Lisp_Object network_interface_info (Lisp_Object); extern Lisp_Object remove_slash_colon (Lisp_Object); extern void update_processes_for_thread_death (Lisp_Object); +extern void dissociate_controlling_tty (void); INLINE_HEADER_END commit a062fc4137ff195fe269076cda07a61c2e1a8012 Author: Michael Albinus Date: Sat Nov 10 16:03:12 2018 +0100 Provide branch information for both Emacs and Tramp (Bug#33328) * doc/lispref/intro.texi (Version Info): Document `emacs-repository-version' and `emacs-repository-branch'. * etc/NEWS: Mention `emacs-repository-branch'. * lisp/loadup.el: Initialize `emacs-repository-branch'. * lisp/version.el (emacs-repository-branch): New variable. (emacs-repository-branch-git, emacs-repository-get-branch): New defuns. * lisp/mail/emacsbug.el (report-emacs-bug): Insert `emacs-repository-branch'. * lisp/net/tramp.el (tramp-get-local-gid): Use `group-name' if available. (tramp-debug-message): * lisp/net/tramp-cmds.el (tramp-bug): Report also `tramp-repository-branch' and `tramp-repository-version'. * lisp/net/trampver.el (tramp-repository-branch) (tramp-repository-version): New defconst. (tramp-repository-get-version): Remove. diff --git a/doc/lispref/intro.texi b/doc/lispref/intro.texi index 197f54ecc5..2353cf956c 100644 --- a/doc/lispref/intro.texi +++ b/doc/lispref/intro.texi @@ -530,6 +530,18 @@ directory (without cleaning). This is only of relevance when developing Emacs. @end defvar +@defvar emacs-repository-version +A string that gives the repository revision from which Emacs was +built. If Emacs was built outside revision control, the value is +@code{nil}. +@end defvar + +@defvar emacs-repository-branch +A string that gives the repository branch from which Emacs was built. +In the most cases this is @code{"master"}. If Emacs was built outside +revision control, the value is @code{nil}. +@end defvar + @node Acknowledgments @section Acknowledgments diff --git a/etc/NEWS b/etc/NEWS index e5892d718e..b8073dd175 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -225,6 +225,10 @@ In addition to nil or non-nil, the value can now be a predicate function. Follow mode uses this to control scrolling of its windows when the last screen line in a window is not fully visible. ++++ +** New variable 'emacs-repository-branch'. +It reports the git branch from which Emacs was built. + * Editing Changes in Emacs 27.1 diff --git a/lisp/loadup.el b/lisp/loadup.el index 5ecfae170f..eb663538a3 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -368,8 +368,8 @@ lost after dumping"))) (string-to-number (substring name (length base) exelen)))) files))) - (setq emacs-repository-version (condition-case nil (emacs-repository-get-version) - (error nil))) + (setq emacs-repository-version (ignore-errors (emacs-repository-get-version)) + emacs-repository-branch (ignore-errors (emacs-repository-get-branch))) ;; A constant, so we shouldn't change it with `setq'. (defconst emacs-build-number (if versions (1+ (apply 'max versions)) 1)))) diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index 8cacad8726..e55f950aac 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -307,6 +307,8 @@ usually do not have translators for other languages.\n\n"))) (if (stringp emacs-repository-version) (insert "Repository revision: " emacs-repository-version "\n")) + (if (stringp emacs-repository-branch) + (insert "Repository branch: " emacs-repository-branch "\n")) (if (fboundp 'x-server-vendor) (condition-case nil ;; This is used not only for X11 but also W32 and others. diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index 456300e766..3c8f182ae9 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -198,8 +198,9 @@ This includes password cache, file cache, connection cache, buffers." ;; In rare cases, it could contain the password. So we make it nil. tramp-password-save-function) (reporter-submit-bug-report - tramp-bug-report-address ; to-address - (format "tramp (%s)" tramp-version) ; package name and version + tramp-bug-report-address ; to-address + (format "tramp (%s %s/%s)" ; package name and version + tramp-version tramp-repository-branch tramp-repository-version) (sort (delq nil (mapcar (lambda (x) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 44d66404f1..e8d535e85e 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1609,10 +1609,13 @@ ARGUMENTS to actually emit the message (if applicable)." ";; Emacs: %s Tramp: %s -*- mode: outline; -*-" emacs-version tramp-version)) (when (>= tramp-verbose 10) - (insert - (format - "\n;; Location: %s Git: %s" - (locate-library "tramp") (tramp-repository-get-version))))) + (let ((tramp-verbose 0)) + (insert + (format + "\n;; Location: %s Git: %s/%s" + (locate-library "tramp") + (or tramp-repository-branch "") + (or tramp-repository-version "")))))) (unless (bolp) (insert "\n")) ;; Timestamp. diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index de76788cc0..f93e538084 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -38,17 +38,23 @@ (defconst tramp-bug-report-address "tramp-devel@gnu.org" "Email address to send bug reports to.") -(defun tramp-repository-get-version () - "Try to return as a string the repository revision of the Tramp sources." - (let ((dir (locate-dominating-file (locate-library "tramp") ".git"))) - (when dir - (with-temp-buffer - (let ((default-directory (file-name-as-directory dir))) - (and (zerop - (ignore-errors - (call-process "git" nil '(t nil) nil "rev-parse" "HEAD"))) - (not (zerop (buffer-size))) - (replace-regexp-in-string "\n" "" (buffer-string)))))))) +(defconst tramp-repository-branch + (ignore-errors + ;; Suppress message from `emacs-repository-get-branch'. + (let ((inhibit-message t)) + ;; `emacs-repository-get-branch' has been introduced with Emacs 27.1. + (with-no-warnings + (emacs-repository-get-branch + (locate-dominating-file (locate-library "tramp") ".git"))))) + "The repository branch of the Tramp sources.") + +(defconst tramp-repository-version + (ignore-errors + ;; Suppress message from `emacs-repository-get-version'. + (let ((inhibit-message t)) + (emacs-repository-get-version + (locate-dominating-file (locate-library "tramp") ".git")))) + "The repository revision of the Tramp sources.") ;; Check for Emacs version. (let ((x (if (not (string-lessp emacs-version "24.1")) diff --git a/lisp/version.el b/lisp/version.el index 8491930819..c72164cdac 100644 --- a/lisp/version.el +++ b/lisp/version.el @@ -135,6 +135,34 @@ Optional argument DIR is a directory to use instead of `source-directory'. Optional argument EXTERNAL is ignored." (emacs-repository-version-git (or dir source-directory))) +(defvar emacs-repository-branch nil + "String giving the repository branch from which this Emacs was built. +Value is nil if Emacs was not built from a repository checkout, +or if we could not determine the branch.") + +(defun emacs-repository-branch-git (dir) + "Ask git itself for the branch information for directory DIR." + (message "Waiting for git...") + (with-temp-buffer + (let ((default-directory (file-name-as-directory dir))) + (and (zerop + (with-demoted-errors "Error running git rev-parse --abbrev-ref: %S" + (call-process "git" nil '(t nil) nil + "rev-parse" "--abbrev-ref" "HEAD"))) + (goto-char (point-min)) + (buffer-substring (point) (line-end-position)))))) + +(defun emacs-repository-get-branch (&optional dir) + "Try to return as a string the repository branch of the Emacs sources. +The format of the returned string is dependent on the VCS in use. +Value is nil if the sources do not seem to be under version +control, or if we could not determine the branch. Note that +this reports on the current state of the sources, which may not +correspond to the running Emacs. + +Optional argument DIR is a directory to use instead of `source-directory'." + (emacs-repository-branch-git (or dir source-directory))) + ;; We put version info into the executable in the form that `ident' uses. (purecopy (concat "\n$Id: " (subst-char-in-string ?\n ?\s (emacs-version)) " $\n")) commit 55f3f21b39389263d707b091d7e1b45d295a149c Author: Michael Albinus Date: Sat Nov 10 15:55:23 2018 +0100 * lisp/net/tramp.el (tramp-get-local-gid): Use `group-name' if available. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 4ee69d7198..44d66404f1 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4193,10 +4193,14 @@ ID-FORMAT valid values are `string' and `integer'." (defun tramp-get-local-gid (id-format) "The gid of the local user, in ID-FORMAT. ID-FORMAT valid values are `string' and `integer'." - ;; `group-gid' has been introduced with Emacs 24.4. - (if (and (fboundp 'group-gid) (equal id-format 'integer)) - (tramp-compat-funcall 'group-gid) - (tramp-compat-file-attribute-group-id (file-attributes "~/" id-format)))) + (cond + ;; `group-gid' has been introduced with Emacs 24.4. + ((and (fboundp 'group-gid) (equal id-format 'integer)) + (tramp-compat-funcall 'group-gid)) + ;; `group-name' has been introduced with Emacs 27.1. + ((and (fboundp 'group-name) (equal id-format 'string)) + (tramp-compat-funcall 'group-name (tramp-compat-funcall 'group-gid))) + ((tramp-compat-file-attribute-group-id (file-attributes "~/" id-format))))) (defun tramp-get-local-locale (&optional vec) "Determine locale, supporting UTF8 if possible. commit 70c75167ede4c54bb796187146437120856f890b Author: Allen Li Date: Wed Oct 24 20:48:15 2018 -0600 Add setter for 'xref-marker-ring-length' * lisp/progmodes/xref.el (xref-marker-ring-length): Add setter. * etc/NEWS: Document last change. (Bug#32849) diff --git a/etc/NEWS b/etc/NEWS index 668b59a20a..e5892d718e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -460,6 +460,11 @@ for example. This command finds definitions of the identifier at the place of a mouse click event, and is intended to be bound to a mouse event. ++++ +*** Changing 'xref-marker-ring-length' works after 'xref.el' is loaded. +Previously, setting 'xref-marker-ring-length' would only take effect +if set before 'xref.el' was loaded. + ** Ecomplete *** The ecomplete sorting has changed to a decay-based algorithm. diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 6b1421a6f7..3b449bf9b1 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -317,8 +317,12 @@ backward." ;;; Marker stack (M-. pushes, M-, pops) (defcustom xref-marker-ring-length 16 - "Length of the xref marker ring." - :type 'integer) + "Length of the xref marker ring. +If this variable is not set through Customize, you must call +`xref-set-marker-ring-length' for changes to take effect." + :type 'integer + :initialize #'custom-initialize-default + :set #'xref-set-marker-ring-length) (defcustom xref-prompt-for-identifier '(not xref-find-definitions xref-find-definitions-other-window @@ -354,6 +358,14 @@ elements is negated: these commands will NOT prompt." (defvar xref--marker-ring (make-ring xref-marker-ring-length) "Ring of markers to implement the marker stack.") +(defun xref-set-marker-ring-length (var val) + "Set `xref-marker-ring-length'. +VAR is the symbol `xref-marker-ring-length' and VAL is the new +value." + (set-default var val) + (if (ring-p xref--marker-ring) + (ring-resize xref--marker-ring val))) + (defun xref-push-marker-stack (&optional m) "Add point M (defaults to `point-marker') to the marker stack." (ring-insert xref--marker-ring (or m (point-marker)))) commit 5578112e182e20661783a1fef2c779b8844cf082 Author: Allen Li Date: Wed Oct 24 20:44:01 2018 -0600 Add 'ring-resize' function * lisp/emacs-lisp/ring.el (ring-resize): New function. (Bug#32849) * doc/lispref/sequences.texi (Rings): Document new function 'ring-resize'. * etc/NEWS: Document new function 'ring-resize'. * test/lisp/emacs-lisp/ring-tests.el (ring-test-ring-resize): New tests. diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 554716084e..955ad669b8 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -1777,6 +1777,11 @@ If the ring is full, this function removes the newest element to make room for the inserted element. @end defun +@defun ring-resize ring size +Set the size of @var{ring} to @var{size}. If the new size is smaller, +then the oldest items in the ring are discarded. +@end defun + @cindex fifo data structure If you are careful not to exceed the ring size, you can use the ring as a first-in-first-out queue. For example: diff --git a/etc/NEWS b/etc/NEWS index 7f3e74457d..668b59a20a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1218,6 +1218,10 @@ to mean that it is not known whether DST is in effect. 'json-insert', 'json-parse-string', and 'json-parse-buffer'. These are implemented in C using the Jansson library. ++++ +** New function 'ring-resize'. +'ring-resize' can be used to grow or shrink a ring. + ** Mailcap --- diff --git a/lisp/emacs-lisp/ring.el b/lisp/emacs-lisp/ring.el index 312df6b2de..1b36811f9e 100644 --- a/lisp/emacs-lisp/ring.el +++ b/lisp/emacs-lisp/ring.el @@ -189,17 +189,28 @@ Raise error if ITEM is not in the RING." (defun ring-extend (ring x) "Increase the size of RING by X." (when (and (integerp x) (> x 0)) - (let* ((hd (car ring)) - (length (ring-length ring)) - (size (ring-size ring)) - (old-vec (cddr ring)) - (new-vec (make-vector (+ size x) nil))) - (setcdr ring (cons length new-vec)) - ;; If the ring is wrapped, the existing elements must be written - ;; out in the right order. - (dotimes (j length) - (aset new-vec j (aref old-vec (mod (+ hd j) size)))) - (setcar ring 0)))) + (ring-resize ring (+ x (ring-size ring))))) + +(defun ring-resize (ring size) + "Set the size of RING to SIZE. +If the new size is smaller, then the oldest items in the ring are +discarded." + (when (integerp size) + (let ((length (ring-length ring)) + (new-vec (make-vector size nil))) + (if (= length 0) + (setcdr ring (cons 0 new-vec)) + (let* ((hd (car ring)) + (old-size (ring-size ring)) + (old-vec (cddr ring)) + (copy-length (min size length)) + (copy-hd (mod (+ hd (- length copy-length)) length))) + (setcdr ring (cons copy-length new-vec)) + ;; If the ring is wrapped, the existing elements must be written + ;; out in the right order. + (dotimes (j copy-length) + (aset new-vec j (aref old-vec (mod (+ copy-hd j) old-size)))) + (setcar ring 0)))))) (defun ring-insert+extend (ring item &optional grow-p) "Like `ring-insert', but if GROW-P is non-nil, then enlarge ring. diff --git a/test/lisp/emacs-lisp/ring-tests.el b/test/lisp/emacs-lisp/ring-tests.el index 0b4e3d9a69..9fa36aa3d3 100644 --- a/test/lisp/emacs-lisp/ring-tests.el +++ b/test/lisp/emacs-lisp/ring-tests.el @@ -162,6 +162,43 @@ (should (= (ring-size ring) 5)) (should (equal (ring-elements ring) '(3 2 1))))) +(ert-deftest ring-resize/grow () + (let ((ring (make-ring 3))) + (ring-insert ring 1) + (ring-insert ring 2) + (ring-insert ring 3) + (ring-resize ring 5) + (should (= (ring-size ring) 5)) + (should (equal (ring-elements ring) '(3 2 1))))) + +(ert-deftest ring-resize/grow-empty () + (let ((ring (make-ring 3))) + (ring-resize ring 5) + (should (= (ring-size ring) 5)) + (should (equal (ring-elements ring) '())))) + +(ert-deftest ring-resize/grow-wrapped-ring () + (let ((ring (make-ring 3))) + (ring-insert ring 1) + (ring-insert ring 2) + (ring-insert ring 3) + (ring-insert ring 4) + (ring-insert ring 5) + (ring-resize ring 5) + (should (= (ring-size ring) 5)) + (should (equal (ring-elements ring) '(5 4 3))))) + +(ert-deftest ring-resize/shrink () + (let ((ring (make-ring 5))) + (ring-insert ring 1) + (ring-insert ring 2) + (ring-insert ring 3) + (ring-insert ring 4) + (ring-insert ring 5) + (ring-resize ring 3) + (should (= (ring-size ring) 3)) + (should (equal (ring-elements ring) '(5 4 3))))) + (ert-deftest ring-tests-insert () (let ((ring (make-ring 2))) (ring-insert+extend ring :a) commit 705adc237629a78c10165f9a3b3260cb56242cda Author: Eli Zaretskii Date: Sat Nov 10 11:32:14 2018 +0200 Fix last commit * doc/lispref/os.texi (User Identification): Fix function name of 'group-name'. diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 6d1b3f3dbc..41753859e5 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -1230,9 +1230,9 @@ groups on the system. If Emacs cannot retrieve this information, the return value is @code{nil}. @end defun -@defun user-login-name gid -This runction returns the group name that corresponds to @var{gid}, -or @code{nil} if there is no such group. +@defun group-name gid +This function returns the group name that corresponds to the numeric +group ID @var{gid}, or @code{nil} if there is no such group. @end defun commit d6b7b60cd0b4af8c0760589e132593b5c716d8ce Author: Eli Zaretskii Date: Sat Nov 10 11:16:17 2018 +0200 Fix last change * src/editfns.c (Fgroup_name): Fix the doc string. Move closer to the "group" functions. * src/w32.c (getgrgid): Return NULL if GID is not the group ID of the user of this Emacs session * test/src/editfns-tests.el (test-group-name): Rename from 'group-name'. Add tests for non-Posix hosts. Test error when the argument to group-name is invalid. * etc/NEWS: Fix wording of last added entry. diff --git a/etc/NEWS b/etc/NEWS index c11b9988e4..7f3e74457d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1264,7 +1264,7 @@ uses of this function all but disappeared by now, so we are un-obsoleting it. +++ -** New function 'group-name' returns a group name based on a group-GID +** New function 'group-name' returns a group name corresponding to GID. * Changes in Emacs 27.1 on Non-Free Operating Systems diff --git a/src/editfns.c b/src/editfns.c index 15a0fa7659..8df4ed107e 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -1143,21 +1143,6 @@ of the user with that uid, or nil if there is no such user. */) return (pw ? build_string (pw->pw_name) : Qnil); } -DEFUN ("group-name", Fgroup_name, Sgroup_name, 1, 1, 0, - doc: /* If argument GID is an integer or a float, return the login name -of the group with that gid, or nil if there is no such GID. */) - (Lisp_Object gid) -{ - struct group *gr; - gid_t id; - - CONS_TO_INTEGER (gid, gid_t, id); - block_input (); - gr = getgrgid (id); - unblock_input (); - return (gr ? build_string (gr->gr_name) : Qnil); -} - DEFUN ("user-real-login-name", Fuser_real_login_name, Suser_real_login_name, 0, 0, 0, doc: /* Return the name of the user's real uid, as a string. @@ -1191,6 +1176,24 @@ Value is a fixnum, if it's small enough, otherwise a bignum. */) return INT_TO_INTEGER (uid); } +DEFUN ("group-name", Fgroup_name, Sgroup_name, 1, 1, 0, + doc: /* Return the name of the group whose numeric group ID is GID. +The argument GID should be an integer or a float. +Return nil if a group with such GID does not exists or is not known. */) + (Lisp_Object gid) +{ + struct group *gr; + gid_t id; + + if (!NUMBERP (gid) && !CONSP (gid)) + error ("Invalid GID specification"); + CONS_TO_INTEGER (gid, gid_t, id); + block_input (); + gr = getgrgid (id); + unblock_input (); + return gr ? build_string (gr->gr_name) : Qnil; +} + DEFUN ("group-gid", Fgroup_gid, Sgroup_gid, 0, 0, 0, doc: /* Return the effective gid of Emacs. Value is a fixnum, if it's small enough, otherwise a bignum. */) diff --git a/src/w32.c b/src/w32.c index e643c42150..3eaa1279dd 100644 --- a/src/w32.c +++ b/src/w32.c @@ -2043,7 +2043,9 @@ getpwuid (unsigned uid) struct group * getgrgid (gid_t gid) { - return &dflt_group; + if (gid == dflt_passwd.pw_gid) + return &dflt_group; + return NULL; } struct passwd * diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index 6ee0ab09f7..7b6c990f35 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -351,11 +351,18 @@ (should (equal (format "%-#50.40x" v3) "-0x000000003ffffffffffffffe000000000000000 ")))) -(ert-deftest group-name () - (let ((list `((0 . "root") - (1000 . ,(user-login-name 1000)) - (1212345 . nil)))) - (dolist (test list) - (should (equal (group-name (car test)) (cdr test)))))) +(ert-deftest test-group-name () + (cond + ((memq system-type '(windows-nt ms-dos)) + (should (stringp (group-name (group-gid)))) + (should-not (group-name 123456789)) + (should-error (group-name 'foo))) + (t + (let ((list `((0 . "root") + (1000 . ,(user-login-name 1000)) + (1212345 . nil)))) + (dolist (test list) + (should (equal (group-name (car test)) (cdr test))))) + (should-error (group-name 'foo))))) ;;; editfns-tests.el ends here commit ffb4c76d99ba9d4f5a0d876c23b2837d31291141 Author: Jules Tamagnan Date: Tue Oct 30 10:22:03 2018 -0700 src/editfns.c (group-name): New function. diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index cb33757325..6d1b3f3dbc 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -1230,6 +1230,11 @@ groups on the system. If Emacs cannot retrieve this information, the return value is @code{nil}. @end defun +@defun user-login-name gid +This runction returns the group name that corresponds to @var{gid}, +or @code{nil} if there is no such group. +@end defun + @node Time of Day @section Time of Day diff --git a/etc/NEWS b/etc/NEWS index 29bbde9395..c11b9988e4 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1263,6 +1263,9 @@ where there's no better alternative. We believe that the incorrect uses of this function all but disappeared by now, so we are un-obsoleting it. ++++ +** New function 'group-name' returns a group name based on a group-GID + * Changes in Emacs 27.1 on Non-Free Operating Systems diff --git a/src/editfns.c b/src/editfns.c index e995b38a44..15a0fa7659 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -1143,6 +1143,21 @@ of the user with that uid, or nil if there is no such user. */) return (pw ? build_string (pw->pw_name) : Qnil); } +DEFUN ("group-name", Fgroup_name, Sgroup_name, 1, 1, 0, + doc: /* If argument GID is an integer or a float, return the login name +of the group with that gid, or nil if there is no such GID. */) + (Lisp_Object gid) +{ + struct group *gr; + gid_t id; + + CONS_TO_INTEGER (gid, gid_t, id); + block_input (); + gr = getgrgid (id); + unblock_input (); + return (gr ? build_string (gr->gr_name) : Qnil); +} + DEFUN ("user-real-login-name", Fuser_real_login_name, Suser_real_login_name, 0, 0, 0, doc: /* Return the name of the user's real uid, as a string. @@ -4487,6 +4502,7 @@ it to be non-nil. */); defsubr (&Sinsert_byte); defsubr (&Suser_login_name); + defsubr (&Sgroup_name); defsubr (&Suser_real_login_name); defsubr (&Suser_uid); defsubr (&Suser_real_uid); diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index 17b2c51073..6ee0ab09f7 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -351,4 +351,11 @@ (should (equal (format "%-#50.40x" v3) "-0x000000003ffffffffffffffe000000000000000 ")))) +(ert-deftest group-name () + (let ((list `((0 . "root") + (1000 . ,(user-login-name 1000)) + (1212345 . nil)))) + (dolist (test list) + (should (equal (group-name (car test)) (cdr test)))))) + ;;; editfns-tests.el ends here commit 92296de42bc5805670d083e2518e00251cb1375c Author: Stefan Monnier Date: Fri Nov 9 09:51:54 2018 -0500 * src/data.c (Ftype_of): xwidget objects are possible! (bug#33294) (syms_of_data): Define Qwidget here. * src/xwidget.c (syms_of_xwidget): Instead of here. diff --git a/src/data.c b/src/data.c index 8d58cbd941..0a098c9994 100644 --- a/src/data.c +++ b/src/data.c @@ -276,10 +276,12 @@ for example, (type-of 1) returns `integer'. */) } case PVEC_MODULE_FUNCTION: return Qmodule_function; - /* "Impossible" cases. */ case PVEC_XWIDGET: - case PVEC_OTHER: + return Qxwidget; case PVEC_XWIDGET_VIEW: + return Qxwidget_view; + /* "Impossible" cases. */ + case PVEC_OTHER: case PVEC_SUB_CHAR_TABLE: case PVEC_FREE: ; } @@ -3732,8 +3734,8 @@ syms_of_data (void) DEFSYM (Qmarker, "marker"); DEFSYM (Qoverlay, "overlay"); DEFSYM (Qfinalizer, "finalizer"); -#ifdef HAVE_MODULES DEFSYM (Qmodule_function, "module-function"); +#ifdef HAVE_MODULES DEFSYM (Quser_ptr, "user-ptr"); #endif DEFSYM (Qfloat, "float"); @@ -3756,6 +3758,8 @@ syms_of_data (void) DEFSYM (Qfont_entity, "font-entity"); DEFSYM (Qfont_object, "font-object"); DEFSYM (Qterminal, "terminal"); + DEFSYM (Qxwidget, "xwidget"); + DEFSYM (Qxwidget_view, "xwidget-view"); DEFSYM (Qdefun, "defun"); diff --git a/src/xwidget.c b/src/xwidget.c index 530d1af707..bcc450bac6 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -992,8 +992,6 @@ syms_of_xwidget (void) defsubr (&Sxwidget_buffer); defsubr (&Sset_xwidget_plist); - DEFSYM (Qxwidget, "xwidget"); - DEFSYM (QCxwidget, ":xwidget"); DEFSYM (QCtitle, ":title"); commit 4f0e54223a60a34818365475440e023747eab7e9 Author: Eli Zaretskii Date: Fri Nov 9 11:22:46 2018 +0200 Improve doc strings generated by 'easy-mmode-define-navigation' * lisp/emacs-lisp/easy-mmode.el (easy-mmode-define-navigation): Include the documentation of prefix argument in the generated doc string. diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index d74c3ddb97..035c65b1c0 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -632,7 +632,8 @@ BODY is executed after moving to the destination location." (unless name (setq name base-name)) `(progn (defun ,next-sym (&optional count) - ,(format "Go to the next COUNT'th %s." name) + ,(format "Go to the next COUNT'th %s. +Interactively, COUNT is the prefix numeric argument, and defaults to 1." name) (interactive "p") (unless count (setq count 1)) (if (< count 0) (,prev-sym (- count)) @@ -654,7 +655,9 @@ BODY is executed after moving to the destination location." ,@body)) (put ',next-sym 'definition-name ',base) (defun ,prev-sym (&optional count) - ,(format "Go to the previous COUNT'th %s" (or name base-name)) + ,(format "Go to the previous COUNT'th %s. +Interactively, COUNT is the prefix numeric argument, and defaults to 1." + (or name base-name)) (interactive "p") (unless count (setq count 1)) (if (< count 0) (,next-sym (- count)) commit a3242cc4593a1682f467d00b93670e538171c620 Author: Eli Zaretskii Date: Fri Nov 9 11:13:32 2018 +0200 Improve documentation of Diff mode * doc/emacs/files.texi (Diff Mode): Document the effect of prefix argument on the Diff mode's commands. Document 'diff-jump-to-old-file'. diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 61aa2fc301..9c57bbe267 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -1427,23 +1427,30 @@ manually, type @kbd{M-x diff-mode}. @cindex hunk, diff The changes specified in a patch are grouped into @dfn{hunks}, which are contiguous chunks of text that contain one or more changed lines. -Hunks can also include unchanged lines to provide context for the +Hunks usually also include unchanged lines to provide context for the changes. Each hunk is preceded by a @dfn{hunk header}, which -specifies the old and new line numbers at which the hunk occurs. Diff -mode highlights each hunk header, to distinguish it from the actual -contents of the hunk. +specifies the old and new line numbers where the hunk's changes occur. +Diff mode highlights each hunk header, to distinguish it from the +actual contents of the hunk. + + The first hunk in a patch is preceded by a file header, which shows +the names of the new and the old versions of the file, and their time +stamps. If a patch shows changes for more than one file, each file +has such a header before the first hunk of that file's changes. @vindex diff-update-on-the-fly You can edit a Diff mode buffer like any other buffer. (If it is -read-only, you need to make it writable first. @xref{Misc Buffer}.) -Whenever you change a hunk, Diff mode attempts to automatically -correct the line numbers in the hunk headers, to ensure that the patch -remains correct. To disable automatic line number correction, -change the variable @code{diff-update-on-the-fly} to @code{nil}. - - Diff mode treats each hunk as an error message, similar to -Compilation mode. Thus, you can use commands such as @kbd{C-x `} to -visit the corresponding source locations. @xref{Compilation Mode}. +read-only, you need to make it writable first; see @ref{Misc Buffer}.) +Whenever you edit a hunk, Diff mode attempts to automatically correct +the line numbers in the hunk headers, to ensure that the patch remains +correct, and could still be applied by @command{patch}. To disable +automatic line number correction, change the variable +@code{diff-update-on-the-fly} to @code{nil}. + + Diff mode arranges for hunks to be treated as compiler error +messages by @kbd{C-x `} and other commands that handle error messages +(@pxref{Compilation Mode}). Thus, you can use the compilation-mode +commands to visit the corresponding source locations. In addition, Diff mode provides the following commands to navigate, manipulate and apply parts of patches: @@ -1451,7 +1458,8 @@ manipulate and apply parts of patches: @table @kbd @item M-n @findex diff-hunk-next -Move to the next hunk-start (@code{diff-hunk-next}). +Move to the next hunk-start (@code{diff-hunk-next}). With prefix +argument @var{n}, move forward to the @var{n}th next hunk. @findex diff-auto-refine-mode @cindex mode, Diff Auto-Refine @@ -1469,19 +1477,22 @@ default, add this to your init file (@pxref{Hooks}): @item M-p @findex diff-hunk-prev -Move to the previous hunk-start (@code{diff-hunk-prev}). Like +Move to the previous hunk-start (@code{diff-hunk-prev}). With prefix +argument @var{n}, move back to the @var{n}th previous hunk. Like @kbd{M-n}, this has the side-effect of refining the hunk you move to, unless you disable Diff Auto-Refine mode. @item M-@} @findex diff-file-next Move to the next file-start, in a multi-file patch -(@code{diff-file-next}). +(@code{diff-file-next}). With prefix argument @var{n}, move forward +to the start of the @var{n}th next file. @item M-@{ @findex diff-file-prev Move to the previous file-start, in a multi-file patch -(@code{diff-file-prev}). +(@code{diff-file-prev}). With prefix argument @var{n}, move back to +the start of the @var{n}th previous file. @item M-k @findex diff-hunk-kill @@ -1496,7 +1507,10 @@ In a multi-file patch, kill the current file part. @findex diff-apply-hunk @cindex patches, applying Apply this hunk to its target file (@code{diff-apply-hunk}). With a -prefix argument of @kbd{C-u}, revert this hunk. +prefix argument of @kbd{C-u}, revert this hunk, i.e.@: apply the +reverse of the hunk, which changes the ``new'' version into the ``old'' +version. If @code{diff-jump-to-old-file} is non-@code{nil}, apply the +hunk to the ``old'' version of the file instead. @item C-c C-b @findex diff-refine-hunk @@ -1506,8 +1520,16 @@ of each changed line were actually changed. @item C-c C-c @findex diff-goto-source +@vindex diff-jump-to-old-file Go to the source file and line corresponding to this hunk -(@code{diff-goto-source}). +(@code{diff-goto-source}). By default, this jumps to the ``new'' +version of the file, the one shown first on the file header. +With a prefix argument, jump to the ``old'' version instead. If +@code{diff-jump-to-old-file} is non-@code{nil}, this command by +default jumps to the ``old'' file, and the meaning of the prefix +argument is reversed. If the prefix argument is a number greater than +8 (e.g., if you type @kbd{C-u C-u C-c C-c}), then this command also +sets @code{diff-jump-to-old-file} for the next invocation. @item C-c C-e @findex diff-ediff-patch @@ -1517,41 +1539,47 @@ Start an Ediff session with the patch (@code{diff-ediff-patch}). @item C-c C-n @findex diff-restrict-view Restrict the view to the current hunk (@code{diff-restrict-view}). -@xref{Narrowing}. With a prefix argument of @kbd{C-u}, restrict the +@xref{Narrowing}. With a prefix argument, restrict the view to the current file of a multiple-file patch. To widen again, use @kbd{C-x n w} (@code{widen}). @item C-c C-r @findex diff-reverse-direction Reverse the direction of comparison for the entire buffer -(@code{diff-reverse-direction}). +(@code{diff-reverse-direction}). With a prefix argument, reverse the +direction only inside the current region (@pxref{Mark}). Reversing +the direction means changing the hunks and the file-start headers to +produce a patch that would change the ``new'' version into the ``old'' +one. @item C-c C-s @findex diff-split-hunk -Split the hunk at point (@code{diff-split-hunk}). This is for -manually editing patches, and only works with the @dfn{unified diff -format} produced by the @option{-u} or @option{--unified} options to -the @command{diff} program. If you need to split a hunk in the -@dfn{context diff format} produced by the @option{-c} or -@option{--context} options to @command{diff}, first convert the buffer -to the unified diff format with @kbd{C-c C-u}. +Split the hunk at point (@code{diff-split-hunk}) into two separate +hunks. This inserts a hunk header and modifies the header of the +current hunk. This command is useful for manually editing patches, +and only works with the @dfn{unified diff format} produced by the +@option{-u} or @option{--unified} options to the @command{diff} +program. If you need to split a hunk in the @dfn{context diff format} +produced by the @option{-c} or @option{--context} options to +@command{diff}, first convert the buffer to the unified diff format +with @kbd{C-c C-u}. @item C-c C-d @findex diff-unified->context Convert the entire buffer to the @dfn{context diff format} (@code{diff-unified->context}). With a prefix argument, convert only -the text within the region. +the hunks within the region. @item C-c C-u @findex diff-context->unified Convert the entire buffer to unified diff format (@code{diff-context->unified}). With a prefix argument, convert unified format to context format. When the mark is active, convert -only the text within the region. +only the hunks within the region. @item C-c C-w @findex diff-ignore-whitespace-hunk -Re-diff the current hunk, disregarding changes in whitespace +Re-generate the current hunk, disregarding changes in whitespace (@code{diff-ignore-whitespace-hunk}). @item C-x 4 A @@ -1582,7 +1610,8 @@ that whitespace in both the patch and the patched source file(s). This command does not save the modifications that it makes, so you can decide whether to save the changes (the list of modified files is displayed in the echo area). With a prefix argument, it tries to -modify the original source files rather than the patched source files. +modify the original (``old'') source files rather than the patched +(``new'') source files. @node Copying and Naming @section Copying, Naming and Renaming Files commit 39e85a0c6c8de75b446e8e4dc41cdfdca96907e3 Author: Noam Postavsky Date: Mon Oct 29 19:01:07 2018 -0400 Note that lex bound lambda forms are not self-quoting (Bug#33199) * doc/lispref/functions.texi (Anonymous Functions): * lisp/subr.el (lambda): Note that under lexical binding a lambda form yields a closure object (Bug#33199). diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 242d754dea..216666c713 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -1082,15 +1082,18 @@ This macro returns an anonymous function with argument list @var{args}, documentation string @var{doc} (if any), interactive spec @var{interactive} (if any), and body forms given by @var{body}. -In effect, this macro makes @code{lambda} forms self-quoting: -evaluating a form whose @sc{car} is @code{lambda} yields the form -itself: +Under dynamic binding, this macro effectively makes @code{lambda} +forms self-quoting: evaluating a form whose @sc{car} is @code{lambda} +yields the form itself: @example (lambda (x) (* x x)) @result{} (lambda (x) (* x x)) @end example +Note that when evaluting under lexical binding the result is a closure +object (@pxref{Closures}). + The @code{lambda} form has one other effect: it tells the Emacs evaluator and byte-compiler that its argument is a function, by using @code{function} as a subroutine (see below). diff --git a/lisp/subr.el b/lisp/subr.el index 59f6949b21..d09789340f 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -93,12 +93,13 @@ Info node `(elisp)Specification List' for details." `(put (quote ,symbol) 'edebug-form-spec (quote ,spec))) (defmacro lambda (&rest cdr) - "Return a lambda expression. -A call of the form (lambda ARGS DOCSTRING INTERACTIVE BODY) is -self-quoting; the result of evaluating the lambda expression is the -expression itself. The lambda expression may then be treated as a -function, i.e., stored as the function value of a symbol, passed to -`funcall' or `mapcar', etc. + "Return an anonymous function. +Under dynamic binding, a call of the form (lambda ARGS DOCSTRING +INTERACTIVE BODY) is self-quoting; the result of evaluating the +lambda expression is the expression itself. Under lexical +binding, the result is a closure. Regardless, the result is a +function, i.e., it may be stored as the function value of a +symbol, passed to `funcall' or `mapcar', etc. ARGS should take the same form as an argument list for a `defun'. DOCSTRING is an optional documentation string. commit f3345dee4b40293547d10963c6cb242a62e424ba Author: Pierre-Yves Luyten Date: Sat Oct 13 22:06:41 2018 +0200 Add functions to open a bookmark in another frame * lisp/bookmark.el (bookmark-jump-other-frame): New function. Bind in bookmark-map. (bookmark-bmenu-other-frame): New function. Bind in bookmark-bmenu-mode-map. Patch applied by Karl Fogel. diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 58a279473d..15a841e208 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -209,6 +209,7 @@ A non-nil value may result in truncated bookmark names." (define-key map "j" 'bookmark-jump) (define-key map "g" 'bookmark-jump) ;"g"o (define-key map "o" 'bookmark-jump-other-window) + (define-key map "5" 'bookmark-jump-other-frame) (define-key map "i" 'bookmark-insert) (define-key map "e" 'edit-bookmarks) (define-key map "f" 'bookmark-insert-location) ;"f"ind @@ -1124,6 +1125,14 @@ DISPLAY-FUNC would be `switch-to-buffer-other-window'." bookmark-current-bookmark))) (bookmark-jump bookmark 'switch-to-buffer-other-window)) +;;;###autoload +(defun bookmark-jump-other-frame (bookmark) + "Jump to BOOKMARK in another frame. See `bookmark-jump' for more." + (interactive + (list (bookmark-completing-read "Jump to bookmark (in another frame)" + bookmark-current-bookmark))) + (let ((pop-up-frames t)) + (bookmark-jump-other-window bookmark))) (defun bookmark-jump-noselect (bookmark) "Return the location pointed to by BOOKMARK (see `bookmark-jump'). @@ -1561,6 +1570,7 @@ unique numeric suffixes \"<2>\", \"<3>\", etc." (set-keymap-parent map special-mode-map) (define-key map "v" 'bookmark-bmenu-select) (define-key map "w" 'bookmark-bmenu-locate) + (define-key map "5" 'bookmark-bmenu-other-frame) (define-key map "2" 'bookmark-bmenu-2-window) (define-key map "1" 'bookmark-bmenu-1-window) (define-key map "j" 'bookmark-bmenu-this-window) @@ -1702,6 +1712,7 @@ Bookmark names preceded by a \"*\" have annotations. \\[bookmark-bmenu-this-window] -- select this bookmark in place of the bookmark menu buffer. \\[bookmark-bmenu-other-window] -- select this bookmark in another window, so the bookmark menu bookmark remains visible in its window. +\\[bookmark-bmenu-other-frame] -- select this bookmark in another frame. \\[bookmark-bmenu-switch-other-window] -- switch the other window to this bookmark. \\[bookmark-bmenu-rename] -- rename this bookmark (prompts for new name). \\[bookmark-bmenu-relocate] -- relocate this bookmark's file (prompts for new file). @@ -1971,6 +1982,13 @@ With a prefix arg, prompts for a file to save them in." (bookmark--jump-via bookmark 'switch-to-buffer-other-window))) +(defun bookmark-bmenu-other-frame () + "Select this line's bookmark in other frame." + (interactive) + (let ((bookmark (bookmark-bmenu-bookmark)) + (pop-up-frames t)) + (bookmark-jump-other-window bookmark))) + (defun bookmark-bmenu-switch-other-window () "Make the other window select this line's bookmark. The current window remains selected." commit 3450970dacd73506ef3d6eed6709375be5ccf2b6 Author: Juri Linkov Date: Thu Nov 8 23:27:49 2018 +0200 * lisp/windmove.el (windmove-create-window): New defcustom (bug#32790). (windmove-do-window-select): Use it. diff --git a/etc/NEWS b/etc/NEWS index 1020a2a0ea..29bbde9395 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -292,6 +292,11 @@ In the current follow group of windows, "ghost" cursors are no longer displayed in the non-selected follow windows. To get the old behavior back, customize follow-hide-ghost-cursors to nil. +** Windmove + +*** windmove-create-window when non-nil makes a new window on moving off +the edge of the frame. + ** Octave mode The mode is automatically enabled in files that start with the 'function' keyword. diff --git a/lisp/windmove.el b/lisp/windmove.el index 42e10b591f..598e495c7a 100644 --- a/lisp/windmove.el +++ b/lisp/windmove.el @@ -149,6 +149,15 @@ is inactive." :type 'boolean :group 'windmove) +(defcustom windmove-create-window nil + "Whether movement off the edge of the frame creates a new window. +If this variable is set to t, moving left from the leftmost window in +a frame will create a new window on the left, and similarly for the other +directions." + :type 'boolean + :group 'windmove + :version "27.1") + ;; If your Emacs sometimes places an empty column between two adjacent ;; windows, you may wish to set this delta to 2. (defcustom windmove-window-distance-delta 1 @@ -471,8 +480,15 @@ DIR, ARG, and WINDOW are handled as by `windmove-other-window-loc'." (defun windmove-do-window-select (dir &optional arg window) "Move to the window at direction DIR. DIR, ARG, and WINDOW are handled as by `windmove-other-window-loc'. -If no window is at direction DIR, an error is signaled." +If no window is at direction DIR, an error is signaled. +If `windmove-create-window' is non-nil, instead of signalling an error +it creates a new window at direction DIR ." (let ((other-window (windmove-find-other-window dir arg window))) + (when (and windmove-create-window + (or (null other-window) + (and (window-minibuffer-p other-window) + (not (minibuffer-window-active-p other-window))))) + (setq other-window (split-window window nil dir))) (cond ((null other-window) (user-error "No window %s from selected window" dir)) ((and (window-minibuffer-p other-window) @@ -493,7 +509,8 @@ With no prefix argument, or with prefix argument equal to zero, \"left\" is relative to the position of point in the window; otherwise it is relative to the top edge (for positive ARG) or the bottom edge \(for negative ARG) of the current window. -If no window is at the desired location, an error is signaled." +If no window is at the desired location, an error is signaled +unless `windmove-create-window' is non-nil that creates a new window." (interactive "P") (windmove-do-window-select 'left arg)) @@ -504,7 +521,8 @@ With no prefix argument, or with prefix argument equal to zero, \"up\" is relative to the position of point in the window; otherwise it is relative to the left edge (for positive ARG) or the right edge (for negative ARG) of the current window. -If no window is at the desired location, an error is signaled." +If no window is at the desired location, an error is signaled +unless `windmove-create-window' is non-nil that creates a new window." (interactive "P") (windmove-do-window-select 'up arg)) @@ -515,7 +533,8 @@ With no prefix argument, or with prefix argument equal to zero, \"right\" is relative to the position of point in the window; otherwise it is relative to the top edge (for positive ARG) or the bottom edge (for negative ARG) of the current window. -If no window is at the desired location, an error is signaled." +If no window is at the desired location, an error is signaled +unless `windmove-create-window' is non-nil that creates a new window." (interactive "P") (windmove-do-window-select 'right arg)) @@ -526,7 +545,8 @@ With no prefix argument, or with prefix argument equal to zero, \"down\" is relative to the position of point in the window; otherwise it is relative to the left edge (for positive ARG) or the right edge \(for negative ARG) of the current window. -If no window is at the desired location, an error is signaled." +If no window is at the desired location, an error is signaled +unless `windmove-create-window' is non-nil that creates a new window." (interactive "P") (windmove-do-window-select 'down arg)) commit fa605f242eec680b2c7d1374d1405510818d9103 Author: Martin Rudalics Date: Thu Nov 8 20:20:13 2018 +0100 Rewrite buffer display related doc-strings and doc * lisp/window.el (display-buffer-overriding-action) (display-buffer-alist, display-buffer-base-action) (display-buffer-fallback-action, display-buffer-assq-regexp) (display-buffer): Rewrite doc-strings using suggestions by Alan Mackenzie . (display-buffer-use-some-frame): Adjust doc-string and reformat code. * doc/lispref/windows.texi (Buffer Display Action Alists): Make docs on 'window-height', 'window-width' and 'preserve-size' entries more accurate. diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 640c9923e9..106074e13d 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -2747,8 +2747,8 @@ the buffer. This entry is used by @vindex reusable-frames@r{, a buffer display action alist entry} @item reusable-frames -The value specifies the frame(s) to search for a window that can be -reused because it already displays the buffer. It can be set as +The value specifies the set of frames to search for a window that can +be reused because it already displays the buffer. It can be set as follows: @itemize @bullet @@ -2792,17 +2792,20 @@ entry. @vindex window-height@r{, a buffer display action alist entry} @item window-height The value specifies whether and how to adjust the height of the chosen -window, and can have the following values: +window and can be one of the following: @itemize @bullet @item @code{nil} means to leave the height of the chosen window alone. @item -A number specifies the desired height of the chosen window. An -integer specifies the number of lines of the window. A floating-point -number gives the fraction of the window's height with respect to the -height of the frame's root window. +An integer number specifies the desired total height of the chosen +window in lines. + +@item +A floating-point number specifies the fraction of the chosen window's +desired total height with respect to the total height of its frame's +root window. @item If the value specifies a function, that function is called with one @@ -2812,7 +2815,11 @@ are @code{shrink-window-if-larger-than-buffer} and @code{fit-window-to-buffer}, see @ref{Resizing Windows}. @end itemize -All action functions that choose a window should process this entry. +By convention, the height of the chosen window is adjusted only if the +window is part of a vertical combination (@pxref{Windows and Frames}) +to avoid changing the height of other, unrelated windows. Also, this +entry should be processed only under certain conditions which are +specified right below this list. @vindex window-width@r{, a buffer display action alist entry} @item window-width @@ -2825,10 +2832,13 @@ value can be one of the following: @code{nil} means to leave the width of the chosen window alone. @item -A number specifies the desired width of the chosen window. An integer -specifies the number of columns of the window. A floating-point -number gives the fraction of the window's width with respect to the -width of the frame's root window. +An integer specifies the desired total width of the chosen window in +columns. + +@item +A floating-point number specifies the fraction of the chosen window's +desired total width with respect to the total width of the frame's +root window. @item If the value specifies a function, that function is called with one @@ -2836,16 +2846,21 @@ argument---the chosen window. The function is supposed to adjust the width of the window; its return value is ignored. @end itemize -All action functions that choose a window should process this entry. +By convention, the width of the chosen window is adjusted only if the +window is part of a horizontal combination (@pxref{Windows and +Frames}) to avoid changing the width of other, unrelated windows. +Also, this entry should be processed under only certain conditions +which are specified right below this list. @vindex preserve-size@r{, a buffer display action alist entry} @item preserve-size If non-@code{nil} such an entry tells Emacs to preserve the size of the window chosen (@pxref{Preserving Window Sizes}). The value should -be either @code{(t . nil)} to preserve the width of the window, -@code{(nil . t)} to preserve its height or @code{(t . t)} to preserve -both its width and its height. All action functions that choose a -window should process this entry. +be either @w{@code{(t . nil)}} to preserve the width of the window, +@w{@code{(nil . t)}} to preserve its height or @w{@code{(t . t)}} to +preserve both, its width and its height. This entry should be +processed only under certain conditions which are specified right +after this list. @vindex pop-up-frame-parameters@r{, a buffer display action alist entry} @item pop-up-frame-parameters @@ -2900,6 +2915,15 @@ will display the buffer. @code{display-buffer-no-window} is the only action function that cares about this entry. @end table +By convention, the entries @code{window-height}, @code{window-width} +and @code{preserve-size} are applied after the chosen window's buffer +has been set up and if and only if that window never showed another +buffer before. More precisely, the latter means that the window must +have been either created by the current @code{display-buffer} call or +the window was created earlier by @code{display-buffer} to show the +buffer and never was used to show another buffer until it was reused +by the current invocation of @code{display-buffer}. + @node Choosing Window Options @subsection Additional Options for Displaying Buffers diff --git a/lisp/window.el b/lisp/window.el index f96c887be4..92cd8c2738 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -6705,7 +6705,11 @@ live." ((or (eq type 'frame) (and (eq (car quit-restore) 'same) (eq (nth 1 quit-restore) 'frame))) - ;; Adjust size of frame if asked for. + ;; A window that never showed another buffer but BUFFER ever + ;; since it was created on a new frame. + ;; + ;; Adjust size of frame if asked for. We probably should do + ;; that only for a single window frame. (cond ((not size)) ((consp size) @@ -6724,7 +6728,10 @@ live." ((or (eq type 'window) (and (eq (car quit-restore) 'same) (eq (nth 1 quit-restore) 'window))) - ;; Adjust height of window if asked for. + ;; A window that never showed another buffer but BUFFER ever + ;; since it was created on an existing frame. + ;; + ;; Adjust width and/or height of window if asked for. (cond ((not height)) ((numberp height) @@ -6820,31 +6827,41 @@ The actual non-nil value of this variable will be copied to the "Custom type for `display-buffer' actions.") (defvar display-buffer-overriding-action '(nil . nil) - "User-defined overriding action to perform to display a buffer. -This action overrides all the other actions in the action variables -and arguments passed to `display-buffer'. -Value should be a cons cell (FUNCTION . ALIST), where FUNCTION is -a function or a list of functions. Each function should accept -two arguments: a buffer to display and an alist similar to ALIST. -The default value is empty. -See `display-buffer' for details.") + "Overriding action for buffer display. +This action overrides all the other actions in the action +variables and arguments passed to `display-buffer'. The value +should be a cons cell (FUNCTIONS . ALIST), where FUNCTIONS is a +function or a list of functions. Each function should accept two +arguments: a buffer to display and an alist similar to ALIST. +See `display-buffer' for details. + +This variable is not intended for user customization. Lisp +programs should never set this variable permanently but may bind +it around calls of buffer display functions like `display-buffer' +or `pop-to-buffer'. Since such a binding will affect any nested +buffer display requests, this variable should be used with utmost +care.") (put 'display-buffer-overriding-action 'risky-local-variable t) (defcustom display-buffer-alist nil "Alist of user-defined conditional actions for `display-buffer'. -Its value takes effect before `display-buffer-base-action' -and `display-buffer-fallback-action', but after +Its value takes effect before processing the ACTION argument of +`display-buffer' and before `display-buffer-base-action' and +`display-buffer-fallback-action', but after `display-buffer-overriding-action', which see. -If non-nil, this is a list of elements (CONDITION . ACTION), where: + +If non-nil, this is an alist of elements (CONDITION . ACTION), +where: CONDITION is either a regexp matching buffer names, or a function that takes two arguments - a buffer name and the ACTION argument of `display-buffer' - and returns a boolean. - ACTION is a cons cell (FUNCTION . ALIST), where FUNCTION is a - function or a list of functions. Each such function should - accept two arguments: a buffer to display and an alist of the - same form as ALIST. See `display-buffer' for details. + ACTION is a cons cell (FUNCTIONS . ALIST), where FUNCTIONS is an + action function or a list of action functions and ALIST is an + action alist. Each such action function should accept two + arguments: a buffer to display and an alist of the same form as + ALIST. See `display-buffer' for details. `display-buffer' scans this alist until it either finds a matching regular expression or the function specified by a @@ -6864,11 +6881,12 @@ associated action to the list of actions it will try." This is the default action used by `display-buffer' if no other actions are specified or all fail, before falling back on `display-buffer-fallback-action'. -It should be a cons cell (FUNCTION . ALIST), where FUNCTION is a -function or a list of functions. Each function should accept two -arguments: a buffer to display and an alist similar to ALIST. -The default value is empty. -See `display-buffer' for details." + +It should be a cons cell (FUNCTIONS . ALIST), where FUNCTIONS is +an action function or a list of action functions and ALIST is an +action alist. Each such action function should accept two +arguments: a buffer to display and an alist of the same form as +ALIST. See `display-buffer' for details." :type display-buffer--action-custom-type :risky t :version "24.1" @@ -6884,17 +6902,20 @@ See `display-buffer' for details." display-buffer-pop-up-frame)) "Default fallback action for `display-buffer'. This is the action used by `display-buffer' if no other actions -specified, e.g. by the user options `display-buffer-alist' or -`display-buffer-base-action', or they all fail. See `display-buffer'.") +have been specified, for example, by the user options +`display-buffer-alist' or `display-buffer-base-action', or they +all fail. It should never be set by programs or users. See +`display-buffer'.") (put 'display-buffer-fallback-action 'risky-local-variable t) (defun display-buffer-assq-regexp (buffer-name alist action) "Retrieve ALIST entry corresponding to BUFFER-NAME. -This returns the cdr of the ALIST entry if either its key is a -string that matches BUFFER-NAME, as reported by `string-match-p'; -or if the key is a function that returns a non-nil when called -with 3 arguments: the ALIST key, BUFFER-NAME, and ACTION. -ACTION should have the form of the action argument passed to `display-buffer'." +This returns the cdr of the alist entry ALIST if either its key +is a string that matches BUFFER-NAME, as reported by +`string-match-p'; or if the key is a function that returns +non-nil when called with three arguments: the ALIST key, +BUFFER-NAME and ACTION. ACTION should have the form of the +action argument passed to `display-buffer'." (catch 'match (dolist (entry alist) (let ((key (car entry))) @@ -6923,100 +6944,99 @@ fails, call `display-buffer-pop-up-frame'.") (defun display-buffer (buffer-or-name &optional action frame) "Display BUFFER-OR-NAME in some window, without selecting it. -BUFFER-OR-NAME must be a buffer or the name of an existing -buffer. Return the window chosen for displaying BUFFER-OR-NAME, -or nil if no such window is found. - -Optional argument ACTION, if non-nil, should specify a display -action. Its form is described below. - -Optional argument FRAME, if non-nil, acts like an additional -ALIST entry (reusable-frames . FRAME) to the action list of ACTION, -specifying the frame(s) to search for a window that is already -displaying the buffer. See `display-buffer-reuse-window'. - -If ACTION is non-nil, it should have the form (FUNCTION . ALIST), -where FUNCTION is either a function or a list of functions, and -ALIST is an arbitrary association list (alist). - -Each such function should accept two arguments: the buffer to -display and an alist. Based on those arguments, it should -display the buffer and return the window. If the caller is -prepared to handle the case of not displaying the buffer -and returning nil from `display-buffer' it should pass -\(allow-no-window . t) as an element of the ALIST. - -The `display-buffer' function builds a function list and an alist -by combining the functions and alists specified in +BUFFER-OR-NAME must be a buffer or a string naming a live buffer. +Return the window chosen for displaying that buffer, or nil if no +such window is found. + +Optional argument ACTION, if non-nil, should specify a buffer +display action of the form (FUNCTIONS . ALIST). FUNCTIONS is +either an \"action function\" or a possibly empty list of action +functions. ALIST is a possibly empty \"action alist\". + +An action function is a function that accepts two arguments: the +buffer to display and an action alist. Based on those arguments, +it should try to display the buffer in a window and return that +window. An action alist is an association list mapping symbols +to values. Action functions use the action alist passed to them +to fine-tune their behaviors. + +`display-buffer' builds a list of action functions and an action +alist by combining any action functions and alists specified by `display-buffer-overriding-action', `display-buffer-alist', the ACTION argument, `display-buffer-base-action', and `display-buffer-fallback-action' (in order). Then it calls each function in the combined function list in turn, passing the -buffer as the first argument and the combined alist as the second -argument, until one of the functions returns non-nil. - -If ACTION is nil, the function list and the alist are built using -only the other variables mentioned above. - -Available action functions include: - `display-buffer-same-window' - `display-buffer-reuse-window' - `display-buffer-pop-up-frame' - `display-buffer-in-child-frame' - `display-buffer-pop-up-window' - `display-buffer-in-previous-window' - `display-buffer-use-some-window' - `display-buffer-use-some-frame' - -Recognized alist entries include: - - `inhibit-same-window' -- A non-nil value prevents the same - window from being used for display. - - `inhibit-switch-frame' -- A non-nil value prevents any other - frame from being raised or selected, - even if the window is displayed there. - - `reusable-frames' -- Value specifies frame(s) to search for a - window that already displays the buffer. - See `display-buffer-reuse-window'. - - `pop-up-frame-parameters' -- Value specifies an alist of frame - parameters to give a new frame, if - one is created. - - `window-height' -- Value specifies either an integer (the number - of lines of a new window), a floating point number (the - fraction of a new window with respect to the height of the - frame's root window) or a function to be called with one - argument - a new window. The function is supposed to adjust - the height of the window; its return value is ignored. - Suitable functions are `shrink-window-if-larger-than-buffer' - and `fit-window-to-buffer'. - - `window-width' -- Value specifies either an integer (the number - of columns of a new window), a floating point number (the - fraction of a new window with respect to the width of the - frame's root window) or a function to be called with one - argument - a new window. The function is supposed to adjust - the width of the window; its return value is ignored. - - `allow-no-window' -- A non-nil value indicates readiness for the case - of not displaying the buffer and FUNCTION can safely return - a non-window value to suppress displaying. - - `preserve-size' -- Value should be either (t . nil) to - preserve the width of the window, (nil . t) to preserve its - height or (t . t) to preserve both. - - `window-parameters' -- Value specifies an alist of window - parameters to give the chosen window. - -The ACTION argument to `display-buffer' can also have a non-nil -and non-list value. This means to display the buffer in a window -other than the selected one, even if it is already displayed in -the selected window. If called interactively with a prefix -argument, ACTION is t." +buffer as the first argument and the combined action alist as the +second argument, until one of the functions returns non-nil. + +Action functions and the action they try to perform are: + `display-buffer-same-window' -- Use the selected window. + `display-buffer-reuse-window' -- Use a window already showing + the buffer. + `display-buffer-in-previous-window' -- Use a window that did + show the buffer before. + `display-buffer-use-some-window' -- Use some existing window. + `display-buffer-pop-up-window' -- Pop up a new window. + `display-buffer-below-selected' -- Use or pop up a window below + the selected one. + `display-buffer-at-bottom' -- Use or pop up a window at the + bottom of the selected frame. + `display-buffer-pop-up-frame' -- Show the buffer on a new frame. + `display-buffer-in-child-frame' -- Show the buffer in a + child frame. + `display-buffer-no-window' -- Do not display the buffer and + have `display-buffer' return nil immediately. + +Action alist entries are: + 'inhibit-same-window' -- A non-nil value prevents the same + window from being used for display. + 'inhibit-switch-frame' -- A non-nil value prevents any frame + used for showing the buffer from being raised or selected. + 'reusable-frames' -- The value specifies the set of frames to + search for a window that already displays the buffer. + Possible values are nil (the selected frame), t (any live + frame), visible (any visible frame), 0 (any visible or + iconified frame) or an existing live frame. + 'pop-up-frame-parameters' -- The value specifies an alist of + frame parameters to give a new frame, if one is created. + 'window-height' -- The value specifies the desired height of the + window chosen and is either an integer (the total height of + the window), a floating point number (the fraction of its + total height with respect to the total height of the frame's + root window) or a function to be called with one argument - + the chosen window. The function is supposed to adjust the + height of the window; its return value is ignored. Suitable + functions are `shrink-window-if-larger-than-buffer' and + `fit-window-to-buffer'. + 'window-width' -- The value specifies the desired width of the + window chosen and is either an integer (the total width of + the window), a floating point number (the fraction of its + total width with respect to the width of the frame's root + window) or a function to be called with one argument - the + chosen window. The function is supposed to adjust the width + of the window; its return value is ignored. + 'preserve-size' -- The value should be either (t . nil) to + preserve the width of the chosen window, (nil . t) to + preserve its height or (t . t) to preserve its height and + width in future changes of the window configuration. + 'window-parameters' -- The value specifies an alist of window + parameters to give the chosen window. + 'allow-no-window' -- A non-nil value means that `display-buffer' + may not display the buffer and return nil immediately. + +The entries 'window-height', 'window-width' and 'preserve-size' +are applied only when the window used for displaying the buffer +never showed another buffer before. + +The ACTION argument can also have a non-nil and non-list value. +This means to display the buffer in a window other than the +selected one, even if it is already displayed in the selected +window. If called interactively with a prefix argument, ACTION +is t. Non-interactive calls should always supply a list or nil. + +The optional third argument FRAME, if non-nil, acts like a +\(reusable-frames . FRAME) entry appended to the action alist +specified by the ACTION argument." (interactive (list (read-buffer "Display buffer: " (other-buffer)) (if current-prefix-arg t))) (let ((buffer (if (bufferp buffer-or-name) @@ -7074,9 +7094,10 @@ its documentation for additional customization information." ;;; `display-buffer' action functions: (defun display-buffer-use-some-frame (buffer alist) - "Display BUFFER in an existing frame that meets a predicate -\(by default any frame other than the current frame). If -successful, return the window used; otherwise return nil. + "Display BUFFER in an existing frame that meets a predicate. +The default predicate is to use any frame other than the selected +frame. If successful, return the window used; otherwise return +nil. If ALIST has a non-nil `inhibit-switch-frame' entry, avoid raising the frame. @@ -7089,17 +7110,18 @@ predicate. If ALIST has a non-nil `inhibit-same-window' entry, avoid using the currently selected window (only useful with a frame-predicate that allows the selected frame)." - (let* ((predicate (or (cdr (assq 'frame-predicate alist)) - (lambda (frame) - (and - (not (eq frame (selected-frame))) - (not (window-dedicated-p - (or - (get-lru-window frame) - (frame-first-window frame))))) - ))) + (let* ((predicate + (or (cdr (assq 'frame-predicate alist)) + (lambda (frame) + (and (not (eq frame (selected-frame))) + (not (window-dedicated-p + (or (get-lru-window frame) + (frame-first-window frame)))))))) (frame (car (filtered-frame-list predicate))) - (window (and frame (get-lru-window frame nil (cdr (assq 'inhibit-same-window alist)))))) + (window + (and frame + (get-lru-window + frame nil (cdr (assq 'inhibit-same-window alist)))))) (when window (prog1 (window--display-buffer commit 48f6f28132c97b92c0083479a0dfcefd6d0d022f Author: Michael Albinus Date: Thu Nov 8 12:48:54 2018 +0100 * doc/misc/tramp.texi (Password handling): Explain Ange FTP case. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index a0b65d58b5..874c1da1d9 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -1669,6 +1669,16 @@ by setting the user option @code{auth-source-save-behavior} to @code{nil}. @vindex auth-source-debug Set @code{auth-source-debug} to @code{t} to debug messages. +@vindex ange-ftp-netrc-filename +@strong{Note} that @file{auth-source.el} is not used for @option{ftp} +connections, because @value{tramp} passes the work to Ange FTP. If +you want, for example, use your @file{~/.authinfo.gpg} authentication +file, you must customize @code{ange-ftp-netrc-filename}: + +@lisp +(customize-set-variable 'ange-ftp-netrc-filename "~/.authinfo.gpg") +@end lisp + @anchor{Caching passwords} @subsection Caching passwords @@ -4036,7 +4046,7 @@ export EDITOR=/path/to/emacsclient.sh @item -How to determine wheter a buffer is remote? +How to determine whether a buffer is remote? The buffer-local variable @code{default-directory} tells this. If the form @code{(file-remote-p default-directory)} returns non-@code{nil}, commit b61f6c9ac01b189c89bfba80885b6222746d6bc5 Author: Michael Albinus Date: Thu Nov 8 12:21:48 2018 +0100 Get rid of own netrc parsing implementation in Tramp * lisp/net/tramp.el (tramp-parse-netrc): Reimplement, using `netrc-parse'. (tramp-parse-netrc-group): Remove. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 34489b1242..4ee69d7198 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -60,6 +60,7 @@ ;; Pacify byte-compiler. (require 'cl-lib) +(declare-function netrc-parse "netrc") (defvar auto-save-file-name-transforms) (defvar eshell-path-env) (defvar ls-lisp-use-insert-directory-program) @@ -2970,20 +2971,11 @@ Host is always \"localhost\"." (defun tramp-parse-netrc (filename) "Return a list of (user host) tuples allowed to access. User may be nil." - (tramp-parse-file filename 'tramp-parse-netrc-group)) - -(defun tramp-parse-netrc-group () - "Return a (user host) tuple allowed to access. -User may be nil." - (let ((result) - (regexp - (concat - "^[ \t]*machine[ \t]+" "\\(" tramp-host-regexp "\\)" - "\\([ \t]+login[ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?"))) - (when (re-search-forward regexp (point-at-eol) t) - (setq result (list (match-string 3) (match-string 1)))) - (forward-line 1) - result)) + (mapcar + (lambda (item) + (and (assoc "machine" item) + `(,(cdr (assoc "login" item)) ,(cdr (assoc "machine" item))))) + (netrc-parse filename))) ;;;###tramp-autoload (defun tramp-parse-putty (registry-or-dirname) commit 6b7e492f6cf7fd2cb7e02320224a615952fffc58 Author: Juri Linkov Date: Thu Nov 8 00:52:50 2018 +0200 Support VC single file operations from Dired (bug#32596). * lisp/vc/vc.el (vc-ensure-vc-buffer): Use dired-get-filename for dired-mode. Move error-checking outside of the last branch of cond. (vc-dired-deduce-fileset): Remove unused error signaling. diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 57bc3c2fc7..dcfbf26e86 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1061,27 +1061,27 @@ BEWARE: this function may change the current buffer." (t (error "File is not under version control"))))) (defun vc-dired-deduce-fileset () - (let ((backend (vc-responsible-backend default-directory))) - (unless backend (error "Directory not under VC")) - (list backend - (dired-map-over-marks (dired-get-filename nil t) nil)))) + (list (vc-responsible-backend default-directory) + (dired-map-over-marks (dired-get-filename nil t) nil))) (defun vc-ensure-vc-buffer () "Make sure that the current buffer visits a version-controlled file." (cond ((derived-mode-p 'vc-dir-mode) (set-buffer (find-file-noselect (vc-dir-current-file)))) + ((derived-mode-p 'dired-mode) + (set-buffer (find-file-noselect (dired-get-filename)))) (t (while (and vc-parent-buffer (buffer-live-p vc-parent-buffer) ;; Avoid infinite looping when vc-parent-buffer and ;; current buffer are the same buffer. (not (eq vc-parent-buffer (current-buffer)))) - (set-buffer vc-parent-buffer)) - (if (not buffer-file-name) - (error "Buffer %s is not associated with a file" (buffer-name)) - (unless (vc-backend buffer-file-name) - (error "File %s is not under version control" buffer-file-name)))))) + (set-buffer vc-parent-buffer)))) + (if (not buffer-file-name) + (error "Buffer %s is not associated with a file" (buffer-name)) + (unless (vc-backend buffer-file-name) + (error "File %s is not under version control" buffer-file-name)))) ;;; Support for the C-x v v command. ;; This is where all the single-file-oriented code from before the fileset commit 7aa5056b574a4bf05a2cbf629f173e6d94e125da Author: Juri Linkov Date: Thu Nov 8 00:42:28 2018 +0200 * lisp/vc/log-view.el: Better error handling (bug#33295). * lisp/vc/log-view.el (log-view-find-revision) (log-view-annotate-version): Add condition to signal an error when log-view-vc-fileset contains a directory. Use user-error instead of error. * lisp/dired.el (dired-get-file-for-visit): * lisp/locate.el (locate-do-setup): Use user-error instead of error. diff --git a/lisp/dired.el b/lisp/dired.el index f2f2b76eb7..cbd85fed91 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -2219,7 +2219,7 @@ directory in another window." (let ((raw (dired-get-filename nil t)) file-name) (if (null raw) - (error "No file on this line")) + (user-error "No file on this line")) (setq file-name (file-name-sans-versions raw t)) (if (file-exists-p file-name) file-name diff --git a/lisp/locate.el b/lisp/locate.el index d2e640e884..81e9696a0d 100644 --- a/lisp/locate.el +++ b/lisp/locate.el @@ -499,9 +499,9 @@ do not work in subdirectories. (progn (kill-buffer locate-buffer-name) (if locate-current-filter - (error "Locate: no match for %s in database using filter %s" + (user-error "Locate: no match for %s in database using filter %s" search-string locate-current-filter) - (error "Locate: no match for %s in database" search-string)))) + (user-error "Locate: no match for %s in database" search-string)))) (locate-insert-header search-string) diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el index 6ff50dcde5..bfb31ccdab 100644 --- a/lisp/vc/log-view.el +++ b/lisp/vc/log-view.el @@ -217,7 +217,7 @@ If it is nil, `log-view-toggle-entry-display' does nothing.") The match group number 1 should match the file name itself.") (defvar log-view-per-file-logs t - "Set if to t if the logs are shown one file at a time.") + "Set to t if the logs are shown one file at a time.") (defvar log-view-message-re (concat "^\\(?:revision \\(?1:[.0-9]+\\)\\(?:\t.*\\)?" ; RCS and CVS. @@ -517,8 +517,10 @@ Works like `end-of-defun'." If called interactively, visit the version at point." (interactive "d") (unless log-view-per-file-logs - (when (> (length log-view-vc-fileset) 1) - (error "Multiple files shown in this buffer, cannot use this command here"))) + (when (or (> (length log-view-vc-fileset) 1) + (null (car log-view-vc-fileset)) + (file-directory-p (car log-view-vc-fileset))) + (user-error "Multiple files shown in this buffer, cannot use this command here"))) (save-excursion (goto-char pos) (switch-to-buffer (vc-find-revision (if log-view-per-file-logs @@ -561,8 +563,10 @@ If called interactively, visit the version at point." If called interactively, annotate the version at point." (interactive "d") (unless log-view-per-file-logs - (when (> (length log-view-vc-fileset) 1) - (error "Multiple files shown in this buffer, cannot use this command here"))) + (when (or (> (length log-view-vc-fileset) 1) + (null (car log-view-vc-fileset)) + (file-directory-p (car log-view-vc-fileset))) + (user-error "Multiple files shown in this buffer, cannot use this command here"))) (save-excursion (goto-char pos) (vc-annotate (if log-view-per-file-logs commit 25ab0980c773bcfea7fc84bc001481999ef72a81 Author: Juri Linkov Date: Thu Nov 8 00:33:05 2018 +0200 Advertise new hi-lock 'M-s h' key prefix in lisp/bindings.el https://lists.gnu.org/archive/html/emacs-devel/2015-07/msg00104.html diff --git a/lisp/bindings.el b/lisp/bindings.el index 76383ad2ce..bc4e741d01 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -1029,6 +1029,13 @@ if `inhibit-field-text-motion' is non-nil." (define-key search-map "hu" 'unhighlight-regexp) (define-key search-map "hf" 'hi-lock-find-patterns) (define-key search-map "hw" 'hi-lock-write-interactive-patterns) +(put 'highlight-regexp :advertised-binding [?\M-s ?h ?r]) +(put 'highlight-phrase :advertised-binding [?\M-s ?h ?p]) +(put 'highlight-lines-matching-regexp :advertised-binding [?\M-s ?h ?l]) +(put 'highlight-symbol-at-point :advertised-binding [?\M-s ?h ?.]) +(put 'unhighlight-regexp :advertised-binding [?\M-s ?h ?u]) +(put 'hi-lock-find-patterns :advertised-binding [?\M-s ?h ?f]) +(put 'hi-lock-write-interactive-patterns :advertised-binding [?\M-s ?h ?w]) ;;(defun function-key-error () ;; (interactive) commit fdbe4035ac7305c2f70274d2133c310c3480e23a Author: Juri Linkov Date: Thu Nov 8 00:27:58 2018 +0200 * lisp/files-x.el (modify-dir-local-variable): Use assoc-delete-all instead of assq-delete-all for cases when mode is a subdirectory name. (dir-locals-to-string): Call pp-to-string and string-trim-right on values. (Bug#32817) diff --git a/lisp/files-x.el b/lisp/files-x.el index 9af399c87b..5d87a4ed0c 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -30,6 +30,8 @@ ;;; Code: +(eval-when-compile (require 'subr-x)) ; for string-trim-right + ;;; Commands to add/delete file-local/directory-local variables. @@ -484,7 +486,7 @@ from the MODE alist ignoring the input argument VALUE." (if (memq variable '(mode eval)) (cdr mode-assoc) (assq-delete-all variable (cdr mode-assoc)))))) - (assq-delete-all mode variables))) + (assoc-delete-all mode variables))) (setq variables (cons `(,mode . ((,variable . ,value))) variables)))) @@ -513,9 +515,11 @@ from the MODE alist ignoring the input argument VALUE." (car mode-variables) (format "(%s)" (mapconcat (lambda (variable-value) - (format "(%S . %S)" + (format "(%S . %s)" (car variable-value) - (cdr variable-value))) + (string-trim-right + (pp-to-string + (cdr variable-value))))) (cdr mode-variables) "\n")))) variables "\n"))) commit 4254caa2d3bc2ebec6513fccce6a3d6303b068ef Author: Juri Linkov Date: Thu Nov 8 00:20:16 2018 +0200 * lisp/window.el (window-state-put): Create a new window to replace the existing one on the same frame in case when WINDOW is not live. (Bug#32850) * doc/lispref/windows.texi (Window Configurations): Describe changes related to WINDOW arg of window-state-put. diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 772bcdf9a6..9301fdfa9d 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -5706,9 +5706,10 @@ This function puts the window state @var{state} into @var{window}. The argument @var{state} should be the state of a window returned by an earlier invocation of @code{window-state-get}, see above. The optional argument @var{window} can be either a live window or an -internal window (@pxref{Windows and Frames}) and defaults to the -selected one. If @var{window} is not live, it is replaced by a live -window before putting @var{state} into it. +internal window (@pxref{Windows and Frames}). If @var{window} is not +a live window, it is replaced by a new live window created on the same +frame before putting @var{state} into it. If @var{window} is @code{nil}, +it puts the window state into a new window. If the optional argument @var{ignore} is non-@code{nil}, it means to ignore minimum window sizes and fixed-size restrictions. If @var{ignore} diff --git a/lisp/window.el b/lisp/window.el index bcd4fa2959..c0eeba7261 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -2764,7 +2764,7 @@ as small) as possible, but don't signal an error." "Return t when a window on FRAME shall be resized vertically. Optional argument HORIZONTAL non-nil means return t when a window shall be resized horizontally." -(catch 'apply + (catch 'apply (walk-window-tree (lambda (window) (unless (= (window-new-pixel window) @@ -5889,29 +5889,34 @@ value can be also stored on disk and read back in a new session." "Put window state STATE into WINDOW. STATE should be the state of a window returned by an earlier invocation of `window-state-get'. Optional argument WINDOW must -specify a valid window and defaults to the selected one. If -WINDOW is not live, replace WINDOW by a live one before putting -STATE into it. +specify a valid window. If WINDOW is not a live window, +replace WINDOW by a new live window created on the same frame. +If WINDOW is nil, create a new window before putting STATE into it. Optional argument IGNORE non-nil means ignore minimum window sizes and fixed size restrictions. IGNORE equal `safe' means windows can get as small as `window-safe-min-height' and `window-safe-min-width'." (setq window-state-put-stale-windows nil) - (setq window (window-normalize-window window)) - ;; When WINDOW is internal, reduce it to a live one to put STATE into, - ;; see Bug#16793. + ;; When WINDOW is internal or nil, reduce it to a live one, + ;; then create a new window on the same frame to put STATE into. (unless (window-live-p window) (let ((root window)) - (setq window (catch 'live - (walk-window-subtree - (lambda (window) - (when (and (window-live-p window) - (not (window-parameter window 'window-side))) - (throw 'live window))) - root))) - (delete-other-windows-internal window root))) + (setq window (if root + (catch 'live + (walk-window-subtree + (lambda (window) + (when (and (window-live-p window) + (not (window-parameter + window 'window-side))) + (throw 'live window))) + root)) + (selected-window))) + (delete-other-windows-internal window root) + ;; Create a new window to replace the existing one. + (setq window (prog1 (split-window window) + (delete-window window))))) (set-window-dedicated-p window nil) commit 811d9291fcfb12d87bad277d4e8b25152129d73d Author: Michael Albinus Date: Wed Nov 7 16:07:25 2018 +0100 * lisp/net/tramp.el (tramp-get-debug-buffer): Fix error in setting local map. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 6d8e720563..34489b1242 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1592,7 +1592,7 @@ The outline level is equal to the verbosity of the Tramp message." (set (make-local-variable 'outline-regexp) tramp-debug-outline-regexp) (set (make-local-variable 'outline-level) 'tramp-debug-outline-level) ;; Do not edit the debug buffer. - (set-keymap-parent (current-local-map) special-mode-map)) + (use-local-map special-mode-map)) (current-buffer))) (defsubst tramp-debug-message (vec fmt-string &rest arguments) commit aa556596fabe07af8ee33f59c6d3ec3b882f369e Author: Eli Zaretskii Date: Tue Nov 6 17:49:58 2018 +0200 Fix call to GlobalMemoryStatusEx in w32.c * src/w32.c (system_process_attributes): Initialize the size of the data structure passed to GlobalMemoryStatusEx, otherwise it fails. diff --git a/src/w32.c b/src/w32.c index 5ac6618140..b89e5104dc 100644 --- a/src/w32.c +++ b/src/w32.c @@ -7157,6 +7157,7 @@ system_process_attributes (Lisp_Object pid) code_convert_string_norecord (tem, Vlocale_coding_system, 0)), attrs); + memstex.dwLength = sizeof (memstex); if (global_memory_status_ex (&memstex)) #if __GNUC__ || (defined (_MSC_VER) && _MSC_VER >= 1300) totphys = memstex.ullTotalPhys / 1024.0; commit 3abe7bfe306706a95ca8dc404c7645073c949507 Author: Michael Albinus Date: Tue Nov 6 15:48:05 2018 +0100 Handle also port and domain in Tramp proxy definitions * doc/misc/tramp.texi (Multi-hops): Exclude ports and domains from pattern expansion. * lisp/net/tramp-cmds.el (tramp-cleanup-all-connections): Remove ad-hoc proxies. * lisp/net/tramp-sh.el (tramp-compute-multi-hops): Handle also port and domain in the proxy. Propertize ad-hoc proxies. * lisp/net/tramp.el (tramp-default-proxies-alist): Adapt docstring. * test/lisp/net/tramp-tests.el (tramp-test02-file-name-dissect) (tramp-test02-file-name-dissect-simplified) (tramp-test02-file-name-dissect-separate): Extend tests. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index f68205519f..a0b65d58b5 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -1374,7 +1374,8 @@ connect to @samp{bastion.your.domain}, then: @end lisp @var{proxy} can take patterns @code{%h} or @code{%u} for @var{host} or -@var{user} respectively. +@var{user} respectively. Ports or domains, if they are part of +a hop file name, are not expanded by those patterns. To login as @samp{root} on remote hosts in the domain @samp{your.domain}, but login as @samp{root} is disabled for non-local diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index b05f475f2f..456300e766 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -147,6 +147,19 @@ This includes password cache, file cache, connection cache, buffers." (when (bound-and-true-p tramp-archive-enabled) (tramp-archive-cleanup-hash)) + ;; Remove ad-hoc proxies. + (let ((proxies tramp-default-proxies-alist)) + (while proxies + (if (ignore-errors + (get-text-property 0 'tramp-ad-hoc (nth 2 (car proxies)))) + (setq tramp-default-proxies-alist + (delete (car proxies) tramp-default-proxies-alist) + proxies tramp-default-proxies-alist) + (setq proxies (cdr proxies))))) + (when (and tramp-default-proxies-alist tramp-save-ad-hoc-proxies) + (customize-save-variable + 'tramp-default-proxies-alist tramp-default-proxies-alist)) + ;; Remove buffers. (dolist (name (tramp-list-tramp-buffers)) (when (bufferp (get-buffer name)) (kill-buffer name)))) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 11ee063998..4fb011b342 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -4571,21 +4571,21 @@ Goes through the list `tramp-inline-compress-commands'." ;; Ad-hoc proxy definitions. (dolist (proxy (reverse (split-string hops tramp-postfix-hop-regexp 'omit))) - (let ((user (tramp-file-name-user item)) - (host (tramp-file-name-host item)) + (let ((user-domain (tramp-file-name-user-domain item)) + (host-port (tramp-file-name-host-port item)) (proxy (concat tramp-prefix-format proxy tramp-postfix-host-format))) (tramp-message vec 5 "Add proxy (\"%s\" \"%s\" \"%s\")" - (and (stringp host) (regexp-quote host)) - (and (stringp user) (regexp-quote user)) + (and (stringp host-port) (regexp-quote host-port)) + (and (stringp user-domain) (regexp-quote user-domain)) proxy) ;; Add the hop. (add-to-list 'tramp-default-proxies-alist - (list (and (stringp host) (regexp-quote host)) - (and (stringp user) (regexp-quote user)) - proxy)) + (list (and (stringp host-port) (regexp-quote host-port)) + (and (stringp user-domain) (regexp-quote user-domain)) + (propertize proxy 'tramp-ad-hoc t))) (setq item (tramp-dissect-file-name proxy)))) ;; Save the new value. (when (and hops tramp-save-ad-hoc-proxies) @@ -4600,10 +4600,12 @@ Goes through the list `tramp-inline-compress-commands'." (when (and ;; Host. (string-match (or (eval (nth 0 item)) "") - (or (tramp-file-name-host (car target-alist)) "")) + (or (tramp-file-name-host-port (car target-alist)) + "")) ;; User. (string-match (or (eval (nth 1 item)) "") - (or (tramp-file-name-user (car target-alist)) ""))) + (or (tramp-file-name-user-domain (car target-alist)) + ""))) (if (null proxy) ;; No more hops needed. (setq choices nil) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 13c3b5f939..6d8e720563 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -379,11 +379,17 @@ empty string for the method name." This is an alist of items (HOST USER PROXY). The first matching item specifies the proxy to be passed for a file name located on a remote target matching USER@HOST. HOST and USER are regular -expressions. PROXY must be a Tramp filename without a localname -part. Method and user name on PROXY are optional, which is -interpreted with the default values. PROXY can contain the -patterns %h and %u, which are replaced by the strings matching -HOST or USER, respectively. +expressions, which could also cover a domain (USER%DOMAIN) or +port (HOST#PORT). PROXY must be a Tramp filename without a +localname part. Method and user name on PROXY are optional, +which is interpreted with the default values. + +PROXY can contain the patterns %h and %u, which are replaced by +the strings matching HOST or USER (without DOMAIN and PORT parts), +respectively. + +If an entry is added while parsing ad-hoc hop definitions, PROXY +carries the non-nil text property `tramp-ad-hoc'. HOST, USER or PROXY could also be Lisp forms, which will be evaluated. The result must be a string or nil, which is diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index ceda70947c..4016ece94d 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -819,12 +819,14 @@ handled properly. BODY shall not contain a timeout." (file-remote-p (concat "/method1:%u@%h" - "|method2:%u@%h" - "|method3:user3@host3:/path/to/file")) - (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s:" - "method1" "user3" "host3" - "method2" "user3" "host3" - "method3" "user3" "host3"))))) + "|method2:user2@host2" + "|method3:%u@%h" + "|method4:user4%domain4@host4#1234:/path/to/file")) + (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s|%s:%s@%s:" + "method1" "user2" "host2" + "method2" "user2" "host2" + "method3" "user4" "host4" + "method4" "user4%domain4" "host4#1234"))))) (ert-deftest tramp-test02-file-name-dissect-simplified () "Check simplified file name components." @@ -1134,12 +1136,14 @@ handled properly. BODY shall not contain a timeout." (file-remote-p (concat "/%u@%h" + "|user2@host2" "|%u@%h" - "|user3@host3:/path/to/file")) - (format "/%s@%s|%s@%s|%s@%s:" - "user3" "host3" - "user3" "host3" - "user3" "host3")))) + "|user4%domain4@host4#1234:/path/to/file")) + (format "/%s@%s|%s@%s|%s@%s|%s@%s:" + "user2" "host2" + "user2" "host2" + "user4" "host4" + "user4%domain4" "host4#1234")))) ;; Exit. (tramp-change-syntax syntax)))) @@ -1780,12 +1784,14 @@ handled properly. BODY shall not contain a timeout." (file-remote-p (concat "/[method1/%u@%h" - "|method2/%u@%h" - "|method3/user3@host3]/path/to/file")) - (format "/[%s/%s@%s|%s/%s@%s|%s/%s@%s]" - "method1" "user3" "host3" - "method2" "user3" "host3" - "method3" "user3" "host3")))) + "|method2/user2@host2" + "|method3/%u@%h" + "|method4/user4%domain4@host4#1234]/path/to/file")) + (format "/[%s/%s@%s|%s/%s@%s|%s/%s@%s|%s/%s@%s]" + "method1" "user2" "host2" + "method2" "user2" "host2" + "method3" "user4" "host4" + "method4" "user4%domain4" "host4#1234")))) ;; Exit. (tramp-change-syntax syntax)))) commit ff1ee4e0bef4f62b758b70266d2f21be166924c3 Author: Juri Linkov Date: Mon Nov 5 23:11:30 2018 +0200 Support lazy-highlight-buffer in Info (bug#29321, bug#29360). * lisp/isearch.el (isearch-lazy-highlight-point-min) (isearch-lazy-highlight-point-max): New variables. (isearch-lazy-highlight-new-loop): When lazy-highlight-buffer is non-nil, compare (point-min) with isearch-lazy-highlight-point-min, and (point-max) with isearch-lazy-highlight-point-max, for buffers like Info where narrowing changes the values point-min and point-max. diff --git a/lisp/isearch.el b/lisp/isearch.el index 580b3ac40a..42b3aa42ba 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -3202,6 +3202,8 @@ since they have special meaning in a regexp." (defvar isearch-lazy-highlight-window-group nil) (defvar isearch-lazy-highlight-window-start nil) (defvar isearch-lazy-highlight-window-end nil) +(defvar isearch-lazy-highlight-point-min nil) +(defvar isearch-lazy-highlight-point-max nil) (defvar isearch-lazy-highlight-buffer nil) (defvar isearch-lazy-highlight-case-fold-search nil) (defvar isearch-lazy-highlight-regexp nil) @@ -3251,17 +3253,21 @@ by other Emacs features." isearch-lax-whitespace)) (not (eq isearch-lazy-highlight-regexp-lax-whitespace isearch-regexp-lax-whitespace)) - (not (or lazy-highlight-buffer - (= (window-group-start) - isearch-lazy-highlight-window-start))) - (not (or lazy-highlight-buffer - (= (window-group-end) ; Window may have been split/joined. - isearch-lazy-highlight-window-end))) (not (eq isearch-forward isearch-lazy-highlight-forward)) ;; In case we are recovering from an error. (not (equal isearch-error - isearch-lazy-highlight-error)))) + isearch-lazy-highlight-error)) + (not (if lazy-highlight-buffer + (= (point-min) + isearch-lazy-highlight-point-min) + (= (window-group-start) + isearch-lazy-highlight-window-start))) + (not (if lazy-highlight-buffer + (= (point-max) + isearch-lazy-highlight-point-max) + (= (window-group-end) ; Window may have been split/joined. + isearch-lazy-highlight-window-end))))) ;; something important did indeed change (lazy-highlight-cleanup t (not (equal isearch-string ""))) ;stop old timer (setq isearch-lazy-highlight-error isearch-error) @@ -3274,6 +3280,8 @@ by other Emacs features." isearch-lazy-highlight-window-group (selected-window-group) isearch-lazy-highlight-window-start (window-group-start) isearch-lazy-highlight-window-end (window-group-end) + isearch-lazy-highlight-point-min (point-min) + isearch-lazy-highlight-point-max (point-max) isearch-lazy-highlight-buffer lazy-highlight-buffer ;; Start lazy-highlighting at the beginning of the found ;; match (`isearch-other-end'). If no match, use point. commit 0e1d946a9386ff4fbd5f72f39cc96cbdb07f525d Author: Juri Linkov Date: Mon Nov 5 22:57:10 2018 +0200 * lisp/image-mode.el (image--imagemagick-wanted-p): Check for nil filename. (Bug#33241) diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 606c66143a..92ba577b4f 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -786,7 +786,7 @@ was inserted." (defun image--imagemagick-wanted-p (filename) (and (fboundp 'imagemagick-types) (not (eq imagemagick-types-inhibit t)) - (not (and (file-name-extension filename) + (not (and filename (file-name-extension filename) (memq (intern (upcase (file-name-extension filename)) obarray) imagemagick-types-inhibit))))) commit 294a5246b264441d436612d4de0dd89fad130aa3 Author: Glenn Morris Date: Sun Nov 4 09:45:59 2018 -0800 * src/xfaces.c (face_at_buffer_position): Adapt lookup_basic_face call. diff --git a/src/xfaces.c b/src/xfaces.c index 94397cd7f9..76b23a3127 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -6099,7 +6099,7 @@ face_at_buffer_position (struct window *w, ptrdiff_t pos, cached faces since we've looked up the base face, we need to look it up again. */ if (!FACE_FROM_ID_OR_NULL (f, face_id)) - face_id = lookup_basic_face (f, DEFAULT_FACE_ID); + face_id = lookup_basic_face (w, f, DEFAULT_FACE_ID); } else if (NILP (Vface_remapping_alist)) face_id = DEFAULT_FACE_ID; commit 410e65e4ce6f871fd1b8a2ef4b227cbeeb17c1dd Merge: 4fbdccedd5 6937c35d32 Author: Glenn Morris Date: Sun Nov 4 09:37:03 2018 -0800 Merge from origin/emacs-26 6937c35 (origin/emacs-26) Improve recent changes in documentation of ... c04b48c Rewrite documentation of buffer display 7cadb32 ; * doc/lispref/control.texi (pcase Macro): Fix another typo. 963f1d9 ; * doc/lispref/control.texi (pcase Macro): Fix a typo. e824c91 Improve documentation of destructuring-binding macros commit 4fbdccedd58ffe4cd5f7ed7b744123cc25084bc4 Merge: a9140091dd 74bc0e16b7 Author: Glenn Morris Date: Sun Nov 4 09:37:03 2018 -0800 ; Merge from origin/emacs-26 The following commit was skipped: 74bc0e1 Avoid byte compilation warning in rcirc.el commit a9140091dd0df7e89ddbaabec17608a20f06f7b0 Merge: 5ad0d80585 bd1d61753d Author: Glenn Morris Date: Sun Nov 4 09:37:03 2018 -0800 Merge from origin/emacs-26 bd1d617 Avoid race in rcirc process filter (bug#33145) 88ef31a Avoid file-name errors when viewing PDF from Gnus c939042 Avoid crashes with remapped default face in Org mode 97660fa Doc fix for checkdoc-continue 96f055b Fix a typo in autoload.el commit 5ad0d805855dacfee285fe4f2375f18c9f245875 Merge: 9b90f1b6be d53a2b65db Author: Glenn Morris Date: Sun Nov 4 09:37:03 2018 -0800 ; Merge from origin/emacs-26 The following commit was skipped: d53a2b6 ; Auto-commit of loaddefs files. commit 9b90f1b6be09abc31af02a9f09390bdcc8922c6e Merge: 19d2ba0059 9962cf959f Author: Glenn Morris Date: Sun Nov 4 09:37:03 2018 -0800 Merge from origin/emacs-26 9962cf9 * doc/lispref/control.texi (Destructuring patterns): New subs... commit 6937c35d3260fe3fc32249313c7e9b6231cbd3dd Author: Eli Zaretskii Date: Sun Nov 4 19:08:00 2018 +0200 Improve recent changes in documentation of window handling * doc/lispref/windows.texi (Displaying Buffers) (Choosing Window, Buffer Display Action Functions) (Buffer Display Action Alists, Choosing Window Options) (Precedence of Action Functions, The Zen of Buffer Display): Fix wording, punctuation, and markup. Remove redundant cross-references. * doc/emacs/windows.texi (Window Choice, Temporary Displays): Fix wording and punctuation. diff --git a/doc/emacs/windows.texi b/doc/emacs/windows.texi index b09c9ae689..3369e986f9 100644 --- a/doc/emacs/windows.texi +++ b/doc/emacs/windows.texi @@ -386,9 +386,10 @@ to alter this sequence of steps. @itemize @item -First, check if the buffer should be displayed in the selected window -regardless of other considerations. You can tell Emacs to do this by -adding a regular expression matching the buffer's name together with a +If the buffer should be displayed in the selected window regardless of +other considerations, reuse the selected window. By default, this +step is skipped, but you can tell Emacs not to skip it by adding a +regular expression matching the buffer's name together with a reference to the @code{display-buffer-same-window} action function (@pxref{Buffer Display Action Functions,,Action Functions for Buffer Display, elisp, The Emacs Lisp Reference Manual}) to the option @@ -405,17 +406,16 @@ selected window write: @end group @end example -By default, @code{display-buffer-alist} is @code{nil}, so this step is -skipped. +By default, @code{display-buffer-alist} is @code{nil}. @item Otherwise, if the buffer is already displayed in an existing window, reuse that window. Normally, only windows on the selected frame are -considered, but windows on other frames are also reusable if a -corresponding @code{reusable-frames} action alist entry (@pxref{Buffer -Display Action Alists,,Action Alists for Buffer Display, elisp, The -Emacs Lisp Reference Manual}) is used (see the next step for an -example of how to do that). +considered, but windows on other frames are also reusable if you use +the corresponding @code{reusable-frames} action alist entry +(@pxref{Buffer Display Action Alists,,Action Alists for Buffer +Display, elisp, The Emacs Lisp Reference Manual}). See the +next step for an example of how to do that. @item Otherwise, optionally create a new frame and display the buffer there. @@ -434,7 +434,7 @@ Lisp Reference Manual}) as follows: @end example This customization will also try to make the preceding step search for -a reusable window on all visible of iconified frames +a reusable window on all visible or iconified frames. @item Otherwise, try to create a new window by splitting a window on the @@ -475,22 +475,21 @@ and display the buffer there. Some buffers are shown in windows for perusal rather than for editing. Help commands (@pxref{Help}) typically use a buffer called @file{*Help*} for that purpose, minibuffer completion (@pxref{Completion}) uses a -buffer called @file{*Completions*} instead. Such buffers are usually +buffer called @file{*Completions*}, etc. Such buffers are usually displayed only for a short period of time. Normally, Emacs chooses the window for such temporary displays via -@code{display-buffer} as described in the previous subsection. The +@code{display-buffer}, as described in the previous subsection. The @file{*Completions*} buffer, on the other hand, is normally displayed in a window at the bottom of the selected frame, regardless of the number of windows already shown on that frame. If you prefer Emacs to display a temporary buffer in a different -fashion, we recommend customizing the variable -@code{display-buffer-alist} (@pxref{Choosing Window,,Choosing a Window -for Displaying a Buffer, elisp, The Emacs Lisp Reference Manual}). -For example, to display @file{*Completions*} always below the selected -window, use the following form in your initialization file -(@pxref{Init File}): +fashion, customize the variable @code{display-buffer-alist} +(@pxref{Choosing Window,,Choosing a Window for Displaying a Buffer, +elisp, The Emacs Lisp Reference Manual}) appropriately. For example, +to display @file{*Completions*} always below the selected window, use +the following form in your initialization file (@pxref{Init File}): @example @group @@ -504,10 +503,10 @@ window, use the following form in your initialization file The @file{*Completions*} buffer is also special in the sense that Emacs usually tries to make its window just as large as necessary to display all of its contents. To resize windows showing other -temporary displays like, for example, the @file{*Help*} buffer -accordingly, turn on the minor mode (@pxref{Minor Modes}) -@code{temp-buffer-resize-mode} (@pxref{Temporary Displays,,Temporary -Displays, elisp, The Emacs Lisp Reference Manual}). +temporary displays, like, for example, the @file{*Help*} buffer, turn +on the minor mode (@pxref{Minor Modes}) @code{temp-buffer-resize-mode} +(@pxref{Temporary Displays,,Temporary Displays, elisp, The Emacs Lisp +Reference Manual}). @vindex temp-buffer-max-height @vindex temp-buffer-max-width @@ -515,7 +514,7 @@ Displays, elisp, The Emacs Lisp Reference Manual}). can be controlled by customizing the options @code{temp-buffer-max-height} and @code{temp-buffer-max-width} (@pxref{Temporary Displays,,Temporary Displays, elisp, The Emacs Lisp -Reference Manual}) and cannot exceed the size of the containing frame. +Reference Manual}), and cannot exceed the size of the containing frame. @node Window Convenience diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 7f2dff1753..640c9923e9 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -2338,20 +2338,19 @@ Window}). @code{display-buffer} delegates the task of finding a suitable window to so-called action functions (@pxref{Buffer Display Action -Functions}). Before, @code{display-buffer} compiles a so-called -action alist---a special association list action functions can use to -fine-tune their behavior--- and passes that alist on to each action +Functions}). First, @code{display-buffer} compiles a so-called action +alist---a special association list that action functions can use to +fine-tune their behavior. Then it passes that alist on to each action function it calls (@pxref{Buffer Display Action Alists}). The behavior of @code{display-buffer} is highly customizable. To -understand how customizations are put into practice, readers may want -to study examples illustrating the precedence acquired by -@code{display-buffer} for calling action functions (@pxref{Precedence -of Action Functions}). To avoid that Lisp programs calling -@code{display-buffer} come into conflict with users customizing its -behavior, it may make sense to follow a number of guidelines which are -sketched in the final part of this section (@pxref{The Zen of Buffer -Display}). +understand how customizations are used in practice, you may wish to +study examples illustrating the order of precedence which +@code{display-buffer} uses to call action functions (@pxref{Precedence +of Action Functions}). To avoid conflicts between Lisp programs +calling @code{display-buffer} and user customizations of its behavior, +it may make sense to follow a number of guidelines which are sketched +in the final part of this section (@pxref{The Zen of Buffer Display}). @menu * Choosing Window:: How to choose a window for displaying a buffer. @@ -2379,12 +2378,12 @@ Buffers}). @cindex display action This command performs several complex steps to find a window to display in. These steps are described by means of @dfn{display -actions}, which have the form @code{(@var{function} . @var{alist})}. -Here, @var{function} is either a function or a list of functions, -which we refer to as ``action functions'' (@pxref{Buffer Display -Action Functions}); @var{alist} is an association list, which we refer -to as ``action alist'' (@pxref{Buffer Display Action Alists}). See -@ref{The Zen of Buffer Display}, for samples of display actions. +actions}, which have the form @code{(@var{functions} . @var{alist})}. +Here, @var{functions} is either a single function or a list of +functions, referred to as ``action functions'' (@pxref{Buffer Display +Action Functions}); and @var{alist} is an association list, referred +to as ``action alist'' (@pxref{Buffer Display Action Alists}). +@xref{The Zen of Buffer Display}, for samples of display actions. An action function accepts two arguments: the buffer to display and an action alist. It attempts to display the buffer in some window, @@ -2400,14 +2399,14 @@ value. This command makes @var{buffer-or-name} appear in some window, without selecting the window or making the buffer current. The argument @var{buffer-or-name} must be a buffer or the name of an existing -buffer. The return value is the window chosen to display the buffer. -It is @code{nil} if no suitable window was found. +buffer. The return value is the window chosen to display the buffer, +or @code{nil} if no suitable window was found. The optional argument @var{action}, if non-@code{nil}, should normally be a display action (described above). @code{display-buffer} builds a list of action functions and an action alist, by consolidating display actions from the following sources (in order of their precedence, -highest ranking first): +from highest to lowest): @itemize @item @@ -2439,7 +2438,7 @@ may be called multiple times during one call of @code{display-buffer}. @code{display-buffer} calls the action functions specified by this list in turn, passing the buffer as the first argument and the combined action alist as the second argument, until one of the -functions returns non-@code{nil}. See @ref{Precedence of Action +functions returns non-@code{nil}. @xref{Precedence of Action Functions}, for examples how display actions specified by different sources are processed by @code{display-buffer}. @@ -2466,8 +2465,8 @@ should always supply a list value. The optional argument @var{frame}, if non-@code{nil}, specifies which frames to check when deciding whether the buffer is already displayed. -It is equivalent to adding an element @code{(reusable-frames -. @var{frame})} to the action alist of @var{action} (@pxref{Buffer +It is equivalent to adding an element @w{@code{(reusable-frames +. @var{frame})}} to the action alist of @var{action} (@pxref{Buffer Display Action Alists}). The @var{frame} argument is provided for compatibility reasons, Lisp programs should not use it. @end deffn @@ -2475,16 +2474,16 @@ compatibility reasons, Lisp programs should not use it. @defvar display-buffer-overriding-action The value of this variable should be a display action, which is treated with the highest priority by @code{display-buffer}. The -default value is empty, i.e., @code{(nil . nil)}. +default value is an empty display action, i.e., @w{@code{(nil . nil)}}. @end defvar @defopt display-buffer-alist The value of this option is an alist mapping conditions to display actions. Each condition may be either a regular expression matching a buffer name or a function that takes two arguments: a buffer name and -the @var{action} argument passed to @code{display-buffer}. If the -name of the buffer passed to @code{display-buffer} either matches a -regular expression in this alist or the function specified by a +the @var{action} argument passed to @code{display-buffer}. If either +the name of the buffer passed to @code{display-buffer} matches a +regular expression in this alist, or the function specified by a condition returns non-@code{nil}, then @code{display-buffer} uses the corresponding display action to display the buffer. @end defopt @@ -2519,8 +2518,7 @@ and @code{nil} if they fail. This function tries to display @var{buffer} in the selected window. It fails if the selected window is a minibuffer window or is dedicated to another buffer (@pxref{Dedicated Windows}). It also fails if -@var{alist} has a non-@code{nil} @code{inhibit-same-window} entry -(@pxref{Buffer Display Action Alists}). +@var{alist} has a non-@code{nil} @code{inhibit-same-window} entry. @end defun @defun display-buffer-reuse-window buffer alist @@ -2530,15 +2528,13 @@ is already displaying it. If @var{alist} has a non-@code{nil} @code{inhibit-same-window} entry, the selected window is not eligible for reuse. The set of frames to search for a window already displaying @var{buffer} can be specified -with the help of a @code{reusable-frames} action alist entry -(@pxref{Buffer Display Action Alists}). If @var{alist} contains no -@code{reusable-frames} entry, this function searches just the selected -frame. +with the help of the @code{reusable-frames} action alist entry. If +@var{alist} contains no @code{reusable-frames} entry, this function +searches just the selected frame. If this function chooses a window on another frame, it makes that frame visible and, unless @var{alist} contains an -@code{inhibit-switch-frame} entry (@pxref{Buffer Display Action -Alists}), raises that frame if necessary. +@code{inhibit-switch-frame} entry, raises that frame if necessary. @end defun @defun display-buffer-reuse-mode-window buffer alist @@ -2553,8 +2549,8 @@ whose mode derives from one of the modes specified thusly. The behavior is also controlled by @var{alist} entries for @code{inhibit-same-window}, @code{reusable-frames} and -@code{inhibit-switch-frame} (@pxref{Buffer Display Action Alists}) as -is done in the function @code{display-buffer-reuse-window}. +@code{inhibit-switch-frame}, like @code{display-buffer-reuse-window} +does. @end defun @defun display-buffer-pop-up-window buffer alist @@ -2565,27 +2561,25 @@ It actually performs the split by calling the function specified by Options}). The size of the new window can be adjusted by supplying -@code{window-height} and @code{window-width} entries in @var{alist} -(@pxref{Buffer Display Action Alists}). If @var{alist} contains a -@code{preserve-size} entry, Emacs will also try to preserve the size -of the new window during future resize operations (@pxref{Preserving -Window Sizes}). +@code{window-height} and @code{window-width} entries in @var{alist}. +If @var{alist} contains a @code{preserve-size} entry, Emacs will also +try to preserve the size of the new window during future resize +operations (@pxref{Preserving Window Sizes}). -This function fails if no window can be split. More often than not +This function fails if no window can be split. More often than not, this happens because no window is large enough to allow splitting. Setting @code{split-height-threshold} or @code{split-width-threshold} -(@pxref{Choosing Window Options}) to lower values may help in this -regard. Spliting also fails when the selected frame has an -@code{unsplittable} frame parameter; @pxref{Buffer Parameters}. +to lower values may help in this regard. Spliting also fails when the +selected frame has an @code{unsplittable} frame parameter; +@pxref{Buffer Parameters}. @end defun @defun display-buffer-in-previous-window buffer alist -This function tries to display @var{buffer} in a window previously -showing it. If @var{alist} has a non-@code{nil} +This function tries to display @var{buffer} in a window where it was +previously displayed. If @var{alist} has a non-@code{nil} @code{inhibit-same-window} entry, the selected window is not eligible for reuse. If @var{alist} contains a @code{reusable-frames} entry, -its value determines which frames to search for a suitable window -(@pxref{Buffer Display Action Alists}). +its value determines which frames to search for a suitable window. If @var{alist} has a @code{previous-window} entry and the window specified by that entry is live and not dedicated to another buffer, @@ -2596,7 +2590,7 @@ before. @defun display-buffer-use-some-window buffer alist This function tries to display @var{buffer} by choosing an existing window and displaying the buffer in that window. It can fail if all -windows are dedicated to another buffer (@pxref{Dedicated Windows}). +windows are dedicated to other buffers (@pxref{Dedicated Windows}). @end defun @defun display-buffer-below-selected buffer alist @@ -2605,13 +2599,13 @@ selected window. If there is a window below the selected one and that window already displays @var{buffer}, it reuses that window. If there is no such window, this function tries to create a new window -by splitting the selected one and display @var{buffer} there. It will +by splitting the selected one, and displays @var{buffer} there. It will also try to adjust that window's size provided @var{alist} contains a suitable @code{window-height} or @code{window-width} entry, see above. If splitting the selected window fails and there is a non-dedicated -window below the selected one showing some other buffer, it tries to -use that window for showing @var{buffer}. +window below the selected one showing some other buffer, this function +tries to use that window for showing @var{buffer}. @end defun @defun display-buffer-at-bottom buffer alist @@ -2634,19 +2628,19 @@ the newly created frame's parameters. @defun display-buffer-in-child-frame buffer alist This function tries to display @var{buffer} in a child frame -(@pxref{Child Frames}) of the selected frame, either reusing an existing -child frame or by making a new one. If @var{alist} has a non-@code{nil} -@code{child-frame-parameters} entry, the corresponding value is an alist -of frame parameters to give the new frame. A @code{parent-frame} -parameter specifying the selected frame is provided by default. If the -child frame should be or become the child of another frame, a -corresponding entry must be added to @var{alist}. +(@pxref{Child Frames}) of the selected frame, either reusing an +existing child frame or by making a new one. If @var{alist} has a +non-@code{nil} @code{child-frame-parameters} entry, the corresponding +value is an alist of frame parameters to give the new frame. A +@code{parent-frame} parameter specifying the selected frame is +provided by default. If the child frame should become the child of +another frame, a corresponding entry must be added to @var{alist}. The appearance of child frames is largely dependent on the parameters provided via @var{alist}. It is advisable to use at least ratios to specify the size (@pxref{Size Parameters}) and the position -(@pxref{Position Parameters}) of the child frame and to add a -@code{keep-ratio} parameter (@pxref{Frame Interaction Parameters}) in +(@pxref{Position Parameters}) of the child frame, and to add a +@code{keep-ratio} parameter (@pxref{Frame Interaction Parameters}), in order to make sure that the child frame remains visible. For other parameters that should be considered see @ref{Child Frames}. @end defun @@ -2658,8 +2652,7 @@ frame). If this function chooses a window on another frame, it makes that frame visible and, unless @var{alist} contains an -@code{inhibit-switch-frame} entry (@pxref{Buffer Display Action -Alists}), raises that frame if necessary. +@code{inhibit-switch-frame} entry, raises that frame if necessary. If @var{alist} has a non-@code{nil} @code{frame-predicate} entry, its value is a function taking one argument (a frame), returning @@ -2690,7 +2683,7 @@ non-@code{nil} @code{allow-no-window} entry, it is also able to handle a @code{nil} return value. @end defun -Two action functions are described in their proper +Two other action functions are described in their proper sections---@code{display-buffer-in-side-window} (@pxref{Displaying Buffers in Side Windows}) and @code{display-buffer-in-atom-window} (@pxref{Atomic Windows}). @@ -2710,18 +2703,19 @@ and passes that entire list on to any action function it calls. By design, action functions are free in their interpretation of action alist entries. In fact, some entries like @code{allow-no-window} or @code{previous-window} have a meaning only -for one or a few action functions and are ignored by the rest. Other +for one or a few action functions, and are ignored by the rest. Other entries, like @code{inhibit-same-window} or @code{window-parameters}, -are supposed to be respected by most action functions including those +are supposed to be respected by most action functions, including those provided by application programs and external packages. In the previous subsection we have described in detail how individual action functions interpret the action alist entries they care about. Here we give a reference list of all known action alist entries according to their symbols, together with their values and -action functions that recognize them. Throughout this list, the terms -``buffer'' will refer to the buffer @code{display-buffer} is supposed -to display and ``value'' to the entry's value. +action functions (@pxref{Buffer Display Action Functions}) that +recognize them. Throughout this list, the terms ``buffer'' will refer +to the buffer @code{display-buffer} is supposed to display, and +``value'' refers to the entry's value. @table @code @vindex inhibit-same-window@r{, a buffer display action alist entry} @@ -2733,25 +2727,23 @@ must not be used for displaying the buffer. All action functions that @vindex previous-window@r{, a buffer display action alist entry} @item previous-window The value must specify a window that may have displayed the buffer -previously. @code{display-buffer-in-previous-window} (@pxref{Buffer -Display Action Functions}) will give preference to such a window -provided it is still live and not dedicated to another buffer. +previously. @code{display-buffer-in-previous-window} will give +preference to such a window provided it is still live and not +dedicated to another buffer. @vindex mode@r{, a buffer display action alist entry} @item mode The value is either a major mode or a list of major modes. -@code{display-buffer-reuse-mode-window} (@pxref{Buffer Display Action -Functions}) may reuse a window whenever the value specified by this -entry matches the major mode of that window's buffer. Other action -functions ignore such entries. +@code{display-buffer-reuse-mode-window} may reuse a window whenever +the value specified by this entry matches the major mode of that +window's buffer. Other action functions ignore such entries. @vindex frame-predicate@r{, a buffer display action alist entry} @item frame-predicate The value must be a function taking one argument (a frame), supposed to return non-@code{nil} if that frame is a candidate for displaying the buffer. This entry is used by -@code{display-buffer-use-some-frame} (@pxref{Buffer Display Action -Functions}). +@code{display-buffer-use-some-frame}. @vindex reusable-frames@r{, a buffer display action alist entry} @item reusable-frames @@ -2777,9 +2769,9 @@ Note that the meaning of @code{nil} differs slightly from that of the @var{all-frames} argument to @code{next-window} (@pxref{Cyclic Window Ordering}). -A major client of this is @code{display-buffer-reuse-window} -(@pxref{Buffer Display Action Functions}) but all other action -functions that try to reuse a window are affected as well. +A major client of this is @code{display-buffer-reuse-window}, but all +other action functions that try to reuse a window are affected as +well. @vindex inhibit-switch-frame@r{, a buffer display action alist entry} @item inhibit-switch-frame @@ -2787,9 +2779,9 @@ A non-@code{nil} value prevents another frame from being raised or selected, if the window chosen by @code{display-buffer} is displayed there. Primarily affected by this are @code{display-buffer-use-some-frame} and -@code{display-buffer-reuse-window} (@pxref{Buffer Display Action -Functions}). @code{display-buffer-pop-up-frame} should be affected as -well but there is no guarantee that the window manager will comply. +@code{display-buffer-reuse-window}. +@code{display-buffer-pop-up-frame} should be affected as well, but +there is no guarantee that the window manager will comply. @vindex window-parameters@r{, a buffer display action alist entry} @item window-parameters @@ -2800,7 +2792,7 @@ entry. @vindex window-height@r{, a buffer display action alist entry} @item window-height The value specifies whether and how to adjust the height of the chosen -window and can be provided as follows: +window, and can have the following values: @itemize @bullet @item @@ -2825,8 +2817,8 @@ All action functions that choose a window should process this entry. @vindex window-width@r{, a buffer display action alist entry} @item window-width This entry is similar to the @code{window-height} entry described -before but can be used to adjust the chosen window's width instead. -The value can be one of the following: +before, but used to adjust the chosen window's width instead. The +value can be one of the following: @itemize @bullet @item @@ -2852,28 +2844,26 @@ If non-@code{nil} such an entry tells Emacs to preserve the size of the window chosen (@pxref{Preserving Window Sizes}). The value should be either @code{(t . nil)} to preserve the width of the window, @code{(nil . t)} to preserve its height or @code{(t . t)} to preserve -both, its width and its height. All action functions that choose a +both its width and its height. All action functions that choose a window should process this entry. @vindex pop-up-frame-parameters@r{, a buffer display action alist entry} @item pop-up-frame-parameters The value specifies an alist of frame parameters to give a new frame, -if one is created. @code{display-buffer-pop-up-frame} (@pxref{Buffer -Display Action Functions}) is its one and only addressee. +if one is created. @code{display-buffer-pop-up-frame} is its one and +only addressee. @vindex parent-frame@r{, a buffer display action alist entry} @item parent-frame The value specifies the parent frame to be used when the buffer is -displayed on a child frame. This entry is used by -@code{display-buffer-in-child-frame} (@pxref{Buffer Display Action -Functions}) only. +displayed on a child frame. This entry is used only by +@code{display-buffer-in-child-frame}. @vindex child-frame-parameters@r{, a buffer display action alist entry} @item child-frame-parameters -The value specifies an alist of frame parameters used when the buffer -is displayed on a child frame. This entry is used by -@code{display-buffer-in-child-frame} (@pxref{Buffer Display Action -Functions}) only. +The value specifies an alist of frame parameters to use when the buffer +is displayed on a child frame. This entry is used only by +@code{display-buffer-in-child-frame}. @vindex side@r{, a buffer display action alist entry} @item side @@ -2889,27 +2879,25 @@ Windows}). @vindex slot@r{, a buffer display action alist entry} @item slot If non-@code{nil}, the value specifies the slot of the side window -supposed to display the buffer. This entry is used by -@code{display-buffer-in-side-window} only (@pxref{Displaying Buffers -in Side Windows}). +supposed to display the buffer. This entry is used only by +@code{display-buffer-in-side-window}. @vindex window@r{, a buffer display action alist entry} @item window The value specifies a window that is in some way related to the window chosen by @code{display-buffer}. This entry is currently used by @code{display-buffer-in-atom-window} to indicate the window on whose -side the new window shall be created (@pxref{Atomic Windows}). +side the new window shall be created. @vindex allow-no-window@r{, a buffer display action alist entry} @item allow-no-window If the value is non-@code{nil}, @code{display-buffer} does not necessarily have to display the buffer and the caller is prepared to -accept that. This entry is not intended for user customizations since -there is no guarantee that an arbitrary caller of +accept that. This entry is not intended for user customizations, +since there is no guarantee that an arbitrary caller of @code{display-buffer} will be able to handle the case that no window -will display the buffer. @code{display-buffer-no-window} -(@pxref{Buffer Display Action Functions}) is the only action function -that cares about this entry. +will display the buffer. @code{display-buffer-no-window} is the only +action function that cares about this entry. @end table @@ -2937,16 +2925,16 @@ user may specify directly in @code{display-buffer-alist} etc. This variable specifies a function for splitting a window, in order to make a new window for displaying a buffer. It is used by the @code{display-buffer-pop-up-window} action function to actually split -the window (@pxref{Buffer Display Action Functions}). +the window. The value must be a function that takes one argument, a window, and -return either a new window (which will be used to display the desired +returns either a new window (which will be used to display the desired buffer) or @code{nil} (which means the splitting failed). The default value is @code{split-window-sensibly}, which is documented next. @end defopt @defun split-window-sensibly &optional window -This function tries to split @var{window}, and return the newly created +This function tries to split @var{window} and return the newly created window. If @var{window} cannot be split, it returns @code{nil}. If @var{window} is omitted or @code{nil}, it defaults to the selected window. @@ -2957,7 +2945,7 @@ placing the new window below, subject to the restriction imposed by @code{split-height-threshold} (see below), in addition to any other restrictions. If that fails, it tries to split by placing the new window to the right, subject to @code{split-width-threshold} (see -below). If that fails, and the window is the only window on its +below). If that also fails, and the window is the only window on its frame, this function again tries to split and place the new window below, disregarding @code{split-height-threshold}. If this fails as well, this function gives up and returns @code{nil}. @@ -2981,7 +2969,7 @@ that means not to split this way. @defopt even-window-sizes This variable, if non-@code{nil}, causes @code{display-buffer} to even -window sizes whenever it reuses an existing window and that window is +window sizes whenever it reuses an existing window, and that window is adjacent to the selected one. If its value is @code{width-only}, sizes are evened only if the reused @@ -3016,8 +3004,7 @@ directly in @code{display-buffer-alist} etc. @defopt pop-up-frame-function This variable specifies a function for creating a new frame, in order to make a new window for displaying a buffer. It is used by the -@code{display-buffer-pop-up-frame} action function (@pxref{Buffer -Display Action Functions}). +@code{display-buffer-pop-up-frame} action function. The value should be a function that takes no arguments and returns a frame, or @code{nil} if no frame could be created. The default value @@ -3032,9 +3019,8 @@ Parameters}), which is used by the function specified by @code{nil}. This option is provided for backward compatibility only. Note, that -when @code{display-buffer-pop-up-frame} (@pxref{Buffer Display Action -Functions}) calls the function specified by -@code{pop-up-frame-function}, it prepends the value of all +when @code{display-buffer-pop-up-frame} calls the function specified +by @code{pop-up-frame-function}, it prepends the value of all @code{pop-up-frame-parameters} action alist entries to @code{pop-up-frame-alist} so that the values specified by the action alist entry effectively override any corresponding values of @@ -3111,6 +3097,7 @@ specifying the action function @code{display-buffer-same-window}. @subsection Precedence of Action Functions @cindex precedence of buffer display action functions @cindex execution order of buffer display action functions +@cindex buffer display action functions, precedence From the past subsections we already know that @code{display-buffer} must be supplied with a number of display actions (@pxref{Choosing @@ -3132,7 +3119,7 @@ Consider the following form: @noindent Evaluating this form in the buffer @file{*scratch*} of an uncustomized Emacs session will usually fail to reuse a window that shows -@file{*foo*} already but succeed in popping up a new window. +@file{*foo*} already, but succeed in popping up a new window. Evaluating the same form again will now not cause any visible changes---@code{display-buffer} reused the window already showing @file{*foo*} because that action was applicable and had the highest @@ -3157,13 +3144,13 @@ already shown @file{*foo*} previously and was therefore chosen instead of some other window. So far we have only observed the default behavior in an uncustomized -Emacs session. To see how this behavior can be customized let's +Emacs session. To see how this behavior can be customized, let's consider the option @code{display-buffer-base-action}. It provides a very coarse customization which conceptually affects the display of @emph{any} buffer. It can be used to supplement the actions supplied by @code{display-buffer-fallback-action} by reordering them or by adding actions that are not present there but fit more closely the -user's editing practice. It can be, however, also used to change the +user's editing practice. However, it can also be used to change the default behavior in a more profound way. Let's consider a user who, as a rule, prefers to display buffers on @@ -3179,7 +3166,7 @@ another frame. Such a user might provide the following customization: @end example @noindent -This setting will cause@code{display-buffer} to first try to find a +This setting will cause @code{display-buffer} to first try to find a window showing the buffer on a visible or iconified frame and, if no such frame exists, pop up a new frame. You can observe this behavior on a graphical system by typing @w{@kbd{C-x 1}} in the window showing @@ -3191,8 +3178,8 @@ the new frame (usually raising the frame and giving it focus too). Only if creating a new frame fails, @code{display-buffer} will apply the actions supplied by @code{display-buffer-fallback-action} -which means to again try to reuse a window, pop up a new window and so -on. A trivial way to make frame creation fail is supplied by the +which means to again try reusing a window, popping up a new window and +so on. A trivial way to make frame creation fail is supplied by the following form: @example @@ -3213,7 +3200,7 @@ tried there anyway. However, that would fail because due to the precedence of @code{display-buffer-base-action} over @code{display-buffer-fallback-action}, at that time @code{display-buffer-pop-up-frame} would have already won the race. -In fact +In fact, this: @example @group @@ -3231,13 +3218,13 @@ which is probably not what our user wants. default behavior of @code{display-buffer}. Let us now see how @emph{applications} can change the course of @code{display-buffer}. The canonical way to do that is to use the @var{action} argument of -@code{display-buffer} or a function that calls it like, for example, +@code{display-buffer} or a function that calls it, like, for example, @code{pop-to-buffer} (@pxref{Switching Buffers}). Suppose an application wants to display @file{*foo*} preferably below the selected window (to immediately attract the attention of the user to the new window) or, if that fails, in a window at the bottom -of the frame. It could do that with a call like +of the frame. It could do that with a call like this: @example @group @@ -3250,8 +3237,8 @@ of the frame. It could do that with a call like @noindent In order to see how this new, modified form works, delete any frame showing @file{*foo*}, type @w{@kbd{C-x 1}} followed by @w{@kbd{C-x 2}} in the -window showing @file{*scratch*} and subsequently evaluate that form. -@code{display-buffer} should split the upper window and show +window showing @file{*scratch*}, and subsequently evaluate that form. +@code{display-buffer} should split the upper window, and show @file{*foo*} in the new window. Alternatively, if after @w{@kbd{C-x 2}} you had typed @w{@kbd{C-x o}}, @code{display-buffer} would have split the window at the bottom instead. @@ -3269,7 +3256,7 @@ by the @var{action} argument try to reuse such a window first. By setting the @var{action} argument, an application effectively overrules any customization of @code{display-buffer-base-action}. Our -user can now either accept the choice of the application or redouble +user can now either accept the choice of the application, or redouble by customizing the option @code{display-buffer-alist} as follows: @example @@ -3320,9 +3307,9 @@ preferred way regardless of whether the display is also guided by an We can, however, reasonably conclude that customizing @code{display-buffer-alist} differs from customizing -@code{display-buffer-base-action} in two major aspects: It is stronger +@code{display-buffer-base-action} in two major aspects: it is stronger because it overrides the @var{action} argument of -@code{display-buffer}. And it allows to explicitly specify the +@code{display-buffer}, and it allows to explicitly specify the affected buffers. In fact, displaying other buffers is not affected in any way by a customization for @file{*foo*}. For example, @@ -3382,7 +3369,7 @@ explaining who added this and the subsequent elements) is: @end example @noindent -Note that among the internal functions listed here +Note that among the internal functions listed here, @code{display-buffer--maybe-same-window} is effectively ignored while @code{display-buffer--maybe-pop-up-frame-or-window} actually runs @code{display-buffer-pop-up-window}. @@ -3398,7 +3385,7 @@ The action alist passed in each function call is: @noindent which shows that we have used the second specification of -@code{display-buffer-alist} above overriding the specification +@code{display-buffer-alist} above, overriding the specification supplied by @code{display-buffer-base-action}. Suppose our user had written that as @@ -3432,7 +3419,7 @@ regard, the application would have to specify an appropriate @noindent This last example shows that while the precedence order of action -functions is fixed as described in @ref{Choosing Window}, an action +functions is fixed, as described in @ref{Choosing Window}, an action alist entry specified by a display action ranked lower in that order can affect the execution of a higher ranked display action. @@ -3468,13 +3455,13 @@ layouts. back on a split & delete windows metaphor is not a good idea either. Buffer display functions give Lisp programs and users a framework to reconcile their different needs; no comparable framework exists for -splitting and deleting windows. They also allow to at least partially -restore the layout of a frame when removing a buffer from it later -(@pxref{Quitting Windows}). +splitting and deleting windows. Buffer display functions also allow +to at least partially restore the layout of a frame when removing a +buffer from it later (@pxref{Quitting Windows}). Below we will give a number of guidelines to redeem the frustration -mentioned above and thus to avoid that buffers literally get lost in -between the windows of a frame. +mentioned above and thus to avoid literally losing buffers in-between +the windows of a frame. @table @asis @item Write display actions without stress @@ -3499,7 +3486,7 @@ also the last example of the preceding subsection. @end example @noindent -on the other hand specifies one action function and an empty action +on the other hand, specifies one action function and an empty action alist. To combine the effects of the above two specifications one would write the form @@ -3588,7 +3575,7 @@ Options}). This was one major reason for redesigning @code{display-buffer}---to provide a clear framework specifying what users and applications should be allowed to do. - Lisp Programs must be prepared that a user's customizations may + Lisp programs must be prepared that user customizations may cause buffers to get displayed in an unexpected way. They should never assume in their subsequent behavior, that the buffer has been shown precisely the way they asked for in the @var{action} argument of @@ -3597,11 +3584,11 @@ shown precisely the way they asked for in the @var{action} argument of Users should not pose too many and too severe restrictions on how arbitrary buffers get displayed. Otherwise, they will risk to lose the characteristics of showing a buffer for a certain purpose. -Suppose an lisp program has been written to compare different versions +Suppose a Lisp program has been written to compare different versions of a buffer in two windows side-by-side. If the customization of @code{display-buffer-alist} prescribes that any such buffer should be -always shown in or below the selected window, the lisp program will -have a hard time to set up the desired window configuration via +always shown in or below the selected window, the program will have a +hard time to set up the desired window configuration via @code{display-buffer}. To specify a preference for showing an arbitrary buffer, users @@ -3611,7 +3598,7 @@ in the previous subsection. @code{display-buffer-alist} should be reserved for displaying specific buffers in a specific way. @item Consider reusing a window that already shows the buffer -Generally, it's always a good idea for users and lisp program +Generally, it's always a good idea for users and Lisp programmers to be prepared for the case that a window already shows the buffer in question and to reuse that window. In the preceding subsection we have shown that failing to do so properly may cause @@ -3655,19 +3642,19 @@ configurations. To produce a window configuration displaying multiple buffers (or different views of one and the same buffer) in one and the same -display cycle, lisp program programmers will unavoidably have to write +display cycle, Lisp programmers will unavoidably have to write their own action functions. A few tricks listed below might help in this regard. @itemize @bullet @item -Making windows atomic (@pxref{Atomic Windows}) avoids that an -existing window composition gets broken when popping up a new window. +Making windows atomic (@pxref{Atomic Windows}) avoids breaking an +existing window composition when popping up a new window. The new window will pop up outside the composition instead. @item Temporarily dedicating windows to their buffers (@pxref{Dedicated -Windows}) avoids that a window gets used for displaying a different +Windows}) avoids using a window for displaying a different buffer. A non-dedicated window will be used instead. @item @@ -3679,8 +3666,8 @@ the same combination can be shrunk instead, though. @item Side windows (@pxref{Side Windows}) can be used for displaying specific buffers always in a window at the same position of a frame. -This permits to group buffers that do not compete for being shown at -the same time on a frame and show any such buffer in the same window +This permits grouping buffers that do not compete for being shown at +the same time on a frame and showing any such buffer in the same window without disrupting the display of other buffers. @item commit 19d2ba00596b8ee31cff046b2387580b016fa4c5 Author: Eli Zaretskii Date: Sun Nov 4 16:01:09 2018 +0200 A further fix for locally remapped fringe face * src/xdisp.c (expose_window): Temporarily switch to the window's buffer, in case the fringe face was remapped locally in that buffer. (Bug#33244) diff --git a/src/xdisp.c b/src/xdisp.c index 7b0ca47722..fa7691cdd0 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -32252,6 +32252,18 @@ expose_window (struct window *w, XRectangle *fr) y0 or y1 is negative (can happen for tall images). */ int r_bottom = r.y + r.height; + /* We must temporarily switch to the window's buffer, in case + the fringe face has been remapped in that buffer's + face-remapping-alist, so that draw_row_fringe_bitmaps, + called from expose_line, will use the right face. */ + bool buffer_changed = false; + struct buffer *oldbuf = current_buffer; + if (!w->pseudo_window_p) + { + set_buffer_internal_1 (XBUFFER (w->contents)); + buffer_changed = true; + } + /* Update lines intersecting rectangle R. */ first_overlapping_row = last_overlapping_row = NULL; for (row = w->current_matrix->rows; @@ -32297,6 +32309,9 @@ expose_window (struct window *w, XRectangle *fr) break; } + if (buffer_changed) + set_buffer_internal_1 (oldbuf); + /* Display the mode line if there is one. */ if (window_wants_mode_line (w) && (row = MATRIX_MODE_LINE_ROW (w->current_matrix), commit d10036d73759234d67cb587e1876fbfbf7483e83 Author: Michael Albinus Date: Sun Nov 4 12:51:39 2018 +0100 Fix Bug#33194 * lisp/autorevert.el (auto-revert-notify-add-watch): Handle buffers with same descriptor properly. (auto-revert-notify-handler): Handle all buffers with same descriptor. (Bug#33194) * lisp/filenotify.el (file-notify-callback): Simplify. diff --git a/lisp/autorevert.el b/lisp/autorevert.el index fc3469e03d..2cf5b427ea 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -515,32 +515,43 @@ will use an up-to-date value of `auto-revert-interval'" (defun auto-revert-notify-add-watch () "Enable file notification for current buffer's associated file." - ;; We can assume that `buffer-file-name' and - ;; `auto-revert-notify-watch-descriptor' are non-nil. + ;; We can assume that `auto-revert-notify-watch-descriptor' is nil. (unless (or auto-revert-notify-watch-descriptor (string-match auto-revert-notify-exclude-dir-regexp (expand-file-name default-directory)) (file-symlink-p (or buffer-file-name default-directory))) - (setq auto-revert-notify-watch-descriptor - (ignore-errors - (if buffer-file-name - (file-notify-add-watch - (expand-file-name buffer-file-name default-directory) - '(change attribute-change) - 'auto-revert-notify-handler) - (file-notify-add-watch - (expand-file-name default-directory) - '(change) - 'auto-revert-notify-handler)))) - (when auto-revert-notify-watch-descriptor - (setq auto-revert-notify-modified-p t) - (puthash - auto-revert-notify-watch-descriptor - (cons (current-buffer) - (gethash auto-revert-notify-watch-descriptor - auto-revert-notify-watch-descriptor-hash-list)) + ;; Check, whether this has been activated already. + (let ((file (if buffer-file-name + (expand-file-name buffer-file-name default-directory) + (expand-file-name default-directory)))) + (maphash + (lambda (key _value) + (when (and + (equal (file-notify--watch-absolute-filename + (gethash key file-notify-descriptors)) + (directory-file-name file)) + (equal (file-notify--watch-callback + (gethash key file-notify-descriptors)) + 'auto-revert-notify-handler)) + (setq auto-revert-notify-watch-descriptor key))) auto-revert-notify-watch-descriptor-hash-list) - (add-hook 'kill-buffer-hook #'auto-revert-notify-rm-watch nil t)))) + ;; Create a new watch if needed. + (unless auto-revert-notify-watch-descriptor + (setq auto-revert-notify-watch-descriptor + (ignore-errors + (file-notify-add-watch + file + (if buffer-file-name '(change attribute-change) '(change)) + 'auto-revert-notify-handler)))) + (when auto-revert-notify-watch-descriptor + (setq auto-revert-notify-modified-p t) + (puthash + auto-revert-notify-watch-descriptor + (cons (current-buffer) + (gethash auto-revert-notify-watch-descriptor + auto-revert-notify-watch-descriptor-hash-list)) + auto-revert-notify-watch-descriptor-hash-list) + (add-hook 'kill-buffer-hook #'auto-revert-notify-rm-watch nil t))))) ;; If we have file notifications, we want to update the auto-revert buffers ;; immediately when a notification occurs. Since file updates can happen very @@ -626,10 +637,7 @@ no more reverts are possible until the next call of auto-revert-buffers-counter) (auto-revert-handler) (setq auto-revert-buffers-counter-lockedout - auto-revert-buffers-counter)) - - ;; No need to check other buffers. - (cl-return))))))))) + auto-revert-buffers-counter)))))))))) (defun auto-revert-active-p () "Check if auto-revert is active (in current buffer or globally)." diff --git a/lisp/filenotify.el b/lisp/filenotify.el index 59a8c0e88a..a133f9ea7e 100644 --- a/lisp/filenotify.el +++ b/lisp/filenotify.el @@ -45,11 +45,11 @@ could use another implementation.") (:constructor nil) (:constructor file-notify--watch-make (directory filename callback))) - ;; Watched directory + ;; Watched directory. directory ;; Watched relative filename, nil if watching the directory. filename - ;; Function to propagate events to + ;; Function to propagate events to. callback) (defun file-notify--watch-absolute-filename (watch) @@ -242,11 +242,10 @@ EVENT is the cadr of the event in `file-notify-handle-event' ;;(message ;;"file-notify-callback %S %S %S %S %S" ;;desc action file file1 watch) - (if file1 - (funcall (file-notify--watch-callback watch) - `(,desc ,action ,file ,file1)) - (funcall (file-notify--watch-callback watch) - `(,desc ,action ,file)))) + (funcall (file-notify--watch-callback watch) + (if file1 + `(,desc ,action ,file ,file1) + `(,desc ,action ,file)))) ;; Send `stopped' event. (when (or stopped commit c04b48c0883d839f386a1f2921503837b7673062 Author: Martin Rudalics Date: Sun Nov 4 09:15:13 2018 +0100 Rewrite documentation of buffer display * doc/emacs/windows.texi (Window Choice): Rewrite, replacing references to older buffer display options with references to and examples of buffer display actions. (Temporary Displays): Rewrite display of *Completions* example. * doc/lispref/elisp.texi (Top): New Windows section 'Displaying Buffers'. * doc/lispref/frames.texi (Child Frames): Adjust cross reference. * doc/lispref/windows.texi (Windows): New section 'Displaying Buffers'. Move sections 'Choosing Window', 'Display Action Functions' and 'Choosing Window Options' there and adjust namings. Preferably write 'Buffer Display Action' instead of 'Display Action'. More consistently use @w{} to make key binding specifications unsplittable. (Displaying Buffers): New section. (Choosing Window): Make it a subsection of 'Displaying Buffers'. More explicitly describe how 'display-buffer' compiles its list of action functions and the action alist. (Buffer Display Action Functions): Rename from 'Display Action Functions', make it a subsection of 'Displaying Buffers' and rewrite it. Elide more detailed descriptions of action alist entries; these are now in the new section 'Buffer Display Action Functions'. Remove example. (Buffer Display Action Alists): New subsection of 'Displaying Buffers' giving a comprehensive description of recognized action alist entries with appropriate indexing. Contents were partially moved here from the old 'Display Action Functions' section. (Choosing Window Options): Make it a subsection of 'Displaying Buffers'. Add examples of how to rewrite old buffer display options with the help of buffer display actions. (Precedence of Action Functions): New subsection of 'Displaying Buffers' explaining the execution order of action functions with the help of a detailed example. (The Zen of Buffer Display): New subsection of 'Displaying Buffers' supplying guidelines on how to write and use buffer display actions with examples. (Side Windows, Displaying Buffers in Side Windows) (Frame Layouts with Side Windows, Atomic Windows): Update references to the 'Displaying Buffers' subsections. diff --git a/doc/emacs/windows.texi b/doc/emacs/windows.texi index 7dbd680b9b..b09c9ae689 100644 --- a/doc/emacs/windows.texi +++ b/doc/emacs/windows.texi @@ -48,8 +48,8 @@ other windows at all. However, there are other commands such as @kbd{C-x 4 b} that select a different window and switch buffers in it. Also, all commands that display information in a window, including (for example) @kbd{C-h f} (@code{describe-function}) and @kbd{C-x C-b} -(@code{list-buffers}), work by switching buffers in a nonselected -window without affecting the selected window. +(@code{list-buffers}), usually work by displaying buffers in a +nonselected window without affecting the selected window. When multiple windows show the same buffer, they can have different regions, because they can have different values of point. However, @@ -340,11 +340,9 @@ heights of all the windows in the selected frame. in response to a user command. There are several different ways in which commands do this. - Many commands, like @kbd{C-x C-f} (@code{find-file}), display the -buffer by ``taking over'' the selected window, expecting that the -user's attention will be diverted to that buffer. These commands -usually work by calling @code{switch-to-buffer} internally -(@pxref{Select Buffer}). + Many commands, like @kbd{C-x C-f} (@code{find-file}), by default +display the buffer by ``taking over'' the selected window, expecting +that the user's attention will be diverted to that buffer. Some commands try to display intelligently, trying not to take over the selected window, e.g., by splitting off a new window and @@ -367,10 +365,9 @@ key (@pxref{Pop Up Window}). Commands with names ending in @code{-other-frame} behave like @code{display-buffer}, except that they (i) never display in the -selected window and (ii) prefer to create a new frame to display the -desired buffer instead of splitting a window---as though the variable -@code{pop-up-frames} is set to @code{t} (@pxref{Window Choice}). -Several of these commands are bound in the @kbd{C-x 5} prefix key. +selected window and (ii) prefer to either create a new frame or use a +window on some other frame to display the desired buffer. Several of +these commands are bound in the @kbd{C-x 5} prefix key. @menu * Window Choice:: How @code{display-buffer} works. @@ -383,33 +380,61 @@ Several of these commands are bound in the @kbd{C-x 5} prefix key. The @code{display-buffer} command (as well as commands that call it internally) chooses a window to display by following the steps given -below. @xref{Choosing Window,,Choosing a Window for Display, elisp, -The Emacs Lisp Reference Manual}, for details about how to alter this -sequence of steps. +below. @xref{Choosing Window,,Choosing a Window for Displaying a +Buffer, elisp, The Emacs Lisp Reference Manual}, for details about how +to alter this sequence of steps. @itemize -@vindex same-window-buffer-names -@vindex same-window-regexps @item First, check if the buffer should be displayed in the selected window regardless of other considerations. You can tell Emacs to do this by -adding the desired buffer's name to the list -@code{same-window-buffer-names}, or adding a matching regular -expression to the list @code{same-window-regexps}. By default, these -variables are @code{nil}, so this step is skipped. +adding a regular expression matching the buffer's name together with a +reference to the @code{display-buffer-same-window} action function +(@pxref{Buffer Display Action Functions,,Action Functions for Buffer +Display, elisp, The Emacs Lisp Reference Manual}) to the option +@code{display-buffer-alist} (@pxref{Choosing Window,,Choosing a Window +for Displaying a Buffer, elisp, The Emacs Lisp Reference Manual}). +For example, to display the buffer @file{*scratch*} preferably in the +selected window write: + +@example +@group +(customize-set-variable + 'display-buffer-alist + '("\\*scratch\\*" (display-buffer-same-window))) +@end group +@end example + +By default, @code{display-buffer-alist} is @code{nil}, so this step is +skipped. @item Otherwise, if the buffer is already displayed in an existing window, -reuse that window. Normally, only windows on the selected frame -are considered, but windows on other frames are also reusable if you -change @code{pop-up-frames} (see below) to @code{t}. +reuse that window. Normally, only windows on the selected frame are +considered, but windows on other frames are also reusable if a +corresponding @code{reusable-frames} action alist entry (@pxref{Buffer +Display Action Alists,,Action Alists for Buffer Display, elisp, The +Emacs Lisp Reference Manual}) is used (see the next step for an +example of how to do that). -@vindex pop-up-frames @item Otherwise, optionally create a new frame and display the buffer there. -By default, this step is skipped. To enable it, change the variable -@code{pop-up-frames} to a non-@code{nil} value. The special value -@code{graphic-only} means to do this only on graphical displays. +By default, this step is skipped. To enable it, change the value of +the option @code{display-buffer-base-action} (@pxref{Choosing +Window,,Choosing a Window for Displaying a Buffer, elisp, The Emacs +Lisp Reference Manual}) as follows: + +@example +@group +(customize-set-variable + 'display-buffer-base-action + '((display-buffer-reuse-window display-buffer-pop-up-frame) + (reusable-frames . 0))) +@end group +@end example + +This customization will also try to make the preceding step search for +a reusable window on all visible of iconified frames @item Otherwise, try to create a new window by splitting a window on the @@ -429,9 +454,9 @@ window was not split before (to avoid excessive splitting). @item Otherwise, display the buffer in a window previously showing it. -Normally, only windows on the selected frame are considered, but if -@code{pop-up-frames} is non-@code{nil} the window may be also on another -frame. +Normally, only windows on the selected frame are considered, but with +a suitable @code{reusable-frames} action alist entry (see above) the +window may be also on another frame. @item Otherwise, display the buffer in an existing window on the selected @@ -442,14 +467,9 @@ If all the above methods fail for whatever reason, create a new frame and display the buffer there. @end itemize -A more advanced and flexible way to customize the behavior of -@code{display-buffer} is by using the option @code{display-buffer-alist} -mentioned in the next section. - @node Temporary Displays @subsection Displaying non-editable buffers. -@cindex pop-up windows @cindex temporary windows Some buffers are shown in windows for perusal rather than for editing. @@ -459,24 +479,24 @@ buffer called @file{*Completions*} instead. Such buffers are usually displayed only for a short period of time. Normally, Emacs chooses the window for such temporary displays via -@code{display-buffer} as described above. The @file{*Completions*} -buffer, on the other hand, is normally displayed in a window at the -bottom of the selected frame, regardless of the number of windows -already shown on that frame. +@code{display-buffer} as described in the previous subsection. The +@file{*Completions*} buffer, on the other hand, is normally displayed +in a window at the bottom of the selected frame, regardless of the +number of windows already shown on that frame. If you prefer Emacs to display a temporary buffer in a different fashion, we recommend customizing the variable @code{display-buffer-alist} (@pxref{Choosing Window,,Choosing a Window -for Display, elisp, The Emacs Lisp Reference Manual}). For example, -to display @file{*Completions*} by splitting a window as described in -the previous section, use the following form in your initialization -file (@pxref{Init File}): +for Displaying a Buffer, elisp, The Emacs Lisp Reference Manual}). +For example, to display @file{*Completions*} always below the selected +window, use the following form in your initialization file +(@pxref{Init File}): @example @group (customize-set-variable 'display-buffer-alist - '(("\\*Completions\\*" display-buffer-pop-up-window))) + '(("\\*Completions\\*" display-buffer-below-selected))) @end group @end example diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index 7dd1e89de5..05066a2007 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -1043,9 +1043,7 @@ Windows * Cyclic Window Ordering:: Moving around the existing windows. * Buffers and Windows:: Each window displays the contents of a buffer. * Switching Buffers:: Higher-level functions for switching to a buffer. -* Choosing Window:: How to choose a window for displaying a buffer. -* Display Action Functions:: Subroutines for @code{display-buffer}. -* Choosing Window Options:: Extra options affecting how buffers are displayed. +* Displaying Buffers:: Displaying a buffer in a suitable window. * Window History:: Each window remembers the buffers displayed in it. * Dedicated Windows:: How to avoid displaying another buffer in a specific window. @@ -1067,6 +1065,18 @@ Windows redisplay going past a certain point, or window configuration changes. +Displaying Buffers + +* Choosing Window:: How to choose a window for displaying a buffer. +* Buffer Display Action Functions:: Support functions for buffer display. +* Buffer Display Action Alists:: Alists for fine-tuning buffer display + action functions. +* Choosing Window Options:: Extra options affecting how buffers are displayed. +* Precedence of Action Functions:: A tutorial explaining the precedence of + buffer display action functions. +* The Zen of Buffer Display:: How to avoid that buffers get lost in between + windows. + Side Windows * Displaying Buffers in Side Windows:: An action function for displaying diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 1e008da247..e95a684912 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -3198,11 +3198,11 @@ and should be preferred when specifying a non-@code{nil} @code{drag-with-mode-line} parameter. When a child frame is used for displaying a buffer via -@code{display-buffer-in-child-frame} (@pxref{Display Action Functions}), -the frame's @code{auto-hide-function} parameter (@pxref{Frame -Interaction Parameters}) can be set to a function, in order to -appropriately deal with the frame when the window displaying the buffer -shall be quit. +@code{display-buffer-in-child-frame} (@pxref{Buffer Display Action +Functions}), the frame's @code{auto-hide-function} parameter +(@pxref{Frame Interaction Parameters}) can be set to a function, in +order to appropriately deal with the frame when the window displaying +the buffer shall be quit. When a child frame is used during minibuffer interaction, for example, to display completions in a separate window, the @code{minibuffer-exit} diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 960573d865..7f2dff1753 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -25,9 +25,7 @@ is displayed in windows. * Cyclic Window Ordering:: Moving around the existing windows. * Buffers and Windows:: Each window displays the contents of a buffer. * Switching Buffers:: Higher-level functions for switching to a buffer. -* Choosing Window:: How to choose a window for displaying a buffer. -* Display Action Functions:: Subroutines for @code{display-buffer}. -* Choosing Window Options:: Extra options affecting how buffers are displayed. +* Displaying Buffers:: Displaying a buffer in a suitable window. * Window History:: Each window remembers the buffers displayed in it. * Dedicated Windows:: How to avoid displaying another buffer in a specific window. @@ -1542,11 +1540,11 @@ direction as the existing window combination (otherwise, a new internal window is created anyway). @item window-size -This means that @code{display-buffer} makes a new parent window when it -splits a window and is passed a @code{window-height} or -@code{window-width} entry in the @var{alist} argument (@pxref{Display -Action Functions}). Otherwise, window splitting behaves as for a value -of @code{nil}. +This means that @code{display-buffer} makes a new parent window when +it splits a window and is passed a @code{window-height} or +@code{window-width} entry in the @var{alist} argument (@pxref{Buffer +Display Action Functions}). Otherwise, window splitting behaves as +for a value of @code{nil}. @item temp-buffer-resize In this case @code{with-temp-buffer-window} makes a new parent window @@ -1879,7 +1877,7 @@ most recently used one (@pxref{Cyclic Window Ordering}). @cindex ordering of windows, cyclic @cindex window ordering, cyclic - When you use the command @kbd{C-x o} (@code{other-window}) to select + When you use the command @w{@kbd{C-x o}} (@code{other-window}) to select some other window, it moves through live windows in a specific order. For any given configuration of windows, this order never varies. It is called the @dfn{cyclic ordering of windows}. @@ -1899,7 +1897,7 @@ if omitted or @code{nil}, it defaults to the selected window. The optional argument @var{minibuf} specifies whether minibuffer windows should be included in the cyclic ordering. Normally, when @var{minibuf} is @code{nil}, a minibuffer window is included only if it is currently -active; this matches the behavior of @kbd{C-x o}. (Note that a +active; this matches the behavior of @w{@kbd{C-x o}}. (Note that a minibuffer window is active as long as its minibuffer is in use; see @ref{Minibuffers}). @@ -2083,7 +2081,8 @@ variables in the specified buffer. However, if the optional argument @var{keep-margins} is non-@code{nil}, it leaves @var{window}'s display margins, fringes and scroll bar settings alone. -When writing an application, you should normally use the higher-level +When writing an application, you should normally use +@code{display-buffer} (@pxref{Choosing Window}) or the higher-level functions described in @ref{Switching Buffers}, instead of calling @code{set-window-buffer} directly. @@ -2168,7 +2167,6 @@ frame on its terminal, the buffer is replaced anyway. @node Switching Buffers @section Switching to a Buffer in a Window @cindex switching to a buffer -@cindex displaying a buffer This section describes high-level functions for switching to a specified buffer in some window. In general, ``switching to a buffer'' means to @@ -2327,32 +2325,71 @@ unless @var{norecord} is non-@code{nil}. @end deffn +@node Displaying Buffers +@section Displaying a Buffer in a Suitable Window +@cindex buffer display +@cindex displaying a buffer + +This section describes lower-level functions Emacs uses to find or +create a window for displaying a specified buffer. The common +workhorse of these functions is @code{display-buffer} which eventually +handles all incoming requests for buffer display (@pxref{Choosing +Window}). + + @code{display-buffer} delegates the task of finding a suitable +window to so-called action functions (@pxref{Buffer Display Action +Functions}). Before, @code{display-buffer} compiles a so-called +action alist---a special association list action functions can use to +fine-tune their behavior--- and passes that alist on to each action +function it calls (@pxref{Buffer Display Action Alists}). + + The behavior of @code{display-buffer} is highly customizable. To +understand how customizations are put into practice, readers may want +to study examples illustrating the precedence acquired by +@code{display-buffer} for calling action functions (@pxref{Precedence +of Action Functions}). To avoid that Lisp programs calling +@code{display-buffer} come into conflict with users customizing its +behavior, it may make sense to follow a number of guidelines which are +sketched in the final part of this section (@pxref{The Zen of Buffer +Display}). + +@menu +* Choosing Window:: How to choose a window for displaying a buffer. +* Buffer Display Action Functions:: Support functions for buffer display. +* Buffer Display Action Alists:: Alists for fine-tuning buffer display. +* Choosing Window Options:: Extra options affecting how buffers are displayed. +* Precedence of Action Functions:: Examples to explain the precedence of + action functions. +* The Zen of Buffer Display:: How to avoid that buffers get lost in between + windows. +@end menu + + @node Choosing Window -@section Choosing a Window for Display +@subsection Choosing a Window for Displaying a Buffer - The command @code{display-buffer} flexibly chooses a window for +The command @code{display-buffer} flexibly chooses a window for display, and displays a specified buffer in that window. It can be called interactively, via the key binding @kbd{C-x 4 C-o}. It is also used as a subroutine by many functions and commands, including @code{switch-to-buffer} and @code{pop-to-buffer} (@pxref{Switching Buffers}). +@cindex buffer display display action @cindex display action -@cindex action function, for @code{display-buffer} -@cindex action alist, for @code{display-buffer} This command performs several complex steps to find a window to display in. These steps are described by means of @dfn{display actions}, which have the form @code{(@var{function} . @var{alist})}. Here, @var{function} is either a function or a list of functions, -which we refer to as @dfn{action functions}; @var{alist} is an -association list, which we refer to as an @dfn{action alist}. +which we refer to as ``action functions'' (@pxref{Buffer Display +Action Functions}); @var{alist} is an association list, which we refer +to as ``action alist'' (@pxref{Buffer Display Action Alists}). See +@ref{The Zen of Buffer Display}, for samples of display actions. An action function accepts two arguments: the buffer to display and an action alist. It attempts to display the buffer in some window, picking or creating a window according to its own criteria. If successful, it returns the window; otherwise, it returns @code{nil}. -@xref{Display Action Functions}, for a list of predefined action -functions. @code{display-buffer} works by combining display actions from several sources, and calling the action functions in turn, until one @@ -2364,11 +2401,13 @@ This command makes @var{buffer-or-name} appear in some window, without selecting the window or making the buffer current. The argument @var{buffer-or-name} must be a buffer or the name of an existing buffer. The return value is the window chosen to display the buffer. +It is @code{nil} if no suitable window was found. The optional argument @var{action}, if non-@code{nil}, should normally be a display action (described above). @code{display-buffer} builds a list of action functions and an action alist, by consolidating display -actions from the following sources (in order): +actions from the following sources (in order of their precedence, +highest ranking first): @itemize @item @@ -2388,24 +2427,49 @@ The constant @code{display-buffer-fallback-action}. @end itemize @noindent -Each action function is called in turn, passing the buffer as the -first argument and the combined action alist as the second argument, -until one of the functions returns non-@code{nil}. The caller can -pass @code{(allow-no-window . t)} as an element of the action alist to -indicate its readiness to handle the case of not displaying the -buffer in a window. +In practice this means that @code{display-buffer} builds a list of all +action functions specified by these display actions. The first +element of this list is the first action function specified by +@code{display-buffer-overriding-action}, if any. Its last element is +@code{display-buffer-pop-up-frame}---the last action function +specified by @code{display-buffer-fallback-action}. Duplicates are +not removed from this list---hence one and the same action function +may be called multiple times during one call of @code{display-buffer}. + +@code{display-buffer} calls the action functions specified by this +list in turn, passing the buffer as the first argument and the +combined action alist as the second argument, until one of the +functions returns non-@code{nil}. See @ref{Precedence of Action +Functions}, for examples how display actions specified by different +sources are processed by @code{display-buffer}. + +Note that the second argument is always the list of @emph{all} action +alist entries specified by the sources named above. Hence, the first +element of that list is the first action alist entry specified by +@code{display-buffer-overriding-action}, if any. Its last element is +the last alist entry of @code{display-buffer-base-action}, if any (the +action alist of @code{display-buffer-fallback-action} is empty). + +Note also, that the combined action alist may contain duplicate +entries and entries for the same key with different values. As a +rule, action functions always use the first association of a key they +find. Hence, the association an action function uses is not +necessarily the association provided by the display action that +specified that action function, The argument @var{action} can also have a non-@code{nil}, non-list value. This has the special meaning that the buffer should be displayed in a window other than the selected one, even if the selected window is already displaying it. If called interactively -with a prefix argument, @var{action} is @code{t}. +with a prefix argument, @var{action} is @code{t}. Lisp programs +should always supply a list value. The optional argument @var{frame}, if non-@code{nil}, specifies which frames to check when deciding whether the buffer is already displayed. It is equivalent to adding an element @code{(reusable-frames -. @var{frame})} to the action alist of @var{action}. @xref{Display -Action Functions}. +. @var{frame})} to the action alist of @var{action} (@pxref{Buffer +Display Action Alists}). The @var{frame} argument is provided for +compatibility reasons, Lisp programs should not use it. @end deffn @defvar display-buffer-overriding-action @@ -2418,10 +2482,10 @@ default value is empty, i.e., @code{(nil . nil)}. The value of this option is an alist mapping conditions to display actions. Each condition may be either a regular expression matching a buffer name or a function that takes two arguments: a buffer name and -the @var{action} argument passed to @code{display-buffer}. If the name -of the buffer passed to @code{display-buffer} either matches a regular -expression in this alist or the function specified by a condition -returns non-@code{nil}, then @code{display-buffer} uses the +the @var{action} argument passed to @code{display-buffer}. If the +name of the buffer passed to @code{display-buffer} either matches a +regular expression in this alist or the function specified by a +condition returns non-@code{nil}, then @code{display-buffer} uses the corresponding display action to display the buffer. @end defopt @@ -2437,73 +2501,126 @@ This display action specifies the fallback behavior for @end defvr -@node Display Action Functions -@section Action Functions for @code{display-buffer} +@node Buffer Display Action Functions +@subsection Action Functions for Buffer Display +@cindex buffer display action function +@cindex action function, for buffer display + +An @dfn{action function} is a function @code{display-buffer} calls for +choosing a window to display a buffer. Action functions take two +arguments: @var{buffer}, the buffer to display, and @var{alist}, an +action alist (@pxref{Buffer Display Action Alists}). They are +supposed to return a window displaying @var{buffer} if they succeed +and @code{nil} if they fail. -The following basic action functions are defined in Emacs. Each of -these functions takes two arguments: @var{buffer}, the buffer to -display, and @var{alist}, an action alist. Each action function -returns the window if it succeeds, and @code{nil} if it fails. + The following basic action functions are defined in Emacs. @defun display-buffer-same-window buffer alist This function tries to display @var{buffer} in the selected window. It fails if the selected window is a minibuffer window or is dedicated to another buffer (@pxref{Dedicated Windows}). It also fails if -@var{alist} has a non-@code{nil} @code{inhibit-same-window} entry. +@var{alist} has a non-@code{nil} @code{inhibit-same-window} entry +(@pxref{Buffer Display Action Alists}). @end defun @defun display-buffer-reuse-window buffer alist -This function tries to display @var{buffer} by finding a window -that is already displaying it. +This function tries to display @var{buffer} by finding a window that +is already displaying it. If @var{alist} has a non-@code{nil} @code{inhibit-same-window} entry, -the selected window is not eligible for reuse. If @var{alist} -contains a @code{reusable-frames} entry, its value determines which -frames to search for a reusable window: - -@itemize @bullet -@item -@code{nil} means consider windows on the selected frame. -(Actually, the last non-minibuffer frame.) -@item -@code{t} means consider windows on all frames. -@item -@code{visible} means consider windows on all visible frames. -@item -0 means consider windows on all visible or iconified frames. -@item -A frame means consider windows on that frame only. -@end itemize - -Note that these meanings differ slightly from those of the -@var{all-frames} argument to @code{next-window} (@pxref{Cyclic Window -Ordering}). - -If @var{alist} contains no @code{reusable-frames} entry, this function -normally searches just the selected frame; however, if the variable -@code{pop-up-frames} is non-@code{nil}, it searches all frames on the -current terminal. @xref{Choosing Window Options}. +the selected window is not eligible for reuse. The set of frames to +search for a window already displaying @var{buffer} can be specified +with the help of a @code{reusable-frames} action alist entry +(@pxref{Buffer Display Action Alists}). If @var{alist} contains no +@code{reusable-frames} entry, this function searches just the selected +frame. -If this function chooses a window on another frame, it makes that frame -visible and, unless @var{alist} contains an @code{inhibit-switch-frame} -entry (@pxref{Choosing Window Options}), raises that frame if necessary. +If this function chooses a window on another frame, it makes that +frame visible and, unless @var{alist} contains an +@code{inhibit-switch-frame} entry (@pxref{Buffer Display Action +Alists}), raises that frame if necessary. @end defun @defun display-buffer-reuse-mode-window buffer alist This function tries to display @var{buffer} by finding a window that is displaying a buffer in a given mode. -If @var{alist} contains a @code{mode} entry, its value is a major mode -(a symbol) or a list of major modes. If @var{alist} contains no -@code{mode} entry, the current major mode of @var{buffer} is used. A -window is a candidate if it displays a buffer that derives from one of -the given modes. +If @var{alist} contains a @code{mode} entry, its value specifes a +major mode (a symbol) or a list of major modes. If @var{alist} +contains no @code{mode} entry, the current major mode of @var{buffer} +is used instead. A window is a candidate if it displays a buffer +whose mode derives from one of the modes specified thusly. -The behavior is also controlled by entries for +The behavior is also controlled by @var{alist} entries for @code{inhibit-same-window}, @code{reusable-frames} and -@code{inhibit-switch-frame} as is done in the function -@code{display-buffer-reuse-window}. +@code{inhibit-switch-frame} (@pxref{Buffer Display Action Alists}) as +is done in the function @code{display-buffer-reuse-window}. +@end defun +@defun display-buffer-pop-up-window buffer alist +This function tries to display @var{buffer} by splitting the largest +or least recently-used window (usually located on the selected frame). +It actually performs the split by calling the function specified by +@code{split-window-preferred-function} (@pxref{Choosing Window +Options}). + +The size of the new window can be adjusted by supplying +@code{window-height} and @code{window-width} entries in @var{alist} +(@pxref{Buffer Display Action Alists}). If @var{alist} contains a +@code{preserve-size} entry, Emacs will also try to preserve the size +of the new window during future resize operations (@pxref{Preserving +Window Sizes}). + +This function fails if no window can be split. More often than not +this happens because no window is large enough to allow splitting. +Setting @code{split-height-threshold} or @code{split-width-threshold} +(@pxref{Choosing Window Options}) to lower values may help in this +regard. Spliting also fails when the selected frame has an +@code{unsplittable} frame parameter; @pxref{Buffer Parameters}. +@end defun + +@defun display-buffer-in-previous-window buffer alist +This function tries to display @var{buffer} in a window previously +showing it. If @var{alist} has a non-@code{nil} +@code{inhibit-same-window} entry, the selected window is not eligible +for reuse. If @var{alist} contains a @code{reusable-frames} entry, +its value determines which frames to search for a suitable window +(@pxref{Buffer Display Action Alists}). + +If @var{alist} has a @code{previous-window} entry and the window +specified by that entry is live and not dedicated to another buffer, +that window will be preferred, even if it never showed @var{buffer} +before. +@end defun + +@defun display-buffer-use-some-window buffer alist +This function tries to display @var{buffer} by choosing an existing +window and displaying the buffer in that window. It can fail if all +windows are dedicated to another buffer (@pxref{Dedicated Windows}). +@end defun + +@defun display-buffer-below-selected buffer alist +This function tries to display @var{buffer} in a window below the +selected window. If there is a window below the selected one and that +window already displays @var{buffer}, it reuses that window. + +If there is no such window, this function tries to create a new window +by splitting the selected one and display @var{buffer} there. It will +also try to adjust that window's size provided @var{alist} contains a +suitable @code{window-height} or @code{window-width} entry, see above. + +If splitting the selected window fails and there is a non-dedicated +window below the selected one showing some other buffer, it tries to +use that window for showing @var{buffer}. +@end defun + +@defun display-buffer-at-bottom buffer alist +This function tries to display @var{buffer} in a window at the bottom +of the selected frame. + +This either tries to split the window at the bottom of the frame or +the frame's root window, or to reuse an existing window at the bottom +of the selected frame. @end defun @defun display-buffer-pop-up-frame buffer alist @@ -2511,8 +2628,8 @@ This function creates a new frame, and displays the buffer in that frame's window. It actually performs the frame creation by calling the function specified in @code{pop-up-frame-function} (@pxref{Choosing Window Options}). If @var{alist} contains a -@code{pop-up-frame-parameters} entry, the associated value -is added to the newly created frame's parameters. +@code{pop-up-frame-parameters} entry, the associated value is added to +the newly created frame's parameters. @end defun @defun display-buffer-in-child-frame buffer alist @@ -2528,20 +2645,21 @@ corresponding entry must be added to @var{alist}. The appearance of child frames is largely dependent on the parameters provided via @var{alist}. It is advisable to use at least ratios to specify the size (@pxref{Size Parameters}) and the position -(@pxref{Position Parameters}) of the child frame and to add the -@code{keep-ratio} in order to make sure that the child frame remains -visible. For other parameters that should be considered see @ref{Child -Frames}. +(@pxref{Position Parameters}) of the child frame and to add a +@code{keep-ratio} parameter (@pxref{Frame Interaction Parameters}) in +order to make sure that the child frame remains visible. For other +parameters that should be considered see @ref{Child Frames}. @end defun @defun display-buffer-use-some-frame buffer alist -This function tries to display @var{buffer} by trying to find a -frame that meets a predicate (by default any frame other than the -current frame). +This function tries to display @var{buffer} by finding a frame that +meets a predicate (by default any frame other than the selected +frame). -If this function chooses a window on another frame, it makes that frame -visible and, unless @var{alist} contains an @code{inhibit-switch-frame} -entry (@pxref{Choosing Window Options}), raises that frame if necessary. +If this function chooses a window on another frame, it makes that +frame visible and, unless @var{alist} contains an +@code{inhibit-switch-frame} entry (@pxref{Buffer Display Action +Alists}), raises that frame if necessary. If @var{alist} has a non-@code{nil} @code{frame-predicate} entry, its value is a function taking one argument (a frame), returning @@ -2549,233 +2667,282 @@ non-@code{nil} if the frame is a candidate; this function replaces the default predicate. If @var{alist} has a non-@code{nil} @code{inhibit-same-window} entry, -the selected window is used; thus if the selected frame has a single -window, it is not used. +the selected window is not used; thus if the selected frame has a +single window, it is not used. @end defun -@defun display-buffer-pop-up-window buffer alist -This function tries to display @var{buffer} by splitting the largest -or least recently-used window (typically one on the selected frame). -It actually performs the split by calling the function specified in -@code{split-window-preferred-function} (@pxref{Choosing Window -Options}). +@defun display-buffer-no-window buffer alist +If @var{alist} has a non-@code{nil} @code{allow-no-window} entry, then +this function does not display @var{buffer} and returns the symbol +@code{fail}. This constitutes the only exception to the convention +that an action function returns either @code{nil} or a window showing +@var{buffer}. If @var{alist} has no such @code{allow-no-window} +entry, this function returns @code{nil}. + +If this function returns @code{fail}, @code{display-buffer} will skip +the execution of any further display actions and return @code{nil} +immediately. If this function returns @code{nil}, +@code{display-buffer} will continue with the next display action, if +any. -The size of the new window can be adjusted by supplying -@code{window-height} and @code{window-width} entries in @var{alist}. To -adjust the window's height, use an entry whose @sc{car} is -@code{window-height} and whose @sc{cdr} is one of: +It is assumed that when a caller of @code{display-buffer} specifies a +non-@code{nil} @code{allow-no-window} entry, it is also able to handle +a @code{nil} return value. +@end defun + +Two action functions are described in their proper +sections---@code{display-buffer-in-side-window} (@pxref{Displaying +Buffers in Side Windows}) and @code{display-buffer-in-atom-window} +(@pxref{Atomic Windows}). + + +@node Buffer Display Action Alists +@subsection Action Alists for Buffer Display +@cindex buffer display action alist +@cindex action alist for buffer display + +An @dfn{action alist} is an association list mapping predefined +symbols recognized by action functions to values these functions are +supposed to interpret accordingly. In each call, +@code{display-buffer} constructs a new, possibly empty action alist +and passes that entire list on to any action function it calls. + + By design, action functions are free in their interpretation of +action alist entries. In fact, some entries like +@code{allow-no-window} or @code{previous-window} have a meaning only +for one or a few action functions and are ignored by the rest. Other +entries, like @code{inhibit-same-window} or @code{window-parameters}, +are supposed to be respected by most action functions including those +provided by application programs and external packages. + + In the previous subsection we have described in detail how +individual action functions interpret the action alist entries they +care about. Here we give a reference list of all known action alist +entries according to their symbols, together with their values and +action functions that recognize them. Throughout this list, the terms +``buffer'' will refer to the buffer @code{display-buffer} is supposed +to display and ``value'' to the entry's value. + +@table @code +@vindex inhibit-same-window@r{, a buffer display action alist entry} +@item inhibit-same-window +If the value is non-@code{nil}, this signals that the selected window +must not be used for displaying the buffer. All action functions that +(re-)use an existing window should respect this entry. + +@vindex previous-window@r{, a buffer display action alist entry} +@item previous-window +The value must specify a window that may have displayed the buffer +previously. @code{display-buffer-in-previous-window} (@pxref{Buffer +Display Action Functions}) will give preference to such a window +provided it is still live and not dedicated to another buffer. + +@vindex mode@r{, a buffer display action alist entry} +@item mode +The value is either a major mode or a list of major modes. +@code{display-buffer-reuse-mode-window} (@pxref{Buffer Display Action +Functions}) may reuse a window whenever the value specified by this +entry matches the major mode of that window's buffer. Other action +functions ignore such entries. + +@vindex frame-predicate@r{, a buffer display action alist entry} +@item frame-predicate +The value must be a function taking one argument (a frame), supposed +to return non-@code{nil} if that frame is a candidate for displaying +the buffer. This entry is used by +@code{display-buffer-use-some-frame} (@pxref{Buffer Display Action +Functions}). + +@vindex reusable-frames@r{, a buffer display action alist entry} +@item reusable-frames +The value specifies the frame(s) to search for a window that can be +reused because it already displays the buffer. It can be set as +follows: + +@itemize @bullet +@item +@code{nil} means consider only windows on the selected frame. +(Actually, the last frame used that is not a minibuffer-only frame.) +@item +@code{t} means consider windows on all frames. +@item +@code{visible} means consider windows on all visible frames. +@item +0 means consider windows on all visible or iconified frames. +@item +A frame means consider windows on that frame only. +@end itemize + +Note that the meaning of @code{nil} differs slightly from that of the +@var{all-frames} argument to @code{next-window} (@pxref{Cyclic Window +Ordering}). + +A major client of this is @code{display-buffer-reuse-window} +(@pxref{Buffer Display Action Functions}) but all other action +functions that try to reuse a window are affected as well. + +@vindex inhibit-switch-frame@r{, a buffer display action alist entry} +@item inhibit-switch-frame +A non-@code{nil} value prevents another frame from being raised or +selected, if the window chosen by @code{display-buffer} is displayed +there. Primarily affected by this are +@code{display-buffer-use-some-frame} and +@code{display-buffer-reuse-window} (@pxref{Buffer Display Action +Functions}). @code{display-buffer-pop-up-frame} should be affected as +well but there is no guarantee that the window manager will comply. + +@vindex window-parameters@r{, a buffer display action alist entry} +@item window-parameters +The value specifies an alist of window parameters to give the chosen +window. All action functions that choose a window should process this +entry. + +@vindex window-height@r{, a buffer display action alist entry} +@item window-height +The value specifies whether and how to adjust the height of the chosen +window and can be provided as follows: @itemize @bullet @item -@code{nil} means to leave the height of the new window alone. +@code{nil} means to leave the height of the chosen window alone. @item -A number specifies the desired height of the new window. An integer -specifies the number of lines of the window. A floating-point +A number specifies the desired height of the chosen window. An +integer specifies the number of lines of the window. A floating-point number gives the fraction of the window's height with respect to the height of the frame's root window. @item -If the @sc{cdr} specifies a function, that function is called with one -argument: the new window. The function is supposed to adjust the +If the value specifies a function, that function is called with one +argument---the chosen window. The function is supposed to adjust the height of the window; its return value is ignored. Suitable functions are @code{shrink-window-if-larger-than-buffer} and @code{fit-window-to-buffer}, see @ref{Resizing Windows}. @end itemize -To adjust the window's width, use an entry whose @sc{car} is -@code{window-width} and whose @sc{cdr} is one of: +All action functions that choose a window should process this entry. + +@vindex window-width@r{, a buffer display action alist entry} +@item window-width +This entry is similar to the @code{window-height} entry described +before but can be used to adjust the chosen window's width instead. +The value can be one of the following: @itemize @bullet @item -@code{nil} means to leave the width of the new window alone. +@code{nil} means to leave the width of the chosen window alone. @item -A number specifies the desired width of the new window. An integer +A number specifies the desired width of the chosen window. An integer specifies the number of columns of the window. A floating-point number gives the fraction of the window's width with respect to the width of the frame's root window. @item -If the @sc{cdr} specifies a function, that function is called with one -argument: the new window. The function is supposed to adjust the width -of the window; its return value is ignored. +If the value specifies a function, that function is called with one +argument---the chosen window. The function is supposed to adjust the +width of the window; its return value is ignored. @end itemize -If @var{alist} contains a @code{preserve-size} entry, Emacs will try to -preserve the size of the new window during future resize operations -(@pxref{Preserving Window Sizes}). The @sc{cdr} of that entry must be a -cons cell whose @sc{car}, if non-@code{nil}, means to preserve the width -of the window and whose @sc{cdr}, if non-@code{nil}, means to preserve -the height of the window. - -This function can fail if no window splitting can be performed for some -reason (e.g., if the selected frame has an @code{unsplittable} frame -parameter; @pxref{Buffer Parameters}). -@end defun - -@defun display-buffer-below-selected buffer alist -This function tries to display @var{buffer} in a window below the -selected window. If there is a window below the selected one and that -window already displays @var{buffer}, it reuses that window. - -If there is no such window, this function tries to create a new window -by splitting the selected one and display @var{buffer} there. It will -also adjust that window's size provided @var{alist} contains a suitable -@code{window-height} or @code{window-width} entry, see above. - -If splitting the selected window fails and there is a non-dedicated -window below the selected one showing some other buffer, it uses that -window for showing @var{buffer}. -@end defun - -@defun display-buffer-in-previous-window buffer alist -This function tries to display @var{buffer} in a window previously -showing it. If @var{alist} has a non-@code{nil} -@code{inhibit-same-window} entry, the selected window is not eligible -for reuse. If @var{alist} contains a @code{reusable-frames} entry, its -value determines which frames to search for a suitable window as with -@code{display-buffer-reuse-window}. - -If @var{alist} has a @code{previous-window} entry, the window -specified by that entry will override any other window found by the -methods above, even if that window never showed @var{buffer} before. -@end defun - -@defun display-buffer-at-bottom buffer alist -This function tries to display @var{buffer} in a window at the bottom -of the selected frame. - -This either splits the window at the bottom of the frame or the -frame's root window, or reuses an existing window at the bottom of the -selected frame. -@end defun - -@defun display-buffer-use-some-window buffer alist -This function tries to display @var{buffer} by choosing an existing -window and displaying the buffer in that window. It can fail if all -windows are dedicated to another buffer (@pxref{Dedicated Windows}). -@end defun - -@defun display-buffer-no-window buffer alist -If @var{alist} has a non-@code{nil} @code{allow-no-window} entry, then -this function does not display @code{buffer}. This allows you to -override the default action and avoid displaying the buffer. It is -assumed that when the caller specifies a non-@code{nil} -@code{allow-no-window} value it can handle a @code{nil} value returned -from @code{display-buffer} in this case. -@end defun - -If the @var{alist} argument of any of these functions contains a -@code{window-parameters} entry, @code{display-buffer} assigns the -elements of the associated value as window parameters of the chosen -window. - - To illustrate the use of action functions, consider the following -example. - -@example -@group -(display-buffer - (get-buffer-create "*foo*") - '((display-buffer-reuse-window - display-buffer-pop-up-window - display-buffer-pop-up-frame) - (reusable-frames . 0) - (window-height . 10) (window-width . 40))) -@end group -@end example - -@noindent -Evaluating the form above will cause @code{display-buffer} to proceed as -follows: If a buffer called *foo* already appears on a visible or -iconified frame, it will reuse its window. Otherwise, it will try to -pop up a new window or, if that is impossible, a new frame and show the -buffer there. If all these steps fail, it will proceed using whatever -@code{display-buffer-base-action} and -@code{display-buffer-fallback-action} prescribe. - - Furthermore, @code{display-buffer} will try to adjust a reused window -(provided *foo* was put by @code{display-buffer} there before) or a -popped-up window as follows: If the window is part of a vertical -combination, it will set its height to ten lines. Note that if, instead -of the number 10, we specified the function -@code{fit-window-to-buffer}, @code{display-buffer} would come up with a -one-line window to fit the empty buffer. If the window is part of a -horizontal combination, it sets its width to 40 columns. Whether a new -window is vertically or horizontally combined depends on the shape of -the window split and the values of -@code{split-window-preferred-function}, @code{split-height-threshold} -and @code{split-width-threshold} (@pxref{Choosing Window Options}). - - Now suppose we combine this call with a preexisting setup for -@code{display-buffer-alist} as follows. - -@example -@group -(let ((display-buffer-alist - (cons - '("\\*foo\\*" - (display-buffer-reuse-window display-buffer-below-selected) - (reusable-frames) - (window-height . 5)) - display-buffer-alist))) - (display-buffer - (get-buffer-create "*foo*") - '((display-buffer-reuse-window - display-buffer-pop-up-window - display-buffer-pop-up-frame) - (reusable-frames . 0) - (window-height . 10) (window-width . 40)))) -@end group -@end example +All action functions that choose a window should process this entry. + +@vindex preserve-size@r{, a buffer display action alist entry} +@item preserve-size +If non-@code{nil} such an entry tells Emacs to preserve the size of +the window chosen (@pxref{Preserving Window Sizes}). The value should +be either @code{(t . nil)} to preserve the width of the window, +@code{(nil . t)} to preserve its height or @code{(t . t)} to preserve +both, its width and its height. All action functions that choose a +window should process this entry. + +@vindex pop-up-frame-parameters@r{, a buffer display action alist entry} +@item pop-up-frame-parameters +The value specifies an alist of frame parameters to give a new frame, +if one is created. @code{display-buffer-pop-up-frame} (@pxref{Buffer +Display Action Functions}) is its one and only addressee. + +@vindex parent-frame@r{, a buffer display action alist entry} +@item parent-frame +The value specifies the parent frame to be used when the buffer is +displayed on a child frame. This entry is used by +@code{display-buffer-in-child-frame} (@pxref{Buffer Display Action +Functions}) only. + +@vindex child-frame-parameters@r{, a buffer display action alist entry} +@item child-frame-parameters +The value specifies an alist of frame parameters used when the buffer +is displayed on a child frame. This entry is used by +@code{display-buffer-in-child-frame} (@pxref{Buffer Display Action +Functions}) only. + +@vindex side@r{, a buffer display action alist entry} +@item side +The value denotes the side of the frame or window where a new window +displaying the buffer shall be created. This entry is used by +@code{display-buffer-in-side-window} to indicate the side of the frame +where a new side window shall be placed (@pxref{Displaying Buffers in +Side Windows}). It is also used by +@code{display-buffer-in-atom-window} to indicate the side of an +existing window where the new window shall be located (@pxref{Atomic +Windows}). -@noindent -This form will have @code{display-buffer} first try reusing a window -that shows *foo* on the selected frame. If there's no such window, it -will try to split the selected window or, if that is impossible, use the -window below the selected window. +@vindex slot@r{, a buffer display action alist entry} +@item slot +If non-@code{nil}, the value specifies the slot of the side window +supposed to display the buffer. This entry is used by +@code{display-buffer-in-side-window} only (@pxref{Displaying Buffers +in Side Windows}). - If there's no window below the selected one, or the window below the -selected one is dedicated to its buffer, @code{display-buffer} will -proceed as described in the previous example. Note, however, that when -it tries to adjust the height of any reused or popped-up window, it will -in any case try to set its number of lines to 5 since that value -overrides the corresponding specification in the @var{action} argument -of @code{display-buffer}. +@vindex window@r{, a buffer display action alist entry} +@item window +The value specifies a window that is in some way related to the window +chosen by @code{display-buffer}. This entry is currently used by +@code{display-buffer-in-atom-window} to indicate the window on whose +side the new window shall be created (@pxref{Atomic Windows}). + +@vindex allow-no-window@r{, a buffer display action alist entry} +@item allow-no-window +If the value is non-@code{nil}, @code{display-buffer} does not +necessarily have to display the buffer and the caller is prepared to +accept that. This entry is not intended for user customizations since +there is no guarantee that an arbitrary caller of +@code{display-buffer} will be able to handle the case that no window +will display the buffer. @code{display-buffer-no-window} +(@pxref{Buffer Display Action Functions}) is the only action function +that cares about this entry. +@end table @node Choosing Window Options -@section Additional Options for Displaying Buffers +@subsection Additional Options for Displaying Buffers -The behavior of the standard display actions of @code{display-buffer} -(@pxref{Choosing Window}) can be modified by a variety of user -options. +The behavior of buffer display actions (@pxref{Choosing Window}) can +be further modified by the following user options. @defopt pop-up-windows If the value of this variable is non-@code{nil}, @code{display-buffer} is allowed to split an existing window to make a new window for displaying in. This is the default. -This variable is provided mainly for backward compatibility. It is +This variable is provided for backward compatibility only. It is obeyed by @code{display-buffer} via a special mechanism in -@code{display-buffer-fallback-action}, which only calls the action -function @code{display-buffer-pop-up-window} (@pxref{Display Action -Functions}) when the value is @code{nil}. It is not consulted by -@code{display-buffer-pop-up-window} itself, which the user may specify -directly in @code{display-buffer-alist} etc. +@code{display-buffer-fallback-action}, which calls the action function +@code{display-buffer-pop-up-window} (@pxref{Buffer Display Action +Functions}) when the value of this option is non-@code{nil}. It is +not consulted by @code{display-buffer-pop-up-window} itself, which the +user may specify directly in @code{display-buffer-alist} etc. @end defopt @defopt split-window-preferred-function This variable specifies a function for splitting a window, in order to make a new window for displaying a buffer. It is used by the @code{display-buffer-pop-up-window} action function to actually split -the window (@pxref{Display Action Functions}). +the window (@pxref{Buffer Display Action Functions}). -The default value is @code{split-window-sensibly}, which is documented -below. The value must be a function that takes one argument, a window, -and return either a new window (which will be used to display the -desired buffer) or @code{nil} (which means the splitting failed). +The value must be a function that takes one argument, a window, and +return either a new window (which will be used to display the desired +buffer) or @code{nil} (which means the splitting failed). The default +value is @code{split-window-sensibly}, which is documented next. @end defopt @defun split-window-sensibly &optional window @@ -2797,19 +2964,19 @@ well, this function gives up and returns @code{nil}. @end defun @defopt split-height-threshold -This variable, used by @code{split-window-sensibly}, specifies whether -to split the window placing the new window below. If it is an +This variable specifies whether @code{split-window-sensibly} is +allowed to split the window placing the new window below. If it is an integer, that means to split only if the original window has at least that many lines. If it is @code{nil}, that means not to split this way. @end defopt @defopt split-width-threshold -This variable, used by @code{split-window-sensibly}, specifies whether -to split the window placing the new window to the right. If the value -is an integer, that means to split only if the original window has at -least that many columns. If the value is @code{nil}, that means not -to split this way. +This variable specifies whether @code{split-window-sensibly} is +allowed to split the window placing the new window to the right. If +the value is an integer, that means to split only if the original +window has at least that many columns. If the value is @code{nil}, +that means not to split this way. @end defopt @defopt even-window-sizes @@ -2839,9 +3006,9 @@ search any visible or iconified frame, not just the selected frame. This variable is provided mainly for backward compatibility. It is obeyed by @code{display-buffer} via a special mechanism in @code{display-buffer-fallback-action}, which calls the action function -@code{display-buffer-pop-up-frame} (@pxref{Display Action Functions}) -if the value is non-@code{nil}. (This is done before attempting to -split a window.) This variable is not consulted by +@code{display-buffer-pop-up-frame} (@pxref{Buffer Display Action +Functions}) if the value is non-@code{nil}. (This is done before +attempting to split a window.) This variable is not consulted by @code{display-buffer-pop-up-frame} itself, which the user may specify directly in @code{display-buffer-alist} etc. @end defopt @@ -2849,8 +3016,8 @@ directly in @code{display-buffer-alist} etc. @defopt pop-up-frame-function This variable specifies a function for creating a new frame, in order to make a new window for displaying a buffer. It is used by the -@code{display-buffer-pop-up-frame} action function (@pxref{Display -Action Functions}). +@code{display-buffer-pop-up-frame} action function (@pxref{Buffer +Display Action Functions}). The value should be a function that takes no arguments and returns a frame, or @code{nil} if no frame could be created. The default value @@ -2860,30 +3027,670 @@ is a function that creates a frame using the parameters specified by @defopt pop-up-frame-alist This variable holds an alist of frame parameters (@pxref{Frame -Parameters}), which is used by the default function in +Parameters}), which is used by the function specified by @code{pop-up-frame-function} to make a new frame. The default is @code{nil}. -@end defopt -@defopt same-window-buffer-names -A list of buffer names for buffers that should be displayed in the -selected window. If a buffer's name is in this list, -@code{display-buffer} handles the buffer by showing it in the selected -window. +This option is provided for backward compatibility only. Note, that +when @code{display-buffer-pop-up-frame} (@pxref{Buffer Display Action +Functions}) calls the function specified by +@code{pop-up-frame-function}, it prepends the value of all +@code{pop-up-frame-parameters} action alist entries to +@code{pop-up-frame-alist} so that the values specified by the action +alist entry effectively override any corresponding values of +@code{pop-up-frame-alist}. + +Hence, users should set up a @code{pop-up-frame-parameters} action +alist entry in @code{display-buffer-alist} instead of customizing +@code{pop-up-frame-alist}. Only this will guarantee that the value of +a parameter specified by the user overrides the value of that +parameter specified by the caller of @code{display-buffer}. @end defopt -@defopt same-window-regexps -A list of regular expressions that specify buffers that should be -displayed in the selected window. If the buffer's name matches any of -the regular expressions in this list, @code{display-buffer} handles the -buffer by showing it in the selected window. -@end defopt + Many efforts in the design of @code{display-buffer} have been given +to maintain compatibility with code that uses older options like +@code{pop-up-windows}, @code{pop-up-frames}, +@code{pop-up-frame-alist}, @code{same-window-buffer-names} and +@code{same-window-regexps}. Lisp Programs and users should refrain +from using these options. Above we already warned against customizing +@code{pop-up-frame-alist}. Here we describe how to convert the +remaining options to use display actions instead. + +@table @code +@item pop-up-windows +@vindex pop-up-windows@r{, replacement for} +This variable is @code{t} by default. Instead of customizing it to +@code{nil} and thus telling @code{display-buffer} what not to do, it's +much better to list in @code{display-buffer-base-action} the action +functions it should try instead as, for example: + +@example +@group +(customize-set-variable + 'display-buffer-base-action + '((display-buffer-reuse-window display-buffer-same-window + display-buffer-in-previous-window + display-buffer-use-some-window))) +@end group +@end example + +@item pop-up-frames +@vindex pop-up-frames@r{, replacement for} +Instead of customizing this variable to @code{t}, customize +@code{display-buffer-base-action}, for example, as follows: + +@example +@group +(customize-set-variable + 'display-buffer-base-action + '((display-buffer-reuse-window display-buffer-pop-up-frame) + (reusable-frames . 0))) +@end group +@end example + +@item same-window-buffer-names +@itemx same-window-regexps +@vindex same-window-buffer-names@r{, replacement for} +@vindex same-window-regexps@r{, replacement for} +Instead of adding a buffer name or a regular expression to one of +these options use a @code{display-buffer-alist} entry for that buffer +specifying the action function @code{display-buffer-same-window}. + +@example +@group +(customize-set-variable + 'display-buffer-alist + (cons '("\\*foo\\*" (display-buffer-same-window)) + display-buffer-alist)) +@end group +@end example +@end table + + +@node Precedence of Action Functions +@subsection Precedence of Action Functions +@cindex precedence of buffer display action functions +@cindex execution order of buffer display action functions + +From the past subsections we already know that @code{display-buffer} +must be supplied with a number of display actions (@pxref{Choosing +Window}) in order to display a buffer. In a completely uncustomized +Emacs, these actions are specified by +@code{display-buffer-fallback-action} in the following order of +precedence: Reuse a window, pop up a new window on the same frame, use +a window previously showing the buffer, use some window and pop up a +new frame. (Note that the remaining actions named by +@code{display-buffer-fallback-action} are void in an uncustomized +Emacs). + +Consider the following form: + +@example +(display-buffer (get-buffer-create "*foo*")) +@end example + +@noindent +Evaluating this form in the buffer @file{*scratch*} of an uncustomized +Emacs session will usually fail to reuse a window that shows +@file{*foo*} already but succeed in popping up a new window. +Evaluating the same form again will now not cause any visible +changes---@code{display-buffer} reused the window already showing +@file{*foo*} because that action was applicable and had the highest +precedence among all applicable actions. + + Popping up a new window will fail if there is not enough space on +the selected frame. In an uncustomized Emacs it typically fails when +there are already two windows on a frame. For example, if you now +type @w{@kbd{C-x 1}} followed by @w{@kbd{C-x 2}} and evaluate the form +once more, @file{*foo*} should show up in the lower +window---@code{display-buffer} just used ``some'' window. If, before +typing @w{@kbd{C-x 2}} you had typed @w{@kbd{C-x o}}, @file{*foo*} +would have been shown in the upper window because ``some'' window +stands for the ``least recently used'' window and the selected window +has been least recently used if and only if it is alone on its frame. + + Let's assume you did not type @w{@kbd{C-x o}} and @file{*foo*} is +shown in the lower window. Type @w{@kbd{C-x o}} to get there followed +by @w{@kbd{C-x left}} and evaluate the form again. This should +display @file{*foo*} in the same, lower window because that window had +already shown @file{*foo*} previously and was therefore chosen instead +of some other window. + + So far we have only observed the default behavior in an uncustomized +Emacs session. To see how this behavior can be customized let's +consider the option @code{display-buffer-base-action}. It provides a +very coarse customization which conceptually affects the display of +@emph{any} buffer. It can be used to supplement the actions supplied +by @code{display-buffer-fallback-action} by reordering them or by +adding actions that are not present there but fit more closely the +user's editing practice. It can be, however, also used to change the +default behavior in a more profound way. + + Let's consider a user who, as a rule, prefers to display buffers on +another frame. Such a user might provide the following customization: + +@example +@group +(customize-set-variable + 'display-buffer-base-action + '((display-buffer-reuse-window display-buffer-pop-up-frame) + (reusable-frames . 0))) +@end group +@end example + +@noindent +This setting will cause@code{display-buffer} to first try to find a +window showing the buffer on a visible or iconified frame and, if no +such frame exists, pop up a new frame. You can observe this behavior +on a graphical system by typing @w{@kbd{C-x 1}} in the window showing +@file{*scratch*} and evaluating our canonical @code{display-buffer} +form. This will usually create (and give focus to) a new frame whose +root window shows @file{*foo*}. Iconify that frame and evaluate the +canonical form again: @code{display-buffer} will reuse the window on +the new frame (usually raising the frame and giving it focus too). + + Only if creating a new frame fails, @code{display-buffer} will +apply the actions supplied by @code{display-buffer-fallback-action} +which means to again try to reuse a window, pop up a new window and so +on. A trivial way to make frame creation fail is supplied by the +following form: + +@example +@group +(let ((pop-up-frame-function 'ignore)) + (display-buffer (get-buffer-create "*foo*"))) +@end group +@end example + +@noindent +We will forget about that form immediately after observing that it +fails to create a new frame and uses a fallback action instead. + + Note that @code{display-buffer-reuse-window} appears redundant in +the customization of @code{display-buffer-base-action} because it is +already part of @code{display-buffer-fallback-action} and should be +tried there anyway. However, that would fail because due to the +precedence of @code{display-buffer-base-action} over +@code{display-buffer-fallback-action}, at that time +@code{display-buffer-pop-up-frame} would have already won the race. +In fact + +@example +@group +(customize-set-variable + 'display-buffer-base-action + '(display-buffer-pop-up-frame (reusable-frames . 0))) +@end group +@end example + +@noindent +would cause @code{display-buffer} to @emph{always} pop up a new frame +which is probably not what our user wants. + + So far, we have only shown how @emph{users} can customize the +default behavior of @code{display-buffer}. Let us now see how +@emph{applications} can change the course of @code{display-buffer}. +The canonical way to do that is to use the @var{action} argument of +@code{display-buffer} or a function that calls it like, for example, +@code{pop-to-buffer} (@pxref{Switching Buffers}). + + Suppose an application wants to display @file{*foo*} preferably +below the selected window (to immediately attract the attention of the +user to the new window) or, if that fails, in a window at the bottom +of the frame. It could do that with a call like + +@example +@group +(display-buffer + (get-buffer-create "*foo*") + '((display-buffer-below-selected display-buffer-at-bottom))) +@end group +@end example + +@noindent +In order to see how this new, modified form works, delete any frame +showing @file{*foo*}, type @w{@kbd{C-x 1}} followed by @w{@kbd{C-x 2}} in the +window showing @file{*scratch*} and subsequently evaluate that form. +@code{display-buffer} should split the upper window and show +@file{*foo*} in the new window. Alternatively, if after @w{@kbd{C-x 2}} +you had typed @w{@kbd{C-x o}}, @code{display-buffer} would have split the +window at the bottom instead. + + Suppose now that, before evaluating the new form, you have made the +selected window as small as possible, for example, by evaluating the +form @code{(fit-window-to-buffer)} in that window. In that case, +@code{display-buffer} would have failed to split the selected window +and would have split the frame's root window instead, effectively +displaying @file{*foo*} at the bottom of the frame. + + In either case, evaluating the new form a second time should reuse +the window already showing @file{*foo*} since both functions supplied +by the @var{action} argument try to reuse such a window first. + + By setting the @var{action} argument, an application effectively +overrules any customization of @code{display-buffer-base-action}. Our +user can now either accept the choice of the application or redouble +by customizing the option @code{display-buffer-alist} as follows: + +@example +@group +(customize-set-variable + 'display-buffer-alist + '(("\\*foo\\*" + (display-buffer-reuse-window display-buffer-pop-up-frame)))) +@end group +@end example + +@noindent +Trying this with the new, modified form above in a configuration that +does not show @file{*foo*} anywhere, will display @file{*foo*} on a +separate frame, completely ignoring the @var{action} argument of +@code{display-buffer}. + + Note that we didn't care to specify a @code{reusable-frames} action +alist entry in our specification of @code{display-buffer-alist}. +@code{display-buffer} always takes the first one it finds---in our +case the one specified by @code{display-buffer-base-action}. If we +wanted to use a different specification, for example, to exclude +iconified frames showing @file{*foo*} from the list of reusable ones, +we would have to specify that separately, however: + +@example +@group +(customize-set-variable + 'display-buffer-alist + '(("\\*foo\\*" + (display-buffer-reuse-window display-buffer-pop-up-frame) + (reusable-frames . visible)))) +@end group +@end example + +@noindent +If you try this, you will notice that repeated attempts to display +@file{*foo*} will succeed to reuse a frame only if that frame is +visible. + + The above example would allow the conclusion that users customize +@code{display-buffer-alist} for the sole purpose to overrule the +@var{action} argument chosen by applications. Such a conclusion would +be incorrect. @code{display-buffer-alist} is the standard option for +users to direct the course of display of specific buffers in a +preferred way regardless of whether the display is also guided by an +@var{action} argument. + + We can, however, reasonably conclude that customizing +@code{display-buffer-alist} differs from customizing +@code{display-buffer-base-action} in two major aspects: It is stronger +because it overrides the @var{action} argument of +@code{display-buffer}. And it allows to explicitly specify the +affected buffers. In fact, displaying other buffers is not affected +in any way by a customization for @file{*foo*}. For example, + +@example +(display-buffer (get-buffer-create "*bar*")) +@end example + +@noindent +continues being governed by the settings of +@code{display-buffer-base-action} and +@code{display-buffer-fallback-action} only. + + We could stop with our examples here but Lisp programs still have +an ace up their sleeves which they can use to overrule any +customization of @code{display-buffer-alist}. It's the variable +@code{display-buffer-overriding-action} which they can bind around +@code{display-buffer} calls as follows: + +@example +@group +(let ((display-buffer-overriding-action + '((display-buffer-same-window)))) + (display-buffer + (get-buffer-create "*foo*") + '((display-buffer-below-selected display-buffer-at-bottom)))) +@end group +@end example + +@noindent +Evaluating this form will usually display @file{*foo*} in the selected +window regardless of the @var{action} argument and any user +customizations. (Usually, an application will not bother to also +provide an @var{action} argument. Here it just serves to illustrate +the fact that it gets overridden.) + +It might be illustrative to look at the list of action functions +@code{display-buffer} would have tried to display @file{*foo*} with +the customizations we provided here. The list (including comments +explaining who added this and the subsequent elements) is: + +@example +@group +(display-buffer-same-window ;; `display-buffer-overriding-action' + display-buffer-reuse-window ;; `display-buffer-alist' + display-buffer-pop-up-frame + display-buffer-below-selected ;; ACTION argument + display-buffer-at-bottom + display-buffer-reuse-window ;; `display-buffer-base-action' + display-buffer-pop-up-frame + display-buffer--maybe-same-window ;; `display-buffer-fallback-action' + display-buffer-reuse-window + display-buffer--maybe-pop-up-frame-or-window + display-buffer-in-previous-window + display-buffer-use-some-window + display-buffer-pop-up-frame) +@end group +@end example + +@noindent +Note that among the internal functions listed here +@code{display-buffer--maybe-same-window} is effectively ignored while +@code{display-buffer--maybe-pop-up-frame-or-window} actually runs +@code{display-buffer-pop-up-window}. + +The action alist passed in each function call is: + +@example +@group +((reusable-frames . visible) + (reusable-frames . 0)) +@end group +@end example + +@noindent +which shows that we have used the second specification of +@code{display-buffer-alist} above overriding the specification +supplied by @code{display-buffer-base-action}. Suppose our user had +written that as + +@example +@group +(customize-set-variable + 'display-buffer-alist + '(("\\*foo\\*" + (display-buffer-reuse-window display-buffer-pop-up-frame) + (inhibit-same-window . t) + (reusable-frames . visible)))) +@end group +@end example + +@noindent +In this case the @code{inhibit-same-window} alist entry will +successfully invalidate the @code{display-buffer-same-window} +specification from @code{display-buffer-overriding-action} and +@code{display-buffer} will show @file{*foo*} on another frame. To +make @code{display-buffer-overriding-action} more robust in this +regard, the application would have to specify an appropriate +@code{inhibit-same-window} entry too, for example, as follows: + +@example +@group +(let ((display-buffer-overriding-action + '(display-buffer-same-window (inhibit-same-window . nil)))) + (display-buffer (get-buffer-create "*foo*"))) +@end group +@end example + +@noindent +This last example shows that while the precedence order of action +functions is fixed as described in @ref{Choosing Window}, an action +alist entry specified by a display action ranked lower in that order +can affect the execution of a higher ranked display action. + + +@node The Zen of Buffer Display +@subsection The Zen of Buffer Display +@cindex guidelines for buffer display +@cindex writing buffer display actions +@cindex buffer display conventions + +In its most simplistic form, a frame accommodates always one single +window that can be used for displaying a buffer. As a consequence, it +is always the latest call of @code{display-buffer} that will have +succeeded in placing its buffer there. + + Since working with such a frame is not very practical, Emacs by +default allows for more complex frame layouts controlled by the +default values of the frame size and the @code{split-height-threshold} +and @code{split-width-threshold} options. Displaying a buffer not yet +shown on a frame then either splits the single window on that frame or +(re-)uses one of its two windows. + + The default behavior is abandoned as soon as the user customizes +one of these thresholds or manually changes the frame's layout. The +default behavior is also abandoned when calling @code{display-buffer} +with a non-@code{nil} @var{action} argument or the user customizes one +of the options mentioned in the previous subsections. Mastering +@code{display-buffer} soon may become a frustrating experience due to +the plethora of applicable display actions and the resulting frame +layouts. + + However, refraining from using buffer display functions and falling +back on a split & delete windows metaphor is not a good idea either. +Buffer display functions give Lisp programs and users a framework to +reconcile their different needs; no comparable framework exists for +splitting and deleting windows. They also allow to at least partially +restore the layout of a frame when removing a buffer from it later +(@pxref{Quitting Windows}). + + Below we will give a number of guidelines to redeem the frustration +mentioned above and thus to avoid that buffers literally get lost in +between the windows of a frame. + +@table @asis +@item Write display actions without stress +Writing display actions can be a pain because one has to lump together +action functions and action alists in one huge list. (Historical +reasons prevented us from having @code{display-buffer} support +separate arguments for these.) It might help to memorize some basic +forms like the ones listed below: + +@example +'(nil (inhibit-same-window . t)) +@end example + +@noindent +specifies an action alist entry only and no action function. Its sole +purpose is to inhibit a @code{display-buffer-same-window} function +specified elsewhere from showing the buffer in the same window, see +also the last example of the preceding subsection. + +@example +'(display-buffer-below-selected) +@end example + +@noindent +on the other hand specifies one action function and an empty action +alist. To combine the effects of the above two specifications one +would write the form + +@example +'(display-buffer-below-selected (inhibit-same-window . t)) +@end example + +@noindent +to add another action function one would write + +@example +@group +'((display-buffer-below-selected display-buffer-at-bottom) + (inhibit-same-window . t)) +@end group +@end example + +@noindent +and to add another alist entry one would write + +@example +@group +'((display-buffer-below-selected display-buffer-at-bottom) + (inhibit-same-window . t) + (window-height . fit-window-to-buffer)) +@end group +@end example + +@noindent +That last form can be used as @var{action} argument of +@code{display-buffer} in the following way: + +@example +@group +(display-buffer + (get-buffer-create "*foo*") + '((display-buffer-below-selected display-buffer-at-bottom) + (inhibit-same-window . t) + (window-height . fit-window-to-buffer))) +@end group +@end example + +@noindent +In a customization of @code{display-buffer-alist} it would be used as +follows: + +@example +@group +(customize-set-variable + 'display-buffer-alist + '(("\\*foo\\*" + (display-buffer-below-selected display-buffer-at-bottom) + (inhibit-same-window . t) + (window-height . fit-window-to-buffer)))) +@end group +@end example + +@noindent +To add a customization for a second buffer one would then write: + +@example +@group +(customize-set-variable + 'display-buffer-alist + '(("\\*foo\\*" + (display-buffer-below-selected display-buffer-at-bottom) + (inhibit-same-window . t) + (window-height . fit-window-to-buffer)) + ("\\*bar\\*" + (display-buffer-reuse-window display-buffer-pop-up-frame) + (reusable-frames . visible)))) +@end group +@end example + +@item Treat each other with respect +@code{display-buffer-alist} and @code{display-buffer-base-action} are +user options---Lisp programs must never set or rebind them. +@code{display-buffer-overriding-action}, on the other hand, is +reserved for applications---who seldom use that option and if they use +it, then with utmost care. + + Older implementations of @code{display-buffer} frequently caused +users and applications to fight over the settings of user options like +@code{pop-up-frames} and @code{pop-up-windows} (@pxref{Choosing Window +Options}). This was one major reason for redesigning +@code{display-buffer}---to provide a clear framework specifying what +users and applications should be allowed to do. + + Lisp Programs must be prepared that a user's customizations may +cause buffers to get displayed in an unexpected way. They should +never assume in their subsequent behavior, that the buffer has been +shown precisely the way they asked for in the @var{action} argument of +@code{display-buffer}. + + Users should not pose too many and too severe restrictions on how +arbitrary buffers get displayed. Otherwise, they will risk to lose +the characteristics of showing a buffer for a certain purpose. +Suppose an lisp program has been written to compare different versions +of a buffer in two windows side-by-side. If the customization of +@code{display-buffer-alist} prescribes that any such buffer should be +always shown in or below the selected window, the lisp program will +have a hard time to set up the desired window configuration via +@code{display-buffer}. + + To specify a preference for showing an arbitrary buffer, users +should customize @code{display-buffer-base-action}. An example of how +users who prefer working with multiple frames would do that was given +in the previous subsection. @code{display-buffer-alist} should be +reserved for displaying specific buffers in a specific way. + +@item Consider reusing a window that already shows the buffer +Generally, it's always a good idea for users and lisp program +programmers to be prepared for the case that a window already shows +the buffer in question and to reuse that window. In the preceding +subsection we have shown that failing to do so properly may cause +@code{display-buffer} to continuously pop up a new frame although a +frame showing that buffer existed already. In a few cases only, it +might be undesirable to reuse a window, for example, when a different +portion of the buffer should be shown in that window. + + Hence, @code{display-buffer-reuse-window} is one action function +that should be used as often as possible, both in @var{action} +arguments and customizations. An @code{inhibit-same-window} entry in +the @var{action} argument usually takes care of the most common case +where reusing a window showing the buffer should be avoided---that +where the window in question is the selected one. + +@item Attract focus to the window chosen +This is a no-brainer for people working with multiple frames---the +frame showing the buffer will automatically raise and get focus unless +an @code{inhibit-switch-frame} entry forbids it. For single frame +users this task can be considerably more difficult. In particular, +@code{display-buffer-pop-up-window} and +@code{display-buffer-use-some-window} can become obtrusive in this +regard. They split or use a seemingly arbitrary (often the largest or +least recently used) window, distracting the user's attention. + +Some Lisp programs therefore try to choose a window at the bottom of +the frame, for example, in order to display the buffer in vicinity of +the minibuffer window where the user is expected to answer a question +related to the new window. For non-input related actions +@code{display-buffer-below-selected} might be preferable because the +selected window usually already has the user's attention. + +@item Handle subsequent invocations of @code{display-buffer} +@code{display-buffer} is not overly well suited for displaying several +buffers in sequence and making sure that all these buffers are shown +orderly in the resulting window configuration. Again, the standard +action functions @code{display-buffer-pop-up-window} and +@code{display-buffer-use-some-window} are not very suited for this +purpose due to their somewhat chaotic nature in more complex +configurations. + + To produce a window configuration displaying multiple buffers (or +different views of one and the same buffer) in one and the same +display cycle, lisp program programmers will unavoidably have to write +their own action functions. A few tricks listed below might help in +this regard. + +@itemize @bullet +@item +Making windows atomic (@pxref{Atomic Windows}) avoids that an +existing window composition gets broken when popping up a new window. +The new window will pop up outside the composition instead. + +@item +Temporarily dedicating windows to their buffers (@pxref{Dedicated +Windows}) avoids that a window gets used for displaying a different +buffer. A non-dedicated window will be used instead. + +@item +Calling @code{window-preserve-size} (@pxref{Preserving Window Sizes}) +will try to keep the size of the argument window unchanged when +popping up a new window. You have to make sure that another window in +the same combination can be shrunk instead, though. + +@item +Side windows (@pxref{Side Windows}) can be used for displaying +specific buffers always in a window at the same position of a frame. +This permits to group buffers that do not compete for being shown at +the same time on a frame and show any such buffer in the same window +without disrupting the display of other buffers. + +@item +Child frames (@pxref{Child Frames}) can be used to display a buffer +within the screen estate of the selected frame without disrupting that +frame's window configuration and without the overhead associated with +full-fledged frames as inflicted by @code{display-buffer-pop-up-frame}. +@end itemize +@end table -@defun same-window-p buffer-name -This function returns @code{t} if displaying a buffer -named @var{buffer-name} with @code{display-buffer} would -put it in the selected window. -@end defun @node Window History @section Window History @@ -3202,12 +4009,13 @@ main window is either a ``normal'' live window or specifies the area containing all the normal windows. In their most simple form of use, side windows allow to display -specific buffers always in the same area of a frame. Hence they can be -regarded as a generalization of the concept provided by -@code{display-buffer-at-bottom} (@pxref{Display Action Functions}) to -the remaining sides of a frame. With suitable customizations, however, -side windows can be also used to provide frame layouts similar to those -found in so-called integrated development environments (IDEs). +specific buffers always in the same area of a frame. Hence they can +be regarded as a generalization of the concept provided by +@code{display-buffer-at-bottom} (@pxref{Buffer Display Action +Functions}) to the remaining sides of a frame. With suitable +customizations, however, side windows can be also used to provide +frame layouts similar to those found in so-called integrated +development environments (IDEs). @menu * Displaying Buffers in Side Windows:: An action function for displaying @@ -3221,9 +4029,9 @@ found in so-called integrated development environments (IDEs). @node Displaying Buffers in Side Windows @subsection Displaying Buffers in Side Windows -The following action function for @code{display-buffer} (@pxref{Display -Action Functions}) creates or reuses a side window for displaying the -specified buffer. +The following action function for @code{display-buffer} (@pxref{Buffer +Display Action Functions}) creates or reuses a side window for +displaying the specified buffer. @defun display-buffer-in-side-window buffer alist This function displays @var{buffer} in a side window of the selected @@ -3263,11 +4071,11 @@ explicitly provided via a @code{window-parameters} entry in @var{alist}. @end defun By default, side windows cannot be split via @code{split-window} -(@pxref{Splitting Windows}). Also, a side window is not reused or split -by any buffer display action (@pxref{Display Action Functions}) unless -it is explicitly specified as target of that action. Note also that -@code{delete-other-windows} cannot make a side window the only window on -its frame (@pxref{Deleting Windows}). +(@pxref{Splitting Windows}). Also, a side window is not reused or +split by any buffer display action (@pxref{Buffer Display Action +Functions}) unless it is explicitly specified as target of that +action. Note also that @code{delete-other-windows} cannot make a side +window the only window on its frame (@pxref{Deleting Windows}). Once set up, side windows also change the behavior of the commands @code{switch-to-prev-buffer} and @code{switch-to-next-buffer} @@ -3453,9 +4261,9 @@ retain their respective sizes when maximizing the frame, the variable @xref{Resizing Windows}. The last form also makes sure that none of the created side windows -are accessible via @kbd{C-x o} by installing the @code{no-other-window} +are accessible via @w{@kbd{C-x o}} by installing the @code{no-other-window} parameter for each of these windows. In addition, it makes sure that -side windows are not deleted via @kbd{C-x 1} by installing the +side windows are not deleted via @w{@kbd{C-x 1}} by installing the @code{no-delete-other-windows} parameter for each of these windows. Since @code{dired} buffers have no fixed names, we use a special @@ -3547,7 +4355,7 @@ does is to set the @code{window-atom} parameter of each descendant of To create a new atomic window from an existing live window or to add a new window to an existing atomic window, the following buffer display -action function (@pxref{Display Action Functions}) can be used: +action function (@pxref{Buffer Display Action Functions}) can be used: @defun display-buffer-in-atom-window buffer alist This function tries to display @var{buffer} in a new window that will be commit b4eb908f858284a7962851fd99c94598f76afa6f Author: Paul Eggert Date: Sat Nov 3 13:11:26 2018 -0700 Improve time error reporting * src/timefns.c (emacs_mktime_z): Remove; no longer needed. (time_error): New function, replacing invalid_time. All callers changed. (decode_float_time, decode_ticks_hz, decode_time_components): Return an error number instead of merely a boolean. All callers changed. (decode_lisp_time): Signal an error based on the error number, instead of merely returning a boolean to the caller. All callers changed. (format_time_string, Fdecode_time, Fencode_time) (Fcurrent_time_string): Do not assume that a failure of a system time function must be due to time overflow. (Fencode_time): Don't report an error merely because mktime returned ((time_t) -1), as that may be a valid time_t value. Use a simpler error check. See: https://www.sourceware.org/ml/libc-alpha/2018-11/msg00062.html diff --git a/src/timefns.c b/src/timefns.c index c94d97d9a8..f527d5ed7f 100644 --- a/src/timefns.c +++ b/src/timefns.c @@ -171,16 +171,6 @@ emacs_localtime_rz (timezone_t tz, time_t const *t, struct tm *tm) return tm; } -static time_t -emacs_mktime_z (timezone_t tz, struct tm *tm) -{ - errno = 0; - time_t t = mktime_z (tz, tm); - if (t == (time_t) -1 && errno == ENOMEM) - memory_full (SIZE_MAX); - return t; -} - static _Noreturn void invalid_time_zone_specification (Lisp_Object zone) { @@ -347,9 +337,14 @@ time_overflow (void) } static _Noreturn void -invalid_time (void) +time_error (int err) { - error ("Invalid time specification"); + switch (err) + { + case ENOMEM: memory_full (SIZE_MAX); + case EOVERFLOW: time_overflow (); + default: error ("Invalid time specification"); + } } static _Noreturn void @@ -373,19 +368,19 @@ lo_time (time_t t) } /* Convert T into an Emacs time *RESULT, truncating toward minus infinity. - Return true if T is in range, false otherwise. */ -static bool + Return zero if successful, an error number otherwise. */ +static int decode_float_time (double t, struct lisp_time *result) { if (!isfinite (t)) - return false; + return isnan (t) ? EINVAL : EOVERFLOW; /* Actual hz unknown; guess TIMESPEC_HZ. */ mpz_set_d (mpz[1], t); mpz_set_si (mpz[0], floor ((t - trunc (t)) * TIMESPEC_HZ)); mpz_addmul_ui (mpz[0], mpz[1], TIMESPEC_HZ); result->ticks = make_integer_mpz (); result->hz = timespec_hz; - return true; + return 0; } /* Compute S + NS/TIMESPEC_HZ as a double. @@ -569,9 +564,9 @@ lisp_time_form_stamp (struct lisp_time t, Lisp_Object form) start of the POSIX Epoch. Unsuccessful calls may or may not store results. - Return true if successful, false if (TICKS . HZ) would not + Return zero if successful, an error number if (TICKS . HZ) would not be a valid new-format timestamp. */ -static bool +static int decode_ticks_hz (Lisp_Object ticks, Lisp_Object hz, struct lisp_time *result, double *dresult) { @@ -581,7 +576,7 @@ decode_ticks_hz (Lisp_Object ticks, Lisp_Object hz, if (! (INTEGERP (ticks) && ((FIXNUMP (hz) && 0 < XFIXNUM (hz)) || (BIGNUMP (hz) && 0 < mpz_sgn (XBIGNUM (hz)->value))))) - return false; + return EINVAL; if (result) { @@ -600,7 +595,7 @@ decode_ticks_hz (Lisp_Object ticks, Lisp_Object hz, if (ns < 0) s--, ns += TIMESPEC_HZ; *dresult = s_ns_to_double (s, ns); - return true; + return 0; } ns = mpz_fdiv_q_ui (*q, XBIGNUM (ticks)->value, TIMESPEC_HZ); } @@ -610,7 +605,7 @@ decode_ticks_hz (Lisp_Object ticks, Lisp_Object hz, if (FIXNUMP (ticks)) { *dresult = XFIXNUM (ticks); - return true; + return 0; } q = &XBIGNUM (ticks)->value; } @@ -624,7 +619,7 @@ decode_ticks_hz (Lisp_Object ticks, Lisp_Object hz, *dresult = s_ns_to_double (mpz_get_d (*q), ns); } - return true; + return 0; } /* Lisp timestamp classification. */ @@ -649,9 +644,8 @@ enum timeform start of the POSIX Epoch. Unsuccessful calls may or may not store results. - Return true if successful, false if the components are of the wrong - type. */ -static bool + Return zero if successful, an error number otherwise. */ +static int decode_time_components (enum timeform form, Lisp_Object high, Lisp_Object low, Lisp_Object usec, Lisp_Object psec, @@ -660,7 +654,7 @@ decode_time_components (enum timeform form, switch (form) { case TIMEFORM_INVALID: - return false; + return EINVAL; case TIMEFORM_TICKS_HZ: return decode_ticks_hz (high, low, result, dresult); @@ -673,7 +667,7 @@ decode_time_components (enum timeform form, else { *dresult = t; - return true; + return 0; } } @@ -687,7 +681,7 @@ decode_time_components (enum timeform form, } else *dresult = s_ns_to_double (now.tv_sec, now.tv_nsec); - return true; + return 0; } default: @@ -696,7 +690,7 @@ decode_time_components (enum timeform form, if (! (INTEGERP (high) && INTEGERP (low) && FIXNUMP (usec) && FIXNUMP (psec))) - return false; + return EINVAL; EMACS_INT us = XFIXNUM (usec); EMACS_INT ps = XFIXNUM (psec); @@ -740,7 +734,7 @@ decode_time_components (enum timeform form, else *dresult = mpz_get_d (mpz[0]) + (us * 1e6L + ps) / 1e12L; - return true; + return 0; } enum { DECODE_SECS_ONLY = WARN_OBSOLETE_TIMESTAMPS + 1 }; @@ -758,9 +752,8 @@ enum { DECODE_SECS_ONLY = WARN_OBSOLETE_TIMESTAMPS + 1 }; start of the POSIX Epoch. Unsuccessful calls may or may not store results. - Return true if successful, false if SPECIFIED_TIME is - not a valid Lisp timestamp. */ -static bool + Signal an error if unsuccessful. */ +static void decode_lisp_time (Lisp_Object specified_time, int flags, enum timeform *pform, struct lisp_time *result, double *dresult) @@ -820,7 +813,10 @@ decode_lisp_time (Lisp_Object specified_time, int flags, if (pform) *pform = form; - return decode_time_components (form, high, low, usec, psec, result, dresult); + int err = decode_time_components (form, high, low, usec, psec, + result, dresult); + if (err) + time_error (err); } /* Convert Z to time_t, returning true if it fits. */ @@ -915,8 +911,8 @@ list4_to_timespec (Lisp_Object high, Lisp_Object low, struct timespec *result) { struct lisp_time t; - if (! decode_time_components (TIMEFORM_HI_LO_US_PS, high, low, usec, psec, - &t, 0)) + if (decode_time_components (TIMEFORM_HI_LO_US_PS, high, low, usec, psec, + &t, 0)) return false; *result = lisp_to_timespec (t); return timespec_valid_p (*result); @@ -928,10 +924,8 @@ list4_to_timespec (Lisp_Object high, Lisp_Object low, static struct lisp_time lisp_time_struct (Lisp_Object specified_time, enum timeform *pform) { - int flags = WARN_OBSOLETE_TIMESTAMPS; struct lisp_time t; - if (! decode_lisp_time (specified_time, flags, pform, &t, 0)) - invalid_time (); + decode_lisp_time (specified_time, WARN_OBSOLETE_TIMESTAMPS, pform, &t, 0); return t; } @@ -956,8 +950,7 @@ lisp_seconds_argument (Lisp_Object specified_time) { int flags = WARN_OBSOLETE_TIMESTAMPS | DECODE_SECS_ONLY; struct lisp_time lt; - if (! decode_lisp_time (specified_time, flags, 0, <, 0)) - invalid_time (); + decode_lisp_time (specified_time, flags, 0, <, 0); struct timespec t = lisp_to_timespec (lt); if (! timespec_valid_p (t)) time_overflow (); @@ -1126,8 +1119,7 @@ or (if you need time as a string) `format-time-string'. */) (Lisp_Object specified_time) { double t; - if (! decode_lisp_time (specified_time, 0, 0, 0, &t)) - invalid_time (); + decode_lisp_time (specified_time, 0, 0, 0, &t); return make_float (t); } @@ -1200,8 +1192,9 @@ format_time_string (char const *format, ptrdiff_t formatlen, tmp = emacs_localtime_rz (tz, &tsec, tmp); if (! tmp) { + int localtime_errno = errno; xtzfree (tz); - time_overflow (); + time_error (localtime_errno); } synchronize_system_time_locale (); @@ -1338,10 +1331,12 @@ usage: (decode-time &optional TIME ZONE) */) struct tm local_tm, gmt_tm; timezone_t tz = tzlookup (zone, false); struct tm *tm = emacs_localtime_rz (tz, &time_spec, &local_tm); + int localtime_errno = errno; xtzfree (tz); - if (! (tm - && MOST_NEGATIVE_FIXNUM - TM_YEAR_BASE <= local_tm.tm_year + if (!tm) + time_error (localtime_errno); + if (! (MOST_NEGATIVE_FIXNUM - TM_YEAR_BASE <= local_tm.tm_year && local_tm.tm_year <= MOST_POSITIVE_FIXNUM - TM_YEAR_BASE)) time_overflow (); @@ -1445,7 +1440,6 @@ year values as low as 1901 do work. usage: (encode-time &optional TIME FORM &rest OBSOLESCENT-ARGUMENTS) */) (ptrdiff_t nargs, Lisp_Object *args) { - time_t value; struct tm tm; Lisp_Object form = Qnil, zone = Qnil; Lisp_Object a = args[0]; @@ -1460,8 +1454,7 @@ usage: (encode-time &optional TIME FORM &rest OBSOLESCENT-ARGUMENTS) */) if (! CONSP (tail)) { struct lisp_time t; - if (! decode_lisp_time (a, 0, 0, &t, 0)) - invalid_time (); + decode_lisp_time (a, 0, 0, &t, 0); return lisp_time_form_stamp (t, form); } tm.tm_sec = check_tm_member (XCAR (a), 0); a = XCDR (a); @@ -1492,11 +1485,13 @@ usage: (encode-time &optional TIME FORM &rest OBSOLESCENT-ARGUMENTS) */) } timezone_t tz = tzlookup (zone, false); - value = emacs_mktime_z (tz, &tm); + tm.tm_wday = -1; + time_t value = mktime_z (tz, &tm); + int mktime_errno = errno; xtzfree (tz); - if (value == (time_t) -1) - time_overflow (); + if (tm.tm_wday < 0) + time_error (mktime_errno); return time_form_stamp (value, form); } @@ -1544,9 +1539,10 @@ without consideration for daylight saving time. */) range -999 .. 9999. */ struct tm tm; struct tm *tmp = emacs_localtime_rz (tz, &value, &tm); + int localtime_errno = errno; xtzfree (tz); if (! tmp) - time_overflow (); + time_error (localtime_errno); static char const wday_name[][4] = { "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" }; commit 7cadb328092e354225149bbc74c2ddaf4b49b638 Author: Eli Zaretskii Date: Sat Nov 3 19:37:54 2018 +0200 ; * doc/lispref/control.texi (pcase Macro): Fix another typo. diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index c298eae32b..8989b7de91 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -1226,7 +1226,7 @@ For an alternative facility for destructuring binding, see @ref{seq-let}. @defmac pcase-let bindings body@dots{} -Perform desctructuring binding of variables according to +Perform destructuring binding of variables according to @var{bindings}, and then evaluate @var{body}. @var{bindings} is a list of bindings of the form @w{@code{(@var{pattern} @@ -1242,7 +1242,7 @@ evaluated @var{exp}. @end defmac @defmac pcase-let* bindings body@dots{} -Perform desctructuring binding of variables according to +Perform destructuring binding of variables according to @var{bindings}, and then evaluate @var{body}. @var{bindings} is a list of bindings of the form @code{(@var{pattern} commit 963f1d95842638c97c7188c8fbb5eaf1e7232f3e Author: Eli Zaretskii Date: Sat Nov 3 18:11:29 2018 +0200 ; * doc/lispref/control.texi (pcase Macro): Fix a typo. diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index f80622e602..c298eae32b 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -518,8 +518,8 @@ Matches any @var{expval}. This is also known as @dfn{don't care} or @dfn{wildcard}. @item '@var{val} -Matches if @var{expval} is equals @var{val}. The comparison is done -as if by @code{equal} (@pxref{Equality Predicates}). +Matches if @var{expval} equals @var{val}. The comparison is done as +if by @code{equal} (@pxref{Equality Predicates}). @item @var{keyword} @itemx @var{integer} commit e824c914dabd92537a0d6e44eaa10bb4699c312f Author: Eli Zaretskii Date: Sat Nov 3 15:11:33 2018 +0200 Improve documentation of destructuring-binding macros * lisp/emacs-lisp/pcase.el (pcase-dolist, pcase-let) (pcase-let*): Improve the doc strings. * doc/lispref/sequences.texi (Sequence Functions): Improve wording and rename arguments of seq-let to be more descriptive. Add a cross-reference to "Destructuring with pcase Patterns". * doc/lispref/control.texi (Pattern-Matching Conditional): Improve wording and the menu. (pcase Macro): Incorporate patch suggested by Paul Eggert . Reformat text. (Destructuring with pcase Patterns): Rename from "Destructuring patterns", and improve wording and indexing. diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index 06c6622bf0..f80622e602 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -419,65 +419,68 @@ This is not completely equivalent because it can evaluate @var{arg1} or @node Pattern-Matching Conditional @section Pattern-Matching Conditional @cindex pcase -@cindex pattern matching +@cindex pattern matching, programming style Aside from the four basic conditional forms, Emacs Lisp also has a pattern-matching conditional form, the @code{pcase} macro, a hybrid of @code{cond} and @code{cl-case} (@pxref{Conditionals,,,cl,Common Lisp Extensions}) that overcomes their limitations and introduces -the @dfn{pattern matching} programming style. -First, the limitations: +the @dfn{pattern matching programming style}. +The limitations that @code{pcase} overcomes are: @itemize -@item The @code{cond} form chooses among alternatives -by evaluating the predicate @var{condition} of each -of its clauses (@pxref{Conditionals}). -The primary limitation is that variables let-bound in @var{condition} -are not available to the clause's @var{body-forms}. +@item +The @code{cond} form chooses among alternatives by evaluating the +predicate @var{condition} of each of its clauses +(@pxref{Conditionals}). The primary limitation is that variables +let-bound in @var{condition} are not available to the clause's +@var{body-forms}. Another annoyance (more an inconvenience than a limitation) is that when a series of @var{condition} predicates implement -equality tests, there is a lot of repeated code. -For that, why not use @code{cl-case}? +equality tests, there is a lot of repeated code. (@code{cl-case} +solves this inconvenience.) @item The @code{cl-case} macro chooses among alternatives by evaluating the equality of its first argument against a set of specific values. -The limitations are two-fold: + +Its limitations are two-fold: @enumerate -@item The equality tests use @code{eql}. -@item The values must be known and written in advance. +@item +The equality tests use @code{eql}. +@item +The values must be known and written in advance. @end enumerate @noindent These render @code{cl-case} unsuitable for strings or compound -data structures (e.g., lists or vectors). -For that, why not use @code{cond}? -(And here we end up in a circle.) +data structures (e.g., lists or vectors). (@code{cond} doesn't have +these limitations, but it has others, see above.) @end itemize @noindent Conceptually, the @code{pcase} macro borrows the first-arg focus of @code{cl-case} and the clause-processing flow of @code{cond}, replacing @var{condition} with a generalization of -the equality test called @dfn{matching}, +the equality test which is a variant of @dfn{pattern matching}, and adding facilities so that you can concisely express a clause's predicate, and arrange to share let-bindings between a clause's predicate and @var{body-forms}. The concise expression of a predicate is known as a @dfn{pattern}. -When the predicate, called on the value of the first arg, -returns non-@code{nil}, the pattern matches the value -(or sometimes ``the value matches the pattern''). +When the predicate, called on the value of the first arg, returns +non-@code{nil}, we say that ``the pattern matches the value'' (or +sometimes ``the value matches the pattern''). @menu -* The @code{pcase} macro: pcase Macro. Plus examples and caveats. +* The @code{pcase} macro: pcase Macro. Includes examples and caveats. * Extending @code{pcase}: Extending pcase. Define new kinds of patterns. -* Backquote-Style Patterns: Backquote Patterns. Structural matching. -* Destructuring patterns:: Using pcase patterns to extract subfields. +* Backquote-Style Patterns: Backquote Patterns. Structural patterns matching. +* Destructuring with pcase Patterns:: Using pcase patterns to extract subfields. @end menu @node pcase Macro @@ -498,30 +501,30 @@ of the last of @var{body-forms} in the successful clause. Otherwise, @code{pcase} evaluates to @code{nil}. @end defmac -Each @var{pattern} has to be a @dfn{pcase pattern}, which can either -use one of the core patterns defined below, or use one of the patterns -defined via @code{pcase-defmacro}. +@cindex pcase pattern +Each @var{pattern} has to be a @dfn{pcase pattern}, which can use +either one of the core patterns defined below, or one of the patterns +defined via @code{pcase-defmacro} (@pxref{Extending pcase}). -The rest of this subsection -describes different forms of core patterns, -presents some examples, -and concludes with important caveats on using the -let-binding facility provided by some pattern forms. -A core pattern can have the following forms: +The rest of this subsection describes different forms of core +patterns, presents some examples, and concludes with important caveats +on using the let-binding facility provided by some pattern forms. A +core pattern can have the following forms: @table @code @item _ Matches any @var{expval}. -This is known as @dfn{don't care} or @dfn{wildcard}. +This is also known as @dfn{don't care} or @dfn{wildcard}. @item '@var{val} -Matches if @var{expval} is @code{equal} to @var{val}. +Matches if @var{expval} is equals @var{val}. The comparison is done +as if by @code{equal} (@pxref{Equality Predicates}). @item @var{keyword} @itemx @var{integer} @itemx @var{string} -Matches if @var{expval} is @code{equal} to the literal object. +Matches if @var{expval} equals the literal object. This is a special case of @code{'@var{val}}, above, possible because literal objects of these types are self-quoting. @@ -533,17 +536,17 @@ Matches any @var{expval}, and additionally let-binds @var{symbol} to If @var{symbol} is part of a sequencing pattern @var{seqpat} (e.g., by using @code{and}, below), the binding is also available to the portion of @var{seqpat} following the appearance of @var{symbol}. -This usage has some caveats (@pxref{pcase-symbol-caveats,,caveats}). +This usage has some caveats, see @ref{pcase-symbol-caveats,,caveats}. Two symbols to avoid are @code{t}, which behaves like @code{_} -(above) and is deprecated, and @code{nil}, which signals error. +(above) and is deprecated, and @code{nil}, which signals an error. Likewise, it makes no sense to bind keyword symbols (@pxref{Constant Variables}). @item (pred @var{function}) Matches if the predicate @var{function} returns non-@code{nil} when called on @var{expval}. -@var{function} can have one of the possible forms: +the predicate @var{function} can have one of the following forms: @table @asis @item function name (a symbol) @@ -570,20 +573,17 @@ the actual function call becomes: @w{@code{(= 42 @var{expval})}}. @item (app @var{function} @var{pattern}) Matches if @var{function} called on @var{expval} returns a value that matches @var{pattern}. -@var{function} can take one of the -forms described for @code{pred}, above. -Unlike @code{pred}, however, -@code{app} tests the result against @var{pattern}, -rather than against a boolean truth value. +@var{function} can take one of the forms described for @code{pred}, +above. Unlike @code{pred}, however, @code{app} tests the result +against @var{pattern}, rather than against a boolean truth value. @item (guard @var{boolean-expression}) Matches if @var{boolean-expression} evaluates to non-@code{nil}. @item (let @var{pattern} @var{expr}) -Evaluates @var{expr} to get @var{exprval} -and matches if @var{exprval} matches @var{pattern}. -(It is called @code{let} because -@var{pattern} can bind symbols to values using @var{symbol}.) +Evaluates @var{expr} to get @var{exprval} and matches if @var{exprval} +matches @var{pattern}. (It is called @code{let} because @var{pattern} +can bind symbols to values using @var{symbol}.) @end table @cindex sequencing pattern @@ -596,18 +596,16 @@ but instead of processing values, they process sub-patterns. @table @code @item (and @var{pattern1}@dots{}) -Attempts to match @var{pattern1}@dots{}, in order, -until one of them fails to match. -In that case, @code{and} likewise fails to match, -and the rest of the sub-patterns are not tested. -If all sub-patterns match, @code{and} matches. +Attempts to match @var{pattern1}@dots{}, in order, until one of them +fails to match. In that case, @code{and} likewise fails to match, and +the rest of the sub-patterns are not tested. If all sub-patterns +match, @code{and} matches. @item (or @var{pattern1} @var{pattern2}@dots{}) Attempts to match @var{pattern1}, @var{pattern2}, @dots{}, in order, -until one of them succeeds. -In that case, @code{or} likewise matches, -and the rest of the sub-patterns are not tested. -(Note that there must be at least two sub-patterns. +until one of them succeeds. In that case, @code{or} likewise matches, +and the rest of the sub-patterns are not tested. (Note that there +must be at least two sub-patterns. Simply @w{@code{(or @var{pattern1})}} signals error.) @c Issue: Is this correct and intended? @c Are there exceptions, qualifications? @@ -1042,12 +1040,11 @@ Both use a single backquote construct (@pxref{Backquote}). This subsection describes @dfn{backquote-style patterns}, a set of builtin patterns that eases structural matching. -For background, @xref{Pattern-Matching Conditional}. +For background, @pxref{Pattern-Matching Conditional}. -@dfn{Backquote-style patterns} are a powerful set of -@code{pcase} pattern extensions (created using @code{pcase-defmacro}) -that make it easy to match @var{expval} against -specifications of its @emph{structure}. +Backquote-style patterns are a powerful set of @code{pcase} pattern +extensions (created using @code{pcase-defmacro}) that make it easy to +match @var{expval} against specifications of its @emph{structure}. For example, to match @var{expval} that must be a list of two elements whose first element is a specific string and the second @@ -1173,87 +1170,102 @@ evaluation results: (evaluate '(sub 1 2) nil) @result{} error @end example -@node Destructuring patterns -@subsection Destructuring Patterns -@cindex destructuring patterns +@node Destructuring with pcase Patterns +@subsection Destructuring with @code{pcase} Patterns +@cindex destructuring with pcase patterns Pcase patterns not only express a condition on the form of the objects -they can match but they can also extract sub-fields of those objects. -Say we have a list and want to extract 2 elements from it with the -following code: +they can match, but they can also extract sub-fields of those objects. +For example we can extract 2 elements from a list that is the value of +the variable @code{my-list} with the following code: @example - (pcase l + (pcase my-list (`(add ,x ,y) (message "Contains %S and %S" x y))) @end example This will not only extract @code{x} and @code{y} but will additionally -test that @code{l} is a list containing exactly 3 elements and whose -first element is the symbol @code{add}. If any of those tests fail, -@code{pcase} will directly return @code{nil} without calling +test that @code{my-list} is a list containing exactly 3 elements and +whose first element is the symbol @code{add}. If any of those tests +fail, @code{pcase} will immediately return @code{nil} without calling @code{message}. -@dfn{Destructuring} of an object is an operation that extracts -multiple values stored in the object, e.g., the 2nd and the 3rd -element of a list or a vector. @dfn{Destructuring binding} is -similar to a local binding (@pxref{Local Variables}), but it gives -values to multiple elements of a variable by extracting those values -from an object of compatible structure. +Extraction of multiple values stored in an object is known as +@dfn{destructuring}. Using @code{pcase} patterns allows to perform +@dfn{destructuring binding}, which is similar to a local binding +(@pxref{Local Variables}), but gives values to multiple elements of +a variable by extracting those values from an object of compatible +structure. -The macros described in this section use @dfn{destructuring -patterns}, which are normal Pcase patterns used in a context where we -presume that the object does match the pattern, and we only want -to extract some subfields. For example: +The macros described in this section use @code{pcase} patterns to +perform destructuring binding. The condition of the object to be of +compatible structure means that the object must match the pattern, +because only then the object's subfields can be extracted. For +example: @example - (pcase-let ((`(add ,x ,y) l)) + (pcase-let ((`(add ,x ,y) my-list)) (message "Contains %S and %S" x y)) @end example @noindent does the same as the previous example, except that it directly tries -to extract @code{x} and @code{y} from @code{l} without first verifying -if @code{l} is a list which has the right number of elements and has -@code{add} as its first element. -The precise behavior when the object does not actually match the -pattern is undefined, although the body will not be silently skipped: -either an error is signaled or the body is run with some of the -variables potentially bound to arbitrary values like @code{nil}. +to extract @code{x} and @code{y} from @code{my-list} without first +verifying if @code{my-list} is a list which has the right number of +elements and has @code{add} as its first element. The precise +behavior when the object does not actually match the pattern is +undefined, although the body will not be silently skipped: either an +error is signaled or the body is run with some of the variables +potentially bound to arbitrary values like @code{nil}. + +The pcase patterns that are useful for destructuring bindings are +generally those described in @ref{Backquote Patterns}, since they +express a specification of the structure of objects that will match. + +For an alternative facility for destructuring binding, see +@ref{seq-let}. @defmac pcase-let bindings body@dots{} -Bind variables according to @var{bindings} and then eval @var{body}. +Perform desctructuring binding of variables according to +@var{bindings}, and then evaluate @var{body}. @var{bindings} is a list of bindings of the form @w{@code{(@var{pattern} @var{exp})}}, where @var{exp} is an expression to evaluate and -@var{pattern} is a destructuring pattern. +@var{pattern} is a @code{pcase} pattern. -All @var{exp}s are evaluated first after which they are matched +All @var{exp}s are evaluated first, after which they are matched against their respective @var{pattern}, introducing new variable -bindings which can then be used inside @var{body}. +bindings that can then be used inside @var{body}. The variable +bindings are produced by destructuring binding of elements of +@var{pattern} to the values of the corresponding elements of the +evaluated @var{exp}. @end defmac @defmac pcase-let* bindings body@dots{} -Bind variables according to @var{bindings} and then eval @var{body}. +Perform desctructuring binding of variables according to +@var{bindings}, and then evaluate @var{body}. @var{bindings} is a list of bindings of the form @code{(@var{pattern} @var{exp})}, where @var{exp} is an expression to evaluate and -@var{pattern} is a destructuring pattern. - -Unlike @code{pcase-let}, but like @code{let*}, each @var{exp} is -matched against its corresponding @var{pattern} before passing to the -next element of @var{bindings}, so the variables introduced in each -binding are available in the @var{exp}s that follow it, additionally -to being available in @var{body}. +@var{pattern} is a @code{pcase} pattern. The variable bindings are +produced by destructuring binding of elements of @var{pattern} to the +values of the corresponding elements of the evaluated @var{exp}. + +Unlike @code{pcase-let}, but similarly to @code{let*}, each @var{exp} +is matched against its corresponding @var{pattern} before processing +the next element of @var{bindings}, so the variable bindings +introduced in each one of the @var{bindings} are available in the +@var{exp}s of the @var{bindings} that follow it, additionally to +being available in @var{body}. @end defmac -@findex dolist @defmac pcase-dolist (pattern list) body@dots{} -This construct executes @var{body} once for each element of -@var{list}, in a context where the variables appearing in the the -destructuring pattern @var{pattern} are bound to the corresponding -values found in the element. -When @var{pattern} is a simple variable, this ends up being equivalent -to @code{dolist}. +Execute @var{body} once for each element of @var{list}, on each +iteration performing a destructuring binding of variables in +@var{pattern} to the values of the corresponding subfields of the +element of @var{list}. The bindings are performed as if by +@code{pcase-let}. When @var{pattern} is a simple variable, this ends +up being equivalent to @code{dolist} (@pxref{Iteration}). @end defmac diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 51d724cb1d..60d017c3e4 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -1049,15 +1049,18 @@ that @var{sequence} can be a list, vector or string. This is primarily useful for side-effects. @end defmac -@defmac seq-let arguments sequence body@dots{} +@anchor{seq-let} +@defmac seq-let var-sequence val-sequence body@dots{} @cindex sequence destructuring - This macro binds the variables defined in @var{arguments} to the -elements of @var{sequence}. @var{arguments} can themselves include -sequences, allowing for nested destructuring. + This macro binds the variables defined in @var{var-sequence} to the +values that are the corresponding elements of @var{val-sequence}. +This is known as @dfn{destructuring binding}. The elements of +@var{var-sequence} can themselves include sequences, allowing for +nested destructuring. -The @var{arguments} sequence can also include the @code{&rest} marker -followed by a variable name to be bound to the rest of -@code{sequence}. +The @var{var-sequence} sequence can also include the @code{&rest} +marker followed by a variable name to be bound to the rest of +@var{val-sequence}. @example @group @@ -1081,6 +1084,9 @@ followed by a variable name to be bound to the rest of @end group @result{} [3 4] @end example + +The @code{pcase} patterns provide an alternative facility for +destructuring binding, see @ref{Destructuring with pcase Patterns}. @end defmac @defun seq-random-elt sequence diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 2e89ae0779..fde3bdb27f 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -264,10 +264,14 @@ variable name being but a special case of it)." ;;;###autoload (defmacro pcase-let* (bindings &rest body) - "Like `let*' but where you can use `pcase' patterns for bindings. -BODY should be an expression, and BINDINGS should be a list of bindings -of the form (PATTERN EXP). -See `pcase-let' for discussion of how PATTERN is matched." + "Like `let*', but supports destructuring BINDINGS using `pcase' patterns. +As with `pcase-let', BINDINGS are of the form (PATTERN EXP), but the +EXP in each binding in BINDINGS can use the results of the destructuring +bindings that precede it in BINDINGS' order. + +Each EXP should match (i.e. be of compatible structure) to its +respective PATTERN; a mismatch may signal an error or may go +undetected, binding variables to arbitrary values, such as nil." (declare (indent 1) (debug ((&rest (pcase-PAT &optional form)) body))) (let ((cached (gethash bindings pcase--memoize))) @@ -280,13 +284,16 @@ See `pcase-let' for discussion of how PATTERN is matched." ;;;###autoload (defmacro pcase-let (bindings &rest body) - "Like `let' but where you can use `pcase' patterns for bindings. -BODY should be a list of expressions, and BINDINGS should be a list of bindings -of the form (PATTERN EXP). -The PATTERNs are only used to extract data, so the code does not test -whether the data does match the corresponding patterns: a mismatch -may signal an error or may go undetected, binding variables to arbitrary -values, such as nil." + "Like `let', but supports destructuring BINDINGS using `pcase' patterns. +BODY should be a list of expressions, and BINDINGS should be a list of +bindings of the form (PATTERN EXP). +All EXPs are evaluated first, and then used to perform destructuring +bindings by matching each EXP against its respective PATTERN. Then +BODY is evaluated with those bindings in effect. + +Each EXP should match (i.e. be of compatible structure) to its +respective PATTERN; a mismatch may signal an error or may go +undetected, binding variables to arbitrary values, such as nil." (declare (indent 1) (debug pcase-let*)) (if (null (cdr bindings)) `(pcase-let* ,bindings ,@body) @@ -304,11 +311,15 @@ values, such as nil." ;;;###autoload (defmacro pcase-dolist (spec &rest body) - "Superset of `dolist' where the VAR binding can be a `pcase' PATTERN. -More specifically, this is just a shorthand for the following combination -of `dolist' and `pcase-let': - - (dolist (x LIST) (pcase-let ((PATTERN x)) BODY...)) + "Eval BODY once for each set of bindings defined by PATTERN and LIST elements. +PATTERN should be a `pcase' pattern describing the structure of +LIST elements, and LIST is a list of objects that match PATTERN, +i.e. have a structure that is compatible with PATTERN. +For each element of LIST, this macro binds the variables in +PATTERN to the corresponding subfields of the LIST element, and +then evaluates BODY with these bindings in effect. The +destructuring bindings of variables in PATTERN to the subfields +of the elements of LIST is performed as if by `pcase-let'. \n(fn (PATTERN LIST) BODY...)" (declare (indent 1) (debug ((pcase-PAT form) body))) (if (pcase--trivial-upat-p (car spec)) commit 07048183a86134b63cb7132038fab6f36a1e57ca Author: Eli Zaretskii Date: Sat Nov 3 12:39:59 2018 +0200 Allow the fringe face to be remapped locally in a buffer * src/fringe.c (draw_window_fringes): Switch to window's buffer to get the local value of face-remapping-alist, if necessary. (Bug#33244) * src/xfaces.c (syms_of_xfaces) : New DEFSYM. diff --git a/src/fringe.c b/src/fringe.c index 6a44de1bf2..a1016ad349 100644 --- a/src/fringe.c +++ b/src/fringe.c @@ -909,6 +909,12 @@ draw_window_fringes (struct window *w, bool no_fringe_p) if (w->pseudo_window_p) return updated_p; + /* We must switch to the window's buffer to use its local value of + the fringe face, in case it's been remapped in face-remapping-alist. */ + Lisp_Object window_buffer = w->contents; + struct buffer *oldbuf = current_buffer; + set_buffer_internal_1 (XBUFFER (window_buffer)); + /* Must draw line if no fringe */ if (no_fringe_p && (WINDOW_LEFT_FRINGE_WIDTH (w) == 0 @@ -926,6 +932,8 @@ draw_window_fringes (struct window *w, bool no_fringe_p) updated_p = 1; } + set_buffer_internal_1 (oldbuf); + return updated_p; } diff --git a/src/xfaces.c b/src/xfaces.c index 50593f6804..6e06d56ba1 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -6755,6 +6755,7 @@ Because Emacs normally only redraws screen areas when the underlying buffer contents change, you may need to call `redraw-display' after changing this variable for it to take effect. */); Vface_remapping_alist = Qnil; + DEFSYM (Qface_remapping_alist,"face-remapping-alist"); DEFVAR_LISP ("face-font-rescale-alist", Vface_font_rescale_alist, doc: /* Alist of fonts vs the rescaling factors. commit 4a344bcab50e688db76c9e123fb7725796cb260b Author: David Edmondson Date: Sun Oct 28 03:11:21 2018 +0000 Add URL truncation support to rcirc (bug#33043) Suggested by David Edmondson . * lisp/net/rcirc.el (rcirc-url-max-length): New user option controlling extent of URL truncation, defaulting to none. (rcirc-markup-urls): Use it. * etc/NEWS: Announce it. diff --git a/etc/NEWS b/etc/NEWS index 51e3da07d4..1020a2a0ea 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -775,6 +775,13 @@ Tramp for some look-alike remote file names. *** For some connection methods, like "su" or "sudo", the host name in ad-hoc multi-hop file names must match the previous hop. +** Rcirc + +--- +*** New user option 'rcirc-url-max-length'. +Setting this option to an integer causes URLs displayed in Rcirc +buffers to be truncated to that many characters. + ** Register --- *** The return value of method 'register-val-describe' includes the diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index fe9c71a21c..ca707341be 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -168,6 +168,14 @@ underneath each nick." (string :tag "Prefix text")) :group 'rcirc) +(defcustom rcirc-url-max-length nil + "Maximum number of characters in displayed URLs. +If nil, no maximum is applied." + :version "27.1" + :type '(choice (const :tag "No maximum" nil) + (integer :tag "Number of characters")) + :group 'rcirc) + (defvar rcirc-ignore-buffer-activity-flag nil "If non-nil, ignore activity in this buffer.") (make-variable-buffer-local 'rcirc-ignore-buffer-activity-flag) @@ -2485,24 +2493,26 @@ If ARG is given, opens the URL in a new browser window." (rcirc-record-activity (current-buffer) 'nick))))) (defun rcirc-markup-urls (_sender _response) - (while (and rcirc-url-regexp ;; nil means disable URL catching + (while (and rcirc-url-regexp ; nil means disable URL catching. (re-search-forward rcirc-url-regexp nil t)) (let* ((start (match-beginning 0)) - (end (match-end 0)) - (url (match-string-no-properties 0)) - (link-text (buffer-substring-no-properties start end))) + (url (buffer-substring-no-properties start (point)))) + (when rcirc-url-max-length + ;; Replace match with truncated URL. + (delete-region start (point)) + (insert (url-truncate-url-for-viewing url rcirc-url-max-length))) ;; Add a button for the URL. Note that we use `make-text-button', ;; rather than `make-button', as text-buttons are much faster in ;; large buffers. - (make-text-button start end + (make-text-button start (point) 'face 'rcirc-url 'follow-link t 'rcirc-url url 'action (lambda (button) (browse-url (button-get button 'rcirc-url)))) - ;; record the url if it is not already the latest stored url - (when (not (string= link-text (caar rcirc-urls))) - (push (cons link-text start) rcirc-urls))))) + ;; Record the URL if it is not already the latest stored URL. + (unless (string= url (caar rcirc-urls)) + (push (cons url start) rcirc-urls))))) (defun rcirc-markup-keywords (sender response) (when (and (string= response "PRIVMSG") commit 484b99a1a83f5e56c917a20de1d46ba1110d5ca2 Author: Eli Zaretskii Date: Sat Nov 3 11:01:44 2018 +0200 ; * etc/NEWS: Fix last change. (Bug#33188) diff --git a/etc/NEWS b/etc/NEWS index 4f0125c173..51e3da07d4 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -868,14 +868,13 @@ UUID at point. *** 'highlight-regexp' can now highlight subexpressions. The now command accepts a prefix numeric argument to choose the subexpression. -** Mouse display major mode menu -+++ -*** 'minor-mode-menu-from-indicator' now display full minor mode. + +** Mouse display of minor mode menu + +--- +*** 'minor-mode-menu-from-indicator' now display full minor mode name. When there is no menu for a mode, display the mode name after the -indicator instead of just the indicator (which is sometime cryptic). -Ex: -before : SP -now : SP - Smartparens Mode +indicator instead of just the indicator (which is sometimes cryptic). * New Modes and Packages in Emacs 27.1 commit 4eb0e4266f7df67439996ff420a13eb7ba2e137a Author: Pierre TĂ©choueyres Date: Wed Oct 10 20:08:05 2018 +0200 'minor-mode-menu-from-indicator' now display full minor mode. When there is no menu for a mode, display the mode name after the indicator instead of just the indicator (which is sometime cryptic). Ex: before : SP now : SP - Smartparens Mode * etc/NEWS: Add en entry for this new feature. * lisp/mouse.el (minor-mode-menu-from-indicator): Append the mode name after the indicator when there is no menu defined by the mode. diff --git a/etc/NEWS b/etc/NEWS index 8d413cccd4..4f0125c173 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -864,11 +864,18 @@ UUID at point. ** Interactive automatic highlighting - +++ *** 'highlight-regexp' can now highlight subexpressions. The now command accepts a prefix numeric argument to choose the subexpression. +** Mouse display major mode menu ++++ +*** 'minor-mode-menu-from-indicator' now display full minor mode. +When there is no menu for a mode, display the mode name after the +indicator instead of just the indicator (which is sometime cryptic). +Ex: +before : SP +now : SP - Smartparens Mode * New Modes and Packages in Emacs 27.1 diff --git a/lisp/mouse.el b/lisp/mouse.el index 7efe751ab6..ca61e36440 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -171,7 +171,10 @@ items `Turn Off' and `Help'." (mouse-menu-non-singleton menu) (if (fboundp mm-fun) ; bug#20201 `(keymap - ,indicator + ,(format "%s - %s" indicator + (capitalize + (replace-regexp-in-string + "-" " " (format "%S" minor-mode)))) (turn-off menu-item "Turn off minor mode" ,mm-fun) (help menu-item "Help for minor mode" (lambda () (interactive) commit 74bc0e16b7f9fdc5011c28182a2c8d828ee426d8 Author: Eli Zaretskii Date: Sat Nov 3 10:49:51 2018 +0200 Avoid byte compilation warning in rcirc.el * lisp/net/rcirc.el (rcirc-prompt-start-marker): Move definition before 1st use to avoild byte-compiler warning. diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index f57f7555c3..7fc3e34928 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -182,6 +182,8 @@ underneath each nick." :type '(repeat string) :group 'rcirc) +(defvar rcirc-prompt-start-marker nil) + (define-minor-mode rcirc-omit-mode "Toggle the hiding of \"uninteresting\" lines. With a prefix argument ARG, enable Rcirc-Omit mode if ARG is @@ -401,7 +403,6 @@ will be killed." (defvar rcirc-nick nil) -(defvar rcirc-prompt-start-marker nil) (defvar rcirc-prompt-end-marker nil) (defvar rcirc-nick-table nil) commit bd1d61753d90ef47af1e9a3b7a92ee77b7d43ed0 Author: Basil L. Contovounesios Date: Thu Oct 25 03:35:57 2018 +0100 Avoid race in rcirc process filter (bug#33145) * lisp/net/rcirc.el (rcirc-filter): Clear rcirc-process-output before processing its constituent lines. Otherwise, if rcirc-filter runs again before the last rcirc-process-server-response is finished, the contents of rcirc-process-output could be duplicated. diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index c09bff765b..f57f7555c3 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -753,12 +753,12 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.") (with-rcirc-process-buffer process (setq rcirc-last-server-message-time (current-time)) (setq rcirc-process-output (concat rcirc-process-output output)) - (when (= (aref rcirc-process-output - (1- (length rcirc-process-output))) ?\n) - (mapc (lambda (line) - (rcirc-process-server-response process line)) - (split-string rcirc-process-output "[\n\r]" t)) - (setq rcirc-process-output nil)))) + (when (= ?\n (aref rcirc-process-output + (1- (length rcirc-process-output)))) + (let ((lines (split-string rcirc-process-output "[\n\r]" t))) + (setq rcirc-process-output nil) + (dolist (line lines) + (rcirc-process-server-response process line)))))) (defun rcirc-reschedule-timeout (process) (with-rcirc-process-buffer process commit 9aa6861b00645e8365c3249087cc22a42e8fc82b Author: Eli Zaretskii Date: Sat Nov 3 10:42:22 2018 +0200 ; * etc/NEWS: Announce feature introduced in last change. diff --git a/etc/NEWS b/etc/NEWS index efdd7dfeb0..8d413cccd4 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -489,6 +489,11 @@ See the concept index in the Gnus manual for the 'match-list' entry. article(s) to a pre-existing Message buffer, or create a new Message buffer with the article(s) attached. +--- +*** New option 'nnir-notmuch-filter-group-names-function'. +This option controls whether and how to use Gnus search groups as +'path:' search terms to 'notmuch'. + ** erc --- commit 4e9644475727ff718c2c8b0d2ef091aaf3e751c8 Author: Eric Abrahamsen Date: Tue Oct 23 10:51:37 2018 +0800 Allow use of Gnus search groups as notmuch path: search term * lisp/gnus/nnir.el (nnir-notmuch-filter-group-names-function): New option governing whether and how to use Gnus' search groups as path: search terms to notmuch. (nnir-run-notmuch): Check and possibly use above variable. (Bug#33122) diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 7e5f56e4dd..ea7257d0c9 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -518,6 +518,26 @@ that it is for notmuch, not Namazu." :type '(regexp) :group 'nnir) +(defcustom nnir-notmuch-filter-group-names-function + #'gnus-group-short-name + "Whether and how to use Gnus group names as \"path:\" search terms. +When nil, the groups being searched in are not used as notmuch +:path search terms. It's still possible to use \"path:\" terms +manually within the search query, however. + +When a function, map this function over all the group names. By +default this runs them through `gnus-group-short-name', and it is +recommended to use this transform, at least. Further +transforms (for instance, converting \".\" to \"/\") can be +added like so: + +\(add-function :filter-return + nnir-notmuch-filter-group-names-function + (lambda (g) (replace-regexp-in-string \"\\\\.\" \"/\" g)))" + :version "27.1" + :type '(choice function + nil)) + ;;; Developer Extension Variable: (defvar nnir-engines @@ -1505,23 +1525,30 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." (> (nnir-artitem-rsv x) (nnir-artitem-rsv y))))))))) -(defun nnir-run-notmuch (query server &optional _group) +(defun nnir-run-notmuch (query server &optional groups) "Run QUERY against notmuch. Returns a vector of (group name, file name) pairs (also vectors, -actually)." - - ;; (when group - ;; (error "The notmuch backend cannot search specific groups")) +actually). If GROUPS is a list of group names, use them to +construct path: search terms (see the variable +`nnir-notmuch-filter-group-names-function')." (save-excursion - (let ( (qstring (cdr (assq 'query query))) - (groupspec (cdr (assq 'notmuch-group query))) + (let* ((qstring (cdr (assq 'query query))) (prefix (nnir-read-server-parm 'nnir-notmuch-remove-prefix server)) artlist (article-pattern (if (string-match "\\`nnmaildir:" (gnus-group-server server)) - ":[0-9]+" - "^[0-9]+$")) + ":[0-9]+" + "^[0-9]+$")) + (groups (when nnir-notmuch-filter-group-names-function + (mapcar nnir-notmuch-filter-group-names-function + groups))) + (pathquery (when groups + (concat "(" + (mapconcat (lambda (g) + (format " path:%s" g)) + groups " or") + ")"))) artno dirnam filenam) (when (equal "" qstring) @@ -1530,10 +1557,14 @@ actually)." (set-buffer (get-buffer-create nnir-tmp-buffer)) (erase-buffer) - (if groupspec - (message "Doing notmuch query %s on %s..." qstring groupspec) + (if groups + (message "Doing notmuch query %s on %s..." + qstring (mapconcat #'identity groups " ")) (message "Doing notmuch query %s..." qstring)) + (when groups + (setq qstring (concat qstring pathquery))) + (let* ((cp-list `( ,nnir-notmuch-program nil ; input from /dev/null t ; output @@ -1571,10 +1602,7 @@ actually)." (when (string-match article-pattern artno) (when (not (null dirnam)) - ;; maybe limit results to matching groups. - (when (or (not groupspec) - (string-match groupspec dirnam)) - (nnir-add-result dirnam artno "" prefix server artlist))))) + (nnir-add-result dirnam artno "" prefix server artlist)))) (message "Massaging notmuch output...done") commit 1f38454e00826c958807340d156302a78158966f Author: Eli Zaretskii Date: Sat Nov 3 10:37:01 2018 +0200 ; * etc/NEWS: Fix last change. diff --git a/etc/NEWS b/etc/NEWS index b71ac804e3..efdd7dfeb0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -339,8 +339,9 @@ When no files are marked, all modified files are stashed, as before. *** The new hook 'vc-retrieve-tag-hook' runs after retrieving a tag. ---- `vc-hg' now invokes `smerge-mode' correctly when visiting files. -Code that attempted to invoke `smerge-mode' when visiting an Hg file +--- +*** 'vc-hg' now invokes 'smerge-mode' when visiting files. +Code that attempted to invoke 'smerge-mode' when visiting an Hg file with conflicts existed in earlier versions of Emacs, but incorrectly never detected a conflict due to invalid assumptions about cached values. commit 9d5c4d07462e69b4e0552e7f09e3e59a3fd10b6a Author: Daniel Pittman Date: Tue Oct 23 11:24:04 2018 -0400 Fix interaction between vc-hg find-file-hook and vc state caching Bad assumptions in the `vc-hg-find-file-hook' prevented it from working. This correctly them. (Bug#33129). 2018-10-23 Daniel Pittman * lisp/vc/vc-hg.el (vc-hg-find-file-hook): This function made two assumptions about conflicted files that were not accurate, preventing conflicts in files ever being detected. The first was that the `vc-state' was cache by the time this was invoked, which it is not - at least when visiting the file, or using `vc-refresh-state'. The second was that a file with the ".orig" extension would be present, next to the file being visited. This is the default behavior of Mercurial, but can be overridden by the user. Since the VC mode-line code will shortly calculate the state for display, the optimization of testing for the ".orig" file only delayed this work by a few moments. diff --git a/etc/NEWS b/etc/NEWS index ac23b3b181..b71ac804e3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -339,6 +339,12 @@ When no files are marked, all modified files are stashed, as before. *** The new hook 'vc-retrieve-tag-hook' runs after retrieving a tag. +--- `vc-hg' now invokes `smerge-mode' correctly when visiting files. +Code that attempted to invoke `smerge-mode' when visiting an Hg file +with conflicts existed in earlier versions of Emacs, but incorrectly +never detected a conflict due to invalid assumptions about cached +values. + ** diff-mode *** Hunks are now automatically refined by default. To disable it, set the new defcustom 'diff-font-lock-refine' to nil. diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 3696573595..d528813bc0 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -1142,11 +1142,9 @@ REV is the revision to check out into WORKFILE." (defun vc-hg-find-file-hook () (when (and buffer-file-name - (file-exists-p (concat buffer-file-name ".orig")) ;; Hg does not seem to have a "conflict" status, eg ;; hg http://bz.selenic.com/show_bug.cgi?id=2724 - (memq (vc-file-getprop buffer-file-name 'vc-state) - '(edited conflict)) + (memq (vc-state buffer-file-name) '(edited conflict)) ;; Maybe go on to check that "hg resolve -l" says "U"? ;; If "hg resolve -l" says there's a conflict but there are no ;; conflict markers, it's not clear what we should do. commit 88ef31abd4716fad14889b08686d42ebbb7dc6c0 Author: Jordan Wilson Date: Wed Oct 10 11:45:57 2018 +0100 Avoid file-name errors when viewing PDF from Gnus * lisp/doc-view.el (doc-view-mode): Run the output file name through 'convert-standard-filename', to avoid problems with characters that are not allowed in file names on some systems. (Bug#32989) Copyright-paperwork-exempt: yes diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 4a4862f828..6ad47fc792 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -1772,27 +1772,28 @@ toggle between displaying the document or editing it as text. (doc-view-make-safe-dir doc-view-cache-directory) ;; Handle compressed files, remote files, files inside archives (setq-local doc-view--buffer-file-name - (cond - (jka-compr-really-do-compress - ;; FIXME: there's a risk of name conflicts here. - (expand-file-name - (file-name-nondirectory - (file-name-sans-extension buffer-file-name)) - doc-view-cache-directory)) - ;; Is the file readable by local processes? - ;; We used to use `file-remote-p' but it's unclear what it's - ;; supposed to return nil for things like local files accessed - ;; via `su' or via file://... - ((let ((file-name-handler-alist nil)) - (not (and buffer-file-name - (file-readable-p buffer-file-name)))) - ;; FIXME: there's a risk of name conflicts here. - (expand-file-name - (if buffer-file-name - (file-name-nondirectory buffer-file-name) - (buffer-name)) - doc-view-cache-directory)) - (t buffer-file-name))) + (convert-standard-filename + (cond + (jka-compr-really-do-compress + ;; FIXME: there's a risk of name conflicts here. + (expand-file-name + (file-name-nondirectory + (file-name-sans-extension buffer-file-name)) + doc-view-cache-directory)) + ;; Is the file readable by local processes? + ;; We used to use `file-remote-p' but it's unclear what it's + ;; supposed to return nil for things like local files accessed + ;; via `su' or via file://... + ((let ((file-name-handler-alist nil)) + (not (and buffer-file-name + (file-readable-p buffer-file-name)))) + ;; FIXME: there's a risk of name conflicts here. + (expand-file-name + (if buffer-file-name + (file-name-nondirectory buffer-file-name) + (buffer-name)) + doc-view-cache-directory)) + (t buffer-file-name)))) (when (not (string= doc-view--buffer-file-name buffer-file-name)) (write-region nil nil doc-view--buffer-file-name)) commit 7b82d514371f77072b30a4a6a75cba6684ea56b4 Author: Stefan Monnier Date: Fri Nov 2 17:47:11 2018 -0400 * lisp/emacs-lisp/syntax.el (syntax-propertize-rules): Allow empty rules diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el index ad1a9665ff..a4b7015f73 100644 --- a/lisp/emacs-lisp/syntax.el +++ b/lisp/emacs-lisp/syntax.el @@ -176,7 +176,7 @@ Note: back-references in REGEXPs do not work." (re (mapconcat (lambda (rule) - (let* ((orig-re (eval (car rule))) + (let* ((orig-re (eval (car rule) t)) (re orig-re)) (when (and (assq 0 rule) (cdr rules)) ;; If there's more than 1 rule, and the rule want to apply @@ -190,7 +190,7 @@ Note: back-references in REGEXPs do not work." (cond ((assq 0 rule) (if (zerop offset) t `(match-beginning ,offset))) - ((null (cddr rule)) + ((and (cdr rule) (null (cddr rule))) `(match-beginning ,(+ offset (car (cadr rule))))) (t `(or ,@(mapcar commit aee434c3e0e05b4e490753598e4601feb9b9616e Author: Stefan Monnier Date: Fri Nov 2 16:14:49 2018 -0400 * lisp/help-fns.el (describe-symbol): Use help--symbol-completion-table diff --git a/lisp/help-fns.el b/lisp/help-fns.el index ec46a479ed..7979ef3328 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1141,7 +1141,7 @@ current buffer and the selected frame, respectively." (format "Describe symbol (default %s): " v-or-f) "Describe symbol: ") - obarray + #'help--symbol-completion-table (lambda (vv) (cl-some (lambda (x) (funcall (nth 1 x) vv)) describe-symbol-backends)) commit ef183b996c3aade55e16d8fbcd68d9c4f360729e Author: Stefan Monnier Date: Fri Nov 2 15:00:34 2018 -0400 * src/data.c (Ffset): Don't signal gratuitous errors diff --git a/src/data.c b/src/data.c index 538081e5c9..f8b991e898 100644 --- a/src/data.c +++ b/src/data.c @@ -758,7 +758,9 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0, register Lisp_Object function; CHECK_SYMBOL (symbol); /* Perhaps not quite the right error signal, but seems good enough. */ - if (NILP (symbol)) + if (NILP (symbol) && !NILP (definition)) + /* There are so many other ways to shoot oneself in the foot, I don't + think this one little sanity check is worth its cost, but anyway. */ xsignal1 (Qsetting_constant, symbol); function = XSYMBOL (symbol)->u.s.function; commit ea35756ac635dc5e9251552646c0bc0642d7e822 Author: Eric Abrahamsen Date: Thu Nov 1 16:50:17 2018 -0700 Obsolete gnus-correct-length in favor of string-width * lisp/gnus/gnus-spec.el: Define an obsolete alias. diff --git a/lisp/gnus/gnus-spec.el b/lisp/gnus/gnus-spec.el index 379a7f2b5c..4b5f15fbc6 100644 --- a/lisp/gnus/gnus-spec.el +++ b/lisp/gnus/gnus-spec.el @@ -271,9 +271,7 @@ Return a list of updated types." (insert " "))) (insert-char ? (max (- ,column (current-column)) 0)))))) -(defun gnus-correct-length (string) - "Return the correct width of STRING." - (apply #'+ (mapcar #'char-width string))) +(define-obsolete-function-alias 'gnus-correct-length 'string-width "27.1") (defun gnus-correct-substring (string start &optional end) (let ((wstart 0) commit dc7b10e9c452f56a79eb83cd5347e7436fa77e1f Author: Stefan Monnier Date: Fri Nov 2 12:07:12 2018 -0400 * lisp/progmodes/ruby-mode.el: Cosmetic changes Remove redundant :groups. (ruby-font-lock-syntax-table): Delete var. (ruby-mode): Use font-lock-default's syntax-alist instead. diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 32130cee8e..9256dfc17b 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -217,19 +217,16 @@ This should only be called after matching against `ruby-here-doc-beg-re'." (defcustom ruby-indent-tabs-mode nil "Indentation can insert tabs in Ruby mode if this is non-nil." :type 'boolean - :group 'ruby :safe 'booleanp) (defcustom ruby-indent-level 2 "Indentation of Ruby statements." :type 'integer - :group 'ruby :safe 'integerp) (defcustom ruby-comment-column (default-value 'comment-column) "Indentation column of comments." :type 'integer - :group 'ruby :safe 'integerp) (defconst ruby-alignable-keywords '(if while unless until begin case for def) @@ -265,7 +262,6 @@ Only has effect when `ruby-use-smie' is t." (choice ,@(mapcar (lambda (kw) (list 'const kw)) ruby-alignable-keywords)))) - :group 'ruby :safe 'listp :version "24.4") @@ -277,7 +273,6 @@ of its parent. Only has effect when `ruby-use-smie' is t." :type 'boolean - :group 'ruby :safe 'booleanp :version "24.4") @@ -286,7 +281,6 @@ Only has effect when `ruby-use-smie' is t." Also ignores spaces after parenthesis when `space'. Only has effect when `ruby-use-smie' is nil." :type 'boolean - :group 'ruby :safe 'booleanp) ;; FIXME Woefully under documented. What is the point of the last t?. @@ -301,14 +295,12 @@ Only has effect when `ruby-use-smie' is nil." (cons character (choice (const nil) (const t))) (const t) ; why? - ))) - :group 'ruby) + )))) (defcustom ruby-deep-indent-paren-style 'space "Default deep indent style. Only has effect when `ruby-use-smie' is nil." - :type '(choice (const t) (const nil) (const space)) - :group 'ruby) + :type '(choice (const t) (const nil) (const space))) (defcustom ruby-encoding-map '((us-ascii . nil) ;; Do not put coding: us-ascii @@ -318,8 +310,7 @@ Only has effect when `ruby-use-smie' is nil." "Alist to map encoding name from Emacs to Ruby. Associating an encoding name with nil means it needs not be explicitly declared in magic comment." - :type '(repeat (cons (symbol :tag "From") (symbol :tag "To"))) - :group 'ruby) + :type '(repeat (cons (symbol :tag "From") (symbol :tag "To")))) (defcustom ruby-insert-encoding-magic-comment t "Insert a magic Ruby encoding comment upon save if this is non-nil. @@ -336,14 +327,12 @@ even if it's not required." (const :tag "Emacs Style" emacs) (const :tag "Ruby Style" ruby) (const :tag "Custom Style" custom)) - :group 'ruby :version "24.4") (defcustom ruby-custom-encoding-magic-comment-template "# encoding: %s" "A custom encoding comment template. It is used when `ruby-encoding-magic-comment-style' is set to `custom'." :type 'string - :group 'ruby :version "24.4") (defcustom ruby-use-encoding-map t @@ -741,7 +730,7 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'." (back-to-indentation) (narrow-to-region (point) end) (smie-forward-sexp)) - (while (and (setq state (apply 'ruby-parse-partial end state)) + (while (and (setq state (apply #'ruby-parse-partial end state)) (>= (nth 2 state) 0) (< (point) end)))))) (defun ruby-mode-variables () @@ -751,7 +740,7 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'." (smie-setup ruby-smie-grammar #'ruby-smie-rules :forward-token #'ruby-smie--forward-token :backward-token #'ruby-smie--backward-token) - (setq-local indent-line-function 'ruby-indent-line)) + (setq-local indent-line-function #'ruby-indent-line)) (setq-local comment-start "# ") (setq-local comment-end "") (setq-local comment-column ruby-comment-column) @@ -986,6 +975,7 @@ delimiter." ((eq c ?\( ) ruby-deep-arglist))) (defun ruby-parse-partial (&optional end in-string nest depth pcol indent) + ;; FIXME: Document why we can't just use parse-partial-sexp. "TODO: document throughout function body." (or depth (setq depth 0)) (or indent (setq indent 0)) @@ -1160,7 +1150,7 @@ delimiter." (state (list in-string nest depth pcol indent))) ;; parse the rest of the line (while (and (> line-end-position (point)) - (setq state (apply 'ruby-parse-partial + (setq state (apply #'ruby-parse-partial line-end-position state)))) (setq in-string (car state) nest (nth 1 state) @@ -1197,7 +1187,7 @@ delimiter." (save-restriction (narrow-to-region (point) end) (while (and (> end (point)) - (setq state (apply 'ruby-parse-partial end state)))))) + (setq state (apply #'ruby-parse-partial end state)))))) (list (nth 0 state) ; in-string (car (nth 1 state)) ; nest (nth 2 state) ; depth @@ -2034,13 +2024,6 @@ It will be properly highlighted even when the call omits parens.") context))) t))) -(defvar ruby-font-lock-syntax-table - (let ((tbl (make-syntax-table ruby-mode-syntax-table))) - (modify-syntax-entry ?_ "w" tbl) - tbl) - "The syntax table to use for fontifying Ruby mode buffers. -See `font-lock-syntax-table'.") - (defconst ruby-font-lock-keyword-beg-re "\\(?:^\\|[^.@$:]\\|\\.\\.\\)") (defconst ruby-font-lock-keywords @@ -2219,7 +2202,8 @@ See `font-lock-syntax-table'.") ;; Conversion methods on Kernel. (,(concat ruby-font-lock-keyword-beg-re (regexp-opt '("Array" "Complex" "Float" "Hash" - "Integer" "Rational" "String") 'symbols)) + "Integer" "Rational" "String") + 'symbols)) (1 font-lock-builtin-face)) ;; Expression expansion. (ruby-match-expression-expansion @@ -2316,14 +2300,12 @@ See `font-lock-syntax-table'.") Only takes effect if RuboCop is installed." :version "26.1" :type 'boolean - :group 'ruby :safe 'booleanp) (defcustom ruby-rubocop-config ".rubocop.yml" "Configuration file for `ruby-flymake-rubocop'." :version "26.1" :type 'string - :group 'ruby :safe 'stringp) (defun ruby-flymake-rubocop (report-fn &rest _args) @@ -2393,18 +2375,17 @@ Only takes effect if RuboCop is installed." "Major mode for editing Ruby code." (ruby-mode-variables) - (setq-local imenu-create-index-function 'ruby-imenu-create-index) - (setq-local add-log-current-defun-function 'ruby-add-log-current-method) - (setq-local beginning-of-defun-function 'ruby-beginning-of-defun) - (setq-local end-of-defun-function 'ruby-end-of-defun) + (setq-local imenu-create-index-function #'ruby-imenu-create-index) + (setq-local add-log-current-defun-function #'ruby-add-log-current-method) + (setq-local beginning-of-defun-function #'ruby-beginning-of-defun) + (setq-local end-of-defun-function #'ruby-end-of-defun) - (add-hook 'after-save-hook 'ruby-mode-set-encoding nil 'local) - (add-hook 'electric-indent-functions 'ruby--electric-indent-p nil 'local) - (add-hook 'flymake-diagnostic-functions 'ruby-flymake-auto nil 'local) + (add-hook 'after-save-hook #'ruby-mode-set-encoding nil 'local) + (add-hook 'electric-indent-functions #'ruby--electric-indent-p nil 'local) + (add-hook 'flymake-diagnostic-functions #'ruby-flymake-auto nil 'local) - (setq-local font-lock-defaults '((ruby-font-lock-keywords) nil nil)) - (setq-local font-lock-keywords ruby-font-lock-keywords) - (setq-local font-lock-syntax-table ruby-font-lock-syntax-table) + (setq-local font-lock-defaults '((ruby-font-lock-keywords) nil nil + ((?_ . "w")))) (setq-local syntax-propertize-function #'ruby-syntax-propertize)) commit c9390423d609969193de1ea3228e259e22451719 Author: Eli Zaretskii Date: Fri Nov 2 12:07:47 2018 +0200 Avoid crashes with remapped default face in Org mode * src/xfaces.c (face_at_buffer_position): Look up BASE_FACE_ID anew if it is not in the frame's face cache. This avoids crashes when Org mode sets up for a new major mode in embedded code fragment, and the default face is remapped. (Bug#33222) diff --git a/src/xfaces.c b/src/xfaces.c index f1fc6bb632..98a46dcb87 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -5943,7 +5943,14 @@ face_at_buffer_position (struct window *w, ptrdiff_t pos, int face_id; if (base_face_id >= 0) - face_id = base_face_id; + { + face_id = base_face_id; + /* Make sure the base face ID is usable: if someone freed the + cached faces since we've looked up the base face, we need + to look it up again. */ + if (!FACE_FROM_ID_OR_NULL (f, face_id)) + face_id = lookup_basic_face (f, DEFAULT_FACE_ID); + } else if (NILP (Vface_remapping_alist)) face_id = DEFAULT_FACE_ID; else commit 97660fa9d60ef138bea7ec5f7a6b5d2880497066 Author: Eric Abrahamsen Date: Thu Nov 1 13:21:27 2018 -0700 Doc fix for checkdoc-continue * lisp/emacs-lisp/checkdoc.el (checkdoc-continue): There is no second optional argument, and the function always starts from point. diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index f2bf15d72d..f8f6a5c236 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -901,9 +901,8 @@ a separate buffer." ;;;###autoload (defun checkdoc-continue (&optional take-notes) "Find the next doc string in the current buffer which has a style error. -Prefix argument TAKE-NOTES means to continue through the whole buffer and -save warnings in a separate buffer. Second optional argument START-POINT -is the starting location. If this is nil, `point-min' is used instead." +Prefix argument TAKE-NOTES means to continue through the whole +buffer and save warnings in a separate buffer." (interactive "P") (let ((wrong nil) (msg nil) ;; Assign a flag to spellcheck flag commit 96f055bb4b89af240d7151185d8759e9b26d4fdc Author: Eli Zaretskii Date: Thu Nov 1 20:56:31 2018 +0200 Fix a typo in autoload.el * lisp/emacs-lisp/autoload.el (update-directory-autoloads): Remove stray backslashes. (Bug#33231) diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 92ad6155b5..a0ca0440fb 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -1034,7 +1034,7 @@ write its autoloads into the specified file instead." ;; we don't want to depend on whether Emacs was ;; built with or without modules support, nor ;; what is the suffix for the underlying OS. - (unless (string-match "\\.\\(elc\\|\\so\\|dll\\)" suf) + (unless (string-match "\\.\\(elc\\|so\\|dll\\)" suf) (push suf tmp))) (concat "^[^=.].*" (regexp-opt tmp t) "\\'"))) (files (apply #'nconc commit 5b218be0c362316384f5c9ef57a3bef02f742e94 Author: Stefan Monnier Date: Thu Nov 1 09:00:42 2018 -0400 * lisp/progmodes/cc-mode.el: Silence compiler warnings (c-parse-quotes-before-change, c-parse-quotes-after-change): Flag unused args according to convention. diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index d019cf2493..cc1991a564 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1463,7 +1463,7 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") (goto-char (match-beginning 0)) (save-excursion (search-forward "'" (match-end 0) t))))))))) -(defun c-parse-quotes-before-change (beg end) +(defun c-parse-quotes-before-change (_beg _end) ;; This function analyzes 's near the region (c-new-BEG c-new-END), amending ;; those two variables as needed to include 's into that region when they ;; might be syntactically relevant to the change in progress. @@ -1550,7 +1550,7 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") 'c-digit-separator t ?'))))) -(defun c-parse-quotes-after-change (beg end old-len) +(defun c-parse-quotes-after-change (_beg _end _old-len) ;; This function applies syntax-table properties (value '(1)) and ;; c-digit-separator properties as needed to 's within the range (c-new-BEG ;; c-new-END). This operation is performed even within strings and commit f25e5e72151c40d068226d1c6f00ad572bcff2ad Author: Glenn Morris Date: Thu Nov 1 07:24:23 2018 -0400 ; Auto-commit of loaddefs files. diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 9a1f572c11..eda67cdac8 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -25054,7 +25054,8 @@ variable name being but a special case of it). (autoload 'pcase-let* "pcase" "\ Like `let*' but where you can use `pcase' patterns for bindings. BODY should be an expression, and BINDINGS should be a list of bindings -of the form (PAT EXP). +of the form (PATTERN EXP). +See `pcase-let' for discussion of how PATTERN is matched. \(fn BINDINGS &rest BODY)" nil t) @@ -25063,17 +25064,22 @@ of the form (PAT EXP). (autoload 'pcase-let "pcase" "\ Like `let' but where you can use `pcase' patterns for bindings. BODY should be a list of expressions, and BINDINGS should be a list of bindings -of the form (PAT EXP). -The macro is expanded and optimized under the assumption that those -patterns *will* match, so a mismatch may go undetected or may cause -any kind of error. +of the form (PATTERN EXP). +The PATTERNs are only used to extract data, so the code does not test +whether the data does match the corresponding patterns: a mismatch +may signal an error or may go undetected, binding variables to arbitrary +values, such as nil. \(fn BINDINGS &rest BODY)" nil t) (function-put 'pcase-let 'lisp-indent-function '1) (autoload 'pcase-dolist "pcase" "\ -Like `dolist' but where the binding can be a `pcase' pattern. +Superset of `dolist' where the VAR binding can be a `pcase' PATTERN. +More specifically, this is just a shorthand for the following combination +of `dolist' and `pcase-let': + + (dolist (x LIST) (pcase-let ((PATTERN x)) BODY...)) \(fn (PATTERN LIST) BODY...)" nil t) @@ -28900,7 +28906,7 @@ CHAR `chinese-two-byte' (\\cC) `greek-two-byte' (\\cG) `japanese-hiragana-two-byte' (\\cH) - `indian-tow-byte' (\\cI) + `indian-two-byte' (\\cI) `japanese-katakana-two-byte' (\\cK) `korean-hangul-two-byte' (\\cN) `cyrillic-two-byte' (\\cY) @@ -38930,29 +38936,28 @@ Zone out, completely. ;;;*** ;;;### (autoloads nil nil ("abbrev.el" "bindings.el" "buff-menu.el" -;;;;;; "button.el" "calc/calc-aent.el" "calc/calc-embed.el" "calc/calc-loaddefs.el" -;;;;;; "calc/calc-misc.el" "calc/calc-yank.el" "calendar/cal-loaddefs.el" -;;;;;; "calendar/diary-loaddefs.el" "calendar/hol-loaddefs.el" "case-table.el" -;;;;;; "cedet/ede/base.el" "cedet/ede/config.el" "cedet/ede/cpp-root.el" -;;;;;; "cedet/ede/custom.el" "cedet/ede/dired.el" "cedet/ede/emacs.el" -;;;;;; "cedet/ede/files.el" "cedet/ede/generic.el" "cedet/ede/linux.el" -;;;;;; "cedet/ede/loaddefs.el" "cedet/ede/locate.el" "cedet/ede/make.el" -;;;;;; "cedet/ede/shell.el" "cedet/ede/speedbar.el" "cedet/ede/system.el" -;;;;;; "cedet/ede/util.el" "cedet/semantic/analyze.el" "cedet/semantic/analyze/complete.el" -;;;;;; "cedet/semantic/analyze/refs.el" "cedet/semantic/bovine.el" -;;;;;; "cedet/semantic/bovine/c-by.el" "cedet/semantic/bovine/c.el" -;;;;;; "cedet/semantic/bovine/el.el" "cedet/semantic/bovine/gcc.el" -;;;;;; "cedet/semantic/bovine/make-by.el" "cedet/semantic/bovine/make.el" -;;;;;; "cedet/semantic/bovine/scm-by.el" "cedet/semantic/bovine/scm.el" -;;;;;; "cedet/semantic/complete.el" "cedet/semantic/ctxt.el" "cedet/semantic/db-file.el" -;;;;;; "cedet/semantic/db-find.el" "cedet/semantic/db-global.el" -;;;;;; "cedet/semantic/db-mode.el" "cedet/semantic/db-typecache.el" -;;;;;; "cedet/semantic/db.el" "cedet/semantic/debug.el" "cedet/semantic/decorate/include.el" -;;;;;; "cedet/semantic/decorate/mode.el" "cedet/semantic/dep.el" -;;;;;; "cedet/semantic/doc.el" "cedet/semantic/edit.el" "cedet/semantic/find.el" -;;;;;; "cedet/semantic/format.el" "cedet/semantic/html.el" "cedet/semantic/ia-sb.el" -;;;;;; "cedet/semantic/ia.el" "cedet/semantic/idle.el" "cedet/semantic/imenu.el" -;;;;;; "cedet/semantic/lex-spp.el" "cedet/semantic/lex.el" "cedet/semantic/loaddefs.el" +;;;;;; "button.el" "calc/calc-aent.el" "calc/calc-embed.el" "calc/calc-misc.el" +;;;;;; "calc/calc-yank.el" "calendar/cal-loaddefs.el" "calendar/diary-loaddefs.el" +;;;;;; "calendar/hol-loaddefs.el" "case-table.el" "cedet/ede/base.el" +;;;;;; "cedet/ede/config.el" "cedet/ede/cpp-root.el" "cedet/ede/custom.el" +;;;;;; "cedet/ede/dired.el" "cedet/ede/emacs.el" "cedet/ede/files.el" +;;;;;; "cedet/ede/generic.el" "cedet/ede/linux.el" "cedet/ede/locate.el" +;;;;;; "cedet/ede/make.el" "cedet/ede/shell.el" "cedet/ede/speedbar.el" +;;;;;; "cedet/ede/system.el" "cedet/ede/util.el" "cedet/semantic/analyze.el" +;;;;;; "cedet/semantic/analyze/complete.el" "cedet/semantic/analyze/refs.el" +;;;;;; "cedet/semantic/bovine.el" "cedet/semantic/bovine/c-by.el" +;;;;;; "cedet/semantic/bovine/c.el" "cedet/semantic/bovine/el.el" +;;;;;; "cedet/semantic/bovine/gcc.el" "cedet/semantic/bovine/make-by.el" +;;;;;; "cedet/semantic/bovine/make.el" "cedet/semantic/bovine/scm-by.el" +;;;;;; "cedet/semantic/bovine/scm.el" "cedet/semantic/complete.el" +;;;;;; "cedet/semantic/ctxt.el" "cedet/semantic/db-file.el" "cedet/semantic/db-find.el" +;;;;;; "cedet/semantic/db-global.el" "cedet/semantic/db-mode.el" +;;;;;; "cedet/semantic/db-typecache.el" "cedet/semantic/db.el" "cedet/semantic/debug.el" +;;;;;; "cedet/semantic/decorate/include.el" "cedet/semantic/decorate/mode.el" +;;;;;; "cedet/semantic/dep.el" "cedet/semantic/doc.el" "cedet/semantic/edit.el" +;;;;;; "cedet/semantic/find.el" "cedet/semantic/format.el" "cedet/semantic/html.el" +;;;;;; "cedet/semantic/ia-sb.el" "cedet/semantic/ia.el" "cedet/semantic/idle.el" +;;;;;; "cedet/semantic/imenu.el" "cedet/semantic/lex-spp.el" "cedet/semantic/lex.el" ;;;;;; "cedet/semantic/mru-bookmark.el" "cedet/semantic/scope.el" ;;;;;; "cedet/semantic/senator.el" "cedet/semantic/sort.el" "cedet/semantic/symref.el" ;;;;;; "cedet/semantic/symref/cscope.el" "cedet/semantic/symref/global.el" @@ -38965,39 +38970,36 @@ Zone out, completely. ;;;;;; "cedet/semantic/wisent/python-wy.el" "cedet/semantic/wisent/python.el" ;;;;;; "cedet/srecode/compile.el" "cedet/srecode/cpp.el" "cedet/srecode/document.el" ;;;;;; "cedet/srecode/el.el" "cedet/srecode/expandproto.el" "cedet/srecode/getset.el" -;;;;;; "cedet/srecode/insert.el" "cedet/srecode/java.el" "cedet/srecode/loaddefs.el" -;;;;;; "cedet/srecode/map.el" "cedet/srecode/mode.el" "cedet/srecode/srt-wy.el" -;;;;;; "cedet/srecode/srt.el" "cedet/srecode/template.el" "cedet/srecode/texi.el" -;;;;;; "composite.el" "cus-face.el" "cus-start.el" "custom.el" "dired-aux.el" -;;;;;; "dired-loaddefs.el" "dired-x.el" "electric.el" "emacs-lisp/backquote.el" -;;;;;; "emacs-lisp/byte-run.el" "emacs-lisp/cl-extra.el" "emacs-lisp/cl-loaddefs.el" -;;;;;; "emacs-lisp/cl-macs.el" "emacs-lisp/cl-preloaded.el" "emacs-lisp/cl-seq.el" -;;;;;; "emacs-lisp/eieio-compat.el" "emacs-lisp/eieio-custom.el" -;;;;;; "emacs-lisp/eieio-loaddefs.el" "emacs-lisp/eieio-opt.el" -;;;;;; "emacs-lisp/eldoc.el" "emacs-lisp/float-sup.el" "emacs-lisp/lisp-mode.el" -;;;;;; "emacs-lisp/lisp.el" "emacs-lisp/macroexp.el" "emacs-lisp/map-ynp.el" -;;;;;; "emacs-lisp/nadvice.el" "emacs-lisp/syntax.el" "emacs-lisp/timer.el" -;;;;;; "env.el" "epa-hook.el" "erc/erc-autoaway.el" "erc/erc-button.el" -;;;;;; "erc/erc-capab.el" "erc/erc-compat.el" "erc/erc-dcc.el" "erc/erc-desktop-notifications.el" -;;;;;; "erc/erc-ezbounce.el" "erc/erc-fill.el" "erc/erc-identd.el" -;;;;;; "erc/erc-imenu.el" "erc/erc-join.el" "erc/erc-list.el" "erc/erc-loaddefs.el" -;;;;;; "erc/erc-log.el" "erc/erc-match.el" "erc/erc-menu.el" "erc/erc-netsplit.el" -;;;;;; "erc/erc-notify.el" "erc/erc-page.el" "erc/erc-pcomplete.el" -;;;;;; "erc/erc-replace.el" "erc/erc-ring.el" "erc/erc-services.el" -;;;;;; "erc/erc-sound.el" "erc/erc-speedbar.el" "erc/erc-spelling.el" -;;;;;; "erc/erc-stamp.el" "erc/erc-track.el" "erc/erc-truncate.el" -;;;;;; "erc/erc-xdcc.el" "eshell/em-alias.el" "eshell/em-banner.el" -;;;;;; "eshell/em-basic.el" "eshell/em-cmpl.el" "eshell/em-dirs.el" -;;;;;; "eshell/em-glob.el" "eshell/em-hist.el" "eshell/em-ls.el" -;;;;;; "eshell/em-pred.el" "eshell/em-prompt.el" "eshell/em-rebind.el" -;;;;;; "eshell/em-script.el" "eshell/em-smart.el" "eshell/em-term.el" -;;;;;; "eshell/em-tramp.el" "eshell/em-unix.el" "eshell/em-xtra.el" -;;;;;; "eshell/esh-groups.el" "facemenu.el" "faces.el" "files.el" -;;;;;; "font-core.el" "font-lock.el" "format.el" "frame.el" "help.el" -;;;;;; "hfy-cmap.el" "htmlfontify-loaddefs.el" "ibuf-ext.el" "ibuffer-loaddefs.el" -;;;;;; "indent.el" "international/characters.el" "international/charprop.el" -;;;;;; "international/charscript.el" "international/cp51932.el" -;;;;;; "international/eucjp-ms.el" "international/mule-cmds.el" +;;;;;; "cedet/srecode/insert.el" "cedet/srecode/java.el" "cedet/srecode/map.el" +;;;;;; "cedet/srecode/mode.el" "cedet/srecode/srt-wy.el" "cedet/srecode/srt.el" +;;;;;; "cedet/srecode/template.el" "cedet/srecode/texi.el" "composite.el" +;;;;;; "cus-face.el" "cus-start.el" "custom.el" "dired-aux.el" "dired-x.el" +;;;;;; "electric.el" "emacs-lisp/backquote.el" "emacs-lisp/byte-run.el" +;;;;;; "emacs-lisp/cl-extra.el" "emacs-lisp/cl-macs.el" "emacs-lisp/cl-preloaded.el" +;;;;;; "emacs-lisp/cl-seq.el" "emacs-lisp/eieio-compat.el" "emacs-lisp/eieio-custom.el" +;;;;;; "emacs-lisp/eieio-opt.el" "emacs-lisp/eldoc.el" "emacs-lisp/float-sup.el" +;;;;;; "emacs-lisp/lisp-mode.el" "emacs-lisp/lisp.el" "emacs-lisp/macroexp.el" +;;;;;; "emacs-lisp/map-ynp.el" "emacs-lisp/nadvice.el" "emacs-lisp/syntax.el" +;;;;;; "emacs-lisp/timer.el" "env.el" "epa-hook.el" "erc/erc-autoaway.el" +;;;;;; "erc/erc-button.el" "erc/erc-capab.el" "erc/erc-compat.el" +;;;;;; "erc/erc-dcc.el" "erc/erc-desktop-notifications.el" "erc/erc-ezbounce.el" +;;;;;; "erc/erc-fill.el" "erc/erc-identd.el" "erc/erc-imenu.el" +;;;;;; "erc/erc-join.el" "erc/erc-list.el" "erc/erc-log.el" "erc/erc-match.el" +;;;;;; "erc/erc-menu.el" "erc/erc-netsplit.el" "erc/erc-notify.el" +;;;;;; "erc/erc-page.el" "erc/erc-pcomplete.el" "erc/erc-replace.el" +;;;;;; "erc/erc-ring.el" "erc/erc-services.el" "erc/erc-sound.el" +;;;;;; "erc/erc-speedbar.el" "erc/erc-spelling.el" "erc/erc-stamp.el" +;;;;;; "erc/erc-track.el" "erc/erc-truncate.el" "erc/erc-xdcc.el" +;;;;;; "eshell/em-alias.el" "eshell/em-banner.el" "eshell/em-basic.el" +;;;;;; "eshell/em-cmpl.el" "eshell/em-dirs.el" "eshell/em-glob.el" +;;;;;; "eshell/em-hist.el" "eshell/em-ls.el" "eshell/em-pred.el" +;;;;;; "eshell/em-prompt.el" "eshell/em-rebind.el" "eshell/em-script.el" +;;;;;; "eshell/em-smart.el" "eshell/em-term.el" "eshell/em-tramp.el" +;;;;;; "eshell/em-unix.el" "eshell/em-xtra.el" "facemenu.el" "faces.el" +;;;;;; "files.el" "font-core.el" "font-lock.el" "format.el" "frame.el" +;;;;;; "help.el" "hfy-cmap.el" "ibuf-ext.el" "indent.el" "international/characters.el" +;;;;;; "international/charprop.el" "international/charscript.el" +;;;;;; "international/cp51932.el" "international/eucjp-ms.el" "international/mule-cmds.el" ;;;;;; "international/mule-conf.el" "international/mule.el" "international/uni-bidi.el" ;;;;;; "international/uni-brackets.el" "international/uni-category.el" ;;;;;; "international/uni-combining.el" "international/uni-comment.el" @@ -39033,31 +39035,30 @@ Zone out, completely. ;;;;;; "leim/quail/slovak.el" "leim/quail/symbol-ksc.el" "leim/quail/tamil-dvorak.el" ;;;;;; "leim/quail/tsang-b5.el" "leim/quail/tsang-cns.el" "leim/quail/vntelex.el" ;;;;;; "leim/quail/vnvni.el" "leim/quail/welsh.el" "loadup.el" "mail/blessmail.el" -;;;;;; "mail/rmail-loaddefs.el" "mail/rmailedit.el" "mail/rmailkwd.el" -;;;;;; "mail/rmailmm.el" "mail/rmailmsc.el" "mail/rmailsort.el" -;;;;;; "mail/rmailsum.el" "mail/undigest.el" "menu-bar.el" "mh-e/mh-gnus.el" -;;;;;; "mh-e/mh-loaddefs.el" "minibuffer.el" "mouse.el" "net/tramp-loaddefs.el" -;;;;;; "newcomment.el" "obarray.el" "org/ob-core.el" "org/ob-keys.el" -;;;;;; "org/ob-lob.el" "org/ob-matlab.el" "org/ob-tangle.el" "org/ob.el" -;;;;;; "org/org-archive.el" "org/org-attach.el" "org/org-bbdb.el" -;;;;;; "org/org-clock.el" "org/org-datetree.el" "org/org-element.el" -;;;;;; "org/org-feed.el" "org/org-footnote.el" "org/org-id.el" "org/org-indent.el" -;;;;;; "org/org-install.el" "org/org-irc.el" "org/org-loaddefs.el" -;;;;;; "org/org-mobile.el" "org/org-plot.el" "org/org-table.el" -;;;;;; "org/org-timer.el" "org/ox-ascii.el" "org/ox-beamer.el" "org/ox-html.el" -;;;;;; "org/ox-icalendar.el" "org/ox-latex.el" "org/ox-man.el" "org/ox-md.el" -;;;;;; "org/ox-odt.el" "org/ox-org.el" "org/ox-publish.el" "org/ox-texinfo.el" -;;;;;; "org/ox.el" "progmodes/elisp-mode.el" "progmodes/prog-mode.el" -;;;;;; "ps-def.el" "ps-mule.el" "ps-print-loaddefs.el" "register.el" -;;;;;; "replace.el" "rfn-eshadow.el" "select.el" "simple.el" "startup.el" -;;;;;; "subdirs.el" "subr.el" "textmodes/fill.el" "textmodes/page.el" -;;;;;; "textmodes/paragraphs.el" "textmodes/reftex-auc.el" "textmodes/reftex-cite.el" -;;;;;; "textmodes/reftex-dcr.el" "textmodes/reftex-global.el" "textmodes/reftex-index.el" -;;;;;; "textmodes/reftex-loaddefs.el" "textmodes/reftex-parse.el" -;;;;;; "textmodes/reftex-ref.el" "textmodes/reftex-sel.el" "textmodes/reftex-toc.el" -;;;;;; "textmodes/text-mode.el" "uniquify.el" "vc/ediff-hook.el" -;;;;;; "vc/vc-hooks.el" "version.el" "widget.el" "window.el") (0 -;;;;;; 0 0 0)) +;;;;;; "mail/rmailedit.el" "mail/rmailkwd.el" "mail/rmailmm.el" +;;;;;; "mail/rmailmsc.el" "mail/rmailsort.el" "mail/rmailsum.el" +;;;;;; "mail/undigest.el" "menu-bar.el" "mh-e/mh-gnus.el" "mh-e/mh-loaddefs.el" +;;;;;; "minibuffer.el" "mouse.el" "net/tramp-loaddefs.el" "newcomment.el" +;;;;;; "obarray.el" "org/ob-core.el" "org/ob-keys.el" "org/ob-lob.el" +;;;;;; "org/ob-matlab.el" "org/ob-tangle.el" "org/ob.el" "org/org-archive.el" +;;;;;; "org/org-attach.el" "org/org-bbdb.el" "org/org-clock.el" +;;;;;; "org/org-datetree.el" "org/org-element.el" "org/org-feed.el" +;;;;;; "org/org-footnote.el" "org/org-id.el" "org/org-indent.el" +;;;;;; "org/org-install.el" "org/org-irc.el" "org/org-mobile.el" +;;;;;; "org/org-plot.el" "org/org-table.el" "org/org-timer.el" "org/ox-ascii.el" +;;;;;; "org/ox-beamer.el" "org/ox-html.el" "org/ox-icalendar.el" +;;;;;; "org/ox-latex.el" "org/ox-man.el" "org/ox-md.el" "org/ox-odt.el" +;;;;;; "org/ox-org.el" "org/ox-publish.el" "org/ox-texinfo.el" "org/ox.el" +;;;;;; "progmodes/elisp-mode.el" "progmodes/prog-mode.el" "ps-def.el" +;;;;;; "ps-mule.el" "register.el" "replace.el" "rfn-eshadow.el" +;;;;;; "select.el" "simple.el" "startup.el" "subdirs.el" "subr.el" +;;;;;; "textmodes/fill.el" "textmodes/page.el" "textmodes/paragraphs.el" +;;;;;; "textmodes/reftex-auc.el" "textmodes/reftex-cite.el" "textmodes/reftex-dcr.el" +;;;;;; "textmodes/reftex-global.el" "textmodes/reftex-index.el" +;;;;;; "textmodes/reftex-parse.el" "textmodes/reftex-ref.el" "textmodes/reftex-sel.el" +;;;;;; "textmodes/reftex-toc.el" "textmodes/text-mode.el" "uniquify.el" +;;;;;; "vc/ediff-hook.el" "vc/vc-hooks.el" "version.el" "widget.el" +;;;;;; "window.el") (0 0 0 0)) ;;;*** commit d53a2b65db9952580efcf5ffe75a313bcb49a99e Author: Glenn Morris Date: Thu Nov 1 06:24:27 2018 -0400 ; Auto-commit of loaddefs files. diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index a9ea74102d..56a6283f70 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -24952,7 +24952,8 @@ variable name being but a special case of it). (autoload 'pcase-let* "pcase" "\ Like `let*' but where you can use `pcase' patterns for bindings. BODY should be an expression, and BINDINGS should be a list of bindings -of the form (PAT EXP). +of the form (PATTERN EXP). +See `pcase-let' for discussion of how PATTERN is matched. \(fn BINDINGS &rest BODY)" nil t) @@ -24961,17 +24962,22 @@ of the form (PAT EXP). (autoload 'pcase-let "pcase" "\ Like `let' but where you can use `pcase' patterns for bindings. BODY should be a list of expressions, and BINDINGS should be a list of bindings -of the form (PAT EXP). -The macro is expanded and optimized under the assumption that those -patterns *will* match, so a mismatch may go undetected or may cause -any kind of error. +of the form (PATTERN EXP). +The PATTERNs are only used to extract data, so the code does not test +whether the data does match the corresponding patterns: a mismatch +may signal an error or may go undetected, binding variables to arbitrary +values, such as nil. \(fn BINDINGS &rest BODY)" nil t) (function-put 'pcase-let 'lisp-indent-function '1) (autoload 'pcase-dolist "pcase" "\ -Like `dolist' but where the binding can be a `pcase' pattern. +Superset of `dolist' where the VAR binding can be a `pcase' PATTERN. +More specifically, this is just a shorthand for the following combination +of `dolist' and `pcase-let': + + (dolist (x LIST) (pcase-let ((PATTERN x)) BODY...)) \(fn (PATTERN LIST) BODY...)" nil t) @@ -28752,7 +28758,7 @@ CHAR `chinese-two-byte' (\\cC) `greek-two-byte' (\\cG) `japanese-hiragana-two-byte' (\\cH) - `indian-tow-byte' (\\cI) + `indian-two-byte' (\\cI) `japanese-katakana-two-byte' (\\cK) `korean-hangul-two-byte' (\\cN) `cyrillic-two-byte' (\\cY) @@ -34624,7 +34630,7 @@ Reenable Ange-FTP, when Tramp is unloaded. ;;;### (autoloads nil "trampver" "net/trampver.el" (0 0 0 0)) ;;; Generated autoloads from net/trampver.el -(push (purecopy '(tramp 2 3 4 26 2)) package--builtin-versions) +(push (purecopy '(tramp 2 3 5 26 2)) package--builtin-versions) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "trampver" '("tramp-"))) commit 9962cf959fd2edf7a68036ca9a81c0bbe35b67df Author: Stefan Monnier Date: Wed Oct 31 15:34:45 2018 -0400 * doc/lispref/control.texi (Destructuring patterns): New subsection. diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index 5be4b298b4..06c6622bf0 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -477,6 +477,7 @@ returns non-@code{nil}, the pattern matches the value * The @code{pcase} macro: pcase Macro. Plus examples and caveats. * Extending @code{pcase}: Extending pcase. Define new kinds of patterns. * Backquote-Style Patterns: Backquote Patterns. Structural matching. +* Destructuring patterns:: Using pcase patterns to extract subfields. @end menu @node pcase Macro @@ -497,6 +498,10 @@ of the last of @var{body-forms} in the successful clause. Otherwise, @code{pcase} evaluates to @code{nil}. @end defmac +Each @var{pattern} has to be a @dfn{pcase pattern}, which can either +use one of the core patterns defined below, or use one of the patterns +defined via @code{pcase-defmacro}. + The rest of this subsection describes different forms of core patterns, presents some examples, @@ -1168,6 +1173,90 @@ evaluation results: (evaluate '(sub 1 2) nil) @result{} error @end example +@node Destructuring patterns +@subsection Destructuring Patterns +@cindex destructuring patterns + +Pcase patterns not only express a condition on the form of the objects +they can match but they can also extract sub-fields of those objects. +Say we have a list and want to extract 2 elements from it with the +following code: + +@example + (pcase l + (`(add ,x ,y) (message "Contains %S and %S" x y))) +@end example + +This will not only extract @code{x} and @code{y} but will additionally +test that @code{l} is a list containing exactly 3 elements and whose +first element is the symbol @code{add}. If any of those tests fail, +@code{pcase} will directly return @code{nil} without calling +@code{message}. + +@dfn{Destructuring} of an object is an operation that extracts +multiple values stored in the object, e.g., the 2nd and the 3rd +element of a list or a vector. @dfn{Destructuring binding} is +similar to a local binding (@pxref{Local Variables}), but it gives +values to multiple elements of a variable by extracting those values +from an object of compatible structure. + +The macros described in this section use @dfn{destructuring +patterns}, which are normal Pcase patterns used in a context where we +presume that the object does match the pattern, and we only want +to extract some subfields. For example: + +@example + (pcase-let ((`(add ,x ,y) l)) + (message "Contains %S and %S" x y)) +@end example + +@noindent +does the same as the previous example, except that it directly tries +to extract @code{x} and @code{y} from @code{l} without first verifying +if @code{l} is a list which has the right number of elements and has +@code{add} as its first element. +The precise behavior when the object does not actually match the +pattern is undefined, although the body will not be silently skipped: +either an error is signaled or the body is run with some of the +variables potentially bound to arbitrary values like @code{nil}. + +@defmac pcase-let bindings body@dots{} +Bind variables according to @var{bindings} and then eval @var{body}. + +@var{bindings} is a list of bindings of the form @w{@code{(@var{pattern} +@var{exp})}}, where @var{exp} is an expression to evaluate and +@var{pattern} is a destructuring pattern. + +All @var{exp}s are evaluated first after which they are matched +against their respective @var{pattern}, introducing new variable +bindings which can then be used inside @var{body}. +@end defmac + +@defmac pcase-let* bindings body@dots{} +Bind variables according to @var{bindings} and then eval @var{body}. + +@var{bindings} is a list of bindings of the form @code{(@var{pattern} +@var{exp})}, where @var{exp} is an expression to evaluate and +@var{pattern} is a destructuring pattern. + +Unlike @code{pcase-let}, but like @code{let*}, each @var{exp} is +matched against its corresponding @var{pattern} before passing to the +next element of @var{bindings}, so the variables introduced in each +binding are available in the @var{exp}s that follow it, additionally +to being available in @var{body}. +@end defmac + +@findex dolist +@defmac pcase-dolist (pattern list) body@dots{} +This construct executes @var{body} once for each element of +@var{list}, in a context where the variables appearing in the the +destructuring pattern @var{pattern} are bound to the corresponding +values found in the element. +When @var{pattern} is a simple variable, this ends up being equivalent +to @code{dolist}. +@end defmac + + @node Iteration @section Iteration @cindex iteration commit 0913f18dbebd8480289863480cd147a63ee59cca Author: Michael Albinus Date: Wed Oct 31 20:04:04 2018 +0100 Remote file name completion is also performed by auth-sources search * doc/misc/tramp.texi (File name completion): User and host name completion is also performed by auth-sources search. * etc/NEWS: Document remote file name completion using auth-sources. * lisp/net/tramp.el (tramp-completion-use-auth-sources): New user option. (tramp-parse-auth-sources): New defun. (tramp-get-completion-function): Call it. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 128501c390..f68205519f 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -2538,6 +2538,14 @@ names on that host. When the configuration (@pxref{Customizing Completion}) includes user names, then the completion lists will account for the user names as well. +@vindex tramp-completion-use-auth-sources +Results from @code{auth-sources} search (@pxref{Using an +authentication file}) are added to the completion candidates. This +search could be annoying, for example due to a passphrase request of +the @file{~/.authinfo.gpg} authentication file. The user option +@code{tramp-completion-use-auth-sources} controls, whether such a +search is performed during completion. + Remote hosts previously visited or hosts whose connections are kept persistently (@pxref{Connection caching}) will be included in the completion lists. diff --git a/etc/NEWS b/etc/NEWS index 226ae1e135..ac23b3b181 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -750,6 +750,11 @@ are obsoleted in GVFS. +++ *** Validated passwords are saved by auth-source backends which support this. ++++ +*** During user and host name completion in the minibuffer, results +from auth-source search are taken into account. This can be disabled +by setting user option 'tramp-completion-use-auth-sources' to nil. + +++ *** The user option 'tramp-ignored-file-name-regexp' allows to disable Tramp for some look-alike remote file names. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index a1246659d8..13c3b5f939 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1985,6 +1985,8 @@ For definition of that list see `tramp-set-completion-function'." (append `(;; Default settings are taken into account. (tramp-parse-default-user-host ,method) + ;; Hits from auth-sources. + (tramp-parse-auth-sources ,method) ;; Hosts visited once shall be remembered. (tramp-parse-connection-properties ,method)) ;; The method related defaults. @@ -2788,6 +2790,23 @@ This function is added always in `tramp-get-completion-function' for all methods. Resulting data are derived from default settings." `((,(tramp-find-user method nil nil) ,(tramp-find-host method nil nil)))) +(defcustom tramp-completion-use-auth-sources auth-source-do-cache + "Whether to use `auth-source-search' for completion of user and host names. +This could be disturbing, if it requires a password / passphrase, +as for \"~/.authinfo.gpg\"." + :group 'tramp + :version "27.1" + :type 'boolean) + +(defun tramp-parse-auth-sources (method) + "Return a list of (user host) tuples allowed to access for METHOD. +This function is added always in `tramp-get-completion-function' +for all methods. Resulting data are derived from default settings." + (and tramp-completion-use-auth-sources + (mapcar + (lambda (x) `(,(plist-get x :user) ,(plist-get x :host))) + (auth-source-search :port method :max most-positive-fixnum)))) + ;; Generic function. (defun tramp-parse-group (regexp match-level skip-regexp) "Return a (user host) tuple allowed to access. commit 42681c54bf5ea2ff9d2a3ec6553766b194454caf Merge: 3a739236d0 c3cf85b1c1 Author: Glenn Morris Date: Wed Oct 31 07:50:58 2018 -0700 ; Merge from origin/emacs-26 The following commits were skipped: c3cf85b (origin/emacs-26) Add regression test for Bug#33014 1ad2903 Refer to bytecode constant vectors (Bug#33014) commit 3a739236d061cf44dcba77f163e6087be4fd09fa Merge: 5fec8294a7 eb903d8f20 Author: Glenn Morris Date: Wed Oct 31 07:50:57 2018 -0700 Merge from origin/emacs-26 eb903d8 * lisp/emacs-lisp/pcase.el: Improve docstrings. 86abbb3 * lisp/emacs-lisp/rx.el (rx): Fix typo in doc string. (Bug#3... ced58d3 Improve doc string of 'call-process' 38f88a7 Document that generic functions cannot be commands 5aeddfa * lisp/mail/rmailsum.el (rmail-summary-output): Add lost word... 10e0fd8 Add index entries for more isearch commands/bindings (Bug#32990) de28184 * lisp/simple.el (filter-buffer-substring): Clarify doc (Bug#... d192c16 Fix recent change in lispref/processes.texi. commit 5fec8294a7eb50a4ada26519cd578006b8d16b35 Author: Stefan Monnier Date: Wed Oct 31 10:16:02 2018 -0400 * lisp/emacs-lisp/cl-generic.el: Clarify we can't define commands (cl--generic-lambda): Warn about the presence of interactive specs. diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 173173305b..c7f0c48f85 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -345,6 +345,9 @@ the specializer used will be the one returned by BODY." . ,(lambda () spec-args)) macroexpand-all-environment))) (require 'cl-lib) ;Needed to expand `cl-flet' and `cl-function'. + (when (interactive-form (cadr fun)) + (message "Interactive forms unsupported in generic functions: %S" + (interactive-form (cadr fun)))) ;; First macroexpand away the cl-function stuff (e.g. &key and ;; destructuring args, `declare' and whatnot). (pcase (macroexpand fun macroenv) commit c3cf85b1c186e13c2d588aa35ffa57981ca481d7 Author: Gemini Lasswell Date: Tue Oct 30 21:15:51 2018 -0700 Add regression test for Bug#33014 Backport from master. * test/src/eval-tests.el: (eval-tests-byte-code-being-evaluated-is-protected-from-gc): New test. (eval-tests-33014-var): New variable. (eval-tests-33014-func, eval-tests-33014-redefine): New functions. diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el index e68fd13611..eeb98b0994 100644 --- a/test/src/eval-tests.el +++ b/test/src/eval-tests.el @@ -99,4 +99,34 @@ crash/abort/malloc assert failure on the next test." (signal-hook-function #'ignore)) (should-error (eval-tests--exceed-specbind-limit)))) +(ert-deftest eval-tests-byte-code-being-evaluated-is-protected-from-gc () + "Regression test for Bug#33014. +Check that byte-compiled objects being executed by exec-byte-code +are found on the stack and therefore not garbage collected." + (should (string= (eval-tests-33014-func) + "before after: ok foo: (e) bar: (a b c d e) baz: a bop: c"))) + +(defvar eval-tests-33014-var "ok") +(defun eval-tests-33014-func () + "A function which has a non-trivial constants vector when byte-compiled." + (let ((result "before ")) + (eval-tests-33014-redefine) + (garbage-collect) + (setq result (concat result (format "after: %s" eval-tests-33014-var))) + (let ((vals '(0 1 2 3)) + (things '(a b c d e))) + (dolist (val vals) + (setq result + (concat result " " + (cond + ((= val 0) (format "foo: %s" (last things))) + ((= val 1) (format "bar: %s" things)) + ((= val 2) (format "baz: %s" (car things))) + (t (format "bop: %s" (nth 2 things)))))))) + result)) + +(defun eval-tests-33014-redefine () + "Remove the Lisp reference to the byte-compiled object." + (setf (symbol-function #'eval-tests-33014-func) nil)) + ;;; eval-tests.el ends here commit 1ad2903a48b682985a2bd0709ec05f67a1351a8e Author: Paul Eggert Date: Tue Oct 30 21:14:10 2018 -0700 Refer to bytecode constant vectors (Bug#33014) Backport from master. * src/bytecode.c (exec_byte_code): Save VECTOR into stack slot so that it survives GC. The stack slot was otherwise unused, so this doesn’t cost us memory, only a store insn. diff --git a/src/bytecode.c b/src/bytecode.c index e51f9095b3..538cd4f3ca 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -367,6 +367,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, SAFE_ALLOCA_LISP_EXTRA (stack_base, stack_items, bytestr_length); Lisp_Object *stack_lim = stack_base + stack_items; Lisp_Object *top = stack_base; + *top = vector; /* Ensure VECTOR survives GC (Bug#33014). */ memcpy (stack_lim, SDATA (bytestr), bytestr_length); void *void_stack_lim = stack_lim; unsigned char const *bytestr_data = void_stack_lim; commit cf486a7a920d3d95fa9aa98d7b03ebc61b17518a Author: Paul Eggert Date: Tue Oct 30 20:57:46 2018 -0700 Improve fix for Bug#33014 Although the previously-applied fix worked for its platform, it doesn’t suffice in general. * src/bytecode.c (exec_byte_code): Save VECTOR into stack slot so that it survives GC. The stack slot was otherwise unused, so this doesn’t cost us memory, only a store insn. * src/eval.c (Ffuncall): Do not make FUN volatile, reverting 2018-10-14T19:12:04Z!gazally@runbox.com. Adding â€volatile’ does not suffice, since storage for a volatile local can be reclaimed after its last access (e.g., by tail recursion elimination), which would make VECTOR invisible to GC. diff --git a/src/bytecode.c b/src/bytecode.c index 17457fc574..40389e08f0 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -369,6 +369,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, ptrdiff_t item_bytes = stack_items * word_size; Lisp_Object *stack_base = ptr_bounds_clip (alloc, item_bytes); Lisp_Object *top = stack_base; + *top = vector; /* Ensure VECTOR survives GC (Bug#33014). */ Lisp_Object *stack_lim = stack_base + stack_items; unsigned char *bytestr_data = alloc; bytestr_data = ptr_bounds_clip (bytestr_data + item_bytes, bytestr_length); diff --git a/src/eval.c b/src/eval.c index 32cfda24d8..a51d0c9083 100644 --- a/src/eval.c +++ b/src/eval.c @@ -2820,11 +2820,8 @@ Thus, (funcall \\='cons \\='x \\='y) returns (x . y). usage: (funcall FUNCTION &rest ARGUMENTS) */) (ptrdiff_t nargs, Lisp_Object *args) { - /* Use 'volatile' here to cause optimizing compilers to keep a - reference on the stack to the function's bytecode object. See - Bug#33014. */ - Lisp_Object volatile fun; - Lisp_Object original_fun, funcar; + Lisp_Object fun, original_fun; + Lisp_Object funcar; ptrdiff_t numargs = nargs - 1; Lisp_Object val; ptrdiff_t count; commit eb903d8f20ab0c31daa27a08b0acfd30115c7b5e Author: Stefan Monnier Date: Tue Oct 30 14:24:31 2018 -0400 * lisp/emacs-lisp/pcase.el: Improve docstrings. diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index fa7b1de8b4..2e89ae0779 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -266,7 +266,8 @@ variable name being but a special case of it)." (defmacro pcase-let* (bindings &rest body) "Like `let*' but where you can use `pcase' patterns for bindings. BODY should be an expression, and BINDINGS should be a list of bindings -of the form (PAT EXP)." +of the form (PATTERN EXP). +See `pcase-let' for discussion of how PATTERN is matched." (declare (indent 1) (debug ((&rest (pcase-PAT &optional form)) body))) (let ((cached (gethash bindings pcase--memoize))) @@ -281,10 +282,11 @@ of the form (PAT EXP)." (defmacro pcase-let (bindings &rest body) "Like `let' but where you can use `pcase' patterns for bindings. BODY should be a list of expressions, and BINDINGS should be a list of bindings -of the form (PAT EXP). -The macro is expanded and optimized under the assumption that those -patterns *will* match, so a mismatch may go undetected or may cause -any kind of error." +of the form (PATTERN EXP). +The PATTERNs are only used to extract data, so the code does not test +whether the data does match the corresponding patterns: a mismatch +may signal an error or may go undetected, binding variables to arbitrary +values, such as nil." (declare (indent 1) (debug pcase-let*)) (if (null (cdr bindings)) `(pcase-let* ,bindings ,@body) @@ -302,7 +304,11 @@ any kind of error." ;;;###autoload (defmacro pcase-dolist (spec &rest body) - "Like `dolist' but where the binding can be a `pcase' pattern. + "Superset of `dolist' where the VAR binding can be a `pcase' PATTERN. +More specifically, this is just a shorthand for the following combination +of `dolist' and `pcase-let': + + (dolist (x LIST) (pcase-let ((PATTERN x)) BODY...)) \n(fn (PATTERN LIST) BODY...)" (declare (indent 1) (debug ((pcase-PAT form) body))) (if (pcase--trivial-upat-p (car spec)) commit 86abbb3cb8490f73eb00023cf1c9ea7b5a8fffaf Author: Eli Zaretskii Date: Tue Oct 30 19:25:14 2018 +0200 * lisp/emacs-lisp/rx.el (rx): Fix typo in doc string. (Bug#33205) diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index 5fa0eaf194..de0a9276a8 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -1058,7 +1058,7 @@ CHAR `chinese-two-byte' (\\cC) `greek-two-byte' (\\cG) `japanese-hiragana-two-byte' (\\cH) - `indian-tow-byte' (\\cI) + `indian-two-byte' (\\cI) `japanese-katakana-two-byte' (\\cK) `korean-hangul-two-byte' (\\cN) `cyrillic-two-byte' (\\cY) commit b9cbdd045f2d086390b3d0e4412ebac0b19aaead Author: Glenn Morris Date: Tue Oct 30 08:58:05 2018 -0700 * admin/bzrmerge.el: Remove file, long since replaced by gitmerge.el. diff --git a/admin/bzrmerge.el b/admin/bzrmerge.el deleted file mode 100644 index d54ba330f9..0000000000 --- a/admin/bzrmerge.el +++ /dev/null @@ -1,359 +0,0 @@ -;;; bzrmerge.el --- help merge one Emacs bzr branch to another - -;; Copyright (C) 2010-2018 Free Software Foundation, Inc. - -;; Author: Stefan Monnier -;; Keywords: maint - -;; 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 . - -;;; Commentary: - -;; Some usage notes are in admin/notes/bzr. - -;;; Code: - -(eval-when-compile (require 'cl-lib)) - -(defvar bzrmerge-skip-regexp - "back[- ]?port\\|merge\\|sync\\|re-?generate\\|bump version\\|from trunk\\|\ -Auto-commit" - "Regexp matching logs of revisions that might be skipped. -`bzrmerge-missing' will ask you if it should skip any matches.") - -(defconst bzrmerge-buffer "*bzrmerge*" - "Working buffer for bzrmerge.") - -(defconst bzrmerge-warning-buffer "*bzrmerge warnings*" - "Buffer where bzrmerge will display any warnings.") - -(defun bzrmerge-merges () - "Return the list of already merged (not yet committed) revisions. -The list returned is sorted by oldest-first." - (with-current-buffer (get-buffer-create bzrmerge-buffer) - (erase-buffer) - ;; We generally want to make sure we start with a clean tree, but we also - ;; want to allow restarts (i.e. with some part of FROM already merged but - ;; not yet committed). Unversioned (unknown) files in the tree - ;; are also ok. - (call-process "bzr" nil t nil "status" "-v") - (goto-char (point-min)) - (when (re-search-forward "^conflicts:\n" nil t) - (user-error "You still have unresolved conflicts")) - (let ((merges ()) - found) - (if (not (re-search-forward "^pending merges:\n" nil t)) - (when (save-excursion - (goto-char (point-min)) - (while (and - (re-search-forward "^\\([a-z ]*\\):\n" nil t) - (not - (setq found - (not (equal "unknown" (match-string 1))))))) - found) - (user-error "You still have uncommitted changes")) - ;; This is really stupid, but it seems there's no easy way to figure - ;; out which revisions have been merged already. The only info I can - ;; find is the "pending merges" from "bzr status -v", which is not - ;; very machine-friendly. - (while (not (eobp)) - (skip-chars-forward " ") - (push (buffer-substring (point) (line-end-position)) merges) - (forward-line 1))) - merges))) - -(defun bzrmerge-check-match (merge) - ;; Make sure the MERGES match the revisions on the FROM branch. - ;; Stupidly the best form of MERGES I can find is the one from - ;; "bzr status -v" which is very machine non-friendly, so I have - ;; to do some fuzzy matching. - (let ((author - (or - (save-excursion - (if (re-search-forward "^author: *\\([^<]*[^ ]\\) +<.*" - nil t) - (match-string 1))) - (save-excursion - (if (re-search-forward - "^committer: *\\([^<]*[^< ]\\) +<" nil t) - (match-string 1))))) - (timestamp - (save-excursion - (if (re-search-forward - "^timestamp:[^0-9]*\\([-0-9]+\\)" nil t) - (match-string 1)))) - (line1 - (save-excursion - (if (re-search-forward "^message:[ \n]*" nil t) - (buffer-substring (point) (line-end-position)))))) - ;; The `merge' may have a truncated line1 with "...", so get - ;; rid of any "..." and then look for a prefix match. - (when (string-match "\\.+\\'" merge) - (setq merge (substring merge 0 (match-beginning 0)))) - (or (string-prefix-p - merge (concat author " " timestamp " " line1)) - (string-prefix-p - merge (concat author " " timestamp " [merge] " line1))))) - -(defun bzrmerge-missing (from merges) - "Return the list of revisions that need to be merged. -MERGES is the revisions already merged but not yet committed. -Asks about skipping revisions with logs matching `bzrmerge-skip-regexp'. -The result is of the form (TOMERGE . TOSKIP) where TOMERGE and TOSKIP -are both lists of revnos, in oldest-first order." - (with-current-buffer (get-buffer-create bzrmerge-buffer) - (erase-buffer) - (call-process "bzr" nil t nil "missing" "--theirs-only" - (expand-file-name from)) - (let ((revnos ()) (skipped ())) - (pop-to-buffer (current-buffer)) - (goto-char (point-max)) - (while (re-search-backward "^------------------------------------------------------------\nrevno: \\([0-9.]+\\).*" nil t) - (save-excursion - (if merges - (while (not (bzrmerge-check-match (pop merges))) - (unless merges - (error "Unmatched tip of merged revisions"))) - (let ((case-fold-search t) - (revno (match-string 1)) - (skip nil)) - (if (string-match "\\." revno) - (error "Unexpected dotted revno!") - (setq revno (string-to-number revno))) - (re-search-forward "^message:\n") - (while (and (not skip) - (re-search-forward bzrmerge-skip-regexp nil t)) - (let ((str (buffer-substring (line-beginning-position) - (line-end-position)))) - (when (string-match "\\` *" str) - (setq str (substring str (match-end 0)))) - (when (string-match "[.!;, ]+\\'" str) - (setq str (substring str 0 (match-beginning 0)))) - (let ((help-form (substitute-command-keys "\ -Type `y' to skip this revision, -`N' to include it and go on to the next revision, -`n' to not skip, but continue to search this log entry for skip regexps, -`q' to quit merging."))) - (pcase (save-excursion - (read-char-choice - (format "%s: Skip (y/n/N/q/%s)? " str - (key-description (vector help-char))) - '(?y ?n ?N ?q))) - (?y (setq skip t)) - (?q (keyboard-quit)) - ;; A single log entry can match skip-regexp multiple - ;; times. If you are sure you don't want to skip it, - ;; you don't want to be asked multiple times. - (?N (setq skip 'no)))))) - (if (eq skip t) - (push revno skipped) - (push revno revnos))))) - (delete-region (point) (point-max))) - (and (or revnos skipped) - (cons (nreverse revnos) (nreverse skipped)))))) - -(defun bzrmerge-resolve (file) - (unless (file-exists-p file) (error "Bzrmerge-resolve: Can't find %s" file)) - (with-demoted-errors - (let ((exists (find-buffer-visiting file))) - (with-current-buffer (let ((enable-local-variables :safe) - (enable-local-eval nil)) - (find-file-noselect file)) - (if (buffer-modified-p) - (user-error "Unsaved changes in %s" (current-buffer))) - (save-excursion - (cond - ((derived-mode-p 'change-log-mode) - ;; Fix up dates before resolving the conflicts. - (goto-char (point-min)) - (let ((diff-auto-refine-mode nil)) - (while (re-search-forward smerge-begin-re nil t) - (smerge-match-conflict) - (smerge-ensure-match 3) - (let ((start1 (match-beginning 1)) - (end1 (match-end 1)) - (start3 (match-beginning 3)) - (end3 (copy-marker (match-end 3) t))) - (goto-char start3) - (while (re-search-forward change-log-start-entry-re end3 t) - (let* ((str (match-string 0)) - (newstr (save-match-data - (concat (add-log-iso8601-time-string) - (when (string-match " *\\'" str) - (match-string 0 str)))))) - (replace-match newstr t t))) - ;; change-log-resolve-conflict prefers to put match-1's - ;; elements first (for equal dates), whereas we want to put - ;; match-3's first. - (let ((match3 (buffer-substring start3 end3)) - (match1 (buffer-substring start1 end1))) - (delete-region start3 end3) - (goto-char start3) - (insert match1) - (delete-region start1 end1) - (goto-char start1) - (insert match3))))) - ;; (pop-to-buffer (current-buffer)) (debug 'before-resolve) - )) - ;; Try to resolve the conflicts. - (cond - ((member file '("configure" "lisp/ldefs-boot.el" - "lisp/emacs-lisp/cl-loaddefs.el")) - ;; We are in the file's buffer, so names are relative. - (call-process "bzr" nil t nil "revert" - (file-name-nondirectory file)) - (revert-buffer nil 'noconfirm)) - (t - (goto-char (point-max)) - (while (re-search-backward smerge-begin-re nil t) - (save-excursion - (ignore-errors - (smerge-match-conflict) - (smerge-resolve)))) - ;; (when (derived-mode-p 'change-log-mode) - ;; (pop-to-buffer (current-buffer)) (debug 'after-resolve)) - (save-buffer))) - (goto-char (point-min)) - (prog1 (re-search-forward smerge-begin-re nil t) - (unless exists (kill-buffer)))))))) - -(defun bzrmerge-add-metadata (from endrevno) - "Add the metadata for a merge of FROM upto ENDREVNO. -Does not make other difference." - (if (with-temp-buffer - (call-process "bzr" nil t nil "status") - (goto-char (point-min)) - (re-search-forward "^conflicts:\n" nil t)) - (error "Don't know how to add metadata in the presence of conflicts") - (call-process "bzr" nil t nil "shelve" "--all" - "-m" "Bzrmerge shelved merge during skipping") - (call-process "bzr" nil t nil "revert") - (call-process "bzr" nil t nil - "merge" "-r" (format "%s" endrevno) from) - (call-process "bzr" nil t nil "revert" ".") - (call-process "bzr" nil t nil "unshelve"))) - -(defvar bzrmerge-already-done nil) - -(defun bzrmerge-apply (missing from) - (setq from (expand-file-name from)) - (with-current-buffer (get-buffer-create bzrmerge-buffer) - (erase-buffer) - (when (equal (cdr bzrmerge-already-done) (list from missing)) - (setq missing (car bzrmerge-already-done))) - (setq bzrmerge-already-done nil) - (let ((merge (car missing)) - (skip (cdr missing)) - (unsafe nil) - beg end) - (when (or merge skip) - (cond - ((and skip (or (null merge) (< (car skip) (car merge)))) - ;; Do a "skip" (i.e. merge the meta-data only). - (setq beg (1- (car skip))) - (while (and skip (or (null merge) (< (car skip) (car merge)))) - (cl-assert (> (car skip) (or end beg))) - (setq end (pop skip))) - (message "Skipping %s..%s" beg end) - (bzrmerge-add-metadata from end)) - - (t - ;; Do a "normal" merge. - (cl-assert (or (null skip) (< (car merge) (car skip)))) - (setq beg (1- (car merge))) - (while (and merge (or (null skip) (< (car merge) (car skip)))) - (cl-assert (> (car merge) (or end beg))) - (setq end (pop merge))) - (message "Merging %s..%s" beg end) - (if (with-temp-buffer - (call-process "bzr" nil t nil "status") - (zerop (buffer-size))) - (call-process "bzr" nil t nil - "merge" "-r" (format "%s" end) from) - ;; Stupidly, "bzr merge --force -r A..B" dos not maintain the - ;; metadata properly except when the checkout is clean. - (call-process "bzr" nil t nil "merge" - "--force" "-r" (format "%s..%s" beg end) from) - ;; The merge did not update the metadata, so force the next time - ;; around to update it (as a "skip"). - (setq unsafe t) - (push end skip)) - (pop-to-buffer (current-buffer)) - (sit-for 1) - ;; (debug 'after-merge) - ;; Check the conflicts. - ;; FIXME if using the helpful bzr changelog_merge plugin, - ;; there are normally no conflicts in ChangeLogs. - ;; But we still want the dates fixing, like bzrmerge-resolve does. - (let ((conflicted nil) - (files ())) - (goto-char (point-min)) - (when (re-search-forward "bzr: ERROR:" nil t) - (error "Internal Bazaar error!!")) - (while (re-search-forward "^Text conflict in " nil t) - (push (buffer-substring (point) (line-end-position)) files)) - (if (re-search-forward "^\\([0-9]+\\) conflicts encountered" nil t) - (if (/= (length files) (string-to-number (match-string 1))) - (setq conflicted t)) - (if files (setq conflicted t))) - (dolist (file files) - (if (bzrmerge-resolve file) - (setq conflicted t))) - (when conflicted - (setq bzrmerge-already-done - (list (cons merge skip) from missing)) - (if unsafe - ;; FIXME: Obviously, we'd rather make it right rather - ;; than output such a warning. But I don't know how to add - ;; the metadata to bzr's since the technique used in - ;; bzrmerge-add-metadata does not work when there - ;; are conflicts. - (display-warning 'bzrmerge "Resolve conflicts manually. -BEWARE! Important metadata is kept in this Emacs session! -Do not commit without re-running `M-x bzrmerge' first!" - :warning bzrmerge-warning-buffer)) - (user-error "Resolve conflicts manually"))))) - (cons merge skip))))) - -(defun bzrmerge (from) - "Merge from branch FROM into `default-directory'." - (interactive - (list - (let ((def - (with-temp-buffer - (call-process "bzr" nil t nil "info") - (goto-char (point-min)) - (when (re-search-forward "submit branch: *" nil t) - (buffer-substring (point) (line-end-position)))))) - (read-file-name "From branch: " nil nil nil def)))) - ;; Eg we ran bzrmerge once, it stopped with conflicts, we fixed them - ;; and are running it again. - (if (get-buffer bzrmerge-warning-buffer) - (kill-buffer bzrmerge-warning-buffer)) - (message "Merging from %s..." from) - (require 'vc-bzr) - (let ((default-directory (or (vc-bzr-root default-directory) - (error "Not in a Bzr tree")))) - ;; First, check the status. - (let* ((merges (bzrmerge-merges)) - ;; OK, we have the status, now check the missing data. - (missing (bzrmerge-missing from merges))) - (if (not missing) - (message "Merging from %s...nothing to merge" from) - (while missing - (setq missing (bzrmerge-apply missing from))) - (message "Merging from %s...done" from))))) - -(provide 'bzrmerge) -;;; bzrmerge.el ends here commit 049bd5d267bc0d66cc0ba3b70c8773fed95694da Author: Michael Heerdegen Date: Sat Oct 27 01:48:35 2018 +0200 Don't quote self-quoting pcase patterns * admin/bzrmerge.el: * lisp/char-fold.el: * lisp/dired.el: * lisp/emacs-lisp/derived.el: * lisp/emacs-lisp/easy-mmode.el: * lisp/emacs-lisp/easymenu.el: * lisp/emacs-lisp/eieio-core.el: * lisp/emacs-lisp/package.el: * lisp/emacs-lisp/smie.el: * lisp/faces.el: * lisp/filesets.el: * lisp/progmodes/modula2.el: * lisp/progmodes/octave.el: * lisp/progmodes/opascal.el: * lisp/progmodes/perl-mode.el: * lisp/progmodes/prolog.el: * lisp/progmodes/ruby-mode.el: * lisp/progmodes/sh-script.el: * lisp/server.el: * lisp/subr.el: * lisp/textmodes/css-mode.el: * test/lisp/emacs-lisp/pcase-tests.el: Don't quote self-quoting 'pcase' patterns. diff --git a/admin/bzrmerge.el b/admin/bzrmerge.el index cedb625fb0..d54ba330f9 100644 --- a/admin/bzrmerge.el +++ b/admin/bzrmerge.el @@ -150,12 +150,12 @@ Type `y' to skip this revision, (format "%s: Skip (y/n/N/q/%s)? " str (key-description (vector help-char))) '(?y ?n ?N ?q))) - (`?y (setq skip t)) - (`?q (keyboard-quit)) + (?y (setq skip t)) + (?q (keyboard-quit)) ;; A single log entry can match skip-regexp multiple ;; times. If you are sure you don't want to skip it, ;; you don't want to be asked multiple times. - (`?N (setq skip 'no)))))) + (?N (setq skip 'no)))))) (if (eq skip t) (push revno skipped) (push revno revnos))))) diff --git a/lisp/char-fold.el b/lisp/char-fold.el index 86bd6038e3..907d49e4f2 100644 --- a/lisp/char-fold.el +++ b/lisp/char-fold.el @@ -170,7 +170,7 @@ from which to start." ;; need to keep them grouped together like this: "\\( \\|[ ...][ ...]\\)". (while (< i end) (pcase (aref string i) - (`?\s (setq spaces (1+ spaces))) + (?\s (setq spaces (1+ spaces))) (c (when (> spaces 0) (push (char-fold--make-space-string spaces) out) (setq spaces 0)) diff --git a/lisp/dired.el b/lisp/dired.el index 5c7bb9599c..f2f2b76eb7 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -3046,10 +3046,10 @@ TRASH non-nil means to trash the file instead of deleting, provided ("no" ?n "skip to next") ("all" ?! "delete all remaining directories with no more questions") ("quit" ?q "exit"))) - ('"all" (setq recursive 'always dired-recursive-deletes recursive)) - ('"yes" (if (eq recursive 'top) (setq recursive 'always))) - ('"no" (setq recursive nil)) - ('"quit" (keyboard-quit)) + ("all" (setq recursive 'always dired-recursive-deletes recursive)) + ("yes" (if (eq recursive 'top) (setq recursive 'always))) + ("no" (setq recursive nil)) + ("quit" (keyboard-quit)) (_ (keyboard-quit))))) ; catch all unknown answers (setq recursive nil)) ; Empty dir or recursive is nil. (delete-directory file recursive trash)))) diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index 6b47ffea07..483d6fbfa4 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -193,10 +193,10 @@ See Info node `(elisp)Derived Modes' for more details." ;; Process the keyword args. (while (keywordp (car body)) (pcase (pop body) - (`:group (setq group (pop body))) - (`:abbrev-table (setq abbrev (pop body)) (setq declare-abbrev nil)) - (`:syntax-table (setq syntax (pop body)) (setq declare-syntax nil)) - (`:after-hook (setq after-hook (pop body))) + (:group (setq group (pop body))) + (:abbrev-table (setq abbrev (pop body)) (setq declare-abbrev nil)) + (:syntax-table (setq syntax (pop body)) (setq declare-syntax nil)) + (:after-hook (setq after-hook (pop body))) (_ (pop body)))) (setq docstring (derived-mode-make-docstring diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 4d8a502026..d74c3ddb97 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -217,30 +217,30 @@ For example, you could write (while (keywordp (setq keyw (car body))) (setq body (cdr body)) (pcase keyw - (`:init-value (setq init-value (pop body))) - (`:lighter (setq lighter (purecopy (pop body)))) - (`:global (setq globalp (pop body)) - (when (and globalp (symbolp mode)) - (setq setter `(setq-default ,mode)) - (setq getter `(default-value ',mode)))) - (`:extra-args (setq extra-args (pop body))) - (`:set (setq set (list :set (pop body)))) - (`:initialize (setq initialize (list :initialize (pop body)))) - (`:group (setq group (nconc group (list :group (pop body))))) - (`:type (setq type (list :type (pop body)))) - (`:require (setq require (pop body))) - (`:keymap (setq keymap (pop body))) - (`:variable (setq variable (pop body)) - (if (not (and (setq tmp (cdr-safe variable)) - (or (symbolp tmp) - (functionp tmp)))) - ;; PLACE is not of the form (GET . SET). - (progn - (setq setter `(setf ,variable)) - (setq getter variable)) - (setq getter (car variable)) - (setq setter `(funcall #',(cdr variable))))) - (`:after-hook (setq after-hook (pop body))) + (:init-value (setq init-value (pop body))) + (:lighter (setq lighter (purecopy (pop body)))) + (:global (setq globalp (pop body)) + (when (and globalp (symbolp mode)) + (setq setter `(setq-default ,mode)) + (setq getter `(default-value ',mode)))) + (:extra-args (setq extra-args (pop body))) + (:set (setq set (list :set (pop body)))) + (:initialize (setq initialize (list :initialize (pop body)))) + (:group (setq group (nconc group (list :group (pop body))))) + (:type (setq type (list :type (pop body)))) + (:require (setq require (pop body))) + (:keymap (setq keymap (pop body))) + (:variable (setq variable (pop body)) + (if (not (and (setq tmp (cdr-safe variable)) + (or (symbolp tmp) + (functionp tmp)))) + ;; PLACE is not of the form (GET . SET). + (progn + (setq setter `(setf ,variable)) + (setq getter variable)) + (setq getter (car variable)) + (setq setter `(funcall #',(cdr variable))))) + (:after-hook (setq after-hook (pop body))) (_ (push keyw extra-keywords) (push (pop body) extra-keywords)))) (setq keymap-sym (if (and keymap (symbolp keymap)) keymap @@ -407,8 +407,8 @@ on if the hook has explicitly disabled it." (while (keywordp (setq keyw (car keys))) (setq keys (cdr keys)) (pcase keyw - (`:group (setq group (nconc group (list :group (pop keys))))) - (`:global (setq keys (cdr keys))) + (:group (setq group (nconc group (list :group (pop keys))))) + (:global (setq keys (cdr keys))) (_ (push keyw extra-keywords) (push (pop keys) extra-keywords)))) (unless group @@ -533,11 +533,11 @@ Valid keywords and arguments are: (let ((key (pop args)) (val (pop args))) (pcase key - (`:name (setq name val)) - (`:dense (setq dense val)) - (`:inherit (setq inherit val)) - (`:suppress (setq suppress val)) - (`:group) + (:name (setq name val)) + (:dense (setq dense val)) + (:inherit (setq inherit val)) + (:suppress (setq suppress val)) + (:group) (_ (message "Unknown argument %s in defmap" key))))) (unless (keymapp m) (setq bs (append m bs)) diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el index 94d035f374..403829ac46 100644 --- a/lisp/emacs-lisp/easymenu.el +++ b/lisp/emacs-lisp/easymenu.el @@ -226,14 +226,14 @@ possibly preceded by keyword pairs as described in `easy-menu-define'." (let ((arg (cadr menu-items))) (setq menu-items (cddr menu-items)) (pcase keyword - (`:filter + (:filter (setq filter (lambda (menu) (easy-menu-filter-return (funcall arg menu) menu-name)))) - ((or `:enable `:active) (setq enable (or arg ''nil))) - (`:label (setq label arg)) - (`:help (setq help arg)) - ((or `:included `:visible) (setq visible (or arg ''nil)))))) + ((or :enable :active) (setq enable (or arg ''nil))) + (:label (setq label arg)) + (:help (setq help arg)) + ((or :included :visible) (setq visible (or arg ''nil)))))) (if (equal visible ''nil) nil ; Invisible menu entry, return nil. (if (and visible (not (easy-menu-always-true-p visible))) @@ -325,15 +325,15 @@ ITEM defines an item as in `easy-menu-define'." (setq arg (aref item (1+ count))) (setq count (+ 2 count)) (pcase keyword - ((or `:included `:visible) (setq visible (or arg ''nil))) - (`:key-sequence (setq cache arg cache-specified t)) - (`:keys (setq keys arg no-name nil)) - (`:label (setq label arg)) - ((or `:active `:enable) (setq active (or arg ''nil))) - (`:help (setq prop (cons :help (cons arg prop)))) - (`:suffix (setq suffix arg)) - (`:style (setq style arg)) - (`:selected (setq selected (or arg ''nil))))) + ((or :included :visible) (setq visible (or arg ''nil))) + (:key-sequence (setq cache arg cache-specified t)) + (:keys (setq keys arg no-name nil)) + (:label (setq label arg)) + ((or :active :enable) (setq active (or arg ''nil))) + (:help (setq prop (cons :help (cons arg prop)))) + (:suffix (setq suffix arg)) + (:style (setq style arg)) + (:selected (setq selected (or arg ''nil))))) (if suffix (setq label (if (stringp suffix) diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index e5ea33c003..e5c4f198f5 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -388,9 +388,9 @@ See `defclass' for more information." ;; Clean up the meaning of protection. (setq prot (pcase prot - ((or 'nil 'public ':public) nil) - ((or 'protected ':protected) 'protected) - ((or 'private ':private) 'private) + ((or 'nil 'public :public) nil) + ((or 'protected :protected) 'protected) + ((or 'private :private) 'private) (_ (signal 'invalid-slot-type (list :protection prot))))) ;; The default type specifier is supposed to be t, meaning anything. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 9c4c3e9fe7..f2ffef8da7 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2911,17 +2911,17 @@ PKG is a `package-desc' object. Return (PKG-DESC [NAME VERSION STATUS DOC])." (let* ((status (package-desc-status pkg)) (face (pcase status - (`"built-in" 'package-status-built-in) - (`"external" 'package-status-external) - (`"available" 'package-status-available) - (`"avail-obso" 'package-status-avail-obso) - (`"new" 'package-status-new) - (`"held" 'package-status-held) - (`"disabled" 'package-status-disabled) - (`"installed" 'package-status-installed) - (`"dependency" 'package-status-dependency) - (`"unsigned" 'package-status-unsigned) - (`"incompat" 'package-status-incompat) + ("built-in" 'package-status-built-in) + ("external" 'package-status-external) + ("available" 'package-status-available) + ("avail-obso" 'package-status-avail-obso) + ("new" 'package-status-new) + ("held" 'package-status-held) + ("disabled" 'package-status-disabled) + ("installed" 'package-status-installed) + ("dependency" 'package-status-dependency) + ("unsigned" 'package-status-unsigned) + ("incompat" 'package-status-incompat) (_ 'font-lock-warning-face)))) ; obsolete. (list pkg `[(,(symbol-name (package-desc-name pkg)) diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index c01a40172b..4b82172984 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -1856,9 +1856,9 @@ KEYWORDS are additional arguments, which can use the following keywords: (let ((k (pop keywords)) (v (pop keywords))) (pcase k - (`:forward-token + (:forward-token (set (make-local-variable 'smie-forward-token-function) v)) - (`:backward-token + (:backward-token (set (make-local-variable 'smie-backward-token-function) v)) (_ (message "smie-setup: ignoring unknown keyword %s" k))))) (let ((ca (cdr (assq :smie-closer-alist grammar)))) diff --git a/lisp/faces.el b/lisp/faces.el index 18b821a0b6..a8c1546d5a 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1084,27 +1084,27 @@ of a set of discrete values. Value is `integerp' if ATTRIBUTE expects an integer value." (let ((valid (pcase attribute - (`:family + (:family (if (window-system frame) (mapcar (lambda (x) (cons x x)) (font-family-list)) ;; Only one font on TTYs. (list (cons "default" "default")))) - (`:foundry + (:foundry (list nil)) - (`:width + (:width (mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1))) font-width-table)) - (`:weight + (:weight (mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1))) font-weight-table)) - (`:slant + (:slant (mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1))) font-slant-table)) - (`:inverse-video + (:inverse-video (mapcar #'(lambda (x) (cons (symbol-name x) x)) (internal-lisp-face-attribute-values attribute))) - ((or `:underline `:overline `:strike-through `:box) + ((or :underline :overline :strike-through :box) (if (window-system frame) (nconc (mapcar #'(lambda (x) (cons (symbol-name x) x)) (internal-lisp-face-attribute-values attribute)) @@ -1112,12 +1112,12 @@ an integer value." (defined-colors frame))) (mapcar #'(lambda (x) (cons (symbol-name x) x)) (internal-lisp-face-attribute-values attribute)))) - ((or `:foreground `:background) + ((or :foreground :background) (mapcar #'(lambda (c) (cons c c)) (defined-colors frame))) - (`:height + (:height 'integerp) - (`:stipple + (:stipple (and (memq (window-system frame) '(x ns)) ; No stipple on w32 (mapcar #'list (apply #'nconc @@ -1126,7 +1126,7 @@ an integer value." (file-directory-p dir) (directory-files dir))) x-bitmap-file-path))))) - (`:inherit + (:inherit (cons '("none" . nil) (mapcar #'(lambda (c) (cons (symbol-name c) c)) (face-list)))) diff --git a/lisp/filesets.el b/lisp/filesets.el index c1e6ef10d5..8ccfa570e3 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -1559,7 +1559,7 @@ SAVE-FUNCTION takes no argument, but works on the current buffer." (defun filesets-get-fileset-from-name (name &optional mode) "Get fileset definition for NAME." (pcase mode - ((or `:ingroup `:tree) name) + ((or :ingroup :tree) name) (_ (assoc name filesets-data)))) diff --git a/lisp/progmodes/modula2.el b/lisp/progmodes/modula2.el index 582e495a2b..ef12352457 100644 --- a/lisp/progmodes/modula2.el +++ b/lisp/progmodes/modula2.el @@ -232,11 +232,11 @@ ;; FIXME: "^." are two tokens, not one. (defun m2-smie-forward-token () (pcase (smie-default-forward-token) - (`"VAR" (if (zerop (car (syntax-ppss))) "VAR" "VAR-arg")) - (`"CONST" (if (zerop (car (syntax-ppss))) "CONST" "CONST-arg")) - (`";" (save-excursion (m2-smie-refine-semi))) - (`"OF" (save-excursion (forward-char -2) (m2-smie-refine-of))) - (`":" (save-excursion (forward-char -1) (m2-smie-refine-colon))) + ("VAR" (if (zerop (car (syntax-ppss))) "VAR" "VAR-arg")) + ("CONST" (if (zerop (car (syntax-ppss))) "CONST" "CONST-arg")) + (";" (save-excursion (m2-smie-refine-semi))) + ("OF" (save-excursion (forward-char -2) (m2-smie-refine-of))) + (":" (save-excursion (forward-char -1) (m2-smie-refine-colon))) ;; (`"END" (if (and (looking-at "[ \t\n]*\\(\\(?:\\sw\\|\\s_\\)+\\)") ;; (not (assoc (match-string 1) m2-smie-grammar))) ;; "END-proc" "END")) @@ -244,11 +244,11 @@ (defun m2-smie-backward-token () (pcase (smie-default-backward-token) - (`"VAR" (if (zerop (car (syntax-ppss))) "VAR" "VAR-arg")) - (`"CONST" (if (zerop (car (syntax-ppss))) "CONST" "CONST-arg")) - (`";" (save-excursion (forward-char 1) (m2-smie-refine-semi))) - (`"OF" (save-excursion (m2-smie-refine-of))) - (`":" (save-excursion (m2-smie-refine-colon))) + ("VAR" (if (zerop (car (syntax-ppss))) "VAR" "VAR-arg")) + ("CONST" (if (zerop (car (syntax-ppss))) "CONST" "CONST-arg")) + (";" (save-excursion (forward-char 1) (m2-smie-refine-semi))) + ("OF" (save-excursion (m2-smie-refine-of))) + (":" (save-excursion (m2-smie-refine-colon))) ;; (`"END" (if (and (looking-at "\\sw+[ \t\n]+\\(\\(?:\\sw\\|\\s_\\)+\\)") ;; (not (assoc (match-string 1) m2-smie-grammar))) ;; "END-proc" "END")) @@ -272,7 +272,7 @@ (pcase (cons kind token) (`(:elem . basic) m2-indent) (`(:after . ":=") (or m2-indent smie-indent-basic)) - (`(:after . ,(or `"CONST" `"VAR" `"TYPE")) + (`(:after . ,(or "CONST" "VAR" "TYPE")) (or m2-indent smie-indent-basic)) ;; (`(:before . ,(or `"VAR" `"TYPE" `"CONST")) ;; (if (smie-rule-parent-p "PROCEDURE") 0)) diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index 13510eef80..cce5e17e79 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -1065,8 +1065,8 @@ directory and makes this the current buffer's default directory." (unless found (goto-char orig)) found)))) (pcase (and buffer-file-name (file-name-extension buffer-file-name)) - (`"cc" (funcall search - "\\_=24." ;; -> thenrule ;; ; elserule ;; ) - (`(:before . ,(or `"->" `";")) + (`(:before . ,(or "->" ";")) (and (smie-rule-bolp) (smie-rule-parent-p "(") (smie-rule-parent 0))) - (`(:after . ,(or `"->" `"*->")) + (`(:after . ,(or "->" "*->")) ;; We distinguish ;; ;; (a -> @@ -3247,11 +3247,11 @@ the following comma and whitespace, if any." (defun prolog-post-self-insert () (pcase last-command-event - (`?_ (prolog-electric--underscore)) - (`?- (prolog-electric--dash)) - (`?: (prolog-electric--colon)) - ((or `?\( `?\; `?>) (prolog-electric--if-then-else)) - (`?. (prolog-electric--dot)))) + (?_ (prolog-electric--underscore)) + (?- (prolog-electric--dash)) + (?: (prolog-electric--colon)) + ((or ?\( ?\; ?>) (prolog-electric--if-then-else)) + (?. (prolog-electric--dot)))) (defun prolog-find-term (functor arity &optional prefix) "Go to the position at the start of the next occurrence of a term. diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index fad7bc1fb8..32130cee8e 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -612,7 +612,7 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'." ;; For (invalid) code between switch and case. ;; (if (smie-parent-p "switch") 4) )) - (`(:before . ,(or `"(" `"[" `"{")) + (`(:before . ,(or "(" "[" "{")) (cond ((and (equal token "{") (not (smie-rule-prev-p "(" "{" "[" "," "=>" "=" "return" ";")) @@ -639,7 +639,7 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'." (forward-char -1)) (smie-indent-virtual)) (t (smie-rule-parent)))))) - (`(:after . ,(or `"(" "[" "{")) + (`(:after . ,(or "(" "[" "{")) ;; FIXME: Shouldn't this be the default behavior of ;; `smie-indent-after-keyword'? (save-excursion @@ -660,7 +660,7 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'." (smie-backward-sexp ".") (cons 'column (+ (current-column) ruby-indent-level)))) - (`(:before . ,(or `"else" `"then" `"elsif" `"rescue" `"ensure")) + (`(:before . ,(or "else" "then" "elsif" "rescue" "ensure")) (smie-rule-parent)) (`(:before . "when") ;; Align to the previous `when', but look up the virtual @@ -1544,8 +1544,8 @@ With ARG, do it many times. Negative ARG means move forward." (cond ((looking-at "\\s)") (goto-char (scan-sexps (1+ (point)) -1)) (pcase (char-before) - (`?% (forward-char -1)) - ((or `?q `?Q `?w `?W `?r `?x) + (?% (forward-char -1)) + ((or ?q ?Q ?w ?W ?r ?x) (if (eq (char-before (1- (point))) ?%) (forward-char -2)))) nil) @@ -1562,13 +1562,13 @@ With ARG, do it many times. Negative ARG means move forward." (forward-char 1) (while (progn (forward-word-strictly -1) (pcase (char-before) - (`?_ t) - (`?. (forward-char -1) t) - ((or `?$ `?@) + (?_ t) + (?. (forward-char -1) t) + ((or ?$ ?@) (forward-char -1) (and (eq (char-before) (char-after)) (forward-char -1))) - (`?: + (?: (forward-char -1) (eq (char-before) :))))) (if (looking-at ruby-block-end-re) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index aaa86b5816..46c9e6ee65 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -959,8 +959,8 @@ See `sh-feature'.") ;; ((...)) or $((...)) or $[...] or ${...}. Nested ;; parenthesis can occur inside the first of these forms, so ;; parse backward recursively. - (`?\( (eq ?\( (char-before))) - ((or `?\{ `?\[) (eq ?\$ (char-before)))) + (?\( (eq ?\( (char-before))) + ((or ?\{ ?\[) (eq ?\$ (char-before)))) (sh--inside-noncommand-expression (1- (point)))))))) (defun sh-font-lock-open-heredoc (start string eol) @@ -2038,7 +2038,7 @@ May return nil if the line should not be treated as continued." (`(:elem . basic) sh-basic-offset) (`(:after . "case-)") (- (sh-var-value 'sh-indent-for-case-alt) (sh-var-value 'sh-indent-for-case-label))) - (`(:before . ,(or `"(" `"{" `"[" "while" "if" "for" "case")) + (`(:before . ,(or "(" "{" "[" "while" "if" "for" "case")) (if (not (smie-rule-prev-p "&&" "||" "|")) (when (smie-rule-hanging-p) (smie-rule-parent)) @@ -2047,11 +2047,11 @@ May return nil if the line should not be treated as continued." `(column . ,(smie-indent-virtual))))) ;; FIXME: Maybe this handling of ;; should be made into ;; a smie-rule-terminator function that takes the substitute ";" as arg. - (`(:before . ,(or `";;" `";&" `";;&")) + (`(:before . ,(or ";;" ";&" ";;&")) (if (and (smie-rule-bolp) (looking-at ";;?&?[ \t]*\\(#\\|$\\)")) (cons 'column (smie-indent-keyword ";")) (smie-rule-separator kind))) - (`(:after . ,(or `";;" `";&" `";;&")) + (`(:after . ,(or ";;" ";&" ";;&")) (with-demoted-errors (smie-backward-sexp token) (cons 'column @@ -2062,7 +2062,7 @@ May return nil if the line should not be treated as continued." (smie-rule-bolp)))) (current-column) (smie-indent-calculate))))) - (`(:before . ,(or `"|" `"&&" `"||")) + (`(:before . ,(or "|" "&&" "||")) (unless (smie-rule-parent-p token) (smie-backward-sexp token) `(column . ,(+ (funcall smie-rules-function :elem 'basic) @@ -2081,7 +2081,7 @@ May return nil if the line should not be treated as continued." ;; sh-indent-after-done: aligned completely differently. (`(:after . "in") (sh-var-value 'sh-indent-for-case-label)) ;; sh-indent-for-continuation: Line continuations are handled differently. - (`(:after . ,(or `"(" `"{" `"[")) + (`(:after . ,(or "(" "{" "[")) (if (not (looking-at ".[ \t]*[^\n \t#]")) (sh-var-value 'sh-indent-after-open) (goto-char (1- (match-end 0))) @@ -2253,7 +2253,7 @@ Point should be before the newline." (save-excursion (when (sh-smie--rc-after-special-arg-p) `(column . ,(current-column))))) - (`(:before . ,(or `"(" `"{" `"[")) + (`(:before . ,(or "(" "{" "[")) (if (smie-rule-hanging-p) (smie-rule-parent))) ;; FIXME: SMIE parses "if (exp) cmd" as "(if ((exp) cmd))" so "cmd" is ;; treated as an arg to (exp) by default, which indents it all wrong. @@ -2262,7 +2262,7 @@ Point should be before the newline." ;; rule we have is the :list-intro hack, which we use here to align "cmd" ;; with "(exp)", which is rarely the right thing to do, but is better ;; than nothing. - (`(:list-intro . ,(or `"for" `"if" `"while")) t) + (`(:list-intro . ,(or "for" "if" "while")) t) ;; sh-indent-after-switch: handled implicitly by the default { rule. )) diff --git a/lisp/server.el b/lisp/server.el index 50684a20aa..d0a8ca313e 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -1112,16 +1112,16 @@ The following commands are accepted by the client: (while args-left (pcase (pop args-left) ;; -version CLIENT-VERSION: obsolete at birth. - (`"-version" (pop args-left)) + ("-version" (pop args-left)) ;; -nowait: Emacsclient won't wait for a result. - (`"-nowait" (setq nowait t)) + ("-nowait" (setq nowait t)) ;; -current-frame: Don't create frames. - (`"-current-frame" (setq use-current-frame t)) + ("-current-frame" (setq use-current-frame t)) ;; -frame-parameters: Set frame parameters - (`"-frame-parameters" + ("-frame-parameters" (let ((alist (pop args-left))) (if coding-system (setq alist (decode-coding-string alist coding-system))) @@ -1129,24 +1129,24 @@ The following commands are accepted by the client: ;; -display DISPLAY: ;; Open X frames on the given display instead of the default. - (`"-display" + ("-display" (setq display (pop args-left)) (if (zerop (length display)) (setq display nil))) ;; -parent-id ID: ;; Open X frame within window ID, via XEmbed. - (`"-parent-id" + ("-parent-id" (setq parent-id (pop args-left)) (if (zerop (length parent-id)) (setq parent-id nil))) ;; -window-system: Open a new X frame. - (`"-window-system" + ("-window-system" (if (fboundp 'x-create-frame) (setq dontkill t tty-name 'window-system))) ;; -resume: Resume a suspended tty frame. - (`"-resume" + ("-resume" (let ((terminal (process-get proc 'terminal))) (setq dontkill t) (push (lambda () @@ -1157,7 +1157,7 @@ The following commands are accepted by the client: ;; -suspend: Suspend the client's frame. (In case we ;; get out of sync, and a C-z sends a SIGTSTP to ;; emacsclient.) - (`"-suspend" + ("-suspend" (let ((terminal (process-get proc 'terminal))) (setq dontkill t) (push (lambda () @@ -1167,13 +1167,13 @@ The following commands are accepted by the client: ;; -ignore COMMENT: Noop; useful for debugging emacsclient. ;; (The given comment appears in the server log.) - (`"-ignore" + ("-ignore" (setq dontkill t) (pop args-left)) ;; -tty DEVICE-NAME TYPE: Open a new tty frame. ;; (But if we see -window-system later, use that.) - (`"-tty" + ("-tty" (setq tty-name (pop args-left) tty-type (pop args-left) dontkill (or dontkill @@ -1192,7 +1192,7 @@ The following commands are accepted by the client: ;; -position LINE[:COLUMN]: Set point to the given ;; position in the next file. - (`"-position" + ("-position" (if (not (string-match "\\+\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?" (car args-left))) (error "Invalid -position command in client args")) @@ -1203,7 +1203,7 @@ The following commands are accepted by the client: "")))))) ;; -file FILENAME: Load the given file. - (`"-file" + ("-file" (let ((file (pop args-left))) (if coding-system (setq file (decode-coding-string file coding-system))) @@ -1221,7 +1221,7 @@ The following commands are accepted by the client: (setq filepos nil)) ;; -eval EXPR: Evaluate a Lisp expression. - (`"-eval" + ("-eval" (if use-current-frame (setq use-current-frame 'always)) (let ((expr (pop args-left))) @@ -1232,14 +1232,14 @@ The following commands are accepted by the client: (setq filepos nil))) ;; -env NAME=VALUE: An environment variable. - (`"-env" + ("-env" (let ((var (pop args-left))) ;; XXX Variables should be encoded as in getenv/setenv. (process-put proc 'env (cons var (process-get proc 'env))))) ;; -dir DIRNAME: The cwd of the emacsclient process. - (`"-dir" + ("-dir" (setq dir (pop args-left)) (if coding-system (setq dir (decode-coding-string dir coding-system))) diff --git a/lisp/subr.el b/lisp/subr.el index 41dc9aa45f..aaf8909e0c 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -4815,7 +4815,7 @@ command is called from a keyboard macro?" i frame nextframe))) (pcase skip (`nil nil) - (`0 t) + (0 t) (_ (setq i (+ i skip -1)) (funcall get-next-frame))))))) ;; Now `frame' should be "the function from which we were called". (pcase (cons frame nextframe) diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 31ce638b31..63c86317ee 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -1219,7 +1219,7 @@ for determining whether point is within a selector." (`(:elem . basic) css-indent-offset) (`(:elem . arg) 0) ;; "" stands for BOB (bug#15467). - (`(:list-intro . ,(or `";" `"" `":-property")) t) + (`(:list-intro . ,(or ";" "" ":-property")) t) (`(:before . "{") (when (or (smie-rule-hanging-p) (smie-rule-bolp)) (smie-backward-sexp ";") diff --git a/test/lisp/emacs-lisp/pcase-tests.el b/test/lisp/emacs-lisp/pcase-tests.el index 774a488255..c706c1051e 100644 --- a/test/lisp/emacs-lisp/pcase-tests.el +++ b/test/lisp/emacs-lisp/pcase-tests.el @@ -53,7 +53,7 @@ (should (pcase-tests-grep 'memq (macroexpand-all '(pcase x ((or 1 2 3) body))))) (should (pcase-tests-grep - 'member (macroexpand-all '(pcase x ((or '"a" '2 '3) body))))) + 'member (macroexpand-all '(pcase x ((or "a" 2 3) body))))) (should-not (pcase-tests-grep 'memq (macroexpand-all '(pcase x ((or "a" 2 3) body))))) (let ((exp (macroexpand-all commit 607cc2901bab0be64d08aff0394a4676a81da40b Author: Alan Mackenzie Date: Tue Oct 30 11:43:13 2018 +0000 Fix C++ Mode dynamic error with string delimiters. Fixes bug #33163 * lisp/progmodes/cc-mode.el (c-before-change-check-unbalanced-strings): Use the correct variable `end' in place of the wrong `c-new-END'. (c-after-change-re-mark-unbalanced-strings): Correct a logic error whilst skipping over comments. diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 09c30e2bd1..d019cf2493 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1232,21 +1232,21 @@ Note that the style variables are always made local to the buffer." (if (eq beg-literal-type 'string) (setq c-new-BEG (min (car beg-limits) c-new-BEG)))) - ((< c-new-END (point-max)) - (goto-char (1+ c-new-END)) ; might be a newline. + ((< end (point-max)) + (goto-char (1+ end)) ; might be a newline. ;; In the following regexp, the initial \n caters for a newline getting ;; joined to a preceding \ by the removal of what comes between. (re-search-forward "[\n\r]?\\(\\\\\\(.\\|\n\\|\r\\)\\|[^\\\n\r]\\)*" nil t) ;; We're at an EOLL or point-max. - (setq c-new-END (min (1+ (point)) (point-max))) - (goto-char c-new-END) - (if (equal (c-get-char-property (1- (point)) 'syntax-table) '(15)) - (if (memq (char-before) '(?\n ?\r)) + (setq c-new-END (max c-new-END (min (1+ (point)) (point-max)))) + (if (equal (c-get-char-property (point) 'syntax-table) '(15)) + (if (memq (char-after) '(?\n ?\r)) ;; Normally terminated invalid string. - (progn + (let ((eoll-1 (point))) + (forward-char) (backward-sexp) - (c-clear-char-property (1- c-new-END) 'syntax-table) + (c-clear-char-property eoll-1 'syntax-table) (c-clear-char-property (point) 'syntax-table)) ;; Opening " at EOB. (c-clear-char-property (1- (point)) 'syntax-table)) @@ -1254,7 +1254,7 @@ Note that the style variables are always made local to the buffer." ;; Opening " on last line of text (without EOL). (c-clear-char-property (point) 'syntax-table)))) - (t (goto-char c-new-END) + (t (goto-char end) ; point-max (if (c-search-backward-char-property 'syntax-table '(15) c-new-BEG) (c-clear-char-property (point) 'syntax-table)))) @@ -1343,9 +1343,9 @@ Note that the style variables are always made local to the buffer." (while (progn (setq s (parse-partial-sexp (point) c-new-END nil nil s 'syntax-table)) - (and (not (nth 3 s)) - (< (point) c-new-END) - (not (memq (char-before) c-string-delims))))) + (and (< (point) c-new-END) + (or (not (nth 3 s)) + (not (memq (char-before) c-string-delims)))))) ;; We're at the start of a string. (memq (char-before) c-string-delims))) (if (c-unescaped-nls-in-string-p (1- (point))) commit ced58d3e15ae4c085b8246bbf0ef9f1a9b39c456 Author: Eli Zaretskii Date: Tue Oct 30 13:08:28 2018 +0200 Improve doc string of 'call-process' * src/callproc.c (Fcall_process): Clarify DESTINATION in the doc string. diff --git a/src/callproc.c b/src/callproc.c index 973f324139..8f1da2fd7a 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -221,15 +221,20 @@ DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0, doc: /* Call PROGRAM synchronously in separate process. The remaining arguments are optional. The program's input comes from file INFILE (nil means `/dev/null'). -Insert output in DESTINATION before point; t means current buffer; nil for DESTINATION - means discard it; 0 means discard and don't wait; and `(:file FILE)', where - FILE is a file name string, means that it should be written to that file - (if the file already exists it is overwritten). + +Third argument DESTINATION specifies how to handle program's output. +If DESTINATION is a buffer, or t that stands for the current buffer, + it means insert output in that buffer before point. +If DESTINATION is nil, it means discard output; 0 means discard + and don't wait for the program to terminate. +If DESTINATION is `(:file FILE)', where FILE is a file name string, + it means that output should be written to that file (if the file + already exists it is overwritten). DESTINATION can also have the form (REAL-BUFFER STDERR-FILE); in that case, -REAL-BUFFER says what to do with standard output, as above, -while STDERR-FILE says what to do with standard error in the child. -STDERR-FILE may be nil (discard standard error output), -t (mix it with ordinary output), or a file name string. + REAL-BUFFER says what to do with standard output, as above, + while STDERR-FILE says what to do with standard error in the child. + STDERR-FILE may be nil (discard standard error output), + t (mix it with ordinary output), or a file name string. Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted. Remaining arguments are strings passed as command arguments to PROGRAM. commit 38f88a7f00c654a1710b1156150e93e298a0e217 Author: Eli Zaretskii Date: Tue Oct 30 12:14:19 2018 +0200 Document that generic functions cannot be commands * doc/lispref/commands.texi (Defining Commands): * doc/lispref/functions.texi (Generic Functions): Document that generic functions cannot be turned into commands. (Bug#33170) diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 49c839a897..427379bc79 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -136,6 +136,9 @@ start with a capital, e.g., @code{"use (system-name) instead."}); @code{t}; any other symbol, which should be an alternative function to use in Lisp code. +Generic functions (@pxref{Generic Functions}) cannot be turned into +commands by adding the @code{interactive} form to them. + @menu * Using Interactive:: General rules for @code{interactive}. * Interactive Codes:: The standard letter-codes for reading arguments diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 9b8057080e..242d754dea 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -1345,6 +1345,13 @@ to invoke the other auxiliary or primary methods. This allows you to add more methods, distinguished by @var{string}, for the same specializers and qualifiers. @end table + +Functions defined using @code{cl-defmethod} cannot be made +interactive, i.e.@: commands (@pxref{Defining Commands}), by adding +the @code{interactive} form to them. If you need a polymorphic +command, we recommend defining a normal command that calls a +polymorphic function defined via @code{cl-defgeneric} and +@code{cl-defmethod}. @end defmac @cindex dispatch of methods for generic function commit 15059d228c099c7fbccfb04058d58253d40851e7 Author: Glenn Morris Date: Mon Oct 29 20:50:14 2018 -0400 * configure.ac (emacs_config_features): Add notify backends. diff --git a/configure.ac b/configure.ac index 50e3333528..4a80eb442f 100644 --- a/configure.ac +++ b/configure.ac @@ -5498,6 +5498,15 @@ for opt in XAW3D XPM JPEG TIFF GIF PNG RSVG CAIRO IMAGEMAGICK SOUND GPM DBUS \ *) continue ;; esac ;; + NOTIFY) + case $val in + *lkqueue*) opt="$opt LIBKQUEUE" ;; + *kqueue*) opt="$opt KQUEUE" ;; + *inotify*) opt="$opt INOTIFY" ;; + *gfile*) opt="$opt GFILENOTIFY" ;; + *w32*) opt="$opt W32NOTIFY" ;; + esac + ;; esac AS_VAR_APPEND([emacs_config_features], ["$optsep$opt"]) optsep=' ' commit 0c6e9a00046ffb1421563b06030a6ce3025ce1fa Author: Juri Linkov Date: Tue Oct 30 00:57:09 2018 +0200 * lisp/window.el (window--state-get-1): Check buffer-live-p in next-buffers and prev-buffers. (Bug#32850) diff --git a/lisp/window.el b/lisp/window.el index 27d7e42280..bcd4fa2959 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -5552,9 +5552,14 @@ specific buffers." (buffer (window-buffer window)) (selected (eq window (selected-window))) (next-buffers (when (window-live-p window) - (window-next-buffers window))) + (delq nil (mapcar (lambda (buffer) + (and (buffer-live-p buffer) buffer)) + (window-next-buffers window))))) (prev-buffers (when (window-live-p window) - (window-prev-buffers window))) + (delq nil (mapcar (lambda (entry) + (and (buffer-live-p (nth 0 entry)) + entry)) + (window-prev-buffers window))))) (head `(,type ,@(unless (window-next-sibling window) `((last . t))) commit 0e484c66fd63877230c3dfa97f2ce9dda71ad88b Author: Gemini Lasswell Date: Sun Oct 14 12:12:04 2018 -0700 Keep a stack reference to bytecode objects being executed (Bug#33014) * src/eval.c (Ffuncall): Make local variable 'fun' volatile. * test/src/eval-tests.el (eval-tests-byte-code-being-evaluated-is-protected-from-gc): Add regression test for Bug#33014. (eval-tests-33014-var): New variable. (eval-tests-33014-func, eval-tests-33014-redefine): New functions. diff --git a/src/eval.c b/src/eval.c index a51d0c9083..32cfda24d8 100644 --- a/src/eval.c +++ b/src/eval.c @@ -2820,8 +2820,11 @@ Thus, (funcall \\='cons \\='x \\='y) returns (x . y). usage: (funcall FUNCTION &rest ARGUMENTS) */) (ptrdiff_t nargs, Lisp_Object *args) { - Lisp_Object fun, original_fun; - Lisp_Object funcar; + /* Use 'volatile' here to cause optimizing compilers to keep a + reference on the stack to the function's bytecode object. See + Bug#33014. */ + Lisp_Object volatile fun; + Lisp_Object original_fun, funcar; ptrdiff_t numargs = nargs - 1; Lisp_Object val; ptrdiff_t count; diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el index 281d959b53..0c242913e7 100644 --- a/test/src/eval-tests.el +++ b/test/src/eval-tests.el @@ -139,4 +139,34 @@ crash/abort/malloc assert failure on the next test." (defvaralias 'eval-tests--foo-alias 'eval-tests--foo) 'no-warning))))) +(ert-deftest eval-tests-byte-code-being-evaluated-is-protected-from-gc () + "Regression test for Bug#33014. +Check that byte-compiled objects being executed by exec-byte-code +are found on the stack and therefore not garbage collected." + (should (string= (eval-tests-33014-func) + "before after: ok foo: (e) bar: (a b c d e) baz: a bop: c"))) + +(defvar eval-tests-33014-var "ok") +(defun eval-tests-33014-func () + "A function which has a non-trivial constants vector when byte-compiled." + (let ((result "before ")) + (eval-tests-33014-redefine) + (garbage-collect) + (setq result (concat result (format "after: %s" eval-tests-33014-var))) + (let ((vals '(0 1 2 3)) + (things '(a b c d e))) + (dolist (val vals) + (setq result + (concat result " " + (cond + ((= val 0) (format "foo: %s" (last things))) + ((= val 1) (format "bar: %s" things)) + ((= val 2) (format "baz: %s" (car things))) + (t (format "bop: %s" (nth 2 things)))))))) + result)) + +(defun eval-tests-33014-redefine () + "Remove the Lisp reference to the byte-compiled object." + (setf (symbol-function #'eval-tests-33014-func) nil)) + ;;; eval-tests.el ends here commit b9c60200259a562f4762e8debf4646319d7a9332 Author: Michael Albinus Date: Mon Oct 29 14:09:52 2018 +0100 Fix Bug#33006 * lisp/cedet/semantic/symref/grep.el (semantic-symref-perform-search): * lisp/progmodes/xref.el (xref-collect-matches) (xref--collect-matches): Handle remote files. (Bug#33006) diff --git a/lisp/cedet/semantic/symref/grep.el b/lisp/cedet/semantic/symref/grep.el index 93bda6ab29..661e101520 100644 --- a/lisp/cedet/semantic/symref/grep.el +++ b/lisp/cedet/semantic/symref/grep.el @@ -173,14 +173,16 @@ This shell should support pipe redirect syntax." ;; find . -type f -print0 | xargs -0 -e grep -nH -e ;; Note : I removed -e as it is not posix, nor necessary it seems. - (let ((cmd (concat "find " default-directory " -type f " filepattern " -print0 " + (let ((cmd (concat "find " (file-local-name rootdir) + " -type f " filepattern " -print0 " "| xargs -0 grep -H " grepflags "-e " greppat))) ;;(message "Old command: %s" cmd) - (call-process semantic-symref-grep-shell nil b nil + (process-file semantic-symref-grep-shell nil b nil shell-command-switch cmd) ) - (let ((cmd (semantic-symref-grep-use-template rootdir filepattern grepflags greppat))) - (call-process semantic-symref-grep-shell nil b nil + (let ((cmd (semantic-symref-grep-use-template + (file-local-name rootdir) filepattern grepflags greppat))) + (process-file semantic-symref-grep-shell nil b nil shell-command-switch cmd)) )) (setq ans (semantic-symref-parse-tool-output tool b)) diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index c7ae40eb34..6b1421a6f7 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -992,7 +992,7 @@ IGNORES is a list of glob patterns." ;; do that reliably enough, without creating false negatives? (command (xref--rgrep-command (xref--regexp-to-extended regexp) files - (expand-file-name dir) + (file-local-name (expand-file-name dir)) ignores)) (def default-directory) (buf (get-buffer-create " *xref-grep*")) @@ -1003,7 +1003,7 @@ IGNORES is a list of glob patterns." (erase-buffer) (setq default-directory def) (setq status - (call-process-shell-command command nil t)) + (process-file-shell-command command nil t)) (goto-char (point-min)) ;; Can't use the exit status: Grep exits with 1 to mean "no ;; matches found". Find exits with 1 if any of the invocations @@ -1105,6 +1105,7 @@ Such as the current syntax table and the applied syntax properties." (defun xref--collect-matches (hit regexp tmp-buffer) (pcase-let* ((`(,line ,file ,text) hit) + (file (and file (concat (file-remote-p default-directory) file))) (buf (xref--find-buffer-visiting file)) (syntax-needed (xref--regexp-syntax-dependent-p regexp))) (if buf commit 0e6635fdb9ad34dea0540c121c8b981a4fc14832 Author: JoĂŁo Távora Date: Mon Oct 29 11:41:04 2018 +0000 Fix Flymake's diagnostic count with custom error types Fixes: bug#33187 * lisp/progmodes/flymake.el (flymake--mode-line-format): Replace cl-union with iterative cl-pushnew. diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 5831301a57..f0f93f1087 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1183,20 +1183,17 @@ default) no filter is applied." ,@(unless (or all-disabled (null known)) (cl-loop - for (type . severity) - in (cl-sort (mapcar (lambda (type) - (cons type (flymake--severity type))) - (cl-union (hash-table-keys diags-by-type) - '(:error :warning) - :key #'flymake--severity)) - #'> - :key #'cdr) + with types = (hash-table-keys diags-by-type) + with _augmented = (cl-loop for extra in '(:error :warning) + do (cl-pushnew extra types + :key #'flymake--severity)) + for type in (cl-sort types #'> :key #'flymake--severity) for diags = (gethash type diags-by-type) for face = (flymake--lookup-type-property type 'mode-line-face 'compilation-error) - when (or diags - (>= severity (warning-numeric-level :warning))) + when (or diags (>= (flymake--severity type) + (warning-numeric-level :warning))) collect `(:propertize ,(format "%d" (length diags)) face ,face commit 5aeddfac2a55824f700c8913536d665e23afd73d Author: Charles A. Roelli Date: Sun Oct 28 20:29:45 2018 +0100 * lisp/mail/rmailsum.el (rmail-summary-output): Add lost word to doc. diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el index 692f67b87d..667b72b1b3 100644 --- a/lisp/mail/rmailsum.el +++ b/lisp/mail/rmailsum.el @@ -1692,7 +1692,7 @@ Deleted messages are skipped and don't count. When called from Lisp code, N may be omitted and defaults to 1. This command always outputs the complete message header, -even the header display is currently pruned." +even if the header display is currently pruned." (interactive (progn (require 'rmailout) (list (rmail-output-read-file-name) commit 10e0fd8ca955070682d5f09231a7a386ef185fa5 Author: Charles A. Roelli Date: Sun Oct 28 18:07:01 2018 +0100 Add index entries for more isearch commands/bindings (Bug#32990) * doc/emacs/search.texi (Basic Isearch): Index isearch-exit, isearch-abort, isearch-cancel, isearch-repeat-forward, isearch-repeat-backward and their bindings. (Repeat Isearch): Index isearch-ring-advance, isearch-ring-retreat and isearch-edit-string. (Special Isearch): Index isearch-quote-char, isearch-char-by-name and their bindings. Index isearch-query-replace and isearch-query-replace-regexp, and the latter's binding. Explain what isearch-query-replace-regexp does. Index isearch-complete. (Word Search): Index isearch-toggle-word. diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index 58a76580d7..33aa0dd1c7 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -114,24 +114,30 @@ Isearch}, for more about dealing with unsuccessful search. @cindex exit incremental search @cindex incremental search, exiting +@findex isearch-exit +@kindex RET @r{(Incremental search)} When you are satisfied with the place you have reached, type -@key{RET}. This stops searching, leaving the cursor where the search -brought it. Also, any command not specially meaningful in searches -stops the searching and is then executed. Thus, typing @kbd{C-a} -exits the search and then moves to the beginning of the line; typing -one of the arrow keys exits the search and performs the respective -movement command; etc. @key{RET} is necessary only if the next -command you want to type is a printing character, @key{DEL}, -@key{RET}, or another character that is special within searches -(@kbd{C-q}, @kbd{C-w}, @kbd{C-r}, @kbd{C-s}, @kbd{C-y}, @kbd{M-y}, -@kbd{M-r}, @kbd{M-c}, @kbd{M-e}, and some others described below). -You can fine-tune the commands that exit the search; see @ref{Not -Exiting Isearch}. +@key{RET} (@code{isearch-exit}). This stops searching, leaving the +cursor where the search brought it. Also, any command not specially +meaningful in searches stops the searching and is then executed. +Thus, typing @kbd{C-a} exits the search and then moves to the +beginning of the line; typing one of the arrow keys exits the search +and performs the respective movement command; etc. @key{RET} is +necessary only if the next command you want to type is a printing +character, @key{DEL}, @key{RET}, or another character that is special +within searches (@kbd{C-q}, @kbd{C-w}, @kbd{C-r}, @kbd{C-s}, +@kbd{C-y}, @kbd{M-y}, @kbd{M-r}, @kbd{M-c}, @kbd{M-e}, and some others +described below). You can fine-tune the commands that exit the +search; see @ref{Not Exiting Isearch}. As a special exception, entering @key{RET} when the search string is empty launches nonincremental search (@pxref{Nonincremental Search}). (This can be customized; see @ref{Search Customizations}.) +@findex isearch-abort +@findex isearch-cancel +@kindex C-g C-g @r{(Incremental Search)} +@kindex ESC ESC ESC @r{(Incremental Search)} To abandon the search and return to the place where you started, type @kbd{@key{ESC} @key{ESC} @key{ESC}} (@code{isearch-cancel}) or @kbd{C-g C-g} (@code{isearch-abort}). @@ -154,13 +160,18 @@ matches that begin after it. @node Repeat Isearch @subsection Repeating Incremental Search +@kindex C-s @r{(Incremental Search)} +@kindex C-r @r{(Incremental Search)} +@findex isearch-repeat-forward +@findex isearch-repeat-backward Suppose you search forward for @samp{FOO} and find a match, but not the one you expected to find: the @samp{FOO} you were aiming for -occurs later in the buffer. In this event, type another @kbd{C-s} to -move to the next occurrence of the search string. You can repeat this -any number of times. If you overshoot, you can cancel some @kbd{C-s} -characters with @key{DEL}. Similarly, each @kbd{C-r} in a backward -incremental search repeats the backward search. +occurs later in the buffer. In this event, type another @kbd{C-s} +(@code{isearch-repeat-forward}) to move to the next occurrence of the +search string. You can repeat this any number of times. If you +overshoot, you can cancel some @kbd{C-s} commands with @key{DEL}. +Similarly, each @kbd{C-r} (@code{isearch-repeat-backward}) in a +backward incremental search repeats the backward search. @cindex lazy search highlighting If you pause for a little while during incremental search, Emacs @@ -200,12 +211,15 @@ going past the original starting point of the search, it changes to you have already seen. @cindex search ring +@findex isearch-ring-advance +@findex isearch-ring-retreat @kindex M-n @r{(Incremental search)} @kindex M-p @r{(Incremental search)} @vindex search-ring-max To reuse earlier search strings, use the @dfn{search ring}. The -commands @kbd{M-p} and @kbd{M-n} move through the ring to pick a -search string to reuse. These commands leave the selected search ring +commands @kbd{M-p} (@code{isearch-ring-retreat}) and @kbd{M-n} +(@code{isearch-ring-advance}) move through the ring to pick a search +string to reuse. These commands leave the selected search ring element in the minibuffer, where you can edit it. Type @kbd{C-s}/@kbd{C-r} or @key{RET} to accept the string and start searching for it. The number of most recently used search strings @@ -214,14 +228,16 @@ saved in the search ring is specified by the variable @cindex incremental search, edit search string @cindex interactively edit search string +@findex isearch-edit-string @kindex M-e @r{(Incremental search)} @kindex mouse-1 @r{in the minibuffer (Incremental Search)} To edit the current search string in the minibuffer without -replacing it with items from the search ring, type @kbd{M-e} or click -@kbd{mouse-1} in the minibuffer. Type @key{RET}, @kbd{C-s} or -@kbd{C-r} to finish editing the string and search for it. Type -@kbd{C-f} or @kbd{@key{RIGHT}} to add to the search string characters -following point from the buffer from which you started the search. +replacing it with items from the search ring, type @kbd{M-e} +(@code{isearch-edit-string}) or click @kbd{mouse-1} in the minibuffer. +Type @key{RET}, @kbd{C-s} or @kbd{C-r} to finish editing the string +and search for it. Type @kbd{C-f} or @kbd{@key{RIGHT}} to add to the +search string characters following point from the buffer from which +you started the search. @node Isearch Yank @subsection Isearch Yanking @@ -357,17 +373,22 @@ following methods: @itemize @bullet @item -Type @kbd{C-q}, followed by a non-graphic character or a sequence of -octal digits. This adds a character to the search string, similar to -inserting into a buffer using @kbd{C-q} (@pxref{Inserting Text}). For -example, @kbd{C-q C-s} during incremental search adds the -@samp{control-S} character to the search string. +@findex isearch-quote-char +@kindex C-q @r{(Incremental Search)} +Type @kbd{C-q} (@code{isearch-quote-char}), followed by a non-graphic +character or a sequence of octal digits. This adds a character to the +search string, similar to inserting into a buffer using @kbd{C-q} +(@pxref{Inserting Text}). For example, @kbd{C-q C-s} during +incremental search adds the @samp{control-S} character to the search +string. @item -Type @kbd{C-x 8 @key{RET}}, followed by a Unicode name or code-point -in hex. This adds the specified character into the search string, -similar to the usual @code{insert-char} command (@pxref{Inserting -Text}). +@findex isearch-char-by-name +@kindex C-x 8 RET @r{(Incremental Search)} +Type @kbd{C-x 8 @key{RET}} (@code{isearch-char-by-name}), followed by +a Unicode name or code-point in hex. This adds the specified +character into the search string, similar to the usual +@code{insert-char} command (@pxref{Inserting Text}). @item @kindex C-^ @r{(Incremental Search)} @@ -400,12 +421,20 @@ current buffer afterwards. @code{isearch-occur}, which runs @code{occur} with the current search string. @xref{Other Repeating Search, occur}. +@findex isearch-query-replace +@findex isearch-query-replace-regexp @kindex M-% @r{(Incremental search)} - Typing @kbd{M-%} in incremental search invokes @code{query-replace} -or @code{query-replace-regexp} (depending on search mode) with the -current search string used as the string to replace. A negative -prefix argument means to replace backward. @xref{Query Replace}. - +@kindex C-M-% @r{(Incremental search)} + Typing @kbd{M-%} (@code{isearch-query-replace}) in incremental +search invokes @code{query-replace} or @code{query-replace-regexp} +(depending on search mode) with the current search string used as the +string to replace. A negative prefix argument means to replace +backward. @xref{Query Replace}. Typing @kbd{C-M-%} +(@code{isearch-query-replace-regexp}) invokes +@code{query-replace-regexp} with the current search string used as the +regexp to replace. + +@findex isearch-complete @kindex M-TAB @r{(Incremental search)} Typing @kbd{M-@key{TAB}} in incremental search invokes @code{isearch-complete}, which attempts to complete the search string @@ -599,15 +628,17 @@ Search backward for @var{words}, using a nonincremental word search. Search the Web for the text in region. @end table -@kindex M-s w @findex isearch-forward-word +@findex isearch-toggle-word +@kindex M-s w To begin a forward incremental word search, type @kbd{M-s w}. If incremental search is not already active, this runs the command @code{isearch-forward-word}. If incremental search is already active -(whether a forward or backward search), @kbd{M-s w} switches to a word -search while keeping the direction of the search and the current -search string unchanged. You can toggle word search back off by -typing @kbd{M-s w} again. +(whether a forward or backward search), @kbd{M-s w} runs the command +@code{isearch-toggle-word}, which switches to a word search while +keeping the direction of the search and the current search string +unchanged. You can toggle word search back off by typing @kbd{M-s w} +again. @findex word-search-forward @findex word-search-backward commit f3050fc14e05a6eb18a70e0e7ce5d5302d5203e6 Merge: 2fdae77eb6 3dd16a89bf Author: Eli Zaretskii Date: Sun Oct 28 17:55:00 2018 +0200 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit de2818432acacea4eec35d5a92f240856de7b765 Author: Noam Postavsky Date: Sat Oct 27 15:27:45 2018 -0400 * lisp/simple.el (filter-buffer-substring): Clarify doc (Bug#33179). diff --git a/lisp/simple.el b/lisp/simple.el index 29bb9cbcfb..08f622ad8e 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -4232,7 +4232,7 @@ unless a hook has been set. Use `filter-buffer-substring' instead of `buffer-substring', `buffer-substring-no-properties', or `delete-and-extract-region' when you want to allow filtering to take place. For example, major or minor -modes can use `filter-buffer-substring-function' to extract characters +modes can use `filter-buffer-substring-function' to exclude text properties that are special to a buffer, and should not be copied into other buffers." (funcall filter-buffer-substring-function beg end delete)) commit 3dd16a89bf410d77e9ddc41cbfbbd4b343928d6d Author: Juri Linkov Date: Sat Oct 27 23:27:54 2018 +0300 * lisp/isearch.el (lazy-highlight-buffer): New defcustom. (Bug#29360) (lazy-highlight-buffer-max-at-a-time): New defcustom. (isearch-lazy-highlight-buffer): New defvar. (isearch-lazy-highlight-new-loop): Don't check changes in window boundaries when lazy-highlight-buffer is non-nil. Move code that extends start/end to match whole string at point here from isearch-lazy-highlight-search. (isearch-lazy-highlight-search): Add args string and bound like in other search functions. Move calculation of bound to isearch-lazy-highlight-update. (isearch-lazy-highlight-match): New function with code extracted from isearch-lazy-highlight-update to be called also from isearch-lazy-highlight-buffer-update. (isearch-lazy-highlight-update): Reuse the values returned from window-group-start and window-group-end. At the end schedule the timer to call isearch-lazy-highlight-buffer-update when isearch-lazy-highlight-buffer is non-nil. (isearch-lazy-highlight-buffer-update): New function. diff --git a/etc/NEWS b/etc/NEWS index be32ac6b9b..57a83068bd 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -581,6 +581,14 @@ can now be searched via 'C-s'. ** Search and Replace +*** lazy-highlight-buffer highlights matches in the full buffer. +It is useful in combination with lazy-highlight-cleanup customized to nil +to leave matches highlighted in the whole buffer after exiting isearch. +Also when lazy-highlight-buffer prepares highlighting in the buffer, +navigation through the matches without flickering is more smooth. +lazy-highlight-buffer-max-at-a-time controls the number of matches to +highlight in one iteration while processing the full buffer. + +++ *** New isearch bindings. diff --git a/lisp/isearch.el b/lisp/isearch.el index 38110d0998..580b3ac40a 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -304,9 +304,9 @@ are `word-search-regexp' \(`\\[isearch-toggle-word]'), `isearch-symbol-regexp' (defcustom isearch-lazy-highlight t "Controls the lazy-highlighting during incremental search. -When non-nil, all text in the buffer matching the current search -string is highlighted lazily (see `lazy-highlight-initial-delay' -and `lazy-highlight-interval'). +When non-nil, all text currently visible on the screen +matching the current search string is highlighted lazily +(see `lazy-highlight-initial-delay' and `lazy-highlight-interval'). When multiple windows display the current buffer, the highlighting is displayed only on the selected window, unless @@ -351,6 +351,27 @@ A value of nil means highlight all matches shown on the screen." (integer :tag "Some")) :group 'lazy-highlight) +(defcustom lazy-highlight-buffer-max-at-a-time 20 + "Maximum matches to highlight at a time (for `lazy-highlight-buffer'). +Larger values may reduce Isearch's responsiveness to user input; +smaller values make matches highlight slowly. +A value of nil means highlight all matches in the buffer." + :type '(choice (const :tag "All" nil) + (integer :tag "Some")) + :group 'lazy-highlight + :version "27.1") + +(defcustom lazy-highlight-buffer nil + "Controls the lazy-highlighting of the full buffer. +When non-nil, all text in the buffer matching the current search +string is highlighted lazily (see `lazy-highlight-initial-delay', +`lazy-highlight-interval' and `lazy-highlight-buffer-max-at-a-time'). +This is useful when `lazy-highlight-cleanup' is customized to nil +and doesn't remove full-buffer highlighting after a search." + :type 'boolean + :group 'lazy-highlight + :version "27.1") + (defface lazy-highlight '((((class color) (min-colors 88) (background light)) (:background "paleturquoise")) @@ -3181,6 +3202,7 @@ since they have special meaning in a regexp." (defvar isearch-lazy-highlight-window-group nil) (defvar isearch-lazy-highlight-window-start nil) (defvar isearch-lazy-highlight-window-end nil) +(defvar isearch-lazy-highlight-buffer nil) (defvar isearch-lazy-highlight-case-fold-search nil) (defvar isearch-lazy-highlight-regexp nil) (defvar isearch-lazy-highlight-lax-whitespace nil) @@ -3229,10 +3251,12 @@ by other Emacs features." isearch-lax-whitespace)) (not (eq isearch-lazy-highlight-regexp-lax-whitespace isearch-regexp-lax-whitespace)) - (not (= (window-group-start) - isearch-lazy-highlight-window-start)) - (not (= (window-group-end) ; Window may have been split/joined. - isearch-lazy-highlight-window-end)) + (not (or lazy-highlight-buffer + (= (window-group-start) + isearch-lazy-highlight-window-start))) + (not (or lazy-highlight-buffer + (= (window-group-end) ; Window may have been split/joined. + isearch-lazy-highlight-window-end))) (not (eq isearch-forward isearch-lazy-highlight-forward)) ;; In case we are recovering from an error. @@ -3250,6 +3274,7 @@ by other Emacs features." isearch-lazy-highlight-window-group (selected-window-group) isearch-lazy-highlight-window-start (window-group-start) isearch-lazy-highlight-window-end (window-group-end) + isearch-lazy-highlight-buffer lazy-highlight-buffer ;; Start lazy-highlighting at the beginning of the found ;; match (`isearch-other-end'). If no match, use point. ;; One of the next two variables (depending on search direction) @@ -3267,12 +3292,22 @@ by other Emacs features." isearch-lazy-highlight-regexp-lax-whitespace isearch-regexp-lax-whitespace isearch-lazy-highlight-regexp-function isearch-regexp-function isearch-lazy-highlight-forward isearch-forward) + ;; Extend start/end to match whole string at point (bug#19353) + (if isearch-lazy-highlight-forward + (setq isearch-lazy-highlight-start + (min (+ isearch-lazy-highlight-start + (1- (length isearch-lazy-highlight-last-string))) + (point-max))) + (setq isearch-lazy-highlight-end + (max (- isearch-lazy-highlight-end + (1- (length isearch-lazy-highlight-last-string))) + (point-min)))) (unless (equal isearch-string "") (setq isearch-lazy-highlight-timer (run-with-idle-timer lazy-highlight-initial-delay nil 'isearch-lazy-highlight-start))))) -(defun isearch-lazy-highlight-search () +(defun isearch-lazy-highlight-search (string bound) "Search ahead for the next or previous match, for lazy highlighting. Attempt to do the search exactly the way the pending Isearch would." (condition-case nil @@ -3286,24 +3321,10 @@ Attempt to do the search exactly the way the pending Isearch would." (isearch-forward isearch-lazy-highlight-forward) (search-invisible nil) ; don't match invisible text (retry t) - (success nil) - (bound (if isearch-lazy-highlight-forward - (min (or isearch-lazy-highlight-end-limit (point-max)) - (if isearch-lazy-highlight-wrapped - (+ isearch-lazy-highlight-start - ;; Extend bound to match whole string at point - (1- (length isearch-lazy-highlight-last-string))) - (window-group-end))) - (max (or isearch-lazy-highlight-start-limit (point-min)) - (if isearch-lazy-highlight-wrapped - (- isearch-lazy-highlight-end - ;; Extend bound to match whole string at point - (1- (length isearch-lazy-highlight-last-string))) - (window-group-start)))))) + (success nil)) ;; Use a loop like in `isearch-search'. (while retry - (setq success (isearch-search-string - isearch-lazy-highlight-last-string bound t)) + (setq success (isearch-search-string string bound t)) ;; Clear RETRY unless the search predicate says ;; to skip this search hit. (if (or (not success) @@ -3315,6 +3336,17 @@ Attempt to do the search exactly the way the pending Isearch would." success) (error nil))) +(defun isearch-lazy-highlight-match (mb me) + (let ((ov (make-overlay mb me))) + (push ov isearch-lazy-highlight-overlays) + ;; 1000 is higher than ediff's 100+, + ;; but lower than isearch main overlay's 1001 + (overlay-put ov 'priority 1000) + (overlay-put ov 'face 'lazy-highlight) + (unless (or (eq isearch-lazy-highlight 'all-windows) + isearch-lazy-highlight-buffer) + (overlay-put ov 'window (selected-window))))) + (defun isearch-lazy-highlight-start () "Start a new lazy-highlight updating loop." (lazy-highlight-cleanup t) ;remove old overlays @@ -3324,19 +3356,32 @@ Attempt to do the search exactly the way the pending Isearch would." "Update highlighting of other matches for current search." (let ((max lazy-highlight-max-at-a-time) (looping t) - nomore) + nomore window-start window-end) (with-local-quit (save-selected-window (if (and (window-live-p isearch-lazy-highlight-window) (not (memq (selected-window) isearch-lazy-highlight-window-group))) (select-window isearch-lazy-highlight-window)) + (setq window-start (window-group-start)) + (setq window-end (window-group-end)) (save-excursion (save-match-data (goto-char (if isearch-lazy-highlight-forward isearch-lazy-highlight-end isearch-lazy-highlight-start)) (while looping - (let ((found (isearch-lazy-highlight-search))) + (let* ((bound (if isearch-lazy-highlight-forward + (min (or isearch-lazy-highlight-end-limit (point-max)) + (if isearch-lazy-highlight-wrapped + isearch-lazy-highlight-start + window-end)) + (max (or isearch-lazy-highlight-start-limit (point-min)) + (if isearch-lazy-highlight-wrapped + isearch-lazy-highlight-end + window-start)))) + (found (isearch-lazy-highlight-search + isearch-lazy-highlight-last-string + bound))) (when max (setq max (1- max)) (if (<= max 0) @@ -3348,24 +3393,17 @@ Attempt to do the search exactly the way the pending Isearch would." (if isearch-lazy-highlight-forward (if (= mb (if isearch-lazy-highlight-wrapped isearch-lazy-highlight-start - (window-group-end))) + window-end)) (setq found nil) (forward-char 1)) (if (= mb (if isearch-lazy-highlight-wrapped isearch-lazy-highlight-end - (window-group-start))) + window-start)) (setq found nil) (forward-char -1))) ;; non-zero-length match - (let ((ov (make-overlay mb me))) - (push ov isearch-lazy-highlight-overlays) - ;; 1000 is higher than ediff's 100+, - ;; but lower than isearch main overlay's 1001 - (overlay-put ov 'priority 1000) - (overlay-put ov 'face 'lazy-highlight) - (unless (eq isearch-lazy-highlight 'all-windows) - (overlay-put ov 'window (selected-window))))) + (isearch-lazy-highlight-match mb me)) ;; Remember the current position of point for ;; the next call of `isearch-lazy-highlight-update' ;; when `lazy-highlight-max-at-a-time' is too small. @@ -3381,17 +3419,82 @@ Attempt to do the search exactly the way the pending Isearch would." (setq isearch-lazy-highlight-wrapped t) (if isearch-lazy-highlight-forward (progn - (setq isearch-lazy-highlight-end (window-group-start)) + (setq isearch-lazy-highlight-end window-start) (goto-char (max (or isearch-lazy-highlight-start-limit (point-min)) - (window-group-start)))) - (setq isearch-lazy-highlight-start (window-group-end)) + window-start))) + (setq isearch-lazy-highlight-start window-end) (goto-char (min (or isearch-lazy-highlight-end-limit (point-max)) - (window-group-end)))))))) - (unless nomore + window-end))))))) + (if nomore + (when isearch-lazy-highlight-buffer + (if isearch-lazy-highlight-forward + (setq isearch-lazy-highlight-end (point-min)) + (setq isearch-lazy-highlight-start (point-max))) + (run-at-time lazy-highlight-interval nil + 'isearch-lazy-highlight-buffer-update)) (setq isearch-lazy-highlight-timer (run-at-time lazy-highlight-interval nil 'isearch-lazy-highlight-update))))))))) +(defun isearch-lazy-highlight-buffer-update () + "Update highlighting of other matches in the full buffer." + (let ((max lazy-highlight-buffer-max-at-a-time) + (looping t) + nomore window-start window-end) + (with-local-quit + (save-selected-window + (if (and (window-live-p isearch-lazy-highlight-window) + (not (memq (selected-window) isearch-lazy-highlight-window-group))) + (select-window isearch-lazy-highlight-window)) + (setq window-start (window-group-start)) + (setq window-end (window-group-end)) + (save-excursion + (save-match-data + (goto-char (if isearch-lazy-highlight-forward + isearch-lazy-highlight-end + isearch-lazy-highlight-start)) + (while looping + (let* ((bound (if isearch-lazy-highlight-forward + (or isearch-lazy-highlight-end-limit (point-max)) + (or isearch-lazy-highlight-start-limit (point-min)))) + (found (isearch-lazy-highlight-search + isearch-lazy-highlight-last-string + bound))) + (when max + (setq max (1- max)) + (if (<= max 0) + (setq looping nil))) + (if found + (let ((mb (match-beginning 0)) + (me (match-end 0))) + (if (= mb me) ;zero-length match + (if isearch-lazy-highlight-forward + (if (= mb (point-max)) + (setq found nil) + (forward-char 1)) + (if (= mb (point-min)) + (setq found nil) + (forward-char -1))) + ;; Already highlighted by isearch-lazy-highlight-update + (unless (and (>= mb window-start) (<= me window-end)) + ;; non-zero-length match + (isearch-lazy-highlight-match mb me))) + ;; Remember the current position of point for + ;; the next call of `isearch-lazy-highlight-update' + ;; when `lazy-highlight-buffer-max-at-a-time' is too small. + (if isearch-lazy-highlight-forward + (setq isearch-lazy-highlight-end (point)) + (setq isearch-lazy-highlight-start (point))))) + + ;; not found or zero-length match at the search bound + (if (not found) + (setq looping nil + nomore t)))) + (unless nomore + (setq isearch-lazy-highlight-timer + (run-at-time lazy-highlight-interval nil + 'isearch-lazy-highlight-buffer-update))))))))) + (defun isearch-resume (string regexp word forward message case-fold) "Resume an incremental search. STRING is the string or regexp searched for. commit d192c1671cbebb191165169c7add0ade6721e00e Author: Eli Zaretskii Date: Sat Oct 27 21:47:59 2018 +0300 Fix recent change in lispref/processes.texi. * doc/lispref/processes.texi (Asynchronous Processes): Clarify wording. Suggested by Thomas Fitzsimmons . (Bug#33050) diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 0868912b14..e7d61bd5fa 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -601,13 +601,13 @@ Shell mode, because they allow for job control (@kbd{C-c}, @kbd{C-z}, etc.)@: between the process and its children, and because interactive programs treat ptys as terminal devices, whereas pipes don't support these features. However, for subprocesses used by Lisp programs for -internal purposes (i.e., with no user interaction), where significant -amounts of data need to be exchanged between the subprocess and the -Lisp program, it is often better to use a pipe, because pipes are -more efficient, and because they are immune to stray character -injections that ptys introduce for large (around 500 byte) messages. -Also, the total number of ptys is limited on many systems, and it is -good not to waste them unnecessarily. +internal purposes (i.e., no user interaction with the subprocess is +required), where significant amounts of data need to be exchanged +between the subprocess and the Lisp program, it is often better to use +a pipe, because pipes are more efficient, and because they are immune +to stray character injections that ptys introduce for large (around +500 byte) messages. Also, the total number of ptys is limited on many +systems, and it is good not to waste them unnecessarily. @defun make-process &rest args This function is the basic low-level primitive for starting commit 2df74ce79b910c977167e84d4cb37ede1053663f Merge: 3e81e9a0e7 df64da8eb8 Author: Glenn Morris Date: Sat Oct 27 09:15:32 2018 -0700 Merge from origin/emacs-26 df64da8 (origin/emacs-26) * lisp/simple.el (region-extract-function):... 520c486 * lisp/simple.el (region-bounds): Doc fix. (Bug#33168) 9193db0 Improve documentation of 'process-connection-type' 106b9e1 Unify prompt for gnupg passphrase between GNU/Linux and MS-Wi... 2a41616 Doc fix of 'gnus-fetch-old-headers' 29a7644 Deactivate incorrect hyperlinking in gnus-build-sparse-thread... 53ae90f Minor copyedits in cmdargs.texi fc2e65a Improve documentation of X resource loading 13132b3 * lisp/net/tramp-sh.el (tramp-inline-compress-commands): 8361292 ; Fix sorting in admin/MAINTAINERS 92de44f Don't error when indenting malformed Lisp (Bug#30891) c3adbc8 Improve 'isearch-delete-char' documentation (Bug#32990) 6ca71ce ; * lisp/help.el (with-help-window): Remove extra space in doc. f5f9583 Improve XPM load failure message (bug#33126) f3d01d4 Avoid infloop in CPerl mode fontification 71a2d50 Fix minibuffer-help-form for lexical binding 7e8eee6 Fix some NS drawing issues (bug#32932) d72975a * lisp/gnus/mm-util.el (mm-decompress-buffer): Fix split-stri... c97a5f1 * doc/misc/calc.texi (Summary): The +/- key is 'p', not 'P'. # Conflicts: # lisp/gnus/mm-util.el commit df64da8eb845c9f07ee93bfbf28af41a01a2e83f Author: Eli Zaretskii Date: Sat Oct 27 14:08:40 2018 +0300 * lisp/simple.el (region-extract-function): Doc fix. (Bug#33167) diff --git a/lisp/simple.el b/lisp/simple.el index 0e5dadc81f..29bb9cbcfb 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1011,13 +1011,16 @@ instead of deleted." (filter-buffer-substring (region-beginning) (region-end) method))))) "Function to get the region's content. Called with one argument METHOD which can be: -- nil: return the content as a string. +- nil: return the content as a string (list of strings for + non-contiguous regions). - `delete-only': delete the region; the return value is undefined. -- `bounds': return the boundaries of the region as a list of cons - cells of the form (START . END). +- `bounds': return the boundaries of the region as a list of one + or more cons cells of the form (START . END). - anything else: delete the region and return its content - as a string, after filtering it with `filter-buffer-substring', which - is called with METHOD as its 3rd argument.") + as a string (or list of strings for non-contiguous regions), + after filtering it with `filter-buffer-substring', which + is called, for each contiguous sub-region, with METHOD as its + 3rd argument.") (defvar region-insert-function (lambda (lines) commit 520c486d8bc802cbc31da4455c67af4b8bb01d7b Author: Eli Zaretskii Date: Sat Oct 27 13:50:34 2018 +0300 * lisp/simple.el (region-bounds): Doc fix. (Bug#33168) diff --git a/lisp/simple.el b/lisp/simple.el index ba39a49a44..0e5dadc81f 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -5489,8 +5489,10 @@ also checks the value of `use-empty-active-region'." (progn (cl-assert (mark)) t))) (defun region-bounds () - "Return the boundaries of the region as a pair of positions. -Value is a list of cons cells of the form (START . END)." + "Return the boundaries of the region. +Value is a list of one or more cons cells of the form (START . END). +It will have more than one cons cell when the region is non-contiguous, +see `region-noncontiguous-p' and `extract-rectangle-bounds'." (funcall region-extract-function 'bounds)) (defun region-noncontiguous-p () commit 9193db08dea945eb18790f9f9381b9e6317f13fd Author: Eli Zaretskii Date: Sat Oct 27 13:18:33 2018 +0300 Improve documentation of 'process-connection-type' * doc/lispref/processes.texi (Asynchronous Processes): Clarify better when it is advisable to use pipes for communicating with subprocesses. (Bug#33050) diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 34426f339c..0868912b14 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -590,8 +590,8 @@ communication is only partially asynchronous: Emacs sends data to the process only when certain functions are called, and Emacs accepts data from the process only while waiting for input or for a time delay. -@cindex pty -@cindex pipe +@cindex pty, when to use for subprocess communications +@cindex pipe, when to use for subprocess communications An asynchronous process is controlled either via a @dfn{pty} (pseudo-terminal) or a @dfn{pipe}. The choice of pty or pipe is made when creating the process, by default based on the value of the @@ -601,11 +601,13 @@ Shell mode, because they allow for job control (@kbd{C-c}, @kbd{C-z}, etc.)@: between the process and its children, and because interactive programs treat ptys as terminal devices, whereas pipes don't support these features. However, for subprocesses used by Lisp programs for -internal purposes, it is often better to use a pipe, because pipes are +internal purposes (i.e., with no user interaction), where significant +amounts of data need to be exchanged between the subprocess and the +Lisp program, it is often better to use a pipe, because pipes are more efficient, and because they are immune to stray character injections that ptys introduce for large (around 500 byte) messages. -Also, the total number of ptys is limited on many systems and it is -good not to waste them. +Also, the total number of ptys is limited on many systems, and it is +good not to waste them unnecessarily. @defun make-process &rest args This function is the basic low-level primitive for starting @@ -658,7 +660,9 @@ pipe, or @code{nil} to use the default derived from the value of the @code{process-connection-type} variable. This parameter and the value of @code{process-connection-type} are ignored if a non-@code{nil} value is specified for the @code{:stderr} parameter; in that case, the -type will always be @code{pipe}. +type will always be @code{pipe}. On systems where ptys are not +available (MS-Windows), this parameter is likewise ignored, and pipes +are used unconditionally. @item :noquery @var{query-flag} Initialize the process query flag to @var{query-flag}. @@ -863,7 +867,8 @@ around the call to these functions. Note that the value of this variable is ignored when @code{make-process} is called with a non-@code{nil} value of the @code{:stderr} parameter; in that case, Emacs will communicate with -the process using pipes. +the process using pipes. It is also ignored if ptys are unavailable +(MS-Windows). @smallexample @group commit 106b9e138fff3a68cbfa09422441af74cdd0355a Author: Pierre TĂ©choueyres Date: Sun Oct 14 17:49:12 2018 +0200 Unify prompt for gnupg passphrase between GNU/Linux and MS-Windows. * lisp/epg.el (epg--start): Use 'raw-text' for coding system instead of 'binary', in order to avoid spurious carriage return on Microsoft Windows and MS-DOS when prompting for a password. (Bug#33040) diff --git a/lisp/epg.el b/lisp/epg.el index dc0e2df583..87b51b284e 100644 --- a/lisp/epg.el +++ b/lisp/epg.el @@ -657,7 +657,7 @@ callback data (if any)." :command (cons (epg-context-program context) args) :connection-type 'pipe - :coding '(binary . binary) + :coding 'raw-text :filter #'epg--process-filter :stderr error-process :noquery t))) commit 2fdae77eb6489a25a94f1d88a740a9672617d451 Author: Eli Zaretskii Date: Sat Oct 27 12:23:21 2018 +0300 ; * etc/NEWS: Fix last change. diff --git a/etc/NEWS b/etc/NEWS index be32ac6b9b..7a81c2503e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -120,10 +120,11 @@ the new version of the file again.) * Changes in Emacs 27.1 +++ -** emacsclient uses EMACS_SOCKET_NAME if --socket-name is not set. -The behavior is identical to the EMACS_SERVER_FILE, in that the -command line value will override the environment, and the natural -default to TMPDIR, then /tmp, continues to apply. +** emacsclient now supports the 'EMACS_SOCKET_NAME' environment variable. +The behavior is identical to 'EMACS_SERVER_FILE', in that the +command-line value specified via '--socket-name' will override the +environment, and the natural default to TMPDIR, then '/tmp', continues +to apply. +++ ** The function 'read-passwd' uses '*' as default character to hide passwords. commit 3e81e9a0e7742197354515f3d3ea55fdb201eb29 Author: Daniel Pittman Date: Wed Sep 5 09:44:58 2018 -0400 Add support in emacsclient for EMACS_SOCKET_NAME If the '--socket-name' argument is unspecified, the environment variable 'EMACS_SOCKET_NAME' is now consulted with the same semantics. This mirrors the behavior of the '--server-file' argument, and allows for easier configuration of emacsclient when the socket is in a location other than 'TMPDIR' or '/tmp'. * emacsclient.c (set_socket): Add support for the EMACS_SOCKET_NAME environment variable. (Bug#33095) * misc.texi (emacsclient Options): * emacsclient.1: Document the EMACS_SOCKET_NAME environment variable. * etc/NEWS: Announce the new feature. Copyright-paperwork-exempt: yes diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 236cb07785..ab33cafb8e 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -1966,6 +1966,10 @@ is given by the variable @code{server-name} on the Emacs server. If this option is omitted, @command{emacsclient} connects to the first server it finds. (This option is not supported on MS-Windows.) +Alternatively, you can set the @env{EMACS_SOCKET_NAME} environment +variable to point to the server socket. (The command-line option +overrides the environment variable.) + @item -t @itemx --tty @itemx -nw diff --git a/doc/man/emacsclient.1 b/doc/man/emacsclient.1 index 5aaa6d1f08..24ca1c9a46 100644 --- a/doc/man/emacsclient.1 +++ b/doc/man/emacsclient.1 @@ -94,6 +94,7 @@ open a new Emacs frame on the current terminal .TP .B \-s, \-\-socket-name=FILENAME use socket named FILENAME for communication. +This can also be specified via the EMACS_SOCKET_NAME environment variable. .TP .B \-V, \-\-version print version information and exit diff --git a/etc/NEWS b/etc/NEWS index 2249aa48ab..be32ac6b9b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -119,6 +119,12 @@ the new version of the file again.) * Changes in Emacs 27.1 ++++ +** emacsclient uses EMACS_SOCKET_NAME if --socket-name is not set. +The behavior is identical to the EMACS_SERVER_FILE, in that the +command line value will override the environment, and the natural +default to TMPDIR, then /tmp, continues to apply. + +++ ** The function 'read-passwd' uses '*' as default character to hide passwords. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 4fe3a588b1..42b8dd6227 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -1409,6 +1409,9 @@ set_socket (int no_exit_if_error) #ifndef NO_SOCKETS_IN_FILE_SYSTEM /* Explicit --socket-name argument. */ + if (!socket_name) + socket_name = egetenv ("EMACS_SOCKET_NAME"); + if (socket_name) { s = set_local_socket (socket_name); commit 2a416161b2dd33018a01511ac475e8ede4555ed8 Author: Eli Zaretskii Date: Sat Oct 27 12:14:35 2018 +0300 Doc fix of 'gnus-fetch-old-headers' * lisp/gnus/gnus-sum.el (gnus-fetch-old-headers): Avoid treating 'some' and 'invisible' as symbols that need to be hyperlinked. Reported by Robert Pluim . (Bug#33090) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 2391bd497c..c101130ef4 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -83,12 +83,12 @@ If an unread article in the group refers to an older, already read (or just marked as read) article, the old article will not normally be displayed in the Summary buffer. If this variable is t, Gnus will attempt to grab the headers to the old articles, and -thereby build complete threads. If it has the value `some', all -old headers will be fetched but only enough headers to connect +thereby build complete threads. If the value is the symbol `some', +all old headers will be fetched but only enough headers to connect otherwise loose threads will be displayed. This variable can also be a number. In that case, no more than that number of old -headers will be fetched. If it has the value `invisible', all -old headers will be fetched, but none will be displayed. +headers will be fetched. If the value is the symbol `invisible', +all old headers will be fetched, but none will be displayed. The server has to support NOV for any of this to work. commit 29a76443c9dccb33c9eb59b3cee323557a4254be Author: Eric Abrahamsen Date: Thu Oct 18 11:32:47 2018 -0700 Deactivate incorrect hyperlinking in gnus-build-sparse-threads doc * lisp/gnus/gnus-sum.el (gnus-build-sparse-threads): Add the word "symbol" so it doesn't link to the `some' function. (Bug#33090) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index a39af45e92..2391bd497c 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -203,9 +203,10 @@ Useful functions to put in this list include: (defcustom gnus-build-sparse-threads nil "If non-nil, fill in the gaps in threads. -If `some', only fill in the gaps that are needed to tie loose threads -together. If `more', fill in all leaf nodes that Gnus can find. If -non-nil and non-`some', fill in all gaps that Gnus manages to guess." +If set to the symbol `some', only fill in the gaps that are +needed to tie loose threads together. If the symbol `more', fill +in all leaf nodes that Gnus can find. If t (or any other value), +fill in all gaps that Gnus manages to guess." :group 'gnus-thread :type '(choice (const :tag "off" nil) (const some) commit 53ae90f4930f20f1dbe7e1e64ed585a45e9c169c Author: Eli Zaretskii Date: Sat Oct 27 11:40:33 2018 +0300 Minor copyedits in cmdargs.texi * doc/emacs/cmdargs.texi (Initial Options): Document '-nsl'. Add a cross-reference to "Writing Dynamic Modules". diff --git a/doc/emacs/cmdargs.texi b/doc/emacs/cmdargs.texi index f0dd9fffa8..2e2767ccad 100644 --- a/doc/emacs/cmdargs.texi +++ b/doc/emacs/cmdargs.texi @@ -305,6 +305,8 @@ not disable loading @file{site-start.el}. @item --no-site-file @opindex --no-site-file +@itemx -nsl +@opindex -nsl @cindex @file{site-start.el} file, not loading Do not load @file{site-start.el} (@pxref{Init File}). The @samp{-Q} option does this too, but other options like @samp{-q} do not. @@ -379,6 +381,8 @@ Enable expensive correctness checks when dealing with dynamically loadable modules. This is intended for module authors that wish to verify that their module conforms to the module API requirements. The option makes Emacs abort if a module-related assertion triggers. +@xref{Writing Dynamic Modules,, Writing Dynamically-Loaded Modules, +elisp, The GNU Emacs Lisp Reference Manual}. @end table @node Command Example commit fc2e65ae82d70bb343a7f8b3165f238c13c4e587 Author: Eli Zaretskii Date: Sat Oct 27 11:24:53 2018 +0300 Improve documentation of X resource loading * doc/emacs/cmdargs.texi (Initial Options): * doc/emacs/frames.texi (Frame Parameters): * doc/emacs/xresources.texi (Resources): Document the '--no-x-resources' command-line option and the fact that X resources override .emacs settings of frame parameters. (Bug#32975) diff --git a/doc/emacs/cmdargs.texi b/doc/emacs/cmdargs.texi index 733919a374..f0dd9fffa8 100644 --- a/doc/emacs/cmdargs.texi +++ b/doc/emacs/cmdargs.texi @@ -323,14 +323,20 @@ Do not display a startup screen. You can also achieve this effect by setting the variable @code{inhibit-startup-screen} to non-@code{nil} in your initialization file (@pxref{Entering Emacs}). +@item --no-x-resources +@opindex --no-x-resources +@cindex X resources, not loading +Do not load X resources. You can also achieve this effect by setting +the variable @code{inhibit-x-resources} to @code{t} in your +initialization file (@pxref{Resources}). + @item -Q @opindex -Q @itemx --quick @opindex --quick -Start Emacs with minimum customizations. This is similar to using @samp{-q}, -@samp{--no-site-file}, @samp{--no-site-lisp}, and @samp{--no-splash} -together. This also stops Emacs from processing X resources by -setting @code{inhibit-x-resources} to @code{t} (@pxref{Resources}). +Start Emacs with minimum customizations. This is similar to using +@samp{-q}, @samp{--no-site-file}, @samp{--no-site-lisp}, +@samp{--no-x-resources}, and @samp{--no-splash} together.. @item -daemon @opindex -daemon diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi index 9f4c7821e9..6bbaae24b1 100644 --- a/doc/emacs/frames.texi +++ b/doc/emacs/frames.texi @@ -934,6 +934,10 @@ the initial frame, by customizing the variable specify colors and fonts don't affect menus and the menu bar, since those are drawn by the toolkit and not directly by Emacs. + Frame appearance and behavior can also be customized through X +resources (@pxref{X Resources}); these override the parameters of the +initial frame specified in your init file. + Note that if you are using the desktop library to save and restore your sessions, the frames to be restored are recorded in the desktop file, together with their parameters. When these frames are restored, diff --git a/doc/emacs/xresources.texi b/doc/emacs/xresources.texi index db2c6ffafd..903090f51a 100644 --- a/doc/emacs/xresources.texi +++ b/doc/emacs/xresources.texi @@ -46,6 +46,11 @@ this file do not take effect immediately, because the X server stores its own list of resources; to update it, use the command @command{xrdb}---for instance, @samp{xrdb ~/.Xdefaults}. + Settings specified via X resources in general override the +equivalent settings in Emacs init files (@pxref{Init File}), in +particular for parameters of the initial frame (@pxref{Frame +Parameters}). + @cindex registry, setting resources (MS-Windows) (MS-Windows systems do not support X resource files; on such systems, Emacs looks for X resources in the Windows Registry, first under the commit 13132b39932af0139451b9cd77a313c7a023b18e Author: Michael Albinus Date: Sat Oct 27 09:22:18 2018 +0200 * lisp/net/tramp-sh.el (tramp-inline-compress-commands): Suppress warnings about obsolete environment variable GZIP. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 3f83697c6b..c304fcb7aa 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -4436,7 +4436,8 @@ means discard it)." (if (stringp output) (concat " >" output) "")))) (defconst tramp-inline-compress-commands - '(("gzip" "gzip -d") + '(;; Suppress warnings about obsolete environment variable GZIP. + ("env GZIP= gzip" "env GZIP= gzip -d") ("bzip2" "bzip2 -d") ("xz" "xz -d") ("compress" "compress -d")) commit 8361292fec233ac59a04743bddff6b89a3460f65 Author: Michael Albinus Date: Sat Oct 27 09:21:53 2018 +0200 ; Fix sorting in admin/MAINTAINERS diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS index 1a4157ac53..cbf84d55df 100644 --- a/admin/MAINTAINERS +++ b/admin/MAINTAINERS @@ -210,8 +210,8 @@ Paul Eggert Michael Albinus src/inotify.c lisp/autorevert.el - lisp/files.el (file-name-non-special) lisp/eshell/em-tramp.el + lisp/files.el (file-name-non-special) lisp/net/ange-ftp.el lisp/notifications.el lisp/shadowfile.el commit 8fffac14b19d375f774b835ea33ef8989300125d Author: Federico Tedin Date: Fri Oct 26 13:16:50 2018 -0400 Subject: (mouse-drag-and-drop-region): Simplify and remove assumptions * lisp/mouse.el (mouse-drag-and-drop-region): Use insert-for-yank for insertion, remove rectangular-region-specific variables. Use text-property-not-all. * lisp/rect.el (rectangle-dimensions): New function. (rectangle-position-as-coordinates): Use the usual 1-origin for lines. diff --git a/lisp/mouse.el b/lisp/mouse.el index 44cca4c868..7efe751ab6 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -2413,16 +2413,13 @@ is copied instead of being cut." (buffer (current-buffer)) (window (selected-window)) (text-from-read-only buffer-read-only) - ;; Use multiple overlays to cover cases where the region is - ;; rectangular. + ;; Use multiple overlays to cover cases where the region has more + ;; than one boundary. (mouse-drag-and-drop-overlays (mapcar (lambda (bounds) (make-overlay (car bounds) (cdr bounds))) (region-bounds))) (region-noncontiguous (region-noncontiguous-p)) - (region-width (- (overlay-end (car mouse-drag-and-drop-overlays)) - (overlay-start (car mouse-drag-and-drop-overlays)))) - (region-height (length mouse-drag-and-drop-overlays)) point-to-paste point-to-paste-read-only window-to-paste @@ -2467,10 +2464,6 @@ is copied instead of being cut." ;; skipped, value-selection remains nil. (unless value-selection (setq value-selection (funcall region-extract-function nil)) - ;; Remove yank-handler property in order to re-insert text using - ;; the `insert-rectangle' function later on. - (remove-text-properties 0 (length value-selection) - '(yank-handler) value-selection) (when mouse-drag-and-drop-region-show-tooltip (let ((text-size mouse-drag-and-drop-region-show-tooltip)) (setq text-tooltip @@ -2485,15 +2478,11 @@ is copied instead of being cut." ;; Check if selected text is read-only. (setq text-from-read-only (or text-from-read-only - (get-text-property start 'read-only) - (get-text-property end 'read-only) (catch 'loop - (dolist (bound (region-bounds)) - (unless (equal - (next-single-char-property-change - (car bound) 'read-only nil (cdr bound)) - (cdr bound)) - (throw 'loop t))))))) + (dolist (bound (region-bounds)) + (when (text-property-not-all + (car bound) (cdr bound) 'read-only nil) + (throw 'loop t))))))) (setq window-to-paste (posn-window (event-end event))) (setq point-to-paste (posn-point (event-end event))) @@ -2531,16 +2520,16 @@ is copied instead of being cut." (and (eq (overlay-buffer (car mouse-drag-and-drop-overlays)) buffer-to-paste) (if region-noncontiguous - (let ((size (cons region-width region-height)) + (let ((dimensions (rectangle-dimensions start end)) (start-coordinates (rectangle-position-as-coordinates start)) (point-to-paste-coordinates (rectangle-position-as-coordinates point-to-paste))) (and (rectangle-intersect-p - start-coordinates size - point-to-paste-coordinates size) - (not (<= (car point-to-paste-coordinates) + start-coordinates dimensions + point-to-paste-coordinates dimensions) + (not (< (car point-to-paste-coordinates) (car start-coordinates))))) (and (<= (overlay-start (car mouse-drag-and-drop-overlays)) @@ -2635,10 +2624,7 @@ is copied instead of being cut." (setq window-exempt window-to-paste) (goto-char point-to-paste) (push-mark) - - (if region-noncontiguous - (insert-rectangle (split-string value-selection "\n")) - (insert value-selection)) + (insert-for-yank value-selection) ;; On success, set the text as region on destination buffer. (when (not (equal (mark) (point))) diff --git a/lisp/rect.el b/lisp/rect.el index 48db4ffd8f..6b6906ac89 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -170,21 +170,19 @@ The final point after the last operation will be returned." (defun rectangle-position-as-coordinates (position) "Return cons of the column and line values of POSITION. POSITION specifies a position of the current buffer. The value -returned is a cons of the current column of POSITION and its line -number." +returned has the form (COLUMN . LINE)." (save-excursion (goto-char position) (let ((col (current-column)) - (line (1- (line-number-at-pos)))) + (line (line-number-at-pos))) (cons col line)))) (defun rectangle-intersect-p (pos1 size1 pos2 size2) "Return non-nil if two rectangles intersect. POS1 and POS2 specify the positions of the upper-left corners of -the first and second rectangle as conses of their column and line -values. SIZE1 and SIZE2 specify the dimensions of the first and -second rectangle, as conses of their width and height measured in -columns and lines." +the first and second rectangles as conses of the form (COLUMN . LINE). +SIZE1 and SIZE2 specify the dimensions of the first and second +rectangles, as conses of the form (WIDTH . HEIGHT)." (let ((x1 (car pos1)) (y1 (cdr pos1)) (x2 (car pos2)) @@ -198,6 +196,16 @@ columns and lines." (<= (+ y1 h1) y2) (<= (+ y2 h2) y1))))) +(defun rectangle-dimensions (start end) + "Return the dimensions of the rectangle with corners at START +and END. The returned value has the form of (WIDTH . HEIGHT)." + (save-excursion + (let* ((height (1+ (abs (- (line-number-at-pos end) + (line-number-at-pos start))))) + (cols (rectangle--pos-cols start end)) + (width (abs (- (cdr cols) (car cols))))) + (cons width height)))) + (defun delete-rectangle-line (startcol endcol fill) (when (= (move-to-column startcol (if fill t 'coerce)) startcol) (delete-region (point) commit f172ceda8aa5011c1ab79d812f2374a1dbe7a3ef Author: Stefan Monnier Date: Fri Oct 26 13:04:31 2018 -0400 * lisp/files.el (abbreviate-file-name): Avoid save-match-data Also, don't assume homedir doesn't contain special regexp chars. And prefer \` ... \' over ^ ... $. (recover-file): Use user-error. diff --git a/lisp/files.el b/lisp/files.el index b8f6c46146..ad032832ec 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1918,12 +1918,13 @@ started Emacs, set `abbreviated-home-dir' to nil so it will be recalculated)." (unless abbreviated-home-dir (put 'abbreviated-home-dir 'home (expand-file-name "~")) (setq abbreviated-home-dir - (let ((abbreviated-home-dir "$foo")) - (setq abbreviated-home-dir + (let* ((abbreviated-home-dir "\\`\\'.") ;Impossible regexp. + (regexp (concat "\\`" - (abbreviate-file-name - (get 'abbreviated-home-dir 'home)) - "\\(/\\|\\'\\)")) + (regexp-quote + (abbreviate-file-name + (get 'abbreviated-home-dir 'home))) + "\\(/\\|\\'\\)"))) ;; Depending on whether default-directory does or ;; doesn't include non-ASCII characters, the value ;; of abbreviated-home-dir could be multibyte or @@ -1931,9 +1932,9 @@ started Emacs, set `abbreviated-home-dir' to nil so it will be recalculated)." ;; it. Note that this function is called for the ;; first time (from startup.el) when ;; locale-coding-system is already set up. - (if (multibyte-string-p abbreviated-home-dir) - abbreviated-home-dir - (decode-coding-string abbreviated-home-dir + (if (multibyte-string-p regexp) + regexp + (decode-coding-string regexp (if (eq system-type 'windows-nt) 'utf-8 locale-coding-system)))))) @@ -1946,22 +1947,22 @@ started Emacs, set `abbreviated-home-dir' to nil so it will be recalculated)." ;; is likely temporary (eg for testing). ;; FIXME Is it even worth caching abbreviated-home-dir? ;; Ref: https://debbugs.gnu.org/19657#20 - (if (and (string-match abbreviated-home-dir filename) - ;; If the home dir is just /, don't change it. - (not (and (= (match-end 0) 1) - (= (aref filename 0) ?/))) - ;; MS-DOS root directories can come with a drive letter; - ;; Novell Netware allows drive letters beyond `Z:'. - (not (and (memq system-type '(ms-dos windows-nt cygwin)) - (save-match-data - (string-match "^[a-zA-`]:/$" filename)))) - (equal (get 'abbreviated-home-dir 'home) - (save-match-data (expand-file-name "~")))) - (setq filename - (concat "~" - (match-string 1 filename) - (substring filename (match-end 0))))) - filename))) + (let (mb1) + (if (and (string-match abbreviated-home-dir filename) + (setq mb1 (match-beginning 1)) + ;; If the home dir is just /, don't change it. + (not (and (= (match-end 0) 1) + (= (aref filename 0) ?/))) + ;; MS-DOS root directories can come with a drive letter; + ;; Novell Netware allows drive letters beyond `Z:'. + (not (and (memq system-type '(ms-dos windows-nt cygwin)) + (string-match "\\`[a-zA-`]:/\\'" filename))) + (equal (get 'abbreviated-home-dir 'home) + (expand-file-name "~"))) + (setq filename + (concat "~" + (substring filename mb1)))) + filename)))) (defun find-buffer-visiting (filename &optional predicate) "Return the buffer visiting file FILENAME (a string). @@ -2323,9 +2324,9 @@ Do you want to revisit the file normally now? ") ;; If they fail too, set error. (setq error t))))) ;; Record the file's truename, and maybe use that as visited name. - (if (equal filename buffer-file-name) - (setq buffer-file-truename truename) - (setq buffer-file-truename + (setq buffer-file-truename + (if (equal filename buffer-file-name) + truename (abbreviate-file-name (file-truename buffer-file-name)))) (setq buffer-file-number number) (if find-file-visit-truename @@ -4010,6 +4011,8 @@ those in the first." (dolist (f (list file-2 file-1)) (when (and f (file-readable-p f) + ;; FIXME: Aren't file-regular-p and + ;; file-directory-p mutually exclusive? (file-regular-p f) (not (file-directory-p f))) (push f out))) @@ -6014,7 +6017,7 @@ an auto-save file." (interactive "FRecover file: ") (setq file (expand-file-name file)) (if (auto-save-file-name-p (file-name-nondirectory file)) - (error "%s is an auto-save file" (abbreviate-file-name file))) + (user-error "%s is an auto-save file" (abbreviate-file-name file))) (let ((file-name (let ((buffer-file-name file)) (make-auto-save-file-name)))) (cond ((and (file-exists-p file) @@ -6024,8 +6027,8 @@ an auto-save file." ((if (file-exists-p file) (not (file-newer-than-file-p file-name file)) (not (file-exists-p file-name))) - (error "Auto-save file %s not current" - (abbreviate-file-name file-name))) + (user-error "Auto-save file %s not current" + (abbreviate-file-name file-name))) ((with-temp-buffer-window "*Directory*" nil #'(lambda (window _value) commit d404bb5beeec6ccfef583dbb9c43e3d043df31cf Author: Glenn Morris Date: Thu Oct 25 22:08:12 2018 -0700 ; * admin/automerge: Tweak previous NEWS fix diff --git a/admin/automerge b/admin/automerge index b320369d17..8bf981744b 100755 --- a/admin/automerge +++ b/admin/automerge @@ -176,8 +176,8 @@ merge ## FIXME it would be better to trap this in gitmerge. ## NEWS should never be modified, only eg NEWS.26. -git diff --stat --cached origin/master | grep -q "NEWS " && \ - die "NEWS has been modified" +git diff --stat --cached origin/master | grep -q "etc/NEWS " && \ + die "etc/NEWS has been modified" [ "$build" ] || exit 0 commit 3575dd8e8c7edaa904220e5f59240b91814b5564 Author: Glenn Morris Date: Thu Oct 25 21:57:53 2018 -0700 * admin/automerge: Abort if NEWS gets modified. diff --git a/admin/automerge b/admin/automerge index e88711f8d6..b320369d17 100755 --- a/admin/automerge +++ b/admin/automerge @@ -174,6 +174,12 @@ merge () merge +## FIXME it would be better to trap this in gitmerge. +## NEWS should never be modified, only eg NEWS.26. +git diff --stat --cached origin/master | grep -q "NEWS " && \ + die "NEWS has been modified" + + [ "$build" ] || exit 0 commit 92de44fa1fdeda74a9b8254f968829df4c957da0 Author: Noam Postavsky Date: Sat Mar 17 21:14:11 2018 -0400 Don't error when indenting malformed Lisp (Bug#30891) * lisp/emacs-lisp/lisp-mode.el (lisp-indent-calc-next): If we run out of indent stack, reset the parse state. diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 205c810b97..13ad06e4ae 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -827,6 +827,10 @@ by more than one line to cross a string literal." (prog1 (let (indent) (cond ((= (forward-line 1) 1) nil) + ;; Negative depth, probably some kind of syntax error. + ((null indent-stack) + ;; Reset state. + (setq ppss (parse-partial-sexp (point) (point)))) ((car indent-stack)) ((integerp (setq indent (calculate-lisp-indent ppss))) (setf (car indent-stack) indent)) commit c3adbc88a00f2c8fa773d46bfcf4571c9ebde8fb Author: Charles A. Roelli Date: Thu Oct 25 21:01:53 2018 +0200 Improve 'isearch-delete-char' documentation (Bug#32990) * doc/emacs/search.texi (Basic Isearch): Index 'isearch-delete-char', its keybinding and the isearch "input item" concept, and define the latter. (Error in Isearch): Clarify the different uses of DEL and C-M-w during isearch. * lisp/isearch.el (isearch-delete-char): Correct its documentation and link to the Info node '(emacs)Basic Isearch' which explains less technically how this function works in everyday usage. diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index 053603e54f..58a76580d7 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -99,10 +99,18 @@ text that matches the search string---using the @code{isearch} face that customize this highlighting. The current search string is also displayed in the echo area. - If you make a mistake typing the search string, type @key{DEL}. -Each @key{DEL} cancels the last character of the search string. -@xref{Error in Isearch}, for more about dealing with unsuccessful -search. +@cindex isearch input item +@cindex input item, isearch +@findex isearch-delete-char +@kindex DEL @r{(Incremental search)} + If you make a mistake typing the search string, type @key{DEL} +(@code{isearch-delete-char}). Each @key{DEL} cancels the last input +item entered during the search. Emacs records a new @dfn{input item} +whenever you type a command that changes the search string, the +position of point, the success or failure of the search, the direction +of the search, the position of the other end of the current search +result, or the ``wrappedness'' of the search. @xref{Error in +Isearch}, for more about dealing with unsuccessful search. @cindex exit incremental search @cindex incremental search, exiting @@ -283,14 +291,15 @@ string that failed to match is highlighted using the face @code{isearch-fail}. At this point, there are several things you can do. If your string -was mistyped, you can use @key{DEL} to erase some of it and correct -it, or you can type @kbd{M-e} and edit it. If you like the place you -have found, you can type @key{RET} to remain there. Or you can type -@kbd{C-g}, which removes from the search string the characters that -could not be found (the @samp{T} in @samp{FOOT}), leaving those that -were found (the @samp{FOO} in @samp{FOOT}). A second @kbd{C-g} at -that point cancels the search entirely, returning point to where it -was when the search started. +was mistyped, use @key{DEL} to cancel a previous input item +(@pxref{Basic Isearch}), @kbd{C-M-w} to erase one character at a time, +or @kbd{M-e} to edit it. If you like the place you have found, you +can type @key{RET} to remain there. Or you can type @kbd{C-g}, which +removes from the search string the characters that could not be found +(the @samp{T} in @samp{FOOT}), leaving those that were found (the +@samp{FOO} in @samp{FOOT}). A second @kbd{C-g} at that point cancels +the search entirely, returning point to where it was when the search +started. @cindex quitting (in search) @kindex C-g @r{(Incremental search)} diff --git a/lisp/isearch.el b/lisp/isearch.el index 31571e11cd..b180e63d8e 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -1956,11 +1956,14 @@ and reads its face argument using `hi-lock-read-face-name'." (defun isearch-delete-char () - "Discard last input item and move point back. -Last input means the last character or the last isearch command -that added or deleted characters from the search string, -moved point, toggled regexp mode or case-sensitivity, etc. -If no previous match was done, just beep." + "Undo last input item during a search. + +An input item is the result of a command that pushes a new state +of isearch (as recorded by the `isearch--state' structure) to +`isearch-cmds'. Info node `(emacs)Basic Isearch' explains when +Emacs records a new input item. + +If no input items have been entered yet, just beep." (interactive) (if (null (cdr isearch-cmds)) (ding) commit 6ca71ceb687d238f6bdfd483e32b5c6d54bf6d1a Author: Charles A. Roelli Date: Thu Oct 25 20:40:49 2018 +0200 ; * lisp/help.el (with-help-window): Remove extra space in doc. diff --git a/lisp/help.el b/lisp/help.el index 77e3284831..f496214394 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1377,7 +1377,7 @@ puts the buffer specified by BUFFER-OR-NAME in `help-mode' and displays a message about how to delete the help window when it's no longer needed. The help window will be selected if `help-window-select' is non-nil. -Most of this is done by `help-window-setup', which see." +Most of this is done by `help-window-setup', which see." (declare (indent 1) (debug t)) `(progn ;; Make `help-window-point-marker' point nowhere. The only place commit 9dd95bf0b12c8ddba82acae741f944743e37cdd8 Author: Stefan Monnier Date: Thu Oct 25 11:19:05 2018 -0400 * lisp/emacs-lisp/pcase.el (pcase--u1): Fix bignums Use 'eql' to compare integers diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 4a69244d26..57c2d6c3cb 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -870,7 +870,8 @@ Otherwise, it defers to REST which is a list of branches of the form (else-rest (cdr splitrest))) (pcase--if (cond ((null val) `(null ,sym)) - ((or (integerp val) (symbolp val)) + ((integerp val) `(eql ,sym ,val)) + ((symbolp val) (if (pcase--self-quoting-p val) `(eq ,sym ,val) `(eq ,sym ',val))) commit f5f95838bdac9a88ccc00886c6d59d9d5ac73647 Author: Alan Third Date: Wed Oct 24 12:15:16 2018 +0100 Improve XPM load failure message (bug#33126) * src/image.c (xpm_load_image): Only XPM3 is supported, so make that explicit. diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 7dfafe04de..29f87e2eaf 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -2616,6 +2616,13 @@ please call support for your X-server and see if you can get a fix. If you do, please send it to bug-gnu-emacs@gnu.org so we can list it here. +* Runtime problems specific to macOS + +** macOS doesn't come with libxpm, so only XPM3 is supported. + +Libxpm is available for macOS as part of the XQuartz project. + + * Build-time problems ** Configuration diff --git a/src/image.c b/src/image.c index 767979e63b..a6b2d9060b 100644 --- a/src/image.c +++ b/src/image.c @@ -4308,7 +4308,7 @@ xpm_load_image (struct frame *f, return 1; failure: - image_error ("Invalid XPM file (%s)", img->spec); + image_error ("Invalid XPM3 file (%s)", img->spec); x_destroy_x_image (ximg); x_destroy_x_image (mask_img); x_clear_image (f, img); commit f3d01d465398afee11c584a559c6842f575f5a03 Author: Eli Zaretskii Date: Thu Oct 25 17:57:34 2018 +0300 Avoid infloop in CPerl mode fontification * lisp/progmodes/cperl-mode.el (cperl-font-lock-fontify-region-function): Stop the loop at EOB, to avoid inflooping there. (Bug#33114) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 6dbdba75de..b152b9c724 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -8884,7 +8884,7 @@ do extra unwind via `cperl-unwind-to-safe'." (goto-char new-beg))) (setq beg (point)) (goto-char end) - (while (and end + (while (and end (< end (point-max)) (progn (or (bolp) (condition-case nil (forward-line 1) commit 71a2d509f9d2350c6aacfeed24e1e9d8c7fdfebe Author: Andreas Schwab Date: Thu Oct 25 10:55:53 2018 +0200 Fix minibuffer-help-form for lexical binding * lisp/simple.el (set-variable): Substitute var into minibuffer-help-form. * lisp/cus-edit.el (custom-prompt-variable): Likewise. diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 3ede483dad..33efdd9253 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -917,7 +917,7 @@ the current value of the variable, otherwise `symbol-value' is used. If optional COMMENT argument is non-nil, also prompt for a comment and return it as the third element in the list." (let* ((var (read-variable prompt-var)) - (minibuffer-help-form '(describe-variable var)) + (minibuffer-help-form `(describe-variable ',var)) (val (let ((prop (get var 'variable-interactive)) (type (get var 'custom-type)) diff --git a/lisp/simple.el b/lisp/simple.el index 8bbafe49d3..ba39a49a44 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -7930,7 +7930,7 @@ With a prefix argument, set VARIABLE to VALUE buffer-locally." (read-variable (format "Set variable (default %s): " default-var) default-var) (read-variable "Set variable: "))) - (minibuffer-help-form '(describe-variable var)) + (minibuffer-help-form `(describe-variable ',var)) (prop (get var 'variable-interactive)) (obsolete (car (get var 'byte-obsolete-variable))) (prompt (format "Set %s %s to value: " var commit f1f1687fcd8d48cd519c0f2977bcecbf394a7f01 Author: Michael Albinus Date: Wed Oct 24 20:56:40 2018 +0200 Fix Bug#33141 * lisp/net/tramp.el (tramp-make-tramp-file-name): Avoid check for empty method with simplified `tramp-syntax'. (Bug#33141) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index ec8e54509d..15b5a4958c 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -269,4 +269,7 @@ A nil value for either argument stands for the current time." ;;; TODO: +;; * When we get rid of Emacs 24, replace "(mapconcat 'identity" by +;; "(string-join". + ;;; tramp-compat.el ends here diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 2e6cdf999a..a1246659d8 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1439,7 +1439,9 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)." localname (nth 5 args) hop (nth 6 args)))) - (when (zerop (length method)) + ;; Unless `tramp-syntax' is `simplified', we need a method. + (when (and (not (zerop (length tramp-postfix-method-format))) + (zerop (length method))) (signal 'wrong-type-argument (list 'stringp method))) (concat tramp-prefix-format hop (unless (zerop (length tramp-postfix-method-format)) commit 129ffc2761bc977dc859e7065668cdd997fb4ef7 Author: Glenn Morris Date: Wed Oct 24 13:20:01 2018 -0400 * admin/gitmerge.el (gitmerge-resolve): Check NEWS patch exit status. diff --git a/admin/gitmerge.el b/admin/gitmerge.el index a123e0352d..6dedee8dd1 100644 --- a/admin/gitmerge.el +++ b/admin/gitmerge.el @@ -275,6 +275,9 @@ should not be skipped." (setq found (cdr skip)))) found)) +(defvar change-log-start-entry-re) ; in add-log, which defines change-log-mode +(declare-function add-log-iso8601-time-string "add-log" ()) + (defun gitmerge-resolve (file) "Try to resolve conflicts in FILE with smerge. Returns non-nil if conflicts remain." @@ -323,6 +326,9 @@ Returns non-nil if conflicts remain." ;; Try to resolve the conflicts. (let (temp) (cond + ;; FIXME when merging release branch to master, we still + ;; need to detect and handle the case where NEWS was modified + ;; without a conflict. We should abort if NEWS gets changed. ((and (equal file "etc/NEWS") (ignore-errors (setq temp @@ -332,18 +338,21 @@ Returns non-nil if conflicts remain." (or noninteractive (y-or-n-p "Try to fix NEWS conflict? "))) (let ((relfile (file-name-nondirectory file)) - (tempfile (make-temp-file "gitmerge"))) - (unwind-protect + (patchfile (concat temp "-gitmerge.patch"))) + (call-process "git" nil `(:file ,patchfile) nil "diff" + (format ":1:%s" file) + (format ":3:%s" file)) + (if (eq 0 (call-process "patch" patchfile nil nil temp)) (progn - (call-process "git" nil `(:file ,tempfile) nil "diff" - (format ":1:%s" file) - (format ":3:%s" file)) + ;; We intentionally use a non-temporary name for this + ;; file, and only delete it if applied successfully. + (delete-file patchfile) + (call-process "git" nil t nil "add" "--" temp) (call-process "git" nil t nil "reset" "--" relfile) (call-process "git" nil t nil "checkout" "--" relfile) - (revert-buffer nil 'noconfirm) - (call-process "patch" tempfile nil nil temp) - (call-process "git" nil t nil "add" "--" temp)) - (delete-file tempfile)))) + (revert-buffer nil 'noconfirm)) + ;; The conflict markers remain so we return non-nil. + (message "Failed to fix NEWS conflict")))) ;; Generated files. ((member file '("lisp/ldefs-boot.el")) ;; We are in the file's buffer, so names are relative. commit 7e8eee60a9dbb0c59cf26f237b21efe7fd1043c9 Author: Alan Third Date: Sun Oct 14 19:12:00 2018 +0100 Fix some NS drawing issues (bug#32932) * src/nsterm.m (ns_clip_to_rect): (ns_reset_clipping): Remove gsaved variable and associated code. (ns_flush_display): Remove function. (ns_copy_bits): use translateRectsNeedingDisplayInRect:by: to copy any pending drawing actions along with the image. ([EmacsView windowWillResize:toSize:]): Remove unneeded call. ([EmacsView drawRect:]): Remove redundant call to ns_clear_frame_area, and optimize the exposed rectangles. (ns_draw_window_cursor): Remove unneeded disabling of screen updates. diff --git a/src/nsterm.m b/src/nsterm.m index 8c355a89f8..4b5d025ee3 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -277,7 +277,6 @@ - (NSColor *)colorUsingDefaultColorSpace /* display update */ static int ns_window_num = 0; -static BOOL gsaved = NO; static BOOL ns_fake_keydown = NO; #ifdef NS_IMPL_COCOA static BOOL ns_menu_bar_is_hidden = NO; @@ -1180,7 +1179,6 @@ static NSRect constrain_frame_rect(NSRect frameRect, bool isFullscreen) NSRectClipList (r, 2); else NSRectClip (*r); - gsaved = YES; return YES; } @@ -1204,11 +1202,7 @@ static NSRect constrain_frame_rect(NSRect frameRect, bool isFullscreen) { NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_reset_clipping"); - if (gsaved) - { - [[NSGraphicsContext currentContext] restoreGraphicsState]; - gsaved = NO; - } + [[NSGraphicsContext currentContext] restoreGraphicsState]; } @@ -1234,19 +1228,6 @@ static NSRect constrain_frame_rect(NSRect frameRect, bool isFullscreen) return ns_clip_to_rect (f, &clip_rect, 1); } - -static void -ns_flush_display (struct frame *f) -/* Force the frame to redisplay. If areas have previously been marked - dirty by setNeedsDisplayInRect (in ns_clip_to_rect), then this will call - draw_rect: which will "expose" those areas. */ -{ - block_input (); - [FRAME_NS_VIEW (f) displayIfNeeded]; - unblock_input (); -} - - /* ========================================================================== Visible bell and beep. @@ -2710,6 +2691,8 @@ so some key presses (TAB) are swallowed by the system. */ static void ns_copy_bits (struct frame *f, NSRect src, NSRect dest) { + NSSize delta = NSMakeSize (dest.origin.x - src.origin.x, + dest.origin.y - src.origin.y) NSTRACE ("ns_copy_bits"); if (FRAME_NS_VIEW (f)) @@ -2718,10 +2701,21 @@ so some key presses (TAB) are swallowed by the system. */ /* FIXME: scrollRect:by: is deprecated in macOS 10.14. There is no obvious replacement so we may have to come up with our own. */ - [FRAME_NS_VIEW (f) scrollRect: src - by: NSMakeSize (dest.origin.x - src.origin.x, - dest.origin.y - src.origin.y)]; - [FRAME_NS_VIEW (f) setNeedsDisplay:YES]; + [FRAME_NS_VIEW (f) scrollRect: src by: delta]; + +#ifdef NS_IMPL_COCOA + /* As far as I can tell from the documentation, scrollRect:by:, + above, should copy the dirty rectangles from our source + rectangle to our destination, however it appears it clips the + operation to src. As a result we need to use + translateRectsNeedingDisplayInRect:by: below, and we have to + union src and dest so it can pick up the dirty rectangles, + and place them, as it also clips to the rectangle. + + FIXME: We need a GNUstep equivalent. */ + [FRAME_NS_VIEW (f) translateRectsNeedingDisplayInRect:NSUnionRect (src, dest) + by:delta]; +#endif } } @@ -3106,15 +3100,6 @@ Note that CURSOR_WIDTH is meaningful only for (h)bar cursors. else [FRAME_CURSOR_COLOR (f) set]; -#ifdef NS_IMPL_COCOA - /* TODO: This makes drawing of cursor plus that of phys_cursor_glyph - atomic. Cleaner ways of doing this should be investigated. - One way would be to set a global variable DRAWING_CURSOR - when making the call to draw_phys..(), don't focus in that - case, then move the ns_reset_clipping() here after that call. */ - NSDisableScreenUpdates (); -#endif - switch (cursor_type) { case DEFAULT_CURSOR: @@ -3148,10 +3133,6 @@ Note that CURSOR_WIDTH is meaningful only for (h)bar cursors. /* draw the character under the cursor */ if (cursor_type != NO_CURSOR) draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); - -#ifdef NS_IMPL_COCOA - NSEnableScreenUpdates (); -#endif } } @@ -4977,7 +4958,7 @@ static Lisp_Object ns_string_to_lispmod (const char *s) ns_after_update_window_line, ns_update_window_begin, ns_update_window_end, - ns_flush_display, /* flush_display */ + 0, /* flush_display */ x_clear_window_mouse_face, x_get_glyph_overhangs, x_fix_overlapping_area, @@ -7046,7 +7027,6 @@ - (NSSize)windowWillResize: (NSWindow *)sender toSize: (NSSize)frameSize size_title = xmalloc (strlen (old_title) + 40); esprintf (size_title, "%s — (%d x %d)", old_title, cols, rows); [window setTitle: [NSString stringWithUTF8String: size_title]]; - [window display]; xfree (size_title); } } @@ -8095,8 +8075,8 @@ - (instancetype)toggleToolbar: (id)sender - (void)drawRect: (NSRect)rect { - int x = NSMinX (rect), y = NSMinY (rect); - int width = NSWidth (rect), height = NSHeight (rect); + const NSRect *rectList; + NSInteger numRects; NSTRACE ("[EmacsView drawRect:" NSTRACE_FMT_RECT "]", NSTRACE_ARG_RECT(rect)); @@ -8104,9 +8084,23 @@ - (void)drawRect: (NSRect)rect if (!emacsframe || !emacsframe->output_data.ns) return; - ns_clear_frame_area (emacsframe, x, y, width, height); block_input (); - expose_frame (emacsframe, x, y, width, height); + + /* Get only the precise dirty rectangles to avoid redrawing + potentially large areas of the frame that haven't changed. + + I'm not sure this actually provides much of a performance benefit + as it's hard to benchmark, but it certainly doesn't seem to + hurt. */ + [self getRectsBeingDrawn:&rectList count:&numRects]; + for (int i = 0 ; i < numRects ; i++) + { + NSRect r = rectList[i]; + expose_frame (emacsframe, + NSMinX (r), NSMinY (r), + NSWidth (r), NSHeight (r)); + } + unblock_input (); /* commit d72975a654e5effe86625126ba7f2923c8e2f9d2 Author: Katsumi Yamaoka Date: Wed Oct 24 10:09:51 2018 +0000 * lisp/gnus/mm-util.el (mm-decompress-buffer): Fix split-string args. diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index fcd97f2b27..91c5f0e907 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -843,7 +843,8 @@ decompressed data. The buffer's multibyteness must be turned off." (prog2 (insert-file-contents err-file) (buffer-string) - (erase-buffer)) t) + (erase-buffer)) + nil t) " ") "\n") (setq err-msg commit c97a5f1f44a6ae3eb7729d32aa53c9b27e899716 Author: Noam Postavsky Date: Tue Oct 23 21:46:01 2018 -0400 * doc/misc/calc.texi (Summary): The +/- key is 'p', not 'P'. diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index fdec65a9a7..28dadc94c0 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi @@ -35832,7 +35832,7 @@ keystrokes are not listed in this summary. @r{ @: _ @:number @: @:-@:number} @r{ @: e @:number @: @:@:1e number} @r{ @: # @:number @: @:@:current-radix@tfn{#}number} -@r{ @: P @:(in number) @: @:+/-@:} +@r{ @: p @:(in number) @: @:+/-@:} @r{ @: M @:(in number) @: @:mod@:} @r{ @: @@ ' " @: (in number)@: @:@:HMS form} @r{ @: h m s @: (in number)@: @:@:HMS form} commit 00027ff9d0f646662458bdb47cc7e2214f439698 Author: Glenn Morris Date: Tue Oct 23 09:59:30 2018 -0700 ; NEWS merge fixes diff --git a/etc/NEWS b/etc/NEWS index ce849e4990..2249aa48ab 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -21,12 +21,6 @@ Temporary note: --- means no change in the manuals is needed. When you add a new item, use the appropriate mark if you are sure it applies, -+++ -** Installing Emacs now installs the emacs-module.h file. -The emacs-module.h file is now installed in the system-wide include -directory as part of the Emacs installation. This allows to build -Emacs modules outside of the Emacs source tree. - * Installation Changes in Emacs 27.1 @@ -72,9 +66,6 @@ to reduce differences between developer and production builds. This means you can now easily filter several major modes, as well as a single mode. ---- -*** New toggle 'ibuffer-do-toggle-lock', bound to 'L'. - ** Gnus +++ @@ -131,11 +122,6 @@ the new version of the file again.) +++ ** The function 'read-passwd' uses '*' as default character to hide passwords. ---- -** New variable 'xft-ignore-color-fonts'. -Default t means don't try to load color fonts when using Xft, as they -often cause crashes. Set it to nil if you really need those fonts. - --- ** The new option 'tooltip-resize-echo-area' avoids truncating tooltip text on GUI frames when tooltips are displayed in the echo area. Instead, @@ -966,14 +952,6 @@ default-directory-alist, dired-default-directory, dired-default-directory-alist, dired-enable-local-variables, dired-hack-local-variables, dired-local-variables-file, dired-omit-here-always. -** The function 'display-buffer-in-major-side-window' no longer exists. -It has been renamed as internal function 'window--make-major-side-window', -however applications should instead call 'display-buffer-in-side-window' -(passing the SIDE and SLOT parameters as elements of ALIST). This approach -is backwards-compatible with versions of Emacs in which the old function -exists. See the node "Displaying Buffers in Side Windows" in the ELisp -manual for more details. - ** garbage collection no longer treats miscellaneous objects specially; they are now allocated like any other pseudovector. As a result, the 'garbage-collect' and 'memory-use-count' functions no longer return a diff --git a/etc/NEWS.26 b/etc/NEWS.26 index 94bb45c6fe..dfafe7c5c9 100644 --- a/etc/NEWS.26 +++ b/etc/NEWS.26 @@ -25,18 +25,37 @@ webkit2gtk-4.0 package; version 2.12 or later is required. (This change was actually made in Emacs 26.1, but was not called out in its NEWS.) ++++ +** Installing Emacs now installs the emacs-module.h file. +The emacs-module.h file is now installed in the system-wide include +directory as part of the Emacs installation. This allows to build +Emacs modules outside of the Emacs source tree. + * Startup Changes in Emacs 26.2 * Changes in Emacs 26.2 +--- +** Emacs is now compliant with the latest version 11.0 of the Unicode Standard. + +--- +** New variable 'xft-ignore-color-fonts'. +Default t means don't try to load color fonts when using Xft, as they +often cause crashes. Set it to nil if you really need those fonts. + * Editing Changes in Emacs 26.2 * Changes in Specialized Modes and Packages in Emacs 26.2 +** Ibuffer + +--- +*** New toggle 'ibuffer-do-toggle-lock', bound to 'L'. + ** Imenu --- @@ -123,6 +142,25 @@ remove 'buffer-switch' from the list of events in * Lisp Changes in Emacs 26.2 ++++ +** The new function 'read-answer' accepts either long or short answers +depending on the new customizable variable 'read-answer-short'. + ++++ +** New function 'assoc-delete-all'. +Like 'assq-delete-all', but uses 'equal' for comparison. + +--- +** The function 'thing-at-point' behaves as before Emacs 26.1. +The behavior of 'thing-at-point' when called with argument 'list' has +changed in Emacs 26.1, in that it didn't consider text inside comments +and strings as a potential list. This change is now reverted, and +'thing-at-point' behaves like it did before Emacs 26.1. + +To cater to use cases where comments and strings are to be ignored +when looking for a list, the function 'list-at-point' now takes an +optional argument to do so. + * Changes in Emacs 26.2 on Non-Free Operating Systems @@ -1391,6 +1429,13 @@ passphrases, but it was also removed from other pinentry programs as the attack is unrealistic on modern computer systems which don't utilize swap memory usually. +** The function 'display-buffer-in-major-side-window' no longer exists. +It has been renamed as internal function 'window--make-major-side-window', +however applications should instead call 'display-buffer-in-side-window' +(passing the SIDE and SLOT parameters as elements of ALIST). This approach +is backwards-compatible with versions of Emacs in which the old function +exists. See the node "Displaying Buffers in Side Windows" in the ELisp +manual for more details. * Lisp Changes in Emacs 26.1 commit 5aa41f775e1e69dba7c6f2b2a8d0334ca9c2cfdb Merge: 5c5bed72a6 2efd40076c Author: Glenn Morris Date: Tue Oct 23 09:39:11 2018 -0700 Merge from origin/emacs-26 2efd400 (origin/emacs-26) Correct typo in GNU ELPA url 6239016 * doc/misc/dired-x.texi (Omitting Variables): Fix wording. (B... 1531bca Fix help-form binding in dired-create-files cf79327 Fix a pasto in a Gnus doc string a4e40f6 ; * doc/emacs/files.texi (Reverting): Improve wording in last... f632ecb Update revert-buffer documentation eb67689 * lisp/mail/smtpmail.el (smtpmail-send-queued-mail): Load fil... 433e364 ; * etc/NEWS: Announce that emacs-module.h is now installed. # Conflicts: # lisp/mail/smtpmail.el commit 5c5bed72a6b2963a28443f70c8c5c8e510b81f26 Merge: 3ce5a6fc36 e456ddaa30 Author: Glenn Morris Date: Tue Oct 23 09:32:58 2018 -0700 ; Merge from origin/emacs-26 The following commits were skipped: e456dda Tweak Makefile emacs-module.h handling 1dce1b2 Install emacs-module.h (Bug#31929) commit 3ce5a6fc36df6e7c590520a1cc64dda948fddf6f Author: Alan Mackenzie Date: Tue Oct 23 13:28:19 2018 +0000 edebug.el: Move window focus switch into edebug-pop-to-buffer * lisp/emacs-lisp/follow.el (edebug-focus-frame): Remove. (edebug-pop-to-buffer): Call x-focus-frame for GUI frames. (edebug-default-enter, edebug--display-1): Replace call to edebug-focus-frame with x-focus-frame. (edebug-where, edebug-bounce-point, edebug-visit-eval-list): Remove no longer needed calls to edebug-focus-frame. diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index ce4ed687be..15f68a62ac 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -342,12 +342,6 @@ Return the result of the last expression in BODY." (defconst edebug-trace-buffer "*edebug-trace*" "Name of the buffer to put trace info in.") -(defun edebug-focus-frame (frame) - "Switch focus to frame FRAME, if we're in a GUI. -Otherwise, do nothing." - (unless (memq (framep frame) '(nil t pc)) - (x-focus-frame frame))) - (defun edebug-pop-to-buffer (buffer &optional window) ;; Like pop-to-buffer, but select window where BUFFER was last shown. ;; Select WINDOW if it is provided and still exists. Otherwise, @@ -379,6 +373,8 @@ Otherwise, do nothing." (t (split-window (minibuffer-selected-window))))) (set-window-buffer window buffer) (select-window window) + (unless (memq (framep (selected-frame)) '(nil t pc)) + (x-focus-frame (selected-frame))) (set-window-hscroll window 0)) ;; should this be?? (defun edebug-get-displayed-buffer-points () @@ -2346,8 +2342,9 @@ and run its entry function, and set up `edebug-before' and edebug-execution-mode) edebug-next-execution-mode nil) (edebug-default-enter function args body)) - (if (frame-live-p outside-frame) - (edebug-focus-frame outside-frame)))) + (if (and (frame-live-p outside-frame) + (not (memq (framep outside-frame) '(nil t pc)))) + (x-focus-frame outside-frame)))) (let* ((edebug-data (get function 'edebug)) (edebug-def-mark (car edebug-data)) ; mark at def start @@ -2656,7 +2653,8 @@ See `edebug-behavior-alist' for implementations.") (edebug-eval-display eval-result-list) ;; The evaluation list better not have deleted edebug-window-data. (select-window (car edebug-window-data)) - (edebug-focus-frame (window-frame (selected-window))) + (if (not (memq (framep (selected-frame)) '(nil t pc))) + (x-focus-frame (selected-frame))) (set-buffer edebug-buffer) (setq edebug-buffer-outside-point (point)) @@ -3027,7 +3025,6 @@ Otherwise, toggle for all windows." ;;(if edebug-inside-windows ;; (edebug-set-windows edebug-inside-windows)) (edebug-pop-to-buffer edebug-buffer) - (edebug-focus-frame (window-frame (selected-window))) (goto-char edebug-point)) (defun edebug-view-outside () @@ -3055,15 +3052,13 @@ before returning. The default is one second." ;; If the buffer's currently displayed, avoid set-window-configuration. (save-window-excursion (edebug-pop-to-buffer edebug-outside-buffer) - (edebug-focus-frame (window-frame (selected-window))) (goto-char edebug-outside-point) (message "Current buffer: %s Point: %s Mark: %s" (current-buffer) (point) (if (marker-buffer (edebug-mark-marker)) (marker-position (edebug-mark-marker)) "")) (sit-for arg) - (edebug-pop-to-buffer edebug-buffer (car edebug-window-data)) - (edebug-focus-frame (window-frame (selected-window)))))) + (edebug-pop-to-buffer edebug-buffer (car edebug-window-data))))) ;; Joe Wells, here is a start at your idea of adding a buffer to the internal @@ -3885,8 +3880,7 @@ May only be called from within `edebug--recursive-edit'." "Switch to the evaluation list buffer \"*edebug*\"." (interactive) (edebug-eval-redisplay) - (edebug-pop-to-buffer edebug-eval-buffer) - (edebug-focus-frame (window-frame (selected-window)))) + (edebug-pop-to-buffer edebug-eval-buffer)) (defun edebug-update-eval-list () commit 2efd40076c8977aaf54d7478db96e5dbf623f37d Author: Robert Pluim Date: Tue Oct 23 12:19:19 2018 +0200 Correct typo in GNU ELPA url * doc/misc/efaq.texi (Packages that do not come with Emacs): Correct typo in GNU ELPA url (Bug#33072). Change other url references to use https scheme. diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index 8bdd40c71c..4f42de9c42 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -3506,7 +3506,7 @@ see @ref{Packages that do not come with Emacs}. The easiest way to add more features to your Emacs is to use the command @kbd{M-x list-packages}. This contacts the -@uref{https:///elpa.gnu.org, GNU ELPA} (``Emacs Lisp Package Archive'') +@uref{https://elpa.gnu.org, GNU ELPA} (``Emacs Lisp Package Archive'') server and fetches the list of additional packages that it offers. These are GNU packages that are available for use with Emacs, but are distributed separately from Emacs itself, for reasons of space, etc. @@ -3515,8 +3515,8 @@ available, and then Emacs can automatically download and install the packages that you select. @xref{Packages,,, emacs, The GNU Emacs Manual}. There are other, non-GNU, Emacs Lisp package servers, including: -@uref{http://melpa.org/, MELPA}; and -@uref{https://marmalade-repo.org/, Marmalade}. To use additional +@uref{https://melpa.org, MELPA}; and +@uref{https://marmalade-repo.org, Marmalade}. To use additional package servers, customize the @code{package-archives} variable. Be aware that installing a package can run arbitrary code, so only add sources that you trust. @@ -3527,8 +3527,8 @@ GNU Emacs sources mailing list}, which is gatewayed to the connection between the two can be unreliable) is an official place where people can post or announce their extensions to Emacs. -The @uref{http://emacswiki.org, Emacs Wiki} contains pointers to some -additional extensions. @uref{http://wikemacs.org, WikEmacs} is an +The @uref{https://emacswiki.org, Emacs Wiki} contains pointers to some +additional extensions. @uref{https://wikemacs.org, WikEmacs} is an alternative wiki for Emacs. @uref{http://www.damtp.cam.ac.uk/user/sje30/emacs/ell.html, The Emacs commit a38128561757c82fbd088cba379b7a253558c7f1 Author: Paul Eggert Date: Mon Oct 22 19:31:15 2018 -0700 Improve rounding in recent timer fix * lisp/emacs-lisp/timer.el (timer-next-integral-multiple-of-time): Use more-precise arithmetic to handle some boundary cases better when rounding errors occur (Bug#33071). * test/lisp/emacs-lisp/timer-tests.el: (timer-next-integral-multiple-of-time-3): New test, to test one of the boundary cases. (timer-next-integral-multiple-of-time-2): Redo so as to not assume a particular way of rounding 0.01. diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el index e140738d9f..56323c85c2 100644 --- a/lisp/emacs-lisp/timer.el +++ b/lisp/emacs-lisp/timer.el @@ -100,10 +100,16 @@ of SECS seconds since the epoch. SECS may be a fraction." (integerp (cdr time)) (< 0 (cdr time))) time (encode-time time 1000000000000))) + (ticks (car ticks-hz)) (hz (cdr ticks-hz)) - (s-ticks (round (* secs hz))) - (more-ticks (+ (car ticks-hz) s-ticks))) - (encode-time (cons (- more-ticks (% more-ticks s-ticks)) hz)))) + trunc-s-ticks) + (while (let ((s-ticks (* secs hz))) + (setq trunc-s-ticks (truncate s-ticks)) + (/= s-ticks trunc-s-ticks)) + (setq ticks (ash ticks 1)) + (setq hz (ash hz 1))) + (let ((more-ticks (+ ticks trunc-s-ticks))) + (encode-time (cons (- more-ticks (% more-ticks trunc-s-ticks)) hz))))) (defun timer-relative-time (time secs &optional usecs psecs) "Advance TIME by SECS seconds and optionally USECS microseconds diff --git a/test/lisp/emacs-lisp/timer-tests.el b/test/lisp/emacs-lisp/timer-tests.el index 7a5b9263b0..e463b9e98b 100644 --- a/test/lisp/emacs-lisp/timer-tests.el +++ b/test/lisp/emacs-lisp/timer-tests.el @@ -47,9 +47,21 @@ (ert-deftest timer-next-integral-multiple-of-time-2 () "Test bug#33071." (let* ((tc (current-time)) - (tce (encode-time tc 100)) - (nt (timer-next-integral-multiple-of-time tc 0.01)) - (nte (encode-time nt 100))) - (should (= (car nte) (1+ (car tce)))))) + (delta-ticks 1000) + (hz 128000) + (tce (encode-time tc hz)) + (tc+delta (time-add tce (cons delta-ticks hz))) + (tc+deltae (encode-time tc+delta hz)) + (tc+delta-ticks (car tc+deltae)) + (tc-nexte (cons (- tc+delta-ticks (% tc+delta-ticks delta-ticks)) hz)) + (nt (timer-next-integral-multiple-of-time + tc (/ (float delta-ticks) hz))) + (nte (encode-time nt hz))) + (should (equal tc-nexte nte)))) + +(ert-deftest timer-next-integral-multiple-of-time-3 () + "Test bug#33071." + (let ((nt (timer-next-integral-multiple-of-time '(32770 . 65539) 0.5))) + (should (time-equal-p 1 nt)))) ;;; timer-tests.el ends here commit 8602bd855904acc1966f1a94a008f91bb3f88c18 Author: Paul Eggert Date: Mon Oct 22 10:54:45 2018 -0700 Fix epg bug with (TICKS . HZ) timestamp Problem reported by Joseph Mingrone in: https://lists.gnu.org/r/emacs-devel/2018-10/msg00380.html * lisp/epg.el (epg--time-from-seconds): Just use a seconds count; don’t generate an obsolete-format timestamp. diff --git a/lisp/epg.el b/lisp/epg.el index 8f26cd34ee..9d9bc9051d 100644 --- a/lisp/epg.el +++ b/lisp/epg.el @@ -946,10 +946,7 @@ callback data (if any)." (cons (cons 'no-seckey string) (epg-context-result-for context 'error)))) -(defun epg--time-from-seconds (seconds) - (let ((number-seconds (string-to-number (concat seconds ".0")))) - (cons (floor (/ number-seconds 65536)) - (floor (mod number-seconds 65536))))) +(defalias 'epg--time-from-seconds #'string-to-number) (defun epg--status-ERRSIG (context string) (if (string-match "\\`\\([^ ]+\\) \\([0-9]+\\) \\([0-9]+\\) \ commit 7d5919e5e73c62735297eb118b913029594bd0ef Author: Stefan Monnier Date: Mon Oct 22 09:50:08 2018 -0400 * src/minibuf.c (read_minibuf_noninteractive): Remove unused args. diff --git a/src/minibuf.c b/src/minibuf.c index 9395dc8df2..2b331c672d 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -181,12 +181,8 @@ string_to_object (Lisp_Object val, Lisp_Object defalt) from read_minibuf to do the job if noninteractive. */ static Lisp_Object -read_minibuf_noninteractive (Lisp_Object map, Lisp_Object initial, - Lisp_Object prompt, Lisp_Object backup_n, - bool expflag, - Lisp_Object histvar, Lisp_Object histpos, - Lisp_Object defalt, - bool allow_props, bool inherit_input_method) +read_minibuf_noninteractive (Lisp_Object prompt, bool expflag, + Lisp_Object defalt) { ptrdiff_t size, len; char *line; @@ -430,10 +426,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, || (IS_DAEMON && DAEMON_RUNNING)) && NILP (Vexecuting_kbd_macro)) { - val = read_minibuf_noninteractive (map, initial, prompt, - make_fixnum (pos), - expflag, histvar, histpos, defalt, - allow_props, inherit_input_method); + val = read_minibuf_noninteractive (prompt, expflag, defalt); return unbind_to (count, val); } commit 1d2b386ec4dcd8a5844fae3173ba454a51999a56 Author: Michael Albinus Date: Mon Oct 22 09:05:48 2018 +0200 Improve Tramp backward compatibility * lisp/net/tramp-compat.el: (tramp-unload-file-name-handlers): Declare it, for backward compatibility. diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index c3777e6e73..ec8e54509d 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -29,6 +29,11 @@ ;;; Code: +;; In Emacs 24 and 25, `tramp-unload-file-name-handlers' is not +;; autoloaded. So we declare it here in order to avoid recursive +;; load. This will be overwritten in tramp.el. +(defun tramp-unload-file-name-handlers ()) + (require 'auth-source) (require 'advice) (require 'cl-lib) commit 6239016ca68ebf283f41c24e1828d35ad4e1cda5 Author: Eli Zaretskii Date: Mon Oct 22 08:47:18 2018 +0300 * doc/misc/dired-x.texi (Omitting Variables): Fix wording. (Bug#33112) diff --git a/doc/misc/dired-x.texi b/doc/misc/dired-x.texi index 60915e2996..4f843a04de 100644 --- a/doc/misc/dired-x.texi +++ b/doc/misc/dired-x.texi @@ -322,8 +322,8 @@ Default: @code{nil} @cindex How to make omitting the default in Dired If non-@code{nil}, ``uninteresting'' files are not listed. -Uninteresting files are those whose files whose names match regexp -@code{dired-omit-files}, plus those ending with extensions in +Uninteresting files are files whose names match regexp +@code{dired-omit-files}, plus files whose names end with extension in @code{dired-omit-extensions}. @kbd{C-x M-o} (@code{dired-omit-mode}) toggles its value, which is buffer-local. Put commit 969b561972527b0471f9d1b29e0190e978ad8bc1 Author: Glenn Morris Date: Sun Oct 21 17:40:13 2018 -0400 ; Auto-commit of loaddefs files. diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 5ff089812b..9a1f572c11 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -7469,7 +7469,7 @@ You can also switch between context diff and unified diff with \\[diff-context-> or vice versa with \\[diff-unified->context] and you can also reverse the direction of a diff with \\[diff-reverse-direction]. - \\{diff-mode-map} +\\{diff-mode-map} \(fn)" t nil) @@ -13804,6 +13804,8 @@ Interactively, reads the register using `register-read-with-preview'. ;;;### (autoloads nil "fringe" "fringe.el" (0 0 0 0)) ;;; Generated autoloads from fringe.el +(unless (fboundp 'define-fringe-bitmap) (defun define-fringe-bitmap (_bitmap _bits &optional _height _width _align) "Define fringe bitmap BITMAP from BITS of size HEIGHT x WIDTH.\nBITMAP is a symbol identifying the new fringe bitmap.\nBITS is either a string or a vector of integers.\nHEIGHT is height of bitmap. If HEIGHT is nil, use length of BITS.\nWIDTH must be an integer between 1 and 16, or nil which defaults to 8.\nOptional fifth arg ALIGN may be one of â€top’, â€center’, or â€bottom’,\nindicating the positioning of the bitmap relative to the rows where it\nis used; the default is to center the bitmap. Fifth arg may also be a\nlist (ALIGN PERIODIC) where PERIODIC non-nil specifies that the bitmap\nshould be repeated.\nIf BITMAP already exists, the existing definition is replaced.")) + (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "fringe" '("fringe-" "set-fringe-"))) ;;;*** @@ -13908,7 +13910,7 @@ detailed description of this mode. \(fn COMMAND-LINE)" t nil) -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gdb-mi" '("breakpoint-" "def-gdb-" "gdb" "gud-" "nil"))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gdb-mi" '("breakpoint" "def-gdb-" "gdb" "gud-" "hollow-right-triangle" "nil"))) ;;;*** @@ -23452,6 +23454,12 @@ Many aspects this mode can be customized using ;;;### (autoloads nil "octave" "progmodes/octave.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/octave.el + (add-to-list 'auto-mode-alist '("\\.m\\'" . octave-maybe-mode)) + +(autoload 'octave-maybe-mode "octave" "\ +Select `octave-mode' if the current buffer seems to hold Octave code. + +\(fn)" nil nil) (autoload 'octave-mode "octave" "\ Major mode for editing Octave code. @@ -24820,6 +24828,16 @@ short description. (defalias 'package-list-packages 'list-packages) +(autoload 'package-get-version "package" "\ +Return the version number of the package in which this is used. +Assumes it is used from an Elisp file placed inside the top-level directory +of an installed ELPA package. +The return value is a string (or nil in case we can't find it). + +\(fn)" nil nil) + +(function-put 'package-get-version 'pure 't) + (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "package" '("bad-signature" "define-package" "describe-package-1" "package-"))) ;;;*** @@ -29063,9 +29081,26 @@ also enable the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'; disable the mode otherwise. When Savehist mode is enabled, minibuffer history is saved -periodically and when exiting Emacs. When Savehist mode is -enabled for the first time in an Emacs session, it loads the -previous minibuffer history from `savehist-file'. +to `savehist-file' periodically and when exiting Emacs. When +Savehist mode is enabled for the first time in an Emacs session, +it loads the previous minibuffer histories from `savehist-file'. +The variable `savehist-autosave-interval' controls the +periodicity of saving minibuffer histories. + +If `savehist-save-minibuffer-history' is non-nil (the default), +all recorded minibuffer histories will be saved. You can arrange +for additional history variables to be saved and restored by +customizing `savehist-additional-variables', which by default is +an empty list. For example, to save the history of commands +invoked via \\[execute-extended-command], add `command-history' to the list in +`savehist-additional-variables'. + +Alternatively, you could customize `savehist-save-minibuffer-history' +to nil, and add to `savehist-additional-variables' only those +history variables you want to save. + +To ignore some history variables, add their symbols to the list +in `savehist-ignored-variables'. This mode should normally be turned on from your Emacs init file. Calling it at any other time replaces your current minibuffer @@ -31015,7 +31050,7 @@ then `snmpv2-mode-hook'. ;;;### (autoloads nil "soap-client" "net/soap-client.el" (0 0 0 0)) ;;; Generated autoloads from net/soap-client.el -(push (purecopy '(soap-client 3 1 4)) package--builtin-versions) +(push (purecopy '(soap-client 3 1 5)) package--builtin-versions) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "soap-client" '("soap-"))) @@ -34139,10 +34174,7 @@ If DATE lacks timezone information, GMT is assumed. (defalias 'time-to-seconds 'float-time) -(autoload 'seconds-to-time "time-date" "\ -Convert SECONDS to a time value. - -\(fn SECONDS)" nil nil) +(defalias 'seconds-to-time 'encode-time) (autoload 'days-to-time "time-date" "\ Convert DAYS into a time value. @@ -34711,14 +34743,14 @@ match file names at root of the underlying local file system, like \"/sys\" or \"/C:\".") (defun tramp-autoload-file-name-handler (operation &rest args) "\ -Load Tramp file name handler, and perform OPERATION." (if tramp-mode (let ((default-directory temporary-file-directory)) (load "tramp" 'noerror 'nomessage)) (tramp-unload-file-name-handlers)) (apply operation args)) +Load Tramp file name handler, and perform OPERATION." (tramp-unload-file-name-handlers) (if tramp-mode (let ((default-directory temporary-file-directory)) (load "tramp" 'noerror 'nomessage))) (apply operation args)) (defun tramp-register-autoload-file-name-handlers nil "\ Add Tramp file name handlers to `file-name-handler-alist' during autoload." (add-to-list 'file-name-handler-alist (cons tramp-autoload-file-name-regexp 'tramp-autoload-file-name-handler)) (put 'tramp-autoload-file-name-handler 'safe-magic t)) (tramp-register-autoload-file-name-handlers) (defun tramp-unload-file-name-handlers nil "\ -Unload Tramp file name handlers from `file-name-handler-alist'." (dolist (fnh '(tramp-file-name-handler tramp-completion-file-name-handler tramp-archive-file-name-handler tramp-autoload-file-name-handler)) (let ((a1 (rassq fnh file-name-handler-alist))) (setq file-name-handler-alist (delq a1 file-name-handler-alist))))) +Unload Tramp file name handlers from `file-name-handler-alist'." (dolist (fnh file-name-handler-alist) (when (and (symbolp (cdr fnh)) (string-prefix-p "tramp-" (symbol-name (cdr fnh)))) (setq file-name-handler-alist (delq fnh file-name-handler-alist))))) (defvar tramp-completion-mode nil "\ If non-nil, external packages signal that they are in file name completion.") @@ -34757,8 +34789,10 @@ It must be supported by libarchive(3).") (defmacro tramp-archive-autoload-file-name-regexp nil "\ Regular expression matching archive file names." `(concat "\\`" "\\(" ".+" "\\." (regexp-opt tramp-archive-suffixes) "\\(?:" "\\." (regexp-opt tramp-archive-compression-suffixes) "\\)*" "\\)" "\\(" "/" ".*" "\\)" "\\'")) +(defalias 'tramp-archive-autoload-file-name-handler 'tramp-autoload-file-name-handler) + (defun tramp-register-archive-file-name-handler nil "\ -Add archive file name handler to `file-name-handler-alist'." (when tramp-archive-enabled (add-to-list 'file-name-handler-alist (cons (tramp-archive-autoload-file-name-regexp) 'tramp-autoload-file-name-handler)) (put 'tramp-archive-file-name-handler 'safe-magic t))) +Add archive file name handler to `file-name-handler-alist'." (when tramp-archive-enabled (add-to-list 'file-name-handler-alist (cons (tramp-archive-autoload-file-name-regexp) 'tramp-archive-autoload-file-name-handler)) (put 'tramp-archive-autoload-file-name-handler 'safe-magic t))) (add-hook 'after-init-hook 'tramp-register-archive-file-name-handler) @@ -36290,6 +36324,7 @@ If NAME is empty, it refers to the latest revisions of the current branch. If locking is used for the files in DIR, then there must not be any locked files at or below DIR (but if NAME is empty, locked files are allowed and simply skipped). +This function runs the hook `vc-retrieve-tag-hook' when finished. \(fn DIR NAME)" t nil) @@ -38895,28 +38930,29 @@ Zone out, completely. ;;;*** ;;;### (autoloads nil nil ("abbrev.el" "bindings.el" "buff-menu.el" -;;;;;; "button.el" "calc/calc-aent.el" "calc/calc-embed.el" "calc/calc-misc.el" -;;;;;; "calc/calc-yank.el" "calendar/cal-loaddefs.el" "calendar/diary-loaddefs.el" -;;;;;; "calendar/hol-loaddefs.el" "case-table.el" "cedet/ede/base.el" -;;;;;; "cedet/ede/config.el" "cedet/ede/cpp-root.el" "cedet/ede/custom.el" -;;;;;; "cedet/ede/dired.el" "cedet/ede/emacs.el" "cedet/ede/files.el" -;;;;;; "cedet/ede/generic.el" "cedet/ede/linux.el" "cedet/ede/locate.el" -;;;;;; "cedet/ede/make.el" "cedet/ede/shell.el" "cedet/ede/speedbar.el" -;;;;;; "cedet/ede/system.el" "cedet/ede/util.el" "cedet/semantic/analyze.el" -;;;;;; "cedet/semantic/analyze/complete.el" "cedet/semantic/analyze/refs.el" -;;;;;; "cedet/semantic/bovine.el" "cedet/semantic/bovine/c-by.el" -;;;;;; "cedet/semantic/bovine/c.el" "cedet/semantic/bovine/el.el" -;;;;;; "cedet/semantic/bovine/gcc.el" "cedet/semantic/bovine/make-by.el" -;;;;;; "cedet/semantic/bovine/make.el" "cedet/semantic/bovine/scm-by.el" -;;;;;; "cedet/semantic/bovine/scm.el" "cedet/semantic/complete.el" -;;;;;; "cedet/semantic/ctxt.el" "cedet/semantic/db-file.el" "cedet/semantic/db-find.el" -;;;;;; "cedet/semantic/db-global.el" "cedet/semantic/db-mode.el" -;;;;;; "cedet/semantic/db-typecache.el" "cedet/semantic/db.el" "cedet/semantic/debug.el" -;;;;;; "cedet/semantic/decorate/include.el" "cedet/semantic/decorate/mode.el" -;;;;;; "cedet/semantic/dep.el" "cedet/semantic/doc.el" "cedet/semantic/edit.el" -;;;;;; "cedet/semantic/find.el" "cedet/semantic/format.el" "cedet/semantic/html.el" -;;;;;; "cedet/semantic/ia-sb.el" "cedet/semantic/ia.el" "cedet/semantic/idle.el" -;;;;;; "cedet/semantic/imenu.el" "cedet/semantic/lex-spp.el" "cedet/semantic/lex.el" +;;;;;; "button.el" "calc/calc-aent.el" "calc/calc-embed.el" "calc/calc-loaddefs.el" +;;;;;; "calc/calc-misc.el" "calc/calc-yank.el" "calendar/cal-loaddefs.el" +;;;;;; "calendar/diary-loaddefs.el" "calendar/hol-loaddefs.el" "case-table.el" +;;;;;; "cedet/ede/base.el" "cedet/ede/config.el" "cedet/ede/cpp-root.el" +;;;;;; "cedet/ede/custom.el" "cedet/ede/dired.el" "cedet/ede/emacs.el" +;;;;;; "cedet/ede/files.el" "cedet/ede/generic.el" "cedet/ede/linux.el" +;;;;;; "cedet/ede/loaddefs.el" "cedet/ede/locate.el" "cedet/ede/make.el" +;;;;;; "cedet/ede/shell.el" "cedet/ede/speedbar.el" "cedet/ede/system.el" +;;;;;; "cedet/ede/util.el" "cedet/semantic/analyze.el" "cedet/semantic/analyze/complete.el" +;;;;;; "cedet/semantic/analyze/refs.el" "cedet/semantic/bovine.el" +;;;;;; "cedet/semantic/bovine/c-by.el" "cedet/semantic/bovine/c.el" +;;;;;; "cedet/semantic/bovine/el.el" "cedet/semantic/bovine/gcc.el" +;;;;;; "cedet/semantic/bovine/make-by.el" "cedet/semantic/bovine/make.el" +;;;;;; "cedet/semantic/bovine/scm-by.el" "cedet/semantic/bovine/scm.el" +;;;;;; "cedet/semantic/complete.el" "cedet/semantic/ctxt.el" "cedet/semantic/db-file.el" +;;;;;; "cedet/semantic/db-find.el" "cedet/semantic/db-global.el" +;;;;;; "cedet/semantic/db-mode.el" "cedet/semantic/db-typecache.el" +;;;;;; "cedet/semantic/db.el" "cedet/semantic/debug.el" "cedet/semantic/decorate/include.el" +;;;;;; "cedet/semantic/decorate/mode.el" "cedet/semantic/dep.el" +;;;;;; "cedet/semantic/doc.el" "cedet/semantic/edit.el" "cedet/semantic/find.el" +;;;;;; "cedet/semantic/format.el" "cedet/semantic/html.el" "cedet/semantic/ia-sb.el" +;;;;;; "cedet/semantic/ia.el" "cedet/semantic/idle.el" "cedet/semantic/imenu.el" +;;;;;; "cedet/semantic/lex-spp.el" "cedet/semantic/lex.el" "cedet/semantic/loaddefs.el" ;;;;;; "cedet/semantic/mru-bookmark.el" "cedet/semantic/scope.el" ;;;;;; "cedet/semantic/senator.el" "cedet/semantic/sort.el" "cedet/semantic/symref.el" ;;;;;; "cedet/semantic/symref/cscope.el" "cedet/semantic/symref/global.el" @@ -38929,36 +38965,39 @@ Zone out, completely. ;;;;;; "cedet/semantic/wisent/python-wy.el" "cedet/semantic/wisent/python.el" ;;;;;; "cedet/srecode/compile.el" "cedet/srecode/cpp.el" "cedet/srecode/document.el" ;;;;;; "cedet/srecode/el.el" "cedet/srecode/expandproto.el" "cedet/srecode/getset.el" -;;;;;; "cedet/srecode/insert.el" "cedet/srecode/java.el" "cedet/srecode/map.el" -;;;;;; "cedet/srecode/mode.el" "cedet/srecode/srt-wy.el" "cedet/srecode/srt.el" -;;;;;; "cedet/srecode/template.el" "cedet/srecode/texi.el" "composite.el" -;;;;;; "cus-face.el" "cus-start.el" "custom.el" "dired-aux.el" "dired-x.el" -;;;;;; "electric.el" "emacs-lisp/backquote.el" "emacs-lisp/byte-run.el" -;;;;;; "emacs-lisp/cl-extra.el" "emacs-lisp/cl-macs.el" "emacs-lisp/cl-preloaded.el" -;;;;;; "emacs-lisp/cl-seq.el" "emacs-lisp/eieio-compat.el" "emacs-lisp/eieio-custom.el" -;;;;;; "emacs-lisp/eieio-opt.el" "emacs-lisp/eldoc.el" "emacs-lisp/float-sup.el" -;;;;;; "emacs-lisp/lisp-mode.el" "emacs-lisp/lisp.el" "emacs-lisp/macroexp.el" -;;;;;; "emacs-lisp/map-ynp.el" "emacs-lisp/nadvice.el" "emacs-lisp/syntax.el" -;;;;;; "emacs-lisp/timer.el" "env.el" "epa-hook.el" "erc/erc-autoaway.el" -;;;;;; "erc/erc-button.el" "erc/erc-capab.el" "erc/erc-compat.el" -;;;;;; "erc/erc-dcc.el" "erc/erc-desktop-notifications.el" "erc/erc-ezbounce.el" -;;;;;; "erc/erc-fill.el" "erc/erc-identd.el" "erc/erc-imenu.el" -;;;;;; "erc/erc-join.el" "erc/erc-list.el" "erc/erc-log.el" "erc/erc-match.el" -;;;;;; "erc/erc-menu.el" "erc/erc-netsplit.el" "erc/erc-notify.el" -;;;;;; "erc/erc-page.el" "erc/erc-pcomplete.el" "erc/erc-replace.el" -;;;;;; "erc/erc-ring.el" "erc/erc-services.el" "erc/erc-sound.el" -;;;;;; "erc/erc-speedbar.el" "erc/erc-spelling.el" "erc/erc-stamp.el" -;;;;;; "erc/erc-track.el" "erc/erc-truncate.el" "erc/erc-xdcc.el" -;;;;;; "eshell/em-alias.el" "eshell/em-banner.el" "eshell/em-basic.el" -;;;;;; "eshell/em-cmpl.el" "eshell/em-dirs.el" "eshell/em-glob.el" -;;;;;; "eshell/em-hist.el" "eshell/em-ls.el" "eshell/em-pred.el" -;;;;;; "eshell/em-prompt.el" "eshell/em-rebind.el" "eshell/em-script.el" -;;;;;; "eshell/em-smart.el" "eshell/em-term.el" "eshell/em-tramp.el" -;;;;;; "eshell/em-unix.el" "eshell/em-xtra.el" "facemenu.el" "faces.el" -;;;;;; "files.el" "font-core.el" "font-lock.el" "format.el" "frame.el" -;;;;;; "help.el" "hfy-cmap.el" "ibuf-ext.el" "indent.el" "international/characters.el" -;;;;;; "international/charprop.el" "international/charscript.el" -;;;;;; "international/cp51932.el" "international/eucjp-ms.el" "international/mule-cmds.el" +;;;;;; "cedet/srecode/insert.el" "cedet/srecode/java.el" "cedet/srecode/loaddefs.el" +;;;;;; "cedet/srecode/map.el" "cedet/srecode/mode.el" "cedet/srecode/srt-wy.el" +;;;;;; "cedet/srecode/srt.el" "cedet/srecode/template.el" "cedet/srecode/texi.el" +;;;;;; "composite.el" "cus-face.el" "cus-start.el" "custom.el" "dired-aux.el" +;;;;;; "dired-loaddefs.el" "dired-x.el" "electric.el" "emacs-lisp/backquote.el" +;;;;;; "emacs-lisp/byte-run.el" "emacs-lisp/cl-extra.el" "emacs-lisp/cl-loaddefs.el" +;;;;;; "emacs-lisp/cl-macs.el" "emacs-lisp/cl-preloaded.el" "emacs-lisp/cl-seq.el" +;;;;;; "emacs-lisp/eieio-compat.el" "emacs-lisp/eieio-custom.el" +;;;;;; "emacs-lisp/eieio-loaddefs.el" "emacs-lisp/eieio-opt.el" +;;;;;; "emacs-lisp/eldoc.el" "emacs-lisp/float-sup.el" "emacs-lisp/lisp-mode.el" +;;;;;; "emacs-lisp/lisp.el" "emacs-lisp/macroexp.el" "emacs-lisp/map-ynp.el" +;;;;;; "emacs-lisp/nadvice.el" "emacs-lisp/syntax.el" "emacs-lisp/timer.el" +;;;;;; "env.el" "epa-hook.el" "erc/erc-autoaway.el" "erc/erc-button.el" +;;;;;; "erc/erc-capab.el" "erc/erc-compat.el" "erc/erc-dcc.el" "erc/erc-desktop-notifications.el" +;;;;;; "erc/erc-ezbounce.el" "erc/erc-fill.el" "erc/erc-identd.el" +;;;;;; "erc/erc-imenu.el" "erc/erc-join.el" "erc/erc-list.el" "erc/erc-loaddefs.el" +;;;;;; "erc/erc-log.el" "erc/erc-match.el" "erc/erc-menu.el" "erc/erc-netsplit.el" +;;;;;; "erc/erc-notify.el" "erc/erc-page.el" "erc/erc-pcomplete.el" +;;;;;; "erc/erc-replace.el" "erc/erc-ring.el" "erc/erc-services.el" +;;;;;; "erc/erc-sound.el" "erc/erc-speedbar.el" "erc/erc-spelling.el" +;;;;;; "erc/erc-stamp.el" "erc/erc-track.el" "erc/erc-truncate.el" +;;;;;; "erc/erc-xdcc.el" "eshell/em-alias.el" "eshell/em-banner.el" +;;;;;; "eshell/em-basic.el" "eshell/em-cmpl.el" "eshell/em-dirs.el" +;;;;;; "eshell/em-glob.el" "eshell/em-hist.el" "eshell/em-ls.el" +;;;;;; "eshell/em-pred.el" "eshell/em-prompt.el" "eshell/em-rebind.el" +;;;;;; "eshell/em-script.el" "eshell/em-smart.el" "eshell/em-term.el" +;;;;;; "eshell/em-tramp.el" "eshell/em-unix.el" "eshell/em-xtra.el" +;;;;;; "eshell/esh-groups.el" "facemenu.el" "faces.el" "files.el" +;;;;;; "font-core.el" "font-lock.el" "format.el" "frame.el" "help.el" +;;;;;; "hfy-cmap.el" "htmlfontify-loaddefs.el" "ibuf-ext.el" "ibuffer-loaddefs.el" +;;;;;; "indent.el" "international/characters.el" "international/charprop.el" +;;;;;; "international/charscript.el" "international/cp51932.el" +;;;;;; "international/eucjp-ms.el" "international/mule-cmds.el" ;;;;;; "international/mule-conf.el" "international/mule.el" "international/uni-bidi.el" ;;;;;; "international/uni-brackets.el" "international/uni-category.el" ;;;;;; "international/uni-combining.el" "international/uni-comment.el" @@ -38994,30 +39033,31 @@ Zone out, completely. ;;;;;; "leim/quail/slovak.el" "leim/quail/symbol-ksc.el" "leim/quail/tamil-dvorak.el" ;;;;;; "leim/quail/tsang-b5.el" "leim/quail/tsang-cns.el" "leim/quail/vntelex.el" ;;;;;; "leim/quail/vnvni.el" "leim/quail/welsh.el" "loadup.el" "mail/blessmail.el" -;;;;;; "mail/rmailedit.el" "mail/rmailkwd.el" "mail/rmailmm.el" -;;;;;; "mail/rmailmsc.el" "mail/rmailsort.el" "mail/rmailsum.el" -;;;;;; "mail/undigest.el" "menu-bar.el" "mh-e/mh-gnus.el" "mh-e/mh-loaddefs.el" -;;;;;; "minibuffer.el" "mouse.el" "net/tramp-loaddefs.el" "newcomment.el" -;;;;;; "obarray.el" "org/ob-core.el" "org/ob-keys.el" "org/ob-lob.el" -;;;;;; "org/ob-matlab.el" "org/ob-tangle.el" "org/ob.el" "org/org-archive.el" -;;;;;; "org/org-attach.el" "org/org-bbdb.el" "org/org-clock.el" -;;;;;; "org/org-datetree.el" "org/org-element.el" "org/org-feed.el" -;;;;;; "org/org-footnote.el" "org/org-id.el" "org/org-indent.el" -;;;;;; "org/org-install.el" "org/org-irc.el" "org/org-mobile.el" -;;;;;; "org/org-plot.el" "org/org-table.el" "org/org-timer.el" "org/ox-ascii.el" -;;;;;; "org/ox-beamer.el" "org/ox-html.el" "org/ox-icalendar.el" -;;;;;; "org/ox-latex.el" "org/ox-man.el" "org/ox-md.el" "org/ox-odt.el" -;;;;;; "org/ox-org.el" "org/ox-publish.el" "org/ox-texinfo.el" "org/ox.el" -;;;;;; "progmodes/elisp-mode.el" "progmodes/prog-mode.el" "ps-def.el" -;;;;;; "ps-mule.el" "register.el" "replace.el" "rfn-eshadow.el" -;;;;;; "select.el" "simple.el" "startup.el" "subdirs.el" "subr.el" -;;;;;; "textmodes/fill.el" "textmodes/page.el" "textmodes/paragraphs.el" -;;;;;; "textmodes/reftex-auc.el" "textmodes/reftex-cite.el" "textmodes/reftex-dcr.el" -;;;;;; "textmodes/reftex-global.el" "textmodes/reftex-index.el" -;;;;;; "textmodes/reftex-parse.el" "textmodes/reftex-ref.el" "textmodes/reftex-sel.el" -;;;;;; "textmodes/reftex-toc.el" "textmodes/text-mode.el" "uniquify.el" -;;;;;; "vc/ediff-hook.el" "vc/vc-hooks.el" "version.el" "widget.el" -;;;;;; "window.el") (0 0 0 0)) +;;;;;; "mail/rmail-loaddefs.el" "mail/rmailedit.el" "mail/rmailkwd.el" +;;;;;; "mail/rmailmm.el" "mail/rmailmsc.el" "mail/rmailsort.el" +;;;;;; "mail/rmailsum.el" "mail/undigest.el" "menu-bar.el" "mh-e/mh-gnus.el" +;;;;;; "mh-e/mh-loaddefs.el" "minibuffer.el" "mouse.el" "net/tramp-loaddefs.el" +;;;;;; "newcomment.el" "obarray.el" "org/ob-core.el" "org/ob-keys.el" +;;;;;; "org/ob-lob.el" "org/ob-matlab.el" "org/ob-tangle.el" "org/ob.el" +;;;;;; "org/org-archive.el" "org/org-attach.el" "org/org-bbdb.el" +;;;;;; "org/org-clock.el" "org/org-datetree.el" "org/org-element.el" +;;;;;; "org/org-feed.el" "org/org-footnote.el" "org/org-id.el" "org/org-indent.el" +;;;;;; "org/org-install.el" "org/org-irc.el" "org/org-loaddefs.el" +;;;;;; "org/org-mobile.el" "org/org-plot.el" "org/org-table.el" +;;;;;; "org/org-timer.el" "org/ox-ascii.el" "org/ox-beamer.el" "org/ox-html.el" +;;;;;; "org/ox-icalendar.el" "org/ox-latex.el" "org/ox-man.el" "org/ox-md.el" +;;;;;; "org/ox-odt.el" "org/ox-org.el" "org/ox-publish.el" "org/ox-texinfo.el" +;;;;;; "org/ox.el" "progmodes/elisp-mode.el" "progmodes/prog-mode.el" +;;;;;; "ps-def.el" "ps-mule.el" "ps-print-loaddefs.el" "register.el" +;;;;;; "replace.el" "rfn-eshadow.el" "select.el" "simple.el" "startup.el" +;;;;;; "subdirs.el" "subr.el" "textmodes/fill.el" "textmodes/page.el" +;;;;;; "textmodes/paragraphs.el" "textmodes/reftex-auc.el" "textmodes/reftex-cite.el" +;;;;;; "textmodes/reftex-dcr.el" "textmodes/reftex-global.el" "textmodes/reftex-index.el" +;;;;;; "textmodes/reftex-loaddefs.el" "textmodes/reftex-parse.el" +;;;;;; "textmodes/reftex-ref.el" "textmodes/reftex-sel.el" "textmodes/reftex-toc.el" +;;;;;; "textmodes/text-mode.el" "uniquify.el" "vc/ediff-hook.el" +;;;;;; "vc/vc-hooks.el" "version.el" "widget.el" "window.el") (0 +;;;;;; 0 0 0)) ;;;*** commit 08192e40093bdbc8e6be6b283935b51c12d66eca Author: Stefan Monnier Date: Sun Oct 21 14:36:10 2018 -0400 Always define 'define-fringe-bitmap' * lisp/cus-start.el: Test 'fringe-bitmaps' to see if fringe.c was compiled. * lisp/fringe.el: Use lexical-binding. (define-fringe-bitmap): Provide a fallback implementation. * lisp/progmodes/flymake.el (flymake-double-exclamation-mark): Define unconditionally. * lisp/progmodes/gdb-mi.el (define-fringe-bitmap): Don't declare any more. (breakpoint, hollow-right-triangle): Define unconditionally. diff --git a/etc/NEWS b/etc/NEWS index be6668ed42..7a98b492f1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -876,6 +876,9 @@ documentation of the new mode and its commands. * Incompatible Lisp Changes in Emacs 27.1 +** define-fringe-bitmap is always defined, even when Emacs is built +without any GUI support. + --- ** Just loading a theme's file no longer activates the theme's settings. Loading a theme with 'M-x load-theme' still activates the theme, as it diff --git a/lisp/cus-start.el b/lisp/cus-start.el index e33fe6e5ec..133e94fcdb 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -685,7 +685,7 @@ since it could result in memory overflow and make Emacs crash." ((string-match "selection" (symbol-name symbol)) (fboundp 'x-selection-exists-p)) ((string-match "fringe" (symbol-name symbol)) - (fboundp 'define-fringe-bitmap)) + (boundp 'fringe-bitmaps)) ((string-match "\\`imagemagick" (symbol-name symbol)) (fboundp 'imagemagick-types)) ((equal "font-use-system-font" (symbol-name symbol)) diff --git a/lisp/fringe.el b/lisp/fringe.el index a806b4e6a1..583a0e2c20 100644 --- a/lisp/fringe.el +++ b/lisp/fringe.el @@ -1,4 +1,4 @@ -;;; fringe.el --- fringe setup and control +;;; fringe.el --- fringe setup and control -*- lexical-binding:t -*- ;; Copyright (C) 2002-2018 Free Software Foundation, Inc. @@ -291,6 +291,24 @@ SIDE must be the symbol `left' or `right'." 0) (float (frame-char-width)))) +;;;###autoload +(unless (fboundp 'define-fringe-bitmap) + (defun define-fringe-bitmap (_bitmap _bits &optional _height _width _align) + "Define fringe bitmap BITMAP from BITS of size HEIGHT x WIDTH. +BITMAP is a symbol identifying the new fringe bitmap. +BITS is either a string or a vector of integers. +HEIGHT is height of bitmap. If HEIGHT is nil, use length of BITS. +WIDTH must be an integer between 1 and 16, or nil which defaults to 8. +Optional fifth arg ALIGN may be one of â€top’, â€center’, or â€bottom’, +indicating the positioning of the bitmap relative to the rows where it +is used; the default is to center the bitmap. Fifth arg may also be a +list (ALIGN PERIODIC) where PERIODIC non-nil specifies that the bitmap +should be repeated. +If BITMAP already exists, the existing definition is replaced." + ;; This is a fallback for non-GUI builds. + ;; The real implementation is in src/fringe.c. + )) + (provide 'fringe) ;;; fringe.el ends here diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 60d1660e5f..5831301a57 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -219,25 +219,24 @@ Specifically, start it when the saved buffer is actually displayed." :version "26.1" :type 'boolean) -(when (fboundp 'define-fringe-bitmap) - (define-fringe-bitmap 'flymake-double-exclamation-mark - (vector #b00000000 - #b00000000 - #b00000000 - #b00000000 - #b01100110 - #b01100110 - #b01100110 - #b01100110 - #b01100110 - #b01100110 - #b01100110 - #b01100110 - #b00000000 - #b01100110 - #b00000000 - #b00000000 - #b00000000))) +(define-fringe-bitmap 'flymake-double-exclamation-mark + (vector #b00000000 + #b00000000 + #b00000000 + #b00000000 + #b01100110 + #b01100110 + #b01100110 + #b01100110 + #b01100110 + #b01100110 + #b01100110 + #b01100110 + #b00000000 + #b01100110 + #b00000000 + #b00000000 + #b00000000)) (defvar-local flymake-timer nil "Timer for starting syntax check.") diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index da979de540..32bdc315a4 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -1741,16 +1741,12 @@ static char *magick[] = { (defvar breakpoint-disabled-icon nil "Icon for disabled breakpoint in display margin.") -(declare-function define-fringe-bitmap "fringe.c" - (bitmap bits &optional height width align)) - -(and (display-images-p) - ;; Bitmap for breakpoint in fringe - (define-fringe-bitmap 'breakpoint - "\x3c\x7e\xff\xff\xff\xff\x7e\x3c") - ;; Bitmap for gud-overlay-arrow in fringe - (define-fringe-bitmap 'hollow-right-triangle - "\xe0\x90\x88\x84\x84\x88\x90\xe0")) +;; Bitmap for breakpoint in fringe +(define-fringe-bitmap 'breakpoint + "\x3c\x7e\xff\xff\xff\xff\x7e\x3c") +;; Bitmap for gud-overlay-arrow in fringe +(define-fringe-bitmap 'hollow-right-triangle + "\xe0\x90\x88\x84\x84\x88\x90\xe0") (defface breakpoint-enabled '((t commit 17252062b03defe9eac6a510e88b87932ef400fe Author: Stefan Monnier Date: Sun Oct 21 11:05:49 2018 -0400 * lisp/vc/diff-mode.el: Improve diff-font-lock-prettify A few tweaks to the previous code for corner case problems, and a new feature, which is to move the +/- signs to the left fringe. (diff--font-lock-cleanup, diff--filter-substring): New functions. (diff-mode): Use them. (diff--font-lock-refined): Mark the overall overlays as `diff-mode fine` as well, so they get properly cleaned up when changing mode. (diff-fringe-add, diff-fringe-del, diff-fringe-rep, diff-fringe-nul): New bitmaps. (diff--font-lock-prettify): Move the +/- signs to the fringe. (diff-wiggle): Use 'user-error'. diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 6c189c13cd..cf52368508 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -1341,6 +1341,13 @@ See `after-change-functions' for the meaning of BEG, END and LEN." (diff-hunk-next arg) (diff-goto-source)) +(defun diff--font-lock-cleanup () + (remove-overlays nil nil 'diff-mode 'fine) + (when font-lock-mode + (make-local-variable 'font-lock-extra-managed-props) + ;; Added when diff--font-lock-prettify is non-nil! + (cl-pushnew 'display font-lock-extra-managed-props))) + (defvar whitespace-style) (defvar whitespace-trailing-regexp) @@ -1358,12 +1365,10 @@ You can also switch between context diff and unified diff with \\[diff-context-> or vice versa with \\[diff-unified->context] and you can also reverse the direction of a diff with \\[diff-reverse-direction]. - \\{diff-mode-map}" +\\{diff-mode-map}" (set (make-local-variable 'font-lock-defaults) diff-font-lock-defaults) - (add-hook 'font-lock-mode-hook - (lambda () (remove-overlays nil nil 'diff-mode 'fine)) - nil 'local) + (add-hook 'font-lock-mode-hook #'diff--font-lock-cleanup nil 'local) (set (make-local-variable 'outline-regexp) diff-outline-regexp) (set (make-local-variable 'imenu-generic-expression) diff-imenu-generic-expression) @@ -1408,6 +1413,8 @@ a diff with \\[diff-reverse-direction]. #'diff-current-defun) (set (make-local-variable 'add-log-buffer-file-name-function) (lambda () (diff-find-file-name nil 'noprompt))) + (add-function :filter-return (local 'filter-buffer-substring-function) + #'diff--filter-substring) (unless (buffer-file-name) (hack-dir-local-variables-non-file-buffer))) @@ -2088,6 +2095,7 @@ Return new point, if it was moved." (diff--refine-hunk beg end) (let ((ol (make-overlay beg end))) (overlay-put ol 'diff--font-lock-refined t) + (overlay-put ol 'diff-mode 'fine) (overlay-put ol 'evaporate t) (overlay-put ol 'modification-hooks '(diff--font-lock-refine--refresh)))) @@ -2204,19 +2212,80 @@ fixed, visit it in a buffer." ;;; Prettifying from font-lock +(define-fringe-bitmap 'diff-fringe-add + [#b00000000 + #b00000000 + #b00010000 + #b00010000 + #b01111100 + #b00010000 + #b00010000 + #b00000000 + #b00000000] + nil nil 'center) + +(define-fringe-bitmap 'diff-fringe-del + [#b00000000 + #b00000000 + #b00000000 + #b00000000 + #b01111100 + #b00000000 + #b00000000 + #b00000000 + #b00000000] + nil nil 'center) + +(define-fringe-bitmap 'diff-fringe-rep + [#b00000000 + #b00010000 + #b00010000 + #b00010000 + #b00010000 + #b00010000 + #b00000000 + #b00010000 + #b00000000] + nil nil 'center) + +(define-fringe-bitmap 'diff-fringe-nul + ;; Maybe there should be such an "empty" bitmap defined by default? + [#b00000000 + #b00000000 + #b00000000 + #b00000000 + #b00000000 + #b00000000 + #b00000000 + #b00000000 + #b00000000] + nil nil 'center) + (defun diff--font-lock-prettify (limit) - ;; Mimicks the output of Magit's diff. - ;; FIXME: This has only been tested with Git's diff output. (when diff-font-lock-prettify + (save-excursion + ;; FIXME: Include the first space for context-style hunks! + (while (re-search-forward "^[-+! ]" limit t) + (let ((spec (alist-get (char-before) + '((?+ . (left-fringe diff-fringe-add diff-added)) + (?- . (left-fringe diff-fringe-del diff-removed)) + (?! . (left-fringe diff-fringe-rep diff-changed)) + (?\s . (left-fringe diff-fringe-nul)))))) + (put-text-property (match-beginning 0) (match-end 0) 'display spec)))) + ;; Mimicks the output of Magit's diff. + ;; FIXME: This has only been tested with Git's diff output. (while (re-search-forward "^diff " limit t) + ;; FIXME: Switching between context<->unified leads to messed up + ;; file headers by cutting the `display' property in chunks! (when (save-excursion - (forward-line 0) - (looking-at (eval-when-compile - (concat "diff.*\n" - "\\(?:\\(?:new file\\|deleted\\).*\n\\)?" - "\\(?:index.*\n\\)?" - "--- \\(?:/dev/null\\|a/\\(.*\\)\\)\n" - "\\+\\+\\+ \\(?:/dev/null\\|b/\\(.*\\)\\)\n")))) + (forward-line 0) + (looking-at + (eval-when-compile + (concat "diff.*\n" + "\\(?:\\(?:new file\\|deleted\\).*\n\\)?" + "\\(?:index.*\n\\)?" + "--- \\(?:/dev/null\\|a/\\(.*\\)\\)\n" + "\\+\\+\\+ \\(?:/dev/null\\|b/\\(.*\\)\\)\n")))) (put-text-property (match-beginning 0) (or (match-beginning 2) (match-beginning 1)) 'display (propertize @@ -2230,6 +2299,28 @@ fixed, visit it in a buffer." 'display ""))))) nil) +(defun diff--filter-substring (str) + (when diff-font-lock-prettify + ;; Strip the `display' properties added by diff-font-lock-prettify, + ;; since they look weird when you kill&yank! + (remove-text-properties 0 (length str) '(display nil) str) + ;; We could also try to only remove those `display' properties actually + ;; added by diff-font-lock-prettify rather than removing them all blindly. + ;; E.g.: + ;;(let ((len (length str)) + ;; (i 0)) + ;; (while (and (< i len) + ;; (setq i (text-property-not-all i len 'display nil str))) + ;; (let* ((val (get-text-property i 'display str)) + ;; (end (or (text-property-not-all i len 'display val str) len))) + ;; ;; FIXME: Check for display props that prettify the file header! + ;; (when (eq 'left-fringe (car-safe val)) + ;; ;; FIXME: Should we check that it's a diff-fringe-* bitmap? + ;; (remove-text-properties i end '(display nil) str)) + ;; (setq i end)))) + ) + str) + ;;; Support for converting a diff to diff3 markers via `wiggle'. ;; Wiggle can be found at http://neil.brown.name/wiggle/ or in your nearest @@ -2255,7 +2346,7 @@ conflict." (set-buffer (prog1 tmpbuf (setq tmpbuf (current-buffer)))) (when (buffer-modified-p filebuf) (save-some-buffers nil (lambda () (eq (current-buffer) filebuf))) - (if (buffer-modified-p filebuf) (error "Abort!"))) + (if (buffer-modified-p filebuf) (user-error "Abort!"))) (write-region (car bounds) (cadr bounds) patchfile nil 'silent) (let ((exitcode (call-process "wiggle" nil (list tmpbuf errfile) nil commit 1531bca523ea84c20eec9ce1dde0202a78956313 Author: Michael Heerdegen Date: Tue Sep 4 22:00:11 2018 +0200 Fix help-form binding in dired-create-files This fixes Bug#32630: since "dired-aux" moved to lexical binding mode, the free variable TO in the constructed HELP-FORM got out of scope of the surrounding 'let'. * lisp/dired-aux.el (dired-create-files): Make the binding of HELP-FORM a string. diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index e40627309d..eaf5f25701 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1712,7 +1712,7 @@ or with the current marker character if MARKER-CHAR is t." (let* ((overwrite (file-exists-p to)) (dired-overwrite-confirmed ; for dired-handle-overwrite (and overwrite - (let ((help-form '(format-message "\ + (let ((help-form (format-message "\ Type SPC or `y' to overwrite file `%s', DEL or `n' to skip to next, ESC or `q' to not overwrite any of the remaining files, commit 67d3b40e0cba5f34b1c7aacc4e1ccea6300eae76 Author: Michael Albinus Date: Sat Oct 20 13:38:31 2018 +0200 Expand host names in Tramp's ad-hoc multi-hop file names * doc/misc/tramp.texi (Quick Start Guide): Improve wording. (Change file name syntax): Say, that `tramp-file-name-regexp' is not constant. (Ad-hoc multi-hops): Explain host name expansion. * etc/NEWS: Mention that host names in Tramp ad-hoc multi-hop file names must match the previous hop for methods like "su" or "sudo". Fix typos. * lisp/net/tramp.el (tramp-find-method, tramp-find-user): Adapt docstring. (tramp-find-host): Mark default value. (tramp-dissect-file-name): Expand host name for hops. (tramp-dissect-hop-name, tramp-make-tramp-hop-name): New defuns. (tramp-clear-passwd): Simplify. * test/lisp/net/tramp-tests.el (tramp-test02-file-name-dissect) (tramp-test02-file-name-dissect-simplified) (tramp-test02-file-name-dissect-separate) (tramp-test26-file-name-completion): Extend tests. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 7c5ebf334a..128501c390 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -464,7 +464,7 @@ this case it is written as @code{host#port}. @cindex @option{plink} method If your local host runs an SSH client, and the remote host runs an SSH -server, the most simple remote file name is +server, the simplest remote file name is @file{@trampfn{ssh,user@@host,/path/to/file}}. The remote file name @file{@trampfn{ssh,,}} opens a remote connection to yourself on the local host, and is taken often for testing @value{tramp}. @@ -2459,9 +2459,10 @@ and @code{user@@} parts are optional. @defvar tramp-file-name-regexp This variable keeps a regexp which matches the selected remote file -name syntax. However, it is not recommended to use this variable in -external packages, a call of @code{file-remote-p} is much more -appropriate. +name syntax. Its value changes after every call of +@code{tramp-change-syntax}. However, it is not recommended to use +this variable in external packages, a call of @code{file-remote-p} is +much more appropriate. @ifinfo @pxref{Magic File Names, , , elisp} @end ifinfo @@ -2585,9 +2586,9 @@ directory contents. @cindex multi-hop, ad-hoc @cindex proxy hosts, ad-hoc -@value{tramp} file name syntax can accommodate ad hoc specification of +@value{tramp} file name syntax can accommodate ad-hoc specification of multiple proxies without using @code{tramp-default-proxies-alist} -configuration setup(@pxref{Multi-hops}). +configuration setup (@pxref{Multi-hops}). Each proxy is specified using the same syntax as the remote host specification minus the file name part. Each hop is separated by a @@ -2600,8 +2601,6 @@ proxy @samp{bird@@bastion} to a remote file on @samp{you@@remotehost}: @kbd{C-x C-f @value{prefix}ssh@value{postfixhop}bird@@bastion|ssh@value{postfixhop}you@@remotehost@value{postfix}/path @key{RET}} @end example -Proxies can take patterns @code{%h} or @code{%u}. - @value{tramp} adds the ad-hoc definitions on the fly to @code{tramp-default-proxies-alist} and is available for re-use during that Emacs session. Subsequent @value{tramp} connections to @@ -2618,6 +2617,17 @@ For ad-hoc definitions to be saved automatically in @end lisp @end defopt +Ad-hoc proxies can take patterns @code{%h} or @code{%u} like in +@code{tramp-default-proxies-alist}. The following file name expands +to user @code{root} on host @code{remotehost}, starting with an +@option{ssh} session on host @code{remotehost}: +@samp{@value{prefix}ssh@value{postfixhop}%h|su@value{postfixhop}remotehost@value{postfix}}. + +On the other hand, if a trailing hop does not specifiy a host name, +the host name of the previous hop is reused. Therefore, the following +file name is equivalent to the previous example: +@samp{@value{prefix}ssh@value{postfixhop}remotehost|su@value{postfixhop}@value{postfix}}. + @node Remote processes @section Integration with other Emacs packages diff --git a/etc/NEWS b/etc/NEWS index 09f0362fed..be6668ed42 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -172,7 +172,7 @@ the data. +++ ** The Network Security Manager now allows more fine-grained control -of what checks to run via the `network-security-protocol-checks' +of what checks to run via the 'network-security-protocol-checks' variable. +++ @@ -356,7 +356,7 @@ shown in the currently selected window. ** Comint +++ -*** 'send-invisible' is now an obsolete alias for `comint-send-invisible'. +*** 'send-invisible' is now an obsolete alias for 'comint-send-invisible'. Also, 'shell-strip-ctrl-m' is declared obsolete. +++ @@ -391,7 +391,7 @@ facilities to aid more casual SQL developers layout queries and complex expressions. *** 'sql-use-indent-support' (default t) enables SQL indention support. -The `sql-indent' package from ELPA must be installed to get the +The 'sql-indent' package from ELPA must be installed to get the indentation support in 'sql-mode' and 'sql-interactive-mode'. *** 'sql-mode-hook' and 'sql-interactive-mode-hook' changed. @@ -420,7 +420,7 @@ This enables more efficient backends. See the docstring of ** Package -*** New function `package-get-version` lets packages query their own version. +*** New function 'package-get-version' lets packages query their own version. Example use in auctex.el: (defconst auctex-version (package-get-version)) *** New 'package-quickstart' feature. @@ -747,6 +747,10 @@ are obsoleted in GVFS. *** The user option 'tramp-ignored-file-name-regexp' allows to disable Tramp for some look-alike remote file names. ++++ +*** For some connection methods, like "su" or "sudo", the host name in +ad-hoc multi-hop file names must match the previous hop. + ** Register --- *** The return value of method 'register-val-describe' includes the diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index e629ce1731..2e6cdf999a 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1267,7 +1267,7 @@ entry does not exist, return nil." (defun tramp-find-method (method user host) "Return the right method string to use. This is METHOD, if non-nil. Otherwise, do a lookup in -`tramp-default-method-alist'." +`tramp-default-method-alist' and `tramp-default-method'." (when (and method (or (string-equal method "") (string-equal method tramp-default-method-marker))) @@ -1292,7 +1292,7 @@ This is METHOD, if non-nil. Otherwise, do a lookup in (defun tramp-find-user (method user host) "Return the right user string to use. This is USER, if non-nil. Otherwise, do a lookup in -`tramp-default-user-alist'." +`tramp-default-user-alist' and `tramp-default-user'." (let ((result (or user (let ((choices tramp-default-user-alist) @@ -1312,18 +1312,24 @@ This is USER, if non-nil. Otherwise, do a lookup in (defun tramp-find-host (method user host) "Return the right host string to use. -This is HOST, if non-nil. Otherwise, it is `tramp-default-host'." - (or (and (> (length host) 0) host) - (let ((choices tramp-default-host-alist) - lhost item) - (while choices - (setq item (pop choices)) - (when (and (string-match (or (nth 0 item) "") (or method "")) - (string-match (or (nth 1 item) "") (or user ""))) - (setq lhost (nth 2 item)) - (setq choices nil))) - lhost) - tramp-default-host)) +This is HOST, if non-nil. Otherwise, do a lookup in +`tramp-default-host-alist' and `tramp-default-host'." + (let ((result + (or (and (> (length host) 0) host) + (let ((choices tramp-default-host-alist) + lhost item) + (while choices + (setq item (pop choices)) + (when (and (string-match (or (nth 0 item) "") (or method "")) + (string-match (or (nth 1 item) "") (or user ""))) + (setq lhost (nth 2 item)) + (setq choices nil))) + lhost) + tramp-default-host))) + ;; We must mark, whether a default value has been used. + (if (or (> (length host) 0) (null result)) + result + (propertize result 'tramp-default t)))) (defun tramp-dissect-file-name (name &optional nodefault) "Return a `tramp-file-name' structure of NAME, a remote file name. @@ -1343,7 +1349,7 @@ default values are used." (host (match-string (nth 3 tramp-file-name-structure) name)) (localname (match-string (nth 4 tramp-file-name-structure) name)) (hop (match-string (nth 5 tramp-file-name-structure) name)) - domain port) + domain port v) (when user (when (string-match tramp-user-with-domain-regexp user) (setq domain (match-string 2 user) @@ -1359,14 +1365,34 @@ default values are used." (setq host (replace-match "" nil t host)))) (unless nodefault - (setq method (tramp-find-method method user host) - user (tramp-find-user method user host) - host (tramp-find-host method user host))) + (when hop + (setq v (tramp-dissect-hop-name hop) + hop (and hop (tramp-make-tramp-hop-name v)))) + (let ((tramp-default-host + (or (and v (not (string-match "%h" (tramp-file-name-host v))) + (tramp-file-name-host v)) + tramp-default-host))) + (setq method (tramp-find-method method user host) + user (tramp-find-user method user host) + host (tramp-find-host method user host) + hop + (and hop + (format-spec hop (format-spec-make ?h host ?u user)))))) (make-tramp-file-name :method method :user user :domain domain :host host :port port :localname localname :hop hop))))) +(defun tramp-dissect-hop-name (name &optional nodefault) + "Return a `tramp-file-name' structure of `hop' part of NAME. +See `tramp-dissect-file-name' for details." + (tramp-dissect-file-name + (concat + tramp-prefix-format + (replace-regexp-in-string + (concat tramp-postfix-hop-regexp "$") tramp-postfix-host-format name)) + nodefault)) + (defun tramp-buffer-name (vec) "A name for the connection buffer VEC." (let ((method (tramp-file-name-method vec)) @@ -1433,6 +1459,14 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)." tramp-postfix-host-format localname))) +(defun tramp-make-tramp-hop-name (vec) + "Construct a Tramp hop name from VEC." + (replace-regexp-in-string + tramp-prefix-regexp "" + (replace-regexp-in-string + (concat tramp-postfix-host-regexp "$") tramp-postfix-hop-format + (tramp-make-tramp-file-name vec 'noloc)))) + (defun tramp-completion-make-tramp-file-name (method user host localname) "Construct a Tramp file name from METHOD, USER, HOST and LOCALNAME. It must not be a complete Tramp file name, but as long as there are @@ -2313,7 +2347,7 @@ Falls back to normal file name handler if no Tramp file name handler exists." (tramp-message v 1 "Interrupt received in operation %s" (cons operation args))) - ;; Propagate the quit signal. + ;; Propagate the signal. (signal (car err) (cdr err))) ;; When we are in completion mode, some failed @@ -4508,13 +4542,7 @@ Invokes `password-read' if available, `read-passwd' else." (hop (tramp-file-name-hop vec))) (when hop ;; Clear also the passwords of the hops. - (tramp-clear-passwd - (tramp-dissect-file-name - (concat - tramp-prefix-format - (replace-regexp-in-string - (concat tramp-postfix-hop-regexp "$") - tramp-postfix-host-format hop))))) + (tramp-clear-passwd (tramp-dissect-hop-name hop))) (auth-source-forget `(:max 1 ,(and user-domain :user) ,user-domain :host ,host-port :port ,method)) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 6a08cbb5ab..ceda70947c 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -763,8 +763,8 @@ handled properly. BODY shall not contain a timeout." "|-:user2@host2" "|-:user3@host3:/path/to/file")) (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s:" - "-" "user1" "host1" - "-" "user2" "host2" + "method1" "user1" "host1" + "method2" "user2" "host2" "method3" "user3" "host3"))) ;; Expand `tramp-default-user-alist'. @@ -778,9 +778,9 @@ handled properly. BODY shall not contain a timeout." "/method1:host1" "|method2:host2" "|method3:host3:/path/to/file")) - (format "/%s:%s|%s:%s|%s:%s@%s:" - "method1" "host1" - "method2" "host2" + (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s:" + "method1" "user1" "host1" + "method2" "user2" "host2" "method3" "user3" "host3"))) ;; Expand `tramp-default-host-alist'. @@ -794,9 +794,36 @@ handled properly. BODY shall not contain a timeout." "/method1:user1@" "|method2:user2@" "|method3:user3@:/path/to/file")) - (format "/%s:%s@|%s:%s@|%s:%s@%s:" - "method1" "user1" - "method2" "user2" + (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s:" + "method1" "user1" "host1" + "method2" "user2" "host2" + "method3" "user3" "host3"))) + + ;; Ad-hoc user name and host name expansion. + (setq tramp-default-method-alist nil + tramp-default-user-alist nil + tramp-default-host-alist nil) + (should + (string-equal + (file-remote-p + (concat + "/method1:user1@host1" + "|method2:user2@" + "|method3:user3@:/path/to/file")) + (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s:" + "method1" "user1" "host1" + "method2" "user2" "host1" + "method3" "user3" "host1"))) + (should + (string-equal + (file-remote-p + (concat + "/method1:%u@%h" + "|method2:%u@%h" + "|method3:user3@host3:/path/to/file")) + (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s:" + "method1" "user3" "host3" + "method2" "user3" "host3" "method3" "user3" "host3"))))) (ert-deftest tramp-test02-file-name-dissect-simplified () @@ -1067,9 +1094,9 @@ handled properly. BODY shall not contain a timeout." "/host1" "|host2" "|host3:/path/to/file")) - (format "/%s|%s|%s@%s:" - "host1" - "host2" + (format "/%s@%s|%s@%s|%s@%s:" + "user1" "host1" + "user2" "host2" "user3" "host3"))) ;; Expand `tramp-default-host-alist'. @@ -1083,9 +1110,35 @@ handled properly. BODY shall not contain a timeout." "/user1@" "|user2@" "|user3@:/path/to/file")) - (format "/%s@|%s@|%s@%s:" - "user1" - "user2" + (format "/%s@%s|%s@%s|%s@%s:" + "user1" "host1" + "user2" "host2" + "user3" "host3"))) + + ;; Ad-hoc user name and host name expansion. + (setq tramp-default-user-alist nil + tramp-default-host-alist nil) + (should + (string-equal + (file-remote-p + (concat + "/user1@host1" + "|user2@" + "|user3@:/path/to/file")) + (format "/%s@%s|%s@%s|%s@%s:" + "user1" "host1" + "user2" "host1" + "user3" "host1"))) + (should + (string-equal + (file-remote-p + (concat + "/%u@%h" + "|%u@%h" + "|user3@host3:/path/to/file")) + (format "/%s@%s|%s@%s|%s@%s:" + "user3" "host3" + "user3" "host3" "user3" "host3")))) ;; Exit. @@ -1670,9 +1723,9 @@ handled properly. BODY shall not contain a timeout." "/[/user1@host1" "|/user2@host2" "|/user3@host3]/path/to/file")) - (format "/[/%s@%s|/%s@%s|%s/%s@%s]" - "user1" "host1" - "user2" "host2" + (format "/[%s/%s@%s|%s/%s@%s|%s/%s@%s]" + "method1" "user1" "host1" + "method2" "user2" "host2" "method3" "user3" "host3"))) ;; Expand `tramp-default-user-alist'. @@ -1686,9 +1739,9 @@ handled properly. BODY shall not contain a timeout." "/[method1/host1" "|method2/host2" "|method3/host3]/path/to/file")) - (format "/[%s/%s|%s/%s|%s/%s@%s]" - "method1" "host1" - "method2" "host2" + (format "/[%s/%s@%s|%s/%s@%s|%s/%s@%s]" + "method1" "user1" "host1" + "method2" "user2" "host2" "method3" "user3" "host3"))) ;; Expand `tramp-default-host-alist'. @@ -1702,9 +1755,36 @@ handled properly. BODY shall not contain a timeout." "/[method1/user1@" "|method2/user2@" "|method3/user3@]/path/to/file")) - (format "/[%s/%s@|%s/%s@|%s/%s@%s]" - "method1" "user1" - "method2" "user2" + (format "/[%s/%s@%s|%s/%s@%s|%s/%s@%s]" + "method1" "user1" "host1" + "method2" "user2" "host2" + "method3" "user3" "host3"))) + + ;; Ad-hoc user name and host name expansion. + (setq tramp-default-method-alist nil + tramp-default-user-alist nil + tramp-default-host-alist nil) + (should + (string-equal + (file-remote-p + (concat + "/[method1/user1@host1" + "|method2/user2@" + "|method3/user3@]/path/to/file")) + (format "/[%s/%s@%s|%s/%s@%s|%s/%s@%s]" + "method1" "user1" "host1" + "method2" "user2" "host1" + "method3" "user3" "host1"))) + (should + (string-equal + (file-remote-p + (concat + "/[method1/%u@%h" + "|method2/%u@%h" + "|method3/user3@host3]/path/to/file")) + (format "/[%s/%s@%s|%s/%s@%s|%s/%s@%s]" + "method1" "user3" "host3" + "method2" "user3" "host3" "method3" "user3" "host3")))) ;; Exit. @@ -3491,6 +3571,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (when (not (memq system-type '(cygwin windows-nt))) (let ((method (file-remote-p tramp-test-temporary-file-directory 'method)) (host (file-remote-p tramp-test-temporary-file-directory 'host)) + (vec (tramp-dissect-file-name tramp-test-temporary-file-directory)) (orig-syntax tramp-syntax)) (when (and (stringp host) (string-match tramp-host-with-port-regexp host)) (setq host (match-string 1 host))) @@ -3501,6 +3582,10 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (if (tramp--test-expensive-test) (tramp-syntax-values) `(,orig-syntax))) (tramp-change-syntax syntax) + ;; This has cleaned up all connection data, which are used + ;; for completion. We must refill the cache. + (tramp-set-connection-property vec "property" nil) + (let ;; This is needed for the `simplified' syntax. ((method-marker (if (zerop (length tramp-method-regexp)) commit efb214622a0f4e077c09e721d134552dfe76ef70 Author: Eli Zaretskii Date: Sat Oct 20 12:52:52 2018 +0300 Fix 'timer-next-integral-multiple-of-time' * lisp/emacs-lisp/timer.el (timer-next-integral-multiple-of-time): Fix recent change for fractional values of SECS. (Bug#33071) * test/lisp/emacs-lisp/timer-tests.el (timer-next-integral-multiple-of-time-2): New test. diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el index 927e640fea..e140738d9f 100644 --- a/lisp/emacs-lisp/timer.el +++ b/lisp/emacs-lisp/timer.el @@ -101,7 +101,7 @@ of SECS seconds since the epoch. SECS may be a fraction." time (encode-time time 1000000000000))) (hz (cdr ticks-hz)) - (s-ticks (* secs hz)) + (s-ticks (round (* secs hz))) (more-ticks (+ (car ticks-hz) s-ticks))) (encode-time (cons (- more-ticks (% more-ticks s-ticks)) hz)))) diff --git a/test/lisp/emacs-lisp/timer-tests.el b/test/lisp/emacs-lisp/timer-tests.el index c5971ee768..7a5b9263b0 100644 --- a/test/lisp/emacs-lisp/timer-tests.el +++ b/test/lisp/emacs-lisp/timer-tests.el @@ -44,4 +44,12 @@ (timer-next-integral-multiple-of-time '(0 0 0 1) (1+ (ash 1 53))) (list (ash 1 (- 53 16)) 1)))) +(ert-deftest timer-next-integral-multiple-of-time-2 () + "Test bug#33071." + (let* ((tc (current-time)) + (tce (encode-time tc 100)) + (nt (timer-next-integral-multiple-of-time tc 0.01)) + (nte (encode-time nt 100))) + (should (= (car nte) (1+ (car tce)))))) + ;;; timer-tests.el ends here commit cf7932712a1dac49fb299b20762d2f3329f9786b Author: Eli Zaretskii Date: Sat Oct 20 11:26:33 2018 +0300 Fix a pasto in a Gnus doc string * lisp/gnus/gnus-art.el (gnus-article-treat-fold-newsgroups): Doc string fix. (Bug#33081) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 15e88a3422..b712cf53ef 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -2254,9 +2254,7 @@ This only works if the article in question is HTML." start end))))))) (defun gnus-article-treat-fold-newsgroups () - "Unfold folded message headers. -Only the headers that fit into the current window width will be -unfolded." + "Fold the Newsgroups and Followup-To message headers." (interactive) (gnus-with-article-headers (while (gnus-article-goto-header "newsgroups\\|followup-to") commit d684f5d5bc33249038e779a4b2009fd0761f09d5 Author: Stefan Monnier Date: Fri Oct 19 22:31:35 2018 -0400 * lisp/mail/smtpmail.el: (smtpmail-send-queued-mail): Avoid 'load' (smtpmail-send-it): Send metadata directly to the files without bothering to write it into a temp buffer. diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index 8bc3cc78d9..9b045b2558 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -150,7 +150,8 @@ and sent with `smtpmail-send-queued-mail'." :group 'smtpmail) (defcustom smtpmail-queue-dir "~/Mail/queued-mail/" - "Directory where `smtpmail.el' stores queued mail." + "Directory where `smtpmail.el' stores queued mail. +This directory should not be writable by other users." :type 'directory :group 'smtpmail) @@ -360,9 +361,7 @@ for `smtpmail-try-auth-method'.") smtpmail-queue-dir)) (file-data (convert-standard-filename file-data)) (file-elisp (concat file-data ".el")) - (buffer-data (create-file-buffer file-data)) - (buffer-elisp (create-file-buffer file-elisp)) - (buffer-scratch "*queue-mail*")) + (buffer-data (create-file-buffer file-data))) (unless (file-exists-p smtpmail-queue-dir) (make-directory smtpmail-queue-dir t)) (with-current-buffer buffer-data @@ -377,22 +376,16 @@ for `smtpmail-try-auth-method'.") nil t) (insert-buffer-substring tembuf) (write-file file-data) - (set-buffer buffer-elisp) - (erase-buffer) - (insert (concat - "(setq smtpmail-recipient-address-list '" + (write-region + (concat "(setq smtpmail-recipient-address-list '" (prin1-to-string smtpmail-recipient-address-list) - ")\n")) - (write-file file-elisp) - (set-buffer (generate-new-buffer buffer-scratch)) - (insert (concat file-data "\n")) - (append-to-file (point-min) - (point-max) - (expand-file-name smtpmail-queue-index-file - smtpmail-queue-dir))) - (kill-buffer buffer-scratch) - (kill-buffer buffer-data) - (kill-buffer buffer-elisp)))) + ")\n") + nil file-elisp nil 'silent) + (write-region (concat file-data "\n") nil + (expand-file-name smtpmail-queue-index-file + smtpmail-queue-dir) + t 'silent)) + (kill-buffer buffer-data)))) (kill-buffer tembuf) (if (bufferp errbuf) (kill-buffer errbuf))))) @@ -412,7 +405,21 @@ for `smtpmail-try-auth-method'.") (goto-char (point-min)) (while (not (eobp)) (setq file-msg (buffer-substring (point) (line-end-position))) - (load file-msg) + ;; FIXME: Avoid `load' which can execute arbitrary code and is hence + ;; a source of security holes. Better read the file and extract the + ;; data "by hand". + ;;(load file-msg) + (with-temp-buffer + (insert-file-contents (concat file-msg ".el")) + (goto-char (point-min)) + (pcase (read (current-buffer)) + (`(setq smtpmail-recipient-address-list ',v) + (skip-chars-forward " \n\t") + (unless (eobp) (message "Ignoring trailing text in %S" + (concat file-msg ".el"))) + (setq smtpmail-recipient-address-list v)) + (sexp (error "Unexpected code in %S: %S" + (concat file-msg ".el") sexp)))) ;; Insert the message literally: it is already encoded as per ;; the MIME headers, and code conversions might guess the ;; encoding wrongly. commit 32e411943d3f1d1546bfcb1aad8c4d4cd28857d6 Author: Stefan Monnier Date: Fri Oct 19 18:10:42 2018 -0400 * emacs-lisp/package.el (package-get-version): Change into a function (package-quickstart-refresh): Mangle string so it doesn't turn into a false positive for "no-byte-compile: t". diff --git a/etc/NEWS b/etc/NEWS index b906467dcd..09f0362fed 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -420,7 +420,7 @@ This enables more efficient backends. See the docstring of ** Package -*** New macro `package-get-version` lets packages query their own version. +*** New function `package-get-version` lets packages query their own version. Example use in auctex.el: (defconst auctex-version (package-get-version)) *** New 'package-quickstart' feature. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 06e9956da4..9c4c3e9fe7 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -3452,11 +3452,14 @@ The list is displayed in a buffer named `*Packages*'." (list-packages t)) ;;;###autoload -(defmacro package-get-version () +(defun package-get-version () "Return the version number of the package in which this is used. Assumes it is used from an Elisp file placed inside the top-level directory of an installed ELPA package. The return value is a string (or nil in case we can't find it)." + ;; In a sense, this is a lie, but it does just what we want: precompute + ;; the version at compile time and hardcodes it into the .elc file! + (declare (pure t)) ;; Hack alert! (let ((file (or (if (boundp 'byte-compile-current-file) byte-compile-current-file) @@ -3476,6 +3479,7 @@ The return value is a string (or nil in case we can't find it)." (pkgname (file-name-nondirectory (directory-file-name pkgdir))) (mainfile (expand-file-name (concat pkgname ".el") pkgdir))) (when (file-readable-p mainfile) + (require 'lisp-mnt) (with-temp-buffer (insert-file-contents mainfile) (or (lm-header "package-version") @@ -3567,7 +3571,7 @@ activations need to be changed, such as when `package-load-list' is modified." (insert " ;; Local\sVariables: ;; version-control: never -;; no-byte-compile: t +;;\sno-byte-compile: t ;; no-update-autoloads: t ;; End: ")))) commit 7cfe2dc415d0a5768f9e6800836ff6887079dc30 Author: Alan Mackenzie Date: Fri Oct 19 17:44:31 2018 +0000 In edebug in GUIs, move focus to the selected frame. Thus when entering edebug, the focus will be moved to the frame with the source being debugged, and when its finished, the focus will move back. Commands edebug-visit-eval-list (`E') and edebug-bounce-point (`p') have been likewise amended. * src/keyboard.c (readable_events): Handle FOCUS_OUT_EVENT as an invisible event. This prevents input-pending-p returning t when one of these events arrives, and thus obviates an instant termination of sit-for when there's no "real" event waiting. * lisp/emacs-lisp/edebug.el (edebug-focus-frame): New function. (edebug-default-enter, edebug--display-1, edbug-where, edebug-bounce-point) (edebug-visit-eval-list): Call edebug-focus-frame to move focus into the window newly selected by edebug-pop-to-buffer. diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index fb567c9cce..ce4ed687be 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -342,6 +342,12 @@ Return the result of the last expression in BODY." (defconst edebug-trace-buffer "*edebug-trace*" "Name of the buffer to put trace info in.") +(defun edebug-focus-frame (frame) + "Switch focus to frame FRAME, if we're in a GUI. +Otherwise, do nothing." + (unless (memq (framep frame) '(nil t pc)) + (x-focus-frame frame))) + (defun edebug-pop-to-buffer (buffer &optional window) ;; Like pop-to-buffer, but select window where BUFFER was last shown. ;; Select WINDOW if it is provided and still exists. Otherwise, @@ -2328,6 +2334,7 @@ and run its entry function, and set up `edebug-before' and (debugger edebug-debugger) ; only while edebug is active. (edebug-outside-debug-on-error debug-on-error) (edebug-outside-debug-on-quit debug-on-quit) + (outside-frame (selected-frame)) ;; Binding these may not be the right thing to do. ;; We want to allow the global values to be changed. (debug-on-error (or debug-on-error edebug-on-error)) @@ -2338,7 +2345,9 @@ and run its entry function, and set up `edebug-before' and edebug-initial-mode edebug-execution-mode) edebug-next-execution-mode nil) - (edebug-default-enter function args body)))) + (edebug-default-enter function args body)) + (if (frame-live-p outside-frame) + (edebug-focus-frame outside-frame)))) (let* ((edebug-data (get function 'edebug)) (edebug-def-mark (car edebug-data)) ; mark at def start @@ -2647,6 +2656,7 @@ See `edebug-behavior-alist' for implementations.") (edebug-eval-display eval-result-list) ;; The evaluation list better not have deleted edebug-window-data. (select-window (car edebug-window-data)) + (edebug-focus-frame (window-frame (selected-window))) (set-buffer edebug-buffer) (setq edebug-buffer-outside-point (point)) @@ -3017,6 +3027,7 @@ Otherwise, toggle for all windows." ;;(if edebug-inside-windows ;; (edebug-set-windows edebug-inside-windows)) (edebug-pop-to-buffer edebug-buffer) + (edebug-focus-frame (window-frame (selected-window))) (goto-char edebug-point)) (defun edebug-view-outside () @@ -3044,13 +3055,15 @@ before returning. The default is one second." ;; If the buffer's currently displayed, avoid set-window-configuration. (save-window-excursion (edebug-pop-to-buffer edebug-outside-buffer) + (edebug-focus-frame (window-frame (selected-window))) (goto-char edebug-outside-point) (message "Current buffer: %s Point: %s Mark: %s" (current-buffer) (point) (if (marker-buffer (edebug-mark-marker)) (marker-position (edebug-mark-marker)) "")) (sit-for arg) - (edebug-pop-to-buffer edebug-buffer (car edebug-window-data))))) + (edebug-pop-to-buffer edebug-buffer (car edebug-window-data)) + (edebug-focus-frame (window-frame (selected-window)))))) ;; Joe Wells, here is a start at your idea of adding a buffer to the internal @@ -3872,7 +3885,8 @@ May only be called from within `edebug--recursive-edit'." "Switch to the evaluation list buffer \"*edebug*\"." (interactive) (edebug-eval-redisplay) - (edebug-pop-to-buffer edebug-eval-buffer)) + (edebug-pop-to-buffer edebug-eval-buffer) + (edebug-focus-frame (window-frame (selected-window)))) (defun edebug-update-eval-list () diff --git a/src/keyboard.c b/src/keyboard.c index 8ea15d3c89..be727a6549 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -3324,7 +3324,7 @@ readable_events (int flags) if (flags & READABLE_EVENTS_DO_TIMERS_NOW) timer_check (); - /* If the buffer contains only FOCUS_IN_EVENT events, and + /* If the buffer contains only FOCUS_IN/OUT_EVENT events, and READABLE_EVENTS_FILTER_EVENTS is set, report it as empty. */ if (kbd_fetch_ptr != kbd_store_ptr) { @@ -3344,7 +3344,8 @@ readable_events (int flags) #ifdef USE_TOOLKIT_SCROLL_BARS (flags & READABLE_EVENTS_FILTER_EVENTS) && #endif - event->kind == FOCUS_IN_EVENT) + (event->kind == FOCUS_IN_EVENT + || event->kind == FOCUS_OUT_EVENT)) #ifdef USE_TOOLKIT_SCROLL_BARS && !((flags & READABLE_EVENTS_IGNORE_SQUEEZABLES) && (event->kind == SCROLL_BAR_CLICK_EVENT commit d2a07b9a82a632e8baa179c667a98d275e5f6973 Author: Paul Eggert Date: Fri Oct 19 09:06:52 2018 -0700 Fix struct thread alignment on FreeBSD x86 Problem reported by Joseph Mingrone in: https://lists.gnu.org/r/emacs-devel/2018-10/msg00238.html While we’re at it, apply a similar fix to struct Lisp_Subr; this removes the need for GCALIGNED_STRUCT_MEMBER and thus can shrink struct Lisp_Subr a bit. * configure.ac (HAVE_STRUCT_ATTRIBUTE_ALIGNED): Bring back this macro. Although used only for performance (not to actually align structures), we might as well take advantage of it. * src/lisp.h (GCALIGNED_STRUCT_MEMBER): Remove; all uses removed. (union Aligned_Lisp_Subr): New type, like struct Lisp_Subr but aligned. * src/lisp.h (XSUBR, DEFUN): * src/lread.c (defsubr): Use it. All callers changed. * src/thread.c (union aligned_thread_state): New type. (main_thread): Now of this type, so it’s aligned. All uses changed. * src/xmenu.c (syms_of_xmenu) [USE_GTK || USE_X_TOOLKIT]: Adjust to union Aligned_Lisp_Subr change. diff --git a/configure.ac b/configure.ac index 3a61090902..50e3333528 100644 --- a/configure.ac +++ b/configure.ac @@ -5207,6 +5207,22 @@ else fi AC_SUBST(LIBXMENU) +AC_CACHE_CHECK([for struct alignment], + [emacs_cv_struct_alignment], + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM([[#include + struct s { char c; } __attribute__ ((aligned (8))); + struct t { char c; struct s s; }; + char verify[offsetof (struct t, s) == 8 ? 1 : -1]; + ]])], + [emacs_cv_struct_alignment=yes], + [emacs_cv_struct_alignment=no])]) +if test "$emacs_cv_struct_alignment" = yes; then + AC_DEFINE([HAVE_STRUCT_ATTRIBUTE_ALIGNED], 1, + [Define to 1 if 'struct __attribute__ ((aligned (N)))' aligns the + structure to an N-byte boundary.]) +fi + if test "${GNU_MALLOC}" = "yes" ; then AC_DEFINE(GNU_MALLOC, 1, [Define to 1 if you want to use the GNU memory allocator.]) diff --git a/src/lisp.h b/src/lisp.h index 145901dff5..eb6762678c 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -229,7 +229,7 @@ extern bool suppress_checking EXTERNALLY_VISIBLE; USE_LSB_TAG not only requires the least 3 bits of pointers returned by malloc to be 0 but also needs to be able to impose a mult-of-8 alignment on some non-GC Lisp_Objects, all of which are aligned via - GCALIGNED_UNION_MEMBER, GCALIGNED_STRUCT_MEMBER, and GCALIGNED_STRUCT. */ + GCALIGNED_UNION_MEMBER. */ enum Lisp_Bits { @@ -284,15 +284,14 @@ error !; # define GCALIGNMENT 1 #endif -/* If a struct is always allocated by the GC and is therefore always - GC-aligned, put GCALIGNED_STRUCT after its closing '}'; this can - help the compiler generate better code. +/* To cause a union to have alignment of at least GCALIGNMENT, put + GCALIGNED_UNION_MEMBER in its member list. - To cause a union to have alignment of at least GCALIGNMENT, put - GCALIGNED_UNION_MEMBER in its member list. Similarly for a struct - and GCALIGNED_STRUCT_MEMBER, although this may make the struct a - bit bigger on non-GCC platforms. Any struct using - GCALIGNED_STRUCT_MEMBER should also use GCALIGNED_STRUCT. + If a struct is always GC-aligned (either by the GC, or via + allocation in a containing union that has GCALIGNED_UNION_MEMBER) + and does not contain a GC-aligned struct or union, putting + GCALIGNED_STRUCT after its closing '}' can help the compiler + generate better code. Although these macros are reasonably portable, they are not guaranteed on non-GCC platforms, as C11 does not require support @@ -306,10 +305,8 @@ error !; #define GCALIGNED_UNION_MEMBER char alignas (GCALIGNMENT) gcaligned; #if HAVE_STRUCT_ATTRIBUTE_ALIGNED -# define GCALIGNED_STRUCT_MEMBER # define GCALIGNED_STRUCT __attribute__ ((aligned (GCALIGNMENT))) #else -# define GCALIGNED_STRUCT_MEMBER GCALIGNED_UNION_MEMBER # define GCALIGNED_STRUCT #endif #define GCALIGNED(type) (alignof (type) % GCALIGNMENT == 0) @@ -1970,9 +1967,13 @@ struct Lisp_Subr const char *symbol_name; const char *intspec; EMACS_INT doc; - GCALIGNED_STRUCT_MEMBER } GCALIGNED_STRUCT; -verify (GCALIGNED (struct Lisp_Subr)); +union Aligned_Lisp_Subr + { + struct Lisp_Subr s; + GCALIGNED_UNION_MEMBER + }; +verify (GCALIGNED (union Aligned_Lisp_Subr)); INLINE bool SUBRP (Lisp_Object a) @@ -1984,7 +1985,7 @@ INLINE struct Lisp_Subr * XSUBR (Lisp_Object a) { eassert (SUBRP (a)); - return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Subr); + return &XUNTAG (a, Lisp_Vectorlike, union Aligned_Lisp_Subr)->s; } enum char_table_specials @@ -2952,15 +2953,15 @@ CHECK_FIXNUM_CDR (Lisp_Object x) /* This version of DEFUN declares a function prototype with the right arguments, so we can catch errors with maxargs at compile-time. */ #define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \ - static struct Lisp_Subr sname = \ - { { PVEC_SUBR << PSEUDOVECTOR_AREA_BITS }, \ + static union Aligned_Lisp_Subr sname = \ + {{{ PVEC_SUBR << PSEUDOVECTOR_AREA_BITS }, \ { .a ## maxargs = fnname }, \ - minargs, maxargs, lname, intspec, 0}; \ + minargs, maxargs, lname, intspec, 0}}; \ Lisp_Object fnname /* defsubr (Sname); is how we define the symbol for function `name' at start-up time. */ -extern void defsubr (struct Lisp_Subr *); +extern void defsubr (union Aligned_Lisp_Subr *); enum maxargs { diff --git a/src/lread.c b/src/lread.c index 62616cb681..5f3871436d 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4409,8 +4409,9 @@ init_obarray (void) } void -defsubr (struct Lisp_Subr *sname) +defsubr (union Aligned_Lisp_Subr *aname) { + struct Lisp_Subr *sname = &aname->s; Lisp_Object sym, tem; sym = intern_c_string (sname->symbol_name); XSETPVECTYPE (sname, PVEC_SUBR); diff --git a/src/thread.c b/src/thread.c index 3674af0e47..6612697b95 100644 --- a/src/thread.c +++ b/src/thread.c @@ -27,11 +27,18 @@ along with GNU Emacs. If not, see . */ #include "syssignal.h" #include "keyboard.h" -static struct thread_state main_thread; +union aligned_thread_state +{ + struct thread_state s; + GCALIGNED_UNION_MEMBER +}; +verify (GCALIGNED (union aligned_thread_state)); + +static union aligned_thread_state main_thread; -struct thread_state *current_thread = &main_thread; +struct thread_state *current_thread = &main_thread.s; -static struct thread_state *all_threads = &main_thread; +static struct thread_state *all_threads = &main_thread.s; static sys_mutex_t global_lock; @@ -113,7 +120,7 @@ maybe_reacquire_global_lock (void) /* SIGINT handler is always run on the main thread, see deliver_process_signal, so reflect that in our thread-tracking variables. */ - current_thread = &main_thread; + current_thread = &main_thread.s; if (current_thread->not_holding_lock) { @@ -659,7 +666,7 @@ mark_threads (void) void unmark_main_thread (void) { - main_thread.header.size &= ~ARRAY_MARK_FLAG; + main_thread.s.header.size &= ~ARRAY_MARK_FLAG; } @@ -1043,23 +1050,23 @@ thread_check_current_buffer (struct buffer *buffer) static void init_main_thread (void) { - main_thread.header.size + main_thread.s.header.size = PSEUDOVECSIZE (struct thread_state, m_stack_bottom); - XSETPVECTYPE (&main_thread, PVEC_THREAD); - main_thread.m_last_thing_searched = Qnil; - main_thread.m_saved_last_thing_searched = Qnil; - main_thread.name = Qnil; - main_thread.function = Qnil; - main_thread.result = Qnil; - main_thread.error_symbol = Qnil; - main_thread.error_data = Qnil; - main_thread.event_object = Qnil; + XSETPVECTYPE (&main_thread.s, PVEC_THREAD); + main_thread.s.m_last_thing_searched = Qnil; + main_thread.s.m_saved_last_thing_searched = Qnil; + main_thread.s.name = Qnil; + main_thread.s.function = Qnil; + main_thread.s.result = Qnil; + main_thread.s.error_symbol = Qnil; + main_thread.s.error_data = Qnil; + main_thread.s.event_object = Qnil; } bool main_thread_p (void *ptr) { - return ptr == &main_thread; + return ptr == &main_thread.s; } bool @@ -1080,11 +1087,11 @@ void init_threads (void) { init_main_thread (); - sys_cond_init (&main_thread.thread_condvar); + sys_cond_init (&main_thread.s.thread_condvar); sys_mutex_init (&global_lock); sys_mutex_lock (&global_lock); - current_thread = &main_thread; - main_thread.thread_id = sys_thread_self (); + current_thread = &main_thread.s; + main_thread.s.thread_id = sys_thread_self (); } void @@ -1130,7 +1137,7 @@ syms_of_threads (void) DEFVAR_LISP ("main-thread", Vmain_thread, doc: /* The main thread of Emacs. */); #ifdef THREADS_ENABLED - XSETTHREAD (Vmain_thread, &main_thread); + XSETTHREAD (Vmain_thread, &main_thread.s); #else Vmain_thread = Qnil; #endif diff --git a/src/xmenu.c b/src/xmenu.c index 10e882af43..31034f7112 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -2420,6 +2420,6 @@ syms_of_xmenu (void) #if defined (USE_GTK) || defined (USE_X_TOOLKIT) defsubr (&Sx_menu_bar_open_internal); Ffset (intern_c_string ("accelerate-menu"), - intern_c_string (Sx_menu_bar_open_internal.symbol_name)); + intern_c_string (Sx_menu_bar_open_internal.s.symbol_name)); #endif } commit fc3f93705543408b868feb7b93b8d77ab1c6ae53 Author: Eli Zaretskii Date: Fri Oct 19 16:55:17 2018 +0300 ; * etc/NEWS (value): Fix punctuation of a recently added entry. diff --git a/etc/NEWS b/etc/NEWS index f1be50babd..b906467dcd 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -420,7 +420,7 @@ This enables more efficient backends. See the docstring of ** Package -*** New macro `package-get-version` lets packages query their own version +*** New macro `package-get-version` lets packages query their own version. Example use in auctex.el: (defconst auctex-version (package-get-version)) *** New 'package-quickstart' feature. commit 487931cd06fee9520e37bdb40b5340831106aea8 Author: Alan Mackenzie Date: Fri Oct 19 09:54:31 2018 +0000 In follow mode windows in a GUI, don't display inactive cursors This is done by setting cursor-in-non-selected-windows buffer locally. * lisp/follow.el (follow-hide-ghost-cursors): New customizable option. (follow-mode): Create and set, or kill buffer-local copy of cursor-in-non-selected-windows when the mode gets enabled or disabled. (follow-prev-buffer): New variable. (follow-adjust-window): Manipulate cursor-in-non-selected-windows when the current buffer changes, to ensure that cursors stay visible in non-selected follow window groups. * etc/NEWS: Add an entry for this change. diff --git a/etc/NEWS b/etc/NEWS index 2ebe5a16a2..f1be50babd 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -287,6 +287,12 @@ in (info "(emacs) Directory Variables") * Changes in Specialized Modes and Packages in Emacs 27.1 +--- +** Follow mode +In the current follow group of windows, "ghost" cursors are no longer +displayed in the non-selected follow windows. To get the old behavior +back, customize follow-hide-ghost-cursors to nil. + ** Octave mode The mode is automatically enabled in files that start with the 'function' keyword. diff --git a/lisp/follow.el b/lisp/follow.el index b44df423d6..ed7b7d2359 100644 --- a/lisp/follow.el +++ b/lisp/follow.el @@ -311,6 +311,17 @@ are \" Fw\", or simply \"\"." (remove-hook 'find-file-hook 'follow-find-file-hook)) (set-default symbol value))) +(defcustom follow-hide-ghost-cursors t ; Maybe this should be nil. + "When non-nil, Follow mode attempts to hide the obtrusive cursors +in the non-selected windows of a window group. + +This variable takes effect when `follow-mode' is initialized. + +Due to limitations in Emacs, this only operates on the followers +of the selected window." + :type 'boolean + :group 'follow) + (defvar follow-cache-command-list '(next-line previous-line forward-char backward-char right-char left-char) "List of commands that don't require recalculation. @@ -427,6 +438,8 @@ Keys specific to Follow mode: (when isearch-lazy-highlight (setq-local isearch-lazy-highlight 'all-windows)) + (when follow-hide-ghost-cursors + (setq-local cursor-in-non-selected-windows nil)) (setq window-group-start-function 'follow-window-start) (setq window-group-end-function 'follow-window-end) @@ -456,6 +469,8 @@ Keys specific to Follow mode: (kill-local-variable 'window-group-end-function) (kill-local-variable 'window-group-start-function) + (kill-local-variable 'cursor-in-non-selected-windows) + (remove-hook 'ispell-update-post-hook 'follow-post-command-hook t) (remove-hook 'replace-update-post-hook 'follow-post-command-hook t) (remove-hook 'isearch-update-post-hook 'follow-post-command-hook t) @@ -1262,6 +1277,10 @@ non-first windows in Follow mode." ;;; Pre Display Function +(defvar follow-prev-buffer nil + "The buffer current at the last call to `follow-adjust-window' or nil. +follow-mode is not necessarily enabled in this buffer.") + ;; This function is added to `pre-display-function' and is thus called ;; before each redisplay operation. It supersedes (2018-09) the ;; former use of the post command hook, and now does the right thing @@ -1310,6 +1329,24 @@ non-first windows in Follow mode." (defun follow-adjust-window (win) ;; Adjust the window WIN and its followers. (cl-assert (eq (window-buffer win) (current-buffer))) + + ;; Have we moved out of or into a follow-mode window group? + ;; If so, attend to the visibility of the cursors. + (when (not (eq (current-buffer) follow-prev-buffer)) + ;; Do we need to switch off cursor handling in the previous buffer? + (when (buffer-live-p follow-prev-buffer) + (with-current-buffer follow-prev-buffer + (when (and follow-mode + (local-variable-p 'cursor-in-non-selected-windows)) + (setq cursor-in-non-selected-windows + (default-value 'cursor-in-non-selected-windows))))) + ;; Do we need to switch on cursor handling in the current buffer? + (when (and follow-mode + (local-variable-p 'cursor-in-non-selected-windows)) + (setq cursor-in-non-selected-windows nil)) + (when (buffer-live-p (current-buffer)) + (setq follow-prev-buffer (current-buffer)))) + (when (and follow-mode (not (window-minibuffer-p win))) (let ((windows (follow-all-followers win))) commit a4e40f6cb091f06d3edf5b9c4a2700f6eea88432 Author: Eli Zaretskii Date: Fri Oct 19 11:58:53 2018 +0300 ; * doc/emacs/files.texi (Reverting): Improve wording in last change. diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index c1d25af35c..61aa2fc301 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -927,9 +927,10 @@ approximately the same part of the text as before. But if you have made major changes, point may end up in a totally different location. Reverting marks the buffer as not modified. However, it adds the -reverted changes as a single modification to the buffer's undo -history (@pxref{Undo}). Thus, after reverting, you can do @kbd{C-/} -to bring the reverted changes back, if you happen to change your mind. +reverted changes as a single modification to the buffer's undo history +(@pxref{Undo}). Thus, after reverting, you can type @kbd{C-/} or its +aliases to bring the reverted changes back, if you happen to change +your mind. Some kinds of buffers that are not associated with files, such as Dired buffers, can also be reverted. For them, reverting means commit f632ecbb998ccec6442cbf1e6d76a2d63af3e9e2 Author: Mauro Aranda Date: Thu Oct 18 11:28:18 2018 -0300 Update revert-buffer documentation * doc/emacs/files.texi (Reverting): Document that revert-buffer does keep undo history. (Bug#33084) Copyright-paperwork-exempt: yes diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index e950767c38..c1d25af35c 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -926,10 +926,10 @@ way that, if the file was edited only slightly, you will be at approximately the same part of the text as before. But if you have made major changes, point may end up in a totally different location. - Reverting marks the buffer as not modified. It also clears the -buffer's undo history (@pxref{Undo}). Thus, the reversion cannot be -undone---if you change your mind yet again, you can't use the undo -commands to bring the reverted changes back. + Reverting marks the buffer as not modified. However, it adds the +reverted changes as a single modification to the buffer's undo +history (@pxref{Undo}). Thus, after reverting, you can do @kbd{C-/} +to bring the reverted changes back, if you happen to change your mind. Some kinds of buffers that are not associated with files, such as Dired buffers, can also be reverted. For them, reverting means commit 2510126388c7732d6ff02bfeda59fe1af0968b1f Author: Martin Rudalics Date: Fri Oct 19 08:51:03 2018 +0200 Have 'split-window' handle 'up' and 'down' values (Bug#32790) * lisp/window.el (split-window): Handle values of 'up' and 'down' for SIDE argument (Bug#32790). (window-in-direction): Amend doc-string as of yesterday's change. diff --git a/lisp/window.el b/lisp/window.el index e7f54cee56..27d7e42280 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -2262,14 +2262,14 @@ SIDE can be any of the symbols `left', `top', `right' or "Return window in DIRECTION as seen from WINDOW. More precisely, return the nearest window in direction DIRECTION as seen from the position of `window-point' in window WINDOW. -DIRECTION must be one of `above', `below', `left' or `right'. +DIRECTION should be one of 'above', 'below', 'left' or 'right'. WINDOW must be a live window and defaults to the selected one. -Do not return a window whose `no-other-window' parameter is -non-nil. If the nearest window's `no-other-window' parameter is +Do not return a window whose 'no-other-window' parameter is +non-nil. If the nearest window's 'no-other-window' parameter is non-nil, try to find another window in the indicated direction. If, however, the optional argument IGNORE is non-nil, return that -window even if its `no-other-window' parameter is non-nil. +window even if its 'no-other-window' parameter is non-nil. Optional argument SIGN a negative number means to use the right or bottom edge of WINDOW as reference position instead of @@ -2278,7 +2278,7 @@ top edge of WINDOW as reference position. Optional argument WRAP non-nil means to wrap DIRECTION around frame borders. This means to return for WINDOW at the top of the -frame and DIRECTION `above' the minibuffer window if the frame +frame and DIRECTION 'above' the minibuffer window if the frame has one, and a window at the bottom of the frame otherwise. Optional argument MINI nil means to return the minibuffer window @@ -4917,26 +4917,29 @@ absolute value can be less than `window-min-height' or small as one line or two columns. SIZE defaults to half of WINDOW's size. -Optional third argument SIDE nil (or `below') specifies that the -new window shall be located below WINDOW. SIDE `above' means the +Optional third argument SIDE nil (or 'below') specifies that the +new window shall be located below WINDOW. SIDE 'above' means the new window shall be located above WINDOW. In both cases SIZE specifies the new number of lines for WINDOW (or the new window if SIZE is negative) including space reserved for the mode and/or header line. -SIDE t (or `right') specifies that the new window shall be -located on the right side of WINDOW. SIDE `left' means the new +SIDE t (or 'right') specifies that the new window shall be +located on the right side of WINDOW. SIDE 'left' means the new window shall be located on the left of WINDOW. In both cases SIZE specifies the new number of columns for WINDOW (or the new window provided SIZE is negative) including space reserved for -fringes and the scrollbar or a divider column. Any other non-nil -value for SIDE is currently handled like t (or `right'). +fringes and the scrollbar or a divider column. + +For compatibility reasons, SIDE 'up' and 'down' are interpreted +as 'above' and 'below'. Any other non-nil value for SIDE is +currently handled like t (or 'right'). PIXELWISE, if non-nil, means to interpret SIZE pixelwise. If the variable `ignore-window-parameters' is non-nil or the -`split-window' parameter of WINDOW equals t, do not process any -parameters of WINDOW. Otherwise, if the `split-window' parameter +'split-window' parameter of WINDOW equals t, do not process any +parameters of WINDOW. Otherwise, if the 'split-window' parameter of WINDOW specifies a function, call that function with all three arguments and return the value returned by that function. @@ -4952,6 +4955,8 @@ frame. The selected window is not changed by this function." (setq window (window-normalize-window window)) (let* ((side (cond ((not side) 'below) + ((eq side 'up) 'above) + ((eq side 'down) 'below) ((memq side '(below above right left)) side) (t 'right))) (horizontal (not (memq side '(below above)))) @@ -4975,10 +4980,10 @@ frame. The selected window is not changed by this function." (catch 'done (cond ;; Ignore window parameters if either `ignore-window-parameters' - ;; is t or the `split-window' parameter equals t. + ;; is t or the 'split-window' parameter equals t. ((or ignore-window-parameters (eq function t))) ((functionp function) - ;; The `split-window' parameter specifies the function to call. + ;; The 'split-window' parameter specifies the function to call. ;; If that function is `ignore', do nothing. (throw 'done (funcall function window size side))) ;; If WINDOW is part of an atomic window, split the root window @@ -5011,10 +5016,10 @@ frame. The selected window is not changed by this function." (setq window-combination-limit t)) (let* ((parent-pixel-size - ;; `parent-pixel-size' is the pixel size of WINDOW's + ;; 'parent-pixel-size' is the pixel size of WINDOW's ;; parent, provided it has one. (when parent (window-size parent horizontal t))) - ;; `resize' non-nil means we are supposed to resize other + ;; 'resize' non-nil means we are supposed to resize other ;; windows in WINDOW's combination. (resize (and window-combination-resize @@ -5023,9 +5028,9 @@ frame. The selected window is not changed by this function." (not (eq window-combination-limit t)) ;; Resize makes sense in iso-combinations only. (window-combined-p window horizontal))) - ;; `old-pixel-size' is the current pixel size of WINDOW. + ;; 'old-pixel-size' is the current pixel size of WINDOW. (old-pixel-size (window-size window horizontal t)) - ;; `new-size' is the specified or calculated size of the + ;; 'new-size' is the specified or calculated size of the ;; new window. new-pixel-size new-parent new-normal) (cond commit 7aaf9d8a7d314224a9a423286ebf289b60640039 Author: Juri Linkov Date: Fri Oct 19 02:09:15 2018 +0300 * lisp/emacs-lisp/lisp.el (delete-pair): Add optional prefix arg. (Bug#32896) diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 5a89923f8f..3fda1dd618 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -723,11 +723,13 @@ This command assumes point is not in a string or comment." (interactive "P") (insert-pair arg ?\( ?\))) -(defun delete-pair () - "Delete a pair of characters enclosing the sexp that follows point." - (interactive) - (save-excursion (forward-sexp 1) (delete-char -1)) - (delete-char 1)) +(defun delete-pair (&optional arg) + "Delete a pair of characters enclosing ARG sexps following point. +A negative ARG deletes a pair of characters around preceding ARG sexps." + (interactive "p") + (unless arg (setq arg 1)) + (save-excursion (forward-sexp arg) (delete-char (if (> arg 0) -1 1))) + (delete-char (if (> arg 0) 1 -1))) (defun raise-sexp (&optional arg) "Raise ARG sexps higher up the tree." commit e37825fe2a39d07320b508f66568ece67d752d48 Author: Juri Linkov Date: Fri Oct 19 02:01:54 2018 +0300 Use buffer objects for non-writable states in window-state-get. * lisp/window.el (window--state-get-1): Use buffer objects for buffer, next-buffers, prev-buffers if 'writable' is nil. (Bug#32850) diff --git a/lisp/window.el b/lisp/window.el index 47dbf0e1c8..e7f54cee56 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -5584,7 +5584,7 @@ specific buffers." (let ((point (window-point window)) (start (window-start window))) `((buffer - ,(buffer-name buffer) + ,(if writable (buffer-name buffer) buffer) (selected . ,selected) (hscroll . ,(window-hscroll window)) (fringes . ,(window-fringes window)) @@ -5604,20 +5604,20 @@ specific buffers." (with-current-buffer buffer (copy-marker start)))))))) ,@(when next-buffers - `((next-buffers . ,(mapcar (lambda (buffer) - (buffer-name buffer)) - next-buffers)))) + `((next-buffers + . ,(if writable + (mapcar (lambda (buffer) (buffer-name buffer)) + next-buffers) + next-buffers)))) ,@(when prev-buffers - `((prev-buffers . - ,(mapcar (lambda (entry) - (list (buffer-name (nth 0 entry)) - (if writable - (marker-position (nth 1 entry)) - (nth 1 entry)) - (if writable - (marker-position (nth 2 entry)) - (nth 2 entry)))) - prev-buffers)))))) + `((prev-buffers + . ,(if writable + (mapcar (lambda (entry) + (list (buffer-name (nth 0 entry)) + (marker-position (nth 1 entry)) + (marker-position (nth 2 entry)))) + prev-buffers) + prev-buffers)))))) (tail (when (memq type '(vc hc)) (let (list) commit f35916ce510968cf32a34cc32ebc21dd9be30443 Author: Stefan Monnier Date: Thu Oct 18 12:17:52 2018 -0400 * lisp/emacs-lisp/package.el (package-get-version): New macro diff --git a/etc/NEWS b/etc/NEWS index b46dcae9c2..2ebe5a16a2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -414,6 +414,9 @@ This enables more efficient backends. See the docstring of ** Package +*** New macro `package-get-version` lets packages query their own version +Example use in auctex.el: (defconst auctex-version (package-get-version)) + *** New 'package-quickstart' feature. When 'package-quickstart' is non-nil, package.el precomputes a big autoloads file so that activation of packages can be done much faster, which can speed up diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 2ddab65363..06e9956da4 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -689,8 +689,9 @@ PKG-DESC is a `package-desc' object." Load the autoloads file, and ensure `load-path' is setup. If RELOAD is non-nil, also load all files in the package that correspond to previously loaded files." - (let* ((loaded-files-list (when reload - (package--list-loaded-files (package-desc-dir pkg-desc))))) + (let* ((loaded-files-list + (when reload + (package--list-loaded-files (package-desc-dir pkg-desc))))) ;; Add to load path, add autoloads, and activate the package. (package--activate-autoloads-and-load-path pkg-desc) ;; Call `load' on all files in `package-desc-dir' already present in @@ -3450,6 +3451,36 @@ The list is displayed in a buffer named `*Packages*'." (interactive) (list-packages t)) +;;;###autoload +(defmacro package-get-version () + "Return the version number of the package in which this is used. +Assumes it is used from an Elisp file placed inside the top-level directory +of an installed ELPA package. +The return value is a string (or nil in case we can't find it)." + ;; Hack alert! + (let ((file + (or (if (boundp 'byte-compile-current-file) byte-compile-current-file) + load-file-name + buffer-file-name))) + (cond + ((null file) nil) + ;; Packages are normally installed into directories named "-", + ;; so get the version number from there. + ((string-match "/[^/]+-\\([0-9]\\(?:[0-9.]\\|pre\\|beta\\|alpha\\|snapshot\\)+\\)/[^/]+\\'" file) + (match-string 1 file)) + ;; For packages run straight from the an elpa.git clone, there's no + ;; "-" in the directory name, so we have to fetch the version + ;; the hard way. + (t + (let* ((pkgdir (file-name-directory file)) + (pkgname (file-name-nondirectory (directory-file-name pkgdir))) + (mainfile (expand-file-name (concat pkgname ".el") pkgdir))) + (when (file-readable-p mainfile) + (with-temp-buffer + (insert-file-contents mainfile) + (or (lm-header "package-version") + (lm-header "version"))))))))) + ;;;; Quickstart: precompute activation actions for faster start up. ;; Activating packages via `package-initialize' is costly: for N installed commit 46106eec16ddb2294e06f9e482b9183777b90014 Author: Martin Rudalics Date: Thu Oct 18 09:11:30 2018 +0200 Have 'window-in-direction' handle 'up' and 'down' values (Bug#32790) * lisp/window.el (window-in-direction): Handle values of 'up' and 'down' for DIRECTION argument (Bug#32790). Suggested by Juri Linkov . * lisp/windmove.el (windmove-find-other-window): Don't convert first argument of 'window-in-direction'. diff --git a/lisp/windmove.el b/lisp/windmove.el index f565068409..42e10b591f 100644 --- a/lisp/windmove.el +++ b/lisp/windmove.el @@ -464,12 +464,7 @@ movement is relative to." (defun windmove-find-other-window (dir &optional arg window) "Return the window object in direction DIR. DIR, ARG, and WINDOW are handled as by `windmove-other-window-loc'." - (window-in-direction - (cond - ((eq dir 'up) 'above) - ((eq dir 'down) 'below) - (t dir)) - window nil arg windmove-wrap-around t)) + (window-in-direction dir window nil arg windmove-wrap-around t)) ;; Selects the window that's hopefully at the location returned by ;; `windmove-other-window-loc', or screams if there's no window there. diff --git a/lisp/window.el b/lisp/window.el index a7318308ef..47dbf0e1c8 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -2288,8 +2288,13 @@ if WRAP is non-nil, always act as if MINI were nil. Return nil if no suitable window can be found." (setq window (window-normalize-window window t)) - (unless (memq direction '(above below left right)) - (error "Wrong direction %s" direction)) + (cond + ((eq direction 'up) + (setq direction 'above)) + ((eq direction 'down) + (setq direction 'below)) + ((not (memq direction '(above below left right))) + (error "Wrong direction %s" direction))) (let* ((frame (window-frame window)) (hor (memq direction '(left right))) (first (if hor commit e511b9dd6a91ef37e87903182578a0d48cbacece Author: Paul Eggert Date: Wed Oct 17 17:55:43 2018 -0700 Bring back nocombreloc if dumping Without this patch, Emacs dumps core on Fedora 28 x86-64 when configured via "CC='gcc -m32' --enable-gcc-warnings --without-imagemagick --without-gif --with-modules PKG_CONFIG_LIBDIR=/usr/lib/pkgconfig:/usr/share/pkgconfig". and then when run normally in a windowing system. 'make check' and 'emacs -nw' work OK even without the patch. * configure.ac (LD_SWITCH_SYSTEM_TEMACS): Prepend -znocombreloc if supported and if dumping. This mostly reverts 2018-06-15T21:37:39!eggert@cs.ucla.edu "Remove old combreloc hack". diff --git a/configure.ac b/configure.ac index bfd9d5d177..3a61090902 100644 --- a/configure.ac +++ b/configure.ac @@ -1336,6 +1336,37 @@ else ac_link="$ac_link $NON_GCC_LINK_TEST_OPTIONS" fi +dnl On some platforms using GNU ld, linking temacs needs -znocombreloc. +dnl Although this has something to do with dumping, the details are unknown. +dnl If the flag is used but not needed, +dnl Emacs should still work (albeit a bit more slowly), +dnl so use the flag everywhere that it is supported. +dnl When testing whether the flag works, treat GCC specially +dnl since it just gives a non-fatal 'unrecognized option' +dnl if not built to support GNU ld. +if test "$GCC" = yes; then + LDFLAGS_NOCOMBRELOC="-Wl,-znocombreloc" +else + LDFLAGS_NOCOMBRELOC="-znocombreloc" +fi + +AC_CACHE_CHECK([for -znocombreloc], [emacs_cv_znocombreloc], + [if test "$CANNOT_DUMP" = "yes"; then + emacs_cv_znocombreloc='not needed' + else + save_LDFLAGS=$LDFLAGS + LDFLAGS="$LDFLAGS $LDFLAGS_NOCOMBRELOC" + AC_LINK_IFELSE([AC_LANG_PROGRAM([], [])], + [emacs_cv_znocombreloc=yes], [emacs_cv_znocombreloc=no]) + LDFLAGS=$save_LDFLAGS + fi]) + +case $emacs_cv_znocombreloc in + no*) + LDFLAGS_NOCOMBRELOC= ;; +esac + + AC_CACHE_CHECK([whether addresses are sanitized], [emacs_cv_sanitize_address], [AC_COMPILE_IFELSE( @@ -5346,6 +5377,8 @@ if test x$ac_enable_profiling != x ; then esac fi +LD_SWITCH_SYSTEM_TEMACS="$LDFLAGS_NOCOMBRELOC $LD_SWITCH_SYSTEM_TEMACS" + AC_SUBST(LD_SWITCH_SYSTEM_TEMACS) ## Common for all window systems diff --git a/etc/PROBLEMS b/etc/PROBLEMS index eba3420fcb..6805e8733d 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -192,6 +192,18 @@ Upgrading to a newer version of Exceed has been reported to prevent these crashes. You should consider switching to a free X server, such as Xming or Cygwin/X. +** Emacs crashes with SIGSEGV in XtInitializeWidgetClass. + +It crashes on X, but runs fine when called with option "-nw". + +This has been observed when Emacs is linked with GNU ld but without passing +the -z nocombreloc flag. Emacs normally knows to pass the -z nocombreloc +flag when needed, so if you come across a situation where the flag is +necessary but missing, please report it via M-x report-emacs-bug. + +On platforms such as Solaris, you can also work around this problem by +configuring your compiler to use the native linker instead of GNU ld. + ** When Emacs is compiled with Gtk+, closing a display kills Emacs. There is a long-standing bug in GTK that prevents it from recovering commit eb6768977effe5994b6fe3afcfa262465ba631ab Author: Juri Linkov Date: Thu Oct 18 01:24:43 2018 +0300 * lisp/mail/smtpmail.el (smtpmail-send-queued-mail): Load file with .el suffix. For the case when load-prefer-newer is t, ensure loading the right file by explicitly adding the .el suffix. Use the same variable names as in the function smtpmail-send-it. (Bug#33055) diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index 571089d214..baf50dd01b 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -402,21 +402,22 @@ The list is in preference order.") (with-temp-buffer ;; Get index, get first mail, send it, update index, get second ;; mail, send it, etc... - (let ((file-msg "") + (let (file-data file-elisp (qfile (expand-file-name smtpmail-queue-index-file smtpmail-queue-dir)) result) (insert-file-contents qfile) (goto-char (point-min)) (while (not (eobp)) - (setq file-msg (buffer-substring (point) (line-end-position))) - (load file-msg) + (setq file-data (buffer-substring (point) (line-end-position))) + (setq file-elisp (concat file-data ".el")) + (load file-elisp) ;; Insert the message literally: it is already encoded as per ;; the MIME headers, and code conversions might guess the ;; encoding wrongly. (with-temp-buffer (let ((coding-system-for-read 'no-conversion)) - (insert-file-contents file-msg)) + (insert-file-contents file-data)) (let ((smtpmail-mail-address (or (and mail-specify-envelope-from (mail-envelope-from)) user-mail-address))) @@ -426,8 +427,8 @@ The list is in preference order.") (current-buffer))) (error "Sending failed: %s" result)) (error "Sending failed; no recipients")))) - (delete-file file-msg) - (delete-file (concat file-msg ".el")) + (delete-file file-data) + (delete-file file-elisp) (delete-region (point-at-bol) (point-at-bol 2))) (write-region (point-min) (point-max) qfile)))) commit 73567432329a245b2eb02e4c61adea2c8eab6b3a Author: Eli Zaretskii Date: Wed Oct 17 18:19:47 2018 +0300 Avoid assertion violation when comparing with main-thread * src/thread.c (unmark_main_thread): New function. * src/lisp.h (unmark_main_thread): Prototype it. * src/alloc.c (garbage_collect_1): Call it after sweeping. (Bug#33073) * test/src/thread-tests.el (threads-test-bug33073): New test. diff --git a/src/alloc.c b/src/alloc.c index 3b150797c3..0e48b33882 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -5863,6 +5863,8 @@ garbage_collect_1 (void *end) VECTOR_UNMARK (&buffer_defaults); VECTOR_UNMARK (&buffer_local_symbols); + unmark_main_thread (); + check_cons_list (); gc_in_progress = 0; diff --git a/src/lisp.h b/src/lisp.h index a7a26ef350..145901dff5 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4011,6 +4011,7 @@ extern void syms_of_module (void); /* Defined in thread.c. */ extern void mark_threads (void); +extern void unmark_main_thread (void); /* Defined in editfns.c. */ extern void insert1 (Lisp_Object); diff --git a/src/thread.c b/src/thread.c index fc933440fc..3674af0e47 100644 --- a/src/thread.c +++ b/src/thread.c @@ -656,6 +656,12 @@ mark_threads (void) flush_stack_call_func (mark_threads_callback, NULL); } +void +unmark_main_thread (void) +{ + main_thread.header.size &= ~ARRAY_MARK_FLAG; +} + static void diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el index 109e71128a..36bb637790 100644 --- a/test/src/thread-tests.el +++ b/test/src/thread-tests.el @@ -388,4 +388,8 @@ (should (= (length (all-threads)) 1)) (should (equal (thread-last-error) '(error "Die, die, die!"))))) +(ert-deftest threads-test-bug33073 () + (let ((th (make-thread 'ignore))) + (should-not (equal th main-thread)))) + ;;; threads.el ends here commit 134ba45bf0c11048c44a46c11d5dc8da12ca4d3e Author: Federico Tedin Date: Wed Oct 17 08:34:51 2018 +0200 Allow two mouse functions to work with Rectangle Mark mode * lisp/mouse.el (mouse-save-then-kill): Make mouse-save-then-kill work with rectangular regions, including when mouse-drag-copy-region is set to t. (Bug#31240) (mouse-drag-and-drop-region): Allow dragging and dropping rectangular regions. (Bug#31240) * rect.el (rectangle-intersect-p) (rectangle-position-as-coordinates): New functions. diff --git a/lisp/mouse.el b/lisp/mouse.el index cb63ca51c5..44cca4c868 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -29,6 +29,8 @@ ;;; Code: +(eval-when-compile (require 'rect)) + ;;; Utility functions. ;; Indent track-mouse like progn. @@ -1606,8 +1608,8 @@ if `mouse-drag-copy-region' is non-nil)" (if mouse-drag-copy-region ;; Region already saved in the previous click; ;; don't make a duplicate entry, just delete. - (delete-region (mark t) (point)) - (kill-region (mark t) (point))) + (funcall region-extract-function 'delete-only) + (kill-region (mark t) (point) 'region)) (setq mouse-selection-click-count 0) (setq mouse-save-then-kill-posn nil)) @@ -1632,7 +1634,7 @@ if `mouse-drag-copy-region' is non-nil)" (mouse-set-region-1) (when mouse-drag-copy-region ;; Region already copied to kill-ring once, so replace. - (kill-new (filter-buffer-substring (mark t) (point)) t)) + (kill-new (funcall region-extract-function nil) t)) ;; Arrange for a repeated mouse-3 to kill the region. (setq mouse-save-then-kill-posn click-pt))) @@ -2411,7 +2413,16 @@ is copied instead of being cut." (buffer (current-buffer)) (window (selected-window)) (text-from-read-only buffer-read-only) - (mouse-drag-and-drop-overlay (make-overlay start end)) + ;; Use multiple overlays to cover cases where the region is + ;; rectangular. + (mouse-drag-and-drop-overlays (mapcar (lambda (bounds) + (make-overlay (car bounds) + (cdr bounds))) + (region-bounds))) + (region-noncontiguous (region-noncontiguous-p)) + (region-width (- (overlay-end (car mouse-drag-and-drop-overlays)) + (overlay-start (car mouse-drag-and-drop-overlays)))) + (region-height (length mouse-drag-and-drop-overlays)) point-to-paste point-to-paste-read-only window-to-paste @@ -2455,7 +2466,11 @@ is copied instead of being cut." ;; Obtain the dragged text in region. When the loop was ;; skipped, value-selection remains nil. (unless value-selection - (setq value-selection (buffer-substring start end)) + (setq value-selection (funcall region-extract-function nil)) + ;; Remove yank-handler property in order to re-insert text using + ;; the `insert-rectangle' function later on. + (remove-text-properties 0 (length value-selection) + '(yank-handler) value-selection) (when mouse-drag-and-drop-region-show-tooltip (let ((text-size mouse-drag-and-drop-region-show-tooltip)) (setq text-tooltip @@ -2468,12 +2483,18 @@ is copied instead of being cut." value-selection)))) ;; Check if selected text is read-only. - (setq text-from-read-only (or text-from-read-only - (get-text-property start 'read-only) - (not (equal - (next-single-char-property-change - start 'read-only nil end) - end))))) + (setq text-from-read-only + (or text-from-read-only + (get-text-property start 'read-only) + (get-text-property end 'read-only) + (catch 'loop + (dolist (bound (region-bounds)) + (unless (equal + (next-single-char-property-change + (car bound) 'read-only nil (cdr bound)) + (cdr bound)) + (throw 'loop t))))))) + (setq window-to-paste (posn-window (event-end event))) (setq point-to-paste (posn-point (event-end event))) ;; Set nil when target buffer is minibuffer. @@ -2499,13 +2520,34 @@ is copied instead of being cut." ;; the original region. When modifier is pressed, the ;; text will be inserted to inside of the original ;; region. + ;; + ;; If the region is rectangular, check if the newly inserted + ;; rectangular text would intersect the already selected + ;; region. If it would, then set "drag-but-negligible" to t. + ;; As a special case, allow dragging the region freely anywhere + ;; to the left, as this will never trigger its contents to be + ;; inserted into the overlays tracking it. (setq drag-but-negligible - (and (eq (overlay-buffer mouse-drag-and-drop-overlay) + (and (eq (overlay-buffer (car mouse-drag-and-drop-overlays)) buffer-to-paste) - (<= (overlay-start mouse-drag-and-drop-overlay) - point-to-paste) - (<= point-to-paste - (overlay-end mouse-drag-and-drop-overlay))))) + (if region-noncontiguous + (let ((size (cons region-width region-height)) + (start-coordinates + (rectangle-position-as-coordinates start)) + (point-to-paste-coordinates + (rectangle-position-as-coordinates + point-to-paste))) + (and (rectangle-intersect-p + start-coordinates size + point-to-paste-coordinates size) + (not (<= (car point-to-paste-coordinates) + (car start-coordinates))))) + (and (<= (overlay-start + (car mouse-drag-and-drop-overlays)) + point-to-paste) + (<= point-to-paste + (overlay-end + (car mouse-drag-and-drop-overlays)))))))) ;; Show a tooltip. (if mouse-drag-and-drop-region-show-tooltip @@ -2524,8 +2566,9 @@ is copied instead of being cut." (t 'bar))) (when cursor-in-text-area - (overlay-put mouse-drag-and-drop-overlay - 'face 'mouse-drag-and-drop-region) + (dolist (overlay mouse-drag-and-drop-overlays) + (overlay-put overlay + 'face 'mouse-drag-and-drop-region)) (deactivate-mark) ; Maintain region in other window. (mouse-set-point event))))) @@ -2581,7 +2624,9 @@ is copied instead of being cut." (select-window window) (goto-char point) (setq deactivate-mark nil) - (activate-mark)) + (activate-mark) + (when region-noncontiguous + (rectangle-mark-mode))) ;; Modify buffers. (t ;; * DESTINATION BUFFER:: @@ -2590,11 +2635,17 @@ is copied instead of being cut." (setq window-exempt window-to-paste) (goto-char point-to-paste) (push-mark) - (insert value-selection) + + (if region-noncontiguous + (insert-rectangle (split-string value-selection "\n")) + (insert value-selection)) + ;; On success, set the text as region on destination buffer. (when (not (equal (mark) (point))) (setq deactivate-mark nil) - (activate-mark)) + (activate-mark) + (when region-noncontiguous + (rectangle-mark-mode))) ;; * SOURCE BUFFER:: ;; Set back the original text as region or delete the original @@ -2604,8 +2655,9 @@ is copied instead of being cut." ;; remove the original text. (when no-modifier-on-drop (let (deactivate-mark) - (delete-region (overlay-start mouse-drag-and-drop-overlay) - (overlay-end mouse-drag-and-drop-overlay)))) + (dolist (overlay mouse-drag-and-drop-overlays) + (delete-region (overlay-start overlay) + (overlay-end overlay))))) ;; When source buffer and destination buffer are different, ;; keep (set back the original text as region) or remove the ;; original text. @@ -2615,15 +2667,17 @@ is copied instead of being cut." (if mouse-drag-and-drop-region-cut-when-buffers-differ ;; Remove the dragged text from source buffer like ;; operation `cut'. - (delete-region (overlay-start mouse-drag-and-drop-overlay) - (overlay-end mouse-drag-and-drop-overlay)) + (dolist (overlay mouse-drag-and-drop-overlays) + (delete-region (overlay-start overlay) + (overlay-end overlay))) ;; Set back the dragged text as region on source buffer ;; like operation `copy'. (activate-mark)) (select-window window-to-paste)))))) ;; Clean up. - (delete-overlay mouse-drag-and-drop-overlay) + (dolist (overlay mouse-drag-and-drop-overlays) + (delete-overlay overlay)) ;; Restore old states but for the window where the drop ;; occurred. Restore cursor types for all windows. diff --git a/lisp/rect.el b/lisp/rect.el index 8ccf051ee1..48db4ffd8f 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -167,6 +167,37 @@ The final point after the last operation will be returned." (<= (point) endpt)))) final-point))) +(defun rectangle-position-as-coordinates (position) + "Return cons of the column and line values of POSITION. +POSITION specifies a position of the current buffer. The value +returned is a cons of the current column of POSITION and its line +number." + (save-excursion + (goto-char position) + (let ((col (current-column)) + (line (1- (line-number-at-pos)))) + (cons col line)))) + +(defun rectangle-intersect-p (pos1 size1 pos2 size2) + "Return non-nil if two rectangles intersect. +POS1 and POS2 specify the positions of the upper-left corners of +the first and second rectangle as conses of their column and line +values. SIZE1 and SIZE2 specify the dimensions of the first and +second rectangle, as conses of their width and height measured in +columns and lines." + (let ((x1 (car pos1)) + (y1 (cdr pos1)) + (x2 (car pos2)) + (y2 (cdr pos2)) + (w1 (car size1)) + (h1 (cdr size1)) + (w2 (car size2)) + (h2 (cdr size2))) + (not (or (<= (+ x1 w1) x2) + (<= (+ x2 w2) x1) + (<= (+ y1 h1) y2) + (<= (+ y2 h2) y1))))) + (defun delete-rectangle-line (startcol endcol fill) (when (= (move-to-column startcol (if fill t 'coerce)) startcol) (delete-region (point) commit e64065bbbd21b7136a7a4efb4b0f2f39a65905dd Author: Juri Linkov Date: Wed Oct 17 01:36:33 2018 +0300 Use next-buffers and prev-buffers in window-state-get and window-state-put * lisp/window.el (window--state-get-1): Get next-buffers and prev-buffers. (window--state-put-2): Set next-buffers and prev-buffers. (Bug#32850) diff --git a/lisp/window.el b/lisp/window.el index 8ff8497768..a7318308ef 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -5541,6 +5541,10 @@ specific buffers." (t 'leaf))) (buffer (window-buffer window)) (selected (eq window (selected-window))) + (next-buffers (when (window-live-p window) + (window-next-buffers window))) + (prev-buffers (when (window-live-p window) + (window-prev-buffers window))) (head `(,type ,@(unless (window-next-sibling window) `((last . t))) @@ -5593,7 +5597,22 @@ specific buffers." (start . ,(if writable start (with-current-buffer buffer - (copy-marker start)))))))))) + (copy-marker start)))))))) + ,@(when next-buffers + `((next-buffers . ,(mapcar (lambda (buffer) + (buffer-name buffer)) + next-buffers)))) + ,@(when prev-buffers + `((prev-buffers . + ,(mapcar (lambda (entry) + (list (buffer-name (nth 0 entry)) + (if writable + (marker-position (nth 1 entry)) + (nth 1 entry)) + (if writable + (marker-position (nth 2 entry)) + (nth 2 entry)))) + prev-buffers)))))) (tail (when (memq type '(vc hc)) (let (list) @@ -5736,7 +5755,9 @@ value can be also stored on disk and read back in a new session." (let ((window (car item)) (combination-limit (cdr (assq 'combination-limit item))) (parameters (cdr (assq 'parameters item))) - (state (cdr (assq 'buffer item)))) + (state (cdr (assq 'buffer item))) + (next-buffers (cdr (assq 'next-buffers item))) + (prev-buffers (cdr (assq 'prev-buffers item)))) (when combination-limit (set-window-combination-limit window combination-limit)) ;; Reset window's parameters and assign saved ones (we might want @@ -5748,7 +5769,8 @@ value can be also stored on disk and read back in a new session." (set-window-parameter window (car parameter) (cdr parameter)))) ;; Process buffer related state. (when state - (let ((buffer (get-buffer (car state)))) + (let ((buffer (get-buffer (car state))) + (state (cdr state))) (if buffer (with-current-buffer buffer (set-window-buffer window buffer) @@ -5817,7 +5839,30 @@ value can be also stored on disk and read back in a new session." (set-window-point window (cdr (assq 'point state)))) ;; Select window if it's the selected one. (when (cdr (assq 'selected state)) - (select-window window))) + (select-window window)) + (when next-buffers + (set-window-next-buffers + window + (delq nil (mapcar (lambda (buffer) + (setq buffer (get-buffer buffer)) + (when (buffer-live-p buffer) buffer)) + next-buffers)))) + (when prev-buffers + (set-window-prev-buffers + window + (delq nil (mapcar (lambda (entry) + (let ((buffer (get-buffer (nth 0 entry))) + (m1 (nth 1 entry)) + (m2 (nth 2 entry))) + (when (buffer-live-p buffer) + (list buffer + (if (markerp m1) m1 + (set-marker (make-marker) m1 + buffer)) + (if (markerp m2) m2 + (set-marker (make-marker) m2 + buffer)))))) + prev-buffers))))) ;; We don't want to raise an error in case the buffer does ;; not exist anymore, so we switch to a previous one and ;; save the window with the intention of deleting it later commit 84efc93a5525f85659955b113c427a27c80c2a71 Author: Michael Albinus Date: Tue Oct 16 19:44:16 2018 +0200 Fix Bug#32983 * lisp/net/soap-client.el: Bump version to 3.1.5. (soap-parse-server-response): Handle also "multipart/related" Content-Type. (Bug#32983) diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el index f5de05dc3d..7c409665e4 100644 --- a/lisp/net/soap-client.el +++ b/lisp/net/soap-client.el @@ -5,7 +5,7 @@ ;; Author: Alexandru Harsanyi ;; Author: Thomas Fitzsimmons ;; Created: December, 2009 -;; Version: 3.1.4 +;; Version: 3.1.5 ;; Keywords: soap, web-services, comm, hypermedia ;; Package: soap-client ;; Homepage: https://github.com/alex-hhh/emacs-soap-client @@ -2337,6 +2337,14 @@ traverse an element tree." (defun soap-parse-server-response () "Error-check and parse the XML contents of the current buffer." (let ((mime-part (mm-dissect-buffer t t))) + (when (and + (equal (mm-handle-media-type mime-part) "multipart/related") + (equal (get-text-property 0 'type (mm-handle-media-type mime-part)) + "text/xml")) + (setq mime-part + (mm-make-handle + (get-text-property 0 'buffer (mm-handle-media-type mime-part)) + `(,(get-text-property 0 'type (mm-handle-media-type mime-part)))))) (unless mime-part (error "Failed to decode response from server")) (unless (equal (car (mm-handle-type mime-part)) "text/xml") commit 433e364add25dcc32f5103ec28f58298e00204d5 Author: Eli Zaretskii Date: Tue Oct 16 18:48:21 2018 +0300 ; * etc/NEWS: Announce that emacs-module.h is now installed. diff --git a/etc/NEWS b/etc/NEWS index bfd7db016f..dfafe7c5c9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -25,6 +25,12 @@ webkit2gtk-4.0 package; version 2.12 or later is required. (This change was actually made in Emacs 26.1, but was not called out in its NEWS.) ++++ +** Installing Emacs now installs the emacs-module.h file. +The emacs-module.h file is now installed in the system-wide include +directory as part of the Emacs installation. This allows to build +Emacs modules outside of the Emacs source tree. + * Startup Changes in Emacs 26.2 commit e456ddaa304edbe5cca3c5561764ebf9dd4b6732 Author: Glenn Morris Date: Wed Oct 3 16:47:01 2018 -0400 Tweak Makefile emacs-module.h handling * Makefile.in (install-arch-indep, uninstall): Respect DESTDIR. Handle whitespace. Remove non-portable mkdir argument. (cherry picked from commit c1d0dbd6ca92cb221024382b19654e4fbf1d1ed3) diff --git a/Makefile.in b/Makefile.in index 7749818165..f48f785fcc 100644 --- a/Makefile.in +++ b/Makefile.in @@ -561,8 +561,8 @@ set_installuser=for installuser in $${LOGNAME} $${USERNAME} $${USER} \ ## See also these comments from 2004 about cp -r working fine: ## https://lists.gnu.org/r/autoconf-patches/2004-11/msg00005.html install-arch-indep: lisp install-info install-man ${INSTALL_ARCH_INDEP_EXTRA} - umask 022 && $(MKDIR_P) -m 0755 $(includedir) - $(INSTALL_DATA) src/emacs-module.h $(includedir)/emacs-module.h + umask 022 && $(MKDIR_P) "$(DESTDIR)$(includedir)" + $(INSTALL_DATA) src/emacs-module.h "$(DESTDIR)$(includedir)/emacs-module.h" -set ${COPYDESTS} ; \ unset CDPATH; \ $(set_installuser); \ @@ -746,7 +746,7 @@ install-strip: ### ### Don't delete the lisp and etc directories if they're in the source tree. uninstall: uninstall-$(NTDIR) uninstall-doc - rm -f $(includedir)/emacs-module.h + rm -f "$(DESTDIR)$(includedir)/emacs-module.h" $(MAKE) -C lib-src uninstall -unset CDPATH; \ for dir in "$(DESTDIR)${lispdir}" "$(DESTDIR)${etcdir}" ; do \ commit 1dce1b2ffb67907afff2cac62bb05361dac815e4 Author: Philipp Stephani Date: Thu Sep 20 14:03:29 2018 +0200 Install emacs-module.h (Bug#31929) * Makefile.in (includedir): New variable. (install-arch-indep): Install emacs-module.h. (uninstall): Uninstall emacs-module.h. (cherry picked from commit 00ea749f2af44bff6ea8c1259477fbf0ead8a306) diff --git a/Makefile.in b/Makefile.in index 19bf7c423f..7749818165 100644 --- a/Makefile.in +++ b/Makefile.in @@ -151,6 +151,9 @@ libexecdir=@libexecdir@ # Currently only used for the systemd service file. libdir=@libdir@ +# Where to install emacs-module.h. +includedir=@includedir@ + # Where to install Emacs's man pages. # Note they contain cross-references that expect them to be in section 1. mandir=@mandir@ @@ -558,6 +561,8 @@ set_installuser=for installuser in $${LOGNAME} $${USERNAME} $${USER} \ ## See also these comments from 2004 about cp -r working fine: ## https://lists.gnu.org/r/autoconf-patches/2004-11/msg00005.html install-arch-indep: lisp install-info install-man ${INSTALL_ARCH_INDEP_EXTRA} + umask 022 && $(MKDIR_P) -m 0755 $(includedir) + $(INSTALL_DATA) src/emacs-module.h $(includedir)/emacs-module.h -set ${COPYDESTS} ; \ unset CDPATH; \ $(set_installuser); \ @@ -741,6 +746,7 @@ install-strip: ### ### Don't delete the lisp and etc directories if they're in the source tree. uninstall: uninstall-$(NTDIR) uninstall-doc + rm -f $(includedir)/emacs-module.h $(MAKE) -C lib-src uninstall -unset CDPATH; \ for dir in "$(DESTDIR)${lispdir}" "$(DESTDIR)${etcdir}" ; do \ commit 722833d30e609655de4675dd5c25eb8460947f93 Merge: 76a6417baf 73babba26a Author: Glenn Morris Date: Tue Oct 16 08:08:04 2018 -0700 Merge from origin/emacs-26 73babba (origin/emacs-26) Clarify documentation of fractional vertica... b20c51d * lisp/isearch.el (isearch-cmds): Recall absent isearch--stat... 700acbd doc/lispref/edebug.texi (Specification List) Remove obstrusiv... 1902450 Fix wording in module API documentation e724a8f Fix redisplay of glyphless characters 8fc892d Update --without-toolkit-scroll-bars doc 80e0bfa Call GTK functions only on GTK scrollbars 91c4c46 Update the description of startup in ELisp manual 18b42c6 Use the 'line-number' face for line-number fields past EOB a6ab8db Ensure NS frame is redrawn correctly after scroll Conflicts: lisp/isearch.el commit 76a6417baf8ad5e2513b19f63e27c5c913555329 Author: Michael Albinus Date: Tue Oct 16 15:58:45 2018 +0200 Add process thread to list-processes * lisp/simple.el (process-menu-mode, list-processes--refresh): Add process thread. diff --git a/lisp/simple.el b/lisp/simple.el index 96128c6b9b..562a9124b5 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -3959,6 +3959,7 @@ support pty association, if PROGRAM is nil." ;; name "*Async Shell Command*<10>" (bug#30016) ("Buffer" 25 t) ("TTY" 12 t) + ("Thread" 12 t) ("Command" 0 t)]) (make-local-variable 'process-menu-query-only) (setq tabulated-list-sort-key (cons "Process" nil)) @@ -4000,6 +4001,11 @@ Also, delete any process that is exited or signaled." action process-menu-visit-buffer) "--")) (tty (or (process-tty-name p) "--")) + (thread + (cond + ((null (process-thread p)) "--") + ((eq (process-thread p) main-thread) "Main") + ((thread-name (process-thread p))))) (cmd (if (memq type '(network serial)) (let ((contact (process-contact p t))) @@ -4022,7 +4028,7 @@ Also, delete any process that is exited or signaled." (format " at %s b/s" speed) ""))))) (mapconcat 'identity (process-command p) " ")))) - (push (list p (vector name pid status buf-label tty cmd)) + (push (list p (vector name pid status buf-label tty thread cmd)) tabulated-list-entries))))) (tabulated-list-init-header)) commit e07ced013c1ff1469e0cfa019bbfa2438c879919 Author: Stefan Monnier Date: Mon Oct 15 22:44:37 2018 -0400 * doc/lispref/display.texi (Fringe Bitmaps): Remove redundant items diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 9a6fb422f0..b4a4d6c454 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -4170,10 +4170,10 @@ Used to indicate continued lines. @item @code{right-triangle}, @code{left-triangle} The former is used by overlay arrows. The latter is unused. -@item @code{up-arrow}, @code{down-arrow}, @code{top-left-angle} @code{top-right-angle} +@item @code{up-arrow}, @code{down-arrow} @itemx @code{bottom-left-angle}, @code{bottom-right-angle} -@itemx @code{top-right-angle}, @code{top-left-angle} -@itemx @code{left-bracket}, @code{right-bracket}, @code{top-right-angle}, @code{top-left-angle} +@itemx @code{top-left-angle}, @code{top-right-angle} +@itemx @code{left-bracket}, @code{right-bracket} Used to indicate buffer boundaries. @item @code{filled-rectangle}, @code{hollow-rectangle} @@ -4181,7 +4181,7 @@ Used to indicate buffer boundaries. @itemx @code{vertical-bar}, @code{horizontal-bar} Used for different types of fringe cursors. -@item @code{empty-line}, @code{exclamation-mark}, @code{question-mark}, @code{exclamation-mark} +@item @code{empty-line}, @code{exclamation-mark}, @code{question-mark} Not used by core Emacs features. @end table commit 6716eb24cfc5b21be5232acdc8c743dd0de81b41 Author: Stefan Monnier Date: Mon Oct 15 22:31:54 2018 -0400 * lisp/image-mode.el (image-toggle-display-image): Avoid string-make-unibyte diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 97c23e6748..606c66143a 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -145,7 +145,7 @@ otherwise it defaults to t, used for times when the buffer is not displayed." (unless (listp image-mode-winprops-alist) (setq image-mode-winprops-alist nil)) (add-hook 'window-configuration-change-hook - 'image-mode-reapply-winprops nil t)) + #'image-mode-reapply-winprops nil t)) ;;; Image scrolling functions @@ -572,8 +572,8 @@ Key bindings: ;; Keep track of [vh]scroll when switching buffers (image-mode-setup-winprops) - (add-hook 'change-major-mode-hook 'image-toggle-display-text nil t) - (add-hook 'after-revert-hook 'image-after-revert-hook nil t) + (add-hook 'change-major-mode-hook #'image-toggle-display-text nil t) + (add-hook 'after-revert-hook #'image-after-revert-hook nil t) (run-mode-hooks 'image-mode-hook) (let ((image (image-get-display-property)) (msg1 (substitute-command-keys @@ -725,10 +725,14 @@ was inserted." (not (and (boundp 'epa-file-encrypt-to) (local-variable-p 'epa-file-encrypt-to)))))) - (file-or-data (if data-p - (string-make-unibyte - (buffer-substring-no-properties (point-min) (point-max))) - filename)) + (file-or-data + (if data-p + (let ((str + (buffer-substring-no-properties (point-min) (point-max)))) + (if enable-multibyte-characters + (encode-coding-string str buffer-file-coding-system) + str)) + filename)) ;; If we have a `fit-width' or a `fit-height', don't limit ;; the size of the image to the window size. (edges (and (null image-transform-resize) commit d9d5b2b7af69ff4697ab0be8e9c4a83e06eb8367 Author: Stefan Monnier Date: Mon Oct 15 21:24:14 2018 -0400 * lisp/progmodes/octave.el: Register on auto-mode-alist (octave-maybe-mode): New function. diff --git a/etc/NEWS b/etc/NEWS index 946a823173..b46dcae9c2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -287,6 +287,10 @@ in (info "(emacs) Directory Variables") * Changes in Specialized Modes and Packages in Emacs 27.1 +** Octave mode +The mode is automatically enabled in files that start with the +'function' keyword. + ** project.el *** New commands project-search and project-query-replace diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index 984bb73c73..13510eef80 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -170,8 +170,8 @@ parenthetical grouping.") (modify-syntax-entry ?. "." table) (modify-syntax-entry ?\" "\"" table) (modify-syntax-entry ?_ "_" table) - ;; The "b" flag only applies to the second letter of the comstart - ;; and the first letter of the comend, i.e. the "4b" below is ineffective. + ;; The "b" flag only applies to the second letter of the comstart and + ;; the first letter of the comend, i.e. a "4b" below would be ineffective. ;; If we try to put `b' on the single-line comments, we get a similar ;; problem where the % and # chars appear as first chars of the 2-char ;; comend, so the multi-line ender is also turned into style-b. @@ -533,6 +533,27 @@ Non-nil means always go to the next Octave code line after sending." (defvar electric-layout-rules) +;; FIXME: cc-mode.el also adds an entry for .m files, mapping them to +;; objc-mode. We here rely on the fact that loaddefs.el is filled in +;; alphabetical order, so cc-mode.el comes before octave-mode.el, which lets +;; our entry come first! +;;;###autoload (add-to-list 'auto-mode-alist '("\\.m\\'" . octave-maybe-mode)) + +;;;###autoload +(defun octave-maybe-mode () + "Select `octave-mode' if the current buffer seems to hold Octave code." + (if (save-excursion + (with-syntax-table octave-mode-syntax-table + (goto-char (point-min)) + (forward-comment (point-max)) + ;; FIXME: What about Octave files which don't start with "function"? + (looking-at "function"))) + (octave-mode) + (let ((x (rassq 'octave-maybe-mode auto-mode-alist))) + (when x + (let ((auto-mode-alist (remove x auto-mode-alist))) + (set-auto-mode)))))) + ;;;###autoload (define-derived-mode octave-mode prog-mode "Octave" "Major mode for editing Octave code. commit 5a4bfbbd450b50908558b95fcc2080e0b3877cb1 Author: Stefan Monnier Date: Mon Oct 15 20:16:28 2018 -0400 * etc/NEWS.18: Tweak header to be more like the others diff --git a/etc/NEWS.18 b/etc/NEWS.18 index ab76c3c772..81b1a39654 100644 --- a/etc/NEWS.18 +++ b/etc/NEWS.18 @@ -810,7 +810,7 @@ The client/server work only on Berkeley Unix, since they use the Berkeley sockets mechanism for their communication. -* Changes in Lisp programming in Emacs 18. +* Changes in Lisp programming in Emacs 18 ** Init file changes. commit 987956ae24b8311cf8ab4735d0147cb6a4bc370a Author: Juri Linkov Date: Tue Oct 16 01:30:56 2018 +0300 * lisp/image-mode.el (image--imagemagick-wanted-p): Check for file extension. (Bug#32994) (image-toggle-display-text): Let-bind create-lockfiles to nil like in image-toggle-display-image. diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 19fa28d440..97c23e6748 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -692,6 +692,7 @@ on these modes." Remove text properties that display the image." (let ((inhibit-read-only t) (buffer-undo-list t) + (create-lockfiles nil) ; avoid changing dir mtime by lock_file (modified (buffer-modified-p))) (remove-list-of-text-properties (point-min) (point-max) '(display read-nonsticky ;; intangible @@ -781,8 +782,9 @@ was inserted." (defun image--imagemagick-wanted-p (filename) (and (fboundp 'imagemagick-types) (not (eq imagemagick-types-inhibit t)) - (not (memq (intern (upcase (file-name-extension filename)) obarray) - imagemagick-types-inhibit)))) + (not (and (file-name-extension filename) + (memq (intern (upcase (file-name-extension filename)) obarray) + imagemagick-types-inhibit))))) (defun image-toggle-hex-display () "Toggle between image and hex display." commit 96df6043bdd67507a7e3289ef2611e077933deb4 Author: Stefan Monnier Date: Mon Oct 15 16:30:52 2018 -0400 * lisp/textmodes/tex-mode.el (tex-uptodate-p): Recognize [N.N] pages diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index c223af4769..8b0677754f 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -1170,7 +1170,7 @@ subshell is initiated, `tex-shell-hook' is run." (setq-local fill-indent-according-to-mode t) (add-hook 'completion-at-point-functions #'latex-complete-data nil 'local) - (add-hook 'flymake-diagnostic-functions 'tex-chktex nil t) + (add-hook 'flymake-diagnostic-functions #'tex-chktex nil t) (setq-local outline-regexp latex-outline-regexp) (setq-local outline-level #'latex-outline-level) (setq-local forward-sexp-function #'latex-forward-sexp) @@ -1261,8 +1261,8 @@ Entering SliTeX mode runs the hook `text-mode-hook', then the hook (setq-local comment-start-skip "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\)\\(%+ *\\)") (setq-local parse-sexp-ignore-comments t) - (setq-local compare-windows-whitespace 'tex-categorize-whitespace) - (setq-local facemenu-add-face-function 'tex-facemenu-add-face-function) + (setq-local compare-windows-whitespace #'tex-categorize-whitespace) + (setq-local facemenu-add-face-function #'tex-facemenu-add-face-function) (setq-local facemenu-end-add-face "}") (setq-local facemenu-remove-face-function t) (setq-local font-lock-defaults @@ -1591,7 +1591,7 @@ Puts point on a blank line between them." (defvar latex-complete-bibtex-cache nil) (define-obsolete-function-alias 'latex-string-prefix-p - 'string-prefix-p "24.3") + #'string-prefix-p "24.3") (defvar bibtex-reference-key) (declare-function reftex-get-bibfile-list "reftex-cite.el" ()) @@ -2109,7 +2109,7 @@ If NOT-ALL is non-nil, save the `.dvi' file." (delete-file (concat dir (car list)))) (setq list (cdr list)))))) -(add-hook 'kill-emacs-hook 'tex-delete-last-temp-files) +(add-hook 'kill-emacs-hook #'tex-delete-last-temp-files) ;; ;; Machinery to guess the command that the user wants to execute. @@ -2168,7 +2168,7 @@ IN can be either a string (with the same % escapes in it) indicating OUT describes the output file and is either a %-escaped string or nil to indicate that there is no output file.") -(define-obsolete-function-alias 'tex-string-prefix-p 'string-prefix-p "24.3") +(define-obsolete-function-alias 'tex-string-prefix-p #'string-prefix-p "24.3") (defun tex-guess-main-file (&optional all) "Find a likely `tex-main-file'. @@ -2263,9 +2263,11 @@ FILE is typically the output DVI or PDF file." (> (save-excursion ;; Usually page numbers are output as [N], but ;; I've already seen things like - ;; [1{/var/lib/texmf/fonts/map/pdftex/updmap/pdftex.map}] - (or (re-search-backward "\\[[0-9]+\\({[^}]*}\\)?\\]" - nil t) + ;; [N{/var/lib/texmf/fonts/map/pdftex/updmap/pdftex.map}] + ;; as well as [N.N] (e.g. with 'acmart' style). + (or (re-search-backward + "\\[[0-9]+\\({[^}]*}\\|\\.[0-9]+\\)?\\]" + nil t) (point-min))) (save-excursion (or (re-search-backward "Rerun" nil t) @@ -2993,7 +2995,7 @@ There might be text before point." (lambda (x) (pcase (car-safe x) (`font-lock-syntactic-face-function - (cons (car x) 'doctex-font-lock-syntactic-face-function)) + (cons (car x) #'doctex-font-lock-syntactic-face-function)) (_ x))) (cdr font-lock-defaults)))) (setq-local syntax-propertize-function commit 1439d89f4dd3c156ddd4f6877075ffe76456c21a Author: Alan Mackenzie Date: Mon Oct 15 19:48:25 2018 +0000 In follow mode, prevent the cursor resting on a partially displayed line This fixes bug #32848 * lisp/follow.el (follow-adjust-window): If point ends up in a partially displayed line in a left hand or middle window, move it one line forward, to prevent unwanted scrolling should make-cursor-line-fully-visible be non-nil. diff --git a/lisp/follow.el b/lisp/follow.el index e2d3a11b65..b44df423d6 100644 --- a/lisp/follow.el +++ b/lisp/follow.el @@ -1405,7 +1405,13 @@ non-first windows in Follow mode." (unless (eq win (selected-window)) (let ((p (window-point win))) (set-window-start win (window-start win) nil) - (set-window-point win p)))) + (if (nth 2 (pos-visible-in-window-p p win t)) + ;; p is in a partially visible line. We can't leave + ;; window-point there, because C-x o back into WIN + ;; would then fail. + (with-selected-window win + (forward-line)) ; redisplay will recenter it in WIN. + (set-window-point win p))))) (unless visible ;; If point may not be visible in the selected window, commit 73babba26aa714c34aa8d9473ba5b55ce110a215 Author: Alan Mackenzie Date: Mon Oct 15 19:04:05 2018 +0000 Clarify documentation of fractional vertical scrolling and some doc strings * doc/lispref/windows.texi (vertical scrolling): Clarify the meaning of vertical scrolling by referring to tall screen lines, images, and the display action. Clarify an ambiguous English tense. * src/window.c (window-vscroll, set-window-vscroll): Amend doc strings to refer to display. diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 265067146d..960573d865 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -4200,18 +4200,20 @@ point at the middle, top, and bottom of the window. @cindex vertical scroll position @dfn{Vertical fractional scrolling} means shifting text in a window -up or down by a specified multiple or fraction of a line. Each window -has a @dfn{vertical scroll position}, which is a number, never less than -zero. It specifies how far to raise the contents of the window. -Raising the window contents generally makes all or part of some lines -disappear off the top, and all or part of some other lines appear at the -bottom. The usual value is zero. +up or down by a specified multiple or fraction of a line. Emacs uses +it, for example, on images and screen lines which are taller than the +window. Each window has a @dfn{vertical scroll position}, which is a +number, never less than zero. It specifies how far to raise the +contents of the window when displaying them. Raising the window +contents generally makes all or part of some lines disappear off the +top, and all or part of some other lines appear at the bottom. The +usual value is zero. The vertical scroll position is measured in units of the normal line height, which is the height of the default font. Thus, if the value is -.5, that means the window contents are scrolled up half the normal line -height. If it is 3.3, that means the window contents are scrolled up -somewhat over three times the normal line height. +.5, that means the window contents will be scrolled up half the normal +line height. If it is 3.3, that means the window contents are scrolled +up somewhat over three times the normal line height. What fraction of a line the vertical scrolling covers, or how many lines, depends on what the lines contain. A value of .5 could scroll a diff --git a/src/window.c b/src/window.c index 409b01f302..9026a7b5f2 100644 --- a/src/window.c +++ b/src/window.c @@ -7322,6 +7322,8 @@ value. */) DEFUN ("window-vscroll", Fwindow_vscroll, Swindow_vscroll, 0, 2, 0, doc: /* Return the amount by which WINDOW is scrolled vertically. +This takes effect when displaying tall lines or images. + If WINDOW is omitted or nil, it defaults to the selected window. Normally, value is a multiple of the canonical character height of WINDOW; optional second arg PIXELS-P means value is measured in pixels. */) @@ -7344,6 +7346,8 @@ optional second arg PIXELS-P means value is measured in pixels. */) DEFUN ("set-window-vscroll", Fset_window_vscroll, Sset_window_vscroll, 2, 3, 0, doc: /* Set amount by which WINDOW should be scrolled vertically to VSCROLL. +This takes effect when displaying tall lines or images. + WINDOW nil means use the selected window. Normally, VSCROLL is a non-negative multiple of the canonical character height of WINDOW; optional third arg PIXELS-P non-nil means that VSCROLL is in pixels. commit b20c51d62fe8f64b4b39183d23ec9cffd12f6852 Author: Charles A. Roelli Date: Mon Oct 15 19:51:47 2018 +0200 * lisp/isearch.el (isearch-cmds): Recall absent isearch--state slot. diff --git a/lisp/isearch.el b/lisp/isearch.el index 3725779703..31571e11cd 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -590,7 +590,7 @@ variable by the command `isearch-toggle-lax-whitespace'.") "Stack of search status elements. Each element is an `isearch--state' struct where the slots are [STRING MESSAGE POINT SUCCESS FORWARD OTHER-END WORD - ERROR WRAPPED BARRIER CASE-FOLD-SEARCH]") + ERROR WRAPPED BARRIER CASE-FOLD-SEARCH POP-FUN]") (defvar isearch-string "") ; The current search string. (defvar isearch-message "") ; text-char-description version of isearch-string commit 3d91dc1bb5aeecda786ebe1805c33d14c8bd89fa Author: Paul Eggert Date: Mon Oct 15 00:55:37 2018 -0500 Update lib/regex from glibc via Gnulib This syncs recent refactorings from glibc, and incorporates: 2018-10-15 libc-config: merge from glibc 2018-10-15 regex: depend on libc-config * .gitignore: Do not ignore m4/_*.m4. * lib/cdefs.h: New file, copied from Gnulib. * lib/gnulib.mk.in, m4/gnulib-comp.m4: Regenerate. * lib/libc-config.h, m4/__inline.m4: New files, copied from Gnulib. * lib/regcomp.c, lib/regex.c, lib/regex_internal.c: * lib/regex_internal.h, lib/regexec.c: Copy from glibc via Gnulib. diff --git a/.gitignore b/.gitignore index 26fe4bb34e..8ab4e8d407 100644 --- a/.gitignore +++ b/.gitignore @@ -264,6 +264,7 @@ etc/emacs.tmpdesktop *.in-h _* !lib/_Noreturn.h +!m4/_*.m4 /bin/ /BIN/ /data/ diff --git a/lib/cdefs.h b/lib/cdefs.h new file mode 100644 index 0000000000..2d620cccaf --- /dev/null +++ b/lib/cdefs.h @@ -0,0 +1,514 @@ +/* Copyright (C) 1992-2018 Free Software Foundation, Inc. + This file is part of the GNU C Library. + + The GNU C Library 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. + + The GNU C Library 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 the GNU C Library; if not, see + . */ + +#ifndef _SYS_CDEFS_H +#define _SYS_CDEFS_H 1 + +/* We are almost always included from features.h. */ +#ifndef _FEATURES_H +# include +#endif + +/* The GNU libc does not support any K&R compilers or the traditional mode + of ISO C compilers anymore. Check for some of the combinations not + anymore supported. */ +#if defined __GNUC__ && !defined __STDC__ +# error "You need a ISO C conforming compiler to use the glibc headers" +#endif + +/* Some user header file might have defined this before. */ +#undef __P +#undef __PMT + +#ifdef __GNUC__ + +/* All functions, except those with callbacks or those that + synchronize memory, are leaf functions. */ +# if __GNUC_PREREQ (4, 6) && !defined _LIBC +# define __LEAF , __leaf__ +# define __LEAF_ATTR __attribute__ ((__leaf__)) +# else +# define __LEAF +# define __LEAF_ATTR +# endif + +/* GCC can always grok prototypes. For C++ programs we add throw() + to help it optimize the function calls. But this works only with + gcc 2.8.x and egcs. For gcc 3.2 and up we even mark C functions + as non-throwing using a function attribute since programs can use + the -fexceptions options for C code as well. */ +# if !defined __cplusplus && __GNUC_PREREQ (3, 3) +# define __THROW __attribute__ ((__nothrow__ __LEAF)) +# define __THROWNL __attribute__ ((__nothrow__)) +# define __NTH(fct) __attribute__ ((__nothrow__ __LEAF)) fct +# define __NTHNL(fct) __attribute__ ((__nothrow__)) fct +# else +# if defined __cplusplus && __GNUC_PREREQ (2,8) +# define __THROW throw () +# define __THROWNL throw () +# define __NTH(fct) __LEAF_ATTR fct throw () +# define __NTHNL(fct) fct throw () +# else +# define __THROW +# define __THROWNL +# define __NTH(fct) fct +# define __NTHNL(fct) fct +# endif +# endif + +#else /* Not GCC. */ + +# if (defined __cplusplus \ + || (defined __STDC_VERSION__ && __STDC_VERSION__ >= 199901L)) +# define __inline inline +# else +# define __inline /* No inline functions. */ +# endif + +# define __THROW +# define __THROWNL +# define __NTH(fct) fct + +#endif /* GCC. */ + +/* Compilers that are not clang may object to + #if defined __clang__ && __has_extension(...) + even though they do not need to evaluate the right-hand side of the &&. */ +#if defined __clang__ && defined __has_extension +# define __glibc_clang_has_extension(ext) __has_extension (ext) +#else +# define __glibc_clang_has_extension(ext) 0 +#endif + +/* These two macros are not used in glibc anymore. They are kept here + only because some other projects expect the macros to be defined. */ +#define __P(args) args +#define __PMT(args) args + +/* For these things, GCC behaves the ANSI way normally, + and the non-ANSI way under -traditional. */ + +#define __CONCAT(x,y) x ## y +#define __STRING(x) #x + +/* This is not a typedef so `const __ptr_t' does the right thing. */ +#define __ptr_t void * + + +/* C++ needs to know that types and declarations are C, not C++. */ +#ifdef __cplusplus +# define __BEGIN_DECLS extern "C" { +# define __END_DECLS } +#else +# define __BEGIN_DECLS +# define __END_DECLS +#endif + + +/* Fortify support. */ +#define __bos(ptr) __builtin_object_size (ptr, __USE_FORTIFY_LEVEL > 1) +#define __bos0(ptr) __builtin_object_size (ptr, 0) + +#if __GNUC_PREREQ (4,3) +# define __warndecl(name, msg) \ + extern void name (void) __attribute__((__warning__ (msg))) +# define __warnattr(msg) __attribute__((__warning__ (msg))) +# define __errordecl(name, msg) \ + extern void name (void) __attribute__((__error__ (msg))) +#else +# define __warndecl(name, msg) extern void name (void) +# define __warnattr(msg) +# define __errordecl(name, msg) extern void name (void) +#endif + +/* Support for flexible arrays. + Headers that should use flexible arrays only if they're "real" + (e.g. only if they won't affect sizeof()) should test + #if __glibc_c99_flexarr_available. */ +#if defined __STDC_VERSION__ && __STDC_VERSION__ >= 199901L +# define __flexarr [] +# define __glibc_c99_flexarr_available 1 +#elif __GNUC_PREREQ (2,97) +/* GCC 2.97 supports C99 flexible array members as an extension, + even when in C89 mode or compiling C++ (any version). */ +# define __flexarr [] +# define __glibc_c99_flexarr_available 1 +#elif defined __GNUC__ +/* Pre-2.97 GCC did not support C99 flexible arrays but did have + an equivalent extension with slightly different notation. */ +# define __flexarr [0] +# define __glibc_c99_flexarr_available 1 +#else +/* Some other non-C99 compiler. Approximate with [1]. */ +# define __flexarr [1] +# define __glibc_c99_flexarr_available 0 +#endif + + +/* __asm__ ("xyz") is used throughout the headers to rename functions + at the assembly language level. This is wrapped by the __REDIRECT + macro, in order to support compilers that can do this some other + way. When compilers don't support asm-names at all, we have to do + preprocessor tricks instead (which don't have exactly the right + semantics, but it's the best we can do). + + Example: + int __REDIRECT(setpgrp, (__pid_t pid, __pid_t pgrp), setpgid); */ + +#if defined __GNUC__ && __GNUC__ >= 2 + +# define __REDIRECT(name, proto, alias) name proto __asm__ (__ASMNAME (#alias)) +# ifdef __cplusplus +# define __REDIRECT_NTH(name, proto, alias) \ + name proto __THROW __asm__ (__ASMNAME (#alias)) +# define __REDIRECT_NTHNL(name, proto, alias) \ + name proto __THROWNL __asm__ (__ASMNAME (#alias)) +# else +# define __REDIRECT_NTH(name, proto, alias) \ + name proto __asm__ (__ASMNAME (#alias)) __THROW +# define __REDIRECT_NTHNL(name, proto, alias) \ + name proto __asm__ (__ASMNAME (#alias)) __THROWNL +# endif +# define __ASMNAME(cname) __ASMNAME2 (__USER_LABEL_PREFIX__, cname) +# define __ASMNAME2(prefix, cname) __STRING (prefix) cname + +/* +#elif __SOME_OTHER_COMPILER__ + +# define __REDIRECT(name, proto, alias) name proto; \ + _Pragma("let " #name " = " #alias) +*/ +#endif + +/* GCC has various useful declarations that can be made with the + `__attribute__' syntax. All of the ways we use this do fine if + they are omitted for compilers that don't understand it. */ +#if !defined __GNUC__ || __GNUC__ < 2 +# define __attribute__(xyz) /* Ignore */ +#endif + +/* At some point during the gcc 2.96 development the `malloc' attribute + for functions was introduced. We don't want to use it unconditionally + (although this would be possible) since it generates warnings. */ +#if __GNUC_PREREQ (2,96) +# define __attribute_malloc__ __attribute__ ((__malloc__)) +#else +# define __attribute_malloc__ /* Ignore */ +#endif + +/* Tell the compiler which arguments to an allocation function + indicate the size of the allocation. */ +#if __GNUC_PREREQ (4, 3) +# define __attribute_alloc_size__(params) \ + __attribute__ ((__alloc_size__ params)) +#else +# define __attribute_alloc_size__(params) /* Ignore. */ +#endif + +/* At some point during the gcc 2.96 development the `pure' attribute + for functions was introduced. We don't want to use it unconditionally + (although this would be possible) since it generates warnings. */ +#if __GNUC_PREREQ (2,96) +# define __attribute_pure__ __attribute__ ((__pure__)) +#else +# define __attribute_pure__ /* Ignore */ +#endif + +/* This declaration tells the compiler that the value is constant. */ +#if __GNUC_PREREQ (2,5) +# define __attribute_const__ __attribute__ ((__const__)) +#else +# define __attribute_const__ /* Ignore */ +#endif + +/* At some point during the gcc 3.1 development the `used' attribute + for functions was introduced. We don't want to use it unconditionally + (although this would be possible) since it generates warnings. */ +#if __GNUC_PREREQ (3,1) +# define __attribute_used__ __attribute__ ((__used__)) +# define __attribute_noinline__ __attribute__ ((__noinline__)) +#else +# define __attribute_used__ __attribute__ ((__unused__)) +# define __attribute_noinline__ /* Ignore */ +#endif + +/* Since version 3.2, gcc allows marking deprecated functions. */ +#if __GNUC_PREREQ (3,2) +# define __attribute_deprecated__ __attribute__ ((__deprecated__)) +#else +# define __attribute_deprecated__ /* Ignore */ +#endif + +/* Since version 4.5, gcc also allows one to specify the message printed + when a deprecated function is used. clang claims to be gcc 4.2, but + may also support this feature. */ +#if __GNUC_PREREQ (4,5) || \ + __glibc_clang_has_extension (__attribute_deprecated_with_message__) +# define __attribute_deprecated_msg__(msg) \ + __attribute__ ((__deprecated__ (msg))) +#else +# define __attribute_deprecated_msg__(msg) __attribute_deprecated__ +#endif + +/* At some point during the gcc 2.8 development the `format_arg' attribute + for functions was introduced. We don't want to use it unconditionally + (although this would be possible) since it generates warnings. + If several `format_arg' attributes are given for the same function, in + gcc-3.0 and older, all but the last one are ignored. In newer gccs, + all designated arguments are considered. */ +#if __GNUC_PREREQ (2,8) +# define __attribute_format_arg__(x) __attribute__ ((__format_arg__ (x))) +#else +# define __attribute_format_arg__(x) /* Ignore */ +#endif + +/* At some point during the gcc 2.97 development the `strfmon' format + attribute for functions was introduced. We don't want to use it + unconditionally (although this would be possible) since it + generates warnings. */ +#if __GNUC_PREREQ (2,97) +# define __attribute_format_strfmon__(a,b) \ + __attribute__ ((__format__ (__strfmon__, a, b))) +#else +# define __attribute_format_strfmon__(a,b) /* Ignore */ +#endif + +/* The nonnull function attribute marks pointer parameters that + must not be NULL. Do not define __nonnull if it is already defined, + for portability when this file is used in Gnulib. */ +#ifndef __nonnull +# if __GNUC_PREREQ (3,3) +# define __nonnull(params) __attribute__ ((__nonnull__ params)) +# else +# define __nonnull(params) +# endif +#endif + +/* If fortification mode, we warn about unused results of certain + function calls which can lead to problems. */ +#if __GNUC_PREREQ (3,4) +# define __attribute_warn_unused_result__ \ + __attribute__ ((__warn_unused_result__)) +# if defined __USE_FORTIFY_LEVEL && __USE_FORTIFY_LEVEL > 0 +# define __wur __attribute_warn_unused_result__ +# endif +#else +# define __attribute_warn_unused_result__ /* empty */ +#endif +#ifndef __wur +# define __wur /* Ignore */ +#endif + +/* Forces a function to be always inlined. */ +#if __GNUC_PREREQ (3,2) +/* The Linux kernel defines __always_inline in stddef.h (283d7573), and + it conflicts with this definition. Therefore undefine it first to + allow either header to be included first. */ +# undef __always_inline +# define __always_inline __inline __attribute__ ((__always_inline__)) +#else +# undef __always_inline +# define __always_inline __inline +#endif + +/* Associate error messages with the source location of the call site rather + than with the source location inside the function. */ +#if __GNUC_PREREQ (4,3) +# define __attribute_artificial__ __attribute__ ((__artificial__)) +#else +# define __attribute_artificial__ /* Ignore */ +#endif + +/* GCC 4.3 and above with -std=c99 or -std=gnu99 implements ISO C99 + inline semantics, unless -fgnu89-inline is used. Using __GNUC_STDC_INLINE__ + or __GNUC_GNU_INLINE is not a good enough check for gcc because gcc versions + older than 4.3 may define these macros and still not guarantee GNU inlining + semantics. + + clang++ identifies itself as gcc-4.2, but has support for GNU inlining + semantics, that can be checked fot by using the __GNUC_STDC_INLINE_ and + __GNUC_GNU_INLINE__ macro definitions. */ +#if (!defined __cplusplus || __GNUC_PREREQ (4,3) \ + || (defined __clang__ && (defined __GNUC_STDC_INLINE__ \ + || defined __GNUC_GNU_INLINE__))) +# if defined __GNUC_STDC_INLINE__ || defined __cplusplus +# define __extern_inline extern __inline __attribute__ ((__gnu_inline__)) +# define __extern_always_inline \ + extern __always_inline __attribute__ ((__gnu_inline__)) +# else +# define __extern_inline extern __inline +# define __extern_always_inline extern __always_inline +# endif +#endif + +#ifdef __extern_always_inline +# define __fortify_function __extern_always_inline __attribute_artificial__ +#endif + +/* GCC 4.3 and above allow passing all anonymous arguments of an + __extern_always_inline function to some other vararg function. */ +#if __GNUC_PREREQ (4,3) +# define __va_arg_pack() __builtin_va_arg_pack () +# define __va_arg_pack_len() __builtin_va_arg_pack_len () +#endif + +/* It is possible to compile containing GCC extensions even if GCC is + run in pedantic mode if the uses are carefully marked using the + `__extension__' keyword. But this is not generally available before + version 2.8. */ +#if !__GNUC_PREREQ (2,8) +# define __extension__ /* Ignore */ +#endif + +/* __restrict is known in EGCS 1.2 and above. */ +#if !__GNUC_PREREQ (2,92) +# if defined __STDC_VERSION__ && __STDC_VERSION__ >= 199901L +# define __restrict restrict +# else +# define __restrict /* Ignore */ +# endif +#endif + +/* ISO C99 also allows to declare arrays as non-overlapping. The syntax is + array_name[restrict] + GCC 3.1 supports this. */ +#if __GNUC_PREREQ (3,1) && !defined __GNUG__ +# define __restrict_arr __restrict +#else +# ifdef __GNUC__ +# define __restrict_arr /* Not supported in old GCC. */ +# else +# if defined __STDC_VERSION__ && __STDC_VERSION__ >= 199901L +# define __restrict_arr restrict +# else +/* Some other non-C99 compiler. */ +# define __restrict_arr /* Not supported. */ +# endif +# endif +#endif + +#if __GNUC__ >= 3 +# define __glibc_unlikely(cond) __builtin_expect ((cond), 0) +# define __glibc_likely(cond) __builtin_expect ((cond), 1) +#else +# define __glibc_unlikely(cond) (cond) +# define __glibc_likely(cond) (cond) +#endif + +#ifdef __has_attribute +# define __glibc_has_attribute(attr) __has_attribute (attr) +#else +# define __glibc_has_attribute(attr) 0 +#endif + +#if (!defined _Noreturn \ + && (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) < 201112 \ + && !__GNUC_PREREQ (4,7)) +# if __GNUC_PREREQ (2,8) +# define _Noreturn __attribute__ ((__noreturn__)) +# else +# define _Noreturn +# endif +#endif + +#if __GNUC_PREREQ (8, 0) +/* Describes a char array whose address can safely be passed as the first + argument to strncpy and strncat, as the char array is not necessarily + a NUL-terminated string. */ +# define __attribute_nonstring__ __attribute__ ((__nonstring__)) +#else +# define __attribute_nonstring__ +#endif + +#if (!defined _Static_assert && !defined __cplusplus \ + && (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) < 201112 \ + && (!__GNUC_PREREQ (4, 6) || defined __STRICT_ANSI__)) +# define _Static_assert(expr, diagnostic) \ + extern int (*__Static_assert_function (void)) \ + [!!sizeof (struct { int __error_if_negative: (expr) ? 2 : -1; })] +#endif + +/* The #ifndef lets Gnulib avoid including these on non-glibc + platforms, where the includes typically do not exist. */ +#ifndef __WORDSIZE +# include +# include +#endif + +#if defined __LONG_DOUBLE_MATH_OPTIONAL && defined __NO_LONG_DOUBLE_MATH +# define __LDBL_COMPAT 1 +# ifdef __REDIRECT +# define __LDBL_REDIR1(name, proto, alias) __REDIRECT (name, proto, alias) +# define __LDBL_REDIR(name, proto) \ + __LDBL_REDIR1 (name, proto, __nldbl_##name) +# define __LDBL_REDIR1_NTH(name, proto, alias) __REDIRECT_NTH (name, proto, alias) +# define __LDBL_REDIR_NTH(name, proto) \ + __LDBL_REDIR1_NTH (name, proto, __nldbl_##name) +# define __LDBL_REDIR1_DECL(name, alias) \ + extern __typeof (name) name __asm (__ASMNAME (#alias)); +# define __LDBL_REDIR_DECL(name) \ + extern __typeof (name) name __asm (__ASMNAME ("__nldbl_" #name)); +# define __REDIRECT_LDBL(name, proto, alias) \ + __LDBL_REDIR1 (name, proto, __nldbl_##alias) +# define __REDIRECT_NTH_LDBL(name, proto, alias) \ + __LDBL_REDIR1_NTH (name, proto, __nldbl_##alias) +# endif +#endif +#if !defined __LDBL_COMPAT || !defined __REDIRECT +# define __LDBL_REDIR1(name, proto, alias) name proto +# define __LDBL_REDIR(name, proto) name proto +# define __LDBL_REDIR1_NTH(name, proto, alias) name proto __THROW +# define __LDBL_REDIR_NTH(name, proto) name proto __THROW +# define __LDBL_REDIR_DECL(name) +# ifdef __REDIRECT +# define __REDIRECT_LDBL(name, proto, alias) __REDIRECT (name, proto, alias) +# define __REDIRECT_NTH_LDBL(name, proto, alias) \ + __REDIRECT_NTH (name, proto, alias) +# endif +#endif + +/* __glibc_macro_warning (MESSAGE) issues warning MESSAGE. This is + intended for use in preprocessor macros. + + Note: MESSAGE must be a _single_ string; concatenation of string + literals is not supported. */ +#if __GNUC_PREREQ (4,8) || __glibc_clang_prereq (3,5) +# define __glibc_macro_warning1(message) _Pragma (#message) +# define __glibc_macro_warning(message) \ + __glibc_macro_warning1 (GCC warning message) +#else +# define __glibc_macro_warning(msg) +#endif + +/* Generic selection (ISO C11) is a C-only feature, available in GCC + since version 4.9. Previous versions do not provide generic + selection, even though they might set __STDC_VERSION__ to 201112L, + when in -std=c11 mode. Thus, we must check for !defined __GNUC__ + when testing __STDC_VERSION__ for generic selection support. + On the other hand, Clang also defines __GNUC__, so a clang-specific + check is required to enable the use of generic selection. */ +#if !defined __cplusplus \ + && (__GNUC_PREREQ (4, 9) \ + || __glibc_clang_has_extension (c_generic_selections) \ + || (!defined __GNUC__ && defined __STDC_VERSION__ \ + && __STDC_VERSION__ >= 201112L)) +# define __HAVE_GENERIC_SELECTION 1 +#else +# define __HAVE_GENERIC_SELECTION 0 +#endif + +#endif /* sys/cdefs.h */ diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 431d0c0b77..982d3c5c29 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -1040,6 +1040,7 @@ gamegroup = @gamegroup@ gameuser = @gameuser@ gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7 = @gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7@ gl_GNULIB_ENABLED_2049e887c7e5308faad27b3f894bb8c9 = @gl_GNULIB_ENABLED_2049e887c7e5308faad27b3f894bb8c9@ +gl_GNULIB_ENABLED_21ee726a3540c09237a8e70c0baf7467 = @gl_GNULIB_ENABLED_21ee726a3540c09237a8e70c0baf7467@ gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b = @gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b@ gl_GNULIB_ENABLED_37f71b604aa9c54446783d80f42fe547 = @gl_GNULIB_ENABLED_37f71b604aa9c54446783d80f42fe547@ gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31 = @gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31@ @@ -1900,6 +1901,17 @@ EXTRA_DIST += inttypes.in.h endif ## end gnulib module inttypes-incomplete +## begin gnulib module libc-config +ifeq (,$(OMIT_GNULIB_MODULE_libc-config)) + +ifneq (,$(gl_GNULIB_ENABLED_21ee726a3540c09237a8e70c0baf7467)) + +endif +EXTRA_DIST += cdefs.h libc-config.h + +endif +## end gnulib module libc-config + ## begin gnulib module limits-h ifeq (,$(OMIT_GNULIB_MODULE_limits-h)) diff --git a/lib/libc-config.h b/lib/libc-config.h new file mode 100644 index 0000000000..d7b40935cd --- /dev/null +++ b/lib/libc-config.h @@ -0,0 +1,174 @@ +/* System definitions for code taken from the GNU C Library + + Copyright 2017-2018 Free Software Foundation, Inc. + + This program 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. + + This program 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 this program; if not, see + . */ + +/* Written by Paul Eggert. */ + +/* This is intended to be a good-enough substitute for glibc system + macros like those defined in , so that Gnulib code + shared with glibc can do this as the first #include: + + #ifndef _LIBC + # include + #endif + + When compiled as part of glibc this is a no-op; when compiled as + part of Gnulib this includes Gnulib's and defines macros + that glibc library code would normally assume. */ + +#include + +/* On glibc this includes and and #defines + _FEATURES_H, __WORDSIZE, and __set_errno. On FreeBSD 11 it + includes which defines __nonnull. Elsewhere it + is harmless. */ +#include + +/* From glibc . */ +#ifndef __set_errno +# define __set_errno(val) (errno = (val)) +#endif + +/* From glibc . */ + +#ifndef __GNUC_PREREQ +# if defined __GNUC__ && defined __GNUC_MINOR__ +# define __GNUC_PREREQ(maj, min) ((maj) < __GNUC__ + ((min) <= __GNUC_MINOR__)) +# else +# define __GNUC_PREREQ(maj, min) 0 +# endif +#endif + +#ifndef __glibc_clang_prereq +# if defined __clang_major__ && defined __clang_minor__ +# define __glibc_clang_prereq(maj, min) \ + ((maj) < __clang_major__ + ((min) <= __clang_minor__)) +# else +# define __glibc_clang_prereq(maj, min) 0 +# endif +#endif + + +/* Prepare to include , which is our copy of glibc + . */ + +/* Define _FEATURES_H so that does not include . */ +#ifndef _FEATURES_H +# define _FEATURES_H 1 +#endif +/* Define __WORDSIZE so that does not attempt to include + nonexistent files. Make it a syntax error, since Gnulib does not + use __WORDSIZE now, and if Gnulib uses it later the syntax error + will let us know that __WORDSIZE needs configuring. */ +#ifndef __WORDSIZE +# define __WORDSIZE %%% +#endif +/* Undef the macros unconditionally defined by our copy of glibc + , so that they do not clash with any system-defined + versions. */ +#undef _SYS_CDEFS_H +#undef __ASMNAME +#undef __ASMNAME2 +#undef __BEGIN_DECLS +#undef __CONCAT +#undef __END_DECLS +#undef __HAVE_GENERIC_SELECTION +#undef __LDBL_COMPAT +#undef __LDBL_REDIR +#undef __LDBL_REDIR1 +#undef __LDBL_REDIR1_DECL +#undef __LDBL_REDIR1_NTH +#undef __LDBL_REDIR_DECL +#undef __LDBL_REDIR_NTH +#undef __LEAF +#undef __LEAF_ATTR +#undef __NTH +#undef __NTHNL +#undef __P +#undef __PMT +#undef __REDIRECT +#undef __REDIRECT_LDBL +#undef __REDIRECT_NTH +#undef __REDIRECT_NTHNL +#undef __REDIRECT_NTH_LDBL +#undef __STRING +#undef __THROW +#undef __THROWNL +#undef __always_inline +#undef __attribute__ +#undef __attribute_alloc_size__ +#undef __attribute_artificial__ +#undef __attribute_const__ +#undef __attribute_deprecated__ +#undef __attribute_deprecated_msg__ +#undef __attribute_format_arg__ +#undef __attribute_format_strfmon__ +#undef __attribute_malloc__ +#undef __attribute_noinline__ +#undef __attribute_nonstring__ +#undef __attribute_pure__ +#undef __attribute_used__ +#undef __attribute_warn_unused_result__ +#undef __bos +#undef __bos0 +#undef __errordecl +#undef __extension__ +#undef __extern_always_inline +#undef __extern_inline +#undef __flexarr +#undef __fortify_function +#undef __glibc_c99_flexarr_available +#undef __glibc_clang_has_extension +#undef __glibc_likely +#undef __glibc_macro_warning +#undef __glibc_macro_warning1 +#undef __glibc_unlikely +#undef __inline +#undef __ptr_t +#undef __restrict +#undef __restrict_arr +#undef __va_arg_pack +#undef __va_arg_pack_len +#undef __warnattr +#undef __warndecl + +/* Include our copy of glibc . */ +#include + +/* __inline is too pessimistic for non-GCC. */ +#undef __inline +#ifndef HAVE___INLINE +# if 199901 <= __STDC_VERSION__ || defined inline +# define __inline inline +# else +# define __inline +# endif +#endif + + +/* A substitute for glibc , good enough for Gnulib. */ +#define attribute_hidden +#define libc_hidden_proto(name, ...) +#define libc_hidden_def(name) +#define libc_hidden_weak(name) +#define libc_hidden_ver(local, name) +#define strong_alias(name, aliasname) +#define weak_alias(name, aliasname) + +/* A substitute for glibc , good enough for Gnulib. */ +#define SHLIB_COMPAT(lib, introduced, obsoleted) 0 +#define versioned_symbol(lib, local, symbol, version) diff --git a/lib/regcomp.c b/lib/regcomp.c index 0e4816c89c..0b05a63b63 100644 --- a/lib/regcomp.c +++ b/lib/regcomp.c @@ -476,7 +476,7 @@ regcomp (regex_t *_Restrict_ preg, const char *_Restrict_ pattern, int cflags) /* Try to allocate space for the fastmap. */ preg->fastmap = re_malloc (char, SBC_MAX); - if (BE (preg->fastmap == NULL, 0)) + if (__glibc_unlikely (preg->fastmap == NULL)) return REG_ESPACE; syntax |= (cflags & REG_ICASE) ? RE_ICASE : 0; @@ -502,7 +502,7 @@ regcomp (regex_t *_Restrict_ preg, const char *_Restrict_ pattern, int cflags) ret = REG_EPAREN; /* We have already checked preg->fastmap != NULL. */ - if (BE (ret == REG_NOERROR, 1)) + if (__glibc_likely (ret == REG_NOERROR)) /* Compute the fastmap now, since regexec cannot modify the pattern buffer. This function never fails in this implementation. */ (void) re_compile_fastmap (preg); @@ -529,10 +529,9 @@ regerror (int errcode, const regex_t *_Restrict_ preg, char *_Restrict_ errbuf, { const char *msg; size_t msg_size; + int nerrcodes = sizeof __re_error_msgid_idx / sizeof __re_error_msgid_idx[0]; - if (BE (errcode < 0 - || errcode >= (int) (sizeof (__re_error_msgid_idx) - / sizeof (__re_error_msgid_idx[0])), 0)) + if (__glibc_unlikely (errcode < 0 || errcode >= nerrcodes)) /* Only error codes returned by the rest of the code should be passed to this routine. If we are given anything else, or if other regex code generates an invalid error code, then the program has a bug. @@ -543,10 +542,10 @@ regerror (int errcode, const regex_t *_Restrict_ preg, char *_Restrict_ errbuf, msg_size = strlen (msg) + 1; /* Includes the null. */ - if (BE (errbuf_size != 0, 1)) + if (__glibc_likely (errbuf_size != 0)) { size_t cpy_size = msg_size; - if (BE (msg_size > errbuf_size, 0)) + if (__glibc_unlikely (msg_size > errbuf_size)) { cpy_size = errbuf_size - 1; errbuf[cpy_size] = '\0'; @@ -644,7 +643,7 @@ void regfree (regex_t *preg) { re_dfa_t *dfa = preg->buffer; - if (BE (dfa != NULL, 1)) + if (__glibc_likely (dfa != NULL)) { lock_fini (dfa->lock); free_dfa_content (dfa); @@ -754,7 +753,7 @@ re_compile_internal (regex_t *preg, const char * pattern, size_t length, /* Initialize the dfa. */ dfa = preg->buffer; - if (BE (preg->allocated < sizeof (re_dfa_t), 0)) + if (__glibc_unlikely (preg->allocated < sizeof (re_dfa_t))) { /* If zero allocated, but buffer is non-null, try to realloc enough space. This loses if buffer's address is bogus, but @@ -769,9 +768,9 @@ re_compile_internal (regex_t *preg, const char * pattern, size_t length, preg->used = sizeof (re_dfa_t); err = init_dfa (dfa, length); - if (BE (err == REG_NOERROR && lock_init (dfa->lock) != 0, 0)) + if (__glibc_unlikely (err == REG_NOERROR && lock_init (dfa->lock) != 0)) err = REG_ESPACE; - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) { free_dfa_content (dfa); preg->buffer = NULL; @@ -786,7 +785,7 @@ re_compile_internal (regex_t *preg, const char * pattern, size_t length, err = re_string_construct (®exp, pattern, length, preg->translate, (syntax & RE_ICASE) != 0, dfa); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) { re_compile_internal_free_return: free_workarea_compile (preg); @@ -801,12 +800,12 @@ re_compile_internal (regex_t *preg, const char * pattern, size_t length, /* Parse the regular expression, and build a structure tree. */ preg->re_nsub = 0; dfa->str_tree = parse (®exp, preg, syntax, &err); - if (BE (dfa->str_tree == NULL, 0)) + if (__glibc_unlikely (dfa->str_tree == NULL)) goto re_compile_internal_free_return; /* Analyze the tree and create the nfa. */ err = analyze (preg); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) goto re_compile_internal_free_return; #ifdef RE_ENABLE_I18N @@ -822,7 +821,7 @@ re_compile_internal (regex_t *preg, const char * pattern, size_t length, free_workarea_compile (preg); re_string_destruct (®exp); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) { lock_fini (dfa->lock); free_dfa_content (dfa); @@ -864,7 +863,8 @@ init_dfa (re_dfa_t *dfa, size_t pat_len) calculation below, and for similar doubling calculations elsewhere. And it's <= rather than <, because some of the doubling calculations add 1 afterwards. */ - if (BE (MIN (IDX_MAX, SIZE_MAX / max_object_size) / 2 <= pat_len, 0)) + if (__glibc_unlikely (MIN (IDX_MAX, SIZE_MAX / max_object_size) / 2 + <= pat_len)) return REG_ESPACE; dfa->nodes_alloc = pat_len + 1; @@ -908,7 +908,7 @@ init_dfa (re_dfa_t *dfa, size_t pat_len) int i, j, ch; dfa->sb_char = (re_bitset_ptr_t) calloc (sizeof (bitset_t), 1); - if (BE (dfa->sb_char == NULL, 0)) + if (__glibc_unlikely (dfa->sb_char == NULL)) return REG_ESPACE; /* Set the bits corresponding to single byte chars. */ @@ -927,7 +927,7 @@ init_dfa (re_dfa_t *dfa, size_t pat_len) } #endif - if (BE (dfa->nodes == NULL || dfa->state_table == NULL, 0)) + if (__glibc_unlikely (dfa->nodes == NULL || dfa->state_table == NULL)) return REG_ESPACE; return REG_NOERROR; } @@ -943,7 +943,7 @@ init_word_char (re_dfa_t *dfa) int j; int ch = 0; dfa->word_ops_used = 1; - if (BE (dfa->map_notascii == 0, 1)) + if (__glibc_likely (dfa->map_notascii == 0)) { /* Avoid uint32_t and uint64_t as some non-GCC platforms lack them, an issue when this code is used in Gnulib. */ @@ -970,7 +970,7 @@ init_word_char (re_dfa_t *dfa) goto general_case; ch = 128; - if (BE (dfa->is_utf8, 1)) + if (__glibc_likely (dfa->is_utf8)) { memset (&dfa->word_char[i], '\0', (SBC_MAX - ch) / 8); return; @@ -1017,7 +1017,7 @@ create_initial_state (re_dfa_t *dfa) first = dfa->str_tree->first->node_idx; dfa->init_node = first; err = re_node_set_init_copy (&init_nodes, dfa->eclosures + first); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; /* The back-references which are in initial states can epsilon transit, @@ -1061,7 +1061,7 @@ create_initial_state (re_dfa_t *dfa) /* It must be the first time to invoke acquire_state. */ dfa->init_state = re_acquire_state_context (&err, dfa, &init_nodes, 0); /* We don't check ERR here, since the initial state must not be NULL. */ - if (BE (dfa->init_state == NULL, 0)) + if (__glibc_unlikely (dfa->init_state == NULL)) return err; if (dfa->init_state->has_constraint) { @@ -1073,8 +1073,9 @@ create_initial_state (re_dfa_t *dfa) &init_nodes, CONTEXT_NEWLINE | CONTEXT_BEGBUF); - if (BE (dfa->init_state_word == NULL || dfa->init_state_nl == NULL - || dfa->init_state_begbuf == NULL, 0)) + if (__glibc_unlikely (dfa->init_state_word == NULL + || dfa->init_state_nl == NULL + || dfa->init_state_begbuf == NULL)) return err; } else @@ -1181,8 +1182,8 @@ analyze (regex_t *preg) dfa->org_indices = re_malloc (Idx, dfa->nodes_alloc); dfa->edests = re_malloc (re_node_set, dfa->nodes_alloc); dfa->eclosures = re_malloc (re_node_set, dfa->nodes_alloc); - if (BE (dfa->nexts == NULL || dfa->org_indices == NULL || dfa->edests == NULL - || dfa->eclosures == NULL, 0)) + if (__glibc_unlikely (dfa->nexts == NULL || dfa->org_indices == NULL + || dfa->edests == NULL || dfa->eclosures == NULL)) return REG_ESPACE; dfa->subexp_map = re_malloc (Idx, preg->re_nsub); @@ -1203,17 +1204,17 @@ analyze (regex_t *preg) } ret = postorder (dfa->str_tree, lower_subexps, preg); - if (BE (ret != REG_NOERROR, 0)) + if (__glibc_unlikely (ret != REG_NOERROR)) return ret; ret = postorder (dfa->str_tree, calc_first, dfa); - if (BE (ret != REG_NOERROR, 0)) + if (__glibc_unlikely (ret != REG_NOERROR)) return ret; preorder (dfa->str_tree, calc_next, dfa); ret = preorder (dfa->str_tree, link_nfa_nodes, dfa); - if (BE (ret != REG_NOERROR, 0)) + if (__glibc_unlikely (ret != REG_NOERROR)) return ret; ret = calc_eclosure (dfa); - if (BE (ret != REG_NOERROR, 0)) + if (__glibc_unlikely (ret != REG_NOERROR)) return ret; /* We only need this during the prune_impossible_nodes pass in regexec.c; @@ -1222,7 +1223,7 @@ analyze (regex_t *preg) || dfa->nbackref) { dfa->inveclosures = re_malloc (re_node_set, dfa->nodes_len); - if (BE (dfa->inveclosures == NULL, 0)) + if (__glibc_unlikely (dfa->inveclosures == NULL)) return REG_ESPACE; ret = calc_inveclosure (dfa); } @@ -1252,7 +1253,7 @@ postorder (bin_tree_t *root, reg_errcode_t (fn (void *, bin_tree_t *)), do { reg_errcode_t err = fn (extra, node); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; if (node->parent == NULL) return REG_NOERROR; @@ -1274,7 +1275,7 @@ preorder (bin_tree_t *root, reg_errcode_t (fn (void *, bin_tree_t *)), for (node = root; ; ) { reg_errcode_t err = fn (extra, node); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; /* Go to the left node, or up and to the right. */ @@ -1375,7 +1376,8 @@ lower_subexp (reg_errcode_t *err, regex_t *preg, bin_tree_t *node) cls = create_tree (dfa, NULL, NULL, OP_CLOSE_SUBEXP); tree1 = body ? create_tree (dfa, body, cls, CONCAT) : cls; tree = create_tree (dfa, op, tree1, CONCAT); - if (BE (tree == NULL || tree1 == NULL || op == NULL || cls == NULL, 0)) + if (__glibc_unlikely (tree == NULL || tree1 == NULL + || op == NULL || cls == NULL)) { *err = REG_ESPACE; return NULL; @@ -1401,7 +1403,7 @@ calc_first (void *extra, bin_tree_t *node) { node->first = node; node->node_idx = re_dfa_add_node (dfa, node->token); - if (BE (node->node_idx == -1, 0)) + if (__glibc_unlikely (node->node_idx == -1)) return REG_ESPACE; if (node->token.type == ANCHOR) dfa->nodes[node->node_idx].constraint = node->token.opr.ctx_type; @@ -1512,11 +1514,11 @@ duplicate_node_closure (re_dfa_t *dfa, Idx top_org_node, Idx top_clone_node, org_dest = dfa->nexts[org_node]; re_node_set_empty (dfa->edests + clone_node); clone_dest = duplicate_node (dfa, org_dest, constraint); - if (BE (clone_dest == -1, 0)) + if (__glibc_unlikely (clone_dest == -1)) return REG_ESPACE; dfa->nexts[clone_node] = dfa->nexts[org_node]; ok = re_node_set_insert (dfa->edests + clone_node, clone_dest); - if (BE (! ok, 0)) + if (__glibc_unlikely (! ok)) return REG_ESPACE; } else if (dfa->edests[org_node].nelem == 0) @@ -1538,17 +1540,17 @@ duplicate_node_closure (re_dfa_t *dfa, Idx top_org_node, Idx top_clone_node, if (org_node == root_node && clone_node != org_node) { ok = re_node_set_insert (dfa->edests + clone_node, org_dest); - if (BE (! ok, 0)) + if (__glibc_unlikely (! ok)) return REG_ESPACE; break; } /* In case the node has another constraint, append it. */ constraint |= dfa->nodes[org_node].constraint; clone_dest = duplicate_node (dfa, org_dest, constraint); - if (BE (clone_dest == -1, 0)) + if (__glibc_unlikely (clone_dest == -1)) return REG_ESPACE; ok = re_node_set_insert (dfa->edests + clone_node, clone_dest); - if (BE (! ok, 0)) + if (__glibc_unlikely (! ok)) return REG_ESPACE; } else /* dfa->edests[org_node].nelem == 2 */ @@ -1564,14 +1566,14 @@ duplicate_node_closure (re_dfa_t *dfa, Idx top_org_node, Idx top_clone_node, /* There is no such duplicated node, create a new one. */ reg_errcode_t err; clone_dest = duplicate_node (dfa, org_dest, constraint); - if (BE (clone_dest == -1, 0)) + if (__glibc_unlikely (clone_dest == -1)) return REG_ESPACE; ok = re_node_set_insert (dfa->edests + clone_node, clone_dest); - if (BE (! ok, 0)) + if (__glibc_unlikely (! ok)) return REG_ESPACE; err = duplicate_node_closure (dfa, org_dest, clone_dest, root_node, constraint); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; } else @@ -1579,16 +1581,16 @@ duplicate_node_closure (re_dfa_t *dfa, Idx top_org_node, Idx top_clone_node, /* There is a duplicated node which satisfies the constraint, use it to avoid infinite loop. */ ok = re_node_set_insert (dfa->edests + clone_node, clone_dest); - if (BE (! ok, 0)) + if (__glibc_unlikely (! ok)) return REG_ESPACE; } org_dest = dfa->edests[org_node].elems[1]; clone_dest = duplicate_node (dfa, org_dest, constraint); - if (BE (clone_dest == -1, 0)) + if (__glibc_unlikely (clone_dest == -1)) return REG_ESPACE; ok = re_node_set_insert (dfa->edests + clone_node, clone_dest); - if (BE (! ok, 0)) + if (__glibc_unlikely (! ok)) return REG_ESPACE; } org_node = org_dest; @@ -1622,7 +1624,7 @@ static Idx duplicate_node (re_dfa_t *dfa, Idx org_idx, unsigned int constraint) { Idx dup_idx = re_dfa_add_node (dfa, dfa->nodes[org_idx]); - if (BE (dup_idx != -1, 1)) + if (__glibc_likely (dup_idx != -1)) { dfa->nodes[dup_idx].constraint = constraint; dfa->nodes[dup_idx].constraint |= dfa->nodes[org_idx].constraint; @@ -1648,7 +1650,7 @@ calc_inveclosure (re_dfa_t *dfa) for (idx = 0; idx < dfa->eclosures[src].nelem; ++idx) { ok = re_node_set_insert_last (dfa->inveclosures + elems[idx], src); - if (BE (! ok, 0)) + if (__glibc_unlikely (! ok)) return REG_ESPACE; } } @@ -1689,7 +1691,7 @@ calc_eclosure (re_dfa_t *dfa) continue; /* Calculate epsilon closure of 'node_idx'. */ err = calc_eclosure_iter (&eclosure_elem, dfa, node_idx, true); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; if (dfa->eclosures[node_idx].nelem == 0) @@ -1712,7 +1714,7 @@ calc_eclosure_iter (re_node_set *new_set, re_dfa_t *dfa, Idx node, bool root) bool ok; bool incomplete = false; err = re_node_set_alloc (&eclosure, dfa->edests[node].nelem + 1); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; /* This indicates that we are calculating this node now. @@ -1727,7 +1729,7 @@ calc_eclosure_iter (re_node_set *new_set, re_dfa_t *dfa, Idx node, bool root) { err = duplicate_node_closure (dfa, node, node, node, dfa->nodes[node].constraint); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; } @@ -1749,14 +1751,14 @@ calc_eclosure_iter (re_node_set *new_set, re_dfa_t *dfa, Idx node, bool root) if (dfa->eclosures[edest].nelem == 0) { err = calc_eclosure_iter (&eclosure_elem, dfa, edest, false); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; } else eclosure_elem = dfa->eclosures[edest]; /* Merge the epsilon closure of 'edest'. */ err = re_node_set_merge (&eclosure, &eclosure_elem); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; /* If the epsilon closure of 'edest' is incomplete, the epsilon closure of this node is also incomplete. */ @@ -1769,7 +1771,7 @@ calc_eclosure_iter (re_node_set *new_set, re_dfa_t *dfa, Idx node, bool root) /* An epsilon closure includes itself. */ ok = re_node_set_insert (&eclosure, node); - if (BE (! ok, 0)) + if (__glibc_unlikely (! ok)) return REG_ESPACE; if (incomplete && !root) dfa->eclosures[node].nelem = 0; @@ -2139,14 +2141,14 @@ parse (re_string_t *regexp, regex_t *preg, reg_syntax_t syntax, dfa->syntax = syntax; fetch_token (¤t_token, regexp, syntax | RE_CARET_ANCHORS_HERE); tree = parse_reg_exp (regexp, preg, ¤t_token, syntax, 0, err); - if (BE (*err != REG_NOERROR && tree == NULL, 0)) + if (__glibc_unlikely (*err != REG_NOERROR && tree == NULL)) return NULL; eor = create_tree (dfa, NULL, NULL, END_OF_RE); if (tree != NULL) root = create_tree (dfa, tree, eor, CONCAT); else root = eor; - if (BE (eor == NULL || root == NULL, 0)) + if (__glibc_unlikely (eor == NULL || root == NULL)) { *err = REG_ESPACE; return NULL; @@ -2171,7 +2173,7 @@ parse_reg_exp (re_string_t *regexp, regex_t *preg, re_token_t *token, bin_tree_t *tree, *branch = NULL; bitset_word_t initial_bkref_map = dfa->completed_bkref_map; tree = parse_branch (regexp, preg, token, syntax, nest, err); - if (BE (*err != REG_NOERROR && tree == NULL, 0)) + if (__glibc_unlikely (*err != REG_NOERROR && tree == NULL)) return NULL; while (token->type == OP_ALT) @@ -2183,7 +2185,7 @@ parse_reg_exp (re_string_t *regexp, regex_t *preg, re_token_t *token, bitset_word_t accumulated_bkref_map = dfa->completed_bkref_map; dfa->completed_bkref_map = initial_bkref_map; branch = parse_branch (regexp, preg, token, syntax, nest, err); - if (BE (*err != REG_NOERROR && branch == NULL, 0)) + if (__glibc_unlikely (*err != REG_NOERROR && branch == NULL)) { if (tree != NULL) postorder (tree, free_tree, NULL); @@ -2194,7 +2196,7 @@ parse_reg_exp (re_string_t *regexp, regex_t *preg, re_token_t *token, else branch = NULL; tree = create_tree (dfa, tree, branch, OP_ALT); - if (BE (tree == NULL, 0)) + if (__glibc_unlikely (tree == NULL)) { *err = REG_ESPACE; return NULL; @@ -2219,14 +2221,14 @@ parse_branch (re_string_t *regexp, regex_t *preg, re_token_t *token, bin_tree_t *tree, *expr; re_dfa_t *dfa = preg->buffer; tree = parse_expression (regexp, preg, token, syntax, nest, err); - if (BE (*err != REG_NOERROR && tree == NULL, 0)) + if (__glibc_unlikely (*err != REG_NOERROR && tree == NULL)) return NULL; while (token->type != OP_ALT && token->type != END_OF_RE && (nest == 0 || token->type != OP_CLOSE_SUBEXP)) { expr = parse_expression (regexp, preg, token, syntax, nest, err); - if (BE (*err != REG_NOERROR && expr == NULL, 0)) + if (__glibc_unlikely (*err != REG_NOERROR && expr == NULL)) { if (tree != NULL) postorder (tree, free_tree, NULL); @@ -2267,7 +2269,7 @@ parse_expression (re_string_t *regexp, regex_t *preg, re_token_t *token, { case CHARACTER: tree = create_token_tree (dfa, NULL, NULL, token); - if (BE (tree == NULL, 0)) + if (__glibc_unlikely (tree == NULL)) { *err = REG_ESPACE; return NULL; @@ -2282,7 +2284,7 @@ parse_expression (re_string_t *regexp, regex_t *preg, re_token_t *token, fetch_token (token, regexp, syntax); mbc_remain = create_token_tree (dfa, NULL, NULL, token); tree = create_tree (dfa, tree, mbc_remain, CONCAT); - if (BE (mbc_remain == NULL || tree == NULL, 0)) + if (__glibc_unlikely (mbc_remain == NULL || tree == NULL)) { *err = REG_ESPACE; return NULL; @@ -2294,25 +2296,25 @@ parse_expression (re_string_t *regexp, regex_t *preg, re_token_t *token, case OP_OPEN_SUBEXP: tree = parse_sub_exp (regexp, preg, token, syntax, nest + 1, err); - if (BE (*err != REG_NOERROR && tree == NULL, 0)) + if (__glibc_unlikely (*err != REG_NOERROR && tree == NULL)) return NULL; break; case OP_OPEN_BRACKET: tree = parse_bracket_exp (regexp, dfa, token, syntax, err); - if (BE (*err != REG_NOERROR && tree == NULL, 0)) + if (__glibc_unlikely (*err != REG_NOERROR && tree == NULL)) return NULL; break; case OP_BACK_REF: - if (!BE (dfa->completed_bkref_map & (1 << token->opr.idx), 1)) + if (!__glibc_likely (dfa->completed_bkref_map & (1 << token->opr.idx))) { *err = REG_ESUBREG; return NULL; } dfa->used_bkref_map |= 1 << token->opr.idx; tree = create_token_tree (dfa, NULL, NULL, token); - if (BE (tree == NULL, 0)) + if (__glibc_unlikely (tree == NULL)) { *err = REG_ESPACE; return NULL; @@ -2358,7 +2360,7 @@ parse_expression (re_string_t *regexp, regex_t *preg, re_token_t *token, /* mb_partial and word_char bits should be initialized already by peek_token. */ tree = create_token_tree (dfa, NULL, NULL, token); - if (BE (tree == NULL, 0)) + if (__glibc_unlikely (tree == NULL)) { *err = REG_ESPACE; return NULL; @@ -2388,7 +2390,8 @@ parse_expression (re_string_t *regexp, regex_t *preg, re_token_t *token, } tree_last = create_token_tree (dfa, NULL, NULL, token); tree = create_tree (dfa, tree_first, tree_last, OP_ALT); - if (BE (tree_first == NULL || tree_last == NULL || tree == NULL, 0)) + if (__glibc_unlikely (tree_first == NULL || tree_last == NULL + || tree == NULL)) { *err = REG_ESPACE; return NULL; @@ -2397,7 +2400,7 @@ parse_expression (re_string_t *regexp, regex_t *preg, re_token_t *token, else { tree = create_token_tree (dfa, NULL, NULL, token); - if (BE (tree == NULL, 0)) + if (__glibc_unlikely (tree == NULL)) { *err = REG_ESPACE; return NULL; @@ -2412,7 +2415,7 @@ parse_expression (re_string_t *regexp, regex_t *preg, re_token_t *token, case OP_PERIOD: tree = create_token_tree (dfa, NULL, NULL, token); - if (BE (tree == NULL, 0)) + if (__glibc_unlikely (tree == NULL)) { *err = REG_ESPACE; return NULL; @@ -2427,7 +2430,7 @@ parse_expression (re_string_t *regexp, regex_t *preg, re_token_t *token, "alnum", "_", token->type == OP_NOTWORD, err); - if (BE (*err != REG_NOERROR && tree == NULL, 0)) + if (__glibc_unlikely (*err != REG_NOERROR && tree == NULL)) return NULL; break; @@ -2437,7 +2440,7 @@ parse_expression (re_string_t *regexp, regex_t *preg, re_token_t *token, "space", "", token->type == OP_NOTSPACE, err); - if (BE (*err != REG_NOERROR && tree == NULL, 0)) + if (__glibc_unlikely (*err != REG_NOERROR && tree == NULL)) return NULL; break; @@ -2463,7 +2466,7 @@ parse_expression (re_string_t *regexp, regex_t *preg, re_token_t *token, { bin_tree_t *dup_tree = parse_dup_op (tree, regexp, dfa, token, syntax, err); - if (BE (*err != REG_NOERROR && dup_tree == NULL, 0)) + if (__glibc_unlikely (*err != REG_NOERROR && dup_tree == NULL)) { if (tree != NULL) postorder (tree, free_tree, NULL); @@ -2509,13 +2512,14 @@ parse_sub_exp (re_string_t *regexp, regex_t *preg, re_token_t *token, else { tree = parse_reg_exp (regexp, preg, token, syntax, nest, err); - if (BE (*err == REG_NOERROR && token->type != OP_CLOSE_SUBEXP, 0)) + if (__glibc_unlikely (*err == REG_NOERROR + && token->type != OP_CLOSE_SUBEXP)) { if (tree != NULL) postorder (tree, free_tree, NULL); *err = REG_EPAREN; } - if (BE (*err != REG_NOERROR, 0)) + if (__glibc_unlikely (*err != REG_NOERROR)) return NULL; } @@ -2523,7 +2527,7 @@ parse_sub_exp (re_string_t *regexp, regex_t *preg, re_token_t *token, dfa->completed_bkref_map |= 1 << cur_nsub; tree = create_tree (dfa, tree, NULL, SUBEXP); - if (BE (tree == NULL, 0)) + if (__glibc_unlikely (tree == NULL)) { *err = REG_ESPACE; return NULL; @@ -2556,17 +2560,17 @@ parse_dup_op (bin_tree_t *elem, re_string_t *regexp, re_dfa_t *dfa, return NULL; } } - if (BE (start != -2, 1)) + if (__glibc_likely (start != -2)) { /* We treat "{n}" as "{n,n}". */ end = ((token->type == OP_CLOSE_DUP_NUM) ? start : ((token->type == CHARACTER && token->opr.c == ',') ? fetch_number (regexp, token, syntax) : -2)); } - if (BE (start == -2 || end == -2, 0)) + if (__glibc_unlikely (start == -2 || end == -2)) { /* Invalid sequence. */ - if (BE (!(syntax & RE_INVALID_INTERVAL_ORD), 0)) + if (__glibc_unlikely (!(syntax & RE_INVALID_INTERVAL_ORD))) { if (token->type == END_OF_RE) *err = REG_EBRACE; @@ -2585,15 +2589,15 @@ parse_dup_op (bin_tree_t *elem, re_string_t *regexp, re_dfa_t *dfa, return elem; } - if (BE ((end != -1 && start > end) - || token->type != OP_CLOSE_DUP_NUM, 0)) + if (__glibc_unlikely ((end != -1 && start > end) + || token->type != OP_CLOSE_DUP_NUM)) { /* First number greater than second. */ *err = REG_BADBR; return NULL; } - if (BE (RE_DUP_MAX < (end == -1 ? start : end), 0)) + if (__glibc_unlikely (RE_DUP_MAX < (end == -1 ? start : end))) { *err = REG_ESIZE; return NULL; @@ -2607,23 +2611,23 @@ parse_dup_op (bin_tree_t *elem, re_string_t *regexp, re_dfa_t *dfa, fetch_token (token, regexp, syntax); - if (BE (elem == NULL, 0)) + if (__glibc_unlikely (elem == NULL)) return NULL; - if (BE (start == 0 && end == 0, 0)) + if (__glibc_unlikely (start == 0 && end == 0)) { postorder (elem, free_tree, NULL); return NULL; } /* Extract "{n,m}" to "...{0,}". */ - if (BE (start > 0, 0)) + if (__glibc_unlikely (start > 0)) { tree = elem; for (i = 2; i <= start; ++i) { elem = duplicate_tree (elem, dfa); tree = create_tree (dfa, tree, elem, CONCAT); - if (BE (elem == NULL || tree == NULL, 0)) + if (__glibc_unlikely (elem == NULL || tree == NULL)) goto parse_dup_op_espace; } @@ -2632,7 +2636,7 @@ parse_dup_op (bin_tree_t *elem, re_string_t *regexp, re_dfa_t *dfa, /* Duplicate ELEM before it is marked optional. */ elem = duplicate_tree (elem, dfa); - if (BE (elem == NULL, 0)) + if (__glibc_unlikely (elem == NULL)) goto parse_dup_op_espace; old_tree = tree; } @@ -2647,7 +2651,7 @@ parse_dup_op (bin_tree_t *elem, re_string_t *regexp, re_dfa_t *dfa, tree = create_tree (dfa, elem, NULL, (end == -1 ? OP_DUP_ASTERISK : OP_ALT)); - if (BE (tree == NULL, 0)) + if (__glibc_unlikely (tree == NULL)) goto parse_dup_op_espace; /* This loop is actually executed only when end != -1, @@ -2658,11 +2662,11 @@ parse_dup_op (bin_tree_t *elem, re_string_t *regexp, re_dfa_t *dfa, { elem = duplicate_tree (elem, dfa); tree = create_tree (dfa, tree, elem, CONCAT); - if (BE (elem == NULL || tree == NULL, 0)) + if (__glibc_unlikely (elem == NULL || tree == NULL)) goto parse_dup_op_espace; tree = create_tree (dfa, tree, NULL, OP_ALT); - if (BE (tree == NULL, 0)) + if (__glibc_unlikely (tree == NULL)) goto parse_dup_op_espace; } @@ -2717,17 +2721,18 @@ build_range_exp (const reg_syntax_t syntax, { unsigned int start_ch, end_ch; /* Equivalence Classes and Character Classes can't be a range start/end. */ - if (BE (start_elem->type == EQUIV_CLASS || start_elem->type == CHAR_CLASS - || end_elem->type == EQUIV_CLASS || end_elem->type == CHAR_CLASS, - 0)) + if (__glibc_unlikely (start_elem->type == EQUIV_CLASS + || start_elem->type == CHAR_CLASS + || end_elem->type == EQUIV_CLASS + || end_elem->type == CHAR_CLASS)) return REG_ERANGE; /* We can handle no multi character collating elements without libc support. */ - if (BE ((start_elem->type == COLL_SYM - && strlen ((char *) start_elem->opr.name) > 1) - || (end_elem->type == COLL_SYM - && strlen ((char *) end_elem->opr.name) > 1), 0)) + if (__glibc_unlikely ((start_elem->type == COLL_SYM + && strlen ((char *) start_elem->opr.name) > 1) + || (end_elem->type == COLL_SYM + && strlen ((char *) end_elem->opr.name) > 1))) return REG_ECOLLATE; # ifdef RE_ENABLE_I18N @@ -2748,7 +2753,8 @@ build_range_exp (const reg_syntax_t syntax, ? parse_byte (end_ch, mbcset) : end_elem->opr.wch); if (start_wc == WEOF || end_wc == WEOF) return REG_ECOLLATE; - else if (BE ((syntax & RE_NO_EMPTY_RANGES) && start_wc > end_wc, 0)) + else if (__glibc_unlikely ((syntax & RE_NO_EMPTY_RANGES) + && start_wc > end_wc)) return REG_ERANGE; /* Got valid collation sequence values, add them as a new entry. @@ -2759,7 +2765,7 @@ build_range_exp (const reg_syntax_t syntax, if (mbcset) { /* Check the space of the arrays. */ - if (BE (*range_alloc == mbcset->nranges, 0)) + if (__glibc_unlikely (*range_alloc == mbcset->nranges)) { /* There is not enough space, need realloc. */ wchar_t *new_array_start, *new_array_end; @@ -2774,7 +2780,8 @@ build_range_exp (const reg_syntax_t syntax, new_array_end = re_realloc (mbcset->range_ends, wchar_t, new_nranges); - if (BE (new_array_start == NULL || new_array_end == NULL, 0)) + if (__glibc_unlikely (new_array_start == NULL + || new_array_end == NULL)) { re_free (new_array_start); re_free (new_array_end); @@ -2834,7 +2841,7 @@ build_collating_symbol (bitset_t sbcset, const unsigned char *name) # endif /* not RE_ENABLE_I18N */ { size_t name_len = strlen ((const char *) name); - if (BE (name_len != 1, 0)) + if (__glibc_unlikely (name_len != 1)) return REG_ECOLLATE; else { @@ -2969,18 +2976,21 @@ parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa, re_token_t *token, /* Equivalence Classes and Character Classes can't be a range start/end. */ - if (BE (start_elem->type == EQUIV_CLASS || start_elem->type == CHAR_CLASS - || end_elem->type == EQUIV_CLASS || end_elem->type == CHAR_CLASS, - 0)) + if (__glibc_unlikely (start_elem->type == EQUIV_CLASS + || start_elem->type == CHAR_CLASS + || end_elem->type == EQUIV_CLASS + || end_elem->type == CHAR_CLASS)) return REG_ERANGE; /* FIXME: Implement rational ranges here, too. */ start_collseq = lookup_collation_sequence_value (start_elem); end_collseq = lookup_collation_sequence_value (end_elem); /* Check start/end collation sequence values. */ - if (BE (start_collseq == UINT_MAX || end_collseq == UINT_MAX, 0)) + if (__glibc_unlikely (start_collseq == UINT_MAX + || end_collseq == UINT_MAX)) return REG_ECOLLATE; - if (BE ((syntax & RE_NO_EMPTY_RANGES) && start_collseq > end_collseq, 0)) + if (__glibc_unlikely ((syntax & RE_NO_EMPTY_RANGES) + && start_collseq > end_collseq)) return REG_ERANGE; /* Got valid collation sequence values, add them as a new entry. @@ -2990,7 +3000,7 @@ parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa, re_token_t *token, if (nrules > 0 || dfa->mb_cur_max > 1) { /* Check the space of the arrays. */ - if (BE (*range_alloc == mbcset->nranges, 0)) + if (__glibc_unlikely (*range_alloc == mbcset->nranges)) { /* There is not enough space, need realloc. */ uint32_t *new_array_start; @@ -3004,7 +3014,8 @@ parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa, re_token_t *token, new_array_end = re_realloc (mbcset->range_ends, uint32_t, new_nranges); - if (BE (new_array_start == NULL || new_array_end == NULL, 0)) + if (__glibc_unlikely (new_array_start == NULL + || new_array_end == NULL)) return REG_ESPACE; mbcset->range_starts = new_array_start; @@ -3068,7 +3079,7 @@ parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa, re_token_t *token, /* Got valid collation sequence, add it as a new entry. */ /* Check the space of the arrays. */ - if (BE (*coll_sym_alloc == mbcset->ncoll_syms, 0)) + if (__glibc_unlikely (*coll_sym_alloc == mbcset->ncoll_syms)) { /* Not enough, realloc it. */ /* +1 in case of mbcset->ncoll_syms is 0. */ @@ -3077,7 +3088,7 @@ parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa, re_token_t *token, if *alloc == 0. */ int32_t *new_coll_syms = re_realloc (mbcset->coll_syms, int32_t, new_coll_sym_alloc); - if (BE (new_coll_syms == NULL, 0)) + if (__glibc_unlikely (new_coll_syms == NULL)) return REG_ESPACE; mbcset->coll_syms = new_coll_syms; *coll_sym_alloc = new_coll_sym_alloc; @@ -3087,7 +3098,7 @@ parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa, re_token_t *token, } else { - if (BE (name_len != 1, 0)) + if (__glibc_unlikely (name_len != 1)) return REG_ECOLLATE; else { @@ -3131,9 +3142,9 @@ parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa, re_token_t *token, mbcset = (re_charset_t *) calloc (sizeof (re_charset_t), 1); #endif /* RE_ENABLE_I18N */ #ifdef RE_ENABLE_I18N - if (BE (sbcset == NULL || mbcset == NULL, 0)) + if (__glibc_unlikely (sbcset == NULL || mbcset == NULL)) #else - if (BE (sbcset == NULL, 0)) + if (__glibc_unlikely (sbcset == NULL)) #endif /* RE_ENABLE_I18N */ { re_free (sbcset); @@ -3145,7 +3156,7 @@ parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa, re_token_t *token, } token_len = peek_token_bracket (token, regexp, syntax); - if (BE (token->type == END_OF_RE, 0)) + if (__glibc_unlikely (token->type == END_OF_RE)) { *err = REG_BADPAT; goto parse_bracket_exp_free_return; @@ -3160,7 +3171,7 @@ parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa, re_token_t *token, bitset_set (sbcset, '\n'); re_string_skip_bytes (regexp, token_len); /* Skip a token. */ token_len = peek_token_bracket (token, regexp, syntax); - if (BE (token->type == END_OF_RE, 0)) + if (__glibc_unlikely (token->type == END_OF_RE)) { *err = REG_BADPAT; goto parse_bracket_exp_free_return; @@ -3185,7 +3196,7 @@ parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa, re_token_t *token, start_elem.type = COLL_SYM; ret = parse_bracket_element (&start_elem, regexp, token, token_len, dfa, syntax, first_round); - if (BE (ret != REG_NOERROR, 0)) + if (__glibc_unlikely (ret != REG_NOERROR)) { *err = ret; goto parse_bracket_exp_free_return; @@ -3198,7 +3209,7 @@ parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa, re_token_t *token, /* Do not check for ranges if we know they are not allowed. */ if (start_elem.type != CHAR_CLASS && start_elem.type != EQUIV_CLASS) { - if (BE (token->type == END_OF_RE, 0)) + if (__glibc_unlikely (token->type == END_OF_RE)) { *err = REG_EBRACK; goto parse_bracket_exp_free_return; @@ -3207,7 +3218,7 @@ parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa, re_token_t *token, { re_string_skip_bytes (regexp, token_len); /* Skip '-'. */ token_len2 = peek_token_bracket (&token2, regexp, syntax); - if (BE (token2.type == END_OF_RE, 0)) + if (__glibc_unlikely (token2.type == END_OF_RE)) { *err = REG_EBRACK; goto parse_bracket_exp_free_return; @@ -3229,7 +3240,7 @@ parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa, re_token_t *token, end_elem.type = COLL_SYM; ret = parse_bracket_element (&end_elem, regexp, &token2, token_len2, dfa, syntax, true); - if (BE (ret != REG_NOERROR, 0)) + if (__glibc_unlikely (ret != REG_NOERROR)) { *err = ret; goto parse_bracket_exp_free_return; @@ -3249,7 +3260,7 @@ parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa, re_token_t *token, *err = build_range_exp (syntax, sbcset, &start_elem, &end_elem); # endif #endif /* RE_ENABLE_I18N */ - if (BE (*err != REG_NOERROR, 0)) + if (__glibc_unlikely (*err != REG_NOERROR)) goto parse_bracket_exp_free_return; } else @@ -3262,7 +3273,7 @@ parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa, re_token_t *token, #ifdef RE_ENABLE_I18N case MB_CHAR: /* Check whether the array has enough space. */ - if (BE (mbchar_alloc == mbcset->nmbchars, 0)) + if (__glibc_unlikely (mbchar_alloc == mbcset->nmbchars)) { wchar_t *new_mbchars; /* Not enough, realloc it. */ @@ -3271,7 +3282,7 @@ parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa, re_token_t *token, /* Use realloc since array is NULL if *alloc == 0. */ new_mbchars = re_realloc (mbcset->mbchars, wchar_t, mbchar_alloc); - if (BE (new_mbchars == NULL, 0)) + if (__glibc_unlikely (new_mbchars == NULL)) goto parse_bracket_exp_espace; mbcset->mbchars = new_mbchars; } @@ -3284,7 +3295,7 @@ parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa, re_token_t *token, mbcset, &equiv_class_alloc, #endif /* RE_ENABLE_I18N */ start_elem.opr.name); - if (BE (*err != REG_NOERROR, 0)) + if (__glibc_unlikely (*err != REG_NOERROR)) goto parse_bracket_exp_free_return; break; case COLL_SYM: @@ -3293,7 +3304,7 @@ parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa, re_token_t *token, mbcset, &coll_sym_alloc, #endif /* RE_ENABLE_I18N */ start_elem.opr.name); - if (BE (*err != REG_NOERROR, 0)) + if (__glibc_unlikely (*err != REG_NOERROR)) goto parse_bracket_exp_free_return; break; case CHAR_CLASS: @@ -3303,7 +3314,7 @@ parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa, re_token_t *token, #endif /* RE_ENABLE_I18N */ (const char *) start_elem.opr.name, syntax); - if (BE (*err != REG_NOERROR, 0)) + if (__glibc_unlikely (*err != REG_NOERROR)) goto parse_bracket_exp_free_return; break; default: @@ -3311,7 +3322,7 @@ parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa, re_token_t *token, break; } } - if (BE (token->type == END_OF_RE, 0)) + if (__glibc_unlikely (token->type == END_OF_RE)) { *err = REG_EBRACK; goto parse_bracket_exp_free_return; @@ -3342,7 +3353,7 @@ parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa, re_token_t *token, br_token.type = COMPLEX_BRACKET; br_token.opr.mbcset = mbcset; mbc_tree = create_token_tree (dfa, NULL, NULL, &br_token); - if (BE (mbc_tree == NULL, 0)) + if (__glibc_unlikely (mbc_tree == NULL)) goto parse_bracket_exp_espace; for (sbc_idx = 0; sbc_idx < BITSET_WORDS; ++sbc_idx) if (sbcset[sbc_idx]) @@ -3355,12 +3366,12 @@ parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa, re_token_t *token, br_token.type = SIMPLE_BRACKET; br_token.opr.sbcset = sbcset; work_tree = create_token_tree (dfa, NULL, NULL, &br_token); - if (BE (work_tree == NULL, 0)) + if (__glibc_unlikely (work_tree == NULL)) goto parse_bracket_exp_espace; /* Then join them by ALT node. */ work_tree = create_tree (dfa, work_tree, mbc_tree, OP_ALT); - if (BE (work_tree == NULL, 0)) + if (__glibc_unlikely (work_tree == NULL)) goto parse_bracket_exp_espace; } else @@ -3379,7 +3390,7 @@ parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa, re_token_t *token, br_token.type = SIMPLE_BRACKET; br_token.opr.sbcset = sbcset; work_tree = create_token_tree (dfa, NULL, NULL, &br_token); - if (BE (work_tree == NULL, 0)) + if (__glibc_unlikely (work_tree == NULL)) goto parse_bracket_exp_espace; } return work_tree; @@ -3416,7 +3427,7 @@ parse_bracket_element (bracket_elem_t *elem, re_string_t *regexp, if (token->type == OP_OPEN_COLL_ELEM || token->type == OP_OPEN_CHAR_CLASS || token->type == OP_OPEN_EQUIV_CLASS) return parse_bracket_symbol (elem, regexp, token); - if (BE (token->type == OP_CHARSET_RANGE, 0) && !accept_hyphen) + if (__glibc_unlikely (token->type == OP_CHARSET_RANGE) && !accept_hyphen) { /* A '-' must only appear as anything but a range indicator before the closing bracket. Everything else is an error. */ @@ -3511,7 +3522,7 @@ build_equiv_class (bitset_t sbcset, const unsigned char *name) indirect = (const int32_t *) _NL_CURRENT (LC_COLLATE, _NL_COLLATE_INDIRECTMB); idx1 = findidx (table, indirect, extra, &cp, -1); - if (BE (idx1 == 0 || *cp != '\0', 0)) + if (__glibc_unlikely (idx1 == 0 || *cp != '\0')) /* This isn't a valid character. */ return REG_ECOLLATE; @@ -3536,7 +3547,7 @@ build_equiv_class (bitset_t sbcset, const unsigned char *name) bitset_set (sbcset, ch); } /* Check whether the array has enough space. */ - if (BE (*equiv_class_alloc == mbcset->nequiv_classes, 0)) + if (__glibc_unlikely (*equiv_class_alloc == mbcset->nequiv_classes)) { /* Not enough, realloc it. */ /* +1 in case of mbcset->nequiv_classes is 0. */ @@ -3545,7 +3556,7 @@ build_equiv_class (bitset_t sbcset, const unsigned char *name) int32_t *new_equiv_classes = re_realloc (mbcset->equiv_classes, int32_t, new_equiv_class_alloc); - if (BE (new_equiv_classes == NULL, 0)) + if (__glibc_unlikely (new_equiv_classes == NULL)) return REG_ESPACE; mbcset->equiv_classes = new_equiv_classes; *equiv_class_alloc = new_equiv_class_alloc; @@ -3555,7 +3566,7 @@ build_equiv_class (bitset_t sbcset, const unsigned char *name) else #endif /* _LIBC */ { - if (BE (strlen ((const char *) name) != 1, 0)) + if (__glibc_unlikely (strlen ((const char *) name) != 1)) return REG_ECOLLATE; bitset_set (sbcset, *name); } @@ -3589,7 +3600,7 @@ build_charclass (RE_TRANSLATE_TYPE trans, bitset_t sbcset, #ifdef RE_ENABLE_I18N /* Check the space of the arrays. */ - if (BE (*char_class_alloc == mbcset->nchar_classes, 0)) + if (__glibc_unlikely (*char_class_alloc == mbcset->nchar_classes)) { /* Not enough, realloc it. */ /* +1 in case of mbcset->nchar_classes is 0. */ @@ -3597,7 +3608,7 @@ build_charclass (RE_TRANSLATE_TYPE trans, bitset_t sbcset, /* Use realloc since array is NULL if *alloc == 0. */ wctype_t *new_char_classes = re_realloc (mbcset->char_classes, wctype_t, new_char_class_alloc); - if (BE (new_char_classes == NULL, 0)) + if (__glibc_unlikely (new_char_classes == NULL)) return REG_ESPACE; mbcset->char_classes = new_char_classes; *char_class_alloc = new_char_class_alloc; @@ -3607,7 +3618,7 @@ build_charclass (RE_TRANSLATE_TYPE trans, bitset_t sbcset, #define BUILD_CHARCLASS_LOOP(ctype_func) \ do { \ - if (BE (trans != NULL, 0)) \ + if (__glibc_unlikely (trans != NULL)) \ { \ for (i = 0; i < SBC_MAX; ++i) \ if (ctype_func (i)) \ @@ -3667,14 +3678,14 @@ build_charclass_op (re_dfa_t *dfa, RE_TRANSLATE_TYPE trans, bin_tree_t *tree; sbcset = (re_bitset_ptr_t) calloc (sizeof (bitset_t), 1); - if (BE (sbcset == NULL, 0)) + if (__glibc_unlikely (sbcset == NULL)) { *err = REG_ESPACE; return NULL; } #ifdef RE_ENABLE_I18N mbcset = (re_charset_t *) calloc (sizeof (re_charset_t), 1); - if (BE (mbcset == NULL, 0)) + if (__glibc_unlikely (mbcset == NULL)) { re_free (sbcset); *err = REG_ESPACE; @@ -3690,7 +3701,7 @@ build_charclass_op (re_dfa_t *dfa, RE_TRANSLATE_TYPE trans, #endif /* RE_ENABLE_I18N */ class_name, 0); - if (BE (ret != REG_NOERROR, 0)) + if (__glibc_unlikely (ret != REG_NOERROR)) { re_free (sbcset); #ifdef RE_ENABLE_I18N @@ -3720,7 +3731,7 @@ build_charclass_op (re_dfa_t *dfa, RE_TRANSLATE_TYPE trans, br_token.type = SIMPLE_BRACKET; br_token.opr.sbcset = sbcset; tree = create_token_tree (dfa, NULL, NULL, &br_token); - if (BE (tree == NULL, 0)) + if (__glibc_unlikely (tree == NULL)) goto build_word_op_espace; #ifdef RE_ENABLE_I18N @@ -3732,11 +3743,11 @@ build_charclass_op (re_dfa_t *dfa, RE_TRANSLATE_TYPE trans, br_token.opr.mbcset = mbcset; dfa->has_mb_node = 1; mbc_tree = create_token_tree (dfa, NULL, NULL, &br_token); - if (BE (mbc_tree == NULL, 0)) + if (__glibc_unlikely (mbc_tree == NULL)) goto build_word_op_espace; /* Then join them by ALT node. */ tree = create_tree (dfa, tree, mbc_tree, OP_ALT); - if (BE (mbc_tree != NULL, 1)) + if (__glibc_likely (mbc_tree != NULL)) return tree; } else @@ -3772,7 +3783,7 @@ fetch_number (re_string_t *input, re_token_t *token, reg_syntax_t syntax) { fetch_token (token, input, syntax); c = token->opr.c; - if (BE (token->type == END_OF_RE, 0)) + if (__glibc_unlikely (token->type == END_OF_RE)) return -2; if (token->type == OP_CLOSE_DUP_NUM || c == ',') break; @@ -3822,7 +3833,7 @@ create_token_tree (re_dfa_t *dfa, bin_tree_t *left, bin_tree_t *right, const re_token_t *token) { bin_tree_t *tree; - if (BE (dfa->str_tree_storage_idx == BIN_TREE_STORAGE_SIZE, 0)) + if (__glibc_unlikely (dfa->str_tree_storage_idx == BIN_TREE_STORAGE_SIZE)) { bin_tree_storage_t *storage = re_malloc (bin_tree_storage_t, 1); diff --git a/lib/regex.c b/lib/regex.c index 499e1f0e03..2a86e10703 100644 --- a/lib/regex.c +++ b/lib/regex.c @@ -18,7 +18,7 @@ . */ #ifndef _LIBC -# include +# include # if (__GNUC__ == 4 && 6 <= __GNUC_MINOR__) || 4 < __GNUC__ # pragma GCC diagnostic ignored "-Wsuggest-attribute=pure" diff --git a/lib/regex_internal.c b/lib/regex_internal.c index e3ce4abfa6..f13def37bf 100644 --- a/lib/regex_internal.c +++ b/lib/regex_internal.c @@ -59,7 +59,7 @@ re_string_allocate (re_string_t *pstr, const char *str, Idx len, Idx init_len, re_string_construct_common (str, len, pstr, trans, icase, dfa); ret = re_string_realloc_buffers (pstr, init_buf_len); - if (BE (ret != REG_NOERROR, 0)) + if (__glibc_unlikely (ret != REG_NOERROR)) return ret; pstr->word_char = dfa->word_char; @@ -84,7 +84,7 @@ re_string_construct (re_string_t *pstr, const char *str, Idx len, if (len > 0) { ret = re_string_realloc_buffers (pstr, len + 1); - if (BE (ret != REG_NOERROR, 0)) + if (__glibc_unlikely (ret != REG_NOERROR)) return ret; } pstr->mbs = pstr->mbs_allocated ? pstr->mbs : (unsigned char *) str; @@ -97,14 +97,14 @@ re_string_construct (re_string_t *pstr, const char *str, Idx len, while (1) { ret = build_wcs_upper_buffer (pstr); - if (BE (ret != REG_NOERROR, 0)) + if (__glibc_unlikely (ret != REG_NOERROR)) return ret; if (pstr->valid_raw_len >= len) break; if (pstr->bufs_len > pstr->valid_len + dfa->mb_cur_max) break; ret = re_string_realloc_buffers (pstr, pstr->bufs_len * 2); - if (BE (ret != REG_NOERROR, 0)) + if (__glibc_unlikely (ret != REG_NOERROR)) return ret; } } @@ -146,17 +146,18 @@ re_string_realloc_buffers (re_string_t *pstr, Idx new_buf_len) /* Avoid overflow in realloc. */ const size_t max_object_size = MAX (sizeof (wint_t), sizeof (Idx)); - if (BE (MIN (IDX_MAX, SIZE_MAX / max_object_size) < new_buf_len, 0)) + if (__glibc_unlikely (MIN (IDX_MAX, SIZE_MAX / max_object_size) + < new_buf_len)) return REG_ESPACE; new_wcs = re_realloc (pstr->wcs, wint_t, new_buf_len); - if (BE (new_wcs == NULL, 0)) + if (__glibc_unlikely (new_wcs == NULL)) return REG_ESPACE; pstr->wcs = new_wcs; if (pstr->offsets != NULL) { Idx *new_offsets = re_realloc (pstr->offsets, Idx, new_buf_len); - if (BE (new_offsets == NULL, 0)) + if (__glibc_unlikely (new_offsets == NULL)) return REG_ESPACE; pstr->offsets = new_offsets; } @@ -166,7 +167,7 @@ re_string_realloc_buffers (re_string_t *pstr, Idx new_buf_len) { unsigned char *new_mbs = re_realloc (pstr->mbs, unsigned char, new_buf_len); - if (BE (new_mbs == NULL, 0)) + if (__glibc_unlikely (new_mbs == NULL)) return REG_ESPACE; pstr->mbs = new_mbs; } @@ -230,7 +231,7 @@ build_wcs_buffer (re_string_t *pstr) remain_len = end_idx - byte_idx; prev_st = pstr->cur_state; /* Apply the translation if we need. */ - if (BE (pstr->trans != NULL, 0)) + if (__glibc_unlikely (pstr->trans != NULL)) { int i, ch; @@ -244,17 +245,18 @@ build_wcs_buffer (re_string_t *pstr) else p = (const char *) pstr->raw_mbs + pstr->raw_mbs_idx + byte_idx; mbclen = __mbrtowc (&wc, p, remain_len, &pstr->cur_state); - if (BE (mbclen == (size_t) -1 || mbclen == 0 - || (mbclen == (size_t) -2 && pstr->bufs_len >= pstr->len), 0)) + if (__glibc_unlikely (mbclen == (size_t) -1 || mbclen == 0 + || (mbclen == (size_t) -2 + && pstr->bufs_len >= pstr->len))) { /* We treat these cases as a singlebyte character. */ mbclen = 1; wc = (wchar_t) pstr->raw_mbs[pstr->raw_mbs_idx + byte_idx]; - if (BE (pstr->trans != NULL, 0)) + if (__glibc_unlikely (pstr->trans != NULL)) wc = pstr->trans[wc]; pstr->cur_state = prev_st; } - else if (BE (mbclen == (size_t) -2, 0)) + else if (__glibc_unlikely (mbclen == (size_t) -2)) { /* The buffer doesn't have enough space, finish to build. */ pstr->cur_state = prev_st; @@ -317,7 +319,7 @@ build_wcs_upper_buffer (re_string_t *pstr) mbclen = __mbrtowc (&wc, ((const char *) pstr->raw_mbs + pstr->raw_mbs_idx + byte_idx), remain_len, &pstr->cur_state); - if (BE (0 < mbclen && mbclen < (size_t) -2, 1)) + if (__glibc_likely (0 < mbclen && mbclen < (size_t) -2)) { wchar_t wcu = __towupper (wc); if (wcu != wc) @@ -325,7 +327,7 @@ build_wcs_upper_buffer (re_string_t *pstr) size_t mbcdlen; mbcdlen = __wcrtomb (buf, wcu, &prev_st); - if (BE (mbclen == mbcdlen, 1)) + if (__glibc_likely (mbclen == mbcdlen)) memcpy (pstr->mbs + byte_idx, buf, mbclen); else { @@ -350,7 +352,7 @@ build_wcs_upper_buffer (re_string_t *pstr) pstr->mbs[byte_idx] = ch; /* And also cast it to wide char. */ pstr->wcs[byte_idx++] = (wchar_t) ch; - if (BE (mbclen == (size_t) -1, 0)) + if (__glibc_unlikely (mbclen == (size_t) -1)) pstr->cur_state = prev_st; } else @@ -372,7 +374,7 @@ build_wcs_upper_buffer (re_string_t *pstr) offsets_needed: remain_len = end_idx - byte_idx; prev_st = pstr->cur_state; - if (BE (pstr->trans != NULL, 0)) + if (__glibc_unlikely (pstr->trans != NULL)) { int i, ch; @@ -386,7 +388,7 @@ build_wcs_upper_buffer (re_string_t *pstr) else p = (const char *) pstr->raw_mbs + pstr->raw_mbs_idx + src_idx; mbclen = __mbrtowc (&wc, p, remain_len, &pstr->cur_state); - if (BE (0 < mbclen && mbclen < (size_t) -2, 1)) + if (__glibc_likely (0 < mbclen && mbclen < (size_t) -2)) { wchar_t wcu = __towupper (wc); if (wcu != wc) @@ -394,7 +396,7 @@ build_wcs_upper_buffer (re_string_t *pstr) size_t mbcdlen; mbcdlen = __wcrtomb ((char *) buf, wcu, &prev_st); - if (BE (mbclen == mbcdlen, 1)) + if (__glibc_likely (mbclen == mbcdlen)) memcpy (pstr->mbs + byte_idx, buf, mbclen); else if (mbcdlen != (size_t) -1) { @@ -444,7 +446,7 @@ build_wcs_upper_buffer (re_string_t *pstr) else memcpy (pstr->mbs + byte_idx, p, mbclen); - if (BE (pstr->offsets_needed != 0, 0)) + if (__glibc_unlikely (pstr->offsets_needed != 0)) { size_t i; for (i = 0; i < mbclen; ++i) @@ -463,17 +465,17 @@ build_wcs_upper_buffer (re_string_t *pstr) /* It is an invalid character or '\0'. Just use the byte. */ int ch = pstr->raw_mbs[pstr->raw_mbs_idx + src_idx]; - if (BE (pstr->trans != NULL, 0)) + if (__glibc_unlikely (pstr->trans != NULL)) ch = pstr->trans [ch]; pstr->mbs[byte_idx] = ch; - if (BE (pstr->offsets_needed != 0, 0)) + if (__glibc_unlikely (pstr->offsets_needed != 0)) pstr->offsets[byte_idx] = src_idx; ++src_idx; /* And also cast it to wide char. */ pstr->wcs[byte_idx++] = (wchar_t) ch; - if (BE (mbclen == (size_t) -1, 0)) + if (__glibc_unlikely (mbclen == (size_t) -1)) pstr->cur_state = prev_st; } else @@ -508,7 +510,8 @@ re_string_skip_chars (re_string_t *pstr, Idx new_raw_idx, wint_t *last_wc) prev_st = pstr->cur_state; mbclen = __mbrtowc (&wc2, (const char *) pstr->raw_mbs + rawbuf_idx, remain_len, &pstr->cur_state); - if (BE (mbclen == (size_t) -2 || mbclen == (size_t) -1 || mbclen == 0, 0)) + if (__glibc_unlikely (mbclen == (size_t) -2 || mbclen == (size_t) -1 + || mbclen == 0)) { /* We treat these cases as a single byte character. */ if (mbclen == 0 || remain_len == 0) @@ -540,7 +543,7 @@ build_upper_buffer (re_string_t *pstr) for (char_idx = pstr->valid_len; char_idx < end_idx; ++char_idx) { int ch = pstr->raw_mbs[pstr->raw_mbs_idx + char_idx]; - if (BE (pstr->trans != NULL, 0)) + if (__glibc_unlikely (pstr->trans != NULL)) ch = pstr->trans[ch]; pstr->mbs[char_idx] = toupper (ch); } @@ -576,7 +579,7 @@ re_string_reconstruct (re_string_t *pstr, Idx idx, int eflags) { Idx offset; - if (BE (pstr->raw_mbs_idx <= idx, 0)) + if (__glibc_unlikely (pstr->raw_mbs_idx <= idx)) offset = idx - pstr->raw_mbs_idx; else { @@ -598,14 +601,14 @@ re_string_reconstruct (re_string_t *pstr, Idx idx, int eflags) offset = idx; } - if (BE (offset != 0, 1)) + if (__glibc_likely (offset != 0)) { /* Should the already checked characters be kept? */ - if (BE (offset < pstr->valid_raw_len, 1)) + if (__glibc_likely (offset < pstr->valid_raw_len)) { /* Yes, move them to the front of the buffer. */ #ifdef RE_ENABLE_I18N - if (BE (pstr->offsets_needed, 0)) + if (__glibc_unlikely (pstr->offsets_needed)) { Idx low = 0, high = pstr->valid_len, mid; do @@ -677,7 +680,7 @@ re_string_reconstruct (re_string_t *pstr, Idx idx, int eflags) memmove (pstr->wcs, pstr->wcs + offset, (pstr->valid_len - offset) * sizeof (wint_t)); #endif /* RE_ENABLE_I18N */ - if (BE (pstr->mbs_allocated, 0)) + if (__glibc_unlikely (pstr->mbs_allocated)) memmove (pstr->mbs, pstr->mbs + offset, pstr->valid_len - offset); pstr->valid_len -= offset; @@ -693,7 +696,7 @@ re_string_reconstruct (re_string_t *pstr, Idx idx, int eflags) /* No, skip all characters until IDX. */ Idx prev_valid_len = pstr->valid_len; - if (BE (pstr->offsets_needed, 0)) + if (__glibc_unlikely (pstr->offsets_needed)) { pstr->len = pstr->raw_len - idx + offset; pstr->stop = pstr->raw_stop - idx + offset; @@ -721,7 +724,7 @@ re_string_reconstruct (re_string_t *pstr, Idx idx, int eflags) #ifdef _LIBC /* We know the wchar_t encoding is UCS4, so for the simple case, ASCII characters, skip the conversion step. */ - if (isascii (*p) && BE (pstr->trans == NULL, 1)) + if (isascii (*p) && __glibc_likely (pstr->trans == NULL)) { memset (&pstr->cur_state, '\0', sizeof (mbstate_t)); /* pstr->valid_len = 0; */ @@ -739,7 +742,7 @@ re_string_reconstruct (re_string_t *pstr, Idx idx, int eflags) size_t mbclen; const unsigned char *pp = p; - if (BE (pstr->trans != NULL, 0)) + if (__glibc_unlikely (pstr->trans != NULL)) { int i = mlen < 6 ? mlen : 6; while (--i >= 0) @@ -769,13 +772,13 @@ re_string_reconstruct (re_string_t *pstr, Idx idx, int eflags) pstr->tip_context = re_string_context_at (pstr, prev_valid_len - 1, eflags); else - pstr->tip_context = ((BE (pstr->word_ops_used != 0, 0) + pstr->tip_context = ((__glibc_unlikely (pstr->word_ops_used != 0) && IS_WIDE_WORD_CHAR (wc)) ? CONTEXT_WORD : ((IS_WIDE_NEWLINE (wc) && pstr->newline_anchor) ? CONTEXT_NEWLINE : 0)); - if (BE (pstr->valid_len, 0)) + if (__glibc_unlikely (pstr->valid_len)) { for (wcs_idx = 0; wcs_idx < pstr->valid_len; ++wcs_idx) pstr->wcs[wcs_idx] = WEOF; @@ -797,7 +800,7 @@ re_string_reconstruct (re_string_t *pstr, Idx idx, int eflags) ? CONTEXT_NEWLINE : 0)); } } - if (!BE (pstr->mbs_allocated, 0)) + if (!__glibc_unlikely (pstr->mbs_allocated)) pstr->mbs += offset; } pstr->raw_mbs_idx = idx; @@ -811,7 +814,7 @@ re_string_reconstruct (re_string_t *pstr, Idx idx, int eflags) if (pstr->icase) { reg_errcode_t ret = build_wcs_upper_buffer (pstr); - if (BE (ret != REG_NOERROR, 0)) + if (__glibc_unlikely (ret != REG_NOERROR)) return ret; } else @@ -819,7 +822,7 @@ re_string_reconstruct (re_string_t *pstr, Idx idx, int eflags) } else #endif /* RE_ENABLE_I18N */ - if (BE (pstr->mbs_allocated, 0)) + if (__glibc_unlikely (pstr->mbs_allocated)) { if (pstr->icase) build_upper_buffer (pstr); @@ -841,7 +844,7 @@ re_string_peek_byte_case (const re_string_t *pstr, Idx idx) Idx off; /* Handle the common (easiest) cases first. */ - if (BE (!pstr->mbs_allocated, 1)) + if (__glibc_likely (!pstr->mbs_allocated)) return re_string_peek_byte (pstr, idx); #ifdef RE_ENABLE_I18N @@ -873,7 +876,7 @@ re_string_peek_byte_case (const re_string_t *pstr, Idx idx) static unsigned char re_string_fetch_byte_case (re_string_t *pstr) { - if (BE (!pstr->mbs_allocated, 1)) + if (__glibc_likely (!pstr->mbs_allocated)) return re_string_fetch_byte (pstr); #ifdef RE_ENABLE_I18N @@ -924,11 +927,11 @@ static unsigned int re_string_context_at (const re_string_t *input, Idx idx, int eflags) { int c; - if (BE (idx < 0, 0)) + if (__glibc_unlikely (idx < 0)) /* In this case, we use the value stored in input->tip_context, since we can't know the character in input->mbs[-1] here. */ return input->tip_context; - if (BE (idx == input->len, 0)) + if (__glibc_unlikely (idx == input->len)) return ((eflags & REG_NOTEOL) ? CONTEXT_ENDBUF : CONTEXT_NEWLINE | CONTEXT_ENDBUF); #ifdef RE_ENABLE_I18N @@ -947,7 +950,8 @@ re_string_context_at (const re_string_t *input, Idx idx, int eflags) return input->tip_context; } wc = input->wcs[wc_idx]; - if (BE (input->word_ops_used != 0, 0) && IS_WIDE_WORD_CHAR (wc)) + if (__glibc_unlikely (input->word_ops_used != 0) + && IS_WIDE_WORD_CHAR (wc)) return CONTEXT_WORD; return (IS_WIDE_NEWLINE (wc) && input->newline_anchor ? CONTEXT_NEWLINE : 0); @@ -971,7 +975,8 @@ re_node_set_alloc (re_node_set *set, Idx size) set->alloc = size; set->nelem = 0; set->elems = re_malloc (Idx, size); - if (BE (set->elems == NULL, 0) && (MALLOC_0_IS_NONNULL || size != 0)) + if (__glibc_unlikely (set->elems == NULL) + && (MALLOC_0_IS_NONNULL || size != 0)) return REG_ESPACE; return REG_NOERROR; } @@ -983,7 +988,7 @@ re_node_set_init_1 (re_node_set *set, Idx elem) set->alloc = 1; set->nelem = 1; set->elems = re_malloc (Idx, 1); - if (BE (set->elems == NULL, 0)) + if (__glibc_unlikely (set->elems == NULL)) { set->alloc = set->nelem = 0; return REG_ESPACE; @@ -998,7 +1003,7 @@ re_node_set_init_2 (re_node_set *set, Idx elem1, Idx elem2) { set->alloc = 2; set->elems = re_malloc (Idx, 2); - if (BE (set->elems == NULL, 0)) + if (__glibc_unlikely (set->elems == NULL)) return REG_ESPACE; if (elem1 == elem2) { @@ -1031,7 +1036,7 @@ re_node_set_init_copy (re_node_set *dest, const re_node_set *src) { dest->alloc = dest->nelem; dest->elems = re_malloc (Idx, dest->alloc); - if (BE (dest->elems == NULL, 0)) + if (__glibc_unlikely (dest->elems == NULL)) { dest->alloc = dest->nelem = 0; return REG_ESPACE; @@ -1062,7 +1067,7 @@ re_node_set_add_intersect (re_node_set *dest, const re_node_set *src1, { Idx new_alloc = src1->nelem + src2->nelem + dest->alloc; Idx *new_elems = re_realloc (dest->elems, Idx, new_alloc); - if (BE (new_elems == NULL, 0)) + if (__glibc_unlikely (new_elems == NULL)) return REG_ESPACE; dest->elems = new_elems; dest->alloc = new_alloc; @@ -1148,7 +1153,7 @@ re_node_set_init_union (re_node_set *dest, const re_node_set *src1, { dest->alloc = src1->nelem + src2->nelem; dest->elems = re_malloc (Idx, dest->alloc); - if (BE (dest->elems == NULL, 0)) + if (__glibc_unlikely (dest->elems == NULL)) return REG_ESPACE; } else @@ -1202,13 +1207,13 @@ re_node_set_merge (re_node_set *dest, const re_node_set *src) { Idx new_alloc = 2 * (src->nelem + dest->alloc); Idx *new_buffer = re_realloc (dest->elems, Idx, new_alloc); - if (BE (new_buffer == NULL, 0)) + if (__glibc_unlikely (new_buffer == NULL)) return REG_ESPACE; dest->elems = new_buffer; dest->alloc = new_alloc; } - if (BE (dest->nelem == 0, 0)) + if (__glibc_unlikely (dest->nelem == 0)) { dest->nelem = src->nelem; memcpy (dest->elems, src->elems, src->nelem * sizeof (Idx)); @@ -1281,9 +1286,9 @@ re_node_set_insert (re_node_set *set, Idx elem) Idx idx; /* In case the set is empty. */ if (set->alloc == 0) - return BE (re_node_set_init_1 (set, elem) == REG_NOERROR, 1); + return __glibc_likely (re_node_set_init_1 (set, elem) == REG_NOERROR); - if (BE (set->nelem, 0) == 0) + if (__glibc_unlikely (set->nelem) == 0) { /* We already guaranteed above that set->alloc != 0. */ set->elems[0] = elem; @@ -1297,7 +1302,7 @@ re_node_set_insert (re_node_set *set, Idx elem) Idx *new_elems; set->alloc = set->alloc * 2; new_elems = re_realloc (set->elems, Idx, set->alloc); - if (BE (new_elems == NULL, 0)) + if (__glibc_unlikely (new_elems == NULL)) return false; set->elems = new_elems; } @@ -1336,7 +1341,7 @@ re_node_set_insert_last (re_node_set *set, Idx elem) Idx *new_elems; set->alloc = (set->alloc + 1) * 2; new_elems = re_realloc (set->elems, Idx, set->alloc); - if (BE (new_elems == NULL, 0)) + if (__glibc_unlikely (new_elems == NULL)) return false; set->elems = new_elems; } @@ -1403,7 +1408,7 @@ re_node_set_remove_at (re_node_set *set, Idx idx) static Idx re_dfa_add_node (re_dfa_t *dfa, re_token_t token) { - if (BE (dfa->nodes_len >= dfa->nodes_alloc, 0)) + if (__glibc_unlikely (dfa->nodes_len >= dfa->nodes_alloc)) { size_t new_nodes_alloc = dfa->nodes_alloc * 2; Idx *new_nexts, *new_indices; @@ -1414,19 +1419,20 @@ re_dfa_add_node (re_dfa_t *dfa, re_token_t token) const size_t max_object_size = MAX (sizeof (re_token_t), MAX (sizeof (re_node_set), sizeof (Idx))); - if (BE (MIN (IDX_MAX, SIZE_MAX / max_object_size) < new_nodes_alloc, 0)) + if (__glibc_unlikely (MIN (IDX_MAX, SIZE_MAX / max_object_size) + < new_nodes_alloc)) return -1; new_nodes = re_realloc (dfa->nodes, re_token_t, new_nodes_alloc); - if (BE (new_nodes == NULL, 0)) + if (__glibc_unlikely (new_nodes == NULL)) return -1; dfa->nodes = new_nodes; new_nexts = re_realloc (dfa->nexts, Idx, new_nodes_alloc); new_indices = re_realloc (dfa->org_indices, Idx, new_nodes_alloc); new_edests = re_realloc (dfa->edests, re_node_set, new_nodes_alloc); new_eclosures = re_realloc (dfa->eclosures, re_node_set, new_nodes_alloc); - if (BE (new_nexts == NULL || new_indices == NULL - || new_edests == NULL || new_eclosures == NULL, 0)) + if (__glibc_unlikely (new_nexts == NULL || new_indices == NULL + || new_edests == NULL || new_eclosures == NULL)) { re_free (new_nexts); re_free (new_indices); @@ -1485,7 +1491,7 @@ re_acquire_state (reg_errcode_t *err, const re_dfa_t *dfa, /* Suppress bogus uninitialized-variable warnings. */ *err = REG_NOERROR; #endif - if (BE (nodes->nelem == 0, 0)) + if (__glibc_unlikely (nodes->nelem == 0)) { *err = REG_NOERROR; return NULL; @@ -1504,7 +1510,7 @@ re_acquire_state (reg_errcode_t *err, const re_dfa_t *dfa, /* There are no appropriate state in the dfa, create the new one. */ new_state = create_ci_newstate (dfa, nodes, hash); - if (BE (new_state == NULL, 0)) + if (__glibc_unlikely (new_state == NULL)) *err = REG_ESPACE; return new_state; @@ -1551,7 +1557,7 @@ re_acquire_state_context (reg_errcode_t *err, const re_dfa_t *dfa, } /* There are no appropriate state in 'dfa', create the new one. */ new_state = create_cd_newstate (dfa, nodes, context, hash); - if (BE (new_state == NULL, 0)) + if (__glibc_unlikely (new_state == NULL)) *err = REG_ESPACE; return new_state; @@ -1572,7 +1578,7 @@ register_state (const re_dfa_t *dfa, re_dfastate_t *newstate, newstate->hash = hash; err = re_node_set_alloc (&newstate->non_eps_nodes, newstate->nodes.nelem); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return REG_ESPACE; for (i = 0; i < newstate->nodes.nelem; i++) { @@ -1583,12 +1589,12 @@ register_state (const re_dfa_t *dfa, re_dfastate_t *newstate, } spot = dfa->state_table + (hash & dfa->state_hash_mask); - if (BE (spot->alloc <= spot->num, 0)) + if (__glibc_unlikely (spot->alloc <= spot->num)) { Idx new_alloc = 2 * spot->num + 2; re_dfastate_t **new_array = re_realloc (spot->array, re_dfastate_t *, new_alloc); - if (BE (new_array == NULL, 0)) + if (__glibc_unlikely (new_array == NULL)) return REG_ESPACE; spot->array = new_array; spot->alloc = new_alloc; @@ -1626,10 +1632,10 @@ create_ci_newstate (const re_dfa_t *dfa, const re_node_set *nodes, re_dfastate_t *newstate; newstate = (re_dfastate_t *) calloc (sizeof (re_dfastate_t), 1); - if (BE (newstate == NULL, 0)) + if (__glibc_unlikely (newstate == NULL)) return NULL; err = re_node_set_init_copy (&newstate->nodes, nodes); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) { re_free (newstate); return NULL; @@ -1655,7 +1661,7 @@ create_ci_newstate (const re_dfa_t *dfa, const re_node_set *nodes, newstate->has_constraint = 1; } err = register_state (dfa, newstate, hash); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) { free_state (newstate); newstate = NULL; @@ -1676,10 +1682,10 @@ create_cd_newstate (const re_dfa_t *dfa, const re_node_set *nodes, re_dfastate_t *newstate; newstate = (re_dfastate_t *) calloc (sizeof (re_dfastate_t), 1); - if (BE (newstate == NULL, 0)) + if (__glibc_unlikely (newstate == NULL)) return NULL; err = re_node_set_init_copy (&newstate->nodes, nodes); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) { re_free (newstate); return NULL; @@ -1711,7 +1717,7 @@ create_cd_newstate (const re_dfa_t *dfa, const re_node_set *nodes, if (newstate->entrance_nodes == &newstate->nodes) { newstate->entrance_nodes = re_malloc (re_node_set, 1); - if (BE (newstate->entrance_nodes == NULL, 0)) + if (__glibc_unlikely (newstate->entrance_nodes == NULL)) { free_state (newstate); return NULL; @@ -1731,7 +1737,7 @@ create_cd_newstate (const re_dfa_t *dfa, const re_node_set *nodes, } } err = register_state (dfa, newstate, hash); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) { free_state (newstate); newstate = NULL; diff --git a/lib/regex_internal.h b/lib/regex_internal.h index dd0900b719..b0e49cd828 100644 --- a/lib/regex_internal.h +++ b/lib/regex_internal.h @@ -33,23 +33,7 @@ #include #include -/* Properties of integers. Although Gnulib has intprops.h, glibc does - without for now. */ -#ifndef _LIBC -# include "intprops.h" -#else -/* True if the real type T is signed. */ -# define TYPE_SIGNED(t) (! ((t) 0 < (t) -1)) - -/* True if adding the nonnegative Idx values A and B would overflow. - If false, set *R to A + B. A, B, and R may be evaluated more than - once, or zero times. Although this is not a full implementation of - Gnulib INT_ADD_WRAPV, it is good enough for glibc regex code. - FIXME: This implementation is a fragile stopgap, and this file would - be simpler and more robust if intprops.h were migrated into glibc. */ -# define INT_ADD_WRAPV(a, b, r) \ - (IDX_MAX - (a) < (b) ? true : (*(r) = (a) + (b), false)) -#endif +#include #ifdef _LIBC # include @@ -132,8 +116,6 @@ # define RE_ENABLE_I18N #endif -#define BE(expr, val) __builtin_expect (expr, val) - /* Number of ASCII characters. */ #define ASCII_CHARS 0x80 diff --git a/lib/regexec.c b/lib/regexec.c index 6591311164..8b82ea50d4 100644 --- a/lib/regexec.c +++ b/lib/regexec.c @@ -328,9 +328,8 @@ re_search_2_stub (struct re_pattern_buffer *bufp, const char *string1, Idx len; char *s = NULL; - if (BE ((length1 < 0 || length2 < 0 || stop < 0 - || INT_ADD_WRAPV (length1, length2, &len)), - 0)) + if (__glibc_unlikely ((length1 < 0 || length2 < 0 || stop < 0 + || INT_ADD_WRAPV (length1, length2, &len)))) return -2; /* Concatenate the strings. */ @@ -339,7 +338,7 @@ re_search_2_stub (struct re_pattern_buffer *bufp, const char *string1, { s = re_malloc (char, len); - if (BE (s == NULL, 0)) + if (__glibc_unlikely (s == NULL)) return -2; #ifdef _LIBC memcpy (__mempcpy (s, string1, length1), string2, length2); @@ -379,11 +378,13 @@ re_search_stub (struct re_pattern_buffer *bufp, const char *string, Idx length, Idx last_start = start + range; /* Check for out-of-range. */ - if (BE (start < 0 || start > length, 0)) + if (__glibc_unlikely (start < 0 || start > length)) return -1; - if (BE (length < last_start || (0 <= range && last_start < start), 0)) + if (__glibc_unlikely (length < last_start + || (0 <= range && last_start < start))) last_start = length; - else if (BE (last_start < 0 || (range < 0 && start <= last_start), 0)) + else if (__glibc_unlikely (last_start < 0 + || (range < 0 && start <= last_start))) last_start = 0; lock_lock (dfa->lock); @@ -395,17 +396,17 @@ re_search_stub (struct re_pattern_buffer *bufp, const char *string, Idx length, if (start < last_start && bufp->fastmap != NULL && !bufp->fastmap_accurate) re_compile_fastmap (bufp); - if (BE (bufp->no_sub, 0)) + if (__glibc_unlikely (bufp->no_sub)) regs = NULL; /* We need at least 1 register. */ if (regs == NULL) nregs = 1; - else if (BE (bufp->regs_allocated == REGS_FIXED - && regs->num_regs <= bufp->re_nsub, 0)) + else if (__glibc_unlikely (bufp->regs_allocated == REGS_FIXED + && regs->num_regs <= bufp->re_nsub)) { nregs = regs->num_regs; - if (BE (nregs < 1, 0)) + if (__glibc_unlikely (nregs < 1)) { /* Nothing can be copied to regs. */ regs = NULL; @@ -415,7 +416,7 @@ re_search_stub (struct re_pattern_buffer *bufp, const char *string, Idx length, else nregs = bufp->re_nsub + 1; pmatch = re_malloc (regmatch_t, nregs); - if (BE (pmatch == NULL, 0)) + if (__glibc_unlikely (pmatch == NULL)) { rval = -2; goto out; @@ -434,11 +435,11 @@ re_search_stub (struct re_pattern_buffer *bufp, const char *string, Idx length, /* If caller wants register contents data back, copy them. */ bufp->regs_allocated = re_copy_regs (regs, pmatch, nregs, bufp->regs_allocated); - if (BE (bufp->regs_allocated == REGS_UNALLOCATED, 0)) + if (__glibc_unlikely (bufp->regs_allocated == REGS_UNALLOCATED)) rval = -2; } - if (BE (rval == 0, 1)) + if (__glibc_likely (rval == 0)) { if (ret_len) { @@ -468,10 +469,10 @@ re_copy_regs (struct re_registers *regs, regmatch_t *pmatch, Idx nregs, if (regs_allocated == REGS_UNALLOCATED) { /* No. So allocate them with malloc. */ regs->start = re_malloc (regoff_t, need_regs); - if (BE (regs->start == NULL, 0)) + if (__glibc_unlikely (regs->start == NULL)) return REGS_UNALLOCATED; regs->end = re_malloc (regoff_t, need_regs); - if (BE (regs->end == NULL, 0)) + if (__glibc_unlikely (regs->end == NULL)) { re_free (regs->start); return REGS_UNALLOCATED; @@ -482,14 +483,14 @@ re_copy_regs (struct re_registers *regs, regmatch_t *pmatch, Idx nregs, { /* Yes. If we need more elements than were already allocated, reallocate them. If we need fewer, just leave it alone. */ - if (BE (need_regs > regs->num_regs, 0)) + if (__glibc_unlikely (need_regs > regs->num_regs)) { regoff_t *new_start = re_realloc (regs->start, regoff_t, need_regs); regoff_t *new_end; - if (BE (new_start == NULL, 0)) + if (__glibc_unlikely (new_start == NULL)) return REGS_UNALLOCATED; new_end = re_realloc (regs->end, regoff_t, need_regs); - if (BE (new_end == NULL, 0)) + if (__glibc_unlikely (new_end == NULL)) { re_free (new_start); return REGS_UNALLOCATED; @@ -615,9 +616,10 @@ re_search_internal (const regex_t *preg, const char *string, Idx length, nmatch -= extra_nmatch; /* Check if the DFA haven't been compiled. */ - if (BE (preg->used == 0 || dfa->init_state == NULL - || dfa->init_state_word == NULL || dfa->init_state_nl == NULL - || dfa->init_state_begbuf == NULL, 0)) + if (__glibc_unlikely (preg->used == 0 || dfa->init_state == NULL + || dfa->init_state_word == NULL + || dfa->init_state_nl == NULL + || dfa->init_state_begbuf == NULL)) return REG_NOMATCH; #ifdef DEBUG @@ -644,14 +646,14 @@ re_search_internal (const regex_t *preg, const char *string, Idx length, err = re_string_allocate (&mctx.input, string, length, dfa->nodes_len + 1, preg->translate, (preg->syntax & RE_ICASE) != 0, dfa); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) goto free_return; mctx.input.stop = stop; mctx.input.raw_stop = stop; mctx.input.newline_anchor = preg->newline_anchor; err = match_ctx_init (&mctx, eflags, dfa->nbackref * 2); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) goto free_return; /* We will log all the DFA states through which the dfa pass, @@ -661,15 +663,15 @@ re_search_internal (const regex_t *preg, const char *string, Idx length, if (nmatch > 1 || dfa->has_mb_node) { /* Avoid overflow. */ - if (BE ((MIN (IDX_MAX, SIZE_MAX / sizeof (re_dfastate_t *)) - <= mctx.input.bufs_len), 0)) + if (__glibc_unlikely ((MIN (IDX_MAX, SIZE_MAX / sizeof (re_dfastate_t *)) + <= mctx.input.bufs_len))) { err = REG_ESPACE; goto free_return; } mctx.state_log = re_malloc (re_dfastate_t *, mctx.input.bufs_len + 1); - if (BE (mctx.state_log == NULL, 0)) + if (__glibc_unlikely (mctx.state_log == NULL)) { err = REG_ESPACE; goto free_return; @@ -713,19 +715,19 @@ re_search_internal (const regex_t *preg, const char *string, Idx length, case 7: /* Fastmap with single-byte translation, match forward. */ - while (BE (match_first < right_lim, 1) + while (__glibc_likely (match_first < right_lim) && !fastmap[t[(unsigned char) string[match_first]]]) ++match_first; goto forward_match_found_start_or_reached_end; case 6: /* Fastmap without translation, match forward. */ - while (BE (match_first < right_lim, 1) + while (__glibc_likely (match_first < right_lim) && !fastmap[(unsigned char) string[match_first]]) ++match_first; forward_match_found_start_or_reached_end: - if (BE (match_first == right_lim, 0)) + if (__glibc_unlikely (match_first == right_lim)) { ch = match_first >= length ? 0 : (unsigned char) string[match_first]; @@ -758,11 +760,12 @@ re_search_internal (const regex_t *preg, const char *string, Idx length, /* If MATCH_FIRST is out of the valid range, reconstruct the buffers. */ __re_size_t offset = match_first - mctx.input.raw_mbs_idx; - if (BE (offset >= (__re_size_t) mctx.input.valid_raw_len, 0)) + if (__glibc_unlikely (offset + >= (__re_size_t) mctx.input.valid_raw_len)) { err = re_string_reconstruct (&mctx.input, match_first, eflags); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) goto free_return; offset = match_first - mctx.input.raw_mbs_idx; @@ -786,7 +789,7 @@ re_search_internal (const regex_t *preg, const char *string, Idx length, /* Reconstruct the buffers so that the matcher can assume that the matching starts from the beginning of the buffer. */ err = re_string_reconstruct (&mctx.input, match_first, eflags); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) goto free_return; #ifdef RE_ENABLE_I18N @@ -803,7 +806,7 @@ re_search_internal (const regex_t *preg, const char *string, Idx length, start <= last_start ? &match_first : NULL); if (match_last != -1) { - if (BE (match_last == -2, 0)) + if (__glibc_unlikely (match_last == -2)) { err = REG_ESPACE; goto free_return; @@ -823,7 +826,7 @@ re_search_internal (const regex_t *preg, const char *string, Idx length, err = prune_impossible_nodes (&mctx); if (err == REG_NOERROR) break; - if (BE (err != REG_NOMATCH, 0)) + if (__glibc_unlikely (err != REG_NOMATCH)) goto free_return; match_last = -1; } @@ -860,7 +863,7 @@ re_search_internal (const regex_t *preg, const char *string, Idx length, { err = set_regs (preg, &mctx, nmatch, pmatch, dfa->has_plural_match && dfa->nbackref > 0); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) goto free_return; } @@ -871,7 +874,7 @@ re_search_internal (const regex_t *preg, const char *string, Idx length, if (pmatch[reg_idx].rm_so != -1) { #ifdef RE_ENABLE_I18N - if (BE (mctx.input.offsets_needed != 0, 0)) + if (__glibc_unlikely (mctx.input.offsets_needed != 0)) { pmatch[reg_idx].rm_so = (pmatch[reg_idx].rm_so == mctx.input.valid_len @@ -930,11 +933,12 @@ prune_impossible_nodes (re_match_context_t *mctx) halt_node = mctx->last_node; /* Avoid overflow. */ - if (BE (MIN (IDX_MAX, SIZE_MAX / sizeof (re_dfastate_t *)) <= match_last, 0)) + if (__glibc_unlikely (MIN (IDX_MAX, SIZE_MAX / sizeof (re_dfastate_t *)) + <= match_last)) return REG_ESPACE; sifted_states = re_malloc (re_dfastate_t *, match_last + 1); - if (BE (sifted_states == NULL, 0)) + if (__glibc_unlikely (sifted_states == NULL)) { ret = REG_ESPACE; goto free_return; @@ -942,7 +946,7 @@ prune_impossible_nodes (re_match_context_t *mctx) if (dfa->nbackref) { lim_states = re_malloc (re_dfastate_t *, match_last + 1); - if (BE (lim_states == NULL, 0)) + if (__glibc_unlikely (lim_states == NULL)) { ret = REG_ESPACE; goto free_return; @@ -955,7 +959,7 @@ prune_impossible_nodes (re_match_context_t *mctx) match_last); ret = sift_states_backward (mctx, &sctx); re_node_set_free (&sctx.limits); - if (BE (ret != REG_NOERROR, 0)) + if (__glibc_unlikely (ret != REG_NOERROR)) goto free_return; if (sifted_states[0] != NULL || lim_states[0] != NULL) break; @@ -977,7 +981,7 @@ prune_impossible_nodes (re_match_context_t *mctx) match_last + 1); re_free (lim_states); lim_states = NULL; - if (BE (ret != REG_NOERROR, 0)) + if (__glibc_unlikely (ret != REG_NOERROR)) goto free_return; } else @@ -985,7 +989,7 @@ prune_impossible_nodes (re_match_context_t *mctx) sift_ctx_init (&sctx, sifted_states, lim_states, halt_node, match_last); ret = sift_states_backward (mctx, &sctx); re_node_set_free (&sctx.limits); - if (BE (ret != REG_NOERROR, 0)) + if (__glibc_unlikely (ret != REG_NOERROR)) goto free_return; if (sifted_states[0] == NULL) { @@ -1068,7 +1072,7 @@ check_matching (re_match_context_t *mctx, bool fl_longest_match, err = REG_NOERROR; cur_state = acquire_init_state_context (&err, mctx, cur_str_idx); /* An initial state must not be NULL (invalid). */ - if (BE (cur_state == NULL, 0)) + if (__glibc_unlikely (cur_state == NULL)) { assert (err == REG_ESPACE); return -2; @@ -1080,24 +1084,24 @@ check_matching (re_match_context_t *mctx, bool fl_longest_match, /* Check OP_OPEN_SUBEXP in the initial state in case that we use them later. E.g. Processing back references. */ - if (BE (dfa->nbackref, 0)) + if (__glibc_unlikely (dfa->nbackref)) { at_init_state = false; err = check_subexp_matching_top (mctx, &cur_state->nodes, 0); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; if (cur_state->has_backref) { err = transit_state_bkref (mctx, &cur_state->nodes); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; } } } /* If the RE accepts NULL string. */ - if (BE (cur_state->halt, 0)) + if (__glibc_unlikely (cur_state->halt)) { if (!cur_state->has_constraint || check_halt_state_context (mctx, cur_state, cur_str_idx)) @@ -1117,13 +1121,13 @@ check_matching (re_match_context_t *mctx, bool fl_longest_match, re_dfastate_t *old_state = cur_state; Idx next_char_idx = re_string_cur_idx (&mctx->input) + 1; - if ((BE (next_char_idx >= mctx->input.bufs_len, 0) + if ((__glibc_unlikely (next_char_idx >= mctx->input.bufs_len) && mctx->input.bufs_len < mctx->input.len) - || (BE (next_char_idx >= mctx->input.valid_len, 0) + || (__glibc_unlikely (next_char_idx >= mctx->input.valid_len) && mctx->input.valid_len < mctx->input.len)) { err = extend_buffers (mctx, next_char_idx + 1); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) { assert (err == REG_ESPACE); return -2; @@ -1139,7 +1143,7 @@ check_matching (re_match_context_t *mctx, bool fl_longest_match, /* Reached the invalid state or an error. Try to recover a valid state using the state log, if available and if we have not already found a valid (even if not the longest) match. */ - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return -2; if (mctx->state_log == NULL @@ -1148,7 +1152,7 @@ check_matching (re_match_context_t *mctx, bool fl_longest_match, break; } - if (BE (at_init_state, 0)) + if (__glibc_unlikely (at_init_state)) { if (old_state == cur_state) next_start_idx = next_char_idx; @@ -1237,7 +1241,7 @@ proceed_next_node (const re_match_context_t *mctx, Idx nregs, regmatch_t *regs, re_node_set *edests = &dfa->edests[node]; Idx dest_node; ok = re_node_set_insert (eps_via_nodes, node); - if (BE (! ok, 0)) + if (__glibc_unlikely (! ok)) return -2; /* Pick up a valid destination, or return -1 if none is found. */ @@ -1299,7 +1303,7 @@ proceed_next_node (const re_match_context_t *mctx, Idx nregs, regmatch_t *regs, { Idx dest_node; ok = re_node_set_insert (eps_via_nodes, node); - if (BE (! ok, 0)) + if (__glibc_unlikely (! ok)) return -2; dest_node = dfa->edests[node].elems[0]; if (re_node_set_contains (&mctx->state_log[*pidx]->nodes, @@ -1449,9 +1453,9 @@ set_regs (const regex_t *preg, const re_match_context_t *mctx, size_t nmatch, cur_node = proceed_next_node (mctx, nmatch, pmatch, &idx, cur_node, &eps_via_nodes, fs); - if (BE (cur_node < 0, 0)) + if (__glibc_unlikely (cur_node < 0)) { - if (BE (cur_node == -2, 0)) + if (__glibc_unlikely (cur_node == -2)) { re_node_set_free (&eps_via_nodes); if (prev_idx_match_malloced) @@ -1579,10 +1583,10 @@ sift_states_backward (const re_match_context_t *mctx, re_sift_context_t *sctx) /* Build sifted state_log[str_idx]. It has the nodes which can epsilon transit to the last_node and the last_node itself. */ err = re_node_set_init_1 (&cur_dest, sctx->last_node); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; err = update_cur_sifted_state (mctx, sctx, str_idx, &cur_dest); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) goto free_return; /* Then check each states in the state_log. */ @@ -1603,7 +1607,7 @@ sift_states_backward (const re_match_context_t *mctx, re_sift_context_t *sctx) if (mctx->state_log[str_idx]) { err = build_sifted_states (mctx, sctx, str_idx, &cur_dest); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) goto free_return; } @@ -1612,7 +1616,7 @@ sift_states_backward (const re_match_context_t *mctx, re_sift_context_t *sctx) - It is in CUR_SRC. And update state_log. */ err = update_cur_sifted_state (mctx, sctx, str_idx, &cur_dest); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) goto free_return; } err = REG_NOERROR; @@ -1674,7 +1678,7 @@ build_sifted_states (const re_match_context_t *mctx, re_sift_context_t *sctx, continue; } ok = re_node_set_insert (cur_dest, prev_node); - if (BE (! ok, 0)) + if (__glibc_unlikely (! ok)) return REG_ESPACE; } @@ -1695,7 +1699,7 @@ clean_state_log_if_needed (re_match_context_t *mctx, Idx next_state_log_idx) { reg_errcode_t err; err = extend_buffers (mctx, next_state_log_idx + 1); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; } @@ -1723,11 +1727,11 @@ merge_state_array (const re_dfa_t *dfa, re_dfastate_t **dst, re_node_set merged_set; err = re_node_set_init_union (&merged_set, &dst[st_idx]->nodes, &src[st_idx]->nodes); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; dst[st_idx] = re_acquire_state (&err, dfa, &merged_set); re_node_set_free (&merged_set); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; } } @@ -1754,7 +1758,7 @@ update_cur_sifted_state (const re_match_context_t *mctx, /* At first, add the nodes which can epsilon transit to a node in DEST_NODE. */ err = add_epsilon_src_nodes (dfa, dest_nodes, candidates); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; /* Then, check the limitations in the current sift_context. */ @@ -1762,20 +1766,20 @@ update_cur_sifted_state (const re_match_context_t *mctx, { err = check_subexp_limits (dfa, dest_nodes, candidates, &sctx->limits, mctx->bkref_ents, str_idx); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; } } sctx->sifted_states[str_idx] = re_acquire_state (&err, dfa, dest_nodes); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; } if (candidates && mctx->state_log[str_idx]->has_backref) { err = sift_states_bkref (mctx, sctx, str_idx, candidates); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; } return REG_NOERROR; @@ -1790,19 +1794,19 @@ add_epsilon_src_nodes (const re_dfa_t *dfa, re_node_set *dest_nodes, Idx i; re_dfastate_t *state = re_acquire_state (&err, dfa, dest_nodes); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; if (!state->inveclosure.alloc) { err = re_node_set_alloc (&state->inveclosure, dest_nodes->nelem); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return REG_ESPACE; for (i = 0; i < dest_nodes->nelem; i++) { err = re_node_set_merge (&state->inveclosure, dfa->inveclosures + dest_nodes->elems[i]); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return REG_ESPACE; } } @@ -1837,7 +1841,7 @@ sub_epsilon_src_nodes (const re_dfa_t *dfa, Idx node, re_node_set *dest_nodes, { err = re_node_set_add_intersect (&except_nodes, candidates, dfa->inveclosures + cur_node); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) { re_node_set_free (&except_nodes); return err; @@ -2043,7 +2047,7 @@ check_subexp_limits (const re_dfa_t *dfa, re_node_set *dest_nodes, { err = sub_epsilon_src_nodes (dfa, ops_node, dest_nodes, candidates); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; } @@ -2061,7 +2065,7 @@ check_subexp_limits (const re_dfa_t *dfa, re_node_set *dest_nodes, Remove it form the current sifted state. */ err = sub_epsilon_src_nodes (dfa, node, dest_nodes, candidates); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; --node_idx; } @@ -2081,7 +2085,7 @@ check_subexp_limits (const re_dfa_t *dfa, re_node_set *dest_nodes, Remove it form the current sifted state. */ err = sub_epsilon_src_nodes (dfa, node, dest_nodes, candidates); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; } } @@ -2147,27 +2151,27 @@ sift_states_bkref (const re_match_context_t *mctx, re_sift_context_t *sctx, { local_sctx = *sctx; err = re_node_set_init_copy (&local_sctx.limits, &sctx->limits); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) goto free_return; } local_sctx.last_node = node; local_sctx.last_str_idx = str_idx; ok = re_node_set_insert (&local_sctx.limits, enabled_idx); - if (BE (! ok, 0)) + if (__glibc_unlikely (! ok)) { err = REG_ESPACE; goto free_return; } cur_state = local_sctx.sifted_states[str_idx]; err = sift_states_backward (mctx, &local_sctx); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) goto free_return; if (sctx->limited_states != NULL) { err = merge_state_array (dfa, sctx->limited_states, local_sctx.sifted_states, str_idx + 1); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) goto free_return; } local_sctx.sifted_states[str_idx] = cur_state; @@ -2229,10 +2233,10 @@ transit_state (reg_errcode_t *err, re_match_context_t *mctx, #ifdef RE_ENABLE_I18N /* If the current state can accept multibyte. */ - if (BE (state->accept_mb, 0)) + if (__glibc_unlikely (state->accept_mb)) { *err = transit_state_mb (mctx, state); - if (BE (*err != REG_NOERROR, 0)) + if (__glibc_unlikely (*err != REG_NOERROR)) return NULL; } #endif /* RE_ENABLE_I18N */ @@ -2249,11 +2253,11 @@ transit_state (reg_errcode_t *err, re_match_context_t *mctx, for (;;) { trtable = state->trtable; - if (BE (trtable != NULL, 1)) + if (__glibc_likely (trtable != NULL)) return trtable[ch]; trtable = state->word_trtable; - if (BE (trtable != NULL, 1)) + if (__glibc_likely (trtable != NULL)) { unsigned int context; context @@ -2309,7 +2313,7 @@ merge_state_with_log (reg_errcode_t *err, re_match_context_t *mctx, table_nodes = next_state->entrance_nodes; *err = re_node_set_init_union (&next_nodes, table_nodes, log_nodes); - if (BE (*err != REG_NOERROR, 0)) + if (__glibc_unlikely (*err != REG_NOERROR)) return NULL; } else @@ -2329,21 +2333,21 @@ merge_state_with_log (reg_errcode_t *err, re_match_context_t *mctx, re_node_set_free (&next_nodes); } - if (BE (dfa->nbackref, 0) && next_state != NULL) + if (__glibc_unlikely (dfa->nbackref) && next_state != NULL) { /* Check OP_OPEN_SUBEXP in the current state in case that we use them later. We must check them here, since the back references in the next state might use them. */ *err = check_subexp_matching_top (mctx, &next_state->nodes, cur_idx); - if (BE (*err != REG_NOERROR, 0)) + if (__glibc_unlikely (*err != REG_NOERROR)) return NULL; /* If the next state has back references. */ if (next_state->has_backref) { *err = transit_state_bkref (mctx, &next_state->nodes); - if (BE (*err != REG_NOERROR, 0)) + if (__glibc_unlikely (*err != REG_NOERROR)) return NULL; next_state = mctx->state_log[cur_idx]; } @@ -2407,7 +2411,7 @@ check_subexp_matching_top (re_match_context_t *mctx, re_node_set *cur_nodes, & ((bitset_word_t) 1 << dfa->nodes[node].opr.idx))) { err = match_ctx_add_subtop (mctx, node, str_idx); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; } } @@ -2429,7 +2433,7 @@ transit_state_sb (reg_errcode_t *err, re_match_context_t *mctx, unsigned int context; *err = re_node_set_alloc (&next_nodes, state->nodes.nelem + 1); - if (BE (*err != REG_NOERROR, 0)) + if (__glibc_unlikely (*err != REG_NOERROR)) return NULL; for (node_cnt = 0; node_cnt < state->nodes.nelem; ++node_cnt) { @@ -2438,7 +2442,7 @@ transit_state_sb (reg_errcode_t *err, re_match_context_t *mctx, { *err = re_node_set_merge (&next_nodes, dfa->eclosures + dfa->nexts[cur_node]); - if (BE (*err != REG_NOERROR, 0)) + if (__glibc_unlikely (*err != REG_NOERROR)) { re_node_set_free (&next_nodes); return NULL; @@ -2497,7 +2501,7 @@ transit_state_mb (re_match_context_t *mctx, re_dfastate_t *pstate) mctx->max_mb_elem_len = ((mctx->max_mb_elem_len < naccepted) ? naccepted : mctx->max_mb_elem_len); err = clean_state_log_if_needed (mctx, dest_idx); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; #ifdef DEBUG assert (dfa->nexts[cur_node_idx] != -1); @@ -2511,7 +2515,7 @@ transit_state_mb (re_match_context_t *mctx, re_dfastate_t *pstate) { err = re_node_set_init_union (&dest_nodes, dest_state->entrance_nodes, new_nodes); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; } context = re_string_context_at (&mctx->input, dest_idx - 1, @@ -2520,7 +2524,8 @@ transit_state_mb (re_match_context_t *mctx, re_dfastate_t *pstate) = re_acquire_state_context (&err, dfa, &dest_nodes, context); if (dest_state != NULL) re_node_set_free (&dest_nodes); - if (BE (mctx->state_log[dest_idx] == NULL && err != REG_NOERROR, 0)) + if (__glibc_unlikely (mctx->state_log[dest_idx] == NULL + && err != REG_NOERROR)) return err; } return REG_NOERROR; @@ -2559,7 +2564,7 @@ transit_state_bkref (re_match_context_t *mctx, const re_node_set *nodes) Check the substring which the substring matched. */ bkc_idx = mctx->nbkref_ents; err = get_subexp (mctx, node_idx, cur_str_idx); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) goto free_return; /* And add the epsilon closures (which is 'new_dest_nodes') of @@ -2592,8 +2597,8 @@ transit_state_bkref (re_match_context_t *mctx, const re_node_set *nodes) mctx->state_log[dest_str_idx] = re_acquire_state_context (&err, dfa, new_dest_nodes, context); - if (BE (mctx->state_log[dest_str_idx] == NULL - && err != REG_NOERROR, 0)) + if (__glibc_unlikely (mctx->state_log[dest_str_idx] == NULL + && err != REG_NOERROR)) goto free_return; } else @@ -2602,7 +2607,7 @@ transit_state_bkref (re_match_context_t *mctx, const re_node_set *nodes) err = re_node_set_init_union (&dest_nodes, dest_state->entrance_nodes, new_dest_nodes); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) { re_node_set_free (&dest_nodes); goto free_return; @@ -2610,8 +2615,8 @@ transit_state_bkref (re_match_context_t *mctx, const re_node_set *nodes) mctx->state_log[dest_str_idx] = re_acquire_state_context (&err, dfa, &dest_nodes, context); re_node_set_free (&dest_nodes); - if (BE (mctx->state_log[dest_str_idx] == NULL - && err != REG_NOERROR, 0)) + if (__glibc_unlikely (mctx->state_log[dest_str_idx] == NULL + && err != REG_NOERROR)) goto free_return; } /* We need to check recursively if the backreference can epsilon @@ -2621,10 +2626,10 @@ transit_state_bkref (re_match_context_t *mctx, const re_node_set *nodes) { err = check_subexp_matching_top (mctx, new_dest_nodes, cur_str_idx); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) goto free_return; err = transit_state_bkref (mctx, new_dest_nodes); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) goto free_return; } } @@ -2685,7 +2690,8 @@ get_subexp (re_match_context_t *mctx, Idx bkref_node, Idx bkref_str_idx) at the back reference? */ if (sl_str_diff > 0) { - if (BE (bkref_str_off + sl_str_diff > mctx->input.valid_len, 0)) + if (__glibc_unlikely (bkref_str_off + sl_str_diff + > mctx->input.valid_len)) { /* Not enough chars for a successful match. */ if (bkref_str_off + sl_str_diff > mctx->input.len) @@ -2694,7 +2700,7 @@ get_subexp (re_match_context_t *mctx, Idx bkref_node, Idx bkref_str_idx) err = clean_state_log_if_needed (mctx, bkref_str_off + sl_str_diff); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; buf = (const char *) re_string_get_buffer (&mctx->input); } @@ -2713,7 +2719,7 @@ get_subexp (re_match_context_t *mctx, Idx bkref_node, Idx bkref_str_idx) if (err == REG_NOMATCH) continue; - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; } @@ -2732,14 +2738,14 @@ get_subexp (re_match_context_t *mctx, Idx bkref_node, Idx bkref_str_idx) at the back reference? */ if (sl_str_off > 0) { - if (BE (bkref_str_off >= mctx->input.valid_len, 0)) + if (__glibc_unlikely (bkref_str_off >= mctx->input.valid_len)) { /* If we are at the end of the input, we cannot match. */ if (bkref_str_off >= mctx->input.len) break; err = extend_buffers (mctx, bkref_str_off + 1); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; buf = (const char *) re_string_get_buffer (&mctx->input); @@ -2770,10 +2776,10 @@ get_subexp (re_match_context_t *mctx, Idx bkref_node, Idx bkref_str_idx) OP_CLOSE_SUBEXP); if (err == REG_NOMATCH) continue; - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; sub_last = match_ctx_add_sublast (sub_top, cls_node, sl_str); - if (BE (sub_last == NULL, 0)) + if (__glibc_unlikely (sub_last == NULL)) return REG_ESPACE; err = get_subexp_sub (mctx, sub_top, sub_last, bkref_node, bkref_str_idx); @@ -2804,7 +2810,7 @@ get_subexp_sub (re_match_context_t *mctx, const re_sub_match_top_t *sub_top, return err; err = match_ctx_add_entry (mctx, bkref_node, bkref_str, sub_top->str_idx, sub_last->str_idx); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; to_idx = bkref_str + sub_last->str_idx - sub_top->str_idx; return clean_state_log_if_needed (mctx, to_idx); @@ -2854,19 +2860,19 @@ check_arrival (re_match_context_t *mctx, state_array_t *path, Idx top_node, subexp_num = dfa->nodes[top_node].opr.idx; /* Extend the buffer if we need. */ - if (BE (path->alloc < last_str + mctx->max_mb_elem_len + 1, 0)) + if (__glibc_unlikely (path->alloc < last_str + mctx->max_mb_elem_len + 1)) { re_dfastate_t **new_array; Idx old_alloc = path->alloc; Idx incr_alloc = last_str + mctx->max_mb_elem_len + 1; Idx new_alloc; - if (BE (IDX_MAX - old_alloc < incr_alloc, 0)) + if (__glibc_unlikely (IDX_MAX - old_alloc < incr_alloc)) return REG_ESPACE; new_alloc = old_alloc + incr_alloc; - if (BE (SIZE_MAX / sizeof (re_dfastate_t *) < new_alloc, 0)) + if (__glibc_unlikely (SIZE_MAX / sizeof (re_dfastate_t *) < new_alloc)) return REG_ESPACE; new_array = re_realloc (path->array, re_dfastate_t *, new_alloc); - if (BE (new_array == NULL, 0)) + if (__glibc_unlikely (new_array == NULL)) return REG_ESPACE; path->array = new_array; path->alloc = new_alloc; @@ -2887,10 +2893,10 @@ check_arrival (re_match_context_t *mctx, state_array_t *path, Idx top_node, if (str_idx == top_str) { err = re_node_set_init_1 (&next_nodes, top_node); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; err = check_arrival_expand_ecl (dfa, &next_nodes, subexp_num, type); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) { re_node_set_free (&next_nodes); return err; @@ -2902,7 +2908,7 @@ check_arrival (re_match_context_t *mctx, state_array_t *path, Idx top_node, if (cur_state && cur_state->has_backref) { err = re_node_set_init_copy (&next_nodes, &cur_state->nodes); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; } else @@ -2914,14 +2920,14 @@ check_arrival (re_match_context_t *mctx, state_array_t *path, Idx top_node, { err = expand_bkref_cache (mctx, &next_nodes, str_idx, subexp_num, type); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) { re_node_set_free (&next_nodes); return err; } } cur_state = re_acquire_state_context (&err, dfa, &next_nodes, context); - if (BE (cur_state == NULL && err != REG_NOERROR, 0)) + if (__glibc_unlikely (cur_state == NULL && err != REG_NOERROR)) { re_node_set_free (&next_nodes); return err; @@ -2936,7 +2942,7 @@ check_arrival (re_match_context_t *mctx, state_array_t *path, Idx top_node, { err = re_node_set_merge (&next_nodes, &mctx->state_log[str_idx + 1]->nodes); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) { re_node_set_free (&next_nodes); return err; @@ -2947,7 +2953,7 @@ check_arrival (re_match_context_t *mctx, state_array_t *path, Idx top_node, err = check_arrival_add_next_nodes (mctx, str_idx, &cur_state->non_eps_nodes, &next_nodes); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) { re_node_set_free (&next_nodes); return err; @@ -2957,14 +2963,14 @@ check_arrival (re_match_context_t *mctx, state_array_t *path, Idx top_node, if (next_nodes.nelem) { err = check_arrival_expand_ecl (dfa, &next_nodes, subexp_num, type); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) { re_node_set_free (&next_nodes); return err; } err = expand_bkref_cache (mctx, &next_nodes, str_idx, subexp_num, type); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) { re_node_set_free (&next_nodes); return err; @@ -2972,7 +2978,7 @@ check_arrival (re_match_context_t *mctx, state_array_t *path, Idx top_node, } context = re_string_context_at (&mctx->input, str_idx - 1, mctx->eflags); cur_state = re_acquire_state_context (&err, dfa, &next_nodes, context); - if (BE (cur_state == NULL && err != REG_NOERROR, 0)) + if (__glibc_unlikely (cur_state == NULL && err != REG_NOERROR)) { re_node_set_free (&next_nodes); return err; @@ -3041,22 +3047,22 @@ check_arrival_add_next_nodes (re_match_context_t *mctx, Idx str_idx, if (dest_state) { err = re_node_set_merge (&union_set, &dest_state->nodes); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) { re_node_set_free (&union_set); return err; } } ok = re_node_set_insert (&union_set, next_node); - if (BE (! ok, 0)) + if (__glibc_unlikely (! ok)) { re_node_set_free (&union_set); return REG_ESPACE; } mctx->state_log[next_idx] = re_acquire_state (&err, dfa, &union_set); - if (BE (mctx->state_log[next_idx] == NULL - && err != REG_NOERROR, 0)) + if (__glibc_unlikely (mctx->state_log[next_idx] == NULL + && err != REG_NOERROR)) { re_node_set_free (&union_set); return err; @@ -3068,7 +3074,7 @@ check_arrival_add_next_nodes (re_match_context_t *mctx, Idx str_idx, || check_node_accept (mctx, dfa->nodes + cur_node, str_idx)) { ok = re_node_set_insert (next_nodes, dfa->nexts[cur_node]); - if (BE (! ok, 0)) + if (__glibc_unlikely (! ok)) { re_node_set_free (&union_set); return REG_ESPACE; @@ -3096,7 +3102,7 @@ check_arrival_expand_ecl (const re_dfa_t *dfa, re_node_set *cur_nodes, assert (cur_nodes->nelem); #endif err = re_node_set_alloc (&new_nodes, cur_nodes->nelem); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; /* Create a new node set NEW_NODES with the nodes which are epsilon closures of the node in CUR_NODES. */ @@ -3110,7 +3116,7 @@ check_arrival_expand_ecl (const re_dfa_t *dfa, re_node_set *cur_nodes, { /* There are no problematic nodes, just merge them. */ err = re_node_set_merge (&new_nodes, eclosure); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) { re_node_set_free (&new_nodes); return err; @@ -3121,7 +3127,7 @@ check_arrival_expand_ecl (const re_dfa_t *dfa, re_node_set *cur_nodes, /* There are problematic nodes, re-calculate incrementally. */ err = check_arrival_expand_ecl_sub (dfa, &new_nodes, cur_node, ex_subexp, type); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) { re_node_set_free (&new_nodes); return err; @@ -3153,13 +3159,13 @@ check_arrival_expand_ecl_sub (const re_dfa_t *dfa, re_node_set *dst_nodes, if (type == OP_CLOSE_SUBEXP) { ok = re_node_set_insert (dst_nodes, cur_node); - if (BE (! ok, 0)) + if (__glibc_unlikely (! ok)) return REG_ESPACE; } break; } ok = re_node_set_insert (dst_nodes, cur_node); - if (BE (! ok, 0)) + if (__glibc_unlikely (! ok)) return REG_ESPACE; if (dfa->edests[cur_node].nelem == 0) break; @@ -3169,7 +3175,7 @@ check_arrival_expand_ecl_sub (const re_dfa_t *dfa, re_node_set *dst_nodes, err = check_arrival_expand_ecl_sub (dfa, dst_nodes, dfa->edests[cur_node].elems[1], ex_subexp, type); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; } cur_node = dfa->edests[cur_node].elems[0]; @@ -3221,8 +3227,8 @@ expand_bkref_cache (re_match_context_t *mctx, re_node_set *cur_nodes, err2 = check_arrival_expand_ecl (dfa, &new_dests, subexp_num, type); err3 = re_node_set_merge (cur_nodes, &new_dests); re_node_set_free (&new_dests); - if (BE (err != REG_NOERROR || err2 != REG_NOERROR - || err3 != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR || err2 != REG_NOERROR + || err3 != REG_NOERROR)) { err = (err != REG_NOERROR ? err : (err2 != REG_NOERROR ? err2 : err3)); @@ -3244,7 +3250,7 @@ expand_bkref_cache (re_match_context_t *mctx, re_node_set *cur_nodes, err = re_node_set_init_copy (&union_set, &mctx->state_log[to_idx]->nodes); ok = re_node_set_insert (&union_set, next_node); - if (BE (err != REG_NOERROR || ! ok, 0)) + if (__glibc_unlikely (err != REG_NOERROR || ! ok)) { re_node_set_free (&union_set); err = err != REG_NOERROR ? err : REG_ESPACE; @@ -3254,13 +3260,13 @@ expand_bkref_cache (re_match_context_t *mctx, re_node_set *cur_nodes, else { err = re_node_set_init_1 (&union_set, next_node); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) return err; } mctx->state_log[to_idx] = re_acquire_state (&err, dfa, &union_set); re_node_set_free (&union_set); - if (BE (mctx->state_log[to_idx] == NULL - && err != REG_NOERROR, 0)) + if (__glibc_unlikely (mctx->state_log[to_idx] == NULL + && err != REG_NOERROR)) return err; } } @@ -3303,7 +3309,7 @@ build_trtable (const re_dfa_t *dfa, re_dfastate_t *state) else { dests_alloc = re_malloc (struct dests_alloc, 1); - if (BE (dests_alloc == NULL, 0)) + if (__glibc_unlikely (dests_alloc == NULL)) return false; dests_node_malloced = true; } @@ -3316,7 +3322,7 @@ build_trtable (const re_dfa_t *dfa, re_dfastate_t *state) /* At first, group all nodes belonging to 'state' into several destinations. */ ndests = group_nodes_into_DFAstates (dfa, state, dests_node, dests_ch); - if (BE (ndests <= 0, 0)) + if (__glibc_unlikely (ndests <= 0)) { if (dests_node_malloced) re_free (dests_alloc); @@ -3325,7 +3331,7 @@ build_trtable (const re_dfa_t *dfa, re_dfastate_t *state) { state->trtable = (re_dfastate_t **) calloc (sizeof (re_dfastate_t *), SBC_MAX); - if (BE (state->trtable == NULL, 0)) + if (__glibc_unlikely (state->trtable == NULL)) return false; return true; } @@ -3333,14 +3339,14 @@ build_trtable (const re_dfa_t *dfa, re_dfastate_t *state) } err = re_node_set_alloc (&follows, ndests + 1); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) goto out_free; /* Avoid arithmetic overflow in size calculation. */ - if (BE ((((SIZE_MAX - (sizeof (re_node_set) + sizeof (bitset_t)) * SBC_MAX) - / (3 * sizeof (re_dfastate_t *))) - < ndests), - 0)) + size_t ndests_max + = ((SIZE_MAX - (sizeof (re_node_set) + sizeof (bitset_t)) * SBC_MAX) + / (3 * sizeof (re_dfastate_t *))); + if (__glibc_unlikely (ndests_max < ndests)) goto out_free; if (__libc_use_alloca ((sizeof (re_node_set) + sizeof (bitset_t)) * SBC_MAX @@ -3350,7 +3356,7 @@ build_trtable (const re_dfa_t *dfa, re_dfastate_t *state) else { dest_states = re_malloc (re_dfastate_t *, ndests * 3); - if (BE (dest_states == NULL, 0)) + if (__glibc_unlikely (dest_states == NULL)) { out_free: if (dest_states_malloced) @@ -3380,12 +3386,12 @@ build_trtable (const re_dfa_t *dfa, re_dfastate_t *state) if (next_node != -1) { err = re_node_set_merge (&follows, dfa->eclosures + next_node); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) goto out_free; } } dest_states[i] = re_acquire_state_context (&err, dfa, &follows, 0); - if (BE (dest_states[i] == NULL && err != REG_NOERROR, 0)) + if (__glibc_unlikely (dest_states[i] == NULL && err != REG_NOERROR)) goto out_free; /* If the new state has context constraint, build appropriate states for these contexts. */ @@ -3393,7 +3399,8 @@ build_trtable (const re_dfa_t *dfa, re_dfastate_t *state) { dest_states_word[i] = re_acquire_state_context (&err, dfa, &follows, CONTEXT_WORD); - if (BE (dest_states_word[i] == NULL && err != REG_NOERROR, 0)) + if (__glibc_unlikely (dest_states_word[i] == NULL + && err != REG_NOERROR)) goto out_free; if (dest_states[i] != dest_states_word[i] && dfa->mb_cur_max > 1) @@ -3401,7 +3408,7 @@ build_trtable (const re_dfa_t *dfa, re_dfastate_t *state) dest_states_nl[i] = re_acquire_state_context (&err, dfa, &follows, CONTEXT_NEWLINE); - if (BE (dest_states_nl[i] == NULL && err != REG_NOERROR, 0)) + if (__glibc_unlikely (dest_states_nl[i] == NULL && err != REG_NOERROR)) goto out_free; } else @@ -3412,7 +3419,7 @@ build_trtable (const re_dfa_t *dfa, re_dfastate_t *state) bitset_merge (acceptable, dests_ch[i]); } - if (!BE (need_word_trtable, 0)) + if (!__glibc_unlikely (need_word_trtable)) { /* We don't care about whether the following character is a word character, or we are in a single-byte character set so we can @@ -3420,7 +3427,7 @@ build_trtable (const re_dfa_t *dfa, re_dfastate_t *state) 256-entry transition table. */ trtable = state->trtable = (re_dfastate_t **) calloc (sizeof (re_dfastate_t *), SBC_MAX); - if (BE (trtable == NULL, 0)) + if (__glibc_unlikely (trtable == NULL)) goto out_free; /* For all characters ch...: */ @@ -3428,7 +3435,7 @@ build_trtable (const re_dfa_t *dfa, re_dfastate_t *state) for (ch = i * BITSET_WORD_BITS, elem = acceptable[i], mask = 1; elem; mask <<= 1, elem >>= 1, ++ch) - if (BE (elem & 1, 0)) + if (__glibc_unlikely (elem & 1)) { /* There must be exactly one destination which accepts character ch. See group_nodes_into_DFAstates. */ @@ -3451,7 +3458,7 @@ build_trtable (const re_dfa_t *dfa, re_dfastate_t *state) starting at trtable[SBC_MAX]. */ trtable = state->word_trtable = (re_dfastate_t **) calloc (sizeof (re_dfastate_t *), 2 * SBC_MAX); - if (BE (trtable == NULL, 0)) + if (__glibc_unlikely (trtable == NULL)) goto out_free; /* For all characters ch...: */ @@ -3459,7 +3466,7 @@ build_trtable (const re_dfa_t *dfa, re_dfastate_t *state) for (ch = i * BITSET_WORD_BITS, elem = acceptable[i], mask = 1; elem; mask <<= 1, elem >>= 1, ++ch) - if (BE (elem & 1, 0)) + if (__glibc_unlikely (elem & 1)) { /* There must be exactly one destination which accepts character ch. See group_nodes_into_DFAstates. */ @@ -3658,14 +3665,14 @@ group_nodes_into_DFAstates (const re_dfa_t *dfa, const re_dfastate_t *state, bitset_copy (dests_ch[ndests], remains); bitset_copy (dests_ch[j], intersec); err = re_node_set_init_copy (dests_node + ndests, &dests_node[j]); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) goto error_return; ++ndests; } /* Put the position in the current group. */ ok = re_node_set_insert (&dests_node[j], cur_nodes->elems[i]); - if (BE (! ok, 0)) + if (__glibc_unlikely (! ok)) goto error_return; /* If all characters are consumed, go to next node. */ @@ -3677,7 +3684,7 @@ group_nodes_into_DFAstates (const re_dfa_t *dfa, const re_dfastate_t *state, { bitset_copy (dests_ch[ndests], accepts); err = re_node_set_init_1 (dests_node + ndests, cur_nodes->elems[i]); - if (BE (err != REG_NOERROR, 0)) + if (__glibc_unlikely (err != REG_NOERROR)) goto error_return; ++ndests; bitset_empty (accepts); @@ -3711,10 +3718,10 @@ check_node_accept_bytes (const re_dfa_t *dfa, Idx node_idx, int char_len, elem_len; Idx i; - if (BE (node->type == OP_UTF8_PERIOD, 0)) + if (__glibc_unlikely (node->type == OP_UTF8_PERIOD)) { unsigned char c = re_string_byte_at (input, str_idx), d; - if (BE (c < 0xc2, 1)) + if (__glibc_likely (c < 0xc2)) return 0; if (str_idx + 2 > input->len) @@ -4049,15 +4056,15 @@ extend_buffers (re_match_context_t *mctx, int min_len) re_string_t *pstr = &mctx->input; /* Avoid overflow. */ - if (BE (MIN (IDX_MAX, SIZE_MAX / sizeof (re_dfastate_t *)) / 2 - <= pstr->bufs_len, 0)) + if (__glibc_unlikely (MIN (IDX_MAX, SIZE_MAX / sizeof (re_dfastate_t *)) / 2 + <= pstr->bufs_len)) return REG_ESPACE; /* Double the lengths of the buffers, but allocate at least MIN_LEN. */ ret = re_string_realloc_buffers (pstr, MAX (min_len, MIN (pstr->len, pstr->bufs_len * 2))); - if (BE (ret != REG_NOERROR, 0)) + if (__glibc_unlikely (ret != REG_NOERROR)) return ret; if (mctx->state_log != NULL) @@ -4068,7 +4075,7 @@ extend_buffers (re_match_context_t *mctx, int min_len) does not have the right size. */ re_dfastate_t **new_array = re_realloc (mctx->state_log, re_dfastate_t *, pstr->bufs_len + 1); - if (BE (new_array == NULL, 0)) + if (__glibc_unlikely (new_array == NULL)) return REG_ESPACE; mctx->state_log = new_array; } @@ -4080,7 +4087,7 @@ extend_buffers (re_match_context_t *mctx, int min_len) if (pstr->mb_cur_max > 1) { ret = build_wcs_upper_buffer (pstr); - if (BE (ret != REG_NOERROR, 0)) + if (__glibc_unlikely (ret != REG_NOERROR)) return ret; } else @@ -4119,12 +4126,12 @@ match_ctx_init (re_match_context_t *mctx, int eflags, Idx n) size_t max_object_size = MAX (sizeof (struct re_backref_cache_entry), sizeof (re_sub_match_top_t *)); - if (BE (MIN (IDX_MAX, SIZE_MAX / max_object_size) < n, 0)) + if (__glibc_unlikely (MIN (IDX_MAX, SIZE_MAX / max_object_size) < n)) return REG_ESPACE; mctx->bkref_ents = re_malloc (struct re_backref_cache_entry, n); mctx->sub_tops = re_malloc (re_sub_match_top_t *, n); - if (BE (mctx->bkref_ents == NULL || mctx->sub_tops == NULL, 0)) + if (__glibc_unlikely (mctx->bkref_ents == NULL || mctx->sub_tops == NULL)) return REG_ESPACE; } /* Already zero-ed by the caller. @@ -4195,7 +4202,7 @@ match_ctx_add_entry (re_match_context_t *mctx, Idx node, Idx str_idx, Idx from, struct re_backref_cache_entry* new_entry; new_entry = re_realloc (mctx->bkref_ents, struct re_backref_cache_entry, mctx->abkref_ents * 2); - if (BE (new_entry == NULL, 0)) + if (__glibc_unlikely (new_entry == NULL)) { re_free (mctx->bkref_ents); return REG_ESPACE; @@ -4264,19 +4271,19 @@ match_ctx_add_subtop (re_match_context_t *mctx, Idx node, Idx str_idx) assert (mctx->sub_tops != NULL); assert (mctx->asub_tops > 0); #endif - if (BE (mctx->nsub_tops == mctx->asub_tops, 0)) + if (__glibc_unlikely (mctx->nsub_tops == mctx->asub_tops)) { Idx new_asub_tops = mctx->asub_tops * 2; re_sub_match_top_t **new_array = re_realloc (mctx->sub_tops, re_sub_match_top_t *, new_asub_tops); - if (BE (new_array == NULL, 0)) + if (__glibc_unlikely (new_array == NULL)) return REG_ESPACE; mctx->sub_tops = new_array; mctx->asub_tops = new_asub_tops; } mctx->sub_tops[mctx->nsub_tops] = calloc (1, sizeof (re_sub_match_top_t)); - if (BE (mctx->sub_tops[mctx->nsub_tops] == NULL, 0)) + if (__glibc_unlikely (mctx->sub_tops[mctx->nsub_tops] == NULL)) return REG_ESPACE; mctx->sub_tops[mctx->nsub_tops]->node = node; mctx->sub_tops[mctx->nsub_tops++]->str_idx = str_idx; @@ -4290,19 +4297,19 @@ static re_sub_match_last_t * match_ctx_add_sublast (re_sub_match_top_t *subtop, Idx node, Idx str_idx) { re_sub_match_last_t *new_entry; - if (BE (subtop->nlasts == subtop->alasts, 0)) + if (__glibc_unlikely (subtop->nlasts == subtop->alasts)) { Idx new_alasts = 2 * subtop->alasts + 1; re_sub_match_last_t **new_array = re_realloc (subtop->lasts, re_sub_match_last_t *, new_alasts); - if (BE (new_array == NULL, 0)) + if (__glibc_unlikely (new_array == NULL)) return NULL; subtop->lasts = new_array; subtop->alasts = new_alasts; } new_entry = calloc (1, sizeof (re_sub_match_last_t)); - if (BE (new_entry != NULL, 1)) + if (__glibc_likely (new_entry != NULL)) { subtop->lasts[subtop->nlasts] = new_entry; new_entry->node = node; diff --git a/m4/__inline.m4 b/m4/__inline.m4 new file mode 100644 index 0000000000..3d0c479899 --- /dev/null +++ b/m4/__inline.m4 @@ -0,0 +1,22 @@ +# Test for __inline keyword +dnl Copyright 2017-2018 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +AC_DEFUN([gl___INLINE], +[ + AC_CACHE_CHECK([whether the compiler supports the __inline keyword], + [gl_cv_c___inline], + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [[typedef int foo_t; + static __inline foo_t foo (void) { return 0; }]], + [[return foo ();]])], + [gl_cv_c___inline=yes], + [gl_cv_c___inline=no])]) + if test $gl_cv_c___inline = yes; then + AC_DEFINE([HAVE___INLINE], [1], + [Define to 1 if the compiler supports the keyword '__inline'.]) + fi +]) diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 61aabaa342..74f28178ff 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -109,6 +109,7 @@ AC_DEFUN([gl_EARLY], # Code from module inttypes-incomplete: # Code from module largefile: AC_REQUIRE([AC_SYS_LARGEFILE]) + # Code from module libc-config: # Code from module limits-h: # Code from module localtime-buffer: # Code from module lstat: @@ -441,6 +442,7 @@ AC_DEFUN([gl_INIT], gl_gnulib_enabled_getgroups=false gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=false gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1=false + gl_gnulib_enabled_21ee726a3540c09237a8e70c0baf7467=false gl_gnulib_enabled_2049e887c7e5308faad27b3f894bb8c9=false gl_gnulib_enabled_5264294aa0a5557541b53c8c741f7f31=false gl_gnulib_enabled_open=false @@ -554,6 +556,13 @@ AC_DEFUN([gl_INIT], fi fi } + func_gl_gnulib_m4code_21ee726a3540c09237a8e70c0baf7467 () + { + if ! $gl_gnulib_enabled_21ee726a3540c09237a8e70c0baf7467; then + gl___INLINE + gl_gnulib_enabled_21ee726a3540c09237a8e70c0baf7467=true + fi + } func_gl_gnulib_m4code_2049e887c7e5308faad27b3f894bb8c9 () { if ! $gl_gnulib_enabled_2049e887c7e5308faad27b3f894bb8c9; then @@ -669,6 +678,9 @@ AC_DEFUN([gl_INIT], if test $ac_use_included_regex = yes; then func_gl_gnulib_m4code_37f71b604aa9c54446783d80f42fe547 fi + if test $ac_use_included_regex = yes; then + func_gl_gnulib_m4code_21ee726a3540c09237a8e70c0baf7467 + fi if { test $HAVE_DECL_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; } && test $ac_cv_type_long_long_int = yes; then func_gl_gnulib_m4code_strtoll fi @@ -686,6 +698,7 @@ AC_DEFUN([gl_INIT], AM_CONDITIONAL([gl_GNULIB_ENABLED_getgroups], [$gl_gnulib_enabled_getgroups]) AM_CONDITIONAL([gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36], [$gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36]) AM_CONDITIONAL([gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1], [$gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1]) + AM_CONDITIONAL([gl_GNULIB_ENABLED_21ee726a3540c09237a8e70c0baf7467], [$gl_gnulib_enabled_21ee726a3540c09237a8e70c0baf7467]) AM_CONDITIONAL([gl_GNULIB_ENABLED_2049e887c7e5308faad27b3f894bb8c9], [$gl_gnulib_enabled_2049e887c7e5308faad27b3f894bb8c9]) AM_CONDITIONAL([gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31], [$gl_gnulib_enabled_5264294aa0a5557541b53c8c741f7f31]) AM_CONDITIONAL([gl_GNULIB_ENABLED_open], [$gl_gnulib_enabled_open]) @@ -858,6 +871,7 @@ AC_DEFUN([gl_FILE_LIST], [ lib/c-strncasecmp.c lib/careadlinkat.c lib/careadlinkat.h + lib/cdefs.h lib/cloexec.c lib/cloexec.h lib/close-stream.c @@ -920,6 +934,7 @@ AC_DEFUN([gl_FILE_LIST], [ lib/ignore-value.h lib/intprops.h lib/inttypes.in.h + lib/libc-config.h lib/limits.in.h lib/localtime-buffer.c lib/localtime-buffer.h @@ -1002,6 +1017,7 @@ AC_DEFUN([gl_FILE_LIST], [ lib/warn-on-use.h lib/xalloc-oversized.h m4/00gnulib.m4 + m4/__inline.m4 m4/absolute-header.m4 m4/acl.m4 m4/alloca.m4 commit 6b8fd34c4ab1aa23b180440cdc8210900896bbf4 Author: Paul Eggert Date: Sun Oct 14 22:10:48 2018 -0500 Update from Gnulib This is minor refactoring that should not affect Emacs builds. It incorporates: 2018-10-12 Make better use of Autoconf * m4/environ.m4, m4/fsusage.m4, m4/manywarnings.m4, m4/socklen.m4: Copy from Gnulib. diff --git a/m4/environ.m4 b/m4/environ.m4 index 68b67eaca4..acee5364b7 100644 --- a/m4/environ.m4 +++ b/m4/environ.m4 @@ -1,4 +1,4 @@ -# environ.m4 serial 6 +# environ.m4 serial 7 dnl Copyright (C) 2001-2004, 2006-2018 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -29,16 +29,14 @@ AC_DEFUN_ONCE([gl_ENVIRON], AC_DEFUN([gt_CHECK_VAR_DECL], [ define([gt_cv_var], [gt_cv_var_]$2[_declaration]) - AC_MSG_CHECKING([if $2 is properly declared]) - AC_CACHE_VAL([gt_cv_var], [ - AC_COMPILE_IFELSE( - [AC_LANG_PROGRAM( - [[$1 - extern struct { int foo; } $2;]], - [[$2.foo = 1;]])], - [gt_cv_var=no], - [gt_cv_var=yes])]) - AC_MSG_RESULT([$gt_cv_var]) + AC_CACHE_CHECK([if $2 is properly declared], [gt_cv_var], + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [[$1 + extern struct { int foo; } $2;]], + [[$2.foo = 1;]])], + [gt_cv_var=no], + [gt_cv_var=yes])]) if test $gt_cv_var = yes; then AC_DEFINE([HAVE_]m4_translit($2, [a-z], [A-Z])[_DECL], 1, [Define if you have the declaration of $2.]) diff --git a/m4/fsusage.m4 b/m4/fsusage.m4 index f9dfbcb7a0..aab4024a97 100644 --- a/m4/fsusage.m4 +++ b/m4/fsusage.m4 @@ -1,4 +1,4 @@ -# serial 32 +# serial 33 # Obtaining file system usage information. # Copyright (C) 1997-1998, 2000-2001, 2003-2018 Free Software Foundation, Inc. @@ -29,27 +29,30 @@ AC_DEFUN([gl_FSUSAGE], AC_DEFUN([gl_FILE_SYSTEM_USAGE], [ -dnl Enable large-file support. This has the effect of changing the size -dnl of field f_blocks in 'struct statvfs' from 32 bit to 64 bit on -dnl glibc/Hurd, HP-UX 11, Solaris (32-bit mode). It also changes the size -dnl of field f_blocks in 'struct statfs' from 32 bit to 64 bit on -dnl Mac OS X >= 10.5 (32-bit mode). -AC_REQUIRE([AC_SYS_LARGEFILE]) + dnl Enable large-file support. This has the effect of changing the size + dnl of field f_blocks in 'struct statvfs' from 32 bit to 64 bit on + dnl glibc/Hurd, HP-UX 11, Solaris (32-bit mode). It also changes the size + dnl of field f_blocks in 'struct statfs' from 32 bit to 64 bit on + dnl Mac OS X >= 10.5 (32-bit mode). + AC_REQUIRE([AC_SYS_LARGEFILE]) -AC_MSG_CHECKING([how to get file system space usage]) -ac_fsusage_space=no + AC_MSG_CHECKING([how to get file system space usage]) + ac_fsusage_space=no -# Perform only the link test since it seems there are no variants of the -# statvfs function. This check is more than just AC_CHECK_FUNCS([statvfs]) -# because that got a false positive on SCO OSR5. Adding the declaration -# of a 'struct statvfs' causes this test to fail (as it should) on such -# systems. That system is reported to work fine with STAT_STATFS4 which -# is what it gets when this test fails. -if test $ac_fsusage_space = no; then - # glibc/{Hurd,kFreeBSD}, FreeBSD >= 5.0, NetBSD >= 3.0, - # OpenBSD >= 4.4, AIX, HP-UX, IRIX, Solaris, Cygwin, Interix, BeOS. - AC_CACHE_CHECK([for statvfs function (SVR4)], [fu_cv_sys_stat_statvfs], - [AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include + # Perform only the link test since it seems there are no variants of the + # statvfs function. This check is more than just AC_CHECK_FUNCS([statvfs]) + # because that got a false positive on SCO OSR5. Adding the declaration + # of a 'struct statvfs' causes this test to fail (as it should) on such + # systems. That system is reported to work fine with STAT_STATFS4 which + # is what it gets when this test fails. + if test $ac_fsusage_space = no; then + # glibc/{Hurd,kFreeBSD}, FreeBSD >= 5.0, NetBSD >= 3.0, + # OpenBSD >= 4.4, AIX, HP-UX, IRIX, Solaris, Cygwin, Interix, BeOS. + AC_CACHE_CHECK([for statvfs function (SVR4)], + [fu_cv_sys_stat_statvfs], + [AC_LINK_IFELSE( + [AC_LANG_PROGRAM([[ +#include #ifdef __osf__ "Do not use Tru64's statvfs implementation" #endif @@ -68,45 +71,47 @@ struct statvfs fsd; int check_f_blocks_size[sizeof fsd.f_blocks * CHAR_BIT <= 32 ? -1 : 1]; #endif ]], - [[statvfs (0, &fsd);]])], - [fu_cv_sys_stat_statvfs=yes], - [fu_cv_sys_stat_statvfs=no])]) - if test $fu_cv_sys_stat_statvfs = yes; then - ac_fsusage_space=yes - # AIX >= 5.2 has statvfs64 that has a wider f_blocks field than statvfs. - # glibc, HP-UX, IRIX, Solaris have statvfs64 as well, but on these systems - # statvfs with large-file support is already equivalent to statvfs64. - AC_CACHE_CHECK([whether to use statvfs64], - [fu_cv_sys_stat_statvfs64], - [AC_LINK_IFELSE( - [AC_LANG_PROGRAM( - [[#include - #include - struct statvfs64 fsd; - int check_f_blocks_larger_in_statvfs64 - [sizeof (((struct statvfs64 *) 0)->f_blocks) - > sizeof (((struct statvfs *) 0)->f_blocks) - ? 1 : -1]; - ]], - [[statvfs64 (0, &fsd);]])], - [fu_cv_sys_stat_statvfs64=yes], - [fu_cv_sys_stat_statvfs64=no]) + [[statvfs (0, &fsd);]])], + [fu_cv_sys_stat_statvfs=yes], + [fu_cv_sys_stat_statvfs=no]) ]) - if test $fu_cv_sys_stat_statvfs64 = yes; then - AC_DEFINE([STAT_STATVFS64], [1], - [ Define if statvfs64 should be preferred over statvfs.]) - else - AC_DEFINE([STAT_STATVFS], [1], - [ Define if there is a function named statvfs. (SVR4)]) + if test $fu_cv_sys_stat_statvfs = yes; then + ac_fsusage_space=yes + # AIX >= 5.2 has statvfs64 that has a wider f_blocks field than statvfs. + # glibc, HP-UX, IRIX, Solaris have statvfs64 as well, but on these systems + # statvfs with large-file support is already equivalent to statvfs64. + AC_CACHE_CHECK([whether to use statvfs64], + [fu_cv_sys_stat_statvfs64], + [AC_LINK_IFELSE( + [AC_LANG_PROGRAM( + [[#include + #include + struct statvfs64 fsd; + int check_f_blocks_larger_in_statvfs64 + [sizeof (((struct statvfs64 *) 0)->f_blocks) + > sizeof (((struct statvfs *) 0)->f_blocks) + ? 1 : -1]; + ]], + [[statvfs64 (0, &fsd);]])], + [fu_cv_sys_stat_statvfs64=yes], + [fu_cv_sys_stat_statvfs64=no]) + ]) + if test $fu_cv_sys_stat_statvfs64 = yes; then + AC_DEFINE([STAT_STATVFS64], [1], + [Define if statvfs64 should be preferred over statvfs.]) + else + AC_DEFINE([STAT_STATVFS], [1], + [Define if there is a function named statvfs. (SVR4)]) + fi fi fi -fi -# Check for this unconditionally so we have a -# good fallback on glibc/Linux > 2.6 < 2.6.36 -AC_MSG_CHECKING([for two-argument statfs with statfs.f_frsize member]) -AC_CACHE_VAL([fu_cv_sys_stat_statfs2_frsize], -[AC_RUN_IFELSE([AC_LANG_SOURCE([[ + # Check for this unconditionally so we have a + # good fallback on glibc/Linux > 2.6 < 2.6.36 + AC_CACHE_CHECK([for two-argument statfs with statfs.f_frsize member], + [fu_cv_sys_stat_statfs2_frsize], + [AC_RUN_IFELSE( + [AC_LANG_SOURCE([[ #ifdef HAVE_SYS_PARAM_H #include #endif @@ -119,26 +124,26 @@ AC_CACHE_VAL([fu_cv_sys_stat_statfs2_frsize], int main () { - struct statfs fsd; - fsd.f_frsize = 0; - return statfs (".", &fsd) != 0; + struct statfs fsd; + fsd.f_frsize = 0; + return statfs (".", &fsd) != 0; }]])], - [fu_cv_sys_stat_statfs2_frsize=yes], - [fu_cv_sys_stat_statfs2_frsize=no], - [fu_cv_sys_stat_statfs2_frsize=no])]) -AC_MSG_RESULT([$fu_cv_sys_stat_statfs2_frsize]) -if test $fu_cv_sys_stat_statfs2_frsize = yes; then + [fu_cv_sys_stat_statfs2_frsize=yes], + [fu_cv_sys_stat_statfs2_frsize=no], + [fu_cv_sys_stat_statfs2_frsize=no]) + ]) + if test $fu_cv_sys_stat_statfs2_frsize = yes; then ac_fsusage_space=yes AC_DEFINE([STAT_STATFS2_FRSIZE], [1], -[ Define if statfs takes 2 args and struct statfs has a field named f_frsize. - (glibc/Linux > 2.6)]) -fi + [Define if statfs takes 2 args and struct statfs has a field named f_frsize. + (glibc/Linux > 2.6)]) + fi -if test $ac_fsusage_space = no; then - # DEC Alpha running OSF/1 - AC_MSG_CHECKING([for 3-argument statfs function (DEC OSF/1)]) - AC_CACHE_VAL([fu_cv_sys_stat_statfs3_osf1], - [AC_RUN_IFELSE([AC_LANG_SOURCE([[ + if test $ac_fsusage_space = no; then + # DEC Alpha running OSF/1 + AC_CACHE_CHECK([for 3-argument statfs function (DEC OSF/1)], + [fu_cv_sys_stat_statfs3_osf1], + [AC_RUN_IFELSE([AC_LANG_SOURCE([[ #include #include #include @@ -149,28 +154,27 @@ if test $ac_fsusage_space = no; then fsd.f_fsize = 0; return statfs (".", &fsd, sizeof (struct statfs)) != 0; }]])], - [fu_cv_sys_stat_statfs3_osf1=yes], - [fu_cv_sys_stat_statfs3_osf1=no], - [fu_cv_sys_stat_statfs3_osf1=no])]) - AC_MSG_RESULT([$fu_cv_sys_stat_statfs3_osf1]) - if test $fu_cv_sys_stat_statfs3_osf1 = yes; then - ac_fsusage_space=yes - AC_DEFINE([STAT_STATFS3_OSF1], [1], - [ Define if statfs takes 3 args. (DEC Alpha running OSF/1)]) + [fu_cv_sys_stat_statfs3_osf1=yes], + [fu_cv_sys_stat_statfs3_osf1=no], + [fu_cv_sys_stat_statfs3_osf1=no]) + ]) + if test $fu_cv_sys_stat_statfs3_osf1 = yes; then + ac_fsusage_space=yes + AC_DEFINE([STAT_STATFS3_OSF1], [1], + [Define if statfs takes 3 args. (DEC Alpha running OSF/1)]) + fi fi -fi -if test $ac_fsusage_space = no; then - # glibc/Linux, Mac OS X, FreeBSD < 5.0, NetBSD < 3.0, OpenBSD < 4.4. - # (glibc/{Hurd,kFreeBSD}, FreeBSD >= 5.0, NetBSD >= 3.0, - # OpenBSD >= 4.4, AIX, HP-UX, OSF/1, Cygwin already handled above.) - # (On IRIX you need to include , not only and - # .) - # (On Solaris, statfs has 4 arguments.) - AC_MSG_CHECKING([for two-argument statfs with statfs.f_bsize dnl -member (AIX, 4.3BSD)]) - AC_CACHE_VAL([fu_cv_sys_stat_statfs2_bsize], - [AC_RUN_IFELSE([AC_LANG_SOURCE([[ + if test $ac_fsusage_space = no; then + # glibc/Linux, Mac OS X, FreeBSD < 5.0, NetBSD < 3.0, OpenBSD < 4.4. + # (glibc/{Hurd,kFreeBSD}, FreeBSD >= 5.0, NetBSD >= 3.0, + # OpenBSD >= 4.4, AIX, HP-UX, OSF/1, Cygwin already handled above.) + # (On IRIX you need to include , not only and + # .) + # (On Solaris, statfs has 4 arguments.) + AC_CACHE_CHECK([for two-argument statfs with statfs.f_bsize member (AIX, 4.3BSD)], + [fu_cv_sys_stat_statfs2_bsize], + [AC_RUN_IFELSE([AC_LANG_SOURCE([[ #ifdef HAVE_SYS_PARAM_H #include #endif @@ -183,57 +187,56 @@ member (AIX, 4.3BSD)]) int main () { - struct statfs fsd; - fsd.f_bsize = 0; - return statfs (".", &fsd) != 0; + struct statfs fsd; + fsd.f_bsize = 0; + return statfs (".", &fsd) != 0; }]])], - [fu_cv_sys_stat_statfs2_bsize=yes], - [fu_cv_sys_stat_statfs2_bsize=no], - [fu_cv_sys_stat_statfs2_bsize=no])]) - AC_MSG_RESULT([$fu_cv_sys_stat_statfs2_bsize]) - if test $fu_cv_sys_stat_statfs2_bsize = yes; then - ac_fsusage_space=yes - AC_DEFINE([STAT_STATFS2_BSIZE], [1], -[ Define if statfs takes 2 args and struct statfs has a field named f_bsize. - (4.3BSD, SunOS 4, HP-UX, AIX PS/2)]) + [fu_cv_sys_stat_statfs2_bsize=yes], + [fu_cv_sys_stat_statfs2_bsize=no], + [fu_cv_sys_stat_statfs2_bsize=no]) + ]) + if test $fu_cv_sys_stat_statfs2_bsize = yes; then + ac_fsusage_space=yes + AC_DEFINE([STAT_STATFS2_BSIZE], [1], + [Define if statfs takes 2 args and struct statfs has a field named f_bsize. + (4.3BSD, SunOS 4, HP-UX, AIX PS/2)]) + fi fi -fi -if test $ac_fsusage_space = no; then - # SVR3 - # (Solaris already handled above.) - AC_MSG_CHECKING([for four-argument statfs (AIX-3.2.5, SVR3)]) - AC_CACHE_VAL([fu_cv_sys_stat_statfs4], - [AC_RUN_IFELSE([AC_LANG_SOURCE([[ + if test $ac_fsusage_space = no; then + # SVR3 + # (Solaris already handled above.) + AC_CACHE_CHECK([for four-argument statfs (AIX-3.2.5, SVR3)], + [fu_cv_sys_stat_statfs4], + [AC_RUN_IFELSE([AC_LANG_SOURCE([[ #include #include int main () { - struct statfs fsd; - return statfs (".", &fsd, sizeof fsd, 0) != 0; + struct statfs fsd; + return statfs (".", &fsd, sizeof fsd, 0) != 0; }]])], - [fu_cv_sys_stat_statfs4=yes], - [fu_cv_sys_stat_statfs4=no], - [fu_cv_sys_stat_statfs4=no])]) - AC_MSG_RESULT([$fu_cv_sys_stat_statfs4]) - if test $fu_cv_sys_stat_statfs4 = yes; then - ac_fsusage_space=yes - AC_DEFINE([STAT_STATFS4], [1], - [ Define if statfs takes 4 args. (SVR3, Dynix, old Irix, old AIX, Dolphin)]) + [fu_cv_sys_stat_statfs4=yes], + [fu_cv_sys_stat_statfs4=no], + [fu_cv_sys_stat_statfs4=no]) + ]) + if test $fu_cv_sys_stat_statfs4 = yes; then + ac_fsusage_space=yes + AC_DEFINE([STAT_STATFS4], [1], + [Define if statfs takes 4 args. (SVR3, Dynix, old Irix, old AIX, Dolphin)]) + fi fi -fi -if test $ac_fsusage_space = no; then - # 4.4BSD and older NetBSD - # (OSF/1 already handled above.) - # (On AIX, you need to include , not only .) - # (On Solaris, statfs has 4 arguments and 'struct statfs' is not declared in - # .) - AC_MSG_CHECKING([for two-argument statfs with statfs.f_fsize dnl -member (4.4BSD and NetBSD)]) - AC_CACHE_VAL([fu_cv_sys_stat_statfs2_fsize], - [AC_RUN_IFELSE([AC_LANG_SOURCE([[ + if test $ac_fsusage_space = no; then + # 4.4BSD and older NetBSD + # (OSF/1 already handled above.) + # (On AIX, you need to include , not only .) + # (On Solaris, statfs has 4 arguments and 'struct statfs' is not declared in + # .) + AC_CACHE_CHECK([for two-argument statfs with statfs.f_fsize member (4.4BSD and NetBSD)], + [fu_cv_sys_stat_statfs2_fsize], + [AC_RUN_IFELSE([AC_LANG_SOURCE([[ #include #ifdef HAVE_SYS_PARAM_H #include @@ -244,27 +247,27 @@ member (4.4BSD and NetBSD)]) int main () { - struct statfs fsd; - fsd.f_fsize = 0; - return statfs (".", &fsd) != 0; + struct statfs fsd; + fsd.f_fsize = 0; + return statfs (".", &fsd) != 0; }]])], - [fu_cv_sys_stat_statfs2_fsize=yes], - [fu_cv_sys_stat_statfs2_fsize=no], - [fu_cv_sys_stat_statfs2_fsize=no])]) - AC_MSG_RESULT([$fu_cv_sys_stat_statfs2_fsize]) - if test $fu_cv_sys_stat_statfs2_fsize = yes; then - ac_fsusage_space=yes - AC_DEFINE([STAT_STATFS2_FSIZE], [1], -[ Define if statfs takes 2 args and struct statfs has a field named f_fsize. - (4.4BSD, NetBSD)]) + [fu_cv_sys_stat_statfs2_fsize=yes], + [fu_cv_sys_stat_statfs2_fsize=no], + [fu_cv_sys_stat_statfs2_fsize=no]) + ]) + if test $fu_cv_sys_stat_statfs2_fsize = yes; then + ac_fsusage_space=yes + AC_DEFINE([STAT_STATFS2_FSIZE], [1], + [Define if statfs takes 2 args and struct statfs has a field named f_fsize. + (4.4BSD, NetBSD)]) + fi fi -fi -if test $ac_fsusage_space = no; then - # Ultrix - AC_MSG_CHECKING([for two-argument statfs with struct fs_data (Ultrix)]) - AC_CACHE_VAL([fu_cv_sys_stat_fs_data], - [AC_RUN_IFELSE([AC_LANG_SOURCE([[ + if test $ac_fsusage_space = no; then + # Ultrix + AC_CACHE_CHECK([for two-argument statfs with struct fs_data (Ultrix)], + [fu_cv_sys_stat_fs_data], + [AC_RUN_IFELSE([AC_LANG_SOURCE([[ #include #ifdef HAVE_SYS_PARAM_H #include @@ -278,24 +281,24 @@ if test $ac_fsusage_space = no; then int main () { - struct fs_data fsd; - /* Ultrix's statfs returns 1 for success, - 0 for not mounted, -1 for failure. */ - return statfs (".", &fsd) != 1; + struct fs_data fsd; + /* Ultrix's statfs returns 1 for success, + 0 for not mounted, -1 for failure. */ + return statfs (".", &fsd) != 1; }]])], - [fu_cv_sys_stat_fs_data=yes], - [fu_cv_sys_stat_fs_data=no], - [fu_cv_sys_stat_fs_data=no])]) - AC_MSG_RESULT([$fu_cv_sys_stat_fs_data]) - if test $fu_cv_sys_stat_fs_data = yes; then - ac_fsusage_space=yes - AC_DEFINE([STAT_STATFS2_FS_DATA], [1], -[ Define if statfs takes 2 args and the second argument has - type struct fs_data. (Ultrix)]) + [fu_cv_sys_stat_fs_data=yes], + [fu_cv_sys_stat_fs_data=no], + [fu_cv_sys_stat_fs_data=no]) + ]) + if test $fu_cv_sys_stat_fs_data = yes; then + ac_fsusage_space=yes + AC_DEFINE([STAT_STATFS2_FS_DATA], [1], + [Define if statfs takes 2 args and the second argument has + type struct fs_data. (Ultrix)]) + fi fi -fi -AS_IF([test $ac_fsusage_space = yes], [$1], [$2]) + AS_IF([test $ac_fsusage_space = yes], [$1], [$2]) ]) @@ -305,18 +308,22 @@ AS_IF([test $ac_fsusage_space = yes], [$1], [$2]) # enable the work-around code in fsusage.c. AC_DEFUN([gl_STATFS_TRUNCATES], [ - AC_MSG_CHECKING([for statfs that truncates block counts]) - AC_CACHE_VAL([fu_cv_sys_truncating_statfs], - [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ + AC_CACHE_CHECK([for statfs that truncates block counts], + [fu_cv_sys_truncating_statfs], + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM([[ #if !defined(sun) && !defined(__sun) choke -- this is a workaround for a Sun-specific problem #endif #include -#include ]], - [[struct statfs t; long c = *(t.f_spare); - if (c) return 0;]])], - [fu_cv_sys_truncating_statfs=yes], - [fu_cv_sys_truncating_statfs=no])]) +#include + ]], + [[struct statfs t; long c = *(t.f_spare); + if (c) return 0; + ]])], + [fu_cv_sys_truncating_statfs=yes], + [fu_cv_sys_truncating_statfs=no]) + ]) if test $fu_cv_sys_truncating_statfs = yes; then AC_DEFINE([STATFS_TRUNCATES_BLOCK_COUNTS], [1], [Define if the block counts reported by statfs may be truncated to 2GB @@ -324,7 +331,6 @@ choke -- this is a workaround for a Sun-specific problem (SunOS 4.1.2, 4.1.3, and 4.1.3_U1 are reported to have this problem. SunOS 4.1.1 seems not to be affected.)]) fi - AC_MSG_RESULT([$fu_cv_sys_truncating_statfs]) ]) diff --git a/m4/manywarnings.m4 b/m4/manywarnings.m4 index 516c587476..d831ed2eb6 100644 --- a/m4/manywarnings.m4 +++ b/m4/manywarnings.m4 @@ -1,4 +1,4 @@ -# manywarnings.m4 serial 16 +# manywarnings.m4 serial 17 dnl Copyright (C) 2008-2018 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -51,54 +51,53 @@ m4_defun([gl_MANYWARN_ALL_GCC(C)], dnl Check if -W -Werror -Wno-missing-field-initializers is supported dnl with the current $CC $CFLAGS $CPPFLAGS. - AC_MSG_CHECKING([whether -Wno-missing-field-initializers is supported]) - AC_CACHE_VAL([gl_cv_cc_nomfi_supported], [ - gl_save_CFLAGS="$CFLAGS" - CFLAGS="$CFLAGS -W -Werror -Wno-missing-field-initializers" - AC_COMPILE_IFELSE( - [AC_LANG_PROGRAM([[]], [[]])], - [gl_cv_cc_nomfi_supported=yes], - [gl_cv_cc_nomfi_supported=no]) - CFLAGS="$gl_save_CFLAGS"]) - AC_MSG_RESULT([$gl_cv_cc_nomfi_supported]) + AC_CACHE_CHECK([whether -Wno-missing-field-initializers is supported], + [gl_cv_cc_nomfi_supported], + [gl_save_CFLAGS="$CFLAGS" + CFLAGS="$CFLAGS -W -Werror -Wno-missing-field-initializers" + AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM([[]], [[]])], + [gl_cv_cc_nomfi_supported=yes], + [gl_cv_cc_nomfi_supported=no]) + CFLAGS="$gl_save_CFLAGS" + ]) if test "$gl_cv_cc_nomfi_supported" = yes; then dnl Now check whether -Wno-missing-field-initializers is needed dnl for the { 0, } construct. - AC_MSG_CHECKING([whether -Wno-missing-field-initializers is needed]) - AC_CACHE_VAL([gl_cv_cc_nomfi_needed], [ - gl_save_CFLAGS="$CFLAGS" - CFLAGS="$CFLAGS -W -Werror" - AC_COMPILE_IFELSE( - [AC_LANG_PROGRAM( - [[int f (void) - { - typedef struct { int a; int b; } s_t; - s_t s1 = { 0, }; - return s1.b; - } - ]], - [[]])], - [gl_cv_cc_nomfi_needed=no], - [gl_cv_cc_nomfi_needed=yes]) - CFLAGS="$gl_save_CFLAGS" - ]) - AC_MSG_RESULT([$gl_cv_cc_nomfi_needed]) + AC_CACHE_CHECK([whether -Wno-missing-field-initializers is needed], + [gl_cv_cc_nomfi_needed], + [gl_save_CFLAGS="$CFLAGS" + CFLAGS="$CFLAGS -W -Werror" + AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [[int f (void) + { + typedef struct { int a; int b; } s_t; + s_t s1 = { 0, }; + return s1.b; + } + ]], + [[]])], + [gl_cv_cc_nomfi_needed=no], + [gl_cv_cc_nomfi_needed=yes]) + CFLAGS="$gl_save_CFLAGS" + ]) fi dnl Next, check if -Werror -Wuninitialized is useful with the dnl user's choice of $CFLAGS; some versions of gcc warn that it dnl has no effect if -O is not also used - AC_MSG_CHECKING([whether -Wuninitialized is supported]) - AC_CACHE_VAL([gl_cv_cc_uninitialized_supported], [ - gl_save_CFLAGS="$CFLAGS" - CFLAGS="$CFLAGS -Werror -Wuninitialized" - AC_COMPILE_IFELSE( - [AC_LANG_PROGRAM([[]], [[]])], - [gl_cv_cc_uninitialized_supported=yes], - [gl_cv_cc_uninitialized_supported=no]) - CFLAGS="$gl_save_CFLAGS"]) - AC_MSG_RESULT([$gl_cv_cc_uninitialized_supported]) + AC_CACHE_CHECK([whether -Wuninitialized is supported], + [gl_cv_cc_uninitialized_supported], + [gl_save_CFLAGS="$CFLAGS" + CFLAGS="$CFLAGS -Werror -Wuninitialized" + AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM([[]], [[]])], + [gl_cv_cc_uninitialized_supported=yes], + [gl_cv_cc_uninitialized_supported=no]) + CFLAGS="$gl_save_CFLAGS" + ]) fi diff --git a/m4/socklen.m4 b/m4/socklen.m4 index f2d996d0eb..fa79b07b6e 100644 --- a/m4/socklen.m4 +++ b/m4/socklen.m4 @@ -1,4 +1,4 @@ -# socklen.m4 serial 10 +# socklen.m4 serial 11 dnl Copyright (C) 2005-2007, 2009-2018 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -15,8 +15,8 @@ dnl So we have to test to find something that will work. AC_DEFUN([gl_TYPE_SOCKLEN_T], [AC_REQUIRE([gl_CHECK_SOCKET_HEADERS])dnl AC_CHECK_TYPE([socklen_t], , - [AC_MSG_CHECKING([for socklen_t equivalent]) - AC_CACHE_VAL([gl_cv_socklen_t_equiv], + [AC_CACHE_CHECK([for socklen_t equivalent], + [gl_cv_socklen_t_equiv], [# Systems have either "struct sockaddr *" or # "void *" as the second argument to getpeername gl_cv_socklen_t_equiv= @@ -34,11 +34,10 @@ AC_DEFUN([gl_TYPE_SOCKLEN_T], done test "$gl_cv_socklen_t_equiv" != "" && break done - ]) - if test "$gl_cv_socklen_t_equiv" = ""; then - AC_MSG_ERROR([Cannot find a type to use in place of socklen_t]) - fi - AC_MSG_RESULT([$gl_cv_socklen_t_equiv]) + if test "$gl_cv_socklen_t_equiv" = ""; then + AC_MSG_ERROR([Cannot find a type to use in place of socklen_t]) + fi + ]) AC_DEFINE_UNQUOTED([socklen_t], [$gl_cv_socklen_t_equiv], [type to use in place of socklen_t if not defined])], [gl_SOCKET_HEADERS])]) commit aba7910e368f98790fdbaf5256c75da558d7b195 Author: Alan Mackenzie Date: Mon Oct 15 00:45:24 2018 +0000 Add ~44 edebug specs to CC Mode. * lisp/progmodes/cc-cmds.el, lisp/progmodes/cc-defs.el lisp/progmodes/cc-engine.el, lisp/progmodes/cc-fonts.el lisp/progmodes/cc-langs.el: Add lots of edebug specs. * lisp/progmodes/cc-engine.el (c-state-maybe-marker): Tidy up so as to evaluate an argument only once at runtime. diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index 4f256e1008..0269c01a80 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -1640,6 +1640,8 @@ No indentation or other \"electric\" behavior is performed." paren-state orig-point-min orig-point-max)) (setq where 'in-block)))) +(def-edebug-spec c-while-widening-to-decl-block t) + (defun c-beginning-of-defun (&optional arg) "Move backward to the beginning of a defun. Every top level declaration that contains a brace paren block is diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index f41a7cf028..972d214c0c 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -1316,20 +1316,36 @@ with value CHAR in the region [FROM to)." ;(eval-after-load "edebug" ; 2006-07-09: def-edebug-spec is now in subr.el. ; '(progn (def-edebug-spec cc-eval-when-compile (&rest def-form)) +(def-edebug-spec c--mapcan t) +(def-edebug-spec c--set-difference (form form &rest [symbolp form])) +(def-edebug-spec c--intersection (form form &rest [symbolp form])) +(def-edebug-spec c--delete-duplicates (form &rest [symbolp form])) (def-edebug-spec c-point t) +(def-edebug-spec c-next-single-property-change t) +(def-edebug-spec c-delete-and-extract-region t) (def-edebug-spec c-set-region-active t) (def-edebug-spec c-set-keymap-parent t) (def-edebug-spec c-safe t) +(def-edebug-spec c-int-to-char t) +(def-edebug-spec c-characterp t) (def-edebug-spec c-save-buffer-state let*) (def-edebug-spec c-tentative-buffer-changes t) (def-edebug-spec c-forward-syntactic-ws t) (def-edebug-spec c-backward-syntactic-ws t) (def-edebug-spec c-forward-sexp t) (def-edebug-spec c-backward-sexp t) +(def-edebug-spec c-safe-scan-lists t) +(def-edebug-spec c-go-list-forward t) +(def-edebug-spec c-go-list-backward t) (def-edebug-spec c-up-list-forward t) (def-edebug-spec c-up-list-backward t) (def-edebug-spec c-down-list-forward t) (def-edebug-spec c-down-list-backward t) +(def-edebug-spec c-go-up-list-forward t) +(def-edebug-spec c-go-up-list-backward t) +(def-edebug-spec c-go-down-list-forward t) +(def-edebug-spec c-go-down-list-backward t) +(def-edebug-spec c-at-vsemi-p t) (def-edebug-spec c-add-syntax t) (def-edebug-spec c-add-class-syntax t) (def-edebug-spec c-benign-error t) @@ -1337,15 +1353,28 @@ with value CHAR in the region [FROM to)." (def-edebug-spec c-skip-ws-forward t) (def-edebug-spec c-skip-ws-backward t) (def-edebug-spec c-major-mode-is t) +(def-edebug-spec c-search-forward-char-property t) +(def-edebug-spec c-search-backward-char-property t) (def-edebug-spec c-put-char-property t) (def-edebug-spec c-get-char-property t) (def-edebug-spec c-clear-char-property t) +(def-edebug-spec c-clear-char-property-with-value t) (def-edebug-spec c-clear-char-property-with-value-on-char t) (def-edebug-spec c-put-char-properties-on-char t) (def-edebug-spec c-clear-char-properties t) (def-edebug-spec c-put-overlay t) (def-edebug-spec c-delete-overlay t) -(def-edebug-spec c-self-bind-state-cache t);)) +(def-edebug-spec c-mark-<-as-paren t) +(def-edebug-spec c-mark->-as-paren t) +(def-edebug-spec c-unmark-<->-as-paren t) +(def-edebug-spec c-with-<->-as-parens-suppressed (body)) +(def-edebug-spec c-self-bind-state-cache (body)) +(def-edebug-spec c-sc-scan-lists-no-category+1+1 t) +(def-edebug-spec c-sc-scan-lists-no-category+1-1 t) +(def-edebug-spec c-sc-scan-lists-no-category-1+1 t) +(def-edebug-spec c-sc-scan-lists-no-category-1-1 t) +(def-edebug-spec c-sc-scan-lists t) +(def-edebug-spec c-sc-parse-partial-sexp t);)) ;;; Functions. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 3ec7dbcc90..7a6cfdd1b7 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -3879,9 +3879,10 @@ comment at the start of cc-engine.el for more info." (defmacro c-state-maybe-marker (place marker) ;; If PLACE is non-nil, return a marker marking it, otherwise nil. ;; We (re)use MARKER. - `(and ,place - (or ,marker (setq ,marker (make-marker))) - (set-marker ,marker ,place))) + `(let ((-place- ,place)) + (and -place- + (or ,marker (setq ,marker (make-marker))) + (set-marker ,marker -place-)))) (defun c-parse-state () ;; This is a wrapper over `c-parse-state-1'. See that function for a @@ -13254,6 +13255,18 @@ Cannot combine absolute offsets %S and %S in `add' method" indent))) +(def-edebug-spec c-bos-pop-state t) +(def-edebug-spec c-bos-save-error-info t) +(def-edebug-spec c-state-cache-top-lparen t) +(def-edebug-spec c-state-cache-top-paren t) +(def-edebug-spec c-state-cache-after-top-paren t) +(def-edebug-spec c-state-maybe-marker (form symbolp)) +(def-edebug-spec c-record-type-id t) +(def-edebug-spec c-record-ref-id t) +(def-edebug-spec c-forward-keyword-prefixed-id t) +(def-edebug-spec c-forward-id-comma-list t) +(def-edebug-spec c-pull-open-brace (symbolp)) + (cc-provide 'cc-engine) ;; Local Variables: diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 9d2517f252..79254ff755 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -488,6 +488,9 @@ ; (eval-after-load "edebug" ; 2006-07-09: def-edebug-spec is now in subr.el. ; '(progn +(def-edebug-spec c-put-font-lock-face t) +(def-edebug-spec c-remove-font-lock-face t) +(def-edebug-spec c-put-font-lock-string-face t) (def-edebug-spec c-fontify-types-and-refs let*) (def-edebug-spec c-make-syntactic-matcher t) ;; If there are literal quoted or backquoted highlight specs in diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 1b44c75fe6..de49ad75d3 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -205,6 +205,7 @@ the evaluated constant value at compile time." ; ' (def-edebug-spec c-lang-defvar (&define name def-form &optional &or ("quote" symbolp) stringp)) +(def-edebug-spec c-lang-setvar (&define name def-form)) ;; Suppress "might not be defined at runtime" warning. ;; This file is only used when compiling other cc files. commit 8c68e4afa8eebb6f738fdce600a6815509ac50a3 Author: Stefan Monnier Date: Sun Oct 14 16:44:21 2018 -0400 * src/buffer.c (Fmove_overlay): Don't call Fdelete_overlay ... because the data structure is not in a consistent state. * test/src/buffer-tests.el (overlay-evaporation-after-killed-buffer): New test. diff --git a/src/buffer.c b/src/buffer.c index 024e64f0d7..ac2de7d19f 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -3991,6 +3991,16 @@ buffer. */) unchain_both (ob, overlay); } + else + /* An overlay not associated with any buffer will normally have its + `next' field set to NULL, but not always: when killing a buffer, + we just set its overlays_after and overlays_before to NULL without + manually setting each overlay's `next' field to NULL. + Let's correct it here, to simplify subsequent assertions. + FIXME: Maybe the better fix is to change `kill-buffer'!? */ + XOVERLAY (overlay)->next = NULL; + + eassert (XOVERLAY (overlay)->next == NULL); /* Set the overlay boundaries, which may clip them. */ Fset_marker (OVERLAY_START (overlay), beg, buffer); @@ -4020,10 +4030,20 @@ buffer. */) modify_overlay (b, min (o_beg, n_beg), max (o_end, n_end)); } + eassert (XOVERLAY (overlay)->next == NULL); + /* Delete the overlay if it is empty after clipping and has the evaporate property. */ if (n_beg == n_end && !NILP (Foverlay_get (overlay, Qevaporate))) - return unbind_to (count, Fdelete_overlay (overlay)); + { /* We used to call `Fdelete_overlay' here, but it causes problems: + - At this stage, `overlay' is not included in its buffer's lists + of overlays (the data-structure is in an inconsistent state), + contrary to `Fdelete_overlay's assumptions. + - Most of the work done by Fdelete_overlay has already been done + here for other reasons. */ + drop_overlay (XBUFFER (buffer), XOVERLAY (overlay)); + return unbind_to (count, overlay); + } /* Put the overlay into the new buffer's overlay lists, first on the wrong list. */ diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el index 0e4fd3655a..609585f43e 100644 --- a/test/src/buffer-tests.el +++ b/test/src/buffer-tests.el @@ -79,4 +79,19 @@ with parameters from the *Messages* buffer modification." (with-temp-buffer (should (eq (buffer-base-buffer (current-buffer)) nil)))) +(ert-deftest overlay-evaporation-after-killed-buffer () + (let* ((ols (with-temp-buffer + (insert "toto") + (list + (make-overlay (point-min) (point-max)) + (make-overlay (point-min) (point-max)) + (make-overlay (point-min) (point-max))))) + (ol (nth 1 ols))) + (overlay-put ol 'evaporate t) + ;; Evaporation within move-overlay of an overlay that was deleted because + ;; of a kill-buffer, triggered an assertion failure in unchain_both. + (with-temp-buffer + (insert "toto") + (move-overlay ol (point-min) (point-min))))) + ;;; buffer-tests.el ends here commit 700acbd9917732ec35b7cd90d908bf6db6ff6d28 Author: Alan Mackenzie Date: Sun Oct 14 18:20:01 2018 +0000 doc/lispref/edebug.texi (Specification List) Remove obstrusive blank line diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index 5af48fe096..5c47945e55 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -1309,7 +1309,6 @@ succeeds. @item &define @c @kindex &define @r{(Edebug)} - Indicates that the specification is for a defining form. Edebug's definition of a defining form is a form containing one or more code forms which are saved and executed later, after the execution of the commit f1ea2b9e6b63593f5919f60a68a9e19026756ac4 Author: Paul Eggert Date: Sun Oct 14 09:51:32 2018 -0700 Fix lisp_eval_depth in unwind-protect cleanup Problem reported by Paul Pogonyshev (Bug#33034). * src/lisp.h (union specbinding): New member unwind.eval_depth. * src/eval.c (record_unwind_protect, set_unwind_protect): Set it. (do_one_unbind): Use it. diff --git a/src/eval.c b/src/eval.c index 42c275de6b..a51d0c9083 100644 --- a/src/eval.c +++ b/src/eval.c @@ -3429,6 +3429,7 @@ record_unwind_protect (void (*function) (Lisp_Object), Lisp_Object arg) specpdl_ptr->unwind.kind = SPECPDL_UNWIND; specpdl_ptr->unwind.func = function; specpdl_ptr->unwind.arg = arg; + specpdl_ptr->unwind.eval_depth = lisp_eval_depth; grow_specpdl (); } @@ -3501,6 +3502,7 @@ do_one_unbind (union specbinding *this_binding, bool unwinding, switch (this_binding->kind) { case SPECPDL_UNWIND: + lisp_eval_depth = this_binding->unwind.eval_depth; this_binding->unwind.func (this_binding->unwind.arg); break; case SPECPDL_UNWIND_ARRAY: @@ -3595,6 +3597,7 @@ set_unwind_protect (ptrdiff_t count, void (*func) (Lisp_Object), p->unwind.kind = SPECPDL_UNWIND; p->unwind.func = func; p->unwind.arg = arg; + p->unwind.eval_depth = lisp_eval_depth; } void diff --git a/src/lisp.h b/src/lisp.h index 5ecc48b025..a7a26ef350 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3071,6 +3071,7 @@ union specbinding ENUM_BF (specbind_tag) kind : CHAR_BIT; void (*func) (Lisp_Object); Lisp_Object arg; + EMACS_INT eval_depth; } unwind; struct { ENUM_BF (specbind_tag) kind : CHAR_BIT; commit 190245035f3cc9a2183954d046d1e6bacb0cf229 Author: Eli Zaretskii Date: Sun Oct 14 19:12:49 2018 +0300 Fix wording in module API documentation * doc/lispref/internals.texi (Module Functions): Fix confusing wording. Reported by Basil L. Contovounesios . diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 311eb6b262..b68c94d5c7 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -1187,12 +1187,12 @@ it does when Lisp code encounters the same situations. @end deftypefn After writing your C code for a module function, you should make a -Lisp function object from it using @code{make_function}. This is +Lisp function object from it using the @code{make_function} function, +whose pointer is provided in the environment (recall that the pointer +to the environment is returned by @code{get_environment}). This is normally done in the module initialization function (@pxref{module initialization function}), after verifying the @acronym{API} -compatibility, and uses the pointer to @code{make_function} provided -in the environment (recall that the pointer to the environment is -returned by @code{get_environment}). +compatibility. @deftypefn Function emacs_value make_function (emacs_env *@var{env}, ptrdiff_t @var{min_arity}, ptrdiff_t @var{max_arity}, subr @var{func}, const char *@var{docstring}, void *@var{data}) @vindex emacs_variadic_function commit e724a8f6694280fcb4753a87011abf9dc1c2771e Author: Eli Zaretskii Date: Sat Oct 13 19:47:01 2018 +0300 Fix redisplay of glyphless characters * src/conf_post.h (bool_bf): Use 'unsigned int' in the MinGW builds. Suggested by Tom Tromey . (Bug#33017) * src/dispnew.c (scrolling_window): Update commentary regarding xwidget builds. diff --git a/src/conf_post.h b/src/conf_post.h index 69f686d72d..a09e529fc9 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -48,9 +48,11 @@ along with GNU Emacs. If not, see . */ #endif /* The type of bool bitfields. Needed to compile Objective-C with - standard GCC. It was also needed to port to pre-C99 compilers, - although we don't care about that any more. */ -#if NS_IMPL_GNUSTEP + standard GCC, and to make sure adjacent bool_bf fields are packed + into the same 1-, 2-, or 4-byte allocation unit in the MinGW + builds. It was also needed to port to pre-C99 compilers, although + we don't care about that any more. */ +#if NS_IMPL_GNUSTEP || defined(__MINGW32__) typedef unsigned int bool_bf; #else typedef bool bool_bf; diff --git a/src/dispnew.c b/src/dispnew.c index a81d6f64d1..d3a31967ae 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -4125,7 +4125,12 @@ scrolling_window (struct window *w, bool header_line_p) } #ifdef HAVE_XWIDGETS - /* Currently this seems needed to detect xwidget movement reliably. */ + /* Currently this seems needed to detect xwidget movement reliably. + This is most probably because an xwidget glyph is represented in + struct glyph's 'union u' by a pointer to a struct, which takes 8 + bytes in 64-bit builds, and thus the comparison of u.val values + done by GLYPH_EQUAL_P doesn't work reliably, since it assumes the + size of the union is 4 bytes. FIXME. */ return 0; #endif commit f3c13bb38e4120b4b84623892c6df4ddb421d5d0 Author: OGAWA Hirofumi Date: Sun Sep 30 08:31:25 2018 +0900 Fix sieve-mode font lock * lisp/net/sieve-mode.el (sieve-font-lock-keywords): Fix the definition of font-lock faces. (Bug#32881) diff --git a/lisp/net/sieve-mode.el b/lisp/net/sieve-mode.el index 34a4cb611e..b9f424fda8 100644 --- a/lisp/net/sieve-mode.el +++ b/lisp/net/sieve-mode.el @@ -100,23 +100,20 @@ (defconst sieve-font-lock-keywords (eval-when-compile - (list - ;; control commands - (cons (regexp-opt '("require" "if" "else" "elsif" "stop") - 'words) - 'sieve-control-commands) - ;; action commands - (cons (regexp-opt '("fileinto" "redirect" "reject" "keep" "discard") - 'words) - 'sieve-action-commands) - ;; test commands - (cons (regexp-opt '("address" "allof" "anyof" "exists" "false" - "true" "header" "not" "size" "envelope" - "body") - 'words) - 'sieve-test-commands) - (cons "\\Sw+:\\sw+" - 'sieve-tagged-arguments)))) + `( + ;; control commands + (,(regexp-opt '("require" "if" "else" "elsif" "stop") 'words) + . 'sieve-control-commands) + ;; action commands + (,(regexp-opt '("fileinto" "redirect" "reject" "keep" "discard") 'words) + . 'sieve-action-commands) + ;; test commands + (,(regexp-opt '("address" "allof" "anyof" "exists" "false" + "true" "header" "not" "size" "envelope" + "body") + 'words) + . 'sieve-test-commands) + ("\\Sw+:\\sw+" . 'sieve-tagged-arguments)))) ;; Syntax table commit 8fc892df37700d899d2851ef4918c56c5201ea19 Author: Robert Pluim Date: Sat Oct 13 10:52:06 2018 +0200 Update --without-toolkit-scroll-bars doc * configure.ac (--without-toolkit-scroll-bars): Update list of affected toolkits. diff --git a/configure.ac b/configure.ac index 029f451cd4..acea74094d 100644 --- a/configure.ac +++ b/configure.ac @@ -360,7 +360,7 @@ OPTION_DEFAULT_ON([xft],[don't use XFT for anti aliased fonts]) OPTION_DEFAULT_ON([libotf],[don't use libotf for OpenType font support]) OPTION_DEFAULT_ON([m17n-flt],[don't use m17n-flt for text shaping]) -OPTION_DEFAULT_ON([toolkit-scroll-bars],[don't use Motif or Xaw3d scroll bars]) +OPTION_DEFAULT_ON([toolkit-scroll-bars],[don't use Motif/Xaw3d/GTK toolkit scroll bars]) OPTION_DEFAULT_ON([xaw3d],[don't use Xaw3d]) OPTION_DEFAULT_ON([xim],[at runtime, default X11 XIM to off]) AC_ARG_WITH([ns],[AS_HELP_STRING([--with-ns], commit 4824d37041a9647f761c0cad32f2c3c8e367ba96 Author: OGAWA Hirofumi Date: Sun Sep 30 17:40:35 2018 +0900 Fix sieve-upload when sieve-buffer is nil * lisp/net/sieve.el (sieve-upload): Don't rely on sieve-buffer being non-nil. (Bug#32880) Copyright-paperwork-exempt: yes diff --git a/lisp/net/sieve.el b/lisp/net/sieve.el index 1f80ccc1e0..ef7bb5c025 100644 --- a/lisp/net/sieve.el +++ b/lisp/net/sieve.el @@ -345,11 +345,14 @@ Used to bracket operations which move point in the sieve-buffer." ;;;###autoload (defun sieve-upload (&optional name) (interactive) - (when (or (get-buffer sieve-buffer) (call-interactively 'sieve-manage)) - (let ((script (buffer-string)) err) + (when (or (get-buffer sieve-buffer) + (save-current-buffer (call-interactively 'sieve-manage))) + (let ((script (buffer-string)) + (script-name (file-name-sans-extension (buffer-name))) + err) (with-current-buffer (get-buffer sieve-buffer) (setq err (sieve-manage-putscript - (or name sieve-buffer-script-name (buffer-name)) + (or name sieve-buffer-script-name script-name) script sieve-manage-buffer)) (if (sieve-manage-ok-p err) (message (substitute-command-keys commit 80e0bfa96da69e5d1484c5031f42b1b1742567db Author: Robert Pluim Date: Thu Oct 11 16:02:51 2018 +0200 Call GTK functions only on GTK scrollbars * src/gtkutil.c (xg_set_background_color) [USE_TOOLKIT_SCROLL_BARS]: Don't call GTK functions on non-GTK scrollbars (Bug#32975). diff --git a/src/gtkutil.c b/src/gtkutil.c index 6b72671da9..5879ab683e 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -1498,6 +1498,7 @@ xg_set_background_color (struct frame *f, unsigned long bg) block_input (); xg_set_widget_bg (f, FRAME_GTK_WIDGET (f), FRAME_BACKGROUND_PIXEL (f)); +#ifdef USE_TOOLKIT_SCROLL_BARS Lisp_Object bar; for (bar = FRAME_SCROLL_BARS (f); !NILP (bar); @@ -1508,7 +1509,7 @@ xg_set_background_color (struct frame *f, unsigned long bg) GtkWidget *webox = gtk_widget_get_parent (scrollbar); xg_set_widget_bg (f, webox, FRAME_BACKGROUND_PIXEL (f)); } - +#endif unblock_input (); } } commit 91c4c46fd5538c1c8dbe00f272e2a65175940de8 Author: Eli Zaretskii Date: Sat Oct 13 11:36:04 2018 +0300 Update the description of startup in ELisp manual * doc/lispref/os.texi (Startup Summary): Remove stale reference to window-system-initialization-alist. Reported by Zhang Haijun . diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index e60a2c5a70..44fc9a1eea 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -96,24 +96,29 @@ if requested by environment variables such as @env{LANG}. It does some basic parsing of the command-line arguments. @vindex initial-window-system@r{, and startup} -@vindex window-system-initialization-alist +@findex window-system-initialization @item If not running in batch mode, it initializes the window system that the variable @code{initial-window-system} specifies (@pxref{Window -Systems, initial-window-system}). The initialization function for -each supported window system is specified by -@code{window-system-initialization-alist}. If the value -of @code{initial-window-system} is @var{windowsystem}, then the -appropriate initialization function is defined in the file -@file{term/@var{windowsystem}-win.el}. This file should have been -compiled into the Emacs executable when it was built. +Systems, initial-window-system}). The initialization function, +@code{window-system-initialization}, is a @dfn{generic function} +(@pxref{Generic Functions}) whose actual implementation is different +for each supported window system. If the value of +@code{initial-window-system} is @var{windowsystem}, then the +appropriate implementation of the initialization function is defined +in the file @file{term/@var{windowsystem}-win.el}. This file should +have been compiled into the Emacs executable when it was built. @item It runs the normal hook @code{before-init-hook}. @item -If appropriate, it creates a graphical frame. This is not done in -batch (noninteractive) or daemon mode. +If appropriate, it creates a graphical frame. As part of creating the +graphical frame, it initializes the window system specified by +@code{initial-frame-alist} and @code{default-frame-alist} +(@pxref{Initial Parameters}) for the graphical frame, by calling the +@code{window-system-initialization} function for that window system. +This is not done in batch (noninteractive) or daemon mode. @item It initializes the initial frame's faces, and sets up the menu bar commit 95f69e7db235ca450a17c5a24680b742dfdf9aae Author: Eli Zaretskii Date: Sat Oct 13 10:13:10 2018 +0300 Improve 'json-insert' so it doesn't cons a string from JSON * src/json.c (struct json_buffer_and_size): New member inserted_bytes. (json_insert): Instead of creating a string and inserting it into the current buffer, copy the unibyte text into the gap. (struct json_insert_data): New member inserted_bytes. (json_insert_callback): Update commentary. Pass the inserted_bytes value to json_insert and on its return copy the updated value back into DATA. (Fjson_insert): Decode the unibyte text inserted into the gap. Call before-change-functions and after-change-functions only once, before and after processing the insertion of the entire JSON representation. * test/src/json-tests.el (json-insert/throw): Adapt to the modified implementation of json-insert: it no longer calls the modification hooks once for each inserted chunk of JSON representation. diff --git a/src/json.c b/src/json.c index 17cc0965b1..e5c0dc2217 100644 --- a/src/json.c +++ b/src/json.c @@ -624,42 +624,54 @@ struct json_buffer_and_size { const char *buffer; ptrdiff_t size; + /* This tracks how many bytes were inserted by the callback since + json_dump_callback was called. */ + ptrdiff_t inserted_bytes; }; static Lisp_Object json_insert (void *data) { struct json_buffer_and_size *buffer_and_size = data; - /* FIXME: This should be possible without creating an intermediate - string object. */ - Lisp_Object string - = json_make_string (buffer_and_size->buffer, buffer_and_size->size); - insert1 (string); + ptrdiff_t len = buffer_and_size->size; + ptrdiff_t inserted_bytes = buffer_and_size->inserted_bytes; + ptrdiff_t gap_size = GAP_SIZE - inserted_bytes; + + /* Enlarge the gap if necessary. */ + if (gap_size < len) + make_gap (len - gap_size); + + /* Copy this chunk of data into the gap. */ + memcpy ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE + inserted_bytes, + buffer_and_size->buffer, len); + buffer_and_size->inserted_bytes += len; return Qnil; } struct json_insert_data { + /* This tracks how many bytes were inserted by the callback since + json_dump_callback was called. */ + ptrdiff_t inserted_bytes; /* nil if json_insert succeeded, otherwise the symbol Qcatch_all_memory_full or a cons (ERROR-SYMBOL . ERROR-DATA). */ Lisp_Object error; }; -/* Callback for json_dump_callback that inserts the UTF-8 string in - [BUFFER, BUFFER + SIZE) into the current buffer. - If [BUFFER, BUFFER + SIZE) does not contain a valid UTF-8 string, - an unspecified string is inserted into the buffer. DATA must point - to a structure of type json_insert_data. This function may not - exit nonlocally. It catches all nonlocal exits and stores them in - data->error for reraising. */ +/* Callback for json_dump_callback that inserts a JSON representation + as a unibyte string into the gap. DATA must point to a structure + of type json_insert_data. This function may not exit nonlocally. + It catches all nonlocal exits and stores them in data->error for + reraising. */ static int json_insert_callback (const char *buffer, size_t size, void *data) { struct json_insert_data *d = data; struct json_buffer_and_size buffer_and_size - = {.buffer = buffer, .size = size}; + = {.buffer = buffer, .size = size, .inserted_bytes = d->inserted_bytes}; d->error = internal_catch_all (json_insert, &buffer_and_size, Fidentity); + d->inserted_bytes = buffer_and_size.inserted_bytes; return NILP (d->error) ? 0 : -1; } @@ -695,10 +707,15 @@ usage: (json-insert OBJECT &rest ARGS) */) json_t *json = lisp_to_json (args[0], &conf); record_unwind_protect_ptr (json_release_object, json); + prepare_to_modify_buffer (PT, PT, NULL); + move_gap_both (PT, PT_BYTE); struct json_insert_data data; + data.inserted_bytes = 0; /* If desired, we might want to add the following flags: JSON_DECODE_ANY, JSON_ALLOW_NUL. */ int status + /* Could have used json_dumpb, but that became available only in + Jansson 2.10, whereas we want to support 2.7 and upward. */ = json_dump_callback (json, json_insert_callback, &data, JSON_COMPACT); if (status == -1) { @@ -708,6 +725,65 @@ usage: (json-insert OBJECT &rest ARGS) */) json_out_of_memory (); } + ptrdiff_t inserted = 0; + ptrdiff_t inserted_bytes = data.inserted_bytes; + if (inserted_bytes > 0) + { + /* Make the inserted text part of the buffer, as unibyte text. */ + GAP_SIZE -= inserted_bytes; + GPT += inserted_bytes; + GPT_BYTE += inserted_bytes; + ZV += inserted_bytes; + ZV_BYTE += inserted_bytes; + Z += inserted_bytes; + Z_BYTE += inserted_bytes; + + if (GAP_SIZE > 0) + /* Put an anchor to ensure multi-byte form ends at gap. */ + *GPT_ADDR = 0; + + /* If required, decode the stuff we've read into the gap. */ + struct coding_system coding; + /* JSON strings are UTF-8 encoded strings. If for some reason + the text returned by the Jansson library includes invalid + byte sequences, they will be represented by raw bytes in the + buffer text. */ + setup_coding_system (Qutf_8_unix, &coding); + coding.dst_multibyte = + !NILP (BVAR (current_buffer, enable_multibyte_characters)); + if (CODING_MAY_REQUIRE_DECODING (&coding)) + { + move_gap_both (PT, PT_BYTE); + GAP_SIZE += inserted_bytes; + ZV_BYTE -= inserted_bytes; + Z_BYTE -= inserted_bytes; + ZV -= inserted_bytes; + Z -= inserted_bytes; + decode_coding_gap (&coding, inserted_bytes, inserted_bytes); + inserted = coding.produced_char; + } + else + { + /* The target buffer is unibyte, so we don't need to decode. */ + invalidate_buffer_caches (current_buffer, + PT, PT + inserted_bytes); + adjust_after_insert (PT, PT_BYTE, + PT + inserted_bytes, + PT_BYTE + inserted_bytes, + inserted_bytes); + inserted = inserted_bytes; + } + } + + /* Call after-change hooks. */ + signal_after_change (PT, 0, inserted); + if (inserted > 0) + { + update_compositions (PT, PT, CHECK_BORDER); + /* Move point to after the inserted text. */ + SET_PT_BOTH (PT + inserted, PT_BYTE + inserted_bytes); + } + return unbind_to (count, Qnil); } diff --git a/test/src/json-tests.el b/test/src/json-tests.el index 911bc49730..bffee8f39d 100644 --- a/test/src/json-tests.el +++ b/test/src/json-tests.el @@ -272,10 +272,11 @@ Test with both unibyte and multibyte strings." (cl-incf calls) (throw 'test-tag 'throw-value)) :local) - (should-error - (catch 'test-tag - (json-insert '((a . "b") (c . 123) (d . [1 2 t :false])))) - :type 'no-catch) + (should + (equal + (catch 'test-tag + (json-insert '((a . "b") (c . 123) (d . [1 2 t :false])))) + 'throw-value)) (should (equal calls 1))))) (ert-deftest json-serialize/bignum () commit 18b42c6b4b411c217a4a2a16ccfe48640f6582e8 Author: Eli Zaretskii Date: Sat Oct 13 09:44:09 2018 +0300 Use the 'line-number' face for line-number fields past EOB * src/xdisp.c (get_phys_cursor_geometry): Treat rows at and beyond ZV specially. Don't let the cursor exceed the vertical dimensions of the row. (maybe_produce_line_number): Use the 'line-number' face instead of 'default' for blank fields beyond ZV. Don't update the IT metrics when displaying blank line-number fields beyond ZV. (Bug#32337) diff --git a/src/xdisp.c b/src/xdisp.c index eccefa41cf..357f0fb30c 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -2304,7 +2304,10 @@ get_phys_cursor_geometry (struct window *w, struct glyph_row *row, ascent value, lest the hollow cursor looks funny. */ y = w->phys_cursor.y; ascent = row->ascent; - if (row->ascent < glyph->ascent) + /* The test for row at ZV is for when line numbers are displayed and + point is at EOB: the cursor could then be smaller or larger than + the default face's font. */ + if (!row->ends_at_zv_p && row->ascent < glyph->ascent) { y -= glyph->ascent - row->ascent; ascent = glyph->ascent; @@ -2314,6 +2317,9 @@ get_phys_cursor_geometry (struct window *w, struct glyph_row *row, h0 = min (FRAME_LINE_HEIGHT (f), row->visible_height); h = max (h0, ascent + glyph->descent); + /* Don't let the cursor exceed the dimensions of the row, so that + the upper/lower side of the box aren't clipped. */ + h = min (h, row->height); h0 = min (h0, ascent + glyph->descent); y0 = WINDOW_HEADER_LINE_HEIGHT (w); @@ -21175,14 +21181,11 @@ maybe_produce_line_number (struct it *it) for (const char *p = lnum_buf; *p; p++) { /* For continuation lines and lines after ZV, instead of a line - number, produce a blank prefix of the same width. Use the - default face for the blank field beyond ZV. */ - if (beyond_zv) - tem_it.face_id = it->base_face_id; - else if (lnum_face_id != current_lnum_face_id - && (EQ (Vdisplay_line_numbers, Qvisual) - ? this_line == 0 - : this_line == it->pt_lnum)) + number, produce a blank prefix of the same width. */ + if (lnum_face_id != current_lnum_face_id + && (EQ (Vdisplay_line_numbers, Qvisual) + ? this_line == 0 + : this_line == it->pt_lnum)) tem_it.face_id = current_lnum_face_id; else tem_it.face_id = lnum_face_id; @@ -21235,23 +21238,30 @@ maybe_produce_line_number (struct it *it) } } - /* Update IT's metrics due to glyphs produced for line numbers. */ - if (it->glyph_row) + /* Update IT's metrics due to glyphs produced for line numbers. + Don't do that for rows beyond ZV, to avoid displaying a cursor of + different dimensions there. */ + if (!beyond_zv) { - struct glyph_row *row = it->glyph_row; + if (it->glyph_row) + { + struct glyph_row *row = it->glyph_row; - it->max_ascent = max (row->ascent, tem_it.max_ascent); - it->max_descent = max (row->height - row->ascent, tem_it.max_descent); - it->max_phys_ascent = max (row->phys_ascent, tem_it.max_phys_ascent); - it->max_phys_descent = max (row->phys_height - row->phys_ascent, - tem_it.max_phys_descent); - } - else - { - it->max_ascent = max (it->max_ascent, tem_it.max_ascent); - it->max_descent = max (it->max_descent, tem_it.max_descent); - it->max_phys_ascent = max (it->max_phys_ascent, tem_it.max_phys_ascent); - it->max_phys_descent = max (it->max_phys_descent, tem_it.max_phys_descent); + it->max_ascent = max (row->ascent, tem_it.max_ascent); + it->max_descent = max (row->height - row->ascent, tem_it.max_descent); + it->max_phys_ascent = max (row->phys_ascent, tem_it.max_phys_ascent); + it->max_phys_descent = max (row->phys_height - row->phys_ascent, + tem_it.max_phys_descent); + } + else + { + it->max_ascent = max (it->max_ascent, tem_it.max_ascent); + it->max_descent = max (it->max_descent, tem_it.max_descent); + it->max_phys_ascent = max (it->max_phys_ascent, + tem_it.max_phys_ascent); + it->max_phys_descent = max (it->max_phys_descent, + tem_it.max_phys_descent); + } } it->line_number_produced_p = true; commit a6ab8db3a3dc5ec107ef023c6659620584309c97 Author: Alan Third Date: Fri Oct 12 21:45:03 2018 +0100 Ensure NS frame is redrawn correctly after scroll * src/nsterm.m (ns_copy_bits): Set needsDisplay so the previous cursor position is redrawn. diff --git a/src/nsterm.m b/src/nsterm.m index d92d6c3244..8c355a89f8 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -2721,6 +2721,7 @@ so some key presses (TAB) are swallowed by the system. */ [FRAME_NS_VIEW (f) scrollRect: src by: NSMakeSize (dest.origin.x - src.origin.x, dest.origin.y - src.origin.y)]; + [FRAME_NS_VIEW (f) setNeedsDisplay:YES]; } } commit 6cf4dfe472650b3396d2f2592726621a43896de3 Merge: c3856d46f5 643df633ea Author: Glenn Morris Date: Fri Oct 12 10:31:22 2018 -0700 Merge from origin/emacs-26 643df63 (origin/emacs-26) Avoid byte-compiler warning in em-rebind.el d0eca49 ; * doc/emacs/mark.texi (Disabled Transient Mark): Fix last c... af80b10 Improve indexing of 'C-SPC C-SPC' 89a7301 ; * doc/lispref/internals.texi (Writing Dynamic Modules): Fix... a108eaa Fix bug with precious entries in Gnus registry ce8b458 Document in the ELisp manual how to write loadable modules a7ebc6b dired-do-shell-command: Notify users after abort the command # Conflicts: # lisp/registry.el commit c3856d46f53a1081085a97d0e514efe29e8529d7 Merge: 7a7a3a4bfe 0d2bf76d3d Author: Glenn Morris Date: Fri Oct 12 10:28:40 2018 -0700 ; Merge from origin/emacs-26 The following commit was skipped: 0d2bf76 Adapt Tramp version. Do not merge with master commit 7a7a3a4bfe4086d3c89ff7baa6db1f746c28b5c2 Merge: 9c231a4470 6e54762c37 Author: Glenn Morris Date: Fri Oct 12 10:28:40 2018 -0700 Merge from origin/emacs-26 6e54762 Fix Apple Script permissions error 19f705c Fix typo in 'timerp' documentation commit 9c231a447014823ed1955e16b6693adbe041ca99 Author: Michael Albinus Date: Fri Oct 12 13:42:34 2018 +0200 * test/lisp/net/tramp-tests.el (tramp--test-timeout-handler): Add docstring. Remove `interactive' call. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 523c7afada..6a08cbb5ab 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4884,7 +4884,7 @@ Use the `ls' command." (numberp (nth 2 fsi)))))) (defun tramp--test-timeout-handler () - (interactive) + "Timeout handler, reporting a failed test." (ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test))))) ;; This test is inspired by Bug#16928. commit ac2a04e88855d7929bccf58f7585aa5126591870 Author: Michael Albinus Date: Fri Oct 12 13:42:07 2018 +0200 * lisp/net/trampver.el (customize-package-emacs-version-alist): Adapt Tramp version integrated in Emacs 26.2. diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index f17129a402..de76788cc0 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -67,7 +67,7 @@ ("2.2.9-24.4" . "24.4") ("2.2.11-24.5" . "24.5") ("2.2.13.25.1" . "25.1") ("2.2.13.25.2" . "25.2") ("2.2.13.25.2" . "25.3") - ("2.3.3.26.1" . "26.1") ("2.3.4.26.2" . "26.2"))) + ("2.3.3.26.1" . "26.1") ("2.3.5.26.2" . "26.2"))) (add-hook 'tramp-unload-hook (lambda () commit 10cd2500afcad1c6d7ab01c8b8c336e69e9add96 Author: Michael Albinus Date: Fri Oct 12 13:41:12 2018 +0200 Fix error in Tramp loading, uncovered by tramp-test43-* * lisp/net/tramp-archive.el (tramp-archive-autoload-file-name-handler): New defalias. (tramp-register-archive-file-name-handler): Use it. * lisp/net/tramp.el (tramp-file-name-for-operation): Change it for `expand-file-name'. (tramp-file-name-handler): Unset `file-name-handler-alist' when autoloading a Tramp file name handler. (tramp-autoload-file-name-handler): Always unload Tramp file name handlers. (tramp-register-file-name-handlers) (tramp-unload-file-name-handlers): Simplify. diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 5d7562f707..bb87a83f10 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -331,14 +331,18 @@ pass to the OPERATION." (save-match-data (apply (cdr fn) args)) (tramp-archive-run-real-handler operation args))))))) +;;;###autoload +(defalias + 'tramp-archive-autoload-file-name-handler 'tramp-autoload-file-name-handler) + ;;;###autoload (progn (defun tramp-register-archive-file-name-handler () "Add archive file name handler to `file-name-handler-alist'." (when tramp-archive-enabled (add-to-list 'file-name-handler-alist (cons (tramp-archive-autoload-file-name-regexp) - 'tramp-autoload-file-name-handler)) - (put 'tramp-archive-file-name-handler 'safe-magic t)))) + 'tramp-archive-autoload-file-name-handler)) + (put 'tramp-archive-autoload-file-name-handler 'safe-magic t)))) ;;;###autoload (progn diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 08a225602a..e629ce1731 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2138,7 +2138,7 @@ ARGS are the arguments OPERATION has been called with." default-directory)) ;; FILE DIRECTORY resp FILE1 FILE2. ((member operation - '(add-name-to-file copy-directory copy-file expand-file-name + '(add-name-to-file copy-directory copy-file file-equal-p file-in-directory-p file-name-all-completions file-name-completion ;; Starting with Emacs 26.1, just the 2nd argument of @@ -2152,6 +2152,13 @@ ARGS are the arguments OPERATION has been called with." ((tramp-tramp-file-p (nth 0 args)) (nth 0 args)) ((tramp-tramp-file-p (nth 1 args)) (nth 1 args)) (t default-directory)))) + ;; FILE DIRECTORY resp FILE1 FILE2. + ((eq operation 'expand-file-name) + (save-match-data + (cond + ((file-name-absolute-p (nth 0 args)) (nth 0 args)) + ((tramp-tramp-file-p (nth 1 args)) (nth 1 args)) + (t default-directory)))) ;; START END FILE. ((eq operation 'write-region) (if (file-name-absolute-p (nth 2 args)) @@ -2255,7 +2262,8 @@ Falls back to normal file name handler if no Tramp file name handler exists." ;; Tramp packages locally. (when (autoloadp sf) (let ((default-directory - (tramp-compat-temporary-file-directory))) + (tramp-compat-temporary-file-directory)) + file-name-handler-alist) (load (cadr sf) 'noerror 'nomessage))) ;; (tramp-message ;; v 4 "Running `%s'..." (cons operation args)) @@ -2349,10 +2357,10 @@ Falls back to normal file name handler if no Tramp file name handler exists." ;;;###autoload (progn (defun tramp-autoload-file-name-handler (operation &rest args) "Load Tramp file name handler, and perform OPERATION." + (tramp-unload-file-name-handlers) (if tramp-mode (let ((default-directory temporary-file-directory)) - (load "tramp" 'noerror 'nomessage)) - (tramp-unload-file-name-handlers)) + (load "tramp" 'noerror 'nomessage))) (apply operation args))) ;; `tramp-autoload-file-name-handler' must be registered before @@ -2396,15 +2404,8 @@ remote file names." (defun tramp-register-file-name-handlers () "Add Tramp file name handlers to `file-name-handler-alist'." ;; Remove autoloaded handlers from file name handler alist. Useful, - ;; if `tramp-syntax' has been changed. We cannot call - ;; `tramp-unload-file-name-handlers', this would result in recursive - ;; loading of Tramp. - (dolist (fnh '(tramp-file-name-handler - tramp-completion-file-name-handler - tramp-archive-file-name-handler - tramp-autoload-file-name-handler)) - (let ((a1 (rassq fnh file-name-handler-alist))) - (setq file-name-handler-alist (delq a1 file-name-handler-alist)))) + ;; if `tramp-syntax' has been changed. + (tramp-unload-file-name-handlers) ;; Add the handlers. We do not add anything to the `operations' ;; property of `tramp-file-name-handler' and @@ -2479,12 +2480,10 @@ Add operations defined in `HANDLER-alist' to `tramp-file-name-handler'." ;;;###autoload (progn (defun tramp-unload-file-name-handlers () "Unload Tramp file name handlers from `file-name-handler-alist'." - (dolist (fnh '(tramp-file-name-handler - tramp-completion-file-name-handler - tramp-archive-file-name-handler - tramp-autoload-file-name-handler)) - (let ((a1 (rassq fnh file-name-handler-alist))) - (setq file-name-handler-alist (delq a1 file-name-handler-alist)))))) + (dolist (fnh file-name-handler-alist) + (when (and (symbolp (cdr fnh)) + (string-prefix-p "tramp-" (symbol-name (cdr fnh)))) + (setq file-name-handler-alist (delq fnh file-name-handler-alist)))))) (add-hook 'tramp-unload-hook 'tramp-unload-file-name-handlers) commit f5896e2cbf0e537ec6b79ba139220239f934c840 Author: Allen Li Date: Sat Sep 29 15:19:04 2018 -0700 Rework empty abbrev table omitting There were two problems with the original implementation: 1. It changed the behavior of insert-abbrev-table-description when READABLE is nil to sometimes insert one Emacs Lisp expression and sometimes insert nothing. 2. It broke the tests. This commit reworks this so that insert-abbrev-table-description always inserts an expressions even if no abbrevs need to be saved and making only write-abbrev-file check that a table has any abbrevs to save before calling insert-abbrev-table-description. This duplicates the work of filtering the table for savable abbrevs, but the benefit of keeping the API is worth it. * doc/lispref/abbrevs.texi (Abbrev Tables): Update documentation. * lisp/abbrev.el (write-abbrev-file): Skip tables without user abbrevs (insert-abbrev-table-description): Always insert the define expression. (abbrev--table-symbols): New function. * test/lisp/abbrev-tests.el (abbrev--table-symbols-test): Add test for abbrev--table-symbols. diff --git a/doc/lispref/abbrevs.texi b/doc/lispref/abbrevs.texi index 4c9e653cb1..1e9471ba27 100644 --- a/doc/lispref/abbrevs.texi +++ b/doc/lispref/abbrevs.texi @@ -122,9 +122,7 @@ System abbrevs are listed and identified as such. Otherwise the description is a Lisp expression---a call to @code{define-abbrev-table} that would define @var{name} as it is currently defined, but without the system abbrevs. (The mode or package using @var{name} is supposed -to add these to @var{name} separately.) If the Lisp expression would -not define any abbrevs (i.e.@: it defines an empty abbrev table), this -function inserts nothing. +to add these to @var{name} separately.) @end defun @node Defining Abbrevs @@ -234,7 +232,8 @@ Emacs commands to offer to save your abbrevs. Save all abbrev definitions (except system abbrevs), for all abbrev tables listed in @code{abbrev-table-name-list}, in the file @var{filename}, in the form of a Lisp program that when loaded will -define the same abbrevs. If @var{filename} is @code{nil} or omitted, +define the same abbrevs. Tables that do not have any abbrevs to save +are omitted. If @var{filename} is @code{nil} or omitted, @code{abbrev-file-name} is used. This function returns @code{nil}. @end deffn diff --git a/etc/NEWS b/etc/NEWS index ee74e86f40..946a823173 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -258,10 +258,9 @@ case does not match. for abbrevs that have them. +++ -** 'insert-abbrev-table-description' skips empty tables. -'insert-abbrev-table-description' skips inserting empty tables when -inserting non-readable tables. By extension, this makes -'write-abbrev-file' skip writing empty tables. +** 'write-abbrev-file' skips empty tables. +'write-abbrev-file' now skips inserting a 'define-abbrev-table' form for +tables which do not have any non-system abbrevs to save. +++ ** The new functions and commands 'text-property-search-forward' and diff --git a/lisp/abbrev.el b/lisp/abbrev.el index e1fd366ba9..20a967d7d6 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -251,7 +251,8 @@ have been saved." (lambda (s1 s2) (string< (symbol-name s1) (symbol-name s2))))) - (insert-abbrev-table-description table nil)) + (if (abbrev--table-symbols table) + (insert-abbrev-table-description table nil))) (when (unencodable-char-position (point-min) (point-max) 'utf-8) (setq coding-system-for-write (if (> emacs-major-version 24) @@ -937,33 +938,38 @@ is inserted. If READABLE is nil, an expression is inserted. The expression is a call to `define-abbrev-table' that when evaluated will define the abbrev table NAME exactly as it is currently defined. -Abbrevs marked as \"system abbrevs\" are ignored. If the -resulting expression would not define any abbrevs, nothing is -inserted." +Abbrevs marked as \"system abbrevs\" are ignored." + (let ((table (symbol-value name)) + (symbols (abbrev--table-symbols name readable))) + (setq symbols (sort symbols 'string-lessp)) + (let ((standard-output (current-buffer))) + (if readable + (progn + (insert "(") + (prin1 name) + (insert ")\n\n") + (mapc 'abbrev--describe symbols) + (insert "\n\n")) + (insert "(define-abbrev-table '") + (prin1 name) + (if (null symbols) + (insert " '())\n\n") + (insert "\n '(\n") + (mapc 'abbrev--write symbols) + (insert " ))\n\n"))) + nil))) + +(defun abbrev--table-symbols (name &optional system) + "Return the user abbrev symbols in the abbrev table named NAME. +NAME is a symbol whose value is an abbrev table. System abbrevs +are omitted unless SYSTEM is non-nil." (let ((table (symbol-value name)) (symbols ())) (mapatoms (lambda (sym) - (if (and (symbol-value sym) (or readable (not (abbrev-get sym :system)))) + (if (and (symbol-value sym) (or system (not (abbrev-get sym :system)))) (push sym symbols))) table) - (when symbols - (setq symbols (sort symbols 'string-lessp)) - (let ((standard-output (current-buffer))) - (if readable - (progn - (insert "(") - (prin1 name) - (insert ")\n\n") - (mapc 'abbrev--describe symbols) - (insert "\n\n")) - (insert "(define-abbrev-table '") - (prin1 name) - (if (null symbols) - (insert " '())\n\n") - (insert "\n '(\n") - (mapc 'abbrev--write symbols) - (insert " ))\n\n"))) - nil)))) + symbols)) (defun define-abbrev-table (tablename definitions &optional docstring &rest props) diff --git a/test/lisp/abbrev-tests.el b/test/lisp/abbrev-tests.el index facf097815..e50f931cef 100644 --- a/test/lisp/abbrev-tests.el +++ b/test/lisp/abbrev-tests.el @@ -64,6 +64,14 @@ (should (= (length table) obarray-default-size)) (should (eq (abbrev-table-get table 'foo) 'bar)))) +(ert-deftest abbrev--table-symbols-test () + (let ((ert-test-abbrevs (setup-test-abbrev-table))) + (define-abbrev ert-test-abbrevs "sys" "system abbrev" nil :system t) + (should (equal (mapcar #'symbol-name (abbrev--table-symbols 'ert-test-abbrevs)) + '("a-e-t"))) + (should (equal (mapcar #'symbol-name (abbrev--table-symbols 'ert-test-abbrevs t)) + '("a-e-t" "sys"))))) + (ert-deftest abbrev-table-get-put-test () (let ((table (make-abbrev-table))) (should-not (abbrev-table-get table 'foo)) commit 643df633ea8afafce661a20b54676691f59a68ce Author: Alex Branham Date: Fri Oct 5 09:07:13 2018 -0500 Avoid byte-compiler warning in em-rebind.el * lisp/eshell/em-rebind.el (eshell-delete-backward-char): Use 'delete-char' instead of delete-backward-char. (Bug#32945) diff --git a/lisp/eshell/em-rebind.el b/lisp/eshell/em-rebind.el index e6f04b68e0..064dcc762d 100644 --- a/lisp/eshell/em-rebind.el +++ b/lisp/eshell/em-rebind.el @@ -223,7 +223,7 @@ lock it at that." (interactive "P") (let ((count (prefix-numeric-value n))) (if (eshell-point-within-input-p (- (point) count)) - (delete-backward-char count n) + (delete-char (- count) n) (beep)))) (defun eshell-delchar-or-maybe-eof (arg) commit d0eca49e3c811d43dfc9bc407bf608d7a955ced8 Author: Eli Zaretskii Date: Fri Oct 12 11:33:31 2018 +0300 ; * doc/emacs/mark.texi (Disabled Transient Mark): Fix last change. diff --git a/doc/emacs/mark.texi b/doc/emacs/mark.texi index 9747d0261f..626f9dda25 100644 --- a/doc/emacs/mark.texi +++ b/doc/emacs/mark.texi @@ -450,7 +450,7 @@ using @kbd{C-@key{SPC} C-@key{SPC}} or @kbd{C-u C-x C-x}. @table @kbd @item C-@key{SPC} C-@key{SPC} -@kindex C-SPC C-SPC@r{, enabling Transient Mark temporarily} +@kindex C-SPC C-SPC@r{, enabling Transient Mark mode temporarily} Set the mark at point (like plain @kbd{C-@key{SPC}}) and enable Transient Mark mode just once, until the mark is deactivated. (This is not really a separate command; you are using the @kbd{C-@key{SPC}} commit af80b1061293dc98433ee7b444ddde7979b7883d Author: Eli Zaretskii Date: Fri Oct 12 11:31:09 2018 +0300 Improve indexing of 'C-SPC C-SPC' * doc/emacs/mark.texi (Disabled Transient Mark): Fix indexing. (Bug#32959) diff --git a/doc/emacs/mark.texi b/doc/emacs/mark.texi index 10505873c5..9747d0261f 100644 --- a/doc/emacs/mark.texi +++ b/doc/emacs/mark.texi @@ -444,12 +444,13 @@ from point to the end of the buffer. Commands that act this way are identified in their own documentation. @end itemize +@cindex enabling Transient Mark mode temporarily While Transient Mark mode is off, you can activate it temporarily using @kbd{C-@key{SPC} C-@key{SPC}} or @kbd{C-u C-x C-x}. @table @kbd @item C-@key{SPC} C-@key{SPC} -@kindex C-SPC C-SPC@r{, disabling Transient Mark} +@kindex C-SPC C-SPC@r{, enabling Transient Mark temporarily} Set the mark at point (like plain @kbd{C-@key{SPC}}) and enable Transient Mark mode just once, until the mark is deactivated. (This is not really a separate command; you are using the @kbd{C-@key{SPC}} commit 89a73016f71beabbd0617e0963010d5d353e30f1 Author: Eli Zaretskii Date: Thu Oct 11 21:48:10 2018 +0300 ; * doc/lispref/internals.texi (Writing Dynamic Modules): Fix a typo. diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 8db8c06161..311eb6b262 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -1023,7 +1023,7 @@ according to the conventions of the underlying platform. Then place the shared library in a directory mentioned in @code{load-path} (@pxref{Library Search}), where Emacs will find it. -If you wish to verify the conformance of a modue to the Emacs dynamic +If you wish to verify the conformance of a module to the Emacs dynamic module @acronym{API}, invoke Emacs with the @kbd{--module-assertions} option. @xref{Initial Options,,,emacs, The GNU Emacs Manual}. commit a108eaa13c8f2af4d7de9fc788d1b780a5571cd6 Author: Eric Abrahamsen Date: Thu Oct 11 11:20:29 2018 -0700 Fix bug with precious entries in Gnus registry * lisp/registry.el (registry-collect-prune-candidates): This `cdr' was an error: it meant that the last key in the precious list, would be considered a nil. Since the precious list only contains the symbol 'mark by default, marks were never considered precious. * doc/misc/gnus.texi (Store arbitrary data): Fix typo: "marks" should be "mark". diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index db0534e8a6..7be888f3f2 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -26159,7 +26159,7 @@ Get the data under @code{key} for message @code{id}. If any extra entries are precious, their presence will make the registry keep the whole entry forever, even if there are no groups for the Message-ID and if the size limit of the registry is reached. By -default this is just @code{(marks)} so the custom registry marks are +default this is just @code{(mark)} so the custom registry marks are precious. @end defvar diff --git a/lisp/registry.el b/lisp/registry.el index 95097a4f1b..04f3e7b974 100644 --- a/lisp/registry.el +++ b/lisp/registry.el @@ -358,7 +358,7 @@ return LIMIT such candidates. If SORTFUNC is provided, sort entries first and return candidates from beginning of list." (let* ((precious (oref db precious)) (precious-p (lambda (entry-key) - (cdr (memq (car entry-key) precious)))) + (memq (car entry-key) precious))) (data (oref db data)) (candidates (cl-loop for k being the hash-keys of data using (hash-values v) commit ce8b4584a3c69e5c4abad8a0a9c3781ce8c0c1f8 Author: Eli Zaretskii Date: Thu Oct 11 20:53:05 2018 +0300 Document in the ELisp manual how to write loadable modules * doc/lispref/internals.texi (Writing Dynamic Modules) (Module Initialization, Module Functions, Module Values) (Module Misc, Module Nonlocal): New nodes. * doc/lispref/loading.texi (Dynamic Modules): Add cross-reference to the new node. * doc/lispref/internals.texi (GNU Emacs Internals): * doc/lispref/elisp.texi (Top): Update menus for the new nodes. diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index 6c3182b0c7..7dd1e89de5 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -1588,9 +1588,18 @@ GNU Emacs Internals * Memory Usage:: Info about total size of Lisp objects made so far. * C Dialect:: What C variant Emacs is written in. * Writing Emacs Primitives:: Writing C code for Emacs. +* Writing Dynamic Modules:: Writing loadable modules for Emacs. * Object Internals:: Data formats of buffers, windows, processes. * C Integer Types:: How C integer types are used inside Emacs. +Writing Dynamic Modules + +* Module Initialization:: +* Module Functions:: +* Module Values:: +* Module Misc:: +* Module Nonlocal:: + Object Internals * Buffer Internals:: Components of a buffer structure. diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 45c3b87c0a..8db8c06161 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -18,6 +18,7 @@ internal aspects of GNU Emacs that may be of interest to C programmers. * Memory Usage:: Info about total size of Lisp objects made so far. * C Dialect:: What C variant Emacs is written in. * Writing Emacs Primitives:: Writing C code for Emacs. +* Writing Dynamic Modules:: Writing loadable modules for Emacs. * Object Internals:: Data formats of buffers, windows, processes. * C Integer Types:: How C integer types are used inside Emacs. @end menu @@ -980,6 +981,708 @@ in @file{byte-opt.el} that binds @code{side-effect-free-fns} and @code{side-effect-and-error-free-fns} so that the compiler optimizer knows about it. +@node Writing Dynamic Modules +@section Writing Dynamically-Loaded Modules +@cindex writing emacs modules +@cindex dynamic modules, writing + +@cindex module @acronym{API} + This section describes the Emacs module @acronym{API} and how to use +it as part of writing extension modules for Emacs. The module +@acronym{API} is defined in the C programming language, therefore the +description and the examples in this section assume the module is +written in C@. For other programming languages, you will need to use +the appropriate bindings, interfaces and facilities for calling C code. +Emacs C code requires a C99 or later compiler (@pxref{C Dialect}), and +so the code examples in this section also follow that standard. + +Writing a module and integrating it into Emacs comprises the following +tasks: + +@itemize @bullet +@item +Writing initialization code for the module. + +@item +Writing one or more module functions. + +@item +Communicating values and objects between Emacs and your module +functions. + +@item +Handling of error conditions and nonlocal exits. +@end itemize + +@noindent +The following subsections describe these tasks and the @acronym{API} +itself in more detail. + +Once your module is written, compile it to produce a shared library, +according to the conventions of the underlying platform. Then place +the shared library in a directory mentioned in @code{load-path} +(@pxref{Library Search}), where Emacs will find it. + +If you wish to verify the conformance of a modue to the Emacs dynamic +module @acronym{API}, invoke Emacs with the @kbd{--module-assertions} +option. @xref{Initial Options,,,emacs, The GNU Emacs Manual}. + +@menu +* Module Initialization:: +* Module Functions:: +* Module Values:: +* Module Misc:: +* Module Nonlocal:: +@end menu + +@node Module Initialization +@subsection Module Initialization Code +@cindex module initialization + + Begin your module by including the header file @file{emacs-module.h} +and defining the GPL compatibility symbol: + +@example +#include + +int plugin_is_GPL_compatible; +@end example + +The @file{emacs-module.h} file is installed into your system's include +tree as part of the Emacs installation. Alternatively, you can find +it in the Emacs source tree. + +@anchor{module initialization function} +Next, write an initialization function for the module. + +@deftypefn Function int emacs_module_init (struct emacs_runtime *@var{runtime}) +Emacs calls this function when it loads a module. If a module does +not export a function named @code{emacs_module_init}, trying to load +the module will signal an error. The initialization function should +return zero if the initialization succeeds, non-zero otherwise. In +the latter case, Emacs will signal an error, and the loading of the +module will fail. If the user presses @kbd{C-g} during the +initialization, Emacs ignores the return value of the initialization +function and quits (@pxref{Quitting}). (If needed, you can catch user +quitting inside the initialization function, @pxref{should_quit}.) + +The argument @var{runtime} is a pointer to a C @code{struct} that +includes 2 public fields: @code{size}, which provides the size of the +structure in bytes; and @code{get_environment}, which provides a +pointer to a function that allows the module initialization function +access to the Emacs environment object and its interfaces. + +The initialization function should perform whatever initialization is +required for the module. In addition, it can perform the following +tasks: + +@table @asis +@cindex compatibility, between modules and Emacs +@item Compatibility verification +A module can verify that the Emacs executable which loads the module +is compatible with the module, by comparing the @code{size} member of +the @var{runtime} structure with the value compiled into the module: + +@example +int +emacs_module_init (struct emacs_runtime *ert) +@{ + if (ert->size < sizeof (*ert)) + return 1; +@} +@end example + +@noindent +If the size of the runtime object passed to the module is smaller than +what it expects, it means the module was compiled for an Emacs version +newer (later) than the one which attempts to load it, i.e.@: the +module might be incompatible with the Emacs binary. + +In addition, a module can verify the compatibility of the module +@acronym{API} with what the module expects. The following sample code +assumes it is part of the @code{emacs_module_init} function shown +above: + +@example + emacs_env *env = ert->get_environment (ert); + if (env->size < sizeof (*env)) + return 2; +@end example + +@noindent +@cindex module runtime environment +This calls the @code{get_environment} function using the pointer +provided in the @code{runtime} structure to retrieve a pointer to the +@acronym{API}'s @dfn{environment}, a C @code{struct} which also has a +@code{size} field holding the size of the structure in bytes. + +Finally, you can write a module that will work with older versions of +Emacs, by comparing the size of the environment passed by Emacs with +known sizes, like this: + +@example + emacs_env *env = ert->get_environment (ert); + if (env->size >= sizeof (struct emacs_env_26)) + emacs_version = 26; /* Emacs 26 or later. */ + else if (env->size >= sizeof (struct emacs_env_25)) + emacs_version = 25; + else + return 2; /* Unknown or unsupported version. */ +@end example + +@noindent +This works because later Emacs versions always @emph{add} members to +the environment, never @emph{remove} any members, so the size can only +grow with new Emacs releases. Given the version of Emacs, the module +can use only the parts of the module @acronym{API} that existed in +that version, since those parts are identical in later versions. + +We recommend that modules always perform the compatibility +verification, unless they do their job entirely in the initialization +function, and don't access any Lisp objects or use any Emacs functions +accessible through the environment structure. + +@item Binding module functions to Lisp symbols +This gives the module functions names so that Lisp code could call it +by that name. We describe how to do this in @ref{Module Functions} +below. +@end table +@end deftypefn + +@node Module Functions +@subsection Writing Module Functions +@cindex writing module functions +@cindex module functions + + The main reason for writing an Emacs module is to make additional +functions available to Lisp programs that load the module. This +subsection describes how to write such @dfn{module functions}. + +A module function has the following general form and signature: + +@deftypefn Function emacs_value module_func (emacs_env *@var{env}, ptrdiff_t @var{nargs}, emacs_value *@var{args}, void *@var{data}) +The @var{env} argument provides a pointer to the @acronym{API} +environment, needed to access Emacs objects and functions. The +@var{nargs} argument is the required number of arguments, which can be +zero (see @code{make_function} below for more flexible specification +of the argument number), and @var{args} is a pointer to the array of +the function arguments. The argument @var{data} points to additional +data required by the function, which was arranged when +@code{make_function} (see below) was called to create an Emacs +function from @code{module_func}. + +Module functions use the type @code{emacs_value} to communicate Lisp +objects between Emacs and the module (@pxref{Module Values}). The +@acronym{API}, described below and in the following subsections, +provides facilities for conversion between basic C data types and the +corresponding @code{emacs_value} objects. + +A module function always returns a value. If the function returns +normally, the Lisp code which called it will see the Lisp object +corresponding to the @code{emacs_value} value the function returned. +However, if the user typed @kbd{C-g}, or if the module function or its +callees signaled an error or exited nonlocally (@pxref{Module +Nonlocal}), Emacs will ignore the returned value and quit or throw as +it does when Lisp code encounters the same situations. +@end deftypefn + +After writing your C code for a module function, you should make a +Lisp function object from it using @code{make_function}. This is +normally done in the module initialization function (@pxref{module +initialization function}), after verifying the @acronym{API} +compatibility, and uses the pointer to @code{make_function} provided +in the environment (recall that the pointer to the environment is +returned by @code{get_environment}). + +@deftypefn Function emacs_value make_function (emacs_env *@var{env}, ptrdiff_t @var{min_arity}, ptrdiff_t @var{max_arity}, subr @var{func}, const char *@var{docstring}, void *@var{data}) +@vindex emacs_variadic_function +This returns an Emacs function created from the C function @var{func}, +whose signature is as described for @code{module_func} above (assumed +here to be @code{typedef}'ed as @code{subr}). The arguments +@var{min_arity} and @var{max_arity} specify the minimum and maximum +number of arguments that @var{func} can accept. The @var{max_arity} +argument can have the special value @code{emacs_variadic_function}, +which makes the function accept an unlimited number of arguments, like +the @code{&rest} keyword in Lisp (@pxref{Argument List}). + +The argument @var{data} is a way to arrange for arbitrary additional +data to be passed to @var{func} when it is called. Whatever pointer +is passed to @code{make_function} will be passed unaltered to +@var{func}. + +The argument @var{docstring} specifies the documentation string for +the function. It should be either an @acronym{ASCII} string, or a +UTF-8 encoded non-@acronym{ASCII} string, or a @code{NULL} pointer; in +the latter case the function will have no documentation. The +documentation string can end with a line that specifies the advertised +calling convention, see @ref{Function Documentation}. + +Since every module function must accept the pointer to the environment +as its first argument, the call to @code{make_function} could be made +from any module function, but you will normally want to do that from +the module initialization function, so that all the module functions +are known to Emacs once the module is loaded. +@end deftypefn + +Finally, you should bind the Lisp function to a symbol, so that Lisp +code could call your function by name. For that, use the module +@acronym{API} function @code{intern} (@pxref{intern}) whose pointer is +also provided in the environment that module functions can access. + +Combining the above steps, code that arranges for a C function +@code{module_func} to be callable as @code{module-func} from Lisp will +look like this, as part of the module initialization function: + +@example + emacs_env *env = ert->get_environment (ert); + emacs_value func = env->make_function (env, min_arity, max_arity, + module_func, docstring, data); + emacs_value symbol = env->intern (env, "module-func"); + emacs_value args[] = @{symbol, func@}; + env->funcall (env, env->intern (env, "defalias"), 2, args); +@end example + +@noindent +This makes the symbol @code{module-func} known to Emacs by calling +@code{env->intern}, then invokes @code{defalias} from Emacs to bind +the function to that symbol. Note that it is possible to use +@code{fset} instead of @code{defalias}; the differences are described +in @ref{Defining Functions, defalias}. + +Using the module @acronym{API}, it is possible to define more complex +function and data types: interactive functions, inline functions, +macros, etc. However, the resulting C code will be cumbersome and +hard to read. Therefore, we recommend that you limit the module code +which creates functions and data structures to the absolute minimum, +and leave the rest for a Lisp package that will accompany your module, +because doing these additional tasks in Lisp is much easier, and will +produce a much more readable code. For example, given a module +function @code{module-func} defined as above, one way of making an +interactive command @code{module-cmd} based on it is with the +following simple Lisp wrapper: + +@lisp +(defun module-cmd (&rest args) + "Documentation string for the command." + (interactive @var{spec}) + (apply 'module-func args)) +@end lisp + +The Lisp package which goes with your module could then load the +module using the @code{module-load} primitive (@pxref{Dynamic +Modules}) when the package is loaded into Emacs. + +@node Module Values +@subsection Conversion Between Lisp and Module Values +@cindex module values, conversion + +@cindex @code{emacs_value} data type + With very few exceptions, most modules need to exchange data with +Lisp programs that call them: accept arguments to module functions and +return values from module functions. For this purpose, the module +@acronym{API} provides the @code{emacs_value} type, which represents +Emacs Lisp objects communicated via the @acronym{API}; it is the +functional equivalent of the @code{Lisp_Object} type used in Emacs C +primitives (@pxref{Writing Emacs Primitives}). This section describes +the parts of the module @acronym{API} that allow to create +@code{emacs_value} objects corresponding to basic Lisp data types, and +how to access from C data in @code{emacs_value} objects that +correspond to Lisp objects. + +All of the functions described below are actually @emph{function +pointers} provided via the pointer to the environment which every +module function accepts. Therefore, module code should call these +functions through the environment pointer, like this: + +@example +emacs_env *env; /* the environment pointer */ +env->some_function (arguments@dots{}); +@end example + +@noindent +The @code{emacs_env} pointer will usually come from the first argument +to the module function, or from the call to @code{get_environment} if +you need the environment in the module initialization function. + +Most of the functions described below became available in Emacs 25, +the first Emacs release that supported dynamic modules. For the few +functions that became available in later Emacs releases, we mention +the first Emacs version that supported them. + +The following @acronym{API} functions extract values of various C data +types from @code{emacs_value} objects. They all raise the +@code{wrong-type-argument} error condition (@pxref{Type Predicates}) +if the argument @code{emacs_value} object is not of the type expected +by the function. @xref{Module Nonlocal}, for details of how signaling +errors works in Emacs modules, and how to catch error conditions +inside the module before they are reported to Emacs. The +@acronym{API} function @code{type_of} (@pxref{Module Misc, type_of}) +can be used to obtain the type of a @code{emacs_value} object. + +@deftypefn Function intmax_t extract_integer (emacs_env *@var{env}, emacs_value @var{arg}) +This function returns the value of a Lisp integer specified by +@var{arg}. The C data type of the return value, @code{intmax_t}, is +the widest integral data type supported by the C compiler, typically +@w{@code{long long}}. +@end deftypefn + +@deftypefn Function double extract_float (emacs_env *@var{env}, emacs_value @var{arg}) +This function returns the value of a Lisp float specified by +@var{arg}, as a C @code{double} value. +@end deftypefn + +@deftypefn Function bool copy_string_contents (emacs_env *@var{env}, emacs_value @var{arg}, char *@var{buf}, ptrdiff_t *@var{len}) +This function stores the UTF-8 encoded text of a Lisp string specified +by @var{arg} in the array of @code{char} pointed by @var{buf}, which +should have enough space to hold at least @code{*@var{len}} bytes, +including the terminating null byte. The argument @var{len} must not +be a @code{NULL} pointer, and, when the function is called, it should +point to a value that specifies the size of @var{buf} in bytes. + +If the buffer size specified by @code{*@var{len}} is large enough to +hold the string's text, the function stores in @code{*@var{len}} the +actual number of bytes copied to @var{buf}, including the terminating +null byte, and returns @code{true}. If the buffer is too small, the +function raises the @code{args-out-of-range} error condition, stores +the required number of bytes in @code{*@var{len}}, and returns +@code{false}. @xref{Module Nonlocal}, for how to handle pending error +conditions. + +The argument @var{buf} can be a @code{NULL} pointer, in which case the +function stores in @code{*@var{len}} the number of bytes required for +storing the contents of @var{arg}, and returns @code{true}. This is +how you can determine the size of @var{buf} needed to store a +particular string: first call @code{copy_string_contents} with +@code{NULL} as @var{buf}, then allocate enough memory to hold the +number of bytes stored by the function in @code{*@var{len}}, and call +the function again with non-@code{NULL} @var{buf} to actually perform +the text copying. +@end deftypefn + +@deftypefn Function emacs_value vec_get (emacs_env *@var{env}, emacs_value @var{vector}, ptrdiff_t @var{index}) +This function returns the element of @var{vector} at @var{index}. The +@var{index} of the first vector element is zero. The function raises +the @code{args-out-of-range} error condition if the value of +@var{index} is invalid. To extract C data from the value the function +returns, use the other extraction functions described here, as +appropriate for the Lisp data type stored in that element of the +vector. +@end deftypefn + +@deftypefn Function ptrdiff_t vec_size (emacs_env *@var{env}, emacs_value @var{vector}) +This function returns the number of elements in @var{vector}. +@end deftypefn + +@deftypefn Function void vec_set (emacs_env *@var{env}, emacs_value @var{vector}, ptrdiff_t @var{index}, emacs_value @var{value}) +This function stores @var{value} in the element of @var{vector} whose +index is @var{index}. It raises the @code{args-out-of-range} error +condition if the value of @var{index} is invalid. +@end deftypefn + +The following @acronym{API} functions create @code{emacs_value} +objects from basic C data types. They all return the created +@code{emacs_value} object. + +@deftypefn Function emacs_value make_integer (emacs_env *@var{env}, intmax_t @var{n}) +This function takes an integer argument @var{n} and returns the +corresponding @code{emacs_value} object. It raises the +@code{overflow-error} error condition if the value of @var{n} cannot +be represented as an Emacs integer, i.e.@: is not inside the limits +set by @code{most-negative-fixnum} and @code{most-positive-fixnum} +(@pxref{Integer Basics}). +@end deftypefn + +@deftypefn Function emacs_value make_float (emacs_env *@var{env}, double @var{d}) +This function takes a @code{double} argument @var{d} and returns the +corresponding Emacs floating-point value. +@end deftypefn + +@deftypefn Function emacs_value make_string (emacs_env *@var{env}, const char *@var{str}, ptrdiff_t @var{strlen}) +This function creates an Emacs string from C text string pointed by +@var{str} whose length in bytes, not including the terminating null +byte, is @var{strlen}. The original string in @var{str} can be either +an @acronym{ASCII} string or a UTF-8 encoded non-@acronym{ASCII} +string; it can include embedded null bytes, and doesn't have to end in +a terminating null byte at @code{@var{str}[@var{strlen}]}. The +function raises the @code{overflow-error} error condition if +@var{strlen} is negative or exceeds the maximum length of an Emacs +string. +@end deftypefn + +The @acronym{API} does not provide functions to manipulate Lisp data +structures, for example, create lists with @code{cons} and @code{list} +(@pxref{Building Lists}), extract list members with @code{car} and +@code{cdr} (@pxref{List Elements}), create vectors with @code{vector} +(@pxref{Vector Functions}), etc. For these, use @code{intern} and +@code{funcall}, described in the next subsection, to call the +corresponding Lisp functions. + +Normally, @code{emacs_value} objects have a rather short lifetime: it +ends when the @code{emacs_env} pointer used for their creation goes +out of scope. Occasionally, you may need to create @dfn{global +references}: @code{emacs_value} objects that live as long as you +wish. Use the following two functions to manage such objects. + +@deftypefn Function emacs_value make_global_ref (emacs_env *@var{env}, emacs_value @var{value}) +This function returns a global reference for @var{value}. +@end deftypefn + +@deftypefn Function void free_global_ref (emacs_env *@var{env}, emacs_value @var{global_value}) +This function frees the @var{global_value} previously created by +@code{make_global_ref}. The @var{global_value} is no longer valid +after the call. Your module code should pair each call to +@code{make_global_ref} with the corresponding @code{free_global_ref}. +@end deftypefn + +@cindex user pointer, using in module functions +An alternative to keeping around C data structures that need to be +passed to module functions later is to create @dfn{user pointer} +objects. A user pointer, or @code{user-ptr}, object is a Lisp object +that encapsulates a C pointer and can have an associated finalizer +function, which is called when the object is garbage-collected +(@pxref{Garbage Collection}). The module @acronym{API} provides +functions to create and access @code{user-ptr} objects. These +functions raise the @code{wrong-type-argument} error condition if they +are called on @code{emacs_value} that doesn't represent a +@code{user-ptr} object. + +@deftypefn Function emacs_value make_user_ptr (emacs_env *@var{env}, emacs_finalizer @var{fin}, void *@var{ptr}) +This function creates and returns a @code{user-ptr} object which wraps +the C pointer @var{ptr}. The finalizer function @var{fin} can be a +@code{NULL} pointer (meaning no finalizer), or it can be a function of +the following signature: + +@example +typedef void (*emacs_finalizer) (void *@var{ptr}); +@end example + +@noindent +If @var{fin} is not a @code{NULL} pointer, it will be called with the +@var{ptr} as the argument when the @code{user-ptr} object is +garbage-collected. Don't run any expensive code in a finalizer, +because GC must finish quickly to keep Emacs responsive. +@end deftypefn + +@deftypefn Function void *get_user_ptr (emacs_env *@var{env}, emacs_value val) +This function extracts the C pointer from the Lisp object represented +by @var{val}. +@end deftypefn + +@deftypefn Function void set_user_ptr (emacs_env *@var{env}, emacs_value @var{value}, void *@var{ptr}) +This function sets the C pointer embedded in the @code{user-ptr} +object represented by @var{value} to @var{ptr}. +@end deftypefn + +@deftypefn Function emacs_finalizer get_user_finalizer (emacs_env *@var{env}, emacs_value val) +This function returns the finalizer of the @code{user-ptr} object +represented by @var{val}, or @code{NULL} if it doesn't have a finalizer. +@end deftypefn + +@deftypefn Function void set_user_finalizer (emacs_env *@var{env}, emacs_value @var{val}, emacs_finalizer @var{fin}) +This function changes the finalizer of the @code{user-ptr} object +represented by @var{val} to be @var{fin}. If @var{fin} is a +@code{NULL} pointer, the @code{user-ptr} object will have no finalizer. +@end deftypefn + +@node Module Misc +@subsection Miscellaneous Convenience Functions for Modules + + This subsection describes a few convenience functions provided by +the module @acronym{API}. Like the functions described in previous +subsections, all of them are actually function pointers, and need to +be called via the @code{emacs_env} pointer. Description of functions +that were introduced after Emacs 25 calls out the first version where +they became available. + +@deftypefn Function bool eq (emacs_env *@var{env}, emacs_value @var{val1}, emacs_value @var{val2}) +This function returns @code{true} if the Lisp objects represented by +@var{val1} and @var{val2} are identical, @code{false} otherwise. This +is the same as the Lisp function @code{eq} (@pxref{Equality +Predicates}), but avoids the need to intern the objects represented by +the arguments. + +There are no @acronym{API} functions for other equality predicates, so +you will need to use @code{intern} and @code{funcall}, described +below, to perform more complex equality tests. +@end deftypefn + +@deftypefn Function bool is_not_nil (emacs_env *@var{env}, emacs_value @var{val}) +This function tests whether the Lisp object represented by @var{val} +is non-@code{nil}; it returns @code{true} or @code{false} accordingly. + +Note that you could implement an equivalent test by using +@code{intern} to get an @code{emacs_value} representing @code{nil}, +then use @code{eq}, described above, to test for equality. But using +this function is more convenient. +@end deftypefn + +@deftypefn Function emacs_value type_of (emacs_env *@var{env}, emacs_value @code{object}) +This function returns the type of @var{object} as a value that +represents a symbol: @code{string} for a string, @code{integer} for an +integer, @code{process} for a process, etc. @xref{Type Predicates}. +You can use @code{intern} and @code{eq} to compare against known type +symbols, if your code needs to depend on the object type. +@end deftypefn + +@anchor{intern} +@deftypefn Function emacs_value intern (emacs_env *@var{env}, const char *name) +This function returns an interned Emacs symbol whose name is +@var{name}, which should be an @acronym{ASCII} null-terminated string. +It creates a new symbol if one does not already exist. + +Together with @code{funcall}, described below, this function provides +a means for invoking any Lisp-callable Emacs function, provided that +its name is a pure @acronym{ASCII} string. For example, here's how to +intern a symbol whose name @code{name_str} is non-@acronym{ASCII}, by +calling the more powerful Emacs @code{intern} function +(@pxref{Creating Symbols}): + +@example +emacs_value fintern = env->intern (env, "intern"); +emacs_value sym_name = + env->make_string (env, name_str, strlen (name_str)); +emacs_value intern_args[] = @{ sym_name, env->intern (env, "nil") @}; +emacs_value symbol = env->funcall (env, fintern, 2, intern_args); +@end example + +@end deftypefn + +@deftypefn Function emacs_value funcall (emacs_env *@var{env}, emacs_value @var{func}, ptrdiff_t @var{nargs}, emacs_value *@var{args}) +This function calls the specified @var{func} passing it @var{nargs} +arguments from the array pointed to by @var{args}. The argument +@var{func} can be a function symbol (e.g., returned by @code{intern} +described above), a module function returned by @code{make_function} +(@pxref{Module Functions}), a subroutine written in C, etc. If +@var{nargs} is zero, @var{args} can be a @code{NULL} pointer. + +The function returns the value that @var{func} returned. +@end deftypefn + +If your module includes potentially long-running code, it is a good +idea to check from time to time in that code whether the user wants to +quit, e.g., by typing @kbd{C-g} (@pxref{Quitting}). The following +function, which is available since Emacs 26.1, is provided for that +purpose. + +@anchor{should_quit} +@deftypefn Function bool should_quit (emacs_env *@var{env}) +This function returns @code{true} if the user wants to quit. In that +case, we recommend that your module function aborts any on-going +processing and returns as soon as possible. +@end deftypefn + +@node Module Nonlocal +@subsection Nonlocal Exits in Modules +@cindex nonlocal exits, in modules + + Emacs Lisp supports nonlocal exits, whereby program control is +transfered from one point in a program to another remote point. +@xref{Nonlocal Exits}. Thus, Lisp functions called by your module +might exit nonlocally by calling @code{signal} or @code{throw}, and +your module functions must handle such nonlocal exits properly. Such +handling is needed because C programs will not automatically release +resources and perform other cleanups in these cases; your module code +must itself do it. The module @acronym{API} provides facilities for +that, described in this subsection. They are generally available +since Emacs 25; those of them that became available in later releases +explicitly call out the first Emacs version where they became part of +the @acronym{API}. + +When some Lisp code called by a module function signals an error or +throws, the nonlocal exit is trapped, and the pending exit and its +associated data are stored in the environment. Whenever a nonlocal +exit is pending in the environment, any module @acronym{API} function +called with a pointer to that environment will return immediately +without any processing (the functions @code{non_local_exit_check}, +@code{non_local_exit_get}, and @code{non_local_exit_clear} are +exceptions from this rule). If your module function then does nothing +and returns to Emacs, a pending nonlocal exit will cause Emacs to act +on it: signal an error or throw to the corresponding @code{catch}. + +So the simplest ``handling'' of nonlocal exits in module functions is +to do nothing special and let the rest of your code to run as if +nothing happened. However, this can cause two classes of problems: + +@itemize @minus +@item +Your module function might use uninitialized or undefined values, +since @acronym{API} functions return immediately without producing the +expected results. + +@item +Your module might leak resources, because it might not have the +opportunity to release them. +@end itemize + +Therefore, we recommend that your module functions check for nonlocal +exit conditions and recover from them, using the functions described +below. + +@deftypefn Function enum emacs_funcall_exit non_local_exit_check (emacs_env *@var{env}) +This function returns the kind of nonlocal exit condition stored in +@var{env}. The possible values are: + +@vindex emacs_funcall_exit@r{, enumeration} +@vtable @code +@item emacs_funcall_exit_return +The last @acronym{API} function exited normally. +@item emacs_funcall_exit_signal +The last @acronym{API} function signaled an error. +@item emacs_funcall_exit_throw +The last @acronym{API} function exited via @code{throw}. +@end vtable +@end deftypefn + +@deftypefn Function emacs_funcall_exit non_local_exit_get (emacs_env *@var{env}, emacs_value *@var{symbol}, emacs_value *@var{data}) +This function returns the kind of nonlocal exit condition stored in +@var{env}, like @code{non_local_exit_check} does, but it also returns +the full information about the nonlocal exit, if any. If the return +value is @code{emacs_funcall_exit_signal}, the function stores the +error symbol in @code{*@var{symbol}} and the error data in +@code{*@var{data}} (@pxref{Signaling Errors}). If the return value is +@code{emacs_funcall_exit_throw}, the function stores the @code{catch} +tag symbol in @code{*@var{symbol}} and the @code{throw} value in +@code{*@var{data}}. The function doesn't store anything in memory +pointed by these arguments when the return value is +@code{emacs_funcall_exit_return}. +@end deftypefn + +You should check nonlocal exit conditions where it matters: before you +allocated some resource or after you allocated a resource that might +need freeing, or where a failure means further processing is +impossible or infeasible. + +Once your module function detected that a nonlocal exit is pending, it +can either return to Emacs (after performing the necessary local +cleanup), or it can attempt to recover from the nonlocal exit. The +following @acronym{API} functions will help with these tasks. + +@deftypefn Function void non_local_exit_clear (emacs_env *@var{env}) +This function clears the pending nonlocal exit conditions and data +from @var{env}. After calling it, the module @acronym{API} functions +will work normally. Use this function if your module function can +recover from nonlocal exits of the Lisp functions it calls and +continue, and also before calling any of the following two functions +(or any other @acronym{API} functions, if you want them to perform +their intended processing when a nonlocal exit is pending). +@end deftypefn + +@deftypefn Function void non_local_exit_throw (emacs_env *@var{env}, emacs_value @var{tag}, emacs_value @var{value}) +This function throws to the Lisp @code{catch} symbol represented by +@var{tag}, passing it @var{value} as the value to return. Your module +function should in general return soon after calling this function. +One use of this function is when you want to re-throw a non-local exit +from one of the called @acronym{API} or Lisp functions. +@end deftypefn + +@deftypefn Function void non_local_exit_signal (emacs_env *@var{env}, emacs_value @var{error}, emacs_value @var{data}) +This function signals the error represented by @var{error} with the +specified error data @var{data}. The module function should return +soon after calling this function. This function could be useful, +e.g., for signaling errors from module functions to Emacs. +@end deftypefn + + @node Object Internals @section Object Internals @cindex object internals diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi index 80b75729c1..cbb2f701ed 100644 --- a/doc/lispref/loading.texi +++ b/doc/lispref/loading.texi @@ -1139,8 +1139,6 @@ Features}). @section Emacs Dynamic Modules @cindex dynamic modules -@c FIXME: This is intentionally incomplete, as the module integration -@c is not yet finished. To be refined later. A @dfn{dynamic Emacs module} is a shared library that provides additional functionality for use in Emacs Lisp programs, just like a package written in Emacs Lisp would. @@ -1162,30 +1160,43 @@ Every dynamic module should export a C-callable function named @code{load} or @code{require} which loads the module. It should also export a symbol named @code{plugin_is_GPL_compatible} to indicate that its code is released under the GPL or compatible license; Emacs will -refuse to load modules that don't export such a symbol. +signal an error if your program tries to load modules that don't +export such a symbol. If a module needs to call Emacs functions, it should do so through the -API defined and documented in the header file @file{emacs-module.h} -that is part of the Emacs distribution. +@acronym{API} (Application Programming Interface) defined and +documented in the header file @file{emacs-module.h} that is part of +the Emacs distribution. @xref{Writing Dynamic Modules}, for details +of using that API when writing your own modules. @cindex user-ptr object +@cindex user pointer object Modules can create @code{user-ptr} Lisp objects that embed pointers to C struct's defined by the module. This is useful for keeping around complex data structures created by a module, to be passed back to the module's functions. User-ptr objects can also have associated @dfn{finalizers} -- functions to be run when the object is GC'ed; this is useful for freeing any resources allocated for the underlying data -structure, such as memory, open file descriptors, etc. +structure, such as memory, open file descriptors, etc. @xref{Module +Values}. @defun user-ptrp object This function returns @code{t} if its argument is a @code{user-ptr} object. @end defun +@defun module-load file +Emacs calls this low-level primitive to load a module from the +specified @var{file} and perform the necessary initialization of the +module. This is the primitive which makes sure the module exports the +@code{plugin_is_GPL_compatible} symbol, calls the module's +@code{emacs_module_init} function, and signals an error if that +function returns an error indication, or if the use typed @kbd{C-g} +during the initialization. If the initialization succeeds, +@code{module-load} returns @code{t}. Note that @var{file} must +already have the proper file-name extension, as this function doesn't +try looking for files with known extensions, unlike @code{load}. +@end defun + Loadable modules in Emacs are enabled by using the @kbd{--with-modules} option at configure time. - -If you write your own dynamic modules, you may wish to verify their -conformance to the Emacs dynamic module API. Invoking Emacs with the -@kbd{--module-assertions} option will help you in this matter. -@xref{Initial Options,,,emacs, The GNU Emacs Manual}. commit a7ebc6bf633bd3849ccab032dad6b1fd31b1ef43 Author: Tino Calancha Date: Thu Oct 11 17:23:30 2018 +0900 dired-do-shell-command: Notify users after abort the command * lisp/dired-aux.el (dired-do-shell-command): Notify users that the command have aborted when they answer 'n' to the prompt (Bug#32969). diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 516cd2c567..e40627309d 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -757,16 +757,17 @@ can be produced by `dired-get-marked-files', for example." (y-or-n-p (format-message "Confirm--do you mean to use `?' as a wildcard? "))) (t)))) - (when ok - (if on-each - (dired-bunch-files (- 10000 (length command)) - (lambda (&rest files) - (dired-run-shell-command - (dired-shell-stuff-it command files t arg))) - nil file-list) - ;; execute the shell command - (dired-run-shell-command - (dired-shell-stuff-it command file-list nil arg))))))) + (cond ((not ok) (message "Command canceled")) + (t + (if on-each + (dired-bunch-files (- 10000 (length command)) + (lambda (&rest files) + (dired-run-shell-command + (dired-shell-stuff-it command files t arg))) + nil file-list) + ;; execute the shell command + (dired-run-shell-command + (dired-shell-stuff-it command file-list nil arg)))))))) ;; Might use {,} for bash or csh: (defvar dired-mark-prefix "" commit 0d2bf76d3d8a9d05e3b9ff4228608aa446352e7e Author: Michael Albinus Date: Thu Oct 11 09:39:12 2018 +0200 Adapt Tramp version. Do not merge with master * lisp/net/trampver.el: Change version to "2.3.5.26.2". (customize-package-emacs-version-alist): Add Tramp version integrated in Emacs 26.2. diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 6454b5b8f8..7badcd19f8 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -7,7 +7,7 @@ ;; Maintainer: Michael Albinus ;; Keywords: comm, processes ;; Package: tramp -;; Version: 2.3.4.26.2 +;; Version: 2.3.5.26.2 ;; This file is part of GNU Emacs. @@ -33,7 +33,7 @@ ;; should be changed only there. ;;;###tramp-autoload -(defconst tramp-version "2.3.4.26.2" +(defconst tramp-version "2.3.5.26.2" "This version of Tramp.") ;;;###tramp-autoload @@ -55,7 +55,7 @@ ;; Check for Emacs version. (let ((x (if (>= emacs-major-version 24) "ok" - (format "Tramp 2.3.4.26.2 is not fit for %s" + (format "Tramp 2.3.5.26.2 is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version))))))) (unless (string-match "\\`ok\\'" x) (error "%s" x))) @@ -70,7 +70,7 @@ ("2.2.9-24.4" . "24.4") ("2.2.11-24.5" . "24.5") ("2.2.13.25.1" . "25.1") ("2.2.13.25.2" . "25.2") ("2.2.13.25.2" . "25.3") - ("2.3.3.26.1" . "26.1") ("2.3.4.26.2" . "26.2"))) + ("2.3.3.26.1" . "26.1") ("2.3.5.26.2" . "26.2"))) (add-hook 'tramp-unload-hook (lambda () commit 5bd8cfc14d4b0c78c07e65a583f42a10c4cbc06d Author: Paul Eggert Date: Wed Oct 10 23:17:18 2018 -0700 Fix mishandling of symbols that look like numbers * src/bignum.c (make_neg_biguint): New function. * src/lread.c (read1): Do not mishandle an unquoted symbol with name equal to something like "1\0x", i.e., a string of numeric form followed by a NUL byte. Formerly these symbols were misread as numbers. (string_to_number): Change last argument from an integer flag to a pointer to the length. This lets the caller figure out how much of the prefix was used. All callers changed. Add a fast path if the integer (sans sign) fits in uintmax_t. Update comments and simplify now that bignums are present. * src/print.c (print_object): Fix quoting of symbols that look like numbers, by relying on string_to_number for the tricky cases rather than trying to redo its logic, incorrectly. For example, (read (prin1-to-string '\1e+NaN)) formerly returned "1e+NaN", which was wrong: a backslash is needed in the output to prevent it from being read as a NaN. Escape NO_BREAK_SPACE too, since lread.c treats it like SPACE. * test/src/print-tests.el (print-read-roundtrip): Add tests illustrating the abovementioned bugs. diff --git a/src/bignum.c b/src/bignum.c index 0ab8de3ab7..e3db0377a5 100644 --- a/src/bignum.c +++ b/src/bignum.c @@ -117,6 +117,16 @@ make_biguint (uintmax_t n) return make_bignum (); } +/* Return a Lisp integer equal to -N, which must not be in fixnum range. */ +Lisp_Object +make_neg_biguint (uintmax_t n) +{ + eassert (-MOST_NEGATIVE_FIXNUM < n); + mpz_set_uintmax (mpz[0], n); + mpz_neg (mpz[0], mpz[0]); + return make_bignum (); +} + /* Return a Lisp integer with value taken from mpz[0]. Set mpz[0] to a junk value. */ Lisp_Object diff --git a/src/data.c b/src/data.c index 5f1d059512..538081e5c9 100644 --- a/src/data.c +++ b/src/data.c @@ -2796,7 +2796,7 @@ If the base used is not 10, STRING is always parsed as an integer. */) while (*p == ' ' || *p == '\t') p++; - Lisp_Object val = string_to_number (p, b, S2N_IGNORE_TRAILING); + Lisp_Object val = string_to_number (p, b, 0); return NILP (val) ? make_fixnum (0) : val; } diff --git a/src/lisp.h b/src/lisp.h index 2c20b483ca..5ecc48b025 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2506,7 +2506,7 @@ INTEGERP (Lisp_Object x) return FIXNUMP (x) || BIGNUMP (x); } -/* Return a Lisp integer with value taken from n. */ +/* Return a Lisp integer with value taken from N. */ INLINE Lisp_Object make_int (intmax_t n) { @@ -3329,6 +3329,7 @@ extern ptrdiff_t bignum_bufsize (Lisp_Object, int); extern ptrdiff_t bignum_to_c_string (char *, ptrdiff_t, Lisp_Object, int); extern Lisp_Object bignum_to_string (Lisp_Object, int); extern Lisp_Object make_bignum_str (char const *, int); +extern Lisp_Object make_neg_biguint (uintmax_t); extern Lisp_Object double_to_integer (double); /* Converthe integer NUM to *N. Return true if successful, false @@ -3839,7 +3840,7 @@ LOADHIST_ATTACH (Lisp_Object x) extern int openp (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object *, Lisp_Object, bool); enum { S2N_IGNORE_TRAILING = 1 }; -extern Lisp_Object string_to_number (char const *, int, int); +extern Lisp_Object string_to_number (char const *, int, ptrdiff_t *); extern void map_obarray (Lisp_Object, void (*) (Lisp_Object, Lisp_Object), Lisp_Object); extern void dir_warning (const char *, Lisp_Object); diff --git a/src/lread.c b/src/lread.c index 73e38d8995..62616cb681 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2354,12 +2354,14 @@ character_name_to_code (char const *name, ptrdiff_t name_len) { /* For "U+XXXX", pass the leading '+' to string_to_number to reject monstrosities like "U+-0000". */ + ptrdiff_t len = name_len - 1; Lisp_Object code = (name[0] == 'U' && name[1] == '+' - ? string_to_number (name + 1, 16, 0) + ? string_to_number (name + 1, 16, &len) : call2 (Qchar_from_name, make_unibyte_string (name, name_len), Qt)); if (! RANGED_FIXNUMP (0, code, MAX_UNICODE_CHAR) + || len != name_len - 1 || char_surrogate_p (XFIXNUM (code))) { AUTO_STRING (format, "\\N{%s}"); @@ -3531,12 +3533,14 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) || strchr ("\"';()[]#`,", c) == NULL)); *p = 0; + ptrdiff_t nbytes = p - read_buffer; UNREAD (c); if (!quoted && !uninterned_symbol) { - Lisp_Object result = string_to_number (read_buffer, 10, 0); - if (! NILP (result)) + ptrdiff_t len; + Lisp_Object result = string_to_number (read_buffer, 10, &len); + if (! NILP (result) && len == nbytes) return unbind_to (count, result); } if (!quoted && multibyte) @@ -3548,7 +3552,6 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) } { Lisp_Object result; - ptrdiff_t nbytes = p - read_buffer; ptrdiff_t nchars = (multibyte ? multibyte_chars_in_text ((unsigned char *) read_buffer, @@ -3700,18 +3703,18 @@ substitute_in_interval (INTERVAL interval, void *arg) } -/* Convert STRING to a number, assuming base BASE. When STRING has - floating point syntax and BASE is 10, return a nearest float. When - STRING has integer syntax, return a fixnum if the integer fits, or - else a bignum. Otherwise, return nil. If FLAGS & - S2N_IGNORE_TRAILING is nonzero, consider just the longest prefix of - STRING that has valid syntax. */ +/* Convert the initial prefix of STRING to a number, assuming base BASE. + If the prefix has floating point syntax and BASE is 10, return a + nearest float; otherwise, if the prefix has integer syntax, return + the integer; otherwise, return nil. If PLEN, set *PLEN to the + length of the numeric prefix if there is one, otherwise *PLEN is + unspecified. */ Lisp_Object -string_to_number (char const *string, int base, int flags) +string_to_number (char const *string, int base, ptrdiff_t *plen) { char const *cp = string; - bool float_syntax = 0; + bool float_syntax = false; double value = 0; /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on @@ -3797,49 +3800,46 @@ string_to_number (char const *string, int base, int flags) || (state & ~INTOVERFLOW) == (LEAD_INT|E_EXP)); } - /* Return nil if the number uses invalid syntax. If FLAGS & - S2N_IGNORE_TRAILING, accept any prefix that matches. Otherwise, - the entire string must match. */ - if (! (flags & S2N_IGNORE_TRAILING - ? ((state & LEAD_INT) != 0 || float_syntax) - : (!*cp && ((state & ~(INTOVERFLOW | DOT_CHAR)) == LEAD_INT - || float_syntax)))) - return Qnil; + if (plen) + *plen = cp - string; - /* If the number uses integer and not float syntax, and is in C-language - range, use its value, preferably as a fixnum. */ - if (leading_digit >= 0 && ! float_syntax) + /* Return a float if the number uses float syntax. */ + if (float_syntax) { - if ((state & INTOVERFLOW) == 0 - && n <= (negative ? -MOST_NEGATIVE_FIXNUM : MOST_POSITIVE_FIXNUM)) - { - EMACS_INT signed_n = n; - return make_fixnum (negative ? -signed_n : signed_n); - } - - /* Trim any leading "+" and trailing nondigits, then convert to - bignum. */ - string += positive; - if (!*after_digits) - return make_bignum_str (string, base); - ptrdiff_t trimmed_len = after_digits - string; - USE_SAFE_ALLOCA; - char *trimmed = SAFE_ALLOCA (trimmed_len + 1); - memcpy (trimmed, string, trimmed_len); - trimmed[trimmed_len] = '\0'; - Lisp_Object result = make_bignum_str (trimmed, base); - SAFE_FREE (); - return result; + /* Convert to floating point, unless the value is already known + because it is infinite or a NaN. */ + if (! value) + value = atof (string + signedp); + return make_float (negative ? -value : value); } - /* Either the number uses float syntax, or it does not fit into a fixnum. - Convert it from string to floating point, unless the value is already - known because it is an infinity, a NAN, or its absolute value fits in - uintmax_t. */ - if (! value) - value = atof (string + signedp); + /* Return nil if the number uses invalid syntax. */ + if (! (state & LEAD_INT)) + return Qnil; + + /* Fast path if the integer (san sign) fits in uintmax_t. */ + if (! (state & INTOVERFLOW)) + { + if (!negative) + return make_uint (n); + if (-MOST_NEGATIVE_FIXNUM < n) + return make_neg_biguint (n); + EMACS_INT signed_n = n; + return make_fixnum (-signed_n); + } - return make_float (negative ? -value : value); + /* Trim any leading "+" and trailing nondigits, then return a bignum. */ + string += positive; + if (!*after_digits) + return make_bignum_str (string, base); + ptrdiff_t trimmed_len = after_digits - string; + USE_SAFE_ALLOCA; + char *trimmed = SAFE_ALLOCA (trimmed_len + 1); + memcpy (trimmed, string, trimmed_len); + trimmed[trimmed_len] = '\0'; + Lisp_Object result = make_bignum_str (trimmed, base); + SAFE_FREE (); + return result; } diff --git a/src/print.c b/src/print.c index c0c90bc7e9..d15ff97b00 100644 --- a/src/print.c +++ b/src/print.c @@ -1993,39 +1993,17 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) case Lisp_Symbol: { - bool confusing; - unsigned char *p = SDATA (SYMBOL_NAME (obj)); - unsigned char *end = p + SBYTES (SYMBOL_NAME (obj)); - int c; - ptrdiff_t i, i_byte; - ptrdiff_t size_byte; - Lisp_Object name; - - name = SYMBOL_NAME (obj); - - if (p != end && (*p == '-' || *p == '+')) p++; - if (p == end) - confusing = 0; - /* If symbol name begins with a digit, and ends with a digit, - and contains nothing but digits and `e', it could be treated - as a number. So set CONFUSING. - - Symbols that contain periods could also be taken as numbers, - but periods are always escaped, so we don't have to worry - about them here. */ - else if (*p >= '0' && *p <= '9' - && end[-1] >= '0' && end[-1] <= '9') - { - while (p != end && ((*p >= '0' && *p <= '9') - /* Needed for \2e10. */ - || *p == 'e' || *p == 'E')) - p++; - confusing = (end == p); - } - else - confusing = 0; - - size_byte = SBYTES (name); + Lisp_Object name = SYMBOL_NAME (obj); + ptrdiff_t size_byte = SBYTES (name); + + /* Set CONFUSING if NAME looks like a number, calling + string_to_number for non-obvious cases. */ + char *p = SSDATA (name); + bool signedp = *p == '-' || *p == '+'; + ptrdiff_t len; + bool confusing = ((c_isdigit (p[signedp]) || p[signedp] == '.') + && !NILP (string_to_number (p, 10, &len)) + && len == size_byte); if (! NILP (Vprint_gensym) && !SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (obj)) @@ -2036,10 +2014,12 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) break; } - for (i = 0, i_byte = 0; i_byte < size_byte;) + ptrdiff_t i = 0; + for (ptrdiff_t i_byte = 0; i_byte < size_byte; ) { /* Here, we must convert each multi-byte form to the corresponding character code before handing it to PRINTCHAR. */ + int c; FETCH_STRING_CHAR_ADVANCE (c, name, i, i_byte); maybe_quit (); @@ -2049,6 +2029,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) || c == ';' || c == '#' || c == '(' || c == ')' || c == ',' || c == '.' || c == '`' || c == '[' || c == ']' || c == '?' || c <= 040 + || c == NO_BREAK_SPACE || confusing || (i == 1 && confusable_symbol_character_p (c))) { diff --git a/src/process.c b/src/process.c index a9638dfc2d..6cda4f27ac 100644 --- a/src/process.c +++ b/src/process.c @@ -6852,7 +6852,12 @@ SIGCODE may be an integer, or a symbol whose name is a signal name. */) { Lisp_Object tem = Fget_process (process); if (NILP (tem)) - tem = string_to_number (SSDATA (process), 10, 0); + { + ptrdiff_t len; + tem = string_to_number (SSDATA (process), 10, &len); + if (NILP (tem) || len != SBYTES (process)) + return Qnil; + } process = tem; } else if (!NUMBERP (process)) diff --git a/test/src/print-tests.el b/test/src/print-tests.el index 091f1aa1af..78e769f50e 100644 --- a/test/src/print-tests.el +++ b/test/src/print-tests.el @@ -95,8 +95,20 @@ otherwise, use a different charset." "--------\n")))) (ert-deftest print-read-roundtrip () - (let ((sym '\’bar)) - (should (eq (read (prin1-to-string sym)) sym)))) + (let ((syms (list '## '& '* '+ '- '/ '0E '0e '< '= '> 'E 'E0 'NaN '\" + '\# '\#x0 '\' '\'\' '\( '\) '\+00 '\, '\-0 '\. '\.0 + '\0 '\0.0 '\0E0 '\0e0 '\1E+ '\1E+NaN '\1e+ '\1e+NaN + '\; '\? '\[ '\\ '\] '\` '_ 'a 'e 'e0 'x + '{ '| '} '~ : '\’ '\’bar + (intern "\t") (intern "\n") (intern " ") + (intern "\N{NO-BREAK SPACE}") + (intern "\N{ZERO WIDTH SPACE}") + (intern "\0")))) + (dolist (sym syms) + (should (eq (read (prin1-to-string sym)) sym)) + (dolist (sym1 syms) + (let ((sym2 (intern (concat (symbol-name sym) (symbol-name sym1))))) + (should (eq (read (prin1-to-string sym2)) sym2))))))) (ert-deftest print-bignum () (let* ((str "999999999999999999999999999999999") commit 6e54762c3726be9e11b4beb21214abcd4192783a Author: Alan Third Date: Sun Oct 7 16:15:17 2018 +0100 Fix Apple Script permissions error * nextstep/templates/Info.plist.in: Add NSAppleEventsUsageDescription message to enable AppleEvents usage. diff --git a/nextstep/templates/Info.plist.in b/nextstep/templates/Info.plist.in index 9960f085f6..406d6f7731 100644 --- a/nextstep/templates/Info.plist.in +++ b/nextstep/templates/Info.plist.in @@ -675,5 +675,7 @@ along with GNU Emacs. If not, see . NSAppleScriptEnabled YES + NSAppleEventsUsageDescription + Emacs requires permission to send AppleEvents to other applications. commit fd3a48fcd8bb212ec12b9b10a79de0ae605ee93b Author: Stefan Monnier Date: Wed Oct 10 09:45:09 2018 -0400 * lisp/auth-source.el: Minor simplification Remove redundant :group args. (auth-source-backend-parse): Use run-hook-with-args-until-success. diff --git a/lisp/auth-source.el b/lisp/auth-source.el index eb262a13df..fd529b392a 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -83,7 +83,6 @@ expiring. Overrides `password-cache-expiry' through a let-binding." :version "24.1" - :group 'auth-source :type '(choice (const :tag "Never" nil) (const :tag "All Day" 86400) (const :tag "2 Hours" 7200) @@ -139,7 +138,6 @@ let-binding." (smtp "smtp" "25")) "List of authentication protocols and their names" - :group 'auth-source :version "23.2" ;; No Gnus :type '(repeat :tag "Authentication Protocols" (cons :tag "Protocol Entry" @@ -168,7 +166,6 @@ let-binding." (defcustom auth-source-save-behavior 'ask "If set, auth-source will respect it for save behavior." - :group 'auth-source :version "23.2" ;; No Gnus :type `(choice :tag "auth-source new token save behavior" @@ -183,7 +180,6 @@ let-binding." "Set this to tell auth-source when to create GPG password tokens in netrc files. It's either an alist or `never'. Note that if EPA/EPG is not available, this should NOT be used." - :group 'auth-source :version "23.2" ;; No Gnus :type `(choice (const :tag "Always use GPG password tokens" (t gpg)) @@ -203,7 +199,6 @@ Note that if EPA/EPG is not available, this should NOT be used." (defcustom auth-source-do-cache t "Whether auth-source should cache information with `password-cache'." - :group 'auth-source :version "23.2" ;; No Gnus :type `boolean) @@ -218,7 +213,6 @@ for passwords). If the value is a function, debug messages are logged by calling that function using the same arguments as `message'." - :group 'auth-source :version "23.2" ;; No Gnus :type `(choice :tag "auth-source debugging mode" @@ -241,7 +235,6 @@ for details. It's best to customize this with `\\[customize-variable]' because the choices can get pretty complex." - :group 'auth-source :version "26.1" ; neither new nor changed default :type `(repeat :tag "Authentication Sources" (choice @@ -311,7 +304,6 @@ can get pretty complex." (defcustom auth-source-gpg-encrypt-to t "List of recipient keys that `authinfo.gpg' encrypted to. If the value is not a list, symmetric encryption will be used." - :group 'auth-source :version "24.1" ;; No Gnus :type '(choice (const :tag "Symmetric encryption" t) (repeat :tag "Recipient public keys" @@ -363,10 +355,9 @@ soon as a function returns non-nil.") (defun auth-source-backend-parse (entry) "Create an auth-source-backend from an ENTRY in `auth-sources'." - (let (backend) - (cl-dolist (f auth-source-backend-parser-functions) - (when (setq backend (funcall f entry)) - (cl-return))) + (let ((backend + (run-hook-with-args-until-success 'auth-source-backend-parser-functions + entry))) (unless backend ;; none of the parsers worked @@ -416,7 +407,7 @@ soon as a function returns non-nil.") :create-function #'auth-source-netrc-create)))))) ;; Note this function should be last in the parser functions, so we add it first -(add-hook 'auth-source-backend-parser-functions 'auth-source-backends-parser-file) +(add-hook 'auth-source-backend-parser-functions #'auth-source-backends-parser-file) (defun auth-source-backends-parser-macos-keychain (entry) ;; take macos-keychain-{internet,generic}:XYZ and use it as macOS @@ -463,7 +454,7 @@ soon as a function returns non-nil.") :search-function #'auth-source-macos-keychain-search :create-function #'auth-source-macos-keychain-create))))) -(add-hook 'auth-source-backend-parser-functions 'auth-source-backends-parser-macos-keychain) +(add-hook 'auth-source-backend-parser-functions #'auth-source-backends-parser-macos-keychain) (defun auth-source-backends-parser-secrets (entry) ;; take secrets:XYZ and use it as Secrets API collection "XYZ" @@ -510,7 +501,7 @@ soon as a function returns non-nil.") :source "" :type 'ignore)))))) -(add-hook 'auth-source-backend-parser-functions 'auth-source-backends-parser-secrets) +(add-hook 'auth-source-backend-parser-functions #'auth-source-backends-parser-secrets) (defun auth-source-backend-parse-parameters (entry backend) "Fills in the extra auth-source-backend parameters of ENTRY. @@ -528,7 +519,7 @@ parameters." (oset backend port val))) backend) -;; (mapcar 'auth-source-backend-parse auth-sources) +;; (mapcar #'auth-source-backend-parse auth-sources) (cl-defun auth-source-search (&rest spec &key max require create delete @@ -2176,8 +2167,8 @@ entries for git.gnus.org: (plstore-save (oref backend data))))) ;;; Backend specific parsing: JSON backend -;;; (auth-source-search :max 1 :machine "imap.gmail.com") -;;; (auth-source-search :max 1 :host '("my-gmail" "imap.gmail.com") :port '(993 "imaps" "imap" "993" "143") :user nil :require '(:user :secret)) +;; (auth-source-search :max 1 :machine "imap.gmail.com") +;; (auth-source-search :max 1 :host '("my-gmail" "imap.gmail.com") :port '(993 "imaps" "imap" "993" "143") :user nil :require '(:user :secret)) (defun auth-source-json-check (host user port require item) (and item commit 7212bf41a92f14401751e9891c402f67b5ce6846 Author: Stefan Monnier Date: Wed Oct 10 09:20:19 2018 -0400 * lisp/emacs-lisp/lisp-mnt.el: Use lexical-binding Remove redundant :group diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el index 127d71ae6c..5c623a3ab8 100644 --- a/lisp/emacs-lisp/lisp-mnt.el +++ b/lisp/emacs-lisp/lisp-mnt.el @@ -1,4 +1,4 @@ -;;; lisp-mnt.el --- utility functions for Emacs Lisp maintainers +;;; lisp-mnt.el --- utility functions for Emacs Lisp maintainers -*- lexical-binding:t -*- ;; Copyright (C) 1992, 1994, 1997, 2000-2018 Free Software Foundation, ;; Inc. @@ -137,34 +137,28 @@ in your Lisp package: The @(#) construct is used by unix what(1) and then $identifier: doc string $ is used by GNU ident(1)" - :type 'regexp - :group 'lisp-mnt) + :type 'regexp) (defcustom lm-copyright-prefix "^\\(;+[ \t]\\)+Copyright (C) " "Prefix that is ignored before the dates in a copyright. Leading comment characters and whitespace should be in regexp group 1." - :type 'regexp - :group 'lisp-mnt) + :type 'regexp) (defcustom lm-comment-column 16 "Column used for placing formatted output." - :type 'integer - :group 'lisp-mnt) + :type 'integer) (defcustom lm-any-header ".*" "Regexp which matches start of any section." - :type 'regexp - :group 'lisp-mnt) + :type 'regexp) (defcustom lm-commentary-header "Commentary\\|Documentation" "Regexp which matches start of documentation section." - :type 'regexp - :group 'lisp-mnt) + :type 'regexp) (defcustom lm-history-header "Change ?Log\\|History" "Regexp which matches the start of code log section." - :type 'regexp - :group 'lisp-mnt) + :type 'regexp) ;;; Functions: @@ -236,26 +230,26 @@ a section." (while (forward-comment 1)) (point)))))))) -(defsubst lm-code-start () +(defun lm-code-start () "Return the buffer location of the `Code' start marker." (lm-section-start "Code")) (defalias 'lm-code-mark 'lm-code-start) -(defsubst lm-commentary-start () +(defun lm-commentary-start () "Return the buffer location of the `Commentary' start marker." (lm-section-start lm-commentary-header)) (defalias 'lm-commentary-mark 'lm-commentary-start) -(defsubst lm-commentary-end () +(defun lm-commentary-end () "Return the buffer location of the `Commentary' section end." (lm-section-end lm-commentary-header)) -(defsubst lm-history-start () +(defun lm-history-start () "Return the buffer location of the `History' start marker." (lm-section-start lm-history-header)) (defalias 'lm-history-mark 'lm-history-start) -(defsubst lm-copyright-mark () +(defun lm-copyright-mark () "Return the buffer location of the `Copyright' line." (save-excursion (let ((case-fold-search t)) @@ -385,7 +379,7 @@ Each element of the list is a cons; the car is the full name, the cdr is an email address." (lm-with-file file (let ((authorlist (lm-header-multiline "author"))) - (mapcar 'lm-crack-address authorlist)))) + (mapcar #'lm-crack-address authorlist)))) (defun lm-maintainer (&optional file) "Return the maintainer of file FILE, or current buffer if FILE is nil. @@ -453,7 +447,7 @@ each line." (lm-with-file file (let ((keywords (lm-header-multiline "keywords"))) (and keywords - (mapconcat 'downcase keywords " "))))) + (mapconcat #'downcase keywords " "))))) (defun lm-keywords-list (&optional file) "Return list of keywords given in file FILE." @@ -507,7 +501,7 @@ absent, return nil." "Insert, at column COL, list of STRINGS." (if (> (current-column) col) (insert "\n")) (move-to-column col t) - (apply 'insert strings)) + (apply #'insert strings)) (defun lm-verify (&optional file showok verbose non-fsf-ok) "Check that the current buffer (or FILE if given) is in proper format. commit 19f705c438034d10bd206c142faea83a02c8a885 Author: Mauro Aranda Date: Tue Oct 9 18:20:53 2018 -0300 Fix typo in 'timerp' documentation * doc/lispref/os.texi (Timers): Fix typo in 'timerp' documentation. (Bug#32999) Copyright-paperwork-exempt: yes diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index fd1cf638e7..e60a2c5a70 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -1766,7 +1766,7 @@ special object that stores the information about the next invocation times and the function to invoke. @defun timerp object -This predicate function returns non-@code{nil} of @code{object} is a +This predicate function returns non-@code{nil} if @code{object} is a timer. @end defun commit fe0d4594992165393ace67af914ed828e4e8da4d Merge: 8b3aacdf3a 4cf1eb8062 Author: Glenn Morris Date: Tue Oct 9 13:12:56 2018 -0700 Merge from origin/emacs-26 4cf1eb8 (origin/emacs-26) ; * src/data.c (Fkeywordp): Remove inaccura... 3f1470d * doc/emacs/mark.texi (Mark): Index "(de)activating the mark". commit 8b3aacdf3ad09de77b9bdb8bd5ddf31c4e571da9 Merge: b89b5ca648 940ae15604 Author: Glenn Morris Date: Tue Oct 9 13:12:56 2018 -0700 ; Merge from origin/emacs-26 The following commit was skipped: 940ae15 Fix overflow lockup with frames > 255 lines commit b89b5ca648015fc00db4328f5019095e0dc7b6db Merge: 641d98531e 14c032d5f8 Author: Glenn Morris Date: Tue Oct 9 13:12:56 2018 -0700 Merge from origin/emacs-26 14c032d Avoid assertion violations in nonsensical calls to 'signal' b99192f * lisp/simple.el (transient-mark-mode): Correct documentation... 7e42294 Update the locale and language database 8c53d9f Fix a typo in a doc string. 79bda3b Make nneething allow CRLF-encoded files (bug#32940) commit 641d98531ef7177d9ff0cf6f7362c7ff5ad2fc1c Merge: b4e664f3a4 2cae1cf6f8 Author: Glenn Morris Date: Tue Oct 9 13:12:56 2018 -0700 ; Merge from origin/emacs-26 The following commit was skipped: 2cae1cf Further fix to eieio-persistent commit b4e664f3a4222c0f95322fabd184a69f5dc953ed Merge: 86b53729c0 86d2169ac3 Author: Glenn Morris Date: Tue Oct 9 13:12:55 2018 -0700 Merge from origin/emacs-26 86d2169 Avoid ridiculously high stack limit requests on macOS ac3622c Improve documentation of 'read-hide-char' # Conflicts: # src/emacs.c commit 86b53729c0fda525a7c0a050fcdc8dea81c8eff1 Author: Charles A. Roelli Date: Tue Oct 9 20:24:45 2018 +0200 * lisp/vc/vc.el (vc-retrieve-tag-hook): Remove autoload cookie. See https://lists.gnu.org/r/emacs-devel/2018-10/msg00108.html. diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 7707999636..57bc3c2fc7 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -834,7 +834,6 @@ See `run-hooks'." :type 'hook :group 'vc) -;;;###autoload (defcustom vc-retrieve-tag-hook nil "Normal hook (list of functions) run after retrieving a tag." :type 'hook commit 7f1beabfcdcb58d90aa78db22b9a123faf298749 Author: Paul Eggert Date: Tue Oct 9 11:16:00 2018 -0700 Port --enable-gcc-warnings to recent clang * configure.ac: Disable -Wnull-pointer-arithmetic if clang (Bug#32924). diff --git a/configure.ac b/configure.ac index 6f3d7338c3..df910280b4 100644 --- a/configure.ac +++ b/configure.ac @@ -1019,9 +1019,10 @@ AS_IF([test $gl_gcc_warnings = no], gl_WARN_ADD([-Wno-unused-parameter]) # Too many warnings for now gl_WARN_ADD([-Wno-format-nonliteral]) - # clang is unduly picky about braces. + # clang is unduly picky about some things. if test "$emacs_cv_clang" = yes; then gl_WARN_ADD([-Wno-missing-braces]) + gl_WARN_ADD([-Wno-null-pointer-arithmetic]) fi # This causes too much noise in the MinGW build commit 1f88943924d4e5c98e209790ee8c69b8ab8621d0 Author: Paul Eggert Date: Tue Oct 9 09:47:28 2018 -0700 Fix malfunctioning cursor display on 32-bit Gtk This bug on 32-bit platforms was caused by the timespec_hz definition going haywire because the C expression FIXNUM_OVERFLOW_P (MOST_POSITIVE_FIXNUM) did not work in #if. Eventually the numeric problem showed up as a malfunctioning cursor (Bug#32992). Fix the problem with MOST_POSITIVE_FIXNUM. By the way, make_fixnum should check for integer overflow when debugging; this would have made it easier to track this bug down. But one fix at a time. * src/lisp.h (INTTYPEBITS): Now a macro, so usable in #if. (MOST_POSITIVE_FIXNUM): Mention it’s used in #if. diff --git a/src/lisp.h b/src/lisp.h index ae329268dc..2c20b483ca 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -236,13 +236,15 @@ enum Lisp_Bits /* Number of bits in a Lisp_Object value, not counting the tag. */ VALBITS = EMACS_INT_WIDTH - GCTYPEBITS, - /* Number of bits in a Lisp fixnum tag. */ - INTTYPEBITS = GCTYPEBITS - 1, - /* Number of bits in a Lisp fixnum value, not counting the tag. */ FIXNUM_BITS = VALBITS + 1 }; +/* Number of bits in a Lisp fixnum tag; can be used in #if. */ +DEFINE_GDB_SYMBOL_BEGIN (int, INTTYPEBITS) +#define INTTYPEBITS (GCTYPEBITS - 1) +DEFINE_GDB_SYMBOL_END (INTTYPEBITS) + /* The maximum value that can be stored in a EMACS_INT, assuming all bits other than the type bits contribute to a nonnegative signed value. This can be used in #if, e.g., '#if USE_LSB_TAG' below expands to an @@ -1034,7 +1036,7 @@ enum More_Lisp_Bits that cons. */ /* Largest and smallest representable fixnum values. These are the C - values. They are macros for use in static initializers. */ + values. They are macros for use in #if and static initializers. */ #define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS) #define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM) commit bd013a448b152a84cff9b18292d8272faf265447 Author: Stefan Monnier Date: Tue Oct 9 11:57:22 2018 -0400 * lisp/replace.el (occur--garbage-collect-revert-args): New function (occur-mode, occur-1): Use it. (occur--region-start, occur--region-end, occur--region-start-line) (occur--orig-line): Remove vars. (occur-engine): Fix left over use of occur--region-start-line. diff --git a/lisp/replace.el b/lisp/replace.el index a134e4e3e5..ecb47936e7 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1121,6 +1121,11 @@ for this is to reveal context in an outline-mode when the occurrence is hidden." :type 'hook :group 'matching) +(defun occur--garbage-collect-revert-args () + (dolist (boo (nth 2 occur-revert-arguments)) + (when (overlayp boo) (delete-overlay boo))) + (kill-local-variable 'occur-revert-arguments)) + (put 'occur-mode 'mode-class 'special) (define-derived-mode occur-mode special-mode "Occur" "Major mode for output from \\[occur]. @@ -1130,6 +1135,7 @@ Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it. \\{occur-mode-map}" (setq-local revert-buffer-function #'occur-revert-function) + (add-hook 'kill-buffer-hook #'occur--garbage-collect-revert-args nil t) (setq next-error-function #'occur-next-error)) @@ -1411,10 +1417,6 @@ invoke `occur'." (or unique-p (not interactive-p))))) ;; Region limits when `occur' applies on a region. -(defvar occur--region-start nil) -(defvar occur--region-end nil) -(defvar occur--region-start-line nil) -(defvar occur--orig-line nil) (defvar occur--final-pos nil) (defun occur (regexp &optional nlines region) @@ -1624,6 +1626,7 @@ See also `multi-occur'." 42) (window-width)) "" (occur-regexp-descr regexp)))) + (occur--garbage-collect-revert-args) (setq occur-revert-arguments (list regexp nlines bufs)) (if (= count 0) (kill-buffer occur-buf) @@ -1659,26 +1662,27 @@ See also `multi-occur'." ;; begin searching in the buffer (goto-char (if (overlayp boo) (overlay-start boo) (point-min))) (forward-line 0) - (let ((limit (if (overlayp boo) (overlay-end boo) (point-max))) - (curr-line (line-number-at-pos)) ; line count - (orig-line (if (not (overlayp boo)) 1 - (line-number-at-pos - (overlay-get boo 'occur--orig-point)))) - (orig-line-shown-p) - (prev-line nil) ; line number of prev match endpt - (prev-after-lines nil) ; context lines of prev match - (matchbeg 0) - (origpt nil) - (begpt nil) - (endpt nil) - (marker nil) - (curstring "") - (ret nil) - ;; The following binding is for when case-fold-search - ;; has a local binding in the original buffer, in which - ;; case we cannot bind it globally and let that have - ;; effect in every buffer we search. - (case-fold-search case-fold)) + (let* ((limit (if (overlayp boo) (overlay-end boo) (point-max))) + (start-line (line-number-at-pos)) + (curr-line start-line) ; line count + (orig-line (if (not (overlayp boo)) 1 + (line-number-at-pos + (overlay-get boo 'occur--orig-point)))) + (orig-line-shown-p) + (prev-line nil) ; line number of prev match endpt + (prev-after-lines nil) ; context lines of prev match + (matchbeg 0) + (origpt nil) + (begpt nil) + (endpt nil) + (marker nil) + (curstring "") + (ret nil) + ;; The following binding is for when case-fold-search + ;; has a local binding in the original buffer, in which + ;; case we cannot bind it globally and let that have + ;; effect in every buffer we search. + (case-fold-search case-fold)) (or coding ;; Set CODING only if the current buffer locally ;; binds buffer-file-coding-system. @@ -1792,7 +1796,7 @@ See also `multi-occur'." (setq orig-line-shown-p t) (save-excursion (goto-char (point-min)) - (forward-line (- orig-line (or occur--region-start-line 1))) + (forward-line (- orig-line start-line 1)) (occur-engine-line (line-beginning-position) (line-end-position) keep-props))))) ;; Actually insert the match display data @@ -1830,7 +1834,7 @@ See also `multi-occur'." (let ((orig-line-str (save-excursion (goto-char (point-min)) - (forward-line (- orig-line (or occur--region-start-line 1))) + (forward-line (- orig-line start-line 1)) (occur-engine-line (line-beginning-position) (line-end-position) keep-props)))) (add-face-text-property commit 262f5c809913a232a931131d040964cbdf4ac6f9 Author: Eli Zaretskii Date: Tue Oct 9 17:55:15 2018 +0300 Revert part of last commit * lisp/replace.el (occur-revert-function): Revert last change, as it's no longer needed. (Bug#32987) diff --git a/lisp/replace.el b/lisp/replace.el index 7d313842c0..a134e4e3e5 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1207,19 +1207,7 @@ To return to ordinary Occur mode, use \\[occur-cease-edit]." (defun occur-revert-function (_ignore1 _ignore2) "Handle `revert-buffer' for Occur mode buffers." - (if (cdr (nth 2 occur-revert-arguments)) ; multi-occur - (apply 'occur-1 (append occur-revert-arguments (list (buffer-name)))) - (pcase-let ((`(,region-start ,region-end ,orig-line ,buffer) - (occur--parse-occur-buffer)) - (regexp (car occur-revert-arguments))) - (if (not (or region-start region-end)) - (apply 'occur-1 (append occur-revert-arguments (list (buffer-name)))) - (with-current-buffer buffer - (when (wholenump orig-line) - (goto-char (point-min)) - (forward-line (1- orig-line))) - (save-excursion - (occur regexp nil (list (cons region-start region-end))))))))) + (apply #'occur-1 (append occur-revert-arguments (list (buffer-name))))) (defun occur-mode-find-occurrence () (let ((pos (get-text-property (point) 'occur-target))) commit cbb674287878877abe38065d0cc5fa28b7fc577d Merge: cd7caee630 5d1fbe25d4 Author: Eli Zaretskii Date: Tue Oct 9 17:49:59 2018 +0300 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit 5d1fbe25d48ba3ab663afcfe8ee8d5236e8f4cb5 Author: Stefan Monnier Date: Tue Oct 9 10:47:13 2018 -0400 * lisp/replace.el: Rework implementation of the occur region Put the region info in the "list of buffers" used for multi-occur. (occur--parse-occur-buffer): Remove. (occur): Pass the region to occur-1 as an overlay. (occur-1): 'bufs' is now a list of buffers or overlays. (occur-engine): 'buffers' is now a list of buffers or overlays. diff --git a/lisp/replace.el b/lisp/replace.el index 00b2ceee35..a134e4e3e5 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1099,10 +1099,9 @@ a previously found match." map) "Keymap for `occur-mode'.") -(defvar occur-revert-arguments nil +(defvar-local occur-revert-arguments nil "Arguments to pass to `occur-1' to revert an Occur mode buffer. See `occur-revert-function'.") -(make-variable-buffer-local 'occur-revert-arguments) (put 'occur-revert-arguments 'permanent-local t) (defcustom occur-mode-hook '(turn-on-font-lock) @@ -1130,8 +1129,8 @@ for this is to reveal context in an outline-mode when the occurrence is hidden." Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it. \\{occur-mode-map}" - (set (make-local-variable 'revert-buffer-function) 'occur-revert-function) - (setq next-error-function 'occur-next-error)) + (setq-local revert-buffer-function #'occur-revert-function) + (setq next-error-function #'occur-next-error)) ;;; Occur Edit mode @@ -1154,7 +1153,7 @@ the originating buffer. To return to ordinary Occur mode, use \\[occur-cease-edit]." (setq buffer-read-only nil) - (add-hook 'after-change-functions 'occur-after-change-function nil t) + (add-hook 'after-change-functions #'occur-after-change-function nil t) (message (substitute-command-keys "Editing: Type \\[occur-cease-edit] to return to Occur mode."))) @@ -1206,34 +1205,9 @@ To return to ordinary Occur mode, use \\[occur-cease-edit]." (move-to-column col))))))) -(defun occur--parse-occur-buffer() - "Retrieve a list of the form (BEG END ORIG-LINE BUFFER). -BEG and END define the region. -ORIG-LINE and BUFFER are the line and the buffer from which -the user called `occur'." - (save-excursion - (goto-char (point-min)) - (let ((buffer (get-text-property (point) 'occur-title)) - (beg-pos (get-text-property (point) 'region-start)) - (end-pos (get-text-property (point) 'region-end)) - (orig-line (get-text-property (point) 'current-line))) - (list beg-pos end-pos orig-line buffer)))) - (defun occur-revert-function (_ignore1 _ignore2) "Handle `revert-buffer' for Occur mode buffers." - (if (cdr (nth 2 occur-revert-arguments)) ; multi-occur - (apply 'occur-1 (append occur-revert-arguments (list (buffer-name)))) - (pcase-let ((`(,region-start ,region-end ,orig-line ,buffer) - (occur--parse-occur-buffer)) - (regexp (car occur-revert-arguments))) - (with-current-buffer buffer - (when (wholenump orig-line) - (goto-char (point-min)) - (forward-line (1- orig-line))) - (save-excursion - (if (or region-start region-end) - (occur regexp nil (list (cons region-start region-end))) - (apply 'occur-1 (append occur-revert-arguments (list (buffer-name)))))))))) + (apply #'occur-1 (append occur-revert-arguments (list (buffer-name))))) (defun occur-mode-find-occurrence () (let ((pos (get-text-property (point) 'occur-target))) @@ -1487,23 +1461,14 @@ is not modified." (and (use-region-p) (list (region-bounds))))) (let* ((start (and (caar region) (max (caar region) (point-min)))) (end (and (cdar region) (min (cdar region) (point-max)))) - (in-region-p (or start end))) - (when in-region-p - (or start (setq start (point-min))) - (or end (setq end (point-max)))) - (let ((occur--region-start start) - (occur--region-end end) - (occur--region-start-line - (and in-region-p - (line-number-at-pos (min start end)))) - (occur--orig-line - (line-number-at-pos (point)))) - (save-excursion ; If no matches `occur-1' doesn't restore the point. - (and in-region-p (narrow-to-region - (save-excursion (goto-char start) (line-beginning-position)) - (save-excursion (goto-char end) (line-end-position)))) - (occur-1 regexp nlines (list (current-buffer))) - (and in-region-p (widen)))))) + (in-region (or start end)) + (bufs (if (not in-region) (list (current-buffer)) + (let ((ol (make-overlay + (or start (point-min)) + (or end (point-max))))) + (overlay-put ol 'occur--orig-point (point)) + (list ol))))) + (occur-1 regexp nlines bufs))) (defvar ido-ignore-item-temp-list) @@ -1574,17 +1539,27 @@ See also `multi-occur'." (query-replace-descr regexp)))) (defun occur-1 (regexp nlines bufs &optional buf-name) + ;; BUFS is a list of buffer-or-overlay! (unless (and regexp (not (equal regexp ""))) (error "Occur doesn't work with the empty regexp")) (unless buf-name (setq buf-name "*Occur*")) (let (occur-buf - (active-bufs (delq nil (mapcar #'(lambda (buf) - (when (buffer-live-p buf) buf)) - bufs)))) + (active-bufs + (delq nil (mapcar (lambda (boo) + (when (or (buffer-live-p boo) + (and (overlayp boo) + (overlay-buffer boo))) + boo)) + bufs)))) ;; Handle the case where one of the buffers we're searching is the ;; output buffer. Just rename it. - (when (member buf-name (mapcar 'buffer-name active-bufs)) + (when (member buf-name + ;; FIXME: Use cl-exists. + (mapcar + (lambda (boo) + (buffer-name (if (overlayp boo) (overlay-buffer boo) boo))) + active-bufs)) (with-current-buffer (get-buffer buf-name) (rename-uniquely))) @@ -1604,22 +1579,24 @@ See also `multi-occur'." (let ((count (if (stringp nlines) ;; Treat nlines as a regexp to collect. - (let ((bufs active-bufs) - (count 0)) - (while bufs - (with-current-buffer (car bufs) + (let ((count 0)) + (dolist (boo active-bufs) + (with-current-buffer + (if (overlayp boo) (overlay-buffer boo) boo) (save-excursion - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - ;; Insert the replacement regexp. - (let ((str (match-substitute-replacement nlines))) - (if str - (with-current-buffer occur-buf - (insert str) - (setq count (1+ count)) - (or (zerop (current-column)) - (insert "\n")))))))) - (setq bufs (cdr bufs))) + (goto-char + (if (overlayp boo) (overlay-start boo) (point-min))) + (let ((end (if (overlayp boo) (overlay-end boo)))) + (while (re-search-forward regexp end t) + ;; Insert the replacement regexp. + (let ((str (match-substitute-replacement + nlines))) + (if str + (with-current-buffer occur-buf + (insert str) + (setq count (1+ count)) + (or (zerop (current-column)) + (insert "\n")))))))))) count) ;; Perform normal occur. (occur-engine @@ -1662,49 +1639,54 @@ See also `multi-occur'." (defun occur-engine (regexp buffers out-buf nlines case-fold title-face prefix-face match-face keep-props) + ;; BUFFERS is a list of buffer-or-overlay! (with-current-buffer out-buf (let ((global-lines 0) ;; total count of matching lines (global-matches 0) ;; total count of matches (coding nil) (case-fold-search case-fold) - (in-region-p (and occur--region-start occur--region-end)) (multi-occur-p (cdr buffers))) ;; Map over all the buffers - (dolist (buf buffers) - (when (buffer-live-p buf) - (let ((lines 0) ;; count of matching lines - (matches 0) ;; count of matches - (curr-line ;; line count - (or occur--region-start-line 1)) - (orig-line (or occur--orig-line 1)) - (orig-line-shown-p) - (prev-line nil) ;; line number of prev match endpt - (prev-after-lines nil) ;; context lines of prev match - (matchbeg 0) - (origpt nil) - (begpt nil) - (endpt nil) - (marker nil) - (curstring "") - (ret nil) - (inhibit-field-text-motion t) - (headerpt (with-current-buffer out-buf (point)))) - (with-current-buffer buf - ;; The following binding is for when case-fold-search - ;; has a local binding in the original buffer, in which - ;; case we cannot bind it globally and let that have - ;; effect in every buffer we search. - (let ((case-fold-search case-fold)) - (or coding - ;; Set CODING only if the current buffer locally - ;; binds buffer-file-coding-system. - (not (local-variable-p 'buffer-file-coding-system)) - (setq coding buffer-file-coding-system)) - (save-excursion - (goto-char (point-min)) ;; begin searching in the buffer - (while (not (eobp)) + (dolist (boo buffers) + (when (if (overlayp boo) (overlay-buffer boo) (buffer-live-p boo)) + (with-current-buffer (if (overlayp boo) (overlay-buffer boo) boo) + (let ((inhibit-field-text-motion t) + (lines 0) ; count of matching lines + (matches 0) ; count of matches + (headerpt (with-current-buffer out-buf (point))) + ) + (save-excursion + ;; begin searching in the buffer + (goto-char (if (overlayp boo) (overlay-start boo) (point-min))) + (forward-line 0) + (let ((limit (if (overlayp boo) (overlay-end boo) (point-max))) + (curr-line (line-number-at-pos)) ; line count + (orig-line (if (not (overlayp boo)) 1 + (line-number-at-pos + (overlay-get boo 'occur--orig-point)))) + (orig-line-shown-p) + (prev-line nil) ; line number of prev match endpt + (prev-after-lines nil) ; context lines of prev match + (matchbeg 0) + (origpt nil) + (begpt nil) + (endpt nil) + (marker nil) + (curstring "") + (ret nil) + ;; The following binding is for when case-fold-search + ;; has a local binding in the original buffer, in which + ;; case we cannot bind it globally and let that have + ;; effect in every buffer we search. + (case-fold-search case-fold)) + (or coding + ;; Set CODING only if the current buffer locally + ;; binds buffer-file-coding-system. + (not (local-variable-p 'buffer-file-coding-system)) + (setq coding buffer-file-coding-system)) + (while (< (point) limit) (setq origpt (point)) - (when (setq endpt (re-search-forward regexp nil t)) + (when (setq endpt (re-search-forward regexp limit t)) (setq lines (1+ lines)) ;; increment matching lines count (setq matchbeg (match-beginning 0)) ;; Get beginning of first match line and end of the last. @@ -1878,17 +1860,14 @@ See also `multi-occur'." ;; Don't display regexp for multi-buffer. (if (> (length buffers) 1) "" (occur-regexp-descr regexp)) - (buffer-name buf) - (if in-region-p + (buffer-name (if (overlayp boo) (overlay-buffer boo) boo)) + (if (overlayp boo) (format " within region: %d-%d" - occur--region-start - occur--region-end) + (overlay-start boo) + (overlay-end boo)) "")) 'read-only t)) (setq end (point)) - (add-text-properties beg end `(occur-title ,buf current-line ,orig-line - region-start ,occur--region-start - region-end ,occur--region-end)) (when title-face (add-face-text-property beg end title-face)) (goto-char (if (and list-matching-lines-jump-to-current-line @@ -2425,7 +2404,7 @@ characters." (message (if query-flag - (apply 'propertize + (apply #'propertize (concat "Query replacing " (if backward "backward " "") (if delimited-flag @@ -2880,10 +2859,11 @@ characters." (if (= replace-count 1) "" "s") (if (> (+ skip-read-only-count skip-filtered-count - skip-invisible-count) 0) + skip-invisible-count) + 0) (format " (skipped %s)" (mapconcat - 'identity + #'identity (delq nil (list (if (> skip-read-only-count 0) (format "%s read-only" commit cd7caee630f9425a1a16e4da31e892a2ec29ac09 Author: Eli Zaretskii Date: Tue Oct 9 17:46:31 2018 +0300 Unbreak 'revert-buffer' in Occur buffers * lisp/replace.el (occur-revert-function): Use the value of occur-revert-function from the correct buffer. (Bug#32987) * test/lisp/replace-tests.el (replace-occur-revert-bug32543) (replace-occur-revert-bug32987): New tests. diff --git a/lisp/replace.el b/lisp/replace.el index 00b2ceee35..04e5d4273e 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1226,14 +1226,14 @@ the user called `occur'." (pcase-let ((`(,region-start ,region-end ,orig-line ,buffer) (occur--parse-occur-buffer)) (regexp (car occur-revert-arguments))) - (with-current-buffer buffer - (when (wholenump orig-line) - (goto-char (point-min)) - (forward-line (1- orig-line))) - (save-excursion - (if (or region-start region-end) - (occur regexp nil (list (cons region-start region-end))) - (apply 'occur-1 (append occur-revert-arguments (list (buffer-name)))))))))) + (if (not (or region-start region-end)) + (apply 'occur-1 (append occur-revert-arguments (list (buffer-name)))) + (with-current-buffer buffer + (when (wholenump orig-line) + (goto-char (point-min)) + (forward-line (1- orig-line))) + (save-excursion + (occur regexp nil (list (cons region-start region-end))))))))) (defun occur-mode-find-occurrence () (let ((pos (get-text-property (point) 'occur-target))) diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el index 3fcdce6704..5a91a2cc7f 100644 --- a/test/lisp/replace-tests.el +++ b/test/lisp/replace-tests.el @@ -359,6 +359,52 @@ Each element has the format: (dotimes (i (length replace-occur-tests)) (replace-occur-test-create i)) +(ert-deftest replace-occur-revert-bug32543 () + "Test `occur-revert' with non-nil `list-matching-lines-jump-to-current-line'." + (let ((temp-buffer (get-buffer-create " *test-occur*"))) + (unwind-protect + (save-window-excursion + (with-current-buffer temp-buffer + (erase-buffer) + (setq list-matching-lines-jump-to-current-line t) + (insert +";; This buffer is for text that is not saved, and for Lisp evaluation. +;; To create a file, visit it with C-x C-f and enter text in its buffer. + +") + (occur "and") + (with-current-buffer "*Occur*" + (revert-buffer) + (goto-char (point-min)) + (should (string-match "\\`2 matches for \"and\" in buffer: " + (buffer-substring-no-properties + (point) (line-end-position))))))) + (and (buffer-name temp-buffer) + (kill-buffer temp-buffer))))) + +(ert-deftest replace-occur-revert-bug32987 () + "Test `occur-revert' with non-nil `list-matching-lines-jump-to-current-line'." + (let ((temp-buffer (get-buffer-create " *test-occur*"))) + (unwind-protect + (save-window-excursion + (with-current-buffer temp-buffer + (erase-buffer) + (setq list-matching-lines-jump-to-current-line nil) + (insert +";; This buffer is for text that is not saved, and for Lisp evaluation. +;; To create a file, visit it with C-x C-f and enter text in its buffer. + +") + (occur "and") + (with-current-buffer "*Occur*" + (revert-buffer) + (goto-char (point-min)) + (should (string-match "\\`2 matches for \"and\" in buffer: " + (buffer-substring-no-properties + (point) (line-end-position))))))) + (and (buffer-name temp-buffer) + (kill-buffer temp-buffer))))) + ;;; Tests for `query-replace' undo feature. @@ -454,5 +500,4 @@ Return the last evalled form in BODY." input "a" "B" ((?\s . (1 2 3)) (?E . (4)) (?U . (5))) ?q (string= input (buffer-string)))))) - ;;; replace-tests.el ends here commit 333f0bfe766185c66952c6fbd4796c6bb97c868d Author: Stefan Monnier Date: Mon Oct 8 22:33:22 2018 -0400 * lisp/calendar/timeclock.el: Use lexical-binding Require cl-lib. Remove redundant :group args. (timeclock-status-string): Avoid 'setq'. (timeclock-ask-for-project, timeclock-ask-for-reason): Completionu tables can be simple lists of strings. (timeclock-read-moment): Doesn't deserve to be defsubst (most of the others don't either, admittedly). (timeclock-entry): New type. (timeclock-entry-begin, timeclock-entry-end, timeclock-entry-project) (timeclock-entry-comment): Define via 'cl-defstruct'. (timeclock-entry-list-projects, timeclock-day-list-projects): Avoid add-to-list on lexical vars. (timeclock-day-list): Use 'push'. (timeclock-log-data): Use 'pcase'. (timeclock-mean): Simplify. (timeclock-generate-report): Use dotimes. diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el index ddc297604e..646f5298fe 100644 --- a/lisp/calendar/timeclock.el +++ b/lisp/calendar/timeclock.el @@ -1,4 +1,4 @@ -;;; timeclock.el --- mode for keeping track of how much you work +;;; timeclock.el --- mode for keeping track of how much you work -*- lexical-binding:t -*- ;; Copyright (C) 1999-2018 Free Software Foundation, Inc. @@ -62,7 +62,7 @@ ;; `timeclock-ask-before-exiting' to t using M-x customize (this is ;; the default), or by adding the following to your init file: ;; -;; (add-hook 'kill-emacs-query-functions 'timeclock-query-out) +;; (add-hook 'kill-emacs-query-functions #'timeclock-query-out) ;; NOTE: If you change your timelog file without using timeclock's ;; functions, or if you change the value of any of timeclock's @@ -75,6 +75,8 @@ ;;; Code: +(require 'cl-lib) + (defgroup timeclock nil "Keeping track of the time that gets spent." :group 'data) @@ -84,13 +86,11 @@ (defcustom timeclock-file (locate-user-emacs-file "timelog" ".timelog") "The file used to store timeclock data in." :version "24.4" ; added locate-user-emacs-file - :type 'file - :group 'timeclock) + :type 'file) (defcustom timeclock-workday (* 8 60 60) "The length of a work period in seconds." - :type 'integer - :group 'timeclock) + :type 'integer) (defcustom timeclock-relative t "Whether to make reported time relative to `timeclock-workday'. @@ -100,24 +100,21 @@ Tuesday is twelve hours -- relative to an averaged work period of eight hours -- or eight hours, non-relative. So relative time takes into account any discrepancy of time under-worked or over-worked on previous days. This only affects the timeclock mode line display." - :type 'boolean - :group 'timeclock) + :type 'boolean) (defcustom timeclock-get-project-function 'timeclock-ask-for-project "The function used to determine the name of the current project. When clocking in, and no project is specified, this function will be called to determine what is the current project to be worked on. If this variable is nil, no questions will be asked." - :type 'function - :group 'timeclock) + :type 'function) (defcustom timeclock-get-reason-function 'timeclock-ask-for-reason "A function used to determine the reason for clocking out. When clocking out, and no reason is specified, this function will be called to determine what is the reason. If this variable is nil, no questions will be asked." - :type 'function - :group 'timeclock) + :type 'function) (defcustom timeclock-get-workday-function nil "A function used to determine the length of today's workday. @@ -127,19 +124,17 @@ the return value is nil, or equal to `timeclock-workday', nothing special will be done. If it is a quantity different from `timeclock-workday', however, a record will be output to the timelog file to note the fact that that day has a length that is different from the norm." - :type '(choice (const nil) function) - :group 'timeclock) + :type '(choice (const nil) function)) (defcustom timeclock-ask-before-exiting t "If non-nil, ask if the user wants to clock out before exiting Emacs. This variable only has effect if set with \\[customize]." :set (lambda (symbol value) (if value - (add-hook 'kill-emacs-query-functions 'timeclock-query-out) - (remove-hook 'kill-emacs-query-functions 'timeclock-query-out)) + (add-hook 'kill-emacs-query-functions #'timeclock-query-out) + (remove-hook 'kill-emacs-query-functions #'timeclock-query-out)) (set symbol value)) - :type 'boolean - :group 'timeclock) + :type 'boolean) (defvar timeclock-update-timer nil "The timer used to update `timeclock-mode-string'.") @@ -172,7 +167,7 @@ a positive argument to force an update." (if (and currently-displaying (or (and value (boundp 'display-time-hook) - (memq 'timeclock-update-mode-line + (memq #'timeclock-update-mode-line display-time-hook)) (and (not value) timeclock-update-timer))) @@ -185,7 +180,6 @@ a positive argument to force an update." ;; FIXME: The return value isn't used, AFAIK! value)) :type 'boolean - :group 'timeclock :require 'time) (defcustom timeclock-first-in-hook nil @@ -194,40 +188,33 @@ Note that this hook is run before recording any events. Thus the value of `timeclock-hours-today', `timeclock-last-event' and the return value of function `timeclock-last-period' are relative previous to today." - :type 'hook - :group 'timeclock) + :type 'hook) (defcustom timeclock-load-hook nil "Hook that gets run after timeclock has been loaded." - :type 'hook - :group 'timeclock) + :type 'hook) (defcustom timeclock-in-hook nil "A hook run every time an \"in\" event is recorded." - :type 'hook - :group 'timeclock) + :type 'hook) (defcustom timeclock-day-over-hook nil "A hook that is run when the workday has been completed. This hook is only run if the current time remaining is being displayed in the mode line. See the variable `timeclock-mode-line-display'." - :type 'hook - :group 'timeclock) + :type 'hook) (defcustom timeclock-out-hook nil "A hook run every time an \"out\" event is recorded." - :type 'hook - :group 'timeclock) + :type 'hook) (defcustom timeclock-done-hook nil "A hook run every time a project is marked as completed." - :type 'hook - :group 'timeclock) + :type 'hook) (defcustom timeclock-event-hook nil "A hook run every time any event is recorded." - :type 'hook - :group 'timeclock) + :type 'hook) (defvar timeclock-last-event nil "A list containing the last event that was recorded. @@ -294,12 +281,12 @@ display (non-nil means on)." (or (memq 'timeclock-mode-string global-mode-string) (setq global-mode-string (append global-mode-string '(timeclock-mode-string)))) - (add-hook 'timeclock-event-hook 'timeclock-update-mode-line) + (add-hook 'timeclock-event-hook #'timeclock-update-mode-line) (when timeclock-update-timer (cancel-timer timeclock-update-timer) (setq timeclock-update-timer nil)) (if (boundp 'display-time-hook) - (remove-hook 'display-time-hook 'timeclock-update-mode-line)) + (remove-hook 'display-time-hook #'timeclock-update-mode-line)) (if timeclock-use-display-time (progn ;; Update immediately so there is a visible change @@ -308,15 +295,15 @@ display (non-nil means on)." (timeclock-update-mode-line) (message "Activate `display-time-mode' or turn off \ `timeclock-use-display-time' to see timeclock information")) - (add-hook 'display-time-hook 'timeclock-update-mode-line)) + (add-hook 'display-time-hook #'timeclock-update-mode-line)) (setq timeclock-update-timer (run-at-time nil 60 'timeclock-update-mode-line)))) (setq global-mode-string (delq 'timeclock-mode-string global-mode-string)) - (remove-hook 'timeclock-event-hook 'timeclock-update-mode-line) + (remove-hook 'timeclock-event-hook #'timeclock-update-mode-line) (if (boundp 'display-time-hook) (remove-hook 'display-time-hook - 'timeclock-update-mode-line)) + #'timeclock-update-mode-line)) (when timeclock-update-timer (cancel-timer timeclock-update-timer) (setq timeclock-update-timer nil)))) @@ -365,7 +352,8 @@ discover the name of the project." (if (not (= workday timeclock-workday)) (timeclock-log "h" (number-to-string (/ workday (if (zerop (% workday (* 60 60))) - 60 60.0) 60)))))) + 60 60.0) + 60)))))) (timeclock-log "i" (or project (and timeclock-get-project-function (or find-project @@ -417,12 +405,11 @@ If SHOW-SECONDS is non-nil, display second resolution. If TODAY-ONLY is non-nil, the display will be relative only to time worked today, ignoring the time worked on previous days." (interactive "P") - (let ((remainder (timeclock-workday-remaining - (or today-only - (not timeclock-relative)))) - (last-in (equal (car timeclock-last-event) "i")) - status) - (setq status + (let* ((remainder (timeclock-workday-remaining + (or today-only + (not timeclock-relative)))) + (last-in (equal (car timeclock-last-event) "i")) + (status (format "Currently %s since %s (%s), %s %s, leave at %s" (if last-in "IN" "OUT") (if show-seconds @@ -435,7 +422,7 @@ worked today, ignoring the time worked on previous days." (timeclock-seconds-to-string remainder show-seconds t) (if (> remainder 0) "remaining" "over") - (timeclock-when-to-leave-string show-seconds today-only))) + (timeclock-when-to-leave-string show-seconds today-only)))) (if (called-interactively-p 'interactive) (message "%s" status) status))) @@ -623,7 +610,7 @@ arguments of `completing-read'." (format "Clock into which project (default %s): " (or timeclock-last-project (car timeclock-project-list))) - (mapcar 'list timeclock-project-list) + timeclock-project-list (or timeclock-last-project (car timeclock-project-list)))) @@ -632,7 +619,7 @@ arguments of `completing-read'." (defun timeclock-ask-for-reason () "Ask the user for the reason they are clocking out." (timeclock-completing-read "Reason for clocking out: " - (mapcar 'list timeclock-reason-list))) + timeclock-reason-list)) (define-obsolete-function-alias 'timeclock-update-modeline 'timeclock-update-mode-line "24.3") @@ -700,7 +687,7 @@ being logged for. Normally only \"in\" events specify a project." "\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)\\s-+" "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)[ \t]*" "\\([^\n]*\\)")) -(defsubst timeclock-read-moment () +(defun timeclock-read-moment () "Read the moment under point from the timelog." (if (looking-at timeclock-moment-regexp) (let ((code (match-string 1)) @@ -725,27 +712,19 @@ This is only provided for coherency when used by (float-time (cadr timeclock-last-event))) timeclock-last-period)) +(cl-defstruct (timeclock-entry + (:constructor nil) (:copier nil) + (:type list)) + begin end project comment + ;; FIXME: Documented in docstring of timeclock-log-data, but I can't see + ;; where it's used in the code. + final-p) + (defsubst timeclock-entry-length (entry) "Return the length of ENTRY in seconds." (- (float-time (cadr entry)) (float-time (car entry)))) -(defsubst timeclock-entry-begin (entry) - "Return the start time of ENTRY." - (car entry)) - -(defsubst timeclock-entry-end (entry) - "Return the end time of ENTRY." - (cadr entry)) - -(defsubst timeclock-entry-project (entry) - "Return the project of ENTRY." - (nth 2 entry)) - -(defsubst timeclock-entry-comment (entry) - "Return the comment of ENTRY." - (nth 3 entry)) - (defsubst timeclock-entry-list-length (entry-list) "Return the total length of ENTRY-LIST in seconds." (let ((length 0)) @@ -771,14 +750,11 @@ This is only provided for coherency when used by (- (timeclock-entry-list-span entry-list) (timeclock-entry-list-length entry-list))) -(defsubst timeclock-entry-list-projects (entry-list) +(defun timeclock-entry-list-projects (entry-list) "Return a list of all the projects in ENTRY-LIST." - (let (projects proj) + (let (projects) (dolist (entry entry-list) - (setq proj (timeclock-entry-project entry)) - (if projects - (add-to-list 'projects proj) - (setq projects (list proj)))) + (cl-pushnew (timeclock-entry-project entry) projects :test #'equal)) projects)) (defsubst timeclock-day-required (day) @@ -854,9 +830,7 @@ This is only provided for coherency when used by (let (projects) (dolist (day day-list) (dolist (proj (timeclock-day-projects day)) - (if projects - (add-to-list 'projects proj) - (setq projects (list proj))))) + (cl-pushnew proj projects :test #'equal))) projects)) (defsubst timeclock-current-debt (&optional log-data) @@ -871,7 +845,7 @@ This is only provided for coherency when used by "Return a list of the cdrs of the date alist from LOG-DATA." (let (day-list) (dolist (date-list (timeclock-day-alist log-data)) - (setq day-list (cons (cdr date-list) day-list))) + (push (cdr date-list) day-list)) day-list)) (defsubst timeclock-project-alist (&optional log-data) @@ -1022,54 +996,55 @@ See the documentation for the given function if more info is needed." (and beg (not last) (setq last t event (list "o" now)))) (setq line (1+ line)) - (cond ((equal (car event) "b") - (setcar log-data (string-to-number (nth 2 event)))) - ((equal (car event) "h") - (setq last-date-limited (timeclock-time-to-date (cadr event)) - last-date-seconds (* (string-to-number (nth 2 event)) - 3600.0))) - ((equal (car event) "i") - (if beg - (error "Error in format of timelog file, line %d" line) - (setq beg t)) - (setq entry (list (cadr event) nil - (and (> (length (nth 2 event)) 0) - (nth 2 event)))) - (let ((date (timeclock-time-to-date (cadr event)))) - (if (and last-date - (not (equal date last-date))) - (progn - (setcar (cdr log-data) - (cons (cons last-date day) - (cadr log-data))) - (setq day (list (and last-date-limited - last-date-seconds)))) - (unless day - (setq day (list (and last-date-limited - last-date-seconds))))) - (setq last-date date - last-date-limited nil))) - ((equal (downcase (car event)) "o") - (if (not beg) - (error "Error in format of timelog file, line %d" line) - (setq beg nil)) - (setcar (cdr entry) (cadr event)) - (let ((desc (and (> (length (nth 2 event)) 0) - (nth 2 event)))) - (if desc - (nconc entry (list (nth 2 event)))) - (if (equal (car event) "O") - (nconc entry (if desc - (list t) - (list nil t)))) - (nconc day (list entry)) - (setq desc (nth 2 entry)) - (let ((proj (assoc desc (nth 2 log-data)))) - (if (null proj) - (setcar (cddr log-data) - (cons (cons desc (list entry)) - (nth 2 log-data))) - (nconc (cdr proj) (list entry))))))) + (pcase (car event) + ("b" + (setcar log-data (string-to-number (nth 2 event)))) + ("h" + (setq last-date-limited (timeclock-time-to-date (cadr event)) + last-date-seconds (* (string-to-number (nth 2 event)) + 3600.0))) + ("i" + (if beg + (error "Error in format of timelog file, line %d" line) + (setq beg t)) + (setq entry (list (cadr event) nil + (and (> (length (nth 2 event)) 0) + (nth 2 event)))) + (let ((date (timeclock-time-to-date (cadr event)))) + (if (and last-date + (not (equal date last-date))) + (progn + (setcar (cdr log-data) + (cons (cons last-date day) + (cadr log-data))) + (setq day (list (and last-date-limited + last-date-seconds)))) + (unless day + (setq day (list (and last-date-limited + last-date-seconds))))) + (setq last-date date + last-date-limited nil))) + ((or "o" "O") + (if (not beg) + (error "Error in format of timelog file, line %d" line) + (setq beg nil)) + (setcar (cdr entry) (cadr event)) + (let ((desc (and (> (length (nth 2 event)) 0) + (nth 2 event)))) + (if desc + (nconc entry (list (nth 2 event)))) + (if (equal (car event) "O") + (nconc entry (if desc + (list t) + (list nil t)))) + (nconc day (list entry)) + (setq desc (nth 2 entry)) + (let ((proj (assoc desc (nth 2 log-data)))) + (if (null proj) + (setcar (cddr log-data) + (cons (cons desc (list entry)) + (nth 2 log-data))) + (nconc (cdr proj) (list entry))))))) (forward-line)) (if day (setcar (cdr log-data) @@ -1185,14 +1160,12 @@ If optional argument TIME is non-nil, use that instead of the current time." (defun timeclock-mean (l) "Compute the arithmetic mean of the values in the list L." - (let ((total 0) - (count 0)) - (dolist (thisl l) - (setq total (+ total thisl) - count (1+ count))) - (if (zerop count) - 0 - (/ total count)))) + (if (not (consp l)) + 0 + (let ((total 0)) + (dolist (thisl l) + (setq total (+ total thisl))) + (/ total (length l))))) (defun timeclock-generate-report (&optional html-p) "Generate a summary report based on the current timelog file. @@ -1296,81 +1269,69 @@ HTML-P is non-nil, HTML markup is added." six-months-ago one-year-ago))) ;; collect statistics from complete timelog (dolist (day day-list) - (let ((i 0) (l 5)) - (while (< i l) - (unless (time-less-p - (timeclock-day-begin day) - (aref lengths i)) - (let ((base (float-time - (timeclock-day-base - (timeclock-day-begin day))))) - (nconc (aref time-in i) - (list (- (float-time (timeclock-day-begin day)) - base))) - (let ((span (timeclock-day-span day)) - (len (timeclock-day-length day)) - (req (timeclock-day-required day))) - ;; If the day's actual work length is less than - ;; 70% of its span, then likely the exit time - ;; and break amount are not worthwhile adding to - ;; the statistic - (when (and (> span 0) - (> (/ (float len) (float span)) 0.70)) - (nconc (aref time-out i) - (list (- (float-time (timeclock-day-end day)) - base))) - (nconc (aref breaks i) (list (- span len)))) - (if req - (setq len (+ len (- timeclock-workday req)))) - (nconc (aref workday i) (list len))))) - (setq i (1+ i))))) + (dotimes (i 5) + (unless (time-less-p + (timeclock-day-begin day) + (aref lengths i)) + (let ((base (float-time + (timeclock-day-base + (timeclock-day-begin day))))) + (nconc (aref time-in i) + (list (- (float-time (timeclock-day-begin day)) + base))) + (let ((span (timeclock-day-span day)) + (len (timeclock-day-length day)) + (req (timeclock-day-required day))) + ;; If the day's actual work length is less than + ;; 70% of its span, then likely the exit time + ;; and break amount are not worthwhile adding to + ;; the statistic + (when (and (> span 0) + (> (/ (float len) (float span)) 0.70)) + (nconc (aref time-out i) + (list (- (float-time (timeclock-day-end day)) + base))) + (nconc (aref breaks i) (list (- span len)))) + (if req + (setq len (+ len (- timeclock-workday req)))) + (nconc (aref workday i) (list len))))))) ;; average statistics - (let ((i 0) (l 5)) - (while (< i l) - (aset time-in i (timeclock-mean (cdr (aref time-in i)))) - (aset time-out i (timeclock-mean (cdr (aref time-out i)))) - (aset breaks i (timeclock-mean (cdr (aref breaks i)))) - (aset workday i (timeclock-mean (cdr (aref workday i)))) - (setq i (1+ i)))) + (dotimes (i 5) + (aset time-in i (timeclock-mean (cdr (aref time-in i)))) + (aset time-out i (timeclock-mean (cdr (aref time-out i)))) + (aset breaks i (timeclock-mean (cdr (aref breaks i)))) + (aset workday i (timeclock-mean (cdr (aref workday i))))) ;; Output the HTML table (insert "\n") (insert "Time in\n") - (let ((i 0) (l 5)) - (while (< i l) - (insert "" - (timeclock-seconds-to-string (aref time-in i)) - "\n") - (setq i (1+ i)))) + (dotimes (i 5) + (insert "" + (timeclock-seconds-to-string (aref time-in i)) + "\n")) (insert "\n") (insert "\n") (insert "Time out\n") - (let ((i 0) (l 5)) - (while (< i l) - (insert "" - (timeclock-seconds-to-string (aref time-out i)) - "\n") - (setq i (1+ i)))) + (dotimes (i 5) + (insert "" + (timeclock-seconds-to-string (aref time-out i)) + "\n")) (insert "\n") (insert "\n") (insert "Break\n") - (let ((i 0) (l 5)) - (while (< i l) - (insert "" - (timeclock-seconds-to-string (aref breaks i)) - "\n") - (setq i (1+ i)))) + (dotimes (i 5) + (insert "" + (timeclock-seconds-to-string (aref breaks i)) + "\n")) (insert "\n") (insert "\n") (insert "Workday\n") - (let ((i 0) (l 5)) - (while (< i l) - (insert "" - (timeclock-seconds-to-string (aref workday i)) - "\n") - (setq i (1+ i)))) + (dotimes (i 5) + (insert "" + (timeclock-seconds-to-string (aref workday i)) + "\n")) (insert "\n")) (insert " @@ -1393,6 +1354,7 @@ HTML-P is non-nil, HTML markup is added." ;; make sure we know the list of reasons, projects, and have computed ;; the last event and current discrepancy. (if (file-readable-p timeclock-file) + ;; FIXME: Loading a file should not have these kinds of side-effects. (timeclock-reread-log)) ;;; timeclock.el ends here commit cf1ebfa055fcd0749aa4ed2fc4c399470b9eb3de Author: Paul Eggert Date: Mon Oct 8 18:21:47 2018 -0700 Update from Gnulib This incorporates: 2018-10-05 explicit_bzero: make it possible to namespace 2018-10-04 fcntl: make it possible to namespace 2018-10-01 mkostemp, mkostemps: fix C++ compilation on Mac OS X 2018-09-19 maint: mktime.c now shared with glibc 2018-09-18 file-has-acl: fix test failure on Cygwin 2.9 2018-09-18 gettime: nanotime never existed * admin/merge-gnulib (AVOIDED_MODULES): Add mkdir. * doc/misc/texinfo.tex, lib/acl-internal.c, lib/acl-internal.h: * lib/acl_entries.c, lib/explicit_bzero.c, lib/fcntl.c: * lib/get-permissions.c, lib/gettime.c, lib/mktime.c: * lib/set-permissions.c, lib/stdlib.in.h, m4/acl.m4, m4/gettime.m4: Copy from Gnulib. * lib/gnulib.mk.in: Regenerate. diff --git a/admin/merge-gnulib b/admin/merge-gnulib index abb192911d..575e3fa74a 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -47,7 +47,7 @@ GNULIB_MODULES=' AVOIDED_MODULES=' btowc close dup fchdir fstat langinfo lock - malloc-posix mbrtowc mbsinit msvc-inval msvc-nothrow nl_langinfo + malloc-posix mbrtowc mbsinit mkdir msvc-inval msvc-nothrow nl_langinfo openat-die opendir raise save-cwd select setenv sigprocmask stat stdarg stdbool threadlib tzset unsetenv utime utime-h diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex index d7f7f53a34..5840aff4d7 100644 --- a/doc/misc/texinfo.tex +++ b/doc/misc/texinfo.tex @@ -3,7 +3,7 @@ % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -\def\texinfoversion{2018-06-02.09} +\def\texinfoversion{2018-09-21.20} % % Copyright 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995, % 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, @@ -8004,6 +8004,7 @@ \gdef\boldbrax{\let(=\opnr\let)=\clnr\let[=\lbrb\let]=\rbrb} \gdef\magicamp{\let&=\amprm} } +\let\ampchar\& \newcount\parencount diff --git a/lib/acl-internal.c b/lib/acl-internal.c index c62adb0d9d..92e7b9bdf5 100644 --- a/lib/acl-internal.c +++ b/lib/acl-internal.c @@ -23,7 +23,7 @@ #include "acl-internal.h" -#if USE_ACL && HAVE_ACL_GET_FILE +#if USE_ACL && HAVE_ACL_GET_FILE /* Linux, FreeBSD, Mac OS X, IRIX, Tru64, Cygwin >= 2.5 */ # if HAVE_ACL_TYPE_EXTENDED /* Mac OS X */ @@ -37,7 +37,7 @@ acl_extended_nontrivial (acl_t acl) return (acl_entries (acl) > 0); } -# else /* Linux, FreeBSD, IRIX, Tru64 */ +# else /* Linux, FreeBSD, IRIX, Tru64, Cygwin >= 2.5 */ /* ACL is an ACL, from a file, stored as type ACL_TYPE_ACCESS. Return 1 if the given ACL is non-trivial. @@ -51,7 +51,7 @@ acl_access_nontrivial (acl_t acl) at least, allowing us to write return (3 < acl_entries (acl)); but the following code is more robust. */ -# if HAVE_ACL_FIRST_ENTRY /* Linux, FreeBSD */ +# if HAVE_ACL_FIRST_ENTRY /* Linux, FreeBSD, Cygwin >= 2.5 */ acl_entry_t ace; int got_one; @@ -124,7 +124,7 @@ acl_default_nontrivial (acl_t acl) # endif -#elif USE_ACL && HAVE_FACL && defined GETACL /* Solaris, Cygwin, not HP-UX */ +#elif USE_ACL && HAVE_FACL && defined GETACL /* Solaris, Cygwin < 2.5, not HP-UX */ /* Test an ACL retrieved with GETACL. Return 1 if the given ACL, consisting of COUNT entries, is non-trivial. @@ -479,7 +479,7 @@ void free_permission_context (struct permission_context *ctx) { #if USE_ACL -# if HAVE_ACL_GET_FILE /* Linux, FreeBSD, Mac OS X, IRIX, Tru64 */ +# if HAVE_ACL_GET_FILE /* Linux, FreeBSD, Mac OS X, IRIX, Tru64, Cygwin >= 2.5 */ if (ctx->acl) acl_free (ctx->acl); # if !HAVE_ACL_TYPE_EXTENDED @@ -487,7 +487,7 @@ free_permission_context (struct permission_context *ctx) acl_free (ctx->default_acl); # endif -# elif defined GETACL /* Solaris, Cygwin */ +# elif defined GETACL /* Solaris, Cygwin < 2.5 */ free (ctx->entries); # ifdef ACE_GETACL free (ctx->ace_entries); diff --git a/lib/acl-internal.h b/lib/acl-internal.h index 0669d83c46..2da7c5a036 100644 --- a/lib/acl-internal.h +++ b/lib/acl-internal.h @@ -30,7 +30,8 @@ # define GETACLCNT ACL_CNT #endif -/* On Linux, additional ACL related API is available in . */ +/* On Linux and Cygwin >= 2.5, additional ACL related API is available in + . */ #ifdef HAVE_ACL_LIBACL_H # include #endif @@ -72,7 +73,7 @@ _GL_INLINE_HEADER_BEGIN # if HAVE_ACL_GET_FILE /* POSIX 1003.1e (draft 17 -- abandoned) specific version. */ -/* Linux, FreeBSD, Mac OS X, IRIX, Tru64 */ +/* Linux, FreeBSD, Mac OS X, IRIX, Tru64, Cygwin >= 2.5 */ # ifndef MIN_ACL_ENTRIES # define MIN_ACL_ENTRIES 4 @@ -122,7 +123,10 @@ rpl_acl_set_fd (int fd, acl_t acl) # endif /* Linux-specific */ -# ifndef HAVE_ACL_EXTENDED_FILE +/* Cygwin >= 2.5 implements this function, but it returns 1 for all + directories, thus is unusable. */ +# if !defined HAVE_ACL_EXTENDED_FILE || defined __CYGWIN__ +# undef HAVE_ACL_EXTENDED_FILE # define HAVE_ACL_EXTENDED_FILE false # define acl_extended_file(name) (-1) # endif @@ -163,7 +167,7 @@ extern int acl_access_nontrivial (acl_t); extern int acl_default_nontrivial (acl_t); # endif -# elif HAVE_FACL && defined GETACL /* Solaris, Cygwin, not HP-UX */ +# elif HAVE_FACL && defined GETACL /* Solaris, Cygwin < 2.5, not HP-UX */ /* Set to 0 if a file's mode is stored independently from the ACL. */ # if defined __CYGWIN__ /* Cygwin */ @@ -256,14 +260,14 @@ extern int acl_nontrivial (int count, struct acl *entries); struct permission_context { mode_t mode; #if USE_ACL -# if HAVE_ACL_GET_FILE /* Linux, FreeBSD, Mac OS X, IRIX, Tru64 */ +# if HAVE_ACL_GET_FILE /* Linux, FreeBSD, Mac OS X, IRIX, Tru64, Cygwin >= 2.5 */ acl_t acl; # if !HAVE_ACL_TYPE_EXTENDED acl_t default_acl; # endif bool acls_not_supported; -# elif defined GETACL /* Solaris, Cygwin */ +# elif defined GETACL /* Solaris, Cygwin < 2.5 */ int count; aclent_t *entries; # ifdef ACE_GETACL diff --git a/lib/acl_entries.c b/lib/acl_entries.c index 59dd420eaf..ce730d466e 100644 --- a/lib/acl_entries.c +++ b/lib/acl_entries.c @@ -22,7 +22,7 @@ #include "acl-internal.h" /* This file assumes POSIX-draft like ACLs - (Linux, FreeBSD, Mac OS X, IRIX, Tru64). */ + (Linux, FreeBSD, Mac OS X, IRIX, Tru64, Cygwin >= 2.5). */ /* Return the number of entries in ACL. Return -1 and set errno upon failure to determine it. */ @@ -34,7 +34,7 @@ acl_entries (acl_t acl) if (acl != NULL) { -#if HAVE_ACL_FIRST_ENTRY /* Linux, FreeBSD, Mac OS X */ +#if HAVE_ACL_FIRST_ENTRY /* Linux, FreeBSD, Mac OS X, Cygwin >= 2.5 */ # if HAVE_ACL_TYPE_EXTENDED /* Mac OS X */ /* acl_get_entry returns 0 when it successfully fetches an entry, and -1/EINVAL at the end. */ @@ -45,7 +45,7 @@ acl_entries (acl_t acl) got_one >= 0; got_one = acl_get_entry (acl, ACL_NEXT_ENTRY, &ace)) count++; -# else /* Linux, FreeBSD */ +# else /* Linux, FreeBSD, Cygwin >= 2.5 */ /* acl_get_entry returns 1 when it successfully fetches an entry, and 0 at the end. */ acl_entry_t ace; diff --git a/lib/explicit_bzero.c b/lib/explicit_bzero.c index 78ec747c3a..79b7fd66b6 100644 --- a/lib/explicit_bzero.c +++ b/lib/explicit_bzero.c @@ -27,9 +27,11 @@ #include +#if _LIBC /* glibc-internal users use __explicit_bzero_chk, and explicit_bzero redirects to that. */ -#undef explicit_bzero +# undef explicit_bzero +#endif /* Set LEN bytes of S to 0. The compiler will not delete a call to this function, even if S is dead after the call. */ diff --git a/lib/fcntl.c b/lib/fcntl.c index 8e976173c0..74e0f5d391 100644 --- a/lib/fcntl.c +++ b/lib/fcntl.c @@ -27,10 +27,10 @@ #include #include -#if !HAVE_FCNTL -# define rpl_fcntl fcntl +#ifdef __KLIBC__ +# define INCL_DOS +# include #endif -#undef fcntl #if defined _WIN32 && ! defined __CYGWIN__ /* Get declarations of the native Windows API functions. */ @@ -166,93 +166,18 @@ dupfd (int oldfd, int newfd, int flags) } #endif /* W32 */ +/* Forward declarations, because we '#undef fcntl' in the middle of this + compilation unit. */ +/* Our implementation of fcntl (fd, F_DUPFD, target). */ +static int rpl_fcntl_DUPFD (int fd, int target); +/* Our implementation of fcntl (fd, F_DUPFD_CLOEXEC, target). */ +static int rpl_fcntl_DUPFD_CLOEXEC (int fd, int target); #ifdef __KLIBC__ - -# define INCL_DOS -# include - -static int -klibc_fcntl (int fd, int action, /* arg */...) -{ - va_list arg_ptr; - int arg; - struct stat sbuf; - int result = -1; - - va_start (arg_ptr, action); - arg = va_arg (arg_ptr, int); - result = fcntl (fd, action, arg); - /* EPERM for F_DUPFD, ENOTSUP for others */ - if (result == -1 && (errno == EPERM || errno == ENOTSUP) - && !fstat (fd, &sbuf) && S_ISDIR (sbuf.st_mode)) - { - ULONG ulMode; - - switch (action) - { - case F_DUPFD: - /* Find available fd */ - while (fcntl (arg, F_GETFL) != -1 || errno != EBADF) - arg++; - - result = dup2 (fd, arg); - break; - - /* Using underlying APIs is right ? */ - case F_GETFD: - if (DosQueryFHState (fd, &ulMode)) - break; - - result = (ulMode & OPEN_FLAGS_NOINHERIT) ? FD_CLOEXEC : 0; - break; - - case F_SETFD: - if (arg & ~FD_CLOEXEC) - break; - - if (DosQueryFHState (fd, &ulMode)) - break; - - if (arg & FD_CLOEXEC) - ulMode |= OPEN_FLAGS_NOINHERIT; - else - ulMode &= ~OPEN_FLAGS_NOINHERIT; - - /* Filter supported flags. */ - ulMode &= (OPEN_FLAGS_WRITE_THROUGH | OPEN_FLAGS_FAIL_ON_ERROR - | OPEN_FLAGS_NO_CACHE | OPEN_FLAGS_NOINHERIT); - - if (DosSetFHState (fd, ulMode)) - break; - - result = 0; - break; - - case F_GETFL: - result = 0; - break; - - case F_SETFL: - if (arg != 0) - break; - - result = 0; - break; - - default : - errno = EINVAL; - break; - } - } - - va_end (arg_ptr); - - return result; -} - -# define fcntl klibc_fcntl +/* Adds support for fcntl on directories. */ +static int klibc_fcntl (int fd, int action, /* arg */...); #endif + /* Perform the specified ACTION on the file descriptor FD, possibly using the argument ARG further described below. This replacement handles the following actions, and forwards all others on to the @@ -273,112 +198,30 @@ klibc_fcntl (int fd, int action, /* arg */...) return -1 and set errno. */ int -rpl_fcntl (int fd, int action, /* arg */...) +fcntl (int fd, int action, /* arg */...) +#undef fcntl +#ifdef __KLIBC__ +# define fcntl klibc_fcntl +#endif { va_list arg; int result = -1; va_start (arg, action); switch (action) { - -#if !HAVE_FCNTL case F_DUPFD: { int target = va_arg (arg, int); - result = dupfd (fd, target, 0); + result = rpl_fcntl_DUPFD (fd, target); break; } -#elif FCNTL_DUPFD_BUGGY || REPLACE_FCHDIR - case F_DUPFD: - { - int target = va_arg (arg, int); - /* Detect invalid target; needed for cygwin 1.5.x. */ - if (target < 0 || getdtablesize () <= target) - errno = EINVAL; - else - { - /* Haiku alpha 2 loses fd flags on original. */ - int flags = fcntl (fd, F_GETFD); - if (flags < 0) - { - result = -1; - break; - } - result = fcntl (fd, action, target); - if (0 <= result && fcntl (fd, F_SETFD, flags) == -1) - { - int saved_errno = errno; - close (result); - result = -1; - errno = saved_errno; - } -# if REPLACE_FCHDIR - if (0 <= result) - result = _gl_register_dup (fd, result); -# endif - } - break; - } /* F_DUPFD */ -#endif /* FCNTL_DUPFD_BUGGY || REPLACE_FCHDIR */ case F_DUPFD_CLOEXEC: { int target = va_arg (arg, int); - -#if !HAVE_FCNTL - result = dupfd (fd, target, O_CLOEXEC); + result = rpl_fcntl_DUPFD_CLOEXEC (fd, target); break; -#else /* HAVE_FCNTL */ -# if defined __HAIKU__ - /* On Haiku, the system fcntl (fd, F_DUPFD_CLOEXEC, target) sets - the FD_CLOEXEC flag on fd, not on target. Therefore avoid the - system fcntl in this case. */ -# define have_dupfd_cloexec -1 -# else - /* Try the system call first, if the headers claim it exists - (that is, if GNULIB_defined_F_DUPFD_CLOEXEC is 0), since we - may be running with a glibc that has the macro but with an - older kernel that does not support it. Cache the - information on whether the system call really works, but - avoid caching failure if the corresponding F_DUPFD fails - for any reason. 0 = unknown, 1 = yes, -1 = no. */ - static int have_dupfd_cloexec = GNULIB_defined_F_DUPFD_CLOEXEC ? -1 : 0; - if (0 <= have_dupfd_cloexec) - { - result = fcntl (fd, action, target); - if (0 <= result || errno != EINVAL) - { - have_dupfd_cloexec = 1; -# if REPLACE_FCHDIR - if (0 <= result) - result = _gl_register_dup (fd, result); -# endif - } - else - { - result = rpl_fcntl (fd, F_DUPFD, target); - if (result < 0) - break; - have_dupfd_cloexec = -1; - } - } - else -# endif - result = rpl_fcntl (fd, F_DUPFD, target); - if (0 <= result && have_dupfd_cloexec == -1) - { - int flags = fcntl (result, F_GETFD); - if (flags < 0 || fcntl (result, F_SETFD, flags | FD_CLOEXEC) == -1) - { - int saved_errno = errno; - close (result); - errno = saved_errno; - result = -1; - } - } - break; -#endif /* HAVE_FCNTL */ - } /* F_DUPFD_CLOEXEC */ + } #if !HAVE_FCNTL case F_GETFD: @@ -598,3 +441,186 @@ rpl_fcntl (int fd, int action, /* arg */...) va_end (arg); return result; } + +static int +rpl_fcntl_DUPFD (int fd, int target) +{ + int result; +#if !HAVE_FCNTL + result = dupfd (fd, target, 0); +#elif FCNTL_DUPFD_BUGGY || REPLACE_FCHDIR + /* Detect invalid target; needed for cygwin 1.5.x. */ + if (target < 0 || getdtablesize () <= target) + { + result = -1; + errno = EINVAL; + } + else + { + /* Haiku alpha 2 loses fd flags on original. */ + int flags = fcntl (fd, F_GETFD); + if (flags < 0) + result = -1; + else + { + result = fcntl (fd, F_DUPFD, target); + if (0 <= result && fcntl (fd, F_SETFD, flags) == -1) + { + int saved_errno = errno; + close (result); + result = -1; + errno = saved_errno; + } +# if REPLACE_FCHDIR + if (0 <= result) + result = _gl_register_dup (fd, result); +# endif + } + } +#else + result = fcntl (fd, F_DUPFD, target); +#endif + return result; +} + +static int +rpl_fcntl_DUPFD_CLOEXEC (int fd, int target) +{ + int result; +#if !HAVE_FCNTL + result = dupfd (fd, target, O_CLOEXEC); +#else /* HAVE_FCNTL */ +# if defined __HAIKU__ + /* On Haiku, the system fcntl (fd, F_DUPFD_CLOEXEC, target) sets + the FD_CLOEXEC flag on fd, not on target. Therefore avoid the + system fcntl in this case. */ +# define have_dupfd_cloexec -1 +# else + /* Try the system call first, if the headers claim it exists + (that is, if GNULIB_defined_F_DUPFD_CLOEXEC is 0), since we + may be running with a glibc that has the macro but with an + older kernel that does not support it. Cache the + information on whether the system call really works, but + avoid caching failure if the corresponding F_DUPFD fails + for any reason. 0 = unknown, 1 = yes, -1 = no. */ + static int have_dupfd_cloexec = GNULIB_defined_F_DUPFD_CLOEXEC ? -1 : 0; + if (0 <= have_dupfd_cloexec) + { + result = fcntl (fd, F_DUPFD_CLOEXEC, target); + if (0 <= result || errno != EINVAL) + { + have_dupfd_cloexec = 1; +# if REPLACE_FCHDIR + if (0 <= result) + result = _gl_register_dup (fd, result); +# endif + } + else + { + result = rpl_fcntl_DUPFD (fd, target); + if (result >= 0) + have_dupfd_cloexec = -1; + } + } + else +# endif + result = rpl_fcntl_DUPFD (fd, target); + if (0 <= result && have_dupfd_cloexec == -1) + { + int flags = fcntl (result, F_GETFD); + if (flags < 0 || fcntl (result, F_SETFD, flags | FD_CLOEXEC) == -1) + { + int saved_errno = errno; + close (result); + errno = saved_errno; + result = -1; + } + } +#endif /* HAVE_FCNTL */ + return result; +} + +#undef fcntl + +#ifdef __KLIBC__ + +static int +klibc_fcntl (int fd, int action, /* arg */...); +{ + va_list arg_ptr; + int arg; + struct stat sbuf; + int result; + + va_start (arg_ptr, action); + arg = va_arg (arg_ptr, int); + result = fcntl (fd, action, arg); + /* EPERM for F_DUPFD, ENOTSUP for others */ + if (result == -1 && (errno == EPERM || errno == ENOTSUP) + && !fstat (fd, &sbuf) && S_ISDIR (sbuf.st_mode)) + { + ULONG ulMode; + + switch (action) + { + case F_DUPFD: + /* Find available fd */ + while (fcntl (arg, F_GETFL) != -1 || errno != EBADF) + arg++; + + result = dup2 (fd, arg); + break; + + /* Using underlying APIs is right ? */ + case F_GETFD: + if (DosQueryFHState (fd, &ulMode)) + break; + + result = (ulMode & OPEN_FLAGS_NOINHERIT) ? FD_CLOEXEC : 0; + break; + + case F_SETFD: + if (arg & ~FD_CLOEXEC) + break; + + if (DosQueryFHState (fd, &ulMode)) + break; + + if (arg & FD_CLOEXEC) + ulMode |= OPEN_FLAGS_NOINHERIT; + else + ulMode &= ~OPEN_FLAGS_NOINHERIT; + + /* Filter supported flags. */ + ulMode &= (OPEN_FLAGS_WRITE_THROUGH | OPEN_FLAGS_FAIL_ON_ERROR + | OPEN_FLAGS_NO_CACHE | OPEN_FLAGS_NOINHERIT); + + if (DosSetFHState (fd, ulMode)) + break; + + result = 0; + break; + + case F_GETFL: + result = 0; + break; + + case F_SETFL: + if (arg != 0) + break; + + result = 0; + break; + + default: + errno = EINVAL; + break; + } + } + + va_end (arg_ptr); + + return result; +} + +#endif diff --git a/lib/get-permissions.c b/lib/get-permissions.c index 83ba2639a1..3b98451095 100644 --- a/lib/get-permissions.c +++ b/lib/get-permissions.c @@ -38,9 +38,9 @@ get_permissions (const char *name, int desc, mode_t mode, #if USE_ACL && HAVE_ACL_GET_FILE /* POSIX 1003.1e (draft 17 -- abandoned) specific version. */ - /* Linux, FreeBSD, Mac OS X, IRIX, Tru64 */ + /* Linux, FreeBSD, Mac OS X, IRIX, Tru64, Cygwin >= 2.5 */ # if !HAVE_ACL_TYPE_EXTENDED - /* Linux, FreeBSD, IRIX, Tru64 */ + /* Linux, FreeBSD, IRIX, Tru64, Cygwin >= 2.5 */ if (HAVE_ACL_GET_FD && desc != -1) ctx->acl = acl_get_fd (desc); @@ -60,13 +60,13 @@ get_permissions (const char *name, int desc, mode_t mode, return -1; } -# if HAVE_ACL_TYPE_NFS4 /* FreeBSD */ +# if HAVE_ACL_TYPE_NFS4 /* FreeBSD */ /* TODO (see set_permissions). */ -# endif +# endif -# else /* HAVE_ACL_TYPE_EXTENDED */ +# else /* HAVE_ACL_TYPE_EXTENDED */ /* Mac OS X */ /* On Mac OS X, acl_get_file (name, ACL_TYPE_ACCESS) diff --git a/lib/gettime.c b/lib/gettime.c index 171f22476f..bb59c44ff0 100644 --- a/lib/gettime.c +++ b/lib/gettime.c @@ -30,8 +30,6 @@ gettime (struct timespec *ts) { #if defined CLOCK_REALTIME && HAVE_CLOCK_GETTIME clock_gettime (CLOCK_REALTIME, ts); -#elif HAVE_NANOTIME - nanotime (ts); #else struct timeval tv; gettimeofday (&tv, NULL); diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 2e265b3068..431d0c0b77 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -44,6 +44,7 @@ # --avoid=malloc-posix \ # --avoid=mbrtowc \ # --avoid=mbsinit \ +# --avoid=mkdir \ # --avoid=msvc-inval \ # --avoid=msvc-nothrow \ # --avoid=nl_langinfo \ diff --git a/lib/mktime.c b/lib/mktime.c index 6953e984e5..557712fdaa 100644 --- a/lib/mktime.c +++ b/lib/mktime.c @@ -78,7 +78,7 @@ #include "mktime-internal.h" -#ifndef _LIBC +#if !defined _LIBC && (NEED_MKTIME_WORKING || NEED_MKTIME_WINDOWS) static void my_tzset (void) { @@ -527,7 +527,7 @@ mktime (struct tm *tp) be set as if the tzset() function had been called. */ __tzset (); -# if defined __LIBC || NEED_MKTIME_WORKING +# if defined _LIBC || NEED_MKTIME_WORKING static mktime_offset_t localtime_offset; return __mktime_internal (tp, __localtime_r, &localtime_offset); # else diff --git a/lib/set-permissions.c b/lib/set-permissions.c index d42335aa50..a415e133ac 100644 --- a/lib/set-permissions.c +++ b/lib/set-permissions.c @@ -24,7 +24,7 @@ #include "acl-internal.h" #if USE_ACL -# if ! defined HAVE_ACL_FROM_MODE && defined HAVE_ACL_FROM_TEXT /* FreeBSD, IRIX, Tru64 */ +# if ! defined HAVE_ACL_FROM_MODE && defined HAVE_ACL_FROM_TEXT /* FreeBSD, IRIX, Tru64, Cygwin >= 2.5 */ # if HAVE_ACL_GET_FILE && !HAVE_ACL_TYPE_EXTENDED static acl_t @@ -32,7 +32,7 @@ acl_from_mode (mode_t mode) { # if HAVE_ACL_FREE_TEXT /* Tru64 */ char acl_text[] = "u::---,g::---,o::---,"; -# else /* FreeBSD, IRIX */ +# else /* FreeBSD, IRIX, Cygwin >= 2.5 */ char acl_text[] = "u::---,g::---,o::---"; # endif @@ -51,7 +51,7 @@ acl_from_mode (mode_t mode) # endif # endif -# if HAVE_FACL && defined GETACL /* Solaris, Cygwin, not HP-UX */ +# if HAVE_FACL && defined GETACL /* Solaris, Cygwin < 2.5, not HP-UX */ static int set_acls_from_mode (const char *name, int desc, mode_t mode, bool *must_chmod) { @@ -489,9 +489,9 @@ set_acls (struct permission_context *ctx, const char *name, int desc, # if HAVE_ACL_GET_FILE /* POSIX 1003.1e (draft 17 -- abandoned) specific version. */ - /* Linux, FreeBSD, Mac OS X, IRIX, Tru64 */ + /* Linux, FreeBSD, Mac OS X, IRIX, Tru64, Cygwin >= 2.5 */ # if !HAVE_ACL_TYPE_EXTENDED - /* Linux, FreeBSD, IRIX, Tru64 */ + /* Linux, FreeBSD, IRIX, Tru64, Cygwin >= 2.5 */ # ifndef HAVE_ACL_FROM_TEXT # error Must have acl_from_text (see POSIX 1003.1e draft 17). @@ -542,14 +542,14 @@ set_acls (struct permission_context *ctx, const char *name, int desc, } } -# if HAVE_ACL_TYPE_NFS4 /* FreeBSD */ +# if HAVE_ACL_TYPE_NFS4 /* FreeBSD */ /* File systems either support POSIX ACLs (for example, ufs) or NFS4 ACLs (for example, zfs). */ /* TODO: Implement setting ACLs once get_permissions() reads them. */ -# endif +# endif # else /* HAVE_ACL_TYPE_EXTENDED */ /* Mac OS X */ diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h index 3bf35bf6b0..441c018ec1 100644 --- a/lib/stdlib.in.h +++ b/lib/stdlib.in.h @@ -90,9 +90,10 @@ struct random_data # endif #endif -#if (@GNULIB_MKSTEMP@ || @GNULIB_MKSTEMPS@ || @GNULIB_GETSUBOPT@ || defined GNULIB_POSIXCHECK) && ! defined __GLIBC__ && !(defined _WIN32 && ! defined __CYGWIN__) +#if (@GNULIB_MKSTEMP@ || @GNULIB_MKSTEMPS@ || @GNULIB_MKOSTEMP@ || @GNULIB_MKOSTEMPS@ || @GNULIB_GETSUBOPT@ || defined GNULIB_POSIXCHECK) && ! defined __GLIBC__ && !(defined _WIN32 && ! defined __CYGWIN__) /* On Mac OS X 10.3, only declares mkstemp. */ /* On Mac OS X 10.5, only declares mkstemps. */ +/* On Mac OS X 10.13, only declares mkostemp and mkostemps. */ /* On Cygwin 1.7.1, only declares getsubopt. */ /* But avoid namespace pollution on glibc systems and native Windows. */ # include diff --git a/m4/acl.m4 b/m4/acl.m4 index 485cf9af08..b64aa849c8 100644 --- a/m4/acl.m4 +++ b/m4/acl.m4 @@ -1,5 +1,5 @@ # acl.m4 - check for access control list (ACL) primitives -# serial 22 +# serial 23 # Copyright (C) 2002, 2004-2018 Free Software Foundation, Inc. # This file is free software; the Free Software Foundation @@ -30,7 +30,8 @@ AC_DEFUN([gl_FUNC_ACL], ac_save_LIBS=$LIBS dnl Test for POSIX-draft-like API (GNU/Linux, FreeBSD, Mac OS X, - dnl IRIX, Tru64). -lacl is needed on GNU/Linux, -lpacl on OSF/1. + dnl IRIX, Tru64, Cygwin >= 2.5). + dnl -lacl is needed on GNU/Linux, -lpacl on OSF/1. if test $use_acl = 0; then AC_SEARCH_LIBS([acl_get_file], [acl pacl], [if test "$ac_cv_search_acl_get_file" != "none required"; then diff --git a/m4/gettime.m4 b/m4/gettime.m4 index ad355463cc..671b70d5ab 100644 --- a/m4/gettime.m4 +++ b/m4/gettime.m4 @@ -1,4 +1,4 @@ -# gettime.m4 serial 8 +# gettime.m4 serial 9 dnl Copyright (C) 2002, 2004-2006, 2009-2018 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -9,5 +9,5 @@ AC_DEFUN([gl_GETTIME], dnl Prerequisites of lib/gettime.c. AC_REQUIRE([gl_CLOCK_TIME]) AC_REQUIRE([gl_TIMESPEC]) - AC_CHECK_FUNCS_ONCE([gettimeofday nanotime]) + AC_CHECK_FUNCS_ONCE([gettimeofday]) ]) commit fc6004e61760d3bd3e27b593c318e634a221652c Author: Stefan Monnier Date: Mon Oct 8 20:59:59 2018 -0400 * lisp/net/ntlm.el: Use lexical-binding (ntlm-string-as-unibyte): Remove. (ntlm-build-auth-response): Use encode-coding-string instead. (ntlm-build-auth-request, ntlm-build-auth-response, ntlm-ascii2unicode) (ntlm-smb-owf-encrypt, ntlm-smb-hash, ntlm-smb-dohash, ntlm-md4hash): Use fewer setq more Lisp-style. diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el index 7a68c68ab6..142c37510e 100644 --- a/lisp/net/ntlm.el +++ b/lisp/net/ntlm.el @@ -1,4 +1,4 @@ -;;; ntlm.el --- NTLM (NT LanManager) authentication support +;;; ntlm.el --- NTLM (NT LanManager) authentication support -*- lexical-binding:t -*- ;; Copyright (C) 2001, 2007-2018 Free Software Foundation, Inc. @@ -106,7 +106,7 @@ is not given." (request-flags (concat (make-string 1 7) (make-string 1 130) (make-string 1 8) (make-string 1 0))) ;0x07 0x82 0x08 0x00 - lu ld off-d off-u) + ) (when (and user (string-match "@" user)) (unless domain (setq domain (substring user (1+ (match-beginning 0))))) @@ -115,10 +115,10 @@ is not given." ;; set "negotiate domain supplied" bit (aset request-flags 1 (logior (aref request-flags 1) ?\x10))) ;; set fields offsets within the request struct - (setq lu (length user)) - (setq ld (length domain)) - (setq off-u 32) ;offset to the string 'user - (setq off-d (+ 32 lu)) ;offset to the string 'domain + (let* ((lu (length user)) + (ld (length domain)) + (off-u 32) ;offset to the string 'user + (off-d (+ 32 lu))) ;offset to the string 'domain ;; pack the request struct in a string (concat request-ident ;8 bytes request-msgType ;4 bytes @@ -131,24 +131,20 @@ is not given." (md4-pack-int32 (cons 0 off-d)) ;domain field, offset field user ;buffer field domain ;buffer field - ))) - -(eval-when-compile - (defmacro ntlm-string-as-unibyte (string) - (if (fboundp 'string-as-unibyte) - `(string-as-unibyte ,string) - string))) + )))) (defun ntlm-compute-timestamp () "Compute an NTLMv2 timestamp. Return a unibyte string representing the number of tenths of a microsecond since January 1, 1601 as a 64-bit little-endian signed integer." + ;; FIXME: This can likely be significantly simplified using the new + ;; bignums support! (let* ((s-to-tenths-of-us "mul(add(lsh($1,16),$2),10000000)") (us-to-tenths-of-us "mul($3,10)") (ps-to-tenths-of-us "idiv($4,100000)") (tenths-of-us-since-jan-1-1601 - (apply 'calc-eval (concat "add(add(add(" + (apply #'calc-eval (concat "add(add(add(" s-to-tenths-of-us "," us-to-tenths-of-us ")," ps-to-tenths-of-us ")," @@ -157,12 +153,12 @@ signed integer." "116444736000000000)") 'rawnum (encode-time nil 'list))) result-bytes) - (dotimes (byte 8) + (dotimes (_byte 8) (push (calc-eval "and($1,16#FF)" 'rawnum tenths-of-us-since-jan-1-1601) result-bytes) (setq tenths-of-us-since-jan-1-1601 (calc-eval "rsh($1,8,64)" 'rawnum tenths-of-us-since-jan-1-1601))) - (apply 'unibyte-string (nreverse result-bytes)))) + (apply #'unibyte-string (nreverse result-bytes)))) (defun ntlm-generate-nonce () "Generate a random nonce, not to be used more than once. @@ -177,7 +173,13 @@ the NTLM based server for the user USER and the password hash list PASSWORD-HASHES. NTLM uses two hash values which are represented by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of (list (ntlm-smb-passwd-hash password) (ntlm-md4hash password))" - (let* ((rchallenge (ntlm-string-as-unibyte challenge)) + (let* ((rchallenge (if (multibyte-string-p challenge) + (progn + ;; FIXME: Maybe it would be better to + ;; signal an error. + (message "Incorrect challenge string type in ntlm-build-auth-response") + (encode-coding-string challenge 'binary)) + challenge)) ;; get fields within challenge struct ;;(ident (substring rchallenge 0 8)) ;ident, 8 bytes ;;(msgType (substring rchallenge 8 12)) ;msgType, 4 bytes @@ -188,20 +190,16 @@ by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of ;0x07 0x82 0x08 0x00 (flags (substring rchallenge 20 24)) ;flags, 4 bytes (challengeData (substring rchallenge 24 32)) ;challengeData, 8 bytes - uDomain-len uDomain-offs - ;; response struct and its fields + ;; Extract domain string from challenge string. + ;;(uDomain-len (md4-unpack-int16 (substring uDomain 0 2))) + (uDomain-offs (md4-unpack-int32 (substring uDomain 4 8))) + ;; Response struct and its fields. lmRespData ;lmRespData, 24 bytes ntRespData ;ntRespData, variable length - domain ;ascii domain string - workstation ;ascii workstation string - ll ln lu ld lw off-lm off-nt off-u off-d off-w) - ;; extract domain string from challenge string - (setq uDomain-len (md4-unpack-int16 (substring uDomain 0 2))) - (setq uDomain-offs (md4-unpack-int32 (substring uDomain 4 8))) - ;; match Mozilla behavior, which is to send an empty domain string - (setq domain "") - ;; match Mozilla behavior, which is to send "WORKSTATION" - (setq workstation "WORKSTATION") + ;; Match Mozilla behavior, which is to send an empty domain string + (domain "") ;ascii domain string + ;; Match Mozilla behavior, which is to send "WORKSTATION". + (workstation "WORKSTATION")) ;ascii workstation string ;; overwrite domain in case user is given in @ format (when (string-match "@" user) (setq domain (substring user (1+ (match-beginning 0)))) @@ -260,13 +258,11 @@ by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of ;; so just treat it the same as levels 0 and 1 ;; check if "negotiate NTLM2 key" flag is set in type 2 message (if (not (zerop (logand (aref flags 2) 8))) - (let (randomString - sessionHash) - ;; generate NTLM2 session response data - (setq randomString (ntlm-generate-nonce)) - (setq sessionHash (secure-hash 'md5 + ;; generate NTLM2 session response data + (let* ((randomString (ntlm-generate-nonce)) + (sessionHash (secure-hash 'md5 (concat challengeData randomString) - nil nil t)) + nil nil t))) (setq sessionHash (substring sessionHash 0 8)) (setq lmRespData (concat randomString (make-string 16 0))) (setq ntRespData (ntlm-smb-owf-encrypt @@ -278,16 +274,16 @@ by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of (ntlm-smb-owf-encrypt (cadr password-hashes) challengeData)))) ;; get offsets to fields to pack the response struct in a string - (setq ll (length lmRespData)) - (setq ln (length ntRespData)) - (setq lu (length user)) - (setq ld (length domain)) - (setq lw (length workstation)) - (setq off-u 64) ;offset to string 'uUser - (setq off-d (+ off-u (* 2 lu))) ;offset to string 'uDomain - (setq off-w (+ off-d (* 2 ld))) ;offset to string 'uWks - (setq off-lm (+ off-w (* 2 lw))) ;offset to string 'lmResponse - (setq off-nt (+ off-lm ll)) ;offset to string 'ntResponse + (let* ((ll (length lmRespData)) + (ln (length ntRespData)) + (lu (length user)) + (ld (length domain)) + (lw (length workstation)) + (off-u 64) ;offset to string 'uUser + (off-d (+ off-u (* 2 lu))) ;offset to string 'uDomain + (off-w (+ off-d (* 2 ld))) ;offset to string 'uWks + (off-lm (+ off-w (* 2 lw))) ;offset to string 'lmResponse + (off-nt (+ off-lm ll))) ;offset to string 'ntResponse ;; pack the response struct in a string (concat "NTLMSSP\0" ;response ident field, 8 bytes (md4-pack-int32 '(0 . 3)) ;response msgType field, 4 bytes @@ -341,7 +337,7 @@ by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of (ntlm-ascii2unicode workstation lw) ;Unicode workstation, 2*lw bytes lmRespData ;lmResponse, 24 bytes ntRespData ;ntResponse, ln bytes - ))) + )))) (defun ntlm-get-password-hashes (password) "Return a pair of SMB hash and NT MD4 hash of the given password PASSWORD." @@ -351,7 +347,10 @@ by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of (defun ntlm-ascii2unicode (str len) "Convert an ASCII string into a NT Unicode string, which is little-endian utf16." - (let ((utf (make-string (* 2 len) 0)) (i 0) val) + ;; FIXME: Can't we use encode-coding-string with a `utf-16le' coding system? + (let ((utf (make-string (* 2 len) 0)) + (i 0) + val) (while (and (< i len) (not (zerop (setq val (aref str i))))) (aset utf (* 2 i) val) @@ -380,9 +379,9 @@ string PASSWD. PASSWD is truncated to 14 bytes if longer." "Return the response string of 24 bytes long for the given password string PASSWD based on the DES encryption. PASSWD is of at most 14 bytes long and the challenge string C8 of 8 bytes long." - (let ((len (min (length passwd) 16)) p22) - (setq p22 (concat (substring passwd 0 len) ;fill top 16 bytes with passwd - (make-string (- 22 len) 0))) + (let* ((len (min (length passwd) 16)) + (p22 (concat (substring passwd 0 len) ;Fill top 16 bytes with passwd. + (make-string (- 22 len) 0)))) (ntlm-smb-des-e-p24 p22 c8))) (defun ntlm-smb-des-e-p24 (p22 c8) @@ -404,26 +403,26 @@ string C8." "Return the hash string of length 8 for a string IN of length 8 and a string KEY of length 8. FORW is t or nil." (let ((out (make-string 8 0)) - outb ;string of length 64 (inb (make-string 64 0)) (keyb (make-string 64 0)) (key2 (ntlm-smb-str-to-key key)) - (i 0) aa) + (i 0)) (while (< i 64) (unless (zerop (logand (aref in (/ i 8)) (ash 1 (- 7 (% i 8))))) (aset inb i 1)) (unless (zerop (logand (aref key2 (/ i 8)) (ash 1 (- 7 (% i 8))))) (aset keyb i 1)) (setq i (1+ i))) - (setq outb (ntlm-smb-dohash inb keyb forw)) - (setq i 0) - (while (< i 64) - (unless (zerop (aref outb i)) - (setq aa (aref out (/ i 8))) - (aset out (/ i 8) - (logior aa (ash 1 (- 7 (% i 8)))))) - (setq i (1+ i))) - out)) + (let ((outb (ntlm-smb-dohash inb keyb forw)) + aa) + (setq i 0) + (while (< i 64) + (unless (zerop (aref outb i)) + (setq aa (aref out (/ i 8))) + (aset out (/ i 8) + (logior aa (ash 1 (- 7 (% i 8)))))) + (setq i (1+ i))) + out))) (defun ntlm-smb-str-to-key (str) "Return a string of length 8 for the given string STR of length 7." @@ -570,27 +569,22 @@ length of STR is LEN." "Return the hash value for a string IN and a string KEY. Length of IN and KEY are 64. FORW non-nil means forward, nil means backward." - (let (pk1 ;string of length 56 - c ;string of length 28 - d ;string of length 28 - cd ;string of length 56 - (ki (make-vector 16 0)) ;vector of string of length 48 - pd1 ;string of length 64 - l ;string of length 32 - r ;string of length 32 - rl ;string of length 64 - (i 0) (j 0) (k 0)) - (setq pk1 (ntlm-string-permute key ntlm-smb-perm1 56)) - (setq c (substring pk1 0 28)) - (setq d (substring pk1 28 56)) - - (setq i 0) - (while (< i 16) + (let* ((pk1 (ntlm-string-permute key ntlm-smb-perm1 56)) ;string of length 56 + (c (substring pk1 0 28)) ;string of length 28 + (d (substring pk1 28 56)) ;string of length 28 + cd ;string of length 56 + (ki (make-vector 16 0)) ;vector of string of length 48 + pd1 ;string of length 64 + l ;string of length 32 + r ;string of length 32 + rl ;string of length 64 + (i 0) (j 0) (k 0)) + + (dotimes (i 16) (setq c (ntlm-string-lshift c (aref ntlm-smb-sc i) 28)) (setq d (ntlm-string-lshift d (aref ntlm-smb-sc i) 28)) (setq cd (concat (substring c 0 28) (substring d 0 28))) - (aset ki i (ntlm-string-permute cd ntlm-smb-perm2 48)) - (setq i (1+ i))) + (aset ki i (ntlm-string-permute cd ntlm-smb-perm2 48))) (setq pd1 (ntlm-string-permute in ntlm-smb-perm3 64)) @@ -649,16 +643,12 @@ backward." (defun ntlm-md4hash (passwd) "Return the 16 bytes MD4 hash of a string PASSWD after converting it into a Unicode string. PASSWD is truncated to 128 bytes if longer." - (let (len wpwd) - ;; Password cannot be longer than 128 characters - (setq len (length passwd)) - (if (> len 128) - (setq len 128)) - ;; Password must be converted to NT Unicode - (setq wpwd (ntlm-ascii2unicode passwd len)) - ;; Calculate length in bytes - (setq len (* len 2)) - (md4 wpwd len))) + (let* ((len (min (length passwd) 128)) ;Pwd can't be > than 128 characters. + ;; Password must be converted to NT Unicode. + (wpwd (ntlm-ascii2unicode passwd len))) + (md4 wpwd + ;; Calculate length in bytes. + (* len 2)))) (provide 'ntlm) commit 4cf1eb8062d258338ceb83d5c0703f4000cd8181 Author: Eli Zaretskii Date: Mon Oct 8 23:14:59 2018 +0300 ; * src/data.c (Fkeywordp): Remove inaccurate commentary. (Bug#32979) diff --git a/src/data.c b/src/data.c index 4569f00242..8d58cbd941 100644 --- a/src/data.c +++ b/src/data.c @@ -344,8 +344,6 @@ DEFUN ("symbolp", Fsymbolp, Ssymbolp, 1, 1, 0, return Qnil; } -/* Define this in C to avoid unnecessarily consing up the symbol - name. */ DEFUN ("keywordp", Fkeywordp, Skeywordp, 1, 1, 0, doc: /* Return t if OBJECT is a keyword. This means that it is a symbol with a print name beginning with `:' commit 763721613bd478396dec11c8ccf145927ae70a48 Author: Charles A. Roelli Date: Mon Oct 8 21:49:41 2018 +0200 New hook 'vc-retrieve-tag-hook' (Bug#32754) * etc/NEWS: Mention the new variable. * lisp/vc/vc.el (vc-retrieve-tag-hook): New hook. (vc-retrieve-tag): Run the new hook and update its documentation string. diff --git a/etc/NEWS b/etc/NEWS index 020450c957..ee74e86f40 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -329,6 +329,8 @@ git-grep when 'vc-git-grep' is used. When some files are marked, only those are stashed. When no files are marked, all modified files are stashed, as before. +*** The new hook 'vc-retrieve-tag-hook' runs after retrieving a tag. + ** diff-mode *** Hunks are now automatically refined by default. To disable it, set the new defcustom 'diff-font-lock-refine' to nil. diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 6962664d59..7707999636 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -834,6 +834,13 @@ See `run-hooks'." :type 'hook :group 'vc) +;;;###autoload +(defcustom vc-retrieve-tag-hook nil + "Normal hook (list of functions) run after retrieving a tag." + :type 'hook + :group 'vc + :version "27.1") + (defcustom vc-revert-show-diff t "If non-nil, `vc-revert' shows a `vc-diff' buffer before querying." :type 'boolean @@ -2153,7 +2160,8 @@ otherwise use the repository root of the current buffer. If NAME is empty, it refers to the latest revisions of the current branch. If locking is used for the files in DIR, then there must not be any locked files at or below DIR (but if NAME is empty, locked files are -allowed and simply skipped)." +allowed and simply skipped). +This function runs the hook `vc-retrieve-tag-hook' when finished." (interactive (let* ((granularity (vc-call-backend (vc-responsible-backend default-directory) @@ -2180,6 +2188,7 @@ allowed and simply skipped)." (vc-call-backend (vc-responsible-backend dir) 'retrieve-tag dir name update) (vc-resynch-buffer dir t t t) + (run-hooks 'vc-retrieve-tag-hook) (message "%s" (concat msg "done")))) commit 3f1470d96fa8f71a6b5fe87396b2054309c6a59c Author: Charles A. Roelli Date: Mon Oct 8 19:21:41 2018 +0200 * doc/emacs/mark.texi (Mark): Index "(de)activating the mark". (Bug#32956) diff --git a/doc/emacs/mark.texi b/doc/emacs/mark.texi index 0ffa9f74ac..10505873c5 100644 --- a/doc/emacs/mark.texi +++ b/doc/emacs/mark.texi @@ -17,11 +17,13 @@ one comes earlier in the text; each time you move point, the region changes. @cindex active region +@cindex activating the mark Setting the mark at a position in the text also @dfn{activates} it. When the mark is active, we say also that the region is active; Emacs indicates its extent by highlighting the text within it, using the @code{region} face (@pxref{Face Customization}). +@cindex deactivating the mark After certain non-motion commands, including any command that changes the text in the buffer, Emacs automatically @dfn{deactivates} the mark; this turns off the highlighting. You can also explicitly commit 940ae156043c27101759c1577697d3a09d5bc948 Author: Scott Corley Date: Sun Oct 7 23:21:40 2018 -0700 Fix overflow lockup with frames > 255 lines Backport from master. * src/scroll.c (struct matrix_elt): Change unsigned char fields to int to handle frames with more than 255 lines (Bug#32951). Copyright-paperwork-exempt: yes diff --git a/src/scroll.c b/src/scroll.c index 8a53f9614f..7751a0885a 100644 --- a/src/scroll.c +++ b/src/scroll.c @@ -47,13 +47,13 @@ struct matrix_elt int deletecost; /* Number of inserts so far in this run of inserts, for the cost in insertcost. */ - unsigned char insertcount; + int insertcount; /* Number of deletes so far in this run of deletes, for the cost in deletecost. */ - unsigned char deletecount; + int deletecount; /* Number of writes so far since the last insert or delete for the cost in writecost. */ - unsigned char writecount; + int writecount; }; static void do_direct_scrolling (struct frame *, commit a0605d96187bc4103a982cededcd12e2628aba66 Author: Eli Zaretskii Date: Sun Oct 7 20:51:11 2018 +0300 Fix MinGW compilation problem in timefns.c * src/timefns.c (lisp_to_timespec): Fix a mismatch between time_t and timespec.tv_sec data types. diff --git a/src/timefns.c b/src/timefns.c index 7bce3b1e50..c94d97d9a8 100644 --- a/src/timefns.c +++ b/src/timefns.c @@ -896,8 +896,14 @@ lisp_to_timespec (struct lisp_time t) ns = mpz_fdiv_q_ui (*q, *q, TIMESPEC_HZ); } - if (mpz_time (*q, &result.tv_sec)) - result.tv_nsec = ns; + /* With some versions of MinGW, tv_sec is a 64-bit type, whereas + time_t is a 32-bit type. */ + time_t sec; + if (mpz_time (*q, &sec)) + { + result.tv_sec = sec; + result.tv_nsec = ns; + } return result; } commit 14c032d5f8d4ccb608cc906db34ddf17ce465449 Author: Eli Zaretskii Date: Sun Oct 7 17:45:12 2018 +0300 Avoid assertion violations in nonsensical calls to 'signal' * src/eval.c (Fsignal): If both arguments are nil, replace the first one with 'error', to avoid assertion violations further down the line. (Bug#32961) diff --git a/src/eval.c b/src/eval.c index f9563a3f80..e90a9861a1 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1503,7 +1503,7 @@ DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0, This function does not return. An error symbol is a symbol with an `error-conditions' property -that is a list of condition names. +that is a list of condition names. The symbol should be non-nil. A handler for any of those names will get to handle this signal. The symbol `error' should normally be one of them. @@ -1515,6 +1515,9 @@ See also the function `condition-case'. */ attributes: noreturn) (Lisp_Object error_symbol, Lisp_Object data) { + /* If they call us with nonsensical arguments, produce "peculiar error". */ + if (NILP (error_symbol) && NILP (data)) + error_symbol = Qerror; signal_or_quit (error_symbol, data, false); eassume (false); } commit 1baf191a484f9942352e37183c66e2471a8cb577 Author: Paul Eggert Date: Sun Oct 7 00:10:29 2018 -0700 * src/scroll.c (calculate_scrolling): Remove casts. diff --git a/src/scroll.c b/src/scroll.c index 240005b4e3..5d0f32080e 100644 --- a/src/scroll.c +++ b/src/scroll.c @@ -186,13 +186,13 @@ calculate_scrolling (struct frame *frame, else { cost = p1->writecost + first_insert_cost[i]; - if ((int) p1->insertcount > i) + if (p1->insertcount > i) emacs_abort (); cost1 = p1->insertcost + next_insert_cost[i - p1->insertcount]; } p->insertcost = min (cost, cost1) + draw_cost[i] + extra_cost; p->insertcount = (cost < cost1) ? 1 : p1->insertcount + 1; - if ((int) p->insertcount > i) + if (p->insertcount > i) emacs_abort (); /* Calculate the cost if we do a delete line after commit ee3f4698704c26c503064e15ad7a75b7d693b1e4 Author: Scott Corley Date: Sun Oct 7 00:10:29 2018 -0700 Fix overflow lockup with frames > 255 lines * src/scroll.c (struct matrix_elt): Change unsigned char fields to int to handle frames with more than 255 lines (Bug#32951). Copyright-paperwork-exempt: yes diff --git a/src/scroll.c b/src/scroll.c index a29f2d37f5..240005b4e3 100644 --- a/src/scroll.c +++ b/src/scroll.c @@ -41,13 +41,13 @@ struct matrix_elt int deletecost; /* Number of inserts so far in this run of inserts, for the cost in insertcost. */ - unsigned char insertcount; + int insertcount; /* Number of deletes so far in this run of deletes, for the cost in deletecost. */ - unsigned char deletecount; + int deletecount; /* Number of writes so far since the last insert or delete for the cost in writecost. */ - unsigned char writecount; + int writecount; }; static void do_direct_scrolling (struct frame *, commit 3cc452327eff056f17637566aaf05a877e61d69a Author: Paul Eggert Date: Wed Oct 3 09:10:01 2018 -0700 Improvements on (TICKS . HZ) This patch is in response to Eli's review (Bug#32902#10). * src/systime.c: Doc strings of affected functions now refer to format-time-string instead of to Lisp manual, and format-time-string's doc string covers time values. * test/src/systime-tests.el (format-time-string-with-zone): Check decode-time too. (decode-then-encode-time, time-arith-tests): New tests. diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi index 8789a8d56f..b2a4b0eab1 100644 --- a/doc/lispref/buffers.texi +++ b/doc/lispref/buffers.texi @@ -654,7 +654,7 @@ If the buffer has no recorded last modification time, this function returns zero. This case occurs, for instance, if the buffer is not visiting a file or if the time has been explicitly cleared by @code{clear-visited-file-modtime}. Note, however, that -@code{visited-file-modtime} returns a list for some non-file buffers +@code{visited-file-modtime} returns a timestamp for some non-file buffers too. For instance, in a Dired buffer listing a directory, it returns the last modification time of that directory, as recorded by Dired. diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index ea6915350e..64c327c380 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -1457,14 +1457,14 @@ seconds east of Greenwich. @var{dow} and @var{utcoff}. @end defun -@defun encode-time time &optional form +@defun encode-time &optional time form &rest obsolescent-arguments This function converts @var{time} to a Lisp timestamp. It can act as the inverse of @code{decode-time}. -The first argument can be a Lisp time value such as @code{nil} for the -current time, a number of seconds, a pair @code{(@var{ticks} -. @var{hz})}, or a list @code{(@var{high} @var{low} @var{micro} -@var{pico})} (@pxref{Time of Day}). It can also be a list +The first argument can be a time value such as a number of seconds, a +pair @code{(@var{ticks} . @var{hz})}, a list @code{(@var{high} +@var{low} @var{micro} @var{pico})}, or @code{nil} (the default) for +the current time (@pxref{Time of Day}). It can also be a list @code{(@var{second} @var{minute} @var{hour} @var{day} @var{month} @var{year} @var{ignored} @var{dst} @var{zone})} that specifies a decoded time in the style of @code{decode-time}, so that @@ -1494,10 +1494,10 @@ or more arguments. The first six arguments @var{second}, specify most of the components of a decoded time. If there are more than six arguments the @emph{last} argument is used as @var{zone} and any other extra arguments are ignored, so that @code{(apply -'encode-time (decode-time ...))} works; otherwise @var{zone} defaults +#\\='encode-time (decode-time ...))} works; otherwise @var{zone} defaults to the current time zone rule (@pxref{Time Zone Rules}). The decoded time's @var{dst} component is treated as if it was @minus{}1, and -@var{form} so it takes its default value. +@var{form} takes its default value. Year numbers less than 100 are not treated specially. If you want them to stand for years above 1900, or years above 2000, you must alter them diff --git a/src/timefns.c b/src/timefns.c index 72cb54d3a0..7bce3b1e50 100644 --- a/src/timefns.c +++ b/src/timefns.c @@ -1035,8 +1035,8 @@ time_arith (Lisp_Object a, Lisp_Object b, bool subtract) } DEFUN ("time-add", Ftime_add, Stime_add, 2, 2, 0, - doc: /* Return the sum of two time values A and B, as a timestamp. -See Info node `(elisp)Time of Day' for time value formats. + doc: /* Return the sum of two time values A and B, as a time value. +See `format-time-string' for the various forms of a time value. For example, nil stands for the current time. */) (Lisp_Object a, Lisp_Object b) { @@ -1044,9 +1044,9 @@ For example, nil stands for the current time. */) } DEFUN ("time-subtract", Ftime_subtract, Stime_subtract, 2, 2, 0, - doc: /* Return the difference between two time values A and B, as a timestamp. + doc: /* Return the difference between two time values A and B, as a time value. You can use `float-time' to convert the difference into elapsed seconds. -See Info node `(elisp)Time of Day' for time value formats. +See `format-time-string' for the various forms of a time value. For example, nil stands for the current time. */) (Lisp_Object a, Lisp_Object b) { @@ -1092,7 +1092,7 @@ time_cmp (Lisp_Object a, Lisp_Object b) DEFUN ("time-less-p", Ftime_less_p, Stime_less_p, 2, 2, 0, doc: /* Return non-nil if time value A is less than time value B. -See Info node `(elisp)Time of Day' for time value formats. +See `format-time-string' for the various forms of a time value. For example, nil stands for the current time. */) (Lisp_Object a, Lisp_Object b) { @@ -1101,7 +1101,7 @@ For example, nil stands for the current time. */) DEFUN ("time-equal-p", Ftime_equal_p, Stime_equal_p, 2, 2, 0, doc: /* Return non-nil if A and B are equal time values. -See Info node `(elisp)Time of Day' for time value formats. */) +See `format-time-string' for the various forms of a time value. */) (Lisp_Object a, Lisp_Object b) { return time_cmp (a, b) == 0 ? Qt : Qnil; @@ -1110,12 +1110,12 @@ See Info node `(elisp)Time of Day' for time value formats. */) DEFUN ("float-time", Ffloat_time, Sfloat_time, 0, 1, 0, doc: /* Return the current time, as a float number of seconds since the epoch. -If SPECIFIED-TIME is given, it is a Lisp time value to convert to -float instead of the current time. See Info node `(elisp)Time of Day' -for time value formats. +If SPECIFIED-TIME is given, it is a time value to convert to float +instead of the current time. See `format-time-string' for the various +forms of a time value. WARNING: Since the result is floating point, it may not be exact. -If precise time stamps are required, use either `current-time', +If precise time stamps are required, use either `encode-time', or (if you need time as a string) `format-time-string'. */) (Lisp_Object specified_time) { @@ -1226,8 +1226,12 @@ format_time_string (char const *format, ptrdiff_t formatlen, } DEFUN ("format-time-string", Fformat_time_string, Sformat_time_string, 1, 3, 0, - doc: /* Use FORMAT-STRING to format the time TIME, or now if omitted or nil. -TIME is a Lisp time value; see Info node `(elisp)Time of Day'. + doc: /* Use FORMAT-STRING to format the time value TIME. +A time value that is omitted or nil stands for the current time, +a number stands for that many seconds, an integer pair (TICKS . HZ) +stands for TICKS/HZ seconds, and an integer list (HI LO US PS) stands +for HI*2**16 + LO + US/10**6 + PS/10**12 seconds. This function +treats seconds as time since the epoch of 1970-01-01 00:00:00 UTC. The optional ZONE is omitted or nil for Emacs local time, t for Universal Time, `wall' for system wall clock time, or a string as in @@ -1300,8 +1304,8 @@ usage: (format-time-string FORMAT-STRING &optional TIME ZONE) */) DEFUN ("decode-time", Fdecode_time, Sdecode_time, 0, 2, 0, doc: /* Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST UTCOFF). -The optional TIME is the Lisp time value to convert. See Info node -`(elisp)Time of Day' for time value formats. +The optional TIME is the time value to convert. See +`format-time-string' for the various forms of a time value. The optional ZONE is omitted or nil for Emacs local time, t for Universal Time, `wall' for system wall clock time, or a string as in @@ -1381,22 +1385,23 @@ check_tm_member (Lisp_Object obj, int offset) } DEFUN ("encode-time", Fencode_time, Sencode_time, 1, MANY, 0, - doc: /* Convert TIME to a timestamp. + doc: /* Convert optional TIME to a timestamp. Optional FORM specifies how the returned value should be encoded. This can act as the reverse operation of `decode-time', which see. If TIME is a list (SECOND MINUTE HOUR DAY MONTH YEAR IGNORED DST ZONE) -it a decoded time in the style of `decode-time', so that (encode-time -(decode-time ...)) works. TIME can also be a Lisp time value; see -Info node `(elisp)Time of Day'. +it is a decoded time in the style of `decode-time', so that (encode-time +(decode-time ...)) works. TIME can also be a time value. +See `format-time-string' for the various forms of a time value. +For example, an omitted TIME stands for the current time. If FORM is a positive integer, the time is returned as a pair of integers (TICKS . FORM), where TICKS is the number of clock ticks and FORM is the clock frequency in ticks per second. (Currently the positive integer should be at least 65536 if the returned value is expected to be given to standard functions expecting Lisp timestamps.) If FORM is -t, the time is returned as (TICKS . PHZ), where PHZ is a -platform-dependent clock frequency. If FORM is `integer', the time is +t, the time is returned as (TICKS . PHZ), where PHZ is a platform dependent +clock frequency in ticks per second. If FORM is `integer', the time is returned as an integer count of seconds. If FORM is `list', the time is returned as an integer list (HIGH LOW USEC PSEC), where HIGH has the most significant bits of the seconds, LOW has the least significant 16 @@ -1405,11 +1410,12 @@ Returned values are rounded toward minus infinity. Although an omitted or nil FORM currently acts like `list', this is planned to change, so callers requiring list timestamps should specify `list'. -As an obsolescent calling convention, the first 6 arguments SECOND, -MINUTE, HOUR, DAY, MONTH, and YEAR specify the components of a decoded -time, where DST assumed to be -1 and FORM is omitted. If there are more +As an obsolescent calling convention, if this function is called with +6 or more arguments, the first 6 arguments are SECOND, MINUTE, HOUR, +DAY, MONTH, and YEAR, and specify the components of a decoded time, +where DST assumed to be -1 and FORM is omitted. If there are more than 6 arguments the *last* argument is used as ZONE and any other -extra arguments are ignored, so that (apply \\='encode-time +extra arguments are ignored, so that (apply #\\='encode-time (decode-time ...)) works; otherwise ZONE is assumed to be nil. If the input is a decoded time, ZONE is nil for Emacs local time, t @@ -1430,7 +1436,7 @@ If you want them to stand for years in this century, you must do that yourself. Years before 1970 are not guaranteed to work. On some systems, year values as low as 1901 do work. -usage: (encode-time TIME &optional FORM) */) +usage: (encode-time &optional TIME FORM &rest OBSOLESCENT-ARGUMENTS) */) (ptrdiff_t nargs, Lisp_Object *args) { time_t value; @@ -1490,13 +1496,13 @@ usage: (encode-time TIME &optional FORM) */) } DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0, - doc: /* Return the current time, counting the number of seconds since the epoch. - -See Info node `(elisp)Time of Day' for the format of the returned -timestamp. Although this is currently list format, it may change in -future versions of Emacs. Use `encode-time' if you need a particular -form; for example, (encode-time nil \\='list) returns the current time -in list form. */) + doc: /* Return the current time, as the number of seconds since 1970-01-01 00:00:00. +The time is returned as a list of integers (HIGH LOW USEC PSEC). +HIGH has the most significant bits of the seconds, while LOW has the +least significant 16 bits. USEC and PSEC are the microsecond and +picosecond counts. Use `encode-time' if you need a particular +timestamp form; for example, (encode-time nil \\='integer) returns the +current time in seconds. */) (void) { return make_lisp_time (current_timespec ()); @@ -1512,9 +1518,9 @@ The format is `Sun Sep 16 01:03:52 1973'. However, see also the functions `decode-time' and `format-time-string' which provide a much more powerful and general facility. -If SPECIFIED-TIME is given, it is the Lisp time value to format -instead of the current time. See Info node `(elisp)Time of Day' for -time value formats. +If SPECIFIED-TIME is given, it is the time value to format instead of +the current time. See `format-time-string' for the various forms of a +time value. The optional ZONE is omitted or nil for Emacs local time, t for Universal Time, `wall' for system wall clock time, or a string as in @@ -1559,7 +1565,8 @@ OFFSET is an integer number of seconds ahead of UTC (east of Greenwich). NAME is a string giving the name of the time zone. If SPECIFIED-TIME is given, the time zone offset is determined from it instead of using the current time. The argument should be a Lisp -time value; see Info node `(elisp)Time of Day'. +time value; see `format-time-string' for the various forms of a time +value. The optional ZONE is omitted or nil for Emacs local time, t for Universal Time, `wall' for system wall clock time, or a string as in diff --git a/test/src/timefns-tests.el b/test/src/timefns-tests.el index 435dcf7db7..ebeb43de16 100644 --- a/test/src/timefns-tests.el +++ b/test/src/timefns-tests.el @@ -19,7 +19,7 @@ (require 'ert) -;;; Check format-time-string with various TZ settings. +;;; Check format-time-string and decode-time with various TZ settings. ;;; Use only POSIX-compatible TZ values, since the tests should work ;;; even if tzdb is not in use. (ert-deftest format-time-string-with-zone () @@ -35,32 +35,61 @@ ;; Similarly, stick to the limited set of time zones that are ;; supported by both POSIX and MS-Windows: exactly 3 ASCII letters ;; in the abbreviation, and no DST. - (let ((look '(1202 22527 999999 999999)) - (format "%Y-%m-%d %H:%M:%S.%3N %z (%Z)")) - ;; UTC. - (should (string-equal - (format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" look t) - "1972-06-30 23:59:59.999 +0000")) - ;; "UTC0". - (should (string-equal - (format-time-string format look "UTC0") - "1972-06-30 23:59:59.999 +0000 (UTC)")) - ;; Negative UTC offset, as a Lisp list. - (should (string-equal - (format-time-string format look '(-28800 "PST")) - "1972-06-30 15:59:59.999 -0800 (PST)")) - ;; Negative UTC offset, as a Lisp integer. - (should (string-equal - (format-time-string format look -28800) - ;; MS-Windows build replaces unrecognizable TZ values, - ;; such as "-08", with "ZZZ". - (if (eq system-type 'windows-nt) - "1972-06-30 15:59:59.999 -0800 (ZZZ)" - "1972-06-30 15:59:59.999 -0800 (-08)"))) - ;; Positive UTC offset that is not an hour multiple, as a string. - (should (string-equal - (format-time-string format look "IST-5:30") - "1972-07-01 05:29:59.999 +0530 (IST)")))) + (let ((format "%Y-%m-%d %H:%M:%S.%3N %z (%Z)")) + (dolist (look '((1202 22527 999999 999999) + (7879679999900 . 100000) + (78796799999999999999 . 1000000000000))) + ;; UTC. + (should (string-equal + (format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" look t) + "1972-06-30 23:59:59.999 +0000")) + (should (equal (decode-time look t) + '(59 59 23 30 6 1972 5 nil 0))) + ;; "UTC0". + (should (string-equal + (format-time-string format look "UTC0") + "1972-06-30 23:59:59.999 +0000 (UTC)")) + (should (equal (decode-time look "UTC0") + '(59 59 23 30 6 1972 5 nil 0))) + ;; Negative UTC offset, as a Lisp list. + (should (string-equal + (format-time-string format look '(-28800 "PST")) + "1972-06-30 15:59:59.999 -0800 (PST)")) + (should (equal (decode-time look '(-28800 "PST")) + '(59 59 15 30 6 1972 5 nil -28800))) + ;; Negative UTC offset, as a Lisp integer. + (should (string-equal + (format-time-string format look -28800) + ;; MS-Windows build replaces unrecognizable TZ values, + ;; such as "-08", with "ZZZ". + (if (eq system-type 'windows-nt) + "1972-06-30 15:59:59.999 -0800 (ZZZ)" + "1972-06-30 15:59:59.999 -0800 (-08)"))) + (should (equal (decode-time look -28800) + '(59 59 15 30 6 1972 5 nil -28800))) + ;; Positive UTC offset that is not an hour multiple, as a string. + (should (string-equal + (format-time-string format look "IST-5:30") + "1972-07-01 05:29:59.999 +0530 (IST)")) + (should (equal (decode-time look "IST-5:30") + '(59 29 5 1 7 1972 6 nil 19800)))))) + +(ert-deftest decode-then-encode-time () + (let ((time-values (list 0 -2 1 0.0 -0.0 -2.0 1.0 + most-negative-fixnum most-positive-fixnum + (1- most-negative-fixnum) + (1+ most-positive-fixnum) + 1e+INF -1e+INF 1e+NaN -1e+NaN + '(0 1 0 0) '(1 0 0 0) '(-1 0 0 0) + '(123456789000000 . 1000000) + (cons (1+ most-positive-fixnum) 1000000000000) + (cons 1000000000000 (1+ most-positive-fixnum))))) + (dolist (a time-values) + (let* ((d (ignore-errors (decode-time a t))) + (e (encode-time d)) + (diff (float-time (time-subtract a e)))) + (should (or (not d) + (and (<= 0 diff) (< diff 1)))))))) ;;; This should not dump core. (ert-deftest format-time-string-with-outlandish-zone () @@ -80,3 +109,36 @@ (ert-deftest time-equal-p-nil-nil () (should (time-equal-p nil nil))) + +(ert-deftest time-arith-tests () + (let ((time-values (list 0 -1 1 0.0 -0.0 -1.0 1.0 + most-negative-fixnum most-positive-fixnum + (1- most-negative-fixnum) + (1+ most-positive-fixnum) + 1e+INF -1e+INF 1e+NaN -1e+NaN + '(0 0 0 1) '(0 0 1 0) '(0 1 0 0) '(1 0 0 0) + '(-1 0 0 0) '(1 2 3 4) '(-1 2 3 4) + '(-123456789 . 100000) '(123456789 . 1000000) + (cons (1+ most-positive-fixnum) 1000000000000) + (cons 1000000000000 (1+ most-positive-fixnum))))) + (dolist (a time-values) + (dolist (b time-values) + (let ((aa (time-subtract (time-add a b) b))) + (should (or (time-equal-p a aa) (and (floatp aa) (isnan aa))))) + (should (= 1 (+ (if (time-less-p a b) 1 0) + (if (time-equal-p a b) 1 0) + (if (time-less-p b a) 1 0) + (if (or (and (floatp a) (isnan a)) + (and (floatp b) (isnan b))) + 1 0)))) + (should (or (not (time-less-p 0 b)) + (time-less-p a (time-add a b)) + (time-equal-p a (time-add a b)) + (and (floatp (time-add a b)) (isnan (time-add a b))))) + (let ((x (float-time (time-add a b))) + (y (+ (float-time a) (float-time b)))) + (should (or (and (isnan x) (isnan y)) + (= x y) + (< 0.99 (/ x y) 1.01) + (< 0.99 (/ (- (float-time a)) (float-time b)) + 1.01)))))))) commit 93fe420942c08111a6048af7c4d7807c61d80a09 Author: Paul Eggert Date: Wed Oct 3 09:10:01 2018 -0700 New (TICKS . HZ) timestamp format This follows on a suggestion by Stefan Monnier in: https://lists.gnu.org/r/emacs-devel/2018-08/msg00991.html (Bug#32902). * doc/lispref/buffers.texi (Modification Time): * doc/lispref/os.texi (Processor Run Time, Time Calculations) * doc/lispref/processes.texi (System Processes): * doc/lispref/text.texi (Undo): Let the "Time of Day" section cover timestamp format details. * doc/lispref/os.texi (Time of Day): Say that timestamp internal format should not be assumed. Document new (ticks . hz) format. Omit mention of seconds-to-time since it is now just an alias for encode-time. (Time Conversion): Document encode-time extension. * etc/NEWS: Mention changes. * lisp/calendar/cal-dst.el (calendar-system-time-basis): Now const. * lisp/calendar/cal-dst.el (calendar-absolute-from-time) (calendar-time-from-absolute) (calendar-next-time-zone-transition): * lisp/emacs-lisp/timer.el (timer-next-integral-multiple-of-time): Simplify by using bignums, (TICKS . HZ), and new encode-time. * lisp/emacs-lisp/timer.el (timer-next-integral-multiple-of-time): Simplify by using bignums and new encode-time. * lisp/calendar/parse-time.el (parse-iso8601-time-string): Handle DST more accurately, by using new encode-time. * lisp/calendar/time-date.el (seconds-to-time): * lisp/calendar/timeclock.el (timeclock-seconds-to-time): Now just an alias for encode-time. * lisp/calendar/time-date.el (days-to-time): * lisp/emacs-lisp/timer.el (timer--time-setter): * lisp/net/ntlm.el (ntlm-compute-timestamp): * lisp/obsolete/vc-arch.el (vc-arch-add-tagline): * lisp/org/org-id.el (org-id-uuid, org-id-time-to-b36): * lisp/tar-mode (tar-octal-time): Don't assume timestamps default to list form. * lisp/tar-mode.el (tar-parse-octal-long-integer): Now an obsolete alias for tar-parse-octal-integer. * src/keyboard.c (decode_timer): Adjust to changes to time decoding functions elsewhere. * src/timefns.c: Include bignum.h, limits.h. (FASTER_TIMEFNS): New macro. (WARN_OBSOLETE_TIMESTAMPS, CURRENT_TIME_LIST) (timespec_hz, trillion, ztrillion): New constants. (make_timeval): Use TIME_T_MAX instead of its definiens. (check_time_validity, time_add, time_subtract): Remove. All uses removed. (disassemble_lisp_time): Remove; old code now folded into decode_lisp_time. All callers changed. (invalid_hz, s_ns_to_double, ticks_hz_list4, mpz_set_time) (timespec_mpz, timespec_ticks, time_hz_ticks) (lisp_time_hz_ticks, lisp_time_seconds) (time_form_stamp, lisp_time_form_stamp, decode_ticks_hz) (decode_lisp_time, mpz_time, list4_to_timespec): New functions. (decode_float_time, decode_time_components, lisp_to_timespec): Adjust to new struct lisp_time, which does not lose information like the old one did. (enum timeform): New enum. (decode_time_components): New arg FORM. All callers changed. RESULT and DRESULT are now mutually exclusive; no callers need to change because of this. (decode_time_components, lisp_time_struct) (lisp_seconds_argument, time_arith, make_lisp_time, Ffloat_time) (Fencode_time): Add support for (TICKS . HZ) form. (DECODE_SECS_ONLY): New constant. (lisp_time_struct): 2nd arg is now enum timeform, not int. All callers changed. (check_tm_member): Support bignums.m (Fencode_time): Add new two-arg functionality. * src/systime.h (struct lisp_time): Now ticks+hz rather than hi+lo+us+ps, since ticks+hz does not lose info. * test/src/systime-tests.el (time-equal-p-nil-nil): New test. diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi index 1acf4baedb..8789a8d56f 100644 --- a/doc/lispref/buffers.texi +++ b/doc/lispref/buffers.texi @@ -648,10 +648,7 @@ file should not be done. @defun visited-file-modtime This function returns the current buffer's recorded last file -modification time, as a list of the form @code{(@var{high} @var{low} -@var{microsec} @var{picosec})}. (This is the same format that -@code{file-attributes} uses to return time values; @pxref{File -Attributes}.) +modification time, as a Lisp timestamp (@pxref{Time of Day}). If the buffer has no recorded last modification time, this function returns zero. This case occurs, for instance, if the buffer is not @@ -671,9 +668,8 @@ is not @code{nil}, and otherwise to the last modification time of the visited file. If @var{time} is neither @code{nil} nor an integer flag returned -by @code{visited-file-modtime}, it should have the form -@code{(@var{high} @var{low} @var{microsec} @var{picosec})}, -the format used by @code{current-time} (@pxref{Time of Day}). +by @code{visited-file-modtime}, it should be a Lisp time value +(@pxref{Time of Day}). This function is useful if the buffer was not read from the file normally, or if the file itself has been changed for some known benign diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 8ce5a5ed6d..ea6915350e 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -1233,11 +1233,44 @@ return value is @code{nil}. This section explains how to determine the current time and time zone. +@cindex Lisp timestamp +@cindex timestamp, Lisp + Many functions like @code{current-time} and @code{file-attributes} +return @dfn{Lisp timestamp} values that count seconds, and that can +represent absolute time by counting seconds since the @dfn{epoch} of +1970-01-01 00:00:00 UTC. + + Although traditionally Lisp timestamps were integer pairs, their +form has evolved and programs ordinarily should not depend on the +current default form. If your program needs a particular timestamp +form, you can use the @code{encode-time} function to convert it to the +needed form. @xref{Time Conversion}. + @cindex epoch - Most of these functions represent time as a list of four integers -@code{(@var{sec-high} @var{sec-low} @var{microsec} @var{picosec})}. -This represents the number of seconds from the @dfn{epoch} (January -1, 1970 at 00:00 UTC), using the formula: + There are currently three forms of Lisp timestamps, each of +which represents a number of seconds: + +@itemize @bullet +@item +An integer. Although this is the simplest form, it cannot represent +subsecond timestamps. + +@item +A pair of integers @code{(@var{ticks} . @var{hz})}, where @var{hz} is +positive. This represents @var{ticks}/@var{hz} seconds, which is the +same time as plain @var{ticks} if @var{hz} is 1. A common value for +@var{hz} is 1000000000, for a nanosecond-resolution +clock.@footnote{Currently @var{hz} should be at least 65536 to avoid +compatibility warnings when the timestamp is passed to standard +functions, as previous versions of Emacs would interpret such a +timestamps differently due to backward-compatibility concerns. These +warnings are intended to be removed in a future Emacs version.} + +@item +A list of four integers @code{(@var{high} @var{low} @var{micro} +@var{pico})}, where 0 @leq{} @var{low} < 65536, 0 @leq{} @var{micro} < +1000000, and 0 @leq{} @var{pico} < 1000000. +This represents the number of seconds using the formula: @ifnottex @var{high} * 2**16 + @var{low} + @var{micro} * 10**@minus{}6 + @var{pico} * 10**@minus{}12. @@ -1245,21 +1278,23 @@ This represents the number of seconds from the @dfn{epoch} (January @tex $high*2^{16} + low + micro*10^{-6} + pico*10^{-12}$. @end tex -The return value of @code{current-time} represents time using this -form, as do the timestamps in the return values of other functions -such as @code{file-attributes} (@pxref{Definition of -file-attributes}). In some cases, functions may return two- or +In some cases, functions may default to returning two- or three-element lists, with omitted @var{microsec} and @var{picosec} components defaulting to zero. +On all current machines @var{picosec} is a multiple of 1000, but this +may change as higher-resolution clocks become available. +@end itemize @cindex time value Function arguments, e.g., the @var{time} argument to @code{current-time-string}, accept a more-general @dfn{time value} -format, which can be a list of integers as above, or a single number -for seconds since the epoch, or @code{nil} for the current time. You -can convert a time value into a human-readable string using -@code{current-time-string} and @code{format-time-string}, into a list -of integers using @code{seconds-to-time}, and into other forms using +format, which can be a Lisp timestamp, @code{nil} for the current +time, a single floating-point number for seconds, or a list +@code{(@var{high} @var{low} @var{micro})} or @code{(@var{high} +@var{low})} that is a truncated list timestamp with missing elements +taken to be zero. You can convert a time value into +a human-readable string using @code{format-time-string}, into a Lisp +timestamp using @code{encode-time}, and into other forms using @code{decode-time} and @code{float-time}. These functions are described in the following sections. @@ -1287,12 +1322,7 @@ defaults to the current time zone rule. @xref{Time Zone Rules}. @end defun @defun current-time -This function returns the current time, represented as a list of four -integers @code{(@var{sec-high} @var{sec-low} @var{microsec} @var{picosec})}. -These integers have trailing zeros on systems that return time with -lower resolutions. On all current machines @var{picosec} is a -multiple of 1000, but this may change as higher-resolution clocks -become available. +This function returns the current time as a Lisp timestamp. @end defun @defun float-time &optional time @@ -1306,13 +1336,6 @@ exact. Do not use this function if precise time stamps are required. @code{time-to-seconds} is an alias for this function. @end defun -@defun seconds-to-time time -This function converts a time value to list-of-integer form. -For example, if @var{time} is a number, @code{(time-to-seconds -(seconds-to-time @var{time}))} equals the number unless overflow -or rounding errors occur. -@end defun - @node Time Zone Rules @section Time Zone Rules @cindex time zone rules @@ -1434,32 +1457,63 @@ seconds east of Greenwich. @var{dow} and @var{utcoff}. @end defun -@defun encode-time seconds minutes hour day month year &optional zone -This function is the inverse of @code{decode-time}. It converts seven -items of calendrical data into a list-of-integer time value. For the -meanings of the arguments, see the table above under -@code{decode-time}. +@defun encode-time time &optional form +This function converts @var{time} to a Lisp timestamp. +It can act as the inverse of @code{decode-time}. + +The first argument can be a Lisp time value such as @code{nil} for the +current time, a number of seconds, a pair @code{(@var{ticks} +. @var{hz})}, or a list @code{(@var{high} @var{low} @var{micro} +@var{pico})} (@pxref{Time of Day}). It can also be a list +@code{(@var{second} @var{minute} @var{hour} @var{day} @var{month} +@var{year} @var{ignored} @var{dst} @var{zone})} that specifies a +decoded time in the style of @code{decode-time}, so that +@code{(encode-time (decode-time ...))} works. For the meanings of +these list members, see the table under @code{decode-time}. + +The optional @var{form} argument specifies the desired timestamp form +to be returned. If @var{form} is the symbol @code{integer}, this +function returns an integer count of seconds. If @var{form} is a +positive integer, it specifies a clock frequency and this function +returns an integer-pair timestamp @code{(@var{ticks} +. @var{form})}.@footnote{Currently a positive integer @var{form} +should be at least 65536 if the returned value is intended to be given +to standard functions expecting Lisp timestamps.} If @var{form} is +@code{t}, this function treats it as a positive integer suitable for +representing the timestamp; for example, it is treated as 1000000000 +if the platform timestamp has nanosecond resolution. If @var{form} is +@code{list}, this function returns an integer list @code{(@var{high} +@var{low} @var{micro} @var{pico})}. Although an omitted or @code{nil} +@var{form} currently acts like @code{list}, this is planned to change +in a future Emacs version, so callers requiring list timestamps should +pass @code{list} explicitly. + +As an obsolescent calling convention, this function can be given six +or more arguments. The first six arguments @var{second}, +@var{minute}, @var{hour}, @var{day}, @var{month}, and @var{year} +specify most of the components of a decoded time. If there are more +than six arguments the @emph{last} argument is used as @var{zone} and +any other extra arguments are ignored, so that @code{(apply +'encode-time (decode-time ...))} works; otherwise @var{zone} defaults +to the current time zone rule (@pxref{Time Zone Rules}). The decoded +time's @var{dst} component is treated as if it was @minus{}1, and +@var{form} so it takes its default value. Year numbers less than 100 are not treated specially. If you want them to stand for years above 1900, or years above 2000, you must alter them yourself before you call @code{encode-time}. -The optional argument @var{zone} defaults to the current time zone rule. -@xref{Time Zone Rules}. - -If you pass more than seven arguments to @code{encode-time}, the first -six are used as @var{seconds} through @var{year}, the last argument is -used as @var{zone}, and the arguments in between are ignored. This -feature makes it possible to use the elements of a list returned by -@code{decode-time} as the arguments to @code{encode-time}, like this: +The @code{encode-time} function acts as a rough inverse to +@code{decode-time}. For example, you can pass the output of +the latter to the former as follows: @example -(apply 'encode-time (decode-time @dots{})) +(encode-time (decode-time @dots{})) @end example You can perform simple date arithmetic by using out-of-range values for -the @var{seconds}, @var{minutes}, @var{hour}, @var{day}, and @var{month} -arguments; for example, day 0 means the day preceding the given month. +@var{seconds}, @var{minutes}, @var{hour}, @var{day}, and @var{month}; +for example, day 0 means the day preceding the given month. The operating system puts limits on the range of possible time values; if you try to encode a time that is out of range, an error results. @@ -1474,12 +1528,12 @@ on others, years as early as 1901 do work. @cindex formatting time values These functions convert time values to text in a string, and vice versa. -Time values include @code{nil}, numbers, and lists of two to four -integers (@pxref{Time of Day}). +Time values include @code{nil}, numbers, and Lisp timestamps +(@pxref{Time of Day}). @defun date-to-time string This function parses the time-string @var{string} and returns the -corresponding time value. +corresponding Lisp timestamp. @end defun @defun format-time-string format-string &optional time zone @@ -1701,10 +1755,8 @@ When called interactively, it prints the uptime in the echo area. @end deffn @defun get-internal-run-time -This function returns the processor run time used by Emacs as a list -of four integers: @code{(@var{sec-high} @var{sec-low} @var{microsec} -@var{picosec})}, using the same format as @code{current-time} -(@pxref{Time of Day}). +This function returns the processor run time used by Emacs, as a Lisp +timestamp (@pxref{Time of Day}). Note that the time returned by this function excludes the time Emacs was not using the processor, and if the Emacs process has several @@ -1729,9 +1781,10 @@ interactively, it prints the duration in the echo area. @cindex calendrical computations These functions perform calendrical computations using time values -(@pxref{Time of Day}). A value of @code{nil} for any of their +(@pxref{Time of Day}). As with any time value, a value of +@code{nil} for any of their time-value arguments stands for the current system time, and a single -integer number stands for the number of seconds since the epoch. +number stands for the number of seconds since the epoch. @defun time-less-p t1 t2 This returns @code{t} if time value @var{t1} is less than time value @@ -1757,7 +1810,7 @@ float-time}) to convert the result into seconds. This returns the sum of two time values, as a time value. However, the result is a float if either argument is a float infinity or NaN@. One argument should represent a time difference rather than a point in time, -either as a list or as a single number of elapsed seconds. +as a time value that is often just a single number of elapsed seconds. Here is how to add a number of seconds to a time value: @example diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 89ad1cf838..e1113e37f1 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -2158,19 +2158,17 @@ faults for all the child processes of the given process. @item utime Time spent by the process in the user context, for running the -application's code. The corresponding @var{value} is in the -@w{@code{(@var{high} @var{low} @var{microsec} @var{picosec})}} format, the same -format used by functions @code{current-time} (@pxref{Time of Day, -current-time}) and @code{file-attributes} (@pxref{File Attributes}). +application's code. The corresponding @var{value} is a Lisp +timestamp (@pxref{Time of Day}). @item stime Time spent by the process in the system (kernel) context, for -processing system calls. The corresponding @var{value} is in the same -format as for @code{utime}. +processing system calls. The corresponding @var{value} is a Lisp +timestamp. @item time The sum of @code{utime} and @code{stime}. The corresponding -@var{value} is in the same format as for @code{utime}. +@var{value} is a Lisp timestamp. @item cutime @itemx cstime @@ -2189,13 +2187,10 @@ nice values get scheduled more favorably.) The number of threads in the process. @item start -The time when the process was started, in the same -@code{(@var{high} @var{low} @var{microsec} @var{picosec})} format used by -@code{file-attributes} and @code{current-time}. +The time when the process was started, as a Lisp timestamp. @item etime -The time elapsed since the process started, in the format @code{(@var{high} -@var{low} @var{microsec} @var{picosec})}. +The time elapsed since the process started, as a Lisp timestamp. @item vsize The virtual memory size of the process, measured in kilobytes. diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 825827095b..6c38d8eed0 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -1327,9 +1327,8 @@ elements follow immediately after this element. @item (t . @var{time-flag}) This kind of element indicates that an unmodified buffer became -modified. A @var{time-flag} of the form -@code{(@var{sec-high} @var{sec-low} @var{microsec} -@var{picosec})} represents the visited file's modification time as of +modified. A @var{time-flag} that is a non-integer Lisp timestamp +represents the visited file's modification time as of when it was previously visited or saved, using the same format as @code{current-time}; see @ref{Time of Day}. A @var{time-flag} of 0 means the buffer does not correspond to any file; diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi index 9280311b5c..f46b2a7fc1 100644 --- a/doc/misc/emacs-mime.texi +++ b/doc/misc/emacs-mime.texi @@ -1524,12 +1524,12 @@ many mailers don't support it. @xref{rfc2231}. @section time-date While not really a part of the @acronym{MIME} library, it is convenient to -document this library here. It deals with parsing @code{Date} headers +document time conversion functions often used when parsing @code{Date} headers and manipulating time. (Not by using tesseracts, though, I'm sorry to say.) -These functions convert between five formats: A date string, an Emacs -time structure, a decoded time list, a second number, and a day number. +These functions convert between five formats: A date string, a Lisp +timestamp, a decoded time list, a second number, and a day number. Here's a bunch of time/date/second/day examples: @@ -1537,35 +1537,41 @@ Here's a bunch of time/date/second/day examples: (parse-time-string "Sat Sep 12 12:21:54 1998 +0200") @result{} (54 21 12 12 9 1998 6 -1 7200) -(date-to-time "Sat Sep 12 12:21:54 1998 +0200") -@result{} (13818 19266) +(encode-time (date-to-time "Sat Sep 12 12:21:54 1998 +0200") + 1000000) +@result{} (905595714000000 . 1000000) -(parse-iso8601-time-string "1998-09-12T12:21:54+0200") -@result{} (13818 19266) +(encode-time (parse-iso8601-time-string "1998-09-12T12:21:54+0200") + 1000000) +@result{} (905595714000000 . 1000000) -(float-time '(13818 19266)) +(float-time '(905595714000000 . 1000000)) @result{} 905595714.0 -(seconds-to-time 905595714.0) -@result{} (13818 19266 0 0) +(encode-time 905595714.0 1000000) +@result{} (905595714000000 . 1000000) -(time-to-days '(13818 19266)) +(time-to-days '(905595714000000 . 1000000)) @result{} 729644 -(days-to-time 729644) -@result{} (961933 512) +(encode-time (days-to-time 729644) 1000000) +@result{} (63041241600000000 . 1000000) -(time-since '(13818 19266)) -@result{} (6797 9607 984839 247000) +(encode-time (time-since '(905595714000000 . 1000000)) + 1000000) +@result{} (631963244775642171 . 1000000000) -(time-less-p '(13818 19266) '(13818 19145)) +(time-less-p '(905595714000000 . 1000000) + '(905595593000000000 . 1000000000)) @result{} nil -(time-equal-p '(13818 19266) '(13818 19145)) -@result{} nil +(time-equal-p '(905595593000000000 . 1000000000) + '(905595593000000 . 1000000 )) +@result{} t -(time-subtract '(13818 19266) '(13818 19145)) -@result{} (0 121) +(time-subtract '(905595714000000 . 1000000) + '(905595593000000000 . 1000000000)) +@result{} (121000000000 . 1000000000) (days-between "Sat Sep 12 12:21:54 1998 +0200" "Sat Sep 07 12:21:54 1998 +0200") @@ -1574,13 +1580,13 @@ Here's a bunch of time/date/second/day examples: (date-leap-year-p 2000) @result{} t -(time-to-day-in-year '(13818 19266)) +(time-to-day-in-year '(905595714000000 . 1000000)) @result{} 255 (time-to-number-of-days (time-since (date-to-time "Mon, 01 Jan 2001 02:22:26 GMT"))) -@result{} 4314.095589286675 +@result{} 6472.722661506652 @end example And finally, we have @code{safe-date-to-time}, which does the same as @@ -1595,22 +1601,24 @@ An RFC822 (or similar) date string. For instance: @code{"Sat Sep 12 12:21:54 1998 +0200"}. @item time -An internal Emacs time. For instance: @code{(13818 26466 0 0)}. +A Lisp timestamp. +For instance: @code{(905595714000000 . 1000000)}. @item seconds -A floating point representation of the internal Emacs time. For -instance: @code{905595714.0}. +An integer or floating point count of seconds. For instance: +@code{905595714.0}, @code{905595714}. @item days An integer number representing the number of days since 00000101. For instance: @code{729644}. @item decoded time -A list of decoded time. For instance: @code{(54 21 12 12 9 1998 6 t +A list of decoded time. For instance: @code{(54 21 12 12 9 1998 6 nil 7200)}. @end table -All the examples above represent the same moment. +All the examples above represent the same moment, except that +@var{days} represents the day containing the moment. These are the functions available: @@ -1621,8 +1629,9 @@ Take a date and return a time. @item float-time Take a time and return seconds. (This is a built-in function.) -@item seconds-to-time -Take seconds and return a time. +@item encode-time +Take seconds (and other ways to represent time, notably decoded time +lists), and return a time. @item time-to-days Take a time and return days. @@ -1645,7 +1654,7 @@ Take two times and say whether the first time is less (i.e., earlier) than the second time. (This is a built-in function.) @item time-equal-p -Check, whether two time values are equal. The time values must not be +Check whether two time values are equal. The time values need not be in the same format. (This is a built-in function.) @item time-since diff --git a/etc/NEWS b/etc/NEWS index daacf49e62..020450c957 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -995,6 +995,21 @@ like file-attributes that compute file sizes and other attributes, functions like process-id that compute process IDs, and functions like user-uid and group-gid that compute user and group IDs. ++++ +** Although the default timestamp format is still (HI LO US PS), +it is planned to change in a future Emacs version, to exploit bignums. +The documentation has been updated to mention that the timestamp +format may change and that programs should use functions like +format-time-string, decode-time, and encode-time rather than probing +the innards of a timestamp directly, or creating a timestamp by hand. + ++++ +** encode-time supports a new API (encode-time TIME &optional FORM). +This can convert decoded times and Lisp time values to Lisp timestamps +of various forms, including a new timestamp form (TICKS . HZ), where +TICKS is an integer and HZ is a positive integer denoting a clock +frequency. The old encode-time API is still supported. + +++ ** 'time-add', 'time-subtract', and 'time-less-p' now accept infinities and NaNs too, and propagate them or return nil like diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el index 00a8e7498a..25264bda09 100644 --- a/lisp/calendar/cal-dst.el +++ b/lisp/calendar/cal-dst.el @@ -97,62 +97,48 @@ If the locale never uses daylight saving time, set this to nil." ;;;###autoload (put 'calendar-current-time-zone-cache 'risky-local-variable t) -(defvar calendar-system-time-basis +(defconst calendar-system-time-basis (calendar-absolute-from-gregorian '(1 1 1970)) "Absolute date of starting date of system clock.") (defun calendar-absolute-from-time (x utc-diff) "Absolute local date of time X; local time is UTC-DIFF seconds from UTC. -X is (HIGH . LOW) or (HIGH LOW . IGNORED) where HIGH and LOW are the -high and low 16 bits, respectively, of the number of seconds since -1970-01-01 00:00:00 UTC, ignoring leap seconds. +X is the number of seconds since 1970-01-01 00:00:00 UTC, +ignoring leap seconds. Returns the pair (ABS-DATE . SECONDS) where SECONDS after local midnight on absolute date ABS-DATE is the equivalent moment to X." - (let* ((h (car x)) - (xtail (cdr x)) - (l (+ utc-diff (if (numberp xtail) xtail (car xtail)))) - (u (+ (* 512 (mod h 675)) (floor l 128)))) - ;; Overflow is a terrible thing! - (cons (+ calendar-system-time-basis - ;; floor((2^16 h +l) / (60*60*24)) - (* 512 (floor h 675)) (floor u 675)) - ;; (2^16 h +l) mod (60*60*24) - (+ (* (mod u 675) 128) (mod l 128))))) + (let ((secsperday 86400) + (local (+ x utc-diff))) + (cons (+ calendar-system-time-basis (floor local secsperday)) + (mod local secsperday)))) (defun calendar-time-from-absolute (abs-date s) "Time of absolute date ABS-DATE, S seconds after midnight. -Returns the list (HIGH LOW) where HIGH and LOW are the high and low -16 bits, respectively, of the number of seconds 1970-01-01 00:00:00 UTC, -ignoring leap seconds, that is the equivalent moment to S seconds after -midnight UTC on absolute date ABS-DATE." - (let* ((a (- abs-date calendar-system-time-basis)) - (u (+ (* 163 (mod a 512)) (floor s 128)))) - ;; Overflow is a terrible thing! - (list - ;; floor((60*60*24*a + s) / 2^16) - (+ a (* 163 (floor a 512)) (floor u 512)) - ;; (60*60*24*a + s) mod 2^16 - (+ (* 128 (mod u 512)) (mod s 128))))) +Return the number of seconds since 1970-01-01 00:00:00 UTC, +ignoring leap seconds, that is the equivalent moment to S seconds +after midnight UTC on absolute date ABS-DATE." + (let ((secsperday 86400)) + (+ s (* secsperday (- abs-date calendar-system-time-basis))))) (defun calendar-next-time-zone-transition (time) "Return the time of the next time zone transition after TIME. Both TIME and the result are acceptable arguments to `current-time-zone'. Return nil if no such transition can be found." - (let* ((base 65536) ; 2^16 = base of current-time output - (quarter-multiple 120) ; approx = (seconds per quarter year) / base + (let* ((time (encode-time time 'integer)) (time-zone (current-time-zone time)) (time-utc-diff (car time-zone)) hi hi-zone (hi-utc-diff time-utc-diff) + (quarter-seconds 7889238) ; Average seconds per 1/4 Gregorian year. (quarters '(2 1 3))) ;; Heuristic: probe the time zone offset in the next three calendar ;; quarters, looking for a time zone offset different from TIME. (while (and quarters (eq time-utc-diff hi-utc-diff)) - (setq hi (cons (+ (car time) (* (car quarters) quarter-multiple)) 0) + (setq hi (+ time (* (car quarters) quarter-seconds)) hi-zone (current-time-zone hi) hi-utc-diff (car hi-zone) quarters (cdr quarters))) @@ -163,23 +149,16 @@ Return nil if no such transition can be found." ;; Now HI is after the next time zone transition. ;; Set LO to TIME, and then binary search to increase LO and decrease HI ;; until LO is just before and HI is just after the time zone transition. - (let* ((tail (cdr time)) - (lo (cons (car time) (if (numberp tail) tail (car tail)))) + (let* ((lo time) probe) (while ;; Set PROBE to halfway between LO and HI, rounding down. ;; If PROBE equals LO, we are done. - (let* ((lsum (+ (cdr lo) (cdr hi))) - (hsum (+ (car lo) (car hi) (/ lsum base))) - (hsumodd (logand 1 hsum))) - (setq probe (cons (/ (- hsum hsumodd) 2) - (/ (+ (* hsumodd base) (% lsum base)) 2))) - (not (equal lo probe))) + (not (= lo (setq probe (/ (+ lo hi) 2)))) ;; Set either LO or HI to PROBE, depending on probe results. (if (eq (car (current-time-zone probe)) hi-utc-diff) (setq hi probe) (setq lo probe))) - (setcdr hi (list (cdr hi))) hi)))) (autoload 'calendar-persian-to-absolute "cal-persia") diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el index d6c1e9ea16..9443fde4c9 100644 --- a/lisp/calendar/parse-time.el +++ b/lisp/calendar/parse-time.el @@ -227,7 +227,7 @@ If DATE-STRING cannot be parsed, it falls back to (tz-re (nth 2 parse-time-iso8601-regexp)) re-start time seconds minute hour - day month year day-of-week dst tz) + day month year day-of-week (dst -1) tz) ;; We need to populate 'time' with ;; (SEC MIN HOUR DAY MON YEAR DOW DST TZ) @@ -243,6 +243,7 @@ If DATE-STRING cannot be parsed, it falls back to seconds (string-to-number (match-string 3 date-string)) re-start (match-end 0)) (when (string-match tz-re date-string re-start) + (setq dst nil) (if (string= "Z" (match-string 1 date-string)) (setq tz 0) ;; UTC timezone indicated by Z (setq tz (+ @@ -260,7 +261,7 @@ If DATE-STRING cannot be parsed, it falls back to (setq time (parse-time-string date-string))) (and time - (apply 'encode-time time)))) + (encode-time time)))) (provide 'parse-time) diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index 74c607ccb6..c3898e0257 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -168,15 +168,15 @@ If DATE lacks timezone information, GMT is assumed." (defalias 'time-to-seconds 'float-time) ;;;###autoload -(defun seconds-to-time (seconds) - "Convert SECONDS to a time value." - (time-add 0 seconds)) +(defalias 'seconds-to-time 'encode-time) ;;;###autoload (defun days-to-time (days) "Convert DAYS into a time value." - (let ((time (seconds-to-time (* 86400 days)))) - (if (integerp days) + (let ((time (encode-time (* 86400 days)))) + ;; Traditionally, this returned a two-element list if DAYS was an integer. + ;; Keep that tradition if encode-time outputs timestamps in list form. + (if (and (integerp days) (consp (cdr time))) (setcdr (cdr time) nil)) time)) diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el index b46e7732fd..ddc297604e 100644 --- a/lisp/calendar/timeclock.el +++ b/lisp/calendar/timeclock.el @@ -534,8 +534,7 @@ non-nil, the amount returned will be relative to past time worked." string))) (define-obsolete-function-alias 'timeclock-time-to-seconds 'float-time "26.1") -(define-obsolete-function-alias 'timeclock-seconds-to-time 'seconds-to-time - "26.1") +(define-obsolete-function-alias 'timeclock-seconds-to-time 'encode-time "26.1") ;; Should today-only be removed in favor of timeclock-relative? - gm (defsubst timeclock-when-to-leave (&optional today-only) diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el index 74d37b0eae..927e640fea 100644 --- a/lisp/emacs-lisp/timer.el +++ b/lisp/emacs-lisp/timer.el @@ -57,17 +57,11 @@ (defun timer--time-setter (timer time) (timer--check timer) - (setf (timer--high-seconds timer) (pop time)) - (let ((low time) (usecs 0) (psecs 0)) - (when (consp time) - (setq low (pop time)) - (when time - (setq usecs (pop time)) - (when time - (setq psecs (car time))))) - (setf (timer--low-seconds timer) low) - (setf (timer--usecs timer) usecs) - (setf (timer--psecs timer) psecs) + (let ((lt (encode-time time 'list))) + (setf (timer--high-seconds timer) (nth 0 lt)) + (setf (timer--low-seconds timer) (nth 1 lt)) + (setf (timer--usecs timer) (nth 2 lt)) + (setf (timer--psecs timer) (nth 3 lt)) time)) ;; Pseudo field `time'. @@ -102,24 +96,14 @@ fire each time Emacs is idle for that many seconds." "Yield the next value after TIME that is an integral multiple of SECS. More precisely, the next value, after TIME, that is an integral multiple of SECS seconds since the epoch. SECS may be a fraction." - (let* ((trillion 1000000000000) - (time-sec (+ (nth 1 time) - (* 65536 (nth 0 time)))) - (delta-sec (mod (- time-sec) secs)) - (next-sec (+ time-sec (floor delta-sec))) - (next-sec-psec (floor (* trillion (mod delta-sec 1)))) - (sub-time-psec (+ (or (nth 3 time) 0) - (* 1000000 (nth 2 time)))) - (psec-diff (- sub-time-psec next-sec-psec))) - (if (and (<= next-sec time-sec) (< 0 psec-diff)) - (setq next-sec-psec (+ sub-time-psec - (mod (- psec-diff) (* trillion secs))))) - (setq next-sec (+ next-sec (floor next-sec-psec trillion))) - (setq next-sec-psec (mod next-sec-psec trillion)) - (list (floor next-sec 65536) - (floor (mod next-sec 65536)) - (floor next-sec-psec 1000000) - (floor (mod next-sec-psec 1000000))))) + (let* ((ticks-hz (if (and (consp time) (integerp (car time)) + (integerp (cdr time)) (< 0 (cdr time))) + time + (encode-time time 1000000000000))) + (hz (cdr ticks-hz)) + (s-ticks (* secs hz)) + (more-ticks (+ (car ticks-hz) s-ticks))) + (encode-time (cons (- more-ticks (% more-ticks s-ticks)) hz)))) (defun timer-relative-time (time secs &optional usecs psecs) "Advance TIME by SECS seconds and optionally USECS microseconds diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el index 217f0b859f..7a68c68ab6 100644 --- a/lisp/net/ntlm.el +++ b/lisp/net/ntlm.el @@ -155,8 +155,7 @@ signed integer." ;; tenths of microseconds between ;; 1601-01-01 and 1970-01-01 "116444736000000000)") - ;; add trailing zeros to support old current-time formats - 'rawnum (append (current-time) '(0 0)))) + 'rawnum (encode-time nil 'list))) result-bytes) (dotimes (byte 8) (push (calc-eval "and($1,16#FF)" 'rawnum tenths-of-us-since-jan-1-1601) diff --git a/lisp/obsolete/vc-arch.el b/lisp/obsolete/vc-arch.el index 9860c9d3fa..e4c52d5146 100644 --- a/lisp/obsolete/vc-arch.el +++ b/lisp/obsolete/vc-arch.el @@ -133,7 +133,8 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (file-error (insert (format "%s <%s> %s" (current-time-string) user-mail-address - (+ (nth 2 (current-time)) + (+ (% (car (encode-time nil 1000000)) + 1000000) (buffer-size))))))) (comment-region beg (point)))) diff --git a/lisp/org/org-id.el b/lisp/org/org-id.el index 26b203ff06..ad9b7d1ec7 100644 --- a/lisp/org/org-id.el +++ b/lisp/org/org-id.el @@ -357,7 +357,7 @@ So a typical ID could look like \"Org:4nd91V40HI\"." "Return string with random (version 4) UUID." (let ((rnd (md5 (format "%s%s%s%s%s%s%s" (random) - (current-time) + (encode-time nil 'list) (user-uid) (emacs-pid) (user-full-name) @@ -416,7 +416,7 @@ The input I may be a character, or a single-letter string." "Encode TIME as a 10-digit string. This string holds the time to micro-second accuracy, and can be decoded using `org-id-decode'." - (setq time (or time (current-time))) + (setq time (encode-time time 'list)) (concat (org-id-int-to-b36 (nth 0 time) 4) (org-id-int-to-b36 (nth 1 time) 4) (org-id-int-to-b36 (or (nth 2 time) 0) 4))) diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index 19e5159816..cf4e53abef 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -304,7 +304,7 @@ write-date, checksum, link-type, and link-name." (tar-parse-octal-integer string tar-uid-offset tar-gid-offset) (tar-parse-octal-integer string tar-gid-offset tar-size-offset) (tar-parse-octal-integer string tar-size-offset tar-time-offset) - (tar-parse-octal-long-integer string tar-time-offset tar-chk-offset) + (tar-parse-octal-integer string tar-time-offset tar-chk-offset) (tar-parse-octal-integer string tar-chk-offset tar-linkp-offset) link-p linkname @@ -342,20 +342,8 @@ write-date, checksum, link-type, and link-name." start (1+ start))) n))) -(defun tar-parse-octal-long-integer (string &optional start end) - (if (null start) (setq start 0)) - (if (null end) (setq end (length string))) - (if (= (aref string start) 0) - (list 0 0) - (let ((lo 0) - (hi 0)) - (while (< start end) - (if (>= (aref string start) ?0) - (setq lo (+ (* lo 8) (- (aref string start) ?0)) - hi (+ (* hi 8) (ash lo -16)) - lo (logand lo 65535))) - (setq start (1+ start))) - (list hi lo)))) +(define-obsolete-function-alias 'tar-parse-octal-long-integer + 'tar-parse-octal-integer "27.1") (defun tar-parse-octal-integer-safe (string) (if (zerop (length string)) (error "empty string")) @@ -1276,14 +1264,8 @@ for this to be permanent." (defun tar-octal-time (timeval) - ;; Format a timestamp as 11 octal digits. Ghod, I hope this works... - (let ((hibits (car timeval)) (lobits (car (cdr timeval)))) - (format "%05o%01o%05o" - (ash hibits -2) - (logior (ash (logand 3 hibits) 1) - (if (> (logand lobits 32768) 0) 1 0)) - (logand 32767 lobits) - ))) + ;; Format a timestamp as 11 octal digits. + (format "%011o" (encode-time timeval 'integer))) (defun tar-subfile-save-buffer () "In tar subfile mode, save this buffer into its parent tar-file buffer. diff --git a/src/bignum.c b/src/bignum.c index 5d8ab670f2..0ab8de3ab7 100644 --- a/src/bignum.c +++ b/src/bignum.c @@ -31,7 +31,7 @@ along with GNU Emacs. If not, see . */ storage is exhausted. Admittedly this is not ideal. An mpz value in a temporary is made permanent by mpz_swapping it with a bignum's value. Although typically at most two temporaries are needed, - rounding_driver and rounddiv_q need four altogther. */ + time_arith, rounddiv_q and rounding_driver each need four. */ mpz_t mpz[4]; diff --git a/src/keyboard.c b/src/keyboard.c index 35d74f4a79..8ea15d3c89 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -4163,18 +4163,13 @@ decode_timer (Lisp_Object timer, struct timespec *result) Lisp_Object *vec; if (! (VECTORP (timer) && ASIZE (timer) == 9)) - return 0; + return false; vec = XVECTOR (timer)->contents; if (! NILP (vec[0])) - return 0; - if (! FIXNUMP (vec[2])) return false; - - struct lisp_time t; - if (decode_time_components (vec[1], vec[2], vec[3], vec[8], &t, 0) <= 0) + if (! FIXNUMP (vec[2])) return false; - *result = lisp_to_timespec (t); - return timespec_valid_p (*result); + return list4_to_timespec (vec[1], vec[2], vec[3], vec[8], result); } diff --git a/src/systime.h b/src/systime.h index f2f51b009e..0bc1e90fb0 100644 --- a/src/systime.h +++ b/src/systime.h @@ -75,19 +75,22 @@ extern void set_waiting_for_input (struct timespec *); (HI << LO_TIME_BITS) + LO + US / 1e6 + PS / 1e12. */ enum { LO_TIME_BITS = 16 }; -/* A Lisp time (HI LO US PS), sans the cons cells. */ +/* Components of a new-format Lisp timestamp. */ struct lisp_time { - EMACS_INT hi; - int lo, us, ps; + /* Clock count as a Lisp integer. */ + Lisp_Object ticks; + + /* Clock frequency (ticks per second) as a positive Lisp integer. + (TICKS . HZ) is a valid Lisp timestamp unless HZ < 65536. */ + Lisp_Object hz; }; /* defined in timefns.c */ extern struct timeval make_timeval (struct timespec) ATTRIBUTE_CONST; extern Lisp_Object make_lisp_time (struct timespec); -extern int decode_time_components (Lisp_Object, Lisp_Object, Lisp_Object, - Lisp_Object, struct lisp_time *, double *); -extern struct timespec lisp_to_timespec (struct lisp_time); +extern bool list4_to_timespec (Lisp_Object, Lisp_Object, Lisp_Object, + Lisp_Object, struct timespec *); extern struct timespec lisp_time_argument (Lisp_Object); extern _Noreturn void time_overflow (void); extern void init_timefns (bool); diff --git a/src/timefns.c b/src/timefns.c index fcb4485ae3..72cb54d3a0 100644 --- a/src/timefns.c +++ b/src/timefns.c @@ -22,12 +22,14 @@ along with GNU Emacs. If not, see . */ #include "systime.h" #include "blockinput.h" +#include "bignum.h" #include "coding.h" #include "lisp.h" #include #include +#include #include #include #include @@ -55,6 +57,47 @@ along with GNU Emacs. If not, see . */ # define TIME_T_MAX TYPE_MAXIMUM (time_t) #endif +/* Compile with -DFASTER_TIMEFNS=0 to disable common optimizations and + allow easier testing of some slow-path code. */ +#ifndef FASTER_TIMEFNS +# define FASTER_TIMEFNS 1 +#endif + +/* Whether to warn about Lisp timestamps (TICKS . HZ) that may be + instances of obsolete-format timestamps (HI . LO) where HI is + the high-order bits and LO the low-order 16 bits. Currently this + is true, but it should change to false in a future version of + Emacs. Compile with -DWARN_OBSOLETE_TIMESTAMPS=0 to see what the + future will be like. */ +#ifndef WARN_OBSOLETE_TIMESTAMPS +enum { WARN_OBSOLETE_TIMESTAMPS = true }; +#endif + +/* Although current-time etc. generate list-format timestamps + (HI LO US PS), the plan is to change these functions to generate + frequency-based timestamps (TICKS . HZ) in a future release. + To try this now, compile with -DCURRENT_TIME_LIST=0. */ +#ifndef CURRENT_TIME_LIST +enum { CURRENT_TIME_LIST = true }; +#endif + +#if FIXNUM_OVERFLOW_P (1000000000) +static Lisp_Object timespec_hz; +#else +# define timespec_hz make_fixnum (TIMESPEC_HZ) +#endif + +#define TRILLION 1000000000000 +#if FIXNUM_OVERFLOW_P (TRILLION) +static Lisp_Object trillion; +# define ztrillion (XBIGNUM (trillion)->value) +#else +# define trillion make_fixnum (TRILLION) +# if ULONG_MAX < TRILLION || !FASTER_TIMEFNS +mpz_t ztrillion; +# endif +#endif + /* Return a struct timeval that is roughly equivalent to T. Use the least timeval not less than T. Return an extremal value if the result would overflow. */ @@ -69,7 +112,7 @@ make_timeval (struct timespec t) { if (tv.tv_usec < 999999) tv.tv_usec++; - else if (tv.tv_sec < TYPE_MAXIMUM (time_t)) + else if (tv.tv_sec < TIME_T_MAX) { tv.tv_sec++; tv.tv_usec = 0; @@ -309,52 +352,430 @@ invalid_time (void) error ("Invalid time specification"); } -/* Check a return value compatible with that of decode_time_components. */ -static void -check_time_validity (int validity) +static _Noreturn void +invalid_hz (Lisp_Object hz) { - if (validity <= 0) - { - if (validity < 0) - time_overflow (); - else - invalid_time (); - } + xsignal2 (Qerror, build_string ("Invalid time frequency"), hz); } /* Return the upper part of the time T (everything but the bottom 16 bits). */ -static EMACS_INT +static Lisp_Object hi_time (time_t t) { - time_t hi = t >> LO_TIME_BITS; - if (FIXNUM_OVERFLOW_P (hi)) - time_overflow (); - return hi; + return INT_TO_INTEGER (t >> LO_TIME_BITS); } /* Return the bottom bits of the time T. */ -static int +static Lisp_Object lo_time (time_t t) { - return t & ((1 << LO_TIME_BITS) - 1); + return make_fixnum (t & ((1 << LO_TIME_BITS) - 1)); } -/* Decode a Lisp list SPECIFIED_TIME that represents a time. - Set *PHIGH, *PLOW, *PUSEC, *PPSEC to its parts; do not check their values. - Return 2, 3, or 4 to indicate the effective length of SPECIFIED_TIME - if successful, 0 if unsuccessful. */ -static int -disassemble_lisp_time (Lisp_Object specified_time, Lisp_Object *phigh, - Lisp_Object *plow, Lisp_Object *pusec, - Lisp_Object *ppsec) +/* Convert T into an Emacs time *RESULT, truncating toward minus infinity. + Return true if T is in range, false otherwise. */ +static bool +decode_float_time (double t, struct lisp_time *result) +{ + if (!isfinite (t)) + return false; + /* Actual hz unknown; guess TIMESPEC_HZ. */ + mpz_set_d (mpz[1], t); + mpz_set_si (mpz[0], floor ((t - trunc (t)) * TIMESPEC_HZ)); + mpz_addmul_ui (mpz[0], mpz[1], TIMESPEC_HZ); + result->ticks = make_integer_mpz (); + result->hz = timespec_hz; + return true; +} + +/* Compute S + NS/TIMESPEC_HZ as a double. + Calls to this function suffer from double-rounding; + work around some of the problem by using long double. */ +static double +s_ns_to_double (long double s, long double ns) +{ + return s + ns / TIMESPEC_HZ; +} + +/* Make a 4-element timestamp (HI LO US PS) from TICKS and HZ. + Drop any excess precision. */ +static Lisp_Object +ticks_hz_list4 (Lisp_Object ticks, Lisp_Object hz) +{ + mpz_t *zticks = bignum_integer (&mpz[0], ticks); +#if FASTER_TIMEFNS && TRILLION <= ULONG_MAX + mpz_mul_ui (mpz[0], *zticks, TRILLION); +#else + mpz_mul (mpz[0], *zticks, ztrillion); +#endif + mpz_fdiv_q (mpz[0], mpz[0], *bignum_integer (&mpz[1], hz)); +#if FASTER_TIMEFNS && TRILLION <= ULONG_MAX + unsigned long int fullps = mpz_fdiv_q_ui (mpz[0], mpz[0], TRILLION); + int us = fullps / 1000000; + int ps = fullps % 1000000; +#else + mpz_fdiv_qr (mpz[0], mpz[1], mpz[0], ztrillion); + int ps = mpz_fdiv_q_ui (mpz[1], mpz[1], 1000000); + int us = mpz_get_ui (mpz[1]); +#endif + unsigned long ulo = mpz_get_ui (mpz[0]); + if (mpz_sgn (mpz[0]) < 0) + ulo = -ulo; + int lo = ulo & ((1 << LO_TIME_BITS) - 1); + mpz_fdiv_q_2exp (mpz[0], mpz[0], LO_TIME_BITS); + return list4 (make_integer_mpz (), make_fixnum (lo), + make_fixnum (us), make_fixnum (ps)); +} + +/* Set ROP to T. */ +static void +mpz_set_time (mpz_t rop, time_t t) +{ + if (EXPR_SIGNED (t)) + mpz_set_intmax (rop, t); + else + mpz_set_uintmax (rop, t); +} + +/* Store into mpz[0] a clock tick count for T, assuming a + TIMESPEC_HZ-frequency clock. Use mpz[1] as a temp. */ +static void +timespec_mpz (struct timespec t) +{ + mpz_set_ui (mpz[0], t.tv_nsec); + mpz_set_time (mpz[1], t.tv_sec); + mpz_addmul_ui (mpz[0], mpz[1], TIMESPEC_HZ); +} + +/* Convert T to a Lisp integer counting TIMESPEC_HZ ticks. */ +static Lisp_Object +timespec_ticks (struct timespec t) +{ + intmax_t accum; + if (FASTER_TIMEFNS + && !INT_MULTIPLY_WRAPV (t.tv_sec, TIMESPEC_HZ, &accum) + && !INT_ADD_WRAPV (t.tv_nsec, accum, &accum)) + return make_int (accum); + timespec_mpz (t); + return make_integer_mpz (); +} + +/* Convert T to a Lisp integer counting HZ ticks, taking the floor. + Assume T is valid, but check HZ. */ +static Lisp_Object +time_hz_ticks (time_t t, Lisp_Object hz) +{ + if (FIXNUMP (hz)) + { + if (XFIXNUM (hz) <= 0) + invalid_hz (hz); + intmax_t ticks; + if (FASTER_TIMEFNS && !INT_MULTIPLY_WRAPV (t, XFIXNUM (hz), &ticks)) + return make_int (ticks); + } + else if (! (BIGNUMP (hz) && 0 < mpz_sgn (XBIGNUM (hz)->value))) + invalid_hz (hz); + + mpz_set_time (mpz[0], t); + mpz_mul (mpz[0], mpz[0], *bignum_integer (&mpz[1], hz)); + return make_integer_mpz (); +} +static Lisp_Object +lisp_time_hz_ticks (struct lisp_time t, Lisp_Object hz) +{ + if (FASTER_TIMEFNS && EQ (t.hz, hz)) + return t.ticks; + if (FIXNUMP (hz)) + { + if (XFIXNUM (hz) <= 0) + invalid_hz (hz); + intmax_t ticks; + if (FASTER_TIMEFNS && FIXNUMP (t.ticks) && FIXNUMP (t.hz) + && !INT_MULTIPLY_WRAPV (XFIXNUM (t.ticks), XFIXNUM (hz), &ticks)) + return make_int (ticks / XFIXNUM (t.hz) + - (ticks % XFIXNUM (t.hz) < 0)); + } + else if (! (BIGNUMP (hz) && 0 < mpz_sgn (XBIGNUM (hz)->value))) + invalid_hz (hz); + + mpz_mul (mpz[0], + *bignum_integer (&mpz[0], t.ticks), + *bignum_integer (&mpz[1], hz)); + mpz_fdiv_q (mpz[0], mpz[0], *bignum_integer (&mpz[1], t.hz)); + return make_integer_mpz (); +} + +/* Convert T to a Lisp integer counting seconds, taking the floor. */ +static Lisp_Object +lisp_time_seconds (struct lisp_time t) +{ + if (!FASTER_TIMEFNS) + return lisp_time_hz_ticks (t, make_fixnum (1)); + if (FIXNUMP (t.ticks) && FIXNUMP (t.hz)) + return make_fixnum (XFIXNUM (t.ticks) / XFIXNUM (t.hz) + - (XFIXNUM (t.ticks) % XFIXNUM (t.hz) < 0)); + mpz_fdiv_q (mpz[0], + *bignum_integer (&mpz[0], t.ticks), + *bignum_integer (&mpz[1], t.hz)); + return make_integer_mpz (); +} + +/* Convert T to a Lisp timestamp. */ +Lisp_Object +make_lisp_time (struct timespec t) +{ + if (CURRENT_TIME_LIST) + { + time_t s = t.tv_sec; + int ns = t.tv_nsec; + return list4 (hi_time (s), lo_time (s), + make_fixnum (ns / 1000), make_fixnum (ns % 1000 * 1000)); + } + else + return Fcons (timespec_ticks (t), timespec_hz); +} + +/* Convert T to a Lisp timestamp. FORM specifies the timestamp format. */ +static Lisp_Object +time_form_stamp (time_t t, Lisp_Object form) +{ + if (NILP (form)) + form = CURRENT_TIME_LIST ? Qlist : Qt; + if (EQ (form, Qlist)) + return list2 (hi_time (t), lo_time (t)); + if (EQ (form, Qt) || EQ (form, Qinteger)) + return INT_TO_INTEGER (t); + return Fcons (time_hz_ticks (t, form), form); +} +static Lisp_Object +lisp_time_form_stamp (struct lisp_time t, Lisp_Object form) +{ + if (NILP (form)) + form = CURRENT_TIME_LIST ? Qlist : Qt; + if (EQ (form, Qlist)) + return ticks_hz_list4 (t.ticks, t.hz); + if (EQ (form, Qinteger)) + return lisp_time_seconds (t); + if (EQ (form, Qt)) + form = t.hz; + return Fcons (lisp_time_hz_ticks (t, form), form); +} + +/* From what should be a valid timestamp (TICKS . HZ), generate the + corresponding time values. + + If RESULT is not null, store into *RESULT the converted time. + Otherwise, store into *DRESULT the number of seconds since the + start of the POSIX Epoch. Unsuccessful calls may or may not store + results. + + Return true if successful, false if (TICKS . HZ) would not + be a valid new-format timestamp. */ +static bool +decode_ticks_hz (Lisp_Object ticks, Lisp_Object hz, + struct lisp_time *result, double *dresult) +{ + int ns; + mpz_t *q = &mpz[0]; + + if (! (INTEGERP (ticks) + && ((FIXNUMP (hz) && 0 < XFIXNUM (hz)) + || (BIGNUMP (hz) && 0 < mpz_sgn (XBIGNUM (hz)->value))))) + return false; + + if (result) + { + result->ticks = ticks; + result->hz = hz; + } + else + { + if (FASTER_TIMEFNS && EQ (hz, timespec_hz)) + { + if (FIXNUMP (ticks)) + { + verify (1 < TIMESPEC_HZ); + EMACS_INT s = XFIXNUM (ticks) / TIMESPEC_HZ; + ns = XFIXNUM (ticks) % TIMESPEC_HZ; + if (ns < 0) + s--, ns += TIMESPEC_HZ; + *dresult = s_ns_to_double (s, ns); + return true; + } + ns = mpz_fdiv_q_ui (*q, XBIGNUM (ticks)->value, TIMESPEC_HZ); + } + else if (FASTER_TIMEFNS && EQ (hz, make_fixnum (1))) + { + ns = 0; + if (FIXNUMP (ticks)) + { + *dresult = XFIXNUM (ticks); + return true; + } + q = &XBIGNUM (ticks)->value; + } + else + { + mpz_mul_ui (*q, *bignum_integer (&mpz[1], ticks), TIMESPEC_HZ); + mpz_fdiv_q (*q, *q, *bignum_integer (&mpz[1], hz)); + ns = mpz_fdiv_q_ui (*q, *q, TIMESPEC_HZ); + } + + *dresult = s_ns_to_double (mpz_get_d (*q), ns); + } + + return true; +} + +/* Lisp timestamp classification. */ +enum timeform + { + TIMEFORM_INVALID = 0, + TIMEFORM_HI_LO, /* seconds in the form (HI << LO_TIME_BITS) + LO. */ + TIMEFORM_HI_LO_US, /* seconds plus microseconds (HI LO US) */ + TIMEFORM_NIL, /* current time in nanoseconds */ + TIMEFORM_HI_LO_US_PS, /* seconds plus micro and picoseconds (HI LO US PS) */ + TIMEFORM_FLOAT, /* time as a float */ + TIMEFORM_TICKS_HZ /* fractional time: HI is ticks, LO is ticks per second */ + }; + +/* From the valid form FORM and the time components HIGH, LOW, USEC + and PSEC, generate the corresponding time value. If LOW is + floating point, the other components should be zero and FORM should + not be TIMEFORM_TICKS_HZ. + + If RESULT is not null, store into *RESULT the converted time. + Otherwise, store into *DRESULT the number of seconds since the + start of the POSIX Epoch. Unsuccessful calls may or may not store + results. + + Return true if successful, false if the components are of the wrong + type. */ +static bool +decode_time_components (enum timeform form, + Lisp_Object high, Lisp_Object low, + Lisp_Object usec, Lisp_Object psec, + struct lisp_time *result, double *dresult) +{ + switch (form) + { + case TIMEFORM_INVALID: + return false; + + case TIMEFORM_TICKS_HZ: + return decode_ticks_hz (high, low, result, dresult); + + case TIMEFORM_FLOAT: + { + double t = XFLOAT_DATA (low); + if (result) + return decode_float_time (t, result); + else + { + *dresult = t; + return true; + } + } + + case TIMEFORM_NIL: + { + struct timespec now = current_timespec (); + if (result) + { + result->ticks = timespec_ticks (now); + result->hz = timespec_hz; + } + else + *dresult = s_ns_to_double (now.tv_sec, now.tv_nsec); + return true; + } + + default: + break; + } + + if (! (INTEGERP (high) && INTEGERP (low) + && FIXNUMP (usec) && FIXNUMP (psec))) + return false; + EMACS_INT us = XFIXNUM (usec); + EMACS_INT ps = XFIXNUM (psec); + + /* Normalize out-of-range lower-order components by carrying + each overflow into the next higher-order component. */ + us += ps / 1000000 - (ps % 1000000 < 0); + mpz_set_intmax (mpz[0], us / 1000000 - (us % 1000000 < 0)); + mpz_add (mpz[0], mpz[0], *bignum_integer (&mpz[1], low)); + mpz_addmul_ui (mpz[0], *bignum_integer (&mpz[1], high), 1 << LO_TIME_BITS); + ps = ps % 1000000 + 1000000 * (ps % 1000000 < 0); + us = us % 1000000 + 1000000 * (us % 1000000 < 0); + + if (result) + { + switch (form) + { + case TIMEFORM_HI_LO: + /* Floats and nil were handled above, so it was an integer. */ + result->hz = make_fixnum (1); + break; + + case TIMEFORM_HI_LO_US: + mpz_mul_ui (mpz[0], mpz[0], 1000000); + mpz_add_ui (mpz[0], mpz[0], us); + result->hz = make_fixnum (1000000); + break; + + case TIMEFORM_HI_LO_US_PS: + mpz_mul_ui (mpz[0], mpz[0], 1000000); + mpz_add_ui (mpz[0], mpz[0], us); + mpz_mul_ui (mpz[0], mpz[0], 1000000); + mpz_add_ui (mpz[0], mpz[0], ps); + result->hz = trillion; + break; + + default: + eassume (false); + } + result->ticks = make_integer_mpz (); + } + else + *dresult = mpz_get_d (mpz[0]) + (us * 1e6L + ps) / 1e12L; + + return true; +} + +enum { DECODE_SECS_ONLY = WARN_OBSOLETE_TIMESTAMPS + 1 }; + +/* Decode a Lisp timestamp SPECIFIED_TIME that represents a time. + + FLAGS specifies conversion flags. If FLAGS & DECODE_SECS_ONLY, + ignore and do not validate any sub-second components of an + old-format SPECIFIED_TIME. If FLAGS & WARN_OBSOLETE_TIMESTAMPS, + diagnose what could be obsolete (HIGH . LOW) timestamps. + + If PFORM is not null, store into *PFORM the form of SPECIFIED-TIME. + If RESULT is not null, store into *RESULT the converted time; + otherwise, store into *DRESULT the number of seconds since the + start of the POSIX Epoch. Unsuccessful calls may or may not store + results. + + Return true if successful, false if SPECIFIED_TIME is + not a valid Lisp timestamp. */ +static bool +decode_lisp_time (Lisp_Object specified_time, int flags, + enum timeform *pform, + struct lisp_time *result, double *dresult) { Lisp_Object high = make_fixnum (0); Lisp_Object low = specified_time; Lisp_Object usec = make_fixnum (0); Lisp_Object psec = make_fixnum (0); - int len = 4; + enum timeform form = TIMEFORM_HI_LO; - if (CONSP (specified_time)) + if (NILP (specified_time)) + form = TIMEFORM_NIL; + else if (FLOATP (specified_time)) + form = TIMEFORM_FLOAT; + else if (CONSP (specified_time)) { high = XCAR (specified_time); low = XCDR (specified_time); @@ -362,259 +783,185 @@ disassemble_lisp_time (Lisp_Object specified_time, Lisp_Object *phigh, { Lisp_Object low_tail = XCDR (low); low = XCAR (low); - if (CONSP (low_tail)) + if (! (flags & DECODE_SECS_ONLY)) { - usec = XCAR (low_tail); - low_tail = XCDR (low_tail); if (CONSP (low_tail)) - psec = XCAR (low_tail); - else - len = 3; - } - else if (!NILP (low_tail)) - { - usec = low_tail; - len = 3; + { + usec = XCAR (low_tail); + low_tail = XCDR (low_tail); + if (CONSP (low_tail)) + { + psec = XCAR (low_tail); + form = TIMEFORM_HI_LO_US_PS; + } + else + form = TIMEFORM_HI_LO_US; + } + else if (!NILP (low_tail)) + { + usec = low_tail; + form = TIMEFORM_HI_LO_US; + } } - else - len = 2; } else - len = 2; + { + if (flags & WARN_OBSOLETE_TIMESTAMPS + && RANGED_FIXNUMP (0, low, (1 << LO_TIME_BITS) - 1)) + message ("obsolete timestamp with cdr %"pI"d", XFIXNUM (low)); + form = TIMEFORM_TICKS_HZ; + } - /* When combining components, require LOW to be an integer, - as otherwise it would be a pain to add up times. */ + /* Require LOW to be an integer, as otherwise the computation + would be considerably trickier. */ if (! INTEGERP (low)) - return 0; + form = TIMEFORM_INVALID; } - else if (INTEGERP (specified_time)) - len = 2; - - *phigh = high; - *plow = low; - *pusec = usec; - *ppsec = psec; - return len; + + if (pform) + *pform = form; + return decode_time_components (form, high, low, usec, psec, result, dresult); } -/* Convert T into an Emacs time *RESULT, truncating toward minus infinity. - Return true if T is in range, false otherwise. */ +/* Convert Z to time_t, returning true if it fits. */ static bool -decode_float_time (double t, struct lisp_time *result) +mpz_time (mpz_t const z, time_t *t) { - double lo_multiplier = 1 << LO_TIME_BITS; - double emacs_time_min = MOST_NEGATIVE_FIXNUM * lo_multiplier; - if (! (emacs_time_min <= t && t < -emacs_time_min)) - return false; - - double small_t = t / lo_multiplier; - EMACS_INT hi = small_t; - double t_sans_hi = t - hi * lo_multiplier; - int lo = t_sans_hi; - long double fracps = (t_sans_hi - lo) * 1e12L; -#ifdef INT_FAST64_MAX - int_fast64_t ifracps = fracps; - int us = ifracps / 1000000; - int ps = ifracps % 1000000; -#else - int us = fracps / 1e6L; - int ps = fracps - us * 1e6L; -#endif - us -= (ps < 0); - ps += (ps < 0) * 1000000; - lo -= (us < 0); - us += (us < 0) * 1000000; - hi -= (lo < 0); - lo += (lo < 0) << LO_TIME_BITS; - result->hi = hi; - result->lo = lo; - result->us = us; - result->ps = ps; + if (TYPE_SIGNED (time_t)) + { + intmax_t i; + if (! (mpz_to_intmax (z, &i) && TIME_T_MIN <= i && i <= TIME_T_MAX)) + return false; + *t = i; + } + else + { + uintmax_t i; + if (! (mpz_to_uintmax (z, &i) && i <= TIME_T_MAX)) + return false; + *t = i; + } return true; } -/* From the time components HIGH, LOW, USEC and PSEC taken from a Lisp - list, generate the corresponding time value. - If LOW is floating point, the other components should be zero. - - If RESULT is not null, store into *RESULT the converted time. - If *DRESULT is not null, store into *DRESULT the number of - seconds since the start of the POSIX Epoch. - - Return 1 if successful, 0 if the components are of the - wrong type, and -1 if the time is out of range. */ -int -decode_time_components (Lisp_Object high, Lisp_Object low, Lisp_Object usec, - Lisp_Object psec, - struct lisp_time *result, double *dresult) +/* Convert T to struct timespec, returning an invalid timespec + if T does not fit. */ +static struct timespec +lisp_to_timespec (struct lisp_time t) { - EMACS_INT hi, us, ps; - intmax_t lo; - if (! (FIXNUMP (high) - && FIXNUMP (usec) && FIXNUMP (psec))) - return 0; - if (! INTEGERP (low)) + struct timespec result = invalid_timespec (); + int ns; + mpz_t *q = &mpz[0]; + + if (FASTER_TIMEFNS && EQ (t.hz, timespec_hz)) { - if (FLOATP (low)) - { - double t = XFLOAT_DATA (low); - if (result && ! decode_float_time (t, result)) - return -1; - if (dresult) - *dresult = t; - return 1; - } - else if (NILP (low)) + if (FIXNUMP (t.ticks)) { - struct timespec now = current_timespec (); - if (result) + EMACS_INT s = XFIXNUM (t.ticks) / TIMESPEC_HZ; + ns = XFIXNUM (t.ticks) % TIMESPEC_HZ; + if (ns < 0) + s--, ns += TIMESPEC_HZ; + if ((TYPE_SIGNED (time_t) ? TIME_T_MIN <= s : 0 <= s) + && s <= TIME_T_MAX) { - result->hi = hi_time (now.tv_sec); - result->lo = lo_time (now.tv_sec); - result->us = now.tv_nsec / 1000; - result->ps = now.tv_nsec % 1000 * 1000; + result.tv_sec = s; + result.tv_nsec = ns; } - if (dresult) - *dresult = now.tv_sec + now.tv_nsec / 1e9; - return 1; + return result; } else - return 0; + ns = mpz_fdiv_q_ui (*q, XBIGNUM (t.ticks)->value, TIMESPEC_HZ); } - - hi = XFIXNUM (high); - if (! integer_to_intmax (low, &lo)) - return -1; - us = XFIXNUM (usec); - ps = XFIXNUM (psec); - - /* Normalize out-of-range lower-order components by carrying - each overflow into the next higher-order component. */ - us += ps / 1000000 - (ps % 1000000 < 0); - lo += us / 1000000 - (us % 1000000 < 0); - if (INT_ADD_WRAPV (lo >> LO_TIME_BITS, hi, &hi)) - return -1; - ps = ps % 1000000 + 1000000 * (ps % 1000000 < 0); - us = us % 1000000 + 1000000 * (us % 1000000 < 0); - lo &= (1 << LO_TIME_BITS) - 1; - - if (result) + else if (FASTER_TIMEFNS && EQ (t.hz, make_fixnum (1))) { - if (FIXNUM_OVERFLOW_P (hi)) - return -1; - result->hi = hi; - result->lo = lo; - result->us = us; - result->ps = ps; + ns = 0; + if (FIXNUMP (t.ticks)) + { + EMACS_INT s = XFIXNUM (t.ticks); + if ((TYPE_SIGNED (time_t) ? TIME_T_MIN <= s : 0 <= s) + && s <= TIME_T_MAX) + { + result.tv_sec = s; + result.tv_nsec = ns; + } + return result; + } + else + q = &XBIGNUM (t.ticks)->value; } - - if (dresult) + else { - double dhi = hi; - *dresult = (us * 1e6 + ps) / 1e12 + lo + dhi * (1 << LO_TIME_BITS); + mpz_mul_ui (*q, *bignum_integer (q, t.ticks), TIMESPEC_HZ); + mpz_fdiv_q (*q, *q, *bignum_integer (&mpz[1], t.hz)); + ns = mpz_fdiv_q_ui (*q, *q, TIMESPEC_HZ); } - return 1; + if (mpz_time (*q, &result.tv_sec)) + result.tv_nsec = ns; + return result; } -struct timespec -lisp_to_timespec (struct lisp_time t) +/* Convert (HIGH LOW USEC PSEC) to struct timespec. + Return true if successful. */ +bool +list4_to_timespec (Lisp_Object high, Lisp_Object low, + Lisp_Object usec, Lisp_Object psec, + struct timespec *result) { - if (! ((TYPE_SIGNED (time_t) ? TIME_T_MIN >> LO_TIME_BITS <= t.hi : 0 <= t.hi) - && t.hi <= TIME_T_MAX >> LO_TIME_BITS)) - return invalid_timespec (); - time_t s = (t.hi << LO_TIME_BITS) + t.lo; - int ns = t.us * 1000 + t.ps / 1000; - return make_timespec (s, ns); + struct lisp_time t; + if (! decode_time_components (TIMEFORM_HI_LO_US_PS, high, low, usec, psec, + &t, 0)) + return false; + *result = lisp_to_timespec (t); + return timespec_valid_p (*result); } /* Decode a Lisp list SPECIFIED_TIME that represents a time. - Store its effective length into *PLEN. If SPECIFIED_TIME is nil, use the current time. Signal an error if SPECIFIED_TIME does not represent a time. */ static struct lisp_time -lisp_time_struct (Lisp_Object specified_time, int *plen) +lisp_time_struct (Lisp_Object specified_time, enum timeform *pform) { - Lisp_Object high, low, usec, psec; + int flags = WARN_OBSOLETE_TIMESTAMPS; struct lisp_time t; - int len = disassemble_lisp_time (specified_time, &high, &low, &usec, &psec); - if (!len) + if (! decode_lisp_time (specified_time, flags, pform, &t, 0)) invalid_time (); - int val = decode_time_components (high, low, usec, psec, &t, 0); - check_time_validity (val); - *plen = len; return t; } -/* Like lisp_time_struct, except return a struct timespec. - Discard any low-order digits. */ +/* Decode a Lisp list SPECIFIED_TIME that represents a time. + Discard any low-order (sub-ns) resolution. + If SPECIFIED_TIME is nil, use the current time. + Signal an error if SPECIFIED_TIME does not represent a timespec. */ struct timespec lisp_time_argument (Lisp_Object specified_time) { - int len; - struct lisp_time lt = lisp_time_struct (specified_time, &len); + struct lisp_time lt = lisp_time_struct (specified_time, 0); struct timespec t = lisp_to_timespec (lt); if (! timespec_valid_p (t)) time_overflow (); return t; } -/* Like lisp_time_argument, except decode only the seconds part, - and do not check the subseconds part. */ +/* Like lisp_time_argument, except decode only the seconds part, and + do not check the subseconds part. */ static time_t lisp_seconds_argument (Lisp_Object specified_time) { - Lisp_Object high, low, usec, psec; - struct lisp_time t; - - int val = disassemble_lisp_time (specified_time, &high, &low, &usec, &psec); - if (val != 0) - { - val = decode_time_components (high, low, make_fixnum (0), - make_fixnum (0), &t, 0); - if (0 < val - && ! ((TYPE_SIGNED (time_t) - ? TIME_T_MIN >> LO_TIME_BITS <= t.hi - : 0 <= t.hi) - && t.hi <= TIME_T_MAX >> LO_TIME_BITS)) - val = -1; - } - check_time_validity (val); - return (t.hi << LO_TIME_BITS) + t.lo; -} - -static struct lisp_time -time_add (struct lisp_time ta, struct lisp_time tb) -{ - EMACS_INT hi = ta.hi + tb.hi; - int lo = ta.lo + tb.lo; - int us = ta.us + tb.us; - int ps = ta.ps + tb.ps; - us += (1000000 <= ps); - ps -= (1000000 <= ps) * 1000000; - lo += (1000000 <= us); - us -= (1000000 <= us) * 1000000; - hi += (1 << LO_TIME_BITS <= lo); - lo -= (1 << LO_TIME_BITS <= lo) << LO_TIME_BITS; - return (struct lisp_time) { hi, lo, us, ps }; -} - -static struct lisp_time -time_subtract (struct lisp_time ta, struct lisp_time tb) -{ - EMACS_INT hi = ta.hi - tb.hi; - int lo = ta.lo - tb.lo; - int us = ta.us - tb.us; - int ps = ta.ps - tb.ps; - us -= (ps < 0); - ps += (ps < 0) * 1000000; - lo -= (us < 0); - us += (us < 0) * 1000000; - hi -= (lo < 0); - lo += (lo < 0) << LO_TIME_BITS; - return (struct lisp_time) { hi, lo, us, ps }; + int flags = WARN_OBSOLETE_TIMESTAMPS | DECODE_SECS_ONLY; + struct lisp_time lt; + if (! decode_lisp_time (specified_time, flags, 0, <, 0)) + invalid_time (); + struct timespec t = lisp_to_timespec (lt); + if (! timespec_valid_p (t)) + time_overflow (); + return t.tv_sec; } +/* Given Lisp operands A and B, add their values, and return the + result as a Lisp timestamp that is in (TICKS . HZ) form if either A + or B are in that form, (HI LO US PS) form otherwise. Subtract + instead of adding if SUBTRACT. */ static Lisp_Object time_arith (Lisp_Object a, Lisp_Object b, bool subtract) { @@ -627,45 +974,80 @@ time_arith (Lisp_Object a, Lisp_Object b, bool subtract) if (FLOATP (b) && !isfinite (XFLOAT_DATA (b))) return subtract ? make_float (-XFLOAT_DATA (b)) : b; - int alen, blen; - struct lisp_time ta = lisp_time_struct (a, &alen); - struct lisp_time tb = lisp_time_struct (b, &blen); - struct lisp_time t = (subtract ? time_subtract : time_add) (ta, tb); - if (FIXNUM_OVERFLOW_P (t.hi)) - time_overflow (); - Lisp_Object val = Qnil; + enum timeform aform, bform; + struct lisp_time ta = lisp_time_struct (a, &aform); + struct lisp_time tb = lisp_time_struct (b, &bform); + Lisp_Object ticks, hz; - switch (max (alen, blen)) + if (FASTER_TIMEFNS && EQ (ta.hz, tb.hz)) { - default: - val = Fcons (make_fixnum (t.ps), val); - FALLTHROUGH; - case 3: - val = Fcons (make_fixnum (t.us), val); - FALLTHROUGH; - case 2: - val = Fcons (make_fixnum (t.lo), val); - val = Fcons (make_fixnum (t.hi), val); - break; + hz = ta.hz; + if (FIXNUMP (ta.ticks) && FIXNUMP (tb.ticks)) + ticks = make_int (subtract + ? XFIXNUM (ta.ticks) - XFIXNUM (tb.ticks) + : XFIXNUM (ta.ticks) + XFIXNUM (tb.ticks)); + else + { + (subtract ? mpz_sub : mpz_add) + (mpz[0], + *bignum_integer (&mpz[0], ta.ticks), + *bignum_integer (&mpz[1], tb.ticks)); + ticks = make_integer_mpz (); + } + } + else + { + /* The plan is to decompose ta into na/da and tb into nb/db. + Start by computing da and db. */ + mpz_t *da = bignum_integer (&mpz[1], ta.hz); + mpz_t *db = bignum_integer (&mpz[2], tb.hz); + + /* The plan is to compute (na * (db/g) + nb * (da/g)) / lcm (da, db) + where g = gcd (da, db). Start by computing g. */ + mpz_t *g = &mpz[3]; + mpz_gcd (*g, *da, *db); + + /* fa = da/g, fb = db/g. */ + mpz_t *fa = &mpz[1], *fb = &mpz[3]; + mpz_tdiv_q (*fa, *da, *g); + mpz_tdiv_q (*fb, *db, *g); + + /* FIXME: Maybe omit need for extra temp by computing fa * db here? */ + + /* hz = fa * db. This is equal to lcm (da, db). */ + mpz_mul (mpz[0], *fa, *db); + hz = make_integer_mpz (); + + /* ticks = (fb * na) OPER (fa * nb), where OPER is + or -. + OP is the multiply-add or multiply-sub form of OPER. */ + mpz_t *na = bignum_integer (&mpz[0], ta.ticks); + mpz_mul (mpz[0], *fb, *na); + mpz_t *nb = bignum_integer (&mpz[3], tb.ticks); + (subtract ? mpz_submul : mpz_addmul) (mpz[0], *fa, *nb); + ticks = make_integer_mpz (); } - return val; + /* Return the (TICKS . HZ) form if either argument is that way, + otherwise the (HI LO US PS) form for backward compatibility. */ + return (aform == TIMEFORM_TICKS_HZ || bform == TIMEFORM_TICKS_HZ + ? Fcons (ticks, hz) + : ticks_hz_list4 (ticks, hz)); } DEFUN ("time-add", Ftime_add, Stime_add, 2, 2, 0, - doc: /* Return the sum of two time values A and B, as a time value. -A nil value for either argument stands for the current time. -See `current-time-string' for the various forms of a time value. */) + doc: /* Return the sum of two time values A and B, as a timestamp. +See Info node `(elisp)Time of Day' for time value formats. +For example, nil stands for the current time. */) (Lisp_Object a, Lisp_Object b) { return time_arith (a, b, false); } DEFUN ("time-subtract", Ftime_subtract, Stime_subtract, 2, 2, 0, - doc: /* Return the difference between two time values A and B, as a time value. -Use `float-time' to convert the difference into elapsed seconds. -A nil value for either argument stands for the current time. -See `current-time-string' for the various forms of a time value. */) + doc: /* Return the difference between two time values A and B, as a timestamp. +You can use `float-time' to convert the difference into elapsed seconds. +See Info node `(elisp)Time of Day' for time value formats. +For example, nil stands for the current time. */) (Lisp_Object a, Lisp_Object b) { return time_arith (a, b, true); @@ -685,54 +1067,52 @@ time_cmp (Lisp_Object a, Lisp_Object b) return da < db ? -1 : da != db; } - int alen, blen; - struct lisp_time ta = lisp_time_struct (a, &alen); - struct lisp_time tb = lisp_time_struct (b, &blen); - return (ta.hi != tb.hi ? (ta.hi < tb.hi ? -1 : 1) - : ta.lo != tb.lo ? (ta.lo < tb.lo ? -1 : 1) - : ta.us != tb.us ? (ta.us < tb.us ? -1 : 1) - : ta.ps < tb.ps ? -1 : ta.ps != tb.ps); + struct lisp_time ta = lisp_time_struct (a, 0); + + /* Compare nil to nil correctly, and other eq values while we're at it. + Compare here rather than earlier, to handle NaNs and check formats. */ + if (EQ (a, b)) + return 0; + + struct lisp_time tb = lisp_time_struct (b, 0); + mpz_t *za = bignum_integer (&mpz[0], ta.ticks); + mpz_t *zb = bignum_integer (&mpz[1], tb.ticks); + if (! (FASTER_TIMEFNS && EQ (ta.hz, tb.hz))) + { + /* This could be sped up by looking at the signs, sizes, and + number of bits of the two sides; see how GMP does mpq_cmp. + It may not be worth the trouble here, though. */ + mpz_mul (mpz[0], *za, *bignum_integer (&mpz[2], tb.hz)); + mpz_mul (mpz[1], *zb, *bignum_integer (&mpz[2], ta.hz)); + za = &mpz[0]; + zb = &mpz[1]; + } + return mpz_cmp (*za, *zb); } DEFUN ("time-less-p", Ftime_less_p, Stime_less_p, 2, 2, 0, - doc: /* Return non-nil if time value T1 is earlier than time value T2. -A nil value for either argument stands for the current time. -See `current-time-string' for the various forms of a time value. */) - (Lisp_Object t1, Lisp_Object t2) + doc: /* Return non-nil if time value A is less than time value B. +See Info node `(elisp)Time of Day' for time value formats. +For example, nil stands for the current time. */) + (Lisp_Object a, Lisp_Object b) { - return time_cmp (t1, t2) < 0 ? Qt : Qnil; + return time_cmp (a, b) < 0 ? Qt : Qnil; } DEFUN ("time-equal-p", Ftime_equal_p, Stime_equal_p, 2, 2, 0, - doc: /* Return non-nil if T1 and T2 are equal time values. -A nil value for either argument stands for the current time. -See `current-time-string' for the various forms of a time value. */) - (Lisp_Object t1, Lisp_Object t2) + doc: /* Return non-nil if A and B are equal time values. +See Info node `(elisp)Time of Day' for time value formats. */) + (Lisp_Object a, Lisp_Object b) { - return time_cmp (t1, t2) == 0 ? Qt : Qnil; + return time_cmp (a, b) == 0 ? Qt : Qnil; } -/* Make a Lisp list that represents the Emacs time T. T may be an - invalid time, with a slightly negative tv_nsec value such as - UNKNOWN_MODTIME_NSECS; in that case, the Lisp list contains a - correspondingly negative picosecond count. */ -Lisp_Object -make_lisp_time (struct timespec t) -{ - time_t s = t.tv_sec; - int ns = t.tv_nsec; - return list4i (hi_time (s), lo_time (s), ns / 1000, ns % 1000 * 1000); -} - DEFUN ("float-time", Ffloat_time, Sfloat_time, 0, 1, 0, doc: /* Return the current time, as a float number of seconds since the epoch. -If SPECIFIED-TIME is given, it is the time to convert to float -instead of the current time. The argument should have the form -\(HIGH LOW) or (HIGH LOW USEC) or (HIGH LOW USEC PSEC). Thus, -you can use times from `current-time' and from `file-attributes'. -SPECIFIED-TIME can also have the form (HIGH . LOW), but this is -considered obsolete. +If SPECIFIED-TIME is given, it is a Lisp time value to convert to +float instead of the current time. See Info node `(elisp)Time of Day' +for time value formats. WARNING: Since the result is floating point, it may not be exact. If precise time stamps are required, use either `current-time', @@ -740,9 +1120,7 @@ or (if you need time as a string) `format-time-string'. */) (Lisp_Object specified_time) { double t; - Lisp_Object high, low, usec, psec; - if (! (disassemble_lisp_time (specified_time, &high, &low, &usec, &psec) - && decode_time_components (high, low, usec, psec, 0, &t))) + if (! decode_lisp_time (specified_time, 0, 0, 0, &t)) invalid_time (); return make_float (t); } @@ -849,10 +1227,7 @@ format_time_string (char const *format, ptrdiff_t formatlen, DEFUN ("format-time-string", Fformat_time_string, Sformat_time_string, 1, 3, 0, doc: /* Use FORMAT-STRING to format the time TIME, or now if omitted or nil. -TIME is specified as (HIGH LOW USEC PSEC), as returned by -`current-time' or `file-attributes'. It can also be a single integer -number of seconds since the epoch. The obsolete form (HIGH . LOW) is -also still accepted. +TIME is a Lisp time value; see Info node `(elisp)Time of Day'. The optional ZONE is omitted or nil for Emacs local time, t for Universal Time, `wall' for system wall clock time, or a string as in @@ -925,10 +1300,8 @@ usage: (format-time-string FORMAT-STRING &optional TIME ZONE) */) DEFUN ("decode-time", Fdecode_time, Sdecode_time, 0, 2, 0, doc: /* Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST UTCOFF). -The optional TIME should be a list of (HIGH LOW . IGNORED), -as from `current-time' and `file-attributes', or nil to use the -current time. It can also be a single integer number of seconds since -the epoch. The obsolete form (HIGH . LOW) is also still accepted. +The optional TIME is the Lisp time value to convert. See Info node +`(elisp)Time of Day' for time value formats. The optional ZONE is omitted or nil for Emacs local time, t for Universal Time, `wall' for system wall clock time, or a string as in @@ -983,32 +1356,71 @@ usage: (decode-time &optional TIME ZONE) */) } /* Return OBJ - OFFSET, checking that OBJ is a valid fixnum and that - the result is representable as an int. */ + the result is representable as an int. 0 <= OFFSET <= TM_YEAR_BASE. */ static int check_tm_member (Lisp_Object obj, int offset) { - CHECK_FIXNUM (obj); - EMACS_INT n = XFIXNUM (obj); - int result; - if (INT_SUBTRACT_WRAPV (n, offset, &result)) - time_overflow (); - return result; + if (FASTER_TIMEFNS && INT_MAX <= MOST_POSITIVE_FIXNUM - TM_YEAR_BASE) + { + CHECK_FIXNUM (obj); + EMACS_INT n = XFIXNUM (obj); + int i; + if (INT_SUBTRACT_WRAPV (n, offset, &i)) + time_overflow (); + return i; + } + else + { + CHECK_INTEGER (obj); + mpz_sub_ui (mpz[0], *bignum_integer (&mpz[0], obj), offset); + intmax_t i; + if (! (mpz_to_intmax (mpz[0], &i) && INT_MIN <= i && i <= INT_MAX)) + time_overflow (); + return i; + } } -DEFUN ("encode-time", Fencode_time, Sencode_time, 6, MANY, 0, - doc: /* Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time. -This is the reverse operation of `decode-time', which see. - -The optional ZONE is omitted or nil for Emacs local time, t for -Universal Time, `wall' for system wall clock time, or a string as in -the TZ environment variable. It can also be a list (as from +DEFUN ("encode-time", Fencode_time, Sencode_time, 1, MANY, 0, + doc: /* Convert TIME to a timestamp. +Optional FORM specifies how the returned value should be encoded. +This can act as the reverse operation of `decode-time', which see. + +If TIME is a list (SECOND MINUTE HOUR DAY MONTH YEAR IGNORED DST ZONE) +it a decoded time in the style of `decode-time', so that (encode-time +(decode-time ...)) works. TIME can also be a Lisp time value; see +Info node `(elisp)Time of Day'. + +If FORM is a positive integer, the time is returned as a pair of +integers (TICKS . FORM), where TICKS is the number of clock ticks and FORM +is the clock frequency in ticks per second. (Currently the positive +integer should be at least 65536 if the returned value is expected to +be given to standard functions expecting Lisp timestamps.) If FORM is +t, the time is returned as (TICKS . PHZ), where PHZ is a +platform-dependent clock frequency. If FORM is `integer', the time is +returned as an integer count of seconds. If FORM is `list', the time is +returned as an integer list (HIGH LOW USEC PSEC), where HIGH has the +most significant bits of the seconds, LOW has the least significant 16 +bits, and USEC and PSEC are the microsecond and picosecond counts. +Returned values are rounded toward minus infinity. Although an +omitted or nil FORM currently acts like `list', this is planned to +change, so callers requiring list timestamps should specify `list'. + +As an obsolescent calling convention, the first 6 arguments SECOND, +MINUTE, HOUR, DAY, MONTH, and YEAR specify the components of a decoded +time, where DST assumed to be -1 and FORM is omitted. If there are more +than 6 arguments the *last* argument is used as ZONE and any other +extra arguments are ignored, so that (apply \\='encode-time +(decode-time ...)) works; otherwise ZONE is assumed to be nil. + +If the input is a decoded time, ZONE is nil for Emacs local time, t +for Universal Time, `wall' for system wall clock time, or a string as +in the TZ environment variable. It can also be a list (as from `current-time-zone') or an integer (as from `decode-time') applied without consideration for daylight saving time. -You can pass more than 7 arguments; then the first six arguments -are used as SECOND through YEAR, and the *last* argument is used as ZONE. -The intervening arguments are ignored. -This feature lets (apply \\='encode-time (decode-time ...)) work. +If the input is a decoded time and ZONE specifies a time zone with +daylight-saving transitions, DST is t for daylight saving time and nil +for standard time. If DST is -1, the daylight saving flag is guessed. Out-of-range values for SECOND, MINUTE, HOUR, DAY, or MONTH are allowed; for example, a DAY of 0 means the day preceding the given month. @@ -1018,21 +1430,55 @@ If you want them to stand for years in this century, you must do that yourself. Years before 1970 are not guaranteed to work. On some systems, year values as low as 1901 do work. -usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */) +usage: (encode-time TIME &optional FORM) */) (ptrdiff_t nargs, Lisp_Object *args) { time_t value; struct tm tm; - Lisp_Object zone = (nargs > 6 ? args[nargs - 1] : Qnil); - - tm.tm_sec = check_tm_member (args[0], 0); - tm.tm_min = check_tm_member (args[1], 0); - tm.tm_hour = check_tm_member (args[2], 0); - tm.tm_mday = check_tm_member (args[3], 0); - tm.tm_mon = check_tm_member (args[4], 1); - tm.tm_year = check_tm_member (args[5], TM_YEAR_BASE); + Lisp_Object form = Qnil, zone = Qnil; + Lisp_Object a = args[0]; tm.tm_isdst = -1; + if (nargs <= 2) + { + if (nargs == 2) + form = args[1]; + Lisp_Object tail = a; + for (int i = 0; i < 9; i++, tail = XCDR (tail)) + if (! CONSP (tail)) + { + struct lisp_time t; + if (! decode_lisp_time (a, 0, 0, &t, 0)) + invalid_time (); + return lisp_time_form_stamp (t, form); + } + tm.tm_sec = check_tm_member (XCAR (a), 0); a = XCDR (a); + tm.tm_min = check_tm_member (XCAR (a), 0); a = XCDR (a); + tm.tm_hour = check_tm_member (XCAR (a), 0); a = XCDR (a); + tm.tm_mday = check_tm_member (XCAR (a), 0); a = XCDR (a); + tm.tm_mon = check_tm_member (XCAR (a), 1); a = XCDR (a); + tm.tm_year = check_tm_member (XCAR (a), TM_YEAR_BASE); a = XCDR (a); + a = XCDR (a); + if (SYMBOLP (XCAR (a))) + tm.tm_isdst = !NILP (XCAR (a)); + a = XCDR (a); + zone = XCAR (a); + } + else if (nargs < 6) + xsignal2 (Qwrong_number_of_arguments, Qencode_time, make_fixnum (nargs)); + else + { + if (6 < nargs) + zone = args[nargs - 1]; + form = Qnil; + tm.tm_sec = check_tm_member (a, 0); + tm.tm_min = check_tm_member (args[1], 0); + tm.tm_hour = check_tm_member (args[2], 0); + tm.tm_mday = check_tm_member (args[3], 0); + tm.tm_mon = check_tm_member (args[4], 1); + tm.tm_year = check_tm_member (args[5], TM_YEAR_BASE); + } + timezone_t tz = tzlookup (zone, false); value = emacs_mktime_z (tz, &tm); xtzfree (tz); @@ -1040,15 +1486,17 @@ usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */) if (value == (time_t) -1) time_overflow (); - return list2i (hi_time (value), lo_time (value)); + return time_form_stamp (value, form); } DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0, - doc: /* Return the current time, as the number of seconds since 1970-01-01 00:00:00. -The time is returned as a list of integers (HIGH LOW USEC PSEC). -HIGH has the most significant bits of the seconds, while LOW has the -least significant 16 bits. USEC and PSEC are the microsecond and -picosecond counts. */) + doc: /* Return the current time, counting the number of seconds since the epoch. + +See Info node `(elisp)Time of Day' for the format of the returned +timestamp. Although this is currently list format, it may change in +future versions of Emacs. Use `encode-time' if you need a particular +form; for example, (encode-time nil \\='list) returns the current time +in list form. */) (void) { return make_lisp_time (current_timespec ()); @@ -1064,12 +1512,9 @@ The format is `Sun Sep 16 01:03:52 1973'. However, see also the functions `decode-time' and `format-time-string' which provide a much more powerful and general facility. -If SPECIFIED-TIME is given, it is a time to format instead of the -current time. The argument should have the form (HIGH LOW . IGNORED). -Thus, you can use times obtained from `current-time' and from -`file-attributes'. SPECIFIED-TIME can also be a single integer number -of seconds since the epoch. The obsolete form (HIGH . LOW) is also -still accepted. +If SPECIFIED-TIME is given, it is the Lisp time value to format +instead of the current time. See Info node `(elisp)Time of Day' for +time value formats. The optional ZONE is omitted or nil for Emacs local time, t for Universal Time, `wall' for system wall clock time, or a string as in @@ -1113,11 +1558,8 @@ OFFSET is an integer number of seconds ahead of UTC (east of Greenwich). A negative value means west of Greenwich. NAME is a string giving the name of the time zone. If SPECIFIED-TIME is given, the time zone offset is determined from it -instead of using the current time. The argument should have the form -\(HIGH LOW . IGNORED). Thus, you can use times obtained from -`current-time' and from `file-attributes'. SPECIFIED-TIME can also be -a single integer number of seconds since the epoch. The obsolete form -(HIGH . LOW) is also still accepted. +instead of using the current time. The argument should be a Lisp +time value; see Info node `(elisp)Time of Day'. The optional ZONE is omitted or nil for Emacs local time, t for Universal Time, `wall' for system wall clock time, or a string as in @@ -1272,6 +1714,21 @@ emacs_setenv_TZ (const char *tzstring) void syms_of_timefns (void) { +#ifndef timespec_hz + timespec_hz = make_int (TIMESPEC_HZ); + staticpro (×pec_hz); +#endif +#ifndef trillion + trillion = make_int (1000000000000); + staticpro (&trillion); +#endif +#if (ULONG_MAX < TRILLION || !FASTER_TIMEFNS) && !defined ztrillion + mpz_init_set_ui (ztrillion, 1000000); + mpz_mul_ui (ztrillion, ztrillion, 1000000); +#endif + + DEFSYM (Qencode_time, "encode-time"); + defsubr (&Scurrent_time); defsubr (&Stime_add); defsubr (&Stime_subtract); diff --git a/test/src/timefns-tests.el b/test/src/timefns-tests.el index 8418b509e1..435dcf7db7 100644 --- a/test/src/timefns-tests.el +++ b/test/src/timefns-tests.el @@ -77,3 +77,6 @@ (format-time-string "%Y-%m-%d %H:%M:%S" (- (ash 1 31) 3600) t) "2038-01-19 02:14:08") (timefns-tests--have-leap-seconds)))) + +(ert-deftest time-equal-p-nil-nil () + (should (time-equal-p nil nil))) commit 84f39d3389209e566dde9acbdd78f5572f0c6751 Author: Paul Eggert Date: Wed Oct 3 09:10:01 2018 -0700 Export converting mpz to [u]intmax This refactoring will help improve timestamp handling later (Bug#32902). * src/bignum.c (mpz_set_uintmax): Move to bignum.h, and make inline. (mpz_set_uintmax_slow): Now extern. (mpz_to_intmax, mpz_to_uintmax): New functions, with implementation taken from the old bignum_to_intmax and bignum_to_uintmax. (bignum_to_intmax, bignum_to_uintmax): Use them. diff --git a/src/bignum.c b/src/bignum.c index 1e78d981b7..5d8ab670f2 100644 --- a/src/bignum.c +++ b/src/bignum.c @@ -101,18 +101,6 @@ make_bignum (void) return make_bignum_bits (mpz_sizeinbase (mpz[0], 2)); } -static void mpz_set_uintmax_slow (mpz_t, uintmax_t); - -/* Set RESULT to V. */ -static void -mpz_set_uintmax (mpz_t result, uintmax_t v) -{ - if (v <= ULONG_MAX) - mpz_set_ui (result, v); - else - mpz_set_uintmax_slow (result, v); -} - /* Return a Lisp integer equal to N, which must not be in fixnum range. */ Lisp_Object make_bigint (intmax_t n) @@ -183,7 +171,7 @@ mpz_set_intmax_slow (mpz_t result, intmax_t v) mpz_limbs_finish (result, negative ? -n : n); } -static void +void mpz_set_uintmax_slow (mpz_t result, uintmax_t v) { int maxlimbs = (UINTMAX_WIDTH + GMP_NUMB_BITS - 1) / GMP_NUMB_BITS; @@ -200,13 +188,13 @@ mpz_set_uintmax_slow (mpz_t result, uintmax_t v) mpz_limbs_finish (result, n); } -/* Return the value of the bignum X if it fits, 0 otherwise. - A bignum cannot be zero, so 0 indicates failure reliably. */ -intmax_t -bignum_to_intmax (Lisp_Object x) +/* If Z fits into *PI, store its value there and return true. + Return false otherwise. */ +bool +mpz_to_intmax (mpz_t const z, intmax_t *pi) { - ptrdiff_t bits = mpz_sizeinbase (XBIGNUM (x)->value, 2); - bool negative = mpz_sgn (XBIGNUM (x)->value) < 0; + ptrdiff_t bits = mpz_sizeinbase (z, 2); + bool negative = mpz_sgn (z) < 0; if (bits < INTMAX_WIDTH) { @@ -215,39 +203,60 @@ bignum_to_intmax (Lisp_Object x) do { - intmax_t limb = mpz_getlimbn (XBIGNUM (x)->value, i++); + intmax_t limb = mpz_getlimbn (z, i++); v += limb << shift; shift += GMP_NUMB_BITS; } while (shift < bits); - return negative ? -v : v; + *pi = negative ? -v : v; + return true; + } + if (bits == INTMAX_WIDTH && INTMAX_MIN < -INTMAX_MAX && negative + && mpz_scan1 (z, 0) == INTMAX_WIDTH - 1) + { + *pi = INTMAX_MIN; + return true; } - return ((bits == INTMAX_WIDTH && INTMAX_MIN < -INTMAX_MAX && negative - && mpz_scan1 (XBIGNUM (x)->value, 0) == INTMAX_WIDTH - 1) - ? INTMAX_MIN : 0); + return false; } -uintmax_t -bignum_to_uintmax (Lisp_Object x) +bool +mpz_to_uintmax (mpz_t const z, uintmax_t *pi) { + if (mpz_sgn (z) < 0) + return false; + ptrdiff_t bits = mpz_sizeinbase (z, 2); + if (UINTMAX_WIDTH < bits) + return false; + uintmax_t v = 0; - if (0 <= mpz_sgn (XBIGNUM (x)->value)) + int i = 0, shift = 0; + + do { - ptrdiff_t bits = mpz_sizeinbase (XBIGNUM (x)->value, 2); - if (bits <= UINTMAX_WIDTH) - { - int i = 0, shift = 0; - - do - { - uintmax_t limb = mpz_getlimbn (XBIGNUM (x)->value, i++); - v += limb << shift; - shift += GMP_NUMB_BITS; - } - while (shift < bits); - } + uintmax_t limb = mpz_getlimbn (z, i++); + v += limb << shift; + shift += GMP_NUMB_BITS; } - return v; + while (shift < bits); + + *pi = v; + return true; +} + +/* Return the value of the bignum X if it fits, 0 otherwise. + A bignum cannot be zero, so 0 indicates failure reliably. */ +intmax_t +bignum_to_intmax (Lisp_Object x) +{ + intmax_t i; + return mpz_to_intmax (XBIGNUM (x)->value, &i) ? i : 0; +} +uintmax_t +bignum_to_uintmax (Lisp_Object x) +{ + uintmax_t i; + return mpz_to_uintmax (XBIGNUM (x)->value, &i) ? i : 0; } /* Yield an upper bound on the buffer size needed to contain a C diff --git a/src/bignum.h b/src/bignum.h index e9cd5c0763..fd035e6e14 100644 --- a/src/bignum.h +++ b/src/bignum.h @@ -45,7 +45,10 @@ extern mpz_t mpz[4]; extern void init_bignum (void); extern Lisp_Object make_integer_mpz (void); +extern bool mpz_to_intmax (mpz_t const, intmax_t *) ARG_NONNULL ((1, 2)); +extern bool mpz_to_uintmax (mpz_t const, uintmax_t *) ARG_NONNULL ((1, 2)); extern void mpz_set_intmax_slow (mpz_t, intmax_t) ARG_NONNULL ((1)); +extern void mpz_set_uintmax_slow (mpz_t, uintmax_t) ARG_NONNULL ((1)); extern double mpz_get_d_rounded (mpz_t const); INLINE_HEADER_BEGIN @@ -68,6 +71,14 @@ mpz_set_intmax (mpz_t result, intmax_t v) else mpz_set_intmax_slow (result, v); } +INLINE void ARG_NONNULL ((1)) +mpz_set_uintmax (mpz_t result, uintmax_t v) +{ + if (v <= ULONG_MAX) + mpz_set_ui (result, v); + else + mpz_set_uintmax_slow (result, v); +} /* Return a pointer to an mpz_t that is equal to the Lisp integer I. If I is a bignum this returns a pointer to I's representation; commit 0faad0a0025cb4c6cbdba44e5b259690fae27b1a Author: Paul Eggert Date: Wed Oct 3 09:10:00 2018 -0700 Coalesce duplicate make_lisp_timeval etc. * src/sysdep.c (timeval_to_timespec, make_lisp_timeval): Coalesce duplicate definitions (Bug#32902). diff --git a/src/sysdep.c b/src/sysdep.c index 0695686361..7a0c8a8ab8 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -3047,6 +3047,22 @@ list_system_processes (void) #endif /* !defined (WINDOWSNT) */ + +#if defined __FreeBSD__ || defined DARWIN_OS + +static struct timespec +timeval_to_timespec (struct timeval t) +{ + return make_timespec (t.tv_sec, t.tv_usec * 1000); +} +static Lisp_Object +make_lisp_timeval (struct timeval t) +{ + return make_lisp_time (timeval_to_timespec (t)); +} + +#endif + #if defined GNU_LINUX && defined HAVE_LONG_LONG_INT static struct timespec time_from_jiffies (unsigned long long tval, long hz) @@ -3567,18 +3583,6 @@ system_process_attributes (Lisp_Object pid) #elif defined __FreeBSD__ -static struct timespec -timeval_to_timespec (struct timeval t) -{ - return make_timespec (t.tv_sec, t.tv_usec * 1000); -} - -static Lisp_Object -make_lisp_timeval (struct timeval t) -{ - return make_lisp_time (timeval_to_timespec (t)); -} - Lisp_Object system_process_attributes (Lisp_Object pid) { @@ -3748,18 +3752,6 @@ system_process_attributes (Lisp_Object pid) #elif defined DARWIN_OS -static struct timespec -timeval_to_timespec (struct timeval t) -{ - return make_timespec (t.tv_sec, t.tv_usec * 1000); -} - -static Lisp_Object -make_lisp_timeval (struct timeval t) -{ - return make_lisp_time (timeval_to_timespec (t)); -} - Lisp_Object system_process_attributes (Lisp_Object pid) { commit b5d08da1e9ea7ee1334d810348c656babe6a15d2 Author: Paul Eggert Date: Wed Oct 3 09:10:00 2018 -0700 Move timestamp-related stuff to timefns.c This does not change behavior; it’s just long-overdue refactoring (Bug#32902). * src/emacs.c (main): Call init_timefns, syms_of_timefns. * src/timefns.c: New file, containing timestamp-related stuff from editfns.c and sysdep.c. * src/Makefile.in (base_obj): Add timefns.o. * src/editfns.c: Simplify by moving a big chunk to timefns.c. Do not include systime.h, sys/resource.h, sys/param.h, strftime.h, coding.h. (HAVE_TZALLOC_BUG, TM_YEAR_BASE, HAVE_TM_GMTOFF, tzeqlen) (local_tz, utc_tz, emacs_localtime_rz, emacs_mktime_z) (invalid_time_zone_specification, xtzfree, tzlookup) (TIME_T_MIN, TIME_T_MAX, time_overflow, invalid_time) (check_time_validity, hi_time, lo_time, Fcurrent_time) (time_add, time_subtract, time_arith, Ftime_add) (Ftime_subtract, Ftime_less_p, Fget_internal_run_time) (make_lisp_time, disassemble_lisp_time, decode_float_time) (lisp_to_timespec, lisp_time_struct, lisp_time_argument) (lisp_seconds_argument, Ffloat_time, emacs_nmemftime) (Fformat_time_string, format_time_string, Fdecode_time) (check_tm_member, Fencode_time, Fcurrent_time_string) (tm_gmtoff, Fcurrent_time_zone, Fset_time_zone_rule) (emacs_getenv_TZ, emacs_setenv_TZ): Move to timefns.c. * src/emacs.c (main): Adjust to initialization changes. * src/sysdep.c: Include if it's present. Regularize includes a bit. (Fget_internal_run_time): Move here from editfns.c. (init_timefns, syms_of_timefns): New functions. * src/w32.h (w32_get_internal_run_time): Move decl here so that it need not be cloned. * test/src/editfns-tests.el: * test/src/editfns-tests.el (format-time-string-with-zone) (format-time-string-with-outlandish-zone) (editfns-tests--have-leap-seconds) (format-time-string-with-bignum-on-32-bit): Move to ... * test/src/timefns-tests.el: ... this new file. diff --git a/src/Makefile.in b/src/Makefile.in index 72f568988a..2dba1026c3 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -399,7 +399,7 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \ eval.o floatfns.o fns.o font.o print.o lread.o $(MODULES_OBJ) \ syntax.o $(UNEXEC_OBJ) bytecode.o \ process.o gnutls.o callproc.o \ - region-cache.o sound.o atimer.o \ + region-cache.o sound.o timefns.o atimer.o \ doprnt.o intervals.o textprop.o composite.o xml.o lcms.o $(NOTIFY_OBJ) \ $(XWIDGETS_OBJ) \ profiler.o decompress.o \ diff --git a/src/editfns.c b/src/editfns.c index 47509c23d0..e995b38a44 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -35,34 +35,13 @@ along with GNU Emacs. If not, see . */ #include "lisp.h" -/* systime.h includes which, on some systems, is required - for ; thus systime.h must be included before - */ -#include "systime.h" - -#if defined HAVE_SYS_RESOURCE_H -#include -#endif - -#include #include #include #include -#ifdef HAVE_TIMEZONE_T -# include -# if defined __NetBSD_Version__ && __NetBSD_Version__ < 700000000 -# define HAVE_TZALLOC_BUG true -# endif -#endif -#ifndef HAVE_TZALLOC_BUG -# define HAVE_TZALLOC_BUG false -#endif - #include #include #include -#include #include #include "composite.h" @@ -70,34 +49,12 @@ along with GNU Emacs. If not, see . */ #include "ptr-bounds.h" #include "character.h" #include "buffer.h" -#include "coding.h" #include "window.h" #include "blockinput.h" -#define TM_YEAR_BASE 1900 - -#ifdef WINDOWSNT -extern Lisp_Object w32_get_internal_run_time (void); -#endif - -static struct lisp_time lisp_time_struct (Lisp_Object, int *); -static Lisp_Object format_time_string (char const *, ptrdiff_t, struct timespec, - Lisp_Object, struct tm *); -static long int tm_gmtoff (struct tm *); -static int tm_diff (struct tm *, struct tm *); static void update_buffer_properties (ptrdiff_t, ptrdiff_t); static Lisp_Object styled_format (ptrdiff_t, Lisp_Object *, bool); -#ifndef HAVE_TM_GMTOFF -# define HAVE_TM_GMTOFF false -#endif - -enum { tzeqlen = sizeof "TZ=" - 1 }; - -/* Time zones equivalent to current local time and to UTC, respectively. */ -static timezone_t local_tz; -static timezone_t const utc_tz = 0; - /* The cached value of Vsystem_name. This is used only to compare it to Vsystem_name, so it need not be visible to the GC. */ static Lisp_Object cached_system_name; @@ -109,153 +66,9 @@ init_and_cache_system_name (void) cached_system_name = Vsystem_name; } -static struct tm * -emacs_localtime_rz (timezone_t tz, time_t const *t, struct tm *tm) -{ - tm = localtime_rz (tz, t, tm); - if (!tm && errno == ENOMEM) - memory_full (SIZE_MAX); - return tm; -} - -static time_t -emacs_mktime_z (timezone_t tz, struct tm *tm) -{ - errno = 0; - time_t t = mktime_z (tz, tm); - if (t == (time_t) -1 && errno == ENOMEM) - memory_full (SIZE_MAX); - return t; -} - -static _Noreturn void -invalid_time_zone_specification (Lisp_Object zone) -{ - xsignal2 (Qerror, build_string ("Invalid time zone specification"), zone); -} - -/* Free a timezone, except do not free the time zone for local time. - Freeing utc_tz is also a no-op. */ -static void -xtzfree (timezone_t tz) -{ - if (tz != local_tz) - tzfree (tz); -} - -/* Convert the Lisp time zone rule ZONE to a timezone_t object. - The returned value either is 0, or is LOCAL_TZ, or is newly allocated. - If SETTZ, set Emacs local time to the time zone rule; otherwise, - the caller should eventually pass the returned value to xtzfree. */ -static timezone_t -tzlookup (Lisp_Object zone, bool settz) -{ - static char const tzbuf_format[] = "<%+.*"pI"d>%s%"pI"d:%02d:%02d"; - char const *trailing_tzbuf_format = tzbuf_format + sizeof "<%+.*"pI"d" - 1; - char tzbuf[sizeof tzbuf_format + 2 * INT_STRLEN_BOUND (EMACS_INT)]; - char const *zone_string; - timezone_t new_tz; - - if (NILP (zone)) - return local_tz; - else if (EQ (zone, Qt) || EQ (zone, make_fixnum (0))) - { - zone_string = "UTC0"; - new_tz = utc_tz; - } - else - { - bool plain_integer = FIXNUMP (zone); - - if (EQ (zone, Qwall)) - zone_string = 0; - else if (STRINGP (zone)) - zone_string = SSDATA (ENCODE_SYSTEM (zone)); - else if (plain_integer || (CONSP (zone) && FIXNUMP (XCAR (zone)) - && CONSP (XCDR (zone)))) - { - Lisp_Object abbr UNINIT; - if (!plain_integer) - { - abbr = XCAR (XCDR (zone)); - zone = XCAR (zone); - } - - EMACS_INT abszone = eabs (XFIXNUM (zone)), hour = abszone / (60 * 60); - int hour_remainder = abszone % (60 * 60); - int min = hour_remainder / 60, sec = hour_remainder % 60; - - if (plain_integer) - { - int prec = 2; - EMACS_INT numzone = hour; - if (hour_remainder != 0) - { - prec += 2, numzone = 100 * numzone + min; - if (sec != 0) - prec += 2, numzone = 100 * numzone + sec; - } - sprintf (tzbuf, tzbuf_format, prec, - XFIXNUM (zone) < 0 ? -numzone : numzone, - &"-"[XFIXNUM (zone) < 0], hour, min, sec); - zone_string = tzbuf; - } - else - { - AUTO_STRING (leading, "<"); - AUTO_STRING_WITH_LEN (trailing, tzbuf, - sprintf (tzbuf, trailing_tzbuf_format, - &"-"[XFIXNUM (zone) < 0], - hour, min, sec)); - zone_string = SSDATA (concat3 (leading, ENCODE_SYSTEM (abbr), - trailing)); - } - } - else - invalid_time_zone_specification (zone); - - new_tz = tzalloc (zone_string); - - if (HAVE_TZALLOC_BUG && !new_tz && errno != ENOMEM && plain_integer - && XFIXNUM (zone) % (60 * 60) == 0) - { - /* tzalloc mishandles POSIX strings; fall back on tzdb if - possible (Bug#30738). */ - sprintf (tzbuf, "Etc/GMT%+"pI"d", - (XFIXNUM (zone) / (60 * 60))); - new_tz = tzalloc (zone_string); - } - - if (!new_tz) - { - if (errno == ENOMEM) - memory_full (SIZE_MAX); - invalid_time_zone_specification (zone); - } - } - - if (settz) - { - block_input (); - emacs_setenv_TZ (zone_string); - tzset (); - timezone_t old_tz = local_tz; - local_tz = new_tz; - tzfree (old_tz); - unblock_input (); - } - - return new_tz; -} - void -init_editfns (bool dumping) +init_editfns (void) { -#if !defined CANNOT_DUMP - /* A valid but unlikely setting for the TZ environment variable. - It is OK (though a bit slower) if the user chooses this value. */ - static char dump_tz_string[] = "TZ=UtC0"; -#endif - const char *user_name; register char *p; struct passwd *pw; /* password entry for the current user */ @@ -264,37 +77,6 @@ init_editfns (bool dumping) /* Set up system_name even when dumping. */ init_and_cache_system_name (); -#ifndef CANNOT_DUMP - /* When just dumping out, set the time zone to a known unlikely value - and skip the rest of this function. */ - if (dumping) - { - xputenv (dump_tz_string); - tzset (); - return; - } -#endif - - char *tz = getenv ("TZ"); - -#if !defined CANNOT_DUMP - /* If the execution TZ happens to be the same as the dump TZ, - change it to some other value and then change it back, - to force the underlying implementation to reload the TZ info. - This is needed on implementations that load TZ info from files, - since the TZ file contents may differ between dump and execution. */ - if (tz && strcmp (tz, &dump_tz_string[tzeqlen]) == 0) - { - ++*tz; - tzset (); - --*tz; - } -#endif - - /* Set the time zone rule now, so that the call to putenv is done - before multiple threads are active. */ - tzlookup (tz ? build_string (tz) : Qwall, true); - pw = getpwuid (getuid ()); #ifdef MSDOS /* We let the real user name default to "root" because that's quite @@ -1349,7 +1131,7 @@ of the user with that uid, or nil if there is no such user. */) (That can happen if Emacs is dumpable but you decide to run `temacs -l loadup' and not dump. */ if (NILP (Vuser_login_name)) - init_editfns (false); + init_editfns (); if (NILP (uid)) return Vuser_login_name; @@ -1372,7 +1154,7 @@ This ignores the environment variables LOGNAME and USER, so it differs from (That can happen if Emacs is dumpable but you decide to run `temacs -l loadup' and not dump. */ if (NILP (Vuser_login_name)) - init_editfns (false); + init_editfns (); return Vuser_real_login_name; } @@ -1494,1058 +1276,6 @@ Value is a fixnum, if it's small enough, otherwise a bignum. */) } - -#ifndef TIME_T_MIN -# define TIME_T_MIN TYPE_MINIMUM (time_t) -#endif -#ifndef TIME_T_MAX -# define TIME_T_MAX TYPE_MAXIMUM (time_t) -#endif - -/* Report that a time value is out of range for Emacs. */ -void -time_overflow (void) -{ - error ("Specified time is not representable"); -} - -static _Noreturn void -invalid_time (void) -{ - error ("Invalid time specification"); -} - -/* Check a return value compatible with that of decode_time_components. */ -static void -check_time_validity (int validity) -{ - if (validity <= 0) - { - if (validity < 0) - time_overflow (); - else - invalid_time (); - } -} - -/* Return the upper part of the time T (everything but the bottom 16 bits). */ -static EMACS_INT -hi_time (time_t t) -{ - time_t hi = t >> LO_TIME_BITS; - if (FIXNUM_OVERFLOW_P (hi)) - time_overflow (); - return hi; -} - -/* Return the bottom bits of the time T. */ -static int -lo_time (time_t t) -{ - return t & ((1 << LO_TIME_BITS) - 1); -} - -DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0, - doc: /* Return the current time, as the number of seconds since 1970-01-01 00:00:00. -The time is returned as a list of integers (HIGH LOW USEC PSEC). -HIGH has the most significant bits of the seconds, while LOW has the -least significant 16 bits. USEC and PSEC are the microsecond and -picosecond counts. */) - (void) -{ - return make_lisp_time (current_timespec ()); -} - -static struct lisp_time -time_add (struct lisp_time ta, struct lisp_time tb) -{ - EMACS_INT hi = ta.hi + tb.hi; - int lo = ta.lo + tb.lo; - int us = ta.us + tb.us; - int ps = ta.ps + tb.ps; - us += (1000000 <= ps); - ps -= (1000000 <= ps) * 1000000; - lo += (1000000 <= us); - us -= (1000000 <= us) * 1000000; - hi += (1 << LO_TIME_BITS <= lo); - lo -= (1 << LO_TIME_BITS <= lo) << LO_TIME_BITS; - return (struct lisp_time) { hi, lo, us, ps }; -} - -static struct lisp_time -time_subtract (struct lisp_time ta, struct lisp_time tb) -{ - EMACS_INT hi = ta.hi - tb.hi; - int lo = ta.lo - tb.lo; - int us = ta.us - tb.us; - int ps = ta.ps - tb.ps; - us -= (ps < 0); - ps += (ps < 0) * 1000000; - lo -= (us < 0); - us += (us < 0) * 1000000; - hi -= (lo < 0); - lo += (lo < 0) << LO_TIME_BITS; - return (struct lisp_time) { hi, lo, us, ps }; -} - -static Lisp_Object -time_arith (Lisp_Object a, Lisp_Object b, bool subtract) -{ - if (FLOATP (a) && !isfinite (XFLOAT_DATA (a))) - { - double da = XFLOAT_DATA (a); - double db = XFLOAT_DATA (Ffloat_time (b)); - return make_float (subtract ? da - db : da + db); - } - if (FLOATP (b) && !isfinite (XFLOAT_DATA (b))) - return subtract ? make_float (-XFLOAT_DATA (b)) : b; - - int alen, blen; - struct lisp_time ta = lisp_time_struct (a, &alen); - struct lisp_time tb = lisp_time_struct (b, &blen); - struct lisp_time t = (subtract ? time_subtract : time_add) (ta, tb); - if (FIXNUM_OVERFLOW_P (t.hi)) - time_overflow (); - Lisp_Object val = Qnil; - - switch (max (alen, blen)) - { - default: - val = Fcons (make_fixnum (t.ps), val); - FALLTHROUGH; - case 3: - val = Fcons (make_fixnum (t.us), val); - FALLTHROUGH; - case 2: - val = Fcons (make_fixnum (t.lo), val); - val = Fcons (make_fixnum (t.hi), val); - break; - } - - return val; -} - -DEFUN ("time-add", Ftime_add, Stime_add, 2, 2, 0, - doc: /* Return the sum of two time values A and B, as a time value. -A nil value for either argument stands for the current time. -See `current-time-string' for the various forms of a time value. */) - (Lisp_Object a, Lisp_Object b) -{ - return time_arith (a, b, false); -} - -DEFUN ("time-subtract", Ftime_subtract, Stime_subtract, 2, 2, 0, - doc: /* Return the difference between two time values A and B, as a time value. -Use `float-time' to convert the difference into elapsed seconds. -A nil value for either argument stands for the current time. -See `current-time-string' for the various forms of a time value. */) - (Lisp_Object a, Lisp_Object b) -{ - return time_arith (a, b, true); -} - -/* Return negative, 0, positive if a < b, a == b, a > b respectively. - Return positive if either a or b is a NaN; this is good enough - for the current callers. */ -static int -time_cmp (Lisp_Object a, Lisp_Object b) -{ - if ((FLOATP (a) && !isfinite (XFLOAT_DATA (a))) - || (FLOATP (b) && !isfinite (XFLOAT_DATA (b)))) - { - double da = FLOATP (a) ? XFLOAT_DATA (a) : 0; - double db = FLOATP (b) ? XFLOAT_DATA (b) : 0; - return da < db ? -1 : da != db; - } - - int alen, blen; - struct lisp_time ta = lisp_time_struct (a, &alen); - struct lisp_time tb = lisp_time_struct (b, &blen); - return (ta.hi != tb.hi ? (ta.hi < tb.hi ? -1 : 1) - : ta.lo != tb.lo ? (ta.lo < tb.lo ? -1 : 1) - : ta.us != tb.us ? (ta.us < tb.us ? -1 : 1) - : ta.ps < tb.ps ? -1 : ta.ps != tb.ps); -} - -DEFUN ("time-less-p", Ftime_less_p, Stime_less_p, 2, 2, 0, - doc: /* Return non-nil if time value T1 is earlier than time value T2. -A nil value for either argument stands for the current time. -See `current-time-string' for the various forms of a time value. */) - (Lisp_Object t1, Lisp_Object t2) -{ - return time_cmp (t1, t2) < 0 ? Qt : Qnil; -} - -DEFUN ("time-equal-p", Ftime_equal_p, Stime_equal_p, 2, 2, 0, - doc: /* Return non-nil if T1 and T2 are equal time values. -A nil value for either argument stands for the current time. -See `current-time-string' for the various forms of a time value. */) - (Lisp_Object t1, Lisp_Object t2) -{ - return time_cmp (t1, t2) == 0 ? Qt : Qnil; -} - - -DEFUN ("get-internal-run-time", Fget_internal_run_time, Sget_internal_run_time, - 0, 0, 0, - doc: /* Return the current run time used by Emacs. -The time is returned as in the style of `current-time'. - -On systems that can't determine the run time, `get-internal-run-time' -does the same thing as `current-time'. */) - (void) -{ -#ifdef HAVE_GETRUSAGE - struct rusage usage; - time_t secs; - int usecs; - - if (getrusage (RUSAGE_SELF, &usage) < 0) - /* This shouldn't happen. What action is appropriate? */ - xsignal0 (Qerror); - - /* Sum up user time and system time. */ - secs = usage.ru_utime.tv_sec + usage.ru_stime.tv_sec; - usecs = usage.ru_utime.tv_usec + usage.ru_stime.tv_usec; - if (usecs >= 1000000) - { - usecs -= 1000000; - secs++; - } - return make_lisp_time (make_timespec (secs, usecs * 1000)); -#else /* ! HAVE_GETRUSAGE */ -#ifdef WINDOWSNT - return w32_get_internal_run_time (); -#else /* ! WINDOWSNT */ - return Fcurrent_time (); -#endif /* WINDOWSNT */ -#endif /* HAVE_GETRUSAGE */ -} - - -/* Make a Lisp list that represents the Emacs time T. T may be an - invalid time, with a slightly negative tv_nsec value such as - UNKNOWN_MODTIME_NSECS; in that case, the Lisp list contains a - correspondingly negative picosecond count. */ -Lisp_Object -make_lisp_time (struct timespec t) -{ - time_t s = t.tv_sec; - int ns = t.tv_nsec; - return list4i (hi_time (s), lo_time (s), ns / 1000, ns % 1000 * 1000); -} - -/* Decode a Lisp list SPECIFIED_TIME that represents a time. - Set *PHIGH, *PLOW, *PUSEC, *PPSEC to its parts; do not check their values. - Return 2, 3, or 4 to indicate the effective length of SPECIFIED_TIME - if successful, 0 if unsuccessful. */ -static int -disassemble_lisp_time (Lisp_Object specified_time, Lisp_Object *phigh, - Lisp_Object *plow, Lisp_Object *pusec, - Lisp_Object *ppsec) -{ - Lisp_Object high = make_fixnum (0); - Lisp_Object low = specified_time; - Lisp_Object usec = make_fixnum (0); - Lisp_Object psec = make_fixnum (0); - int len = 4; - - if (CONSP (specified_time)) - { - high = XCAR (specified_time); - low = XCDR (specified_time); - if (CONSP (low)) - { - Lisp_Object low_tail = XCDR (low); - low = XCAR (low); - if (CONSP (low_tail)) - { - usec = XCAR (low_tail); - low_tail = XCDR (low_tail); - if (CONSP (low_tail)) - psec = XCAR (low_tail); - else - len = 3; - } - else if (!NILP (low_tail)) - { - usec = low_tail; - len = 3; - } - else - len = 2; - } - else - len = 2; - - /* When combining components, require LOW to be an integer, - as otherwise it would be a pain to add up times. */ - if (! INTEGERP (low)) - return 0; - } - else if (INTEGERP (specified_time)) - len = 2; - - *phigh = high; - *plow = low; - *pusec = usec; - *ppsec = psec; - return len; -} - -/* Convert T into an Emacs time *RESULT, truncating toward minus infinity. - Return true if T is in range, false otherwise. */ -static bool -decode_float_time (double t, struct lisp_time *result) -{ - double lo_multiplier = 1 << LO_TIME_BITS; - double emacs_time_min = MOST_NEGATIVE_FIXNUM * lo_multiplier; - if (! (emacs_time_min <= t && t < -emacs_time_min)) - return false; - - double small_t = t / lo_multiplier; - EMACS_INT hi = small_t; - double t_sans_hi = t - hi * lo_multiplier; - int lo = t_sans_hi; - long double fracps = (t_sans_hi - lo) * 1e12L; -#ifdef INT_FAST64_MAX - int_fast64_t ifracps = fracps; - int us = ifracps / 1000000; - int ps = ifracps % 1000000; -#else - int us = fracps / 1e6L; - int ps = fracps - us * 1e6L; -#endif - us -= (ps < 0); - ps += (ps < 0) * 1000000; - lo -= (us < 0); - us += (us < 0) * 1000000; - hi -= (lo < 0); - lo += (lo < 0) << LO_TIME_BITS; - result->hi = hi; - result->lo = lo; - result->us = us; - result->ps = ps; - return true; -} - -/* From the time components HIGH, LOW, USEC and PSEC taken from a Lisp - list, generate the corresponding time value. - If LOW is floating point, the other components should be zero. - - If RESULT is not null, store into *RESULT the converted time. - If *DRESULT is not null, store into *DRESULT the number of - seconds since the start of the POSIX Epoch. - - Return 1 if successful, 0 if the components are of the - wrong type, and -1 if the time is out of range. */ -int -decode_time_components (Lisp_Object high, Lisp_Object low, Lisp_Object usec, - Lisp_Object psec, - struct lisp_time *result, double *dresult) -{ - EMACS_INT hi, us, ps; - intmax_t lo; - if (! (FIXNUMP (high) - && FIXNUMP (usec) && FIXNUMP (psec))) - return 0; - if (! INTEGERP (low)) - { - if (FLOATP (low)) - { - double t = XFLOAT_DATA (low); - if (result && ! decode_float_time (t, result)) - return -1; - if (dresult) - *dresult = t; - return 1; - } - else if (NILP (low)) - { - struct timespec now = current_timespec (); - if (result) - { - result->hi = hi_time (now.tv_sec); - result->lo = lo_time (now.tv_sec); - result->us = now.tv_nsec / 1000; - result->ps = now.tv_nsec % 1000 * 1000; - } - if (dresult) - *dresult = now.tv_sec + now.tv_nsec / 1e9; - return 1; - } - else - return 0; - } - - hi = XFIXNUM (high); - if (! integer_to_intmax (low, &lo)) - return -1; - us = XFIXNUM (usec); - ps = XFIXNUM (psec); - - /* Normalize out-of-range lower-order components by carrying - each overflow into the next higher-order component. */ - us += ps / 1000000 - (ps % 1000000 < 0); - lo += us / 1000000 - (us % 1000000 < 0); - if (INT_ADD_WRAPV (lo >> LO_TIME_BITS, hi, &hi)) - return -1; - ps = ps % 1000000 + 1000000 * (ps % 1000000 < 0); - us = us % 1000000 + 1000000 * (us % 1000000 < 0); - lo &= (1 << LO_TIME_BITS) - 1; - - if (result) - { - if (FIXNUM_OVERFLOW_P (hi)) - return -1; - result->hi = hi; - result->lo = lo; - result->us = us; - result->ps = ps; - } - - if (dresult) - { - double dhi = hi; - *dresult = (us * 1e6 + ps) / 1e12 + lo + dhi * (1 << LO_TIME_BITS); - } - - return 1; -} - -struct timespec -lisp_to_timespec (struct lisp_time t) -{ - if (! ((TYPE_SIGNED (time_t) ? TIME_T_MIN >> LO_TIME_BITS <= t.hi : 0 <= t.hi) - && t.hi <= TIME_T_MAX >> LO_TIME_BITS)) - return invalid_timespec (); - time_t s = (t.hi << LO_TIME_BITS) + t.lo; - int ns = t.us * 1000 + t.ps / 1000; - return make_timespec (s, ns); -} - -/* Decode a Lisp list SPECIFIED_TIME that represents a time. - Store its effective length into *PLEN. - If SPECIFIED_TIME is nil, use the current time. - Signal an error if SPECIFIED_TIME does not represent a time. */ -static struct lisp_time -lisp_time_struct (Lisp_Object specified_time, int *plen) -{ - Lisp_Object high, low, usec, psec; - struct lisp_time t; - int len = disassemble_lisp_time (specified_time, &high, &low, &usec, &psec); - if (!len) - invalid_time (); - int val = decode_time_components (high, low, usec, psec, &t, 0); - check_time_validity (val); - *plen = len; - return t; -} - -/* Like lisp_time_struct, except return a struct timespec. - Discard any low-order digits. */ -struct timespec -lisp_time_argument (Lisp_Object specified_time) -{ - int len; - struct lisp_time lt = lisp_time_struct (specified_time, &len); - struct timespec t = lisp_to_timespec (lt); - if (! timespec_valid_p (t)) - time_overflow (); - return t; -} - -/* Like lisp_time_argument, except decode only the seconds part, - and do not check the subseconds part. */ -static time_t -lisp_seconds_argument (Lisp_Object specified_time) -{ - Lisp_Object high, low, usec, psec; - struct lisp_time t; - - int val = disassemble_lisp_time (specified_time, &high, &low, &usec, &psec); - if (val != 0) - { - val = decode_time_components (high, low, make_fixnum (0), - make_fixnum (0), &t, 0); - if (0 < val - && ! ((TYPE_SIGNED (time_t) - ? TIME_T_MIN >> LO_TIME_BITS <= t.hi - : 0 <= t.hi) - && t.hi <= TIME_T_MAX >> LO_TIME_BITS)) - val = -1; - } - check_time_validity (val); - return (t.hi << LO_TIME_BITS) + t.lo; -} - -DEFUN ("float-time", Ffloat_time, Sfloat_time, 0, 1, 0, - doc: /* Return the current time, as a float number of seconds since the epoch. -If SPECIFIED-TIME is given, it is the time to convert to float -instead of the current time. The argument should have the form -\(HIGH LOW) or (HIGH LOW USEC) or (HIGH LOW USEC PSEC). Thus, -you can use times from `current-time' and from `file-attributes'. -SPECIFIED-TIME can also have the form (HIGH . LOW), but this is -considered obsolete. - -WARNING: Since the result is floating point, it may not be exact. -If precise time stamps are required, use either `current-time', -or (if you need time as a string) `format-time-string'. */) - (Lisp_Object specified_time) -{ - double t; - Lisp_Object high, low, usec, psec; - if (! (disassemble_lisp_time (specified_time, &high, &low, &usec, &psec) - && decode_time_components (high, low, usec, psec, 0, &t))) - invalid_time (); - return make_float (t); -} - -/* Write information into buffer S of size MAXSIZE, according to the - FORMAT of length FORMAT_LEN, using time information taken from *TP. - Use the time zone specified by TZ. - Use NS as the number of nanoseconds in the %N directive. - Return the number of bytes written, not including the terminating - '\0'. If S is NULL, nothing will be written anywhere; so to - determine how many bytes would be written, use NULL for S and - ((size_t) -1) for MAXSIZE. - - This function behaves like nstrftime, except it allows null - bytes in FORMAT and it does not support nanoseconds. */ -static size_t -emacs_nmemftime (char *s, size_t maxsize, const char *format, - size_t format_len, const struct tm *tp, timezone_t tz, int ns) -{ - size_t total = 0; - - /* Loop through all the null-terminated strings in the format - argument. Normally there's just one null-terminated string, but - there can be arbitrarily many, concatenated together, if the - format contains '\0' bytes. nstrftime stops at the first - '\0' byte so we must invoke it separately for each such string. */ - for (;;) - { - size_t len; - size_t result; - - if (s) - s[0] = '\1'; - - result = nstrftime (s, maxsize, format, tp, tz, ns); - - if (s) - { - if (result == 0 && s[0] != '\0') - return 0; - s += result + 1; - } - - maxsize -= result + 1; - total += result; - len = strlen (format); - if (len == format_len) - return total; - total++; - format += len + 1; - format_len -= len + 1; - } -} - -DEFUN ("format-time-string", Fformat_time_string, Sformat_time_string, 1, 3, 0, - doc: /* Use FORMAT-STRING to format the time TIME, or now if omitted or nil. -TIME is specified as (HIGH LOW USEC PSEC), as returned by -`current-time' or `file-attributes'. It can also be a single integer -number of seconds since the epoch. The obsolete form (HIGH . LOW) is -also still accepted. - -The optional ZONE is omitted or nil for Emacs local time, t for -Universal Time, `wall' for system wall clock time, or a string as in -the TZ environment variable. It can also be a list (as from -`current-time-zone') or an integer (as from `decode-time') applied -without consideration for daylight saving time. - -The value is a copy of FORMAT-STRING, but with certain constructs replaced -by text that describes the specified date and time in TIME: - -%Y is the year, %y within the century, %C the century. -%G is the year corresponding to the ISO week, %g within the century. -%m is the numeric month. -%b and %h are the locale's abbreviated month name, %B the full name. - (%h is not supported on MS-Windows.) -%d is the day of the month, zero-padded, %e is blank-padded. -%u is the numeric day of week from 1 (Monday) to 7, %w from 0 (Sunday) to 6. -%a is the locale's abbreviated name of the day of week, %A the full name. -%U is the week number starting on Sunday, %W starting on Monday, - %V according to ISO 8601. -%j is the day of the year. - -%H is the hour on a 24-hour clock, %I is on a 12-hour clock, %k is like %H - only blank-padded, %l is like %I blank-padded. -%p is the locale's equivalent of either AM or PM. -%q is the calendar quarter (1–4). -%M is the minute (00-59). -%S is the second (00-59; 00-60 on platforms with leap seconds) -%s is the number of seconds since 1970-01-01 00:00:00 +0000. -%N is the nanosecond, %6N the microsecond, %3N the millisecond, etc. -%Z is the time zone abbreviation, %z is the numeric form. - -%c is the locale's date and time format. -%x is the locale's "preferred" date format. -%D is like "%m/%d/%y". -%F is the ISO 8601 date format (like "%Y-%m-%d"). - -%R is like "%H:%M", %T is like "%H:%M:%S", %r is like "%I:%M:%S %p". -%X is the locale's "preferred" time format. - -Finally, %n is a newline, %t is a tab, %% is a literal %, and -unrecognized %-sequences stand for themselves. - -Certain flags and modifiers are available with some format controls. -The flags are `_', `-', `^' and `#'. For certain characters X, -%_X is like %X, but padded with blanks; %-X is like %X, -but without padding. %^X is like %X, but with all textual -characters up-cased; %#X is like %X, but with letter-case of -all textual characters reversed. -%NX (where N stands for an integer) is like %X, -but takes up at least N (a number) positions. -The modifiers are `E' and `O'. For certain characters X, -%EX is a locale's alternative version of %X; -%OX is like %X, but uses the locale's number symbols. - -For example, to produce full ISO 8601 format, use "%FT%T%z". - -usage: (format-time-string FORMAT-STRING &optional TIME ZONE) */) - (Lisp_Object format_string, Lisp_Object timeval, Lisp_Object zone) -{ - struct timespec t = lisp_time_argument (timeval); - struct tm tm; - - CHECK_STRING (format_string); - format_string = code_convert_string_norecord (format_string, - Vlocale_coding_system, 1); - return format_time_string (SSDATA (format_string), SBYTES (format_string), - t, zone, &tm); -} - -static Lisp_Object -format_time_string (char const *format, ptrdiff_t formatlen, - struct timespec t, Lisp_Object zone, struct tm *tmp) -{ - char buffer[4000]; - char *buf = buffer; - ptrdiff_t size = sizeof buffer; - size_t len; - int ns = t.tv_nsec; - USE_SAFE_ALLOCA; - - timezone_t tz = tzlookup (zone, false); - /* On some systems, like 32-bit MinGW, tv_sec of struct timespec is - a 64-bit type, but time_t is a 32-bit type. emacs_localtime_rz - expects a pointer to time_t value. */ - time_t tsec = t.tv_sec; - tmp = emacs_localtime_rz (tz, &tsec, tmp); - if (! tmp) - { - xtzfree (tz); - time_overflow (); - } - synchronize_system_time_locale (); - - while (true) - { - buf[0] = '\1'; - len = emacs_nmemftime (buf, size, format, formatlen, tmp, tz, ns); - if ((0 < len && len < size) || (len == 0 && buf[0] == '\0')) - break; - - /* Buffer was too small, so make it bigger and try again. */ - len = emacs_nmemftime (NULL, SIZE_MAX, format, formatlen, tmp, tz, ns); - if (STRING_BYTES_BOUND <= len) - { - xtzfree (tz); - string_overflow (); - } - size = len + 1; - buf = SAFE_ALLOCA (size); - } - - xtzfree (tz); - AUTO_STRING_WITH_LEN (bufstring, buf, len); - Lisp_Object result = code_convert_string_norecord (bufstring, - Vlocale_coding_system, 0); - SAFE_FREE (); - return result; -} - -DEFUN ("decode-time", Fdecode_time, Sdecode_time, 0, 2, 0, - doc: /* Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST UTCOFF). -The optional TIME should be a list of (HIGH LOW . IGNORED), -as from `current-time' and `file-attributes', or nil to use the -current time. It can also be a single integer number of seconds since -the epoch. The obsolete form (HIGH . LOW) is also still accepted. - -The optional ZONE is omitted or nil for Emacs local time, t for -Universal Time, `wall' for system wall clock time, or a string as in -the TZ environment variable. It can also be a list (as from -`current-time-zone') or an integer (the UTC offset in seconds) applied -without consideration for daylight saving time. - -The list has the following nine members: SEC is an integer between 0 -and 60; SEC is 60 for a leap second, which only some operating systems -support. MINUTE is an integer between 0 and 59. HOUR is an integer -between 0 and 23. DAY is an integer between 1 and 31. MONTH is an -integer between 1 and 12. YEAR is an integer indicating the -four-digit year. DOW is the day of week, an integer between 0 and 6, -where 0 is Sunday. DST is t if daylight saving time is in effect, -nil if it is not in effect, and -1 if this information is -not available. UTCOFF is an integer indicating the UTC offset in -seconds, i.e., the number of seconds east of Greenwich. (Note that -Common Lisp has different meanings for DOW and UTCOFF.) - -usage: (decode-time &optional TIME ZONE) */) - (Lisp_Object specified_time, Lisp_Object zone) -{ - time_t time_spec = lisp_seconds_argument (specified_time); - struct tm local_tm, gmt_tm; - timezone_t tz = tzlookup (zone, false); - struct tm *tm = emacs_localtime_rz (tz, &time_spec, &local_tm); - xtzfree (tz); - - if (! (tm - && MOST_NEGATIVE_FIXNUM - TM_YEAR_BASE <= local_tm.tm_year - && local_tm.tm_year <= MOST_POSITIVE_FIXNUM - TM_YEAR_BASE)) - time_overflow (); - - /* Avoid overflow when INT_MAX < EMACS_INT_MAX. */ - EMACS_INT tm_year_base = TM_YEAR_BASE; - - return CALLN (Flist, - make_fixnum (local_tm.tm_sec), - make_fixnum (local_tm.tm_min), - make_fixnum (local_tm.tm_hour), - make_fixnum (local_tm.tm_mday), - make_fixnum (local_tm.tm_mon + 1), - make_fixnum (local_tm.tm_year + tm_year_base), - make_fixnum (local_tm.tm_wday), - (local_tm.tm_isdst < 0 ? make_fixnum (-1) - : local_tm.tm_isdst == 0 ? Qnil : Qt), - (HAVE_TM_GMTOFF - ? make_fixnum (tm_gmtoff (&local_tm)) - : gmtime_r (&time_spec, &gmt_tm) - ? make_fixnum (tm_diff (&local_tm, &gmt_tm)) - : Qnil)); -} - -/* Return OBJ - OFFSET, checking that OBJ is a valid fixnum and that - the result is representable as an int. */ -static int -check_tm_member (Lisp_Object obj, int offset) -{ - CHECK_FIXNUM (obj); - EMACS_INT n = XFIXNUM (obj); - int result; - if (INT_SUBTRACT_WRAPV (n, offset, &result)) - time_overflow (); - return result; -} - -DEFUN ("encode-time", Fencode_time, Sencode_time, 6, MANY, 0, - doc: /* Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time. -This is the reverse operation of `decode-time', which see. - -The optional ZONE is omitted or nil for Emacs local time, t for -Universal Time, `wall' for system wall clock time, or a string as in -the TZ environment variable. It can also be a list (as from -`current-time-zone') or an integer (as from `decode-time') applied -without consideration for daylight saving time. - -You can pass more than 7 arguments; then the first six arguments -are used as SECOND through YEAR, and the *last* argument is used as ZONE. -The intervening arguments are ignored. -This feature lets (apply \\='encode-time (decode-time ...)) work. - -Out-of-range values for SECOND, MINUTE, HOUR, DAY, or MONTH are allowed; -for example, a DAY of 0 means the day preceding the given month. -Year numbers less than 100 are treated just like other year numbers. -If you want them to stand for years in this century, you must do that yourself. - -Years before 1970 are not guaranteed to work. On some systems, -year values as low as 1901 do work. - -usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */) - (ptrdiff_t nargs, Lisp_Object *args) -{ - time_t value; - struct tm tm; - Lisp_Object zone = (nargs > 6 ? args[nargs - 1] : Qnil); - - tm.tm_sec = check_tm_member (args[0], 0); - tm.tm_min = check_tm_member (args[1], 0); - tm.tm_hour = check_tm_member (args[2], 0); - tm.tm_mday = check_tm_member (args[3], 0); - tm.tm_mon = check_tm_member (args[4], 1); - tm.tm_year = check_tm_member (args[5], TM_YEAR_BASE); - tm.tm_isdst = -1; - - timezone_t tz = tzlookup (zone, false); - value = emacs_mktime_z (tz, &tm); - xtzfree (tz); - - if (value == (time_t) -1) - time_overflow (); - - return list2i (hi_time (value), lo_time (value)); -} - -DEFUN ("current-time-string", Fcurrent_time_string, Scurrent_time_string, - 0, 2, 0, - doc: /* Return the current local time, as a human-readable string. -Programs can use this function to decode a time, -since the number of columns in each field is fixed -if the year is in the range 1000-9999. -The format is `Sun Sep 16 01:03:52 1973'. -However, see also the functions `decode-time' and `format-time-string' -which provide a much more powerful and general facility. - -If SPECIFIED-TIME is given, it is a time to format instead of the -current time. The argument should have the form (HIGH LOW . IGNORED). -Thus, you can use times obtained from `current-time' and from -`file-attributes'. SPECIFIED-TIME can also be a single integer number -of seconds since the epoch. The obsolete form (HIGH . LOW) is also -still accepted. - -The optional ZONE is omitted or nil for Emacs local time, t for -Universal Time, `wall' for system wall clock time, or a string as in -the TZ environment variable. It can also be a list (as from -`current-time-zone') or an integer (as from `decode-time') applied -without consideration for daylight saving time. */) - (Lisp_Object specified_time, Lisp_Object zone) -{ - time_t value = lisp_seconds_argument (specified_time); - timezone_t tz = tzlookup (zone, false); - - /* Convert to a string in ctime format, except without the trailing - newline, and without the 4-digit year limit. Don't use asctime - or ctime, as they might dump core if the year is outside the - range -999 .. 9999. */ - struct tm tm; - struct tm *tmp = emacs_localtime_rz (tz, &value, &tm); - xtzfree (tz); - if (! tmp) - time_overflow (); - - static char const wday_name[][4] = - { "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" }; - static char const mon_name[][4] = - { "Jan", "Feb", "Mar", "Apr", "May", "Jun", - "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" }; - printmax_t year_base = TM_YEAR_BASE; - char buf[sizeof "Mon Apr 30 12:49:17 " + INT_STRLEN_BOUND (int) + 1]; - int len = sprintf (buf, "%s %s%3d %02d:%02d:%02d %"pMd, - wday_name[tm.tm_wday], mon_name[tm.tm_mon], tm.tm_mday, - tm.tm_hour, tm.tm_min, tm.tm_sec, - tm.tm_year + year_base); - - return make_unibyte_string (buf, len); -} - -/* Yield A - B, measured in seconds. - This function is copied from the GNU C Library. */ -static int -tm_diff (struct tm *a, struct tm *b) -{ - /* Compute intervening leap days correctly even if year is negative. - Take care to avoid int overflow in leap day calculations, - but it's OK to assume that A and B are close to each other. */ - int a4 = (a->tm_year >> 2) + (TM_YEAR_BASE >> 2) - ! (a->tm_year & 3); - int b4 = (b->tm_year >> 2) + (TM_YEAR_BASE >> 2) - ! (b->tm_year & 3); - int a100 = a4 / 25 - (a4 % 25 < 0); - int b100 = b4 / 25 - (b4 % 25 < 0); - int a400 = a100 >> 2; - int b400 = b100 >> 2; - int intervening_leap_days = (a4 - b4) - (a100 - b100) + (a400 - b400); - int years = a->tm_year - b->tm_year; - int days = (365 * years + intervening_leap_days - + (a->tm_yday - b->tm_yday)); - return (60 * (60 * (24 * days + (a->tm_hour - b->tm_hour)) - + (a->tm_min - b->tm_min)) - + (a->tm_sec - b->tm_sec)); -} - -/* Yield A's UTC offset, or an unspecified value if unknown. */ -static long int -tm_gmtoff (struct tm *a) -{ -#if HAVE_TM_GMTOFF - return a->tm_gmtoff; -#else - return 0; -#endif -} - -DEFUN ("current-time-zone", Fcurrent_time_zone, Scurrent_time_zone, 0, 2, 0, - doc: /* Return the offset and name for the local time zone. -This returns a list of the form (OFFSET NAME). -OFFSET is an integer number of seconds ahead of UTC (east of Greenwich). - A negative value means west of Greenwich. -NAME is a string giving the name of the time zone. -If SPECIFIED-TIME is given, the time zone offset is determined from it -instead of using the current time. The argument should have the form -\(HIGH LOW . IGNORED). Thus, you can use times obtained from -`current-time' and from `file-attributes'. SPECIFIED-TIME can also be -a single integer number of seconds since the epoch. The obsolete form -(HIGH . LOW) is also still accepted. - -The optional ZONE is omitted or nil for Emacs local time, t for -Universal Time, `wall' for system wall clock time, or a string as in -the TZ environment variable. It can also be a list (as from -`current-time-zone') or an integer (as from `decode-time') applied -without consideration for daylight saving time. - -Some operating systems cannot provide all this information to Emacs; -in this case, `current-time-zone' returns a list containing nil for -the data it can't find. */) - (Lisp_Object specified_time, Lisp_Object zone) -{ - struct timespec value; - struct tm local_tm, gmt_tm; - Lisp_Object zone_offset, zone_name; - - zone_offset = Qnil; - value = make_timespec (lisp_seconds_argument (specified_time), 0); - zone_name = format_time_string ("%Z", sizeof "%Z" - 1, value, - zone, &local_tm); - - /* gmtime_r expects a pointer to time_t, but tv_sec of struct - timespec on some systems (MinGW) is a 64-bit field. */ - time_t tsec = value.tv_sec; - if (HAVE_TM_GMTOFF || gmtime_r (&tsec, &gmt_tm)) - { - long int offset = (HAVE_TM_GMTOFF - ? tm_gmtoff (&local_tm) - : tm_diff (&local_tm, &gmt_tm)); - zone_offset = make_fixnum (offset); - if (SCHARS (zone_name) == 0) - { - /* No local time zone name is available; use numeric zone instead. */ - long int hour = offset / 3600; - int min_sec = offset % 3600; - int amin_sec = min_sec < 0 ? - min_sec : min_sec; - int min = amin_sec / 60; - int sec = amin_sec % 60; - int min_prec = min_sec ? 2 : 0; - int sec_prec = sec ? 2 : 0; - char buf[sizeof "+0000" + INT_STRLEN_BOUND (long int)]; - zone_name = make_formatted_string (buf, "%c%.2ld%.*d%.*d", - (offset < 0 ? '-' : '+'), - hour, min_prec, min, sec_prec, sec); - } - } - - return list2 (zone_offset, zone_name); -} - -DEFUN ("set-time-zone-rule", Fset_time_zone_rule, Sset_time_zone_rule, 1, 1, 0, - doc: /* Set the Emacs local time zone using TZ, a string specifying a time zone rule. -If TZ is nil or `wall', use system wall clock time; this differs from -the usual Emacs convention where nil means current local time. If TZ -is t, use Universal Time. If TZ is a list (as from -`current-time-zone') or an integer (as from `decode-time'), use the -specified time zone without consideration for daylight saving time. - -Instead of calling this function, you typically want something else. -To temporarily use a different time zone rule for just one invocation -of `decode-time', `encode-time', or `format-time-string', pass the -function a ZONE argument. To change local time consistently -throughout Emacs, call (setenv "TZ" TZ): this changes both the -environment of the Emacs process and the variable -`process-environment', whereas `set-time-zone-rule' affects only the -former. */) - (Lisp_Object tz) -{ - tzlookup (NILP (tz) ? Qwall : tz, true); - return Qnil; -} - -/* A buffer holding a string of the form "TZ=value", intended - to be part of the environment. If TZ is supposed to be unset, - the buffer string is "tZ=". */ - static char *tzvalbuf; - -/* Get the local time zone rule. */ -char * -emacs_getenv_TZ (void) -{ - return tzvalbuf[0] == 'T' ? tzvalbuf + tzeqlen : 0; -} - -/* Set the local time zone rule to TZSTRING, which can be null to - denote wall clock time. Do not record the setting in LOCAL_TZ. - - This function is not thread-safe, in theory because putenv is not, - but mostly because of the static storage it updates. Other threads - that invoke localtime etc. may be adversely affected while this - function is executing. */ - -int -emacs_setenv_TZ (const char *tzstring) -{ - static ptrdiff_t tzvalbufsize; - ptrdiff_t tzstringlen = tzstring ? strlen (tzstring) : 0; - char *tzval = tzvalbuf; - bool new_tzvalbuf = tzvalbufsize <= tzeqlen + tzstringlen; - - if (new_tzvalbuf) - { - /* Do not attempt to free the old tzvalbuf, since another thread - may be using it. In practice, the first allocation is large - enough and memory does not leak. */ - tzval = xpalloc (NULL, &tzvalbufsize, - tzeqlen + tzstringlen - tzvalbufsize + 1, -1, 1); - tzvalbuf = tzval; - tzval[1] = 'Z'; - tzval[2] = '='; - } - - if (tzstring) - { - /* Modify TZVAL in place. Although this is dicey in a - multithreaded environment, we know of no portable alternative. - Calling putenv or setenv could crash some other thread. */ - tzval[0] = 'T'; - strcpy (tzval + tzeqlen, tzstring); - } - else - { - /* Turn 'TZ=whatever' into an empty environment variable 'tZ='. - Although this is also dicey, calling unsetenv here can crash Emacs. - See Bug#8705. */ - tzval[0] = 't'; - tzval[tzeqlen] = 0; - } - - -#ifndef WINDOWSNT - /* Modifying *TZVAL merely requires calling tzset (which is the - caller's responsibility). However, modifying TZVAL requires - calling putenv; although this is not thread-safe, in practice this - runs only on startup when there is only one thread. */ - bool need_putenv = new_tzvalbuf; -#else - /* MS-Windows 'putenv' copies the argument string into a block it - allocates, so modifying *TZVAL will not change the environment. - However, the other threads run by Emacs on MS-Windows never call - 'xputenv' or 'putenv' or 'unsetenv', so the original cause for the - dicey in-place modification technique doesn't exist there in the - first place. */ - bool need_putenv = true; -#endif - if (need_putenv) - xputenv (tzval); - - return 0; -} - /* Insert NARGS Lisp objects in the array ARGS by calling INSERT_FUNC (if a type of object is Lisp_Int) or INSERT_FROM_STRING_FUNC (if a type of object is Lisp_String). INHERIT is passed to @@ -5764,19 +4494,6 @@ it to be non-nil. */); defsubr (&Sgroup_real_gid); defsubr (&Suser_full_name); defsubr (&Semacs_pid); - defsubr (&Scurrent_time); - defsubr (&Stime_add); - defsubr (&Stime_subtract); - defsubr (&Stime_equal_p); - defsubr (&Stime_less_p); - defsubr (&Sget_internal_run_time); - defsubr (&Sformat_time_string); - defsubr (&Sfloat_time); - defsubr (&Sdecode_time); - defsubr (&Sencode_time); - defsubr (&Scurrent_time_string); - defsubr (&Scurrent_time_zone); - defsubr (&Sset_time_zone_rule); defsubr (&Ssystem_name); defsubr (&Smessage); defsubr (&Smessage_box); diff --git a/src/emacs.c b/src/emacs.c index ddaaf3fed5..b7a8279352 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1512,6 +1512,8 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem syms_of_minibuf (); syms_of_process (); syms_of_search (); + syms_of_sysdep (); + syms_of_timefns (); syms_of_frame (); syms_of_syntax (); syms_of_terminal (); @@ -1653,9 +1655,11 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem init_charset (); - /* This calls putenv and so must precede init_process_emacs. Also, - it sets Voperating_system_release, which init_process_emacs uses. */ - init_editfns (dumping); + /* This calls putenv and so must precede init_process_emacs. */ + init_timefns (dumping); + + /* This sets Voperating_system_release, which init_process_emacs uses. */ + init_editfns (); /* These two call putenv. */ #ifdef HAVE_DBUS diff --git a/src/lisp.h b/src/lisp.h index bb190b691b..ae329268dc 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4014,11 +4014,10 @@ extern void save_excursion_save (union specbinding *); extern void save_excursion_restore (Lisp_Object, Lisp_Object); extern Lisp_Object save_restriction_save (void); extern void save_restriction_restore (Lisp_Object); -extern _Noreturn void time_overflow (void); extern Lisp_Object make_buffer_string (ptrdiff_t, ptrdiff_t, bool); extern Lisp_Object make_buffer_string_both (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, bool); -extern void init_editfns (bool); +extern void init_editfns (void); extern void syms_of_editfns (void); /* Defined in buffer.c. */ @@ -4355,6 +4354,7 @@ extern ptrdiff_t emacs_write_quit (int, void const *, ptrdiff_t); extern void emacs_perror (char const *); extern int renameat_noreplace (int, char const *, int, char const *); extern int str_collate (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); +extern void syms_of_sysdep (void); /* Defined in filelock.c. */ extern void lock_file (Lisp_Object); diff --git a/src/sysdep.c b/src/sysdep.c index 722d8138de..0695686361 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -91,13 +91,19 @@ along with GNU Emacs. If not, see . */ #include #include +#include "syssignal.h" +#include "systime.h" #include "systty.h" #include "syswait.h" +#ifdef HAVE_SYS_RESOURCE_H +# include +#endif + #ifdef HAVE_SYS_UTSNAME_H -#include -#include -#endif /* HAVE_SYS_UTSNAME_H */ +# include +# include +#endif #include "keyboard.h" #include "frame.h" @@ -118,18 +124,15 @@ along with GNU Emacs. If not, see . */ #endif #ifdef WINDOWSNT -#include +# include /* In process.h which conflicts with the local copy. */ -#define _P_WAIT 0 +# define _P_WAIT 0 int _cdecl _spawnlp (int, const char *, const char *, ...); /* The following is needed for O_CLOEXEC, F_SETFD, FD_CLOEXEC, and several prototypes of functions called below. */ -#include +# include #endif -#include "syssignal.h" -#include "systime.h" - /* ULLONG_MAX is missing on Red Hat Linux 7.3; see Bug#11781. */ #ifndef ULLONG_MAX #define ULLONG_MAX TYPE_MAXIMUM (unsigned long long int) @@ -2704,30 +2707,6 @@ emacs_perror (char const *message) errno = err; } -/* Return a struct timeval that is roughly equivalent to T. - Use the least timeval not less than T. - Return an extremal value if the result would overflow. */ -struct timeval -make_timeval (struct timespec t) -{ - struct timeval tv; - tv.tv_sec = t.tv_sec; - tv.tv_usec = t.tv_nsec / 1000; - - if (t.tv_nsec % 1000 != 0) - { - if (tv.tv_usec < 999999) - tv.tv_usec++; - else if (tv.tv_sec < TYPE_MAXIMUM (time_t)) - { - tv.tv_sec++; - tv.tv_usec = 0; - } - } - - return tv; -} - /* Set the access and modification time stamps of FD (a.k.a. FILE) to be ATIME and MTIME, respectively. FD must be either negative -- in which case it is ignored -- @@ -3911,6 +3890,42 @@ system_process_attributes (Lisp_Object pid) } #endif /* !defined (WINDOWSNT) */ + +DEFUN ("get-internal-run-time", Fget_internal_run_time, Sget_internal_run_time, + 0, 0, 0, + doc: /* Return the current run time used by Emacs. +The time is returned as in the style of `current-time'. + +On systems that can't determine the run time, `get-internal-run-time' +does the same thing as `current-time'. */) + (void) +{ +#ifdef HAVE_GETRUSAGE + struct rusage usage; + time_t secs; + int usecs; + + if (getrusage (RUSAGE_SELF, &usage) < 0) + /* This shouldn't happen. What action is appropriate? */ + xsignal0 (Qerror); + + /* Sum up user time and system time. */ + secs = usage.ru_utime.tv_sec + usage.ru_stime.tv_sec; + usecs = usage.ru_utime.tv_usec + usage.ru_stime.tv_usec; + if (usecs >= 1000000) + { + usecs -= 1000000; + secs++; + } + return make_lisp_time (make_timespec (secs, usecs * 1000)); +#else /* ! HAVE_GETRUSAGE */ +#ifdef WINDOWSNT + return w32_get_internal_run_time (); +#else /* ! WINDOWSNT */ + return Fcurrent_time (); +#endif /* WINDOWSNT */ +#endif /* HAVE_GETRUSAGE */ +} /* Wide character string collation. */ @@ -4116,3 +4131,9 @@ str_collate (Lisp_Object s1, Lisp_Object s2, return res; } #endif /* WINDOWSNT */ + +void +syms_of_sysdep (void) +{ + defsubr (&Sget_internal_run_time); +} diff --git a/src/systime.h b/src/systime.h index ad5ab85730..f2f51b009e 100644 --- a/src/systime.h +++ b/src/systime.h @@ -19,6 +19,7 @@ along with GNU Emacs. If not, see . */ #ifndef EMACS_SYSTIME_H #define EMACS_SYSTIME_H +#include "lisp.h" #include INLINE_HEADER_BEGIN @@ -66,7 +67,6 @@ timespec_valid_p (struct timespec t) /* defined in sysdep.c */ extern int set_file_times (int, const char *, struct timespec, struct timespec); -extern struct timeval make_timeval (struct timespec) ATTRIBUTE_CONST; /* defined in keyboard.c */ extern void set_waiting_for_input (struct timespec *); @@ -82,12 +82,16 @@ struct lisp_time int lo, us, ps; }; -/* defined in editfns.c */ +/* defined in timefns.c */ +extern struct timeval make_timeval (struct timespec) ATTRIBUTE_CONST; extern Lisp_Object make_lisp_time (struct timespec); extern int decode_time_components (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, struct lisp_time *, double *); extern struct timespec lisp_to_timespec (struct lisp_time); extern struct timespec lisp_time_argument (Lisp_Object); +extern _Noreturn void time_overflow (void); +extern void init_timefns (bool); +extern void syms_of_timefns (void); INLINE_HEADER_END diff --git a/src/timefns.c b/src/timefns.c new file mode 100644 index 0000000000..fcb4485ae3 --- /dev/null +++ b/src/timefns.c @@ -0,0 +1,1287 @@ +/* Timestamp functions for Emacs + +Copyright (C) 1985-1987, 1989, 1993-2018 Free Software Foundation, Inc. + +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 . */ + +#include + +#include "systime.h" + +#include "blockinput.h" +#include "coding.h" +#include "lisp.h" + +#include + +#include +#include +#include +#include + +#ifdef HAVE_TIMEZONE_T +# include +# if defined __NetBSD_Version__ && __NetBSD_Version__ < 700000000 +# define HAVE_TZALLOC_BUG true +# endif +#endif +#ifndef HAVE_TZALLOC_BUG +# define HAVE_TZALLOC_BUG false +#endif + +#define TM_YEAR_BASE 1900 + +#ifndef HAVE_TM_GMTOFF +# define HAVE_TM_GMTOFF false +#endif + +#ifndef TIME_T_MIN +# define TIME_T_MIN TYPE_MINIMUM (time_t) +#endif +#ifndef TIME_T_MAX +# define TIME_T_MAX TYPE_MAXIMUM (time_t) +#endif + +/* Return a struct timeval that is roughly equivalent to T. + Use the least timeval not less than T. + Return an extremal value if the result would overflow. */ +struct timeval +make_timeval (struct timespec t) +{ + struct timeval tv; + tv.tv_sec = t.tv_sec; + tv.tv_usec = t.tv_nsec / 1000; + + if (t.tv_nsec % 1000 != 0) + { + if (tv.tv_usec < 999999) + tv.tv_usec++; + else if (tv.tv_sec < TYPE_MAXIMUM (time_t)) + { + tv.tv_sec++; + tv.tv_usec = 0; + } + } + + return tv; +} + +/* Yield A's UTC offset, or an unspecified value if unknown. */ +static long int +tm_gmtoff (struct tm *a) +{ +#if HAVE_TM_GMTOFF + return a->tm_gmtoff; +#else + return 0; +#endif +} + +/* Yield A - B, measured in seconds. + This function is copied from the GNU C Library. */ +static int +tm_diff (struct tm *a, struct tm *b) +{ + /* Compute intervening leap days correctly even if year is negative. + Take care to avoid int overflow in leap day calculations, + but it's OK to assume that A and B are close to each other. */ + int a4 = (a->tm_year >> 2) + (TM_YEAR_BASE >> 2) - ! (a->tm_year & 3); + int b4 = (b->tm_year >> 2) + (TM_YEAR_BASE >> 2) - ! (b->tm_year & 3); + int a100 = a4 / 25 - (a4 % 25 < 0); + int b100 = b4 / 25 - (b4 % 25 < 0); + int a400 = a100 >> 2; + int b400 = b100 >> 2; + int intervening_leap_days = (a4 - b4) - (a100 - b100) + (a400 - b400); + int years = a->tm_year - b->tm_year; + int days = (365 * years + intervening_leap_days + + (a->tm_yday - b->tm_yday)); + return (60 * (60 * (24 * days + (a->tm_hour - b->tm_hour)) + + (a->tm_min - b->tm_min)) + + (a->tm_sec - b->tm_sec)); +} + +enum { tzeqlen = sizeof "TZ=" - 1 }; + +/* Time zones equivalent to current local time and to UTC, respectively. */ +static timezone_t local_tz; +static timezone_t const utc_tz = 0; + +static struct tm * +emacs_localtime_rz (timezone_t tz, time_t const *t, struct tm *tm) +{ + tm = localtime_rz (tz, t, tm); + if (!tm && errno == ENOMEM) + memory_full (SIZE_MAX); + return tm; +} + +static time_t +emacs_mktime_z (timezone_t tz, struct tm *tm) +{ + errno = 0; + time_t t = mktime_z (tz, tm); + if (t == (time_t) -1 && errno == ENOMEM) + memory_full (SIZE_MAX); + return t; +} + +static _Noreturn void +invalid_time_zone_specification (Lisp_Object zone) +{ + xsignal2 (Qerror, build_string ("Invalid time zone specification"), zone); +} + +/* Free a timezone, except do not free the time zone for local time. + Freeing utc_tz is also a no-op. */ +static void +xtzfree (timezone_t tz) +{ + if (tz != local_tz) + tzfree (tz); +} + +/* Convert the Lisp time zone rule ZONE to a timezone_t object. + The returned value either is 0, or is LOCAL_TZ, or is newly allocated. + If SETTZ, set Emacs local time to the time zone rule; otherwise, + the caller should eventually pass the returned value to xtzfree. */ +static timezone_t +tzlookup (Lisp_Object zone, bool settz) +{ + static char const tzbuf_format[] = "<%+.*"pI"d>%s%"pI"d:%02d:%02d"; + char const *trailing_tzbuf_format = tzbuf_format + sizeof "<%+.*"pI"d" - 1; + char tzbuf[sizeof tzbuf_format + 2 * INT_STRLEN_BOUND (EMACS_INT)]; + char const *zone_string; + timezone_t new_tz; + + if (NILP (zone)) + return local_tz; + else if (EQ (zone, Qt) || EQ (zone, make_fixnum (0))) + { + zone_string = "UTC0"; + new_tz = utc_tz; + } + else + { + bool plain_integer = FIXNUMP (zone); + + if (EQ (zone, Qwall)) + zone_string = 0; + else if (STRINGP (zone)) + zone_string = SSDATA (ENCODE_SYSTEM (zone)); + else if (plain_integer || (CONSP (zone) && FIXNUMP (XCAR (zone)) + && CONSP (XCDR (zone)))) + { + Lisp_Object abbr UNINIT; + if (!plain_integer) + { + abbr = XCAR (XCDR (zone)); + zone = XCAR (zone); + } + + EMACS_INT abszone = eabs (XFIXNUM (zone)), hour = abszone / (60 * 60); + int hour_remainder = abszone % (60 * 60); + int min = hour_remainder / 60, sec = hour_remainder % 60; + + if (plain_integer) + { + int prec = 2; + EMACS_INT numzone = hour; + if (hour_remainder != 0) + { + prec += 2, numzone = 100 * numzone + min; + if (sec != 0) + prec += 2, numzone = 100 * numzone + sec; + } + sprintf (tzbuf, tzbuf_format, prec, + XFIXNUM (zone) < 0 ? -numzone : numzone, + &"-"[XFIXNUM (zone) < 0], hour, min, sec); + zone_string = tzbuf; + } + else + { + AUTO_STRING (leading, "<"); + AUTO_STRING_WITH_LEN (trailing, tzbuf, + sprintf (tzbuf, trailing_tzbuf_format, + &"-"[XFIXNUM (zone) < 0], + hour, min, sec)); + zone_string = SSDATA (concat3 (leading, ENCODE_SYSTEM (abbr), + trailing)); + } + } + else + invalid_time_zone_specification (zone); + + new_tz = tzalloc (zone_string); + + if (HAVE_TZALLOC_BUG && !new_tz && errno != ENOMEM && plain_integer + && XFIXNUM (zone) % (60 * 60) == 0) + { + /* tzalloc mishandles POSIX strings; fall back on tzdb if + possible (Bug#30738). */ + sprintf (tzbuf, "Etc/GMT%+"pI"d", - (XFIXNUM (zone) / (60 * 60))); + new_tz = tzalloc (zone_string); + } + + if (!new_tz) + { + if (errno == ENOMEM) + memory_full (SIZE_MAX); + invalid_time_zone_specification (zone); + } + } + + if (settz) + { + block_input (); + emacs_setenv_TZ (zone_string); + tzset (); + timezone_t old_tz = local_tz; + local_tz = new_tz; + tzfree (old_tz); + unblock_input (); + } + + return new_tz; +} + +void +init_timefns (bool dumping) +{ +#ifndef CANNOT_DUMP + /* A valid but unlikely setting for the TZ environment variable. + It is OK (though a bit slower) if the user chooses this value. */ + static char dump_tz_string[] = "TZ=UtC0"; + + /* When just dumping out, set the time zone to a known unlikely value + and skip the rest of this function. */ + if (dumping) + { + xputenv (dump_tz_string); + tzset (); + return; + } +#endif + + char *tz = getenv ("TZ"); + +#if !defined CANNOT_DUMP + /* If the execution TZ happens to be the same as the dump TZ, + change it to some other value and then change it back, + to force the underlying implementation to reload the TZ info. + This is needed on implementations that load TZ info from files, + since the TZ file contents may differ between dump and execution. */ + if (tz && strcmp (tz, &dump_tz_string[tzeqlen]) == 0) + { + ++*tz; + tzset (); + --*tz; + } +#endif + + /* Set the time zone rule now, so that the call to putenv is done + before multiple threads are active. */ + tzlookup (tz ? build_string (tz) : Qwall, true); +} + +/* Report that a time value is out of range for Emacs. */ +void +time_overflow (void) +{ + error ("Specified time is not representable"); +} + +static _Noreturn void +invalid_time (void) +{ + error ("Invalid time specification"); +} + +/* Check a return value compatible with that of decode_time_components. */ +static void +check_time_validity (int validity) +{ + if (validity <= 0) + { + if (validity < 0) + time_overflow (); + else + invalid_time (); + } +} + +/* Return the upper part of the time T (everything but the bottom 16 bits). */ +static EMACS_INT +hi_time (time_t t) +{ + time_t hi = t >> LO_TIME_BITS; + if (FIXNUM_OVERFLOW_P (hi)) + time_overflow (); + return hi; +} + +/* Return the bottom bits of the time T. */ +static int +lo_time (time_t t) +{ + return t & ((1 << LO_TIME_BITS) - 1); +} + +/* Decode a Lisp list SPECIFIED_TIME that represents a time. + Set *PHIGH, *PLOW, *PUSEC, *PPSEC to its parts; do not check their values. + Return 2, 3, or 4 to indicate the effective length of SPECIFIED_TIME + if successful, 0 if unsuccessful. */ +static int +disassemble_lisp_time (Lisp_Object specified_time, Lisp_Object *phigh, + Lisp_Object *plow, Lisp_Object *pusec, + Lisp_Object *ppsec) +{ + Lisp_Object high = make_fixnum (0); + Lisp_Object low = specified_time; + Lisp_Object usec = make_fixnum (0); + Lisp_Object psec = make_fixnum (0); + int len = 4; + + if (CONSP (specified_time)) + { + high = XCAR (specified_time); + low = XCDR (specified_time); + if (CONSP (low)) + { + Lisp_Object low_tail = XCDR (low); + low = XCAR (low); + if (CONSP (low_tail)) + { + usec = XCAR (low_tail); + low_tail = XCDR (low_tail); + if (CONSP (low_tail)) + psec = XCAR (low_tail); + else + len = 3; + } + else if (!NILP (low_tail)) + { + usec = low_tail; + len = 3; + } + else + len = 2; + } + else + len = 2; + + /* When combining components, require LOW to be an integer, + as otherwise it would be a pain to add up times. */ + if (! INTEGERP (low)) + return 0; + } + else if (INTEGERP (specified_time)) + len = 2; + + *phigh = high; + *plow = low; + *pusec = usec; + *ppsec = psec; + return len; +} + +/* Convert T into an Emacs time *RESULT, truncating toward minus infinity. + Return true if T is in range, false otherwise. */ +static bool +decode_float_time (double t, struct lisp_time *result) +{ + double lo_multiplier = 1 << LO_TIME_BITS; + double emacs_time_min = MOST_NEGATIVE_FIXNUM * lo_multiplier; + if (! (emacs_time_min <= t && t < -emacs_time_min)) + return false; + + double small_t = t / lo_multiplier; + EMACS_INT hi = small_t; + double t_sans_hi = t - hi * lo_multiplier; + int lo = t_sans_hi; + long double fracps = (t_sans_hi - lo) * 1e12L; +#ifdef INT_FAST64_MAX + int_fast64_t ifracps = fracps; + int us = ifracps / 1000000; + int ps = ifracps % 1000000; +#else + int us = fracps / 1e6L; + int ps = fracps - us * 1e6L; +#endif + us -= (ps < 0); + ps += (ps < 0) * 1000000; + lo -= (us < 0); + us += (us < 0) * 1000000; + hi -= (lo < 0); + lo += (lo < 0) << LO_TIME_BITS; + result->hi = hi; + result->lo = lo; + result->us = us; + result->ps = ps; + return true; +} + +/* From the time components HIGH, LOW, USEC and PSEC taken from a Lisp + list, generate the corresponding time value. + If LOW is floating point, the other components should be zero. + + If RESULT is not null, store into *RESULT the converted time. + If *DRESULT is not null, store into *DRESULT the number of + seconds since the start of the POSIX Epoch. + + Return 1 if successful, 0 if the components are of the + wrong type, and -1 if the time is out of range. */ +int +decode_time_components (Lisp_Object high, Lisp_Object low, Lisp_Object usec, + Lisp_Object psec, + struct lisp_time *result, double *dresult) +{ + EMACS_INT hi, us, ps; + intmax_t lo; + if (! (FIXNUMP (high) + && FIXNUMP (usec) && FIXNUMP (psec))) + return 0; + if (! INTEGERP (low)) + { + if (FLOATP (low)) + { + double t = XFLOAT_DATA (low); + if (result && ! decode_float_time (t, result)) + return -1; + if (dresult) + *dresult = t; + return 1; + } + else if (NILP (low)) + { + struct timespec now = current_timespec (); + if (result) + { + result->hi = hi_time (now.tv_sec); + result->lo = lo_time (now.tv_sec); + result->us = now.tv_nsec / 1000; + result->ps = now.tv_nsec % 1000 * 1000; + } + if (dresult) + *dresult = now.tv_sec + now.tv_nsec / 1e9; + return 1; + } + else + return 0; + } + + hi = XFIXNUM (high); + if (! integer_to_intmax (low, &lo)) + return -1; + us = XFIXNUM (usec); + ps = XFIXNUM (psec); + + /* Normalize out-of-range lower-order components by carrying + each overflow into the next higher-order component. */ + us += ps / 1000000 - (ps % 1000000 < 0); + lo += us / 1000000 - (us % 1000000 < 0); + if (INT_ADD_WRAPV (lo >> LO_TIME_BITS, hi, &hi)) + return -1; + ps = ps % 1000000 + 1000000 * (ps % 1000000 < 0); + us = us % 1000000 + 1000000 * (us % 1000000 < 0); + lo &= (1 << LO_TIME_BITS) - 1; + + if (result) + { + if (FIXNUM_OVERFLOW_P (hi)) + return -1; + result->hi = hi; + result->lo = lo; + result->us = us; + result->ps = ps; + } + + if (dresult) + { + double dhi = hi; + *dresult = (us * 1e6 + ps) / 1e12 + lo + dhi * (1 << LO_TIME_BITS); + } + + return 1; +} + +struct timespec +lisp_to_timespec (struct lisp_time t) +{ + if (! ((TYPE_SIGNED (time_t) ? TIME_T_MIN >> LO_TIME_BITS <= t.hi : 0 <= t.hi) + && t.hi <= TIME_T_MAX >> LO_TIME_BITS)) + return invalid_timespec (); + time_t s = (t.hi << LO_TIME_BITS) + t.lo; + int ns = t.us * 1000 + t.ps / 1000; + return make_timespec (s, ns); +} + +/* Decode a Lisp list SPECIFIED_TIME that represents a time. + Store its effective length into *PLEN. + If SPECIFIED_TIME is nil, use the current time. + Signal an error if SPECIFIED_TIME does not represent a time. */ +static struct lisp_time +lisp_time_struct (Lisp_Object specified_time, int *plen) +{ + Lisp_Object high, low, usec, psec; + struct lisp_time t; + int len = disassemble_lisp_time (specified_time, &high, &low, &usec, &psec); + if (!len) + invalid_time (); + int val = decode_time_components (high, low, usec, psec, &t, 0); + check_time_validity (val); + *plen = len; + return t; +} + +/* Like lisp_time_struct, except return a struct timespec. + Discard any low-order digits. */ +struct timespec +lisp_time_argument (Lisp_Object specified_time) +{ + int len; + struct lisp_time lt = lisp_time_struct (specified_time, &len); + struct timespec t = lisp_to_timespec (lt); + if (! timespec_valid_p (t)) + time_overflow (); + return t; +} + +/* Like lisp_time_argument, except decode only the seconds part, + and do not check the subseconds part. */ +static time_t +lisp_seconds_argument (Lisp_Object specified_time) +{ + Lisp_Object high, low, usec, psec; + struct lisp_time t; + + int val = disassemble_lisp_time (specified_time, &high, &low, &usec, &psec); + if (val != 0) + { + val = decode_time_components (high, low, make_fixnum (0), + make_fixnum (0), &t, 0); + if (0 < val + && ! ((TYPE_SIGNED (time_t) + ? TIME_T_MIN >> LO_TIME_BITS <= t.hi + : 0 <= t.hi) + && t.hi <= TIME_T_MAX >> LO_TIME_BITS)) + val = -1; + } + check_time_validity (val); + return (t.hi << LO_TIME_BITS) + t.lo; +} + +static struct lisp_time +time_add (struct lisp_time ta, struct lisp_time tb) +{ + EMACS_INT hi = ta.hi + tb.hi; + int lo = ta.lo + tb.lo; + int us = ta.us + tb.us; + int ps = ta.ps + tb.ps; + us += (1000000 <= ps); + ps -= (1000000 <= ps) * 1000000; + lo += (1000000 <= us); + us -= (1000000 <= us) * 1000000; + hi += (1 << LO_TIME_BITS <= lo); + lo -= (1 << LO_TIME_BITS <= lo) << LO_TIME_BITS; + return (struct lisp_time) { hi, lo, us, ps }; +} + +static struct lisp_time +time_subtract (struct lisp_time ta, struct lisp_time tb) +{ + EMACS_INT hi = ta.hi - tb.hi; + int lo = ta.lo - tb.lo; + int us = ta.us - tb.us; + int ps = ta.ps - tb.ps; + us -= (ps < 0); + ps += (ps < 0) * 1000000; + lo -= (us < 0); + us += (us < 0) * 1000000; + hi -= (lo < 0); + lo += (lo < 0) << LO_TIME_BITS; + return (struct lisp_time) { hi, lo, us, ps }; +} + +static Lisp_Object +time_arith (Lisp_Object a, Lisp_Object b, bool subtract) +{ + if (FLOATP (a) && !isfinite (XFLOAT_DATA (a))) + { + double da = XFLOAT_DATA (a); + double db = XFLOAT_DATA (Ffloat_time (b)); + return make_float (subtract ? da - db : da + db); + } + if (FLOATP (b) && !isfinite (XFLOAT_DATA (b))) + return subtract ? make_float (-XFLOAT_DATA (b)) : b; + + int alen, blen; + struct lisp_time ta = lisp_time_struct (a, &alen); + struct lisp_time tb = lisp_time_struct (b, &blen); + struct lisp_time t = (subtract ? time_subtract : time_add) (ta, tb); + if (FIXNUM_OVERFLOW_P (t.hi)) + time_overflow (); + Lisp_Object val = Qnil; + + switch (max (alen, blen)) + { + default: + val = Fcons (make_fixnum (t.ps), val); + FALLTHROUGH; + case 3: + val = Fcons (make_fixnum (t.us), val); + FALLTHROUGH; + case 2: + val = Fcons (make_fixnum (t.lo), val); + val = Fcons (make_fixnum (t.hi), val); + break; + } + + return val; +} + +DEFUN ("time-add", Ftime_add, Stime_add, 2, 2, 0, + doc: /* Return the sum of two time values A and B, as a time value. +A nil value for either argument stands for the current time. +See `current-time-string' for the various forms of a time value. */) + (Lisp_Object a, Lisp_Object b) +{ + return time_arith (a, b, false); +} + +DEFUN ("time-subtract", Ftime_subtract, Stime_subtract, 2, 2, 0, + doc: /* Return the difference between two time values A and B, as a time value. +Use `float-time' to convert the difference into elapsed seconds. +A nil value for either argument stands for the current time. +See `current-time-string' for the various forms of a time value. */) + (Lisp_Object a, Lisp_Object b) +{ + return time_arith (a, b, true); +} + +/* Return negative, 0, positive if a < b, a == b, a > b respectively. + Return positive if either a or b is a NaN; this is good enough + for the current callers. */ +static int +time_cmp (Lisp_Object a, Lisp_Object b) +{ + if ((FLOATP (a) && !isfinite (XFLOAT_DATA (a))) + || (FLOATP (b) && !isfinite (XFLOAT_DATA (b)))) + { + double da = FLOATP (a) ? XFLOAT_DATA (a) : 0; + double db = FLOATP (b) ? XFLOAT_DATA (b) : 0; + return da < db ? -1 : da != db; + } + + int alen, blen; + struct lisp_time ta = lisp_time_struct (a, &alen); + struct lisp_time tb = lisp_time_struct (b, &blen); + return (ta.hi != tb.hi ? (ta.hi < tb.hi ? -1 : 1) + : ta.lo != tb.lo ? (ta.lo < tb.lo ? -1 : 1) + : ta.us != tb.us ? (ta.us < tb.us ? -1 : 1) + : ta.ps < tb.ps ? -1 : ta.ps != tb.ps); +} + +DEFUN ("time-less-p", Ftime_less_p, Stime_less_p, 2, 2, 0, + doc: /* Return non-nil if time value T1 is earlier than time value T2. +A nil value for either argument stands for the current time. +See `current-time-string' for the various forms of a time value. */) + (Lisp_Object t1, Lisp_Object t2) +{ + return time_cmp (t1, t2) < 0 ? Qt : Qnil; +} + +DEFUN ("time-equal-p", Ftime_equal_p, Stime_equal_p, 2, 2, 0, + doc: /* Return non-nil if T1 and T2 are equal time values. +A nil value for either argument stands for the current time. +See `current-time-string' for the various forms of a time value. */) + (Lisp_Object t1, Lisp_Object t2) +{ + return time_cmp (t1, t2) == 0 ? Qt : Qnil; +} + + +/* Make a Lisp list that represents the Emacs time T. T may be an + invalid time, with a slightly negative tv_nsec value such as + UNKNOWN_MODTIME_NSECS; in that case, the Lisp list contains a + correspondingly negative picosecond count. */ +Lisp_Object +make_lisp_time (struct timespec t) +{ + time_t s = t.tv_sec; + int ns = t.tv_nsec; + return list4i (hi_time (s), lo_time (s), ns / 1000, ns % 1000 * 1000); +} + +DEFUN ("float-time", Ffloat_time, Sfloat_time, 0, 1, 0, + doc: /* Return the current time, as a float number of seconds since the epoch. +If SPECIFIED-TIME is given, it is the time to convert to float +instead of the current time. The argument should have the form +\(HIGH LOW) or (HIGH LOW USEC) or (HIGH LOW USEC PSEC). Thus, +you can use times from `current-time' and from `file-attributes'. +SPECIFIED-TIME can also have the form (HIGH . LOW), but this is +considered obsolete. + +WARNING: Since the result is floating point, it may not be exact. +If precise time stamps are required, use either `current-time', +or (if you need time as a string) `format-time-string'. */) + (Lisp_Object specified_time) +{ + double t; + Lisp_Object high, low, usec, psec; + if (! (disassemble_lisp_time (specified_time, &high, &low, &usec, &psec) + && decode_time_components (high, low, usec, psec, 0, &t))) + invalid_time (); + return make_float (t); +} + +/* Write information into buffer S of size MAXSIZE, according to the + FORMAT of length FORMAT_LEN, using time information taken from *TP. + Use the time zone specified by TZ. + Use NS as the number of nanoseconds in the %N directive. + Return the number of bytes written, not including the terminating + '\0'. If S is NULL, nothing will be written anywhere; so to + determine how many bytes would be written, use NULL for S and + ((size_t) -1) for MAXSIZE. + + This function behaves like nstrftime, except it allows null + bytes in FORMAT and it does not support nanoseconds. */ +static size_t +emacs_nmemftime (char *s, size_t maxsize, const char *format, + size_t format_len, const struct tm *tp, timezone_t tz, int ns) +{ + size_t total = 0; + + /* Loop through all the null-terminated strings in the format + argument. Normally there's just one null-terminated string, but + there can be arbitrarily many, concatenated together, if the + format contains '\0' bytes. nstrftime stops at the first + '\0' byte so we must invoke it separately for each such string. */ + for (;;) + { + size_t len; + size_t result; + + if (s) + s[0] = '\1'; + + result = nstrftime (s, maxsize, format, tp, tz, ns); + + if (s) + { + if (result == 0 && s[0] != '\0') + return 0; + s += result + 1; + } + + maxsize -= result + 1; + total += result; + len = strlen (format); + if (len == format_len) + return total; + total++; + format += len + 1; + format_len -= len + 1; + } +} + +static Lisp_Object +format_time_string (char const *format, ptrdiff_t formatlen, + struct timespec t, Lisp_Object zone, struct tm *tmp) +{ + char buffer[4000]; + char *buf = buffer; + ptrdiff_t size = sizeof buffer; + size_t len; + int ns = t.tv_nsec; + USE_SAFE_ALLOCA; + + timezone_t tz = tzlookup (zone, false); + /* On some systems, like 32-bit MinGW, tv_sec of struct timespec is + a 64-bit type, but time_t is a 32-bit type. emacs_localtime_rz + expects a pointer to time_t value. */ + time_t tsec = t.tv_sec; + tmp = emacs_localtime_rz (tz, &tsec, tmp); + if (! tmp) + { + xtzfree (tz); + time_overflow (); + } + synchronize_system_time_locale (); + + while (true) + { + buf[0] = '\1'; + len = emacs_nmemftime (buf, size, format, formatlen, tmp, tz, ns); + if ((0 < len && len < size) || (len == 0 && buf[0] == '\0')) + break; + + /* Buffer was too small, so make it bigger and try again. */ + len = emacs_nmemftime (NULL, SIZE_MAX, format, formatlen, tmp, tz, ns); + if (STRING_BYTES_BOUND <= len) + { + xtzfree (tz); + string_overflow (); + } + size = len + 1; + buf = SAFE_ALLOCA (size); + } + + xtzfree (tz); + AUTO_STRING_WITH_LEN (bufstring, buf, len); + Lisp_Object result = code_convert_string_norecord (bufstring, + Vlocale_coding_system, 0); + SAFE_FREE (); + return result; +} + +DEFUN ("format-time-string", Fformat_time_string, Sformat_time_string, 1, 3, 0, + doc: /* Use FORMAT-STRING to format the time TIME, or now if omitted or nil. +TIME is specified as (HIGH LOW USEC PSEC), as returned by +`current-time' or `file-attributes'. It can also be a single integer +number of seconds since the epoch. The obsolete form (HIGH . LOW) is +also still accepted. + +The optional ZONE is omitted or nil for Emacs local time, t for +Universal Time, `wall' for system wall clock time, or a string as in +the TZ environment variable. It can also be a list (as from +`current-time-zone') or an integer (as from `decode-time') applied +without consideration for daylight saving time. + +The value is a copy of FORMAT-STRING, but with certain constructs replaced +by text that describes the specified date and time in TIME: + +%Y is the year, %y within the century, %C the century. +%G is the year corresponding to the ISO week, %g within the century. +%m is the numeric month. +%b and %h are the locale's abbreviated month name, %B the full name. + (%h is not supported on MS-Windows.) +%d is the day of the month, zero-padded, %e is blank-padded. +%u is the numeric day of week from 1 (Monday) to 7, %w from 0 (Sunday) to 6. +%a is the locale's abbreviated name of the day of week, %A the full name. +%U is the week number starting on Sunday, %W starting on Monday, + %V according to ISO 8601. +%j is the day of the year. + +%H is the hour on a 24-hour clock, %I is on a 12-hour clock, %k is like %H + only blank-padded, %l is like %I blank-padded. +%p is the locale's equivalent of either AM or PM. +%q is the calendar quarter (1–4). +%M is the minute (00-59). +%S is the second (00-59; 00-60 on platforms with leap seconds) +%s is the number of seconds since 1970-01-01 00:00:00 +0000. +%N is the nanosecond, %6N the microsecond, %3N the millisecond, etc. +%Z is the time zone abbreviation, %z is the numeric form. + +%c is the locale's date and time format. +%x is the locale's "preferred" date format. +%D is like "%m/%d/%y". +%F is the ISO 8601 date format (like "%Y-%m-%d"). + +%R is like "%H:%M", %T is like "%H:%M:%S", %r is like "%I:%M:%S %p". +%X is the locale's "preferred" time format. + +Finally, %n is a newline, %t is a tab, %% is a literal %, and +unrecognized %-sequences stand for themselves. + +Certain flags and modifiers are available with some format controls. +The flags are `_', `-', `^' and `#'. For certain characters X, +%_X is like %X, but padded with blanks; %-X is like %X, +but without padding. %^X is like %X, but with all textual +characters up-cased; %#X is like %X, but with letter-case of +all textual characters reversed. +%NX (where N stands for an integer) is like %X, +but takes up at least N (a number) positions. +The modifiers are `E' and `O'. For certain characters X, +%EX is a locale's alternative version of %X; +%OX is like %X, but uses the locale's number symbols. + +For example, to produce full ISO 8601 format, use "%FT%T%z". + +usage: (format-time-string FORMAT-STRING &optional TIME ZONE) */) + (Lisp_Object format_string, Lisp_Object timeval, Lisp_Object zone) +{ + struct timespec t = lisp_time_argument (timeval); + struct tm tm; + + CHECK_STRING (format_string); + format_string = code_convert_string_norecord (format_string, + Vlocale_coding_system, 1); + return format_time_string (SSDATA (format_string), SBYTES (format_string), + t, zone, &tm); +} + +DEFUN ("decode-time", Fdecode_time, Sdecode_time, 0, 2, 0, + doc: /* Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST UTCOFF). +The optional TIME should be a list of (HIGH LOW . IGNORED), +as from `current-time' and `file-attributes', or nil to use the +current time. It can also be a single integer number of seconds since +the epoch. The obsolete form (HIGH . LOW) is also still accepted. + +The optional ZONE is omitted or nil for Emacs local time, t for +Universal Time, `wall' for system wall clock time, or a string as in +the TZ environment variable. It can also be a list (as from +`current-time-zone') or an integer (the UTC offset in seconds) applied +without consideration for daylight saving time. + +The list has the following nine members: SEC is an integer between 0 +and 60; SEC is 60 for a leap second, which only some operating systems +support. MINUTE is an integer between 0 and 59. HOUR is an integer +between 0 and 23. DAY is an integer between 1 and 31. MONTH is an +integer between 1 and 12. YEAR is an integer indicating the +four-digit year. DOW is the day of week, an integer between 0 and 6, +where 0 is Sunday. DST is t if daylight saving time is in effect, +nil if it is not in effect, and -1 if daylight saving information is +not available. UTCOFF is an integer indicating the UTC offset in +seconds, i.e., the number of seconds east of Greenwich. (Note that +Common Lisp has different meanings for DOW and UTCOFF.) + +usage: (decode-time &optional TIME ZONE) */) + (Lisp_Object specified_time, Lisp_Object zone) +{ + time_t time_spec = lisp_seconds_argument (specified_time); + struct tm local_tm, gmt_tm; + timezone_t tz = tzlookup (zone, false); + struct tm *tm = emacs_localtime_rz (tz, &time_spec, &local_tm); + xtzfree (tz); + + if (! (tm + && MOST_NEGATIVE_FIXNUM - TM_YEAR_BASE <= local_tm.tm_year + && local_tm.tm_year <= MOST_POSITIVE_FIXNUM - TM_YEAR_BASE)) + time_overflow (); + + /* Avoid overflow when INT_MAX < EMACS_INT_MAX. */ + EMACS_INT tm_year_base = TM_YEAR_BASE; + + return CALLN (Flist, + make_fixnum (local_tm.tm_sec), + make_fixnum (local_tm.tm_min), + make_fixnum (local_tm.tm_hour), + make_fixnum (local_tm.tm_mday), + make_fixnum (local_tm.tm_mon + 1), + make_fixnum (local_tm.tm_year + tm_year_base), + make_fixnum (local_tm.tm_wday), + (local_tm.tm_isdst < 0 ? make_fixnum (-1) + : local_tm.tm_isdst == 0 ? Qnil : Qt), + (HAVE_TM_GMTOFF + ? make_fixnum (tm_gmtoff (&local_tm)) + : gmtime_r (&time_spec, &gmt_tm) + ? make_fixnum (tm_diff (&local_tm, &gmt_tm)) + : Qnil)); +} + +/* Return OBJ - OFFSET, checking that OBJ is a valid fixnum and that + the result is representable as an int. */ +static int +check_tm_member (Lisp_Object obj, int offset) +{ + CHECK_FIXNUM (obj); + EMACS_INT n = XFIXNUM (obj); + int result; + if (INT_SUBTRACT_WRAPV (n, offset, &result)) + time_overflow (); + return result; +} + +DEFUN ("encode-time", Fencode_time, Sencode_time, 6, MANY, 0, + doc: /* Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time. +This is the reverse operation of `decode-time', which see. + +The optional ZONE is omitted or nil for Emacs local time, t for +Universal Time, `wall' for system wall clock time, or a string as in +the TZ environment variable. It can also be a list (as from +`current-time-zone') or an integer (as from `decode-time') applied +without consideration for daylight saving time. + +You can pass more than 7 arguments; then the first six arguments +are used as SECOND through YEAR, and the *last* argument is used as ZONE. +The intervening arguments are ignored. +This feature lets (apply \\='encode-time (decode-time ...)) work. + +Out-of-range values for SECOND, MINUTE, HOUR, DAY, or MONTH are allowed; +for example, a DAY of 0 means the day preceding the given month. +Year numbers less than 100 are treated just like other year numbers. +If you want them to stand for years in this century, you must do that yourself. + +Years before 1970 are not guaranteed to work. On some systems, +year values as low as 1901 do work. + +usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */) + (ptrdiff_t nargs, Lisp_Object *args) +{ + time_t value; + struct tm tm; + Lisp_Object zone = (nargs > 6 ? args[nargs - 1] : Qnil); + + tm.tm_sec = check_tm_member (args[0], 0); + tm.tm_min = check_tm_member (args[1], 0); + tm.tm_hour = check_tm_member (args[2], 0); + tm.tm_mday = check_tm_member (args[3], 0); + tm.tm_mon = check_tm_member (args[4], 1); + tm.tm_year = check_tm_member (args[5], TM_YEAR_BASE); + tm.tm_isdst = -1; + + timezone_t tz = tzlookup (zone, false); + value = emacs_mktime_z (tz, &tm); + xtzfree (tz); + + if (value == (time_t) -1) + time_overflow (); + + return list2i (hi_time (value), lo_time (value)); +} + +DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0, + doc: /* Return the current time, as the number of seconds since 1970-01-01 00:00:00. +The time is returned as a list of integers (HIGH LOW USEC PSEC). +HIGH has the most significant bits of the seconds, while LOW has the +least significant 16 bits. USEC and PSEC are the microsecond and +picosecond counts. */) + (void) +{ + return make_lisp_time (current_timespec ()); +} + +DEFUN ("current-time-string", Fcurrent_time_string, Scurrent_time_string, + 0, 2, 0, + doc: /* Return the current local time, as a human-readable string. +Programs can use this function to decode a time, +since the number of columns in each field is fixed +if the year is in the range 1000-9999. +The format is `Sun Sep 16 01:03:52 1973'. +However, see also the functions `decode-time' and `format-time-string' +which provide a much more powerful and general facility. + +If SPECIFIED-TIME is given, it is a time to format instead of the +current time. The argument should have the form (HIGH LOW . IGNORED). +Thus, you can use times obtained from `current-time' and from +`file-attributes'. SPECIFIED-TIME can also be a single integer number +of seconds since the epoch. The obsolete form (HIGH . LOW) is also +still accepted. + +The optional ZONE is omitted or nil for Emacs local time, t for +Universal Time, `wall' for system wall clock time, or a string as in +the TZ environment variable. It can also be a list (as from +`current-time-zone') or an integer (as from `decode-time') applied +without consideration for daylight saving time. */) + (Lisp_Object specified_time, Lisp_Object zone) +{ + time_t value = lisp_seconds_argument (specified_time); + timezone_t tz = tzlookup (zone, false); + + /* Convert to a string in ctime format, except without the trailing + newline, and without the 4-digit year limit. Don't use asctime + or ctime, as they might dump core if the year is outside the + range -999 .. 9999. */ + struct tm tm; + struct tm *tmp = emacs_localtime_rz (tz, &value, &tm); + xtzfree (tz); + if (! tmp) + time_overflow (); + + static char const wday_name[][4] = + { "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" }; + static char const mon_name[][4] = + { "Jan", "Feb", "Mar", "Apr", "May", "Jun", + "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" }; + printmax_t year_base = TM_YEAR_BASE; + char buf[sizeof "Mon Apr 30 12:49:17 " + INT_STRLEN_BOUND (int) + 1]; + int len = sprintf (buf, "%s %s%3d %02d:%02d:%02d %"pMd, + wday_name[tm.tm_wday], mon_name[tm.tm_mon], tm.tm_mday, + tm.tm_hour, tm.tm_min, tm.tm_sec, + tm.tm_year + year_base); + + return make_unibyte_string (buf, len); +} + +DEFUN ("current-time-zone", Fcurrent_time_zone, Scurrent_time_zone, 0, 2, 0, + doc: /* Return the offset and name for the local time zone. +This returns a list of the form (OFFSET NAME). +OFFSET is an integer number of seconds ahead of UTC (east of Greenwich). + A negative value means west of Greenwich. +NAME is a string giving the name of the time zone. +If SPECIFIED-TIME is given, the time zone offset is determined from it +instead of using the current time. The argument should have the form +\(HIGH LOW . IGNORED). Thus, you can use times obtained from +`current-time' and from `file-attributes'. SPECIFIED-TIME can also be +a single integer number of seconds since the epoch. The obsolete form +(HIGH . LOW) is also still accepted. + +The optional ZONE is omitted or nil for Emacs local time, t for +Universal Time, `wall' for system wall clock time, or a string as in +the TZ environment variable. It can also be a list (as from +`current-time-zone') or an integer (as from `decode-time') applied +without consideration for daylight saving time. + +Some operating systems cannot provide all this information to Emacs; +in this case, `current-time-zone' returns a list containing nil for +the data it can't find. */) + (Lisp_Object specified_time, Lisp_Object zone) +{ + struct timespec value; + struct tm local_tm, gmt_tm; + Lisp_Object zone_offset, zone_name; + + zone_offset = Qnil; + value = make_timespec (lisp_seconds_argument (specified_time), 0); + zone_name = format_time_string ("%Z", sizeof "%Z" - 1, value, + zone, &local_tm); + + /* gmtime_r expects a pointer to time_t, but tv_sec of struct + timespec on some systems (MinGW) is a 64-bit field. */ + time_t tsec = value.tv_sec; + if (HAVE_TM_GMTOFF || gmtime_r (&tsec, &gmt_tm)) + { + long int offset = (HAVE_TM_GMTOFF + ? tm_gmtoff (&local_tm) + : tm_diff (&local_tm, &gmt_tm)); + zone_offset = make_fixnum (offset); + if (SCHARS (zone_name) == 0) + { + /* No local time zone name is available; use numeric zone instead. */ + long int hour = offset / 3600; + int min_sec = offset % 3600; + int amin_sec = min_sec < 0 ? - min_sec : min_sec; + int min = amin_sec / 60; + int sec = amin_sec % 60; + int min_prec = min_sec ? 2 : 0; + int sec_prec = sec ? 2 : 0; + char buf[sizeof "+0000" + INT_STRLEN_BOUND (long int)]; + zone_name = make_formatted_string (buf, "%c%.2ld%.*d%.*d", + (offset < 0 ? '-' : '+'), + hour, min_prec, min, sec_prec, sec); + } + } + + return list2 (zone_offset, zone_name); +} + +DEFUN ("set-time-zone-rule", Fset_time_zone_rule, Sset_time_zone_rule, 1, 1, 0, + doc: /* Set the Emacs local time zone using TZ, a string specifying a time zone rule. +If TZ is nil or `wall', use system wall clock time; this differs from +the usual Emacs convention where nil means current local time. If TZ +is t, use Universal Time. If TZ is a list (as from +`current-time-zone') or an integer (as from `decode-time'), use the +specified time zone without consideration for daylight saving time. + +Instead of calling this function, you typically want something else. +To temporarily use a different time zone rule for just one invocation +of `decode-time', `encode-time', or `format-time-string', pass the +function a ZONE argument. To change local time consistently +throughout Emacs, call (setenv "TZ" TZ): this changes both the +environment of the Emacs process and the variable +`process-environment', whereas `set-time-zone-rule' affects only the +former. */) + (Lisp_Object tz) +{ + tzlookup (NILP (tz) ? Qwall : tz, true); + return Qnil; +} + +/* A buffer holding a string of the form "TZ=value", intended + to be part of the environment. If TZ is supposed to be unset, + the buffer string is "tZ=". */ + static char *tzvalbuf; + +/* Get the local time zone rule. */ +char * +emacs_getenv_TZ (void) +{ + return tzvalbuf[0] == 'T' ? tzvalbuf + tzeqlen : 0; +} + +/* Set the local time zone rule to TZSTRING, which can be null to + denote wall clock time. Do not record the setting in LOCAL_TZ. + + This function is not thread-safe, in theory because putenv is not, + but mostly because of the static storage it updates. Other threads + that invoke localtime etc. may be adversely affected while this + function is executing. */ + +int +emacs_setenv_TZ (const char *tzstring) +{ + static ptrdiff_t tzvalbufsize; + ptrdiff_t tzstringlen = tzstring ? strlen (tzstring) : 0; + char *tzval = tzvalbuf; + bool new_tzvalbuf = tzvalbufsize <= tzeqlen + tzstringlen; + + if (new_tzvalbuf) + { + /* Do not attempt to free the old tzvalbuf, since another thread + may be using it. In practice, the first allocation is large + enough and memory does not leak. */ + tzval = xpalloc (NULL, &tzvalbufsize, + tzeqlen + tzstringlen - tzvalbufsize + 1, -1, 1); + tzvalbuf = tzval; + tzval[1] = 'Z'; + tzval[2] = '='; + } + + if (tzstring) + { + /* Modify TZVAL in place. Although this is dicey in a + multithreaded environment, we know of no portable alternative. + Calling putenv or setenv could crash some other thread. */ + tzval[0] = 'T'; + strcpy (tzval + tzeqlen, tzstring); + } + else + { + /* Turn 'TZ=whatever' into an empty environment variable 'tZ='. + Although this is also dicey, calling unsetenv here can crash Emacs. + See Bug#8705. */ + tzval[0] = 't'; + tzval[tzeqlen] = 0; + } + + +#ifndef WINDOWSNT + /* Modifying *TZVAL merely requires calling tzset (which is the + caller's responsibility). However, modifying TZVAL requires + calling putenv; although this is not thread-safe, in practice this + runs only on startup when there is only one thread. */ + bool need_putenv = new_tzvalbuf; +#else + /* MS-Windows 'putenv' copies the argument string into a block it + allocates, so modifying *TZVAL will not change the environment. + However, the other threads run by Emacs on MS-Windows never call + 'xputenv' or 'putenv' or 'unsetenv', so the original cause for the + dicey in-place modification technique doesn't exist there in the + first place. */ + bool need_putenv = true; +#endif + if (need_putenv) + xputenv (tzval); + + return 0; +} + +void +syms_of_timefns (void) +{ + defsubr (&Scurrent_time); + defsubr (&Stime_add); + defsubr (&Stime_subtract); + defsubr (&Stime_less_p); + defsubr (&Stime_equal_p); + defsubr (&Sformat_time_string); + defsubr (&Sfloat_time); + defsubr (&Sdecode_time); + defsubr (&Sencode_time); + defsubr (&Scurrent_time_string); + defsubr (&Scurrent_time_zone); + defsubr (&Sset_time_zone_rule); +} diff --git a/src/w32.c b/src/w32.c index 4b57d91641..e643c42150 100644 --- a/src/w32.c +++ b/src/w32.c @@ -535,8 +535,6 @@ static Lisp_Object ltime (ULONGLONG); /* Get total user and system times for get-internal-run-time. Returns a list of integers if the times are provided by the OS (NT derivatives), otherwise it returns the result of current-time. */ -Lisp_Object w32_get_internal_run_time (void); - Lisp_Object w32_get_internal_run_time (void) { diff --git a/src/w32.h b/src/w32.h index 9c219cdda6..42b3d98245 100644 --- a/src/w32.h +++ b/src/w32.h @@ -195,6 +195,7 @@ extern int filename_from_ansi (const char *, char *); extern int filename_to_ansi (const char *, char *); extern int filename_from_utf16 (const wchar_t *, char *); extern int filename_to_utf16 (const char *, wchar_t *); +extern Lisp_Object w32_get_internal_run_time (void); extern void w32_init_file_name_codepage (void); extern int codepage_for_filenames (CPINFO *); extern Lisp_Object ansi_encode_filename (Lisp_Object); diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index 4a840c8d7d..17b2c51073 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -204,65 +204,6 @@ (should (string-equal (format "%d" 0.9) "0")) (should (string-equal (format "%d" 1.1) "1"))) -;;; Check format-time-string with various TZ settings. -;;; Use only POSIX-compatible TZ values, since the tests should work -;;; even if tzdb is not in use. -(ert-deftest format-time-string-with-zone () - ;; Don’t use (0 0 0 0) as the test case, as there are too many bugs - ;; in MS-Windows (and presumably other) C libraries when formatting - ;; time stamps near the Epoch of 1970-01-01 00:00:00 UTC, and this - ;; test is for GNU Emacs, not for C runtimes. Instead, look before - ;; you leap: "look" is the timestamp just before the first leap - ;; second on 1972-06-30 23:59:60 UTC, so it should format to the - ;; same string regardless of whether the underlying C library - ;; ignores leap seconds, while avoiding circa-1970 glitches. - ;; - ;; Similarly, stick to the limited set of time zones that are - ;; supported by both POSIX and MS-Windows: exactly 3 ASCII letters - ;; in the abbreviation, and no DST. - (let ((look '(1202 22527 999999 999999)) - (format "%Y-%m-%d %H:%M:%S.%3N %z (%Z)")) - ;; UTC. - (should (string-equal - (format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" look t) - "1972-06-30 23:59:59.999 +0000")) - ;; "UTC0". - (should (string-equal - (format-time-string format look "UTC0") - "1972-06-30 23:59:59.999 +0000 (UTC)")) - ;; Negative UTC offset, as a Lisp list. - (should (string-equal - (format-time-string format look '(-28800 "PST")) - "1972-06-30 15:59:59.999 -0800 (PST)")) - ;; Negative UTC offset, as a Lisp integer. - (should (string-equal - (format-time-string format look -28800) - ;; MS-Windows build replaces unrecognizable TZ values, - ;; such as "-08", with "ZZZ". - (if (eq system-type 'windows-nt) - "1972-06-30 15:59:59.999 -0800 (ZZZ)" - "1972-06-30 15:59:59.999 -0800 (-08)"))) - ;; Positive UTC offset that is not an hour multiple, as a string. - (should (string-equal - (format-time-string format look "IST-5:30") - "1972-07-01 05:29:59.999 +0530 (IST)")))) - -;;; This should not dump core. -(ert-deftest format-time-string-with-outlandish-zone () - (should (stringp - (format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" nil - (concat (make-string 2048 ?X) "0"))))) - -(defun editfns-tests--have-leap-seconds () - (string-equal (format-time-string "%Y-%m-%d %H:%M:%S" 78796800 t) - "1972-06-30 23:59:60")) - -(ert-deftest format-time-string-with-bignum-on-32-bit () - (should (or (string-equal - (format-time-string "%Y-%m-%d %H:%M:%S" (- (ash 1 31) 3600) t) - "2038-01-19 02:14:08") - (editfns-tests--have-leap-seconds)))) - (ert-deftest format-with-field () (should (equal (format "First argument %2$s, then %3$s, then %1$s" 1 2 3) "First argument 2, then 3, then 1")) diff --git a/test/src/timefns-tests.el b/test/src/timefns-tests.el new file mode 100644 index 0000000000..8418b509e1 --- /dev/null +++ b/test/src/timefns-tests.el @@ -0,0 +1,79 @@ +;;; timefns-tests.el -- tests for timefns.c + +;; Copyright (C) 2016-2018 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; This program 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. + +;; This program 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 this program. If not, see . + +(require 'ert) + +;;; Check format-time-string with various TZ settings. +;;; Use only POSIX-compatible TZ values, since the tests should work +;;; even if tzdb is not in use. +(ert-deftest format-time-string-with-zone () + ;; Don’t use (0 0 0 0) as the test case, as there are too many bugs + ;; in MS-Windows (and presumably other) C libraries when formatting + ;; time stamps near the Epoch of 1970-01-01 00:00:00 UTC, and this + ;; test is for GNU Emacs, not for C runtimes. Instead, look before + ;; you leap: "look" is the timestamp just before the first leap + ;; second on 1972-06-30 23:59:60 UTC, so it should format to the + ;; same string regardless of whether the underlying C library + ;; ignores leap seconds, while avoiding circa-1970 glitches. + ;; + ;; Similarly, stick to the limited set of time zones that are + ;; supported by both POSIX and MS-Windows: exactly 3 ASCII letters + ;; in the abbreviation, and no DST. + (let ((look '(1202 22527 999999 999999)) + (format "%Y-%m-%d %H:%M:%S.%3N %z (%Z)")) + ;; UTC. + (should (string-equal + (format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" look t) + "1972-06-30 23:59:59.999 +0000")) + ;; "UTC0". + (should (string-equal + (format-time-string format look "UTC0") + "1972-06-30 23:59:59.999 +0000 (UTC)")) + ;; Negative UTC offset, as a Lisp list. + (should (string-equal + (format-time-string format look '(-28800 "PST")) + "1972-06-30 15:59:59.999 -0800 (PST)")) + ;; Negative UTC offset, as a Lisp integer. + (should (string-equal + (format-time-string format look -28800) + ;; MS-Windows build replaces unrecognizable TZ values, + ;; such as "-08", with "ZZZ". + (if (eq system-type 'windows-nt) + "1972-06-30 15:59:59.999 -0800 (ZZZ)" + "1972-06-30 15:59:59.999 -0800 (-08)"))) + ;; Positive UTC offset that is not an hour multiple, as a string. + (should (string-equal + (format-time-string format look "IST-5:30") + "1972-07-01 05:29:59.999 +0530 (IST)")))) + +;;; This should not dump core. +(ert-deftest format-time-string-with-outlandish-zone () + (should (stringp + (format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" nil + (concat (make-string 2048 ?X) "0"))))) + +(defun timefns-tests--have-leap-seconds () + (string-equal (format-time-string "%Y-%m-%d %H:%M:%S" 78796800 t) + "1972-06-30 23:59:60")) + +(ert-deftest format-time-string-with-bignum-on-32-bit () + (should (or (string-equal + (format-time-string "%Y-%m-%d %H:%M:%S" (- (ash 1 31) 3600) t) + "2038-01-19 02:14:08") + (timefns-tests--have-leap-seconds)))) commit b99192fe24fc5dd75340083403e95a65cb4a6d79 Author: Charles A. Roelli Date: Sat Oct 6 21:24:32 2018 +0200 * lisp/simple.el (transient-mark-mode): Correct documentation. (Bug#32956) diff --git a/lisp/simple.el b/lisp/simple.el index d5674aae9b..8bbafe49d3 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -5793,10 +5793,10 @@ Transient Mark mode if ARG is omitted or nil. Transient Mark mode is a global minor mode. When enabled, the region is highlighted with the `region' face whenever the mark -is active. The mark is \"deactivated\" by changing the buffer, -and after certain other operations that set the mark but whose -main purpose is something else--for example, incremental search, -\\[beginning-of-buffer], and \\[end-of-buffer]. +is active. The mark is \"deactivated\" after certain non-motion +commands, including those that change the text in the buffer, and +during shift or mouse selection by any unshifted cursor motion +command (see Info node `Shift Selection' for more details). You can also deactivate the mark by typing \\[keyboard-quit] or \\[keyboard-escape-quit]. commit 7e4229411be6064a7dcd95480af6f02faa86751f Author: Eli Zaretskii Date: Sat Oct 6 12:38:36 2018 +0300 Update the locale and language database * lisp/international/mule-cmds.el (locale-language-names): Update the list of supported locales. Use existing language names where available. diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 333fe2aa91..88dfa6f34b 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -2229,7 +2229,7 @@ See `set-language-info-alist' for use in programs." ("bg" "Bulgarian" cp1251) ; Bulgarian ; bh Bihari ; bi Bislama - ("bn" . "UTF-8") ; Bengali, Bangla + ("bn" "Bengali" utf-8) ; Bengali, Bangla ("bo" . "Tibetan") ("br" . "Latin-1") ; Breton ("bs" . "Latin-2") ; Bosnian @@ -2242,6 +2242,7 @@ See `set-language-info-alist' for use in programs." ("de" "German" iso-8859-1) ; dv Divehi ; dz Bhutani + ("ee" . "Latin-4") ; Ewe ("el" "Greek" iso-8859-7) ;; Users who specify "en" explicitly typically want Latin-1, not ASCII. ;; That's actually what the GNU locales define, modulo things like @@ -2250,10 +2251,10 @@ See `set-language-info-alist' for use in programs." ("en" "English" iso-8859-1) ; English ("eo" . "Esperanto") ; Esperanto ("es" "Spanish" iso-8859-1) - ("et" . "Latin-1") ; Estonian + ("et" . "Latin-9") ; Estonian ("eu" . "Latin-1") ; Basque - ("fa" . "UTF-8") ; Persian - ("fi" . "Latin-1") ; Finnish + ("fa" "Persian" utf-8) ; Persian + ("fi" . "Latin-9") ; Finnish ("fj" . "Latin-1") ; Fiji ("fo" . "Latin-1") ; Faroese ("fr" "French" iso-8859-1) ; French @@ -2263,11 +2264,12 @@ See `set-language-info-alist' for use in programs." ("gez" "Ethiopic" utf-8) ; Geez ("gl" . "Latin-1") ; Gallegan; Galician ; gn Guarani - ("gu" . "UTF-8") ; Gujarati + ("gu" "Gujarati" utf-8) ; Gujarati ("gv" . "Latin-1") ; Manx Gaelic ; ha Hausa ("he" "Hebrew" iso-8859-8) ("hi" "Devanagari" utf-8) ; Hindi + ("hni_IN" . "UTF-8") ; Chhattisgarhi ("hr" "Croatian" iso-8859-2) ; Croatian ("hu" . "Latin-2") ; Hungarian ; hy Armenian @@ -2284,20 +2286,20 @@ See `set-language-info-alist' for use in programs." ("ka" "Georgian" georgian-ps) ; Georgian ; kk Kazakh ("kl" . "Latin-1") ; Greenlandic - ; km Cambodian + ("km" "Khmer" utf-8) ; Cambodian, Khmer ("kn" "Kannada" utf-8) ("ko" "Korean" euc-kr) - ; ks Kashmiri + ("ks" . "UTF-8") ; Kashmiri ; ku Kurdish ("kw" . "Latin-1") ; Cornish - ; ky Kirghiz + ("ky" . "UTF-8") ; Kirghiz ("la" . "Latin-1") ; Latin ("lb" . "Latin-1") ; Luxemburgish - ("lg" . "Laint-6") ; Ganda + ("lg" . "Latin-6") ; Ganda, a.k.a. Luganda ; ln Lingala ("lo" "Lao" utf-8) ; Laothian ("lt" "Lithuanian" iso-8859-13) - ("lv" . "Latvian") ; Latvian, Lettish + ("lv" "Latvian" iso-8859-13) ; Latvian, Lettish ; mg Malagasy ("mi" . "Latin-7") ; Maori ("mk" "Cyrillic-ISO" iso-8859-5) ; Macedonian @@ -2307,24 +2309,29 @@ See `set-language-info-alist' for use in programs." ("mr" "Devanagari" utf-8) ; Marathi ("ms" . "Latin-1") ; Malay ("mt" . "Latin-3") ; Maltese - ; my Burmese + ("my" "Burmese" utf-8) ; Burmese ; na Nauru ("nb" . "Latin-1") ; Norwegian ("ne" "Devanagari" utf-8) ; Nepali ("nl" "Dutch" iso-8859-1) + ("nn" . "Latin-1") ; Norwegian Nynorsk ("no" . "Latin-1") ; Norwegian + ("nr_ZA" . "UTF-8") ; South Ndebele + ("nso_ZA" . "UTF-8") ; Pedi ("oc" . "Latin-1") ; Occitan ("om_ET" . "UTF-8") ; (Afan) Oromo ("om" . "Latin-1") ; (Afan) Oromo - ; or Oriya - ("pa" . "UTF-8") ; Punjabi - ("pl" . "Latin-2") ; Polish + ("or" "Oriya" utf-8) + ("pa" "Punjabi" utf-8) ; Punjabi + ("pl" "Polish" iso-8859-2) ; Polish ; ps Pashto, Pushto + ("pt_BR" "Brazilian Portuguese" iso-8859-1) ; Brazilian Portuguese ("pt" . "Latin-1") ; Portuguese ; qu Quechua ("rm" . "Latin-1") ; Rhaeto-Romanic ; rn Kirundi ("ro" "Romanian" iso-8859-2) + ("ru_RU.koi8r" "Cyrillic-KOI8" koi8-r) ("ru_RU" "Russian" iso-8859-5) ("ru_UA" "Russian" koi8-u) ; rw Kinyarwanda @@ -2333,7 +2340,7 @@ See `set-language-info-alist' for use in programs." ("se" . "UTF-8") ; Northern Sami ; sg Sangho ("sh" . "Latin-2") ; Serbo-Croatian - ; si Sinhalese + ("si" "Sinhala" utf-8) ; Sinhalese ("sid" . "UTF-8") ; Sidamo ("sk" "Slovak" iso-8859-2) ("sl" "Slovenian" iso-8859-2) @@ -2341,7 +2348,7 @@ See `set-language-info-alist' for use in programs." ; sn Shona ("so_ET" "UTF-8") ; Somali ("so" "Latin-1") ; Somali - ("sq" . "Latin-1") ; Albanian + ("sq" . "Latin-2") ; Albanian ("sr" . "Latin-2") ; Serbian (Latin alphabet) ; ss Siswati ("st" . "Latin-1") ; Sesotho @@ -2349,17 +2356,20 @@ See `set-language-info-alist' for use in programs." ("sv" "Swedish" iso-8859-1) ; Swedish ("sw" . "Latin-1") ; Swahili ("ta" "Tamil" utf-8) - ("te" . "UTF-8") ; Telugu + ("te" "Telugu" utf-8) ; Telugu ("tg" "Tajik" koi8-t) - ("th" "Thai" tis-620) + ("th_TH.tis620" "Thai" tis-620) + ("th_TH.TIS-620" "Thai" tis-620) + ("th_TH" "Thai" iso-8859-11) + ("th" "Thai" iso-8859-11) ("ti" "Ethiopic" utf-8) ; Tigrinya ("tig_ER" . "UTF-8") ; Tigre ; tk Turkmen ("tl" . "Latin-1") ; Tagalog - ; tn Setswana + ("tn" . "Latin-9") ; Setswana, Tswana ; to Tonga ("tr" "Turkish" iso-8859-9) - ; ts Tsonga + ("ts" . "Latin-1") ; Tsonga ("tt" . "UTF-8") ; Tatar ; tw Twi ; ug Uighur @@ -2367,6 +2377,7 @@ See `set-language-info-alist' for use in programs." ("ur" . "UTF-8") ; Urdu ("uz_UZ@cyrillic" . "UTF-8"); Uzbek ("uz" . "Latin-1") ; Uzbek + ("ve" . "UTF-8") ; Venda ("vi" "Vietnamese" utf-8) ; vo Volapuk ("wa" . "Latin-1") ; Walloon @@ -2396,7 +2407,6 @@ See `set-language-info-alist' for use in programs." ;; Nonstandard or obsolete language codes ("cz" . "Czech") ; e.g. Solaris 2.6 - ("ee" . "Latin-4") ; Estonian, e.g. X11R6.4 ("iw" . "Hebrew") ; e.g. X11R6.4 ("sp" . "Cyrillic-ISO") ; Serbian (Cyrillic alphabet), e.g. X11R6.4 ("su" . "Latin-1") ; Finnish, e.g. Solaris 2.6 commit 8c53d9fede22b1929de4b9aaaca6a5611d5c5475 Author: Eli Zaretskii Date: Fri Oct 5 16:51:17 2018 +0300 Fix a typo in a doc string. * lisp/window.el (display-buffer-alist): Fix a typo in a doc string. Reported by Michael Heerdegen . diff --git a/lisp/window.el b/lisp/window.el index 818bd3dd2b..f96c887be4 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -6831,7 +6831,7 @@ See `display-buffer' for details.") (put 'display-buffer-overriding-action 'risky-local-variable t) (defcustom display-buffer-alist nil - "Alist of uder-defined conditional actions for `display-buffer'. + "Alist of user-defined conditional actions for `display-buffer'. Its value takes effect before `display-buffer-base-action' and `display-buffer-fallback-action', but after `display-buffer-overriding-action', which see. commit 79bda3bc4731c7ac67b499a154c636d8eeb2edee Author: Katsumi Yamaoka Date: Fri Oct 5 00:22:20 2018 +0000 Make nneething allow CRLF-encoded files (bug#32940) * lisp/gnus/nneething.el (nneething-request-article): Bind coding system to raw-text instead of binary when reading a file, that may be CRLF-encoded (bug#32940). diff --git a/lisp/gnus/nneething.el b/lisp/gnus/nneething.el index 9b6a92f10e..886cbf8146 100644 --- a/lisp/gnus/nneething.el +++ b/lisp/gnus/nneething.el @@ -123,7 +123,7 @@ included.") (file-exists-p file) ; The file exists. (not (file-directory-p file)) ; It's not a dir. (save-excursion - (let ((nnmail-file-coding-system 'binary)) + (let ((nnmail-file-coding-system 'raw-text)) (nnmail-find-file file)) ; Insert the file in the nntp buf. (unless (nnheader-article-p) ; Either it's a real article... (let ((type commit 2cae1cf6f87a10f9d85d1759b1703abcc421c9a5 Author: Eric Abrahamsen Date: Sun Apr 8 16:49:20 2018 -0700 Further fix to eieio-persistent * lisp/emacs-lisp/eieio-base.el (eieio-persistent-validate/fix-slot-value): Make handling of hash tables and vectors recursive. This is necessary because the write process, in `eieio-override-prin1' is also recursive. With any luck, this will be the last fix of its kind. If that's true, cherry-pick to Emacs 26.2 later on. diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el index cba6cab1d4..b55bde7139 100644 --- a/lisp/emacs-lisp/eieio-base.el +++ b/lisp/emacs-lisp/eieio-base.el @@ -360,32 +360,30 @@ Second, any text properties will be stripped from strings." proposed-value)))) ;; For hash-tables and vectors, the top-level `read' will not ;; "look inside" member values, so we need to do that - ;; explicitly. + ;; explicitly. Because `eieio-override-prin1' is recursive in + ;; the case of hash-tables and vectors, we recurse + ;; `eieio-persistent-validate/fix-slot-value' here as well. ((hash-table-p proposed-value) (maphash (lambda (key value) - (cond ((class-p (car-safe value)) - (setf (gethash key proposed-value) - (eieio-persistent-convert-list-to-object - value))) - ((and (consp value) - (eq (car value) 'quote)) - (setf (gethash key proposed-value) - (cadr value))))) + (setf (gethash key proposed-value) + (if (class-p (car-safe value)) + (eieio-persistent-convert-list-to-object + value) + (eieio-persistent-validate/fix-slot-value + class slot value)))) proposed-value) proposed-value) ((vectorp proposed-value) (dotimes (i (length proposed-value)) (let ((val (aref proposed-value i))) - (cond ((class-p (car-safe val)) - (aset proposed-value i - (eieio-persistent-convert-list-to-object - (aref proposed-value i)))) - ((and (consp val) - (eq (car val) 'quote)) - (aset proposed-value i - (cadr val)))))) + (aset proposed-value i + (if (class-p (car-safe val)) + (eieio-persistent-convert-list-to-object + val) + (eieio-persistent-validate/fix-slot-value + class slot val))))) proposed-value) ((stringp proposed-value) commit 86d2169ac3458412a084c7fc4047c3a389924cad Author: Eli Zaretskii Date: Thu Oct 4 19:13:17 2018 +0300 Avoid ridiculously high stack limit requests on macOS * src/emacs.c (main): Avoid wraparound in subtraction of rlim_t values, in case rlim_t is an unsigned type. (Bug#32338) diff --git a/src/emacs.c b/src/emacs.c index 483e848f6d..f80047e89e 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -875,7 +875,8 @@ main (int argc, char **argv) newlim = rlim.rlim_max; newlim -= newlim % pagesize; - if (pagesize <= newlim - lim) + if (newlim > lim /* in case rlim_t is an unsigned type */ + && pagesize <= newlim - lim) { rlim.rlim_cur = newlim; if (setrlimit (RLIMIT_STACK, &rlim) == 0) @@ -884,9 +885,10 @@ main (int argc, char **argv) } /* If the stack is big enough, let regex.c more of it before falling back to heap allocation. */ - emacs_re_safe_alloca = max - (min (lim - extra, SIZE_MAX) * (min_ratio / ratio), - MAX_ALLOCA); + if (lim < extra) + lim = extra; /* avoid wrap-around in unsigned subtraction */ + emacs_re_safe_alloca = + max (min (lim - extra, SIZE_MAX) * (min_ratio / ratio), MAX_ALLOCA); } #endif /* HAVE_SETRLIMIT and RLIMIT_STACK and not CYGWIN */ commit 44bf4a6b012f65327718b8c8334bfac1aee26370 Author: Michael Albinus Date: Thu Oct 4 09:46:14 2018 +0200 Some reaarangements in tramp*.texi * doc/misc/trampver.texi (trampfn): Change check for definition of macro. (tramp-bug-report-address): New variable. * doc/misc/tramp.texi (Top, Bug Reports): Use it. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 7bc365ffdf..7c5ebf334a 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -73,9 +73,9 @@ Savannah Project Page}. @end ifhtml There is a mailing list for @value{tramp}, available at -@email{tramp-devel@@gnu.org}, and archived at -@uref{https://lists.gnu.org/r/tramp-devel/, the -@value{tramp} Mail Archive}. +@email{@value{tramp-bug-report-address}}, and archived at +@uref{https://lists.gnu.org/r/tramp-devel/, the @value{tramp} Mail +Archive}. @page @insertcopying @@ -3247,9 +3247,9 @@ discussing, and general discussions about @value{tramp}. post for moderator approval. Sometimes this approval step may take as long as 48 hours due to public holidays. -@email{tramp-devel@@gnu.org} is the mailing list. Messages sent to -this address go to all the subscribers. This is @emph{not} the -address to send subscription requests to. +@email{@value{tramp-bug-report-address}} is the mailing list. +Messages sent to this address go to all the subscribers. This is +@emph{not} the address to send subscription requests to. To subscribe to the mailing list, visit: @uref{https://lists.gnu.org/mailman/listinfo/tramp-devel/, the diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index db4654ce28..aac7243446 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -5,12 +5,12 @@ @c Copyright (C) 2003-2018 Free Software Foundation, Inc. @c See file doclicense.texi for copying conditions. -@c In the Tramp GIT, the version number is auto-frobbed from -@c configure.ac, so you should edit that file and run -@c "autoconf && ./configure" to change the version number. +@c In the Tramp GIT, the version number is auto-frobbed from tramp.el, +@c and the bug report address is auto-frobbed from configure.ac. @set trampver 2.4.1-pre +@set tramp-bug-report-address tramp-devel@@gnu.org -@c Other flags from configuration +@c Other flags from configuration. @set instprefix /usr/local @set lispdir /usr/local/share/emacs/site-lisp @set infodir /usr/local/share/info @@ -46,12 +46,15 @@ @end ifset @c Macro for formatting a file name according to the respective -@c syntax. Macro arguments should not have any leading or trailing -@c whitespace. Not very elegant, but I don't know it better. - -@unmacro trampfn +@c syntax. trampver.texi is included several times in tramp.texi and +@c trampinst.texi. Redefining the macro is reported as warning for +@c creating the dvi and pdf files, so we declare the macro only the +@c first time this file is included. +@ifclear trampfndefined +@set trampfndefined @macro trampfn {method, userhost, localname} @value{prefix}@c \method\@value{postfixhop}@c \userhost\@value{postfix}\localname\ @end macro +@end ifclear diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 1956ab648b..f17129a402 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -25,11 +25,10 @@ ;;; Code: -;; In the Tramp GIT repository, the version number and the bug report -;; address are auto-frobbed from configure.ac, so you should edit that -;; file and run "autoconf && ./configure" to change them. Emacs -;; version check is defined in macro AC_EMACS_INFO of aclocal.m4; -;; should be changed only there. +;; In the Tramp GIT, the version number is auto-frobbed from tramp.el, +;; and the bug report address is auto-frobbed from configure.ac. +;; Emacs version check is defined in macro AC_EMACS_INFO of +;; aclocal.m4; should be changed only there. ;;;###tramp-autoload (defconst tramp-version "2.4.1-pre" commit 945a7622326f7d93dd318f01d54f6bf23e0021cf Author: Paul Eggert Date: Wed Oct 3 15:55:43 2018 -0700 Fix emacs_re_safe_alloca calculation Problem and draft fix noted by Eli Zaretskii in: https://lists.gnu.org/r/emacs-devel/2018-10/msg00022.html * src/emacs.c (main): Fix arithmetic used in calculation of emacs_re_safe_alloca. diff --git a/src/emacs.c b/src/emacs.c index b1c96d1828..ddaaf3fed5 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -888,11 +888,11 @@ main (int argc, char **argv) lim = newlim; } } - /* If the stack is big enough, let regex-emacs.c more of it before - falling back to heap allocation. */ - emacs_re_safe_alloca = max - (min (lim - extra, SIZE_MAX) * (min_ratio / ratio), - MAX_ALLOCA); + /* If the stack is big enough, let regex-emacs.c use more of it + before falling back to heap allocation. */ + ptrdiff_t max_failures + = min (lim - extra, min (PTRDIFF_MAX, SIZE_MAX)) / ratio; + emacs_re_safe_alloca = max (max_failures * min_ratio, MAX_ALLOCA); } #endif /* HAVE_SETRLIMIT and RLIMIT_STACK and not CYGWIN */ commit 5cbce95796a2a8b8857fb9e289a9fd9a1158677b Author: Glenn Morris Date: Wed Oct 3 17:08:28 2018 -0400 * Makefile.in (uninstall): Remove some stray icon files. diff --git a/Makefile.in b/Makefile.in index d8d345e805..f0b2b66c88 100644 --- a/Makefile.in +++ b/Makefile.in @@ -786,7 +786,9 @@ uninstall: uninstall-$(NTDIR) uninstall-doc (if cd "$(DESTDIR)${icondir}"; then \ rm -f hicolor/*x*/apps/"${EMACS_NAME}.png" \ "hicolor/scalable/apps/${EMACS_NAME}.svg" \ - hicolor/scalable/mimetypes/`echo emacs-document | sed '$(TRANSFORM)'`.svg; \ + "hicolor/scalable/apps/${EMACS_NAME}.ico" \ + "hicolor/scalable/mimetypes/${EMACS_NAME}-document.svg" \ + "hicolor/scalable/mimetypes/${EMACS_NAME}-document23.svg"; \ fi) -rm -f "$(DESTDIR)${desktopdir}/${EMACS_NAME}.desktop" -rm -f "$(DESTDIR)${appdatadir}/${EMACS_NAME}.appdata.xml" commit c1d0dbd6ca92cb221024382b19654e4fbf1d1ed3 Author: Glenn Morris Date: Wed Oct 3 16:47:01 2018 -0400 Tweak Makefile emacs-module.h handling * Makefile.in (install-arch-indep, uninstall): Respect DESTDIR. Handle whitespace. Remove non-portable mkdir argument. diff --git a/Makefile.in b/Makefile.in index e10fdc3bd6..d8d345e805 100644 --- a/Makefile.in +++ b/Makefile.in @@ -563,8 +563,8 @@ set_installuser=for installuser in $${LOGNAME} $${USERNAME} $${USER} \ ## See also these comments from 2004 about cp -r working fine: ## https://lists.gnu.org/r/autoconf-patches/2004-11/msg00005.html install-arch-indep: lisp install-info install-man ${INSTALL_ARCH_INDEP_EXTRA} - umask 022 && $(MKDIR_P) -m 0755 $(includedir) - $(INSTALL_DATA) src/emacs-module.h $(includedir)/emacs-module.h + umask 022 && $(MKDIR_P) "$(DESTDIR)$(includedir)" + $(INSTALL_DATA) src/emacs-module.h "$(DESTDIR)$(includedir)/emacs-module.h" -set ${COPYDESTS} ; \ unset CDPATH; \ $(set_installuser); \ @@ -748,7 +748,7 @@ install-strip: ### ### Don't delete the lisp and etc directories if they're in the source tree. uninstall: uninstall-$(NTDIR) uninstall-doc - rm -f $(includedir)/emacs-module.h + rm -f "$(DESTDIR)$(includedir)/emacs-module.h" $(MAKE) -C lib-src uninstall -unset CDPATH; \ for dir in "$(DESTDIR)${lispdir}" "$(DESTDIR)${etcdir}" ; do \ commit 00ea749f2af44bff6ea8c1259477fbf0ead8a306 Author: Philipp Stephani Date: Thu Sep 20 14:03:29 2018 +0200 Install emacs-module.h (Bug#31929) * Makefile.in (includedir): New variable. (install-arch-indep): Install emacs-module.h. (uninstall): Uninstall emacs-module.h. diff --git a/Makefile.in b/Makefile.in index c6b2cfa78a..e10fdc3bd6 100644 --- a/Makefile.in +++ b/Makefile.in @@ -151,6 +151,9 @@ libexecdir=@libexecdir@ # Currently only used for the systemd service file. libdir=@libdir@ +# Where to install emacs-module.h. +includedir=@includedir@ + # Where to install Emacs's man pages. # Note they contain cross-references that expect them to be in section 1. mandir=@mandir@ @@ -560,6 +563,8 @@ set_installuser=for installuser in $${LOGNAME} $${USERNAME} $${USER} \ ## See also these comments from 2004 about cp -r working fine: ## https://lists.gnu.org/r/autoconf-patches/2004-11/msg00005.html install-arch-indep: lisp install-info install-man ${INSTALL_ARCH_INDEP_EXTRA} + umask 022 && $(MKDIR_P) -m 0755 $(includedir) + $(INSTALL_DATA) src/emacs-module.h $(includedir)/emacs-module.h -set ${COPYDESTS} ; \ unset CDPATH; \ $(set_installuser); \ @@ -743,6 +748,7 @@ install-strip: ### ### Don't delete the lisp and etc directories if they're in the source tree. uninstall: uninstall-$(NTDIR) uninstall-doc + rm -f $(includedir)/emacs-module.h $(MAKE) -C lib-src uninstall -unset CDPATH; \ for dir in "$(DESTDIR)${lispdir}" "$(DESTDIR)${etcdir}" ; do \ commit ac3622c81acb93fa340a1e0e73188b1587b3970a Author: Charles A. Roelli Date: Wed Oct 3 19:59:34 2018 +0200 Improve documentation of 'read-hide-char' * src/minibuf.c (syms_of_minibuf) : Clarify documentation and mention where else the variable is used. * doc/lispref/minibuf.texi (Reading a Password): Add an index entry for 'read-hide-char'. diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 2951ef5aae..97797d0009 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -2236,6 +2236,7 @@ Here is an example of using this function: To read a password to pass to another program, you can use the function @code{read-passwd}. +@vindex read-hide-char @defun read-passwd prompt &optional confirm default This function reads a password, prompting with @var{prompt}. It does not echo the password as the user types it; instead, it echoes diff --git a/src/minibuf.c b/src/minibuf.c index 691fad07b7..f1bde913fc 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -2107,8 +2107,11 @@ properties. */); DEFVAR_LISP ("read-hide-char", Vread_hide_char, doc: /* Whether to hide input characters in noninteractive mode. -It must be a character, which will be used to mask the input -characters. This variable should never be set globally. */); +If non-nil, it must be a character, which will be used to mask the +input characters. This variable should never be set globally. + +This variable also overrides the default character that `read-passwd' +uses to hide passwords. */); Vread_hide_char = Qnil; defsubr (&Sactive_minibuffer_window); commit 43a8494babaeec60464e11c46c2ebfc993179d72 Author: Michael Albinus Date: Wed Oct 3 19:34:02 2018 +0200 * doc/misc/trampver.texi (trampfn): Call `unmacro' prior defining * doc/misc/trampver.texi (trampfn): Call `unmacro' prior defining. trampver.texi is included several times; it raises an error otherwise. diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index 3a3ada9e84..db4654ce28 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -49,6 +49,7 @@ @c syntax. Macro arguments should not have any leading or trailing @c whitespace. Not very elegant, but I don't know it better. +@unmacro trampfn @macro trampfn {method, userhost, localname} @value{prefix}@c \method\@value{postfixhop}@c commit 0d118ee59fd8fb9167fd734be38e68ff4d72c66b Merge: eb6c0c33f1 99f45ee42c Author: Glenn Morris Date: Wed Oct 3 09:25:27 2018 -0700 ; Merge from origin/emacs-26 The following commit was skipped: 99f45ee (origin/emacs-26) In follow mode, prevent the cursor resting ... commit eb6c0c33f1d8dc6aa5832eb21d460d0072578d80 Merge: 42516f01db ea77c6594e Author: Glenn Morris Date: Wed Oct 3 09:25:26 2018 -0700 Merge from origin/emacs-26 ea77c65 Revert "Temporary workaround for bug #32848 for branch emacs-26" 2c8ea46 Revert "* etc/NEWS: Note setting make-cursor-line-fully-visib... f8df6f2 * etc/NEWS: Note setting make-cursor-line-fully-visible to ni... cdca208 Fix note about interactive advice (Bug#32905) 508c40e Comple fix for Bug#32550 commit 42516f01dbcafce8dcb8b357e591f838b5590476 Merge: f562118111 35b56a24a0 Author: Glenn Morris Date: Wed Oct 3 09:25:26 2018 -0700 ; Merge from origin/emacs-26 The following commit was skipped: 35b56a2 ; Auto-commit of loaddefs files. commit f5621181111ba7cc58967ee9b1cfa08020d3e3ea Merge: a773b0918c 9c028d6965 Author: Glenn Morris Date: Wed Oct 3 09:25:26 2018 -0700 Merge from origin/emacs-26 9c028d6 * lisp/savehist.el (savehist-mode): Doc fix. (Bug#32889) 3a2b5a7 ; * lisp/bindings.el (bindings--define-key): Doc fix. (Bug#3... 6a7a869 Org manual: Rewrite the Org Mobile section # Conflicts: # lisp/savehist.el commit a773b0918ce15cbd657c1e77417b231ffb0363fb Merge: 48adb87bcb 6650751ce7 Author: Glenn Morris Date: Wed Oct 3 09:23:16 2018 -0700 ; Merge from origin/emacs-26 The following commit was skipped: 6650751 Temporary workaround for bug #32848 for branch emacs-26 commit 48adb87bcb0f27e2d18fc6523c472af4916d5884 Merge: 51f0cccdde 7296b6fbf2 Author: Glenn Morris Date: Wed Oct 3 09:23:16 2018 -0700 Merge from origin/emacs-26 7296b6f Improve cl-do, cl-do* docstrings d416109 Avoid returning early in 'while-no-input' due to subprocesses e8a4d94 Cleanup when opening a new terminal fails. (Bug#32794) # Conflicts: # etc/NEWS commit 99f45ee42c5554d606407f6da37700e9bf86bd35 Author: Alan Mackenzie Date: Wed Oct 3 15:57:15 2018 +0000 In follow mode, prevent the cursor resting on a partially displayed line Don't merge to master. This fixes bug #32848 * lisp/follow.el (follow-adjust-window): If point ends up in a partially displayed line in a left hand or middle window, move it one line forward, to prevent unwanted scrolling should make-cursor-line-fully-visible be non-nil. diff --git a/lisp/follow.el b/lisp/follow.el index fd397c077b..eb48ec179c 100644 --- a/lisp/follow.el +++ b/lisp/follow.el @@ -1385,7 +1385,13 @@ non-first windows in Follow mode." (unless (eq win (selected-window)) (let ((p (window-point win))) (set-window-start win (window-start win) nil) - (set-window-point win p)))) + (if (nth 2 (pos-visible-in-window-p p win t)) + ;; p is in a partially visible line. We can't leave + ;; window-point there, because C-x o back into WIN + ;; would then fail. + (with-selected-window win + (forward-line)) ; redisplay will recenter it in WIN. + (set-window-point win p))))) (unless visible ;; If point may not be visible in the selected window, commit ea77c6594e5ccc9057ca664ef1dea766ca291b8e Author: Alan Mackenzie Date: Wed Oct 3 12:08:59 2018 +0000 Revert "Temporary workaround for bug #32848 for branch emacs-26" This reverts commit 6650751ce73413d05599df07a9c5bc70744260f3. diff --git a/lisp/follow.el b/lisp/follow.el index 7942901bb4..fd397c077b 100644 --- a/lisp/follow.el +++ b/lisp/follow.el @@ -438,10 +438,7 @@ Keys specific to Follow mode: (setq pos-visible-in-window-group-p-function 'follow-pos-visible-in-window-p) (setq selected-window-group-function 'follow-all-followers) - (setq move-to-window-group-line-function 'follow-move-to-window-line) - - ;; Crude workaround for bug #32848 for the emacs-26 branch, 2018-09-30. - (setq-local make-cursor-line-fully-visible nil)) + (setq move-to-window-group-line-function 'follow-move-to-window-line)) ;; Remove globally-installed hook functions only if there is no ;; other Follow mode buffer. @@ -454,9 +451,6 @@ Keys specific to Follow mode: (remove-hook 'post-command-hook 'follow-post-command-hook) (remove-hook 'window-size-change-functions 'follow-window-size-change))) - ;; Second part of crude workaround for bug #32848. - (kill-local-variable 'make-cursor-line-fully-visible) - (kill-local-variable 'move-to-window-group-line-function) (kill-local-variable 'selected-window-group-function) (kill-local-variable 'pos-visible-in-window-group-p-function) commit 2c8ea4654dc72ccb93ef63632a888ea3d395f599 Author: Alan Mackenzie Date: Wed Oct 3 12:08:27 2018 +0000 Revert "* etc/NEWS: Note setting make-cursor-line-fully-visible to nil in follow-mode" This reverts commit f3c8f4bde2de2b9d42c44f5e44f34c427bebdc58. diff --git a/etc/NEWS b/etc/NEWS index 440741b9b8..bfd7db016f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -15,12 +15,6 @@ in older Emacs versions. You can narrow news to a specific version by calling 'view-emacs-news' with a prefix argument or by typing C-u C-h C-n. -Temporary note: -+++ indicates that all necessary documentation updates are complete. - (This means all relevant manuals in doc/ AND lisp doc-strings.) ---- means no change in the manuals is needed. -When you add a new item, use the appropriate mark if you are sure it applies, - * Installation Changes in Emacs 26.2 @@ -51,14 +45,6 @@ often cause crashes. Set it to nil if you really need those fonts. * Changes in Specialized Modes and Packages in Emacs 26.2 ---- -** Follow mode -Follow mode now sets a buffer local value of nil for -make-cursor-line-fully-visible in any buffer using it. This ensures -correct operation if point is moved by C-n to the next window when -there is a partially displayed line at the bottom of the original -window. - ** Ibuffer --- commit f8df6f23070d506e64e3f5079940ca5bef2f1b7e Author: Alan Mackenzie Date: Sun Sep 30 15:58:40 2018 +0000 * etc/NEWS: Note setting make-cursor-line-fully-visible to nil in follow-mode Also re-insert the "temporary note" explaining --- and +++. diff --git a/etc/NEWS b/etc/NEWS index bfd7db016f..440741b9b8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -15,6 +15,12 @@ in older Emacs versions. You can narrow news to a specific version by calling 'view-emacs-news' with a prefix argument or by typing C-u C-h C-n. +Temporary note: ++++ indicates that all necessary documentation updates are complete. + (This means all relevant manuals in doc/ AND lisp doc-strings.) +--- means no change in the manuals is needed. +When you add a new item, use the appropriate mark if you are sure it applies, + * Installation Changes in Emacs 26.2 @@ -45,6 +51,14 @@ often cause crashes. Set it to nil if you really need those fonts. * Changes in Specialized Modes and Packages in Emacs 26.2 +--- +** Follow mode +Follow mode now sets a buffer local value of nil for +make-cursor-line-fully-visible in any buffer using it. This ensures +correct operation if point is moved by C-n to the next window when +there is a partially displayed line at the bottom of the original +window. + ** Ibuffer --- commit 51f0cccdde9bd1679e20f35d30e39e872ce6513a Author: Alan Mackenzie Date: Wed Oct 3 10:45:59 2018 +0000 Put follow-mode's engine on pre-redisplay-hook instead of post-command-hook This fixes bug #32874. * lisp/follow.el (follow-mode): Put follow-pre-redisplay-function onto pre-redisplay-function instead of putting follow-post-command-hook onto post-command-hook. Amend the removal operation analogously. (follow-pre-redisplay-function): New function. diff --git a/lisp/follow.el b/lisp/follow.el index 7aa7b51473..e2d3a11b65 100644 --- a/lisp/follow.el +++ b/lisp/follow.el @@ -187,8 +187,8 @@ ;; Implementation: ;; ;; The main method by which Follow mode aligns windows is via the -;; function `follow-post-command-hook', which is run after each -;; command. This "fixes up" the alignment of other windows which are +;; function `follow-pre-redisplay-function', which is run before each +;; redisplay. This "fixes up" the alignment of other windows which are ;; showing the same Follow mode buffer, on the same frame as the ;; selected window. It does not try to deal with buffers other than ;; the buffer of the selected frame, or windows on other frames. @@ -418,7 +418,7 @@ Keys specific to Follow mode: (if follow-mode (progn (add-hook 'compilation-filter-hook 'follow-align-compilation-windows t t) - (add-hook 'post-command-hook 'follow-post-command-hook t) + (add-function :before pre-redisplay-function 'follow-pre-redisplay-function) (add-hook 'window-size-change-functions 'follow-window-size-change t) (add-hook 'after-change-functions 'follow-after-change nil t) (add-hook 'isearch-update-post-hook 'follow-post-command-hook nil t) @@ -445,7 +445,7 @@ Keys specific to Follow mode: (setq following (buffer-local-value 'follow-mode (car buffers)) buffers (cdr buffers))) (unless following - (remove-hook 'post-command-hook 'follow-post-command-hook) + (remove-function pre-redisplay-function 'follow-pre-redisplay-function) (remove-hook 'window-size-change-functions 'follow-window-size-change))) (kill-local-variable 'move-to-window-group-line-function) @@ -1260,10 +1260,27 @@ non-first windows in Follow mode." (not (eq win top)))) ;; Loop while this is true. (set-buffer orig-buffer)))) -;;; Post Command Hook +;;; Pre Display Function + +;; This function is added to `pre-display-function' and is thus called +;; before each redisplay operation. It supersedes (2018-09) the +;; former use of the post command hook, and now does the right thing +;; when a program calls `redisplay' or `sit-for'. + +(defun follow-pre-redisplay-function (wins) + (if (or (eq wins t) + (null wins) + (and (listp wins) + (memq (selected-window) wins))) + (follow-post-command-hook))) -;; The magic little box. This function is called after every command. +;;; Post Command Hook +;; The magic little box. This function was formerly called after every +;; command. It is now called before each redisplay operation (see +;; `follow-pre-redisplay-function' above), and at the end of several +;; search/replace commands. It retains its historical name. +;; ;; This is not as complicated as it seems. It is simply a list of common ;; display situations and the actions to take, plus commands for redrawing ;; the screen if it should be unaligned. @@ -1284,6 +1301,12 @@ non-first windows in Follow mode." (setq follow-windows-start-end-cache nil)) (follow-adjust-window win))))) +;; NOTE: to debug follow-mode with edebug, it is helpful to add +;; `follow-post-command-hook' to `post-command-hook' temporarily. Do +;; this locally to the target buffer with, say,: +;; M-: (add-hook 'post-command-hook 'follow-post-command-hook t t) +;; . + (defun follow-adjust-window (win) ;; Adjust the window WIN and its followers. (cl-assert (eq (window-buffer win) (current-buffer))) commit cdca208932a1d7f81a31f858f5f9fa55760b8323 Author: Noam Postavsky Date: Tue Oct 2 19:56:43 2018 -0400 Fix note about interactive advice (Bug#32905) * doc/lispref/functions.texi (Core Advising Primitives): Add missing ':', and finish the sentence fragment. diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 93059e8e3a..9b8057080e 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -1674,7 +1674,9 @@ Note: The interactive spec of @var{function} will apply to the combined function and should hence obey the calling convention of the combined function rather than that of @var{function}. In many cases, it makes no difference since they are identical, but it does matter for @code{:around}, -@code{:filter-args}, and @code{filter-return}, where @var{function}. +@code{:filter-args}, and @code{:filter-return}, where @var{function} +receives different arguments than the original function stored in +@var{place}. @end defmac @defmac remove-function place function commit 3eedabaef37ecbcf30144ab9efa2441bbfc950e0 Author: Stefan Monnier Date: Tue Oct 2 12:37:04 2018 -0400 * lisp/emacs-lisp/autoload.el (autoload-ignored-definitions): New var (autoload-generate-file-autoloads): Use it. diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 3d73351911..c9ee532ac8 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -660,6 +660,21 @@ Don't try to split prefixes that are already longer than that.") (defvar autoload-builtin-package-versions nil) +(defvar autoload-ignored-definitions + '("define-obsolete-function-alias" + "define-obsolete-variable-alias" + "define-category" "define-key" + "defgroup" "defface" "defadvice" + "def-edebug-spec" + ;; Hmm... this is getting ugly: + "define-widget" + "define-erc-module" + "define-erc-response-handler" + "defun-rcirc-command") + "List of strings naming definitions to ignore for prefixes. +More specifically those definitions will not be considered for the +`register-definition-prefixes' call.") + ;; When called from `generate-file-autoloads' we should ignore ;; `generated-autoload-file' altogether. When called from ;; `update-file-autoloads' we don't know `outbuf'. And when called from @@ -758,16 +773,7 @@ FILE's modification time." (looking-at "(\\(def[^ ]+\\) ['(]*\\([^' ()\"\n]+\\)[\n \t]") (not (member (match-string 1) - '("define-obsolete-function-alias" - "define-obsolete-variable-alias" - "define-category" "define-key" - "defgroup" "defface" "defadvice" - "def-edebug-spec" - ;; Hmm... this is getting ugly: - "define-widget" - "define-erc-module" - "define-erc-response-handler" - "defun-rcirc-command")))) + autoload-ignored-definitions))) (push (match-string-no-properties 2) defs)) (forward-sexp 1) (forward-line 1))))))) commit 0f505bbef6bc70d16899a24512e8eeb8eab505b4 Author: Michael Albinus Date: Tue Oct 2 16:51:51 2018 +0200 Rearrangements in tramp*.texi * doc/misc/trampver.texi (trampfn): New macro, taken from tramp.texi. * doc/misc/tramp.texi (trampfn): Moved to trampver.texi. (Top): Add sections `System Requirement' and `Basic Installation'. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 530e8dc1b4..7bc365ffdf 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -12,16 +12,6 @@ @c This is *so* much nicer :) @footnotestyle end -@c Macro for formatting a file name according to the respective -@c syntax. Macro arguments should not have any leading or trailing -@c whitespace. Not very elegant, but I don't know it better. - -@macro trampfn {method, userhost, localname} -@value{prefix}@c -\method\@value{postfixhop}@c -\userhost\@value{postfix}\localname\ -@end macro - @copying Copyright @copyright{} 1999--2018 Free Software Foundation, Inc. @@ -122,8 +112,11 @@ For the developer: --- The Detailed Node Listing --- @c @ifset installchapter + Installing @value{tramp} with your Emacs +* System Requirements:: Prerequisites for :@value{tramp} installation. +* Basic Installation:: Installation steps.: * Installation parameters:: Parameters in order to control installation. * Testing:: A test suite for @value{tramp}. * Load paths:: How to plug-in @value{tramp} into your environment. @@ -4107,7 +4100,7 @@ Unloading @value{tramp} resets Ange FTP plugins also. @c For the developer @node Files directories and localnames -@chapter How file names, directories and localnames are mangled and managed. +@chapter How file names, directories and localnames are mangled and managed @menu * Localname deconstruction:: Splitting a localname into its component parts. diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index 807330bb9b..3a3ada9e84 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -44,3 +44,13 @@ @set ipv6prefix @set ipv6postfix @end ifset + +@c Macro for formatting a file name according to the respective +@c syntax. Macro arguments should not have any leading or trailing +@c whitespace. Not very elegant, but I don't know it better. + +@macro trampfn {method, userhost, localname} +@value{prefix}@c +\method\@value{postfixhop}@c +\userhost\@value{postfix}\localname\ +@end macro commit dfbb207ff946792efebb31c0c59b8245c304544a Author: Charles A. Roelli Date: Mon Oct 1 21:41:11 2018 +0200 * lisp/vc/vc.el (vc-checkin): Simplify 'run-hook' call. diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index d3d66d6fb5..6962664d59 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1536,8 +1536,7 @@ The optional argument REV may be a string specifying the new revision level (only supported for some older VCSes, like RCS and CVS). Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." - (when vc-before-checkin-hook - (run-hooks 'vc-before-checkin-hook)) + (run-hooks 'vc-before-checkin-hook) (vc-start-logentry files comment initial-contents "Enter a change comment." commit c45789a595cc09457d54c4c878e8aae84f79d59d Author: Michael Albinus Date: Mon Oct 1 14:34:35 2018 +0200 Use `float-time' in tramp-sh.el where needed * lisp/net/tramp-sh.el (tramp-sh-handle-verify-visited-file-modtime): Use `float-time'. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index b2be43395f..956fe2ddb7 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1449,7 +1449,7 @@ of." ;; recorded last modification time, or there is no established ;; connection. (if (or (not f) - (zerop (visited-file-modtime)) + (zerop (float-time (visited-file-modtime))) (not (file-remote-p f nil 'connected))) t (with-parsed-tramp-file-name f nil commit 886a1f26413b3eec427155163a2f3ceb163efce8 Author: Michael Albinus Date: Mon Oct 1 14:33:51 2018 +0200 Minor edits in tramp.texi * doc/misc/tramp.texi (Password handling): Say "user option". (Remote shell setup): Say "environment variable". (External packages): Add `non-essential' to variable index. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 88fa55fdee..530e8dc1b4 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -1646,7 +1646,7 @@ the need. The package @file{auth-source.el}, originally developed for No Gnus, reads passwords from different sources, @xref{Help for users, , auth-source, auth}. The default authentication file is -@file{~/.authinfo.gpg}, but this can be changed via the variable +@file{~/.authinfo.gpg}, but this can be changed via the user option @code{auth-sources}. @noindent @@ -1670,7 +1670,7 @@ If there doesn't exist a proper entry, the password is read interactively. After successful login (verification of the password), it is offered to save a corresponding entry for further use by @code{auth-source} backends which support this. This could be changed -by setting the variable @code{auth-source-save-behavior} to @code{nil}. +by setting the user option @code{auth-source-save-behavior} to @code{nil}. @vindex auth-source-debug Set @code{auth-source-debug} to @code{t} to debug messages. @@ -2031,10 +2031,10 @@ shell-specific config files. For example, bash can use parsing. This redefinition affects the looks of a prompt in an interactive remote shell through commands, such as @kbd{M-x shell @key{RET}}. Such prompts, however, can be reset to something more -readable and recognizable using these @value{tramp} variables. +readable and recognizable using these environment variables. -@value{tramp} sets the @env{INSIDE_EMACS} variable in the startup -script file @file{~/.emacs_SHELLNAME}. +@value{tramp} sets the @env{INSIDE_EMACS} environment variable in the +startup script file @file{~/.emacs_SHELLNAME}. @env{SHELLNAME} is @code{bash} or equivalent shell names. Change it by setting the environment variable @env{ESHELL} in the @file{.emacs} as @@ -3671,7 +3671,7 @@ Due to the remote shell saving tilde expansions triggered by @value{tramp} can suppress this behavior with the user option @code{tramp-histfile-override}. When set to @code{t}, environment variable @env{HISTFILE} is unset, and environment variables -@env{HISTFILESIZE} @env{HISTSIZE} are set to 0. +@env{HISTFILESIZE} and @env{HISTSIZE} are set to 0. Alternatively, @code{tramp-histfile-override} could be a string. Environment variable @env{HISTFILE} is set to this file name then. Be @@ -4133,6 +4133,7 @@ handlers. @section Integrating with external Lisp packages @subsection File name completion. +@vindex non-essential Sometimes, it is not convenient to open a new connection to a remote host, including entering the password and alike. For example, this is nasty for packages providing file name completion. Such a package commit 508c40ef1dd625b9c9a58c863995ed241f4a5184 Author: Michael Albinus Date: Mon Oct 1 14:17:27 2018 +0200 Comple fix for Bug#32550 * lisp/net/tramp.el (tramp-rfn-eshadow-update-overlay): Use `save-excursion'. This completes the fix of Bug#32550. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 452e70ec35..98ec8415c7 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1941,21 +1941,20 @@ been set up by `rfn-eshadow-setup-minibuffer'." (minibuffer-prompt-end))) ;; We do not want to send any remote command. (non-essential t)) - (when - (tramp-tramp-file-p - (buffer-substring-no-properties end (point-max))) - (save-restriction - (narrow-to-region - (1+ (or (string-match - (tramp-rfn-eshadow-update-overlay-regexp) - (buffer-string) end) - end)) - (point-max)) - (let ((rfn-eshadow-overlay tramp-rfn-eshadow-overlay) - (rfn-eshadow-update-overlay-hook nil) - file-name-handler-alist) - (move-overlay rfn-eshadow-overlay (point-max) (point-max)) - (rfn-eshadow-update-overlay))))))) + (when (tramp-tramp-file-p (buffer-substring end (point-max))) + (save-excursion + (save-restriction + (narrow-to-region + (1+ (or (string-match + (tramp-rfn-eshadow-update-overlay-regexp) + (buffer-string) end) + end)) + (point-max)) + (let ((rfn-eshadow-overlay tramp-rfn-eshadow-overlay) + (rfn-eshadow-update-overlay-hook nil) + file-name-handler-alist) + (move-overlay rfn-eshadow-overlay (point-max) (point-max)) + (rfn-eshadow-update-overlay)))))))) (add-hook 'rfn-eshadow-update-overlay-hook 'tramp-rfn-eshadow-update-overlay) commit 0915462e46157f25022bb6f0f433e40c2e8461be Author: Glenn Morris Date: Mon Oct 1 07:23:39 2018 -0400 ; Auto-commit of loaddefs files. diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index bdf4c31529..5ff089812b 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -6626,7 +6626,7 @@ buffers accepted by the function pointed out by variable `dabbrev-friend-buffer-function', if `dabbrev-check-other-buffers' says so. Then, if `dabbrev-check-all-buffers' is non-nil, look in all the other buffers, subject to constraints specified -by `dabbrev-ignored-buffer-names' and `dabbrev-ignored-regexps'. +by `dabbrev-ignored-buffer-names' and `dabbrev-ignored-buffer-regexps'. A positive prefix argument, N, says to take the Nth backward *distinct* possibility. A negative argument says search forward. @@ -11451,7 +11451,9 @@ See documentation of variable `tags-file-name'. (defalias 'pop-tag-mark 'xref-pop-marker-stack) -(autoload 'next-file "etags" "\ +(defalias 'next-file 'tags-next-file) + +(autoload 'tags-next-file "etags" "\ Select next file among files in current tags table. A first argument of t (prefix arg, if interactive) initializes to the @@ -11471,40 +11473,32 @@ Continue last \\[tags-search] or \\[tags-query-replace] command. Used noninteractively with non-nil argument to begin such a command (the argument is passed to `next-file', which see). -Two variables control the processing we do on each file: the value of -`tags-loop-scan' is a form to be executed on each file to see if it is -interesting (it returns non-nil if so) and `tags-loop-operate' is a form to -evaluate to operate on an interesting file. If the latter evaluates to -nil, we exit; otherwise we scan the next file. - \(fn &optional FIRST-TIME)" t nil) +(make-obsolete 'tags-loop-continue 'multifile-continue '"27.1") + (autoload 'tags-search "etags" "\ Search through all files listed in tags table for match for REGEXP. Stops when a match is found. To continue searching for next match, use command \\[tags-loop-continue]. -If FILE-LIST-FORM is non-nil, it should be a form that, when -evaluated, will return a list of file names. The search will be -restricted to these files. +If FILES if non-nil should be a list or an iterator returning the files to search. +The search will be restricted to these files. Also see the documentation of the `tags-file-name' variable. -\(fn REGEXP &optional FILE-LIST-FORM)" t nil) +\(fn REGEXP &optional FILES)" t nil) (autoload 'tags-query-replace "etags" "\ Do `query-replace-regexp' of FROM with TO on all files listed in tags table. Third arg DELIMITED (prefix arg) means replace only word-delimited matches. If you exit (\\[keyboard-quit], RET or q), you can resume the query replace with the command \\[tags-loop-continue]. -Fourth arg FILE-LIST-FORM non-nil means initialize the replacement loop. - -If FILE-LIST-FORM is non-nil, it is a form to evaluate to -produce the list of files to search. +For non-interactive use, superceded by `multifile-initialize-replace'. -See also the documentation of the variable `tags-file-name'. +\(fn FROM TO &optional DELIMITED FILES)" t nil) -\(fn FROM TO &optional DELIMITED FILE-LIST-FORM)" t nil) +(set-advertised-calling-convention 'tags-query-replace '(from to &optional delimited) '"27.1") (autoload 'list-tags "etags" "\ Display list of tags in file FILE. @@ -11541,7 +11535,7 @@ for \\[find-tag] (which see). \(fn)" nil nil) -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "etags" '("default-tags-table-function" "etags-" "file-of-tag" "find-tag-" "goto-tag-location-function" "initialize-new-tags-table" "last-tag" "list-tags-function" "next-file-list" "select-tags-table-" "snarf-tag-function" "tag" "verify-tags-table-function" "xref-"))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "etags" '("default-tags-table-function" "etags-" "file-of-tag" "find-tag-" "goto-tag-location-function" "initialize-new-tags-table" "last-tag" "list-tags-function" "select-tags-table-" "snarf-tag-function" "tag" "verify-tags-table-function" "xref-"))) ;;;*** @@ -12631,7 +12625,7 @@ Execute BODY, and unwind connection-local variables. (function-put 'with-connection-local-profiles 'lisp-indent-function '1) -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "files-x" '("connection-local-" "hack-connection-local-variables" "modify-" "read-file-local-variable"))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "files-x" '("connection-local-" "dir-locals-to-string" "hack-connection-local-variables" "modify-" "read-file-local-variable"))) ;;;*** @@ -16909,6 +16903,9 @@ Define a filter named NAME. DOCUMENTATION is the documentation of the function. READER is a form which should read a qualifier from the user. DESCRIPTION is a short string describing the filter. +ACCEPT-LIST is a boolean; if non-nil, the filter accepts either +a single condition or a list of them; in the latter +case the filter is the `or' composition of the conditions. BODY should contain forms which will be evaluated to test whether or not a particular buffer should be displayed or not. The forms in BODY @@ -17152,7 +17149,7 @@ See also the variable `idlwave-shell-prompt-pattern'. \(Type \\[describe-mode] in the shell buffer for a list of commands.) -\(fn &optional ARG QUICK)" t nil) +\(fn &optional ARG)" t nil) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "idlw-shell" '("idlwave-"))) @@ -22269,6 +22266,41 @@ QUALITY can be: ;;;*** +;;;### (autoloads nil "multifile" "multifile.el" (0 0 0 0)) +;;; Generated autoloads from multifile.el + +(autoload 'multifile-initialize "multifile" "\ +Initialize a new round of operation on several files. +FILES can be either a list of file names, or an iterator (used with `iter-next') +which returns a file name at each step. +SCAN-FUNCTION is a function called with no argument inside a buffer +and it should return non-nil if that buffer has something on which to operate. +OPERATE-FUNCTION is a function called with no argument; it is expected +to perform the operation on the current file buffer and when done +should return non-nil to mean that we should immediately continue +operating on the next file and nil otherwise. + +\(fn FILES SCAN-FUNCTION OPERATE-FUNCTION)" nil nil) + +(autoload 'multifile-initialize-search "multifile" "\ + + +\(fn REGEXP FILES CASE-FOLD)" nil nil) + +(autoload 'multifile-initialize-replace "multifile" "\ +Initialize a new round of query&replace on several files. +FROM is a regexp and TO is the replacement to use. +FILES describes the file, as in `multifile-initialize'. +CASE-FOLD can be t, nil, or `default', the latter one meaning to obey +the default setting of `case-fold-search'. +DELIMITED if non-nil means replace only word-delimited matches. + +\(fn FROM TO FILES CASE-FOLD &optional DELIMITED)" nil nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "multifile" '("multifile-"))) + +;;;*** + ;;;### (autoloads nil "mwheel" "mwheel.el" (0 0 0 0)) ;;; Generated autoloads from mwheel.el @@ -24850,7 +24882,8 @@ STRING should be on something resembling an RFC2822 string, a la somewhat liberal in what format it accepts, and will attempt to return a \"likely\" value even for somewhat malformed strings. The values returned are identical to those of `decode-time', but -any values that are unknown are returned as nil. +any unknown values other than DST are returned as nil, and an +unknown DST value is returned as -1. \(fn STRING)" nil nil) @@ -26354,6 +26387,20 @@ recognized. \(fn)" t nil) +(autoload 'project-search "project" "\ +Search for REGEXP in all the files of the project. +Stops when a match is found. +To continue searching for next match, use command \\[multifile-continue]. + +\(fn REGEXP)" t nil) + +(autoload 'project-query-replace "project" "\ +Search for REGEXP in all the files of the project. +Stops when a match is found. +To continue searching for next match, use command \\[multifile-continue]. + +\(fn FROM TO)" t nil) + (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "project" '("project-"))) ;;;*** @@ -33791,15 +33838,17 @@ Return the number at point, or nil if none is found. (autoload 'list-at-point "thingatpt" "\ Return the Lisp list at point, or nil if none is found. +If IGNORE-COMMENT-OR-STRING is non-nil comments and strings are +treated as white space. -\(fn)" nil nil) +\(fn &optional IGNORE-COMMENT-OR-STRING)" nil nil) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "thingatpt" '("beginning-of-thing" "define-thing-chars" "end-of-thing" "filename" "form-at-point" "in-string-p" "sentence-at-point" "thing-at-point-" "word-at-point"))) ;;;*** -;;;### (autoloads nil "thread" "emacs-lisp/thread.el" (0 0 0 0)) -;;; Generated autoloads from emacs-lisp/thread.el +;;;### (autoloads nil "thread" "thread.el" (0 0 0 0)) +;;; Generated autoloads from thread.el (autoload 'thread-handle-event "thread" "\ Handle thread events, propagated by `thread-signal'. @@ -33808,6 +33857,14 @@ An EVENT has the format \(fn EVENT)" t nil) +(autoload 'list-threads "thread" "\ +Display a list of threads. + +\(fn)" t nil) + (put 'list-threads 'disabled "Beware: manually canceling threads can ruin your Emacs session.") + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "thread" '("thread-list-"))) + ;;;*** ;;;### (autoloads nil "thumbs" "thumbs.el" (0 0 0 0)) commit 35b56a24a09792a0e966f861aa01c07ed1826a82 Author: Glenn Morris Date: Mon Oct 1 06:23:16 2018 -0400 ; Auto-commit of loaddefs files. diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 2ff94d333b..a9ea74102d 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -28927,13 +28927,30 @@ or call the function `savehist-mode'.") (autoload 'savehist-mode "savehist" "\ Toggle saving of minibuffer history (Savehist mode). With a prefix argument ARG, enable Savehist mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. +positive, and disable it otherwise. If called from Lisp, +also enable the mode if ARG is omitted or nil. When Savehist mode is enabled, minibuffer history is saved -periodically and when exiting Emacs. When Savehist mode is -enabled for the first time in an Emacs session, it loads the -previous minibuffer history from `savehist-file'. +to `savehist-file' periodically and when exiting Emacs. When +Savehist mode is enabled for the first time in an Emacs session, +it loads the previous minibuffer histories from `savehist-file'. +The variable `savehist-autosave-interval' controls the +periodicity of saving minibuffer histories. + +If `savehist-save-minibuffer-history' is non-nil (the default), +all recorded minibuffer histories will be saved. You can arrange +for additional history variables to be saved and restored by +customizing `savehist-additional-variables', which by default is +an empty list. For example, to save the history of commands +invoked via \\[execute-extended-command], add `command-history' to the list in +`savehist-additional-variables'. + +Alternatively, you could customize `savehist-save-minibuffer-history' +to nil, and add to `savehist-additional-variables' only those +history variables you want to save. + +To ignore some history variables, add their symbols to the list +in `savehist-ignored-variables'. This mode should normally be turned on from your Emacs init file. Calling it at any other time replaces your current minibuffer @@ -33666,8 +33683,10 @@ Return the number at point, or nil if none is found. (autoload 'list-at-point "thingatpt" "\ Return the Lisp list at point, or nil if none is found. +If IGNORE-COMMENT-OR-STRING is non-nil comments and strings are +treated as white space. -\(fn)" nil nil) +\(fn &optional IGNORE-COMMENT-OR-STRING)" nil nil) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "thingatpt" '("form-at-point" "thing-at-point-" "sentence-at-point" "word-at-point" "in-string-p" "end-of-thing" "beginning-of-thing"))) commit 9c028d6965c7bb3024ada4f59be133b940438127 Author: Eli Zaretskii Date: Mon Oct 1 10:45:33 2018 +0300 * lisp/savehist.el (savehist-mode): Doc fix. (Bug#32889) diff --git a/lisp/savehist.el b/lisp/savehist.el index fbb5f53390..893590ce80 100644 --- a/lisp/savehist.el +++ b/lisp/savehist.el @@ -172,13 +172,30 @@ minibuffer history.") (define-minor-mode savehist-mode "Toggle saving of minibuffer history (Savehist mode). With a prefix argument ARG, enable Savehist mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. +positive, and disable it otherwise. If called from Lisp, +also enable the mode if ARG is omitted or nil. When Savehist mode is enabled, minibuffer history is saved -periodically and when exiting Emacs. When Savehist mode is -enabled for the first time in an Emacs session, it loads the -previous minibuffer history from `savehist-file'. +to `savehist-file' periodically and when exiting Emacs. When +Savehist mode is enabled for the first time in an Emacs session, +it loads the previous minibuffer histories from `savehist-file'. +The variable `savehist-autosave-interval' controls the +periodicity of saving minibuffer histories. + +If `savehist-save-minibuffer-history' is non-nil (the default), +all recorded minibuffer histories will be saved. You can arrange +for additional history variables to be saved and restored by +customizing `savehist-additional-variables', which by default is +an empty list. For example, to save the history of commands +invoked via \\[execute-extended-command], add `command-history' to the list in +`savehist-additional-variables'. + +Alternatively, you could customize `savehist-save-minibuffer-history' +to nil, and add to `savehist-additional-variables' only those +history variables you want to save. + +To ignore some history variables, add their symbols to the list +in `savehist-ignored-variables'. This mode should normally be turned on from your Emacs init file. Calling it at any other time replaces your current minibuffer commit 3a2b5a713f92ffba3bdb52725e98030ad5b43a67 Author: Eli Zaretskii Date: Mon Oct 1 10:19:27 2018 +0300 ; * lisp/bindings.el (bindings--define-key): Doc fix. (Bug#32885) diff --git a/lisp/bindings.el b/lisp/bindings.el index 3e202b9b78..a1af4389be 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -265,7 +265,10 @@ Normally nil in most modes, since there is no process to display.") (make-variable-buffer-local 'mode-line-process) (defun bindings--define-key (map key item) - "Make as much as possible of the menus pure." + "Define KEY in keymap MAP according to ITEM from a menu. +This is like `define-key', but it takes the definition from the +specified menu item, and makes pure copies of as much as possible +of the menu's data." (declare (indent 2)) (define-key map key (cond commit 87d0007499d8434f40926c99f1edc3c4a700a79d Author: Michael R. Mauger Date: Mon Oct 1 00:12:51 2018 -0400 Automate support for `sql-indent' ELPA package * progmodes/lisp/sql.el (sql-use-indent-support): New variable. (sql-is-indent-available): New function. (sql-indent-enable): Use above. (sql-mode-hook, sql-interactive-mode-hook): Add `sql-indent-enable'. diff --git a/etc/NEWS b/etc/NEWS index a54abd7a63..daacf49e62 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -365,6 +365,29 @@ better emulate 'M-.' in both Bash and zsh, since the former counts from the beginning of the arguments, while the latter counts from the end. +** SQL + +*** Installation of 'sql-indent' from ELPA is strongly encouraged. +This package support sophisticated rules for properly indenting SQL +statements. SQL is not like other programming languages like C, Java, +or Python where code is sparse and rules for formatting are fairly +well established. Instead SQL is more like COBOL (from which it came) +and code tends to be very dense and line ending decisions driven by +syntax and line length considerations to make readable code. +Experienced SQL developers may prefer to rely upon existing Emacs +facilities for formatting code but the 'sql-indent' package provides +facilities to aid more casual SQL developers layout queries and +complex expressions. + +*** 'sql-use-indent-support' (default t) enables SQL indention support. +The `sql-indent' package from ELPA must be installed to get the +indentation support in 'sql-mode' and 'sql-interactive-mode'. + +*** 'sql-mode-hook' and 'sql-interactive-mode-hook' changed. +Both hook variables have had 'sql-indent-enable' added to their +default values. If youhave existing customizations to these variables, +you should make sure that the new default entry is included. + ** Term --- diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index ba180c2b26..1cdae35ac3 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -213,7 +213,7 @@ ;; Drew Adams -- Emacs 20 support ;; Harald Maier -- sql-send-string ;; Stefan Monnier -- font-lock corrections; -;; code polish +;; code polish; on-going guidance and mentorship ;; Paul Sleigh -- MySQL keyword enhancement ;; Andrew Schein -- sql-port bug ;; Ian Bjorhovde -- db2 escape newlines @@ -222,6 +222,7 @@ ;; Mark Wilkinson -- file-local variables ignored ;; Simen Heggestøyl -- Postgres database completion ;; Robert Cochran -- MariaDB support +;; Alex Harsanyi -- sql-indent package and support ;; @@ -723,6 +724,30 @@ This allows highlighting buffers properly when you open them." :group 'SQL :safe 'symbolp) +;; SQL indent support + +(defcustom sql-use-indent-support t + "If non-nil then use the SQL indent support features of sql-indent. +The `sql-indent' package in ELPA provides indentation support for +SQL statements with easy customizations to support varied layout +requirements. + +The package must be available to be loaded and activated." + :group 'SQL + :link '(url-link "https://elpa.gnu.org/packages/sql-indent.html") + :type 'booleanp + :version "27.1") + +(defun sql-is-indent-available () + "Check if sql-indent module is available." + (when (locate-library "sql-indent") + (fboundp 'sqlind-minor-mode))) + +(defun sql-indent-enable () + "Enable `sqlind-minor-mode' if available and requested." + (when (sql-is-indent-available) + (sqlind-minor-mode (if sql-use-indent-support +1 -1)))) + ;; misc customization of sql.el behavior (defcustom sql-electric-stuff nil @@ -850,15 +875,17 @@ commands when the input history is read, as if you had set ;; The usual hooks -(defcustom sql-interactive-mode-hook '() +(defcustom sql-interactive-mode-hook '(sql-indent-enable) "Hook for customizing `sql-interactive-mode'." :type 'hook - :group 'SQL) + :group 'SQL + :version "27.1") -(defcustom sql-mode-hook '() +(defcustom sql-mode-hook '(sql-indent-enable) "Hook for customizing `sql-mode'." :type 'hook - :group 'SQL) + :group 'SQL + :version "27.1") (defcustom sql-set-sqli-hook '() "Hook for reacting to changes of `sql-buffer'. commit d2111c5f72ccae7c3b31b476cce2a0bf458bc38d Author: Charles A. Roelli Date: Sun Sep 30 17:05:29 2018 +0200 * doc/emacs/help.texi (Misc Help): Document 'info-other-window'. diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index 94d27a276d..66673eb233 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi @@ -523,13 +523,17 @@ currently in use. @xref{Coding Systems}. @section Other Help Commands @kindex C-h i +@kindex C-h 4 i @findex info +@findex info-other-window @cindex Info @cindex manuals, included @kbd{C-h i} (@code{info}) runs the Info program, which browses -structured documentation files. The entire Emacs manual is available -within Info, along with many other manuals for the GNU system. Type -@kbd{h} after entering Info to run a tutorial on using Info. +structured documentation files. @kbd{C-h 4 i} +(@code{info-other-window}) does the same, but shows the Info buffer in +another window. The entire Emacs manual is available within Info, +along with many other manuals for the GNU system. Type @kbd{h} after +entering Info to run a tutorial on using Info. @cindex find Info manual by its file name With a numeric argument @var{n}, @kbd{C-h i} selects the Info buffer commit 65e6824efb760dc151884b0e211524d714f2d798 Author: Sam Steingold Date: Sun Sep 30 08:32:29 2018 -0400 Document 2d54710c36: vc-git-stash & *vc-dir* diff --git a/etc/NEWS b/etc/NEWS index 155394ef68..a54abd7a63 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -325,6 +325,10 @@ file. This new variable allows customizing the default arguments passed to git-grep when 'vc-git-grep' is used. +*** Command 'vc-git-stash' now respects marks in the '*vc-dir*' buffer. +When some files are marked, only those are stashed. +When no files are marked, all modified files are stashed, as before. + ** diff-mode *** Hunks are now automatically refined by default. To disable it, set the new defcustom 'diff-font-lock-refine' to nil. commit 6a7a869c33bb69efd93bb0ce8d8322083dbbcbac Author: Nicolas Goaziou Date: Sat Sep 29 16:40:42 2018 +0200 Org manual: Rewrite the Org Mobile section * doc/misc/org.texi (Org Mobile): Rewritten from "MobileOrg" section. Remove all references to non-free software. Moved into "Miscellaneous", much like Org Crypt library. No longer an appendix. (Footnotes): Remove a reference to "MobileOrg". (Bug#32722) diff --git a/doc/misc/org.texi b/doc/misc/org.texi index 60647e65e8..873ce4d2cd 100644 --- a/doc/misc/org.texi +++ b/doc/misc/org.texi @@ -325,7 +325,6 @@ Jambunathan K, Dan Davison, Thomas Dye, David O'Toole, and Philip Rooke. * Working with source code:: Export, evaluate, and tangle code blocks * Miscellaneous:: All the rest which did not fit elsewhere * Hacking:: How to hack your way around -* MobileOrg:: Viewing and capture on a mobile device * History and acknowledgments:: How Org came into being * GNU Free Documentation License:: The license for this documentation. * Main Index:: An index of Org's concepts and features @@ -760,12 +759,19 @@ Miscellaneous * TTY keys:: Using Org on a tty * Interaction:: With other Emacs packages * org-crypt:: Encrypting Org files +* Org Mobile:: Viewing and capture on a mobile device Interaction with other packages * Cooperation:: Packages Org cooperates with * Conflicts:: Packages that lead to conflicts +Org Mobile + +* Setting up the staging area:: For the mobile device +* Pushing to the mobile application:: Uploading Org files and agendas +* Pulling from the mobile application:: Integrating captured and flagged items + Hacking * Hooks:: How to reach into Org's internals @@ -788,12 +794,6 @@ Tables and lists in arbitrary syntax * Translator functions:: Copy and modify * Radio lists:: Sending and receiving lists -MobileOrg - -* Setting up the staging area:: For the mobile device -* Pushing to MobileOrg:: Uploading Org files and agendas -* Pulling from MobileOrg:: Integrating captured and flagged items - @end detailmenu @end menu @@ -17253,6 +17253,7 @@ emacs -Q --batch --eval " * TTY keys:: Using Org on a tty * Interaction:: With other Emacs packages * org-crypt:: Encrypting Org files +* Org Mobile:: Viewing and capture on a mobile device @end menu @@ -18187,6 +18188,150 @@ Suggested Org crypt settings in Emacs init file: Excluding the crypt tag from inheritance prevents encrypting previously encrypted text. +@node Org Mobile +@section Org Mobile + +@cindex smartphone + +Org Mobile is a protocol for synchronizing Org files between Emacs and +other applications, e.g., on mobile devices. It enables offline-views +and capture support for an Org mode system that is rooted on a ``real'' +computer. The external application can also record changes to +existing entries. + +This appendix describes Org's support for agenda view formats +compatible with Org Mobile. It also describes synchronizing changes, +such as to notes, between the mobile application and the computer. + +To change tags and TODO states in the mobile application, first +customize the variables @code{org-todo-keywords} and @code{org-tag-alist}. +These should cover all the important tags and TODO keywords, even if +Org files use only some of them. Though the mobile application is +expected to support in-buffer settings, it is required to understand +TODO states @emph{sets} (see @ref{Per-file keywords}) and +@emph{mutually exclusive} tags (see @ref{Setting tags}) only for those set in +these variables. + +@menu +* Setting up the staging area:: For the mobile device +* Pushing to the mobile application:: Uploading Org files and agendas +* Pulling from the mobile application:: Integrating captured and flagged items +@end menu + +@node Setting up the staging area +@subsection Setting up the staging area + +@vindex org-mobile-directory +The mobile application needs access to a file directory on +a server@footnote{For a server to host files, consider using a WebDAV server, +such as @uref{https://nextcloud.com, Nextcloud}. Additional help is at this @uref{https://orgmode.org/worg/org-faq.html#mobileorg_webdav, FAQ entry}.} to interact with Emacs. Pass its location through +the @code{org-mobile-directory} variable. If you can mount that directory +locally just set the variable to point to that directory: + +@lisp +(setq org-mobile-directory "~/orgmobile/") +@end lisp + +@noindent +Alternatively, by using TRAMP (see @ref{Top,TRAMP User Manual,,tramp,}), +@code{org-mobile-directory} may point to a remote directory accessible +through, for example, SSH and SCP: + +@lisp +(setq org-mobile-directory "/scpc:user@@remote.host:org/webdav/") +@end lisp + +@vindex org-mobile-encryption +With a public server, consider encrypting the files. Org also +requires OpenSSL installed on the local computer. To turn on +encryption, set the same password in the mobile application and in +Emacs. Set the password in the variable +@code{org-mobile-use-encryption}@footnote{If Emacs is configured for safe storing of passwords, then +configure the variable @code{org-mobile-encryption-password}; please read +the docstring of that variable.}. Note that even after the mobile +application encrypts the file contents, the file name remains visible +on the file systems of the local computer, the server, and the mobile +device. + +@node Pushing to the mobile application +@subsection Pushing to the mobile application + +@findex org-mobile-push +@vindex org-mobile-files +The command @code{org-mobile-push} copies files listed in +@code{org-mobile-files} into the staging area. Files include agenda files +(as listed in @code{org-agenda-files}). Customize @code{org-mobile-files} to +add other files. File names are staged with paths relative to +@code{org-directory}, so all files should be inside this directory@footnote{Symbolic links in @code{org-directory} need to have the same name +as their targets.}. + +Push creates a special Org file @samp{agendas.org} with custom agenda views +defined by the user@footnote{While creating the agendas, Org mode forces ID properties on +all referenced entries, so that these entries can be uniquely +identified if Org Mobile flags them for further action. To avoid +setting properties configure the variable +@code{org-mobile-force-id-on-agenda-items} to @code{nil}. Org mode then relies +on outline paths, assuming they are unique.}. + +Finally, Org writes the file @samp{index.org}, containing links to other +files. The mobile application reads this file first from the server +to determine what other files to download for agendas. For faster +downloads, it is expected to only read files whose checksums@footnote{Checksums are stored automatically in the file +@samp{checksums.dat}.} +have changed. + +@node Pulling from the mobile application +@subsection Pulling from the mobile application + +@findex org-mobile-pull +The command @code{org-mobile-pull} synchronizes changes with the server. +More specifically, it first pulls the Org files for viewing. It then +appends captured entries and pointers to flagged or changed entries to +the file @samp{mobileorg.org} on the server. Org ultimately integrates its +data in an inbox file format, through the following steps: + +@enumerate +@item +@vindex org-mobile-inbox-for-pull +Org moves all entries found in @samp{mobileorg.org}@footnote{The file will be empty after this operation.} and appends +them to the file pointed to by the variable +@code{org-mobile-inbox-for-pull}. It should reside neither in the +staging area nor on the server. Each captured entry and each +editing event is a top-level entry in the inbox file. + +@item +@cindex @samp{FLAGGED}, tag +After moving the entries, Org processes changes to the shared +files. Some of them are applied directly and without user +interaction. Examples include changes to tags, TODO state, +headline and body text. Entries requiring further action are +tagged as @samp{FLAGGED}. Org marks entries with problems with an error +message in the inbox. They have to be resolved manually. + +@item +Org generates an agenda view for flagged entries for user +intervention to clean up. For notes stored in flagged entries, Org +displays them in the echo area when point is on the corresponding +agenda item. + +@table @asis +@item @kbd{?} +Pressing @kbd{?} displays the entire flagged note in +another window. Org also pushes it to the kill ring. To +store flagged note as a normal note, use @kbd{? z C-y C-c C-c}. Pressing @kbd{?} twice does these things: first +it removes the @samp{FLAGGED} tag; second, it removes the flagged +note from the property drawer; third, it signals that manual +editing of the flagged entry is now finished. +@end table +@end enumerate + +@kindex ? @r{(Agenda dispatcher)} +From the agenda dispatcher, @kbd{?} returns to the view to finish +processing flagged entries. Note that these entries may not be the +most recent since the mobile application searches files that were last +pulled. To get an updated agenda view with changes since the last +pull, pull again. + @node Hacking @appendix Hacking @cindex hacking @@ -19151,140 +19296,6 @@ The following example counts the number of entries with TODO keyword (length (org-map-entries t "/+WAITING" 'agenda)) @end lisp -@node MobileOrg -@appendix MobileOrg -@cindex iPhone -@cindex MobileOrg - -MobileOrg is a companion mobile app that runs on iOS and Android devices. -MobileOrg enables offline-views and capture support for an Org mode system -that is rooted on a ``real'' computer. MobileOrg can record changes to -existing entries. - -The @uref{https://github.com/MobileOrg/, iOS implementation} for the -@emph{iPhone/iPod Touch/iPad} series of devices, was started by Richard -Moreland and is now in the hands Sean Escriva. Android users should check -out @uref{http://wiki.github.com/matburt/mobileorg-android/, MobileOrg -Android} by Matt Jones. Though the two implementations are not identical, -they offer similar features. - -This appendix describes Org's support for agenda view formats compatible with -MobileOrg. It also describes synchronizing changes, such as to notes, -between MobileOrg and the computer. - -To change tags and TODO states in MobileOrg, first customize the variables -@code{org-todo-keywords} and @code{org-tag-alist}. These should cover all -the important tags and TODO keywords, even if Org files use only some of -them. Though MobileOrg has in-buffer settings, it understands TODO states -@emph{sets} (@pxref{Per-file keywords}) and @emph{mutually exclusive} tags -(@pxref{Setting tags}) only for those set in these variables. - -@menu -* Setting up the staging area:: For the mobile device -* Pushing to MobileOrg:: Uploading Org files and agendas -* Pulling from MobileOrg:: Integrating captured and flagged items -@end menu - -@node Setting up the staging area -@section Setting up the staging area - -MobileOrg needs access to a file directory on a server to interact with -Emacs. With a public server, consider encrypting the files. MobileOrg -version 1.5 supports encryption for the iPhone. Org also requires -@file{openssl} installed on the local computer. To turn on encryption, set -the same password in MobileOrg and in Emacs. Set the password in the -variable @code{org-mobile-use-encryption}@footnote{If Emacs is configured for -safe storing of passwords, then configure the variable, -@code{org-mobile-encryption-password}; please read the docstring of that -variable.}. Note that even after MobileOrg encrypts the file contents, the -file names will remain visible on the file systems of the local computer, the -server, and the mobile device. - -For a server to host files, consider options like -@uref{http://dropbox.com,Dropbox.com} account@footnote{An alternative is to -use webdav server. MobileOrg documentation has details of webdav server -configuration. Additional help is at -@uref{https://orgmode.org/worg/org-faq.html#mobileorg_webdav, FAQ entry}.}. -On first connection, MobileOrg creates a directory @file{MobileOrg/} on -Dropbox. Pass its location to Emacs through an init file variable as -follows: - -@lisp -(setq org-mobile-directory "~/Dropbox/MobileOrg") -@end lisp - -Org copies files to the above directory for MobileOrg. Org also uses the -same directory for sharing notes between Org and MobileOrg. - -@node Pushing to MobileOrg -@section Pushing to MobileOrg - -Org pushes files listed in @code{org-mobile-files} to -@code{org-mobile-directory}. Files include agenda files (as listed in -@code{org-agenda-files}). Customize @code{org-mobile-files} to add other -files. File names will be staged with paths relative to -@code{org-directory}, so all files should be inside this -directory@footnote{Symbolic links in @code{org-directory} should have the -same name as their targets.}. - -Push creates a special Org file @file{agendas.org} with custom agenda views -defined by the user@footnote{While creating the agendas, Org mode will force -ID properties on all referenced entries, so that these entries can be -uniquely identified if MobileOrg flags them for further action. To avoid -setting properties configure the variable -@code{org-mobile-force-id-on-agenda-items} to @code{nil}. Org mode will then -rely on outline paths, assuming they are unique.}. - -Org writes the file @file{index.org}, containing links to other files. -MobileOrg reads this file first from the server to determine what other files -to download for agendas. For faster downloads, MobileOrg will read only -those files whose checksums@footnote{Checksums are stored automatically in -the file @file{checksums.dat}.} have changed. - -@node Pulling from MobileOrg -@section Pulling from MobileOrg - -When MobileOrg synchronizes with the server, it pulls the Org files for -viewing. It then appends to the file @file{mobileorg.org} on the server the -captured entries, pointers to flagged and changed entries. Org integrates -its data in an inbox file format. - -@enumerate -@item -Org moves all entries found in -@file{mobileorg.org}@footnote{@file{mobileorg.org} will be empty after this -operation.} and appends them to the file pointed to by the variable -@code{org-mobile-inbox-for-pull}. Each captured entry and each editing event -is a top-level entry in the inbox file. -@item -After moving the entries, Org attempts changes to MobileOrg. Some changes -are applied directly and without user interaction. Examples include changes -to tags, TODO state, headline and body text. Entries for further action are -tagged as @code{:FLAGGED:}. Org marks entries with problems with an error -message in the inbox. They have to be resolved manually. -@item -Org generates an agenda view for flagged entries for user intervention to -clean up. For notes stored in flagged entries, MobileOrg displays them in -the echo area when the cursor is on the corresponding agenda item. - -@table @kbd -@kindex ? -@item ? -Pressing @kbd{?} displays the entire flagged note in another window. Org -also pushes it to the kill ring. To store flagged note as a normal note, use -@kbd{? z C-y C-c C-c}. Pressing @kbd{?} twice does these things: first it -removes the @code{:FLAGGED:} tag; second, it removes the flagged note from -the property drawer; third, it signals that manual editing of the flagged -entry is now finished. -@end table -@end enumerate - -@kindex C-c a ? -@kbd{C-c a ?} returns to the agenda view to finish processing flagged -entries. Note that these entries may not be the most recent since MobileOrg -searches files that were last pulled. To get an updated agenda view with -changes since the last pull, pull again. - @node History and acknowledgments @appendix History and acknowledgments @cindex acknowledgments commit 8bd48212020ee206b782477ac32b918861bcaf08 Author: Eli Zaretskii Date: Sun Sep 30 14:14:59 2018 +0300 Allow 'make-cursor-line-fully-visible' name a function * src/xdisp.c (cursor_row_fully_visible_p): Handle the case of make-cursor-line-fully-visible being a function. Accept a 3rd argument; if non-zero, assume the caller already tested the conditions for the cursor being fully-visible, and don't recheck them. All callers changed. (try_cursor_movement, try_window_id): Call cursor_row_fully_visible_p instead of testing the value of make-cursor-line-fully-visible directly. (syms_of_xdisp) : Update the doc string. Define a symbol Qmake_cursor_line_fully_visible. (Bug#32848) * lisp/cus-start.el (standard): Update the Custom form. * etc/NEWS: Mention the change in possible values of 'make-cursor-line-fully-visible'. diff --git a/etc/NEWS b/etc/NEWS index 7e7de165ec..155394ef68 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -220,6 +220,12 @@ This triggers to search the program on the remote host as indicated by When set to t, no message will be shown when auto-saving (default value: nil). +--- +** The value of 'make-cursor-line-fully-visible' can now be a function. +In addition to nil or non-nil, the value can now be a predicate +function. Follow mode uses this to control scrolling of its windows +when the last screen line in a window is not fully visible. + * Editing Changes in Emacs 27.1 diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 88a61753f2..e33fe6e5ec 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -547,7 +547,12 @@ since it could result in memory overflow and make Emacs crash." (const :tag "Respect `truncate-lines'" nil) (other :tag "Truncate if not full-width" t)) "23.1") - (make-cursor-line-fully-visible windows boolean) + (make-cursor-line-fully-visible + windows + (choice + (const :tag "Make cursor always fully visible" t) + (const :tag "Allow cursor to be partially-visible" nil) + (function :tag "User-defined function"))) (mode-line-in-non-selected-windows mode-line boolean "22.1") (line-number-display-limit display (choice integer diff --git a/src/xdisp.c b/src/xdisp.c index 93cd54a324..d61d421f08 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -842,7 +842,7 @@ static Lisp_Object redisplay_window_1 (Lisp_Object); static bool set_cursor_from_row (struct window *, struct glyph_row *, struct glyph_matrix *, ptrdiff_t, ptrdiff_t, int, int); -static bool cursor_row_fully_visible_p (struct window *, bool, bool); +static bool cursor_row_fully_visible_p (struct window *, bool, bool, bool); static bool update_menu_bar (struct frame *, bool, bool); static bool try_window_reusing_current_matrix (struct window *); static int try_window_id (struct window *); @@ -14346,7 +14346,7 @@ redisplay_internal (void) eassert (this_line_vpos == it.vpos); eassert (this_line_y == it.current_y); set_cursor_from_row (w, row, w->current_matrix, 0, 0, 0, 0); - if (cursor_row_fully_visible_p (w, false, true)) + if (cursor_row_fully_visible_p (w, false, true, false)) { #ifdef GLYPH_DEBUG *w->desired_matrix->method = 0; @@ -15628,19 +15628,46 @@ run_window_scroll_functions (Lisp_Object window, struct text_pos startp) window's current glyph matrix; otherwise use the desired glyph matrix. + If JUST_TEST_USER_PREFERENCE_P, just test what the value of + make-cursor-row-fully-visible requires, don't test the actual + cursor position. The assumption is that in that case the caller + performs the necessary testing of the cursor position. + A value of false means the caller should do scrolling as if point had gone off the screen. */ static bool cursor_row_fully_visible_p (struct window *w, bool force_p, - bool current_matrix_p) + bool current_matrix_p, + bool just_test_user_preference_p) { struct glyph_matrix *matrix; struct glyph_row *row; int window_height; + Lisp_Object mclfv_p = + buffer_local_value (Qmake_cursor_line_fully_visible, w->contents); - if (!make_cursor_line_fully_visible_p) + /* If no local binding, use the global value. */ + if (EQ (mclfv_p, Qunbound)) + mclfv_p = Vmake_cursor_line_fully_visible; + /* Follow mode sets the variable to a Lisp function in buffers that + are under Follow mode. */ + if (FUNCTIONP (mclfv_p)) + { + Lisp_Object window; + XSETWINDOW (window, w); + /* Implementation note: if the function we call here signals an + error, we will NOT scroll when the cursor is partially-visible. */ + Lisp_Object val = safe_call1 (mclfv_p, window); + if (NILP (val)) + return true; + else if (just_test_user_preference_p) + return false; + } + else if (NILP (mclfv_p)) return true; + else if (just_test_user_preference_p) + return false; /* It's not always possible to find the cursor, e.g, when a window is full of overlay strings. Don't do anything in that case. */ @@ -16002,7 +16029,7 @@ try_scrolling (Lisp_Object window, bool just_this_one_p, /* If cursor ends up on a partially visible line, treat that as being off the bottom of the screen. */ if (! cursor_row_fully_visible_p (w, extra_scroll_margin_lines <= 1, - false) + false, false) /* It's possible that the cursor is on the first line of the buffer, which is partially obscured due to a vscroll (Bug#7537). In that case, avoid looping forever. */ @@ -16367,7 +16394,7 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, /* Make sure this isn't a header line by any chance, since then MATRIX_ROW_PARTIALLY_VISIBLE_P might yield true. */ && !row->mode_line_p - && make_cursor_line_fully_visible_p) + && !cursor_row_fully_visible_p (w, true, true, true)) { if (PT == MATRIX_ROW_END_CHARPOS (row) && !row->ends_at_zv_p @@ -16385,7 +16412,7 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, else { set_cursor_from_row (w, row, w->current_matrix, 0, 0, 0, 0); - if (!cursor_row_fully_visible_p (w, false, true)) + if (!cursor_row_fully_visible_p (w, false, true, false)) rc = CURSOR_MOVEMENT_MUST_SCROLL; else rc = CURSOR_MOVEMENT_SUCCESS; @@ -16964,7 +16991,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) new_vpos = window_box_height (w) / 2; } - if (!cursor_row_fully_visible_p (w, false, false)) + if (!cursor_row_fully_visible_p (w, false, false, false)) { /* Point does appear, but on a line partly visible at end of window. Move it back to a fully-visible line. */ @@ -17059,7 +17086,8 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) goto need_larger_matrices; } } - if (w->cursor.vpos < 0 || !cursor_row_fully_visible_p (w, false, false)) + if (w->cursor.vpos < 0 + || !cursor_row_fully_visible_p (w, false, false, false)) { clear_glyph_matrix (w->desired_matrix); goto try_to_scroll; @@ -17206,7 +17234,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) /* Forget any recorded base line for line number display. */ w->base_line_number = 0; - if (!cursor_row_fully_visible_p (w, true, false)) + if (!cursor_row_fully_visible_p (w, true, false, false)) { clear_glyph_matrix (w->desired_matrix); last_line_misfit = true; @@ -17502,7 +17530,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) set_cursor_from_row (w, row, matrix, 0, 0, 0, 0); } - if (!cursor_row_fully_visible_p (w, false, false)) + if (!cursor_row_fully_visible_p (w, false, false, false)) { /* If vscroll is enabled, disable it and try again. */ if (w->vscroll) @@ -19068,9 +19096,10 @@ try_window_id (struct window *w) && CHARPOS (start) > BEGV) /* Old redisplay didn't take scroll margin into account at the bottom, but then global-hl-line-mode doesn't scroll. KFS 2004-06-14 */ - || (w->cursor.y + (make_cursor_line_fully_visible_p - ? cursor_height + this_scroll_margin - : 1)) > it.last_visible_y) + || (w->cursor.y + + (cursor_row_fully_visible_p (w, false, true, true) + ? 1 + : cursor_height + this_scroll_margin)) > it.last_visible_y) { w->cursor.vpos = -1; clear_glyph_matrix (w->desired_matrix); @@ -32903,9 +32932,15 @@ automatically; to decrease the tool-bar height, use \\[recenter]. */); doc: /* Non-nil means raise tool-bar buttons when the mouse moves over them. */); auto_raise_tool_bar_buttons_p = true; - DEFVAR_BOOL ("make-cursor-line-fully-visible", make_cursor_line_fully_visible_p, - doc: /* Non-nil means to scroll (recenter) cursor line if it is not fully visible. */); - make_cursor_line_fully_visible_p = true; + DEFVAR_LISP ("make-cursor-line-fully-visible", Vmake_cursor_line_fully_visible, + doc: /* Whether to scroll the window if the cursor line is not fully visible. +If the value is non-nil, Emacs scrolls or recenters the window to make +the cursor line fully visible. The value could also be a function, which +is called with a single argument, the window to be scrolled, and should +return non-nil if the partially-visible cursor requires scrolling the +window, nil if it's okay to leave the cursor partially-visible. */); + Vmake_cursor_line_fully_visible = Qt; + DEFSYM (Qmake_cursor_line_fully_visible, "make-cursor-line-fully-visible"); DEFVAR_LISP ("tool-bar-border", Vtool_bar_border, doc: /* Border below tool-bar in pixels. commit 6650751ce73413d05599df07a9c5bc70744260f3 Author: Alan Mackenzie Date: Sun Sep 30 10:46:26 2018 +0000 Temporary workaround for bug #32848 for branch emacs-26 Do not merge with master. * lisp/follow.el (follow-mode): Set make-cursor-line-fully-visible to nil buffer locally whilst follow-mode is active. diff --git a/lisp/follow.el b/lisp/follow.el index fd397c077b..7942901bb4 100644 --- a/lisp/follow.el +++ b/lisp/follow.el @@ -438,7 +438,10 @@ Keys specific to Follow mode: (setq pos-visible-in-window-group-p-function 'follow-pos-visible-in-window-p) (setq selected-window-group-function 'follow-all-followers) - (setq move-to-window-group-line-function 'follow-move-to-window-line)) + (setq move-to-window-group-line-function 'follow-move-to-window-line) + + ;; Crude workaround for bug #32848 for the emacs-26 branch, 2018-09-30. + (setq-local make-cursor-line-fully-visible nil)) ;; Remove globally-installed hook functions only if there is no ;; other Follow mode buffer. @@ -451,6 +454,9 @@ Keys specific to Follow mode: (remove-hook 'post-command-hook 'follow-post-command-hook) (remove-hook 'window-size-change-functions 'follow-window-size-change))) + ;; Second part of crude workaround for bug #32848. + (kill-local-variable 'make-cursor-line-fully-visible) + (kill-local-variable 'move-to-window-group-line-function) (kill-local-variable 'selected-window-group-function) (kill-local-variable 'pos-visible-in-window-group-p-function) commit 6217746dd64b43a2a2b3b66ab50cfbbfc984f36c Merge: fcea306042 9ad0f1d15c Author: Alan Third Date: Sat Sep 29 17:08:43 2018 +0100 Merge from origin/emacs-26 9ad0f1d15c Fix deprecation warning 7946445962 Make all NS drawing be done from drawRect 41fa88b99b ; Fix some doc typos commit fcea30604254e1e77eaa88d9b4d15dd048d41233 Author: Alan Third Date: Sat Sep 29 14:47:23 2018 +0100 ; Add myself to MAINTAINERS file diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS index 10633a8e0e..6db1d8801c 100644 --- a/admin/MAINTAINERS +++ b/admin/MAINTAINERS @@ -240,6 +240,14 @@ Vibhav Pant lisp/net/browse-url.el lisp/erc/* +Alan Third + The NS port: + nextstep/* + src/ns* + src/*.m + lisp/term/ns-win.el + doc/emacs/macos.texi + ;;; Local Variables: ;;; coding: utf-8 commit ce0da8a427467a2a5e5636f4d69eb56b56b0925e Author: Michael Albinus Date: Sat Sep 29 15:33:48 2018 +0200 Rework time-* functions in Tramp * doc/misc/emacs-mime.texi (time-date): Add time-equal-p. * lisp/net/tramp-compat.el (tramp-compat-time-equal-p): New defsubst. * lisp/net/tramp.el (tramp-file-name-handler): Remove `debug' error handler. (tramp-half-a-year): Remove. (tramp-time-dont-know, tramp-time-doesnt-exist): New defconst. (tramp-time-diff): Remove compat code. (tramp-handle-set-visited-file-modtime) (tramp-handle-verify-visited-file-modtime): * lisp/net/tramp-adb.el (tramp-do-parse-file-attributes-with-ls) (tramp-adb-handle-set-file-times): * lisp/net/tramp-sh.el (tramp-do-file-attributes-with-ls) (tramp-sh-handle-set-visited-file-modtime) (tramp-sh-handle-verify-visited-file-modtime) (tramp-sh-handle-set-file-times) (tramp-sh-handle-file-newer-than-file-p): Use `tramp-time-dont-know', `tramp-time-doesnt-exist' and `tramp-compat-time-equal-p'. (tramp-sh-handle-verify-visited-file-modtime): Simplify check. * lisp/net/tramp-smb.el (tramp-smb-handle-file-attributes) (tramp-smb-read-file-entry): Use `tramp-time-dont-know'. (tramp-smb-handle-insert-directory): Adapt half-a-year check. * src/editfns.c (Ftime_equal_p): Adapt docstring. * test/lisp/net/tramp-tests.el (tramp-test19-directory-files-and-attributes) (tramp-test22-file-times): Use `tramp-compat-time-equal-p' and `tramp-time-dont-know'. (tramp-test23-visited-file-modtime): Extend test. diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi index 45f37fb855..9280311b5c 100644 --- a/doc/misc/emacs-mime.texi +++ b/doc/misc/emacs-mime.texi @@ -1561,6 +1561,9 @@ Here's a bunch of time/date/second/day examples: (time-less-p '(13818 19266) '(13818 19145)) @result{} nil +(time-equal-p '(13818 19266) '(13818 19145)) +@result{} nil + (time-subtract '(13818 19266) '(13818 19145)) @result{} (0 121) @@ -1641,6 +1644,10 @@ return a ``zero'' time. Take two times and say whether the first time is less (i.e., earlier) than the second time. (This is a built-in function.) +@item time-equal-p +Check, whether two time values are equal. The time values must not be +in the same format. (This is a built-in function.) + @item time-since Take a time and return a time saying how long it was since that time. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 35b0fdda62..36374f88e0 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -411,9 +411,9 @@ pass to the OPERATION." ;; no way to handle numeric ids in Androids ash (if (eq id-format 'integer) 0 uid) (if (eq id-format 'integer) 0 gid) - '(0 0) ; atime + tramp-time-dont-know ; atime (date-to-time date) ; mtime - '(0 0) ; ctime + tramp-time-dont-know ; ctime size mod-string ;; fake @@ -725,7 +725,9 @@ But handle the case, if the \"test\" command is not available." (with-parsed-tramp-file-name filename nil (tramp-flush-file-properties v (file-name-directory localname)) (tramp-flush-file-properties v localname) - (let ((time (if (or (null time) (equal time '(0 0))) + (let ((time (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) time))) (tramp-adb-send-command-and-check diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index b40a4d7edd..ebb4254dab 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -118,9 +118,8 @@ Returns DEFAULT if not set." (and (consp value) (or (null remote-file-name-inhibit-cache) (and (integerp remote-file-name-inhibit-cache) - (<= - (tramp-time-diff (current-time) (car value)) - remote-file-name-inhibit-cache)) + (<= (tramp-time-diff (current-time) (car value)) + remote-file-name-inhibit-cache)) (and (consp remote-file-name-inhibit-cache) (time-less-p remote-file-name-inhibit-cache (car value))))) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index bcfaf40ebc..c3777e6e73 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -247,6 +247,14 @@ If NAME is a remote file name, the local part of NAME is unquoted." (funcall handler 'exec-path) exec-path))))) +;; `time-equal-p' has appeared in Emacs 27.1. +(if (fboundp 'time-equal-p) + (defalias 'tramp-compat-time-equal-p 'time-equal-p) + (defsubst tramp-compat-time-equal-p (t1 t2) + "Return non-nil if time value T1 is equal to time value T2. +A nil value for either argument stands for the current time." + (equal (or t1 (current-time)) (or t2 (current-time))))) + (add-hook 'tramp-unload-hook (lambda () (unload-feature 'tramp-loaddefs 'force) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index f46ddc68ae..c150edf3f1 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -650,7 +650,7 @@ Return nil for null BYTE-ARRAY." (cond ((and (consp message) (characterp (car message))) (format "%S" (tramp-gvfs-dbus-byte-array-to-string message))) - ((and (consp message) (not (consp (cdr message)))) + ((and (consp message) (atom (cdr message))) (cons (tramp-gvfs-stringify-dbus-message (car message)) (tramp-gvfs-stringify-dbus-message (cdr message)))) ((consp message) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 64d208175f..b2be43395f 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1348,13 +1348,10 @@ component is used as the target of the symlink." res-uid ;; 3. File gid. res-gid - ;; 4. Last access time, as a list of integers. Normally - ;; this would be in the same format as `current-time', but - ;; the subseconds part is not currently implemented, and - ;; (0 0) denotes an unknown time. - ;; 5. Last modification time, likewise. - ;; 6. Last status change time, likewise. - '(0 0) '(0 0) '(0 0) ;CCC how to find out? + ;; 4. Last access time. + ;; 5. Last modification time. + ;; 6. Last status change time. + tramp-time-dont-know tramp-time-dont-know tramp-time-dont-know ;; 7. Size in bytes (-1, if number is out of range). res-size ;; 8. File modes, as a string of ten letters or dashes as in ls -l. @@ -1420,13 +1417,10 @@ component is used as the target of the symlink." (with-parsed-tramp-file-name f nil (let* ((remote-file-name-inhibit-cache t) (attr (file-attributes f)) - ;; '(-1 65535) means file doesn't exists yet. (modtime (or (tramp-compat-file-attribute-modification-time attr) - '(-1 65535)))) + tramp-time-doesnt-exist))) (setq coding-system-used last-coding-system-used) - ;; We use '(0 0) as a don't-know value. See also - ;; `tramp-do-file-attributes-with-ls'. - (if (not (equal modtime '(0 0))) + (if (not (tramp-compat-time-equal-p modtime tramp-time-dont-know)) (tramp-run-real-handler 'set-visited-file-modtime (list modtime)) (progn (tramp-send-command @@ -1455,7 +1449,7 @@ of." ;; recorded last modification time, or there is no established ;; connection. (if (or (not f) - (eq (visited-file-modtime) 0) + (zerop (visited-file-modtime)) (not (file-remote-p f nil 'connected))) t (with-parsed-tramp-file-name f nil @@ -1466,16 +1460,10 @@ of." (cond ;; File exists, and has a known modtime. - ((and attr (not (equal modtime '(0 0)))) - (< (abs (tramp-time-diff - modtime - ;; For compatibility, deal with both the old - ;; (HIGH . LOW) and the new (HIGH LOW) return - ;; values of `visited-file-modtime'. - (if (atom (cdr mt)) - (list (car mt) (cdr mt)) - mt))) - 2)) + ((and attr + (not + (tramp-compat-time-equal-p modtime tramp-time-dont-know))) + (< (abs (tramp-time-diff modtime mt)) 2)) ;; Modtime has the don't know value. (attr (tramp-send-command @@ -1491,7 +1479,7 @@ of." v localname "visited-file-modtime-ild" ""))) ;; If file does not exist, say it is not modified if and ;; only if that agrees with the buffer's record. - (t (equal mt '(-1 65535)))))))))) + (t (tramp-compat-time-equal-p mt tramp-time-doesnt-exist))))))))) (defun tramp-sh-handle-set-file-modes (filename mode) "Like `set-file-modes' for Tramp files." @@ -1510,9 +1498,12 @@ of." (when (tramp-get-remote-touch v) (tramp-flush-file-properties v (file-name-directory localname)) (tramp-flush-file-properties v localname) - (let ((time (if (or (null time) (equal time '(0 0))) - (current-time) - time))) + (let ((time + (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) + time))) (tramp-send-command-and-check v (format "env TZ=UTC %s %s %s" @@ -1685,11 +1676,13 @@ be non-negative integers." (fa2 (file-attributes file2))) (if (and (not - (equal (tramp-compat-file-attribute-modification-time fa1) - '(0 0))) + (tramp-compat-time-equal-p + (tramp-compat-file-attribute-modification-time fa1) + tramp-time-dont-know)) (not - (equal (tramp-compat-file-attribute-modification-time fa2) - '(0 0)))) + (tramp-compat-time-equal-p + (tramp-compat-file-attribute-modification-time fa2) + tramp-time-dont-know))) (> 0 (tramp-time-diff (tramp-compat-file-attribute-modification-time fa2) (tramp-compat-file-attribute-modification-time fa1))) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 583acbde03..a97b801730 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -817,18 +817,18 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; Check result. (when entry (list (and (string-match "d" (nth 1 entry)) - t) ;0 file type - -1 ;1 link count - uid ;2 uid - gid ;3 gid - '(0 0) ;4 atime - (nth 3 entry) ;5 mtime - '(0 0) ;6 ctime - (nth 2 entry) ;7 size - (nth 1 entry) ;8 mode - nil ;9 gid weird - inode ;10 inode number - device)))))))) ;11 file system number + t) ;0 file type + -1 ;1 link count + uid ;2 uid + gid ;3 gid + tramp-time-dont-know ;4 atime + (nth 3 entry) ;5 mtime + tramp-time-dont-know ;6 ctime + (nth 2 entry) ;7 size + (nth 1 entry) ;8 mode + nil ;9 gid weird + inode ;10 inode number + device)))))))) ;11 file system number (defun tramp-smb-do-file-attributes-with-stat (vec &optional id-format) "Implement `file-attributes' for Tramp files using stat command." @@ -1085,8 +1085,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (or (tramp-compat-file-attribute-group-id attr) "nogroup") (or (tramp-compat-file-attribute-size attr) (nth 2 x)) (format-time-string - (if (time-less-p (time-subtract (current-time) (nth 3 x)) - tramp-half-a-year) + (if (time-less-p + ;; Half a year. + (time-since (nth 3 x)) (days-to-time 183)) "%b %e %R" "%b %e %Y") (nth 3 x))))) ; date @@ -1816,7 +1817,7 @@ Result is the list (LOCALNAME MODE SIZE MTIME)." sec min hour day (cdr (assoc (downcase month) parse-time-months)) year) - '(0 0))) + tramp-time-dont-know)) (list localname mode size mtime)))) (defun tramp-smb-get-cifs-capabilities (vec) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 723b35c9e7..e1602db149 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3602,13 +3602,11 @@ support symbolic links." (buffer-name))) (unless time-list (let ((remote-file-name-inhibit-cache t)) - ;; '(-1 65535) means file doesn't exists yet. (setq time-list (or (tramp-compat-file-attribute-modification-time (file-attributes (buffer-file-name))) - '(-1 65535))))) - ;; We use '(0 0) as a don't-know value. - (unless (equal time-list '(0 0)) + tramp-time-doesnt-exist)))) + (unless (tramp-compat-time-equal-p time-list tramp-time-dont-know) (tramp-run-real-handler 'set-visited-file-modtime (list time-list)))) (defun tramp-handle-verify-visited-file-modtime (&optional buf) @@ -3634,21 +3632,14 @@ of." (cond ;; File exists, and has a known modtime. - ((and attr (not (equal modtime '(0 0)))) - (< (abs (tramp-time-diff - modtime - ;; For compatibility, deal with both the old - ;; (HIGH . LOW) and the new (HIGH LOW) return - ;; values of `visited-file-modtime'. - (if (atom (cdr mt)) - (list (car mt) (cdr mt)) - mt))) - 2)) + ((and attr + (not (tramp-compat-time-equal-p modtime tramp-time-dont-know))) + (< (abs (tramp-time-diff modtime mt)) 2)) ;; Modtime has the don't know value. (attr t) ;; If file does not exist, say it is not modified if and ;; only if that agrees with the buffer's record. - (t (equal mt '(-1 65535))))))))) + (t (tramp-compat-time-equal-p mt tramp-time-doesnt-exist)))))))) ;; This is used in tramp-gvfs.el and tramp-sh.el. (defconst tramp-gio-events @@ -4531,17 +4522,19 @@ Invokes `password-read' if available, `read-passwd' else." :host ,host-port :port ,method)) (password-cache-remove (tramp-make-tramp-file-name vec 'noloc 'nohop)))) -;; Snarfed code from time-date.el. +;;;###tramp-autoload +(defconst tramp-time-dont-know '(0 0 0 1000) + "An invalid time value, used as \"Don’t know\" value.") -(defconst tramp-half-a-year '(241 17024) -"Evaluated by \"(days-to-time 183)\".") +;;;###tramp-autoload +(defconst tramp-time-doesnt-exist '(-1 65535) + "An invalid time value, used as \"Doesn’t exist\" value.") ;;;###tramp-autoload (defun tramp-time-diff (t1 t2) "Return the difference between the two times, in seconds. T1 and T2 are time values (as returned by `current-time' for example)." - ;; Starting with Emacs 25.1, we could change this to use `time-subtract'. - (float-time (tramp-compat-funcall 'subtract-time t1 t2))) + (float-time (time-subtract t1 t2))) (defun tramp-unquote-shell-quote-argument (s) "Remove quotation prefix \"/:\" from string S, and quote it then for shell." diff --git a/src/editfns.c b/src/editfns.c index daea746387..47509c23d0 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -1677,7 +1677,9 @@ See `current-time-string' for the various forms of a time value. */) } DEFUN ("time-equal-p", Ftime_equal_p, Stime_equal_p, 2, 2, 0, - doc: /* Return non-nil if T1 and T2 are equal time values. */) + doc: /* Return non-nil if T1 and T2 are equal time values. +A nil value for either argument stands for the current time. +See `current-time-string' for the various forms of a time value. */) (Lisp_Object t1, Lisp_Object t2) { return time_cmp (t1, t2) == 0 ? Qt : Qnil; diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 79013558fd..523c7afada 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2882,16 +2882,17 @@ This tests also `file-readable-p', `file-regular-p' and ;; able to return the date correctly. They say "don't know". (dolist (elt attr) (unless - (zerop - (float-time - (nth 5 (file-attributes - (expand-file-name (car elt) tmp-name2))))) + (tramp-compat-time-equal-p + (nth + 5 (file-attributes (expand-file-name (car elt) tmp-name2))) + tramp-time-dont-know) (should (equal (file-attributes (expand-file-name (car elt) tmp-name2)) (cdr elt))))) (setq attr (directory-files-and-attributes tmp-name2 'full)) (dolist (elt attr) - (unless (zerop (float-time (nth 5 (file-attributes (car elt))))) + (unless (tramp-compat-time-equal-p + (nth 5 (file-attributes (car elt))) tramp-time-dont-know) (should (equal (file-attributes (car elt)) (cdr elt))))) (setq attr (directory-files-and-attributes tmp-name2 nil "^b")) @@ -3215,14 +3216,13 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (write-region "foo" nil tmp-name1) (should (file-exists-p tmp-name1)) (should (consp (nth 5 (file-attributes tmp-name1)))) - ;; A zero timestamp means don't know, and will be replaced by - ;; `current-time'. Therefore, use timestamp 1. Skip the - ;; test, if the remote handler is not able to set the - ;; correct time. + ;; Skip the test, if the remote handler is not able to set + ;; the correct time. (skip-unless (set-file-times tmp-name1 (seconds-to-time 1))) ;; Dumb remote shells without perl(1) or stat(1) are not ;; able to return the date correctly. They say "don't know". - (unless (zerop (float-time (nth 5 (file-attributes tmp-name1)))) + (unless (tramp-compat-time-equal-p + (nth 5 (file-attributes tmp-name1)) tramp-time-dont-know) (should (equal (nth 5 (file-attributes tmp-name1)) (seconds-to-time 1))) (write-region "bla" nil tmp-name2) @@ -3252,6 +3252,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (verify-visited-file-modtime)) (set-visited-file-modtime (seconds-to-time 1)) (should (verify-visited-file-modtime)) + (should (= 1 (float-time (visited-file-modtime)))) + + ;; Checks with deleted file. + (delete-file tmp-name) + (dired-uncache tmp-name) + (should (verify-visited-file-modtime)) + (set-visited-file-modtime (seconds-to-time 1)) + (should (verify-visited-file-modtime)) (should (= 1 (float-time (visited-file-modtime)))))) ;; Cleanup. commit 9284e22676a80789a95c3df3b74ac938a0f5eeaa Author: Michael Albinus Date: Sat Sep 29 13:46:59 2018 +0200 Fix minor problem in tramp-handle-substitute-in-file-name * lisp/net/tramp.el (tramp-handle-substitute-in-file-name): Suppress cygwin-mount file name handlers. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 567701a9b2..723b35c9e7 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3585,7 +3585,11 @@ support symbolic links." (setq filename (concat (file-remote-p filename) (replace-regexp-in-string - "\\`/+" "/" (substitute-in-file-name localname))))))) + "\\`/+" "/" + ;; We must disable cygwin-mount file name + ;; handlers and alike. + (tramp-run-real-handler + 'substitute-in-file-name (list localname)))))))) ;; "/m:h:~" does not work for completion. We use "/m:h:~/". (if (and (stringp localname) (string-equal "~" localname)) (concat filename "/") commit fd369be7ebf08414f4c517c7c2e854ccb9d520bc Author: Michael Albinus Date: Sat Sep 29 12:40:15 2018 +0200 Finish fix for Bug#21559 * lisp/vc/vc-git.el (vc-git--call): If `revert-buffer-in-progress-p' flag is set, prepend "GIT_OPTIONAL_LOCKS=0" to "process-environment". (Bug#21559) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 03afce5170..4ea7ea5344 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1628,8 +1628,15 @@ The difference to vc-do-command is that this function always invokes (or coding-system-for-read vc-git-log-output-coding-system)) (coding-system-for-write (or coding-system-for-write vc-git-commits-coding-system)) - (process-environment (cons "PAGER=" process-environment))) - (push "GIT_DIR" process-environment) + (process-environment + (append + `("GIT_DIR" + "PAGER=" + ;; Avoid repository locking during background operations + ;; (bug#21559). + ,@(when revert-buffer-in-progress-p + '("GIT_OPTIONAL_LOCKS=0"))) + process-environment))) (apply 'process-file vc-git-program nil buffer nil command args))) (defun vc-git--out-ok (command &rest args) commit 2296bf188fc99d66306e71e6decd3d2e176b7ae6 Author: Tino Calancha Date: Sat Sep 29 18:40:46 2018 +0900 Ibuffer filter by modes: Accept several mode names Extend all mode filters so that they handle >1 mode. For instance, if the users want to filter all buffers in C or C++ mode, then they can call the filter interactively with input: 'c-mode,c++-mode' (Bug#32731). * lisp/ibuf-macs.el(define-ibuffer-filter): Add key :accept-list. If the value of this key is non-nil, then the filter accepts either a single qualifier or a list of them; in the latter case, the resultant filter is the `or' composition of the individual ones. * lisp/ibuf-ext.el (ibuffer-filter-by-used-mode) (ibuffer-filter-by-mode, ibuffer-filter-by-derived-mode) Set :accept-list value non-nil. Interactively, accept a comma separated list of mode names. * etc/NEWS(Ibuffer): Announce this change. Co-authored-by: Noam Postavsky diff --git a/etc/NEWS b/etc/NEWS index 474af167e8..7e7de165ec 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -61,6 +61,11 @@ to reduce differences between developer and production builds. ** Ibuffer +--- +*** All mode filters can now accept a list of symbols. +This means you can now easily filter several major modes, as well +as a single mode. + --- *** New toggle 'ibuffer-do-toggle-lock', bound to 'L'. diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index d9949d2835..32ec91db97 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el @@ -1228,28 +1228,33 @@ If INCLUDE-PARENTS is non-nil then include parent modes." ;;;###autoload (autoload 'ibuffer-filter-by-mode "ibuf-ext") (define-ibuffer-filter mode - "Limit current view to buffers with major mode QUALIFIER." + "Limit current view to buffers with major mode(s) specified by QUALIFIER. +QUALIFIER is the mode name as a symbol or a list of symbols. +Called interactively, accept a comma separated list of mode names." (:description "major mode" :reader (let* ((buf (ibuffer-current-buffer)) (default (if (and buf (buffer-live-p buf)) (symbol-name (buffer-local-value 'major-mode buf))))) - (intern - (completing-read + (mapcar #'intern + (completing-read-multiple (if default (format "Filter by major mode (default %s): " default) "Filter by major mode: ") obarray - #'(lambda (e) - (string-match "-mode\\'" (symbol-name e))) - t nil nil default)))) + (lambda (e) + (string-match "-mode\\'" (if (symbolp e) (symbol-name e) e))) + t nil nil default))) + :accept-list t) (eq qualifier (buffer-local-value 'major-mode buf))) ;;;###autoload (autoload 'ibuffer-filter-by-used-mode "ibuf-ext") (define-ibuffer-filter used-mode - "Limit current view to buffers with major mode QUALIFIER. -Called interactively, this function allows selection of modes + "Limit current view to buffers with major mode(s) specified by QUALIFIER. +QUALIFIER is the mode name as a symbol or a list of symbols. + +Called interactively, accept a comma separated list of mode names currently used by buffers." (:description "major mode in use" :reader @@ -1257,23 +1262,29 @@ currently used by buffers." (default (if (and buf (buffer-live-p buf)) (symbol-name (buffer-local-value 'major-mode buf))))) - (intern - (completing-read + (mapcar #'intern + (completing-read-multiple (if default (format "Filter by major mode (default %s): " default) "Filter by major mode: ") - (ibuffer-list-buffer-modes) nil t nil nil default)))) + (ibuffer-list-buffer-modes) nil t nil nil default))) + :accept-list t) (eq qualifier (buffer-local-value 'major-mode buf))) ;;;###autoload (autoload 'ibuffer-filter-by-derived-mode "ibuf-ext") (define-ibuffer-filter derived-mode - "Limit current view to buffers whose major mode inherits from QUALIFIER." + "Limit current view to buffers with major mode(s) specified by QUALIFIER. +QUALIFIER is the mode name as a symbol or a list of symbols. + Restrict the view to buffers whose major mode derivates + from modes specified by QUALIFIER. +Called interactively, accept a comma separated list of mode names." (:description "derived mode" - :reader - (intern - (completing-read "Filter by derived mode: " - (ibuffer-list-buffer-modes t) - nil t))) + :reader + (mapcar #'intern + (completing-read-multiple "Filter by derived mode: " + (ibuffer-list-buffer-modes t) + nil t)) + :accept-list t) (with-current-buffer buf (derived-mode-p qualifier))) ;;;###autoload (autoload 'ibuffer-filter-by-name "ibuf-ext") diff --git a/lisp/ibuf-macs.el b/lisp/ibuf-macs.el index 6a70a8341a..72a35a5331 100644 --- a/lisp/ibuf-macs.el +++ b/lisp/ibuf-macs.el @@ -280,14 +280,18 @@ buffer object. ;;;###autoload (cl-defmacro define-ibuffer-filter (name documentation - (&key - reader - description) - &rest body) + (&key + reader + description + accept-list) + &rest body) "Define a filter named NAME. DOCUMENTATION is the documentation of the function. READER is a form which should read a qualifier from the user. DESCRIPTION is a short string describing the filter. +ACCEPT-LIST is a boolean; if non-nil, the filter accepts either +a single condition or a list of them; in the latter +case the filter is the `or' composition of the conditions. BODY should contain forms which will be evaluated to test whether or not a particular buffer should be displayed or not. The forms in BODY @@ -296,30 +300,41 @@ bound to the current value of the filter. \(fn NAME DOCUMENTATION (&key READER DESCRIPTION) &rest BODY)" (declare (indent 2) (doc-string 2)) - (let ((fn-name (intern (concat "ibuffer-filter-by-" (symbol-name name))))) + (let ((fn-name (intern (concat "ibuffer-filter-by-" (symbol-name name)))) + (filter (make-symbol "ibuffer-filter")) + (qualifier-str (make-symbol "ibuffer-qualifier-str"))) `(progn (defun ,fn-name (qualifier) - ,(or documentation "This filter is not documented.") - (interactive (list ,reader)) - (if (null (ibuffer-push-filter (cons ',name qualifier))) - (message "%s" - (format ,(concat (format "Filter by %s already applied: " description) - " %s") - qualifier)) - (message "%s" - (format ,(concat (format "Filter by %s added: " description) - " %s") - qualifier)) - (ibuffer-update nil t))) + ,(or documentation "This filter is not documented.") + (interactive (list ,reader)) + (let ((,filter (cons ',name qualifier)) + (,qualifier-str qualifier)) + ,(when accept-list + `(progn + (unless (listp qualifier) (setq qualifier (list qualifier))) + ;; Reject equivalent filters: (or f1 f2) is same as (or f2 f1). + (setq qualifier (sort (delete-dups qualifier) #'string-lessp)) + (setq ,filter (cons ',name (car qualifier))) + (setq ,qualifier-str + (mapconcat (lambda (m) (if (symbolp m) (symbol-name m) m)) + qualifier ",")) + (when (cdr qualifier) ; Compose individual filters with `or'. + (setq ,filter `(or ,@(mapcar (lambda (m) (cons ',name m)) qualifier)))))) + (if (null (ibuffer-push-filter ,filter)) + (message ,(format "Filter by %s already applied: %%s" description) + ,qualifier-str) + (message ,(format "Filter by %s added: %%s" description) + ,qualifier-str) + (ibuffer-update nil t)))) (push (list ',name ,description - (lambda (buf qualifier) - (condition-case nil - (progn ,@body) - (error (ibuffer-pop-filter) - (when (eq ',name 'predicate) - (error "Wrong filter predicate: %S" - qualifier)))))) - ibuffer-filtering-alist) + (lambda (buf qualifier) + (condition-case nil + (progn ,@body) + (error (ibuffer-pop-filter) + (when (eq ',name 'predicate) + (error "Wrong filter predicate: %S" + qualifier)))))) + ibuffer-filtering-alist) :autoload-end))) (provide 'ibuf-macs) commit 7296b6fbf27aeae76ea63ab2d9d9f2e46491b971 Author: Tino Calancha Date: Sat Sep 29 18:06:03 2018 +0900 Improve cl-do, cl-do* docstrings * lisp/emacs-lisp/cl-macs.el(cl-do, cl-do*): Improve docstring (Bug#32803). diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 0854e665b9..ffe88a21a8 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -1745,7 +1745,24 @@ such that COMBO is equivalent to (and . CLAUSES)." ;;;###autoload (defmacro cl-do (steps endtest &rest body) - "The Common Lisp `do' loop. + "Bind variables and run BODY forms until END-TEST returns non-nil. +First, each VAR is bound to the associated INIT value as if by a `let' form. +Then, in each iteration of the loop, the END-TEST is evaluated; if true, +the loop is finished. Otherwise, the BODY forms are evaluated, then each +VAR is set to the associated STEP expression (as if by a `cl-psetq' form) +and the next iteration begins. + +Once the END-TEST becomes true, the RESULT forms are evaluated (with +the VARs still bound to their values) to produce the result +returned by `cl-do'. + +Note that the entire loop is enclosed in an implicit `nil' block, so +that you can use `cl-return' to exit at any time. + +Also note that END-TEST is checked before evaluating BODY. If END-TEST +is initially non-nil, `cl-do' will exit without running BODY. + +For more details, see `cl-do' description in Info node `(cl) Iteration'. \(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" (declare (indent 2) @@ -1757,7 +1774,25 @@ such that COMBO is equivalent to (and . CLAUSES)." ;;;###autoload (defmacro cl-do* (steps endtest &rest body) - "The Common Lisp `do*' loop. + "Bind variables and run BODY forms until END-TEST returns non-nil. +First, each VAR is bound to the associated INIT value as if by a `let*' form. +Then, in each iteration of the loop, the END-TEST is evaluated; if true, +the loop is finished. Otherwise, the BODY forms are evaluated, then each +VAR is set to the associated STEP expression (as if by a `setq' +form) and the next iteration begins. + +Once the END-TEST becomes true, the RESULT forms are evaluated (with +the VARs still bound to their values) to produce the result +returned by `cl-do*'. + +Note that the entire loop is enclosed in an implicit `nil' block, so +that you can use `cl-return' to exit at any time. + +Also note that END-TEST is checked before evaluating BODY. If END-TEST +is initially non-nil, `cl-do*' will exit without running BODY. + +This is to `cl-do' what `let*' is to `let'. +For more details, see `cl-do*' description in Info node `(cl) Iteration'. \(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" (declare (indent 2) (debug cl-do)) commit 3bbe9e609138ae88a4c98bcee0da8fcf8b4a3e80 Author: Allen Li Date: Sun Dec 31 20:33:21 2017 -0800 Avoid writing empty abbrev tables Fixes bug#29923 'insert-abbrev-table-description' with a non-nil READABLE inserts Lisp forms suitable for evaluation to restore the defined abbrevs. We don't have to insert a form for tables that do not have any abbrevs. To implement this, we need to filter out system abbrevs before checking if a table is empty, because system abbrevs were previously skipped in the 'abbrev--write' call, at which point we would already have started inserting the beginning of a table definition form. * lisp/abbrev.el (insert-abbrev-table-description): Skip inserting empty tables when READABLE is non-nil. Clarify behavior in documentation string. (abbrev--write): Remove system abbrev check. * doc/lispref/abbrevs.texi (Abbrev Tables): Document behavior with empty tables. * etc/NEWS: Mention the change in behavior of 'insert-abbrev-table-description'. diff --git a/doc/lispref/abbrevs.texi b/doc/lispref/abbrevs.texi index 087e694520..4c9e653cb1 100644 --- a/doc/lispref/abbrevs.texi +++ b/doc/lispref/abbrevs.texi @@ -122,7 +122,9 @@ System abbrevs are listed and identified as such. Otherwise the description is a Lisp expression---a call to @code{define-abbrev-table} that would define @var{name} as it is currently defined, but without the system abbrevs. (The mode or package using @var{name} is supposed -to add these to @var{name} separately.) +to add these to @var{name} separately.) If the Lisp expression would +not define any abbrevs (i.e.@: it defines an empty abbrev table), this +function inserts nothing. @end defun @node Defining Abbrevs diff --git a/etc/NEWS b/etc/NEWS index 354072fc81..474af167e8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -246,6 +246,12 @@ case does not match. 'write-abbrev-file' now writes special properties like ':case-fixed' for abbrevs that have them. ++++ +** 'insert-abbrev-table-description' skips empty tables. +'insert-abbrev-table-description' skips inserting empty tables when +inserting non-readable tables. By extension, this makes +'write-abbrev-file' skip writing empty tables. + +++ ** The new functions and commands 'text-property-search-forward' and 'text-property-search-backward' have been added. These provide an diff --git a/lisp/abbrev.el b/lisp/abbrev.el index cddce8f529..e1fd366ba9 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -896,24 +896,22 @@ is not undone." (defun abbrev--write (sym) "Write the abbrev in a `read'able form. -Only writes the non-system abbrevs. Presumes that `standard-output' points to `current-buffer'." - (unless (or (null (symbol-value sym)) (abbrev-get sym :system)) - (insert " (") - (prin1 (symbol-name sym)) - (insert " ") - (prin1 (symbol-value sym)) - (insert " ") - (prin1 (symbol-function sym)) - (insert " :count ") - (prin1 (abbrev-get sym :count)) - (when (abbrev-get sym :case-fixed) - (insert " :case-fixed ") - (prin1 (abbrev-get sym :case-fixed))) - (when (abbrev-get sym :enable-function) - (insert " :enable-function ") - (prin1 (abbrev-get sym :enable-function))) - (insert ")\n"))) + (insert " (") + (prin1 (symbol-name sym)) + (insert " ") + (prin1 (symbol-value sym)) + (insert " ") + (prin1 (symbol-function sym)) + (insert " :count ") + (prin1 (abbrev-get sym :count)) + (when (abbrev-get sym :case-fixed) + (insert " :case-fixed ") + (prin1 (abbrev-get sym :case-fixed))) + (when (abbrev-get sym :enable-function) + (insert " :enable-function ") + (prin1 (abbrev-get sym :enable-function))) + (insert ")\n")) (defun abbrev--describe (sym) (when (symbol-value sym) @@ -934,31 +932,38 @@ Presumes that `standard-output' points to `current-buffer'." "Insert before point a full description of abbrev table named NAME. NAME is a symbol whose value is an abbrev table. If optional 2nd arg READABLE is non-nil, a human-readable description -is inserted. Otherwise the description is an expression, -a call to `define-abbrev-table', which would -define the abbrev table NAME exactly as it is currently defined. - -Abbrevs marked as \"system abbrevs\" are omitted." +is inserted. + +If READABLE is nil, an expression is inserted. The expression is +a call to `define-abbrev-table' that when evaluated will define +the abbrev table NAME exactly as it is currently defined. +Abbrevs marked as \"system abbrevs\" are ignored. If the +resulting expression would not define any abbrevs, nothing is +inserted." (let ((table (symbol-value name)) (symbols ())) - (mapatoms (lambda (sym) (if (symbol-value sym) (push sym symbols))) table) - (setq symbols (sort symbols 'string-lessp)) - (let ((standard-output (current-buffer))) - (if readable - (progn - (insert "(") - (prin1 name) - (insert ")\n\n") - (mapc 'abbrev--describe symbols) - (insert "\n\n")) - (insert "(define-abbrev-table '") - (prin1 name) - (if (null symbols) - (insert " '())\n\n") - (insert "\n '(\n") - (mapc 'abbrev--write symbols) - (insert " ))\n\n"))) - nil))) + (mapatoms (lambda (sym) + (if (and (symbol-value sym) (or readable (not (abbrev-get sym :system)))) + (push sym symbols))) + table) + (when symbols + (setq symbols (sort symbols 'string-lessp)) + (let ((standard-output (current-buffer))) + (if readable + (progn + (insert "(") + (prin1 name) + (insert ")\n\n") + (mapc 'abbrev--describe symbols) + (insert "\n\n")) + (insert "(define-abbrev-table '") + (prin1 name) + (if (null symbols) + (insert " '())\n\n") + (insert "\n '(\n") + (mapc 'abbrev--write symbols) + (insert " ))\n\n"))) + nil)))) (defun define-abbrev-table (tablename definitions &optional docstring &rest props) commit d416109f06ab3910e3f49176185154a5179b6354 Author: Eli Zaretskii Date: Sat Sep 29 10:11:08 2018 +0300 Avoid returning early in 'while-no-input' due to subprocesses * src/keyboard.c (kbd_buffer_store_buffered_event): Support also the internal buffer-switch events. (syms_of_keyboard) : New DEFSYM. * lisp/subr.el (while-no-input-ignore-events): Ignore 'buffer-switch' events. Reported by Michael Heerdegen . * etc/NEWS: Mention the change in behavior of 'while-no-input' diff --git a/etc/NEWS b/etc/NEWS index 578b9b8d95..bfd7db016f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -123,6 +123,16 @@ be removed prior using the changed 'shadow-*' commands. The old name is an alias of the new name. Future Emacs version will obsolete it. +--- +** 'while-no-input' does not return due to input from subprocesses. +Input that arrived from subprocesses while some code executed inside +the 'while-no-input' form injected an internal buffer-switch event +that counted as input and would cause 'while-no-input' to return, +perhaps prematurely. These buffer-switch events are now by default +ignored by 'while-no-input'; if you need to get the old behavior, +remove 'buffer-switch' from the list of events in +'while-no-input-ignore-events'. + * Lisp Changes in Emacs 26.2 diff --git a/lisp/subr.el b/lisp/subr.el index 7582b6cdb8..59f6949b21 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3542,7 +3542,7 @@ is allowed once again. (Immediately, if `inhibit-quit' is nil.)" ;; Don't throw `throw-on-input' on those events by default. (setq while-no-input-ignore-events '(focus-in focus-out help-echo iconify-frame - make-frame-visible selection-request)) + make-frame-visible selection-request buffer-switch)) (defmacro while-no-input (&rest body) "Execute BODY only as long as there's no pending input. diff --git a/src/keyboard.c b/src/keyboard.c index 1da5ac088d..0d56ea3f7a 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -3569,6 +3569,7 @@ kbd_buffer_store_buffered_event (union buffered_input_event *event, case ICONIFY_EVENT: ignore_event = Qiconify_frame; break; case DEICONIFY_EVENT: ignore_event = Qmake_frame_visible; break; case SELECTION_REQUEST_EVENT: ignore_event = Qselection_request; break; + case BUFFER_SWITCH_EVENT: ignore_event = Qbuffer_switch; break; default: ignore_event = Qnil; break; } @@ -11104,6 +11105,8 @@ syms_of_keyboard (void) /* Menu and tool bar item parts. */ DEFSYM (Qmenu_enable, "menu-enable"); + DEFSYM (Qbuffer_switch, "buffer-switch"); + #ifdef HAVE_NTGUI DEFSYM (Qlanguage_change, "language-change"); DEFSYM (Qend_session, "end-session"); commit 48ff4c0b2f78f1812fa12e3a56ee5f2a0bc712f7 Author: Andrew Schwartzmeyer Date: Mon Sep 24 21:09:39 2018 -0700 Support mode aliases in 'provided-mode-derived-p' * lisp/subr.el (provided-mode-derived-p): Check aliases of MODES as well as MODES themselves. (Bug#32795) * test/lisp/subr-tests.el (provided-mode-derived-p): New test. Copyright-paperwork-exempt: yes diff --git a/etc/NEWS b/etc/NEWS index e6508eb60b..354072fc81 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -982,6 +982,11 @@ This works like 'dolist', but reports progress similar to This works like 'delete-frame-functions', but runs after the frame to be deleted has been made dead and removed from the frame list. +--- +** The function 'provided-mode-derived-p' was extended to support aliases. +The function now returns non-nil when the argument MODE is derived +from any alias of any of MODES. + +++ ** New frame focus state inspection interface. The hooks 'focus-in-hook' and 'focus-out-hook' are now obsolete. diff --git a/lisp/subr.el b/lisp/subr.el index 9e880bc880..4c05111f51 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1918,11 +1918,15 @@ Only affects hooks run in the current buffer." ;; PUBLIC: find if the current mode derives from another. (defun provided-mode-derived-p (mode &rest modes) - "Non-nil if MODE is derived from one of MODES. + "Non-nil if MODE is derived from one of MODES or their aliases. Uses the `derived-mode-parent' property of the symbol to trace backwards. If you just want to check `major-mode', use `derived-mode-p'." - (while (and (not (memq mode modes)) - (setq mode (get mode 'derived-mode-parent)))) + (while + (and + (not (memq mode modes)) + (let* ((parent (get mode 'derived-mode-parent)) + (parentfn (symbol-function parent))) + (setq mode (if (and parentfn (symbolp parentfn)) parentfn parent))))) mode) (defun derived-mode-p (&rest modes) diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 86938d5dbe..f218a7663e 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -61,6 +61,18 @@ (quote (0 font-lock-keyword-face)))))))) +(ert-deftest provided-mode-derived-p () + ;; base case: `derived-mode' directly derives `prog-mode' + (should (progn + (define-derived-mode derived-mode prog-mode "test") + (provided-mode-derived-p 'derived-mode 'prog-mode))) + ;; edge case: `derived-mode' derives an alias of `prog-mode' + (should (progn + (defalias 'parent-mode + (if (fboundp 'prog-mode) 'prog-mode 'fundamental-mode)) + (define-derived-mode derived-mode parent-mode "test") + (provided-mode-derived-p 'derived-mode 'prog-mode)))) + (ert-deftest number-sequence-test () (should (= (length (number-sequence (1- most-positive-fixnum) most-positive-fixnum)) commit c973a0f15efe173671d82ac9a6ba67d5a592dc2e Author: Trevor Murphy Date: Sat Sep 22 16:42:20 2018 -0700 Allow user customization to affect display of *Find* buffer. * lisp/find-dired.el (find-dired): Use 'pop-to-buffer-same-window' instead of 'switch-to-buffer'. diff --git a/lisp/find-dired.el b/lisp/find-dired.el index ebd14b0757..9a798b0e39 100644 --- a/lisp/find-dired.el +++ b/lisp/find-dired.el @@ -144,7 +144,7 @@ use in place of \"-ls\" as the final argument." ;; Check that it's really a directory. (or (file-directory-p dir) (error "find-dired needs a directory: %s" dir)) - (switch-to-buffer (get-buffer-create "*Find*")) + (pop-to-buffer-same-window (get-buffer-create "*Find*")) ;; See if there's still a `find' running, and offer to kill ;; it first, if it is. commit e8a4d942dd7305b85850603c97d987e52510a726 Author: John Shahid Date: Fri Sep 21 11:15:10 2018 -0400 Cleanup when opening a new terminal fails. (Bug#32794) * src/term.c (init_tty): Call delete_terminal_internal if emacs_open fail. * src/terminal.c (delete_terminal): Move some code into delete_terminal_internal and call it. (delete_terminal_internal): New function. * src/termhooks.h: Prototype for delete_terminal_internal. diff --git a/src/term.c b/src/term.c index f542fc527c..8493cc02c4 100644 --- a/src/term.c +++ b/src/term.c @@ -4004,6 +4004,7 @@ init_tty (const char *name, const char *terminal_type, bool must_succeed) char const *diagnostic = (fd < 0) ? "Could not open file: %s" : "Not a tty device: %s"; emacs_close (fd); + delete_terminal_internal (terminal); maybe_fatal (must_succeed, terminal, diagnostic, diagnostic, name); } diff --git a/src/termhooks.h b/src/termhooks.h index 1b2c95e824..543809b9e4 100644 --- a/src/termhooks.h +++ b/src/termhooks.h @@ -729,6 +729,7 @@ extern struct terminal *get_named_terminal (const char *); extern struct terminal *create_terminal (enum output_method, struct redisplay_interface *); extern void delete_terminal (struct terminal *); +extern void delete_terminal_internal (struct terminal *); extern Lisp_Object terminal_glyph_code (struct terminal *, int); /* The initial terminal device, created by initial_term_init. */ diff --git a/src/terminal.c b/src/terminal.c index 070b8aac1f..043ee67e0c 100644 --- a/src/terminal.c +++ b/src/terminal.c @@ -314,7 +314,6 @@ create_terminal (enum output_method type, struct redisplay_interface *rif) void delete_terminal (struct terminal *terminal) { - struct terminal **tp; Lisp_Object tail, frame; /* Protect against recursive calls. delete_frame calls the @@ -335,6 +334,14 @@ delete_terminal (struct terminal *terminal) } } + delete_terminal_internal (terminal); +} + +void +delete_terminal_internal (struct terminal *terminal) +{ + struct terminal **tp; + for (tp = &terminal_list; *tp != terminal; tp = &(*tp)->next_terminal) if (! *tp) emacs_abort (); commit 804f9e74de17cc68355d32bfb66710fd5b6b47b7 Author: Stefan Monnier Date: Fri Sep 28 15:54:15 2018 -0400 * etc/NEWS.18: Use outline-mode and a more standard format diff --git a/etc/NEWS.1-17 b/etc/NEWS.1-17 index cfa0b400cc..c74cc3de71 100644 --- a/etc/NEWS.1-17 +++ b/etc/NEWS.1-17 @@ -2529,5 +2529,4 @@ along with GNU Emacs. If not, see . Local variables: mode: outline -mode: text end: diff --git a/etc/NEWS.18 b/etc/NEWS.18 index e2645b9401..ab76c3c772 100644 --- a/etc/NEWS.18 +++ b/etc/NEWS.18 @@ -8,23 +8,23 @@ This file is about changes in emacs version 18. -Changes in version 18.52. +* Changes in Emacs 18.52. -* X windows version 10 is supported under system V. +** X windows version 10 is supported under system V. -* Pop-up menus are now supported with the same Lisp interface in +** Pop-up menus are now supported with the same Lisp interface in both version 10 and 11 of X windows. -* C-x 4 a is a new command to edit a change-log entry in another window. +** C-x 4 a is a new command to edit a change-log entry in another window. -* The emacs client program now allows an option +NNN to specify the +** The emacs client program now allows an option +NNN to specify the line number to go to in the file whose name follows. Thus, emacsclient foo.c +45 bar.c will find the files `foo.c' and `bar.c', going to line 45 in `bar.c'. -* Dired allows empty directories to be deleted like files. +** Dired allows empty directories to be deleted like files. -* When the terminal type is used to find a terminal-specific file to +** When the terminal type is used to find a terminal-specific file to run, Emacs now tries the entire terminal type first. If that doesn't yield a file that exists, the last hyphen and what follows it is stripped. If that doesn't yield a file that exists, the previous @@ -34,97 +34,97 @@ example, if the terminal type is `aaa-48-foo', Emacs will try first Underscores now receive the same treatment as hyphens. -* Texinfo features: @defun, etc. texinfo-show-structure. +** Texinfo features: @defun, etc. texinfo-show-structure. New template commands. texinfo-format-region. -* The special "local variable" `eval' is now ignored if you are running +** The special "local variable" `eval' is now ignored if you are running as root. -* New command `c-macro-expand' shows the result of C macro expansion +** New command `c-macro-expand' shows the result of C macro expansion in the region. It works using the C preprocessor, so its results are completely accurate. -* Errors in trying to auto save now flash error messages for a few seconds. +** Errors in trying to auto save now flash error messages for a few seconds. -* Killing a buffer now sends SIGHUP to the buffer's process. +** Killing a buffer now sends SIGHUP to the buffer's process. -* New hooks. +** New hooks. -** `spell-region' now allows you to filter the text before spelling-checking. +*** `spell-region' now allows you to filter the text before spelling-checking. If the value of `spell-filter' is non-nil, it is called, with no arguments, looking at a temporary buffer containing a copy of the text to be checked. It can alter the text freely before the spell program sees it. -** The variable `lpr-command' now specifies the command to be used when +*** The variable `lpr-command' now specifies the command to be used when you use the commands to print text (such as M-x print-buffer). -** Posting netnews now calls the value of `news-inews-hook' (if not nil) +*** Posting netnews now calls the value of `news-inews-hook' (if not nil) as a function of no arguments before the actual posting. -** Rmail now calls the value of `rmail-show-message-hook' (if not nil) +*** Rmail now calls the value of `rmail-show-message-hook' (if not nil) as a function of no arguments, each time a new message is selected. -** `kill-emacs' calls the value of `kill-emacs-hook' as a function of no args. +*** `kill-emacs' calls the value of `kill-emacs-hook' as a function of no args. -* New libraries. +** New libraries. See the source code of each library for more information. -** icon.el: a major mode for editing programs written in Icon. +*** icon.el: a major mode for editing programs written in Icon. -** life.el: a simulator for the cellular automaton "life". Load the +*** life.el: a simulator for the cellular automaton "life". Load the library and run M-x life. -** doctex.el: a library for converting the Emacs `etc/DOC' file of +*** doctex.el: a library for converting the Emacs `etc/DOC' file of documentation strings into TeX input. -** saveconf.el: a library which records the arrangement of windows and +*** saveconf.el: a library which records the arrangement of windows and buffers when you exit Emacs, and automatically recreates the same setup the next time you start Emacs. -** uncompress.el: a library that automatically uncompresses files +*** uncompress.el: a library that automatically uncompresses files when you visit them. -** c-fill.el: a mode for editing filled comments in C. +*** c-fill.el: a mode for editing filled comments in C. -** kermit.el: an extended version of shell-mode designed for running kermit. +*** kermit.el: an extended version of shell-mode designed for running kermit. -** spook.el: a library for adding some "distract the NSA" keywords to every +*** spook.el: a library for adding some "distract the NSA" keywords to every message you send. -** hideif.el: a library for hiding parts of a C program based on preprocessor +*** hideif.el: a library for hiding parts of a C program based on preprocessor conditionals. -** autoinsert.el: a library to put in some initial text when you visit +*** autoinsert.el: a library to put in some initial text when you visit a nonexistent file. The text used depends on the major mode, and comes from a directory of files created by you. -* New programming features. +** New programming features. -** The variable `window-system-version' now contains the version number +*** The variable `window-system-version' now contains the version number of the window system you are using (if appropriate). When using X windows, its value is either 10 or 11. -** (interactive "N") uses the prefix argument if any; otherwise, it reads +*** (interactive "N") uses the prefix argument if any; otherwise, it reads a number using the minibuffer. -** VMS: there are two new functions `vms-system-info' and `shrink-to-icon'. +*** VMS: there are two new functions `vms-system-info' and `shrink-to-icon'. The former allows you to get many kinds of system status information. See its self-documentation for full details. The second is used with the window system: it iconifies the Emacs window. -** VMS: the new function `define-logical-name' allows you to create +*** VMS: the new function `define-logical-name' allows you to create job-wide logical names. The old function `define-dcl-symbol' has been removed. -Changes in version 18.50. +* Changes in Emacs 18.50. -* X windows version 11 is supported. +** X windows version 11 is supported. Define X11 in config.h if you want X version 11 instead of version 10. -* The command M-x gdb runs the GDB debugger as an inferior. +** The command M-x gdb runs the GDB debugger as an inferior. It asks for the filename of the executable you want to debug. GDB runs as an inferior with I/O through an Emacs buffer. All the @@ -140,21 +140,21 @@ and `finish'. In any source file, the commands C-x SPC tells GDB to set a breakpoint on the current line. -* M-x calendar displays a three-month calendar. +** M-x calendar displays a three-month calendar. -* C-u 0 C-x C-s never makes a backup file. +** C-u 0 C-x C-s never makes a backup file. This is a way you can explicitly request not to make a backup. -* `term-setup-hook' is for users only. +** `term-setup-hook' is for users only. Emacs never uses this variable for internal purposes, so you can freely set it in your `.emacs' file to make Emacs do something special after loading any terminal-specific setup file from `lisp/term'. -* `copy-keymap' now copies recursive submaps. +** `copy-keymap' now copies recursive submaps. -* New overlay-arrow feature. +** New overlay-arrow feature. If you set the variable `overlay-arrow-string' to a string and `overlay-arrow-position' to a marker, that string is displayed on @@ -162,12 +162,12 @@ the screen at the position of that marker, hiding whatever text would have appeared there. If that position isn't on the screen, or if the buffer the marker points into isn't displayed, there is no effect. -* -batch mode can read from the terminal. +** -batch mode can read from the terminal. It now works to use `read-char' to do terminal input in a noninteractive Emacs run. End of file causes Emacs to exit. -* Variables `data-bytes-used' and `data-bytes-free' removed. +** Variables `data-bytes-used' and `data-bytes-free' removed. These variables cannot really work because the 24-bit range of an integer in (most ports of) GNU Emacs is not large enough to hold their @@ -175,9 +175,9 @@ values on many systems. -Changes in version 18.45, since version 18.41. +* Changes in Emacs 18.45, since version 18.41. -* C indentation parameter `c-continued-brace-offset'. +** C indentation parameter `c-continued-brace-offset'. This parameter's value is added to the indentation of any line that is in a continuation context and starts with an open-brace. @@ -188,26 +188,26 @@ For example, it applies to the open brace shown here: The default value is zero. -* Dabbrev expansion (Meta-/) preserves case. +** Dabbrev expansion (Meta-/) preserves case. When you use Meta-/ to search the buffer for an expansion of an abbreviation, if the expansion found is all lower case except perhaps for its first letter, then the case pattern of the abbreviation is carried over to the expansion that replaces it. -* TeX-mode syntax. +** TeX-mode syntax. \ is no longer given "escape character" syntax in TeX mode. It now has the syntax of an ordinary punctuation character. As a result, \[...\] and such like are considered to balance each other. -* Mail-mode automatic Reply-To field. +** Mail-mode automatic Reply-To field. If the variable `mail-default-reply-to' is non-`nil', then each time you start to compose a message, a Reply-To field is inserted with its contents taken from the value of `mail-default-reply-to'. -* Where is your .emacs file? +** Where is your .emacs file? If you run Emacs under `su', so your real and effective uids are different, Emacs uses the home directory associated with the real uid @@ -218,23 +218,23 @@ file. The .emacs file is not loaded at all if -batch is specified. -* Prolog mode is the default for ".pl" files. +** Prolog mode is the default for ".pl" files. -* File names are not case-sensitive on VMS. +** File names are not case-sensitive on VMS. On VMS systems, all file names that you specify are converted to upper case. You can use either upper or lower case indiscriminately. -* VMS-only function 'define-dcl-symbol'. +** VMS-only function 'define-dcl-symbol'. This is a new name for the function formerly called `define-logical-name'. -Editing Changes in Emacs 18 +* Editing Changes in Emacs 18 -* Additional systems and machines are supported. +** Additional systems and machines are supported. GNU Emacs now runs on Vax VMS. However, many facilities that are normally implemented by running subprocesses do not work yet. This includes listing @@ -256,13 +256,13 @@ to working. The port for the Elxsi is partly merged. See the file MACHINES for full status information and machine-specific installation advice. -* Searching is faster. +** Searching is faster. Forward search for a text string, or for a regexp that is equivalent to a text string, is now several times faster. Motion by lines and counting lines is also faster. -* Memory usage improvements. +** Memory usage improvements. It is no longer possible to run out of memory during garbage collection. As a result, running out of memory is never fatal. This @@ -271,27 +271,27 @@ strings in place rather than copying them. Another consequence of the change is a reduction in total memory usage and a slight increase in garbage collection speed. -* Display changes. +** Display changes. -** Editing above top of screen. +*** Editing above top of screen. When you delete or kill or alter text that reaches to the top of the screen or above it, so that display would start in the middle of a line, Emacs will usually attempt to scroll the text so that display starts at the beginning of a line again. -** Yanking in the minibuffer. +*** Yanking in the minibuffer. The message "Mark Set" is no longer printed when the minibuffer is active. This is convenient with many commands, including C-y, that normally print such a message. -** Cursor appears in last line during y-or-n questions. +*** Cursor appears in last line during y-or-n questions. Questions that want a `y' or `n' answer now move the cursor to the last line, following the question. -* Library loading changes. +** Library loading changes. `load' now considers all possible suffixes (`.elc', `.el' and none) for each directory in `load-path' before going on to the next directory. @@ -313,13 +313,13 @@ is no longer allowed. Instead, there are two commands for loading files. `M-x load-file' reads a file name with completion and defaulting and then loads exactly that file, with no searching and no suffixes. -* Emulation of other editors. +** Emulation of other editors. -** `edt-emulation-on' starts emulating DEC's EDT editor. +*** `edt-emulation-on' starts emulating DEC's EDT editor. Do `edt-emulation-off' to return Emacs to normal. -** `vi-mode' and `vip-mode' starts emulating vi. +*** `vi-mode' and `vip-mode' starts emulating vi. These are two different vi emulations provided by GNU Emacs users. We are interested in feedback as to which emulation is preferable. @@ -327,20 +327,20 @@ We are interested in feedback as to which emulation is preferable. See the documentation and source code for these functions for more information. -** `set-gosmacs-bindings' emulates Gosling Emacs. +*** `set-gosmacs-bindings' emulates Gosling Emacs. This command changes many global bindings to resemble those of Gosling Emacs. The previous bindings are saved and can be restored using `set-gnu-bindings'. -* Emulation of a display terminal. +** Emulation of a display terminal. Within Emacs it is now possible to run programs (such as emacs or supdup) which expect to do output to a visual display terminal. See the function `terminal-emulator' for more information. -* New support for keypads and function keys. +** New support for keypads and function keys. There is now a first attempt at terminal-independent support for keypad and function keys. @@ -369,7 +369,7 @@ used in forming the name of the terminal-specific file. Thus, for terminal type `aaa-48', the file loaded is now `term/aaa.el' rather than `term/aaa-48.el'. -* New startup command line options. +** New startup command line options. `-i FILE' or `-insert FILE' in the command line to Emacs tells Emacs to insert the contents of FILE into the current buffer at that point in @@ -383,7 +383,7 @@ emulator on the X window system and you want to run Emacs to work through the terminal emulator instead of working directly with the window system, use this switch. -* Buffer-sorting commands. +** Buffer-sorting commands. Various M-x commands whose names start with `sort-' sort parts of the region: @@ -404,13 +404,13 @@ sort-columns divides into lines and sorts them according to the contents Refer to the self-documentation of these commands for full usage information. -* Changes in various commands. +** Changes in various commands. -** `tags-query-replace' and `tags-search' change. +*** `tags-query-replace' and `tags-search' change. These functions now display the name of the file being searched at the moment. -** `occur' output now serves as a menu. `occur-menu' command deleted. +*** `occur' output now serves as a menu. `occur-menu' command deleted. `M-x occur' now allows you to move quickly to any of the occurrences listed. Select the `*Occur*' buffer that contains the output of `occur', @@ -423,7 +423,7 @@ The command `occur-menu' is thus obsolete, and has been deleted. One way to get a list of matching lines without line numbers is to copy the text to another buffer and use the command `keep-lines'. -** Incremental search changes. +*** Incremental search changes. Ordinary and regexp incremental searches now have distinct default search strings. Thus, regexp searches recall only previous regexp @@ -458,12 +458,12 @@ If `search-slow-window-lines' is negative, the slow search window is put at the top of the screen, and the absolute value or the negative number specifies the height of it. -** Undo changes +*** Undo changes The undo command now will mark the buffer as unmodified only when it is identical to the contents of the visited file. -** C-M-v in minibuffer. +*** C-M-v in minibuffer. If while in the minibuffer you request help in a way that uses a window to display something, then until you exit the minibuffer C-M-v @@ -472,7 +472,7 @@ in the minibuffer window scrolls the window of help. For example, if you request a list of possible completions, C-M-v can be used reliably to scroll the completion list. -** M-TAB command. +*** M-TAB command. Meta-TAB performs completion on the Emacs Lisp symbol names. The sexp in the buffer before point is compared against all existing nontrivial @@ -483,12 +483,12 @@ or properties. If there are multiple possibilities for the very next character, a list of possible completions is displayed. -** Dynamic abbreviation package. +*** Dynamic abbreviation package. The new command Meta-/ expands an abbreviation in the buffer before point by searching the buffer for words that start with the abbreviation. -** Changes in saving kbd macros. +*** Changes in saving kbd macros. The commands `write-kbd-macro' and `append-kbd-macro' have been deleted. The way to save a keyboard macro is to use the new command @@ -498,12 +498,12 @@ file such as your Emacs init file `~/.emacs', insert the macro definition (perhaps deleting an old definition for the same macro) and then save the file. -** C-x ' command. +*** C-x ' command. The new command C-x ' (expand-abbrev) expands the word before point as an abbrev, even if abbrev-mode is not turned on. -** Sending to inferior Lisp. +*** Sending to inferior Lisp. The command C-M-x in Lisp mode, which sends the current defun to an inferior Lisp process, now works by writing the text into a temporary @@ -517,20 +517,20 @@ appear on the screen and scrolls it so that the bottom is showing. Two variables `inferior-lisp-load-command' and `inferior-lisp-prompt', exist to customize these feature for different Lisp implementations. -** C-x p now disabled. +*** C-x p now disabled. The command C-x p, a nonrecommended command which narrows to the current page, is now initially disabled like C-x n. -* Dealing with files. +** Dealing with files. -** C-x C-v generalized +*** C-x C-v generalized This command is now allowed even if the current buffer is not visiting a file. As usual, it kills the current buffer and replaces it with a newly found file. -** M-x recover-file improved; auto save file names changed. +*** M-x recover-file improved; auto save file names changed. M-x recover-file now checks whether the last auto-save file is more recent than the real visited file before offering to read in the @@ -555,21 +555,21 @@ You can customize the way auto save file names are made by redefining the two functions `make-auto-save-file-name' and `auto-save-file-name-p', both of which are defined in `files.el'. -** Modifying a buffer whose file is changed on disk is detected instantly. +*** Modifying a buffer whose file is changed on disk is detected instantly. On systems where clash detection (locking of files being edited) is implemented, Emacs also checks the first time you modify a buffer whether the file has changed on disk since it was last visited or saved. If it has, you are asked to confirm that you want to change the buffer. -** Exiting Emacs offers to save `*mail*'. +*** Exiting Emacs offers to save `*mail*'. Emacs can now know about buffers that it should offer to save on exit even though they are not visiting files. This is done for any buffer which has a non-nil local value of `buffer-offer-save'. By default, Mail mode provides such a local value. -** Backup file changes. +*** Backup file changes. If a backup file cannot be written in the directory of the visited file due to fascist file protection, a backup file is now written in your home @@ -579,7 +579,7 @@ the most recently made such backup is available. When backup files are made by copying, the last-modification time of the original file is now preserved in the backup copy. -** Visiting remote files. +*** Visiting remote files. On an internet host, you can now visit and save files on any other internet host directly from Emacs with the commands M-x ftp-find-file @@ -592,14 +592,14 @@ give the user name and password for use on that host. FTP is reinvoked each time you ask to use it, but previously specified user names and passwords are remembered automatically. -** Dired `g' command. +*** Dired `g' command. `g' in Dired mode is equivalent to M-x revert-buffer; it causes the current contents of the same directory to be read in. -* Changes in major modes. +** Changes in major modes. -** C mode indentation change. +*** C mode indentation change. The binding of Linefeed is no longer changed by C mode. It once again has its normal meaning, which is to insert a newline and then indent @@ -618,28 +618,28 @@ is non-whitespace preceding point on the current line. Giving it a prefix argument will force reindentation of the line (as well as of the compound statement that begins after point, if any). -** Fortran mode now exists. +*** Fortran mode now exists. This mode provides commands for motion and indentation of Fortran code, plus built-in abbrevs for Fortran keywords. For details, see the manual or the on-line documentation of the command `fortran-mode'. -** Scribe mode now exists. +*** Scribe mode now exists. This mode does something useful for editing files of Scribe input. It is used automatically for files with names ending in ".mss". -** Modula2 and Prolog modes now exist. +*** Modula2 and Prolog modes now exist. These modes are for editing programs in the languages of the same names. They can be selected with M-x modula-2-mode and M-x prolog-mode. -** Telnet mode changes. +*** Telnet mode changes. The telnet mode special commands have now been assigned to C-c keys. Most of them are the same as in Shell mode. -** Picture mode changes. +*** Picture mode changes. The special picture-mode commands to specify the direction of cursor motion after insertion have been moved to C-c keys. The commands to @@ -647,13 +647,13 @@ specify diagonal motion were already C-c keys; they are unchanged. The keys to specify horizontal or vertical motion are now C-c < (left), C-c > (right), C-c ^ (up) and C-c . (down). -** Nroff mode comments. +*** Nroff mode comments. Comments are now supported in Nroff mode. The standard comment commands such as M-; and C-x ; know how to insert, align and delete comments that start with backslash-doublequote. -** LaTeX mode. +*** LaTeX mode. LaTeX mode now exists. Use M-x latex-mode to select this mode, and M-x plain-tex-mode to select the previously existing mode for Plain @@ -677,7 +677,7 @@ C-c C-f close a block (appropriate for LaTeX only). this inserts an \end{...} on the following line and puts point on a blank line between them. -** Outline mode changes. +*** Outline mode changes. Invisible lines in outline mode are now indicated by `...' at the end of the previous visible line. @@ -701,9 +701,9 @@ the string that matches. A line starting with a ^L (formfeed) is now by default considered a header line. -* Mail reading and sending. +** Mail reading and sending. -** MH-E changes. +*** MH-E changes. MH-E has been extensively modified and improved since the v17 release. It contains many new features, including commands to: extracted failed @@ -715,7 +715,7 @@ single messages. MH-E also has had numerous bugs fixed and commands made to run faster. Furthermore, its keybindings have been changed to be compatible with Rmail and the rest of GNU Emacs. -** Mail mode changes. +*** Mail mode changes. The C-c commands of mail mode have been rearranged: @@ -727,28 +727,28 @@ C-c y, C-c w and C-c q have been changed to C-c C-y, C-c C-w and C-c C-q. Thus, C-c LETTER is always unassigned. -** Rmail C-r command changed to w. +*** Rmail C-r command changed to w. The Rmail command to edit the current message is now `w'. This change has been made because people frequently type C-r while in Rmail hoping to do a reverse incremental search. That now works. -* Rnews changes. +** Rnews changes. -** Caesar rotation added. +*** Caesar rotation added. The function news-caesar-buffer-body performs encryption and decryption of the body of a news message. It defaults to the USENET standard of 13, and accepts any numeric arg between 1 to 25 and -25 to -1. The function is bound to C-c C-r in both news-mode and news-reply-mode. -** rmail-output command added. +*** rmail-output command added. The C-o command has been bound to rmail-output in news-mode. This allows one to append an article to a file which is in either Unix mail or RMAIL format. -** news-reply-mode changes. +*** news-reply-mode changes. The C-c commands of news reply mode have been rearranged and changed, so that C-c LETTER is always unassigned: @@ -773,7 +773,7 @@ C-c C-y news-reply-yank-original (insert current message, in NEWS). C-c C-q mail-fill-yanked-message (fill what was yanked). C-c C-r caesar rotate all letters by 13 places in the article's body (rot13). -* Existing Emacs usable as a server. +** Existing Emacs usable as a server. Programs such as mailers that invoke "the editor" as an inferior to edit some text can now be told to use an existing Emacs process @@ -810,11 +810,11 @@ The client/server work only on Berkeley Unix, since they use the Berkeley sockets mechanism for their communication. -Changes in Lisp programming in Emacs version 18. +* Changes in Lisp programming in Emacs 18. -* Init file changes. +** Init file changes. -** Suffixes no longer accepted on `.emacs'. +*** Suffixes no longer accepted on `.emacs'. Emacs will no longer load a file named `.emacs.el' or `emacs.elc' in place of `.emacs'. This is so that it will take less time to @@ -822,7 +822,7 @@ find `.emacs'. If you want to compile your init file, give it another name and make `.emacs' a link to the `.elc' file, or make it contain a call to `load' to load the `.elc' file. -** `default-profile' renamed to `default', and loaded after `.emacs'. +*** `default-profile' renamed to `default', and loaded after `.emacs'. It used to be the case that the file `default-profile' was loaded if and only if `.emacs' was not found. @@ -839,13 +839,13 @@ Note that for most purposes you are better off using a `site-init' library since that will be loaded before the runnable Emacs is dumped. By using a `site-init' library, you avoid taking up time each time Emacs is started. -** inhibit-command-line has been eliminated. +*** inhibit-command-line has been eliminated. This variable used to exist for .emacs files to set. It has been eliminated because you can get the same effect by setting command-line-args to nil and setting inhibit-startup-message to t. -* `apply' is more general. +** `apply' is more general. `apply' now accepts any number of arguments. The first one is a function; the rest are individual arguments to pass to that function, except for the @@ -854,7 +854,7 @@ last, which is a list of arguments to pass. Previously, `apply' required exactly two arguments. Its old behavior follows as a special case of the new definition. -* New code-letter for `interactive'. +** New code-letter for `interactive'. (interactive "NFoo: ") is like (interactive "nFoo: ") in reading a number using the minibuffer to serve as the argument; however, @@ -863,9 +863,9 @@ value as the argument, and does not use the minibuffer at all. This is used by the `goto-line' and `goto-char' commands. -* Semantics of variables. +** Semantics of variables. -** Built-in per-buffer variables improved. +*** Built-in per-buffer variables improved. Several built-in variables which in the past had a different value in each buffer now behave exactly as if `make-variable-buffer-local' had @@ -887,12 +887,12 @@ They now refer to the default value of the variable, which is not quite the same behavior as before, but it should enable old init files to continue to work. -** New per-buffer variables. +*** New per-buffer variables. The variables `fill-prefix', `comment-column' and `indent-tabs-mode' are now per-buffer. They work just like `fill-column', etc. -** New function `setq-default'. +*** New function `setq-default'. `setq-default' sets the default value of a variable, and uses the same syntax that `setq' accepts: the variable name is not evaluated @@ -901,12 +901,12 @@ and need not be quoted. `(setq-default case-fold-search nil)' would make searches case-sensitive in all buffers that do not have local values for `case-fold-search'. -** Functions `global-set' and `global-value' deleted. +*** Functions `global-set' and `global-value' deleted. These functions were never used except by mistake by users expecting the functionality of `set-default' and `default-value'. -* Changes in defaulting of major modes. +** Changes in defaulting of major modes. When `default-major-mode' is `nil', new buffers are supposed to get their major mode from the buffer that is current. However, @@ -917,7 +917,7 @@ Now such modes' names have been given non-`nil' `mode-class' properties. If the current buffer's mode has such a property, Fundamental mode is used as the default for newly created buffers. -* `where-is-internal' requires additional arguments. +** `where-is-internal' requires additional arguments. This function now accepts three arguments, two of them required: DEFINITION, the definition to search for; LOCAL-KEYMAP, the keymap @@ -938,38 +938,38 @@ The incompatibility is sad, but `nil' is a legitimate value for the second argument (it means there is no local keymap), so it cannot also serve as a default meaning to use the current local keymap. -* Abbrevs with hooks. +** Abbrevs with hooks. When an abbrev defined with a hook is expanded, it now performs the usual replacement of the abbrev with the expansion before running the hook. Previously the abbrev itself was deleted but the expansion was not inserted. -* Function `scan-buffer' deleted. +** Function `scan-buffer' deleted. Use `search-forward' or `search-backward' in place of `scan-buffer'. You will have to rearrange the arguments. -* X window interface improvements. +** X window interface improvements. -** Detect release of mouse buttons. +*** Detect release of mouse buttons. Button-up events can now be detected. See the file `lisp/x-mouse.el' for details. -** New pop-up menu facility. +*** New pop-up menu facility. The new function `x-popup-menu' pops up a menu (in a X window) and returns an indication of which selection the user made. For more information, see its self-documentation. -* M-x disassemble. +** M-x disassemble. This command prints the disassembly of a byte-compiled Emacs Lisp function. Would anyone like to interface this to the debugger? -* `insert-buffer-substring' can insert part of the current buffer. +** `insert-buffer-substring' can insert part of the current buffer. The old restriction that the text being inserted had to come from a different buffer is now lifted. @@ -977,7 +977,7 @@ a different buffer is now lifted. When inserting text from the current buffer, the text to be inserted is determined from the specified bounds before any copying takes place. -* New function `substitute-key-definition'. +** New function `substitute-key-definition'. This is a new way to replace one command with another command as the binding of whatever keys may happen to refer to it. @@ -986,29 +986,29 @@ binding of whatever keys may happen to refer to it. for keys defined to run OLDDEF, and rebinds those keys to run NEWDEF instead. -* New function `insert-char'. +** New function `insert-char'. Insert a specified character, a specified number of times. -* `mark-marker' changed. +** `mark-marker' changed. When there is no mark, this now returns a marker that points nowhere, rather than `nil'. -* `ding' accepts argument. +** `ding' accepts argument. When given an argument, the function `ding' does not terminate execution of a keyboard macro. Normally, `ding' does terminate all macros that are currently executing. -* New function `minibuffer-depth'. +** New function `minibuffer-depth'. This function returns the current depth in minibuffer activations. The value is zero when the minibuffer is not in use. Values greater than one are possible if the user has entered the minibuffer recursively. -* New function `documentation-property'. +** New function `documentation-property'. (documentation-property SYMBOL PROPNAME) is like (get SYMBOL PROPNAME), except that if the property value is a number `documentation-property' @@ -1018,7 +1018,7 @@ in the DOC file and return the string found there. (documentation-property VAR 'variable-documentation) is the proper way for a Lisp program to get the documentation of variable VAR. -* New documentation-string expansion feature. +** New documentation-string expansion feature. If a documentation string (for a variable or function) contains text of the form `\', it means that all command names specified in @@ -1045,7 +1045,7 @@ in the current buffer's local map. The current global keymap is always searched second, whether `\<...>' has been used or not. -* Multiple hooks allowed in certain contexts. +** Multiple hooks allowed in certain contexts. The old hook variables `find-file-hook', `find-file-not-found-hook' and `write-file-hook' have been replaced. @@ -1072,7 +1072,7 @@ together to implement editing of files that are not stored as Unix files: stored in archives, or inside version control systems, or on other machines running other operating systems and accessible via ftp. -* New hooks for suspending Emacs. +** New hooks for suspending Emacs. Suspending Emacs runs the hook `suspend-hook' before suspending and the hook `suspend-resume-hook' if the suspended Emacs is resumed. @@ -1082,22 +1082,22 @@ non-`nil', then suspending is inhibited and so is running the `suspend-resume-hook'. The non-`nil' value means that the `suspend-hook' has done whatever suspending is required. -* Disabling commands can print a special message. +** Disabling commands can print a special message. A command is disabled by giving it a non-`nil' `disabled' property. Now, if this property is a string, it is included in the message printed when the user tries to run the command. -* Emacs can open TCP connections. +** Emacs can open TCP connections. The function `open-network-stream' opens a TCP connection to a specified host and service. Its value is a Lisp object that represents the connection. The object is a kind of "subprocess", and I/O are done like I/O to subprocesses. -* Display-related changes. +** Display-related changes. -** New mode-line control features. +*** New mode-line control features. The display of the mode line used to be controlled by a format-string that was the value of the variable `mode-line-format'. @@ -1188,12 +1188,12 @@ global-mode-string The idea of these variables is to eliminate the need for major modes to alter mode-line-format itself. -** `window-point' valid for selected window. +*** `window-point' valid for selected window. The value returned by `window-point' used to be incorrect when its argument was the selected window. Now the value is correct. -** Window configurations may be saved as Lisp objects. +*** Window configurations may be saved as Lisp objects. The function `current-window-configuration' returns a special type of Lisp object that represents the current layout of windows: the @@ -1203,7 +1203,7 @@ which parts of the buffers appear on the screen. The function `set-window-configuration' takes one argument, which must be a window configuration object, and restores that configuration. -** New hook `temp-output-buffer-show-hook'. +*** New hook `temp-output-buffer-show-hook'. This hook allows you to control how help buffers are displayed. Whenever `with-output-to-temp-buffer' has executed its body and wants @@ -1213,30 +1213,30 @@ The hook function is solely responsible for displaying the buffer. The standard manner of display--making the buffer appear in a window--is used only if there is no hook function. -** New function `minibuffer-window'. +*** New function `minibuffer-window'. This function returns the window used (sometimes) for displaying the minibuffer. It can be used even when the minibuffer is not active. -** New feature to `next-window'. +*** New feature to `next-window'. If the optional second argument is neither `nil' nor `t', the minibuffer window is omitted from consideration even when active; if the starting window was the last non-minibuffer window, the value will be the first non-minibuffer window. -** New variable `minibuffer-scroll-window'. +*** New variable `minibuffer-scroll-window'. When this variable is non-`nil', the command `scroll-other-window' uses it as the window to be scrolled. Displays of completion-lists set this variable to the window containing the display. -** New argument to `sit-for'. +*** New argument to `sit-for'. A non-nil second argument to `sit-for' means do not redisplay; just wait for the specified time or until input is available. -** Deleted function `set-minor-mode'; minor modes must be changed. +*** Deleted function `set-minor-mode'; minor modes must be changed. The function `set-minor-mode' has been eliminated. The display of minor mode names in the mode line is now controlled by the @@ -1245,7 +1245,7 @@ mode, it is sufficient to add an element to this list. Once that is done, you can turn the mode on and off just by setting a variable, and the display will show its status automatically. -** New variable `cursor-in-echo-area'. +*** New variable `cursor-in-echo-area'. If this variable is non-nil, the screen cursor appears on the last line of the screen, at the end of the text displayed there. @@ -1253,7 +1253,7 @@ last line of the screen, at the end of the text displayed there. Binding this variable to t is useful at times when reading single characters of input with `read-char'. -** New per-buffer variable `selective-display-ellipses'. +*** New per-buffer variable `selective-display-ellipses'. If this variable is non-nil, an ellipsis (`...') appears on the screen at the end of each text line that is followed by invisible text. @@ -1264,14 +1264,14 @@ on the screen that invisible text is present. Text is made invisible under the control of the variable `selective-display'; this is how Outline mode and C-x $ work. -** New variable `no-redraw-on-reenter'. +*** New variable `no-redraw-on-reenter'. If you set this variable non-nil, Emacs will not clear the screen when you resume it after suspending it. This is for the sake of terminals with multiple screens of memory, where the termcap entry has been set up to switch between screens when Emacs is suspended and resumed. -** New argument to `set-screen-height' or `set-screen-width'. +*** New argument to `set-screen-height' or `set-screen-width'. These functions now take an optional second argument which says what significance the newly specified height or width has. @@ -1293,9 +1293,9 @@ to move the cursor to the last line will do. 2. The ``real'' height of the terminal determines how much padding is needed. -* File-related changes. +** File-related changes. -** New parameter `backup-by-copying-when-mismatch'. +*** New parameter `backup-by-copying-when-mismatch'. If this variable is non-`nil', then when Emacs is about to save a file, it will create the backup file by copying if that would avoid @@ -1307,7 +1307,7 @@ last. I recommend that this variable be left normally `nil' and changed with a local variables list in those particular files where the uid needs to be preserved. -** New parameter `file-precious-flag'. +*** New parameter `file-precious-flag'. If this variable is non-`nil', saving the buffer tries to avoid leaving an incomplete file due to disk full or other I/O errors. @@ -1317,14 +1317,14 @@ file is renamed back to the name you visited. Backups are always made by copying for such files. -** New variable `buffer-offer-save'. +*** New variable `buffer-offer-save'. If the value of this variable is non-`nil' in a buffer then exiting Emacs will offer to save the buffer (if it is modified and nonempty) even if the buffer is not visiting a file. This variable is automatically made local to the current buffer whenever it is set. -** `rename-file', `copy-file', `add-name-to-file' and `make-symbolic-link'. +*** `rename-file', `copy-file', `add-name-to-file' and `make-symbolic-link'. The third argument to these functions used to be `t' or `nil'; `t' meaning go ahead even if the specified new file name already has a file, @@ -1333,13 +1333,13 @@ and `nil' meaning to get an error. Now if the third argument is a number it means to ask the user for confirmation in this case. -** New optional argument to `copy-file'. +*** New optional argument to `copy-file'. If `copy-file' receives a non-nil fourth argument, it attempts to give the new copy the same time-of-last-modification that the original file has. -** New function `file-newer-than-file-p'. +*** New function `file-newer-than-file-p'. (file-newer-than-file-p FILE1 FILE2) returns non-nil if FILE1 has been modified more recently than FILE2. If FILE1 does not exist, the value @@ -1347,24 +1347,24 @@ is always nil; otherwise, if FILE2 does not exist, the value is t. This is meant for use when FILE2 depends on FILE1, to see if changes in FILE1 make it necessary to recompute FILE2 from it. -** Changed function `file-exists-p'. +*** Changed function `file-exists-p'. This function is no longer the same as `file-readable-p'. `file-exists-p' can now return t for a file that exists but which the fascists won't allow you to read. -** New function `file-locked-p'. +*** New function `file-locked-p'. This function receives a file name as argument and returns `nil' if the file is not locked, `t' if locked by this Emacs, or a string giving the name of the user who has locked it. -** New function `file-name-sans-versions'. +*** New function `file-name-sans-versions'. (file-name-sans-versions NAME) returns a substring of NAME, with any version numbers or other backup suffixes deleted from the end. -** New functions for directory names. +*** New functions for directory names. Although a directory is really a kind of file, specifying a directory uses a somewhat different syntax from specifying a file. @@ -1390,7 +1390,7 @@ and (directory-file-name "/usr/rms/") returns "/usr/rms". On VMS, (file-name-as-directory "du:[rms]foo.dir") returns "du:[rms.foo]" and (directory-file-name "du:[rms.foo]") returns "du:[rms]foo.dir". -** Value of `file-attributes' changed. +*** Value of `file-attributes' changed. The function file-attributes returns a list containing many kinds of information about a file. Now the list has eleven elements. @@ -1403,14 +1403,14 @@ the same directory by you. The eleventh element is the inode number of the file. -** VMS-only function `file-name-all-versions'. +*** VMS-only function `file-name-all-versions'. This function returns a list of all the completions, including version number, of a specified version-number-less file name. This is like `file-name-all-completions', except that the latter returns values that do not include version numbers. -** VMS-only variable `vms-stmlf-recfm'. +*** VMS-only variable `vms-stmlf-recfm'. On a VMS system, if this variable is non-nil, Emacs will give newly created files the record format `stmlf'. This is necessary for files @@ -1423,46 +1423,46 @@ no effect. This variable has no effect on Unix systems. -** `insert-file-contents' on an empty file. +*** `insert-file-contents' on an empty file. This no longer sets the buffer's "modified" flag. -** New function (VMS only) `define-logical-name': +*** New function (VMS only) `define-logical-name': (define-logical-name LOGICAL TRANSLATION) defines a VMS logical name LOGICAL whose translation is TRANSLATION. The new name applies to the current process only. -** Deleted variable `ask-about-buffer-names'. +*** Deleted variable `ask-about-buffer-names'. If you want buffer names for files to be generated in a special way, you must redefine `create-file-buffer'. -* Subprocess-related changes. +** Subprocess-related changes. -** New function `process-list'. +*** New function `process-list'. This function takes no arguments and returns a list of all of Emacs's asynchronous subprocesses. -** New function `process-exit-status'. +*** New function `process-exit-status'. This function, given a process, process name or buffer as argument, returns the exit status code or signal number of the process. If the process has not yet exited or died, this function returns 0. -** Process output ignores `buffer-read-only'. +*** Process output ignores `buffer-read-only'. Output from a process will go into the process's buffer even if the buffer is read only. -** Switching buffers in filter functions and sentinels. +*** Switching buffers in filter functions and sentinels. Emacs no longer saves and restore the current buffer around calling the filter and sentinel functions, so these functions can now permanently alter the selected buffer in a straightforward manner. -** Specifying environment variables for subprocesses. +*** Specifying environment variables for subprocesses. When a subprocess is started with `start-process' or `call-process', the value of the variable `process-environment' is taken to @@ -1472,38 +1472,38 @@ value should be a list of strings, each of the form "VAR=VALUE". `process-environment' is initialized when Emacs starts up based on Emacs's environment. -** New variable `process-connection-type'. +*** New variable `process-connection-type'. If this variable is `nil', when a subprocess is created, Emacs uses a pipe rather than a pty to communicate with it. Normally this variable is `t', telling Emacs to use a pty if ptys are supported and one is available. -** New function `waiting-for-user-input-p'. +*** New function `waiting-for-user-input-p'. This function, given a subprocess as argument, returns `t' if that subprocess appears to be waiting for input sent from Emacs, or `nil' otherwise. -** New hook `shell-set-directory-error-hook'. +*** New hook `shell-set-directory-error-hook'. The value of this variable is called, with no arguments, whenever Shell mode gets an error trying to keep track of directory-setting commands (such as `cd' and `pushd') used in the shell buffer. -* New functions `user-uid' and `user-real-uid'. +** New functions `user-uid' and `user-real-uid'. These functions take no arguments and return, respectively, the effective uid and the real uid of the Emacs process. The value in each case is an integer. -* New variable `print-escape-newlines' controls string printing. +** New variable `print-escape-newlines' controls string printing. If this variable is non-`nil', then when a Lisp string is printed by the Lisp printing function `prin1' or `print', newline characters are printed as `\n' rather than as a literal newline. -* New function `sysnetunam' on HPUX. +** New function `sysnetunam' on HPUX. This function takes two arguments, a network address PATH and a login string LOGIN, and executes the system call `netunam'. @@ -1511,7 +1511,7 @@ It returns `t' if the call succeeds, otherwise `nil'. News regarding installation: -* Many `s-...' file names changed. +** Many `s-...' file names changed. Many `s-...' files have been renamed. All periods in such names, except the ones just before the final `h', have been changed to @@ -1519,7 +1519,7 @@ hyphens. Thus, `s-bsd4.2.h' has been renamed to `s-bsd4-2.h'. This is so a Unix distribution can be moved mechanically to VMS. -* `DOCSTR...' file now called `DOC-...'. +** `DOCSTR...' file now called `DOC-...'. The file of on-line documentation strings, that used to be `DOCSTR.mm.nn.oo' in this directory, is now called `DOC-mm.nn.oo'. @@ -1529,11 +1529,11 @@ for translating filenames for VMS. This file also now contains the doc strings for variables as well as functions. -* Emacs no longer uses floating point arithmetic. +** Emacs no longer uses floating point arithmetic. This may make it easier to port to some machines. -* Macros `XPNTR' and `XSETPNTR'; flag `DATA_SEG_BITS'. +** Macros `XPNTR' and `XSETPNTR'; flag `DATA_SEG_BITS'. These macros exclusively are used to unpack a pointer from a Lisp_Object and to insert a pointer into a Lisp_Object. Redefining them may help @@ -1543,7 +1543,7 @@ certain high bits set. If `DATA_SEG_BITS' is defined, it should be a number which contains the high bits to be inclusive or'ed with pointers that are unpacked. -* New flag `HAVE_X_MENU'. +** New flag `HAVE_X_MENU'. Define this flag in `config.h' in addition to `HAVE_X_WINDOWS' to enable use of the Emacs interface to X Menus. On some operating @@ -1551,11 +1551,11 @@ systems, the rest of the X interface works properly but X Menus do not work; hence this separate flag. See the file `src/xmenu.c' for more information. -* Macros `ARRAY_MARK_FLAG' and `DONT_COPY_FLAG'. +** Macros `ARRAY_MARK_FLAG' and `DONT_COPY_FLAG'. -* `HAVE_ALLOCA' prevents assembly of `alloca.s'. +** `HAVE_ALLOCA' prevents assembly of `alloca.s'. -* `SYSTEM_MALLOC' prevents use of GNU `malloc.c'. +** `SYSTEM_MALLOC' prevents use of GNU `malloc.c'. SYSTEM_MALLOC, if defined, means use the system's own `malloc' routines rather than those that come with Emacs. @@ -1563,21 +1563,21 @@ rather than those that come with Emacs. Use this only if absolutely necessary, because if it is used you do not get warnings when space is getting low. -* New flags to control unexec. +** New flags to control unexec. See the file `unexec.c' for a long comment on the compilation switches that suffice to make it work on many machines. -* `PNTR_COMPARISON_TYPE' +** `PNTR_COMPARISON_TYPE' Pointers that need to be compared for ordering are converted to this type first. Normally this is `unsigned int'. -* `HAVE_VFORK', `HAVE_DUP2' and `HAVE_GETTIMEOFDAY'. +** `HAVE_VFORK', `HAVE_DUP2' and `HAVE_GETTIMEOFDAY'. These flags just say whether certain system calls are available. -* New macros control compiler switches, linker switches and libraries. +** New macros control compiler switches, linker switches and libraries. The m- and s- files can now control in a modular fashion the precise arguments passed to `cc' and `ld'. @@ -1618,5 +1618,5 @@ along with GNU Emacs. If not, see . Local variables: -mode: text +mode: outline end: commit 9ad0f1d15c06eb07dfbd9bd3e3b8a0d747942152 Author: Alan Third Date: Wed Sep 26 22:21:37 2018 +0100 Fix deprecation warning * src/nsterm.m (ns_term_init): Use writeToFile or writeToURL as required. diff --git a/src/nsterm.m b/src/nsterm.m index 954020dcde..d92d6c3244 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -5193,7 +5193,21 @@ Needs to be here because ns_initialize_display_info () uses AppKit classes. alpha: 1.0] forKey: [NSString stringWithUTF8String: name]]; } - [cl writeToFile: nil]; + + /* FIXME: Report any errors writing the color file below. */ +#if MAC_OS_X_VERSION_MAX_ALLOWED >= 101100 +#if MAC_OS_X_VERSION_MIN_REQUIRED < 101100 + if ([cl respondsToSelector:@selector(writeToURL:error:)]) +#endif + [cl writeToURL:nil error:nil]; +#if MAC_OS_X_VERSION_MIN_REQUIRED < 101100 + else +#endif +#endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 101100 */ +#if MAC_OS_X_VERSION_MIN_REQUIRED < 101100 \ + || defined (NS_IMPL_GNUSTEP) + [cl writeToFile: nil]; +#endif } } commit 7946445962372c4255180af45cb7c857f1b0b5fa Author: Alan Third Date: Fri Sep 28 20:23:07 2018 +0100 Make all NS drawing be done from drawRect See bug#31904 and bug#32812. * src/nsterm.m (ns_update_begin): Don't lock focus, only clip if there is already a view focused. (ns_update_end): Don't mess with view focusing any more. (ns_focus): Only clip drawing if there is already a focused view, otherwise mark area dirty for later drawing. Renamed ns_clip_to_rect. All callers changed. (ns_unfocus): Don't unfocus the view any more. Renamed ns_reset_clipping. All callers changed. (ns_clip_to_row): Update to match ns_clip_to_rect. (ns_clear_frame): (ns_clear_frame_area): (ns_draw_fringe_bitmap): (ns_draw_window_cursor): (ns_draw_vertical_window_border): (ns_draw_window_divider): (ns_dumpglyphs_stretch): (ns_draw_glyph_string): Only draw if ns_focus or ns_clip_to_row return YES. (ns_copy_bits): Remove superfluous calls to ns_(un)focus. (ns_flush_display): New function. diff --git a/src/nsterm.m b/src/nsterm.m index 5ed71c9f8f..954020dcde 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -276,12 +276,7 @@ - (NSColor *)colorUsingDefaultColorSpace long context_menu_value = 0; /* display update */ -static struct frame *ns_updating_frame; -static NSView *focus_view = NULL; static int ns_window_num = 0; -#ifdef NS_IMPL_GNUSTEP -static NSRect uRect; // TODO: This is dead, remove it? -#endif static BOOL gsaved = NO; static BOOL ns_fake_keydown = NO; #ifdef NS_IMPL_COCOA @@ -1039,12 +1034,13 @@ static NSRect constrain_frame_rect(NSRect frameRect, bool isFullscreen) external (RIF) call; whole frame, called before update_window_begin -------------------------------------------------------------------------- */ { +#ifdef NS_IMPL_COCOA EmacsView *view = FRAME_NS_VIEW (f); + NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_update_begin"); ns_update_auto_hide_menu_bar (); -#ifdef NS_IMPL_COCOA if ([view isFullscreen] && [view fsIsNative]) { // Fix reappearing tool bar in fullscreen for Mac OS X 10.7 @@ -1053,36 +1049,29 @@ static NSRect constrain_frame_rect(NSRect frameRect, bool isFullscreen) if (! tbar_visible != ! [toolbar isVisible]) [toolbar setVisible: tbar_visible]; } -#endif - - ns_updating_frame = f; - [view lockFocus]; /* drawRect may have been called for say the minibuffer, and then clip path is for the minibuffer. But the display engine may draw more because we have set the frame as garbaged. So reset clip path to the whole view. */ -#ifdef NS_IMPL_COCOA - { - NSBezierPath *bp; - NSRect r = [view frame]; - NSRect cr = [[view window] frame]; - /* If a large frame size is set, r may be larger than the window frame - before constrained. In that case don't change the clip path, as we - will clear in to the tool bar and title bar. */ - if (r.size.height - + FRAME_NS_TITLEBAR_HEIGHT (f) - + FRAME_TOOLBAR_HEIGHT (f) <= cr.size.height) - { - bp = [[NSBezierPath bezierPathWithRect: r] retain]; - [bp setClip]; - [bp release]; - } - } -#endif - -#ifdef NS_IMPL_GNUSTEP - uRect = NSMakeRect (0, 0, 0, 0); + /* FIXME: I don't think we need to do this. */ + if ([NSView focusView] == FRAME_NS_VIEW (f)) + { + NSBezierPath *bp; + NSRect r = [view frame]; + NSRect cr = [[view window] frame]; + /* If a large frame size is set, r may be larger than the window frame + before constrained. In that case don't change the clip path, as we + will clear in to the tool bar and title bar. */ + if (r.size.height + + FRAME_NS_TITLEBAR_HEIGHT (f) + + FRAME_TOOLBAR_HEIGHT (f) <= cr.size.height) + { + bp = [[NSBezierPath bezierPathWithRect: r] retain]; + [bp setClip]; + [bp release]; + } + } #endif } @@ -1164,99 +1153,66 @@ static NSRect constrain_frame_rect(NSRect frameRect, bool isFullscreen) external (RIF) call; for whole frame, called after update_window_end -------------------------------------------------------------------------- */ { - EmacsView *view = FRAME_NS_VIEW (f); - NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_update_end"); /* if (f == MOUSE_HL_INFO (f)->mouse_face_mouse_frame) */ MOUSE_HL_INFO (f)->mouse_face_defer = 0; - - block_input (); - - [view unlockFocus]; - [[view window] flushWindow]; - - unblock_input (); - ns_updating_frame = NULL; } -static void -ns_focus (struct frame *f, NSRect *r, int n) + +static BOOL +ns_clip_to_rect (struct frame *f, NSRect *r, int n) /* -------------------------------------------------------------------------- - Internal: Focus on given frame. During small local updates this is used to - draw, however during large updates, ns_update_begin and ns_update_end are - called to wrap the whole thing, in which case these calls are stubbed out. - Except, on GNUstep, we accumulate the rectangle being drawn into, because - the back end won't do this automatically, and will just end up flushing - the entire window. + Clip the drawing area to rectangle r in frame f. If drawing is not + currently possible mark r as dirty and return NO, otherwise return + YES. -------------------------------------------------------------------------- */ { - NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_focus"); - if (r != NULL) + NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_clip_to_rect"); + if (r) { NSTRACE_RECT ("r", *r); - } - if (f != ns_updating_frame) - { - NSView *view = FRAME_NS_VIEW (f); - if (view != focus_view) + if ([NSView focusView] == FRAME_NS_VIEW (f)) { - if (focus_view != NULL) - { - [focus_view unlockFocus]; - [[focus_view window] flushWindow]; -/*debug_lock--; */ - } + [[NSGraphicsContext currentContext] saveGraphicsState]; + if (n == 2) + NSRectClipList (r, 2); + else + NSRectClip (*r); + gsaved = YES; - if (view) - [view lockFocus]; - focus_view = view; -/*if (view) debug_lock++; */ + return YES; } - } - - /* clipping */ - if (r) - { - [[NSGraphicsContext currentContext] saveGraphicsState]; - if (n == 2) - NSRectClipList (r, 2); else - NSRectClip (*r); - gsaved = YES; + { + NSView *view = FRAME_NS_VIEW (f); + int i; + for (i = 0 ; i < n ; i++) + [view setNeedsDisplayInRect:r[i]]; + } } + + return NO; } static void -ns_unfocus (struct frame *f) -/* -------------------------------------------------------------------------- - Internal: Remove focus on given frame - -------------------------------------------------------------------------- */ +ns_reset_clipping (struct frame *f) +/* Internal: Restore the previous graphics state, unsetting any + clipping areas. */ { - NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_unfocus"); + NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_reset_clipping"); if (gsaved) { [[NSGraphicsContext currentContext] restoreGraphicsState]; gsaved = NO; } - - if (f != ns_updating_frame) - { - if (focus_view != NULL) - { - [focus_view unlockFocus]; - [[focus_view window] flushWindow]; - focus_view = NULL; -/*debug_lock--; */ - } - } } -static void +static BOOL ns_clip_to_row (struct window *w, struct glyph_row *row, enum glyph_row_area area, BOOL gc) /* -------------------------------------------------------------------------- @@ -1275,7 +1231,19 @@ static NSRect constrain_frame_rect(NSRect frameRect, bool isFullscreen) clip_rect.size.width = window_width; clip_rect.size.height = row->visible_height; - ns_focus (f, &clip_rect, 1); + return ns_clip_to_rect (f, &clip_rect, 1); +} + + +static void +ns_flush_display (struct frame *f) +/* Force the frame to redisplay. If areas have previously been marked + dirty by setNeedsDisplayInRect (in ns_clip_to_rect), then this will call + draw_rect: which will "expose" those areas. */ +{ + block_input (); + [FRAME_NS_VIEW (f) displayIfNeeded]; + unblock_input (); } @@ -2699,14 +2667,16 @@ so some key presses (TAB) are swallowed by the system. */ r = [view bounds]; block_input (); - ns_focus (f, &r, 1); - [ns_lookup_indexed_color (NS_FACE_BACKGROUND - (FACE_FROM_ID (f, DEFAULT_FACE_ID)), f) set]; - NSRectFill (r); - ns_unfocus (f); - - /* as of 2006/11 or so this is now needed */ - ns_redraw_scroll_bars (f); + if (ns_clip_to_rect (f, &r, 1)) + { + [ns_lookup_indexed_color (NS_FACE_BACKGROUND + (FACE_FROM_ID (f, DEFAULT_FACE_ID)), f) set]; + NSRectFill (r); + ns_reset_clipping (f); + + /* as of 2006/11 or so this is now needed */ + ns_redraw_scroll_bars (f); + } unblock_input (); } @@ -2727,13 +2697,14 @@ so some key presses (TAB) are swallowed by the system. */ NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_clear_frame_area"); r = NSIntersectionRect (r, [view frame]); - ns_focus (f, &r, 1); - [ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f) set]; + if (ns_clip_to_rect (f, &r, 1)) + { + [ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f) set]; - NSRectFill (r); + NSRectFill (r); - ns_unfocus (f); - return; + ns_reset_clipping (f); + } } static void @@ -2745,11 +2716,11 @@ so some key presses (TAB) are swallowed by the system. */ { hide_bell(); // Ensure the bell image isn't scrolled. - ns_focus (f, &dest, 1); + /* FIXME: scrollRect:by: is deprecated in macOS 10.14. There is + no obvious replacement so we may have to come up with our own. */ [FRAME_NS_VIEW (f) scrollRect: src by: NSMakeSize (dest.origin.x - src.origin.x, dest.origin.y - src.origin.y)]; - ns_unfocus (f); } } @@ -2960,85 +2931,86 @@ so some key presses (TAB) are swallowed by the system. */ } /* Must clip because of partially visible lines. */ - ns_clip_to_row (w, row, ANY_AREA, YES); - - if (!p->overlay_p) + if (ns_clip_to_row (w, row, ANY_AREA, YES)) { - int bx = p->bx, by = p->by, nx = p->nx, ny = p->ny; - - if (bx >= 0 && nx > 0) + if (!p->overlay_p) { - NSRect r = NSMakeRect (bx, by, nx, ny); - NSRectClip (r); - [ns_lookup_indexed_color (face->background, f) set]; - NSRectFill (r); - } - } + int bx = p->bx, by = p->by, nx = p->nx, ny = p->ny; - if (p->which) - { - NSRect r = NSMakeRect (p->x, p->y, p->wd, p->h); - EmacsImage *img = bimgs[p->which - 1]; - - if (!img) - { - // Note: For "periodic" images, allocate one EmacsImage for - // the base image, and use it for all dh:s. - unsigned short *bits = p->bits; - int full_height = p->h + p->dh; - int i; - unsigned char *cbits = xmalloc (full_height); - - for (i = 0; i < full_height; i++) - cbits[i] = bits[i]; - img = [[EmacsImage alloc] initFromXBM: cbits width: 8 - height: full_height - fg: 0 bg: 0]; - bimgs[p->which - 1] = img; - xfree (cbits); + if (bx >= 0 && nx > 0) + { + NSRect r = NSMakeRect (bx, by, nx, ny); + NSRectClip (r); + [ns_lookup_indexed_color (face->background, f) set]; + NSRectFill (r); + } } - NSTRACE_RECT ("r", r); + if (p->which) + { + NSRect r = NSMakeRect (p->x, p->y, p->wd, p->h); + EmacsImage *img = bimgs[p->which - 1]; - NSRectClip (r); - /* Since we composite the bitmap instead of just blitting it, we need - to erase the whole background. */ - [ns_lookup_indexed_color(face->background, f) set]; - NSRectFill (r); + if (!img) + { + // Note: For "periodic" images, allocate one EmacsImage for + // the base image, and use it for all dh:s. + unsigned short *bits = p->bits; + int full_height = p->h + p->dh; + int i; + unsigned char *cbits = xmalloc (full_height); + + for (i = 0; i < full_height; i++) + cbits[i] = bits[i]; + img = [[EmacsImage alloc] initFromXBM: cbits width: 8 + height: full_height + fg: 0 bg: 0]; + bimgs[p->which - 1] = img; + xfree (cbits); + } - { - NSColor *bm_color; - if (!p->cursor_p) - bm_color = ns_lookup_indexed_color(face->foreground, f); - else if (p->overlay_p) - bm_color = ns_lookup_indexed_color(face->background, f); - else - bm_color = f->output_data.ns->cursor_color; - [img setXBMColor: bm_color]; - } + NSTRACE_RECT ("r", r); -#ifdef NS_IMPL_COCOA - // Note: For periodic images, the full image height is "h + hd". - // By using the height h, a suitable part of the image is used. - NSRect fromRect = NSMakeRect(0, 0, p->wd, p->h); + NSRectClip (r); + /* Since we composite the bitmap instead of just blitting it, we need + to erase the whole background. */ + [ns_lookup_indexed_color(face->background, f) set]; + NSRectFill (r); - NSTRACE_RECT ("fromRect", fromRect); + { + NSColor *bm_color; + if (!p->cursor_p) + bm_color = ns_lookup_indexed_color(face->foreground, f); + else if (p->overlay_p) + bm_color = ns_lookup_indexed_color(face->background, f); + else + bm_color = f->output_data.ns->cursor_color; + [img setXBMColor: bm_color]; + } - [img drawInRect: r - fromRect: fromRect - operation: NSCompositingOperationSourceOver - fraction: 1.0 - respectFlipped: YES - hints: nil]; +#ifdef NS_IMPL_COCOA + // Note: For periodic images, the full image height is "h + hd". + // By using the height h, a suitable part of the image is used. + NSRect fromRect = NSMakeRect(0, 0, p->wd, p->h); + + NSTRACE_RECT ("fromRect", fromRect); + + [img drawInRect: r + fromRect: fromRect + operation: NSCompositingOperationSourceOver + fraction: 1.0 + respectFlipped: YES + hints: nil]; #else - { - NSPoint pt = r.origin; - pt.y += p->h; - [img compositeToPoint: pt operation: NSCompositingOperationSourceOver]; - } + { + NSPoint pt = r.origin; + pt.y += p->h; + [img compositeToPoint: pt operation: NSCompositingOperationSourceOver]; + } #endif + } + ns_reset_clipping (f); } - ns_unfocus (f); } @@ -3120,67 +3092,66 @@ Note that CURSOR_WIDTH is meaningful only for (h)bar cursors. r.size.height = h; r.size.width = w->phys_cursor_width; - /* Prevent the cursor from being drawn outside the text area. */ - ns_clip_to_row (w, glyph_row, TEXT_AREA, NO); /* do ns_focus(f, &r, 1); if remove */ - - - face = FACE_FROM_ID_OR_NULL (f, phys_cursor_glyph->face_id); - if (face && NS_FACE_BACKGROUND (face) - == ns_index_color (FRAME_CURSOR_COLOR (f), f)) + /* Prevent the cursor from being drawn outside the text area. */ + if (ns_clip_to_row (w, glyph_row, TEXT_AREA, NO)) { - [ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), f) set]; - hollow_color = FRAME_CURSOR_COLOR (f); - } - else - [FRAME_CURSOR_COLOR (f) set]; + face = FACE_FROM_ID_OR_NULL (f, phys_cursor_glyph->face_id); + if (face && NS_FACE_BACKGROUND (face) + == ns_index_color (FRAME_CURSOR_COLOR (f), f)) + { + [ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), f) set]; + hollow_color = FRAME_CURSOR_COLOR (f); + } + else + [FRAME_CURSOR_COLOR (f) set]; #ifdef NS_IMPL_COCOA - /* TODO: This makes drawing of cursor plus that of phys_cursor_glyph - atomic. Cleaner ways of doing this should be investigated. - One way would be to set a global variable DRAWING_CURSOR - when making the call to draw_phys..(), don't focus in that - case, then move the ns_unfocus() here after that call. */ - NSDisableScreenUpdates (); + /* TODO: This makes drawing of cursor plus that of phys_cursor_glyph + atomic. Cleaner ways of doing this should be investigated. + One way would be to set a global variable DRAWING_CURSOR + when making the call to draw_phys..(), don't focus in that + case, then move the ns_reset_clipping() here after that call. */ + NSDisableScreenUpdates (); #endif - switch (cursor_type) - { - case DEFAULT_CURSOR: - case NO_CURSOR: - break; - case FILLED_BOX_CURSOR: - NSRectFill (r); - break; - case HOLLOW_BOX_CURSOR: - NSRectFill (r); - [hollow_color set]; - NSRectFill (NSInsetRect (r, 1, 1)); - [FRAME_CURSOR_COLOR (f) set]; - break; - case HBAR_CURSOR: - NSRectFill (r); - break; - case BAR_CURSOR: - s = r; - /* If the character under cursor is R2L, draw the bar cursor - on the right of its glyph, rather than on the left. */ - cursor_glyph = get_phys_cursor_glyph (w); - if ((cursor_glyph->resolved_level & 1) != 0) - s.origin.x += cursor_glyph->pixel_width - s.size.width; - - NSRectFill (s); - break; - } - ns_unfocus (f); + switch (cursor_type) + { + case DEFAULT_CURSOR: + case NO_CURSOR: + break; + case FILLED_BOX_CURSOR: + NSRectFill (r); + break; + case HOLLOW_BOX_CURSOR: + NSRectFill (r); + [hollow_color set]; + NSRectFill (NSInsetRect (r, 1, 1)); + [FRAME_CURSOR_COLOR (f) set]; + break; + case HBAR_CURSOR: + NSRectFill (r); + break; + case BAR_CURSOR: + s = r; + /* If the character under cursor is R2L, draw the bar cursor + on the right of its glyph, rather than on the left. */ + cursor_glyph = get_phys_cursor_glyph (w); + if ((cursor_glyph->resolved_level & 1) != 0) + s.origin.x += cursor_glyph->pixel_width - s.size.width; + + NSRectFill (s); + break; + } + ns_reset_clipping (f); - /* draw the character under the cursor */ - if (cursor_type != NO_CURSOR) - draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); + /* draw the character under the cursor */ + if (cursor_type != NO_CURSOR) + draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); #ifdef NS_IMPL_COCOA - NSEnableScreenUpdates (); + NSEnableScreenUpdates (); #endif - + } } @@ -3198,12 +3169,14 @@ Note that CURSOR_WIDTH is meaningful only for (h)bar cursors. face = FACE_FROM_ID_OR_NULL (f, VERTICAL_BORDER_FACE_ID); - ns_focus (f, &r, 1); - if (face) - [ns_lookup_indexed_color(face->foreground, f) set]; + if (ns_clip_to_rect (f, &r, 1)) + { + if (face) + [ns_lookup_indexed_color(face->foreground, f) set]; - NSRectFill(r); - ns_unfocus (f); + NSRectFill(r); + ns_reset_clipping (f); + } } @@ -3230,39 +3203,40 @@ Note that CURSOR_WIDTH is meaningful only for (h)bar cursors. NSTRACE ("ns_draw_window_divider"); - ns_focus (f, ÷r, 1); - - if ((y1 - y0 > x1 - x0) && (x1 - x0 >= 3)) - /* A vertical divider, at least three pixels wide: Draw first and - last pixels differently. */ + if (ns_clip_to_rect (f, ÷r, 1)) { - [ns_lookup_indexed_color(color_first, f) set]; - NSRectFill(NSMakeRect (x0, y0, 1, y1 - y0)); - [ns_lookup_indexed_color(color, f) set]; - NSRectFill(NSMakeRect (x0 + 1, y0, x1 - x0 - 2, y1 - y0)); - [ns_lookup_indexed_color(color_last, f) set]; - NSRectFill(NSMakeRect (x1 - 1, y0, 1, y1 - y0)); - } - else if ((x1 - x0 > y1 - y0) && (y1 - y0 >= 3)) - /* A horizontal divider, at least three pixels high: Draw first and - last pixels differently. */ - { - [ns_lookup_indexed_color(color_first, f) set]; - NSRectFill(NSMakeRect (x0, y0, x1 - x0, 1)); - [ns_lookup_indexed_color(color, f) set]; - NSRectFill(NSMakeRect (x0, y0 + 1, x1 - x0, y1 - y0 - 2)); - [ns_lookup_indexed_color(color_last, f) set]; - NSRectFill(NSMakeRect (x0, y1 - 1, x1 - x0, 1)); - } - else - { - /* In any other case do not draw the first and last pixels - differently. */ - [ns_lookup_indexed_color(color, f) set]; - NSRectFill(divider); - } + if ((y1 - y0 > x1 - x0) && (x1 - x0 >= 3)) + /* A vertical divider, at least three pixels wide: Draw first and + last pixels differently. */ + { + [ns_lookup_indexed_color(color_first, f) set]; + NSRectFill(NSMakeRect (x0, y0, 1, y1 - y0)); + [ns_lookup_indexed_color(color, f) set]; + NSRectFill(NSMakeRect (x0 + 1, y0, x1 - x0 - 2, y1 - y0)); + [ns_lookup_indexed_color(color_last, f) set]; + NSRectFill(NSMakeRect (x1 - 1, y0, 1, y1 - y0)); + } + else if ((x1 - x0 > y1 - y0) && (y1 - y0 >= 3)) + /* A horizontal divider, at least three pixels high: Draw first and + last pixels differently. */ + { + [ns_lookup_indexed_color(color_first, f) set]; + NSRectFill(NSMakeRect (x0, y0, x1 - x0, 1)); + [ns_lookup_indexed_color(color, f) set]; + NSRectFill(NSMakeRect (x0, y0 + 1, x1 - x0, y1 - y0 - 2)); + [ns_lookup_indexed_color(color_last, f) set]; + NSRectFill(NSMakeRect (x0, y1 - 1, x1 - x0, 1)); + } + else + { + /* In any other case do not draw the first and last pixels + differently. */ + [ns_lookup_indexed_color(color, f) set]; + NSRectFill(divider); + } - ns_unfocus (f); + ns_reset_clipping (f); + } } static void @@ -3846,83 +3820,84 @@ Function modeled after x_draw_glyph_string_box (). n = ns_get_glyph_string_clip_rect (s, r); *r = NSMakeRect (s->x, s->y, s->background_width, s->height); - ns_focus (s->f, r, n); - - if (s->hl == DRAW_MOUSE_FACE) - { - face = FACE_FROM_ID_OR_NULL (s->f, - MOUSE_HL_INFO (s->f)->mouse_face_face_id); - if (!face) - face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); - } - else - face = FACE_FROM_ID (s->f, s->first_glyph->face_id); - - bgCol = ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), s->f); - fgCol = ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), s->f); - - for (i = 0; i < n; ++i) + if (ns_clip_to_rect (s->f, r, n)) { - if (!s->row->full_width_p) + if (s->hl == DRAW_MOUSE_FACE) { - int overrun, leftoverrun; - - /* truncate to avoid overwriting fringe and/or scrollbar */ - overrun = max (0, (s->x + s->background_width) - - (WINDOW_BOX_RIGHT_EDGE_X (s->w) - - WINDOW_RIGHT_FRINGE_WIDTH (s->w))); - r[i].size.width -= overrun; - - /* truncate to avoid overwriting to left of the window box */ - leftoverrun = (WINDOW_BOX_LEFT_EDGE_X (s->w) - + WINDOW_LEFT_FRINGE_WIDTH (s->w)) - s->x; - - if (leftoverrun > 0) - { - r[i].origin.x += leftoverrun; - r[i].size.width -= leftoverrun; - } - - /* XXX: Try to work between problem where a stretch glyph on - a partially-visible bottom row will clear part of the - modeline, and another where list-buffers headers and similar - rows erroneously have visible_height set to 0. Not sure - where this is coming from as other terms seem not to show. */ - r[i].size.height = min (s->height, s->row->visible_height); + face = FACE_FROM_ID_OR_NULL (s->f, + MOUSE_HL_INFO (s->f)->mouse_face_face_id); + if (!face) + face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); } + else + face = FACE_FROM_ID (s->f, s->first_glyph->face_id); - [bgCol set]; + bgCol = ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), s->f); + fgCol = ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), s->f); - /* NOTE: under NS this is NOT used to draw cursors, but we must avoid - overwriting cursor (usually when cursor on a tab) */ - if (s->hl == DRAW_CURSOR) + for (i = 0; i < n; ++i) { - CGFloat x, width; + if (!s->row->full_width_p) + { + int overrun, leftoverrun; + + /* truncate to avoid overwriting fringe and/or scrollbar */ + overrun = max (0, (s->x + s->background_width) + - (WINDOW_BOX_RIGHT_EDGE_X (s->w) + - WINDOW_RIGHT_FRINGE_WIDTH (s->w))); + r[i].size.width -= overrun; + + /* truncate to avoid overwriting to left of the window box */ + leftoverrun = (WINDOW_BOX_LEFT_EDGE_X (s->w) + + WINDOW_LEFT_FRINGE_WIDTH (s->w)) - s->x; + + if (leftoverrun > 0) + { + r[i].origin.x += leftoverrun; + r[i].size.width -= leftoverrun; + } + + /* XXX: Try to work between problem where a stretch glyph on + a partially-visible bottom row will clear part of the + modeline, and another where list-buffers headers and similar + rows erroneously have visible_height set to 0. Not sure + where this is coming from as other terms seem not to show. */ + r[i].size.height = min (s->height, s->row->visible_height); + } + + [bgCol set]; + + /* NOTE: under NS this is NOT used to draw cursors, but we must avoid + overwriting cursor (usually when cursor on a tab). */ + if (s->hl == DRAW_CURSOR) + { + CGFloat x, width; - x = r[i].origin.x; - width = s->w->phys_cursor_width; - r[i].size.width -= width; - r[i].origin.x += width; + x = r[i].origin.x; + width = s->w->phys_cursor_width; + r[i].size.width -= width; + r[i].origin.x += width; - NSRectFill (r[i]); + NSRectFill (r[i]); - /* Draw overlining, etc. on the cursor. */ - if (s->w->phys_cursor_type == FILLED_BOX_CURSOR) - ns_draw_text_decoration (s, face, bgCol, width, x); + /* Draw overlining, etc. on the cursor. */ + if (s->w->phys_cursor_type == FILLED_BOX_CURSOR) + ns_draw_text_decoration (s, face, bgCol, width, x); + else + ns_draw_text_decoration (s, face, fgCol, width, x); + } else - ns_draw_text_decoration (s, face, fgCol, width, x); - } - else - { - NSRectFill (r[i]); - } + { + NSRectFill (r[i]); + } - /* Draw overlining, etc. on the stretch glyph (or the part - of the stretch glyph after the cursor). */ - ns_draw_text_decoration (s, face, fgCol, r[i].size.width, - r[i].origin.x); + /* Draw overlining, etc. on the stretch glyph (or the part + of the stretch glyph after the cursor). */ + ns_draw_text_decoration (s, face, fgCol, r[i].size.width, + r[i].origin.x); + } + ns_reset_clipping (s->f); } - ns_unfocus (s->f); s->background_filled_p = 1; } } @@ -4072,9 +4047,11 @@ overwriting cursor (usually when cursor on a tab) */ if (next->first_glyph->type != STRETCH_GLYPH) { n = ns_get_glyph_string_clip_rect (s->next, r); - ns_focus (s->f, r, n); - ns_maybe_dumpglyphs_background (s->next, 1); - ns_unfocus (s->f); + if (ns_clip_to_rect (s->f, r, n)) + { + ns_maybe_dumpglyphs_background (s->next, 1); + ns_reset_clipping (s->f); + } } else { @@ -4089,10 +4066,12 @@ overwriting cursor (usually when cursor on a tab) */ || s->first_glyph->type == COMPOSITE_GLYPH)) { n = ns_get_glyph_string_clip_rect (s, r); - ns_focus (s->f, r, n); - ns_maybe_dumpglyphs_background (s, 1); - ns_dumpglyphs_box_or_relief (s); - ns_unfocus (s->f); + if (ns_clip_to_rect (s->f, r, n)) + { + ns_maybe_dumpglyphs_background (s, 1); + ns_dumpglyphs_box_or_relief (s); + ns_reset_clipping (s->f); + } box_drawn_p = 1; } @@ -4101,9 +4080,11 @@ overwriting cursor (usually when cursor on a tab) */ case IMAGE_GLYPH: n = ns_get_glyph_string_clip_rect (s, r); - ns_focus (s->f, r, n); - ns_dumpglyphs_image (s, r[0]); - ns_unfocus (s->f); + if (ns_clip_to_rect (s->f, r, n)) + { + ns_dumpglyphs_image (s, r[0]); + ns_reset_clipping (s->f); + } break; case STRETCH_GLYPH: @@ -4113,66 +4094,68 @@ overwriting cursor (usually when cursor on a tab) */ case CHAR_GLYPH: case COMPOSITE_GLYPH: n = ns_get_glyph_string_clip_rect (s, r); - ns_focus (s->f, r, n); + if (ns_clip_to_rect (s->f, r, n)) + { + if (s->for_overlaps || (s->cmp_from > 0 + && ! s->first_glyph->u.cmp.automatic)) + s->background_filled_p = 1; + else + ns_maybe_dumpglyphs_background + (s, s->first_glyph->type == COMPOSITE_GLYPH); - if (s->for_overlaps || (s->cmp_from > 0 - && ! s->first_glyph->u.cmp.automatic)) - s->background_filled_p = 1; - else - ns_maybe_dumpglyphs_background - (s, s->first_glyph->type == COMPOSITE_GLYPH); + if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type == FILLED_BOX_CURSOR) + { + unsigned long tmp = NS_FACE_BACKGROUND (s->face); + NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face); + NS_FACE_FOREGROUND (s->face) = tmp; + } - if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type == FILLED_BOX_CURSOR) - { - unsigned long tmp = NS_FACE_BACKGROUND (s->face); - NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face); - NS_FACE_FOREGROUND (s->face) = tmp; - } + { + BOOL isComposite = s->first_glyph->type == COMPOSITE_GLYPH; - { - BOOL isComposite = s->first_glyph->type == COMPOSITE_GLYPH; + if (isComposite) + ns_draw_composite_glyph_string_foreground (s); + else + ns_draw_glyph_string_foreground (s); + } - if (isComposite) - ns_draw_composite_glyph_string_foreground (s); - else - ns_draw_glyph_string_foreground (s); - } + { + NSColor *col = (NS_FACE_FOREGROUND (s->face) != 0 + ? ns_lookup_indexed_color (NS_FACE_FOREGROUND (s->face), + s->f) + : FRAME_FOREGROUND_COLOR (s->f)); + [col set]; + + /* Draw underline, overline, strike-through. */ + ns_draw_text_decoration (s, s->face, col, s->width, s->x); + } - { - NSColor *col = (NS_FACE_FOREGROUND (s->face) != 0 - ? ns_lookup_indexed_color (NS_FACE_FOREGROUND (s->face), - s->f) - : FRAME_FOREGROUND_COLOR (s->f)); - [col set]; - - /* Draw underline, overline, strike-through. */ - ns_draw_text_decoration (s, s->face, col, s->width, s->x); - } + if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type == FILLED_BOX_CURSOR) + { + unsigned long tmp = NS_FACE_BACKGROUND (s->face); + NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face); + NS_FACE_FOREGROUND (s->face) = tmp; + } - if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type == FILLED_BOX_CURSOR) - { - unsigned long tmp = NS_FACE_BACKGROUND (s->face); - NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face); - NS_FACE_FOREGROUND (s->face) = tmp; + ns_reset_clipping (s->f); } - - ns_unfocus (s->f); break; case GLYPHLESS_GLYPH: n = ns_get_glyph_string_clip_rect (s, r); - ns_focus (s->f, r, n); - - if (s->for_overlaps || (s->cmp_from > 0 - && ! s->first_glyph->u.cmp.automatic)) - s->background_filled_p = 1; - else - ns_maybe_dumpglyphs_background - (s, s->first_glyph->type == COMPOSITE_GLYPH); - /* ... */ - /* Not yet implemented. */ - /* ... */ - ns_unfocus (s->f); + if (ns_clip_to_rect (s->f, r, n)) + { + if (s->for_overlaps || (s->cmp_from > 0 + && ! s->first_glyph->u.cmp.automatic)) + s->background_filled_p = 1; + else + ns_maybe_dumpglyphs_background + (s, s->first_glyph->type == COMPOSITE_GLYPH); + /* ... */ + /* Not yet implemented. */ + /* ... */ + ns_reset_clipping (s->f); + } break; default: @@ -4183,9 +4166,11 @@ overwriting cursor (usually when cursor on a tab) */ if (!s->for_overlaps && !box_drawn_p && s->face->box != FACE_NO_BOX) { n = ns_get_glyph_string_clip_rect (s, r); - ns_focus (s->f, r, n); - ns_dumpglyphs_box_or_relief (s); - ns_unfocus (s->f); + if (ns_clip_to_rect (s->f, r, n)) + { + ns_dumpglyphs_box_or_relief (s); + ns_reset_clipping (s->f); + } } s->num_clips = 0; @@ -4991,7 +4976,7 @@ static Lisp_Object ns_string_to_lispmod (const char *s) ns_after_update_window_line, ns_update_window_begin, ns_update_window_end, - 0, /* flush_display */ + ns_flush_display, /* flush_display */ x_clear_window_mouse_face, x_get_glyph_overhangs, x_fix_overlapping_area, commit ac7421423cd977e96a8f06d12dc6abdbfcaabf5d Author: Stefan Monnier Date: Fri Sep 28 14:56:58 2018 -0400 * etc/NEWS.1-17: Use outline-mode and a more standard format diff --git a/etc/NEWS.1-17 b/etc/NEWS.1-17 index 63ef9a3855..cfa0b400cc 100644 --- a/etc/NEWS.1-17 +++ b/etc/NEWS.1-17 @@ -8,21 +8,21 @@ This file is about changes in emacs versions 1 through 17. -Changes in Emacs 17 +* Changes in Emacs 17 -* Frustrated? +** Frustrated? Try M-x doctor. -* Bored? +** Bored? Try M-x hanoi. -* Brain-damaged? +** Brain-damaged? Try M-x yow. -* Sun3, Tahoe, Apollo, HP9000s300, Celerity, NCR Tower 32, +** Sun3, Tahoe, Apollo, HP9000s300, Celerity, NCR Tower 32, Sequent, Stride, Encore, Plexus and AT&T 7300 machines supported. The Tahoe, Sun3, Sequent and Celerity use 4.2. In regard to the @@ -30,24 +30,24 @@ Apollo, see the file APOLLO in this directory. NCR Tower32, HP9000s300, Stride and Nu run forms of System V. System V rel 2 also works on Vaxes now. See etc/MACHINES. -* System V Unix supported, including subprocesses. +** System V Unix supported, including subprocesses. It should be possible now to bring up Emacs on a machine running mere unameliorated system V Unix with no major work; just possible bug fixes. But you can expect to find a handful of those on any machine that Emacs has not been run on before. -* Berkeley 4.1 Unix supported. +** Berkeley 4.1 Unix supported. See etc/MACHINES. -* Portable `alloca' provided. +** Portable `alloca' provided. Emacs can now run on machines that do not and cannot support the library subroutine `alloca' in the canonical fashion, using an `alloca' emulation written in C. -* On-line manual. +** On-line manual. Info now contains an Emacs manual, with essentially the same text as in the printed manual. @@ -57,7 +57,7 @@ The manual can now be printed with a standard TeX. Nicely typeset and printed copies of the manual are available from the Free Software Foundation. -* Backup file version numbers. +** Backup file version numbers. Emacs now supports version numbers in backup files. @@ -108,7 +108,7 @@ to keep, overriding `dired-kept-versions'. A negative argument specifies the number of oldest versions to keep, using minus the argument to override `kept-old-versions'. -* Immediate conflict detection. +** Immediate conflict detection. Emacs now locks the files it is modifying, so that if you start to modify within Emacs a file that is being @@ -130,27 +130,27 @@ directory. If such a directory is not provided and told to Emacs as part of configuring it for your machine, the lock feature is turned off. -* M-x recover-file. +** M-x recover-file. This command is used to get a file back from an auto-save (after a system crash, for example). It takes a file name as argument and visits that file, but gets the data from the file's last auto save rather than from the file itself. -* M-x normal-mode. +** M-x normal-mode. This command resets the current buffer's major mode and local variables to be as specified by the visit filename, the -*- line and/or the Local Variables: block at the end of the buffer. It is the same thing normally done when a file is first visited. -* Echo area messages disappear shortly if minibuffer is in use. +** Echo area messages disappear shortly if minibuffer is in use. Any message in the echo area disappears after 2 seconds if the minibuffer is active. This allows the minibuffer to become visible again. -* C-z on System V runs a subshell. +** C-z on System V runs a subshell. On systems which do not allow programs to be suspended, the C-z command forks a subshell that talks directly to the terminal, and then waits @@ -158,18 +158,18 @@ for the subshell to exit. This gets almost the effect of suspending in that you can run other programs and then return to Emacs. However, you cannot log out from the subshell. -* C-c is always a prefix character. +** C-c is always a prefix character. Also, subcommands of C-c which are letters are always reserved for the user. No standard Emacs major mode defines any of them. -* Picture mode C-c commands changed. +** Picture mode C-c commands changed. The old C-c k command is now C-c C-w. The old C-c y command is now C-c C-x. -* Shell mode commands changed. +** Shell mode commands changed. All the special commands of Shell mode are now moved onto the C-c prefix. Most are not changed aside from that. @@ -182,7 +182,7 @@ is now C-c C-o, and C-x C-v (show output) is now C-c C-r. The old M-= (copy previous input) command is now C-c C-y. -* Shell mode recognizes aliases for `pushd', `popd' and `cd'. +** Shell mode recognizes aliases for `pushd', `popd' and `cd'. Shell mode now uses the variable `shell-pushd-regexp' as a regular expression to recognize any command name that is @@ -194,13 +194,13 @@ There are also `shell-popd-regexp' to recognize commands with the effect of a `popd', and `shell-cd-regexp' to recognize commands with the effect of a `cd'. -* "Exit" command in certain modes now C-c C-c. +** "Exit" command in certain modes now C-c C-c. These include electric buffer menu mode, electric command history mode, Info node edit mode, and Rmail edit mode. In all these modes, the command to exit used to be just C-c. -* Outline mode changes. +** Outline mode changes. Lines that are not heading lines are now called "body" lines. The command `hide-text' is renamed to `hide-body'. @@ -212,7 +212,7 @@ Changes of line visibility are no longer undoable. As a result, they no longer use up undo memory and no longer interfere with undoing earlier commands. -* Rmail changes. +** Rmail changes. The s and q commands now both expunge deleted messages before saving; use C-x C-s to save without expunging. @@ -229,23 +229,23 @@ o now outputs to an Rmail file, and C-o to a Unix mail file. The F command (rmail-find) is renamed to M-s (rmail-search). Various new commands and features exist; see the Emacs manual. -* Local bindings described first in describe-bindings. +** Local bindings described first in describe-bindings. -* [...], {...} now balance in Fundamental mode. +** [...], {...} now balance in Fundamental mode. -* Nroff mode and TeX mode. +** Nroff mode and TeX mode. There are two new major modes for editing nroff input and TeX input. See the Emacs manual for full information. -* New C indentation style variable `c-brace-imaginary-offset'. +** New C indentation style variable `c-brace-imaginary-offset'. The value of `c-brace-imaginary-offset', normally zero, controls the indentation of a statement inside a brace-group where the open-brace is not the first thing on a line. The value says where the open-brace is imagined to be, relative to the first nonblank character on the line. -* Dired improvements. +** Dired improvements. Dired now normally keeps the cursor at the beginning of the file name, not at the beginning of the line. The most used motion commands are @@ -259,22 +259,22 @@ printed in an error message. If the `v' command is invoked on a file which is a directory, dired is run on that directory. -* `visit-tag-table' renamed `visit-tags-table'. +** `visit-tag-table' renamed `visit-tags-table'. This is so apropos of `tags' finds everything you need to know about in connection with Tags. -* `mh-e' library uses C-c as prefix. +** `mh-e' library uses C-c as prefix. All the special commands of `mh-rmail' now are placed on a C-c prefix rather than on the C-x prefix. This is for consistency with other special modes with their own commands. -* M-$ or `spell-word' checks word before point. +** M-$ or `spell-word' checks word before point. It used to check the word after point. -* Quitting during autoloading no longer causes trouble. +** Quitting during autoloading no longer causes trouble. Now, when a file is autoloaded, all function redefinitions and `provide' calls are recorded and are undone if you quit @@ -284,14 +284,14 @@ As a result, it no longer happens that some of the entry points which are normally autoloading have been defined already, but the entire file is not really present to support them. -* `else' can now be indented correctly in C mode. +** `else' can now be indented correctly in C mode. TAB in C mode now knows which `if' statement an `else' matches up with, and can indent the `else' correctly under the `if', even if the `if' contained such things as another `if' statement, or a `while' or `for' statement, with no braces around it. -* `batch-byte-compile' +** `batch-byte-compile' Runs byte-compile-file on the files specified on the command line. All the rest of the command line arguments are taken as files to @@ -300,7 +300,7 @@ Must be used only with -batch, and kills emacs on completion. Each file will be processed even if an error occurred previously. For example, invoke `emacs -batch -f batch-byte-compile *.el'. -* `-batch' changes. +** `-batch' changes. `-batch' now implies `-q': no init file is loaded by Emacs when `-batch' is used. Also, no `term/TERMTYPE.el' file is loaded. Auto @@ -313,7 +313,7 @@ One echo-area message that is not suppressed is the one that says that a file is being loaded. That is because you can prevent this message by passing `t' as the third argument to `load'. -* Display of search string in incremental search. +** Display of search string in incremental search. Now, when you type C-s or C-r to reuse the previous search string, that search string is displayed immediately in the echo area. @@ -321,23 +321,23 @@ string, that search string is displayed immediately in the echo area. Three dots are displayed after the search string while search is actually going on. -* View commands. +** View commands. The commands C-x ], C-x [, C-x /, C-x j and C-x o are now available inside `view-buffer' and `view-file', with their normal meanings. -* Full-width windows preferred. +** Full-width windows preferred. The ``other-window'' commands prefer other full width windows, and will split only full width windows. -* M-x rename-file can copy if necessary. +** M-x rename-file can copy if necessary. When used between different file systems, since actual renaming does not work, the old file will be copied and deleted. -* Within C-x ESC, you can pick the command to repeat. +** Within C-x ESC, you can pick the command to repeat. While editing a previous command to be repeated, inside C-x ESC, you can now use the commands M-p and M-n to pick an earlier or @@ -353,24 +353,24 @@ The command you finally execute using C-x ESC is added to the front of the command history, unless it is identical with the first thing in the command history. -* Use C-c C-c to exit from editing within Info. +** Use C-c C-c to exit from editing within Info. It used to be C-z for this. Somehow this use of C-z was left out when all the others were moved. The intention is that C-z should always suspend Emacs. -* Default arg to C-x < and C-x > now window width minus 2. +** Default arg to C-x < and C-x > now window width minus 2. These commands, which scroll the current window horizontally by a specified number of columns, now scroll a considerable distance rather than a single column if used with no argument. -* Auto Save Files Deleted. +** Auto Save Files Deleted. The default value of `delete-auto-save-files' is now `t', so that when you save a file for real, its auto save file is deleted. -* Rnews changes. +** Rnews changes. The N, P and J keys in Rnews are renamed to M-n, M-p and M-j. These keys move among newsgroups. @@ -382,7 +382,7 @@ this change, are eliminated. The s command for outputting the current article to a file is renamed as o, to be compatible with Rmail. -* Sendmail changes. +** Sendmail changes. If you have a ~/.mailrc file, Emacs searches it for mailing address aliases, and these aliases are expanded when you send mail in Emacs. @@ -407,15 +407,15 @@ The new variable `mail-header-separator' now specifies the string to use on the line that goes between the headers and the message text. By default it is still "--text follows this line--". -* Command history truncated automatically. +** Command history truncated automatically. Just before each garbage collection, all but the last 30 elements of the command history are discarded. -Incompatible Lisp Programming Changes in Emacs 17 +* Incompatible Lisp Programming Changes in Emacs 17 -* `"e' no longer supported. +** `"e' no longer supported. This feature, which allowed Lisp functions to take arguments that were not evaluated, has been eliminated, because it is @@ -434,7 +434,7 @@ with (defun foo-1 (x y z) ... -* Functions `region-to-string' and `region-around-match' removed. +** Functions `region-to-string' and `region-around-match' removed. These functions were made for compatibility with Gosling Emacs, but it turns out to be undesirable to use them in GNU Emacs because they use @@ -450,24 +450,24 @@ the two functions `match-beginning' and `match-end'. These give you one bound at a time, as a numeric value, without changing point or the mark. -* Function `function-type' removed. +** Function `function-type' removed. This just appeared not to be very useful. It can easily be written in Lisp if you happen to want it. Just use `symbol-function' to get the function definition of a symbol, and look at its data type or its car if it is a list. -* Variable `buffer-number' removed. +** Variable `buffer-number' removed. You can still use the function `buffer-number' to find out a buffer's unique number (assigned in order of creation). -* Variable `executing-macro' renamed `executing-kbd-macro'. +** Variable `executing-macro' renamed `executing-kbd-macro'. This variable is the currently executing keyboard macro, as a string, or `nil' when no keyboard macro is being executed. -* Loading term/$TERM. +** Loading term/$TERM. The library term/$TERM (where $TERM get replaced by your terminal type), which is done by Emacs automatically when it starts up, now @@ -478,12 +478,12 @@ term-$TERM; thus, for example, term-vt100.el, but now they live in a special subdirectory named term, and have names like term/vt100.el. -* `command-history' format changed. +** `command-history' format changed. The elements of this list are now Lisp expressions which can be evaluated directly to repeat a command. -* Unused editing commands removed. +** Unused editing commands removed. The functions `forward-to-word', `backward-to-word', `upcase-char', `mark-beginning-of-buffer' and `mark-end-of-buffer' @@ -491,9 +491,9 @@ have been removed. Their definitions can be found in file lisp/unused.el if you need them. -Upward Compatible Lisp Programming Changes in Emacs 17 +* Upward Compatible Lisp Programming Changes in Emacs 17 -* You can now continue after errors and quits. +** You can now continue after errors and quits. When the debugger is entered because of a C-g, due to a non-`nil' value of `debug-on-quit', the `c' command in the debugger @@ -513,7 +513,7 @@ is not valid, another error occurs. Errors signaled with the function `error' cannot be continued. If you try to continue, the error just happens again. -* `dot' renamed `point'. +** `dot' renamed `point'. The word `dot' has been replaced with `point' in all function and variable names, including: @@ -526,7 +526,7 @@ function and variable names, including: The old names are still supported, for now. -* `string-match' records position of end of match. +** `string-match' records position of end of match. After a successful call to `string-match', `(match-end 0)' will return the index in the string of the first character after the match. @@ -534,7 +534,7 @@ Also, `match-begin' and `match-end' with nonzero arguments can be used to find the indices of beginnings and ends of substrings matched by subpatterns surrounded by parentheses. -* New function `insert-before-markers'. +** New function `insert-before-markers'. This function is just like `insert' except in the handling of any relocatable markers that are located at the point of insertion. @@ -542,7 +542,7 @@ With `insert', such markers end up pointing before the inserted text. With `insert-before-markers', they end up pointing after the inserted text. -* New function `copy-alist'. +** New function `copy-alist'. This function takes one argument, a list, and makes a disjoint copy of the alist structure. The list itself is copied, and each element @@ -552,30 +552,30 @@ remain shared with the original argument. This is what it takes to get two alists disjoint enough that changes in one do not change the result of `assq' on the other. -* New function `copy-keymap'. +** New function `copy-keymap'. This function takes a keymap as argument and returns a new keymap containing initially the same bindings. Rebindings in either one of them will not alter the bindings in the other. -* New function `copy-syntax-table'. +** New function `copy-syntax-table'. This function takes a syntax table as argument and returns a new syntax table containing initially the same syntax settings. Changes in either one of them will not alter the other. -* Randomizing the random numbers. +** Randomizing the random numbers. `(random t)' causes the random number generator's seed to be set based on the current time and Emacs's process id. -* Third argument to `modify-syntax-entry'. +** Third argument to `modify-syntax-entry'. The optional third argument to `modify-syntax-entry', if specified should be a syntax table. The modification is made in that syntax table rather than in the current syntax table. -* New function `run-hooks'. +** New function `run-hooks'. This function takes any number of symbols as arguments. It processes the symbols in order. For each symbol which @@ -584,7 +584,7 @@ called as a function, with no arguments. This is useful in major mode commands. -* Second arg to `switch-to-buffer'. +** Second arg to `switch-to-buffer'. If this function is given a non-`nil' second argument, then the selection being done is not recorded on the selection history. @@ -592,7 +592,7 @@ The buffer's position in the history remains unchanged. This feature is used by the view commands, so that the selection history after exiting from viewing is the same as it was before. -* Second arg to `display-buffer' and `pop-to-buffer'. +** Second arg to `display-buffer' and `pop-to-buffer'. These two functions both accept an optional second argument which defaults to `nil'. If the argument is not `nil', it means that @@ -602,7 +602,7 @@ the selected window. This feature is used by `switch-to-buffer-other-window'. -* New variable `completion-ignore-case'. +** New variable `completion-ignore-case'. If this variable is non-`nil', completion allows strings in different cases to be considered matching. The global value @@ -614,13 +614,13 @@ to change the value globally, but you might not like the consequences in the many situations (buffer names, command names, file names) where case makes a difference. -* Major modes related to Text mode call text-mode-hook, then their own hooks. +** Major modes related to Text mode call text-mode-hook, then their own hooks. For example, turning on Outline mode first calls the value of `text-mode-hook' as a function, if it exists and is non-`nil', and then does likewise for the variable `outline-mode-hook'. -* Defining new command line switches. +** Defining new command line switches. You can define a new command line switch in your .emacs file by putting elements on the value of `command-switch-alist'. @@ -638,26 +638,26 @@ examine this variable, and do (setq command-line-args (cdr command-line-args) to "use up" an argument. -* New variable `load-in-progress'. +** New variable `load-in-progress'. This variable is non-`nil' when a file of Lisp code is being read and executed by `load'. -* New variable `print-length'. +** New variable `print-length'. The value of this variable is normally `nil'. It may instead be a number; in that case, when a list is printed by `prin1' or `princ' only that many initial elements are printed; the rest are replaced by `...'. -* New variable `find-file-not-found-hook'. +** New variable `find-file-not-found-hook'. If `find-file' or any of its variants is used on a nonexistent file, the value of `find-file-not-found-hook' is called (if it is not `nil') with no arguments, after creating an empty buffer. The file's name can be found as the value of `buffer-file-name'. -* Processes without buffers. +** Processes without buffers. In the function `start-process', you can now specify `nil' as the process's buffer. You can also set a process's buffer to `nil' @@ -672,7 +672,7 @@ When a process has no buffer, its output is lost unless it has a filter, and no indication of its being stopped or killed is given unless it has a sentinel. -* New function `user-variable-p'. `v' arg prompting changed. +** New function `user-variable-p'. `v' arg prompting changed. This function takes a symbol as argument and returns `t' if the symbol is defined as a user option variable. This means @@ -686,7 +686,7 @@ user variables. The function `read-variable' also now accepts and completes over user variables only. -* CBREAK mode input is the default in Unix 4.3 bsd. +** CBREAK mode input is the default in Unix 4.3 bsd. In Berkeley 4.3 Unix, there are sufficient features for Emacs to work fully correctly using CBREAK mode and not using SIGIO. @@ -695,7 +695,7 @@ This mode corresponds to `nil' as the first argument to `set-input-mode'. You can still select either mode by calling that function. -* Information on memory usage. +** Information on memory usage. The new variable `data-bytes-used' contains the number of bytes of impure space allocated in Emacs. @@ -704,18 +704,18 @@ Emacs could allocate. Note that space formerly allocated and freed again still counts as `used', since it is still in Emacs's address space. -* No limit on size of output from `format'. +** No limit on size of output from `format'. The string output from `format' used to be truncated to 100 characters in length. Now it can have any length. -* New errors `void-variable' and `void-function' replace `void-symbol'. +** New errors `void-variable' and `void-function' replace `void-symbol'. This change makes it possible to have error messages that clearly distinguish undefined variables from undefined functions. It also allows `condition-case' to handle one case without the other. -* `replace-match' handling of `\'. +** `replace-match' handling of `\'. In `replace-match', when the replacement is not literal, `\' in the replacement string is always treated as an @@ -728,19 +728,19 @@ This level of escaping is comparable with what goes on in a regular expression. It is over and above the level of `\' escaping that goes on when strings are read in Lisp syntax. -* New error `invalid-regexp'. +** New error `invalid-regexp'. A regexp search signals this type of error if the argument does not meet the rules for regexp syntax. -* `kill-emacs' with argument. +** `kill-emacs' with argument. If the argument is a number, it is returned as the exit status code of the Emacs process. If the argument is a string, its contents are stuffed as pending terminal input, to be read by another program after Emacs is dead. -* New fifth argument to `subst-char-in-region'. +** New fifth argument to `subst-char-in-region'. This argument is optional and defaults to `nil'. If it is not `nil', then the substitutions made by this function are not recorded @@ -749,7 +749,7 @@ in the Undo mechanism. This feature should be used with great care. It is now used by Outline mode to make lines visible or invisible. -* ` *Backtrace*' buffer renamed to `*Backtrace*'. +** ` *Backtrace*' buffer renamed to `*Backtrace*'. As a result, you can now reselect this buffer easily if you switch to another while in the debugger. @@ -757,7 +757,7 @@ another while in the debugger. Exiting from the debugger kills the `*Backtrace*' buffer, so you will not try to give commands in it when no longer really in the debugger. -* New function `switch-to-buffer-other-window'. +** New function `switch-to-buffer-other-window'. This is the new primitive to select a specified buffer (the argument) in another window. It is not quite the same as @@ -768,7 +768,7 @@ leave the current window's old buffer displayed as well. All functions to select a buffer in another window should do so by calling this new function. -* New variable `minibuffer-help-form'. +** New variable `minibuffer-help-form'. At entry to the minibuffer, the variable `help-form' is bound to the value of `minibuffer-help-form'. @@ -779,7 +779,7 @@ the definition of C-h as a command). `minibuffer-help-form' can be used to provide a different default way of handling C-h while in the minibuffer. -* New \{...} documentation construct. +** New \{...} documentation construct. It is now possible to set up the documentation string for a major mode in such a way that it always describes the contents @@ -799,23 +799,23 @@ For example, the documentation string for the function `c-mode' contains Variables controlling indentation style: ... -* New character syntax class "punctuation". +** New character syntax class "punctuation". Punctuation characters behave like whitespace in word and list parsing, but can be distinguished in regexps and in the function `char-syntax'. Punctuation syntax is represented by a period in `modify-syntax-entry'. -* `auto-mode-alist' no longer needs entries for backup-file names, +** `auto-mode-alist' no longer needs entries for backup-file names, Backup suffixes of all kinds are now stripped from a file's name before searching `auto-mode-alist'. -Changes in Emacs 16 +* Changes in Emacs 16 -* No special code for Ambassadors, VT-100's and Concept-100's. +** No special code for Ambassadors, VT-100's and Concept-100's. Emacs now controls these terminals based on the termcap entry, like all other terminals. Formerly it did not refer to the termcap entries @@ -827,24 +827,24 @@ fixing up the termcap entry. See ./TERMS for more info. See ./TERMS in any case if you find that some terminal does not work right with Emacs now. -* Minibuffer default completion character is TAB (and not ESC). +** Minibuffer default completion character is TAB (and not ESC). So that ESC can be used in minibuffer for more useful prefix commands. -* C-z suspends Emacs in all modes. +** C-z suspends Emacs in all modes. Formerly, C-z was redefined for other purposes by certain modes, such as Buffer Menu mode. Now other keys are used for those purposes, to keep the meaning of C-z uniform. -* C-x ESC (repeat-complex-command) allows editing the command it repeats. +** C-x ESC (repeat-complex-command) allows editing the command it repeats. Instead of asking for confirmation to re-execute a command from the command history, the command is placed, in its Lisp form, into the minibuffer for editing. You can confirm by typing RETURN, change some arguments and then confirm, or abort with C-g. -* Incremental search does less redisplay on slow terminals. +** Incremental search does less redisplay on slow terminals. If the terminal baud rate is <= the value of `isearch-slow-speed', incremental searching outside the text on the screen creates @@ -857,7 +857,7 @@ The initial value of `isearch-slow-speed' is 1200. This feature is courtesy of crl@purdue. -* Recursive minibuffers not allowed. +** Recursive minibuffers not allowed. If the minibuffer window is selected, most commands that would use the minibuffer gets an error instead. (Specific commands @@ -873,7 +873,7 @@ you can probably understand recursive minibuffers. This may be overridden by binding the variable `enable-recursive-minibuffers' to t. -* New major mode Emacs-Lisp mode, for editing Lisp code to run in Emacs. +** New major mode Emacs-Lisp mode, for editing Lisp code to run in Emacs. The mode in which emacs lisp files is edited is now called emacs-lisp-mode and is distinct from lisp-mode. The latter is intended for use with @@ -884,7 +884,7 @@ called emacs-lisp-mode-hook. A consequence of this changes is that .emacs init files which set the value of lisp-mode-hook may need to be changed to use the new names. -* Correct matching of parentheses is checked on insertion. +** Correct matching of parentheses is checked on insertion. When you insert a close-paren, the matching open-paren is checked for validity. The close paren must be the kind @@ -894,9 +894,9 @@ preceded by quoting backslash syntax character is not matched. This feature was originally written by shane@mit-ajax. -* M-x list-command-history -* M-x command-history-mode -* M-x electric-command-history +** M-x list-command-history +** M-x command-history-mode +** M-x electric-command-history `list-command-history' displays forms from the command history subject to user controlled filtering and limit on number of forms. It leaves @@ -913,7 +913,7 @@ which invoked `electric-command-history'. The original window configuration is restored on exit unless the command selected changes it. -* M-x edit-picture +** M-x edit-picture Enters a temporary major mode (the previous major mode is remembered and can is restored on exit) designed for editing pictures and tables. @@ -926,7 +926,7 @@ the documentation of function edit-picture for more details. Calls value of `edit-picture-hook' on entry if non-nil. -* Stupid C-s/C-q `flow control' supported. +** Stupid C-s/C-q `flow control' supported. Do (set-input-mode nil t) to tell Emacs to use CBREAK mode and interpret C-s and C-q as flow control commands. (set-input-mode t nil) switches @@ -955,18 +955,18 @@ The configuration switch CBREAK_INPUT is now eliminated. INTERRUPT_INPUT exists only to specify the default mode of operation; #define it to make interrupt-driven input the default. -* Completion of directory names provides a slash. +** Completion of directory names provides a slash. If file name completion yields the name of a directory, a slash is appended to it. -* Undo can clear modified-flag. +** Undo can clear modified-flag. If you undo changes in a buffer back to a state in which the buffer was not considered "modified", then it is labeled as once again "unmodified". -* M-x run-lisp. +** M-x run-lisp. This command creates an inferior Lisp process whose input and output appear in the Emacs buffer named `*lisp*'. That buffer uses a major mode @@ -977,21 +977,21 @@ lisp-mode-hook, in that order, if non-nil. Meanwhile, in lisp-mode, the command C-M-x is defined to send the current defun as input to the `*lisp*' subprocess. -* Mode line says `Narrow' when buffer is clipped. +** Mode line says `Narrow' when buffer is clipped. If a buffer has a clipping restriction (made by `narrow-to-region') then its mode line contains the word `Narrow' after the major and minor modes. -* Mode line says `Abbrev' when abbrev mode is on. +** Mode line says `Abbrev' when abbrev mode is on. -* add-change-log-entry takes prefix argument +** add-change-log-entry takes prefix argument Giving a prefix argument makes it prompt for login name, full name, and site name, with defaults. Otherwise the defaults are used with no confirmation. -* M-x view-buffer and M-x view-file +** M-x view-buffer and M-x view-file view-buffer selects the named buffer, view-file finds the named file; the resulting buffer is placed into view-mode (a recursive edit). The normal @@ -1004,7 +1004,7 @@ Each calls value of `view-hook' if non-nil on entry. written by shane@mit-ajax. -* New key commands in dired. +** New key commands in dired. `v' views (like more) the file on the current line. `#' marks auto-save files for deletion. @@ -1014,7 +1014,7 @@ file is renamed to same directory. `c' copies a file and updates the directory listing if the file is copied to the same directory. -* New function `electric-buffer-list'. +** New function `electric-buffer-list'. This pops up a buffer describing the set of emacs buffers. Immediately typing space makes the buffer list go away and returns @@ -1032,15 +1032,15 @@ Type C-h after invoking electric-buffer-list for more information. Calls value of `electric-buffer-menu-mode-hook' if non-nil on entry. Calls value of `after-electric-buffer-menu' on exit (select) if non-nil. -Changes in version 16 for mail reading and sending +** Changes in version 16 for mail reading and sending -* sendmail prefix character is C-c (and not C-z). New command C-c w. +*** sendmail prefix character is C-c (and not C-z). New command C-c w. For instance C-c C-c (or C-c C-s) sends mail now rather than C-z C-z. C-c w inserts your `signature' (contents of ~/.signature) at the end of mail. -* New feature in C-c y command in sending mail. +*** New feature in C-c y command in sending mail. C-c y is the command to insert the message being replied to. Normally it deletes most header fields and indents everything @@ -1050,7 +1050,7 @@ Now, C-c y does not delete header fields or indent. C-c y with any other numeric argument does delete most header fields, but indents by the amount specified in the argument. -* C-r command in Rmail edits current message. +*** C-r command in Rmail edits current message. It does this by switching to a different major mode which is nearly the same as Text mode. The only difference @@ -1063,31 +1063,31 @@ C-c and C-] are the only ways "back into Rmail", but you can switch to other buffers and edit them as usual. C-r in Rmail changes only the handling of the Rmail buffer. -* Rmail command `t' toggles header display. +*** Rmail command `t' toggles header display. Normally Rmail reformats messages to hide most header fields. `t' switches to display of all the header fields of the current message, as long as it remains current. Another `t' switches back to the usual display. -* Rmail command '>' goes to the last message. +*** Rmail command '>' goes to the last message. -* Rmail commands `a' and `k' set message attributes. +*** Rmail commands `a' and `k' set message attributes. `a' adds an attribute and `k' removes one. You specify the attribute by name. You can specify either a built-in flag such as "deleted" or "filed", or a user-defined keyword (anything not recognized as built-in). -* Rmail commands `l' and `L' summarize by attributes. +*** Rmail commands `l' and `L' summarize by attributes. These commands create a summary with one line per message, like `h', but they list only some of the messages. You specify which attribute (for `l') or attributes (for `L') the messages should have. -* Rmail can parse mmdf mail files. +*** Rmail can parse mmdf mail files. -* Interface to MH mail system. +*** Interface to MH mail system. mh-e is a front end for GNU emacs and the MH mail system. It provides a friendly and convenient interface to the MH commands. @@ -1103,9 +1103,9 @@ compiler switch. From larus@berkeley. -New hooks and parameters in version 16 +** New hooks and parameters in version 16 -* New variable `blink-matching-paren-distance'. +*** New variable `blink-matching-paren-distance'. This is the maximum number of characters to search for an open-paren to match an inserted close-paren. @@ -1118,13 +1118,13 @@ open-paren is found. This feature was originally written by shane@mit-ajax. -* New variable `find-file-run-dired' +*** New variable `find-file-run-dired' If nil, find-file will report an error if an attempt to visit a directory is detected; otherwise, it runs dired on that directory. The default is t. -* Variable `dired-listing-switches' holds switches given to `ls' by dired. +*** Variable `dired-listing-switches' holds switches given to `ls' by dired. The value should be a string containing `-' followed by letters. The letter `l' had better be included and letter 'F' had better be excluded! @@ -1132,12 +1132,12 @@ The default is "-al". This feature was originally written by shane@mit-ajax. -* New variable `display-time-day-and-date'. +*** New variable `display-time-day-and-date'. If this variable is set non-`nil', the function M-x display-time displays the day and date, as well as the time. -* New parameter `c-continued-statement-indent'. +*** New parameter `c-continued-statement-indent'. This controls the extra indentation given to a line that continues a C statement started on the previous line. @@ -1147,7 +1147,7 @@ By default it is 2, which is why you would see bar (); -* Changed meaning of `c-indent-level'. +*** Changed meaning of `c-indent-level'. The value of `c-brace-offset' used to be subtracted from the value of `c-indent-level' whenever @@ -1157,20 +1157,20 @@ As a result, `c-indent-level' is now the offset of statements within a block, relative to the line containing the open-brace that starts the block. -* turn-on-auto-fill is useful value for text-mode-hook. +*** turn-on-auto-fill is useful value for text-mode-hook. (setq text-mode-hook 'turn-on-auto-fill) is all you have to do to make sure Auto Fill mode is turned on whenever you enter Text mode. -* Parameter explicit-shell-file-name for M-x shell. +*** Parameter explicit-shell-file-name for M-x shell. This variable, if non-nil, specifies the file name to use for the shell to run if you do M-x shell. Changes in version 16 affecting Lisp programming: -* Documentation strings adapt to customization. +*** Documentation strings adapt to customization. Often the documentation string for a command wants to mention another command. Simply stating the other command as a @@ -1201,12 +1201,12 @@ The new function `substitute-command-keys' takes a string possibly containing \[...] constructs and replaces those constructs with the key sequences they currently stand for. -* Primitives `find-line-comment' and `find-line-comment-body' flushed. +*** Primitives `find-line-comment' and `find-line-comment-body' flushed. Search for the value of `comment-start-skip' if you want to find whether and where a line has a comment. -* New function `auto-save-file-name-p' +*** New function `auto-save-file-name-p' Should return non-`nil' if given a string which is the name of an auto-save file (sans directory name). If you redefine @@ -1214,11 +1214,11 @@ auto-save file (sans directory name). If you redefine default, this function returns `t' for filenames beginning with character `#'. -* The value of `exec-directory' now ends in a slash. +*** The value of `exec-directory' now ends in a slash. This is to be compatible with most directory names in GNU Emacs. -* Dribble files and termscript files. +*** Dribble files and termscript files. (open-dribble-file FILE) opens a dribble file named FILE. When a dribble file is open, every character Emacs reads from the terminal is @@ -1231,51 +1231,51 @@ are also written in the termscript file. The two of these together are very useful for debugging Emacs problems in redisplay. -* Upper case command characters by default are same as lower case. +*** Upper case command characters by default are same as lower case. If a character in a command is an upper case letter, and is not defined, Emacs uses the definition of the corresponding lower case letter. For example, if C-x U is not directly undefined, it is treated as a synonym for C-x u (undo). -* Undefined function errors versus undefined variable errors. +*** Undefined function errors versus undefined variable errors. Void-symbol errors now say "boundp" if the symbol's value was void or "fboundp" if the function definition was void. -* New function `bury-buffer'. +*** New function `bury-buffer'. The new function `bury-buffer' takes one argument, a buffer object, and puts that buffer at the end of the internal list of buffers. So it is the least preferred candidate for use as the default value of C-x b, or for other-buffer to return. -* Already-displayed buffers have low priority for display. +*** Already-displayed buffers have low priority for display. When a buffer is chosen automatically for display, or to be the default in C-x b, buffers already displayed in windows have lower priority than buffers not currently visible. -* `set-window-start' accepts a third argument NOFORCE. +*** `set-window-start' accepts a third argument NOFORCE. This argument, if non-nil, prevents the window's force_start flag from being set. Setting the force_start flag causes the next redisplay to insist on starting display at the specified starting point, even if dot must be moved to get it onto the screen. -* New function `send-string-to-terminal'. +*** New function `send-string-to-terminal'. This function takes one argument, a string, and outputs its contents to the terminal exactly as specified: control characters, escape sequences, and all. -* Keypad put in command mode. +*** Keypad put in command mode. The terminal's keypad is now put into command mode, as opposed to numeric mode, while Emacs is running. This is done by means of the termcap `ks' and `ke' strings. -* New function `generate-new-buffer' +*** New function `generate-new-buffer' This function takes a string as an argument NAME and looks for a creates and returns a buffer called NAME if one did not already exist. @@ -1283,12 +1283,12 @@ Otherwise, it successively tries appending suffixes of the form "<1>", "<2>" etc to NAME until it creates a string which does not name an existing buffer. A new buffer with that name is the created and returned. -* New function `prin1-to-string' +*** New function `prin1-to-string' This function takes one argument, a lisp object, and returns a string containing that object's printed representation, such as `prin1' would output. -* New function `read-from-minibuffer' +*** New function `read-from-minibuffer' Lets you supply a prompt, initial-contents, a keymap, and specify whether the result should be interpreted as a string or a lisp object. @@ -1296,23 +1296,23 @@ Old functions `read-minibuffer', `eval-minibuffer', `read-string' all take second optional string argument which is initial contents of minibuffer. -* minibuffer variable names changed (names of keymaps) +*** minibuffer variable names changed (names of keymaps) minibuf-local-map -> minibuffer-local-map minibuf-local-ns-map -> minibuffer-local-ns-map minibuf-local-completion-map -> minibuffer-local-completion-map minibuf-local-must-match-map -> minibuffer-local-must-match-map -Changes in version 16 affecting configuring and building Emacs +** Changes in version 16 affecting configuring and building Emacs -* Configuration switch VT100_INVERSE eliminated. +*** Configuration switch VT100_INVERSE eliminated. You can control the use of inverse video on any terminal by setting the variable `inverse-video', or by changing the termcap entry. If you like, set `inverse-video' in your `.emacs' file based on examination of (getenv "TERM"). -* New switch `-batch' makes Emacs run noninteractively. +*** New switch `-batch' makes Emacs run noninteractively. If the switch `-batch' is used, Emacs treats its standard output and input like ordinary files (even if they are a terminal). @@ -1330,22 +1330,22 @@ way to accomplish this. The Lisp variable `noninteractive' is now defined, to be `nil' except when `-batch' has been specified. -* Emacs can be built with output redirected to a file. +*** Emacs can be built with output redirected to a file. This is because -batch (see above) is now used in building Emacs. -Changes in Emacs 15 +* Changes in Emacs 15 -* Emacs now runs on Sun and Megatest 68000 systems; +** Emacs now runs on Sun and Megatest 68000 systems; also on at least one 16000 system running 4.2. -* Emacs now alters the output-start and output-stop characters +** Emacs now alters the output-start and output-stop characters to prevent C-s and C-q from being considered as flow control by cretinous rlogin software in 4.2. -* It is now possible convert Mocklisp code (for Gosling Emacs) to Lisp code +** It is now possible convert Mocklisp code (for Gosling Emacs) to Lisp code that can run in GNU Emacs. M-x convert-mocklisp-buffer converts the contents of the current buffer from Mocklisp to GNU Emacs Lisp. You should then save the converted buffer with C-x C-w @@ -1365,7 +1365,7 @@ Changes in Emacs 15 to GNU lisp code, with M-x convert-mocklisp-buffer being the first step in this process. -* Control-x n (narrow-to-region) is now by default a disabled command. +** Control-x n (narrow-to-region) is now by default a disabled command. This means that, if you issue this command, it will ask whether you really mean it. You have the opportunity to enable the @@ -1373,7 +1373,7 @@ Changes in Emacs 15 This will place the form "(put 'narrow-to-region 'disabled nil)" in your .emacs file. -* Tags now prompts for the tag table file name to use. +** Tags now prompts for the tag table file name to use. All the tags commands ask for the tag table file name if you have not yet specified one. @@ -1382,12 +1382,12 @@ Changes in Emacs 15 specify the tag table file name initially, or to switch to a new tag table. -* If truncate-partial-width-windows is non-nil (as it initially is), +** If truncate-partial-width-windows is non-nil (as it initially is), all windows less than the full screen width (that is, made by side-by-side splitting) truncate lines rather than continuing them. -* Emacs now checks for Lisp stack overflow to avoid fatal errors. +** Emacs now checks for Lisp stack overflow to avoid fatal errors. The depth in eval, apply and funcall may not exceed max-lisp-eval-depth. The depth in variable bindings and unwind-protects may not exceed max-specpdl-size. If either limit is exceeded, an error occurs. @@ -1395,7 +1395,7 @@ Changes in Emacs 15 too large, you are vulnerable to a fatal error if you invoke Lisp code that does infinite recursion. -* New hooks find-file-hook and write-file-hook. +** New hooks find-file-hook and write-file-hook. Both of these variables if non-nil should be functions of no arguments. At the time they are called (current-buffer) will be the buffer being read or written respectively. @@ -1409,13 +1409,13 @@ Changes in Emacs 15 write-file-hook is called just before writing out a file from a buffer. -* The initial value of shell-prompt-pattern is now "^[^#$%>]*[#$%>] *" +** The initial value of shell-prompt-pattern is now "^[^#$%>]*[#$%>] *" -* If the .emacs file sets inhibit-startup-message to non-nil, +** If the .emacs file sets inhibit-startup-message to non-nil, the messages normally printed by Emacs at startup time are inhibited. -* Facility for run-time conditionalization on the basis of emacs features. +** Facility for run-time conditionalization on the basis of emacs features. The new variable features is a list of symbols which represent "features" of the executing emacs, for use in run-time conditionalization. @@ -1438,14 +1438,14 @@ Changes in Emacs 15 (if (not featurep FEATURE) (error ...)))) FILE-NAME is optional and defaults to FEATURE. -* New function load-average. +** New function load-average. This returns a list of three integers, which are the current 1 minute, 5 minute and 15 minute load averages, each multiplied by a hundred (since normally they are floating point numbers). -* Per-terminal libraries loaded automatically. +** Per-terminal libraries loaded automatically. Emacs when starting up on terminal type T automatically loads a library named term-T. T is the value of the TERM environment variable. @@ -1457,7 +1457,7 @@ Changes in Emacs 15 redefinitions and let the user's init file, which is loaded later, call that command or not, as the user prefers. -* Programmer's note: detecting killed buffers. +** Programmer's note: detecting killed buffers. Buffers are eliminated by explicitly killing them, using the function kill-buffer. This does not eliminate or affect @@ -1466,7 +1466,7 @@ Changes in Emacs 15 the buffer has been killed, use the function buffer-name. It returns nil on a killed buffer, and a string on a live buffer. -* New ways to access the last command input character. +** New ways to access the last command input character. The function last-key-struck, which used to return the last input character that was read by command input, is eliminated. @@ -1479,13 +1479,13 @@ Changes in Emacs 15 read for. last-input-char and last-command-char are different only inside a command that has called read-char to read input. -* The new switch -kill causes Emacs to exit after processing the +** The new switch -kill causes Emacs to exit after processing the preceding command line arguments. Thus, emacs -l lib data -e do-it -kill means to load lib, find file data, call do-it on no arguments, and then exit. -* The config.h file has been modularized. +** The config.h file has been modularized. Options that depend on the machine you are running on are defined in a file whose name starts with "m-", such as m-vax.h. @@ -1499,25 +1499,25 @@ Changes in Emacs 15 select the correct m- and s- files but will never have to change their contents. -* Termcap AL and DL strings are understood. +** Termcap AL and DL strings are understood. If the termcap entry defines AL and DL strings, for insertion and deletion of multiple lines in one blow, Emacs now uses them. This matters most on certain bit map display terminals for which scrolling is comparatively slow. -* Bias against scrolling screen far on fast terminals. +** Bias against scrolling screen far on fast terminals. Emacs now prefers to redraw a few lines rather than shift them a long distance on the screen, when the terminal is fast. -* New major mode, mim-mode. +** New major mode, mim-mode. This major mode is for editing MDL code. Perhaps a MDL user can explain why it is not called mdl-mode. You must load the library mim-mode explicitly to use this. -* GNU documentation formatter `texinfo'. +** GNU documentation formatter `texinfo'. The `texinfo' library defines a format for documentation files which can be passed through Tex to make a printed manual @@ -1532,7 +1532,7 @@ Changes in Emacs 15 This is not ready for distribution yet, but will appear at a later time. -* New function read-from-string (emacs 15.29) +** New function read-from-string (emacs 15.29) read-from-string takes three arguments: a string to read from, and optionally start and end indices which delimit a substring @@ -1551,14 +1551,14 @@ Changes in Emacs 15 -Changes in Emacs 14 +* Changes in Emacs 14 -* Completion now prints various messages such as [Sole Completion] +** Completion now prints various messages such as [Sole Completion] or [Next Character Not Unique] to describe the results obtained. These messages appear after the text in the minibuffer, and remain on the screen until a few seconds go by or you type a key. -* The buffer-read-only flag is implemented. +** The buffer-read-only flag is implemented. Setting or binding this per-buffer variable to a non-nil value makes illegal any operation which would modify the textual content of the buffer. (Such operations signal a buffer-read-only error) @@ -1568,12 +1568,12 @@ Changes in Emacs 14 by default to prevent accidental damage to the information in those buffers. -* Functions car-safe and cdr-safe. +** Functions car-safe and cdr-safe. These functions are like car and cdr when the argument is a cons. Given an argument not a cons, car-safe always returns nil, with no error; the same for cdr-safe. -* The new function user-real-login-name returns the name corresponding +** The new function user-real-login-name returns the name corresponding to the real uid of the Emacs process. This is usually the same as what user-login-name returns; however, when Emacs is invoked from su, user-real-login-name returns "root" but user-login-name @@ -1581,9 +1581,9 @@ Changes in Emacs 14 -Changes in Emacs 13 +* Changes in Emacs 13 -* There is a new version numbering scheme. +** There is a new version numbering scheme. What used to be the first version number, which was 1, has been discarded since it does not seem that I need three @@ -1594,7 +1594,7 @@ Changes in Emacs 13 Emacs when I distribute it; it will be incremented each time Emacs is built at another site. -* There is now a reader syntax for Meta characters: +** There is now a reader syntax for Meta characters: \M-CHAR means CHAR or'ed with the Meta bit. For example: ?\M-x is (+ ?x 128) @@ -1608,7 +1608,7 @@ Changes in Emacs 13 ?\C- can be used likewise for control characters. (13.9) -* Installation change +** Installation change The string "../lisp" now adds to the front of the load-path used for searching for Lisp files during Emacs initialization. It used to replace the path specified in paths.h entirely. @@ -1617,13 +1617,13 @@ Changes in Emacs 13 -Changes in Emacs 1.12 +* Changes in Emacs 1.12 -* There is a new installation procedure. +** There is a new installation procedure. See the file INSTALL that comes in the top level directory in the tar file or tape. -* The Meta key is now supported on terminals that have it. +** The Meta key is now supported on terminals that have it. This is a shift key which causes the high bit to be turned on in all input characters typed while it is held down. @@ -1643,10 +1643,10 @@ Changes in Emacs 1.12 explicitly, but not effective if the character comes from the use of the Meta key. -* `-' is no longer a completion command in the minibuffer. +** `-' is no longer a completion command in the minibuffer. It is an ordinary self-inserting character. -* The list load-path of directories load to search for Lisp files +** The list load-path of directories load to search for Lisp files is now controlled by the EMACSLOADPATH environment variable [[ Note this was originally EMACS-LOAD-PATH and has been changed again; sh does not deal properly with hyphens in env variable names]] @@ -1658,7 +1658,7 @@ Changes in Emacs 1.12 ignore EMACSLOADPATH, however; you should avoid having this variable set while building Emacs. -* You can now specify a translation table for keyboard +** You can now specify a translation table for keyboard input characters, as a way of exchanging or substituting keys on the keyboard. @@ -1709,20 +1709,20 @@ Changes in Emacs 1.12 (aset keyboard-translate-table (+ 128 ?\_) (+ 128 ?\^?)) (aset keyboard-translate-table (+ 128 ?\^?) (+ 128 ?\_)) -* (process-kill-without-query PROCESS) +** (process-kill-without-query PROCESS) This marks the process so that, when you kill Emacs, you will not on its account be queried about active subprocesses. -Changes in Emacs 1.11 +* Changes in Emacs 1.11 -* The commands C-c and C-z have been interchanged, +** The commands C-c and C-z have been interchanged, for greater compatibility with normal Unix usage. C-z now runs suspend-emacs and C-c runs exit-recursive-edit. -* The value returned by file-name-directory now ends +** The value returned by file-name-directory now ends with a slash. (file-name-directory "foo/bar") => "foo/". This avoids confusing results when dealing with files in the root directory. @@ -1730,13 +1730,13 @@ Changes in Emacs 1.11 The value of the per-buffer variable default-directory is also supposed to have a final slash now. -* There are now variables to control the switches passed to +** There are now variables to control the switches passed to `ls' by the C-x C-d command (list-directory). list-directory-brief-switches is a string, initially "-CF", used for brief listings, and list-directory-verbose-switches is a string, initially "-l", used for verbose ones. -* For Ann Arbor Ambassador terminals, the termcap "ti" string +** For Ann Arbor Ambassador terminals, the termcap "ti" string is now used to initialize the screen geometry on entry to Emacs, and the "te" string is used to set it back on exit. If the termcap entry does not define the "ti" or "te" string, @@ -1744,36 +1744,36 @@ Changes in Emacs 1.11 -Changes in Emacs 1.10 +* Changes in Emacs 1.10 -* GNU Emacs has been made almost 1/3 smaller. +** GNU Emacs has been made almost 1/3 smaller. It now dumps out as only 530kbytes on Vax 4.2bsd. -* The term "checkpoint" has been replaced by "auto save" +** The term "checkpoint" has been replaced by "auto save" throughout the function names, variable names and documentation of GNU Emacs. -* The function load now tries appending ".elc" and ".el" +** The function load now tries appending ".elc" and ".el" to the specified filename BEFORE it tries the filename without change. -* rmail now makes the mode line display the total number +** rmail now makes the mode line display the total number of messages and the current message number. The "f" command now means forward a message to another user. The command to search through all messages for a string is now "F". The "u" command now means to move back to the previous message and undelete it. To undelete the selected message, use Meta-u. -* The hyphen character is now equivalent to a Space while +** The hyphen character is now equivalent to a Space while in completing minibuffers. Both mean to complete an additional word. -* The Lisp function error now takes args like format +** The Lisp function error now takes args like format which are used to construct the error message. -* Redisplay will refuse to start its display at the end of the buffer. +** Redisplay will refuse to start its display at the end of the buffer. It will pick a new place to display from, rather than use that. -* The value returned by garbage-collect has been changed. +** The value returned by garbage-collect has been changed. Its first element is no longer a number but a cons, whose car is the number of cons cells now in use, and whose cdr is the number of cons cells that have been @@ -1781,42 +1781,42 @@ Changes in Emacs 1.10 The second element is similar but describes symbols rather than cons cells. The third element is similar but describes markers. -* The variable buffer-name has been eliminated. +** The variable buffer-name has been eliminated. The function buffer-name still exists. This is to prevent user programs from changing buffer names without going through the rename-buffer function. -Changes in Emacs 1.9 +* Changes in Emacs 1.9 -* When a fill prefix is in effect, paragraphs are started +** When a fill prefix is in effect, paragraphs are started or separated by lines that do not start with the fill prefix. Also, a line which consists of the fill prefix followed by white space separates paragraphs. -* C-x C-v runs the new function find-alternate-file. +** C-x C-v runs the new function find-alternate-file. It finds the specified file, switches to that buffer, and kills the previous current buffer. (It requires confirmation if that buffer had changes.) This is most useful after you find the wrong file due to a typo. -* Exiting the minibuffer moves the cursor to column 0, +** Exiting the minibuffer moves the cursor to column 0, to show you that it has really been exited. -* Meta-g (fill-region) now fills each paragraph in the +** Meta-g (fill-region) now fills each paragraph in the region individually. To fill the region as if it were a single paragraph (for when the paragraph-delimiting mechanism does the wrong thing), use fill-region-as-paragraph. -* Tab in text mode now runs the function tab-to-tab-stop. +** Tab in text mode now runs the function tab-to-tab-stop. A new mode called indented-text-mode is like text-mode except that in it Tab runs the function indent-relative, which indents the line under the previous line. If auto fill is enabled while in indented-text-mode, the new lines that it makes are indented. -* Functions kill-rectangle and yank-rectangle. +** Functions kill-rectangle and yank-rectangle. kill-rectangle deletes the rectangle specified by dot and mark (or by two arguments) and saves it in the variable killed-rectangle. yank-rectangle inserts the rectangle in that variable. @@ -1826,7 +1826,7 @@ Changes in Emacs 1.9 not be changed if the rectangle is later reinserted at a different column position. -* `+' in a regular expression now means +** `+' in a regular expression now means to repeat the previous expression one or more times. `?' means to repeat it zero or one time. They are in all regards like `*' except for the @@ -1836,19 +1836,19 @@ Changes in Emacs 1.9 when it is at the beginning of a word; \> matches the null string at the end of a word. -* C-x p narrows the buffer so that only the current page +** C-x p narrows the buffer so that only the current page is visible. -* C-x ) with argument repeats the kbd macro just +** C-x ) with argument repeats the kbd macro just defined that many times, counting the definition as one repetition. -* C-x ( with argument begins defining a kbd macro +** C-x ( with argument begins defining a kbd macro starting with the last one defined. It executes that previous kbd macro initially, just as if you began by typing it over again. -* C-x q command queries the user during kbd macro execution. +** C-x q command queries the user during kbd macro execution. With prefix argument, enters recursive edit, reading keyboard commands even within a kbd macro. You can give different commands each time the macro executes. @@ -1859,7 +1859,7 @@ Changes in Emacs 1.9 C-r -- enter a recursive edit, then on exit ask again for a character C-l -- redisplay screen and ask again." -* write-kbd-macro and append-kbd-macro are used to save +** write-kbd-macro and append-kbd-macro are used to save a kbd macro definition in a file (as Lisp code to redefine the macro when the file is loaded). These commands differ in that write-kbd-macro @@ -1868,26 +1868,26 @@ Changes in Emacs 1.9 record the keys which invoke the macro as well as the macro's definition. -* The variable global-minor-modes is used to display +** The variable global-minor-modes is used to display strings in the mode line of all buffers. It should be a list of elements that are conses whose cdrs are strings to be displayed. This complements the variable minor-modes, which has the same effect but has a separate value in each buffer. -* C-x = describes horizontal scrolling in effect, if any. +** C-x = describes horizontal scrolling in effect, if any. -* Return now auto-fills the line it is ending, in auto fill mode. +** Return now auto-fills the line it is ending, in auto fill mode. Space with zero as argument auto-fills the line before it just like Space without an argument. -Changes in Emacs 1.8 +* Changes in Emacs 1.8 This release mostly fixes bugs. There are a few new features: -* apropos now sorts the symbols before displaying them. +** apropos now sorts the symbols before displaying them. Also, it returns a list of the symbols found. apropos now accepts a second arg PRED which should be a function @@ -1901,26 +1901,26 @@ This release mostly fixes bugs. There are a few new features: C-h a now runs the new function command-apropos rather than apropos, and shows only symbols with definitions as commands. -* M-x shell sends the command +** M-x shell sends the command if (-f ~/.emacs_NAME)source ~/.emacs_NAME invisibly to the shell when it starts. Here NAME is replaced by the name of shell used, as it came from your ESHELL or SHELL environment variable but with directory name, if any, removed. -* M-, now runs the command tags-loop-continue, which is used +** M-, now runs the command tags-loop-continue, which is used to resume a terminated tags-search or tags-query-replace. -Changes in Emacs 1.7 +* Changes in Emacs 1.7 It's Beat CCA Week. -* The initial buffer is now called "*scratch*" instead of "scratch", +** The initial buffer is now called "*scratch*" instead of "scratch", so that all buffer names used automatically by Emacs now have *'s. -* Undo information is now stored separately for each buffer. +** Undo information is now stored separately for each buffer. The Undo command (C-x u) always applies to the current buffer only. @@ -1932,7 +1932,7 @@ It's Beat CCA Week. kept for buffers whose names start with spaces. (These buffers also do not appear in the C-x C-b display.) -* Rectangle operations are now implemented. +** Rectangle operations are now implemented. C-x r stores the rectangle described by dot and mark into a register; it reads the register name from the keyboard. C-x g, the command to insert the contents of a register, @@ -1950,7 +1950,7 @@ It's Beat CCA Week. delete the text of the specified rectangle, moving the text beyond it on each line leftward. -* Side-by-side windows are allowed. Use C-x 5 to split the +** Side-by-side windows are allowed. Use C-x 5 to split the current window into two windows side by side. C-x } makes the selected window ARG columns wider at the expense of the windows at its sides. C-x { makes the selected @@ -1960,7 +1960,7 @@ It's Beat CCA Week. C-x 2 now accepts a numeric argument to specify the number of lines to give to the uppermost of the two windows it makes. -* Horizontal scrolling of the lines in a window is now implemented. +** Horizontal scrolling of the lines in a window is now implemented. C-x < (scroll-left) scrolls all displayed lines left, with the numeric argument (default 1) saying how far to scroll. When the window is scrolled left, some amount of the beginning @@ -1972,17 +1972,17 @@ It's Beat CCA Week. regardless of the value of the variable truncate-lines in the buffer being displayed. -* C-x C-d now uses the default output format of `ls', +** C-x C-d now uses the default output format of `ls', which gives just file names in multiple columns. C-u C-x C-d passes the -l switch to `ls'. -* C-t at the end of a line now exchanges the two preceding characters. +** C-t at the end of a line now exchanges the two preceding characters. All the transpose commands now interpret zero as an argument to mean to transpose the textual unit after or around dot with the one after or around the mark. -* M-! executes a shell command in an inferior shell +** M-! executes a shell command in an inferior shell and displays the output from it. With a prefix argument, it inserts the output in the current buffer after dot and sets the mark after the output. The shell command @@ -1992,10 +1992,10 @@ It's Beat CCA Week. as input to the shell command. A prefix argument makes the output from the command replace the contents of the region. -* The mode line will now say "Def" after the major mode +** The mode line will now say "Def" after the major mode while a keyboard macro is being defined. -* The variable fill-prefix is now used by Meta-q. +** The variable fill-prefix is now used by Meta-q. Meta-q removes the fill prefix from lines that start with it before filling, and inserts the fill prefix on each line after filling. @@ -2003,35 +2003,35 @@ It's Beat CCA Week. The command C-x . sets the fill prefix equal to the text on the current line before dot. -* The new command Meta-j (indent-new-comment-line), +** The new command Meta-j (indent-new-comment-line), is like Linefeed (indent-new-line) except when dot is inside a comment; in that case, Meta-j inserts a comment starter on the new line, indented under the comment starter above. It also inserts a comment terminator at the end of the line above, if the language being edited calls for one. -* Rmail should work correctly now, and has some C-h m documentation. +** Rmail should work correctly now, and has some C-h m documentation. -Changes in Emacs 1.6 +* Changes in Emacs 1.6 -* save-buffers-kill-emacs is now on C-x C-c +** save-buffers-kill-emacs is now on C-x C-c while C-x C-z does suspend-emacs. This is to make C-x C-c like the normal Unix meaning of C-c and C-x C-z like the normal Unix meaning of C-z. -* M-ESC (eval-expression) is now a disabled command by default. +** M-ESC (eval-expression) is now a disabled command by default. This prevents users who type ESC ESC accidentally from getting confusing results. Put (put 'eval-expression 'disabled nil) in your ~/.emacs file to enable the command. -* Self-inserting text is grouped into bunches for undoing. +** Self-inserting text is grouped into bunches for undoing. Each C-x u command undoes up to 20 consecutive self-inserting characters. -* Help f now uses as a default the function being called +** Help f now uses as a default the function being called in the innermost Lisp expression that dot is in. This makes it more convenient to use while writing Lisp code to run in Emacs. @@ -2041,7 +2041,7 @@ Changes in Emacs 1.6 Likewise, Help v uses the symbol around or before dot as a default, if that is a variable name. -* Commands that read filenames now insert the default +** Commands that read filenames now insert the default directory in the minibuffer, to become part of your input. This allows you to see what the default is. You may type a filename which goes at the end of the @@ -2060,13 +2060,13 @@ Changes in Emacs 1.6 Set the variable insert-default-directory to nil to turn off this feature. -* M-x shell now uses the environment variable ESHELL, +** M-x shell now uses the environment variable ESHELL, if it exists, as the file name of the shell to run. If there is no ESHELL variable, the SHELL variable is used. This is because some shells do not work properly as inferiors of Emacs (or anything like Emacs). -* A new variable minor-modes now exists, with a separate value +** A new variable minor-modes now exists, with a separate value in each buffer. Its value should be an alist of elements (MODE-FUNCTION-SYMBOL . PRETTY-NAME-STRING), one for each minor mode that is turned on in the buffer. The pretty @@ -2076,7 +2076,7 @@ Changes in Emacs 1.6 turn on the minor mode if given 1 as an argument; they are present so that Help m can find their documentation strings. -* The format of tag table files has been changed. +** The format of tag table files has been changed. The new format enables Emacs to find tags much faster. A new program, etags, exists to make the kind of @@ -2092,13 +2092,13 @@ Changes in Emacs 1.6 The tags library can no longer use standard ctags-style tag tables files. -* The file of Lisp code Emacs reads on startup is now +** The file of Lisp code Emacs reads on startup is now called ~/.emacs rather than ~/.emacs_pro. -* copy-file now gives the copied file the same mode bits +** copy-file now gives the copied file the same mode bits as the original file. -* Output from a process inserted into the process's buffer +** Output from a process inserted into the process's buffer no longer sets the buffer's mark. Instead it sets a marker associated with the process to point to the end of the inserted text. You can access this marker with @@ -2106,27 +2106,27 @@ Changes in Emacs 1.6 and then either examine its position with marker-position or set its position with set-marker. -* completing-read takes a new optional fifth argument which, +** completing-read takes a new optional fifth argument which, if non-nil, should be a string of text to insert into the minibuffer before reading user commands. -* The Lisp function elt now exists: +** The Lisp function elt now exists: (elt ARRAY N) is like (aref ARRAY N), (elt LIST N) is like (nth N LIST). -* rplaca is now a synonym for setcar, and rplacd for setcdr. +** rplaca is now a synonym for setcar, and rplacd for setcdr. eql is now a synonym for eq; it turns out that the Common Lisp distinction between eq and eql is insignificant in Emacs. numberp is a new synonym for integerp. -* auto-save has been renamed to auto-save-mode. +** auto-save has been renamed to auto-save-mode. -* Auto save file names for buffers are now created by the +** Auto save file names for buffers are now created by the function make-auto-save-file-name. This is so you can redefine that function to change the way auto save file names are chosen. -* expand-file-name no longer discards a final slash. +** expand-file-name no longer discards a final slash. (expand-file-name "foo" "/lose") => "/lose/foo" (expand-file-name "foo/" "/lose") => "/lose/foo/" @@ -2140,7 +2140,7 @@ Changes in Emacs 1.6 delete-file call expand-file-name on the file name supplied. This change makes them considerably faster in the usual case. -* Interactive calling spec strings allow the new code letter 'D' +** Interactive calling spec strings allow the new code letter 'D' which means to read a directory name. It is like 'f' except that the default if the user makes no change in the minibuffer is to return the current default directory rather than the @@ -2148,9 +2148,9 @@ Changes in Emacs 1.6 -Changes in Emacs 1.5 +* Changes in Emacs 1.5 -* suspend-emacs now accepts an optional argument +** suspend-emacs now accepts an optional argument which is a string to be stuffed as terminal input to be read by Emacs's superior shell after Emacs exits. @@ -2158,28 +2158,28 @@ Changes in Emacs 1.5 to transmit text to a Lisp job running as a sibling of Emacs. -* If find-file is given the name of a directory, +** If find-file is given the name of a directory, it automatically invokes dired on that directory rather than reading in the binary data that make up the actual contents of the directory according to Unix. -* Saving an Emacs buffer now preserves the file modes +** Saving an Emacs buffer now preserves the file modes of any previously existing file with the same name. This works using new Lisp functions file-modes and set-file-modes, which can be used to read or set the mode bits of any file. -* The Lisp function cond now exists, with its traditional meaning. +** The Lisp function cond now exists, with its traditional meaning. -* defvar and defconst now permit the documentation string +** defvar and defconst now permit the documentation string to be omitted. defvar also permits the initial value to be omitted; then it acts only as a comment. -Changes in Emacs 1.4 +* Changes in Emacs 1.4 -* Auto-filling now normally indents the new line it creates +** Auto-filling now normally indents the new line it creates by calling indent-according-to-mode. This function, meanwhile, has in Fundamental and Text modes the effect of making the line have an indentation of the value of left-margin, a per-buffer variable. @@ -2188,7 +2188,7 @@ Changes in Emacs 1.4 it does that in all modes that supply their own indentation routine, but in Fundamental, Text and allied modes it inserts a tab character. -* The command M-x grep now invokes grep (on arguments +** The command M-x grep now invokes grep (on arguments supplied by the user) and reads the output from grep asynchronously into a buffer. The command C-x ` can be used to move to the lines that grep has found. @@ -2199,35 +2199,35 @@ Changes in Emacs 1.4 is proceeding; as more matches or error messages arrive, C-x ` will parse them and be able to find them. -* M-x mail now provides a command to send the message +** M-x mail now provides a command to send the message and "exit"--that is, return to the previously selected buffer. It is C-z C-z. -* Tab in C mode now tries harder to adapt to all indentation styles. +** Tab in C mode now tries harder to adapt to all indentation styles. If the line being indented is a statement that is not the first one in the containing compound-statement, it is aligned under the beginning of the first statement. -* The functions screen-width and screen-height return the +** The functions screen-width and screen-height return the total width and height of the screen as it is now being used. set-screen-width and set-screen-height tell Emacs how big to assume the screen is; they each take one argument, an integer. -* The Lisp function 'function' now exists. function is the +** The Lisp function 'function' now exists. function is the same as quote, except that it serves as a signal to the Lisp compiler that the argument should be compiled as a function. Example: (mapcar (function (lambda (x) (+ x 5))) list) -* The function set-key has been renamed to global-set-key. +** The function set-key has been renamed to global-set-key. undefine-key and local-undefine-key has been renamed to global-unset-key and local-unset-key. -* Emacs now collects input from asynchronous subprocesses +** Emacs now collects input from asynchronous subprocesses while waiting in the functions sleep-for and sit-for. -* Shell mode's Newline command attempts to distinguish subshell +** Shell mode's Newline command attempts to distinguish subshell prompts from user input when issued in the middle of the buffer. It no longer reexecutes from dot to the end of the line; it reeexecutes the entire line minus any prompt. @@ -2237,9 +2237,9 @@ Changes in Emacs 1.4 -Changes in Emacs 1.3 +* Changes in Emacs 1.3 -* An undo facility exists now. Type C-x u to undo a batch of +** An undo facility exists now. Type C-x u to undo a batch of changes (usually one command's changes, but some commands such as query-replace divide their changes into multiple batches. You can repeat C-x u to undo further. As long @@ -2256,45 +2256,45 @@ Changes in Emacs 1.3 for each buffer, so it is mainly good if you do something totally spastic. [This has since been fixed.] -* A learn-by-doing tutorial introduction to Emacs now exists. +** A learn-by-doing tutorial introduction to Emacs now exists. Type C-h t to enter it. -* An Info documentation browser exists. Do M-x info to enter it. +** An Info documentation browser exists. Do M-x info to enter it. It contains a tutorial introduction so that no more documentation is needed here. As of now, the only documentation in it is that of Info itself. -* Help k and Help c are now different. Help c prints just the +** Help k and Help c are now different. Help c prints just the name of the function which the specified key invokes. Help k prints the documentation of the function as well. -* A document of the differences between GNU Emacs and Twenex Emacs +** A document of the differences between GNU Emacs and Twenex Emacs now exists. It is called DIFF, in the same directory as this file. -* C mode can now indent comments better, including multi-line ones. +** C mode can now indent comments better, including multi-line ones. Meta-Control-q now reindents comment lines within the expression being aligned. -* Insertion of a close-parenthesis now shows the matching open-parenthesis +** Insertion of a close-parenthesis now shows the matching open-parenthesis even if it is off screen, by printing the text following it on its line in the minibuffer. -* A file can now contain a list of local variable values +** A file can now contain a list of local variable values to be in effect when the file is edited. See the file DIFF in the same directory as this file for full details. -* A function nth is defined. It means the same thing as in Common Lisp. +** A function nth is defined. It means the same thing as in Common Lisp. -* The function install-command has been renamed to set-key. +** The function install-command has been renamed to set-key. It now takes the key sequence as the first argument and the definition for it as the second argument. Likewise, local-install-command has been renamed to local-set-key. -Changes in Emacs 1.2 +* Changes in Emacs 1.2 -* A Lisp single-stepping and debugging facility exists. +** A Lisp single-stepping and debugging facility exists. To cause the debugger to be entered when an error occurs, set the variable debug-on-error non-nil. @@ -2337,7 +2337,7 @@ Changes in Emacs 1.2 You can mark a frame to enter the debugger on exit with the `b' command, or clear such a mark with `u'. -* Lisp macros now exist. +** Lisp macros now exist. For example, you can write (defmacro cadr (arg) (list 'car (list 'cdr arg))) and then the expression @@ -2347,9 +2347,9 @@ Changes in Emacs 1.2 -Changes in Emacs 1.1 +* Changes in Emacs 1.1 -* The initial buffer is now called "scratch" and is in a +** The initial buffer is now called "scratch" and is in a new major mode, Lisp Interaction mode. This mode is intended for typing Lisp expressions, evaluating them, and having the values printed into the buffer. @@ -2360,31 +2360,31 @@ Changes in Emacs 1.1 The other commands of Lisp mode are available. -* The C-x C-e command for evaluating the Lisp expression +** The C-x C-e command for evaluating the Lisp expression before dot has been changed to print the value in the minibuffer line rather than insert it in the buffer. A numeric argument causes the printed value to appear in the buffer instead. -* In Lisp mode, the command M-C-x evaluates the defun +** In Lisp mode, the command M-C-x evaluates the defun containing or following dot. The value is printed in the minibuffer. -* The value of a Lisp expression evaluated using M-ESC +** The value of a Lisp expression evaluated using M-ESC is now printed in the minibuffer. -* M-q now runs fill-paragraph, independent of major mode. +** M-q now runs fill-paragraph, independent of major mode. -* C-h m now prints documentation on the current buffer's +** C-h m now prints documentation on the current buffer's major mode. What it prints is the documentation of the major mode name as a function. All major modes have been equipped with documentation that describes all commands peculiar to the major mode, for this purpose. -* You can display a Unix manual entry with +** You can display a Unix manual entry with the M-x manual-entry command. -* You can run a shell, displaying its output in a buffer, +** You can run a shell, displaying its output in a buffer, with the M-x shell command. The Return key sends input to the subshell. Output is printed inserted automatically in the buffer. Commands C-c, C-d, C-u, C-w and C-z are redefined @@ -2393,7 +2393,7 @@ Changes in Emacs 1.1 enter them, so that the default directory of the Emacs buffer always remains the same as that of the subshell. -* C-x $ (that's a real dollar sign) controls line-hiding based +** C-x $ (that's a real dollar sign) controls line-hiding based on indentation. With a numeric arg N > 0, it causes all lines indented by N or more columns to become invisible. They are, effectively, tacked onto the preceding line, where @@ -2408,7 +2408,7 @@ Changes in Emacs 1.1 C-x $ with no argument turns off this mode, which in any case is remembered separately for each buffer. -* Outline mode is another form of selective display. +** Outline mode is another form of selective display. It is a major mode invoked with M-x outline-mode. It is intended for editing files that are structured as outlines, with heading lines (lines that begin with one @@ -2429,12 +2429,12 @@ Changes in Emacs 1.1 All editing commands treat hidden outline-mode lines as part of the preceding visible line. -* C-x C-z runs save-buffers-kill-emacs +** C-x C-z runs save-buffers-kill-emacs offers to save each file buffer, then exits. -* C-c's function is now called suspend-emacs. +** C-c's function is now called suspend-emacs. -* The command C-x m runs mail, which switches to a buffer *mail* +** The command C-x m runs mail, which switches to a buffer *mail* and lets you compose a message to send. C-x 4 m runs mail in another window. Type C-z C-s in the mail buffer to send the message according to what you have entered in the buffer. @@ -2442,7 +2442,7 @@ Changes in Emacs 1.1 You must separate the headers from the message text with an empty line. -* You can now dired partial directories (specified with names +** You can now dired partial directories (specified with names containing *'s, etc, all processed by the shell). Also, you can dired more than one directory; dired names the buffer according to the filespec or directory name. Reinvoking @@ -2455,9 +2455,9 @@ Changes in Emacs 1.1 C-x C-d (list-directory) also allows partial directories now. -Lisp programming changes +** Lisp programming changes -* t as an output stream now means "print to the minibuffer". +*** t as an output stream now means "print to the minibuffer". If there is already text in the minibuffer printed via t as an output stream, the new text is appended to the old (or is truncated and lost at the margin). If the minibuffer @@ -2472,17 +2472,17 @@ Lisp programming changes is ignored; each `read' from t reads fresh input. t is now the top-level value of standard-input. -* A marker may be used as an input stream or an output stream. +*** A marker may be used as an input stream or an output stream. The effect is to grab input from where the marker points, advancing it over the characters read, or to insert output at the marker and advance it. -* Output from an asynchronous subprocess is now inserted at +*** Output from an asynchronous subprocess is now inserted at the end of the associated buffer, not at the buffer's dot, and the buffer's mark is set to the end of the inserted output each time output is inserted. -* (pos-visible-in-window-p POS WINDOW) +*** (pos-visible-in-window-p POS WINDOW) returns t if position POS in WINDOW's buffer is in the range that is being displayed in WINDOW; nil if it is scrolled vertically out of visibility. @@ -2493,18 +2493,18 @@ Lisp programming changes POS defaults to (dot), and WINDOW to (selected-window). -* Variable buffer-alist replaced by function (buffer-list). +*** Variable buffer-alist replaced by function (buffer-list). The actual alist of buffers used internally by Emacs is now no longer accessible, to prevent the user from crashing Emacs by modifying it. The function buffer-list returns a list of all existing buffers. Modifying this list cannot hurt anything as a new list is constructed by each call to buffer-list. -* load now takes an optional third argument NOMSG which, if non-nil, +*** load now takes an optional third argument NOMSG which, if non-nil, prevents load from printing a message when it starts and when it is done. -* byte-recompile-directory is a new function which finds all +*** byte-recompile-directory is a new function which finds all the .elc files in a directory, and regenerates each one which is older than the corresponding .el (Lisp source) file. @@ -2528,5 +2528,6 @@ along with GNU Emacs. If not, see . Local variables: +mode: outline mode: text end: commit 41fa88b99bebf7af62cdea0c0867b04e9b968db3 Author: Glenn Morris Date: Fri Sep 28 14:02:52 2018 -0400 ; Fix some doc typos diff --git a/lisp/cedet/ede/project-am.el b/lisp/cedet/ede/project-am.el index d3f0648350..e0fb111d07 100644 --- a/lisp/cedet/ede/project-am.el +++ b/lisp/cedet/ede/project-am.el @@ -532,7 +532,7 @@ DIR is the directory to apply to new targets." (project-rescan tmp) (setq ntargets (cons tmp ntargets))) (makefile-macro-file-list macro)) - ;; Non-indirect will have a target whos sources + ;; Non-indirect will have a target whose sources ;; are actual files, not names of other targets. (let ((files (makefile-macro-file-list macro))) (when files diff --git a/lisp/cedet/semantic/db-ref.el b/lisp/cedet/semantic/db-ref.el index 8f20fee954..40d8dbd58b 100644 --- a/lisp/cedet/semantic/db-ref.el +++ b/lisp/cedet/semantic/db-ref.el @@ -80,7 +80,7 @@ Abstract tables would be difficult to reference." (cl-defmethod semanticdb-check-references ((dbt semanticdb-table)) "Check and cleanup references in the database DBT. -Any reference to a file that cannot be found, or whos file no longer +Any reference to a file that cannot be found, or whose file no longer refers to DBT will be removed." (let ((refs (oref dbt db-refs)) (myexpr (concat "\\<" (oref dbt file))) diff --git a/lisp/cedet/semantic/scope.el b/lisp/cedet/semantic/scope.el index a2c68ed3a6..f18451fd59 100644 --- a/lisp/cedet/semantic/scope.el +++ b/lisp/cedet/semantic/scope.el @@ -140,7 +140,7 @@ Saves scoping information between runs of the analyzer.") (cl-defmethod semantic-scope-set-typecache ((cache semantic-scope-cache) types-in-scope) "Set the :typescope property on CACHE to some types. -TYPES-IN-SCOPE is a list of type tags whos members are +TYPES-IN-SCOPE is a list of type tags whose members are currently in scope. For each type in TYPES-IN-SCOPE, add those members to the types list. If nil, then the typescope is reset." commit 857c2c271080ef62e57128f531cee6e974ca28fb Author: Paul Eggert Date: Fri Sep 28 10:32:41 2018 -0700 Rename time-equal to time-equal-p This is for consistency with time-less-p. * doc/lispref/os.texi (Time Calculations), etc/NEWS: * src/editfns.c (Ftime_equal_p, syms_of_editfns): * test/lisp/emacs-lisp/timer-tests.el (timer-test-multiple-of-time): Rename. diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 400e6bb45c..8ce5a5ed6d 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -1739,7 +1739,7 @@ This returns @code{t} if time value @var{t1} is less than time value The result is @code{nil} if either argument is a NaN. @end defun -@defun time-equal t1 t2 +@defun time-equal-p t1 t2 This returns @code{t} if @var{t1} and @var{t2} are equal time values. The result is @code{nil} if either argument is a NaN. @end defun diff --git a/etc/NEWS b/etc/NEWS index 4dd4260b29..e6508eb60b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -957,7 +957,7 @@ infinities and NaNs too, and propagate them or return nil like floating-point operators do. +++ -** New function 'time-equal' compares time values for equality. +** New function 'time-equal-p' compares time values for equality. ** define-minor-mode automatically documents the meaning of ARG. diff --git a/src/editfns.c b/src/editfns.c index acd80bbf31..daea746387 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -1676,7 +1676,7 @@ See `current-time-string' for the various forms of a time value. */) return time_cmp (t1, t2) < 0 ? Qt : Qnil; } -DEFUN ("time-equal", Ftime_equal, Stime_equal, 2, 2, 0, +DEFUN ("time-equal-p", Ftime_equal_p, Stime_equal_p, 2, 2, 0, doc: /* Return non-nil if T1 and T2 are equal time values. */) (Lisp_Object t1, Lisp_Object t2) { @@ -5765,7 +5765,7 @@ it to be non-nil. */); defsubr (&Scurrent_time); defsubr (&Stime_add); defsubr (&Stime_subtract); - defsubr (&Stime_equal); + defsubr (&Stime_equal_p); defsubr (&Stime_less_p); defsubr (&Sget_internal_run_time); defsubr (&Sformat_time_string); diff --git a/test/lisp/emacs-lisp/timer-tests.el b/test/lisp/emacs-lisp/timer-tests.el index 0e40cdf442..c5971ee768 100644 --- a/test/lisp/emacs-lisp/timer-tests.el +++ b/test/lisp/emacs-lisp/timer-tests.el @@ -40,7 +40,7 @@ (should (debug-timer-check)) t)) (ert-deftest timer-test-multiple-of-time () - (should (time-equal + (should (time-equal-p (timer-next-integral-multiple-of-time '(0 0 0 1) (1+ (ash 1 53))) (list (ash 1 (- 53 16)) 1)))) commit 6aa93b45af9fb3631fb8fb6a04407db4d9a74107 Merge: 2d54710c36 1908173a4d Author: Glenn Morris Date: Fri Sep 28 07:54:24 2018 -0700 Merge from origin/emacs-26 1908173 (origin/emacs-26) Fix Bug#32828 7f5086d * lisp/net/shr.el (shr-copy-url): Fix docstring. d309994 Fix typos in documentation 25cdd65 ; Spellcheck two more documentation strings c8bda05 ; * lisp/simple.el (save-interprogram-paste-before-kill): Fix... dc7fdee * doc/emacs/kmacro.texi (Basic Keyboard Macro): Mention old b... 17766a1 Improve docs of functions/variables related to 'display-buffer' a363931 * lisp/mouse.el (tear-off-window): Fix non-mouse use (bug#32799) 8b8a4c0 Improve documentation of directory-local variables c9c9756 Don't use obsolete variable 'save-place' in documentation ca208e8 Use save-place-mode instead of save-place commit 2d54710c36c8b5f7e0d25eefd45c318c0cb533ea Author: Sam Steingold Date: Fri Sep 28 10:51:05 2018 -0400 lisp/vc/vc-git.el (vc-git-stash): Respect vc-dir marked files diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index ca457fb3d1..03afce5170 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1480,7 +1480,7 @@ This command shares argument histories with \\[rgrep] and \\[grep]." (interactive "sStash name: ") (let ((root (vc-git-root default-directory))) (when root - (vc-git--call nil "stash" "save" name) + (apply #'vc-git--call nil "stash" "push" "-m" name (vc-dir-marked-files)) (vc-resynch-buffer root t t)))) (defvar vc-git-stash-read-history nil commit 1908173a4d79649566fbef12962e251c69e300a2 Author: Michael Albinus Date: Fri Sep 28 12:51:25 2018 +0200 Fix Bug#32828 * lisp/net/dbus.el (dbus-init-bus): Return number of connections, as promised by the docstring. (Bug#32828) diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index f63ab9a15a..5f44c36034 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -1791,10 +1791,11 @@ GTK+. It should be used with care for at least the `:system' and this connection to those buses." (or (featurep 'dbusbind) (signal 'dbus-error (list "Emacs not compiled with dbus support"))) - (dbus--init-bus bus private) - (dbus-register-signal - bus nil dbus-path-local dbus-interface-local - "Disconnected" #'dbus-handle-bus-disconnect)) + (prog1 + (dbus--init-bus bus private) + (dbus-register-signal + bus nil dbus-path-local dbus-interface-local + "Disconnected" #'dbus-handle-bus-disconnect))) ;; Initialize `:system' and `:session' buses. This adds their file commit 06e2814e1f3a80d247675319d3c438989592fb06 Author: Paul Eggert Date: Thu Sep 27 18:28:27 2018 -0700 time-equal, and time values of infinity and NaN * doc/lispref/os.texi (Time Calculations): Document time-equal, and the behavior on NaNs and infinities of time-less-p, time-add, time-subtract. * etc/NEWS: Mention the change. * src/editfns.c (time_arith): Change last arg from function to bool. All callers changed. Do the right thing with infinities and NaNs. (time_cmp): New function, which handlesx infinities and NaNs. (Ftime_less_p): Use it. (Ftime_equal): New function. * test/lisp/emacs-lisp/timer-tests.el (timer-test-multiple-of-time): Use it. diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 8481fea806..67b78aea74 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -1736,17 +1736,26 @@ integer number stands for the number of seconds since the epoch. @defun time-less-p t1 t2 This returns @code{t} if time value @var{t1} is less than time value @var{t2}. +The result is @code{nil} if either argument is a NaN. +@end defun + +@defun time-equal t1 t2 +This returns @code{t} if @var{t1} and @var{t2} are equal time values. +The result is @code{nil} if either argument is a NaN. @end defun @defun time-subtract t1 t2 This returns the time difference @var{t1} @minus{} @var{t2} between -two time values, as a time value. If you need the difference in units +two time values, as a time value. However, the result is a float +if either argument is a float infinity or NaN@. +If you need the difference in units of elapsed seconds, use @code{float-time} (@pxref{Time of Day, float-time}) to convert the result into seconds. @end defun @defun time-add t1 t2 This returns the sum of two time values, as a time value. +However, the result is a float if either argument is a float infinity or NaN@. One argument should represent a time difference rather than a point in time, either as a list or as a single number of elapsed seconds. Here is how to add a number of seconds to a time value: diff --git a/etc/NEWS b/etc/NEWS index 2a609e4027..4dd4260b29 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -951,6 +951,14 @@ like file-attributes that compute file sizes and other attributes, functions like process-id that compute process IDs, and functions like user-uid and group-gid that compute user and group IDs. ++++ +** 'time-add', 'time-subtract', and 'time-less-p' now accept +infinities and NaNs too, and propagate them or return nil like +floating-point operators do. + ++++ +** New function 'time-equal' compares time values for equality. + ** define-minor-mode automatically documents the meaning of ARG. +++ diff --git a/src/editfns.c b/src/editfns.c index ec6e8ba98d..acd80bbf31 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -1589,13 +1589,21 @@ time_subtract (struct lisp_time ta, struct lisp_time tb) } static Lisp_Object -time_arith (Lisp_Object a, Lisp_Object b, - struct lisp_time (*op) (struct lisp_time, struct lisp_time)) +time_arith (Lisp_Object a, Lisp_Object b, bool subtract) { + if (FLOATP (a) && !isfinite (XFLOAT_DATA (a))) + { + double da = XFLOAT_DATA (a); + double db = XFLOAT_DATA (Ffloat_time (b)); + return make_float (subtract ? da - db : da + db); + } + if (FLOATP (b) && !isfinite (XFLOAT_DATA (b))) + return subtract ? make_float (-XFLOAT_DATA (b)) : b; + int alen, blen; struct lisp_time ta = lisp_time_struct (a, &alen); struct lisp_time tb = lisp_time_struct (b, &blen); - struct lisp_time t = op (ta, tb); + struct lisp_time t = (subtract ? time_subtract : time_add) (ta, tb); if (FIXNUM_OVERFLOW_P (t.hi)) time_overflow (); Lisp_Object val = Qnil; @@ -1623,7 +1631,7 @@ A nil value for either argument stands for the current time. See `current-time-string' for the various forms of a time value. */) (Lisp_Object a, Lisp_Object b) { - return time_arith (a, b, time_add); + return time_arith (a, b, false); } DEFUN ("time-subtract", Ftime_subtract, Stime_subtract, 2, 2, 0, @@ -1633,7 +1641,30 @@ A nil value for either argument stands for the current time. See `current-time-string' for the various forms of a time value. */) (Lisp_Object a, Lisp_Object b) { - return time_arith (a, b, time_subtract); + return time_arith (a, b, true); +} + +/* Return negative, 0, positive if a < b, a == b, a > b respectively. + Return positive if either a or b is a NaN; this is good enough + for the current callers. */ +static int +time_cmp (Lisp_Object a, Lisp_Object b) +{ + if ((FLOATP (a) && !isfinite (XFLOAT_DATA (a))) + || (FLOATP (b) && !isfinite (XFLOAT_DATA (b)))) + { + double da = FLOATP (a) ? XFLOAT_DATA (a) : 0; + double db = FLOATP (b) ? XFLOAT_DATA (b) : 0; + return da < db ? -1 : da != db; + } + + int alen, blen; + struct lisp_time ta = lisp_time_struct (a, &alen); + struct lisp_time tb = lisp_time_struct (b, &blen); + return (ta.hi != tb.hi ? (ta.hi < tb.hi ? -1 : 1) + : ta.lo != tb.lo ? (ta.lo < tb.lo ? -1 : 1) + : ta.us != tb.us ? (ta.us < tb.us ? -1 : 1) + : ta.ps < tb.ps ? -1 : ta.ps != tb.ps); } DEFUN ("time-less-p", Ftime_less_p, Stime_less_p, 2, 2, 0, @@ -1642,14 +1673,14 @@ A nil value for either argument stands for the current time. See `current-time-string' for the various forms of a time value. */) (Lisp_Object t1, Lisp_Object t2) { - int t1len, t2len; - struct lisp_time a = lisp_time_struct (t1, &t1len); - struct lisp_time b = lisp_time_struct (t2, &t2len); - return ((a.hi != b.hi ? a.hi < b.hi - : a.lo != b.lo ? a.lo < b.lo - : a.us != b.us ? a.us < b.us - : a.ps < b.ps) - ? Qt : Qnil); + return time_cmp (t1, t2) < 0 ? Qt : Qnil; +} + +DEFUN ("time-equal", Ftime_equal, Stime_equal, 2, 2, 0, + doc: /* Return non-nil if T1 and T2 are equal time values. */) + (Lisp_Object t1, Lisp_Object t2) +{ + return time_cmp (t1, t2) == 0 ? Qt : Qnil; } @@ -5734,6 +5765,7 @@ it to be non-nil. */); defsubr (&Scurrent_time); defsubr (&Stime_add); defsubr (&Stime_subtract); + defsubr (&Stime_equal); defsubr (&Stime_less_p); defsubr (&Sget_internal_run_time); defsubr (&Sformat_time_string); diff --git a/test/lisp/emacs-lisp/timer-tests.el b/test/lisp/emacs-lisp/timer-tests.el index 1d3ba757f6..0e40cdf442 100644 --- a/test/lisp/emacs-lisp/timer-tests.el +++ b/test/lisp/emacs-lisp/timer-tests.el @@ -40,10 +40,8 @@ (should (debug-timer-check)) t)) (ert-deftest timer-test-multiple-of-time () - (should (zerop - (float-time - (time-subtract - (timer-next-integral-multiple-of-time '(0 0 0 1) (1+ (ash 1 53))) - (list (ash 1 (- 53 16)) 1)))))) + (should (time-equal + (timer-next-integral-multiple-of-time '(0 0 0 1) (1+ (ash 1 53))) + (list (ash 1 (- 53 16)) 1)))) ;;; timer-tests.el ends here commit 7f5086da051aaf80e44db9d6f682a259ff1c686b Author: Noam Postavsky Date: Thu Sep 27 19:36:09 2018 -0400 * lisp/net/shr.el (shr-copy-url): Fix docstring. diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 5582e29c52..364f289e1a 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -302,9 +302,9 @@ under point instead." (defun shr-copy-url (url) "Copy the URL under point to the kill ring. -If IMAGE-URL (the prefix) is non-nil, or there is no link under -point, but there is an image under point then copy the URL of the -image under point instead." +With a prefix argument, or if there is no link under point, but +there is an image under point then copy the URL of the image +under point instead." (interactive (list (shr-url-at-point current-prefix-arg))) (if (not url) (message "No URL under point") commit d309994aff03200ed8ef9fadd98f69d6d3166701 Author: Eli Zaretskii Date: Thu Sep 27 18:48:06 2018 +0300 Fix typos in documentation * doc/misc/vhdl-mode.texi (Custom Indentation Functions): * doc/misc/url.texi (Customization): * doc/misc/tramp.texi (Overview): * doc/misc/srecode.texi (Developing Template Functions): * doc/misc/sieve.texi (Sieve Mode): * doc/misc/reftex.texi (Options - Creating Citations): * doc/misc/org.texi (Cooperation, Conflicts): * doc/misc/gnus.texi (Misc Group Stuff): * doc/misc/eshell.texi (Bugs and ideas): * doc/misc/calc.texi (Summary): * doc/man/emacsclient.1: * doc/lispref/os.texi (Security Considerations): * doc/lispref/control.texi (pcase Macro): * CONTRIBUTE: Fix typos. Reported by Mak Kolybabi (Bug#32853) diff --git a/CONTRIBUTE b/CONTRIBUTE index c4f424ce56..0b68052a0c 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -97,7 +97,7 @@ Otherwise do not mark it. If your change requires updating the manuals to document new functions/commands/variables/faces, then use the proper Texinfo command to index them; for instance, use @vindex for variables and -@findex for functions/commands. For the full list of predefine indices, see +@findex for functions/commands. For the full list of predefined indices, see https://www.gnu.org/software/texinfo/manual/texinfo/html_node/Predefined-Indices.html or run the shell command 'info "(texinfo)Predefined Indices"'. diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index 9e1bd6b3ec..5be4b298b4 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -791,7 +791,7 @@ Here are some important details about that usage. @enumerate @item When @var{symbol} occurs more than once in @var{seqpat}, -the second and subsequent occurances do not expand to re-binding, +the second and subsequent occurrences do not expand to re-binding, but instead expand to an equality test using @code{eq}. The following example features a @code{pcase} form diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index ed73a1c031..fd1cf638e7 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -3018,7 +3018,7 @@ Although Emacs normally respects access permissions of the underlying operating system, in some cases it handles accesses specially. For example, file names can have handlers that treat the files specially, with their own access checking. @xref{Magic File Names}. Also, a -buffer can be read-only even if the corresponding file is writeable, +buffer can be read-only even if the corresponding file is writable, and vice versa, which can result in messages such as @samp{File passwd is write-protected; try to save anyway? (yes or no)}. @xref{Read Only Buffers}. diff --git a/doc/man/emacsclient.1 b/doc/man/emacsclient.1 index daaacab7f3..5aaa6d1f08 100644 --- a/doc/man/emacsclient.1 +++ b/doc/man/emacsclient.1 @@ -1,7 +1,7 @@ .\" See section COPYING for conditions for redistribution. .TH EMACSCLIENT 1 .\" NAME should be all caps, SECTION should be 1-8, maybe w/ subsection -.\" other parms are allowed: see man(7), man(1) +.\" other params are allowed: see man(7), man(1) .SH NAME emacsclient \- tells a running Emacs to visit a file .SH SYNOPSIS diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index 5e11d35e90..fdec65a9a7 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi @@ -36249,7 +36249,7 @@ keystrokes are not listed in this summary. @c @r{ @: j + @:formula @: 27 @:calc-sel-add-both-sides@:} @r{ @: j - @:formula @: 27 @:calc-sel-sub-both-sides@:} -@r{ @: j * @:formula @: 27 @:calc-sel-mul-both-sides@:} +@r{ @: j * @:formula @: 27 @:calc-sel-mult-both-sides@:} @r{ @: j / @:formula @: 27 @:calc-sel-div-both-sides@:} @r{ @: j & @: @: 27 @:calc-sel-invert@:} diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index b0d5603e0c..ea1d070c2a 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -851,7 +851,7 @@ since. Make it so that the Lisp command on the right of the pipe is repeatedly called with the input strings as arguments. This will require changing -@code{eshell-do-pipeline} to handle non-process targets. +@code{eshell-do-pipelines} to handle non-process targets. @item Input redirection is not supported diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 6271cd6601..db0534e8a6 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -4442,7 +4442,7 @@ generated. It may be used to modify the buffer in some strange, unnatural way. @item gnus-group-prepared-hook -@vindex gnus-group-prepare-hook +@vindex gnus-group-prepared-hook is called as the very last thing after the group buffer has been generated. It may be used to move point around, for instance. diff --git a/doc/misc/org.texi b/doc/misc/org.texi index 88cdb5f951..60647e65e8 100644 --- a/doc/misc/org.texi +++ b/doc/misc/org.texi @@ -17993,7 +17993,7 @@ supports Imenu menus. Enable it with a mode hook as follows: @end lisp @vindex org-imenu-depth By default the Imenu index is two levels deep. Change the index depth using -thes variable, @code{org-imenu-depth}. +the variable @code{org-imenu-depth}. @item @file{speedbar.el} by Eric M. Ludlam @cindex @file{speedbar.el} @cindex Ludlam, Eric M. @@ -18067,7 +18067,7 @@ different replacement keys, look at the variable @code{org-disputed-keys}. @cindex @file{ecomplete.el} Ecomplete provides ``electric'' address completion in address header -lines in message buffers. Sadly Orgtbl mode cuts ecompletes power +lines in message buffers. Sadly Orgtbl mode cuts ecomplete's power supply: No completion happens when Orgtbl mode is enabled in message buffers while entering text in address header lines. If one wants to use ecomplete one should @emph{not} follow the advice to automagically diff --git a/doc/misc/reftex.texi b/doc/misc/reftex.texi index 2ea98cf5df..4367d773e6 100644 --- a/doc/misc/reftex.texi +++ b/doc/misc/reftex.texi @@ -4618,7 +4618,7 @@ return the string to insert into the buffer. @defopt reftex-cite-prompt-optional-args Non-@code{nil} means, prompt for empty optional arguments in cite macros. -When an entry in @code{reftex-cite-format} ist given with square brackets to +When an entry in @code{reftex-cite-format} is given with square brackets to indicate optional arguments (for example @samp{\\cite[][]@{%l@}}), RefTeX can prompt for values. Possible values are: @example diff --git a/doc/misc/sieve.texi b/doc/misc/sieve.texi index 2d290b3688..cad3cd8646 100644 --- a/doc/misc/sieve.texi +++ b/doc/misc/sieve.texi @@ -127,7 +127,7 @@ bindings to manage Sieve scripts remotely. @xref{Managing Sieve}. @kindex C-c RET @findex sieve-manage @cindex manage remote sieve script -Open a connection to a remote server using the Managesieve protocol. +Open a connection to a remote server using the Manage Sieve protocol. @item C-c C-l @kindex C-c C-l diff --git a/doc/misc/srecode.texi b/doc/misc/srecode.texi index 2987f62974..7d8416e901 100644 --- a/doc/misc/srecode.texi +++ b/doc/misc/srecode.texi @@ -1474,7 +1474,7 @@ to write your own function in order to provide your dictionaries with the values needed for custom templates. In this way, you can build your own code generator for any language -based on a set of predefined macros whos values you need to derive +based on a set of predefined macros whose values you need to derive from Emacs Lisp code yourself. For example: diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 222f6c86b9..6e02683707 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -300,7 +300,7 @@ into a buffer, and then deletes the temporary file. @item Edit, modify, change the buffer contents as normal, and then save the -buffer wth @kbd{C-x C-s}. +buffer with @kbd{C-x C-s}. @item @value{tramp} transfers the buffer contents to the remote host in diff --git a/doc/misc/url.texi b/doc/misc/url.texi index 1acf5f2319..04bbc48dd2 100644 --- a/doc/misc/url.texi +++ b/doc/misc/url.texi @@ -1335,7 +1335,7 @@ The User Agent string used for sending @acronym{HTTP}/@acronym{HTTPS} requests. The value should be @code{nil}, which means that no @samp{User-Agent} header is generated, @code{default}, which means that a string is generated based on the setting of -@code{url-privacy-leve}, a string or a function of no arguments that +@code{url-privacy-level}, a string or a function of no arguments that returns a string. The default is @code{default}, which means that the diff --git a/doc/misc/vhdl-mode.texi b/doc/misc/vhdl-mode.texi index 8fc75106d5..c0efdbf75f 100644 --- a/doc/misc/vhdl-mode.texi +++ b/doc/misc/vhdl-mode.texi @@ -734,7 +734,7 @@ operator on the first line of the statement. Here is the lisp code Custom indent functions take a single argument, which is a syntactic component cons cell (see @ref{Syntactic Analysis}). The function returns an integer offset value that will be added to the -running total indentation for the lne. Note that what actually gets +running total indentation for the line. Note that what actually gets returned is the difference between the column that the signal assignment operator is on, and the column of the buffer relative position passed in the function's argument. Remember that VHDL Mode automatically commit 21fc3227634c720128206980c72080dfc825a3de Author: Juri Linkov Date: Thu Sep 27 03:08:09 2018 +0300 * etc/NEWS: Mention syntax change in add-dir-local-variable (bug#32817) diff --git a/etc/NEWS b/etc/NEWS index bc6791b05b..2a609e4027 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -262,6 +262,12 @@ large files. Now it also offers a third alternative: to visit the file literally, as in 'find-file-literally', which speeds up navigation and editing of large files. +--- +** add-dir-local-variable now uses dotted pair notation syntax +to write alists of variables to .dir-locals.el. This is the same +syntax that you can see in the example of a .dir-locals.el file +in (info "(emacs) Directory Variables") + * Changes in Specialized Modes and Packages in Emacs 27.1 commit 500fb237764aa1ff5e245f38b9eff442b2ef6770 Author: Charles A. Roelli Date: Wed Sep 26 19:48:07 2018 +0200 * lisp/vc-bzr.el (log-view-current-tag-function): Remove unused defvar. diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index aa3d1443aa..8e1a6bec20 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -695,7 +695,6 @@ or a superior directory.") (defvar log-view-message-re) (defvar log-view-file-re) (defvar log-view-font-lock-keywords) -(defvar log-view-current-tag-function) (defvar log-view-per-file-logs) (defvar log-view-expanded-log-entry-function) commit 420faac11072cb6a956784b208fc28e83f40108e Author: Alan Mackenzie Date: Wed Sep 26 17:09:43 2018 +0000 CC Mode: consider tails of compound identifiers when seeking found types. * lisp/progmodes/cc-engine.el (c-forward-over-token): New function, extracted from ... (c-forward-over-token-and-ws): Refactor to use the above. (c-forward-type): Use c-check-qualified-type in place of c-check-type (twice). (c-forward-over-compound-identifier): New function. (c-check-qualified-type): New function. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 278ade0560..3ec7dbcc90 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -4295,6 +4295,41 @@ comment at the start of cc-engine.el for more info." "\\w\\|\\s_\\|\\s\"\\|\\s|" "\\w\\|\\s_\\|\\s\"")) +(defun c-forward-over-token (&optional balanced) + "Move forward over a token. +Return t if we moved, nil otherwise (i.e. we were at EOB, or a +non-token or BALANCED is non-nil and we can't move). If we +are at syntactic whitespace, move over this in place of a token. + +If BALANCED is non-nil move over any balanced parens we are at, and never move +out of an enclosing paren." + (let ((jump-syntax (if balanced + c-jump-syntax-balanced + c-jump-syntax-unbalanced)) + (here (point))) + (condition-case nil + (cond + ((/= (point) + (progn (c-forward-syntactic-ws) (point))) + ;; If we're at whitespace, count this as the token. + t) + ((eobp) nil) + ((looking-at jump-syntax) + (goto-char (scan-sexps (point) 1)) + t) + ((looking-at c-nonsymbol-token-regexp) + (goto-char (match-end 0)) + t) + ((save-restriction + (widen) + (looking-at c-nonsymbol-token-regexp)) + nil) + (t + (forward-char) + t)) + (error (goto-char here) + nil)))) + (defun c-forward-over-token-and-ws (&optional balanced) "Move forward over a token and any following whitespace Return t if we moved, nil otherwise (i.e. we were at EOB, or a @@ -4306,35 +4341,8 @@ out of an enclosing paren. This function differs from `c-forward-token-2' in that it will move forward over the final token in a buffer, up to EOB." - (let ((jump-syntax (if balanced - c-jump-syntax-balanced - c-jump-syntax-unbalanced)) - (here (point))) - (when - (condition-case nil - (cond - ((/= (point) - (progn (c-forward-syntactic-ws) (point))) - ;; If we're at whitespace, count this as the token. - t) - ((eobp) nil) - ((looking-at jump-syntax) - (goto-char (scan-sexps (point) 1)) - t) - ((looking-at c-nonsymbol-token-regexp) - (goto-char (match-end 0)) - t) - ((save-restriction - (widen) - (looking-at c-nonsymbol-token-regexp)) - nil) - (t - (forward-char) - t)) - (error (goto-char here) - nil)) - (c-forward-syntactic-ws) - t))) + (prog1 (c-forward-over-token balanced) + (c-forward-syntactic-ws))) (defun c-forward-token-2 (&optional count balanced limit) "Move forward by tokens. @@ -7662,7 +7670,7 @@ comment at the start of cc-engine.el for more info." (c-record-type-id id-range)) (unless res (setq res 'found))) - (setq res (if (c-check-type id-start id-end) + (setq res (if (c-check-qualified-type id-start) ;; It's an identifier that has been used as ;; a type somewhere else. 'found @@ -7674,7 +7682,7 @@ comment at the start of cc-engine.el for more info." (c-forward-syntactic-ws) (setq res (if (eq (char-after) ?\() - (if (c-check-type id-start id-end) + (if (c-check-qualified-type id-start) ;; It's an identifier that has been used as ;; a type somewhere else. 'found @@ -7799,6 +7807,37 @@ comment at the start of cc-engine.el for more info." (prog1 (car ,ps) (setq ,ps (cdr ,ps))))) +(defun c-forward-over-compound-identifier () + ;; Go over a possibly compound identifier, such as C++'s Foo::Bar::Baz, + ;; returning that identifier (with any syntactic WS removed). Return nil if + ;; we're not at an identifier. + (when (c-on-identifier) + (let ((consolidated "") (consolidated-:: "") + start end) + (while + (progn + (setq start (point)) + (c-forward-over-token) + (setq consolidated + (concat consolidated-:: + (buffer-substring-no-properties start (point)))) + (c-forward-syntactic-ws) + (and c-opt-identifier-concat-key + (looking-at c-opt-identifier-concat-key) + (progn + (setq start (point)) + (c-forward-over-token) + (setq end (point)) + (c-forward-syntactic-ws) + (and + (c-on-identifier) + (setq consolidated-:: + (concat consolidated + (buffer-substring-no-properties start end)))))))) + (if (equal consolidated "") + nil + consolidated)))) + (defun c-back-over-compound-identifier () ;; Point is putatively just after a "compound identifier", i.e. something ;; looking (in C++) like this "FQN::of::base::Class". Move to the start of @@ -7823,6 +7862,21 @@ comment at the start of cc-engine.el for more info." (goto-char end) t))) +(defun c-check-qualified-type (from) + ;; Look up successive tails of a (possibly) qualified type in + ;; `c-found-types'. If one of them matches, return it, else return nil. + (save-excursion + (goto-char from) + (let ((compound (c-forward-over-compound-identifier))) + (when compound + (while (and c-opt-identifier-concat-key + (> (length compound) 0) + (not (gethash compound c-found-types)) + (string-match c-opt-identifier-concat-key compound)) + (setq compound (substring compound (match-end 0)))) + (and (gethash compound c-found-types) + compound))))) + (defun c-back-over-member-initializer-braces () ;; Point is just after a closing brace/parenthesis. Try to parse this as a ;; C++ member initializer list, going back to just after the introducing ":" commit f1aa21a5b25b9371b42c267ef9ec557fa75ec95a Author: Juri Linkov Date: Tue Sep 25 22:40:23 2018 +0300 Rename add-dir-local-variables-to-string to dir-locals-to-string (bug#32817) diff --git a/lisp/files-x.el b/lisp/files-x.el index 201b7a47d5..9af399c87b 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -492,7 +492,7 @@ from the MODE alist ignoring the input argument VALUE." ;; Insert modified alist of directory-local variables. (insert ";;; Directory Local Variables\n") (insert ";;; For more information see (info \"(emacs) Directory Variables\")\n\n") - (princ (add-dir-local-variables-to-string + (princ (dir-locals-to-string (sort variables (lambda (a b) (cond @@ -505,18 +505,18 @@ from the MODE alist ignoring the input argument VALUE." (goto-char (point-min)) (indent-sexp)))) -(defun add-dir-local-variables-to-string (variables) +(defun dir-locals-to-string (variables) "Output alists of VARIABLES to string in dotted pair notation syntax." (format "(%s)" (mapconcat - (lambda (mode-variable) + (lambda (mode-variables) (format "(%S . %s)" - (car mode-variable) + (car mode-variables) (format "(%s)" (mapconcat (lambda (variable-value) - (format "(%s . %S)" + (format "(%S . %S)" (car variable-value) (cdr variable-value))) - (cdr mode-variable) "\n")))) + (cdr mode-variables) "\n")))) variables "\n"))) ;;;###autoload commit 25cdd65c4eeb34e7781c1d2bf38a245518e92185 Author: Charles A. Roelli Date: Tue Sep 25 21:33:00 2018 +0200 ; Spellcheck two more documentation strings * lisp/files.el (hack-local-variables): * src/keymap.c (Ftext_char_description): Spellcheck documentation. diff --git a/lisp/files.el b/lisp/files.el index a3e72e2ce9..9a8ed64e70 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3486,7 +3486,7 @@ DIR-NAME is the name of the associated directory. Otherwise it is nil." (defun hack-local-variables (&optional handle-mode) "Parse and put into effect this buffer's local variables spec. -For buffers visitying files, also puts into effect directory-local +For buffers visiting files, also puts into effect directory-local variables. Uses `hack-local-variables-apply' to apply the variables. diff --git a/src/keymap.c b/src/keymap.c index fe0781a7f2..f9c77ea99e 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -2287,7 +2287,7 @@ DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, doc: /* Return the description of CHARACTER in standard Emacs notation. CHARACTER must be a valid character code that passes the `characterp' test. Control characters turn into "^char", and characters with Meta and other -modifiers signal an error, as they are not valid characterr codes. +modifiers signal an error, as they are not valid character codes. This differs from `single-key-description' which accepts character events, and thus doesn't enforce the `characterp' condition, turns control characters into "C-char", and uses the 2**27 bit for Meta. commit c8bda0555c5e54f139a60b58741b1ae3228bc897 Author: Charles A. Roelli Date: Tue Sep 25 21:29:29 2018 +0200 ; * lisp/simple.el (save-interprogram-paste-before-kill): Fix documentation. diff --git a/lisp/simple.el b/lisp/simple.el index a51a5205ce..d5674aae9b 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -4324,7 +4324,7 @@ ring directly.") A non-nil value ensures that Emacs kill operations do not irrevocably overwrite existing clipboard text by saving it to the `kill-ring' prior to the kill. Such text can subsequently be -retrieved via \\[yank] \\[yank-pop]]." +retrieved via \\[yank] \\[yank-pop]." :type 'boolean :group 'killing :version "23.2") commit d0c77a189423dbf648ca5ae9d831a5a2e04e6947 Author: Paul Eggert Date: Mon Sep 24 19:13:34 2018 -0700 Remove some assumptions about timestamp format These changes remove some assumptions of Lisp code on timestamp format. Although we’re not going to change the default format any time soon, I went looking for code that was too intimate about details of timestamp format and removed assumptions where this was easy to do with current Emacs primitives. * lisp/ido.el (ido-wash-history): Fix test for zero timestamp. * lisp/time.el (display-time-event-handler): Use time-less-p rather than doing it by hand. (display-time-update): Simplify by using float-time instead of doing the equivalent by hand. * lisp/url/url-auth.el (url-digest-auth-make-cnonce): * test/lisp/calendar/parse-time-tests.el (parse-time-tests): * test/lisp/emacs-lisp/timer-tests.el (timer-test-multiple-of-time): * test/lisp/net/tramp-tests.el: (tramp-test19-directory-files-and-attributes) (tramp-test22-file-times, tramp-test23-visited-file-modtime): Don’t assume detailed format of returned Lisp timestamps. diff --git a/lisp/ido.el b/lisp/ido.el index 64d820333f..7bf4a92b22 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -1518,9 +1518,7 @@ Removes badly formatted data and ignored directories." (consp time) (cond ((integerp (car time)) - (and (/= (car time) 0) - (integerp (car (cdr time))) - (/= (car (cdr time)) 0) + (and (not (zerop (float-time time))) (ido-may-cache-directory dir))) ((eq (car time) 'ftp) (and (numberp (cdr time)) diff --git a/lisp/time.el b/lisp/time.el index f8d933d48a..bfecba9f9d 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -336,15 +336,10 @@ would give mode line times like `94/12/30 21:07:48 (UTC)'." (next-time (timer-relative-time (list (aref timer 1) (aref timer 2) (aref timer 3)) (* 5 (aref timer 4)) 0))) - ;; If the activation time is far in the past, + ;; If the activation time is not in the future, ;; skip executions until we reach a time in the future. ;; This avoids a long pause if Emacs has been suspended for hours. - (or (> (nth 0 next-time) (nth 0 current)) - (and (= (nth 0 next-time) (nth 0 current)) - (> (nth 1 next-time) (nth 1 current))) - (and (= (nth 0 next-time) (nth 0 current)) - (= (nth 1 next-time) (nth 1 current)) - (> (nth 2 next-time) (nth 2 current))) + (or (time-less-p current next-time) (progn (timer-set-time timer (timer-next-integral-multiple-of-time current display-time-interval) @@ -439,23 +434,16 @@ update which can wait for the next redisplay." ((and (stringp mail-spool-file) (or (null display-time-server-down-time) ;; If have been down for 20 min, try again. - (> (- (nth 1 now) display-time-server-down-time) - 1200) - (and (< (nth 1 now) display-time-server-down-time) - (> (- (nth 1 now) - display-time-server-down-time) - -64336)))) - (let ((start-time (current-time))) + (< 1200 (- (float-time now) + display-time-server-down-time)))) + (let ((start-time (float-time))) (prog1 (display-time-file-nonempty-p mail-spool-file) - (if (> (- (nth 1 (current-time)) - (nth 1 start-time)) - 20) - ;; Record that mail file is not accessible. - (setq display-time-server-down-time - (nth 1 (current-time))) - ;; Record that mail file is accessible. - (setq display-time-server-down-time nil))))))) + ;; Record whether mail file is accessible. + (setq display-time-server-down-time + (let ((end-time (float-time))) + (and (< 20 (- end-time start-time)) + end-time)))))))) (24-hours (substring time 11 13)) (hour (string-to-number 24-hours)) (12-hours (int-to-string (1+ (% (+ hour 11) 12)))) diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el index 67e701ecb1..401baece83 100644 --- a/lisp/url/url-auth.el +++ b/lisp/url/url-auth.el @@ -192,7 +192,9 @@ key cache `url-digest-auth-storage'." (defun url-digest-auth-make-cnonce () "Compute a new unique client nonce value." (base64-encode-string - (apply 'format "%016x%04x%04x%05x%05x" (random) (current-time)) t)) + (apply #'format "%016x%08x%08x" (random) + (read (format-time-string "(%s %N)"))) + t)) (defun url-digest-auth-nonce-count (_nonce) "The number requests sent to server with the given NONCE. diff --git a/test/lisp/calendar/parse-time-tests.el b/test/lisp/calendar/parse-time-tests.el index 9689997f79..ca71ff71b7 100644 --- a/test/lisp/calendar/parse-time-tests.el +++ b/test/lisp/calendar/parse-time-tests.el @@ -45,20 +45,34 @@ '(42 35 19 22 2 2016 1 nil -28800))) (should (equal (parse-time-string "Friday, 21 Sep 2018 13:47:58 PDT") '(58 47 13 21 9 2018 5 t -25200))) - (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54-0200") - '(13818 33666))) - (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54-0230") - '(13818 35466))) - (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54-02:00") - '(13818 33666))) - (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54-02") - '(13818 33666))) - (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54+0230") - '(13818 17466))) - (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54+02") - '(13818 19266))) - (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54Z") - '(13818 26466))) + (should (equal (format-time-string + "%Y-%m-%d %H:%M:%S" + (parse-iso8601-time-string "1998-09-12T12:21:54-0200") t) + "1998-09-12 14:21:54")) + (should (equal (format-time-string + "%Y-%m-%d %H:%M:%S" + (parse-iso8601-time-string "1998-09-12T12:21:54-0230") t) + "1998-09-12 14:51:54")) + (should (equal (format-time-string + "%Y-%m-%d %H:%M:%S" + (parse-iso8601-time-string "1998-09-12T12:21:54-02:00") t) + "1998-09-12 14:21:54")) + (should (equal (format-time-string + "%Y-%m-%d %H:%M:%S" + (parse-iso8601-time-string "1998-09-12T12:21:54-02") t) + "1998-09-12 14:21:54")) + (should (equal (format-time-string + "%Y-%m-%d %H:%M:%S" + (parse-iso8601-time-string "1998-09-12T12:21:54+0230") t) + "1998-09-12 09:51:54")) + (should (equal (format-time-string + "%Y-%m-%d %H:%M:%S" + (parse-iso8601-time-string "1998-09-12T12:21:54+02") t) + "1998-09-12 10:21:54")) + (should (equal (format-time-string + "%Y-%m-%d %H:%M:%S" + (parse-iso8601-time-string "1998-09-12T12:21:54Z") t) + "1998-09-12 12:21:54")) (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54") (encode-time 54 21 12 12 9 1998)))) diff --git a/test/lisp/emacs-lisp/timer-tests.el b/test/lisp/emacs-lisp/timer-tests.el index fa92c1b64a..1d3ba757f6 100644 --- a/test/lisp/emacs-lisp/timer-tests.el +++ b/test/lisp/emacs-lisp/timer-tests.el @@ -40,8 +40,10 @@ (should (debug-timer-check)) t)) (ert-deftest timer-test-multiple-of-time () - (should (equal - (timer-next-integral-multiple-of-time '(0 0 0 1) (1+ (ash 1 53))) - (list (ash 1 (- 53 16)) 1 0 0)))) + (should (zerop + (float-time + (time-subtract + (timer-next-integral-multiple-of-time '(0 0 0 1) (1+ (ash 1 53))) + (list (ash 1 (- 53 16)) 1)))))) ;;; timer-tests.el ends here diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 55884f30a7..79013558fd 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2882,16 +2882,16 @@ This tests also `file-readable-p', `file-regular-p' and ;; able to return the date correctly. They say "don't know". (dolist (elt attr) (unless - (equal - (nth - 5 (file-attributes (expand-file-name (car elt) tmp-name2))) - '(0 0)) + (zerop + (float-time + (nth 5 (file-attributes + (expand-file-name (car elt) tmp-name2))))) (should (equal (file-attributes (expand-file-name (car elt) tmp-name2)) (cdr elt))))) (setq attr (directory-files-and-attributes tmp-name2 'full)) (dolist (elt attr) - (unless (equal (nth 5 (file-attributes (car elt))) '(0 0)) + (unless (zerop (float-time (nth 5 (file-attributes (car elt))))) (should (equal (file-attributes (car elt)) (cdr elt))))) (setq attr (directory-files-and-attributes tmp-name2 nil "^b")) @@ -3215,14 +3215,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (write-region "foo" nil tmp-name1) (should (file-exists-p tmp-name1)) (should (consp (nth 5 (file-attributes tmp-name1)))) - ;; '(0 0) means don't know, and will be replaced by - ;; `current-time'. Therefore, we use '(0 1). We skip the + ;; A zero timestamp means don't know, and will be replaced by + ;; `current-time'. Therefore, use timestamp 1. Skip the ;; test, if the remote handler is not able to set the ;; correct time. (skip-unless (set-file-times tmp-name1 (seconds-to-time 1))) ;; Dumb remote shells without perl(1) or stat(1) are not ;; able to return the date correctly. They say "don't know". - (unless (equal (nth 5 (file-attributes tmp-name1)) '(0 0)) + (unless (zerop (float-time (nth 5 (file-attributes tmp-name1)))) (should (equal (nth 5 (file-attributes tmp-name1)) (seconds-to-time 1))) (write-region "bla" nil tmp-name2) @@ -3250,9 +3250,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (with-temp-buffer (insert-file-contents tmp-name) (should (verify-visited-file-modtime)) - (set-visited-file-modtime '(0 1)) + (set-visited-file-modtime (seconds-to-time 1)) (should (verify-visited-file-modtime)) - (should (equal (visited-file-modtime) '(0 1 0 0))))) + (should (= 1 (float-time (visited-file-modtime)))))) ;; Cleanup. (ignore-errors (delete-file tmp-name)))))) commit 19ab7686ae42dcce1e0861bce4713c69a64eec45 Author: Juri Linkov Date: Mon Sep 24 23:52:57 2018 +0300 Output alists with dotted pair notation in .dir-locals.el * lisp/files-x.el (add-dir-local-variables-to-string): New function. (modify-dir-local-variable): Use it. (Bug#32817) diff --git a/lisp/files-x.el b/lisp/files-x.el index 92532e85f4..201b7a47d5 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -492,15 +492,32 @@ from the MODE alist ignoring the input argument VALUE." ;; Insert modified alist of directory-local variables. (insert ";;; Directory Local Variables\n") (insert ";;; For more information see (info \"(emacs) Directory Variables\")\n\n") - (pp (sort variables - (lambda (a b) - (cond - ((null (car a)) t) - ((null (car b)) nil) - ((and (symbolp (car a)) (stringp (car b))) t) - ((and (symbolp (car b)) (stringp (car a))) nil) - (t (string< (car a) (car b)))))) - (current-buffer))))) + (princ (add-dir-local-variables-to-string + (sort variables + (lambda (a b) + (cond + ((null (car a)) t) + ((null (car b)) nil) + ((and (symbolp (car a)) (stringp (car b))) t) + ((and (symbolp (car b)) (stringp (car a))) nil) + (t (string< (car a) (car b))))))) + (current-buffer)) + (goto-char (point-min)) + (indent-sexp)))) + +(defun add-dir-local-variables-to-string (variables) + "Output alists of VARIABLES to string in dotted pair notation syntax." + (format "(%s)" (mapconcat + (lambda (mode-variable) + (format "(%S . %s)" + (car mode-variable) + (format "(%s)" (mapconcat + (lambda (variable-value) + (format "(%s . %S)" + (car variable-value) + (cdr variable-value))) + (cdr mode-variable) "\n")))) + variables "\n"))) ;;;###autoload (defun add-dir-local-variable (mode variable value) commit dc7fdee08c2c3b5b62ee5556689889e91d76610a Author: Stefan Monnier Date: Mon Sep 24 14:58:11 2018 -0400 * doc/emacs/kmacro.texi (Basic Keyboard Macro): Mention old bindings According to Apple gospel, function keys are partly going the way of the dodo so F3/F4 can, like in the good old days, be hard to reach for some users. diff --git a/doc/emacs/kmacro.texi b/doc/emacs/kmacro.texi index dac41fdb87..0151c816a8 100644 --- a/doc/emacs/kmacro.texi +++ b/doc/emacs/kmacro.texi @@ -49,15 +49,19 @@ intelligent or general. For such things, Lisp must be used. @table @kbd @item @key{F3} +@itemx C-x ( Start defining a keyboard macro (@code{kmacro-start-macro-or-insert-counter}). @item @key{F4} +@itemx C-x e If a keyboard macro is being defined, end the definition; otherwise, execute the most recent keyboard macro (@code{kmacro-end-or-call-macro}). @item C-u @key{F3} +@itemx C-u C-x ( Re-execute last keyboard macro, then append keys to its definition. @item C-u C-u @key{F3} +@itemx C-u C-u C-x ( Append keys to the last keyboard macro without re-executing it. @item C-x C-k r Run the last keyboard macro on each line that begins in the region commit 36243179695a1711308e1d2f57c9ff847f3ef2d0 Author: Paul Eggert Date: Mon Sep 24 10:44:34 2018 -0700 Fix â€make clean’ with a file named â€-.o’ Problem reported by T.V Raman in: https://lists.gnu.org/r/emacs-devel/2018-09/msg00866.html * Makefile.in (clean, extraclean): * doc/emacs/Makefile.in (mostlyclean): * doc/lispintro/Makefile.in (mostlyclean): * doc/lispref/Makefile.in (mostlyclean): * doc/misc/Makefile.in (mostlyclean, clean): * etc/refcards/Makefile (clean): * lib-src/Makefile.in (mostlyclean, extraclean): * lib/Makefile.in (clean): * lwlib/Makefile.in (clean mostlyclean): * oldXMenu/Makefile.in (clean mostlyclean): * src/Makefile.in (mostlyclean, extraclean): * test/Makefile.in (mostlyclean): Say â€rm ./*.o’ instead of â€rm *.o’ to avoid undesirable failure when a file name begins with â€-’. diff --git a/Makefile.in b/Makefile.in index 5ea48824bd..c6b2cfa78a 100644 --- a/Makefile.in +++ b/Makefile.in @@ -839,7 +839,7 @@ $(foreach dir,$(clean_dirs),$(eval $(call submake_template,$(dir),clean))) clean: $(clean_dirs:=_clean) $(MAKE) -C admin/charsets $@ [ ! -d test ] || $(MAKE) -C test $@ - -rm -f *.tmp etc/*.tmp* + -rm -f ./*.tmp etc/*.tmp* -rm -rf info-dir.* ### 'bootclean' @@ -926,7 +926,7 @@ $(foreach dir,$(extraclean_dirs),$(eval $(call submake_template,$(dir),extraclea extraclean: $(extraclean_dirs:=_extraclean) ${top_maintainer_clean} -rm -f config-tmp-* - -rm -f *~ \#* + -rm -f ./*~ \#* # The src subdir knows how to do the right thing # even when the build directory and source dir are different. diff --git a/doc/emacs/Makefile.in b/doc/emacs/Makefile.in index 1da2f1550f..54e173f8d6 100644 --- a/doc/emacs/Makefile.in +++ b/doc/emacs/Makefile.in @@ -206,8 +206,8 @@ doc-emacsver: ## Temp files. mostlyclean: - rm -f *.aux *.log *.toc *.cp *.cps *.fn *.fns *.ky *.kys \ - *.op *.ops *.pg *.pgs *.tp *.tps *.vr *.vrs + rm -f ./*.aux ./*.log ./*.toc ./*.cp ./*.cps ./*.fn ./*.fns ./*.ky ./*.kys \ + ./*.op ./*.ops ./*.pg ./*.pgs ./*.tp ./*.tps ./*.vr ./*.vrs ## Products not in the release tarfiles. clean: mostlyclean diff --git a/doc/lispintro/Makefile.in b/doc/lispintro/Makefile.in index 71739fdb35..e2a1229d5c 100644 --- a/doc/lispintro/Makefile.in +++ b/doc/lispintro/Makefile.in @@ -109,8 +109,8 @@ emacs-lisp-intro.ps: emacs-lisp-intro.dvi .PHONY: mostlyclean clean distclean bootstrap-clean maintainer-clean infoclean mostlyclean: - rm -f *.aux *.log *.toc *.cp *.cps *.fn *.fns *.ky *.kys \ - *.op *.ops *.pg *.pgs *.tp *.tps *.vr *.vrs + rm -f ./*.aux ./*.log ./*.toc ./*.cp ./*.cps ./*.fn ./*.fns ./*.ky ./*.kys \ + ./*.op ./*.ops ./*.pg ./*.pgs ./*.tp ./*.tps ./*.vr ./*.vrs clean: mostlyclean rm -f $(DVI_TARGETS) $(HTML_TARGETS) $(PDF_TARGETS) $(PS_TARGETS) diff --git a/doc/lispref/Makefile.in b/doc/lispref/Makefile.in index 98ca90a96d..221f4f97f5 100644 --- a/doc/lispref/Makefile.in +++ b/doc/lispref/Makefile.in @@ -167,8 +167,8 @@ elisp.ps: elisp.dvi ## [12] stuff is from two-volume.make. mostlyclean: - rm -f *.aux *.log *.toc *.cp *.cps *.fn *.fns *.ky *.kys \ - *.op *.ops *.pg *.pgs *.tp *.tps *.vr *.vrs + rm -f ./*.aux ./*.log ./*.toc ./*.cp ./*.cps ./*.fn ./*.fns ./*.ky ./*.kys \ + ./*.op ./*.ops ./*.pg ./*.pgs ./*.tp ./*.tps ./*.vr ./*.vrs rm -f elisp[12]* vol[12].tmp clean: mostlyclean diff --git a/doc/misc/Makefile.in b/doc/misc/Makefile.in index 11086b3303..fd07ea4ca1 100644 --- a/doc/misc/Makefile.in +++ b/doc/misc/Makefile.in @@ -224,13 +224,13 @@ ${buildinfodir}/tramp.info tramp.html: ${srcdir}/trampver.texi .PHONY: mostlyclean clean distclean bootstrap-clean maintainer-clean mostlyclean: - rm -f *.aux *.log *.toc *.c[mp] *.c[mp]s *.fn *.fns \ - *.ky *.kys *.op *.ops *.p[gj] *.p[gj]s *.sc *.scs *.ss \ - *.t[gp] *.t[gp]s *.vr *.vrs + rm -f ./*.aux ./*.log ./*.toc ./*.c[mp] ./*.c[mp]s ./*.fn ./*.fns \ + ./*.ky ./*.kys ./*.op ./*.ops ./*.p[gj] ./*.p[gj]s ./*.sc ./*.scs ./*.ss \ + ./*.t[gp] ./*.t[gp]s ./*.vr ./*.vrs rm -f gnustmp* clean: mostlyclean - rm -f *.dvi *.html *.pdf *.ps + rm -f ./*.dvi ./*.html ./*.pdf ./*.ps distclean: clean rm -f Makefile diff --git a/etc/refcards/Makefile b/etc/refcards/Makefile index b61ff5f803..a3c8e55172 100644 --- a/etc/refcards/Makefile +++ b/etc/refcards/Makefile @@ -311,7 +311,7 @@ viperCard.dvi: $(vipercard_deps) .PHONY: clean clean: - -rm -f *.dvi *.log *.aux + -rm -f ./*.dvi ./*.log ./*.aux distclean: clean diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in index b2b901788a..ecb9208a1c 100644 --- a/lib-src/Makefile.in +++ b/lib-src/Makefile.in @@ -334,7 +334,7 @@ uninstall: fi mostlyclean: - rm -f core *.o *.res + rm -f core ./*.o ./*.res clean: mostlyclean rm -f ${EXE_FILES} @@ -345,7 +345,7 @@ distclean: clean bootstrap-clean maintainer-clean: distclean extraclean: maintainer-clean - rm -f *~ \#* + rm -f ./*~ \#* ## Test the contents of the directory. check: diff --git a/lib/Makefile.in b/lib/Makefile.in index b26db27423..7dba31be71 100644 --- a/lib/Makefile.in +++ b/lib/Makefile.in @@ -118,7 +118,7 @@ TAGS: $(ETAGS) $(tagsfiles) .PHONY: $(ETAGS) tags clean: - rm -f *.[ao] *-t \#* $(DEPDIR)/* + rm -f ./*.[ao] ./*-t \#* $(DEPDIR)/* mostlyclean: clean rm -f $(filter-out %-t,$(MOSTLYCLEANFILES)) distclean bootstrap-clean: mostlyclean diff --git a/lwlib/Makefile.in b/lwlib/Makefile.in index 6bd2608381..ed71270a77 100644 --- a/lwlib/Makefile.in +++ b/lwlib/Makefile.in @@ -111,7 +111,7 @@ $(globals_h): .PHONY: mostlyclean clean distclean bootstrap-clean maintainer-clean clean mostlyclean: - rm -f *.o liblw.a \#* $(DEPDIR)/* + rm -f ./*.o liblw.a \#* $(DEPDIR)/* distclean: clean rm -f Makefile diff --git a/oldXMenu/Makefile.in b/oldXMenu/Makefile.in index d795038797..211bac97ee 100644 --- a/oldXMenu/Makefile.in +++ b/oldXMenu/Makefile.in @@ -138,7 +138,7 @@ libXMenu11.a: $(OBJS) $(EXTRA) .PHONY: mostlyclean clean distclean bootstrap-clean maintainer-clean clean mostlyclean: - rm -f libXMenu11.a *.o $(DEPDIR)/* + rm -f libXMenu11.a ./*.o $(DEPDIR)/* bootstrap-clean maintainer-clean distclean: clean rm -f Makefile diff --git a/src/Makefile.in b/src/Makefile.in index 7d9c2361a9..72f568988a 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -645,12 +645,12 @@ ns-app: emacs$(EXEEXT) .PHONY: versionclean extraclean mostlyclean: - rm -f temacs$(EXEEXT) core *.core \#* *.o + rm -f temacs$(EXEEXT) core ./*.core \#* ./*.o rm -f ../etc/DOC rm -f bootstrap-emacs$(EXEEXT) emacs-$(version)$(EXEEXT) rm -f buildobj.h rm -f globals.h gl-stamp - rm -f *.res *.tmp + rm -f ./*.res ./*.tmp clean: mostlyclean rm -f emacs-*.*.*[0-9]$(EXEEXT) emacs$(EXEEXT) $(DEPDIR)/* @@ -674,7 +674,7 @@ maintainer-clean: distclean versionclean: -rm -f emacs$(EXEEXT) emacs-*.*.*[0-9]$(EXEEXT) ../etc/DOC* extraclean: distclean - -rm -f *~ \#* + -rm -f ./*~ \#* ETAGS = ../lib-src/etags${EXEEXT} diff --git a/test/Makefile.in b/test/Makefile.in index a1f4388288..adb316c3d9 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -307,7 +307,7 @@ endif mostlyclean: -@for f in ${LOGFILES}; do test ! -f $$f || mv $$f $$f~; done - rm -f *.tmp + rm -f ./*.tmp clean: find . '(' -name '*.log' -o -name '*.log~' ')' $(FIND_DELETE) commit 17766a14cc2c7fe51040f5d2dadfb8112f175dba Author: Eli Zaretskii Date: Mon Sep 24 18:07:02 2018 +0300 Improve docs of functions/variables related to 'display-buffer' * lisp/window.el (display-buffer, pop-to-buffer-same-window) (display-buffer-same-window, display-buffer-in-side-window) (same-window-p, display-buffer-overriding-action) (display-buffer-base-action) (display-buffer--same-window-action) (display-buffer--other-frame-action) (with-current-buffer-window, with-displayed-buffer-window) (display-buffer-alist, display-buffer-assq-regexp) (display-buffer-other-frame): Clarify and improve the doc strings. (Bug#32798) diff --git a/lisp/window.el b/lisp/window.el index 2c0ea8e4d5..818bd3dd2b 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -201,7 +201,7 @@ argument replaces this)." (defmacro with-current-buffer-window (buffer-or-name action quit-function &rest body) "Evaluate BODY with a buffer BUFFER-OR-NAME current and show that buffer. -This construct is like `with-temp-buffer-window' but unlike that +This construct is like `with-temp-buffer-window' but unlike that, makes the buffer specified by BUFFER-OR-NAME current for running BODY." (declare (debug t)) @@ -224,7 +224,7 @@ BODY." (defmacro with-displayed-buffer-window (buffer-or-name action quit-function &rest body) "Show a buffer BUFFER-OR-NAME and evaluate BODY in that buffer. -This construct is like `with-current-buffer-window' but unlike that +This construct is like `with-current-buffer-window' but unlike that, displays the buffer specified by BUFFER-OR-NAME before running BODY." (declare (debug t)) (let ((buffer (make-symbol "buffer")) @@ -992,16 +992,16 @@ and may be called only if no window on SIDE exists yet." ALIST is an association list of symbols and values. The following special symbols can be used in ALIST. -`side' denotes the side of the frame where the new window shall - be located. Valid values are `bottom', `right', `top' and - `left'. The default is `bottom'. + `side' denotes the side of the frame where the new window shall + be located. Valid values are `bottom', `right', `top' and + `left'. The default is `bottom'. -`slot' if non-nil, specifies the window slot where to display - BUFFER. A value of zero or nil means use the middle slot on - the specified side. A negative value means use a slot - preceding (that is, above or on the left of) the middle slot. - A positive value means use a slot following (that is, below or - on the right of) the middle slot. The default is zero. + `slot' if non-nil, specifies the window slot where to display + BUFFER. A value of zero or nil means use the middle slot on + the specified side. A negative value means use a slot + preceding (that is, above or on the left of) the middle slot. + A positive value means use a slot following (that is, below or + on the right of) the middle slot. The default is zero. If the current frame size or the settings of `window-sides-slots' do not permit making a new window, a suitable existing window may @@ -6382,7 +6382,7 @@ See also `same-window-buffer-names'." :group 'windows) (defun same-window-p (buffer-name) - "Return non-nil if a buffer named BUFFER-NAME would be shown in the \"same\" window. + "Return non-nil if buffer BUFFER-NAME would be shown in the \"same\" window. This function returns non-nil if `display-buffer' or `pop-to-buffer' would show a buffer named BUFFER-NAME in the selected rather than (as usual) some other window. See @@ -6820,16 +6820,22 @@ The actual non-nil value of this variable will be copied to the "Custom type for `display-buffer' actions.") (defvar display-buffer-overriding-action '(nil . nil) - "Overriding action to perform to display a buffer. -It should be a cons cell (FUNCTION . ALIST), where FUNCTION is a -function or a list of functions. Each function should accept two -arguments: a buffer to display and an alist similar to ALIST. + "User-defined overriding action to perform to display a buffer. +This action overrides all the other actions in the action variables +and arguments passed to `display-buffer'. +Value should be a cons cell (FUNCTION . ALIST), where FUNCTION is +a function or a list of functions. Each function should accept +two arguments: a buffer to display and an alist similar to ALIST. +The default value is empty. See `display-buffer' for details.") (put 'display-buffer-overriding-action 'risky-local-variable t) (defcustom display-buffer-alist nil - "Alist of conditional actions for `display-buffer'. -This is a list of elements (CONDITION . ACTION), where: + "Alist of uder-defined conditional actions for `display-buffer'. +Its value takes effect before `display-buffer-base-action' +and `display-buffer-fallback-action', but after +`display-buffer-overriding-action', which see. +If non-nil, this is a list of elements (CONDITION . ACTION), where: CONDITION is either a regexp matching buffer names, or a function that takes two arguments - a buffer name and the @@ -6855,9 +6861,13 @@ associated action to the list of actions it will try." (defcustom display-buffer-base-action '(nil . nil) "User-specified default action for `display-buffer'. +This is the default action used by `display-buffer' if no other +actions are specified or all fail, before falling back on +`display-buffer-fallback-action'. It should be a cons cell (FUNCTION . ALIST), where FUNCTION is a function or a list of functions. Each function should accept two arguments: a buffer to display and an alist similar to ALIST. +The default value is empty. See `display-buffer' for details." :type display-buffer--action-custom-type :risky t @@ -6875,12 +6885,16 @@ See `display-buffer' for details." "Default fallback action for `display-buffer'. This is the action used by `display-buffer' if no other actions specified, e.g. by the user options `display-buffer-alist' or -`display-buffer-base-action'. See `display-buffer'.") +`display-buffer-base-action', or they all fail. See `display-buffer'.") (put 'display-buffer-fallback-action 'risky-local-variable t) (defun display-buffer-assq-regexp (buffer-name alist action) "Retrieve ALIST entry corresponding to BUFFER-NAME. -ACTION is the action argument passed to `display-buffer'." +This returns the cdr of the ALIST entry if either its key is a +string that matches BUFFER-NAME, as reported by `string-match-p'; +or if the key is a function that returns a non-nil when called +with 3 arguments: the ALIST key, BUFFER-NAME, and ACTION. +ACTION should have the form of the action argument passed to `display-buffer'." (catch 'match (dolist (entry alist) (let ((key (car entry))) @@ -6893,7 +6907,8 @@ ACTION is the action argument passed to `display-buffer'." (defvar display-buffer--same-window-action '(display-buffer-same-window (inhibit-same-window . nil)) - "A `display-buffer' action for displaying in the same window.") + "A `display-buffer' action for displaying in the same window. +Specifies to call `display-buffer-same-window'.") (put 'display-buffer--same-window-action 'risky-local-variable t) (defvar display-buffer--other-frame-action @@ -6901,7 +6916,9 @@ ACTION is the action argument passed to `display-buffer'." display-buffer-pop-up-frame) (reusable-frames . 0) (inhibit-same-window . t)) - "A `display-buffer' action for displaying in another frame.") + "A `display-buffer' action for displaying in another frame. +Specifies to call `display-buffer-reuse-window', and if that +fails, call `display-buffer-pop-up-frame'.") (put 'display-buffer--other-frame-action 'risky-local-variable t) (defun display-buffer (buffer-or-name &optional action frame) @@ -6922,7 +6939,7 @@ If ACTION is non-nil, it should have the form (FUNCTION . ALIST), where FUNCTION is either a function or a list of functions, and ALIST is an arbitrary association list (alist). -Each such FUNCTION should accept two arguments: the buffer to +Each such function should accept two arguments: the buffer to display and an alist. Based on those arguments, it should display the buffer and return the window. If the caller is prepared to handle the case of not displaying the buffer @@ -7046,6 +7063,9 @@ argument, ACTION is t." (defun display-buffer-other-frame (buffer) "Display buffer BUFFER preferably in another frame. +This function attempts to look for a window displaying BUFFER, +on all the frames on the current terminal, skipping the selected +window; if that fails, it pops up a new frame. This uses the function `display-buffer' as a subroutine; see its documentation for additional customization information." (interactive "BDisplay buffer in other frame: ") @@ -7089,10 +7109,10 @@ that allows the selected frame)." (defun display-buffer-same-window (buffer alist) "Display BUFFER in the selected window. -This fails if ALIST has a non-nil `inhibit-same-window' entry, or -if the selected window is a minibuffer window or is dedicated to -another buffer; in that case, return nil. Otherwise, return the -selected window." +This fails if ALIST has an `inhibit-same-window' element whose +value is non-nil, or if the selected window is a minibuffer +window or is dedicated to another buffer; in that case, return nil. +Otherwise, return the selected window." (unless (or (cdr (assq 'inhibit-same-window alist)) (window-minibuffer-p) (window-dedicated-p)) @@ -7557,7 +7577,12 @@ Optional argument NORECORD, if non-nil means do not put this buffer at the front of the list of recently selected ones. Unlike `pop-to-buffer', this function prefers using the selected -window over popping up a new window or frame." +window over popping up a new window or frame. Specifically, if +the selected window is neither a minibuffer window (as reported +by `window-minibuffer-p'), nor is dedicated to another buffer +(see `window-dedicated-p'), BUFFER will be displayed in the +currently selected window; otherwise it will be displayed in +another window." (pop-to-buffer buffer display-buffer--same-window-action norecord)) (defun read-buffer-to-switch (prompt) commit 662bee7d70ccd3903e123b08c7ec9108a1a2ce0b Author: Paul Eggert Date: Sun Sep 23 18:30:46 2018 -0700 file-attributes cleanup Mostly, this replaces magic-number calls like (nth 4 A) with more-informative calls like (file-attribute-access-time A). It also fixes some documentation and minor timestamp coding issues that I noticed while looking into this. * doc/lispref/files.texi (File Attributes): * lisp/files.el (file-attribute-size) (file-attribute-inode-number, file-attribute-device-number): * src/dired.c (Fdirectory_files_and_attributes) (Ffile_attributes): Mention which attributes must be integers, or nonnegative integers, as opposed to merely being numbers. Remove no-longer-correct talk about representing large integers as conses of integers. * doc/lispref/files.texi (Magic File Names): * doc/misc/gnus.texi (Low-level interface to the spam-stat dictionary): * lisp/autorevert.el (auto-revert-find-file-function) (auto-revert-tail-mode, auto-revert-handler): * lisp/auth-source.el (auth-source-netrc-parse): * lisp/cedet/ede/files.el (ede--inode-for-dir): * lisp/cedet/semantic/db-file.el (object-write): * lisp/cedet/semantic/db-mode.el (semanticdb-kill-hook): * lisp/cedet/semantic/db.el (semanticdb-needs-refresh-p) (semanticdb-synchronize): * lisp/cedet/srecode/table.el (srecode-mode-table-new): * lisp/desktop.el (desktop-save, desktop-read): * lisp/dired-aux.el (dired-file-set-difference) (dired-do-chxxx, dired-do-chmod, dired-copy-file-recursive) (dired-create-files): * lisp/dired.el (dired-directory-changed-p, dired-readin): * lisp/dos-w32.el (w32-direct-print-region-helper): * lisp/emacs-lisp/autoload.el (autoload-generate-file-autoloads) (autoload-find-destination, update-directory-autoloads): * lisp/emacs-lisp/shadow.el (load-path-shadows-same-file-or-nonexistent): * lisp/epg.el (epg--start, epg-wait-for-completion): * lisp/eshell/em-ls.el (eshell-ls-filetype-p) (eshell-ls-applicable, eshell-ls-size-string) (eshell-ls-file, eshell-ls-dir, eshell-ls-files) (eshell-ls-entries): * lisp/eshell/em-pred.el (eshell-predicate-alist) (eshell-pred-file-type, eshell-pred-file-links) (eshell-pred-file-size): * lisp/eshell/em-unix.el (eshell-shuffle-files, eshell/cat) (eshell-du-sum-directory, eshell/du): * lisp/eshell/esh-util.el (eshell-read-passwd) (eshell-read-hosts): * lisp/files.el (remote-file-name-inhibit-cache) (find-file-noselect, insert-file-1, dir-locals-find-file) (dir-locals-read-from-dir, backup-buffer) (file-ownership-preserved-p, copy-directory) (read-file-modes): * lisp/find-lisp.el (find-lisp-format): * lisp/gnus/gnus-agent.el (gnus-agent-unfetch-articles) (gnus-agent-read-agentview, gnus-agent-expire-group-1) (gnus-agent-request-article, gnus-agent-regenerate-group) (gnus-agent-update-files-total-fetched-for) (gnus-agent-update-view-total-fetched-for): * lisp/gnus/gnus-cache.el (gnus-cache-read-active) (gnus-cache-update-file-total-fetched-for) (gnus-cache-update-overview-total-fetched-for): * lisp/gnus/gnus-cloud.el (gnus-cloud-file-new-p): * lisp/gnus/gnus-score.el (gnus-score-score-files): * lisp/gnus/gnus-start.el (gnus-save-newsrc-file) (gnus-master-read-slave-newsrc): * lisp/gnus/gnus-sum.el (gnus-summary-import-article): * lisp/gnus/gnus-util.el (gnus-file-newer-than) (gnus-cache-file-contents): * lisp/gnus/mail-source.el (mail-source-delete-old-incoming) (mail-source-callback, mail-source-movemail): * lisp/gnus/nneething.el (nneething-create-mapping) (nneething-make-head): * lisp/gnus/nnfolder.el (nnfolder-read-folder): * lisp/gnus/nnheader.el (nnheader-file-size) (nnheader-insert-nov-file): * lisp/gnus/nnmail.el (nnmail-activate): * lisp/gnus/nnmaildir.el (nnmaildir--group-maxnum) (nnmaildir--new-number, nnmaildir--update-nov) (nnmaildir--scan, nnmaildir-request-scan) (nnmaildir-request-update-info) (nnmaildir-request-expire-articles): * lisp/gnus/nnmh.el (nnmh-request-list-1) (nnmh-request-expire-articles, nnmh-update-gnus-unreads): * lisp/gnus/nnml.el (nnml-request-expire-articles): * lisp/gnus/spam-stat.el (spam-stat-save, spam-stat-load) (spam-stat-process-directory, spam-stat-test-directory): * lisp/ido.el (ido-directory-too-big-p) (ido-file-name-all-completions): * lisp/image-dired.el (image-dired-get-thumbnail-image) (image-dired-create-thumb-1): * lisp/info.el (info-insert-file-contents): * lisp/ls-lisp.el (ls-lisp-insert-directory) (ls-lisp-handle-switches, ls-lisp-classify-file) (ls-lisp-format): * lisp/mail/blessmail.el: * lisp/mail/feedmail.el (feedmail-default-date-generator) (feedmail-default-message-id-generator): * lisp/mail/mailabbrev.el (mail-abbrevs-sync-aliases) (mail-abbrevs-setup): * lisp/mail/mspools.el (mspools-size-folder): * lisp/mail/rmail.el (rmail-insert-inbox-text): * lisp/mail/sendmail.el (sendmail-sync-aliases): * lisp/mh-e/mh-alias.el (mh-alias-tstamp): * lisp/net/ange-ftp.el (ange-ftp-parse-netrc) (ange-ftp-write-region, ange-ftp-file-newer-than-file-p) (ange-ftp-cf1): * lisp/net/eudcb-mab.el (eudc-mab-query-internal): * lisp/net/eww.el (eww-read-bookmarks): * lisp/net/netrc.el (netrc-parse): * lisp/net/newst-backend.el (newsticker--image-get): * lisp/nxml/rng-loc.el (rng-get-parsed-schema-locating-file): * lisp/obsolete/fast-lock.el (fast-lock-save-cache): * lisp/obsolete/vc-arch.el (vc-arch-state) (vc-arch-diff3-rej-p): * lisp/org/ob-eval.el (org-babel--shell-command-on-region): * lisp/org/org-attach.el (org-attach-commit): * lisp/org/org-macro.el (org-macro-initialize-templates): * lisp/org/org.el (org-babel-load-file) (org-file-newer-than-p): * lisp/org/ox-html.el (org-html-format-spec): * lisp/org/ox-publish.el (org-publish-find-date) (org-publish-cache-ctime-of-src): * lisp/pcmpl-gnu.el (pcomplete/tar): * lisp/pcmpl-rpm.el (pcmpl-rpm-packages): * lisp/play/cookie1.el (cookie-snarf): * lisp/progmodes/cmacexp.el (c-macro-expansion): * lisp/ps-bdf.el (bdf-file-mod-time): * lisp/server.el (server-ensure-safe-dir): * lisp/simple.el (shell-command-on-region): * lisp/speedbar.el (speedbar-item-info-file-helper) (speedbar-check-obj-this-line): * lisp/thumbs.el (thumbs-cleanup-thumbsdir): * lisp/time.el (display-time-mail-check-directory) (display-time-file-nonempty-p): * lisp/url/url-cache.el (url-is-cached): * lisp/url/url-file.el (url-file-asynch-callback): * lisp/vc/diff-mode.el (diff-delete-if-empty): * lisp/vc/pcvs-info.el (cvs-fileinfo-from-entries): * lisp/vc/vc-bzr.el (vc-bzr-state-heuristic): * lisp/vc/vc-cvs.el (vc-cvs-checkout-model) (vc-cvs-state-heuristic, vc-cvs-merge-news) (vc-cvs-retrieve-tag, vc-cvs-parse-status, vc-cvs-parse-entry): * lisp/vc/vc-hg.el (vc-hg--slurp-hgignore-1) (vc-hg--ignore-patterns-valid-p) (vc-hg--cached-dirstate-search, vc-hg-state-fast): * lisp/vc/vc-hooks.el (vc-after-save): * lisp/vc/vc-rcs.el (vc-rcs-workfile-is-newer): * lisp/vc/vc-svn.el (vc-svn-merge-news, vc-svn-parse-status): * lisp/vc/vc.el (vc-checkout, vc-checkin, vc-revert-file): * lisp/xdg.el (xdg-mime-apps): Prefer (file-attribute-size A) to (nth 7 A), and similarly for other file attributes accessors. * doc/lispref/files.texi (File Attributes): * doc/lispref/intro.texi (Version Info): * doc/lispref/os.texi (Idle Timers): * lisp/erc/erc.el (erc-string-to-emacs-time): * lisp/files.el (file-attribute-access-time) (file-attribute-modification-time) (file-attribute-status-change-time): * lisp/net/tramp-compat.el: (tramp-compat-file-attribute-modification-time) (tramp-compat-file-attribute-size): * src/buffer.c (syms_of_buffer): * src/editfns.c (Fget_internal_run_time): * src/fileio.c (Fvisited_file_modtime) (Fset_visited_file_modtime): * src/keyboard.c (Fcurrent_idle_time): * src/process.c (Fprocess_attributes): Defer implementation details about timestamp format to the section that talks about timestamp format, to make it easier to change the documentation later if timestamp formats are extended. * lisp/gnus/gnus-util.el (gnus-file-newer-than): * lisp/speedbar.el (speedbar-check-obj-this-line): * lisp/vc/vc-rcs.el (vc-rcs-workfile-is-newer): Prefer time-less-p to doing it by hand. * lisp/ls-lisp.el (ls-lisp-format): Inode numbers are no longer conses. * lisp/vc/vc-bzr.el (vc-bzr-state-heuristic): Use eql, not eq, to compare integers that might be bignums. * lisp/org/ox-publish.el (org-publish-cache-ctime-of-src): Prefer float-time to doing time arithmetic by hand. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index c50e358beb..5682919b64 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -1299,28 +1299,27 @@ Alternate names, also known as hard links, can be created by using the @item The file's @acronym{UID}, normally as a string (@code{file-attribute-user-id}). However, if it does not correspond -to a named user, the value is a number. +to a named user, the value is an integer. @item The file's @acronym{GID}, likewise (@code{file-attribute-group-id}). @item -The time of last access, as a list of four integers -@code{(@var{sec-high} @var{sec-low} @var{microsec} @var{picosec})} -(@code{file-attribute-access-time}). (This is similar to the value of -@code{current-time}; see @ref{Time of Day}.) The value is truncated +The time of last access as a Lisp timestamp +(@code{file-attribute-status-change-time}). The timestamp is in the +style of @code{current-time} (@pxref{Time of Day}) and is truncated to that of the filesystem's timestamp resolution; for example, on some FAT-based filesystems, only the date of last access is recorded, so this time will always hold the midnight of the day of the last access. @cindex modification time of file @item -The time of last modification as a list of four integers (as above) +The time of last modification as a Lisp timestamp (@code{file-attribute-modification-time}). This is the last time when the file's contents were modified. @item -The time of last status change as a list of four integers (as above) +The time of last status change as a Lisp timestamp (@code{file-attribute-status-change-time}). This is the time of the last change to the file's access mode bits, its owner and group, and other information recorded in the filesystem for the file, beyond the @@ -1337,11 +1336,12 @@ The file's modes, as a string of ten letters or dashes, as in An unspecified value, present for backward compatibility. @item -The file's inode number (@code{file-attribute-inode-number}). +The file's inode number (@code{file-attribute-inode-number}), +a nonnegative integer. @item The filesystem number of the device that the file is on -@code{file-attribute-device-number}). +@code{file-attribute-device-number}), an integer. This element and the file's inode number together give enough information to distinguish any two files on the system---no two files can have the same values for both of these @@ -2918,7 +2918,7 @@ are included. This is similar to @code{directory-files} in deciding which files to report on and how to report their names. However, instead of returning a list of file names, it returns for each file a -list @code{(@var{filename} @var{attributes})}, where @var{attributes} +list @code{(@var{filename} . @var{attributes})}, where @var{attributes} is what @code{file-attributes} returns for that file. The optional argument @var{id-format} has the same meaning as the corresponding argument to @code{file-attributes} (@pxref{Definition @@ -3410,8 +3410,9 @@ between consecutive checks. For example: (let ((remote-file-name-inhibit-cache (- display-time-interval 5))) (and (file-exists-p file) - (< 0 (nth 7 (file-attributes - (file-chase-links file))))))) + (< 0 (file-attribute-size + (file-attributes + (file-chase-links file))))))) @end example @end defopt diff --git a/doc/lispref/intro.texi b/doc/lispref/intro.texi index f421f3b3ef..197f54ecc5 100644 --- a/doc/lispref/intro.texi +++ b/doc/lispref/intro.texi @@ -493,7 +493,7 @@ giving a prefix argument makes @var{here} non-@code{nil}. @defvar emacs-build-time The value of this variable indicates the time at which Emacs was -built. It is a list of four integers, like the value of +built. It uses the style of @code{current-time} (@pxref{Time of Day}), or is @code{nil} if the information is not available. diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 43ca9ede00..8481fea806 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -1991,8 +1991,7 @@ the idleness time, as described below. @defun current-idle-time If Emacs is idle, this function returns the length of time Emacs has -been idle, as a list of four integers: @code{(@var{sec-high} -@var{sec-low} @var{microsec} @var{picosec})}, using the same format as +been idle, using the same format as @code{current-time} (@pxref{Time of Day}). When Emacs is not idle, @code{current-idle-time} returns @code{nil}. diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 6ccb9e55f3..40cc44a12e 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -25889,13 +25889,13 @@ Reset: (setq spam-stat (make-hash-table :test 'equal)) Learn spam: (spam-stat-process-spam-directory "~/Mail/mail/spam") Learn non-spam: (spam-stat-process-non-spam-directory "~/Mail/mail/misc") Save table: (spam-stat-save) -File size: (nth 7 (file-attributes spam-stat-file)) +File size: (file-attribute-size (file-attributes spam-stat-file)) Number of words: (hash-table-count spam-stat) Test spam: (spam-stat-test-directory "~/Mail/mail/spam") Test non-spam: (spam-stat-test-directory "~/Mail/mail/misc") Reduce table size: (spam-stat-reduce-size) Save table: (spam-stat-save) -File size: (nth 7 (file-attributes spam-stat-file)) +File size: (file-attribute-size (file-attributes spam-stat-file)) Number of words: (hash-table-count spam-stat) Test spam: (spam-stat-test-directory "~/Mail/mail/spam") Test non-spam: (spam-stat-test-directory "~/Mail/mail/misc") diff --git a/lisp/auth-source.el b/lisp/auth-source.el index 261e972613..eb262a13df 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -956,7 +956,8 @@ Note that the MAX parameter is used so we can exit the parse early." (if (and (functionp cached-secrets) (equal cached-mtime - (nth 5 (file-attributes file)))) + (file-attribute-modification-time + (file-attributes file)))) (progn (auth-source-do-trivia "auth-source-netrc-parse: using CACHED file data for %s" @@ -968,7 +969,8 @@ Note that the MAX parameter is used so we can exit the parse early." ;; (note for the irony-impaired: they are just obfuscated) (auth-source--aput auth-source-netrc-cache file - (list :mtime (nth 5 (file-attributes file)) + (list :mtime (file-attribute-modification-time + (file-attributes file)) :secret (let ((v (mapcar #'1+ (buffer-string)))) (lambda () (apply #'string (mapcar #'1- v))))))) (goto-char (point-min)) diff --git a/lisp/autorevert.el b/lisp/autorevert.el index c60fe010a3..fc3469e03d 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -321,7 +321,7 @@ the list of old buffers.") (defun auto-revert-find-file-function () (setq-local auto-revert-tail-pos - (nth 7 (file-attributes buffer-file-name)))) + (file-attribute-size (file-attributes buffer-file-name)))) (add-hook 'find-file-hook #'auto-revert-find-file-function) @@ -434,7 +434,8 @@ Perform a full revert? ") (add-hook 'before-save-hook (lambda () (auto-revert-tail-mode 0)) nil t) (or (local-variable-p 'auto-revert-tail-pos) ; don't lose prior position (setq-local auto-revert-tail-pos - (nth 7 (file-attributes buffer-file-name)))) + (file-attribute-size + (file-attributes buffer-file-name)))) ;; let auto-revert-mode set up the mechanism for us if it isn't already (or auto-revert-mode (let ((auto-revert-tail-mode t)) @@ -656,8 +657,8 @@ This is an internal function used by Auto-Revert Mode." (and (file-readable-p buffer-file-name) (/= auto-revert-tail-pos (setq size - (nth 7 (file-attributes - buffer-file-name))))) + (file-attribute-size + (file-attributes buffer-file-name))))) (funcall (or buffer-stale-function #'buffer-stale--default-function) t))) diff --git a/lisp/cedet/ede/files.el b/lisp/cedet/ede/files.el index c95402e365..2c47481478 100644 --- a/lisp/cedet/ede/files.el +++ b/lisp/cedet/ede/files.el @@ -113,7 +113,7 @@ of the anchor file for the project." (if ede--disable-inode (ede--put-inode-dir-hash dir 0) (let ((fattr (file-attributes dir))) - (ede--put-inode-dir-hash dir (nth 10 fattr)) + (ede--put-inode-dir-hash dir (file-attribute-inode-number fattr)) ))))) (cl-defmethod ede--project-inode ((proj ede-project-placeholder)) diff --git a/lisp/cedet/semantic/db-file.el b/lisp/cedet/semantic/db-file.el index 7035939c38..2d55c274cd 100644 --- a/lisp/cedet/semantic/db-file.el +++ b/lisp/cedet/semantic/db-file.el @@ -307,8 +307,8 @@ Argument OBJ is the object to write." ;; Make sure that the file size and other attributes are ;; up to date. (let ((fattr (file-attributes (semanticdb-full-filename obj)))) - (oset obj fsize (nth 7 fattr)) - (oset obj lastmodtime (nth 5 fattr)) + (oset obj fsize (file-attribute-size fattr)) + (oset obj lastmodtime (file-attribute-modification-time fattr)) ) ;; Do it! diff --git a/lisp/cedet/semantic/db-mode.el b/lisp/cedet/semantic/db-mode.el index 638f2915f0..e61eb7183a 100644 --- a/lisp/cedet/semantic/db-mode.el +++ b/lisp/cedet/semantic/db-mode.el @@ -178,8 +178,9 @@ handle it later if need be." (let ((fattr (file-attributes (semanticdb-full-filename semanticdb-current-table)))) - (oset semanticdb-current-table fsize (nth 7 fattr)) - (oset semanticdb-current-table lastmodtime (nth 5 fattr)) + (oset semanticdb-current-table fsize (file-attribute-size fattr)) + (oset semanticdb-current-table lastmodtime + (file-attribute-modification-time fattr)) (oset semanticdb-current-table buffer nil) )) ;; If this messes up, just clear the system diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el index 491752e439..05484fccc0 100644 --- a/lisp/cedet/semantic/db.el +++ b/lisp/cedet/semantic/db.el @@ -611,8 +611,8 @@ The file associated with OBJ does not need to be in a buffer." ;; Buffer isn't loaded. The only clue we have is if the file ;; is somehow different from our mark in the semanticdb table. (let* ((stats (file-attributes ff)) - (actualsize (nth 7 stats)) - (actualmod (nth 5 stats)) + (actualsize (file-attribute-size stats)) + (actualmod (file-attribute-modification-time stats)) ) (or (not (slot-boundp obj 'tags)) @@ -631,8 +631,8 @@ The file associated with OBJ does not need to be in a buffer." (oset table tags new-tags) (oset table pointmax (point-max)) (let ((fattr (file-attributes (semanticdb-full-filename table)))) - (oset table fsize (nth 7 fattr)) - (oset table lastmodtime (nth 5 fattr)) + (oset table fsize (file-attribute-size fattr)) + (oset table lastmodtime (file-attribute-modification-time fattr)) ) ;; Assume it is now up to date. (oset table unmatched-syntax semantic-unmatched-syntax-cache) diff --git a/lisp/cedet/srecode/table.el b/lisp/cedet/srecode/table.el index ac968a6f9c..af2e8b178a 100644 --- a/lisp/cedet/srecode/table.el +++ b/lisp/cedet/srecode/table.el @@ -187,8 +187,8 @@ INIT are the initialization parameters for the new template table." (new (apply 'srecode-template-table (file-name-nondirectory file) :file file - :filesize (nth 7 attr) - :filedate (nth 5 attr) + :filesize (file-attribute-size attr) + :filedate (file-attribute-modification-time attr) :major-mode mode init ))) diff --git a/lisp/desktop.el b/lisp/desktop.el index a9fa2873b3..1346fa3241 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -1031,7 +1031,8 @@ without further confirmation." (setq desktop-dirname (file-name-as-directory (expand-file-name dirname))) (save-excursion (let ((eager desktop-restore-eager) - (new-modtime (nth 5 (file-attributes (desktop-full-file-name))))) + (new-modtime (file-attribute-modification-time + (file-attributes (desktop-full-file-name))))) (when (or (not new-modtime) ; nothing to overwrite (equal desktop-file-modtime new-modtime) @@ -1134,7 +1135,9 @@ without further confirmation." (write-region (point-min) (point-max) (desktop-full-file-name) nil 'nomessage)) (setq desktop-file-checksum checksum) ;; We remember when it was modified (which is presumably just now). - (setq desktop-file-modtime (nth 5 (file-attributes (desktop-full-file-name))))))))))) + (setq desktop-file-modtime (file-attribute-modification-time + (file-attributes + (desktop-full-file-name))))))))))) ;; ---------------------------------------------------------------------------- ;;;###autoload @@ -1238,7 +1241,9 @@ Using it may cause conflicts. Use it anyway? " owner))))) 'window-configuration-change-hook))) (desktop-auto-save-disable) ;; Evaluate desktop buffer and remember when it was modified. - (setq desktop-file-modtime (nth 5 (file-attributes (desktop-full-file-name)))) + (setq desktop-file-modtime (file-attribute-modification-time + (file-attributes + (desktop-full-file-name)))) (load (desktop-full-file-name) t t t) ;; If it wasn't already, mark it as in-use, to bother other ;; desktop instances. diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index ce2ed13ad0..1f13204b7c 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -200,9 +200,12 @@ Examples of PREDICATE: (> mtime1 mtime2) - mark newer files (not (= size1 size2)) - mark files with different sizes - (not (string= (nth 8 fa1) (nth 8 fa2))) - mark files with different modes - (not (and (= (nth 2 fa1) (nth 2 fa2)) - mark files with different UID - (= (nth 3 fa1) (nth 3 fa2)))) and GID." + (not (string= (file-attribute-modes fa1) - mark files with different modes + (file-attribute-modes fa2))) + (not (and (= (file-attribute-user-id fa1) - mark files with different UID + (file-attribute-user-id fa2)) + (= (file-attribute-group-id fa1) - and GID. + (file-attribute-group-id fa2))))" (interactive (list (let* ((target-dir (dired-dwim-target-directory)) @@ -269,12 +272,12 @@ condition. Two file items are considered to match if they are equal (eval predicate `((fa1 . ,fa1) (fa2 . ,fa2) - (size1 . ,(nth 7 fa1)) - (size2 . ,(nth 7 fa2)) + (size1 . ,(file-attribute-size fa1)) + (size2 . ,(file-attribute-size fa2)) (mtime1 - . ,(float-time (nth 5 fa1))) + . ,(float-time (file-attribute-modification-time fa1))) (mtime2 - . ,(float-time (nth 5 fa2))) + . ,(float-time (file-attribute-modification-time fa2))) ))))) (setq list (cdr list))) list) @@ -308,11 +311,14 @@ List has a form of (file-name full-file-name (attribute-list))." (cond ((eq op-symbol 'touch) (format-time-string "%Y%m%d%H%M.%S" - (nth 5 (file-attributes default-file)))) + (file-attribute-modification-time + (file-attributes default-file)))) ((eq op-symbol 'chown) - (nth 2 (file-attributes default-file 'string))) + (file-attribute-user-id + (file-attributes default-file 'string))) ((eq op-symbol 'chgrp) - (nth 3 (file-attributes default-file 'string)))))) + (file-attribute-group-id + (file-attributes default-file 'string)))))) (prompt (concat "Change " attribute-name " of %s to" (if (eq op-symbol 'touch) " (default now): " @@ -365,7 +371,7 @@ into the minibuffer." ;; The source of default file attributes is the file at point. (default-file (dired-get-filename t t)) (modestr (when default-file - (nth 8 (file-attributes default-file)))) + (file-attribute-modes (file-attributes default-file)))) (default (and (stringp modestr) (string-match "^.\\(...\\)\\(...\\)\\(...\\)$" modestr) @@ -1571,20 +1577,20 @@ If `ask', ask for user confirmation." (defun dired-copy-file-recursive (from to ok-flag &optional preserve-time top recursive) - (when (and (eq t (car (file-attributes from))) + (when (and (eq t (file-attribute-type (file-attributes from))) (file-in-directory-p to from)) (error "Cannot copy `%s' into its subdirectory `%s'" from to)) (let ((attrs (file-attributes from))) (if (and recursive - (eq t (car attrs)) + (eq t (file-attribute-type attrs)) (or (eq recursive 'always) (yes-or-no-p (format "Recursive copies of %s? " from)))) (copy-directory from to preserve-time) (or top (dired-handle-overwrite to)) (condition-case err - (if (stringp (car attrs)) + (if (stringp (file-attribute-type attrs)) ;; It is a symlink - (make-symbolic-link (car attrs) to ok-flag) + (make-symbolic-link (file-attribute-type attrs) to ok-flag) (dired-maybe-create-dirs (file-name-directory to)) (copy-file from to ok-flag preserve-time)) (file-date-error @@ -1765,7 +1771,7 @@ ESC or `q' to not overwrite any of the remaining files, (setq to destname)) ;; If DESTNAME is a subdirectory of FROM, not a symlink, ;; and the method in use is copying, signal an error. - (and (eq t (car (file-attributes destname))) + (and (eq t (file-attribute-type (file-attributes destname))) (eq file-creator 'dired-copy-file) (file-in-directory-p destname from) (error "Cannot copy `%s' into its subdirectory `%s'" diff --git a/lisp/dired.el b/lisp/dired.el index 0ed1a4f602..5c7bb9599c 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -850,8 +850,8 @@ If DIRNAME is already in a Dired buffer, that buffer is used without refresh." (not (let ((attributes (file-attributes dirname)) (modtime (visited-file-modtime))) (or (eq modtime 0) - (not (eq (car attributes) t)) - (equal (nth 5 attributes) modtime))))) + (not (eq (file-attribute-type attributes) t)) + (equal (file-attribute-modification-time attributes) modtime))))) (defvar auto-revert-remote-files) @@ -1092,7 +1092,8 @@ wildcards, erases the buffer, and builds the subdir-alist anew (dired-build-subdir-alist) (let ((attributes (file-attributes dirname))) (if (eq (car attributes) t) - (set-visited-file-modtime (nth 5 attributes)))) + (set-visited-file-modtime (file-attribute-modification-time + attributes)))) (set-buffer-modified-p nil) ;; No need to narrow since the whole buffer contains just ;; dired-readin's output, nothing else. The hook can diff --git a/lisp/dos-w32.el b/lisp/dos-w32.el index a45a9d1026..c19aa44016 100644 --- a/lisp/dos-w32.el +++ b/lisp/dos-w32.el @@ -342,7 +342,7 @@ filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"." w32-direct-print-region-use-command-dot-com ;; file-attributes fails on LPT ports on Windows 9x but ;; not on NT, so handle both cases for safety. - (eq (or (nth 7 (file-attributes printer)) 0) 0)) + (eq (or (file-attribute-size (file-attributes printer)) 0) 0)) (write-region start end tempfile nil 0) (let ((w32-quote-process-args nil)) (call-process "command.com" nil errbuf nil "/c" diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index efeb056204..3d73351911 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -813,7 +813,8 @@ FILE's modification time." (marker-buffer other-output-start) "actual autoloads are elsewhere" load-name relfile (if autoload-timestamps - (nth 5 (file-attributes absfile)) + (file-attribute-modification-time + (file-attributes absfile)) autoload--non-timestamp)) (insert ";;; Generated autoloads from " relfile "\n"))) (insert generate-autoload-section-trailer))))))) @@ -849,7 +850,8 @@ FILE's modification time." ;; `emacs-internal' instead. nil nil 'emacs-mule-unix) (if autoload-timestamps - (nth 5 (file-attributes relfile)) + (file-attribute-modification-time + (file-attributes relfile)) autoload--non-timestamp))) (insert ";;; Generated autoloads from " relfile "\n"))) (insert generate-autoload-section-trailer)))) @@ -862,7 +864,7 @@ FILE's modification time." ;; If the entries were added to some other buffer, then the file ;; doesn't add entries to OUTFILE. otherbuf)) - (nth 5 (file-attributes absfile)))) + (file-attribute-modification-time (file-attributes absfile)))) (error ;; Probably unbalanced parens in forward-sexp. In that case, the ;; condition is scan-error, and the signal data includes point @@ -943,7 +945,8 @@ removes any prior now out-of-date autoload entries." (existing-buffer (if buffer-file-name buf)) (output-file (autoload-generated-file)) (output-time (if (file-exists-p output-file) - (nth 5 (file-attributes output-file)))) + (file-attribute-modification-time + (file-attributes output-file)))) (found nil)) (with-current-buffer (autoload-find-generated-file) ;; This is to make generated-autoload-file have Unix EOLs, so @@ -965,7 +968,8 @@ removes any prior now out-of-date autoload entries." ;; Check if it is up to date. (let ((begin (match-beginning 0)) (last-time (nth 4 form)) - (file-time (nth 5 (file-attributes file)))) + (file-time (file-attribute-modification-time + (file-attributes file)))) (if (and (or (null existing-buffer) (not (buffer-modified-p existing-buffer))) (cond @@ -1058,7 +1062,8 @@ write its autoloads into the specified file instead." generated-autoload-file)) (output-time (if (file-exists-p generated-autoload-file) - (nth 5 (file-attributes generated-autoload-file))))) + (file-attribute-modification-time + (file-attributes generated-autoload-file))))) (with-current-buffer (autoload-find-generated-file) (save-excursion @@ -1079,7 +1084,8 @@ write its autoloads into the specified file instead." (if (member last-time (list t autoload--non-timestamp)) (setq last-time output-time)) (dolist (file file) - (let ((file-time (nth 5 (file-attributes file)))) + (let ((file-time (file-attribute-modification-time + (file-attributes file)))) (when (and file-time (not (time-less-p last-time file-time))) ;; file unchanged @@ -1098,7 +1104,8 @@ write its autoloads into the specified file instead." t autoload--non-timestamp)) output-time oldtime)) - (nth 5 (file-attributes file)))) + (file-attribute-modification-time + (file-attributes file)))) ;; File hasn't changed. nil) (t diff --git a/lisp/emacs-lisp/shadow.el b/lisp/emacs-lisp/shadow.el index 2e53382fa8..260ac3683d 100644 --- a/lisp/emacs-lisp/shadow.el +++ b/lisp/emacs-lisp/shadow.el @@ -161,8 +161,8 @@ See the documentation for `list-load-path-shadows' for further information." (or (equal (file-truename f1) (file-truename f2)) ;; As a quick test, avoiding spawning a process, compare file ;; sizes. - (and (= (nth 7 (file-attributes f1)) - (nth 7 (file-attributes f2))) + (and (= (file-attribute-size (file-attributes f1)) + (file-attribute-size (file-attributes f2))) (eq 0 (call-process "cmp" nil nil nil "-s" f1 f2)))))))) (defvar load-path-shadows-font-lock-keywords diff --git a/lisp/epg.el b/lisp/epg.el index f79f2046de..8f26cd34ee 100644 --- a/lisp/epg.el +++ b/lisp/epg.el @@ -608,7 +608,9 @@ callback data (if any)." ;; for more details. (when (and agent-info (string-match "\\(.*\\):[0-9]+:[0-9]+" agent-info)) (setq agent-file (match-string 1 agent-info) - agent-mtime (or (nth 5 (file-attributes agent-file)) '(0 0 0 0)))) + agent-mtime (or (file-attribute-modification-time + (file-attributes agent-file)) + '(0 0 0 0)))) (if epg-debug (save-excursion (unless epg-debug-buffer @@ -735,7 +737,9 @@ callback data (if any)." (if (with-current-buffer (process-buffer (epg-context-process context)) (and epg-agent-file (time-less-p epg-agent-mtime - (or (nth 5 (file-attributes epg-agent-file)) 0)))) + (or (file-attribute-modification-time + (file-attributes epg-agent-file)) + 0)))) (redraw-frame)) (epg-context-set-result-for context 'error diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index fc51009641..a7e27424f2 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -6040,8 +6040,7 @@ non-nil value is found. ;; time routines (defun erc-string-to-emacs-time (string) - "Convert the long number represented by STRING into an Emacs format. -Returns a list of the form (HIGH LOW), compatible with Emacs time format." + "Convert the long number represented by STRING into an Emacs timestamp." (let* ((n (string-to-number (concat string ".0")))) (list (truncate (/ n 65536)) (truncate (mod n 65536))))) diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el index 2b568a991a..53de7f7ec6 100644 --- a/lisp/eshell/em-ls.el +++ b/lisp/eshell/em-ls.el @@ -183,9 +183,9 @@ really need to stick around for very long." "The face used for highlighting junk file names.") (defsubst eshell-ls-filetype-p (attrs type) - "Test whether ATTRS specifies a directory." - (if (nth 8 attrs) - (eq (aref (nth 8 attrs) 0) type))) + "Test whether ATTRS specifies a file of type TYPE." + (if (file-attribute-modes attrs) + (eq (aref (file-attribute-modes attrs) 0) type))) (defmacro eshell-ls-applicable (attrs index func file) "Test whether, for ATTRS, the user can do what corresponds to INDEX. @@ -193,8 +193,8 @@ ATTRS is a string of file modes. See `file-attributes'. If we cannot determine the answer using ATTRS (e.g., if we need to know what group the user is in), compute the return value by calling FUNC with FILE as an argument." - `(let ((owner (nth 2 ,attrs)) - (modes (nth 8 ,attrs))) + `(let ((owner (file-attribute-user-id ,attrs)) + (modes (file-attribute-modes ,attrs))) (cond ((cond ((numberp owner) (= owner (user-uid))) ((stringp owner) @@ -437,7 +437,7 @@ Sort entries alphabetically across.") (defsubst eshell-ls-size-string (attrs size-width) "Return the size string for ATTRS length, using SIZE-WIDTH." - (let* ((str (eshell-ls-printable-size (nth 7 attrs) t)) + (let* ((str (eshell-ls-printable-size (file-attribute-size attrs) t)) (len (length str))) (if (< len size-width) (concat (make-string (- size-width len) ? ) str) @@ -503,19 +503,19 @@ whose cdr is the list of file attributes." (if numeric-uid-gid "%s%4d %-8s %-8s " "%s%4d %-14s %-8s ") - (or (nth 8 attrs) "??????????") - (or (nth 1 attrs) 0) - (or (let ((user (nth 2 attrs))) + (or (file-attribute-modes attrs) "??????????") + (or (file-attribute-link-number attrs) 0) + (or (let ((user (file-attribute-user-id attrs))) (and (stringp user) (eshell-substring user 14))) - (nth 2 attrs) + (file-attribute-user-id attrs) "") - (or (let ((group (nth 3 attrs))) + (or (let ((group (file-attribute-group-id attrs))) (and (stringp group) (eshell-substring group 8))) - (nth 3 attrs) + (file-attribute-group-id attrs) "")) - (let* ((str (eshell-ls-printable-size (nth 7 attrs))) + (let* ((str (eshell-ls-printable-size (file-attribute-size attrs))) (len (length str))) ;; Let file sizes shorter than 9 align neatly. (if (< len (or size-width 8)) @@ -585,12 +585,12 @@ relative to that directory." (let ((total 0.0)) (setq size-width 0) (dolist (e entries) - (if (nth 7 (cdr e)) - (setq total (+ total (nth 7 (cdr e))) + (if (file-attribute-size (cdr e)) + (setq total (+ total (file-attribute-size (cdr e))) size-width (max size-width (length (eshell-ls-printable-size - (nth 7 (cdr e)) + (file-attribute-size (cdr e)) (not ;; If we are under -l, count length ;; of sizes in bytes, not in blocks. @@ -700,7 +700,7 @@ Each member of FILES is either a string or a cons cell of the form (if (not show-size) (setq display-files (mapcar 'eshell-ls-annotate files)) (dolist (file files) - (let* ((str (eshell-ls-printable-size (nth 7 (cdr file)) t)) + (let* ((str (eshell-ls-printable-size (file-attribute-size (cdr file)) t)) (len (length str))) (if (< len size-width) (setq str (concat (make-string (- size-width len) ? ) str))) @@ -766,14 +766,14 @@ need to be printed." (if show-size (max size-width (length (eshell-ls-printable-size - (nth 7 (cdr entry)) t)))))) + (file-attribute-size (cdr entry)) t)))))) (setq dirs (cons entry dirs))) (setq files (cons entry files) size-width (if show-size (max size-width (length (eshell-ls-printable-size - (nth 7 (cdr entry)) t))))))) + (file-attribute-size (cdr entry)) t))))))) (when files (eshell-ls-files (eshell-ls-sort-entries files) size-width show-recursive) diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el index b3b16d909b..c3b942d25a 100644 --- a/lisp/eshell/em-pred.el +++ b/lisp/eshell/em-pred.el @@ -89,10 +89,12 @@ ordinary strings." (?t . (eshell-pred-file-mode 1000)) ; sticky bit (?U . #'(lambda (file) ; owned by effective uid (if (file-exists-p file) - (= (nth 2 (file-attributes file)) (user-uid))))) + (= (file-attribute-user-id (file-attributes file)) + (user-uid))))) ;; (?G . #'(lambda (file) ; owned by effective gid ;; (if (file-exists-p file) - ;; (= (nth 2 (file-attributes file)) (user-uid))))) + ;; (= (file-attribute-user-id (file-attributes file)) + ;; (user-uid))))) (?* . #'(lambda (file) (and (file-regular-p file) (not (file-symlink-p file)) @@ -460,7 +462,7 @@ that `ls -l' will show in the first column of its display. " `(lambda (file) (let ((attrs (eshell-file-attributes (directory-file-name file)))) (if attrs - (memq (aref (nth 8 attrs) 0) + (memq (aref (file-attribute-modes attrs) 0) ,(if (eq type ?%) '(?b ?c) (list 'quote (list type)))))))) @@ -489,7 +491,8 @@ that `ls -l' will show in the first column of its display. " '< (if (eq qual ?+) '> - '=)) (nth 1 attrs) ,amount)))))) + '=)) + (file-attribute-link-number attrs) ,amount)))))) (defun eshell-pred-file-size () "Return a predicate to test whether a file is of a given size." @@ -518,7 +521,8 @@ that `ls -l' will show in the first column of its display. " '< (if (eq qual ?+) '> - '=)) (nth 7 attrs) ,amount)))))) + '=)) + (file-attribute-size attrs) ,amount)))))) (defun eshell-pred-substitute (&optional repeat) "Return a modifier function that will substitute matches." diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index 9a99c53571..3aecebc2eb 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -370,12 +370,14 @@ Remove the DIRECTORY(ies), if they are empty.") (or (not (eshell-under-windows-p)) (eq system-type 'ms-dos)) (setq attr (eshell-file-attributes (car files))) - (nth 10 attr-target) (nth 10 attr) - ;; Use equal, not -, since the inode and the device could - ;; cons cells. - (equal (nth 10 attr-target) (nth 10 attr)) - (nth 11 attr-target) (nth 11 attr) - (equal (nth 11 attr-target) (nth 11 attr))) + (file-attribute-inode-number attr-target) + (file-attribute-inode-number attr) + (equal (file-attribute-inode-number attr-target) + (file-attribute-inode-number attr)) + (file-attribute-device-number attr-target) + (file-attribute-device-number attr) + (equal (file-attribute-device-number attr-target) + (file-attribute-device-number attr))) (eshell-error (format-message "%s: `%s' and `%s' are the same file\n" command (car files) target))) (t @@ -397,16 +399,16 @@ Remove the DIRECTORY(ies), if they are empty.") (let (eshell-warn-dot-directories) (if (and (not deep) (eq func 'rename-file) - ;; Use equal, since the device might be a - ;; cons cell. - (equal (nth 11 (eshell-file-attributes - (file-name-directory - (directory-file-name - (expand-file-name source))))) - (nth 11 (eshell-file-attributes - (file-name-directory - (directory-file-name - (expand-file-name target))))))) + (equal (file-attribute-device-number + (eshell-file-attributes + (file-name-directory + (directory-file-name + (expand-file-name source))))) + (file-attribute-device-number + (eshell-file-attributes + (file-name-directory + (directory-file-name + (expand-file-name target))))))) (apply 'eshell-funcalln func source target args) (unless (file-directory-p target) (if em-verbose @@ -612,7 +614,8 @@ symlink, then revert to the system's definition of cat." (> (length arg) 0) (eq (aref arg 0) ?-)) (let ((attrs (eshell-file-attributes arg))) - (and attrs (memq (aref (nth 8 attrs) 0) + (and attrs + (memq (aref (file-attribute-modes attrs) 0) '(?d ?l ?-))))) (throw 'special t))))) (let ((ext-cat (eshell-search-path "cat"))) @@ -843,19 +846,19 @@ external command." (unless (string-match "\\`\\.\\.?\\'" (caar entries)) (let* ((entry (concat path "/" (caar entries))) - (symlink (and (stringp (cadr (car entries))) - (cadr (car entries))))) + (symlink (and (stringp (file-attribute-type (cdar entries))) + (file-attribute-type (cdar entries))))) (unless (or (and symlink (not dereference-links)) (and only-one-filesystem (/= only-one-filesystem - (nth 12 (car entries))))) + (file-attribute-device-number (cdar entries))))) (if symlink (setq entry symlink)) (setq size (+ size - (if (eq t (cadr (car entries))) + (if (eq t (car (cdar entries))) (eshell-du-sum-directory entry (1+ depth)) - (let ((file-size (nth 8 (car entries)))) + (let ((file-size (file-attribute-size (cdar entries)))) (prog1 file-size (if show-all @@ -926,7 +929,7 @@ Summarize disk usage of each FILE, recursively for directories.") (while args (if only-one-filesystem (setq only-one-filesystem - (nth 11 (eshell-file-attributes + (file-attribute-device-number (eshell-file-attributes (file-name-as-directory (car args)))))) (setq size (+ size (eshell-du-sum-directory (directory-file-name (car args)) 0))) diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index 5ef1ae4129..8fe8c461fd 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -447,7 +447,7 @@ list." (not (symbol-value timestamp-var)) (time-less-p (symbol-value timestamp-var) - (nth 5 (file-attributes file)))) + (file-attribute-modification-time (file-attributes file)))) (progn (set result-var (eshell-read-passwd-file file)) (set timestamp-var (current-time)))) @@ -501,7 +501,7 @@ list." (not (symbol-value timestamp-var)) (time-less-p (symbol-value timestamp-var) - (nth 5 (file-attributes file)))) + (file-attribute-modification-time (file-attributes file)))) (progn (set result-var (eshell-read-hosts-file file)) (set timestamp-var (current-time)))) diff --git a/lisp/files.el b/lisp/files.el index da4f2cd78f..7efbf05b1a 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1152,7 +1152,8 @@ consecutive checks. For example: (defun display-time-file-nonempty-p (file) (let ((remote-file-name-inhibit-cache (- display-time-interval 5))) (and (file-exists-p file) - (< 0 (nth 7 (file-attributes (file-chase-links file)))))))" + (< 0 (file-attribute-size + (file-attributes (file-chase-links file)))))))" :group 'files :version "24.1" :type `(choice @@ -2155,10 +2156,10 @@ the various files." ;; Check to see if the file looks uncommonly large. (when (not (or buf nowarn)) (when (eq (abort-if-file-too-large - (nth 7 attributes) "open" filename t) + (file-attribute-size attributes) "open" filename t) 'raw) (setf rawfile t)) - (warn-maybe-out-of-memory (nth 7 attributes))) + (warn-maybe-out-of-memory (file-attribute-size attributes))) (if buf ;; We are using an existing buffer. (let (nonexistent) @@ -2372,7 +2373,8 @@ This function ensures that none of these modifications will take place." (signal 'file-error (list "Opening input file" "Is a directory" filename))) ;; Check whether the file is uncommonly large - (abort-if-file-too-large (nth 7 (file-attributes filename)) "insert" filename) + (abort-if-file-too-large (file-attribute-size (file-attributes filename)) + "insert" filename) (let* ((buffer (find-buffer-visiting (abbreviate-file-name (file-truename filename)) #'buffer-modified-p)) (tem (funcall insert-func filename))) @@ -3856,8 +3858,8 @@ Each element in this list has the form (DIR CLASS MTIME). DIR is the name of the directory. CLASS is the name of a variable class (a symbol). MTIME is the recorded modification time of the directory-local -variables file associated with this entry. This time is a list -of integers (the same format as `file-attributes'), and is +variables file associated with this entry. This time is a Lisp +timestamp (the same format as `current-time'), and is used to test whether the cache entry is still valid. Alternatively, MTIME can be nil, which means the entry is always considered valid.") @@ -4061,7 +4063,9 @@ This function returns either: (equal (nth 2 dir-elt) (let ((latest 0)) (dolist (f cached-files latest) - (let ((f-time (nth 5 (file-attributes f)))) + (let ((f-time + (file-attribute-modification-time + (file-attributes f)))) (if (time-less-p latest f-time) (setq latest f-time))))))))) ;; This cache entry is OK. @@ -4093,7 +4097,8 @@ Return the new class name, which is a symbol named DIR." (variables)) (with-demoted-errors "Error reading dir-locals: %S" (dolist (file files) - (let ((file-time (nth 5 (file-attributes file)))) + (let ((file-time (file-attribute-modification-time + (file-attributes file)))) (if (time-less-p latest file-time) (setq latest file-time))) (with-temp-buffer @@ -4445,7 +4450,7 @@ BACKUPNAME is the backup file name, which is the old file renamed." (let ((attr (file-attributes real-file-name 'integer))) - (<= (nth 2 attr) + (<= (file-attribute-user-id attr) copy-when-priv-mismatch)))) (not (file-ownership-preserved-p real-file-name t))))) @@ -4537,32 +4542,36 @@ the group would be preserved too." ;; Return t if the file doesn't exist, since it's true that no ;; information would be lost by an (attempted) delete and create. (or (null attributes) - (and (or (= (nth 2 attributes) (user-uid)) + (and (or (= (file-attribute-user-id attributes) (user-uid)) ;; Files created on Windows by Administrator (RID=500) ;; have the Administrators group (RID=544) recorded as ;; their owner. Rewriting them will still preserve the ;; owner. (and (eq system-type 'windows-nt) - (= (user-uid) 500) (= (nth 2 attributes) 544))) + (= (user-uid) 500) + (= (file-attribute-user-id attributes) 544))) (or (not group) ;; On BSD-derived systems files always inherit the parent ;; directory's group, so skip the group-gid test. (memq system-type '(berkeley-unix darwin gnu/kfreebsd)) - (= (nth 3 attributes) (group-gid))) + (= (file-attribute-group-id attributes) (group-gid))) (let* ((parent (or (file-name-directory file) ".")) (parent-attributes (file-attributes parent 'integer))) (and parent-attributes ;; On some systems, a file created in a setuid directory ;; inherits that directory's owner. (or - (= (nth 2 parent-attributes) (user-uid)) - (string-match "^...[^sS]" (nth 8 parent-attributes))) + (= (file-attribute-user-id parent-attributes) + (user-uid)) + (string-match + "^...[^sS]" + (file-attribute-modes parent-attributes))) ;; On many systems, a file created in a setgid directory ;; inherits that directory's group. On some systems ;; this happens even if the setgid bit is not set. (or (not group) - (= (nth 3 parent-attributes) - (nth 3 attributes))))))))))) + (= (file-attribute-group-id parent-attributes) + (file-attribute-group-id attributes))))))))))) (defun file-name-sans-extension (filename) "Return FILENAME sans final \"extension\". @@ -5722,7 +5731,8 @@ into NEWNAME instead." ;; Set directory attributes. (let ((modes (file-modes directory)) - (times (and keep-time (nth 5 (file-attributes directory))))) + (times (and keep-time (file-attribute-modification-time + (file-attributes directory))))) (if modes (set-file-modes newname modes)) (if times (set-file-times newname times)))))) @@ -7328,7 +7338,7 @@ based on existing mode bits, as in \"og+rX-w\"." (let* ((modes (or (if orig-file (file-modes orig-file) 0) (error "File not found"))) (modestr (and (stringp orig-file) - (nth 8 (file-attributes orig-file)))) + (file-attribute-modes (file-attributes orig-file)))) (default (and (stringp modestr) (string-match "^.\\(...\\)\\(...\\)\\(...\\)$" modestr) @@ -7508,27 +7518,24 @@ returned." (defsubst file-attribute-access-time (attributes) "The last access time in ATTRIBUTES returned by `file-attributes'. -This a list of integers (HIGH LOW USEC PSEC) in the same style -as (current-time)." +This a Lisp timestamp in the style of `current-time'." (nth 4 attributes)) (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 style of `current-time'." (nth 5 attributes)) (defsubst file-attribute-status-change-time (attributes) "The status modification time in ATTRIBUTES returned by `file-attributes'. This is the time of last change to the file's attributes: owner -and group, access mode bits, etc, and is a list of integers (HIGH -LOW USEC PSEC) in the same style as (current-time)." +and group, access mode bits, etc., and is a Lisp timestamp in the +style of `current-time'." (nth 6 attributes)) (defsubst file-attribute-size (attributes) - "The size (in bytes) in ATTRIBUTES returned by `file-attributes'. -This is a floating point number if the size is too large for an integer." + "The integer size (in bytes) in ATTRIBUTES returned by `file-attributes'." (nth 7 attributes)) (defsubst file-attribute-modes (attributes) @@ -7538,20 +7545,12 @@ This is a string of ten letters or dashes as in ls -l." (defsubst file-attribute-inode-number (attributes) "The inode number in ATTRIBUTES returned by `file-attributes'. -If it is larger than what an Emacs integer can hold, this is of -the form (HIGH . LOW): first the high bits, then the low 16 bits. -If even HIGH is too large for an Emacs integer, this is instead -of the form (HIGH MIDDLE . LOW): first the high bits, then the -middle 24 bits, and finally the low 16 bits." +It is a nonnegative integer." (nth 10 attributes)) (defsubst file-attribute-device-number (attributes) "The file system device number in ATTRIBUTES returned by `file-attributes'. -If it is larger than what an Emacs integer can hold, this is of -the form (HIGH . LOW): first the high bits, then the low 16 bits. -If even HIGH is too large for an Emacs integer, this is instead -of the form (HIGH MIDDLE . LOW): first the high bits, then the -middle 24 bits, and finally the low 16 bits." +It is an integer." (nth 11 attributes)) (defun file-attribute-collect (attributes &rest attr-names) diff --git a/lisp/find-lisp.el b/lisp/find-lisp.el index 0070e590c3..a3e4511d72 100644 --- a/lisp/find-lisp.el +++ b/lisp/find-lisp.el @@ -300,24 +300,24 @@ It is a function which takes two arguments, the directory and its parent." "Format one line of long ls output for file FILE-NAME. FILE-ATTR and FILE-SIZE give the file's attributes and size. SWITCHES and TIME-INDEX give the full switch list and time data." - (let ((file-type (nth 0 file-attr))) + (let ((file-type (file-attribute-type file-attr))) (concat (if (memq ?i switches) ; inode number - (format "%6d " (nth 10 file-attr))) + (format "%6d " (file-attribute-inode-number file-attr))) ;; nil is treated like "" in concat (if (memq ?s switches) ; size in K - (format "%4d " (1+ (/ (nth 7 file-attr) 1024)))) - (nth 8 file-attr) ; permission bits + (format "%4d " (1+ (/ (file-attribute-size file-attr) 1024)))) + (file-attribute-modes file-attr) (format " %3d %-8s %-8s %8d " - (nth 1 file-attr) ; no. of links - (if (numberp (nth 2 file-attr)) - (int-to-string (nth 2 file-attr)) - (nth 2 file-attr)) ; uid + (file-attribute-link-number file-attr) + (if (numberp (file-attribute-user-id file-attr)) + (int-to-string (file-attribute-user-id file-attr)) + (file-attribute-user-id file-attr)) (if (eq system-type 'ms-dos) "root" ; everything is root on MSDOS. - (if (numberp (nth 3 file-attr)) - (int-to-string (nth 3 file-attr)) - (nth 3 file-attr))) ; gid - (nth 7 file-attr) ; size in bytes + (if (numberp (file-attribute-group-id file-attr)) + (int-to-string (file-attribute-group-id file-attr)) + (file-attribute-group-id file-attr))) + (file-attribute-size file-attr) ) (find-lisp-format-time file-attr switches now) " " diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 532fd7e7b8..18e6174fa0 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -1603,7 +1603,8 @@ downloaded into the agent." (number-to-string have-this))) (size-file (float (or (and gnus-agent-total-fetched-hashtb - (nth 7 (file-attributes file-name))) + (file-attribute-size + (file-attributes file-name))) 0))) (file-name-coding-system nnmail-pathname-coding-system)) @@ -2096,12 +2097,16 @@ doesn't exist, to valid the overview buffer." (let* (alist (file-name-coding-system nnmail-pathname-coding-system) (file-attributes (directory-files-and-attributes - (gnus-agent-article-name "" - gnus-agent-read-agentview) nil "^[0-9]+$" t))) + (gnus-agent-article-name + "" gnus-agent-read-agentview) + nil "^[0-9]+$" t))) (while file-attributes (let ((fa (pop file-attributes))) - (unless (nth 1 fa) - (push (cons (string-to-number (nth 0 fa)) (time-to-days (nth 5 fa))) alist)))) + (unless (file-attribute-type (cdr fa)) + (push (cons (string-to-number (car fa)) + (time-to-days + (file-attribute-access-time (cdr fa)))) + alist)))) alist) (file-error nil)))))) @@ -3347,7 +3352,8 @@ missing NOV entry. Run gnus-agent-regenerate-group to restore it."))) (ignore-errors ; Just being paranoid. (let* ((file-name (nnheader-concat dir (number-to-string article-number))) - (size (float (nth 7 (file-attributes file-name))))) + (size (float (file-attribute-size + (file-attributes file-name))))) (cl-incf bytes-freed size) (cl-incf size-files-deleted size) (cl-incf files-deleted) @@ -3800,7 +3806,7 @@ has been fetched." (buffer-read-only nil) (file-name-coding-system nnmail-pathname-coding-system)) (when (and (file-exists-p file) - (> (nth 7 (file-attributes file)) 0)) + (> (file-attribute-size (file-attributes file)) 0)) (erase-buffer) (gnus-kill-all-overlays) (let ((coding-system-for-read gnus-cache-coding-system)) @@ -3945,9 +3951,11 @@ If REREAD is not nil, downloaded articles are marked as unread." ;; This entry in the overview has been downloaded (push (cons (car downloaded) (time-to-days - (nth 5 (file-attributes - (concat dir (number-to-string - (car downloaded))))))) alist) + (file-attribute-modification-time + (file-attributes + (concat dir (number-to-string + (car downloaded))))))) + alist) (setq downloaded (cdr downloaded)) (setq nov-arts (cdr nov-arts))) (t @@ -4105,19 +4113,21 @@ agent has fetched." (let ((sum 0.0) file) (while (setq file (pop delta)) - (cl-incf sum (float (or (nth 7 (file-attributes - (nnheader-concat - path - (if (numberp file) - (number-to-string file) - file)))) 0)))) + (cl-incf sum (float (or (file-attribute-size + (file-attributes + (nnheader-concat + path + (if (numberp file) + (number-to-string file) + file)))) + 0)))) (setq delta sum)) (let ((sum (- (nth 2 entry))) (info (directory-files-and-attributes path nil "^-?[0-9]+$" t)) file) (while (setq file (pop info)) - (cl-incf sum (float (or (nth 8 file) 0)))) + (cl-incf sum (float (or (file-attribute-size (cdr file)) 0)))) (setq delta sum)))) (setq gnus-agent-need-update-total-fetched-for t) @@ -4138,11 +4148,11 @@ modified." (gnus-sethash path (make-list 3 0) gnus-agent-total-fetched-hashtb))) (file-name-coding-system nnmail-pathname-coding-system) - (size (or (nth 7 (file-attributes - (nnheader-concat - path (if agent-over - ".overview" - ".agentview")))) + (size (or (file-attribute-size (file-attributes + (nnheader-concat + path (if agent-over + ".overview" + ".agentview")))) 0))) (setq gnus-agent-need-update-total-fetched-for t) (setf (nth (if agent-over 1 0) entry) size))))) diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el index 6afc52c0fc..a16b61a3bd 100644 --- a/lisp/gnus/gnus-cache.el +++ b/lisp/gnus/gnus-cache.el @@ -642,7 +642,8 @@ $ emacs -batch -l ~/.emacs -l gnus -f gnus-jog-cache" "Read the cache active file." (gnus-make-directory gnus-cache-directory) (if (or (not (file-exists-p gnus-cache-active-file)) - (zerop (nth 7 (file-attributes gnus-cache-active-file))) + (zerop (file-attribute-size + (file-attributes gnus-cache-active-file))) force) ;; There is no active file, so we generate one. (gnus-cache-generate-active) @@ -854,7 +855,7 @@ supported." size) (if file - (setq size (or (nth 7 (file-attributes file)) 0)) + (setq size (or (file-attribute-size (file-attributes file)) 0)) (let* ((file-name-coding-system nnmail-pathname-coding-system) (files (directory-files (gnus-cache-file-name group "") t nil t)) @@ -862,8 +863,8 @@ supported." (setq size 0.0) (while (setq file (pop files)) (setq attrs (file-attributes file)) - (unless (nth 0 attrs) - (cl-incf size (float (nth 7 attrs))))))) + (unless (file-attribute-type attrs) + (cl-incf size (float (file-attribute-size attrs))))))) (setq gnus-cache-need-update-total-fetched-for t) @@ -877,7 +878,7 @@ supported." (gnus-sethash group (make-list 2 0) gnus-cache-total-fetched-hashtb))) (file-name-coding-system nnmail-pathname-coding-system) - (size (or (nth 7 (file-attributes + (size (or (file-attribute-size (file-attributes (or file (gnus-cache-file-name group ".overview")))) 0))) diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el index 16bd80dbfa..1aa8e71ae1 100644 --- a/lisp/gnus/gnus-cloud.el +++ b/lisp/gnus/gnus-cloud.el @@ -339,7 +339,8 @@ Use old data if FORCE-OLDER is not nil." (format-time-string "%FT%T%z" time)) (defun gnus-cloud-file-new-p (file full) - (let ((timestamp (gnus-cloud-timestamp (nth 5 (file-attributes file)))) + (let ((timestamp (gnus-cloud-timestamp (file-attribute-modification-time + (file-attributes file)))) (old (cadr (assoc file gnus-cloud-file-timestamps)))) (when (or full (null old) diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index 6878aa69c6..327cc69392 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -2675,7 +2675,8 @@ the score file and its full name, including the directory.") (gnus-file-newer-than gnus-kill-files-directory (car gnus-score-file-list))) (setq gnus-score-file-list - (cons (nth 5 (file-attributes gnus-kill-files-directory)) + (cons (file-attribute-modification-time + (file-attributes gnus-kill-files-directory)) (nreverse (directory-files gnus-kill-files-directory t diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 623055e1f6..f15d645a53 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -2822,7 +2822,8 @@ If FORCE is non-nil, the .newsrc file is read." ;; Check timestamp of `gnus-current-startup-file'.eld against ;; `gnus-save-newsrc-file-last-timestamp'. (if (let* ((checkfile (concat gnus-current-startup-file ".eld")) - (mtime (nth 5 (file-attributes checkfile)))) + (mtime (file-attribute-modification-time + (file-attributes checkfile)))) (and gnus-save-newsrc-file-last-timestamp (time-less-p gnus-save-newsrc-file-last-timestamp mtime) @@ -2843,7 +2844,8 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-run-hooks 'gnus-save-quick-newsrc-hook) (save-buffer) (setq gnus-save-newsrc-file-last-timestamp - (nth 5 (file-attributes buffer-file-name)))) + (file-attribute-modification-time + (file-attributes buffer-file-name)))) (let ((coding-system-for-write gnus-ding-file-coding-system) (version-control gnus-backup-startup-file) (startup-file (concat gnus-current-startup-file ".eld")) @@ -2880,7 +2882,8 @@ If FORCE is non-nil, the .newsrc file is read." (rename-file working-file startup-file t) (gnus-set-file-modes startup-file setmodes) (setq gnus-save-newsrc-file-last-timestamp - (nth 5 (file-attributes startup-file))))) + (file-attribute-modification-time + (file-attributes startup-file))))) (condition-case nil (delete-file working-file) (file-error nil))))) @@ -3053,11 +3056,12 @@ If FORCE is non-nil, the .newsrc file is read." (with-current-buffer (gnus-get-buffer-create " *gnus slave*") (setq slave-files (sort (mapcar (lambda (file) - (list (nth 5 (file-attributes file)) file)) + (list (file-attribute-modification-time + (file-attributes file)) + file)) slave-files) (lambda (f1 f2) - (or (< (caar f1) (caar f2)) - (< (nth 1 (car f1)) (nth 1 (car f2))))))) + (time-less-p (car f1) (car f2))))) (while slave-files (erase-buffer) (setq file (nth 1 (car slave-files))) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index ceb9842166..f56b822ac5 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -10340,16 +10340,19 @@ latter case, they will be copied into the relevant groups." (unless (re-search-forward "^date:" nil t) (goto-char (point-max)) (setq atts (file-attributes file)) - (insert "Date: " (message-make-date (nth 5 atts)) "\n"))) + (insert "Date: " (message-make-date + (file-attribute-modification-time atts)) + "\n"))) ;; This doesn't look like an article, so we fudge some headers. (setq atts (file-attributes file) lines (count-lines (point-min) (point-max))) (insert "From: " (read-string "From: ") "\n" "Subject: " (read-string "Subject: ") "\n" - "Date: " (message-make-date (nth 5 atts)) "\n" + "Date: " (message-make-date + (file-attribute-modification-time atts)) "\n" "Message-ID: " (message-make-message-id) "\n" "Lines: " (int-to-string lines) "\n" - "Chars: " (int-to-string (nth 7 atts)) "\n\n")) + "Chars: " (int-to-string (file-attribute-size atts)) "\n\n")) (setq group-art (gnus-request-accept-article group nil t)) (kill-buffer (current-buffer))) (setq gnus-newsgroup-active (gnus-activate-group group)) diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index b30e4d125b..2e4b054a9f 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -277,10 +277,7 @@ Symbols are also allowed; their print names are used instead." ;;; Time functions. (defun gnus-file-newer-than (file date) - (let ((fdate (nth 5 (file-attributes file)))) - (or (> (car fdate) (car date)) - (and (= (car fdate) (car date)) - (> (nth 1 fdate) (nth 1 date)))))) + (time-less-p date (file-attribute-modification-time (file-attributes file)))) ;;; Keymap macros. @@ -1434,7 +1431,7 @@ SPEC is a predicate specifier that contains stuff like `or', `and', (defun gnus-cache-file-contents (file variable function) "Cache the contents of FILE in VARIABLE. The contents come from FUNCTION." - (let ((time (nth 5 (file-attributes file))) + (let ((time (file-attribute-modification-time (file-attributes file))) contents value) (if (or (null (setq value (symbol-value variable))) (not (equal (car value) file)) diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index 0e1c073636..5af292091e 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -602,7 +602,8 @@ If CONFIRM is non-nil, ask for confirmation before removing a file." (let* ((ffile (car files)) (bfile (replace-regexp-in-string "\\`.*/\\([^/]+\\)\\'" "\\1" ffile)) - (filetime (nth 5 (file-attributes ffile)))) + (filetime (file-attribute-modification-time + (file-attributes ffile)))) (setq files (cdr files)) (when (and (> (time-to-number-of-days (time-subtract now filetime)) diff) @@ -618,7 +619,8 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) (defun mail-source-callback (callback info) "Call CALLBACK on the mail file. Pass INFO on to CALLBACK." (if (or (not (file-exists-p mail-source-crash-box)) - (zerop (nth 7 (file-attributes mail-source-crash-box)))) + (zerop (file-attribute-size + (file-attributes mail-source-crash-box)))) (progn (when (file-exists-p mail-source-crash-box) (delete-file mail-source-crash-box)) @@ -670,7 +672,7 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) ((not (file-exists-p from)) ;; There is no inbox. (setq to nil)) - ((zerop (nth 7 (file-attributes from))) + ((zerop (file-attribute-size (file-attributes from))) ;; Empty file. (setq to nil)) (t diff --git a/lisp/gnus/nneething.el b/lisp/gnus/nneething.el index abd17c5508..10ac702550 100644 --- a/lisp/gnus/nneething.el +++ b/lisp/gnus/nneething.el @@ -215,8 +215,9 @@ included.") (setq nneething-map (mapcar (lambda (n) (list (cdr n) (car n) - (nth 5 (file-attributes - (nneething-file-name (car n)))))) + (file-attribute-modification-time + (file-attributes + (nneething-file-name (car n)))))) nneething-map))) ;; Remove files matching the exclusion regexp. (when nneething-exclude-files @@ -244,7 +245,7 @@ included.") (while map (if (and (member (cadr (car map)) files) ;; We also remove files that have changed mod times. - (equal (nth 5 (file-attributes + (equal (file-attribute-modification-time (file-attributes (nneething-file-name (cadr (car map))))) (cadr (cdar map)))) (progn @@ -262,7 +263,7 @@ included.") (setq touched t) (setcdr nneething-active (1+ (cdr nneething-active))) (push (list (cdr nneething-active) (car files) - (nth 5 (file-attributes + (file-attribute-modification-time (file-attributes (nneething-file-name (car files))))) nneething-map)) (setq files (cdr files))) @@ -318,15 +319,17 @@ included.") "Subject: " (file-name-nondirectory file) (or extra-msg "") "\n" "Message-ID: \n" - (if (equal '(0 0) (nth 5 atts)) "" - (concat "Date: " (current-time-string (nth 5 atts)) "\n")) + (if (zerop (float-time (file-attribute-modification-time atts))) "" + (concat "Date: " + (current-time-string (file-attribute-modification-time atts)) + "\n")) (or (when buffer (with-current-buffer buffer (when (re-search-forward "<[a-zA-Z0-9_]@[-a-zA-Z0-9_]>" 1000 t) (concat "From: " (match-string 0) "\n")))) - (nneething-from-line (nth 2 atts) file)) - (if (> (string-to-number (int-to-string (nth 7 atts))) 0) - (concat "Chars: " (int-to-string (nth 7 atts)) "\n") + (nneething-from-line (file-attribute-user-id atts) file)) + (if (> (file-attribute-size atts) 0) + (concat "Chars: " (int-to-string (file-attribute-size atts)) "\n") "") (if buffer (with-current-buffer buffer diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el index 11a3986668..8ef6f2a058 100644 --- a/lisp/gnus/nnfolder.el +++ b/lisp/gnus/nnfolder.el @@ -862,7 +862,7 @@ deleted. Point is left where the deleted region was." (mm-enable-multibyte) ;; Use multibyte buffer for future copying. (buffer-disable-undo) (if (equal (cadr (assoc group nnfolder-scantime-alist)) - (nth 5 (file-attributes file))) + (file-attribute-modification-time (file-attributes file))) ;; This looks up-to-date, so we don't do any scanning. (if (file-exists-p file) buffer diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index b9ce20413f..83a9c3f3e1 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -896,7 +896,7 @@ without formatting." (defun nnheader-file-size (file) "Return the file size of FILE or 0." - (or (nth 7 (file-attributes file)) 0)) + (or (file-attribute-size (file-attributes file)) 0)) (defun nnheader-find-etc-directory (package &optional file first) "Go through `load-path' and find the \"../etc/PACKAGE\" directory. @@ -951,7 +951,7 @@ find-file-hook, etc. (mm-insert-file-contents filename visit beg end replace))) (defun nnheader-insert-nov-file (file first) - (let ((size (nth 7 (file-attributes file))) + (let ((size (file-attribute-size (file-attributes file))) (cutoff (* 32 1024))) (when size (if (< size cutoff) diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index 08db5ab5b6..13c4303291 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -1534,7 +1534,8 @@ See the documentation for the variable `nnmail-split-fancy' for details." (and (setq file (ignore-errors (symbol-value (intern (format "%s-active-file" backend))))) - (setq file-time (nth 5 (file-attributes file))) + (setq file-time (file-attribute-modification-time + (file-attributes file))) (or (not (setq timestamp (condition-case () diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index fbabf573c4..afaf3dcfcf 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -318,15 +318,15 @@ This variable is set by `nnmaildir-request-article'.") (setq attr (file-attributes (concat dir (number-to-string number-opened)))) (or attr (throw 'return (1- number-opened))) - (setq ino-opened (nth 10 attr) - nlink (nth 1 attr) + (setq ino-opened (file-attribute-inode-number attr) + nlink (file-attribute-link-number attr) number-linked (+ number-opened nlink)) (if (or (< nlink 1) (< number-linked nlink)) (signal 'error '("Arithmetic overflow"))) (setq attr (file-attributes (concat dir (number-to-string number-linked)))) (or attr (throw 'return (1- number-linked))) - (unless (equal ino-opened (nth 10 attr)) + (unless (equal ino-opened (file-attribute-inode-number attr)) (setq number-opened number-linked)))))) ;; Make the given server, if non-nil, be the current server. Then make the @@ -392,8 +392,8 @@ This variable is set by `nnmaildir-request-article'.") (setq make-new-file nil previous-number-link 0)) (let* ((attr (file-attributes path-open)) - (nlink (nth 1 attr))) - (setq ino-open (nth 10 attr) + (nlink (file-attribute-link-number attr))) + (setq ino-open (file-attribute-inode-number attr) number-link (+ number-open nlink)) (if (or (< nlink 1) (< number-link nlink)) (signal 'error '("Arithmetic overflow")))) @@ -412,7 +412,7 @@ This variable is set by `nnmaildir-request-article'.") number-open number-link)) ((nnmaildir--eexist-p err) (let ((attr (file-attributes path-link))) - (unless (equal (nth 10 attr) ino-open) + (unless (equal (file-attribute-inode-number attr) ino-open) (setq number-open number-link number-link 0)))) (t (signal (car err) (cdr err))))))))) @@ -437,8 +437,8 @@ This variable is set by `nnmaildir-request-article'.") (unless attr (nnmaildir--expired-article group article) (throw 'return nil)) - (setq mtime (nth 5 attr) - attr (nth 7 attr) + (setq mtime (file-attribute-modification-time attr) + attr (file-attribute-size attr) nov (nnmaildir--art-nov article) dir (nnmaildir--nndir dir) novdir (nnmaildir--nov-dir dir) @@ -794,29 +794,33 @@ This variable is set by `nnmaildir-request-article'.") (setq read-only (nnmaildir--param pgname 'read-only) ls (or (nnmaildir--param pgname 'directory-files) srv-ls)) (unless read-only - (setq x (nth 11 (file-attributes tdir))) - (unless (and (equal x (nth 11 nattr)) (equal x (nth 11 cattr))) + (setq x (file-attribute-device-number (file-attributes tdir))) + (unless (and (equal x (file-attribute-device-number nattr)) + (equal x (file-attribute-device-number cattr))) (setf (nnmaildir--srv-error nnmaildir--cur-server) (concat "Maildir spans filesystems: " absdir)) (throw 'return nil)) (dolist (file (funcall ls tdir 'full "\\`[^.]" 'nosort)) (setq x (file-attributes file)) - (if (or (> (cadr x) 1) (time-less-p (nth 4 x) 36h-ago)) + (if (or (> (file-attribute-link-number x) 1) + (time-less-p (file-attribute-access-time x) 36h-ago)) (delete-file file)))) (or scan-msgs isnew (throw 'return t)) - (setq nattr (nth 5 nattr)) + (setq nattr (file-attribute-modification-time nattr)) (if (equal nattr (nnmaildir--grp-new group)) (setq nattr nil)) (if read-only (setq dir (and (or isnew nattr) ndir)) (when (or isnew nattr) (dolist (file (funcall ls ndir nil "\\`[^.]" 'nosort)) (setq x (concat ndir file)) - (and (time-less-p (nth 5 (file-attributes x)) nil) + (and (time-less-p (file-attribute-modification-time + (file-attributes x)) + nil) (rename-file x (concat cdir (nnmaildir--ensure-suffix file))))) (setf (nnmaildir--grp-new group) nattr)) - (setq cattr (nth 5 (file-attributes cdir))) + (setq cattr (file-attribute-modification-time (file-attributes cdir))) (if (equal cattr (nnmaildir--grp-cur group)) (setq cattr nil)) (setq dir (and (or isnew cattr) cdir))) @@ -903,7 +907,7 @@ This variable is set by `nnmaildir-request-article'.") (if (nnmaildir--srv-gnm nnmaildir--cur-server) (nnmail-get-new-mail 'nnmaildir nil nil scan-group)) (unintern scan-group groups)) - (setq x (nth 5 (file-attributes srv-dir)) + (setq x (file-attribute-modification-time (file-attributes srv-dir)) scan-group (null scan-group)) (if (equal x (nnmaildir--srv-mtime nnmaildir--cur-server)) (if scan-group @@ -936,7 +940,7 @@ This variable is set by `nnmaildir-request-article'.") (dolist (grp x) (unintern grp groups)) (setf (nnmaildir--srv-mtime nnmaildir--cur-server) - (nth 5 (file-attributes srv-dir)))) + (file-attribute-modification-time (file-attributes srv-dir)))) (and scan-group (nnmaildir--srv-gnm nnmaildir--cur-server) (nnmail-get-new-mail 'nnmaildir nil nil)))))) @@ -993,7 +997,7 @@ This variable is set by `nnmaildir-request-article'.") (curdir (nnmaildir--cur (nnmaildir--srvgrp-dir (nnmaildir--srv-dir nnmaildir--cur-server) gname))) - (curdir-mtime (nth 5 (file-attributes curdir))) + (curdir-mtime (file-attribute-modification-time (file-attributes curdir))) pgname flist always-marks never-marks old-marks dir all-marks marks ranges markdir read ls old-mmth new-mmth mtime existing missing deactivate-mark) @@ -1046,7 +1050,7 @@ This variable is set by `nnmaildir-request-article'.") ;; a filename flag, get the later of the mtimes for markdir and ;; curdir, otherwise only the markdir counts. (setq mtime - (let ((markdir-mtime (nth 5 (file-attributes markdir)))) + (let ((markdir-mtime (file-attribute-modification-time (file-attributes markdir)))) (cond ((null (nnmaildir--mark-to-flag mark)) markdir-mtime) @@ -1599,7 +1603,7 @@ This variable is set by `nnmaildir-request-article'.") (nnmaildir--expired-article group article)) ((and no-force (progn - (setq time (nth 5 time) + (setq time (file-attribute-modification-time time) bound-iter boundary) (while (and bound-iter time (= (car bound-iter) (car time))) diff --git a/lisp/gnus/nnmh.el b/lisp/gnus/nnmh.el index 33be64fb8d..d0f8ec256e 100644 --- a/lisp/gnus/nnmh.el +++ b/lisp/gnus/nnmh.el @@ -210,8 +210,10 @@ as unread by Gnus.") min rdir num subdirectoriesp file) ;; Recurse down directories. (setq subdirectoriesp - ;; nth 1 of file-attributes always 1 on MS Windows :( - (/= (nth 1 (file-attributes (file-truename dir))) 2)) + ;; link number always 1 on MS Windows :( + (/= (file-attribute-link-number + (file-attributes (file-truename dir))) + 2)) (dolist (rdir files) (if (or (not subdirectoriesp) (file-regular-p rdir)) @@ -263,7 +265,8 @@ as unread by Gnus.") (while (and articles is-old) (setq article (concat dir (int-to-string (car articles)))) - (when (setq mod-time (nth 5 (file-attributes article))) + (when (setq mod-time (file-attribute-modification-time + (file-attributes article))) (if (and (nnmh-deletable-article-p newsgroup (car articles)) (setq is-old (nnmail-expired-article-p newsgroup mod-time force))) @@ -534,8 +537,8 @@ as unread by Gnus.") art) (while (setq art (pop arts)) (when (not (equal - (nth 5 (file-attributes - (concat dir (int-to-string (car art))))) + (file-attribute-modification-time + (file-attributes (concat dir (int-to-string (car art))))) (cdr art))) (setq articles (delq art articles)) (push (car art) new)))) @@ -546,8 +549,9 @@ as unread by Gnus.") (mapcar (lambda (art) (cons art - (nth 5 (file-attributes - (concat dir (int-to-string art)))))) + (file-attribute-modification-time + (file-attributes + (concat dir (int-to-string art)))))) new))) ;; Make Gnus mark all new articles as unread. (when new diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el index 6307e13218..e7a5b99835 100644 --- a/lisp/gnus/nnml.el +++ b/lisp/gnus/nnml.el @@ -344,7 +344,8 @@ non-nil.") (while (and articles is-old) (if (and (setq article (nnml-article-to-file (setq number (pop articles)))) - (setq mod-time (nth 5 (file-attributes article))) + (setq mod-time (file-attribute-modification-time + (file-attributes article))) (nnml-deletable-article-p group number) (setq is-old (nnmail-expired-article-p group mod-time force nnml-inhibit-expiry))) diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el index 9205295260..3625132f8f 100644 --- a/lisp/gnus/spam-stat.el +++ b/lisp/gnus/spam-stat.el @@ -77,13 +77,13 @@ ;; Learn spam: (spam-stat-process-spam-directory "~/Mail/mail/spam") ;; Learn non-spam: (spam-stat-process-non-spam-directory "~/Mail/mail/misc") ;; Save table: (spam-stat-save) -;; File size: (nth 7 (file-attributes spam-stat-file)) +;; File size: (file-attribute-size (file-attributes spam-stat-file)) ;; Number of words: (hash-table-count spam-stat) ;; Test spam: (spam-stat-test-directory "~/Mail/mail/spam") ;; Test non-spam: (spam-stat-test-directory "~/Mail/mail/misc") ;; Reduce table size: (spam-stat-reduce-size) ;; Save table: (spam-stat-save) -;; File size: (nth 7 (file-attributes spam-stat-file)) +;; File size: (file-attribute-size (file-attributes spam-stat-file)) ;; Number of words: (hash-table-count spam-stat) ;; Test spam: (spam-stat-test-directory "~/Mail/mail/spam") ;; Test non-spam: (spam-stat-test-directory "~/Mail/mail/misc") @@ -424,7 +424,8 @@ spam-stat (spam-stat-to-hash-table '(" spam-stat-ngood spam-stat-nbad)) (insert ")))")))) (message "Saved %s." spam-stat-file) (setq spam-stat-dirty nil - spam-stat-last-saved-at (nth 5 (file-attributes spam-stat-file))))) + spam-stat-last-saved-at (file-attribute-modification-time + (file-attributes spam-stat-file))))) (defun spam-stat-load () "Read the `spam-stat' hash table from disk." @@ -434,12 +435,14 @@ spam-stat (spam-stat-to-hash-table '(" spam-stat-ngood spam-stat-nbad)) ((or (not (boundp 'spam-stat-last-saved-at)) (null spam-stat-last-saved-at) (not (equal spam-stat-last-saved-at - (nth 5 (file-attributes spam-stat-file))))) + (file-attribute-modification-time + (file-attributes spam-stat-file))))) (progn (load-file spam-stat-file) (setq spam-stat-dirty nil spam-stat-last-saved-at - (nth 5 (file-attributes spam-stat-file))))) + (file-attribute-modification-time + (file-attributes spam-stat-file))))) (t (message "Spam stat file not loaded: no change in disk."))))) (defun spam-stat-to-hash-table (entries) @@ -561,8 +564,10 @@ check the variable `spam-stat-score-data'." (dolist (f files) (when (and (file-readable-p f) (file-regular-p f) - (> (nth 7 (file-attributes f)) 0) - (< (time-to-number-of-days (time-since (nth 5 (file-attributes f)))) + (> (file-attribute-size (file-attributes f)) 0) + (< (time-to-number-of-days + (time-since (file-attribute-modification-time + (file-attributes f)))) spam-stat-process-directory-age)) (setq count (1+ count)) (message "Reading %s: %.2f%%" dir (/ count max)) @@ -607,7 +612,7 @@ display non-spam files; otherwise display spam files." (dolist (f files) (when (and (file-readable-p f) (file-regular-p f) - (> (nth 7 (file-attributes f)) 0)) + (> (file-attribute-size (file-attributes f)) 0)) (setq count (1+ count)) (message "Reading %.2f%%, score %.2f" (/ count max) (/ score count)) diff --git a/lisp/ido.el b/lisp/ido.el index f9a9607a3a..64d820333f 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -1750,7 +1750,8 @@ is enabled then some keybindings are changed in the keymap." (ido-final-slash dir) (not (ido-is-unc-host dir)) (file-directory-p dir) - (> (nth 7 (file-attributes (file-truename dir))) ido-max-directory-size)))) + (> (file-attribute-size (file-attributes (file-truename dir))) + ido-max-directory-size)))) (defun ido-set-current-directory (dir &optional subdir no-merge) ;; Set ido's current directory to DIR or DIR/SUBDIR @@ -3610,7 +3611,7 @@ Uses and updates `ido-dir-file-cache'." (ftp (ido-is-ftp-directory dir)) (unc (ido-is-unc-host dir)) (attr (if (or ftp unc) nil (file-attributes dir))) - (mtime (nth 5 attr)) + (mtime (file-attribute-modification-time attr)) valid) (when cached ; should we use the cached entry ? (cond diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 1acb31928b..17e566d5b1 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -587,8 +587,9 @@ Create the thumbnails directory if it does not exist." (let* ((thumb-file (image-dired-thumb-name file)) (thumb-attr (file-attributes thumb-file))) (when (or (not thumb-attr) - (time-less-p (nth 5 thumb-attr) - (nth 5 (file-attributes file)))) + (time-less-p (file-attribute-modification-time thumb-attr) + (file-attribute-modification-time + (file-attributes file)))) (image-dired-create-thumb file thumb-file)) (create-image thumb-file) ;; (list 'image :type 'jpeg @@ -752,7 +753,8 @@ Increase at own risk.") (let* ((width (int-to-string (image-dired-thumb-size 'width))) (height (int-to-string (image-dired-thumb-size 'height))) (modif-time (format-time-string - "%s" (nth 5 (file-attributes original-file)))) + "%s" (file-attribute-modification-time + (file-attributes original-file)))) (thumbnail-nq8-file (replace-regexp-in-string ".png\\'" "-nq8.png" thumbnail-file)) (spec @@ -2652,8 +2654,8 @@ tags to their respective image file. Internal function used by ;; (mapcar ;; (lambda (f) ;; (let ((fattribs (file-attributes f))) -;; ;; Get last access time and file size -;; `(,(nth 4 fattribs) ,(nth 7 fattribs) ,f))) +;; `(,(file-attribute-access-time fattribs) +;; ,(file-attribute-size fattribs) ,f))) ;; (directory-files (image-dired-dir) t ".+\\.thumb\\..+$")) ;; ;; Sort function. Compare time between two files. ;; (lambda (l1 l2) diff --git a/lisp/info.el b/lisp/info.el index ab2c51d84b..f2e29578f8 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -654,9 +654,11 @@ Do the right thing if the file has been compressed or zipped." ;; Clear the caches of modified Info files. (let* ((attribs-old (cdr (assoc fullname Info-file-attributes))) - (modtime-old (and attribs-old (nth 5 attribs-old))) + (modtime-old (and attribs-old + (file-attribute-modification-time attribs-old))) (attribs-new (and (stringp fullname) (file-attributes fullname))) - (modtime-new (and attribs-new (nth 5 attribs-new)))) + (modtime-new (and attribs-new + (file-attribute-modification-time attribs-new)))) (when (and modtime-old modtime-new (time-less-p modtime-old modtime-new)) (setq Info-index-nodes (remove (assoc (or Info-current-file filename) diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index adb86dd05b..95f3163ddf 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -385,13 +385,13 @@ not contain `d', so that a full listing is expected." ;; files we are about to display. (dolist (elt file-alist) (setq attr (cdr elt) - fuid (nth 2 attr) + fuid (file-attribute-user-id attr) uid-len (if (stringp fuid) (string-width fuid) (length (format "%d" fuid))) - fgid (nth 3 attr) + fgid (file-attribute-group-id attr) gid-len (if (stringp fgid) (string-width fgid) (length (format "%d" fgid))) - file-size (nth 7 attr)) + file-size (file-attribute-size attr)) (if (> uid-len max-uid-len) (setq max-uid-len uid-len)) (if (> gid-len max-gid-len) @@ -418,7 +418,7 @@ not contain `d', so that a full listing is expected." files (cdr files) short (car elt) attr (cdr elt) - file-size (nth 7 attr)) + file-size (file-attribute-size attr)) (and attr (setq sum (+ file-size ;; Even if neither SUM nor file's size @@ -474,7 +474,7 @@ not contain `d', so that a full listing is expected." (if (memq ?F switches) (ls-lisp-classify-file file fattr) file) - fattr (nth 7 fattr) + fattr (file-attribute-size fattr) switches time-index)) (message "%s: doesn't exist or is inaccessible" file) (ding) (sit-for 2))))) ; to show user the message! @@ -659,10 +659,9 @@ SWITCHES is a list of characters. Default sorting is alphabetic." (sort (copy-sequence file-alist) ; modifies its argument! (cond ((memq ?S switches) (lambda (x y) ; sorted on size - ;; 7th file attribute is file size ;; Make largest file come first - (< (nth 7 (cdr y)) - (nth 7 (cdr x))))) + (< (file-attribute-size (cdr y)) + (file-attribute-size (cdr x))))) ((setq index (ls-lisp-time-index switches)) (lambda (x y) ; sorted on time (time-less-p (nth index (cdr y)) @@ -719,8 +718,8 @@ FATTR is the file attributes returned by `file-attributes' for the file. The file type indicators are `/' for directories, `@' for symbolic links, `|' for FIFOs, `=' for sockets, `*' for regular files that are executable, and nothing for other types of files." - (let* ((type (car fattr)) - (modestr (nth 8 fattr)) + (let* ((type (file-attribute-type fattr)) + (modestr (file-attribute-modes fattr)) (typestr (substring modestr 0 1)) (file-name (propertize filename 'dired-filename t))) (cond @@ -773,35 +772,13 @@ FOLLOWED by null and full filename, SOLELY for full alpha sort." "Format one line of long ls output for file FILE-NAME. FILE-ATTR and FILE-SIZE give the file's attributes and size. SWITCHES and TIME-INDEX give the full switch list and time data." - (let ((file-type (nth 0 file-attr)) + (let ((file-type (file-attribute-type file-attr)) ;; t for directory, string (name linked to) ;; for symbolic link, or nil. - (drwxrwxrwx (nth 8 file-attr))) ; attribute string ("drwxrwxrwx") + (drwxrwxrwx (file-attribute-modes file-attr))) (concat (if (memq ?i switches) ; inode number - (let ((inode (nth 10 file-attr))) - (if (consp inode) - (if (consp (cdr inode)) - ;; 2^(24+16) = 1099511627776.0, but - ;; multiplying by it and then adding the - ;; other members of the cons cell in one go - ;; loses precision, since a double does not - ;; have enough significant digits to hold a - ;; full 64-bit value. So below we split - ;; 1099511627776 into high 13 and low 5 - ;; digits and compute in two parts. - (let ((p1 (* (car inode) 10995116.0)) - (p2 (+ (* (car inode) 27776.0) - (* (cadr inode) 65536.0) - (cddr inode)))) - (format " %13.0f%05.0f " - ;; Use floor to emulate integer - ;; division. - (+ p1 (floor p2 100000.0)) - (mod p2 100000.0))) - (format " %18.0f " - (+ (* (car inode) 65536.0) - (cdr inode)))) - (format " %18d " inode)))) + (let ((inode (file-attribute-inode-number file-attr))) + (format " %18d " inode))) ;; nil is treated like "" in concat (if (memq ?s switches) ; size in K, rounded up ;; In GNU ls, -h affects the size in blocks, displayed @@ -819,14 +796,14 @@ SWITCHES and TIME-INDEX give the full switch list and time data." (fceiling (/ file-size 1024.0))))) drwxrwxrwx ; attribute string (if (memq 'links ls-lisp-verbosity) - (format "%3d" (nth 1 file-attr))) ; link count + (format "%3d" (file-attribute-link-number file-attr))) ;; Numeric uid/gid are more confusing than helpful; ;; Emacs should be able to make strings of them. ;; They tend to be bogus on non-UNIX platforms anyway so ;; optionally hide them. (if (memq 'uid ls-lisp-verbosity) ;; uid can be a string or an integer - (let ((uid (nth 2 file-attr))) + (let ((uid (file-attribute-user-id file-attr))) (format (if (stringp uid) ls-lisp-uid-s-fmt ls-lisp-uid-d-fmt) @@ -834,7 +811,7 @@ SWITCHES and TIME-INDEX give the full switch list and time data." (if (not (memq ?G switches)) ; GNU ls -- shows group by default (if (or (memq ?g switches) ; UNIX ls -- no group by default (memq 'gid ls-lisp-verbosity)) - (let ((gid (nth 3 file-attr))) + (let ((gid (file-attribute-group-id file-attr))) (format (if (stringp gid) ls-lisp-gid-s-fmt ls-lisp-gid-d-fmt) diff --git a/lisp/mail/blessmail.el b/lisp/mail/blessmail.el index 8261f175ad..62e9873b49 100644 --- a/lisp/mail/blessmail.el +++ b/lisp/mail/blessmail.el @@ -49,15 +49,15 @@ (setq attr (file-attributes dirname)) (if (not (eq t (car attr))) (insert (format "echo %s is not a directory\n" rmail-spool-directory)) - (setq modes (nth 8 attr)) + (setq modes (file-attribute-modes attr)) (cond ((= ?w (aref modes 8)) ;; Nothing needs to be done. ) ((= ?w (aref modes 5)) - (insert "chgrp " (number-to-string (nth 3 attr)) + (insert "chgrp " (number-to-string (file-attribute-group-id attr)) " $* && chmod g+s $*\n")) ((= ?w (aref modes 2)) - (insert "chown " (number-to-string (nth 2 attr)) + (insert "chown " (number-to-string (file-attribute-user-id attr)) " $* && chmod u+s $*\n")) (t (insert "chown root $* && chmod u+s $*\n")))) diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el index ec4a1162b2..2b63343239 100644 --- a/lisp/mail/feedmail.el +++ b/lisp/mail/feedmail.el @@ -2815,16 +2815,13 @@ return that value." (defun feedmail-default-date-generator (maybe-file) "Default function for generating Date: header contents." (feedmail-say-debug ">in-> feedmail-default-date-generator") - (when maybe-file - (feedmail-say-debug (concat "4 cre " (feedmail-rfc822-date (nth 4 (file-attributes maybe-file))))) - (feedmail-say-debug (concat "5 mod " (feedmail-rfc822-date (nth 5 (file-attributes maybe-file))))) - (feedmail-say-debug (concat "6 sta " (feedmail-rfc822-date (nth 6 (file-attributes maybe-file)))))) - (let ((date-time)) - (if (and (not feedmail-queue-use-send-time-for-date) maybe-file) - (setq date-time (nth 5 (file-attributes maybe-file)))) - (feedmail-rfc822-date date-time)) - ) - + (let ((attr (and maybe-file (file-attributes maybe-file)))) + (when attr + (feedmail-say-debug (concat "4 cre " (feedmail-rfc822-date (file-attribute-access-time attr)))) + (feedmail-say-debug (concat "5 mod " (feedmail-rfc822-date (file-attribute-modification-time attr)))) + (feedmail-say-debug (concat "6 sta " (feedmail-rfc822-date (file-attribute-status-change-time attr))))) + (feedmail-rfc822-date (and attr (not feedmail-queue-use-send-time-for-date) + (file-attribute-modification-time attr))))) (defun feedmail-fiddle-date (maybe-file) "Fiddle Date:. See documentation of `feedmail-date-generator'." @@ -2874,7 +2871,8 @@ probably not appropriate for you." (concat (if (equal (match-beginning 1) (match-end 1)) "" "-") end-stuff)) (setq end-stuff (concat "@" end-stuff))) (if (and (not feedmail-queue-use-send-time-for-message-id) maybe-file) - (setq date-time (nth 5 (file-attributes maybe-file)))) + (setq date-time (file-attribute-modification-time + (file-attributes maybe-file)))) (format "<%d-%s%s%s>" (mod (random) 10000) (format-time-string "%a%d%b%Y%H%M%S" date-time) diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el index 0ce1a3b12b..e5456d92af 100644 --- a/lisp/mail/mailabbrev.el +++ b/lisp/mail/mailabbrev.el @@ -163,7 +163,8 @@ no aliases, which is represented by this being a table with no entries.)") (defun mail-abbrevs-sync-aliases () (when mail-personal-alias-file (if (file-exists-p mail-personal-alias-file) - (let ((modtime (nth 5 (file-attributes mail-personal-alias-file)))) + (let ((modtime (file-attribute-modification-time + (file-attributes mail-personal-alias-file)))) (if (not (equal mail-abbrev-modtime modtime)) (progn (setq mail-abbrev-modtime modtime) @@ -176,7 +177,8 @@ no aliases, which is represented by this being a table with no entries.)") (file-exists-p mail-personal-alias-file)) (progn (setq mail-abbrev-modtime - (nth 5 (file-attributes mail-personal-alias-file))) + (file-attribute-modification-time + (file-attributes mail-personal-alias-file))) (build-mail-abbrevs))) (mail-abbrevs-sync-aliases) (add-function :around (local 'abbrev-expand-function) diff --git a/lisp/mail/mspools.el b/lisp/mail/mspools.el index aa91f36a67..2e8765eb67 100644 --- a/lisp/mail/mspools.el +++ b/lisp/mail/mspools.el @@ -387,7 +387,7 @@ nil." (let ((file (concat mspools-folder-directory spool)) size) (setq file (or (file-symlink-p file) file)) - (setq size (nth 7 (file-attributes file))) + (setq size (file-attribute-size (file-attributes file))) ;; size could be nil if the sym-link points to a non-existent file ;; so check this first. (if (and size (> size 0)) diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 9416d04902..73a17ee15e 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -2028,10 +2028,10 @@ Value is the size of the newly read mail after conversion." "the remote server" proto))) ((and (file-exists-p tofile) - (/= 0 (nth 7 (file-attributes tofile)))) + (/= 0 (file-attribute-size (file-attributes tofile)))) (message "Getting mail from %s..." tofile)) ((and (file-exists-p file) - (/= 0 (nth 7 (file-attributes file)))) + (/= 0 (file-attribute-size (file-attributes file)))) (message "Getting mail from %s..." file))) ;; Set TOFILE if have not already done so, and ;; rename or copy the file FILE to TOFILE if and as appropriate. diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index 50dd81039e..6fc91a3acd 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -561,7 +561,8 @@ This also saves the value of `send-mail-function' via Customize." (defun sendmail-sync-aliases () (when mail-personal-alias-file - (let ((modtime (nth 5 (file-attributes mail-personal-alias-file)))) + (let ((modtime (file-attribute-modification-time + (file-attributes mail-personal-alias-file)))) (or (equal mail-alias-modtime modtime) (setq mail-alias-modtime modtime mail-aliases t))))) diff --git a/lisp/mh-e/mh-alias.el b/lisp/mh-e/mh-alias.el index fa91042fd9..257d6b31cc 100644 --- a/lisp/mh-e/mh-alias.el +++ b/lisp/mh-e/mh-alias.el @@ -78,7 +78,8 @@ If ARG is non-nil, set timestamp with the current time." (function (lambda (file) (when (and file (file-exists-p file)) - (setq stamp (nth 5 (file-attributes file))) + (setq stamp (file-attribute-modification-time + (file-attributes file))) (or (> (car stamp) (car mh-alias-tstamp)) (and (= (car stamp) (car mh-alias-tstamp)) (> (cadr stamp) (cadr mh-alias-tstamp))))))) diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index 2fc7ac251e..1aa794477a 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -1361,11 +1361,13 @@ only return the directory part of FILE." (ange-ftp-real-expand-file-name ange-ftp-netrc-filename))) (setq attr (ange-ftp-real-file-attributes file))) (if (and attr ; file exists. - (not (equal (nth 5 attr) ange-ftp-netrc-modtime))) ; file changed + (not (equal (file-attribute-modification-time attr) + ange-ftp-netrc-modtime))) ; file changed (save-match-data (if (or ange-ftp-disable-netrc-security-check - (and (eq (nth 2 attr) (user-uid)) ; Same uids. - (string-match ".r..------" (nth 8 attr)))) + (and (eq (file-attribute-user-id attr) (user-uid)) ; Same uids. + (string-match ".r..------" + (file-attribute-modes attr)))) (with-current-buffer ;; we are cheating a bit here. I'm trying to do the equivalent ;; of find-file on the .netrc file, but then nuke it afterwards. @@ -1389,7 +1391,8 @@ only return the directory part of FILE." (ange-ftp-message "%s either not owned by you or badly protected." ange-ftp-netrc-filename) (sit-for 1)) - (setq ange-ftp-netrc-modtime (nth 5 attr)))))) + (setq ange-ftp-netrc-modtime + (file-attribute-modification-time attr)))))) ;; Return a list of prefixes of the form 'user@host:' to be used when ;; completion is done in the root directory. @@ -3242,7 +3245,8 @@ system TYPE.") ;; tell the process filter what size the transfer will be. (let ((attr (file-attributes temp))) (if attr - (ange-ftp-set-xfer-size host user (nth 7 attr)))) + (ange-ftp-set-xfer-size host user + (file-attribute-size attr)))) ;; put or append the file. (let ((result (ange-ftp-send-cmd host user @@ -3481,8 +3485,8 @@ system TYPE.") (let ((f1-parsed (ange-ftp-ftp-name f1)) (f2-parsed (ange-ftp-ftp-name f2))) (if (or f1-parsed f2-parsed) - (let ((f1-mt (nth 5 (file-attributes f1))) - (f2-mt (nth 5 (file-attributes f2)))) + (let ((f1-mt (file-attribute-modification-time (file-attributes f1))) + (f2-mt (file-attribute-modification-time (file-attributes f2)))) (cond ((null f1-mt) nil) ((null f2-mt) t) (t (time-less-p f2-mt f1-mt)))) @@ -3782,7 +3786,8 @@ so return the size on the remote host exactly. See RFC 3659." ;; tell the process filter what size the file is. (let ((attr (file-attributes (or temp2 filename)))) (if attr - (ange-ftp-set-xfer-size t-host t-user (nth 7 attr)))) + (ange-ftp-set-xfer-size t-host t-user + (file-attribute-size attr)))) (ange-ftp-send-cmd t-host diff --git a/lisp/net/eudcb-mab.el b/lisp/net/eudcb-mab.el index a21348480e..a69c77b723 100644 --- a/lisp/net/eudcb-mab.el +++ b/lisp/net/eudcb-mab.el @@ -53,7 +53,8 @@ RETURN-ATTRS is a list of attributes to return, defaulting to (let ((fmt-string "%ln:%fn:%p:%e") (mab-buffer (get-buffer-create " *mab contacts*")) - (modified (nth 5 (file-attributes eudc-contacts-file))) + (modified (file-attribute-modification-time + (file-attributes eudc-contacts-file))) result) (with-current-buffer mab-buffer (make-local-variable 'eudc-buffer-time) diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 97fdabd72b..64cc1a51f6 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -1667,7 +1667,7 @@ If CHARSET is nil then use UTF-8." (defun eww-read-bookmarks () (let ((file (expand-file-name "eww-bookmarks" eww-bookmarks-directory))) (setq eww-bookmarks - (unless (zerop (or (nth 7 (file-attributes file)) 0)) + (unless (zerop (or (file-attribute-size (file-attributes file)) 0)) (with-temp-buffer (insert-file-contents file) (read (current-buffer))))))) diff --git a/lisp/net/netrc.el b/lisp/net/netrc.el index ec743dcff0..7b974ebf61 100644 --- a/lisp/net/netrc.el +++ b/lisp/net/netrc.el @@ -63,12 +63,14 @@ "port")) alist elem result pair) (if (and netrc-cache - (equal (car netrc-cache) (nth 5 (file-attributes file)))) + (equal (car netrc-cache) (file-attribute-modification-time + (file-attributes file)))) (insert (base64-decode-string (rot13-string (cdr netrc-cache)))) (insert-file-contents file) (when (string-match "\\.gpg\\'" file) ;; Store the contents of the file heavily encrypted in memory. - (setq netrc-cache (cons (nth 5 (file-attributes file)) + (setq netrc-cache (cons (file-attribute-modification-time + (file-attributes file)) (rot13-string (base64-encode-string (buffer-string))))))) diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el index 32893d2eea..b6fbdfb766 100644 --- a/lisp/net/newst-backend.el +++ b/lisp/net/newst-backend.el @@ -1800,7 +1800,8 @@ download it from URL first." (let ((image-name (concat directory feed-name))) (if (and (file-exists-p image-name) (time-less-p nil - (time-add (nth 5 (file-attributes image-name)) + (time-add (file-attribute-modification-time + (file-attributes image-name)) (seconds-to-time 86400)))) (newsticker--debug-msg "%s: Getting image for %s skipped" (format-time-string "%A, %H:%M") diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 9af57fb075..bcfaf40ebc 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -142,15 +142,15 @@ returned." (defsubst tramp-compat-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 style of `current-time'." (nth 5 attributes))) (if (fboundp 'file-attribute-size) (defalias 'tramp-compat-file-attribute-size 'file-attribute-size) (defsubst tramp-compat-file-attribute-size (attributes) "The size (in bytes) in ATTRIBUTES returned by `file-attributes'. -This is a floating point number if the size is too large for an integer." +If the size is too large for a fixnum, this is a bignum in Emacs 27 +and later, and is a float in Emacs 26 and earlier." (nth 7 attributes))) (if (fboundp 'file-attribute-modes) diff --git a/lisp/nxml/rng-loc.el b/lisp/nxml/rng-loc.el index a9a1950822..75d983189a 100644 --- a/lisp/nxml/rng-loc.el +++ b/lisp/nxml/rng-loc.el @@ -407,7 +407,7 @@ or nil." "Return a list of rules for the schema locating file FILE." (setq file (expand-file-name file)) (let ((cached (assoc file rng-schema-locating-file-alist)) - (mtime (nth 5 (file-attributes file))) + (mtime (file-attribute-modification-time (file-attributes file))) parsed) (cond ((not mtime) (when cached diff --git a/lisp/obsolete/fast-lock.el b/lisp/obsolete/fast-lock.el index 41e48c3eaf..21db32148f 100644 --- a/lisp/obsolete/fast-lock.el +++ b/lisp/obsolete/fast-lock.el @@ -441,7 +441,8 @@ See `fast-lock-mode'." ;; Only save if user's restrictions are satisfied. (and min-size (>= (buffer-size) min-size)) (or fast-lock-save-others - (eq (user-uid) (nth 2 (file-attributes buffer-file-name)))) + (eq (user-uid) (file-attribute-user-id + (file-attributes buffer-file-name)))) ;; ;; Only save if there are `face' properties to save. (text-property-not-all (point-min) (point-max) 'face nil)) diff --git a/lisp/obsolete/vc-arch.el b/lisp/obsolete/vc-arch.el index 414ae77fc6..9860c9d3fa 100644 --- a/lisp/obsolete/vc-arch.el +++ b/lisp/obsolete/vc-arch.el @@ -304,8 +304,9 @@ Only the value `maybe' can be trusted :-(." ;; Buh? Unexpected format. 'edited (let ((ats (file-attributes file))) - (if (and (eq (nth 7 ats) (string-to-number (match-string 2))) - (equal (format-time-string "%s" (nth 5 ats)) + (if (and (eq (file-attribute-size ats) (string-to-number (match-string 2))) + (equal (format-time-string + "%s" (file-attribute-modification-time ats)) (match-string 1))) 'up-to-date 'edited))))))))) @@ -402,7 +403,7 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see (defun vc-arch-diff3-rej-p (rej) (let ((attrs (file-attributes rej))) - (and attrs (< (nth 7 attrs) 60) + (and attrs (< (file-attribute-size attrs) 60) (with-temp-buffer (insert-file-contents rej) (goto-char (point-min)) diff --git a/lisp/org/ob-eval.el b/lisp/org/ob-eval.el index 2bfaa08a60..f8cb285dd3 100644 --- a/lisp/org/ob-eval.el +++ b/lisp/org/ob-eval.el @@ -120,7 +120,7 @@ function in various versions of Emacs. (delete-file input-file)) (when (and error-file (file-exists-p error-file)) - (when (< 0 (nth 7 (file-attributes error-file))) + (when (< 0 (file-attribute-size (file-attributes error-file))) (with-current-buffer (get-buffer-create error-buffer) (let ((pos-from-end (- (point-max) (point)))) (or (bobp) diff --git a/lisp/org/org-attach.el b/lisp/org/org-attach.el index 9774e3a797..203e71e954 100644 --- a/lisp/org/org-attach.el +++ b/lisp/org/org-attach.el @@ -352,7 +352,7 @@ This checks for the existence of a \".git\" directory in that directory." (shell-command-to-string "git ls-files -zmo --exclude-standard") "\0" t)) (if (and use-annex - (>= (nth 7 (file-attributes new-or-modified)) + (>= (file-attribute-size (file-attributes new-or-modified)) org-attach-git-annex-cutoff)) (call-process "git" nil nil nil "annex" "add" new-or-modified) (call-process "git" nil nil nil "add" new-or-modified)) diff --git a/lisp/org/org-macro.el b/lisp/org/org-macro.el index 1033db2af4..e50b2f9984 100644 --- a/lisp/org/org-macro.el +++ b/lisp/org/org-macro.el @@ -159,7 +159,8 @@ function installs the following ones: \"property\", (format "(eval (format-time-string \"$1\" (or (and (org-string-nw-p \"$2\") (org-macro--vc-modified-time %s)) '%s)))" (prin1-to-string visited-file) (prin1-to-string - (nth 5 (file-attributes visited-file))))))))) + (file-attribute-modification-time + (file-attributes visited-file))))))))) ;; Initialize and install "n" macro. (org-macro--counter-initialize) (funcall update-templates diff --git a/lisp/org/org.el b/lisp/org/org.el index 21d9cd8785..873ae6b820 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -230,8 +230,9 @@ file to byte-code before it is loaded." (let* ((age (lambda (file) (float-time (time-subtract (current-time) - (nth 5 (or (file-attributes (file-truename file)) - (file-attributes file))))))) + (file-attribute-modification-time + (or (file-attributes (file-truename file)) + (file-attributes file))))))) (base-name (file-name-sans-extension file)) (exported-file (concat base-name ".el"))) ;; tangle if the Org file is newer than the elisp file @@ -22381,7 +22382,9 @@ returned by, e.g., `current-time'." ;; (e.g. HFS+) do not retain any finer granularity. As ;; a consequence, make sure we return non-nil when the two ;; times are equal. - (not (time-less-p (cl-subseq (nth 5 (file-attributes file)) 0 2) + (not (time-less-p (cl-subseq (file-attribute-modification-time + (file-attributes file)) + 0 2) (cl-subseq time 0 2))))) (defun org-compile-file (source process ext &optional err-msg log-buf spec) diff --git a/lisp/org/ox-html.el b/lisp/org/ox-html.el index 39f7d83e14..6166a4ad01 100644 --- a/lisp/org/ox-html.el +++ b/lisp/org/ox-html.el @@ -1935,7 +1935,8 @@ INFO is a plist used as a communication channel." (?c . ,(plist-get info :creator)) (?C . ,(let ((file (plist-get info :input-file))) (format-time-string timestamp-format - (and file (nth 5 (file-attributes file)))))) + (and file (file-attribute-modification-time + (file-attributes file)))))) (?v . ,(or (plist-get info :html-validation-link) ""))))) (defun org-html--build-pre/postamble (type info) diff --git a/lisp/org/ox-publish.el b/lisp/org/ox-publish.el index ba5a0232e4..80ef239b67 100644 --- a/lisp/org/ox-publish.el +++ b/lisp/org/ox-publish.el @@ -879,7 +879,8 @@ If FILE is an Org file and provides a DATE keyword use it. In any other case use the file system's modification time. Return time in `current-time' format." (let ((file (org-publish--expand-file-name file project))) - (if (file-directory-p file) (nth 5 (file-attributes file)) + (if (file-directory-p file) (file-attribute-modification-time + (file-attributes file)) (let ((date (org-publish-find-property file :date project))) ;; DATE is a secondary string. If it contains a time-stamp, ;; convert it to internal format. Otherwise, use FILE @@ -889,7 +890,8 @@ time in `current-time' format." (let ((value (org-element-interpret-data ts))) (and (org-string-nw-p value) (org-time-string-to-time value)))))) - ((file-exists-p file) (nth 5 (file-attributes file))) + ((file-exists-p file) (file-attribute-modification-time + (file-attributes file))) (t (error "No such file: \"%s\"" file))))))) (defun org-publish-sitemap-default-entry (entry style project) @@ -1348,8 +1350,7 @@ does not exist." (expand-file-name (or (file-symlink-p file) file) (file-name-directory file))))) (if (not attr) (error "No such file: \"%s\"" file) - (+ (ash (car (nth 5 attr)) 16) - (cadr (nth 5 attr)))))) + (floor (float-time (file-attribute-modification-time attr)))))) (provide 'ox-publish) diff --git a/lisp/pcmpl-gnu.el b/lisp/pcmpl-gnu.el index 16c992662d..c4e5a677d0 100644 --- a/lisp/pcmpl-gnu.el +++ b/lisp/pcmpl-gnu.el @@ -316,7 +316,7 @@ (while (pcomplete-here (if (and complete-within (let* ((fa (file-attributes (pcomplete-arg 1))) - (size (nth 7 fa))) + (size (file-attribute-size fa))) (and (numberp size) (or (null large-file-warning-threshold) (< size large-file-warning-threshold))))) diff --git a/lisp/pcmpl-rpm.el b/lisp/pcmpl-rpm.el index 74ddb8b9d7..7f164c9f2b 100644 --- a/lisp/pcmpl-rpm.el +++ b/lisp/pcmpl-rpm.el @@ -71,7 +71,8 @@ "Return a list of all installed rpm packages." (if (and pcmpl-rpm-cache pcmpl-rpm-cache-time - (let ((mtime (nth 5 (file-attributes pcmpl-rpm-cache-stamp-file)))) + (let ((mtime (file-attribute-modification-time + (file-attributes pcmpl-rpm-cache-stamp-file)))) (and mtime (not (time-less-p pcmpl-rpm-cache-time mtime))))) pcmpl-rpm-packages (message "Getting list of installed rpms...") diff --git a/lisp/play/cookie1.el b/lisp/play/cookie1.el index 5ae2cb432e..7a6a56b191 100644 --- a/lisp/play/cookie1.el +++ b/lisp/play/cookie1.el @@ -125,7 +125,8 @@ and subsequent calls on the same file won't go to disk." (setq phrase-file (cookie-check-file phrase-file)) (let ((sym (intern-soft phrase-file cookie-cache))) (and sym (not (equal (symbol-function sym) - (nth 5 (file-attributes phrase-file)))) + (file-attribute-modification-time + (file-attributes phrase-file)))) (yes-or-no-p (concat phrase-file " has changed. Read new contents? ")) (setq sym nil)) @@ -133,7 +134,8 @@ and subsequent calls on the same file won't go to disk." (symbol-value sym) (setq sym (intern phrase-file cookie-cache)) (if startmsg (message "%s" startmsg)) - (fset sym (nth 5 (file-attributes phrase-file))) + (fset sym (file-attribute-modification-time + (file-attributes phrase-file))) (let (result) (with-temp-buffer (insert-file-contents (expand-file-name phrase-file)) diff --git a/lisp/progmodes/cmacexp.el b/lisp/progmodes/cmacexp.el index 742ac80be1..7dcfb10af0 100644 --- a/lisp/progmodes/cmacexp.el +++ b/lisp/progmodes/cmacexp.el @@ -383,7 +383,8 @@ Optional arg DISPLAY non-nil means show messages in the echo area." (not (member (file-name-nondirectory shell-file-name) msdos-shells))) (eq exit-status 0)) - (zerop (nth 7 (file-attributes (expand-file-name tempname)))) + (zerop (file-attribute-size + (file-attributes (expand-file-name tempname)))) (progn (goto-char (point-min)) ;; Put the messages inside a comment, so they won't get in diff --git a/lisp/ps-bdf.el b/lisp/ps-bdf.el index 301142ed48..f9632f0013 100644 --- a/lisp/ps-bdf.el +++ b/lisp/ps-bdf.el @@ -70,13 +70,12 @@ for BDFNAME." (defsubst bdf-file-mod-time (filename) "Return modification time of FILENAME. -The value is a list of integers in the same format as `current-time'." - (nth 5 (file-attributes filename))) +The value is a timestamp in the same format as `current-time'." + (file-attribute-modification-time (file-attributes filename))) (defun bdf-file-newer-than-time (filename mod-time) "Return non-nil if and only if FILENAME is newer than MOD-TIME. -MOD-TIME is a modification time as a list of integers in the same -format as `current-time'." +MOD-TIME is a modification time in the same format as `current-time'." (let ((new-mod-time (bdf-file-mod-time filename))) (time-less-p mod-time new-mod-time))) @@ -168,8 +167,7 @@ FONT-INFO is a list of the following format: (BDFFILE MOD-TIME FONT-BOUNDING-BOX RELATIVE-COMPOSE BASELINE-OFFSET CODE-RANGE MAXLEN OFFSET-VECTOR) -MOD-TIME is last modification time as a list of integers in the -same format as `current-time'. +MOD-TIME is last modification time in the same format as `current-time'. SIZE is a size of the font on 72 dpi device. This value is got from SIZE record of the font. diff --git a/lisp/server.el b/lisp/server.el index fd024480bd..50684a20aa 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -540,13 +540,13 @@ Creates the directory if necessary and makes sure: (setq attrs (file-attributes dir 'integer))) ;; Check that it's safe for use. - (let* ((uid (nth 2 attrs)) + (let* ((uid (file-attribute-user-id attrs)) (w32 (eq system-type 'windows-nt)) (unsafe (cond - ((not (eq t (car attrs))) + ((not (eq t (file-attribute-type attrs))) (if (null attrs) "its attributes can't be checked" (format "it is a %s" - (if (stringp (car attrs)) + (if (stringp (file-attribute-type attrs)) "symlink" "file")))) ((and w32 (zerop uid)) ; on FAT32? (display-warning diff --git a/lisp/simple.el b/lisp/simple.el index ffd7fcc067..f0fcbf5756 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -3827,7 +3827,8 @@ interactively, this is t." ;; No output; error? (let ((output (if (and error-file - (< 0 (nth 7 (file-attributes error-file)))) + (< 0 (file-attribute-size + (file-attributes error-file)))) (format "some error output%s" (if shell-command-default-error-buffer (format " to the \"%s\" buffer" @@ -3850,7 +3851,7 @@ interactively, this is t." ))))) (when (and error-file (file-exists-p error-file)) - (if (< 0 (nth 7 (file-attributes error-file))) + (if (< 0 (file-attribute-size (file-attributes error-file))) (with-current-buffer (get-buffer-create error-buffer) (let ((pos-from-end (- (point-max) (point)))) (or (bobp) diff --git a/lisp/speedbar.el b/lisp/speedbar.el index 48829d4023..f3ea048cb8 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -1466,9 +1466,10 @@ Return nil if not applicable. If FILENAME, then use that instead of reading it from the speedbar buffer." (let* ((item (or filename (speedbar-line-file))) (attr (if item (file-attributes item) nil))) - (if (and item attr) (dframe-message "%s %-6d %s" (nth 8 attr) - (nth 7 attr) item) - nil))) + (if (and item attr) + (dframe-message "%s %-6d %s" + (file-attribute-modes attr) + (file-attribute-size attr) item)))) (defun speedbar-item-info-tag-helper () "Display info about a tag that is on the current line. @@ -3008,13 +3009,13 @@ the file being checked." (cdr (car oa)))))) nil ;; Find out if the object is out of date or not. - (let ((date1 (nth 5 (file-attributes fulln))) - (date2 (nth 5 (file-attributes (concat - (file-name-sans-extension fulln) - (cdr (car oa))))))) - (if (or (< (car date1) (car date2)) - (and (= (car date1) (car date2)) - (< (nth 1 date1) (nth 1 date2)))) + (let ((date1 (file-attribute-modification-time + (file-attributes fulln))) + (date2 (file-attribute-modification-time + (file-attributes (concat + (file-name-sans-extension fulln) + (cdr (car oa))))))) + (if (time-less-p date1 date2) (car speedbar-obj-indicator) (cdr speedbar-obj-indicator))))))) diff --git a/lisp/thumbs.el b/lisp/thumbs.el index 26c9935429..067a32ba57 100644 --- a/lisp/thumbs.el +++ b/lisp/thumbs.el @@ -210,7 +210,9 @@ reached." (mapcar (lambda (f) (let ((fattribs-list (file-attributes f))) - `(,(nth 4 fattribs-list) ,(nth 7 fattribs-list) ,f))) + `(,(file-attribute-access-time fattribs-list) + ,(file-attribute-size fattribs-list) + ,f))) (directory-files (thumbs-thumbsdir) t (image-file-name-regexp))) (lambda (l1 l2) (time-less-p (car l1) (car l2))))) (dirsize (apply '+ (mapcar (lambda (x) (cadr x)) files-list)))) diff --git a/lisp/time.el b/lisp/time.el index 94f7009953..f8d933d48a 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -365,7 +365,8 @@ Switches from the 1 to 5 to 15 minute load average, and then back to 1." (while (and mail-files (= size 0)) ;; Count size of regular files only. (setq size (+ size (or (and (file-regular-p (car mail-files)) - (nth 7 (file-attributes (car mail-files)))) + (file-attribute-size + (file-attributes (car mail-files)))) 0))) (setq mail-files (cdr mail-files))) (if (> size 0) @@ -483,7 +484,8 @@ update which can wait for the next redisplay." (defun display-time-file-nonempty-p (file) (let ((remote-file-name-inhibit-cache (- display-time-interval 5))) (and (file-exists-p file) - (< 0 (nth 7 (file-attributes (file-chase-links file))))))) + (< 0 (file-attribute-size + (file-attributes (file-chase-links file))))))) ;;;###autoload (define-minor-mode display-time-mode diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el index 309c96cbcc..3765d9dc93 100644 --- a/lisp/url/url-cache.el +++ b/lisp/url/url-cache.el @@ -86,10 +86,10 @@ FILE can be created or overwritten." The actual return value is the last modification time of the cache file." (let* ((fname (url-cache-create-filename url)) (attribs (file-attributes fname))) - (and fname ; got a filename - (file-exists-p fname) ; file exists - (not (eq (nth 0 attribs) t)) ; Its not a directory - (nth 5 attribs)))) ; Can get last mod-time + (and fname + (file-exists-p fname) + (not (eq (file-attribute-type attribs) t)) + (file-attribute-modification-time attribs)))) (defun url-cache-create-filename-human-readable (url) "Return a filename in the local cache for URL." @@ -226,7 +226,7 @@ considered \"expired\"." (setq deleted-files (1+ deleted-files)))) ((time-less-p (time-add - (nth 5 (file-attributes file)) + (file-attribute-modification-time (file-attributes file)) (seconds-to-time url-cache-expire-time)) now) (delete-file file) diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el index 1c7c20e7c8..02542ccbcc 100644 --- a/lisp/url/url-file.el +++ b/lisp/url/url-file.el @@ -70,7 +70,7 @@ to them." buff func func args args efs)) - (let ((size (nth 7 (file-attributes name)))) + (let ((size (file-attribute-size (file-attributes name)))) (with-current-buffer buff (goto-char (point-max)) (if (/= -1 size) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index b91a2ba45a..6c189c13cd 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -1450,7 +1450,7 @@ modified lines of the diff." ;; can just remove the file altogether. Very handy for .rej files if we ;; remove hunks as we apply them. (when (and buffer-file-name - (eq 0 (nth 7 (file-attributes buffer-file-name)))) + (eq 0 (file-attribute-size (file-attributes buffer-file-name)))) (delete-file buffer-file-name))) (defun diff-delete-empty-files () diff --git a/lisp/vc/pcvs-info.el b/lisp/vc/pcvs-info.el index edcfc6e6c4..2947733a24 100644 --- a/lisp/vc/pcvs-info.el +++ b/lisp/vc/pcvs-info.el @@ -451,7 +451,8 @@ DIR can also be a file." ((not (file-exists-p (concat dir f))) (setq type 'MISSING)) ((equal rev "0") (setq type 'ADDED rev nil)) ((equal date "Result of merge") (setq subtype 'MERGED)) - ((let ((mtime (nth 5 (file-attributes (concat dir f)))) + ((let ((mtime (file-attribute-modification-time + (file-attributes (concat dir f)))) (system-time-locale "C")) (setq timestamp (format-time-string "%c" mtime t)) ;; Solaris sometimes uses "Wed Sep 05", not "Wed Sep 5". diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index 630932fe37..aa3d1443aa 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -268,8 +268,8 @@ in the repository root directory of FILE." ;; If file is in dirstate, can only be added (b#8025). ((or (not (match-beginning 4)) (eq (char-after (match-beginning 4)) ?a)) 'added) - ((or (and (eq (string-to-number (match-string 3)) - (nth 7 (file-attributes file))) + ((or (and (eql (string-to-number (match-string 3)) + (file-attribute-size (file-attributes file))) (equal (match-string 5) (save-match-data (vc-bzr-sha1 file))) ;; For a file, does the executable state match? @@ -281,7 +281,8 @@ in the repository root directory of FILE." ?x (mapcar 'identity - (nth 8 (file-attributes file)))))) + (file-attribute-modes + (file-attributes file)))))) (if (eq (char-after (match-beginning 7)) ?y) exe @@ -291,8 +292,8 @@ in the repository root directory of FILE." ;; checkouts \2 is empty and we need to ;; look for size in \6. (eq (match-beginning 2) (match-end 2)) - (eq (string-to-number (match-string 6)) - (nth 7 (file-attributes file))) + (eql (string-to-number (match-string 6)) + (file-attribute-size (file-attributes file))) (equal (match-string 5) (vc-bzr-sha1 file)))) 'up-to-date) diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el index 54ece6cc26..ac98d996d2 100644 --- a/lisp/vc/vc-cvs.el +++ b/lisp/vc/vc-cvs.el @@ -57,7 +57,7 @@ ;; (We actually shouldn't trust this, but there is ;; no other way to learn this from CVS at the ;; moment (version 1.9).) - (string-match "r-..-..-." (nth 8 attrib))) + (string-match "r-..-..-." (file-attribute-modes attrib))) 'announce 'implicit)))))) @@ -257,7 +257,7 @@ See also variable `vc-cvs-sticky-date-format-string'." ;; If the file has not changed since checkout, consider it `up-to-date'. ;; Otherwise consider it `edited'. (let ((checkout-time (vc-file-getprop file 'vc-checkout-time)) - (lastmod (nth 5 (file-attributes file)))) + (lastmod (file-attribute-modification-time (file-attributes file)))) (cond ((equal checkout-time lastmod) 'up-to-date) ((string= (vc-working-revision file) "0") 'added) @@ -524,7 +524,8 @@ The changes are between FIRST-REVISION and SECOND-REVISION." (string= (match-string 1) "P ")) (vc-file-setprop file 'vc-state 'up-to-date) (vc-file-setprop file 'vc-checkout-time - (nth 5 (file-attributes file))) + (file-attribute-modification-time + (file-attributes file))) 0);; indicate success to the caller ;; Merge successful, but our own changes are still in the file ((string= (match-string 1) "M ") @@ -748,7 +749,8 @@ If UPDATE is non-nil, then update (resynch) any affected buffers." (vc-file-setprop file 'vc-state 'up-to-date) (vc-file-setprop file 'vc-working-revision nil) (vc-file-setprop file 'vc-checkout-time - (nth 5 (file-attributes file)))) + (file-attribute-modification-time + (file-attributes file)))) ((or (string= state "M") (string= state "C")) (vc-file-setprop file 'vc-state 'edited) @@ -931,7 +933,8 @@ state." (cond ((string-match "Up-to-date" status) (vc-file-setprop file 'vc-checkout-time - (nth 5 (file-attributes file))) + (file-attribute-modification-time + (file-attributes file))) 'up-to-date) ((string-match "Locally Modified" status) 'edited) ((string-match "Needs Merge" status) 'needs-merge) @@ -1174,7 +1177,7 @@ is non-nil." ;; (which is based on textual comparison), because there can be problems ;; generating a time string that looks exactly like the one from CVS. (let* ((time (match-string 2)) - (mtime (nth 5 (file-attributes file))) + (mtime (file-attribute-modification-time (file-attributes file))) (parsed-time (progn (require 'parse-time) (parse-time-string (concat time " +0000"))))) (cond ((and (not (string-match "\\+" time)) diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 76eec884a1..3696573595 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -833,7 +833,7 @@ if we don't understand a construct, we signal (with-temp-buffer (let ((attr (file-attributes hgignore))) (when attr (insert-file-contents hgignore)) - (push (list hgignore (nth 5 attr) (nth 7 attr)) + (push (list hgignore (file-attribute-modification-time attr) (file-attribute-size attr)) vc-hg--hgignore-filenames)) (while (not (eobp)) ;; This list of pattern-file commands isn't complete, but it @@ -897,8 +897,8 @@ REPO must be the directory name of an hg repository." (saved-mtime (nth 1 fs)) (saved-size (nth 2 fs)) (attr (file-attributes (nth 0 fs))) - (current-mtime (nth 5 attr)) - (current-size (nth 7 attr))) + (current-mtime (file-attribute-modification-time attr)) + (current-size (file-attribute-size attr))) (unless (and (equal saved-mtime current-mtime) (equal saved-size current-size)) (setf valid nil)))) @@ -968,8 +968,8 @@ Avoids the need to repeatedly scan dirstate on repeated calls to `vc-hg-state', as we see during registration queries.") (defun vc-hg--cached-dirstate-search (dirstate dirstate-attr ascii-fname) - (let* ((mtime (nth 5 dirstate-attr)) - (size (nth 7 dirstate-attr)) + (let* ((mtime (file-attribute-modification-time dirstate-attr)) + (size (file-attribute-size dirstate-attr)) (cache vc-hg--dirstate-scan-cache) ) (if (and cache @@ -1012,7 +1012,7 @@ hg binary." ;; Repository must be in an understood format (not (vc-hg--requirements-understood-p repo)) ;; Dirstate too small to be valid - (< (nth 7 dirstate-attr) 40) + (< (file-attribute-size dirstate-attr) 40) (progn (setf repo-relative-filename (file-relative-name truename repo)) @@ -1036,8 +1036,9 @@ hg binary." ((eq state ?n) (let ((vc-hg-size (nth 2 dirstate-entry)) (vc-hg-mtime (nth 3 dirstate-entry)) - (fs-size (nth 7 stat)) - (fs-mtime (vc-hg--time-to-integer (nth 5 stat)))) + (fs-size (file-attribute-size stat)) + (fs-mtime (vc-hg--time-to-integer + (file-attribute-modification-time stat)))) (if (and (eql vc-hg-size fs-size) (eql vc-hg-mtime fs-mtime)) 'up-to-date 'edited))) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index f1b622b54a..84e11f2e01 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -658,7 +658,7 @@ Before doing that, check if there are any old backups and get rid of them." ;; If the file was saved in the same second in which it was ;; checked out, clear the checkout-time to avoid confusion. (if (equal (vc-file-getprop file 'vc-checkout-time) - (nth 5 (file-attributes file))) + (file-attribute-modification-time (file-attributes file))) (vc-file-setprop file 'vc-checkout-time nil)) (if (vc-state-refresh file backend) (vc-mode-line file backend))) diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el index 9fa52bf5dc..51a4443962 100644 --- a/lisp/vc/vc-rcs.el +++ b/lisp/vc/vc-rcs.el @@ -955,11 +955,10 @@ Uses `rcs2log' which only works for RCS and CVS." "Return non-nil if FILE is newer than its RCS master. This likely means that FILE has been changed with respect to its master version." - (let ((file-time (nth 5 (file-attributes file))) - (master-time (nth 5 (file-attributes (vc-master-name file))))) - (or (> (nth 0 file-time) (nth 0 master-time)) - (and (= (nth 0 file-time) (nth 0 master-time)) - (> (nth 1 file-time) (nth 1 master-time)))))) + (let ((file-time (file-attribute-modification-time (file-attributes file))) + (master-time (file-attribute-modification-time + (file-attributes (vc-master-name file))))) + (time-less-p master-time file-time))) (defun vc-rcs-find-most-recent-rev (branch) "Find most recent revision on BRANCH." diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index 2cbf34ba43..4b1a34bd5f 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -479,7 +479,8 @@ The changes are between FIRST-VERSION and SECOND-VERSION." ((string= (match-string 2) "U") (vc-file-setprop file 'vc-state 'up-to-date) (vc-file-setprop file 'vc-checkout-time - (nth 5 (file-attributes file))) + (file-attribute-modification-time + (file-attributes file))) 0);; indicate success to the caller ;; Merge successful, but our own changes are still in the file ((string= (match-string 2) "G") @@ -729,7 +730,8 @@ Set file properties accordingly. If FILENAME is non-nil, return its status." (if (eq (char-after (match-beginning 1)) ?*) 'needs-update (vc-file-setprop file 'vc-checkout-time - (nth 5 (file-attributes file))) + (file-attribute-modification-time + (file-attributes file))) 'up-to-date)) ((eq status ?A) ;; If the file was actually copied, (match-string 2) is "-". diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 487594b2d5..d3d66d6fb5 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1481,7 +1481,8 @@ After check-out, runs the normal hook `vc-checkout-hook'." nil) 'up-to-date 'edited)) - (vc-checkout-time . ,(nth 5 (file-attributes file)))))) + (vc-checkout-time . ,(file-attribute-modification-time + (file-attributes file)))))) (vc-resynch-buffer file t t) (run-hooks 'vc-checkout-hook)) @@ -1558,7 +1559,8 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." (vc-call-backend backend 'checkin files comment rev) (mapc 'vc-delete-automatic-version-backups files)) `((vc-state . up-to-date) - (vc-checkout-time . ,(nth 5 (file-attributes file))) + (vc-checkout-time . ,(file-attribute-modification-time + (file-attributes file))) (vc-working-revision . nil))) (message "Checking in %s...done" (vc-delistify files))) 'vc-checkin-hook @@ -2568,7 +2570,8 @@ its name; otherwise return nil." (vc-delete-automatic-version-backups file)) (vc-call revert file backup-file)) `((vc-state . up-to-date) - (vc-checkout-time . ,(nth 5 (file-attributes file))))) + (vc-checkout-time . ,(file-attribute-modification-time + (file-attributes file))))) (vc-resynch-buffer file t t)) ;;;###autoload diff --git a/lisp/xdg.el b/lisp/xdg.el index a896eb855a..f8183249d5 100644 --- a/lisp/xdg.el +++ b/lisp/xdg.el @@ -295,7 +295,9 @@ Results are cached in `xdg-mime-table'." (files ())) (let ((mtim1 (get 'xdg-mime-table 'mtime)) (mtim2 (cl-loop for f in caches when (file-readable-p f) - maximize (float-time (nth 5 (file-attributes f)))))) + maximize (float-time + (file-attribute-modification-time + (file-attributes f)))))) ;; If one of the MIME/Desktop cache files has been modified: (when (or (null mtim1) (time-less-p mtim1 mtim2)) (setq xdg-mime-table nil))) diff --git a/src/buffer.c b/src/buffer.c index 1f18dbd11a..024e64f0d7 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -6010,11 +6010,11 @@ An entry (TEXT . POSITION) represents the deletion of the string TEXT from (abs POSITION). If POSITION is positive, point was at the front of the text being deleted; if negative, point was at the end. -An entry (t HIGH LOW USEC PSEC) indicates that the buffer was previously -unmodified; (HIGH LOW USEC PSEC) is in the same style as (current-time) -and is the visited file's modification time, as of that time. If the -modification time of the most recent save is different, this entry is -obsolete. +An entry (t . TIMESTAMP), where TIMESTAMP is in the style of +`current-time', indicates that the buffer was previously unmodified; +TIMESTAMP is the visited file's modification time, as of that time. +If the modification time of the most recent save is different, this +entry is obsolete. An entry (t . 0) means the buffer was previously unmodified but its time stamp was unknown because it was not associated with a file. diff --git a/src/dired.c b/src/dired.c index 70c5bb24b4..7ad401c728 100644 --- a/src/dired.c +++ b/src/dired.c @@ -347,7 +347,7 @@ DEFUN ("directory-files-and-attributes", Fdirectory_files_and_attributes, doc: /* Return a list of names of files and their attributes in DIRECTORY. Value is a list of the form: - ((FILE1 FILE1-ATTRS) (FILE2 FILE2-ATTRS) ...) + ((FILE1 . FILE1-ATTRS) (FILE2 . FILE2-ATTRS) ...) where each FILEn-ATTRS is the attributes of FILEn as returned by `file-attributes'. @@ -866,26 +866,22 @@ provided: `file-attribute-type', `file-attribute-link-number', Elements of the attribute list are: 0. t for directory, string (name linked to) for symbolic link, or nil. 1. Number of links to file. - 2. File uid as a string or a number. If a string value cannot be - looked up, an integer value is returned, which could be a fixnum, - if it's small enough, otherwise a bignum. + 2. File uid as a string or (if ID-FORMAT is `integer' or a string value + cannot be looked up) as an integer. 3. File gid, likewise. - 4. Last access time, as a list of integers (HIGH LOW USEC PSEC) in the - same style as (current-time). + 4. Last access time, in the style of `current-time'. (See a note below about access time on FAT-based filesystems.) 5. Last modification time, likewise. This is the time of the last change to the file's contents. 6. Last status change time, likewise. This is the time of last change to the file's attributes: owner and group, access mode bits, etc. - 7. Size in bytes, which could be a fixnum, if it's small enough, - otherwise a bignum. + 7. Size in bytes, as an integer. 8. File modes, as a string of ten letters or dashes as in ls -l. 9. An unspecified value, present only for backward compatibility. -10. inode number, which could be a fixnum, if it's small enough, - otherwise a bignum. -11. Filesystem device number. If it is larger than what a fixnum - can hold, it is a bignum. +10. inode number, as a nonnegative integer. +11. Filesystem device number, as an integer. +Large integers are bignums, so `eq' might not work on them. On most filesystems, the combination of the inode and the device number uniquely identifies the file. diff --git a/src/editfns.c b/src/editfns.c index 047a73f0b8..ec6e8ba98d 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -1656,8 +1656,7 @@ See `current-time-string' for the various forms of a time value. */) DEFUN ("get-internal-run-time", Fget_internal_run_time, Sget_internal_run_time, 0, 0, 0, doc: /* Return the current run time used by Emacs. -The time is returned as a list (HIGH LOW USEC PSEC), using the same -style as (current-time). +The time is returned as in the style of `current-time'. On systems that can't determine the run time, `get-internal-run-time' does the same thing as `current-time'. */) diff --git a/src/fileio.c b/src/fileio.c index 5ca7c595f7..7fb865809f 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -5454,10 +5454,9 @@ See Info node `(elisp)Modification Time' for more details. */) DEFUN ("visited-file-modtime", Fvisited_file_modtime, Svisited_file_modtime, 0, 0, 0, doc: /* Return the current buffer's recorded visited file modification time. -The value is a list of the form (HIGH LOW USEC PSEC), like the time values that -`file-attributes' returns. If the current buffer has no recorded file -modification time, this function returns 0. If the visited file -doesn't exist, return -1. +Return a Lisp timestamp (as in `current-time') if the current buffer +has a recorded file modification time, 0 if it doesn't, and -1 if the +visited file doesn't exist. See Info node `(elisp)Modification Time' for more details. */) (void) { @@ -5473,9 +5472,8 @@ DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime, Useful if the buffer was not read from the file normally or if the file itself has been changed for some known benign reason. An argument specifies the modification time value to use -\(instead of that of the visited file), in the form of a list -\(HIGH LOW USEC PSEC) or an integer flag as returned by -`visited-file-modtime'. */) +\(instead of that of the visited file), in the form of a time value as +in `current-time' or an integer flag as returned by `visited-file-modtime'. */) (Lisp_Object time_flag) { if (!NILP (time_flag)) diff --git a/src/keyboard.c b/src/keyboard.c index 008d3b9d7c..1c1f1514ae 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -4377,8 +4377,8 @@ timer_check (void) DEFUN ("current-idle-time", Fcurrent_idle_time, Scurrent_idle_time, 0, 0, 0, doc: /* Return the current length of Emacs idleness, or nil. -The value when Emacs is idle is a list of four integers (HIGH LOW USEC PSEC) -in the same style as (current-time). +The value when Emacs is idle is a Lisp timestamp in the style of +`current-time'. The value when Emacs is not idle is nil. diff --git a/src/process.c b/src/process.c index b4ba641f31..a9638dfc2d 100644 --- a/src/process.c +++ b/src/process.c @@ -7934,8 +7934,7 @@ integer or floating point values. majflt -- number of major page faults (number) cminflt -- cumulative number of minor page faults (number) cmajflt -- cumulative number of major page faults (number) - utime -- user time used by the process, in (current-time) format, - which is a list of integers (HIGH LOW USEC PSEC) + utime -- user time used by the process, in `current-time' format stime -- system time used by the process (current-time) time -- sum of utime and stime (current-time) cutime -- user time used by the process and its children (current-time) @@ -7947,7 +7946,7 @@ integer or floating point values. start -- time the process started (current-time) vsize -- virtual memory size of the process in KB's (number) rss -- resident set size of the process in KB's (number) - etime -- elapsed time the process is running, in (HIGH LOW USEC PSEC) format + etime -- elapsed time the process is running (current-time) pcpu -- percents of CPU time used by the process (floating-point number) pmem -- percents of total physical memory used by process's resident set (floating-point number) commit c2dee17e19e1cf80c2263f8de276cceb0252b76d Author: Stefan Monnier Date: Sun Sep 23 16:45:03 2018 -0400 * doc/emacs/maintaining.texi: Fix one more occurrence of `next-file` diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index c7eea90b92..4527c23d9e 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -2116,8 +2116,8 @@ variable @code{tags-apropos-additional-actions}; see its documentation for details. @end ignore -@findex next-file - @kbd{M-x next-file} visits files covered by the selected tags table. +@findex tags-next-file + @kbd{M-x tags-next-file} visits files covered by the selected tags table. The first time it is called, it visits the first file covered by the table. Each subsequent call visits the next covered file, unless a prefix argument is supplied, in which case it returns to the first commit 75386e305f388ff51bc8cf9945f52c29c14427cd Author: Stefan Monnier Date: Sat Sep 22 19:28:35 2018 -0400 * lisp/play/bubbles.el: Use lexical-binding diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el index ee2135b9bb..a54682fff2 100644 --- a/lisp/play/bubbles.el +++ b/lisp/play/bubbles.el @@ -1,4 +1,4 @@ -;;; bubbles.el --- Puzzle game for Emacs +;;; bubbles.el --- Puzzle game for Emacs -*- lexical-binding:t -*- ;; Copyright (C) 2007-2018 Free Software Foundation, Inc. @@ -144,8 +144,7 @@ images the `ascii' theme will be used." (const :tag "Diamonds" diamonds) (const :tag "Balls" balls) (const :tag "Emacs" emacs) - (const :tag "ASCII (no images)" ascii)) - :group 'bubbles) + (const :tag "ASCII (no images)" ascii))) (defconst bubbles--grid-small '(10 . 10) "Predefined small bubbles grid.") @@ -168,8 +167,7 @@ images the `ascii' theme will be used." (const :tag "Huge" ,bubbles--grid-huge) (cons :tag "User defined" (integer :tag "Width") - (integer :tag "Height"))) - :group 'bubbles) + (integer :tag "Height")))) (defconst bubbles--colors-2 '("orange" "violet") "Predefined bubbles color list with two colors.") @@ -194,16 +192,14 @@ types are present." (const :tag "Red, darkgreen, blue, orange" ,bubbles--colors-4) (const :tag "Red, darkgreen, blue, orange, violet" ,bubbles--colors-5) - (repeat :tag "User defined" color)) - :group 'bubbles) + (repeat :tag "User defined" color))) (defcustom bubbles-chars '(?+ ?O ?# ?X ?. ?* ?& ?§) "Characters used for bubbles. Note that the actual number of different bubbles is determined by the number of colors, see `bubbles-colors'." - :type '(repeat character) - :group 'bubbles) + :type '(repeat character)) (defcustom bubbles-shift-mode 'default @@ -212,12 +208,10 @@ Available modes are `shift-default' and `shift-always'." :type '(radio (const :tag "Default" default) (const :tag "Shifter" always) ;;(const :tag "Mega Shifter" mega) - ) - :group 'bubbles) + )) (defcustom bubbles-mode-hook nil "Hook run by Bubbles mode." - :group 'bubbles :type 'hook) (defun bubbles-customize () @@ -898,7 +892,7 @@ static char * dot3d_xpm[] = { ;; bubbles mode map (defvar bubbles-mode-map (let ((map (make-sparse-keymap 'bubbles-mode-map))) -;; (suppress-keymap map t) + ;; (suppress-keymap map t) (define-key map "q" 'bubbles-quit) (define-key map "\n" 'bubbles-plop) (define-key map " " 'bubbles-plop) @@ -925,7 +919,7 @@ static char * dot3d_xpm[] = { (buffer-disable-undo) (force-mode-line-update) (redisplay) - (add-hook 'post-command-hook 'bubbles--mark-neighborhood t t)) + (add-hook 'post-command-hook #'bubbles--mark-neighborhood t t)) ;;;###autoload (defun bubbles () @@ -1004,14 +998,14 @@ Set `bubbles--col-offset' and `bubbles--row-offset'." (list bubbles--row-offset)))) (insert "\n") (let ((max-char (length (bubbles--colors)))) - (dotimes (i (bubbles--grid-height)) + (dotimes (_ (bubbles--grid-height)) (let ((p (point))) (insert " ") (put-text-property p (point) 'display (cons 'space (list :width (list bubbles--col-offset))))) - (dotimes (j (bubbles--grid-width)) + (dotimes (_ (bubbles--grid-width)) (let* ((index (random max-char)) (char (nth index bubbles-chars))) (insert char) @@ -1268,7 +1262,7 @@ Use optional parameter POS instead of point if given." (while (get-text-property (point) 'removed) (setq shifted-cols (1+ shifted-cols)) (bubbles--shift 'right (1- (bubbles--grid-height)) j)) - (dotimes (k shifted-cols) + (dotimes (_ shifted-cols) (let ((i (- (bubbles--grid-height) 2))) (while (>= i 0) (setq shifted (or (bubbles--shift 'right i j) @@ -1422,8 +1416,8 @@ Return t if new char is non-empty." (goto-char (point-min)) (forward-line 1) (let ((inhibit-read-only t)) - (dotimes (i (bubbles--grid-height)) - (dotimes (j (bubbles--grid-width)) + (dotimes (_ (bubbles--grid-height)) + (dotimes (_ (bubbles--grid-width)) (forward-char 1) (let ((index (or (get-text-property (point) 'index) -1))) (let ((img bubbles--empty-image)) commit a3639317bc9ba2bf2a92396970beb0ce9c3f446d Author: Stefan Monnier Date: Sat Sep 22 19:16:55 2018 -0400 * lisp/mouse.el (tear-off-window): Fix non-mouse use (bug#32799) diff --git a/lisp/mouse.el b/lisp/mouse.el index f749d12054..d14b5cbea4 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -326,7 +326,7 @@ This command must be bound to a mouse click." (define-obsolete-function-alias 'mouse-tear-off-window 'tear-off-window "24.4") (defun tear-off-window (click) "Delete the selected window, and create a new frame displaying its buffer." - (interactive "e") + (interactive (list last-nonmenu-event)) (mouse-minibuffer-check click) (let* ((window (posn-window (event-start click))) (buf (window-buffer window)) commit 0b36041d2a528419982a19940573783ff318c0d4 Author: Paul Eggert Date: Sat Sep 22 08:59:06 2018 -0700 Round bignums consistently with other integers * src/bignum.c (mpz_bufsize): New function. (bignum_bufsize): Use it. (mpz_get_d_rounded): New function. (bignum_to_double): Use it. * src/bignum.c (bignum_to_double): * src/data.c (bignum_arith_driver): When converting bignums to double, round instead of truncating, to be consistent with what happens with fixnums. * test/src/floatfns-tests.el (bignum-to-float): Test rounding. diff --git a/src/bignum.c b/src/bignum.c index 5e86c404b7..1e78d981b7 100644 --- a/src/bignum.c +++ b/src/bignum.c @@ -62,7 +62,7 @@ init_bignum (void) double bignum_to_double (Lisp_Object n) { - return mpz_get_d (XBIGNUM (n)->value); + return mpz_get_d_rounded (XBIGNUM (n)->value); } /* Return D, converted to a Lisp integer. Discard any fraction. @@ -251,12 +251,40 @@ bignum_to_uintmax (Lisp_Object x) } /* Yield an upper bound on the buffer size needed to contain a C - string representing the bignum NUM in base BASE. This includes any + string representing the NUM in base BASE. This includes any preceding '-' and the terminating null. */ +static ptrdiff_t +mpz_bufsize (mpz_t const num, int base) +{ + return mpz_sizeinbase (num, base) + 2; +} ptrdiff_t bignum_bufsize (Lisp_Object num, int base) { - return mpz_sizeinbase (XBIGNUM (num)->value, base) + 2; + return mpz_bufsize (XBIGNUM (num)->value, base); +} + +/* Convert NUM to a nearest double, as opposed to mpz_get_d which + truncates toward zero. */ +double +mpz_get_d_rounded (mpz_t const num) +{ + ptrdiff_t size = mpz_bufsize (num, 10); + + /* Use mpz_get_d as a shortcut for a bignum so small that rounding + errors cannot occur, which is possible if EMACS_INT (not counting + sign) has fewer bits than a double significand. */ + if (! ((FLT_RADIX == 2 && DBL_MANT_DIG <= FIXNUM_BITS - 1) + || (FLT_RADIX == 16 && DBL_MANT_DIG * 4 <= FIXNUM_BITS - 1)) + && size <= DBL_DIG + 2) + return mpz_get_d (num); + + USE_SAFE_ALLOCA; + char *buf = SAFE_ALLOCA (size); + mpz_get_str (buf, 10, num); + double result = strtod (buf, NULL); + SAFE_FREE (); + return result; } /* Store into BUF (of size SIZE) the value of NUM as a base-BASE string. diff --git a/src/bignum.h b/src/bignum.h index 6551549343..e9cd5c0763 100644 --- a/src/bignum.h +++ b/src/bignum.h @@ -46,6 +46,7 @@ extern mpz_t mpz[4]; extern void init_bignum (void); extern Lisp_Object make_integer_mpz (void); extern void mpz_set_intmax_slow (mpz_t, intmax_t) ARG_NONNULL ((1)); +extern double mpz_get_d_rounded (mpz_t const); INLINE_HEADER_BEGIN diff --git a/src/data.c b/src/data.c index cc080372d8..750d494b83 100644 --- a/src/data.c +++ b/src/data.c @@ -2921,7 +2921,7 @@ bignum_arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args, CHECK_NUMBER_COERCE_MARKER (val); if (FLOATP (val)) return float_arith_driver (code, nargs, args, argnum, - mpz_get_d (*accum), val); + mpz_get_d_rounded (*accum), val); } } diff --git a/test/src/floatfns-tests.el b/test/src/floatfns-tests.el index 14576b603c..61b1c25743 100644 --- a/test/src/floatfns-tests.el +++ b/test/src/floatfns-tests.el @@ -35,6 +35,12 @@ (should-error (fround 0) :type 'wrong-type-argument)) (ert-deftest bignum-to-float () + ;; 122 because we want to go as big as possible to provoke a rounding error, + ;; but not too big: 2**122 < 10**37 < 2**123, and the C standard says + ;; 10**37 <= DBL_MAX so 2**122 cannot overflow as a double. + (let ((a (1- (ash 1 122)))) + (should (or (eql a (1- (floor (float a)))) + (eql a (floor (float a)))))) (should (eql (float (+ most-positive-fixnum 1)) (+ (float most-positive-fixnum) 1)))) commit 596ccc087c8f844f81b075da643e5c554a8de9d6 Author: Stefan Monnier Date: Sat Sep 22 11:47:40 2018 -0400 Complement to last commit diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 5c3017a388..c7eea90b92 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -1981,7 +1981,7 @@ table. @item M-x tags-query-replace @key{RET} @var{regexp} @key{RET} @var{replacement} @key{RET} Perform a @code{query-replace-regexp} on each file in the selected tags table. -@item M-x tags-loop-continue +@item M-x multifile-continue Restart one of the last 2 commands above, from the current location of point. @end table @@ -2017,9 +2017,9 @@ you can follow its progress. As soon as it finds an occurrence, @code{tags-search} returns. This command requires tags tables to be available (@pxref{Tags Tables}). -@findex tags-loop-continue +@findex multifile-continue Having found one match with @code{tags-search}, you probably want to -find all the rest. @kbd{M-x tags-loop-continue} resumes the +find all the rest. @kbd{M-x multifile-continue} resumes the @code{tags-search}, finding one more match. This searches the rest of the current buffer, followed by the remaining files of the tags table. @@ -2042,10 +2042,10 @@ default is to use the same setting as the value of single invocation of @kbd{M-x tags-query-replace}. But often it is useful to exit temporarily, which you can do with any input event that has no special query replace meaning. You can resume the query -replace subsequently by typing @kbd{M-x tags-loop-continue}; this +replace subsequently by typing @kbd{M-x multifile-continue}; this command resumes the last tags search or replace command that you did. For instance, to skip the rest of the current file, you can type -@w{@kbd{M-> M-x tags-loop-continue}}. +@w{@kbd{M-> M-x multifile-continue}}. Note that the commands described above carry out much broader searches than the @code{xref-find-definitions} family. The @@ -2077,7 +2077,7 @@ Display a list of all known identifiers matching @var{regexp}. Display a list of the identifiers defined in the program file @var{file}. -@item M-x next-file +@item M-x tags-next-file Visit files recorded in the selected tags table. @end table diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index 38e89c6cfd..d9d213df15 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -2443,7 +2443,7 @@ Next we define the menu items: @smallexample (define-key menu-bar-replace-menu [tags-repl-continue] - '(menu-item "Continue Replace" tags-loop-continue + '(menu-item "Continue Replace" multifile-continue :help "Continue last tags replace operation")) (define-key menu-bar-replace-menu [tags-repl] '(menu-item "Replace in tagged files" tags-query-replace diff --git a/etc/NEWS b/etc/NEWS index 2158fdc10d..bc6791b05b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -265,6 +265,17 @@ navigation and editing of large files. * Changes in Specialized Modes and Packages in Emacs 27.1 +** project.el +*** New commands project-search and project-query-replace + +** Etags ++++ +*** 'next-file' is now an obsolete alias of tags-next-file +*** tags-loop-revert-buffers is an obsolete alias of multifile-revert-buffers +*** The tags-loop-continue function along with the tags-loop-operate and +tags-loop-scan variables are now obsolete; use the new multifile-initialize and +multifile-continue functions instead. + --- ** bibtex *** New commands 'bibtex-next-entry' and 'bibtex-previous-entry'. @@ -770,6 +781,8 @@ subexpression. * New Modes and Packages in Emacs 27.1 +** multifile.el lets one setup multifile operations like search&replace + +++ ** Emacs can now visit files in archives as if they were directories. This feature uses Tramp and works only on systems which support GVFS, diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 20d5ad95d8..74e01f87e9 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -300,7 +300,7 @@ menu-bar-separator) (bindings--define-key menu [tags-continue] - '(menu-item "Continue Tags Search" tags-loop-continue + '(menu-item "Continue Tags Search" multifile-continue :help "Continue last tags search operation")) (bindings--define-key menu [tags-srch] '(menu-item "Search Tagged Files..." tags-search @@ -349,7 +349,7 @@ (defvar menu-bar-replace-menu (let ((menu (make-sparse-keymap "Replace"))) (bindings--define-key menu [tags-repl-continue] - '(menu-item "Continue Replace" tags-loop-continue + '(menu-item "Continue Replace" multifile-continue :help "Continue last tags replace operation")) (bindings--define-key menu [tags-repl] '(menu-item "Replace in Tagged Files..." tags-query-replace commit 55ec674f5090f420c8982f5206e6566b5a664340 Author: Stefan Monnier Date: Sat Sep 22 11:46:35 2018 -0400 * lisp/multifile.el: New file, extracted from etags.el The main motivation for this change was the introduction of project-query-replace. dired's multi-file query&replace was implemented on top of etags.el even though it did not use TAGS in any way, so I moved this generic multifile code into its own package, with a nicer interface, and then used that in project.el. * lisp/progmodes/project.el (project-files): New generic function. (project-search, project-query-replace): New commands. * lisp/dired-aux.el (dired-do-search, dired-do-query-replace-regexp): Use multifile.el instead of etags.el. * lisp/progmodes/etags.el: Remove redundant :groups. (next-file-list): Remove var. (tags-loop-revert-buffers): Make it an obsolete alias. (next-file): Don't autoload (it can't do anything useful before some other etags.el function setup the multifile operation). (tags--all-files): New function, extracted from next-file. (tags-next-file): Rename from next-file. Rewrite using tags--all-files and multifile-next-file. (next-file): Keep it as an obsolete alias. (tags-loop-operate, tags-loop-scan): Mark as obsolete. (tags--compat-files, tags--compat-initialize): New function. (tags-loop-continue): Rewrite using multifile-continue. Mark as obsolete. (tags--last-search-operate-function): New var. (tags-search, tags-query-replace): Rewrite using multifile.el. * lisp/emacs-lisp/generator.el (iter-end-of-sequence): Use 'define-error'. (iter-make): New macro. (iter-empty): New iterator. * lisp/menu-bar.el (menu-bar-search-menu, menu-bar-replace-menu): tags-loop-continue -> multifile-continue. diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 21ee50ce5c..ce2ed13ad0 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -2832,7 +2832,7 @@ is part of a file name (i.e., has the text property `dired-filename')." "Search for a string through all marked files using Isearch." (interactive) (multi-isearch-files - (dired-get-marked-files nil nil 'dired-nondirectory-p nil t))) + (dired-get-marked-files nil nil #'dired-nondirectory-p nil t))) ;;;###autoload (defun dired-do-isearch-regexp () @@ -2847,7 +2847,11 @@ is part of a file name (i.e., has the text property `dired-filename')." Stops when a match is found. To continue searching for next match, use command \\[tags-loop-continue]." (interactive "sSearch marked files (regexp): ") - (tags-search regexp '(dired-get-marked-files nil nil 'dired-nondirectory-p))) + (multifile-initialize-search + regexp + (dired-get-marked-files nil nil #'dired-nondirectory-p) + 'default) + (multifile-continue)) ;;;###autoload (defun dired-do-query-replace-regexp (from to &optional delimited) @@ -2860,13 +2864,16 @@ with the command \\[tags-loop-continue]." (query-replace-read-args "Query replace regexp in marked files" t t))) (list (nth 0 common) (nth 1 common) (nth 2 common)))) - (dolist (file (dired-get-marked-files nil nil 'dired-nondirectory-p nil t)) + (dolist (file (dired-get-marked-files nil nil #'dired-nondirectory-p nil t)) (let ((buffer (get-file-buffer file))) (if (and buffer (with-current-buffer buffer buffer-read-only)) (error "File `%s' is visited read-only" file)))) - (tags-query-replace from to delimited - '(dired-get-marked-files nil nil 'dired-nondirectory-p))) + (multifile-initialize-replace + from to (dired-get-marked-files nil nil #'dired-nondirectory-p) + (if (equal from (downcase from)) nil 'default) + delimited) + (multifile-continue)) (declare-function xref--show-xrefs "xref") (declare-function xref-query-replace-in-results "xref") diff --git a/lisp/emacs-lisp/generator.el b/lisp/emacs-lisp/generator.el index 506df59d8e..e38c7d9109 100644 --- a/lisp/emacs-lisp/generator.el +++ b/lisp/emacs-lisp/generator.el @@ -567,8 +567,11 @@ modified copy." (unless ,normal-exit-symbol ,@unwind-forms)))))) -(put 'iter-end-of-sequence 'error-conditions '(iter-end-of-sequence)) -(put 'iter-end-of-sequence 'error-message "iteration terminated") +(define-error 'iter-end-of-sequence "Iteration terminated" + ;; FIXME: This was not defined originally as an `error' condition, so + ;; we reproduce this by passing itself as the parent, which avoids the + ;; default `error' parent. Maybe it *should* be in the `error' category? + 'iter-end-of-sequence) (defun cps--make-close-iterator-form (terminal-state) (if cps--cleanup-table-symbol @@ -700,6 +703,14 @@ of values. Callers can retrieve each value using `iter-next'." `(lambda ,arglist ,(cps-generate-evaluator body))) +(defmacro iter-make (&rest body) + "Return a new iterator." + (declare (debug t)) + (cps-generate-evaluator body)) + +(defconst iter-empty (lambda (_op _val) (signal 'iter-end-of-sequence nil)) + "Trivial iterator that always signals the end of sequence.") + (defun iter-next (iterator &optional yield-result) "Extract a value from an iterator. YIELD-RESULT becomes the return value of `iter-yield' in the diff --git a/lisp/multifile.el b/lisp/multifile.el new file mode 100644 index 0000000000..712da5cc77 --- /dev/null +++ b/lisp/multifile.el @@ -0,0 +1,217 @@ +;;; multifile.el --- Operations on multiple files -*- lexical-binding: t; -*- + +;; Copyright (C) 2018 Free Software Foundation, Inc. + +;; Author: Stefan Monnier + +;; This program 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. + +;; This program 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 this program. If not, see . + +;;; Commentary: + +;; Support functions for operations like search or query&replace applied to +;; several files. This code was largely inspired&extracted from an earlier +;; version of etags.el. + +;; TODO: +;; - Maybe it would make sense to replace the multifile--* vars with a single +;; global var holding a struct, and then stash those structs into a history +;; of past operations, so you can perform a multifile-search while in the +;; middle of a multifile-replace and later go back to that +;; multifile-replace. +;; - Make multi-isearch work on top of this library (might require changes +;; to this library, of course). + +;;; Code: + +(require 'generator) + +(defgroup multifile nil + "Operations on multiple files." + :group 'tools) + +(defcustom multifile-revert-buffers 'silent + "Whether to revert files during multifile operation. + `silent' means to only do it if `revert-without-query' is applicable; + t means to offer to do it for all applicable files; + nil means never to do it" + :type '(choice (const silent) (const t) (const nil))) + +;; FIXME: This already exists in GNU ELPA's iterator.el. Maybe it should move +;; to generator.el? +(iter-defun multifile--list-to-iterator (list) + (while list (iter-yield (pop list)))) + +(defvar multifile--iterator iter-empty) +(defvar multifile--scan-function + (lambda () (user-error "No operation in progress"))) +(defvar multifile--operate-function #'ignore) +(defvar multifile--freshly-initialized nil) + +;;;###autoload +(defun multifile-initialize (files scan-function operate-function) + "Initialize a new round of operation on several files. +FILES can be either a list of file names, or an iterator (used with `iter-next') +which returns a file name at each step. +SCAN-FUNCTION is a function called with no argument inside a buffer +and it should return non-nil if that buffer has something on which to operate. +OPERATE-FUNCTION is a function called with no argument; it is expected +to perform the operation on the current file buffer and when done +should return non-nil to mean that we should immediately continue +operating on the next file and nil otherwise." + (setq multifile--iterator + (if (and (listp files) (not (functionp files))) + (multifile--list-to-iterator files) + files)) + (setq multifile--scan-function scan-function) + (setq multifile--operate-function operate-function) + (setq multifile--freshly-initialized t)) + +(defun multifile-next-file (&optional novisit) + ;; FIXME: Should we provide an interactive command, like tags-next-file? + (let ((next (condition-case nil + (iter-next multifile--iterator) + (iter-end-of-sequence nil)))) + (unless next + (and novisit + (get-buffer " *next-file*") + (kill-buffer " *next-file*")) + (user-error "All files processed")) + (let* ((buffer (get-file-buffer next)) + (new (not buffer))) + ;; Optionally offer to revert buffers + ;; if the files have changed on disk. + (and buffer multifile-revert-buffers + (not (verify-visited-file-modtime buffer)) + (if (eq multifile-revert-buffers 'silent) + (and (not (buffer-modified-p buffer)) + (let ((revertible nil)) + (dolist (re revert-without-query) + (when (string-match-p re next) + (setq revertible t))) + revertible)) + (y-or-n-p + (format + (if (buffer-modified-p buffer) + "File %s changed on disk. Discard your edits? " + "File %s changed on disk. Reread from disk? ") + next))) + (with-current-buffer buffer + (revert-buffer t t))) + (if (not (and new novisit)) + (set-buffer (find-file-noselect next)) + ;; Like find-file, but avoids random warning messages. + (set-buffer (get-buffer-create " *next-file*")) + (kill-all-local-variables) + (erase-buffer) + (setq new next) + (insert-file-contents new nil)) + new))) + +(defun multifile-continue () + "Continue last multi-file operation." + (interactive) + (let (new + ;; Non-nil means we have finished one file + ;; and should not scan it again. + file-finished + original-point + (messaged nil)) + (while + (progn + ;; Scan files quickly for the first or next interesting one. + ;; This starts at point in the current buffer. + (while (or multifile--freshly-initialized file-finished + (save-restriction + (widen) + (not (funcall multifile--scan-function)))) + ;; If nothing was found in the previous file, and + ;; that file isn't in a temp buffer, restore point to + ;; where it was. + (when original-point + (goto-char original-point)) + + (setq file-finished nil) + (setq new (multifile-next-file t)) + + ;; If NEW is non-nil, we got a temp buffer, + ;; and NEW is the file name. + (when (or messaged + (and (not multifile--freshly-initialized) + (> baud-rate search-slow-speed) + (setq messaged t))) + (message "Scanning file %s..." (or new buffer-file-name))) + + (setq multifile--freshly-initialized nil) + (setq original-point (if new nil (point))) + (goto-char (point-min))) + + ;; If we visited it in a temp buffer, visit it now for real. + (if new + (let ((pos (point))) + (erase-buffer) + (set-buffer (find-file-noselect new)) + (setq new nil) ;No longer in a temp buffer. + (widen) + (goto-char pos)) + (push-mark original-point t)) + + (switch-to-buffer (current-buffer)) + + ;; Now operate on the file. + ;; If value is non-nil, continue to scan the next file. + (save-restriction + (widen) + (funcall multifile--operate-function))) + (setq file-finished t)))) + +;;;###autoload +(defun multifile-initialize-search (regexp files case-fold) + (let ((last-buffer (current-buffer))) + (multifile-initialize + files + (lambda () + (let ((case-fold-search + (if (memq case-fold '(t nil)) case-fold case-fold-search))) + (re-search-forward regexp nil t))) + (lambda () + (unless (eq last-buffer (current-buffer)) + (setq last-buffer (current-buffer)) + (message "Scanning file %s...found" buffer-file-name)) + nil)))) + +;;;###autoload +(defun multifile-initialize-replace (from to files case-fold &optional delimited) + "Initialize a new round of query&replace on several files. +FROM is a regexp and TO is the replacement to use. +FILES describes the file, as in `multifile-initialize'. +CASE-FOLD can be t, nil, or `default', the latter one meaning to obey +the default setting of `case-fold-search'. +DELIMITED if non-nil means replace only word-delimited matches." + ;; FIXME: Not sure how the delimited-flag interacts with the regexp-flag in + ;; `perform-replace', so I just try to mimic the old code. + (multifile-initialize + files + (lambda () + (let ((case-fold-search + (if (memql case-fold '(nil t)) case-fold case-fold-search))) + (if (re-search-forward from nil t) + ;; When we find a match, move back + ;; to the beginning of it so perform-replace + ;; will see it. + (goto-char (match-beginning 0))))) + (lambda () + (perform-replace from to t t delimited nil multi-query-replace-map)))) + +(provide 'multifile) +;;; multifile.el ends here diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index 4f07fe9485..6844e9b0f7 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -26,9 +26,17 @@ ;;; Code: +;; The namespacing of this package is a mess: +;; - The file name is "etags", but the "exported" functionality doesn't use +;; this name +;; - Uses "etags-", "tags-", and "tag-" prefixes. +;; - Many functions use "-tag-" or "-tags-", or even "-etags-" not as +;; prefixes but somewhere within the name. + (require 'ring) (require 'button) (require 'xref) +(require 'multifile) ;;;###autoload (defvar tags-file-name nil @@ -49,7 +57,6 @@ Use the `etags' program to make a tags table file.") "Whether tags operations should be case-sensitive. A value of t means case-insensitive, a value of nil means case-sensitive. Any other value means use the setting of `case-fold-search'." - :group 'etags :type '(choice (const :tag "Case-sensitive" nil) (const :tag "Case-insensitive" t) (other :tag "Use default" default)) @@ -63,7 +70,6 @@ An element that is a directory means the file \"TAGS\" in that directory. To switch to a new list of tags tables, setting this variable is sufficient. If you set this variable, do not also set `tags-file-name'. Use the `etags' program to make a tags table file." - :group 'etags :type '(repeat file)) ;;;###autoload @@ -72,8 +78,7 @@ Use the `etags' program to make a tags table file." "List of extensions tried by etags when `auto-compression-mode' is on. An empty string means search the non-compressed file." :version "24.1" ; added xz - :type '(repeat string) - :group 'etags) + :type '(repeat string)) ;; !!! tags-compression-info-list should probably be replaced by access ;; to directory list and matching jka-compr-compression-info-list. Currently, @@ -91,14 +96,12 @@ An empty string means search the non-compressed file." t means do; nil means don't (always start a new list). Any other value means ask the user whether to add a new tags table to the current list (as opposed to starting a new list)." - :group 'etags :type '(choice (const :tag "Do" t) (const :tag "Don't" nil) (other :tag "Ask" ask-user))) (defcustom tags-revert-without-query nil "Non-nil means reread a TAGS table without querying, if it has changed." - :group 'etags :type 'boolean) (defvar tags-table-computed-list nil @@ -131,7 +134,6 @@ Each element is a list of strings which are file names.") "Hook to be run by \\[find-tag] after finding a tag. See `run-hooks'. The value in the buffer in which \\[find-tag] is done is used, not the value in the buffer \\[find-tag] goes to." - :group 'etags :type 'hook) ;;;###autoload @@ -140,7 +142,6 @@ not the value in the buffer \\[find-tag] goes to." If nil, and the symbol that is the value of `major-mode' has a `find-tag-default-function' property (see `put'), that is used. Otherwise, `find-tag-default' is used." - :group 'etags :type '(choice (const nil) function)) (define-obsolete-variable-alias 'find-tag-marker-ring-length @@ -148,13 +149,11 @@ Otherwise, `find-tag-default' is used." (defcustom tags-tag-face 'default "Face for tags in the output of `tags-apropos'." - :group 'etags :type 'face :version "21.1") (defcustom tags-apropos-verbose nil "If non-nil, print the name of the tags file in the *Tags List* buffer." - :group 'etags :type 'boolean :version "21.1") @@ -175,7 +174,6 @@ Example value: ((\"Emacs Lisp\" Info-goto-emacs-command-node obarray) (\"Common Lisp\" common-lisp-hyperspec common-lisp-hyperspec-obarray) (\"SCWM\" scwm-documentation scwm-obarray))" - :group 'etags :type '(repeat (list (string :tag "Title") function (sexp :tag "Tags to search"))) @@ -209,9 +207,6 @@ use function `tags-table-files' to do so.") (defvar tags-included-tables nil "List of tags tables included by the current tags table.") - -(defvar next-file-list nil - "List of files for \\[next-file] to process.") ;; Hooks for file formats. @@ -328,10 +323,10 @@ file the tag was in." (defun tags-table-check-computed-list () "Compute `tags-table-computed-list' from `tags-table-list' if necessary." - (let ((expanded-list (mapcar 'tags-expand-table-name tags-table-list))) + (let ((expanded-list (mapcar #'tags-expand-table-name tags-table-list))) (or (equal tags-table-computed-list-for expanded-list) ;; The list (or default-directory) has changed since last computed. - (let* ((compute-for (mapcar 'copy-sequence expanded-list)) + (let* ((compute-for (mapcar #'copy-sequence expanded-list)) (tables (copy-sequence compute-for)) ;Mutated in the loop. (computed nil) table-buffer) @@ -351,7 +346,7 @@ file the tag was in." (if (tags-included-tables) ;; Insert the included tables into the list we ;; are processing. - (setcdr tables (nconc (mapcar 'tags-expand-table-name + (setcdr tables (nconc (mapcar #'tags-expand-table-name (tags-included-tables)) (cdr tables)))))) ;; This table is not in core yet. Insert a placeholder @@ -502,7 +497,7 @@ buffers. If CORE-ONLY is nil, it is ignored." ;; Select the tags table buffer and get the file list up to date. (let ((tags-file-name (car tables))) (visit-tags-table-buffer 'same) - (if (member this-file (mapcar 'expand-file-name + (if (member this-file (mapcar #'expand-file-name (tags-table-files))) ;; Found it. (setq found tables)))) @@ -853,7 +848,7 @@ If no tags table is loaded, do nothing and return nil." (defun find-tag--default () (funcall (or find-tag-default-function (get major-mode 'find-tag-default-function) - 'find-tag-default))) + #'find-tag-default))) (defvar last-tag nil "Last tag found by \\[find-tag].") @@ -1698,18 +1693,14 @@ Point should be just after a string that matches TAG." (let ((bol (point))) (and (search-forward "\177" (line-end-position) t) (re-search-backward re bol t))))) - -(defcustom tags-loop-revert-buffers nil - "Non-nil means tags-scanning loops should offer to reread changed files. -These loops normally read each file into Emacs, but when a file -is already visited, they use the existing buffer. -When this flag is non-nil, they offer to revert the existing buffer -in the case where the file has changed since you visited it." - :type 'boolean - :group 'etags) +(define-obsolete-variable-alias 'tags-loop-revert-buffers 'multifile-revert-buffers "27.1") ;;;###autoload -(defun next-file (&optional initialize novisit) +(defalias 'next-file 'tags-next-file) +(make-obsolete 'next-file + "use tags-next-file or multifile-initialize and multifile-next-file instead" "27.1") +;;;###autoload +(defun tags-next-file (&optional initialize novisit) "Select next file among files in current tags table. A first argument of t (prefix arg, if interactive) initializes to the @@ -1723,71 +1714,39 @@ Value is nil if the file was already visited; if the file was newly read in, the value is the filename." ;; Make the interactive arg t if there was any prefix arg. (interactive (list (if current-prefix-arg t))) - (cond ((not initialize) - ;; Not the first run. - ) - ((eq initialize t) - ;; Initialize the list from the tags table. - (save-excursion - (let ((cbuf (current-buffer))) - ;; Visit the tags table buffer to get its list of files. - (visit-tags-table-buffer) - ;; Copy the list so we can setcdr below, and expand the file - ;; names while we are at it, in this buffer's default directory. - (setq next-file-list (mapcar 'expand-file-name (tags-table-files))) - ;; Iterate over all the tags table files, collecting - ;; a complete list of referenced file names. - (while (visit-tags-table-buffer t cbuf) - ;; Find the tail of the working list and chain on the new - ;; sublist for this tags table. - (let ((tail next-file-list)) - (while (cdr tail) - (setq tail (cdr tail))) - ;; Use a copy so the next loop iteration will not modify the - ;; list later returned by (tags-table-files). - (if tail - (setcdr tail (mapcar 'expand-file-name (tags-table-files))) - (setq next-file-list (mapcar 'expand-file-name - (tags-table-files))))))))) - (t - ;; Initialize the list by evalling the argument. - (setq next-file-list (eval initialize)))) - (unless next-file-list - (and novisit - (get-buffer " *next-file*") - (kill-buffer " *next-file*")) - (user-error "All files processed")) - (let* ((next (car next-file-list)) - (buffer (get-file-buffer next)) - (new (not buffer))) - ;; Advance the list before trying to find the file. - ;; If we get an error finding the file, don't get stuck on it. - (setq next-file-list (cdr next-file-list)) - ;; Optionally offer to revert buffers - ;; if the files have changed on disk. - (and buffer tags-loop-revert-buffers - (not (verify-visited-file-modtime buffer)) - (y-or-n-p - (format - (if (buffer-modified-p buffer) - "File %s changed on disk. Discard your edits? " - "File %s changed on disk. Reread from disk? ") - next)) - (with-current-buffer buffer - (revert-buffer t t))) - (if (not (and new novisit)) - (find-file next) - ;; Like find-file, but avoids random warning messages. - (switch-to-buffer (get-buffer-create " *next-file*")) - (kill-all-local-variables) - (erase-buffer) - (setq new next) - (insert-file-contents new nil)) - new)) + (when initialize ;; Not the first run. + (tags--compat-initialize initialize)) + (multifile-next-file novisit) + (switch-to-buffer (current-buffer))) +(defun tags--all-files () + (save-excursion + (let ((cbuf (current-buffer)) + (files nil)) + ;; Visit the tags table buffer to get its list of files. + (visit-tags-table-buffer) + ;; Copy the list so we can setcdr below, and expand the file + ;; names while we are at it, in this buffer's default directory. + (setq files (mapcar #'expand-file-name (tags-table-files))) + ;; Iterate over all the tags table files, collecting + ;; a complete list of referenced file names. + (while (visit-tags-table-buffer t cbuf) + ;; Find the tail of the working list and chain on the new + ;; sublist for this tags table. + (let ((tail files)) + (while (cdr tail) + (setq tail (cdr tail))) + ;; Use a copy so the next loop iteration will not modify the + ;; list later returned by (tags-table-files). + (setf (if tail (cdr tail) files) + (mapcar #'expand-file-name (tags-table-files))))) + files))) + +(make-obsolete-variable 'tags-loop-operate 'multifile-initialize "27.1") (defvar tags-loop-operate nil "Form for `tags-loop-continue' to eval to change one file.") +(make-obsolete-variable 'tags-loop-scan 'multifile-initialize "27.1") (defvar tags-loop-scan '(user-error "%s" (substitute-command-keys @@ -1805,121 +1764,84 @@ Bind `case-fold-search' during the evaluation, depending on the value of case-fold-search))) (eval form))) +(defun tags--compat-files (files) + (cond + ((eq files t) (tags--all-files)) ;; Initialize the list from the tags table. + ((functionp files) files) + ((stringp (car-safe files)) files) + (t + ;; Backward compatibility <27.1 + ;; Initialize the list by evalling the argument. + (eval files)))) + +(defun tags--compat-initialize (initialize) + (multifile-initialize + (tags--compat-files initialize) + (if tags-loop-operate + (lambda () (tags-loop-eval tags-loop-operate)) + (lambda () (message "Scanning file %s...found" buffer-file-name) nil)) + (lambda () (tags-loop-eval tags-loop-scan)))) ;;;###autoload (defun tags-loop-continue (&optional first-time) "Continue last \\[tags-search] or \\[tags-query-replace] command. Used noninteractively with non-nil argument to begin such a command (the -argument is passed to `next-file', which see). - -Two variables control the processing we do on each file: the value of -`tags-loop-scan' is a form to be executed on each file to see if it is -interesting (it returns non-nil if so) and `tags-loop-operate' is a form to -evaluate to operate on an interesting file. If the latter evaluates to -nil, we exit; otherwise we scan the next file." +argument is passed to `next-file', which see)." + ;; Two variables control the processing we do on each file: the value of + ;; `tags-loop-scan' is a form to be executed on each file to see if it is + ;; interesting (it returns non-nil if so) and `tags-loop-operate' is a form to + ;; evaluate to operate on an interesting file. If the latter evaluates to + ;; nil, we exit; otherwise we scan the next file. + (declare (obsolete multifile-continue "27.1")) (interactive) - (let (new - ;; Non-nil means we have finished one file - ;; and should not scan it again. - file-finished - original-point - (messaged nil)) - (while - (progn - ;; Scan files quickly for the first or next interesting one. - ;; This starts at point in the current buffer. - (while (or first-time file-finished - (save-restriction - (widen) - (not (tags-loop-eval tags-loop-scan)))) - ;; If nothing was found in the previous file, and - ;; that file isn't in a temp buffer, restore point to - ;; where it was. - (when original-point - (goto-char original-point)) - - (setq file-finished nil) - (setq new (next-file first-time t)) - - ;; If NEW is non-nil, we got a temp buffer, - ;; and NEW is the file name. - (when (or messaged - (and (not first-time) - (> baud-rate search-slow-speed) - (setq messaged t))) - (message "Scanning file %s..." (or new buffer-file-name))) - - (setq first-time nil) - (setq original-point (if new nil (point))) - (goto-char (point-min))) + (when first-time ;; Backward compatibility. + (tags--compat-initialize first-time)) + (multifile-continue)) - ;; If we visited it in a temp buffer, visit it now for real. - (if new - (let ((pos (point))) - (erase-buffer) - (set-buffer (find-file-noselect new)) - (setq new nil) ;No longer in a temp buffer. - (widen) - (goto-char pos)) - (push-mark original-point t)) - - (switch-to-buffer (current-buffer)) - - ;; Now operate on the file. - ;; If value is non-nil, continue to scan the next file. - (save-restriction - (widen) - (tags-loop-eval tags-loop-operate))) - (setq file-finished t)) - (and messaged - (null tags-loop-operate) - (message "Scanning file %s...found" buffer-file-name)))) +;; We use it to detect when the last loop was a tags-search. +(defvar tags--last-search-operate-function nil) ;;;###autoload -(defun tags-search (regexp &optional file-list-form) +(defun tags-search (regexp &optional files) "Search through all files listed in tags table for match for REGEXP. Stops when a match is found. To continue searching for next match, use command \\[tags-loop-continue]. -If FILE-LIST-FORM is non-nil, it should be a form that, when -evaluated, will return a list of file names. The search will be -restricted to these files. +If FILES if non-nil should be a list or an iterator returning the files to search. +The search will be restricted to these files. Also see the documentation of the `tags-file-name' variable." (interactive "sTags search (regexp): ") - (if (and (equal regexp "") - (eq (car tags-loop-scan) 're-search-forward) - (null tags-loop-operate)) - ;; Continue last tags-search as if by M-,. - (tags-loop-continue nil) - (setq tags-loop-scan `(re-search-forward ',regexp nil t) - tags-loop-operate nil) - (tags-loop-continue (or file-list-form t)))) + (unless (and (equal regexp "") + ;; FIXME: If some other multifile operation took place, + ;; rather than search for "", we should repeat the last search! + (eq multifile--operate-function + tags--last-search-operate-function)) + (multifile-initialize-search + regexp + (tags--compat-files (or files t)) + tags-case-fold-search) + ;; Store it, so we can detect if some other multifile operation took + ;; place since the last search! + (setq tags--last-search-operate-function multifile--operate-function)) + (multifile-continue)) ;;;###autoload -(defun tags-query-replace (from to &optional delimited file-list-form) +(defun tags-query-replace (from to &optional delimited files) "Do `query-replace-regexp' of FROM with TO on all files listed in tags table. Third arg DELIMITED (prefix arg) means replace only word-delimited matches. If you exit (\\[keyboard-quit], RET or q), you can resume the query replace with the command \\[tags-loop-continue]. -Fourth arg FILE-LIST-FORM non-nil means initialize the replacement loop. - -If FILE-LIST-FORM is non-nil, it is a form to evaluate to -produce the list of files to search. - -See also the documentation of the variable `tags-file-name'." +For non-interactive use, superceded by `multifile-initialize-replace'." + (declare (advertised-calling-convention (from to &optional delimited) "27.1")) (interactive (query-replace-read-args "Tags query replace (regexp)" t t)) - (setq tags-loop-scan `(let ,(unless (equal from (downcase from)) - '((case-fold-search nil))) - (if (re-search-forward ',from nil t) - ;; When we find a match, move back - ;; to the beginning of it so perform-replace - ;; will see it. - (goto-char (match-beginning 0)))) - tags-loop-operate `(perform-replace ',from ',to t t ',delimited - nil multi-query-replace-map)) - (tags-loop-continue (or file-list-form t))) - + (multifile-initialize-replace + from to + (tags--compat-files (or files t)) + (if (equal from (downcase from)) nil 'default) + delimited) + (multifile-continue)) + (defun tags-complete-tags-table-file (string predicate what) ; Doc string? (save-excursion ;; If we need to ask for the tag table, allow that. @@ -1976,7 +1898,8 @@ directory specification." (funcall tags-apropos-function regexp)))) (etags-tags-apropos-additional regexp)) (with-current-buffer "*Tags List*" - (eval-and-compile (require 'apropos)) + (require 'apropos) + (declare-function apropos-mode "apropos") (apropos-mode) ;; apropos-mode is derived from fundamental-mode and it kills ;; all local variables. @@ -2006,14 +1929,14 @@ see the doc of that variable if you want to add names to the list." (when tags-table-list (setq desired-point (point-marker)) (setq b (point)) - (princ (mapcar 'abbreviate-file-name tags-table-list) (current-buffer)) + (princ (mapcar #'abbreviate-file-name tags-table-list) (current-buffer)) (make-text-button b (point) 'type 'tags-select-tags-table 'etags-table (car tags-table-list)) (insert "\n")) (while set-list (unless (eq (car set-list) tags-table-list) (setq b (point)) - (princ (mapcar 'abbreviate-file-name (car set-list)) (current-buffer)) + (princ (mapcar #'abbreviate-file-name (car set-list)) (current-buffer)) (make-text-button b (point) 'type 'tags-select-tags-table 'etags-table (car (car set-list))) (insert "\n")) @@ -2027,9 +1950,9 @@ see the doc of that variable if you want to add names to the list." 'etags-table tags-file-name) (insert "\n")) (setq set-list (delete tags-file-name - (apply 'nconc (cons (copy-sequence tags-table-list) - (mapcar 'copy-sequence - tags-table-set-list))))) + (apply #'nconc (cons (copy-sequence tags-table-list) + (mapcar #'copy-sequence + tags-table-set-list))))) (while set-list (setq b (point)) (insert (abbreviate-file-name (car set-list))) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index eab24e1ea6..f3f29cbac9 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -189,6 +189,18 @@ to find the list of ignores for each directory." (cl-defmethod project-roots ((project (head transient))) (list (cdr project))) +(cl-defgeneric project-files (project &optional dirs) + "Return a list of files in directories DIRS in PROJECT. +DIRS is a list of absolute directories; it should be some +subset of the project roots and external roots." + ;; This default implementation only works if project-file-completion-table + ;; returns a "flat" completion table. + ;; FIXME: Maybe we should do the reverse: implement the default + ;; `project-file-completion-table' on top of `project-files'. + (all-completions + "" (project-file-completion-table + project (or dirs (project-roots project))))) + (defgroup project-vc nil "Project implementation using the VC package." :version "25.1" @@ -389,12 +401,17 @@ recognized." ;; removing it when it has no matches. Neither seems natural ;; enough. Removal is confusing; early expansion makes the prompt ;; too long. - (let* ((new-prompt (if default + (let* (;; (initial-input + ;; (let ((common-prefix (try-completion "" collection))) + ;; (if (> (length common-prefix) 0) + ;; (file-name-directory common-prefix)))) + (new-prompt (if default (format "%s (default %s): " prompt default) (format "%s: " prompt))) (res (completing-read new-prompt collection predicate t - nil hist default inherit-input-method))) + nil ;; initial-input + hist default inherit-input-method))) (if (and (equal res default) (not (test-completion res collection predicate))) (completing-read (format "%s: " prompt) @@ -402,5 +419,30 @@ recognized." inherit-input-method) res))) +(declare-function multifile-continue "multifile" ()) + +;;;###autoload +(defun project-search (regexp) + "Search for REGEXP in all the files of the project. +Stops when a match is found. +To continue searching for next match, use command \\[multifile-continue]." + (interactive "sSearch (regexp): ") + (multifile-initialize-search + regexp (project-files (project-current t)) 'default) + (multifile-continue)) + +;;;###autoload +(defun project-query-replace (from to) + "Search for REGEXP in all the files of the project. +Stops when a match is found. +To continue searching for next match, use command \\[multifile-continue]." + (interactive + (pcase-let ((`(,from ,to) + (query-replace-read-args "Query replace (regexp)" t t))) + (list from to))) + (multifile-initialize-replace + from to (project-files (project-current t)) 'default) + (multifile-continue)) + (provide 'project) ;;; project.el ends here commit 8b8a4c0aeb21692970fe919e96ad4b832fe1078b Author: Eli Zaretskii Date: Sat Sep 22 12:06:51 2018 +0300 Improve documentation of directory-local variables * lisp/files.el (hack-local-variables, normal-mode) (after-find-file, find-file-hook): Mention directory-local variables in the doc strings. Suggested by Marcin Borkowski . * doc/emacs/custom.texi (File Variables, Directory Variables): Clarify that directory-local variables are overridden by file-local ones. diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index 141fa045b6..b93009ad21 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -1059,6 +1059,10 @@ local variable specifications; it automatically makes these variables local to the buffer, and sets them to the values specified in the file. + File local variables override directory local variables +(@pxref{Directory Variables}), if any are specified for a file's +directory. + @menu * Specifying File Variables:: Specifying file local variables. * Safe File Variables:: Making sure file local variables are safe. @@ -1309,7 +1313,12 @@ confirmation about processing @code{eval} variables. Sometimes, you may wish to define the same set of local variables to all the files in a certain directory and its subdirectories, such as the directory tree of a large software project. This can be -accomplished with @dfn{directory-local variables}. +accomplished with @dfn{directory-local variables}. File local +variables override directory local variables, so if some of the files +in a directory need specialized settings, you can specify the settings +for the majority of the directory's files in directory variables, and +then define file local variables in a few files which need the general +settings overridden. @cindex @file{.dir-locals.el} file The usual way to define directory-local variables is to put a file diff --git a/lisp/files.el b/lisp/files.el index 4eb1560a20..a3e72e2ce9 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -493,7 +493,8 @@ The functions are called in the order given until one of them returns non-nil.") (defcustom find-file-hook nil "List of functions to be called after a buffer is loaded from a file. The buffer's local variables (if any) will have been processed before the -functions are called." +functions are called. This includes directory-local variables, if any, +for the file's directory." :group 'find-file :type 'hook :options '(auto-insert) @@ -2369,7 +2370,7 @@ the file contents into it using `insert-file-contents-literally'." _after-find-file-from-revert-buffer nomodes) "Called after finding a file and by the default revert function. -Sets buffer mode, parses local variables. +Sets buffer mode, parses file-local and directory-local variables. Optional args ERROR, WARN, and NOAUTO: ERROR non-nil means there was an error in reading the file. WARN non-nil means warn if there exists an auto-save file more recent than the visited file. @@ -2454,7 +2455,7 @@ unless NOMODES is non-nil." (defun normal-mode (&optional find-file) "Choose the major mode for this buffer automatically. -Also sets up any specified local variables of the file. +Also sets up any specified local variables of the file or its directory. Uses the visited file name, the -*- line, and the local variables spec. This function is called automatically from `find-file'. In that case, @@ -3485,6 +3486,8 @@ DIR-NAME is the name of the associated directory. Otherwise it is nil." (defun hack-local-variables (&optional handle-mode) "Parse and put into effect this buffer's local variables spec. +For buffers visitying files, also puts into effect directory-local +variables. Uses `hack-local-variables-apply' to apply the variables. If HANDLE-MODE is nil, we apply all the specified local commit c9c9756d21d19da8b7c265c1e9d6766e42ccfbfe Author: Eli Zaretskii Date: Sat Sep 22 10:54:58 2018 +0300 Don't use obsolete variable 'save-place' in documentation * doc/lispref/customize.texi (Variable Definitions): Replace example of saveplace defcustom with a fictitious one, which will not bit-rot with time. (Bug#32741) diff --git a/doc/lispref/customize.texi b/doc/lispref/customize.texi index b3528b12d5..1cc7cb65b5 100644 --- a/doc/lispref/customize.texi +++ b/doc/lispref/customize.texi @@ -449,15 +449,14 @@ those other variables already have their intended values. It is useful to specify the @code{:require} keyword for an option that turns on a certain feature. This causes Emacs to load the feature, if it is not already loaded, whenever the option is set. -@xref{Common Keywords}. Here is an example, from the library -@file{saveplace.el}: +@xref{Common Keywords}. Here is an example: @example -(defcustom save-place nil - "Non-nil means automatically save place in each file..." +(defcustom frobnicate-automatically nil + "Non-nil means automatically frobnicate all buffers." :type 'boolean - :require 'saveplace - :group 'save-place) + :require 'frobnicate-mode + :group 'frobnicate) @end example If a customization item has a type such as @code{hook} or commit ca208e83885db25569d1096a7925babb9940ecdd Author: Mark A. Hershberger Date: Sat Sep 15 12:49:49 2018 -0400 Use save-place-mode instead of save-place * lisp/menu-bar.el (menu-bar-options-save, menu-bar-options-menu): * lisp/saveplace.el (save-place-to-alist, save-places-to-alist) (save-place-find-file-hook, save-place-dired-hook): Use save-place-mode instead of the obsolete save-place. diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index e2ebd98119..280fb9354d 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -689,7 +689,7 @@ The selected font will be the default on both the existing and future frames." debug-on-quit debug-on-error ;; Somehow this works, when tool-bar and menu-bar don't. tooltip-mode window-divider-mode - save-place uniquify-buffer-name-style fringe-mode + save-place-mode uniquify-buffer-name-style fringe-mode indicate-empty-lines indicate-buffer-boundaries case-fold-search font-use-system-font current-language-environment default-input-method @@ -1413,7 +1413,7 @@ mail status in mode line")) (bindings--define-key menu [save-place] (menu-bar-make-toggle - toggle-save-place-globally save-place + toggle-save-place-globally save-place-mode "Save Place in Files between Sessions" "Saving place in files %s" "Visit files of previous session when restarting Emacs" @@ -1421,7 +1421,7 @@ mail status in mode line")) ;; Do it by name, to avoid a free-variable ;; warning during byte compilation. (set-default - 'save-place (not (symbol-value 'save-place))))) + 'save-place-mode (not (symbol-value 'save-place-mode))))) (bindings--define-key menu [uniquify] (menu-bar-make-toggle diff --git a/lisp/saveplace.el b/lisp/saveplace.el index aeb6cf1de7..b6a71166ff 100644 --- a/lisp/saveplace.el +++ b/lisp/saveplace.el @@ -27,7 +27,7 @@ ;; Automatically save place in files, so that visiting them later ;; (even during a different Emacs session) automatically moves point ;; to the saved position, when the file is first found. Uses the -;; value of buffer-local variable save-place to determine whether to +;; value of buffer-local variable save-place-mode to determine whether to ;; save position or not. ;; ;; Thanks to Stefan Schoef, who sent a patch with the @@ -179,7 +179,7 @@ file: (defun save-place-to-alist () ;; put filename and point in a cons box and then cons that onto the - ;; front of the save-place-alist, if save-place is non-nil. + ;; front of the save-place-alist, if save-place-mode is non-nil. ;; Otherwise, just delete that file from the alist. ;; first check to make sure alist has been loaded in from the master ;; file. If not, do so, then feel free to modify the alist. It @@ -309,8 +309,8 @@ may have changed) back to `save-place-alist'." nil)))) (defun save-places-to-alist () - ;; go through buffer-list, saving places to alist if save-place is - ;; non-nil, deleting them from alist if it is nil. + ;; go through buffer-list, saving places to alist if save-place-mode + ;; is non-nil, deleting them from alist if it is nil. (let ((buf-list (buffer-list))) (while buf-list ;; put this into a save-excursion in case someone is counting on @@ -335,7 +335,7 @@ may have changed) back to `save-place-alist'." (and (integerp (cdr cell)) (goto-char (cdr cell)))) ;; and make sure it will be saved again for later - (setq save-place t))))) + (setq save-place-mode t))))) (declare-function dired-goto-file "dired" (file)) @@ -360,7 +360,7 @@ may have changed) back to `save-place-alist'." ((and (listp (cdr cell)) (assq 'dired-filename (cdr cell))) (dired-goto-file (cdr (assq 'dired-filename (cdr cell))))))) ;; and make sure it will be saved again for later - (setq save-place t))))) + (setq save-place-mode t))))) (defun save-place-kill-emacs-hook () ;; First update the alist. This loads the old save-place-file if nec. commit 3727bc7d599c24715a66de3e899a82b6f07d1aac Author: Paul Eggert Date: Fri Sep 21 23:08:52 2018 -0700 Fix (+ bignum float) bug * src/data.c (bignum_arith_driver): Fix typo: missing â€return’. * test/src/data-tests.el (data-tests-bignum): Test for the typo. diff --git a/src/data.c b/src/data.c index 1e97d9efa1..cc080372d8 100644 --- a/src/data.c +++ b/src/data.c @@ -2920,8 +2920,8 @@ bignum_arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args, val = args[argnum]; CHECK_NUMBER_COERCE_MARKER (val); if (FLOATP (val)) - float_arith_driver (code, nargs, args, argnum, - mpz_get_d (*accum), val); + return float_arith_driver (code, nargs, args, argnum, + mpz_get_d (*accum), val); } } diff --git a/test/src/data-tests.el b/test/src/data-tests.el index 701e579ae2..3cd4802a98 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -547,6 +547,16 @@ comparing the subr with a much slower lisp implementation." (should (<= b-1 b0)) (should (<= b-1 b-1)) + (should (= (+ f0 b0) (+ b0 f0))) + (should (= (+ f0 b-1) (+ b-1 f0))) + (should (= (+ f-1 b0) (+ b0 f-1))) + (should (= (+ f-1 b-1) (+ b-1 f-1))) + + (should (= (* f0 b0) (* b0 f0))) + (should (= (* f0 b-1) (* b-1 f0))) + (should (= (* f-1 b0) (* b0 f-1))) + (should (= (* f-1 b-1) (* b-1 f-1))) + (should (= b0 f0)) (should (= b0 b0)) commit 0bec064454adac2bdff04a11bbdfaa79aa4ce052 Author: Paul Eggert Date: Fri Sep 21 14:24:42 2018 -0700 Fix ambiguity in nil DST flag Formerly nil meant both that DST was not in effect and that the DST flag was unknown, and different functions interpreted the flag differently. Now the meaning is consistently nil for DST not in effect, and -1 for DST flag not known. * doc/lispref/os.texi (Time Conversion): The DST slot is now three-valued, not two-. * doc/misc/emacs-mime.texi (time-date): Adjust to new behavior. * etc/NEWS: Mention this. * lisp/calendar/parse-time.el (parse-time-string): * src/editfns.c (Fdecode_time): Return -1 for unknown DST flag. * test/lisp/calendar/parse-time-tests.el (parse-time-tests): Adjust tests to match new behavior, and add a new test for nil vs -1. diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 0b9dd1c9cc..43ca9ede00 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -1423,7 +1423,8 @@ The year, an integer typically greater than 1900. The day of week, as an integer between 0 and 6, where 0 stands for Sunday. @item dst -@code{t} if daylight saving time is effect, otherwise @code{nil}. +@code{t} if daylight saving time is effect, @code{nil} if it is not +in effect, and @minus{}1 if this information is not available. @item utcoff An integer indicating the Universal Time offset in seconds, i.e., the number of seconds east of Greenwich. diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi index b71cc3755b..45f37fb855 100644 --- a/doc/misc/emacs-mime.texi +++ b/doc/misc/emacs-mime.texi @@ -1535,7 +1535,7 @@ Here's a bunch of time/date/second/day examples: @example (parse-time-string "Sat Sep 12 12:21:54 1998 +0200") -@result{} (54 21 12 12 9 1998 6 nil 7200) +@result{} (54 21 12 12 9 1998 6 -1 7200) (date-to-time "Sat Sep 12 12:21:54 1998 +0200") @result{} (13818 19266) diff --git a/etc/NEWS b/etc/NEWS index 736955be0c..2158fdc10d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1060,6 +1060,14 @@ a multibyte string even if its second argument is an ASCII character. ** (format "%d" X) no longer mishandles a floating-point number X that does not fit in a machine integer. ++++ +** In the DST slot, encode-time and parse-time-string now return -1 +if it is not known whether daylight saving time is in effect. +Formerly they were inconsistent: encode-time returned t in this +situation, whereas parse-time-string returned nil. Now they +consistently use use nil to mean that DST is not in effect, and use -1 +to mean that it is not known whether DST is in effect. + ** New JSON parsing and serialization functions 'json-serialize', 'json-insert', 'json-parse-string', and 'json-parse-buffer'. These are implemented in C using the Jansson library. diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el index 2f9e557dab..d6c1e9ea16 100644 --- a/lisp/calendar/parse-time.el +++ b/lisp/calendar/parse-time.el @@ -29,8 +29,9 @@ ;; `parse-time-string' parses a time in a string and returns a list of 9 ;; values, just like `decode-time', where unspecified elements in the -;; string are returned as nil. `encode-time' may be applied on these -;; values to obtain an internal time value. +;; string are returned as nil (except unspecfied DST is returned as -1). +;; `encode-time' may be applied on these values to obtain an internal +;; time value. ;;; Code: @@ -151,8 +152,9 @@ STRING should be on something resembling an RFC2822 string, a la somewhat liberal in what format it accepts, and will attempt to return a \"likely\" value even for somewhat malformed strings. The values returned are identical to those of `decode-time', but -any values that are unknown are returned as nil." - (let ((time (list nil nil nil nil nil nil nil nil nil)) +any unknown values other than DST are returned as nil, and an +unknown DST value is returned as -1." + (let ((time (list nil nil nil nil nil nil nil -1 nil)) (temp (parse-time-tokenize (downcase string)))) (while temp (let ((parse-time-elt (pop temp)) diff --git a/src/editfns.c b/src/editfns.c index 8c7491beed..047a73f0b8 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -2165,7 +2165,8 @@ between 0 and 23. DAY is an integer between 1 and 31. MONTH is an integer between 1 and 12. YEAR is an integer indicating the four-digit year. DOW is the day of week, an integer between 0 and 6, where 0 is Sunday. DST is t if daylight saving time is in effect, -otherwise nil. UTCOFF is an integer indicating the UTC offset in +nil if it is not in effect, and -1 if this information is +not available. UTCOFF is an integer indicating the UTC offset in seconds, i.e., the number of seconds east of Greenwich. (Note that Common Lisp has different meanings for DOW and UTCOFF.) @@ -2194,7 +2195,8 @@ usage: (decode-time &optional TIME ZONE) */) make_fixnum (local_tm.tm_mon + 1), make_fixnum (local_tm.tm_year + tm_year_base), make_fixnum (local_tm.tm_wday), - local_tm.tm_isdst ? Qt : Qnil, + (local_tm.tm_isdst < 0 ? make_fixnum (-1) + : local_tm.tm_isdst == 0 ? Qnil : Qt), (HAVE_TM_GMTOFF ? make_fixnum (tm_gmtoff (&local_tm)) : gmtime_r (&time_spec, &gmt_tm) diff --git a/test/lisp/calendar/parse-time-tests.el b/test/lisp/calendar/parse-time-tests.el index 3a956a5662..9689997f79 100644 --- a/test/lisp/calendar/parse-time-tests.el +++ b/test/lisp/calendar/parse-time-tests.el @@ -28,21 +28,23 @@ (ert-deftest parse-time-tests () (should (equal (parse-time-string "Mon, 22 Feb 2016 19:35:42 +0100") - '(42 35 19 22 2 2016 1 nil 3600))) + '(42 35 19 22 2 2016 1 -1 3600))) (should (equal (parse-time-string "22 Feb 2016 19:35:42 +0100") - '(42 35 19 22 2 2016 nil nil 3600))) + '(42 35 19 22 2 2016 nil -1 3600))) (should (equal (parse-time-string "22 Feb 2016 +0100") - '(nil nil nil 22 2 2016 nil nil 3600))) + '(nil nil nil 22 2 2016 nil -1 3600))) (should (equal (parse-time-string "Mon, 22 Feb 16 19:35:42 +0100") - '(42 35 19 22 2 2016 1 nil 3600))) + '(42 35 19 22 2 2016 1 -1 3600))) (should (equal (parse-time-string "Mon, 22 February 2016 19:35:42 +0100") - '(42 35 19 22 2 2016 1 nil 3600))) + '(42 35 19 22 2 2016 1 -1 3600))) (should (equal (parse-time-string "Mon, 22 feb 2016 19:35:42 +0100") - '(42 35 19 22 2 2016 1 nil 3600))) + '(42 35 19 22 2 2016 1 -1 3600))) (should (equal (parse-time-string "Monday, 22 february 2016 19:35:42 +0100") - '(42 35 19 22 2 2016 1 nil 3600))) - (should (equal (parse-time-string "Monday, 22 february 2016 19:35:42 PDT") - '(42 35 19 22 2 2016 1 t -25200))) + '(42 35 19 22 2 2016 1 -1 3600))) + (should (equal (parse-time-string "Monday, 22 february 2016 19:35:42 PST") + '(42 35 19 22 2 2016 1 nil -28800))) + (should (equal (parse-time-string "Friday, 21 Sep 2018 13:47:58 PDT") + '(58 47 13 21 9 2018 5 t -25200))) (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54-0200") '(13818 33666))) (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54-0230") commit 167274d44f1ccaee65a5b68e15c3ed79a53447d1 Author: Philipp Stephani Date: Fri Sep 21 22:00:14 2018 +0200 Avoid an overflow error in emacs-module.c * src/emacs-module.c (Fmodule_load): Allow creating a bignum to avoid overflow error diff --git a/src/emacs-module.c b/src/emacs-module.c index 1ecba8603f..0dcd7f0cc5 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -747,11 +747,7 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0, maybe_quit (); if (r != 0) - { - if (FIXNUM_OVERFLOW_P (r)) - overflow_error (); - xsignal2 (Qmodule_init_failed, file, make_fixnum (r)); - } + xsignal2 (Qmodule_init_failed, file, INT_TO_INTEGER (r)); module_signal_or_throw (&env_priv); return unbind_to (count, Qt); commit ee3be3fdfa96d7d1a0740c8145a26d758c12a711 Author: Philipp Stephani Date: Fri Sep 21 21:56:25 2018 +0200 Use new function overflow_error in a few places * src/emacs-module.c (module_make_global_ref, module_funcall) (module_make_string, Fmodule_load): * src/json.c (json_to_lisp): Use overflow_error. diff --git a/src/emacs-module.c b/src/emacs-module.c index 6155535f86..1ecba8603f 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -304,7 +304,7 @@ module_make_global_ref (emacs_env *env, emacs_value ref) Lisp_Object value = HASH_VALUE (h, i); EMACS_INT refcount = XFIXNAT (value) + 1; if (MOST_POSITIVE_FIXNUM < refcount) - xsignal0 (Qoverflow_error); + overflow_error (); value = make_fixed_natnum (refcount); set_hash_value_slot (h, i, value); } @@ -475,7 +475,7 @@ module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs, USE_SAFE_ALLOCA; ptrdiff_t nargs1; if (INT_ADD_WRAPV (nargs, 1, &nargs1)) - xsignal0 (Qoverflow_error); + overflow_error (); SAFE_ALLOCA_LISP (newargs, nargs1); newargs[0] = value_to_lisp (fun); for (ptrdiff_t i = 0; i < nargs; i++) @@ -583,7 +583,7 @@ module_make_string (emacs_env *env, const char *str, ptrdiff_t length) { MODULE_FUNCTION_BEGIN (module_nil); if (! (0 <= length && length <= STRING_BYTES_BOUND)) - xsignal0 (Qoverflow_error); + overflow_error (); /* FIXME: AUTO_STRING_WITH_LEN requires STR to be null-terminated, but we shouldn't require that. */ AUTO_STRING_WITH_LEN (lstr, str, length); @@ -749,7 +749,7 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0, if (r != 0) { if (FIXNUM_OVERFLOW_P (r)) - xsignal0 (Qoverflow_error); + overflow_error (); xsignal2 (Qmodule_init_failed, file, make_fixnum (r)); } diff --git a/src/json.c b/src/json.c index 8b365e3795..17cc0965b1 100644 --- a/src/json.c +++ b/src/json.c @@ -740,7 +740,7 @@ json_to_lisp (json_t *json, struct json_configuration *conf) xsignal0 (Qjson_object_too_deep); size_t size = json_array_size (json); if (FIXNUM_OVERFLOW_P (size)) - xsignal0 (Qoverflow_error); + overflow_error (); Lisp_Object result = Fmake_vector (make_fixed_natnum (size), Qunbound); for (ptrdiff_t i = 0; i < size; ++i) ASET (result, i, @@ -759,7 +759,7 @@ json_to_lisp (json_t *json, struct json_configuration *conf) { size_t size = json_object_size (json); if (FIXNUM_OVERFLOW_P (size)) - xsignal0 (Qoverflow_error); + overflow_error (); result = CALLN (Fmake_hash_table, QCtest, Qequal, QCsize, make_fixed_natnum (size)); struct Lisp_Hash_Table *h = XHASH_TABLE (result); commit 9f10e1a0eef0dd5572a34a76617d50df0e3dd357 Author: Philipp Stephani Date: Fri Sep 21 21:50:56 2018 +0200 Support bignums when serializing JSON * src/json.c (lisp_to_json): Support bignums. * test/src/json-tests.el (json-serialize/bignum): New test. diff --git a/src/json.c b/src/json.c index 976783d785..8b365e3795 100644 --- a/src/json.c +++ b/src/json.c @@ -488,10 +488,14 @@ lisp_to_json (Lisp_Object lisp, struct json_configuration *conf) return json_check (json_false ()); else if (EQ (lisp, Qt)) return json_check (json_true ()); - else if (FIXNUMP (lisp)) + else if (INTEGERP (lisp)) { - CHECK_TYPE_RANGED_INTEGER (json_int_t, lisp); - return json_check (json_integer (XFIXNUM (lisp))); + intmax_t low = TYPE_MINIMUM (json_int_t); + intmax_t high = TYPE_MAXIMUM (json_int_t); + intmax_t value; + if (! integer_to_intmax (lisp, &value) || value < low || high < value) + args_out_of_range_3 (lisp, make_int (low), make_int (high)); + return json_check (json_integer (value)); } else if (FLOATP (lisp)) return json_check (json_real (XFLOAT_DATA (lisp))); diff --git a/test/src/json-tests.el b/test/src/json-tests.el index 8bd679b886..911bc49730 100644 --- a/test/src/json-tests.el +++ b/test/src/json-tests.el @@ -278,5 +278,13 @@ Test with both unibyte and multibyte strings." :type 'no-catch) (should (equal calls 1))))) +(ert-deftest json-serialize/bignum () + (skip-unless (fboundp 'json-serialize)) + (should (equal (json-serialize (vector (1+ most-positive-fixnum) + (1- most-negative-fixnum))) + (format "[%d,%d]" + (1+ most-positive-fixnum) + (1- most-negative-fixnum))))) + (provide 'json-tests) ;;; json-tests.el ends here commit 7f3877e83405a089b580fe9d0342dc0b6c08cbfc Author: Paul Eggert Date: Thu Sep 20 17:43:42 2018 -0700 Bindat examples in source, not manual * doc/lispref/processes.texi (Bindat Examples): Remove, fixing a FIXME in the manual. The long example had bitrotted to some extent, compared to the more-up-to-date example in bindat.el commentary, which apparently what people were referring to anyway. The short example was confusing and not that useful and will be obsolescent anyway if we change timestamp format. diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index 0a445a36bd..a615fcb4b7 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -1391,7 +1391,6 @@ Packing and Unpacking Byte Arrays * Bindat Spec:: Describing data layout. * Bindat Functions:: Doing the unpacking and packing. -* Bindat Examples:: Samples of what bindat.el can do for you! Emacs Display diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index f9ba703300..89ad1cf838 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -3126,7 +3126,6 @@ direction is also known as @dfn{serializing} or @dfn{packing}. @menu * Bindat Spec:: Describing data layout. * Bindat Functions:: Doing the unpacking and packing. -* Bindat Examples:: Samples of what bindat.el can do for you! @end menu @node Bindat Spec @@ -3369,132 +3368,3 @@ dotted notation. @result{} "127.0.0.1" @end example @end defun - -@node Bindat Examples -@subsection Examples of Byte Unpacking and Packing -@c FIXME? This seems a very long example for something that is not used -@c very often. As of 25.2, gdb-mi.el is the only user of bindat.el in Emacs. -@c Maybe one or both of these examples should just be moved to the -@c commentary of bindat.el. - - Here are two complete examples that use bindat.el. -The first shows simple byte packing: - -@lisp -(require 'bindat) - -(defun rfc868-payload () - (bindat-pack - '((now-hi u16) - (now-lo u16)) - ;; Emacs uses Unix epoch, while RFC868 epoch - ;; is 1900-01-01 00:00:00, which is 2208988800 - ;; (or #x83aa7e80) seconds more. - (let ((now (time-add nil '(#x83aa #x7e80)))) - `((now-hi . ,(car now)) - (now-lo . ,(cadr now)))))) - -(let ((s (rfc868-payload))) - (list (multibyte-string-p s) - (mapconcat (lambda (byte) - (format "%02x" byte)) - s " ") - (current-time-string))) - @result{} (nil "dc 6d 17 01" "Fri Mar 10 13:13:53 2017") -@end lisp - -The following is an example of defining and unpacking a complex -structure. Consider the following C structures: - -@example -struct header @{ - unsigned long dest_ip; - unsigned long src_ip; - unsigned short dest_port; - unsigned short src_port; -@}; - -struct data @{ - unsigned char type; - unsigned char opcode; - unsigned short length; /* in network byte order */ - unsigned char id[8]; /* null-terminated string */ - unsigned char data[/* (length + 3) & ~3 */]; -@}; - -struct packet @{ - struct header header; - unsigned long counters[2]; /* in little endian order */ - unsigned char items; - unsigned char filler[3]; - struct data item[/* items */]; - -@}; -@end example - -The corresponding data layout specification is: - -@lisp -(setq header-spec - '((dest-ip ip) - (src-ip ip) - (dest-port u16) - (src-port u16))) - -(setq data-spec - '((type u8) - (opcode u8) - (length u16) ; network byte order - (id strz 8) - (data vec (length)) - (align 4))) - -(setq packet-spec - '((header struct header-spec) - (counters vec 2 u32r) ; little endian order - (items u8) - (fill 3) - (item repeat (items) - (struct data-spec)))) -@end lisp - -A binary data representation is: - -@lisp -(setq binary-data - [ 192 168 1 100 192 168 1 101 01 28 21 32 - 160 134 1 0 5 1 0 0 2 0 0 0 - 2 3 0 5 ?A ?B ?C ?D ?E ?F 0 0 1 2 3 4 5 0 0 0 - 1 4 0 7 ?B ?C ?D ?E ?F ?G 0 0 6 7 8 9 10 11 12 0 ]) -@end lisp - -The corresponding decoded structure is: - -@lisp -(setq decoded (bindat-unpack packet-spec binary-data)) - @result{} -((header - (dest-ip . [192 168 1 100]) - (src-ip . [192 168 1 101]) - (dest-port . 284) - (src-port . 5408)) - (counters . [100000 261]) - (items . 2) - (item ((data . [1 2 3 4 5]) - (id . "ABCDEF") - (length . 5) - (opcode . 3) - (type . 2)) - ((data . [6 7 8 9 10 11 12]) - (id . "BCDEFG") - (length . 7) - (opcode . 4) - (type . 1)))) -@end lisp - -An example of fetching data from this structure: - -@lisp -(bindat-get-field decoded 'item 1 'id) - @result{} "BCDEFG" -@end lisp commit d6f3c2cf0628afaefe428140d8c6615e925044ad Author: Tino Calancha Date: Fri Sep 21 05:13:54 2018 +0900 Fix a previous commit Suggested by Stefan Monnier here: https://lists.gnu.org/archive/html/emacs-devel/2018-09/msg00783.html * lisp/replace.el (occur--parse-occur-buffer): Since point is at the beginning of the buffer, use `point'. (occur-revert-function): Prefer `pcase-let' and `point-min'. Check whether `region-start' or `region-end' are non-nil. diff --git a/lisp/replace.el b/lisp/replace.el index eb65c7a82d..00b2ceee35 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1213,29 +1213,25 @@ ORIG-LINE and BUFFER are the line and the buffer from which the user called `occur'." (save-excursion (goto-char (point-min)) - (let ((buffer (get-text-property (point-at-bol) 'occur-title)) - (beg-pos (get-text-property (point-at-bol) 'region-start)) - (end-pos (get-text-property (point-at-bol) 'region-end)) - (orig-line (get-text-property (point-at-bol) 'current-line)) - beg-line end-line) + (let ((buffer (get-text-property (point) 'occur-title)) + (beg-pos (get-text-property (point) 'region-start)) + (end-pos (get-text-property (point) 'region-end)) + (orig-line (get-text-property (point) 'current-line))) (list beg-pos end-pos orig-line buffer)))) (defun occur-revert-function (_ignore1 _ignore2) "Handle `revert-buffer' for Occur mode buffers." (if (cdr (nth 2 occur-revert-arguments)) ; multi-occur (apply 'occur-1 (append occur-revert-arguments (list (buffer-name)))) - (let* ((region (occur--parse-occur-buffer)) - (region-start (nth 0 region)) - (region-end (nth 1 region)) - (orig-line (nth 2 region)) - (buffer (nth 3 region)) - (regexp (car occur-revert-arguments))) + (pcase-let ((`(,region-start ,region-end ,orig-line ,buffer) + (occur--parse-occur-buffer)) + (regexp (car occur-revert-arguments))) (with-current-buffer buffer (when (wholenump orig-line) - (goto-char 1) + (goto-char (point-min)) (forward-line (1- orig-line))) (save-excursion - (if region + (if (or region-start region-end) (occur regexp nil (list (cons region-start region-end))) (apply 'occur-1 (append occur-revert-arguments (list (buffer-name)))))))))) commit 44c1ce3a370ed94199751d1429a65f40880b9234 Merge: 229c51afbf d28d54c767 Author: Glenn Morris Date: Thu Sep 20 07:50:34 2018 -0700 Merge from origin/emacs-26 d28d54c (origin/emacs-26) More accurate docs for 'text-char-description' b3baf99 Document synchronous behavior of eshell/make (Bug#32513) 98544ea Fix bs-show with wide characters (Bug#17822) 85af51b Improve Custom menu labels for 2 options 72a2a36 Improve wording of last change in dired-x.texi d4fa83b Fix GnuTLS test suite with GnuTLS versions 3.4.x b5bee6b Fix build with gnutls versions 3.0 to 3.2 (Bug#32446) 67eb80e ; * etc/enriched.txt (hanging-indents): Remove extra indent. c71cfb7 Fix the Bubbles game on TTY frames 3bbf21b Add choice to reshow certificate information (Bug#31877) 6f2c471 * src/alloc.c (Fbool_vector, Flist, Fvector): Doc tweak. 39eecb3 * src/alloc.c (vector): Fix grammatical error in doc string: ... commit 229c51afbf741b20504b821e6fd5da4145a776f5 Author: Bob Newell Date: Tue Sep 11 20:37:42 2018 -1000 New input methods hawaiian-postfix and hawaiian-prefix * lisp/leim/quail/latin-pre.el ("hawaiian-prefix"): * lisp/leim/quail/latin-post.el ("hawaiian-postfix"): New input methods. (Bug#32714) * etc/NEWS: Mention the new input methods. diff --git a/etc/NEWS b/etc/NEWS index cc517c37c3..736955be0c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -196,6 +196,9 @@ regular expression was previously invalid, but is now accepted: --- ** The German prefix and postfix input methods now support Capital sharp S. +--- +** New input methods hawaiian-postfix and hawaiian-prefix. + +++ ** New function 'exec-path'. This function by default returns the value of the corresponding diff --git a/lisp/leim/quail/latin-post.el b/lisp/leim/quail/latin-post.el index 791152bd65..8b0253f36e 100644 --- a/lisp/leim/quail/latin-post.el +++ b/lisp/leim/quail/latin-post.el @@ -739,6 +739,54 @@ Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\=' ("z~~" ["z~"]) ) +;;; Hawaiian postfix input method. It's a small subset of Latin-4 +;;; with the addition of an Ę»okina mapping. Hopefully the Ę»okina shows +;;; correctly on most displays. + +;;; This reference is an authoritative guide to Hawaiian orthography: +;;; http://www2.hawaii.edu/~strauch/tips/HawaiianOrthography.html + +;;; Initial coding 2018-09-08 Bob Newell, Honolulu, HawaiĘ»i +;;; Comments to bobnewell@bobnewell.net + +(quail-define-package + "hawaiian-postfix" "Hawaiian Postfix" "H<" t + "Hawaiian characters input method with postfix modifiers + + | postfix | examples + ------------+---------+---------- + Ę»okina | \\=` | \\=` -> Ę» + kahakĹŤ | - | a- -> Ä + +Doubling the postfix separates the letter and postfix. a-- -> a- +" nil t nil nil nil nil nil nil nil nil t) + +(quail-define-rules + ("A-" ?Ä€) + ("E-" ?Ä’) + ("I~" ?Ĩ) + ("O-" ?ĹŚ) + ("U-" ?ĹŞ) + ("a-" ?Ä) + ("e-" ?Ä“) + ("i-" ?Ä«) + ("o-" ?ĹŤ) + ("u-" ?Ĺ«) + ("`" ?Ę») + + ("A--" ["A-"]) + ("E--" ["E-"]) + ("I--" ["I-"]) + ("O--" ["O-"]) + ("U--" ["U-"]) + ("a--" ["a-"]) + ("e--" ["e-"]) + ("i--" ["i-"]) + ("o--" ["o-"]) + ("u--" ["u-"]) + ("``" ["`"]) + ) + (quail-define-package "latin-5-postfix" "Latin-5" "5<" t "Latin-5 characters input method with postfix modifiers diff --git a/lisp/leim/quail/latin-pre.el b/lisp/leim/quail/latin-pre.el index ca5af94ad2..9d343e79c3 100644 --- a/lisp/leim/quail/latin-pre.el +++ b/lisp/leim/quail/latin-pre.el @@ -1285,4 +1285,52 @@ of characters from a single Latin-N charset. ("~~" ?¸) ) +;;; Hawaiian prefix input method. It's a small subset of Latin-4 +;;; with the addition of an Ę»okina mapping. Hopefully the Ę»okina shows +;;; correctly on most displays. + +;;; This reference is an authoritative guide to Hawaiian orthography: +;;; http://www2.hawaii.edu/~strauch/tips/HawaiianOrthography.html + +;;; Initial coding 2018-09-08 Bob Newell, Honolulu, HawaiĘ»i +;;; Comments to bobnewell@bobnewell.net + +(quail-define-package + "hawaiian-prefix" "Hawaiian Prefix" "H>" t + "Hawaiian characters input method with postfix modifiers + + | prefix | examples + ------------+---------+---------- + Ę»okina | \\=` | \\=` -> Ę» + kahakĹŤ | - | -a -> Ä + +Doubling the prefix separates the letter and prefix. --a -> -a +" nil t nil nil nil nil nil nil nil nil t) + +(quail-define-rules + ("-A" ?Ä€) + ("-E" ?Ä’) + ("~I" ?Ĩ) + ("-O" ?ĹŚ) + ("-U" ?ĹŞ) + ("-a" ?Ä) + ("-e" ?Ä“) + ("-i" ?Ä«) + ("-o" ?ĹŤ) + ("-u" ?Ĺ«) + ("`" ?Ę») + + ("--A" ["-A"]) + ("--E" ["-E"]) + ("--I" ["-I"]) + ("--O" ["-O"]) + ("--U" ["-U"]) + ("--a" ["-a"]) + ("--e" ["-e"]) + ("--i" ["-i"]) + ("--o" ["-o"]) + ("--u" ["-u"]) + ("``" ["`"]) + ) + ;;; latin-pre.el ends here commit d28d54c76754759e5f0fc8254541fbb4ef6a21d8 Author: Eli Zaretskii Date: Thu Sep 20 09:41:55 2018 +0300 More accurate docs for 'text-char-description' * src/keymap.c (Ftext_char_description): * doc/lispref/help.texi (Describing Characters): More accurate description of 'text-char-description'. Remove incorrect examples from the ELisp manual. (Bug#32743) diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi index a23bc413d2..2688a2bff6 100644 --- a/doc/lispref/help.texi +++ b/doc/lispref/help.texi @@ -556,13 +556,15 @@ brackets. @defun text-char-description character This function returns a string describing @var{character} in the -standard Emacs notation for characters that can appear in text---like -@code{single-key-description}, except that the argument must be a -valid character code that passes a @code{characterp} test -(@pxref{Character Codes}), control characters are represented with a -leading caret (which is how control characters in Emacs buffers are -usually displayed), and the 2**7 bit is treated as the Meta bit, -whereas @code{single-key-description} uses the 2**27 bit for Meta. +standard Emacs notation for characters that can appear in +text---similar to @code{single-key-description}, except that the +argument must be a valid character code that passes a +@code{characterp} test (@pxref{Character Codes}). The function +produces descriptions of control characters with a leading caret +(which is how Emacs usually displays control characters in buffers). +Characters with modifier bits will cause this function to signal an +error (@acronym{ASCII} characters with the Control modifier are an +exception, they are represented as control characters). @smallexample @group @@ -571,19 +573,7 @@ whereas @code{single-key-description} uses the 2**27 bit for Meta. @end group @group (text-char-description ?\M-m) - @result{} "\xed" -@end group -@group -(text-char-description ?\C-\M-m) - @result{} "\x8d" -@end group -@group -(text-char-description (+ 128 ?m)) - @result{} "M-m" -@end group -@group -(text-char-description (+ 128 ?\C-m)) - @result{} "M-^M" + @error{} Wrong type argument: characterp, 134217837 @end group @end smallexample @end defun diff --git a/src/keymap.c b/src/keymap.c index ec483c7a63..fe0781a7f2 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -2286,7 +2286,8 @@ push_text_char_description (register unsigned int c, register char *p) DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0, doc: /* Return the description of CHARACTER in standard Emacs notation. CHARACTER must be a valid character code that passes the `characterp' test. -Control characters turn into "^char", the 2**7 bit is treated as Meta, etc. +Control characters turn into "^char", and characters with Meta and other +modifiers signal an error, as they are not valid characterr codes. This differs from `single-key-description' which accepts character events, and thus doesn't enforce the `characterp' condition, turns control characters into "C-char", and uses the 2**27 bit for Meta. commit b3baf997c8e9bbff351e0bf24b8fdae8831ec1df Author: Noam Postavsky Date: Wed Sep 19 18:57:37 2018 -0400 Document synchronous behavior of eshell/make (Bug#32513) * doc/misc/eshell.texi (Built-ins): * lisp/eshell/em-unix.el (eshell/make): Mention that it falls back to the external 'make' command when called synchronously. diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index 951a28f482..b0d5603e0c 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -346,8 +346,9 @@ Alias to Emacs's @code{locate} function, which simply runs the external @item make @cmindex make -Run @command{make} through @code{compile}. -@xref{Compilation, , , emacs, The GNU Emacs Manual}. +Run @command{make} through @code{compile} when run asynchronously +(e.g., @samp{make &}). @xref{Compilation, , , emacs, The GNU Emacs +Manual}. Otherwise call the external @command{make} command. @item occur @cmindex occur diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index b00b6654cc..b569f90993 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -656,7 +656,8 @@ Concatenate FILE(s), or standard input, to standard output.") ;; special front-end functions for compilation-mode buffers (defun eshell/make (&rest args) - "Use `compile' to do background makes." + "Use `compile' to do background makes. +Fallback to standard make when called synchronously." (if (and eshell-current-subjob-p (eshell-interactive-output-p)) (let ((compilation-process-setup-function commit 98544ea3ea1638228db48c5ff993caded470d9c1 Author: Shigeru Fukaya Date: Sat Jun 21 12:35:55 2014 +0900 Fix bs-show with wide characters (Bug#17822) * lisp/bs.el (bs--insert-one-entry, bs-show-in-buffer): Use string-width instead of length. diff --git a/lisp/bs.el b/lisp/bs.el index 0d65da14c7..32431ba446 100644 --- a/lisp/bs.el +++ b/lisp/bs.el @@ -1159,7 +1159,7 @@ and move point to current buffer." (bs-mode) (let* ((inhibit-read-only t) (map-fun (lambda (entry) - (length (buffer-name entry)))) + (string-width (buffer-name entry)))) (max-length-of-names (apply 'max (cons 0 (mapcar map-fun list)))) (name-entry-length (min bs-maximal-buffer-name-column @@ -1371,7 +1371,7 @@ normally *buffer-selection*." apply-args) (nth 3 column) ; align (- min to-much))) - (len (length new-string))) + (len (string-width new-string))) (setq string (concat string new-string)) (when (> len min) (setq to-much (- len min)))))) commit 85af51bab161473afed53517a81c2c3fb1f24b7c Author: Eli Zaretskii Date: Wed Sep 19 10:54:41 2018 +0300 Improve Custom menu labels for 2 options * lisp/dired.el (dired-use-ls-dired): * lisp/progmodes/xref.el (xref-prompt-for-identifier): Improve the doc string and the defcustom menu/tags text. (Bug#32756) diff --git a/lisp/dired.el b/lisp/dired.el index 2520ed2a10..579de723df 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -88,9 +88,11 @@ If nil, `dired-listing-switches' is used." (defcustom dired-use-ls-dired 'unspecified "Non-nil means Dired should pass the \"--dired\" option to \"ls\". -The special value of `unspecified' means to check explicitly, and -save the result in this variable. This is performed the first -time `dired-insert-directory' is called. +If nil, don't pass \"--dired\" to \"ls\". +The special value of `unspecified' means to check whether \"ls\" +supports the \"--dired\" option, and save the result in this +variable. This is performed the first time `dired-insert-directory' +is invoked. Note that if you set this option to nil, either through choice or because your \"ls\" program does not support \"--dired\", Dired @@ -104,9 +106,10 @@ This is used by default on MS Windows, which does not have an \"ls\" program. Note that `ls-lisp' does not support as many options as GNU ls, though. For more details, see Info node `(emacs)ls in Lisp'." :group 'dired - :type '(choice (const :tag "Check for --dired support" unspecified) + :type '(choice (const :tag + "Use --dired only if 'ls' supports it" unspecified) (const :tag "Do not use --dired" nil) - (other :tag "Use --dired" t))) + (other :tag "Always use --dired" t))) (defcustom dired-chmod-program "chmod" "Name of chmod command (usually `chmod')." diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index e563951793..abb2a93425 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -323,21 +323,23 @@ backward." (defcustom xref-prompt-for-identifier '(not xref-find-definitions xref-find-definitions-other-window xref-find-definitions-other-frame) - "When t, always prompt for the identifier name. + "If non-nil, prompt for the identifier to find. + +When t, always prompt for the identifier name. When nil, prompt only when there's no value at point we can use, or when the command has been called with the prefix argument. -Otherwise, it's a list of xref commands which will prompt -anyway (the value at point, if any, will be used as the default). - +Otherwise, it's a list of xref commands which will always prompt, +with the identifier at point, if any, used as the default. If the list starts with `not', the meaning of the rest of the -elements is negated." - :type '(choice (const :tag "always" t) - (const :tag "auto" nil) - (set :menu-tag "command specific" :tag "commands" +elements is negated: these commands will NOT prompt." + :type '(choice (const :tag "Always prompt for identifier" t) + (const :tag "Prompt if no identifier at point" nil) + (set :menu-tag "Prompt according to command" + :tag "Prompt according to command" :value (not) - (const :tag "Except" not) + (const :tag "Except for commands listed below" not) (repeat :inline t (symbol :tag "command"))))) (defcustom xref-after-jump-hook '(recenter commit 72a2a36654d5f73624986d8f92d7745d58c3d500 Author: Eli Zaretskii Date: Wed Sep 19 10:08:03 2018 +0300 Improve wording of last change in dired-x.texi * doc/misc/dired-x.texi (Shell Command Guessing): Clarify wording in description of 'dired-guess-shell-alist-user'. Avoid passive tense. (Bug#32733) diff --git a/doc/misc/dired-x.texi b/doc/misc/dired-x.texi index d7f3586675..60915e2996 100644 --- a/doc/misc/dired-x.texi +++ b/doc/misc/dired-x.texi @@ -593,7 +593,9 @@ where each @var{command} can either be a string or a Lisp expression that evaluates to a string. If several commands are given, all of them will temporarily be pushed onto the history. -A @samp{*} in the shell command is replaced by the file name. +A @samp{*} in the shell command stands for the file name that matched +@var{regexp}. When Emacs invokes the @var{command}, it replaces each +instance of @samp{*} with the matched file name. You can set this variable in your @file{~/.emacs}. For example, to add rules for @samp{.foo} and @samp{.bar} file extensions, write commit 75d9a55fae1c484aa6d213064931bfe3b65cf5dd Author: Tino Calancha Date: Tue Sep 18 21:29:59 2018 +0900 Fix bug 32543 Store the region and orig line into the *Occur* header line. Retrieve this information in `occur-revert-function'. * lisp/replace.el (occur--parse-occur-buffer): New defun. (occur-revert-function): Use it. (occur-engine): Store region and original position as text properties into the *Occur* header line. * lisp/replace.el (occur-engine): Add sensible default values for (occur--orig-line and nlines. diff --git a/lisp/replace.el b/lisp/replace.el index 20b868a765..eb65c7a82d 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1206,9 +1206,38 @@ To return to ordinary Occur mode, use \\[occur-cease-edit]." (move-to-column col))))))) +(defun occur--parse-occur-buffer() + "Retrieve a list of the form (BEG END ORIG-LINE BUFFER). +BEG and END define the region. +ORIG-LINE and BUFFER are the line and the buffer from which +the user called `occur'." + (save-excursion + (goto-char (point-min)) + (let ((buffer (get-text-property (point-at-bol) 'occur-title)) + (beg-pos (get-text-property (point-at-bol) 'region-start)) + (end-pos (get-text-property (point-at-bol) 'region-end)) + (orig-line (get-text-property (point-at-bol) 'current-line)) + beg-line end-line) + (list beg-pos end-pos orig-line buffer)))) + (defun occur-revert-function (_ignore1 _ignore2) "Handle `revert-buffer' for Occur mode buffers." - (apply 'occur-1 (append occur-revert-arguments (list (buffer-name))))) + (if (cdr (nth 2 occur-revert-arguments)) ; multi-occur + (apply 'occur-1 (append occur-revert-arguments (list (buffer-name)))) + (let* ((region (occur--parse-occur-buffer)) + (region-start (nth 0 region)) + (region-end (nth 1 region)) + (orig-line (nth 2 region)) + (buffer (nth 3 region)) + (regexp (car occur-revert-arguments))) + (with-current-buffer buffer + (when (wholenump orig-line) + (goto-char 1) + (forward-line (1- orig-line))) + (save-excursion + (if region + (occur regexp nil (list (cons region-start region-end))) + (apply 'occur-1 (append occur-revert-arguments (list (buffer-name)))))))))) (defun occur-mode-find-occurrence () (let ((pos (get-text-property (point) 'occur-target))) @@ -1651,7 +1680,7 @@ See also `multi-occur'." (matches 0) ;; count of matches (curr-line ;; line count (or occur--region-start-line 1)) - (orig-line occur--orig-line) + (orig-line (or occur--orig-line 1)) (orig-line-shown-p) (prev-line nil) ;; line number of prev match endpt (prev-after-lines nil) ;; context lines of prev match @@ -1701,6 +1730,8 @@ See also `multi-occur'." (setq matches (1+ matches))) (when (and list-matching-lines-jump-to-current-line (not multi-occur-p)) + (or orig-line (setq orig-line 1)) + (or nlines (setq nlines (line-number-at-pos (point-max)))) (when (= curr-line orig-line) (add-face-text-property 0 len list-matching-lines-current-line-face nil curstring) @@ -1859,7 +1890,9 @@ See also `multi-occur'." "")) 'read-only t)) (setq end (point)) - (add-text-properties beg end `(occur-title ,buf)) + (add-text-properties beg end `(occur-title ,buf current-line ,orig-line + region-start ,occur--region-start + region-end ,occur--region-end)) (when title-face (add-face-text-property beg end title-face)) (goto-char (if (and list-matching-lines-jump-to-current-line commit d4fa83baf5462cfcf61ebbb8c0a0ec584d11c39a Author: Eli Zaretskii Date: Tue Sep 18 13:24:29 2018 +0300 Fix GnuTLS test suite with GnuTLS versions 3.4.x * src/gnutls.c (gnutls_cipher_get_tag_size): Make it return zero only for versions of GnuTLS < 3.2.2, where gnutls_cipher_get_tag_size was introduced. This fixes the GnuTLS test suite, which assumes that any cipher whose tag size is non-zero is AEAD-capable, and doesn't test such ciphers if AEAD is not available, i.e. for GnuTLS < 3.5.1. (Bug#32446) diff --git a/src/gnutls.c b/src/gnutls.c index d0869ae901..9e105b948f 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -38,8 +38,8 @@ along with GNU Emacs. If not, see . */ So, require 3.5.1. */ #if GNUTLS_VERSION_NUMBER >= 0x030501 # define HAVE_GNUTLS_AEAD -#else -/* gnutls_cipher_get_tag_size was introduced in 3.2.0, but it's only +#elif GNUTLS_VERSION_NUMBER < 0x030202 +/* gnutls_cipher_get_tag_size was introduced in 3.2.2, but it's only relevant for AEAD ciphers. */ # define gnutls_cipher_get_tag_size(cipher) 0 #endif commit b5bee6bf489d8c54a5e39baed4d578ada54c99bf Author: Noam Postavsky Date: Sat Sep 15 10:25:11 2018 -0400 Fix build with gnutls versions 3.0 to 3.2 (Bug#32446) We previously used functions available only in 3.2+ for all 3.x versions. * src/gnutls.c [GNUTLS_VERSION_NUMBER < 0x030501]: Replace calls to gnutls_cipher_get_tag_size with 0. [GNUTLS_VERSION_NUMBER < 0x030200]: Alias gnutls_cipher_get_iv_size to gnutls_cipher_get_block_size, gnutls_digest_list to gnutls_mac_list, and gnutls_digest_get_name to gnutls_mac_get_name. [WINDOWSNT]: Adjust DLL function definitions and declarations accordingly. diff --git a/src/gnutls.c b/src/gnutls.c index 461260e27f..d0869ae901 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -38,6 +38,23 @@ along with GNU Emacs. If not, see . */ So, require 3.5.1. */ #if GNUTLS_VERSION_NUMBER >= 0x030501 # define HAVE_GNUTLS_AEAD +#else +/* gnutls_cipher_get_tag_size was introduced in 3.2.0, but it's only + relevant for AEAD ciphers. */ +# define gnutls_cipher_get_tag_size(cipher) 0 +#endif + +#if GNUTLS_VERSION_NUMBER < 0x030200 +/* gnutls_cipher_get_iv_size was introduced in 3.2.0. For the ciphers + available in previous versions, block size is equivalent. */ +#define gnutls_cipher_get_iv_size(cipher) gnutls_cipher_get_block_size (cipher) +#endif + +#if GNUTLS_VERSION_NUMBER < 0x030202 +/* gnutls_digest_list and gnutls_digest_get_name were added in 3.2.2. + For previous versions, the mac algorithms are equivalent. */ +# define gnutls_digest_list() ((const gnutls_digest_algorithm_t *) gnutls_mac_list ()) +# define gnutls_digest_get_name(id) gnutls_mac_get_name ((gnutls_mac_algorithm_t) id) #endif /* gnutls_mac_get_nonce_size was added in GnuTLS 3.2.0, but was @@ -205,13 +222,21 @@ DEF_DLL_FN (const gnutls_mac_algorithm_t *, gnutls_mac_list, (void)); DEF_DLL_FN (size_t, gnutls_mac_get_nonce_size, (gnutls_mac_algorithm_t)); # endif DEF_DLL_FN (size_t, gnutls_mac_get_key_size, (gnutls_mac_algorithm_t)); +# ifndef gnutls_digest_list DEF_DLL_FN (const gnutls_digest_algorithm_t *, gnutls_digest_list, (void)); +# endif +# ifndef gnutls_digest_get_name DEF_DLL_FN (const char *, gnutls_digest_get_name, (gnutls_digest_algorithm_t)); +# endif DEF_DLL_FN (gnutls_cipher_algorithm_t *, gnutls_cipher_list, (void)); +# ifndef gnutls_cipher_get_iv_size DEF_DLL_FN (int, gnutls_cipher_get_iv_size, (gnutls_cipher_algorithm_t)); +# endif DEF_DLL_FN (size_t, gnutls_cipher_get_key_size, (gnutls_cipher_algorithm_t)); DEF_DLL_FN (int, gnutls_cipher_get_block_size, (gnutls_cipher_algorithm_t)); +# ifndef gnutls_cipher_get_tag_size DEF_DLL_FN (int, gnutls_cipher_get_tag_size, (gnutls_cipher_algorithm_t)); +# endif DEF_DLL_FN (int, gnutls_cipher_init, (gnutls_cipher_hd_t *, gnutls_cipher_algorithm_t, const gnutls_datum_t *, const gnutls_datum_t *)); @@ -339,13 +364,21 @@ init_gnutls_functions (void) LOAD_DLL_FN (library, gnutls_mac_get_nonce_size); # endif LOAD_DLL_FN (library, gnutls_mac_get_key_size); +# ifndef gnutls_digest_list LOAD_DLL_FN (library, gnutls_digest_list); +# endif +# ifndef gnutls_digest_get_name LOAD_DLL_FN (library, gnutls_digest_get_name); +# endif LOAD_DLL_FN (library, gnutls_cipher_list); +# ifndef gnutls_cipher_get_iv_size LOAD_DLL_FN (library, gnutls_cipher_get_iv_size); +# endif LOAD_DLL_FN (library, gnutls_cipher_get_key_size); LOAD_DLL_FN (library, gnutls_cipher_get_block_size); +# ifndef gnutls_cipher_get_tag_size LOAD_DLL_FN (library, gnutls_cipher_get_tag_size); +# endif LOAD_DLL_FN (library, gnutls_cipher_init); LOAD_DLL_FN (library, gnutls_cipher_set_iv); LOAD_DLL_FN (library, gnutls_cipher_encrypt2); @@ -455,13 +488,21 @@ init_gnutls_functions (void) # define gnutls_mac_get_nonce_size fn_gnutls_mac_get_nonce_size # endif # define gnutls_mac_get_key_size fn_gnutls_mac_get_key_size -# define gnutls_digest_list fn_gnutls_digest_list -# define gnutls_digest_get_name fn_gnutls_digest_get_name +# ifndef gnutls_digest_list +# define gnutls_digest_list fn_gnutls_digest_list +# endif +# ifndef gnutls_digest_get_name +# define gnutls_digest_get_name fn_gnutls_digest_get_name +# endif # define gnutls_cipher_list fn_gnutls_cipher_list -# define gnutls_cipher_get_iv_size fn_gnutls_cipher_get_iv_size +# ifndef gnutls_cipher_get_iv_size +# define gnutls_cipher_get_iv_size fn_gnutls_cipher_get_iv_size +# endif # define gnutls_cipher_get_key_size fn_gnutls_cipher_get_key_size # define gnutls_cipher_get_block_size fn_gnutls_cipher_get_block_size -# define gnutls_cipher_get_tag_size fn_gnutls_cipher_get_tag_size +# ifndef gnutls_cipher_get_tag_size +# define gnutls_cipher_get_tag_size fn_gnutls_cipher_get_tag_size +# endif # define gnutls_cipher_init fn_gnutls_cipher_init # define gnutls_cipher_set_iv fn_gnutls_cipher_set_iv # define gnutls_cipher_encrypt2 fn_gnutls_cipher_encrypt2 commit 67eb80e0bf099e8075f31da3a3d22b5568786bfa Author: Eli Zaretskii Date: Mon Sep 17 22:46:22 2018 +0300 ; * etc/enriched.txt (hanging-indents): Remove extra indent. diff --git a/etc/enriched.txt b/etc/enriched.txt index 773fa619f2..251b133eb8 100644 --- a/etc/enriched.txt +++ b/etc/enriched.txt @@ -175,7 +175,7 @@ as possible. The text/enriched standard is defined in Internet RFC 1896 -(<). +(<). bluewhiteCUSTOMIZATION commit 458948189e56a110739ff9002236d269b8382293 Author: Stefan Monnier Date: Mon Sep 17 14:02:05 2018 -0400 * lisp/emacs-lisp/advice.el: Only use defmacro when needed (ad-get-advice-info): Mark it inlinable. (ad-get-advice-info-macro): Make it an obsolete alias. (ad-copy-advice-info, ad-is-advised, ad-get-advice-info-field) (ad-find-advice, ad-macrofy, ad-lambdafy, ad-lambda-p, ad-advice-p) (ad-compiled-p, ad-compiled-code, ad-get-cache-definition) (ad-get-cache-id, ad-set-cache): Turn macros into defsubsts. (ad-defadvice-flags): Make it into a plain list. (ad-set-advice-info-field): Apply a bit of CSE. diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index 6fb28c4c4d..04d2fbf444 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -1681,11 +1681,11 @@ On each iteration VAR will be bound to the name of an advised function (setq ,(car varform) (intern ,(car varform))) ,@body)) -(defun ad-get-advice-info (function) +(defsubst ad-get-advice-info (function) (get function 'ad-advice-info)) -(defmacro ad-get-advice-info-macro (function) - `(get ,function 'ad-advice-info)) +(define-obsolete-function-alias 'ad-get-advice-info-macro + #'ad-get-advice-info "27.1") (defsubst ad-set-advice-info (function advice-info) (cond @@ -1697,13 +1697,12 @@ On each iteration VAR will be bound to the name of an advised function #'ad--defalias-fset))) (put function 'ad-advice-info advice-info)) -(defmacro ad-copy-advice-info (function) - `(copy-tree (get ,function 'ad-advice-info))) +(defsubst ad-copy-advice-info (function) + (copy-tree (get function 'ad-advice-info))) -(defmacro ad-is-advised (function) +(defalias 'ad-is-advised #'ad-get-advice-info "Return non-nil if FUNCTION has any advice info associated with it. -This does not mean that the advice is also active." - `(ad-get-advice-info-macro ,function)) +This does not mean that the advice is also active.") (defun ad-initialize-advice-info (function) "Initialize the advice info for FUNCTION. @@ -1711,19 +1710,19 @@ Assumes that FUNCTION has not yet been advised." (ad-pushnew-advised-function function) (ad-set-advice-info function (list (cons 'active nil)))) -(defmacro ad-get-advice-info-field (function field) +(defsubst ad-get-advice-info-field (function field) "Retrieve the value of the advice info FIELD of FUNCTION." - `(cdr (assq ,field (ad-get-advice-info-macro ,function)))) + (cdr (assq field (ad-get-advice-info function)))) (defun ad-set-advice-info-field (function field value) "Destructively modify VALUE of the advice info FIELD of FUNCTION." - (and (ad-is-advised function) - (cond ((assq field (ad-get-advice-info-macro function)) - ;; A field with that name is already present: - (rplacd (assq field (ad-get-advice-info-macro function)) value)) - (t;; otherwise, create a new field with that name: - (nconc (ad-get-advice-info-macro function) - (list (cons field value))))))) + (let ((info (ad-get-advice-info function))) + (and info + (cond ((assq field info) + ;; A field with that name is already present: + (rplacd (assq field info) value)) + (t;; otherwise, create a new field with that name: + (nconc info (list (cons field value)))))))) ;; Don't make this a macro so we can use it as a predicate: (defun ad-is-active (function) @@ -1934,9 +1933,9 @@ be used to prompt for the function." ;; @@ Finding, enabling, adding and removing pieces of advice: ;; =========================================================== -(defmacro ad-find-advice (function class name) +(defsubst ad-find-advice (function class name) "Find the first advice of FUNCTION in CLASS with NAME." - `(assq ,name (ad-get-advice-info-field ,function ,class))) + (assq name (ad-get-advice-info-field function class))) (defun ad-advice-position (function class name) "Return position of first advice of FUNCTION in CLASS with NAME." @@ -2104,34 +2103,33 @@ the cache-id will clear the cache." ;; @@ Accessing and manipulating function definitions: ;; =================================================== -(defmacro ad-macrofy (definition) +(defsubst ad-macrofy (definition) "Take a lambda function DEFINITION and make a macro out of it." - `(cons 'macro ,definition)) + (cons 'macro definition)) -(defmacro ad-lambdafy (definition) - "Take a macro function DEFINITION and make a lambda out of it." - `(cdr ,definition)) +(defalias 'ad-lambdafy #'cdr + "Take a macro function DEFINITION and make a lambda out of it.") -(defmacro ad-lambda-p (definition) +(defsubst ad-lambda-p (definition) ;;"non-nil if DEFINITION is a lambda expression." - `(eq (car-safe ,definition) 'lambda)) + (eq (car-safe definition) 'lambda)) ;; see ad-make-advice for the format of advice definitions: -(defmacro ad-advice-p (definition) +(defsubst ad-advice-p (definition) ;;"non-nil if DEFINITION is a piece of advice." - `(eq (car-safe ,definition) 'advice)) + (eq (car-safe definition) 'advice)) -(defmacro ad-compiled-p (definition) +(defsubst ad-compiled-p (definition) "Return non-nil if DEFINITION is a compiled byte-code object." - `(or (byte-code-function-p ,definition) - (and (macrop ,definition) - (byte-code-function-p (ad-lambdafy ,definition))))) + (or (byte-code-function-p definition) + (and (macrop definition) + (byte-code-function-p (ad-lambdafy definition))))) -(defmacro ad-compiled-code (compiled-definition) +(defsubst ad-compiled-code (compiled-definition) "Return the byte-code object of a COMPILED-DEFINITION." - `(if (macrop ,compiled-definition) - (ad-lambdafy ,compiled-definition) - ,compiled-definition)) + (if (macrop compiled-definition) + (ad-lambdafy compiled-definition) + compiled-definition)) (defun ad-lambda-expression (definition) "Return the lambda expression of a function/macro/advice DEFINITION." @@ -2692,15 +2690,15 @@ should be modified. The assembled function will be returned." ;; the added efficiency. The validation itself is also pretty cheap, certainly ;; a lot cheaper than reconstructing an advised definition. -(defmacro ad-get-cache-definition (function) - `(car (ad-get-advice-info-field ,function 'cache))) +(defsubst ad-get-cache-definition (function) + (car (ad-get-advice-info-field function 'cache))) -(defmacro ad-get-cache-id (function) - `(cdr (ad-get-advice-info-field ,function 'cache))) +(defsubst ad-get-cache-id (function) + (cdr (ad-get-advice-info-field function 'cache))) -(defmacro ad-set-cache (function definition id) - `(ad-set-advice-info-field - ,function 'cache (cons ,definition ,id))) +(defsubst ad-set-cache (function definition id) + (ad-set-advice-info-field + function 'cache (cons definition id))) (defun ad-clear-cache (function) "Clears a previously cached advised definition of FUNCTION. @@ -3093,9 +3091,8 @@ deactivation, which might run hooks and get into other trouble." ;; Completion alist of valid `defadvice' flags -(defvar ad-defadvice-flags - '(("protect") ("disable") ("activate") - ("compile") ("preactivate"))) +(defconst ad-defadvice-flags + '("protect" "disable" "activate" "compile" "preactivate")) ;;;###autoload (defmacro defadvice (function args &rest body) @@ -3175,7 +3172,7 @@ usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) (let ((completion (try-completion (symbol-name flag) ad-defadvice-flags))) (cond ((eq completion t) flag) - ((assoc completion ad-defadvice-flags) + ((member completion ad-defadvice-flags) (intern completion)) (t (error "defadvice: Invalid or ambiguous flag: %s" flag)))))) @@ -3216,7 +3213,7 @@ usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) For any members of FUNCTIONS that are not currently advised the rebinding will be a noop. Any modifications done to the definitions of FUNCTIONS will be undone on exit of this macro." - (declare (indent 1)) + (declare (indent 1) (obsolete nil "27.1")) (let* ((index -1) ;; Make let-variables to store current definitions: (current-bindings commit 77c3c464a1603e2675347c88bb8cde26a6a3e2f8 Author: Stefan Monnier Date: Mon Sep 17 13:46:21 2018 -0400 * lisp/emacs-lisp/advice.el (ad-advised-functions): Make it a plain list (ad-read-advised-function, ad-do-advised-functions): Adjust accordingly. (ad-pushnew-advised-function, ad-pop-advised-function): Also make them into functions. diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index 49c2d5f4f9..6fb28c4c4d 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -1575,7 +1575,6 @@ ;; ============================== (require 'macroexp) -;; At run-time also, since ad-do-advised-functions returns code that uses it. (eval-when-compile (require 'cl-lib)) ;; @@ Variable definitions: @@ -1662,18 +1661,14 @@ generates a copy of TREE." ;; (this list is maintained as a completion table): (defvar ad-advised-functions nil) -(defmacro ad-pushnew-advised-function (function) +(defun ad-pushnew-advised-function (function) "Add FUNCTION to `ad-advised-functions' unless its already there." - `(if (not (assoc (symbol-name ,function) ad-advised-functions)) - (setq ad-advised-functions - (cons (list (symbol-name ,function)) - ad-advised-functions)))) + (add-to-list 'ad-advised-functions (symbol-name function))) -(defmacro ad-pop-advised-function (function) +(defun ad-pop-advised-function (function) "Remove FUNCTION from `ad-advised-functions'." - `(setq ad-advised-functions - (delq (assoc (symbol-name ,function) ad-advised-functions) - ad-advised-functions))) + (setq ad-advised-functions + (delete (symbol-name function) ad-advised-functions))) (defmacro ad-do-advised-functions (varform &rest body) "`dolist'-style iterator that maps over advised functions. @@ -1683,7 +1678,7 @@ On each iteration VAR will be bound to the name of an advised function \(a symbol)." (declare (indent 1)) `(dolist (,(car varform) ad-advised-functions) - (setq ,(car varform) (intern (car ,(car varform)))) + (setq ,(car varform) (intern ,(car varform))) ,@body)) (defun ad-get-advice-info (function) @@ -1849,7 +1844,7 @@ function at point for which PREDICATE returns non-nil)." (require 'help) (function-called-at-point)))) (and function - (assoc (symbol-name function) ad-advised-functions) + (member (symbol-name function) ad-advised-functions) (or (null predicate) (funcall predicate function)) function)) @@ -2813,7 +2808,7 @@ advised definition from scratch." ;; advised definition will be generated. (defun ad-preactivate-advice (function advice class position) - "Preactivate FUNCTION and returns the constructed cache." + "Preactivate FUNCTION and return the constructed cache." (let* ((advicefunname (ad-get-advice-info-field function 'advicefunname)) (old-advice (symbol-function advicefunname)) (old-advice-info (ad-copy-advice-info function)) commit c71cfb79c3e9cfcd1189be5ac9fa12333a995565 Author: Eli Zaretskii Date: Mon Sep 17 17:34:31 2018 +0300 Fix the Bubbles game on TTY frames * lisp/play/bubbles.el (bubbles--col-offset) (bubbles--row-offset): Doc fixes. (bubbles--compute-offsets): Conflate the GUI and TTY code into a single common version. Set the offsets to simple numbers, not to lists. (bubbles--initialize, bubbles--show-scores): Wrap offset values in a list, so that they are interpreted as pixel values, not as units of character width. This fixes the game on TTY frames. (Bug#32744) diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el index e30838dfca..ee2135b9bb 100644 --- a/lisp/play/bubbles.el +++ b/lisp/play/bubbles.el @@ -250,10 +250,10 @@ Available modes are `shift-default' and `shift-always'." "Indicate whether images have been created successfully.") (defvar bubbles--col-offset 0 - "Horizontal offset for centering the bubbles grid.") + "Horizontal offset for centering the bubbles grid, in pixels.") (defvar bubbles--row-offset 0 - "Vertical offset for centering the bubbles grid.") + "Vertical offset for centering the bubbles grid, in pixels.") (defvar bubbles--save-data nil "List containing bubbles save data (SCORE BUFFERCONTENTS).") @@ -960,33 +960,26 @@ columns on its right towards the left. (defun bubbles--compute-offsets () "Update horizontal and vertical offsets for centering the bubbles grid. Set `bubbles--col-offset' and `bubbles--row-offset'." - (cond ((and (display-images-p) - bubbles--images-ok - (not (eq bubbles-graphics-theme 'ascii)) - (fboundp 'window-inside-pixel-edges)) - ;; compute offset in units of pixels - (let ((bubbles--image-size - (car (image-size (car bubbles--images) t)))) - (setq bubbles--col-offset - (list - (max 0 (/ (- (nth 2 (window-inside-pixel-edges)) - (nth 0 (window-inside-pixel-edges)) - (* ( + bubbles--image-size 2) ;; margin - (bubbles--grid-width))) 2)))) - (setq bubbles--row-offset - (list - (max 0 (/ (- (nth 3 (window-inside-pixel-edges)) - (nth 1 (window-inside-pixel-edges)) - (* (+ bubbles--image-size 1) ;; margin - (bubbles--grid-height))) 2)))))) - (t - ;; compute offset in units of chars - (setq bubbles--col-offset - (max 0 (/ (- (window-width) - (bubbles--grid-width)) 2))) - (setq bubbles--row-offset - (max 0 (/ (- (window-height) - (bubbles--grid-height) 2) 2)))))) + (let* ((use-images-p (and (display-images-p) + bubbles--images-ok + (not (eq bubbles-graphics-theme 'ascii)))) + (bubbles--image-size + (if use-images-p (car (image-size (car bubbles--images) t)) 1)) + ;; In GUI mode, leave thin margins around the images. + (image-hor-size + (if use-images-p (+ bubbles--image-size 2) bubbles--image-size)) + (image-vert-size + (if use-images-p (1+ bubbles--image-size) bubbles--image-size))) + (setq bubbles--col-offset + (max 0 (/ (- (nth 2 (window-body-pixel-edges)) + (nth 0 (window-body-pixel-edges)) + (* image-hor-size (bubbles--grid-width))) + 2))) + (setq bubbles--row-offset + (max 0 (/ (- (nth 3 (window-body-pixel-edges)) + (nth 1 (window-body-pixel-edges)) + (* image-vert-size (bubbles--grid-height))) + 2))))) (defun bubbles--remove-overlays () "Remove all overlays." @@ -1007,7 +1000,8 @@ Set `bubbles--col-offset' and `bubbles--row-offset'." (insert " ") (put-text-property (point-min) (point) 'display - (cons 'space (list :height bubbles--row-offset))) + (cons 'space (list :height + (list bubbles--row-offset)))) (insert "\n") (let ((max-char (length (bubbles--colors)))) (dotimes (i (bubbles--grid-height)) @@ -1015,7 +1009,8 @@ Set `bubbles--col-offset' and `bubbles--row-offset'." (insert " ") (put-text-property p (point) 'display - (cons 'space (list :width bubbles--col-offset)))) + (cons 'space (list :width + (list bubbles--col-offset))))) (dotimes (j (bubbles--grid-width)) (let* ((index (random max-char)) (char (nth index bubbles-chars))) @@ -1025,7 +1020,8 @@ Set `bubbles--col-offset' and `bubbles--row-offset'." (insert "\n ") (put-text-property (1- (point)) (point) 'display - (cons 'space (list :width bubbles--col-offset)))) + (cons 'space (list :width + (list bubbles--col-offset))))) (put-text-property (point-min) (point-max) 'pointer 'arrow)) (bubbles-mode) (bubbles--reset-score) @@ -1177,7 +1173,7 @@ Use optional parameter POS instead of point if given." (insert " ") (put-text-property (1- (point)) (point) 'display - (cons 'space (list :width bubbles--col-offset))) + (cons 'space (list :width (list bubbles--col-offset)))) (insert (format "Score: %4d" bubbles--score)) (put-text-property pos (point) 'status t)))) @@ -1197,7 +1193,7 @@ Use optional parameter POS instead of point if given." (insert "\n ") (put-text-property (1- (point)) (point) 'display - (cons 'space (list :width bubbles--col-offset))) + (cons 'space (list :width (list bubbles--col-offset)))) (insert "Game Over!")) ;; save score (gamegrid-add-score (format "bubbles-%s-%d-%d-%d-scores" commit 295bacba61bd681798b55599551116db197b3388 Author: Paul Eggert Date: Sun Sep 16 21:24:04 2018 -0700 Move current_timespec decl to timespec.h This change was motivated by the desire to remove the weird dependency of lib-src/profile.o on src/systime.h. profile.c included systime.h only for current_timespec, and this inclusion required systime.h to have #ifdef emacs in multiple places and complicated further changes I have in mind. The current_timespec decl belongs in timespec.h anyway, and the main effect of this change is to move it there. * lib-src/profile.c (INLINE): Remove. Include timespec.h, not systime.h. * lib/gettime.c (gettime): Prefer clock_gettime to nanotime, and don’t worry about it failing on a CLOCK_REALTIME arg. POSIX requires it to succeed and I don’t know of any counterexamples where the fallbacks would work. (current_timespec): Move here from src/systime.h. Nowadays it seems to be better to not have this function be inline. * lib/timespec.h: Include arg-nonnull.h. (current_timespec): New declaration. (gettime, settime): Declare args to be nonnull. * lib/gettime.c, lib/timespec.h: Copy from Gnulib. * src/systime.h: Simplify by assuming â€emacs’ is defined, which it always is now. (current_timespec): Move to lib/timespec.h. diff --git a/lib-src/profile.c b/lib-src/profile.c index cccdfbc7c8..649eb04b37 100644 --- a/lib-src/profile.c +++ b/lib-src/profile.c @@ -30,14 +30,13 @@ along with GNU Emacs. If not, see . */ ** operations: reset_watch, get_time */ -#define INLINE EXTERN_INLINE #include #include #include #include -#include +#include #include static struct timespec TV1; diff --git a/lib/gettime.c b/lib/gettime.c index 9a4e342f18..171f22476f 100644 --- a/lib/gettime.c +++ b/lib/gettime.c @@ -28,21 +28,24 @@ void gettime (struct timespec *ts) { -#if HAVE_NANOTIME +#if defined CLOCK_REALTIME && HAVE_CLOCK_GETTIME + clock_gettime (CLOCK_REALTIME, ts); +#elif HAVE_NANOTIME nanotime (ts); #else + struct timeval tv; + gettimeofday (&tv, NULL); + ts->tv_sec = tv.tv_sec; + ts->tv_nsec = tv.tv_usec * 1000; +#endif +} -# if defined CLOCK_REALTIME && HAVE_CLOCK_GETTIME - if (clock_gettime (CLOCK_REALTIME, ts) == 0) - return; -# endif - - { - struct timeval tv; - gettimeofday (&tv, NULL); - ts->tv_sec = tv.tv_sec; - ts->tv_nsec = tv.tv_usec * 1000; - } +/* Return the current system time as a struct timespec. */ -#endif +struct timespec +current_timespec (void) +{ + struct timespec ts; + gettime (&ts); + return ts; } diff --git a/lib/timespec.h b/lib/timespec.h index c414cfe45e..cc49668f42 100644 --- a/lib/timespec.h +++ b/lib/timespec.h @@ -17,9 +17,9 @@ along with this program. If not, see . */ #if ! defined TIMESPEC_H -# define TIMESPEC_H +#define TIMESPEC_H -# include +#include #ifndef _GL_INLINE_HEADER_BEGIN #error "Please include config.h first." @@ -33,6 +33,7 @@ _GL_INLINE_HEADER_BEGIN extern "C" { #endif +#include "arg-nonnull.h" #include "verify.h" /* Inverse resolution of timespec timestamps (in units per second), @@ -122,8 +123,9 @@ timespectod (struct timespec a) return a.tv_sec + a.tv_nsec / 1e9; } -void gettime (struct timespec *); -int settime (struct timespec const *); +struct timespec current_timespec (void); +void gettime (struct timespec *) _GL_ARG_NONNULL ((1)); +int settime (struct timespec const *) _GL_ARG_NONNULL ((1)); #ifdef __cplusplus } diff --git a/src/systime.h b/src/systime.h index ede3d4eb12..ad5ab85730 100644 --- a/src/systime.h +++ b/src/systime.h @@ -23,12 +23,10 @@ along with GNU Emacs. If not, see . */ INLINE_HEADER_BEGIN -#ifdef emacs -# ifdef HAVE_X_WINDOWS -# include -# else +#ifdef HAVE_X_WINDOWS +# include +#else typedef unsigned long Time; -# endif #endif /* On some configurations (hpux8.0, X11R4), sys/time.h and X11/Xos.h @@ -66,15 +64,6 @@ timespec_valid_p (struct timespec t) return t.tv_nsec >= 0; } -/* Return current system time. */ -INLINE struct timespec -current_timespec (void) -{ - struct timespec r; - gettime (&r); - return r; -} - /* defined in sysdep.c */ extern int set_file_times (int, const char *, struct timespec, struct timespec); extern struct timeval make_timeval (struct timespec) ATTRIBUTE_CONST; @@ -82,10 +71,6 @@ extern struct timeval make_timeval (struct timespec) ATTRIBUTE_CONST; /* defined in keyboard.c */ extern void set_waiting_for_input (struct timespec *); -/* When lisp.h is not included Lisp_Object is not defined (this can - happen when this file is used outside the src directory). */ -#ifdef emacs - /* Emacs uses the integer list (HI LO US PS) to represent the time (HI << LO_TIME_BITS) + LO + US / 1e6 + PS / 1e12. */ enum { LO_TIME_BITS = 16 }; @@ -103,7 +88,6 @@ extern int decode_time_components (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, struct lisp_time *, double *); extern struct timespec lisp_to_timespec (struct lisp_time); extern struct timespec lisp_time_argument (Lisp_Object); -#endif INLINE_HEADER_END commit 75ab41d00d97c4de1ca343ce5273d1aad4975f37 Author: Stefan Monnier Date: Sun Sep 16 23:54:04 2018 -0400 * lisp/delsel.el (minibuffer-keyboard-quit): Remove old redundant code. The various minibuffer maps all inherit from minibuffer-local-map nowadays, so a single binding in it is all it takes. diff --git a/lisp/delsel.el b/lisp/delsel.el index a3c2934947..9582272d18 100644 --- a/lisp/delsel.el +++ b/lisp/delsel.el @@ -294,18 +294,10 @@ then it takes a second \\[keyboard-quit] to abort the minibuffer." (abort-recursive-edit))) (define-key minibuffer-local-map "\C-g" 'minibuffer-keyboard-quit) -(define-key minibuffer-local-ns-map "\C-g" 'minibuffer-keyboard-quit) -(define-key minibuffer-local-completion-map "\C-g" 'minibuffer-keyboard-quit) -(define-key minibuffer-local-must-match-map "\C-g" 'minibuffer-keyboard-quit) -(define-key minibuffer-local-isearch-map "\C-g" 'minibuffer-keyboard-quit) (defun delsel-unload-function () "Unload the Delete Selection library." (define-key minibuffer-local-map "\C-g" 'abort-recursive-edit) - (define-key minibuffer-local-ns-map "\C-g" 'abort-recursive-edit) - (define-key minibuffer-local-completion-map "\C-g" 'abort-recursive-edit) - (define-key minibuffer-local-must-match-map "\C-g" 'abort-recursive-edit) - (define-key minibuffer-local-isearch-map "\C-g" 'abort-recursive-edit) (dolist (sym '(self-insert-command insert-char quoted-insert yank clipboard-yank insert-register newline-and-indent reindent-then-newline-and-indent newline open-line)) commit 3bbf21b9139e203d7254a9434c88bd38238ed57e Author: Allen Li Date: Wed Aug 1 03:04:26 2018 -0700 Add choice to reshow certificate information (Bug#31877) In various situations, the window displaying the certificate information can be hidden (such as if the user accidentally presses ?, which causes the read-multiple-choice help window to replace it). Instead of leaving the user to make a choice blindly, add a choice to reshow the certification information. * lisp/net/nsm.el (nsm-query-user): Add reshow choice. diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el index d6fe967fc7..3f33e822d0 100644 --- a/lisp/net/nsm.el +++ b/lisp/net/nsm.el @@ -319,29 +319,34 @@ unencrypted." t)))) (defun nsm-query-user (message args cert) - (let ((buffer (get-buffer-create "*Network Security Manager*"))) - (save-window-excursion - ;; First format the certificate and warnings. - (with-help-window buffer - (with-current-buffer buffer - (erase-buffer) - (when (> (length cert) 0) - (insert cert "\n")) - (let ((start (point))) - (insert (apply #'format-message message args)) - (goto-char start) - ;; Fill the first line of the message, which usually - ;; contains lots of explanatory text. - (fill-region (point) (line-end-position))))) - ;; Then ask the user what to do about it. - (unwind-protect - (cadr - (read-multiple-choice - "Continue connecting?" - '((?a "always" "Accept this certificate this session and for all future sessions.") - (?s "session only" "Accept this certificate this session only.") - (?n "no" "Refuse to use this certificate, and close the connection.")))) - (kill-buffer buffer))))) + (catch 'return + (while t + (let ((buffer (get-buffer-create "*Network Security Manager*"))) + (save-window-excursion + ;; First format the certificate and warnings. + (with-help-window buffer + (with-current-buffer buffer + (erase-buffer) + (when (> (length cert) 0) + (insert cert "\n")) + (let ((start (point))) + (insert (apply #'format-message message args)) + (goto-char start) + ;; Fill the first line of the message, which usually + ;; contains lots of explanatory text. + (fill-region (point) (line-end-position))))) + ;; Then ask the user what to do about it. + (pcase (unwind-protect + (cadr + (read-multiple-choice + "Continue connecting?" + '((?a "always" "Accept this certificate this session and for all future sessions.") + (?s "session only" "Accept this certificate this session only.") + (?n "no" "Refuse to use this certificate, and close the connection.") + (?r "reshow" "Reshow certificate information.")))) + (kill-buffer buffer)) + ("reshow") + (val (throw 'return val)))))))) (defun nsm-save-host (host port status what permanency) (let* ((id (nsm-id host port)) commit 3a2ffa62a7e491fda1083cbedb165a3e49fd21c6 Author: Noam Postavsky Date: Sun Sep 16 19:39:06 2018 -0400 Clarify condition-case docstring * src/eval.c (Fcondition_case): Note that it handles non-error symbols too. diff --git a/src/eval.c b/src/eval.c index 500427cb62..5e25caaa84 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1238,8 +1238,10 @@ Each element of HANDLERS looks like (CONDITION-NAME BODY...) where the BODY is made of Lisp expressions. A handler is applicable to an error if CONDITION-NAME is one of the -error's condition names. A CONDITION-NAME of t applies to any error -symbol. If an error happens, the first applicable handler is run. +error's condition names. Handlers may also apply when non-error +symbols are signaled (e.g., `quit'). A CONDITION-NAME of t applies to +any symbol, including non-error symbols. If multiple handlers are +applicable, only the first one runs. The car of a handler may be a list of condition names instead of a single condition name; then it handles all of them. If the special commit bc4f4b6e0ccbc361f4fabbed5eb2e5a357107588 Author: Noam Postavsky Date: Sun Sep 16 20:12:33 2018 -0400 ; Add FIXME regarding previous change diff --git a/lisp/cedet/ede/pconf.el b/lisp/cedet/ede/pconf.el index 495903d7ef..cba7aaad8e 100644 --- a/lisp/cedet/ede/pconf.el +++ b/lisp/cedet/ede/pconf.el @@ -135,6 +135,8 @@ don't do it. A value of nil means to just do it.") (with-current-buffer "*compilation*" (goto-char (point-max)) + ;; FIXME: Use `compilation-finish-functions' or similar to + ;; avoid relying on exact format of `mode-line-process'. (when (not (string= (car mode-line-process) ":exit [0]")) (error "Configure failed!")) commit b2c1b03f6ba1fbf0514bd51dfbbc36d202d0c807 Author: Pierre Lorenzon Date: Wed Aug 29 05:28:32 2018 +0200 Update pconf for compile.el mode-line-process changes * lisp/cedet/ede/pconf.el (ede-proj-configure-synchronize): Check the first list element of mode-line-process (Bug#32564). Copyright-paperwork-exempt: yes diff --git a/lisp/cedet/ede/pconf.el b/lisp/cedet/ede/pconf.el index 9368420a74..495903d7ef 100644 --- a/lisp/cedet/ede/pconf.el +++ b/lisp/cedet/ede/pconf.el @@ -135,7 +135,7 @@ don't do it. A value of nil means to just do it.") (with-current-buffer "*compilation*" (goto-char (point-max)) - (when (not (string= mode-line-process ":exit [0]")) + (when (not (string= (car mode-line-process) ":exit [0]")) (error "Configure failed!")) ;; The Makefile is now recreated by configure? commit db64d4d082bb2578e5e9691f839dfb4e4c6306aa Author: Paul Eggert Date: Sun Sep 16 13:41:21 2018 -0700 * src/thread.h: Do not include systime.h; no longer needed. diff --git a/src/thread.h b/src/thread.h index 28d8d864fb..464506d263 100644 --- a/src/thread.h +++ b/src/thread.h @@ -30,7 +30,6 @@ along with GNU Emacs. If not, see . */ #endif #include "sysselect.h" /* FIXME */ -#include "systime.h" /* FIXME */ #include "systhread.h" struct thread_state commit 238c7cd730819ddba2dbde3c46ee36136575695b Author: Paul Eggert Date: Sun Sep 16 08:52:16 2018 -0700 Don’t assume obsolescent setitimer function * src/atimer.c (start_atimer, debug_timer_callback): Don’t assume support for setitimer merely because struct itimerspec works. POSIX no longer requires support for the obsolescent setitimer function. diff --git a/src/atimer.c b/src/atimer.c index 97f07362ae..505f6bcea1 100644 --- a/src/atimer.c +++ b/src/atimer.c @@ -113,10 +113,10 @@ start_atimer (enum atimer_type type, struct timespec timestamp, sigset_t oldset; /* Round TIMESTAMP up to the next full second if we don't have itimers. */ -#ifndef HAVE_SETITIMER +#if ! (defined HAVE_ITIMERSPEC || defined HAVE_SETITIMER) if (timestamp.tv_nsec != 0 && timestamp.tv_sec < TYPE_MAXIMUM (time_t)) timestamp = make_timespec (timestamp.tv_sec + 1, 0); -#endif /* not HAVE_SETITIMER */ +#endif /* Get an atimer structure from the free-list, or allocate a new one. */ @@ -494,15 +494,14 @@ debug_timer_callback (struct atimer *t) r->intime = 0; else if (result >= 0) { -#ifdef HAVE_SETITIMER + bool intime = true; +#if defined HAVE_ITIMERSPEC || defined HAVE_SETITIMER struct timespec delta = timespec_sub (now, r->expected); /* Too late if later than expected + 0.02s. FIXME: this should depend from system clock resolution. */ - if (timespec_cmp (delta, make_timespec (0, 20000000)) > 0) - r->intime = 0; - else -#endif /* HAVE_SETITIMER */ - r->intime = 1; + intime = timespec_cmp (delta, make_timespec (0, 20000000)) <= 0; +#endif + r->intime = intime; } } commit 7fac15f9945ed6def9b60942f3595c18f1740f31 Author: Paul Eggert Date: Sat Sep 15 23:17:15 2018 -0700 Simplify get_up_time on GNU/Linux * src/sysdep.c (get_up_time) [GNU_LINUX && HAVE_LONG_LONG_INT]: Omit unused locals. diff --git a/src/sysdep.c b/src/sysdep.c index ecbbbbc0ef..722d8138de 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -3111,13 +3111,12 @@ get_up_time (void) if (fup) { - unsigned long long upsec, upfrac, idlesec, idlefrac; - int upfrac_start, upfrac_end, idlefrac_start, idlefrac_end; + unsigned long long upsec, upfrac; + int upfrac_start, upfrac_end; - if (fscanf (fup, "%llu.%n%llu%n %llu.%n%llu%n", - &upsec, &upfrac_start, &upfrac, &upfrac_end, - &idlesec, &idlefrac_start, &idlefrac, &idlefrac_end) - == 4) + if (fscanf (fup, "%llu.%n%llu%n", + &upsec, &upfrac_start, &upfrac, &upfrac_end) + == 2) { if (TYPE_MAXIMUM (time_t) < upsec) { commit 6f2c471689ef57d992ee48bbcdeb8b90f0a1d78a Author: Glenn Morris Date: Sat Sep 15 15:33:32 2018 -0700 * src/alloc.c (Fbool_vector, Flist, Fvector): Doc tweak. Use a simpler, consistent form. diff --git a/src/alloc.c b/src/alloc.c index cdfd826b9a..738ed45df8 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2410,7 +2410,7 @@ LENGTH must be a number. INIT matters only in whether it is t or nil. */) DEFUN ("bool-vector", Fbool_vector, Sbool_vector, 0, MANY, 0, doc: /* Return a new bool-vector with specified arguments as elements. -Any number of arguments, even zero arguments, are allowed. +Allows any number of arguments, including zero. usage: (bool-vector &rest OBJECTS) */) (ptrdiff_t nargs, Lisp_Object *args) { @@ -2857,7 +2857,7 @@ listn (enum constype type, ptrdiff_t count, Lisp_Object arg, ...) DEFUN ("list", Flist, Slist, 0, MANY, 0, doc: /* Return a newly created list with specified arguments as elements. -Any number of arguments, even zero arguments, are allowed. +Allows any number of arguments, including zero. usage: (list &rest OBJECTS) */) (ptrdiff_t nargs, Lisp_Object *args) { @@ -3469,7 +3469,7 @@ See also the function `vector'. */) DEFUN ("vector", Fvector, Svector, 0, MANY, 0, doc: /* Return a newly created vector with specified arguments as elements. -Any number of arguments, even zero arguments, is allowed. +Allows any number of arguments, including zero. usage: (vector &rest OBJECTS) */) (ptrdiff_t nargs, Lisp_Object *args) { @@ -3885,7 +3885,7 @@ build_marker (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t bytepos) elements. If all the arguments are characters that can fit in a string of events, make a string; otherwise, make a vector. - Any number of arguments, even zero arguments, are allowed. */ + Allows any number of arguments, including zero. */ Lisp_Object make_event_array (ptrdiff_t nargs, Lisp_Object *args) commit d2048949bcd5735c17b4a194fc75d16ba25907ca Author: Paul Eggert Date: Sat Sep 15 15:00:54 2018 -0700 Go back to old method for nnmaildir names * lisp/gnus/nnmaildir.el (nnmaildir-request-accept-article): Omit leading 0s after "M" in file name. Problem reported by Glenn Morris in: https://lists.gnu.org/r/emacs-devel/2018-09/msg00660.html diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index 48a470c746..fbabf573c4 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -1463,7 +1463,7 @@ This variable is set by `nnmaildir-request-article'.") (unless (string-equal nnmaildir--delivery-time file) (setq nnmaildir--delivery-time file nnmaildir--delivery-count 0)) - (setq file (concat file (format-time-string "M%6N" time))) + (setq file (concat file "M" (number-to-string (caddr time)))) (setq file (concat file nnmaildir--delivery-pid) file (concat file "Q" (number-to-string nnmaildir--delivery-count)) file (concat file "." (nnmaildir--system-name)) commit 3937b5b52af3eb78101dc385ac8dfe7a36e2e624 Author: Paul Eggert Date: Sat Sep 15 14:10:49 2018 -0700 Fix icalendar tests to match new behavior * test/lisp/calendar/icalendar-tests.el (icalendar--create-uid): Do not intrude into or rely upon undocumented internal implementation details of icalendar--create-uid. Problem reported by Glenn Morris in: https://lists.gnu.org/r/emacs-devel/2018-09/msg00660.html diff --git a/test/lisp/calendar/icalendar-tests.el b/test/lisp/calendar/icalendar-tests.el index 2fecabcd75..617e886989 100644 --- a/test/lisp/calendar/icalendar-tests.el +++ b/test/lisp/calendar/icalendar-tests.el @@ -57,17 +57,16 @@ (ert-deftest icalendar--create-uid () "Test for `icalendar--create-uid'." - (let* ((icalendar-uid-format "xxx-%t-%c-%h-%u-%s") + (let* ((icalendar-uid-format "xxx-%c-%h-%u-%s") (icalendar--uid-count 77) (entry-full "30.06.1964 07:01 blahblah") (hash (format "%d" (abs (sxhash entry-full)))) (contents "DTSTART:19640630T070100\nblahblah") (username (or user-login-name "UNKNOWN_USER"))) - (cl-letf (((symbol-function 'current-time) (lambda () '(1 2 3)))) - (should (= 77 icalendar--uid-count)) - (should (string= (concat "xxx-123-77-" hash "-" username "-19640630") - (icalendar--create-uid entry-full contents))) - (should (= 78 icalendar--uid-count))) + (should (= 77 icalendar--uid-count)) + (should (string= (concat "xxx-77-" hash "-" username "-19640630") + (icalendar--create-uid entry-full contents))) + (should (= 78 icalendar--uid-count)) (setq contents "blahblah") (setq icalendar-uid-format "yyy%syyy") (should (string= (concat "yyyDTSTARTyyy") commit 39eecb382ba3a50db5a9ddce7f1ed7c7bbbc691c Author: Alan Mackenzie Date: Sat Sep 15 20:21:08 2018 +0000 * src/alloc.c (vector): Fix grammatical error in doc string: "are" -> "is". diff --git a/src/alloc.c b/src/alloc.c index 3654d30182..cdfd826b9a 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3469,7 +3469,7 @@ See also the function `vector'. */) DEFUN ("vector", Fvector, Svector, 0, MANY, 0, doc: /* Return a newly created vector with specified arguments as elements. -Any number of arguments, even zero arguments, are allowed. +Any number of arguments, even zero arguments, is allowed. usage: (vector &rest OBJECTS) */) (ptrdiff_t nargs, Lisp_Object *args) { commit a2d5cb5a6175de5ad338d7e3e59916b9a1af9f7c Author: Glenn Morris Date: Sat Sep 15 09:30:02 2018 -0700 ; * etc/NEWS: assoc-delete-all fix This is a mess. This function was added in master in afba4ccb8b8, undocumented. It was then tweaked and documented in 9824885fabe. Much later in cc233365a92 the original untweaked and undocumented version was backported to emacs-26. This was independently redocumented in emacs-26 in cc8f334d2da, which conflicted with the interface changes that had been made on master. diff --git a/etc/NEWS b/etc/NEWS index fa93112c91..cc517c37c3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -976,7 +976,7 @@ A buffer-local value of this hook is now run only if at least one window showing the buffer has changed its size. +++ -** New function assoc-delete-all. +** The function assoc-delete-all now takes an optional predicate argument. +++ ** New function 'string-distance' to calculate the Levenshtein distance commit 9e79d59790809387707852e6d1b691d1bfbf2327 Merge: ffbe561ee5 e133b63062 Author: Glenn Morris Date: Sat Sep 15 09:20:32 2018 -0700 Merge from origin/emacs-26 e133b63 (origin/emacs-26) Avoid adverse side effects of fixing bug#21824 cc8f334 Document changes called out in NEWS 20ecc52 ; * etc/NEWS: Document recent change in 'thing-at-point'. 1fc5283 ; INSTALL: Fix a typo in the last commit. 24f240d Tiny doc updates re yum/dnf etc 41c2d25 Remove unused variable 1e3b3fa Fix (thing-at-point 'list) regression (Bug#31772) 219893a Clarify meaning of '*' 41cdda2 * etc/PROBLEMS: Document Ubuntu 16.04 issue. 1c22f03 Increase default value for imenu-auto-rescan-maxout ee84389 Improve recent change to ELisp manual ff374e4 * doc/lispref/display.texi (SVG Images): Improve wording. 3a0caf6 * doc/lispref/display.texi (SVG Images): Fix a typo. (Bug#32... Conflicts: doc/lispref/lists.texi etc/NEWS commit ffbe561ee5acb0b9edc5f4c995c287fb2485c315 Author: Noam Postavsky Date: Sat Sep 15 09:44:30 2018 -0400 Don't call modification hooks unprepared Inhibit modification hooks when performing message coalescing because in that case, we aren't doing the necessary preparation for running modification hooks (i.e., we pass PREPARE=false for the insert_1_both and del_range_both calls). See also Bug#30823 and Bug#21824. * src/xdisp.c (message_dolog): Let-bind inhibit-modification-hooks to t around del_range_both calls. diff --git a/src/xdisp.c b/src/xdisp.c index 47286e25c8..93cd54a324 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -10417,6 +10417,13 @@ message_dolog (const char *m, ptrdiff_t nbytes, bool nlflag, bool multibyte) ptrdiff_t this_bol, this_bol_byte, prev_bol, prev_bol_byte; printmax_t dups; + /* Since we call del_range_both passing false for PREPARE, + we aren't prepared to run modification hooks (we could + end up calling modification hooks from another buffer and + only with AFTER=t, Bug#21824). */ + ptrdiff_t count = SPECPDL_INDEX (); + specbind (Qinhibit_modification_hooks, Qt); + insert_1_both ("\n", 1, 1, true, false, false); scan_newline (Z, Z_BYTE, BEG, BEG_BYTE, -2, false); @@ -10462,6 +10469,8 @@ message_dolog (const char *m, ptrdiff_t nbytes, bool nlflag, bool multibyte) -XFIXNAT (Vmessage_log_max) - 1, false); del_range_both (BEG, BEG_BYTE, PT, PT_BYTE, false); } + + unbind_to (count, Qnil); } BEGV = marker_position (oldbegv); BEGV_BYTE = marker_byte_position (oldbegv); commit f1ddaf7b65bb8edac41813b48f96a84c7fc2e263 Author: Wenjamin Petrenko Date: Sat Sep 8 17:27:56 2018 +0300 Make 'filesets-save-config' save filesets added by 'filesets-add-buffer' * lisp/filesets.el (filesets-set-config): Use 'customize-set-variable' so that filesets are saved by 'customize-save-customized' in 'filesets-save-config'. (Bug#20630) Copyright-paperwork-exempt: yes diff --git a/lisp/filesets.el b/lisp/filesets.el index 63f7c75b65..c1e6ef10d5 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -242,8 +242,7 @@ key is supported." (defun filesets-set-config (fileset var val) "Set-default wrapper function." (filesets-reset-fileset fileset) - (set-default var val)) -; (customize-set-variable var val)) + (customize-set-variable var val)) ; (filesets-build-menu)) ;; It seems this is a workaround for the XEmacs issue described in the commit e133b630625d6e5791c8b491c1cf3252cdb97080 Author: Eli Zaretskii Date: Sat Sep 15 12:21:12 2018 +0300 Avoid adverse side effects of fixing bug#21824 * test/src/buffer-tests.el (overlay-modification-hooks-deleted-overlay): New test. * src/buffer.c (report_overlay_modification): Don't bypass all the overlay-modification hooks; instead, invoke each function only if the buffer associated with the overlay is the current buffer. (Bug#30823) diff --git a/src/buffer.c b/src/buffer.c index b0cee71703..179360c562 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -4543,23 +4543,6 @@ report_overlay_modification (Lisp_Object start, Lisp_Object end, bool after, Lisp_Object *copy; ptrdiff_t i; - if (size) - { - Lisp_Object ovl - = XVECTOR (last_overlay_modification_hooks)->contents[1]; - - /* If the buffer of the first overlay in the array doesn't - match the current buffer, then these modification hooks - should not be run in this buffer. This could happen when - some code calls some insdel functions, such as del_range_1, - with the PREPARE argument false -- in that case this - function is never called to record the overlay modification - hook functions in the last_overlay_modification_hooks - array, so anything we find there is not ours. */ - if (XMARKER (OVERLAY_START (ovl))->buffer != current_buffer) - return; - } - USE_SAFE_ALLOCA; SAFE_ALLOCA_LISP (copy, size); memcpy (copy, XVECTOR (last_overlay_modification_hooks)->contents, @@ -4570,7 +4553,12 @@ report_overlay_modification (Lisp_Object start, Lisp_Object end, bool after, Lisp_Object prop_i, overlay_i; prop_i = copy[i++]; overlay_i = copy[i++]; - call_overlay_mod_hooks (prop_i, overlay_i, after, arg1, arg2, arg3); + /* It is possible that the recorded overlay has been deleted + (which makes it's markers' buffers be nil), or that (due to + some bug) it belongs to a different buffer. Only run this + hook if the overlay belongs to the current buffer. */ + if (XMARKER (OVERLAY_START (overlay_i))->buffer == current_buffer) + call_overlay_mod_hooks (prop_i, overlay_i, after, arg1, arg2, arg3); } SAFE_FREE (); diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el index f9c477fbfd..8479bbdda0 100644 --- a/test/src/buffer-tests.el +++ b/test/src/buffer-tests.el @@ -45,6 +45,25 @@ with parameters from the *Messages* buffer modification." (should (eq buf (current-buffer)))) (when msg-ov (delete-overlay msg-ov)))))) +(ert-deftest overlay-modification-hooks-deleted-overlay () + "Test for bug#30823." + (let ((check-point nil) + (ov-delete nil) + (ov-set nil)) + (with-temp-buffer + (insert "abc") + (setq ov-set (make-overlay 1 3)) + (overlay-put ov-set 'modification-hooks + (list (lambda (_o after &rest _args) + (and after (setq check-point t))))) + (setq ov-delete (make-overlay 1 3)) + (overlay-put ov-delete 'modification-hooks + (list (lambda (o after &rest _args) + (and (not after) (delete-overlay o))))) + (goto-char 2) + (insert "1") + (should (eq check-point t))))) + (ert-deftest test-generate-new-buffer-name-bug27966 () (should-not (string-equal "nil" (progn (get-buffer-create "nil") commit cc8f334d2da736be8935f5abae51f7b1f992b343 Author: Eli Zaretskii Date: Sat Sep 15 11:51:34 2018 +0300 Document changes called out in NEWS * doc/lispref/lists.texi (Association Lists): Document 'assoc-delete-all'. * doc/lispref/minibuf.texi (Minibuffers): Adapt menu. (Multiple Queries): Document 'read-answer'. * etc/NEWS: Reflect the above documentation in the respective entries. diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index e05633a881..ce62793550 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -1736,6 +1736,13 @@ alist @end example @end defun +@defun assoc-delete-all key alist +This function deletes from @var{alist} all the elements whose @sc{car} +is @code{equal} to @var{key}. It works like @code{assq-delete-all}, +except for the predicate used for comparing alist elements with +@var{key}. +@end defun + @defun rassq-delete-all value alist This function deletes from @var{alist} all the elements whose @sc{cdr} is @code{eq} to @var{value}. It returns the shortened alist, and diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 8fac1c3e76..2951ef5aae 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -26,7 +26,7 @@ argument. * Initial Input:: Specifying initial contents for the minibuffer. * Completion:: How to invoke and customize completion. * Yes-or-No Queries:: Asking a question with a simple answer. -* Multiple Queries:: Asking a series of similar questions. +* Multiple Queries:: Asking complex questions. * Reading a Password:: Reading a password from the terminal. * Minibuffer Commands:: Commands used as key bindings in minibuffers. * Minibuffer Windows:: Operating on the special minibuffer windows. @@ -2084,9 +2084,12 @@ Do you really want to remove everything? (yes or no) @end defun @node Multiple Queries -@section Asking Multiple Y-or-N Questions -@cindex multiple yes-or-no questions +@section Asking Multiple-Choice Questions + + This section describes facilities for asking the user more complex +questions or several similar questions. +@cindex multiple yes-or-no questions When you have a series of similar questions to ask, such as ``Do you want to save this buffer?'' for each buffer in turn, you should use @code{map-y-or-n-p} to ask the collection of questions, rather than @@ -2180,6 +2183,52 @@ The return value of @code{map-y-or-n-p} is the number of objects acted on. @c FIXME An example of this would be more useful than all the @c preceding examples of simple things. +If you need to ask the user a question that might have more than just +2 answers, use @code{read-answer}. + +@defun read-answer question answers +@vindex read-answer-short +This function prompts the user with text in @var{question}, which +should end in the @samp{SPC} character. The function includes in the +prompt the possible responses in @var{answers} by appending them to +the end of @var{question}. The possible responses are provided in +@var{answers} as an alist whose elements are of the following form: + +@lisp +(@var{long-answer} @var{short-answer} @var{help-message}) +@end lisp + +@noindent +where @var{long-answer} is the complete text of the user response, a +string; @var{short-answer} is a short form of the same response, a +single character; and @var{help-message} is the text that describes +the meaning of the answer. If the variable @code{read-answer-short} +is non-@code{nil}, the prompt will show the short variants of the +possible answers and the user is expected to type the single +characters shown in the prompt; otherwise the prompt will show the +long variants of the answers, and the user is expected to type the +full text of one of the answers and end by pressing @key{RET}. If +@code{use-dialog-box} is non-@code{nil}, and this function was invoked +by mouse events, the question and the answers will be displayed in a +GUI dialog box. + +The function returns the text of the @var{long-answer} selected by the +user, regardless of whether long or short answers were shown in the +prompt and typed by the user. + +Here is an example of using this function: + +@lisp +(let ((read-answer-short t)) + (read-answer "Foo " + '(("yes" ?y "perform the action") + ("no" ?n "skip to the next") + ("all" ?! "perform for the rest without more questions") + ("help" ?h "show help") + ("quit" ?q "exit")))) +@end lisp +@end defun + @node Reading a Password @section Reading a Password @cindex passwords, reading diff --git a/etc/NEWS b/etc/NEWS index 3a949a9805..578b9b8d95 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -78,6 +78,7 @@ in its NEWS.) ** VC +--- *** VC support for Mercurial was improved. Emacs now avoids invoking 'hg' as much as possible, for faster operation. (This and the following changes were actually made in Emacs 26.1, but @@ -125,9 +126,11 @@ obsolete it. * Lisp Changes in Emacs 26.2 ++++ ** The new function 'read-answer' accepts either long or short answers depending on the new customizable variable 'read-answer-short'. ++++ ** New function 'assoc-delete-all'. Like 'assq-delete-all', but uses 'equal' for comparison. commit 20ecc5266e1ffb1cff3e31475631b5c76b99e997 Author: Eli Zaretskii Date: Sat Sep 15 11:07:16 2018 +0300 ; * etc/NEWS: Document recent change in 'thing-at-point'. diff --git a/etc/NEWS b/etc/NEWS index a54ac2db43..3a949a9805 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -131,6 +131,17 @@ depending on the new customizable variable 'read-answer-short'. ** New function 'assoc-delete-all'. Like 'assq-delete-all', but uses 'equal' for comparison. +--- +** The function 'thing-at-point' behaves as before Emacs 26.1. +The behavior of 'thing-at-point' when called with argument 'list' has +changed in Emacs 26.1, in that it didn't consider text inside comments +and strings as a potential list. This change is now reverted, and +'thing-at-point' behaves like it did before Emacs 26.1. + +To cater to use cases where comments and strings are to be ignored +when looking for a list, the function 'list-at-point' now takes an +optional argument to do so. + * Changes in Emacs 26.2 on Non-Free Operating Systems commit 1fc52830508c35ada75c3ac3687ae5a0ef6b2816 Author: Eli Zaretskii Date: Sat Sep 15 10:52:55 2018 +0300 ; INSTALL: Fix a typo in the last commit. diff --git a/INSTALL b/INSTALL index dcf7b6d780..0c56fff6d4 100644 --- a/INSTALL +++ b/INSTALL @@ -204,7 +204,7 @@ configure Emacs with. On Debian-based systems, you can install all the packages needed to build the installed version of Emacs with a command like 'apt-get build-dep emacs' (on older systems, replace 'emacs' with eg 'emacs25'). On Red Hat-based systems, the corresponding command is -'dnf builddep emacs' (or older systems, use 'yum-builddep' instead). +'dnf builddep emacs' (on older systems, use 'yum-builddep' instead). DETAILED BUILDING AND INSTALLATION: commit 24f240d51e0da1d36950907a753273ecd8ea2075 Author: Glenn Morris Date: Fri Sep 14 08:54:28 2018 -0700 Tiny doc updates re yum/dnf etc * INSTALL: Mention dnf and Debian unversioned emacs package. * doc/misc/efaq.texi (Installing Emacs): Mention dnf. diff --git a/INSTALL b/INSTALL index ab2e800e67..dcf7b6d780 100644 --- a/INSTALL +++ b/INSTALL @@ -202,8 +202,9 @@ The names of the packages that you need varies according to the GNU/Linux distribution that you use, and the options that you want to configure Emacs with. On Debian-based systems, you can install all the packages needed to build the installed version of Emacs with a command -like 'apt-get build-dep emacs24'. On Red Hat systems, the -corresponding command is 'yum-builddep emacs'. +like 'apt-get build-dep emacs' (on older systems, replace 'emacs' with +eg 'emacs25'). On Red Hat-based systems, the corresponding command is +'dnf builddep emacs' (or older systems, use 'yum-builddep' instead). DETAILED BUILDING AND INSTALLATION: diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index 69a1a6d465..8bdd40c71c 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -3362,8 +3362,9 @@ and binaries, and how to install Emacs on those systems. Most GNU/Linux distributions provide pre-built Emacs packages. If Emacs is not installed already, you can install it by running (as -root) a command such as @samp{yum install emacs} (Red Hat and -derivatives) or @samp{apt-get install emacs} (Debian and derivatives). +root) a command such as @samp{dnf install emacs} (Red Hat and +derivatives; use @samp{yum} in older distributions) or +@samp{apt-get install emacs} (Debian and derivatives). If you want to compile Emacs yourself, read the file @file{INSTALL} in the source distribution. In brief: commit 4ee34ee82d2e1b944165bee7bf31076f1db594ef Author: Stefan Monnier Date: Fri Sep 14 11:52:15 2018 -0400 * lisp/progmodes/idlw-shell.el: Use lexical-binding (idlwave-shell-source-frame): Remove unused var 'frame'. (idlwave-shell): Remove unused arg 'quick'. (idlwave-shell-complete-filename, idlwave-shell-edit-default-command-line) (idlwave-shell-retall, idlwave-shell-closeall): Remove unused arg 'arg'. (idlwave-shell-move-to-bp): Remove unused var 'got-bp'. (zmacs-regions): Declare. (idlwave-shell-update-bp-overlays): Remove unused var 'win'. (idlwave-shell-delete-expression-overlay) (idlwave-shell-mouse-nop): Delete function. Use 'ignore' instead. (idlwave-shell-delete-output-overlay): Ignore 'ignore' commands rather than idlwave-shell-mouse-nop commands. (idlwave-shell-mode-map, idlwave-shell-electric-debug-mode-map): Move (part of) the initialization into the declaration. (idlwave-shell-electric-debug-mode-on-hook) (idlwave-shell-electric-debug-mode-off-hook): Keep them empty, move code into the minor mode's definition instead. (idlwave-shell-electric-debug-mode): Don't use advice needlessly. diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index 616341b0a2..46e2ecaa39 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -1,4 +1,4 @@ -;; idlw-shell.el --- run IDL as an inferior process of Emacs. +;; idlw-shell.el --- run IDL as an inferior process of Emacs. -*- lexical-binding:t -*- ;; Copyright (C) 1999-2018 Free Software Foundation, Inc. @@ -1115,8 +1115,7 @@ IDL has currently stepped.") (setq idlwave-shell-display-wframe (if (eq (selected-frame) idlwave-shell-idl-wframe) (or - (let ((flist (visible-frame-list)) - (frame (selected-frame))) + (let ((flist (visible-frame-list))) (catch 'exit (while flist (if (not (eq (car flist) @@ -1142,7 +1141,7 @@ IDL has currently stepped.") (make-frame idlwave-shell-frame-parameters))))) ;;;###autoload -(defun idlwave-shell (&optional arg quick) +(defun idlwave-shell (&optional arg) "Run an inferior IDL, with I/O through buffer `(idlwave-shell-buffer)'. If buffer exists but shell process is not running, start new IDL. If buffer exists and shell process is running, just switch to the buffer. @@ -1881,10 +1880,10 @@ directory." 'idlwave-shell-filter-directory 'hide 'wait)) -(defun idlwave-shell-retall (&optional arg) +(defun idlwave-shell-retall () "Return from the entire calling stack. Also get rid of widget events in the queue." - (interactive "P") + (interactive) (save-selected-window ;;if (widget_info(/MANAGED))[0] gt 0 then for i=0,n_elements(widget_info(/MANAGED))-1 do widget_control,(widget_info(/MANAGED))[i],/clear_events & (idlwave-shell-send-command "retall" nil @@ -1892,9 +1891,9 @@ Also get rid of widget events in the queue." nil t) (idlwave-shell-display-line nil))) -(defun idlwave-shell-closeall (&optional arg) +(defun idlwave-shell-closeall () "Close all open files." - (interactive "P") + (interactive) (idlwave-shell-send-command "close,/all" nil (idlwave-shell-hide-p 'misc) nil t)) @@ -2157,7 +2156,7 @@ keywords." (if entry (setq idlw-help-link (cdr entry)))) ; setting dynamic variable! (t (error "This should not happen"))))) -(defun idlwave-shell-complete-filename (&optional arg) +(defun idlwave-shell-complete-filename () "Complete a file name at point if after a file name. We assume that we are after a file name when completing one of the args of an executive .run, .rnew or .compile." @@ -2739,10 +2738,9 @@ Runs to the last statement and then steps 1 statement. Use the .out command." (bp-alist idlwave-shell-bp-alist) (orig-func (if (> dir 0) '> '<)) (closer-func (if (> dir 0) '< '>)) - bp got-bp bp-line cur-line) + bp bp-line cur-line) (while (setq bp (pop bp-alist)) (when (string= file (car (car bp))) - (setq got-bp 1) (setq cur-line (nth 1 (car bp))) (if (and (funcall orig-func cur-line orig-bp-line) @@ -2759,6 +2757,8 @@ Runs to the last statement and then steps 1 statement. Use the .out command." (interactive "P") (idlwave-shell-print arg 'help)) +(defvar zmacs-regions) + (defmacro idlwave-shell-mouse-examine (help &optional ev) "Create a function for generic examination of expressions." `(lambda (event) @@ -2782,7 +2782,7 @@ Runs to the last statement and then steps 1 statement. Use the .out command." ;; Begin terrible hack section -- XEmacs tests for button2 explicitly ;; on drag events, calling drag-n-drop code if detected. Ughhh... -(defun idlwave-default-mouse-track-event-is-with-button (event n) +(defun idlwave-default-mouse-track-event-is-with-button (_event _n) t) (defun idlwave-xemacs-hack-mouse-track (event) @@ -3193,22 +3193,20 @@ size(___,/DIMENSIONS)" output-begin output-end buffer)))) (defun idlwave-shell-delete-output-overlay () - (unless (or (eq this-command 'idlwave-shell-mouse-nop) - (eq this-command 'handle-switch-frame)) + (unless (memql this-command '(ignore handle-switch-frame)) (condition-case nil (if idlwave-shell-output-overlay (delete-overlay idlwave-shell-output-overlay)) (error nil)) - (remove-hook 'pre-command-hook 'idlwave-shell-delete-output-overlay))) + (remove-hook 'pre-command-hook #'idlwave-shell-delete-output-overlay))) (defun idlwave-shell-delete-expression-overlay () - (unless (or (eq this-command 'idlwave-shell-mouse-nop) - (eq this-command 'handle-switch-frame)) + (unless (memql this-command '(ignore handle-switch-frame)) (condition-case nil (if idlwave-shell-expression-overlay (delete-overlay idlwave-shell-expression-overlay)) (error nil)) - (remove-hook 'pre-command-hook 'idlwave-shell-delete-expression-overlay))) + (remove-hook 'pre-command-hook #'idlwave-shell-delete-expression-overlay))) (defvar idlwave-shell-bp-alist nil "Alist of breakpoints. @@ -3591,7 +3589,7 @@ Existing overlays are recycled, in order to minimize consumption." (bp-list idlwave-shell-bp-alist) (use-glyph (and (memq idlwave-shell-mark-breakpoints '(t glyph)) idlwave-shell-bp-glyph)) - ov ov-list bp buf old-buffers win) + ov ov-list bp buf old-buffers) ;; Delete the old overlays from their buffers (if ov-alist @@ -3798,9 +3796,9 @@ only for glyphs)." (t (message "Unimplemented: %s" select)))))) -(defun idlwave-shell-edit-default-command-line (arg) +(defun idlwave-shell-edit-default-command-line () "Edit the current execute command." - (interactive "P") + (interactive) (setq idlwave-shell-command-line-to-execute (read-string "IDL> " idlwave-shell-command-line-to-execute))) @@ -4057,9 +4055,56 @@ Otherwise, just expand the file name." ;; Keybindings ------------------------------------------------------------ -(defvar idlwave-shell-mode-map (copy-keymap comint-mode-map) +(defvar idlwave-shell-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map comint-mode-map) + + ;;(define-key map "\M-?" 'comint-dynamic-list-completions) + ;;(define-key map "\t" 'comint-dynamic-complete) + + (define-key map "\C-w" 'comint-kill-region) + (define-key map "\t" 'idlwave-shell-complete) + (define-key map "\M-\t" 'idlwave-shell-complete) + (define-key map "\C-c\C-s" 'idlwave-shell) + (define-key map "\C-c?" 'idlwave-routine-info) + (define-key map "\C-g" 'idlwave-keyboard-quit) + (define-key map "\M-?" 'idlwave-context-help) + (define-key map [(control meta ?\?)] + 'idlwave-help-assistant-help-with-topic) + (define-key map "\C-c\C-i" 'idlwave-update-routine-info) + (define-key map "\C-c\C-y" 'idlwave-shell-char-mode-loop) + (define-key map "\C-c\C-x" 'idlwave-shell-send-char) + (define-key map "\C-c=" 'idlwave-resolve) + (define-key map "\C-c\C-v" 'idlwave-find-module) + (define-key map "\C-c\C-k" 'idlwave-kill-autoloaded-buffers) + (define-key map idlwave-shell-prefix-key + 'idlwave-shell-debug-map) + (define-key map [(up)] 'idlwave-shell-up-or-history) + (define-key map [(down)] 'idlwave-shell-down-or-history) + (define-key idlwave-shell-mode-map + (if (featurep 'xemacs) [(shift button3)] [(shift mouse-3)]) + 'idlwave-mouse-context-help) + map) "Keymap for `idlwave-mode'.") -(defvar idlwave-shell-electric-debug-mode-map (make-sparse-keymap)) + +(defvar idlwave-shell-electric-debug-mode-map + (let ((map (make-sparse-keymap))) + ;; A few extras in the electric debug map + (define-key map " " 'idlwave-shell-step) + (define-key map "+" 'idlwave-shell-stack-up) + (define-key map "=" 'idlwave-shell-stack-up) + (define-key map "-" 'idlwave-shell-stack-down) + (define-key map "_" 'idlwave-shell-stack-down) + (define-key map "e" (lambda () (interactive) (idlwave-shell-print '(16)))) + (define-key map "q" 'idlwave-shell-retall) + (define-key map "t" + (lambda () (interactive) (idlwave-shell-send-command "help,/TRACE"))) + (define-key map [(control ??)] 'idlwave-shell-electric-debug-help) + (define-key map "x" + (lambda (arg) (interactive "P") + (idlwave-shell-print arg nil nil t))) + map)) + (defvar idlwave-shell-mode-prefix-map (make-sparse-keymap)) (fset 'idlwave-shell-mode-prefix-map idlwave-shell-mode-prefix-map) (defvar idlwave-mode-prefix-map (make-sparse-keymap)) @@ -4069,29 +4114,6 @@ Otherwise, just expand the file name." "Define a key in both the shell and buffer mode maps." (define-key idlwave-mode-map key hook) (define-key idlwave-shell-mode-map key hook)) - -;(define-key idlwave-shell-mode-map "\M-?" 'comint-dynamic-list-completions) -;(define-key idlwave-shell-mode-map "\t" 'comint-dynamic-complete) - -(define-key idlwave-shell-mode-map "\C-w" 'comint-kill-region) -(define-key idlwave-shell-mode-map "\t" 'idlwave-shell-complete) -(define-key idlwave-shell-mode-map "\M-\t" 'idlwave-shell-complete) -(define-key idlwave-shell-mode-map "\C-c\C-s" 'idlwave-shell) -(define-key idlwave-shell-mode-map "\C-c?" 'idlwave-routine-info) -(define-key idlwave-shell-mode-map "\C-g" 'idlwave-keyboard-quit) -(define-key idlwave-shell-mode-map "\M-?" 'idlwave-context-help) -(define-key idlwave-shell-mode-map [(control meta ?\?)] - 'idlwave-help-assistant-help-with-topic) -(define-key idlwave-shell-mode-map "\C-c\C-i" 'idlwave-update-routine-info) -(define-key idlwave-shell-mode-map "\C-c\C-y" 'idlwave-shell-char-mode-loop) -(define-key idlwave-shell-mode-map "\C-c\C-x" 'idlwave-shell-send-char) -(define-key idlwave-shell-mode-map "\C-c=" 'idlwave-resolve) -(define-key idlwave-shell-mode-map "\C-c\C-v" 'idlwave-find-module) -(define-key idlwave-shell-mode-map "\C-c\C-k" 'idlwave-kill-autoloaded-buffers) -(define-key idlwave-shell-mode-map idlwave-shell-prefix-key - 'idlwave-shell-debug-map) -(define-key idlwave-shell-mode-map [(up)] 'idlwave-shell-up-or-history) -(define-key idlwave-shell-mode-map [(down)] 'idlwave-shell-down-or-history) (define-key idlwave-mode-map "\C-c\C-y" 'idlwave-shell-char-mode-loop) (define-key idlwave-mode-map "\C-c\C-x" 'idlwave-shell-send-char) @@ -4112,22 +4134,12 @@ Otherwise, just expand the file name." [(control shift down-mouse-2)]) 'idlwave-shell-examine-select) ;; Add this one from the idlwave-mode-map -(define-key idlwave-shell-mode-map - (if (featurep 'xemacs) - [(shift button3)] - [(shift mouse-3)]) - 'idlwave-mouse-context-help) - ;; For Emacs, we need to turn off the button release events. -(defun idlwave-shell-mouse-nop (event) - (interactive "e")) + (unless (featurep 'xemacs) - (idlwave-shell-define-key-both - [(shift mouse-2)] 'idlwave-shell-mouse-nop) - (idlwave-shell-define-key-both - [(shift control mouse-2)] 'idlwave-shell-mouse-nop) - (idlwave-shell-define-key-both - [(control meta mouse-2)] 'idlwave-shell-mouse-nop)) + (idlwave-shell-define-key-both [(shift mouse-2)] 'ignore) + (idlwave-shell-define-key-both [(shift control mouse-2)] 'ignore) + (idlwave-shell-define-key-both [(control meta mouse-2)] 'ignore)) ;; The following set of bindings is used to bind the debugging keys. @@ -4207,26 +4219,6 @@ Otherwise, just expand the file name." (define-key idlwave-shell-electric-debug-mode-map (char-to-string c2) cmd)))) -;; A few extras in the electric debug map -(define-key idlwave-shell-electric-debug-mode-map " " 'idlwave-shell-step) -(define-key idlwave-shell-electric-debug-mode-map "+" 'idlwave-shell-stack-up) -(define-key idlwave-shell-electric-debug-mode-map "=" 'idlwave-shell-stack-up) -(define-key idlwave-shell-electric-debug-mode-map "-" - 'idlwave-shell-stack-down) -(define-key idlwave-shell-electric-debug-mode-map "_" - 'idlwave-shell-stack-down) -(define-key idlwave-shell-electric-debug-mode-map "e" - (lambda () (interactive) (idlwave-shell-print '(16)))) -(define-key idlwave-shell-electric-debug-mode-map "q" 'idlwave-shell-retall) -(define-key idlwave-shell-electric-debug-mode-map "t" - (lambda () (interactive) (idlwave-shell-send-command "help,/TRACE"))) -(define-key idlwave-shell-electric-debug-mode-map [(control ??)] - 'idlwave-shell-electric-debug-help) -(define-key idlwave-shell-electric-debug-mode-map "x" - (lambda (arg) (interactive "P") - (idlwave-shell-print arg nil nil t))) - - ; Enter the prefix map in two places. (fset 'idlwave-debug-map idlwave-mode-prefix-map) (fset 'idlwave-shell-debug-map idlwave-shell-mode-prefix-map) @@ -4254,43 +4246,32 @@ Otherwise, just expand the file name." When Idlwave Shell Electric Debug mode is enabled, the Idlwave Shell debugging commands are available as single key sequences." - nil " *Debugging*" idlwave-shell-electric-debug-mode-map) - -(add-hook - 'idlwave-shell-electric-debug-mode-on-hook - (lambda () - (set (make-local-variable 'idlwave-shell-electric-debug-read-only) - buffer-read-only) - (setq buffer-read-only t) - (add-to-list 'idlwave-shell-electric-debug-buffers (current-buffer)) - (if idlwave-shell-stop-line-overlay - (overlay-put idlwave-shell-stop-line-overlay 'face - idlwave-shell-electric-stop-line-face)) - (if (facep 'fringe) - (set-face-foreground 'fringe idlwave-shell-electric-stop-color - (selected-frame))))) - -(add-hook - 'idlwave-shell-electric-debug-mode-off-hook - (lambda () - ;; Return to previous read-only state - (setq buffer-read-only (if (boundp 'idlwave-shell-electric-debug-read-only) - idlwave-shell-electric-debug-read-only)) - (setq idlwave-shell-electric-debug-buffers - (delq (current-buffer) idlwave-shell-electric-debug-buffers)) - (if idlwave-shell-stop-line-overlay - (overlay-put idlwave-shell-stop-line-overlay 'face - idlwave-shell-stop-line-face) - (if (facep 'fringe) - (set-face-foreground 'fringe (face-foreground 'default)))))) - -;; easy-mmode defines electric-debug-mode for us, so we need to advise it. -(defadvice idlwave-shell-electric-debug-mode (after print-enter activate) - "Print out an entrance message." - (when idlwave-shell-electric-debug-mode + :lighter " *Debugging*" + (cond + (idlwave-shell-electric-debug-mode + (set (make-local-variable 'idlwave-shell-electric-debug-read-only) + buffer-read-only) + (setq buffer-read-only t) + (add-to-list 'idlwave-shell-electric-debug-buffers (current-buffer)) + (if idlwave-shell-stop-line-overlay + (overlay-put idlwave-shell-stop-line-overlay 'face + idlwave-shell-electric-stop-line-face)) + (if (facep 'fringe) + (set-face-foreground 'fringe idlwave-shell-electric-stop-color + (selected-frame))) (message "Electric Debugging mode entered. Press [C-?] for help, [q] to quit")) - (force-mode-line-update)) + (t + ;; Return to previous read-only state + (setq buffer-read-only (if (boundp 'idlwave-shell-electric-debug-read-only) + idlwave-shell-electric-debug-read-only)) + (setq idlwave-shell-electric-debug-buffers + (delq (current-buffer) idlwave-shell-electric-debug-buffers)) + (if idlwave-shell-stop-line-overlay + (overlay-put idlwave-shell-stop-line-overlay 'face + idlwave-shell-stop-line-face) + (if (facep 'fringe) + (set-face-foreground 'fringe (face-foreground 'default))))))) ;; Turn it off in all relevant buffers (defvar idlwave-shell-electric-debug-buffers nil) commit e6380c43338fe4f8ca2df78eb549f96b14275ffc Author: Stefan Monnier Date: Fri Sep 14 11:25:16 2018 -0400 * lisp/progmodes/ada-mode.el (comment-region): Avoid defadvice Don't load 'advice' if it won't be used! diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el index 76c9be93d0..fd6a2b0b2d 100644 --- a/lisp/progmodes/ada-mode.el +++ b/lisp/progmodes/ada-mode.el @@ -4519,6 +4519,7 @@ Moves to `begin' if in a declarative part." (define-key ada-mode-map "\C-c\C-n" 'ada-make-subprogram-body) ;; Use predefined function of Emacs19 for comments (RE) + ;; FIXME: Made redundant with Emacs-21's standard comment-dwim binding on M-; (define-key ada-mode-map "\C-c;" 'comment-region) (define-key ada-mode-map "\C-c:" 'ada-uncomment-region) @@ -4756,16 +4757,17 @@ Moves to `begin' if in a declarative part." ;; function for justifying the comments. ;; ------------------------------------------------------- -(defadvice comment-region (before ada-uncomment-anywhere disable) - (if (and (consp arg) ;; a prefix with \C-u is of the form '(4), whereas - ;; \C-u 2 sets arg to '2' (fixed by S.Leake) - (derived-mode-p 'ada-mode)) - (save-excursion - (let ((cs (concat "^[ \t]*" (regexp-quote comment-start)))) - (goto-char beg) - (while (re-search-forward cs end t) - (replace-match comment-start)) - )))) +(when (or (<= emacs-major-version 20) (featurep 'xemacs)) + (defadvice comment-region (before ada-uncomment-anywhere disable) + (if (and (consp arg) ;; a prefix with \C-u is of the form '(4), whereas + ;; \C-u 2 sets arg to '2' (fixed by S.Leake) + (derived-mode-p 'ada-mode)) + (save-excursion + (let ((cs (concat "^[ \t]*" (regexp-quote comment-start)))) + (goto-char beg) + (while (re-search-forward cs end t) + (replace-match comment-start)) + ))))) (defun ada-uncomment-region (beg end &optional arg) "Uncomment region BEG .. END. commit 628102f6f42d2ea82c4eda81ee35bdec1da32a9b Author: Stefan Monnier Date: Fri Sep 14 11:14:02 2018 -0400 * lisp/eshell/em-dirs.el (eshell-expand-multiple-dots): Avoid defadvice. diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el index 5180a0700d..b7d13ee27b 100644 --- a/lisp/eshell/em-dirs.el +++ b/lisp/eshell/em-dirs.el @@ -314,16 +314,18 @@ Thus, this does not include the current directory.") path))) (defun eshell-expand-multiple-dots (path) + ;; FIXME: This advice recommendation is rather odd: it's somewhat + ;; dangerous and it claims not to work with minibuffer-completion, which + ;; makes it much less interesting. "Convert `...' to `../..', `....' to `../../..', etc.. With the following piece of advice, you can make this functionality available in most of Emacs, with the exception of filename completion in the minibuffer: - (defadvice expand-file-name - (before translate-multiple-dots - (filename &optional directory) activate) - (setq filename (eshell-expand-multiple-dots filename)))" + (advice-add 'expand-file-name :around #'my-expand-multiple-dots) + (defun my-expand-multiple-dots (orig-fun filename &rest args) + (apply orig-fun (eshell-expand-multiple-dots filename) args))" (while (string-match "\\(?:^\\|/\\)\\.\\.\\(\\.+\\)\\(?:$\\|/\\)" path) (let* ((extra-dots (match-string 1 path)) (len (length extra-dots)) commit 441e23b5eb13929db9341f93ee71b761135943e3 Author: Stefan Monnier Date: Fri Sep 14 11:05:33 2018 -0400 * lisp/mail/feedmail.el: Use lexical-binding (feedmail-queue-buffer-file-name): Improve advising example. (feedmail-vm-mail-mode): Improve auto-mode-alist example. (feedmail-queue-runner-prompt): Remove unused function. diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el index 6093aecd5c..ec4a1162b2 100644 --- a/lisp/mail/feedmail.el +++ b/lisp/mail/feedmail.el @@ -1,5 +1,6 @@ -;;; feedmail.el --- assist other email packages to massage outgoing messages -;;; This file is in the public domain. +;;; feedmail.el --- assist other email packages to massage outgoing messages -*- lexical-binding:t -*- + +;; This file is in the public domain. ;; This file is part of GNU Emacs. @@ -1312,25 +1313,21 @@ There's no trivial way to avoid it. It's unwise to just set the value of `buffer-file-name' to nil because that will defeat feedmail's file management features. Instead, arrange for this variable to be set to the value of `buffer-file-name' before setting that to nil. An easy way -to do that would be with defadvice on `mail-send' \(undoing the -assignments in a later advice). +to do that would be with an advice on `mail-send'. feedmail will pretend that `buffer-file-name', if nil, has the value assigned of `feedmail-queue-buffer-file-name' and carry out its normal activities. feedmail does not restore the non-nil value of -`buffer-file-name'. For safe bookkeeping, the user should insure that +`buffer-file-name'. For safe bookkeeping, the user should ensure that feedmail-queue-buffer-file-name is restored to nil. -Example `defadvice' for mail-send: - - (defadvice mail-send (before feedmail-mail-send-before-advice activate) - (setq feedmail-queue-buffer-file-name buffer-file-name) - (setq buffer-file-name nil)) +Example advice for mail-send: - (defadvice mail-send (after feedmail-mail-send-after-advice activate) - (if feedmail-queue-buffer-file-name (setq buffer-file-name feedmail-queue-buffer-file-name)) - (setq feedmail-queue-buffer-file-name nil)) -") + (advice-add 'mail-send :around #'my-feedmail-mail-send-advice) + (defun my-feedmail-mail-send-advice (orig-fun &rest args) + (let ((feedmail-queue-buffer-file-name buffer-file-name) + (buffer-file-name nil)) + (apply orig-fun args)))") ;; defvars to make byte-compiler happy(er) (defvar feedmail-error-buffer nil) @@ -1438,7 +1435,7 @@ internal buffers will be reused and things will get confused." ) (defcustom feedmail-queue-runner-mode-setter - (lambda (&optional arg) (mail-mode)) + (lambda (&optional _) (mail-mode)) "A function to set the proper mode of a message file. Called when the message is read back out of the queue directory with a single argument, the optional argument used in the call to @@ -1474,7 +1471,10 @@ set `mail-header-separator' to the value of (defcustom feedmail-queue-runner-message-sender - (lambda (&optional arg) (mail-send)) + (lambda (&optional _) + ;; `mail-send' is not autoloaded, which is why we need the `require'. + (require 'sendmail) (declare-function mail-send "sendmail") + (mail-send)) "Function to initiate sending a message file. Called for each message read back out of the queue directory with a single argument, the optional argument used in the call to @@ -1737,7 +1737,7 @@ insertion.") (declare-function vm-mail "ext:vm" (&optional to subject)) -(defun feedmail-vm-mail-mode (&optional arg) +(defun feedmail-vm-mail-mode (&optional _) "Make something like a buffer that has been created via `vm-mail'. The optional argument is ignored and is just for argument compatibility with `feedmail-queue-runner-mode-setter'. This function is suitable for being @@ -1745,9 +1745,7 @@ applied to a file after you've just read it from disk: for example, a feedmail FQM message file from a queue. You could use something like this: -\(setq auto-mode-alist - (cons \\='(\"\\\\.fqm$\" . feedmail-vm-mail-mode) auto-mode-alist)) -" + (add-to-list 'auto-mode-alist \\='(\"\\\\.fqm\\\\\\='\" . feedmail-vm-mail-mode))" (feedmail-say-debug ">in-> feedmail-vm-mail-mode") (let ((the-buf (current-buffer))) (vm-mail) @@ -2150,19 +2148,8 @@ you can set `feedmail-queue-reminder-alist' to nil." feedmail-prompt-before-queue-user-alist )) -(defun feedmail-queue-runner-prompt () - "Ask whether to queue, send immediately, or return to editing a message, etc." - (feedmail-say-debug ">in-> feedmail-queue-runner-prompt") - (feedmail-queue-send-edit-prompt-inner - feedmail-ask-before-queue-default - feedmail-ask-before-queue-prompt - feedmail-ask-before-queue-reprompt - 'feedmail-message-action-help - feedmail-prompt-before-queue-standard-alist - feedmail-prompt-before-queue-user-alist - )) (defun feedmail-queue-send-edit-prompt-inner (default prompt reprompt helper - standard-alist user-alist) + standard-alist user-alist) (feedmail-say-debug ">in-> feedmail-queue-send-edit-prompt-inner") ;; Some implementation ideas here came from the userlock.el code (or defining-kbd-macro (discard-input)) @@ -2181,6 +2168,8 @@ you can set `feedmail-queue-reminder-alist' to nil." (let ((inhibit-quit t) (cursor-in-echo-area t) (echo-keystrokes 0)) (read-char-exclusive)))) (if (= user-sez help-char) + ;; FIXME: This seems to want to refer to the `helper' argument, + ;; but it's quoted so the `helper' arg ends up unused! (setq answer '(^ . helper)) (if (or (eq user-sez ?\C-m) (eq user-sez ?\C-j) (eq user-sez ?y)) (setq user-sez d-char)) @@ -2209,7 +2198,7 @@ you can set `feedmail-queue-reminder-alist' to nil." ;; emacs convention is that scroll-up moves text up, window down (feedmail-say-debug ">in-> feedmail-scroll-buffer %s" direction) (save-selected-window - (let ((signal-error-on-buffer-boundary nil) + (let ((signal-error-on-buffer-boundary nil) ;FIXME: Unknown var!? (fqm-window (display-buffer (if buffy buffy (current-buffer))))) (select-window fqm-window) (if (eq direction 'up) @@ -2697,8 +2686,10 @@ fiddle-plex, as described in the documentation for the variable (save-excursion (if feedmail-enable-spray (mapcar - (lambda (feedmail-spray-this-address) - (let ((spray-buffer (get-buffer-create " *FQM Outgoing Email Spray*"))) + (lambda (address) + (let ((feedmail-spray-this-address address) + (spray-buffer + (get-buffer-create " *FQM Outgoing Email Spray*"))) (with-current-buffer spray-buffer (erase-buffer) ;; not life's most efficient methodology, but spraying isn't @@ -2712,7 +2703,8 @@ fiddle-plex, as described in the documentation for the variable ;; Message-Id:s, but I doubt that anyone cares, ;; practically. If someone complains about it, I'll ;; add it. - (feedmail-fiddle-list-of-spray-fiddle-plexes feedmail-spray-address-fiddle-plex-list) + (feedmail-fiddle-list-of-spray-fiddle-plexes + feedmail-spray-address-fiddle-plex-list) ;; this (let ) is just in case some buffer eater ;; is cheating and using the global variable name instead ;; of its argument to find the buffer @@ -3147,13 +3139,17 @@ been weeded out." (identity address-list))) -(defun feedmail-one-last-look (feedmail-prepped-text-buffer) +(defun feedmail-one-last-look (buffer) "Offer the user one last chance to give it up." (feedmail-say-debug ">in-> feedmail-one-last-look") (save-excursion + ;; FIXME: switch-to-buffer may fail or pop up a new frame + ;; (in minibuffer-only frames, for example) and save-window-excursion + ;; won't delete the newly created frame upon exit! (save-window-excursion - (switch-to-buffer feedmail-prepped-text-buffer) - (if (and (fboundp 'y-or-n-p-with-timeout) (numberp feedmail-confirm-outgoing-timeout)) + (switch-to-buffer buffer) + (if (and (fboundp 'y-or-n-p-with-timeout) + (numberp feedmail-confirm-outgoing-timeout)) (y-or-n-p-with-timeout "FQM: Send this email? " (abs feedmail-confirm-outgoing-timeout) commit 41c2d25912fdd7b9adb5c550618335158a0b9d97 Author: Leo Liu Date: Fri Sep 14 22:44:09 2018 +0800 Remove unused variable * lisp/progmodes/prolog.el (prolog-hungry-delete-key-flag): Remove. diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index a895a77796..3bcc9bebcd 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -480,12 +480,6 @@ Legal values: ;; Keyboard -(defcustom prolog-hungry-delete-key-flag nil - "Non-nil means delete key consumes all preceding spaces." - :version "24.1" - :group 'prolog-keyboard - :type 'boolean) - (defcustom prolog-electric-dot-flag nil "Non-nil means make dot key electric. Electric dot appends newline or inserts head of a new clause. commit 1e3b3fa6159db837fca2f2d564e51b01048a906f Author: Leo Liu Date: Fri Sep 14 22:31:50 2018 +0800 Fix (thing-at-point 'list) regression (Bug#31772) * lisp/thingatpt.el (thing-at-point-bounds-of-list-at-point): Revert to pre 26.1 behavior. Return whole sexp at point if no enclosing list. (list-at-point): New optional arg to ignore comments and strings. * test/lisp/thingatpt-tests.el (thing-at-point-bounds-of-list-at-point): Fix and augment tests. diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index 6a978fe96e..79f0230a20 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -219,17 +219,15 @@ The bounds of THING are determined by `bounds-of-thing-at-point'." (defun thing-at-point-bounds-of-list-at-point () "Return the bounds of the list at point. +Prefer the enclosing list with fallback on sexp at point. \[Internal function used by `bounds-of-thing-at-point'.]" (save-excursion - (let* ((st (parse-partial-sexp (point-min) (point))) - (beg (or (and (eq 4 (car (syntax-after (point)))) - (not (nth 8 st)) - (point)) - (nth 1 st)))) - (when beg - (goto-char beg) - (forward-sexp) - (cons beg (point)))))) + (if (ignore-errors (up-list -1)) + (ignore-errors (cons (point) (progn (forward-sexp) (point)))) + (let ((bound (bounds-of-thing-at-point 'sexp))) + (and bound + (<= (car bound) (point)) (< (point) (cdr bound)) + bound))))) ;; Defuns @@ -608,8 +606,13 @@ Signal an error if the entire string was not used." (put 'number 'thing-at-point 'number-at-point) ;;;###autoload -(defun list-at-point () - "Return the Lisp list at point, or nil if none is found." - (form-at-point 'list 'listp)) +(defun list-at-point (&optional ignore-comment-or-string) + "Return the Lisp list at point, or nil if none is found. +If IGNORE-COMMENT-OR-STRING is non-nil comments and strings are +treated as white space." + (let ((ppss (and ignore-comment-or-string (syntax-ppss)))) + (save-excursion + (goto-char (or (nth 8 ppss) (point))) + (form-at-point 'list 'listp)))) ;;; thingatpt.el ends here diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el index cfb57de618..1d80519fe7 100644 --- a/test/lisp/thingatpt-tests.el +++ b/test/lisp/thingatpt-tests.el @@ -84,41 +84,43 @@ position to retrieve THING.") (goto-char (nth 1 test)) (should (equal (thing-at-point (nth 2 test)) (nth 3 test)))))) -;; These tests reflect the actual behavior of -;; `thing-at-point-bounds-of-list-at-point'. -(ert-deftest thing-at-point-bug24627 () - "Test for https://debbugs.gnu.org/24627 ." - (let ((string-result '(("(a \"b\" c)" . (a "b" c)) - (";(a \"b\" c)") - ("(a \"b\" c\n)" . (a "b" c)) - ("\"(a b c)\"") - ("(a ;(b c d)\ne)" . (a e)) - ("(foo\n(a ;(b c d)\ne) bar)" . (a e)) - ("(foo\na ;(b c d)\ne bar)" . (foo a e bar)) - ("(foo\n(a \"(b c d)\"\ne) bar)" . (a "(b c d)" e)) - ("(b\n(a ;(foo c d)\ne) bar)" . (a e)) - ("(princ \"(a b c)\")" . (princ "(a b c)")) - ("(defun foo ()\n \"Test function.\"\n ;;(a b)\n nil)" . (defun foo nil "Test function." nil)))) - (file - (expand-file-name "lisp/thingatpt.el" source-directory)) - buf) - ;; Test for `thing-at-point'. - (when (file-exists-p file) - (unwind-protect - (progn - (setq buf (find-file file)) - (goto-char (point-max)) - (forward-line -1) - (should-not (thing-at-point 'list))) - (kill-buffer buf))) - ;; Tests for `list-at-point'. - (dolist (str-res string-result) - (with-temp-buffer - (emacs-lisp-mode) - (insert (car str-res)) - (re-search-backward "\\((a\\|^a\\)") - (should (equal (list-at-point) - (cdr str-res))))))) +;; See bug#24627 and bug#31772. +(ert-deftest thing-at-point-bounds-of-list-at-point () + (cl-macrolet ((with-test-buffer (str &rest body) + `(with-temp-buffer + (emacs-lisp-mode) + (insert ,str) + (search-backward "|") + (delete-char 1) + ,@body))) + (let ((tests1 + '(("|(a \"b\" c)" (a "b" c)) + (";|(a \"b\" c)" (a "b" c) nil) + ("|(a \"b\" c\n)" (a "b" c)) + ("\"|(a b c)\"" (a b c) nil) + ("|(a ;(b c d)\ne)" (a e)) + ("(foo\n|(a ;(b c d)\ne) bar)" (foo (a e) bar)) + ("(foo\n|a ;(b c d)\ne bar)" (foo a e bar)) + ("(foo\n|(a \"(b c d)\"\ne) bar)" (foo (a "(b c d)" e) bar)) + ("(b\n|(a ;(foo c d)\ne) bar)" (b (a e) bar)) + ("(princ \"|(a b c)\")" (a b c) (princ "(a b c)")) + ("(defun foo ()\n \"Test function.\"\n ;;|(a b)\n nil)" + (defun foo nil "Test function." nil) + (defun foo nil "Test function." nil)))) + (tests2 + '(("|list-at-point" . "list-at-point") + ("list-|at-point" . "list-at-point") + ("list-at-point|" . nil) + ("|(a b c)" . "(a b c)") + ("(a b c)|" . nil)))) + (dolist (test tests1) + (with-test-buffer (car test) + (should (equal (list-at-point) (cl-second test))) + (when (cddr test) + (should (equal (list-at-point t) (cl-third test)))))) + (dolist (test tests2) + (with-test-buffer (car test) + (should (equal (thing-at-point 'list) (cdr test)))))))) (ert-deftest thing-at-point-url-in-comment () (with-temp-buffer commit ff349d021df40fd73ac1ead2ed1e376b214d07fd Author: Stefan Monnier Date: Fri Sep 14 10:23:39 2018 -0400 * lisp/progmodes/js.el (js--fill-c-advice): New function (c-forward-sws, c-backward-sws, c-beginning-of-macro): Use it. (js-fill-paragraph): Rename from js-c-fill-paragraph. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index f30e591b15..3ce5af4c49 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -2368,23 +2368,22 @@ i.e., customize JSX element indentation with `sgml-basic-offset', ;; FIXME: Such redefinitions are bad style. We should try and use some other ;; way to get the same result. -(defadvice c-forward-sws (around js-fill-paragraph activate) - (if js--filling-paragraph - (setq ad-return-value (js--forward-syntactic-ws (ad-get-arg 0))) - ad-do-it)) - -(defadvice c-backward-sws (around js-fill-paragraph activate) - (if js--filling-paragraph - (setq ad-return-value (js--backward-syntactic-ws (ad-get-arg 0))) - ad-do-it)) - -(defadvice c-beginning-of-macro (around js-fill-paragraph activate) - (if js--filling-paragraph - (setq ad-return-value (js--beginning-of-macro (ad-get-arg 0))) - ad-do-it)) - -(defun js-c-fill-paragraph (&optional justify) - "Fill the paragraph with `c-fill-paragraph'." +(defun js--fill-c-advice (js-fun) + (lambda (orig-fun &rest args) + (if js--filling-paragraph + (funcall js-fun (car args)) + (apply orig-fun args)))) + +(advice-add 'c-forward-sws + :around (js--fill-c-advice #'js--forward-syntactic-ws)) +(advice-add 'c-backward-sws + :around (js--fill-c-advice #'js--backward-syntactic-ws)) +(advice-add 'c-beginning-of-macro + :around (js--fill-c-advice #'js--beginning-of-macro)) + +(define-obsolete-function-alias 'js-c-fill-paragraph #'js-fill-paragraph "27.1") +(defun js-fill-paragraph (&optional justify) + "Fill the paragraph for Javascript code." (interactive "*P") (let ((js--filling-paragraph t) (fill-paragraph-function #'c-fill-paragraph)) @@ -3875,7 +3874,7 @@ If one hasn't been set, or if it's stale, prompt for a new one." ;; Comments (setq-local comment-start "// ") (setq-local comment-end "") - (setq-local fill-paragraph-function #'js-c-fill-paragraph) + (setq-local fill-paragraph-function #'js-fill-paragraph) (setq-local normal-auto-fill-function #'js-do-auto-fill) ;; Parse cache commit 219893a519e57a53425ea2c821ef0781f9642771 Author: Robert Pluim Date: Fri Sep 14 15:57:14 2018 +0200 Clarify meaning of '*' * doc/misc/dired-x.texi (Shell Command Guessing): Clarify meaning of '*'. (Bug#32733) diff --git a/doc/misc/dired-x.texi b/doc/misc/dired-x.texi index a502667ab8..d7f3586675 100644 --- a/doc/misc/dired-x.texi +++ b/doc/misc/dired-x.texi @@ -593,8 +593,7 @@ where each @var{command} can either be a string or a Lisp expression that evaluates to a string. If several commands are given, all of them will temporarily be pushed onto the history. -If @samp{*} in the shell command, that means to substitute the file -name. +A @samp{*} in the shell command is replaced by the file name. You can set this variable in your @file{~/.emacs}. For example, to add rules for @samp{.foo} and @samp{.bar} file extensions, write commit 383c9a253b2cd030674982046e23c3670543dc68 Author: Michael Albinus Date: Fri Sep 14 10:03:27 2018 +0200 ; Instrument autorevert-tests.el diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el index b378c9b8b0..9710600f16 100644 --- a/test/lisp/autorevert-tests.el +++ b/test/lisp/autorevert-tests.el @@ -181,7 +181,10 @@ This expects `auto-revert--messages' to be bound by ;; modifying `before-revert-hook'. (add-hook 'before-revert-hook - (lambda () (delete-file buffer-file-name)) + (lambda () + ;; Temporarily. + (message "%s deleted" buffer-file-name) + (delete-file buffer-file-name)) nil t) (ert-with-message-capture auto-revert--messages commit da4e5f668582e1f047b6bd5259a1a4f92b5461b6 Author: Paul Eggert Date: Thu Sep 13 17:31:58 2018 -0700 Simplify use of timestamps * lisp/calendar/icalendar.el (icalendar--create-uid): * lisp/gnus/nnmaildir.el (nnmaildir-request-accept-article): Simplify by using format-time-string. * lisp/gnus/nnmaildir.el (nnmaildir--scan): Simplify by using float-time and time-less-p. diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el index c1a3e0a421..e3e458a4dd 100644 --- a/lisp/calendar/icalendar.el +++ b/lisp/calendar/icalendar.el @@ -1016,9 +1016,7 @@ current iCalendar object, as a string. Increase (setq icalendar--uid-count (1+ icalendar--uid-count)) (setq uid (replace-regexp-in-string "%t" - (format "%d%d%d" (car (current-time)) - (cadr (current-time)) - (car (cddr (current-time)))) + (format-time-string "%s%N") uid t t)) (setq uid (replace-regexp-in-string "%h" diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index c8480ddda4..48a470c746 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -764,7 +764,7 @@ This variable is set by `nnmaildir-request-article'.") (defun nnmaildir--scan (gname scan-msgs groups _method srv-dir srv-ls) (catch 'return - (let ((36h-ago (- (car (current-time)) 2)) + (let ((36h-ago (- (float-time) 129600)) absdir nndir tdir ndir cdir nattr cattr isnew pgname read-only ls files num dir flist group x) (setq absdir (nnmaildir--srvgrp-dir srv-dir gname) @@ -801,7 +801,7 @@ This variable is set by `nnmaildir-request-article'.") (throw 'return nil)) (dolist (file (funcall ls tdir 'full "\\`[^.]" 'nosort)) (setq x (file-attributes file)) - (if (or (> (cadr x) 1) (< (car (nth 4 x)) 36h-ago)) + (if (or (> (cadr x) 1) (time-less-p (nth 4 x) 36h-ago)) (delete-file file)))) (or scan-msgs isnew @@ -1463,9 +1463,7 @@ This variable is set by `nnmaildir-request-article'.") (unless (string-equal nnmaildir--delivery-time file) (setq nnmaildir--delivery-time file nnmaildir--delivery-count 0)) - (when (and (consp (cdr time)) - (consp (cddr time))) - (setq file (concat file "M" (number-to-string (caddr time))))) + (setq file (concat file (format-time-string "M%6N" time))) (setq file (concat file nnmaildir--delivery-pid) file (concat file "Q" (number-to-string nnmaildir--delivery-count)) file (concat file "." (nnmaildir--system-name)) commit c44bc4d370b38ac3e9da15579fd372d1410d4b4c Author: Paul Eggert Date: Thu Sep 13 14:28:56 2018 -0700 Fix (floor 54043195528445955 3.0) bug * src/floatfns.c (rounding_driver): Fix rounding error that can occur when both args have values exactly representable as integers but at least one arg is a float. * test/src/floatfns-tests.el (big-round): New test. diff --git a/src/floatfns.c b/src/floatfns.c index 6f5aee2db9..900392575c 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -332,6 +332,18 @@ This is the same as the exponent of a float. */) return make_fixnum (value); } +/* True if A is exactly representable as an integer. */ + +static bool +integer_value (Lisp_Object a) +{ + if (FLOATP (a)) + { + double d = XFLOAT_DATA (a); + return d == floor (d) && isfinite (d); + } + return true; +} /* the rounding functions */ @@ -353,10 +365,16 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor, else { CHECK_NUMBER (divisor); - if (!FLOATP (arg) && !FLOATP (divisor)) + if (integer_value (arg) && integer_value (divisor)) { /* Divide as integers. Converting to double might lose info, even for fixnums; also see the FIXME below. */ + + if (FLOATP (arg)) + arg = double_to_integer (XFLOAT_DATA (arg)); + if (FLOATP (divisor)) + divisor = double_to_integer (XFLOAT_DATA (divisor)); + if (FIXNUMP (divisor)) { if (XFIXNUM (divisor) == 0) diff --git a/test/src/floatfns-tests.el b/test/src/floatfns-tests.el index 3dcddc7f26..14576b603c 100644 --- a/test/src/floatfns-tests.el +++ b/test/src/floatfns-tests.el @@ -109,4 +109,8 @@ (should-error (round n d)) (should-error (truncate n d))))))) +(ert-deftest big-round () + (should (= (floor 54043195528445955 3) + (floor 54043195528445955 3.0)))) + (provide 'floatfns-tests) commit 755fa346eba212b4650c8541023bb78e1658d77b Author: Stephen Berman Date: Thu Sep 13 22:19:22 2018 +0200 Fix wdired handling of symlinks when restoring filename property * lisp/wdired.el (wdired--restore-dired-filename-prop): Use dired-permission-flags-regexp instead of dired-filename to test whether the file is a symlink, since calling file-symlink-p on the latter may fail in wdired-mode (bug#32673). diff --git a/lisp/wdired.el b/lisp/wdired.el index be0bde290a..3157e887d7 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -607,15 +607,22 @@ Optional arguments are ignored." (defun wdired--restore-dired-filename-prop (beg end _len) (save-match-data (save-excursion - (beginning-of-line) - (when (re-search-forward directory-listing-before-filename-regexp - (line-end-position) t) - (setq beg (point) - end (if (and (file-symlink-p (dired-get-filename)) - (search-forward " -> " (line-end-position) t)) - (goto-char (match-beginning 0)) - (line-end-position))) - (put-text-property beg end 'dired-filename t))))) + (let ((lep (line-end-position))) + (beginning-of-line) + (when (re-search-forward + directory-listing-before-filename-regexp lep t) + (setq beg (point) + ;; If the file is a symlink, put the dired-filename + ;; property only on the link name. (Using + ;; (file-symlink-p (dired-get-filename)) fails in + ;; wdired-mode, bug#32673.) + end (if (and (re-search-backward + dired-permission-flags-regexp nil t) + (looking-at "l") + (search-forward " -> " lep t)) + (goto-char (match-beginning 0)) + lep)) + (put-text-property beg end 'dired-filename t)))))) (defun wdired-next-line (arg) "Move down lines then position at filename or the current column. commit f066999b6540451c590cbe32113fae61c4778ba3 Author: Stefan Monnier Date: Wed Sep 12 21:47:39 2018 -0400 (viper-read-key, viper-read-key-sequence): Remove Ever since the time-dependent ESC handling was moved to input-decode-map, viper-read-key-sequence has been obsolete. Clean up accordingly. * lisp/emulation/viper-keym.el: Use lexical-binding. (viper-overriding-map): Remove. * lisp/emulation/viper-macs.el: Use lexical-binding and 'read-key'. * lisp/emulation/viper-util.el: Use lexical-binding. (viper-read-key, viper-read-key-sequence): Remove. * lisp/emulation/viper.el (viper-non-hook-settings): Remove obsolete advice. diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index 3c66abe3e5..3b617a42ab 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -748,7 +748,7 @@ Vi's prefix argument will be used. Otherwise, the prefix argument passed to (unwind-protect (progn (setq com - (key-binding (setq key (viper-read-key-sequence nil)))) + (key-binding (setq key (read-key-sequence nil)))) ;; In case of binding indirection--chase definitions. ;; Have to do it here because we execute this command under ;; different keymaps, so command-execute may not do the @@ -2449,7 +2449,7 @@ These keys are ESC, RET, and LineFeed." (if (eq this-command 'viper-intercept-ESC-key) (setq com 'viper-exit-insert-state) (viper-set-unread-command-events last-input-event) - (setq com (key-binding (viper-read-key-sequence nil)))) + (setq com (key-binding (read-key-sequence nil)))) (condition-case conds (command-execute com) diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el index 5196ca6ac3..cc0b7ebc37 100644 --- a/lisp/emulation/viper-keym.el +++ b/lisp/emulation/viper-keym.el @@ -1,4 +1,4 @@ -;;; viper-keym.el --- Viper keymaps +;;; viper-keym.el --- Viper keymaps -*- lexical-binding:t -*- ;; Copyright (C) 1994-1997, 2000-2018 Free Software Foundation, Inc. @@ -82,10 +82,6 @@ major mode in effect." (defvar viper-insert-intercept-map (make-sparse-keymap)) (defvar viper-emacs-intercept-map (make-sparse-keymap)) -;; keymap used to zap all keymaps other than function-key-map, -;; device-function-key-map, etc. -(defvar viper-overriding-map (make-sparse-keymap)) - (viper-deflocalvar viper-vi-local-user-map (make-sparse-keymap) "Keymap for user-defined local bindings. Useful for changing bindings such as ZZ in certain major modes. diff --git a/lisp/emulation/viper-macs.el b/lisp/emulation/viper-macs.el index 247180c803..cfb46cc19a 100644 --- a/lisp/emulation/viper-macs.el +++ b/lisp/emulation/viper-macs.el @@ -1,4 +1,4 @@ -;;; viper-macs.el --- functions implementing keyboard macros for Viper +;;; viper-macs.el --- functions implementing keyboard macros for Viper -*- lexical-binding:t -*- ;; Copyright (C) 1994-1997, 2000-2018 Free Software Foundation, Inc. @@ -174,7 +174,7 @@ a key is a symbol, e.g., `a', `\\1', `f2', etc., or a list, e.g., (prin1-to-string (viper-display-macro key-seq)) ""))) (message "%s" message) - (setq event (viper-read-key)) + (setq event (read-key)) ;;(setq event (viper-read-event)) (setq key (if (viper-mouse-event-p event) @@ -251,7 +251,7 @@ a key is a symbol, e.g., `a', `\\1', `f2', etc., or a list, e.g., (viper-display-macro key-seq)) ""))) (message "%s" message) - (setq event (viper-read-key)) + (setq event (read-key)) ;;(setq event (viper-read-event)) (setq key (if (viper-mouse-event-p event) @@ -867,15 +867,18 @@ mistakes in macro names to be passed to this function is to use ;; A fast keysequence is one that is terminated by a pause longer than ;; viper-fast-keyseq-timeout. (defun viper-read-fast-keysequence (event macro-alist) + ;; FIXME: Do we still need this? Now that the discrimination between the ESC + ;; key and the ESC byte sent as part of terminal escape sequences is performed + ;; in the input-decode-map, I suspect that we don't need this hack any more. (let ((lis (vector event)) next-event) (while (and (viper-fast-keysequence-p) (viper-keyseq-is-a-possible-macro lis macro-alist)) ;; Seems that viper-read-event is more robust here. We need to be able to ;; place these events on unread-command-events list. If we use - ;; viper-read-key then events will be converted to keys, and sometimes + ;; read-key then events will be converted to keys, and sometimes ;; (e.g., (control \[)) those keys differ from the corresponding events. - ;; So, do not use (setq next-event (viper-read-key)) + ;; So, do not use (setq next-event (read-key)) (setq next-event (viper-read-event)) (or (viper-mouse-event-p next-event) (setq lis (vconcat lis (vector next-event))))) diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el index 2e759bc13b..aa456551a6 100644 --- a/lisp/emulation/viper-util.el +++ b/lisp/emulation/viper-util.el @@ -1,4 +1,4 @@ -;;; viper-util.el --- Utilities used by viper.el +;;; viper-util.el --- Utilities used by viper.el -*- lexical-binding:t -*- ;; Copyright (C) 1994-1997, 1999-2018 Free Software Foundation, Inc. @@ -28,7 +28,6 @@ ;; Compiler pacifier -(defvar viper-overriding-map) (defvar viper-minibuffer-current-face) (defvar viper-minibuffer-insert-face) (defvar viper-minibuffer-vi-face) @@ -631,15 +630,15 @@ Otherwise return the normal value." ;;; Saving settings in custom file -;; Save the current setting of VAR in CUSTOM-FILE. +;; Save the current setting of VAR in FILE. ;; If given, MESSAGE is a message to be displayed after that. ;; This message is erased after 2 secs, if erase-msg is non-nil. -;; Arguments: var message custom-file &optional erase-message -(defun viper-save-setting (var message custom-file &optional erase-msg) +;; Arguments: var message file &optional erase-message +(defun viper-save-setting (var message file &optional erase-msg) (let* ((var-name (symbol-name var)) (var-val (if (boundp var) (eval var))) (regexp (format "^[^;]*%s[ \t\n]*[a-zA-Z---_']*[ \t\n)]" var-name)) - (buf (find-file-noselect (substitute-in-file-name custom-file))) + (buf (find-file-noselect (substitute-in-file-name file))) ) (message "%s" (or message "")) (with-current-buffer buf @@ -661,12 +660,12 @@ Otherwise return the normal value." (message ""))) )) -;; Save STRING in CUSTOM-FILE. If PATTERN is non-nil, remove strings that +;; Save STRING in FILE. If PATTERN is non-nil, remove strings that ;; match this pattern. -(defun viper-save-string-in-file (string custom-file &optional pattern) - (let ((buf (find-file-noselect (substitute-in-file-name custom-file)))) +(defun viper-save-string-in-file (string file &optional pattern) + (let ((buf (find-file-noselect (substitute-in-file-name file)))) (with-current-buffer buf - (let (buffer-read-only) + (let ((inhibit-read-only t)) (goto-char (point-min)) (if pattern (delete-matching-lines pattern)) (goto-char (point-max)) @@ -944,48 +943,6 @@ Otherwise return the normal value." event)) (read-event)))) -;; Viperized read-key-sequence -(defun viper-read-key-sequence (prompt &optional continue-echo) - (let (inhibit-quit event keyseq) - (setq keyseq (read-key-sequence prompt continue-echo)) - (setq event (if (featurep 'xemacs) - (elt keyseq 0) ; XEmacs returns vector of events - (elt (listify-key-sequence keyseq) 0))) - (if (viper-ESC-event-p event) - (let (unread-command-events) - (if (viper-fast-keysequence-p) - (let ((viper-vi-global-user-minor-mode nil) - (viper-vi-local-user-minor-mode nil) - (viper-vi-intercept-minor-mode nil) - (viper-insert-intercept-minor-mode nil) - (viper-replace-minor-mode nil) ; actually unnecessary - (viper-insert-global-user-minor-mode nil) - (viper-insert-local-user-minor-mode nil)) - ;; Note: set unread-command-events only after testing for fast - ;; keysequence. Otherwise, viper-fast-keysequence-p will be - ;; always t -- whether there is anything after ESC or not - (viper-set-unread-command-events keyseq) - (setq keyseq (read-key-sequence nil))) - (viper-set-unread-command-events keyseq) - (setq keyseq (read-key-sequence nil))))) - keyseq)) - - -;; This function lets function-key-map convert key sequences into logical -;; keys. This does a better job than viper-read-event when it comes to kbd -;; macros, since it enables certain macros to be shared between X and TTY modes -;; by correctly mapping key sequences for Left/Right/... (on an ascii -;; terminal) into logical keys left, right, etc. -(defun viper-read-key () ;; FIXME: Use `read-key'? - (let ((overriding-local-map viper-overriding-map) - (inhibit-quit t) - help-char key) - (use-global-map viper-overriding-map) - (unwind-protect - (setq key (elt (viper-read-key-sequence nil) 0)) - (use-global-map global-map)) - key)) - ;; Emacs has a bug in eventp, which causes (eventp nil) to return (nil) ;; instead of nil, if '(nil) was previously inadvertently assigned to diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index 8604020b98..8dd150bf7c 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el @@ -1057,108 +1057,6 @@ Two differences: (setq global-mode-string (append '("" viper-mode-string) (cdr global-mode-string)))) - (if (featurep 'xemacs) - ;; XEmacs - (defadvice describe-key (before viper-describe-key-ad protect activate) - "Force to read key via `viper-read-key-sequence'." - (interactive (list (viper-read-key-sequence "Describe key: ")))) - ;; Emacs - (viper--advice-add 'describe-key :before - (lambda (&rest _) - "Force to read key via `viper-read-key-sequence'." - (interactive (let ((key (viper-read-key-sequence - "Describe key (or click or menu item): "))) - (list key - (prefix-numeric-value current-prefix-arg) - ;; If KEY is a down-event, read also the - ;; corresponding up-event. - (and (vectorp key) - (let ((last-idx (1- (length key)))) - (and (eventp (aref key last-idx)) - (memq 'down (event-modifiers - (aref key last-idx))))) - (or (and (eventp (aref key 0)) - (memq 'down (event-modifiers - (aref key 0))) - ;; For the C-down-mouse-2 popup menu, - ;; there is no subsequent up-event - (= (length key) 1)) - (and (> (length key) 1) - (eventp (aref key 1)) - (memq 'down (event-modifiers (aref key 1))))) - (read-event))))) - nil)) - - ) ; (if (featurep 'xemacs) - - (if (featurep 'xemacs) - ;; XEmacs - (defadvice describe-key-briefly - (before viper-describe-key-briefly-ad protect activate) - "Force to read key via `viper-read-key-sequence'." - (interactive (list (viper-read-key-sequence "Describe key briefly: ")))) - ;; Emacs - (viper--advice-add 'describe-key-briefly :before - (lambda (&rest _) - "Force to read key via `viper-read-key-sequence'." - (interactive (let ((key (viper-read-key-sequence - "Describe key (or click or menu item): "))) - ;; If KEY is a down-event, read and discard the - ;; corresponding up-event. - (and (vectorp key) - (let ((last-idx (1- (length key)))) - (and (eventp (aref key last-idx)) - (memq 'down (event-modifiers (aref key last-idx))))) - (read-event)) - (list key - (if current-prefix-arg - (prefix-numeric-value current-prefix-arg)) - 1))) - nil)) - ) ; (if (featurep 'xemacs) - - ;; FIXME: The default already uses read-file-name, so it looks like this - ;; advice is not needed any more. - ;; (defadvice find-file (before viper-add-suffix-advice activate) - ;; "Use `read-file-name' for reading arguments." - ;; (interactive (cons (read-file-name "Find file: " nil default-directory) - ;; ;; XEmacs: if Mule & prefix arg, ask for coding system - ;; (cond ((and (featurep 'xemacs) (featurep 'mule)) - ;; (list - ;; (and current-prefix-arg - ;; (read-coding-system "Coding-system: ")))) - ;; ;; Emacs: do wildcards - ;; ((and (featurep 'emacs) (boundp 'find-file-wildcards)) - ;; (list find-file-wildcards)))) - ;; )) - ;; (defadvice find-file-other-window (before viper-add-suffix-advice activate) - ;; "Use `read-file-name' for reading arguments." - ;; (interactive (cons (read-file-name "Find file in other window: " - ;; nil default-directory) - ;; ;; XEmacs: if Mule & prefix arg, ask for coding system - ;; (cond ((and (featurep 'xemacs) (featurep 'mule)) - ;; (list - ;; (and current-prefix-arg - ;; (read-coding-system "Coding-system: ")))) - ;; ;; Emacs: do wildcards - ;; ((and (featurep 'emacs) (boundp 'find-file-wildcards)) - ;; (list find-file-wildcards)))) - ;; )) - ;; (defadvice find-file-other-frame (before viper-add-suffix-advice activate) - ;; "Use `read-file-name' for reading arguments." - ;; (interactive (cons (read-file-name "Find file in other frame: " - ;; nil default-directory) - ;; ;; XEmacs: if Mule & prefix arg, ask for coding system - ;; (cond ((and (featurep 'xemacs) (featurep 'mule)) - ;; (list - ;; (and current-prefix-arg - ;; (read-coding-system "Coding-system: ")))) - ;; ;; Emacs: do wildcards - ;; ((and (featurep 'emacs) (boundp 'find-file-wildcards)) - ;; (list find-file-wildcards)))) - ;; )) - - (viper--advice-add 'read-file-name :around (lambda (orig-fun &rest args) "Tell `exit-minibuffer' to run `viper-file-add-suffix' as a hook." commit df3d7e401b1b0e34b3f6583894f05841270fc1db Author: Katsumi Yamaoka Date: Thu Sep 13 00:02:21 2018 +0000 No need to run gnus-article-highlight (bug#32706) * lisp/gnus/deuglify.el (gnus-outlook-display-article-buffer): No need to run gnus-article-highlight (bug#32706). diff --git a/lisp/gnus/deuglify.el b/lisp/gnus/deuglify.el index b09f89772a..6286c535ca 100644 --- a/lisp/gnus/deuglify.el +++ b/lisp/gnus/deuglify.el @@ -299,8 +299,6 @@ It is run after `gnus-article-prepare-hook'." ;; it. Calling `gnus-article-prepare-display' on an already ;; prepared article removes all MIME parts. I'm unsure whether ;; this is a bug or not. - (when (gnus-visual-p 'article-highlight 'highlight) - (gnus-article-highlight t)) (save-excursion (save-restriction (widen) commit 3b38cb0516c0560fd5f54de377c481b42ff28d5f Author: Juri Linkov Date: Thu Sep 13 01:09:53 2018 +0300 * lisp/vc/vc-git.el (vc-git-grep): Set dir to default-directory when it's not available (like it's implemented in lgrep/rgrep) to prevent error in case of `C-u C-u vc-git-grep'. diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 69d6295702..ca457fb3d1 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1440,8 +1440,7 @@ This command shares argument histories with \\[rgrep] and \\[grep]." (cond ((equal current-prefix-arg '(16)) (list (read-from-minibuffer "Run: " "git grep" - nil nil 'grep-history) - nil)) + nil nil 'grep-history))) (t (let* ((regexp (grep-read-regexp)) (files (mapconcat #'shell-quote-argument @@ -1451,6 +1450,8 @@ This command shares argument histories with \\[rgrep] and \\[grep]." (list regexp files dir)))))) (require 'grep) (when (and (stringp regexp) (> (length regexp) 0)) + (unless (and dir (file-accessible-directory-p dir)) + (setq dir default-directory)) (let ((command regexp)) (if (null files) (if (string= command "git grep") commit a1b8418f5e1a4de54528f2887cf653105c3c92fb Author: Juri Linkov Date: Thu Sep 13 00:50:22 2018 +0300 * lisp/dired-x.el (dired-jump): Support archive-subfile-mode exactly like tar-subfile-mode is already supported. diff --git a/lisp/dired-x.el b/lisp/dired-x.el index f07a5deb4f..6c19863f7b 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -445,6 +445,7 @@ See variables `dired-texinfo-unclean-extensions', dired-tex-unclean-extensions (list ".dvi")))) +(defvar archive-superior-buffer) (defvar tar-superior-buffer) ;;; JUMP. @@ -461,8 +462,12 @@ Interactively with prefix argument, read FILE-NAME." (interactive (list nil (and current-prefix-arg (read-file-name "Jump to Dired file: ")))) - (if (bound-and-true-p tar-subfile-mode) - (switch-to-buffer tar-superior-buffer) + (cond + ((bound-and-true-p archive-subfile-mode) + (switch-to-buffer archive-superior-buffer)) + ((bound-and-true-p tar-subfile-mode) + (switch-to-buffer tar-superior-buffer)) + (t ;; Expand file-name before `dired-goto-file' call: ;; `dired-goto-file' requires its argument to be an absolute ;; file name; the result of `read-file-name' could be @@ -490,7 +495,7 @@ Interactively with prefix argument, read FILE-NAME." ;; Toggle omitting, if it is on, and try again. (when dired-omit-mode (dired-omit-mode) - (dired-goto-file file)))))))) + (dired-goto-file file))))))))) ;;;###autoload (defun dired-jump-other-window (&optional file-name) commit 78ff92597ef6e9493a4f06cd9bb5eb4fd1faff5f Author: Juri Linkov Date: Thu Sep 13 00:47:03 2018 +0300 * lisp/simple.el (next-error-no-select): Set display-buffer-overriding-action to display-buffer-reuse-window (bug#32607). diff --git a/lisp/simple.el b/lisp/simple.el index 0ccf2f1d22..ffd7fcc067 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -385,7 +385,11 @@ select the source buffer." (interactive "p") (let ((next-error-highlight next-error-highlight-no-select)) (next-error n)) - (pop-to-buffer next-error-last-buffer)) + (let ((display-buffer-overriding-action '(display-buffer-reuse-window))) + ;; Override user customization such as display-buffer-same-window + ;; and use display-buffer-reuse-window to ensure next-error-last-buffer + ;; is displayed somewhere, not necessarily in the same window (bug#32607). + (pop-to-buffer next-error-last-buffer))) (defun previous-error-no-select (&optional n) "Move point to the previous error in the `next-error' buffer and highlight match. commit 41cdda22c78eb0b00612ce25cdb356dd64322fcc Author: Paul Eggert Date: Wed Sep 12 07:53:43 2018 -0700 * etc/PROBLEMS: Document Ubuntu 16.04 issue. diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 15e2b3359d..7dfafe04de 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -2986,6 +2986,15 @@ as a macro. If the definition (in both unex*.c and malloc.c) is wrong, it can cause problems like this. You might be able to find the correct value in the man page for a.out(5). +* 'make check' failures + +** emacs-module-tests fail on Ubuntu 16.04 + +This is due to a bug in GCC that was fixed in 2015; see +. +You can work around the problem by using a later version of GCC or of +Ubuntu, or by configuring without modules. + * Problems on legacy systems This section covers bugs reported on very old hardware or software. commit 1c22f037fddb6dd9ea3b89ed25543f83c1e147ce Author: Alex Branham Date: Fri Aug 31 08:05:06 2018 -0500 Increase default value for imenu-auto-rescan-maxout * lisp/imenu.el (imenu-auto-rescan-maxout): Increase default value to 600000. (Bug#18426) * doc/emacs/programs.texi (imenu-auto-rescan-maxout): Add documentation for imenu-auto-rescan-maxout. Copyright-paperwork-exempt: yes diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi index 138f82a6bf..46711aaf30 100644 --- a/doc/emacs/programs.texi +++ b/doc/emacs/programs.texi @@ -308,6 +308,10 @@ Rescanning happens automatically if you set @code{imenu-auto-rescan} to a non-@code{nil} value. There is no need to rescan because of small changes in the text. +@vindex imenu-auto-rescan-maxout + @code{imenu-auto-rescan} will be disabled in buffers that are larger +than @code{imenu-auto-rescan-maxout} in bytes. + @vindex imenu-sort-function You can customize the way the menus are sorted by setting the variable @code{imenu-sort-function}. By default, names are ordered as diff --git a/etc/NEWS b/etc/NEWS index f575d4dd00..a54ac2db43 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -50,6 +50,11 @@ often cause crashes. Set it to nil if you really need those fonts. --- *** New toggle 'ibuffer-do-toggle-lock', bound to 'L'. +** Imenu + +--- +*** The value for 'imenu-auto-rescan-maxout' has been increased to 600000. + ** Gnus --- diff --git a/lisp/imenu.el b/lisp/imenu.el index 89114524eb..2608eb259a 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -96,11 +96,11 @@ This might not yet be honored by all index-building functions." :type 'boolean :group 'imenu) -(defcustom imenu-auto-rescan-maxout 60000 - "Imenu auto-rescan is disabled in buffers larger than this size (in bytes). -This variable is buffer-local." +(defcustom imenu-auto-rescan-maxout 600000 + "Imenu auto-rescan is disabled in buffers larger than this size (in bytes)." :type 'integer - :group 'imenu) + :group 'imenu + :version "26.2") (defvar imenu-always-use-completion-buffer-p nil) (make-obsolete-variable 'imenu-always-use-completion-buffer-p commit 9f58ed156974f6345a85da419c57c4235f549f2a Author: Katsumi Yamaoka Date: Wed Sep 12 07:21:15 2018 +0000 Don't highlight article if gnus-visual-p is nil (bug#32706) * lisp/gnus/deuglify.el (gnus-outlook-display-article-buffer): Don't highlight article if gnus-visual-p is nil (bug#32706). diff --git a/lisp/gnus/deuglify.el b/lisp/gnus/deuglify.el index d2bc87caa2..b09f89772a 100644 --- a/lisp/gnus/deuglify.el +++ b/lisp/gnus/deuglify.el @@ -299,8 +299,14 @@ It is run after `gnus-article-prepare-hook'." ;; it. Calling `gnus-article-prepare-display' on an already ;; prepared article removes all MIME parts. I'm unsure whether ;; this is a bug or not. - (gnus-article-highlight t) - (gnus-treat-article nil) + (when (gnus-visual-p 'article-highlight 'highlight) + (gnus-article-highlight t)) + (save-excursion + (save-restriction + (widen) + (article-goto-body) + (narrow-to-region (point) (point-max)) + (gnus-treat-article nil))) (gnus-run-hooks 'gnus-article-prepare-hook 'gnus-outlook-display-hook))) commit 49886b9346eb20acc61a00419df5c94b46012a20 Author: Filipp Gunbin Date: Tue Sep 11 21:43:41 2018 +0300 Fix incorrect spelling of dabbrev-ignored-buffer-regexps in docstrings. * lisp/dabbrev.el (dabbrev-check-all-buffers, dabbrev-expand): Fix docstrings. diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el index 57ee9a526a..913b23dc70 100644 --- a/lisp/dabbrev.el +++ b/lisp/dabbrev.el @@ -219,7 +219,7 @@ designated by `dabbrev-select-buffers-function'. Then, if `dabbrev-check-all-buffers' is non-nil, dabbrev searches all the other buffers, except those named in `dabbrev-ignored-buffer-names', -or matched by `dabbrev-ignored-regexps'." +or matched by `dabbrev-ignored-buffer-regexps'." :type 'boolean :group 'dabbrev) @@ -434,7 +434,7 @@ buffers accepted by the function pointed out by variable `dabbrev-friend-buffer-function', if `dabbrev-check-other-buffers' says so. Then, if `dabbrev-check-all-buffers' is non-nil, look in all the other buffers, subject to constraints specified -by `dabbrev-ignored-buffer-names' and `dabbrev-ignored-regexps'. +by `dabbrev-ignored-buffer-names' and `dabbrev-ignored-buffer-regexps'. A positive prefix argument, N, says to take the Nth backward *distinct* possibility. A negative argument says search forward. commit 40a031e177459f9e7e393fae3766578eed41bedc Author: Paul Eggert Date: Tue Sep 11 11:34:05 2018 -0700 Minor rounding_driver simplification * src/floatfns.c (rounding_driver): Omit last arg, which is now unused. All callers changed. Signal overflow-error for bignum overflow diff --git a/src/floatfns.c b/src/floatfns.c index 8e56fed9d0..6f5aee2db9 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -339,8 +339,7 @@ static Lisp_Object rounding_driver (Lisp_Object arg, Lisp_Object divisor, double (*double_round) (double), void (*int_divide) (mpz_t, mpz_t const, mpz_t const), - EMACS_INT (*fixnum_divide) (EMACS_INT, EMACS_INT), - const char *name) + EMACS_INT (*fixnum_divide) (EMACS_INT, EMACS_INT)) { CHECK_NUMBER (arg); @@ -474,7 +473,7 @@ This rounds the value towards +inf. With optional DIVISOR, return the smallest integer no less than ARG/DIVISOR. */) (Lisp_Object arg, Lisp_Object divisor) { - return rounding_driver (arg, divisor, ceil, mpz_cdiv_q, ceiling2, "ceiling"); + return rounding_driver (arg, divisor, ceil, mpz_cdiv_q, ceiling2); } DEFUN ("floor", Ffloor, Sfloor, 1, 2, 0, @@ -483,7 +482,7 @@ This rounds the value towards -inf. With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR. */) (Lisp_Object arg, Lisp_Object divisor) { - return rounding_driver (arg, divisor, floor, mpz_fdiv_q, floor2, "floor"); + return rounding_driver (arg, divisor, floor, mpz_fdiv_q, floor2); } DEFUN ("round", Fround, Sround, 1, 2, 0, @@ -496,8 +495,7 @@ your machine. For example, (round 2.5) can return 3 on some systems, but 2 on others. */) (Lisp_Object arg, Lisp_Object divisor) { - return rounding_driver (arg, divisor, emacs_rint, rounddiv_q, round2, - "round"); + return rounding_driver (arg, divisor, emacs_rint, rounddiv_q, round2); } /* Since rounding_driver truncates anyway, no need to call 'trunc'. */ @@ -513,8 +511,7 @@ Rounds ARG toward zero. With optional DIVISOR, truncate ARG/DIVISOR. */) (Lisp_Object arg, Lisp_Object divisor) { - return rounding_driver (arg, divisor, identity, mpz_tdiv_q, truncate2, - "truncate"); + return rounding_driver (arg, divisor, identity, mpz_tdiv_q, truncate2); } commit 038a09041af20ed373b15715fbc859d4a305dda8 Author: Paul Eggert Date: Tue Sep 11 11:30:48 2018 -0700 Fix (round 1e+INF) core dump * src/bignum.c (double_to_integer): Signal an error if D cannot be converted, instead of dumping core. * test/src/floatfns-tests.el (special-round): New test. diff --git a/src/bignum.c b/src/bignum.c index 2da2c961c4..5e86c404b7 100644 --- a/src/bignum.c +++ b/src/bignum.c @@ -23,6 +23,7 @@ along with GNU Emacs. If not, see . */ #include "lisp.h" +#include #include /* mpz global temporaries. Making them global saves the trouble of @@ -64,10 +65,13 @@ bignum_to_double (Lisp_Object n) return mpz_get_d (XBIGNUM (n)->value); } -/* Return D, converted to a Lisp integer. Discard any fraction. */ +/* Return D, converted to a Lisp integer. Discard any fraction. + Signal an error if D cannot be converted. */ Lisp_Object double_to_integer (double d) { + if (!isfinite (d)) + overflow_error (); mpz_set_d (mpz[0], d); return make_integer_mpz (); } diff --git a/test/src/floatfns-tests.el b/test/src/floatfns-tests.el index 9a382058b4..3dcddc7f26 100644 --- a/test/src/floatfns-tests.el +++ b/test/src/floatfns-tests.el @@ -94,4 +94,19 @@ (or (/= cdelta fdelta) (zerop (% (round n d) 2))))))))))) +(ert-deftest special-round () + (let ((ns '(-1e+INF 1e+INF -1 1 -1e+NaN 1e+NaN))) + (dolist (n ns) + (unless (<= (abs n) 1) + (should-error (ceiling n)) + (should-error (floor n)) + (should-error (round n)) + (should-error (truncate n))) + (dolist (d ns) + (unless (<= (abs (/ n d)) 1) + (should-error (ceiling n d)) + (should-error (floor n d)) + (should-error (round n d)) + (should-error (truncate n d))))))) + (provide 'floatfns-tests) commit fa3785ea5fd73eaba84b8e3b8f988dd53f3a4148 Author: Paul Eggert Date: Tue Sep 11 11:21:11 2018 -0700 Use overflow-error for bignum overflow This better corresponds to what emacs-26 did in the rare cases where it checked for integer overflow. * src/alloc.c (range_error): Remove. All uses changed to overflow_error. * src/eval.c (overflow_error): New function. diff --git a/src/alloc.c b/src/alloc.c index abb98a9eb6..6bced4e8f0 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -7120,14 +7120,6 @@ verify_alloca (void) #endif /* ENABLE_CHECKING && USE_STACK_LISP_OBJECTS */ -/* Memory allocation for GMP. */ - -void -range_error (void) -{ - xsignal0 (Qrange_error); -} - /* Initialization. */ void diff --git a/src/bignum.c b/src/bignum.c index f4c24d132b..2da2c961c4 100644 --- a/src/bignum.c +++ b/src/bignum.c @@ -80,7 +80,7 @@ make_bignum_bits (size_t bits) /* The documentation says integer-width should be nonnegative, so a single comparison suffices even though 'bits' is unsigned. */ if (integer_width < bits) - range_error (); + overflow_error (); struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value, PVEC_BIGNUM); diff --git a/src/data.c b/src/data.c index 66f69e7e83..1e97d9efa1 100644 --- a/src/data.c +++ b/src/data.c @@ -2407,7 +2407,7 @@ static void emacs_mpz_mul (mpz_t rop, mpz_t const op1, mpz_t const op2) { if (NLIMBS_LIMIT - emacs_mpz_size (op1) < emacs_mpz_size (op2)) - range_error (); + overflow_error (); mpz_mul (rop, op1, op2); } @@ -2421,7 +2421,7 @@ emacs_mpz_mul_2exp (mpz_t rop, mpz_t const op1, mp_bitcnt_t op2) mp_bitcnt_t op2limbs = op2 / GMP_NUMB_BITS; if (lim - emacs_mpz_size (op1) < op2limbs) - range_error (); + overflow_error (); mpz_mul_2exp (rop, op1, op2); } @@ -2435,7 +2435,7 @@ emacs_mpz_pow_ui (mpz_t rop, mpz_t const base, unsigned long exp) int nbase = emacs_mpz_size (base), n; if (INT_MULTIPLY_WRAPV (nbase, exp, &n) || lim < n) - range_error (); + overflow_error (); mpz_pow_ui (rop, base, exp); } @@ -3292,7 +3292,7 @@ expt_integer (Lisp_Object x, Lisp_Object y) && mpz_fits_ulong_p (XBIGNUM (y)->value)) exp = mpz_get_ui (XBIGNUM (y)->value); else - range_error (); + overflow_error (); emacs_mpz_pow_ui (mpz[0], *bignum_integer (&mpz[0], x), exp); return make_integer_mpz (); diff --git a/src/eval.c b/src/eval.c index 60dd6f1e8d..500427cb62 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1765,6 +1765,14 @@ signal_error (const char *s, Lisp_Object arg) xsignal (Qerror, Fcons (build_string (s), arg)); } +/* Use this for arithmetic overflow, e.g., when an integer result is + too large even for a bignum. */ +void +overflow_error (void) +{ + xsignal0 (Qoverflow_error); +} + /* Return true if LIST is a non-nil atom or a list containing one of CONDITIONS. */ diff --git a/src/lisp.h b/src/lisp.h index 454d728f9e..bb190b691b 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3751,7 +3751,6 @@ extern void display_malloc_warning (void); extern ptrdiff_t inhibit_garbage_collection (void); extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object); extern void free_cons (struct Lisp_Cons *); -extern _Noreturn void range_error (void); extern void init_alloc_once (void); extern void init_alloc (void); extern void syms_of_alloc (void); @@ -3888,6 +3887,7 @@ extern _Noreturn void xsignal2 (Lisp_Object, Lisp_Object, Lisp_Object); extern _Noreturn void xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); extern _Noreturn void signal_error (const char *, Lisp_Object); +extern _Noreturn void overflow_error (void); extern bool FUNCTIONP (Lisp_Object); extern Lisp_Object funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *arg_vector); extern Lisp_Object eval_sub (Lisp_Object form); commit ee843895cb5aaac9837162bfe740067e9a5d2403 Author: Eli Zaretskii Date: Tue Sep 11 21:33:28 2018 +0300 Improve recent change to ELisp manual * doc/lispref/commands.texi (Keyboard Events): Add index entry for "character event". (Bug#32562) diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 3e74f05e4c..49c839a897 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -1075,12 +1075,13 @@ the current Emacs session. If a symbol has not yet been so used, @subsection Keyboard Events @cindex keyboard events +@cindex character event There are two kinds of input you can get from the keyboard: ordinary keys, and function keys. Ordinary keys correspond to (possibly modified) characters; the events they generate are represented in Lisp -as characters. The event type of a character event is the character -itself (an integer), which might have some modifier bits set; see -@ref{Classifying Events}. +as characters. The event type of a @dfn{character event} is the +character itself (an integer), which might have some modifier bits +set; see @ref{Classifying Events}. @cindex modifier bits (of input character) @cindex basic code (of input character) commit 94297848332f01a18b5a6a7d29f46d03dcd881ec Author: Michael Albinus Date: Tue Sep 11 11:46:32 2018 +0200 Precise Secret Service API in auth.texi (Bug#29575) * doc/misc/auth.texi (Secret Service API): Item labels are not unique. Document this. (Bug#29575) diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi index 9cf16d8ed4..fcbc83ead5 100644 --- a/doc/misc/auth.texi +++ b/doc/misc/auth.texi @@ -348,25 +348,36 @@ Returns all the item labels of @var{collection} as a list. @defun secrets-create-item collection item password &rest attributes This function creates a new item in @var{collection} with label -@var{item} and password @var{password}. @var{attributes} are -key-value pairs set for the created item. The keys are keyword -symbols, starting with a colon. Example: +@var{item} and password @var{password}. The label @var{item} does not +have to be unique in @var{collection}. @var{attributes} are key-value +pairs set for the created item. The keys are keyword symbols, +starting with a colon. Example: @example -;;; The session "session", the label is "my item" -;;; and the secret (password) is "geheim" +;;; The session is "session", the label is "my item" +;;; and the secret (password) is "geheim". (secrets-create-item "session" "my item" "geheim" :method "sudo" :user "joe" :host "remote-host") @end example + +The key @code{:xdg:schema} determines the scope of the item to be +generated, i.e.@: for which applications the item is intended for. +This is just a string like "org.freedesktop.NetworkManager.Mobile" or +"org.gnome.OnlineAccounts", the other required keys are determined by +this. If no @code{:xdg:schema} is given, +"org.freedesktop.Secret.Generic" is used by default. @end defun @defun secrets-get-secret collection item -Return the secret of item labeled @var{item} in @var{collection}. -If there is no such item, return @code{nil}. +Return the secret of item labeled @var{item} in @var{collection}. If +there are several items labeled @var{item}, it is undefined which one +is returned. If there is no such item, return @code{nil}. @end defun @defun secrets-delete-item collection item -This function deletes item @var{item} in @var{collection}. +This function deletes item @var{item} in @var{collection}. If there +are several items labeled @var{item}, it is undefined which one is +deleted. @end defun The lookup attributes, which are specified during creation of a @@ -376,18 +387,20 @@ from a given secret item and they can be used for searching of items. @defun secrets-get-attribute collection item attribute Returns the value of key @var{attribute} of item labeled @var{item} in -@var{collection}. If there is no such item, or the item doesn't own -this key, the function returns @code{nil}. +@var{collection}. If there are several items labeled @var{item}, it +is undefined which one is returned. If there is no such item, or the +item doesn't own this key, the function returns @code{nil}. @end defun @defun secrets-get-attributes collection item Return the lookup attributes of item labeled @var{item} in -@var{collection}. If there is no such item, or the item has no -attributes, it returns @code{nil}. Example: +@var{collection}. If there are several items labeled @var{item}, it +is undefined which one is returned. If there is no such item, or the +item has no attributes, it returns @code{nil}. Example: @example (secrets-get-attributes "session" "my item") - @result{} ((:user . "joe") (:host ."remote-host")) + @result{} ((:user . "joe") (:host . "remote-host")) @end example @end defun commit ff374e4491c7b9ba2c3c2838865facf129444a7e Author: Eli Zaretskii Date: Tue Sep 11 10:30:25 2018 +0300 * doc/lispref/display.texi (SVG Images): Improve wording. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index d6f35276e9..deabd31d77 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -5401,7 +5401,8 @@ Specifies a rotation angle in degrees. SVG (Scalable Vector Graphics) is an XML format for specifying images. If your Emacs build has SVG support, you can create and manipulate -these images with the following functions. +these images with the following functions from the @file{svg.el} +library. @defun svg-create width height &rest args Create a new, empty SVG image with the specified dimensions. @@ -5415,8 +5416,11 @@ The default width (in pixels) of any lines created. The default stroke color on any lines created. @end table -This function returns an SVG structure, and all the following functions -work on that structure. +@cindex SVG object +This function returns an @dfn{SVG object}, a Lisp data structure that +specifies an SVG image, and all the following functions work on that +structure. The argument @var{svg} in the following functions +specifies such an SVG object. @end defun @defun svg-gradient svg id type stops @@ -5460,8 +5464,8 @@ gradient object. @end table @defun svg-rectangle svg x y width height &rest args -Add a rectangle to @var{svg} where the upper left corner is at -position @var{x}/@var{y} and is of size @var{width}/@var{height}. +Add to @var{svg} a rectangle whose upper left corner is at +position @var{x}/@var{y} and whose size is @var{width}/@var{height}. @lisp (svg-rectangle svg 100 100 500 500 :gradient "gradient1") @@ -5469,24 +5473,24 @@ position @var{x}/@var{y} and is of size @var{width}/@var{height}. @end defun @defun svg-circle svg x y radius &rest args -Add a circle to @var{svg} where the center is at @var{x}/@var{y} -and the radius is @var{radius}. +Add to @var{svg} a circle whose center is at @var{x}/@var{y} and whose +radius is @var{radius}. @end defun @defun svg-ellipse svg x y x-radius y-radius &rest args -Add a circle to @var{svg} where the center is at @var{x}/@var{y} and -the horizontal radius is @var{x-radius} and the vertical radius is +Add to @var{svg} an ellipse whose center is at @var{x}/@var{y}, and +whose horizontal radius is @var{x-radius} and the vertical radius is @var{y-radius}. @end defun @defun svg-line svg x1 y1 x2 y2 &rest args -Add a line to @var{svg} that starts at @var{x1}/@var{y1} and extends +Add to @var{svg} a line that starts at @var{x1}/@var{y1} and extends to @var{x2}/@var{y2}. @end defun @defun svg-polyline svg points &rest args -Add a multiple segment line to @var{svg} that goes through -@var{points}, which is a list of X/Y position pairs. +Add to @var{svg} a multiple-segment line (a.k.a.@: ``polyline'') that +goes through @var{points}, which is a list of X/Y position pairs. @lisp (svg-polyline svg '((200 . 100) (500 . 450) (80 . 100)) @@ -5505,7 +5509,7 @@ that describe the outer circumference of the polygon. @end defun @defun svg-text svg text &rest args -Add a text to @var{svg}. +Add the specified @var{text} to @var{svg}. @lisp (svg-text @@ -5524,9 +5528,9 @@ Add a text to @var{svg}. @defun svg-embed svg image image-type datap &rest args Add an embedded (raster) image to @var{svg}. If @var{datap} is -@code{nil}, @var{IMAGE} should be a file name; if not, it should be a -binary string containing the image data. @var{image-type} should be a -@acronym{MIME} image type, for instance @samp{"image/jpeg"}. +@code{nil}, @var{image} should be a file name; otherwise it should be a +string containing the image data as raw bytes. @var{image-type} should be a +@acronym{MIME} image type, for instance @code{"image/jpeg"}. @lisp (svg-embed svg "~/rms.jpg" "image/jpeg" nil @@ -5539,10 +5543,14 @@ binary string containing the image data. @var{image-type} should be a Remove the element with identifier @code{id} from the @code{svg}. @end defun -Finally, the @code{svg-image} takes an SVG object as its parameter and +@defun svg-image svg +Finally, the @code{svg-image} takes an SVG object as its argument and returns an image object suitable for use in functions like -@code{insert-image}. Here's a complete example that creates and -inserts an image with a circle: +@code{insert-image}. +@end defun + +Here's a complete example that creates and inserts an image with a +circle: @lisp (let ((svg (svg-create 400 400 :stroke-width 10))) commit 3a0caf6b7df3c0646f96db1d033cb0404658f2c0 Author: Eli Zaretskii Date: Tue Sep 11 10:12:49 2018 +0300 * doc/lispref/display.texi (SVG Images): Fix a typo. (Bug#32690) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index aed103ee2c..d6f35276e9 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -5500,7 +5500,7 @@ that describe the outer circumference of the polygon. @lisp (svg-polygon svg '((100 . 100) (200 . 150) (150 . 90)) - :stroke-color "blue" :fill-color "red"") + :stroke-color "blue" :fill-color "red") @end lisp @end defun commit ef93983344e748124ac9bc218700cee14a0df947 Author: Paul Eggert Date: Mon Sep 10 21:22:05 2018 -0700 Adjust to TIMESPEC_HZ renaming Adjust to lib/timespec.h’s renaming of TIMESPEC_RESOLUTION and LOG10_TIMESPEC_RESOLUTION to TIMESPEC_HZ and LOG10_TIMESPEC_HZ. The old names were misnomers. All uses changed. diff --git a/lib-src/profile.c b/lib-src/profile.c index 3818d33e68..cccdfbc7c8 100644 --- a/lib-src/profile.c +++ b/lib-src/profile.c @@ -43,7 +43,7 @@ along with GNU Emacs. If not, see . */ static struct timespec TV1; static int watch_not_started = 1; /* flag */ static char time_string[INT_STRLEN_BOUND (uintmax_t) + sizeof "." - + LOG10_TIMESPEC_RESOLUTION]; + + LOG10_TIMESPEC_HZ]; /* Reset the stopwatch to zero. */ @@ -66,7 +66,7 @@ get_time (void) int ns = TV2.tv_nsec; if (watch_not_started) exit (EXIT_FAILURE); /* call reset_watch first ! */ - sprintf (time_string, "%"PRIuMAX".%0*d", s, LOG10_TIMESPEC_RESOLUTION, ns); + sprintf (time_string, "%"PRIuMAX".%0*d", s, LOG10_TIMESPEC_HZ, ns); return time_string; } diff --git a/src/gtkutil.c b/src/gtkutil.c index 4250355a2f..6212e1af4e 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -1867,7 +1867,7 @@ xg_maybe_add_timer (gpointer data) if (timespec_valid_p (next_time)) { time_t s = next_time.tv_sec; - int per_ms = TIMESPEC_RESOLUTION / 1000; + int per_ms = TIMESPEC_HZ / 1000; int ms = (next_time.tv_nsec + per_ms - 1) / per_ms; if (s <= ((guint) -1 - ms) / 1000) dd->timerid = g_timeout_add (s * 1000 + ms, xg_maybe_add_timer, dd); diff --git a/src/process.c b/src/process.c index 4d96e46976..b4ba641f31 100644 --- a/src/process.c +++ b/src/process.c @@ -252,7 +252,7 @@ static EMACS_INT update_tick; # define HAVE_SEQPACKET #endif -#define READ_OUTPUT_DELAY_INCREMENT (TIMESPEC_RESOLUTION / 100) +#define READ_OUTPUT_DELAY_INCREMENT (TIMESPEC_HZ / 100) #define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5) #define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7) @@ -5478,7 +5478,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, have waited a long amount of time due to repeated timers. */ struct timespec huge_timespec - = make_timespec (TYPE_MAXIMUM (time_t), 2 * TIMESPEC_RESOLUTION); + = make_timespec (TYPE_MAXIMUM (time_t), 2 * TIMESPEC_HZ); struct timespec cmp_time = huge_timespec; if (wait < TIMEOUT || (wait_proc diff --git a/src/sysdep.c b/src/sysdep.c index 52afa2f0e1..ecbbbbc0ef 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -3078,16 +3078,15 @@ time_from_jiffies (unsigned long long tval, long hz) if (TYPE_MAXIMUM (time_t) < s) time_overflow (); - if (LONG_MAX - 1 <= ULLONG_MAX / TIMESPEC_RESOLUTION - || frac <= ULLONG_MAX / TIMESPEC_RESOLUTION) - ns = frac * TIMESPEC_RESOLUTION / hz; + if (LONG_MAX - 1 <= ULLONG_MAX / TIMESPEC_HZ + || frac <= ULLONG_MAX / TIMESPEC_HZ) + ns = frac * TIMESPEC_HZ / hz; else { /* This is reachable only in the unlikely case that HZ * HZ exceeds ULLONG_MAX. It calculates an approximation that is guaranteed to be in range. */ - long hz_per_ns = (hz / TIMESPEC_RESOLUTION - + (hz % TIMESPEC_RESOLUTION != 0)); + long hz_per_ns = hz / TIMESPEC_HZ + (hz % TIMESPEC_HZ != 0); ns = frac / hz_per_ns; } @@ -3123,16 +3122,16 @@ get_up_time (void) if (TYPE_MAXIMUM (time_t) < upsec) { upsec = TYPE_MAXIMUM (time_t); - upfrac = TIMESPEC_RESOLUTION - 1; + upfrac = TIMESPEC_HZ - 1; } else { int upfraclen = upfrac_end - upfrac_start; - for (; upfraclen < LOG10_TIMESPEC_RESOLUTION; upfraclen++) + for (; upfraclen < LOG10_TIMESPEC_HZ; upfraclen++) upfrac *= 10; - for (; LOG10_TIMESPEC_RESOLUTION < upfraclen; upfraclen--) + for (; LOG10_TIMESPEC_HZ < upfraclen; upfraclen--) upfrac /= 10; - upfrac = min (upfrac, TIMESPEC_RESOLUTION - 1); + upfrac = min (upfrac, TIMESPEC_HZ - 1); } up = make_timespec (upsec, upfrac); } diff --git a/src/systime.h b/src/systime.h index b2f893714b..ede3d4eb12 100644 --- a/src/systime.h +++ b/src/systime.h @@ -58,8 +58,8 @@ invalid_timespec (void) } /* Return true if TIME is a valid timespec. This currently doesn't worry - about whether tv_nsec is less than TIMESPEC_RESOLUTION; leap seconds - might cause a problem if it did. */ + about whether tv_nsec is less than TIMESPEC_HZ; leap seconds might + cause a problem if it did. */ INLINE bool timespec_valid_p (struct timespec t) { commit fc389d3a836c11893ac5c5894915e9b8b4868799 Author: Paul Eggert Date: Mon Sep 10 21:16:03 2018 -0700 Update from Gnulib This incorporates: 2018-09-10 timespec: fix resolution confusion 2018-09-09 mktime: simplify in prep for glibc merge 2018-09-07 intprops: minor clarification of code 2018-09-06 stddef: Override max_align_t on NetBSD 8.0/x86 2018-09-06 fcntl: Fix F_DUPFD_CLOEXEC behaviour on Haiku 2018-09-06 strtoll, strtoull: Rely on limits-h module 2018-09-06 limits-h: Provide numerical limits macros 2018-09-06 fcntl: Don't access nonexistent optional argument 2018-09-02 mktime: fix unlikely race+overflow bug 2018-08-31 mktime, timegm: simplify glibc time64_t 2018-08-31 mktime, timegm: simplify merge to glibc * build-aux/config.guess, build-aux/config.sub: * lib/dtotimespec.c, lib/fcntl.c, lib/intprops.h: * lib/limits.in.h, lib/mktime-internal.h, lib/mktime.c: * lib/stat-time.h, lib/strtol.c, lib/timegm.c: * lib/timespec-add.c, lib/timespec-sub.c, lib/timespec.h: * lib/utimens.c, m4/limits-h.m4, m4/stddef_h.m4: Copy from Gnulib. diff --git a/build-aux/config.guess b/build-aux/config.guess index d4fb3213ec..b33c9e890e 100755 --- a/build-aux/config.guess +++ b/build-aux/config.guess @@ -2,7 +2,7 @@ # Attempt to guess a canonical system name. # Copyright 1992-2018 Free Software Foundation, Inc. -timestamp='2018-08-02' +timestamp='2018-08-29' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -838,7 +838,7 @@ EOF *:BSD/OS:*:*) echo "$UNAME_MACHINE"-unknown-bsdi"$UNAME_RELEASE" exit ;; - arm*:FreeBSD:*:*) + arm:FreeBSD:*:*) UNAME_PROCESSOR=`uname -p` set_cc_for_build if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ diff --git a/build-aux/config.sub b/build-aux/config.sub index 49b16732eb..b51fb8cdb6 100755 --- a/build-aux/config.sub +++ b/build-aux/config.sub @@ -2,7 +2,7 @@ # Configuration validation subroutine script. # Copyright 1992-2018 Free Software Foundation, Inc. -timestamp='2018-08-24' +timestamp='2018-08-29' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -639,194 +639,162 @@ case $1 in ;; esac -# Decode aliases for certain CPU-COMPANY combinations. +# Decode 1-component or ad-hoc basic machines case $basic_machine in # Here we handle the default manufacturer of certain CPU types. It is in # some cases the only manufacturer, in others, it is the most popular. - craynv) - basic_machine=craynv-cray - os=${os:-unicosmp} - ;; - fx80) - basic_machine=fx80-alliant - ;; w89k) - basic_machine=hppa1.1-winbond + cpu=hppa1.1 + vendor=winbond ;; op50n) - basic_machine=hppa1.1-oki + cpu=hppa1.1 + vendor=oki ;; op60c) - basic_machine=hppa1.1-oki - ;; - romp) - basic_machine=romp-ibm - ;; - mmix) - basic_machine=mmix-knuth - ;; - rs6000) - basic_machine=rs6000-ibm + cpu=hppa1.1 + vendor=oki ;; - vax) - basic_machine=vax-dec - ;; - pdp11) - basic_machine=pdp11-dec - ;; - we32k) - basic_machine=we32k-att - ;; - cydra) - basic_machine=cydra-cydrome - ;; - i370-ibm* | ibm*) - basic_machine=i370-ibm - ;; - orion) - basic_machine=orion-highlevel + ibm*) + cpu=i370 + vendor=ibm ;; orion105) - basic_machine=clipper-highlevel + cpu=clipper + vendor=highlevel ;; mac | mpw | mac-mpw) - basic_machine=m68k-apple - ;; - microblaze | microblazeel) - basic_machine=$basic_machine-xilinx + cpu=m68k + vendor=apple ;; pmac | pmac-mpw) - basic_machine=powerpc-apple - ;; - xps | xps100) - basic_machine=xps100-honeywell + cpu=powerpc + vendor=apple ;; # Recognize the various machine names and aliases which stand # for a CPU type and a company and sometimes even an OS. 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc) - basic_machine=m68000-att + cpu=m68000 + vendor=att ;; 3b*) - basic_machine=we32k-att - ;; - blackfin-*) - basic_machine=bfin-`echo "$basic_machine" | sed 's/^[^-]*-//'` - os=linux + cpu=we32k + vendor=att ;; bluegene*) - basic_machine=powerpc-ibm + cpu=powerpc + vendor=ibm os=cnk ;; - c54x-*) - basic_machine=tic54x-`echo "$basic_machine" | sed 's/^[^-]*-//'` - ;; - c55x-*) - basic_machine=tic55x-`echo "$basic_machine" | sed 's/^[^-]*-//'` - ;; - c6x-*) - basic_machine=tic6x-`echo "$basic_machine" | sed 's/^[^-]*-//'` - ;; - c90) - basic_machine=c90-cray - os=${os:-unicos} - ;; decsystem10* | dec10*) - basic_machine=pdp10-dec + cpu=pdp10 + vendor=dec os=tops10 ;; decsystem20* | dec20*) - basic_machine=pdp10-dec + cpu=pdp10 + vendor=dec os=tops20 ;; delta | 3300 | motorola-3300 | motorola-delta \ | 3300-motorola | delta-motorola) - basic_machine=m68k-motorola - ;; - dpx20 | dpx20-*) - basic_machine=rs6000-bull - os=${os:-bosx} + cpu=m68k + vendor=motorola ;; dpx2*) - basic_machine=m68k-bull + cpu=m68k + vendor=bull os=sysv3 ;; - e500v[12]) - basic_machine=powerpc-unknown - os=$os"spe" - ;; - e500v[12]-*) - basic_machine=powerpc-`echo "$basic_machine" | sed 's/^[^-]*-//'` - os=$os"spe" - ;; encore | umax | mmax) - basic_machine=ns32k-encore + cpu=ns32k + vendor=encore ;; elxsi) - basic_machine=elxsi-elxsi + cpu=elxsi + vendor=elxsi os=${os:-bsd} ;; fx2800) - basic_machine=i860-alliant + cpu=i860 + vendor=alliant ;; genix) - basic_machine=ns32k-ns + cpu=ns32k + vendor=ns ;; h3050r* | hiux*) - basic_machine=hppa1.1-hitachi + cpu=hppa1.1 + vendor=hitachi os=hiuxwe2 ;; hp3k9[0-9][0-9] | hp9[0-9][0-9]) - basic_machine=hppa1.0-hp + cpu=hppa1.0 + vendor=hp ;; hp9k2[0-9][0-9] | hp9k31[0-9]) - basic_machine=m68000-hp + cpu=m68000 + vendor=hp ;; hp9k3[2-9][0-9]) - basic_machine=m68k-hp + cpu=m68k + vendor=hp ;; hp9k6[0-9][0-9] | hp6[0-9][0-9]) - basic_machine=hppa1.0-hp + cpu=hppa1.0 + vendor=hp ;; hp9k7[0-79][0-9] | hp7[0-79][0-9]) - basic_machine=hppa1.1-hp + cpu=hppa1.1 + vendor=hp ;; hp9k78[0-9] | hp78[0-9]) # FIXME: really hppa2.0-hp - basic_machine=hppa1.1-hp + cpu=hppa1.1 + vendor=hp ;; hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893) # FIXME: really hppa2.0-hp - basic_machine=hppa1.1-hp + cpu=hppa1.1 + vendor=hp ;; hp9k8[0-9][13679] | hp8[0-9][13679]) - basic_machine=hppa1.1-hp + cpu=hppa1.1 + vendor=hp ;; hp9k8[0-9][0-9] | hp8[0-9][0-9]) - basic_machine=hppa1.0-hp + cpu=hppa1.0 + vendor=hp ;; i*86v32) - basic_machine=`echo "$1" | sed -e 's/86.*/86-pc/'` + cpu=`echo "$1" | sed -e 's/86.*/86/'` + vendor=pc os=sysv32 ;; i*86v4*) - basic_machine=`echo "$1" | sed -e 's/86.*/86-pc/'` + cpu=`echo "$1" | sed -e 's/86.*/86/'` + vendor=pc os=sysv4 ;; i*86v) - basic_machine=`echo "$1" | sed -e 's/86.*/86-pc/'` + cpu=`echo "$1" | sed -e 's/86.*/86/'` + vendor=pc os=sysv ;; i*86sol2) - basic_machine=`echo "$1" | sed -e 's/86.*/86-pc/'` + cpu=`echo "$1" | sed -e 's/86.*/86/'` + vendor=pc os=solaris2 ;; j90 | j90-cray) - basic_machine=j90-cray + cpu=j90 + vendor=cray os=${os:-unicos} ;; iris | iris4d) - basic_machine=mips-sgi + cpu=mips + vendor=sgi case $os in irix*) ;; @@ -835,35 +803,23 @@ case $basic_machine in ;; esac ;; - leon-*|leon[3-9]-*) - basic_machine=sparc-`echo "$basic_machine" | sed 's/-.*//'` - ;; - m68knommu-*) - basic_machine=m68k-`echo "$basic_machine" | sed 's/^[^-]*-//'` - os=linux - ;; miniframe) - basic_machine=m68000-convergent + cpu=m68000 + vendor=convergent ;; *mint | mint[0-9]* | *MiNT | *MiNT[0-9]*) - basic_machine=m68k-atari + cpu=m68k + vendor=atari os=mint ;; - mips3*-*) - basic_machine=`echo "$basic_machine" | sed -e 's/mips3/mips64/'` - ;; - mips3*) - basic_machine=`echo "$basic_machine" | sed -e 's/mips3/mips64/'`-unknown - ;; - ms1-*) - basic_machine=`echo "$basic_machine" | sed -e 's/ms1-/mt-/'` - ;; news-3600 | risc-news) - basic_machine=mips-sony + cpu=mips + vendor=sony os=newsos ;; next | m*-next) - basic_machine=m68k-next + cpu=m68k + vendor=next case $os in nextstep* ) ;; @@ -876,441 +832,437 @@ case $basic_machine in esac ;; np1) - basic_machine=np1-gould + cpu=np1 + vendor=gould ;; op50n-* | op60c-*) - basic_machine=hppa1.1-oki + cpu=hppa1.1 + vendor=oki os=proelf ;; - openrisc | openrisc-*) - basic_machine=or32-unknown - ;; pa-hitachi) - basic_machine=hppa1.1-hitachi + cpu=hppa1.1 + vendor=hitachi os=hiuxwe2 ;; - parisc-*) - basic_machine=hppa-`echo "$basic_machine" | sed 's/^[^-]*-//'` - os=linux - ;; pbd) - basic_machine=sparc-tti + cpu=sparc + vendor=tti ;; pbb) - basic_machine=m68k-tti + cpu=m68k + vendor=tti ;; - pc532 | pc532-*) - basic_machine=ns32k-pc532 + pc532) + cpu=ns32k + vendor=pc532 ;; - pc98-*) - basic_machine=i386-`echo "$basic_machine" | sed 's/^[^-]*-//'` + pn) + cpu=pn + vendor=gould ;; - pentium | p5 | k5 | k6 | nexgen | viac3) - basic_machine=i586-pc + power) + cpu=power + vendor=ibm ;; - pentiumpro | p6 | 6x86 | athlon | athlon_*) - basic_machine=i686-pc + ps2) + cpu=i386 + vendor=ibm ;; - pentiumii | pentium2 | pentiumiii | pentium3) - basic_machine=i686-pc + rm[46]00) + cpu=mips + vendor=siemens ;; - pentium4) - basic_machine=i786-pc + rtpc | rtpc-*) + cpu=romp + vendor=ibm ;; - pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*) - basic_machine=i586-`echo "$basic_machine" | sed 's/^[^-]*-//'` + sde) + cpu=mipsisa32 + vendor=sde + os=${os:-elf} ;; - pentiumpro-* | p6-* | 6x86-* | athlon-*) - basic_machine=i686-`echo "$basic_machine" | sed 's/^[^-]*-//'` + simso-wrs) + cpu=sparclite + vendor=wrs + os=vxworks ;; - pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*) - basic_machine=i686-`echo "$basic_machine" | sed 's/^[^-]*-//'` + tower | tower-32) + cpu=m68k + vendor=ncr ;; - pentium4-*) - basic_machine=i786-`echo "$basic_machine" | sed 's/^[^-]*-//'` + vpp*|vx|vx-*) + cpu=f301 + vendor=fujitsu ;; - pn) - basic_machine=pn-gould + w65) + cpu=w65 + vendor=wdc ;; - power) basic_machine=power-ibm + w89k-*) + cpu=hppa1.1 + vendor=winbond + os=proelf ;; - ppc | ppcbe) basic_machine=powerpc-unknown + none) + cpu=none + vendor=none ;; - ppc-* | ppcbe-*) - basic_machine=powerpc-`echo "$basic_machine" | sed 's/^[^-]*-//'` + leon|leon[3-9]) + cpu=sparc + vendor=$basic_machine ;; - ppcle | powerpclittle) - basic_machine=powerpcle-unknown + leon-*|leon[3-9]-*) + cpu=sparc + vendor=`echo "$basic_machine" | sed 's/-.*//'` ;; - ppcle-* | powerpclittle-*) - basic_machine=powerpcle-`echo "$basic_machine" | sed 's/^[^-]*-//'` + + *-*) + IFS="-" read -r cpu vendor <&2 - exit 1 + # Recognize the cannonical CPU types that are allowed with any + # company name. + case $cpu in + 1750a | 580 \ + | a29k \ + | aarch64 | aarch64_be \ + | abacus \ + | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] \ + | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] \ + | alphapca5[67] | alpha64pca5[67] \ + | am33_2.0 \ + | arc | arceb \ + | arm | arm[lb]e | arme[lb] | armv* \ + | avr | avr32 \ + | asmjs \ + | ba \ + | be32 | be64 \ + | bfin | bs2000 \ + | c[123]* | c30 | [cjt]90 | c4x \ + | c8051 | clipper | craynv | csky | cydra \ + | d10v | d30v | dlx | dsp16xx \ + | e2k | elxsi | epiphany \ + | f30[01] | f700 | fido | fr30 | frv | ft32 | fx80 \ + | h8300 | h8500 \ + | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ + | hexagon \ + | i370 | i*86 | i860 | i960 | ia16 | ia64 \ + | ip2k | iq2000 \ + | k1om \ + | le32 | le64 \ + | lm32 \ + | m32c | m32r | m32rle \ + | m5200 | m68000 | m680[012346]0 | m68360 | m683?2 | m68k | v70 | w65 \ + | m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | nvptx | picochip \ + | m88110 | m88k | maxq | mb | mcore | mep | metag \ + | microblaze | microblazeel \ + | mips | mipsbe | mipseb | mipsel | mipsle \ + | mips16 \ + | mips64 | mips64el \ + | mips64octeon | mips64octeonel \ + | mips64orion | mips64orionel \ + | mips64r5900 | mips64r5900el \ + | mips64vr | mips64vrel \ + | mips64vr4100 | mips64vr4100el \ + | mips64vr4300 | mips64vr4300el \ + | mips64vr5000 | mips64vr5000el \ + | mips64vr5900 | mips64vr5900el \ + | mipsisa32 | mipsisa32el \ + | mipsisa32r2 | mipsisa32r2el \ + | mipsisa32r6 | mipsisa32r6el \ + | mipsisa64 | mipsisa64el \ + | mipsisa64r2 | mipsisa64r2el \ + | mipsisa64r6 | mipsisa64r6el \ + | mipsisa64sb1 | mipsisa64sb1el \ + | mipsisa64sr71k | mipsisa64sr71kel \ + | mipsr5900 | mipsr5900el \ + | mipstx39 | mipstx39el \ + | mmix \ + | mn10200 | mn10300 \ + | moxie \ + | mt \ + | msp430 \ + | nds32 | nds32le | nds32be \ + | nfp \ + | nios | nios2 | nios2eb | nios2el \ + | none | np1 | ns16k | ns32k \ + | open8 \ + | or1k* \ + | or32 \ + | orion \ + | pdp10 | pdp11 | pj | pjl | pn | power \ + | powerpc | powerpc64 | powerpc64le | powerpcle | powerpcspe \ + | pru \ + | pyramid \ + | riscv | riscv32 | riscv64 \ + | rl78 | romp | rs6000 | rx \ + | score \ + | sh | sh[1234] | sh[24]a | sh[24]ae[lb] | sh[23]e | she[lb] | sh[lb]e \ + | sh[1234]e[lb] | sh[12345][lb]e | sh[23]ele | sh64 | sh64le \ + | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet \ + | sparclite \ + | sparcv8 | sparcv9 | sparcv9b | sparcv9v | sv1 | sx* \ + | spu \ + | tahoe \ + | tic30 | tic4x | tic54x | tic55x | tic6x | tic80 \ + | tron \ + | ubicom32 \ + | v850 | v850e | v850e1 | v850es | v850e2 | v850e2v3 \ + | vax \ + | visium \ + | wasm32 \ + | we32k \ + | x86 | x86_64 | xc16x | xgate | xps100 \ + | xstormy16 | xtensa* \ + | ymp \ + | z8k | z80) + ;; + + *) + echo Invalid configuration \`"$1"\': machine \`"$cpu-$vendor"\' not recognized 1>&2 + exit 1 + ;; + esac ;; esac # Here we canonicalize certain aliases for manufacturers. -case $basic_machine in - *-digital*) - basic_machine=`echo "$basic_machine" | sed 's/digital.*/dec/'` +case $vendor in + digital*) + vendor=dec ;; - *-commodore*) - basic_machine=`echo "$basic_machine" | sed 's/commodore.*/cbm/'` + commodore*) + vendor=cbm ;; *) ;; @@ -1412,8 +1364,8 @@ case $os in # Remember, each alternative MUST END IN *, to match a version number. ;; qnx*) - case $basic_machine in - x86-* | i*86-*) + case $cpu in + x86 | i*86) ;; *) os=nto-$os @@ -1539,7 +1491,7 @@ case $os in # Until real need of OS specific support for # particular features comes up, bare metal # configurations are quite functional. - case $basic_machine in + case $cpu in arm*) os=eabi ;; @@ -1573,7 +1525,7 @@ else # will signal an error saying that MANUFACTURER isn't an operating # system, and we'll never get to this point. -case $basic_machine in +case $cpu-$vendor in score-*) os=elf ;; @@ -1754,9 +1706,8 @@ fi # Here we handle the case where we know the os, and the CPU type, but not the # manufacturer. We pick the logical manufacturer. -vendor=unknown -case $basic_machine in - *-unknown) +case $vendor in + unknown) case $os in riscix*) vendor=acorn @@ -1825,11 +1776,10 @@ case $basic_machine in vendor=stratus ;; esac - basic_machine=`echo "$basic_machine" | sed "s/unknown/$vendor/"` ;; esac -echo "$basic_machine-$os" +echo "$cpu-$vendor-$os" exit # Local variables: diff --git a/lib/dtotimespec.c b/lib/dtotimespec.c index 599f7427a9..dcbd28051c 100644 --- a/lib/dtotimespec.c +++ b/lib/dtotimespec.c @@ -32,20 +32,20 @@ dtotimespec (double sec) if (! (TYPE_MINIMUM (time_t) < sec)) return make_timespec (TYPE_MINIMUM (time_t), 0); else if (! (sec < 1.0 + TYPE_MAXIMUM (time_t))) - return make_timespec (TYPE_MAXIMUM (time_t), TIMESPEC_RESOLUTION - 1); + return make_timespec (TYPE_MAXIMUM (time_t), TIMESPEC_HZ - 1); else { time_t s = sec; - double frac = TIMESPEC_RESOLUTION * (sec - s); + double frac = TIMESPEC_HZ * (sec - s); long ns = frac; ns += ns < frac; - s += ns / TIMESPEC_RESOLUTION; - ns %= TIMESPEC_RESOLUTION; + s += ns / TIMESPEC_HZ; + ns %= TIMESPEC_HZ; if (ns < 0) { s--; - ns += TIMESPEC_RESOLUTION; + ns += TIMESPEC_HZ; } return make_timespec (s, ns); diff --git a/lib/fcntl.c b/lib/fcntl.c index be6583565b..8e976173c0 100644 --- a/lib/fcntl.c +++ b/lib/fcntl.c @@ -329,6 +329,12 @@ rpl_fcntl (int fd, int action, /* arg */...) result = dupfd (fd, target, O_CLOEXEC); break; #else /* HAVE_FCNTL */ +# if defined __HAIKU__ + /* On Haiku, the system fcntl (fd, F_DUPFD_CLOEXEC, target) sets + the FD_CLOEXEC flag on fd, not on target. Therefore avoid the + system fcntl in this case. */ +# define have_dupfd_cloexec -1 +# else /* Try the system call first, if the headers claim it exists (that is, if GNULIB_defined_F_DUPFD_CLOEXEC is 0), since we may be running with a glibc that has the macro but with an @@ -343,10 +349,10 @@ rpl_fcntl (int fd, int action, /* arg */...) if (0 <= result || errno != EINVAL) { have_dupfd_cloexec = 1; -# if REPLACE_FCHDIR +# if REPLACE_FCHDIR if (0 <= result) result = _gl_register_dup (fd, result); -# endif +# endif } else { @@ -357,6 +363,7 @@ rpl_fcntl (int fd, int action, /* arg */...) } } else +# endif result = rpl_fcntl (fd, F_DUPFD, target); if (0 <= result && have_dupfd_cloexec == -1) { @@ -405,8 +412,183 @@ rpl_fcntl (int fd, int action, /* arg */...) default: { #if HAVE_FCNTL - void *p = va_arg (arg, void *); - result = fcntl (fd, action, p); + switch (action) + { + #ifdef F_BARRIERFSYNC /* macOS */ + case F_BARRIERFSYNC: + #endif + #ifdef F_CHKCLEAN /* macOS */ + case F_CHKCLEAN: + #endif + #ifdef F_CLOSEM /* NetBSD, HP-UX */ + case F_CLOSEM: + #endif + #ifdef F_FLUSH_DATA /* macOS */ + case F_FLUSH_DATA: + #endif + #ifdef F_FREEZE_FS /* macOS */ + case F_FREEZE_FS: + #endif + #ifdef F_FULLFSYNC /* macOS */ + case F_FULLFSYNC: + #endif + #ifdef F_GETCONFINED /* macOS */ + case F_GETCONFINED: + #endif + #ifdef F_GETDEFAULTPROTLEVEL /* macOS */ + case F_GETDEFAULTPROTLEVEL: + #endif + #ifdef F_GETFD /* POSIX */ + case F_GETFD: + #endif + #ifdef F_GETFL /* POSIX */ + case F_GETFL: + #endif + #ifdef F_GETLEASE /* Linux */ + case F_GETLEASE: + #endif + #ifdef F_GETNOSIGPIPE /* macOS */ + case F_GETNOSIGPIPE: + #endif + #ifdef F_GETOWN /* POSIX */ + case F_GETOWN: + #endif + #ifdef F_GETPIPE_SZ /* Linux */ + case F_GETPIPE_SZ: + #endif + #ifdef F_GETPROTECTIONCLASS /* macOS */ + case F_GETPROTECTIONCLASS: + #endif + #ifdef F_GETPROTECTIONLEVEL /* macOS */ + case F_GETPROTECTIONLEVEL: + #endif + #ifdef F_GET_SEALS /* Linux */ + case F_GET_SEALS: + #endif + #ifdef F_GETSIG /* Linux */ + case F_GETSIG: + #endif + #ifdef F_MAXFD /* NetBSD */ + case F_MAXFD: + #endif + #ifdef F_RECYCLE /* macOS */ + case F_RECYCLE: + #endif + #ifdef F_SETFIFOENH /* HP-UX */ + case F_SETFIFOENH: + #endif + #ifdef F_THAW_FS /* macOS */ + case F_THAW_FS: + #endif + /* These actions take no argument. */ + result = fcntl (fd, action); + break; + + #ifdef F_ADD_SEALS /* Linux */ + case F_ADD_SEALS: + #endif + #ifdef F_BADFD /* Solaris */ + case F_BADFD: + #endif + #ifdef F_CHECK_OPENEVT /* macOS */ + case F_CHECK_OPENEVT: + #endif + #ifdef F_DUP2FD /* FreeBSD, AIX, Solaris */ + case F_DUP2FD: + #endif + #ifdef F_DUP2FD_CLOEXEC /* FreeBSD, Solaris */ + case F_DUP2FD_CLOEXEC: + #endif + #ifdef F_DUP2FD_CLOFORK /* Solaris */ + case F_DUP2FD_CLOFORK: + #endif + #ifdef F_DUPFD /* POSIX */ + case F_DUPFD: + #endif + #ifdef F_DUPFD_CLOEXEC /* POSIX */ + case F_DUPFD_CLOEXEC: + #endif + #ifdef F_DUPFD_CLOFORK /* Solaris */ + case F_DUPFD_CLOFORK: + #endif + #ifdef F_GETXFL /* Solaris */ + case F_GETXFL: + #endif + #ifdef F_GLOBAL_NOCACHE /* macOS */ + case F_GLOBAL_NOCACHE: + #endif + #ifdef F_MAKECOMPRESSED /* macOS */ + case F_MAKECOMPRESSED: + #endif + #ifdef F_MOVEDATAEXTENTS /* macOS */ + case F_MOVEDATAEXTENTS: + #endif + #ifdef F_NOCACHE /* macOS */ + case F_NOCACHE: + #endif + #ifdef F_NODIRECT /* macOS */ + case F_NODIRECT: + #endif + #ifdef F_NOTIFY /* Linux */ + case F_NOTIFY: + #endif + #ifdef F_OPLKACK /* IRIX */ + case F_OPLKACK: + #endif + #ifdef F_OPLKREG /* IRIX */ + case F_OPLKREG: + #endif + #ifdef F_RDAHEAD /* macOS */ + case F_RDAHEAD: + #endif + #ifdef F_SETBACKINGSTORE /* macOS */ + case F_SETBACKINGSTORE: + #endif + #ifdef F_SETCONFINED /* macOS */ + case F_SETCONFINED: + #endif + #ifdef F_SETFD /* POSIX */ + case F_SETFD: + #endif + #ifdef F_SETFL /* POSIX */ + case F_SETFL: + #endif + #ifdef F_SETLEASE /* Linux */ + case F_SETLEASE: + #endif + #ifdef F_SETNOSIGPIPE /* macOS */ + case F_SETNOSIGPIPE: + #endif + #ifdef F_SETOWN /* POSIX */ + case F_SETOWN: + #endif + #ifdef F_SETPIPE_SZ /* Linux */ + case F_SETPIPE_SZ: + #endif + #ifdef F_SETPROTECTIONCLASS /* macOS */ + case F_SETPROTECTIONCLASS: + #endif + #ifdef F_SETSIG /* Linux */ + case F_SETSIG: + #endif + #ifdef F_SINGLE_WRITER /* macOS */ + case F_SINGLE_WRITER: + #endif + /* These actions take an 'int' argument. */ + { + int x = va_arg (arg, int); + result = fcntl (fd, action, x); + } + break; + + default: + /* Other actions take a pointer argument. */ + { + void *p = va_arg (arg, void *); + result = fcntl (fd, action, p); + } + break; + } #else errno = EINVAL; #endif diff --git a/lib/intprops.h b/lib/intprops.h index 3d6b3cf4d9..cdaf6586cb 100644 --- a/lib/intprops.h +++ b/lib/intprops.h @@ -342,8 +342,8 @@ Arguments should be free of side effects. */ #define _GL_BINARY_OP_OVERFLOW(a, b, op_result_overflow) \ op_result_overflow (a, b, \ - _GL_INT_MINIMUM ((1 ? 0 : (b)) + (a)), \ - _GL_INT_MAXIMUM ((1 ? 0 : (b)) + (a))) + _GL_INT_MINIMUM (_GL_INT_CONVERT (a, b)), \ + _GL_INT_MAXIMUM (_GL_INT_CONVERT (a, b))) /* Store the low-order bits of A + B, A - B, A * B, respectively, into *R. Return 1 if the result overflows. See above for restrictions. */ diff --git a/lib/limits.in.h b/lib/limits.in.h index 2c809d97ac..89d7195488 100644 --- a/lib/limits.in.h +++ b/lib/limits.in.h @@ -28,15 +28,32 @@ #ifndef _@GUARD_PREFIX@_LIMITS_H #define _@GUARD_PREFIX@_LIMITS_H -/* For HP-UX 11.31. */ -#if defined LONG_LONG_MIN && !defined LLONG_MIN -# define LLONG_MIN LONG_LONG_MIN +#ifndef LLONG_MIN +# if defined LONG_LONG_MIN /* HP-UX 11.31 */ +# define LLONG_MIN LONG_LONG_MIN +# elif defined LONGLONG_MIN /* IRIX 6.5 */ +# define LLONG_MIN LONGLONG_MIN +# elif defined __GNUC__ +# define LLONG_MIN (- __LONG_LONG_MAX__ - 1LL) +# endif #endif -#if defined LONG_LONG_MAX && !defined LLONG_MAX -# define LLONG_MAX LONG_LONG_MAX +#ifndef LLONG_MAX +# if defined LONG_LONG_MAX /* HP-UX 11.31 */ +# define LLONG_MAX LONG_LONG_MAX +# elif defined LONGLONG_MAX /* IRIX 6.5 */ +# define LLONG_MAX LONGLONG_MAX +# elif defined __GNUC__ +# define LLONG_MAX __LONG_LONG_MAX__ +# endif #endif -#if defined ULONG_LONG_MAX && !defined ULLONG_MAX -# define ULLONG_MAX ULONG_LONG_MAX +#ifndef ULLONG_MAX +# if defined ULONG_LONG_MAX /* HP-UX 11.31 */ +# define ULLONG_MAX ULONG_LONG_MAX +# elif defined ULONGLONG_MAX /* IRIX 6.5 */ +# define ULLONG_MAX ULONGLONG_MAX +# elif defined __GNUC__ +# define ULLONG_MAX (__LONG_LONG_MAX__ * 2ULL + 1ULL) +# endif #endif /* The number of usable bits in an unsigned or signed integer type @@ -53,6 +70,19 @@ #define _GL_COB8(n) (_GL_COB4 ((n) >> 4) + _GL_COB4 (n)) #define _GL_COB4(n) (!!((n) & 8) + !!((n) & 4) + !!((n) & 2) + !!((n) & 1)) +#ifndef WORD_BIT +/* Assume 'int' is 32 bits wide. */ +# define WORD_BIT 32 +#endif +#ifndef LONG_BIT +/* Assume 'long' is 32 or 64 bits wide. */ +# if LONG_MAX == INT_MAX +# define LONG_BIT 32 +# else +# define LONG_BIT 64 +# endif +#endif + /* Macros specified by ISO/IEC TS 18661-1:2014. */ #if (! defined ULLONG_WIDTH \ diff --git a/lib/mktime-internal.h b/lib/mktime-internal.h index 92bdda6f6c..31cf3a4dab 100644 --- a/lib/mktime-internal.h +++ b/lib/mktime-internal.h @@ -35,3 +35,19 @@ typedef int mktime_offset_t; time_t mktime_internal (struct tm *, struct tm * (*) (time_t const *, struct tm *), mktime_offset_t *); + +/* Although glibc source code uses leading underscores, Gnulib wants + ordinary names. + + Portable standalone applications should supply a that + declares a POSIX-compliant localtime_r, for the benefit of older + implementations that lack localtime_r or have a nonstandard one. + Similarly for gmtime_r. See the gnulib time_r module for one way + to implement this. */ + +#undef __gmtime_r +#undef __localtime_r +#define __gmtime_r gmtime_r +#define __localtime_r localtime_r + +#define __mktime_internal mktime_internal diff --git a/lib/mktime.c b/lib/mktime.c index 007adf14e8..6953e984e5 100644 --- a/lib/mktime.c +++ b/lib/mktime.c @@ -28,6 +28,8 @@ Macro/expression Which gnulib module This compilation unit should define + _LIBC (glibc proper) mktime + NEED_MKTIME_WORKING mktime rpl_mktime || NEED_MKTIME_WINDOWS @@ -51,25 +53,70 @@ #include #include +#include +#include #include #include #if DEBUG_MKTIME # include -# include -# include /* Make it work even if the system's libc has its own mktime routine. */ # undef mktime # define mktime my_mktime +#endif /* DEBUG_MKTIME */ + +#ifndef NEED_MKTIME_INTERNAL +# define NEED_MKTIME_INTERNAL 0 +#endif +#ifndef NEED_MKTIME_WINDOWS +# define NEED_MKTIME_WINDOWS 0 +#endif +#ifndef NEED_MKTIME_WORKING +# define NEED_MKTIME_WORKING DEBUG_MKTIME #endif -#if NEED_MKTIME_WINDOWS /* on native Windows */ -# include -# include +#include "mktime-internal.h" + +#ifndef _LIBC +static void +my_tzset (void) +{ +# if NEED_MKTIME_WINDOWS + /* Rectify the value of the environment variable TZ. + There are four possible kinds of such values: + - Traditional US time zone names, e.g. "PST8PDT". Syntax: see + + - Time zone names based on geography, that contain one or more + slashes, e.g. "Europe/Moscow". + - Time zone names based on geography, without slashes, e.g. + "Singapore". + - Time zone names that contain explicit DST rules. Syntax: see + + The Microsoft CRT understands only the first kind. It produces incorrect + results if the value of TZ is of the other kinds. + But in a Cygwin environment, /etc/profile.d/tzset.sh sets TZ to a value + of the second kind for most geographies, or of the first kind in a few + other geographies. If it is of the second kind, neutralize it. For the + Microsoft CRT, an absent or empty TZ means the time zone that the user + has set in the Windows Control Panel. + If the value of TZ is of the third or fourth kind -- Cygwin programs + understand these syntaxes as well --, it does not matter whether we + neutralize it or not, since these values occur only when a Cygwin user + has set TZ explicitly; this case is 1. rare and 2. under the user's + responsibility. */ + const char *tz = getenv ("TZ"); + if (tz != NULL && strchr (tz, '/') != NULL) + _putenv ("TZ="); +# elif HAVE_TZSET + tzset (); +# endif +} +# undef __tzset +# define __tzset() my_tzset () #endif -#if NEED_MKTIME_WORKING || NEED_MKTIME_INTERNAL || DEBUG_MKTIME +#if defined _LIBC || NEED_MKTIME_WORKING || NEED_MKTIME_INTERNAL /* A signed type that can represent an integer number of years multiplied by three times the number of seconds in a year. It is @@ -150,19 +197,6 @@ const unsigned short int __mon_yday[2][13] = }; -#ifdef _LIBC -typedef time_t mktime_offset_t; -#else -/* Portable standalone applications should supply a that - declares a POSIX-compliant localtime_r, for the benefit of older - implementations that lack localtime_r or have a nonstandard one. - See the gnulib time_r module for one way to implement this. */ -# undef __localtime_r -# define __localtime_r localtime_r -# define __mktime_internal mktime_internal -# include "mktime-internal.h" -#endif - /* Do the values A and B differ according to the rules for tm_isdst? A and B differ if one is zero and the other positive. */ static bool @@ -304,6 +338,7 @@ ranged_convert (struct tm *(*convert) (const time_t *, struct tm *), return r; } + /* Convert *TP to a time_t value, inverting the monotonic and mostly-unit-linear conversion function CONVERT. Use *OFFSET to keep track of a guess at the offset of the result, @@ -355,6 +390,7 @@ __mktime_internal (struct tm *tp, long_int lmday = mday; long_int yday = mon_yday + lmday; + mktime_offset_t off = *offset; int negative_offset_guess; int sec_requested = sec; @@ -372,7 +408,7 @@ __mktime_internal (struct tm *tp, /* Invert CONVERT by probing. First assume the same offset as last time. */ - INT_SUBTRACT_WRAPV (0, *offset, &negative_offset_guess); + INT_SUBTRACT_WRAPV (0, off, &negative_offset_guess); t0 = ydhms_diff (year, yday, hour, min, sec, EPOCH_YEAR - TM_YEAR_BASE, 0, 0, 0, negative_offset_guess); @@ -478,64 +514,28 @@ __mktime_internal (struct tm *tp, return t; } -#endif /* NEED_MKTIME_WORKING || NEED_MKTIME_INTERNAL || DEBUG_MKTIME */ +#endif /* _LIBC || NEED_MKTIME_WORKING || NEED_MKTIME_INTERNAL */ -#if NEED_MKTIME_WORKING || NEED_MKTIME_WINDOWS || DEBUG_MKTIME - -# if NEED_MKTIME_WORKING || DEBUG_MKTIME -static mktime_offset_t localtime_offset; -# endif +#if defined _LIBC || NEED_MKTIME_WORKING || NEED_MKTIME_WINDOWS /* Convert *TP to a time_t value. */ time_t mktime (struct tm *tp) { -# if NEED_MKTIME_WINDOWS - /* Rectify the value of the environment variable TZ. - There are four possible kinds of such values: - - Traditional US time zone names, e.g. "PST8PDT". Syntax: see - - - Time zone names based on geography, that contain one or more - slashes, e.g. "Europe/Moscow". - - Time zone names based on geography, without slashes, e.g. - "Singapore". - - Time zone names that contain explicit DST rules. Syntax: see - - The Microsoft CRT understands only the first kind. It produces incorrect - results if the value of TZ is of the other kinds. - But in a Cygwin environment, /etc/profile.d/tzset.sh sets TZ to a value - of the second kind for most geographies, or of the first kind in a few - other geographies. If it is of the second kind, neutralize it. For the - Microsoft CRT, an absent or empty TZ means the time zone that the user - has set in the Windows Control Panel. - If the value of TZ is of the third or fourth kind -- Cygwin programs - understand these syntaxes as well --, it does not matter whether we - neutralize it or not, since these values occur only when a Cygwin user - has set TZ explicitly; this case is 1. rare and 2. under the user's - responsibility. */ - const char *tz = getenv ("TZ"); - if (tz != NULL && strchr (tz, '/') != NULL) - _putenv ("TZ="); -# endif - -# if NEED_MKTIME_WORKING || DEBUG_MKTIME -# ifdef _LIBC /* POSIX.1 8.1.1 requires that whenever mktime() is called, the time zone names contained in the external variable 'tzname' shall be set as if the tzset() function had been called. */ __tzset (); -# elif HAVE_TZSET - tzset (); -# endif +# if defined __LIBC || NEED_MKTIME_WORKING + static mktime_offset_t localtime_offset; return __mktime_internal (tp, __localtime_r, &localtime_offset); # else # undef mktime return mktime (tp); # endif } - -#endif /* NEED_MKTIME_WORKING || NEED_MKTIME_WINDOWS || DEBUG_MKTIME */ +#endif /* _LIBC || NEED_MKTIME_WORKING || NEED_MKTIME_WINDOWS */ #ifdef weak_alias weak_alias (mktime, timelocal) diff --git a/lib/stat-time.h b/lib/stat-time.h index 8e787bd3b2..69ebe85df1 100644 --- a/lib/stat-time.h +++ b/lib/stat-time.h @@ -213,7 +213,7 @@ stat_time_normalize (int result, struct stat *st _GL_UNUSED) #if defined __sun && defined STAT_TIMESPEC if (result == 0) { - long int timespec_resolution = 1000000000; + long int timespec_hz = 1000000000; short int const ts_off[] = { offsetof (struct stat, st_atim), offsetof (struct stat, st_mtim), offsetof (struct stat, st_ctim) }; @@ -221,11 +221,11 @@ stat_time_normalize (int result, struct stat *st _GL_UNUSED) for (i = 0; i < sizeof ts_off / sizeof *ts_off; i++) { struct timespec *ts = (struct timespec *) ((char *) st + ts_off[i]); - long int q = ts->tv_nsec / timespec_resolution; - long int r = ts->tv_nsec % timespec_resolution; + long int q = ts->tv_nsec / timespec_hz; + long int r = ts->tv_nsec % timespec_hz; if (r < 0) { - r += timespec_resolution; + r += timespec_hz; q--; } ts->tv_nsec = r; diff --git a/lib/strtol.c b/lib/strtol.c index 55871b4c78..f6f5c3268d 100644 --- a/lib/strtol.c +++ b/lib/strtol.c @@ -117,35 +117,6 @@ # define STRTOL_LONG_MIN LLONG_MIN # define STRTOL_LONG_MAX LLONG_MAX # define STRTOL_ULONG_MAX ULLONG_MAX - -/* The extra casts in the following macros work around compiler bugs, - e.g., in Cray C 5.0.3.0. */ - -/* True if the arithmetic type T is signed. */ -# define TYPE_SIGNED(t) (! ((t) 0 < (t) -1)) - -/* Minimum and maximum values for integer types. - These macros have undefined behavior for signed types that either - have padding bits or do not use two's complement. If this is a - problem for you, please let us know how to fix it for your host. */ - -/* The maximum and minimum values for the integer type T. */ -# define TYPE_MINIMUM(t) ((t) ~ TYPE_MAXIMUM (t)) -# define TYPE_MAXIMUM(t) \ - ((t) (! TYPE_SIGNED (t) \ - ? (t) -1 \ - : ((((t) 1 << (sizeof (t) * CHAR_BIT - 2)) - 1) * 2 + 1))) - -# ifndef ULLONG_MAX -# define ULLONG_MAX TYPE_MAXIMUM (unsigned long long) -# endif -# ifndef LLONG_MAX -# define LLONG_MAX TYPE_MAXIMUM (long long int) -# endif -# ifndef LLONG_MIN -# define LLONG_MIN TYPE_MINIMUM (long long int) -# endif - # if __GNUC__ == 2 && __GNUC_MINOR__ < 7 /* Work around gcc bug with using this constant. */ static const unsigned long long int maxquad = ULLONG_MAX; diff --git a/lib/timegm.c b/lib/timegm.c index 7eb5ecbe33..9d9ab11125 100644 --- a/lib/timegm.c +++ b/lib/timegm.c @@ -1,20 +1,21 @@ /* Convert UTC calendar time to simple time. Like mktime but assumes UTC. - Copyright (C) 1994, 1997, 2003-2004, 2006-2007, 2009-2018 Free Software - Foundation, Inc. This file is part of the GNU C Library. + Copyright (C) 1994-2018 Free Software Foundation, Inc. + This file is part of the GNU C Library. - This program 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, or (at your option) - any later version. + The GNU C Library 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. - This program is distributed in the hope that it will be useful, + The GNU C Library 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. + 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 this program; if not, see . */ + You should have received a copy of the GNU General Public + License along with the GNU C Library; if not, see + . */ #ifndef _LIBC # include @@ -22,14 +23,7 @@ #include -#ifdef _LIBC -typedef time_t mktime_offset_t; -#else -# undef __gmtime_r -# define __gmtime_r gmtime_r -# define __mktime_internal mktime_internal -# include "mktime-internal.h" -#endif +#include "mktime-internal.h" time_t timegm (struct tm *tmp) diff --git a/lib/timespec-add.c b/lib/timespec-add.c index f6a8c38b33..1913b979ed 100644 --- a/lib/timespec-add.c +++ b/lib/timespec-add.c @@ -18,7 +18,7 @@ /* Written by Paul Eggert. */ /* Return the sum of two timespec values A and B. On overflow, return - an extremal value. This assumes 0 <= tv_nsec < TIMESPEC_RESOLUTION. */ + an extremal value. This assumes 0 <= tv_nsec < TIMESPEC_HZ. */ #include #include "timespec.h" @@ -31,7 +31,7 @@ timespec_add (struct timespec a, struct timespec b) time_t rs = a.tv_sec; time_t bs = b.tv_sec; int ns = a.tv_nsec + b.tv_nsec; - int nsd = ns - TIMESPEC_RESOLUTION; + int nsd = ns - TIMESPEC_HZ; int rns = ns; time_t tmin = TYPE_MINIMUM (time_t); time_t tmax = TYPE_MAXIMUM (time_t); @@ -63,7 +63,7 @@ timespec_add (struct timespec a, struct timespec b) { high_overflow: rs = tmax; - rns = TIMESPEC_RESOLUTION - 1; + rns = TIMESPEC_HZ - 1; } } diff --git a/lib/timespec-sub.c b/lib/timespec-sub.c index 398a6a5de4..9eac36e51a 100644 --- a/lib/timespec-sub.c +++ b/lib/timespec-sub.c @@ -19,7 +19,7 @@ /* Return the difference between two timespec values A and B. On overflow, return an extremal value. This assumes 0 <= tv_nsec < - TIMESPEC_RESOLUTION. */ + TIMESPEC_HZ. */ #include #include "timespec.h" @@ -38,7 +38,7 @@ timespec_sub (struct timespec a, struct timespec b) if (ns < 0) { - rns = ns + TIMESPEC_RESOLUTION; + rns = ns + TIMESPEC_HZ; if (bs < tmax) bs++; else if (- TYPE_SIGNED (time_t) < rs) @@ -63,7 +63,7 @@ timespec_sub (struct timespec a, struct timespec b) else { rs = tmax; - rns = TIMESPEC_RESOLUTION - 1; + rns = TIMESPEC_HZ - 1; } } diff --git a/lib/timespec.h b/lib/timespec.h index 94ba8d0b6a..c414cfe45e 100644 --- a/lib/timespec.h +++ b/lib/timespec.h @@ -35,11 +35,17 @@ extern "C" { #include "verify.h" -/* Resolution of timespec timestamps (in units per second), and log - base 10 of the resolution. */ +/* Inverse resolution of timespec timestamps (in units per second), + and log base 10 of the inverse resolution. */ -enum { TIMESPEC_RESOLUTION = 1000000000 }; -enum { LOG10_TIMESPEC_RESOLUTION = 9 }; +enum { TIMESPEC_HZ = 1000000000 }; +enum { LOG10_TIMESPEC_HZ = 9 }; + +/* Obsolescent names for backward compatibility. + They are misnomers, because TIMESPEC_RESOLUTION is not a resolution. */ + +enum { TIMESPEC_RESOLUTION = TIMESPEC_HZ }; +enum { LOG10_TIMESPEC_RESOLUTION = LOG10_TIMESPEC_HZ }; /* Return a timespec with seconds S and nanoseconds NS. */ @@ -88,8 +94,8 @@ timespec_cmp (struct timespec a, struct timespec b) /* Pacify gcc -Wstrict-overflow (bleeding-edge circa 2017-10-02). See: https://lists.gnu.org/r/bug-gnulib/2017-10/msg00006.html */ - assume (-1 <= a.tv_nsec && a.tv_nsec <= 2 * TIMESPEC_RESOLUTION); - assume (-1 <= b.tv_nsec && b.tv_nsec <= 2 * TIMESPEC_RESOLUTION); + assume (-1 <= a.tv_nsec && a.tv_nsec <= 2 * TIMESPEC_HZ); + assume (-1 <= b.tv_nsec && b.tv_nsec <= 2 * TIMESPEC_HZ); return a.tv_nsec - b.tv_nsec; } diff --git a/lib/utimens.c b/lib/utimens.c index e65f55d82f..f6c4fe34c7 100644 --- a/lib/utimens.c +++ b/lib/utimens.c @@ -91,11 +91,11 @@ validate_timespec (struct timespec timespec[2]) if ((timespec[0].tv_nsec != UTIME_NOW && timespec[0].tv_nsec != UTIME_OMIT && ! (0 <= timespec[0].tv_nsec - && timespec[0].tv_nsec < TIMESPEC_RESOLUTION)) + && timespec[0].tv_nsec < TIMESPEC_HZ)) || (timespec[1].tv_nsec != UTIME_NOW && timespec[1].tv_nsec != UTIME_OMIT && ! (0 <= timespec[1].tv_nsec - && timespec[1].tv_nsec < TIMESPEC_RESOLUTION))) + && timespec[1].tv_nsec < TIMESPEC_HZ))) { errno = EINVAL; return -1; diff --git a/m4/limits-h.m4 b/m4/limits-h.m4 index 8388663439..3a2cd91ead 100644 --- a/m4/limits-h.m4 +++ b/m4/limits-h.m4 @@ -11,14 +11,18 @@ AC_DEFUN_ONCE([gl_LIMITS_H], [ gl_CHECK_NEXT_HEADERS([limits.h]) - AC_CACHE_CHECK([whether limits.h has ULLONG_WIDTH etc.], + AC_CACHE_CHECK([whether limits.h has LLONG_MAX, WORD_BIT, ULLONG_WIDTH etc.], [gl_cv_header_limits_width], [AC_COMPILE_IFELSE( - [AC_LANG_PROGRAM([[#ifndef __STDC_WANT_IEC_60559_BFP_EXT__ - #define __STDC_WANT_IEC_60559_BFP_EXT__ 1 - #endif - #include - int ullw = ULLONG_WIDTH;]])], + [AC_LANG_PROGRAM( + [[#ifndef __STDC_WANT_IEC_60559_BFP_EXT__ + #define __STDC_WANT_IEC_60559_BFP_EXT__ 1 + #endif + #include + long long llm = LLONG_MAX; + int wb = WORD_BIT; + int ullw = ULLONG_WIDTH; + ]])], [gl_cv_header_limits_width=yes], [gl_cv_header_limits_width=no])]) if test "$gl_cv_header_limits_width" = yes; then diff --git a/m4/stddef_h.m4 b/m4/stddef_h.m4 index ba3d201cf3..07b040abdf 100644 --- a/m4/stddef_h.m4 +++ b/m4/stddef_h.m4 @@ -1,5 +1,5 @@ dnl A placeholder for , for platforms that have issues. -# stddef_h.m4 serial 5 +# stddef_h.m4 serial 6 dnl Copyright (C) 2009-2018 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -10,13 +10,33 @@ AC_DEFUN([gl_STDDEF_H], AC_REQUIRE([gl_STDDEF_H_DEFAULTS]) AC_REQUIRE([gt_TYPE_WCHAR_T]) STDDEF_H= - AC_CHECK_TYPE([max_align_t], [], [HAVE_MAX_ALIGN_T=0; STDDEF_H=stddef.h], - [[#include - ]]) + + dnl Test whether the type max_align_t exists and whether its alignment + dnl "is as great as is supported by the implementation in all contexts". + AC_CACHE_CHECK([for good max_align_t], + [gl_cv_type_max_align_t], + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [[#include + unsigned int s = sizeof (max_align_t); + #if defined __GNUC__ || defined __IBM__ALIGNOF__ + int check1[2 * (__alignof__ (double) <= __alignof__ (max_align_t)) - 1]; + int check2[2 * (__alignof__ (long double) <= __alignof__ (max_align_t)) - 1]; + #endif + ]])], + [gl_cv_type_max_align_t=yes], + [gl_cv_type_max_align_t=no]) + ]) + if test $gl_cv_type_max_align_t = no; then + HAVE_MAX_ALIGN_T=0 + STDDEF_H=stddef.h + fi + if test $gt_cv_c_wchar_t = no; then HAVE_WCHAR_T=0 STDDEF_H=stddef.h fi + AC_CACHE_CHECK([whether NULL can be used in arbitrary expressions], [gl_cv_decl_null_works], [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include @@ -28,6 +48,7 @@ AC_DEFUN([gl_STDDEF_H], REPLACE_NULL=1 STDDEF_H=stddef.h fi + AC_SUBST([STDDEF_H]) AM_CONDITIONAL([GL_GENERATE_STDDEF_H], [test -n "$STDDEF_H"]) if test -n "$STDDEF_H"; then commit 0407733ef3d4e8e133e91917097dbc9bcc688b47 Merge: 6e050694f2 7efcdf7b3e Author: Glenn Morris Date: Mon Sep 10 13:12:38 2018 -0700 Merge from origin/emacs-26 7efcdf7 (origin/emacs-26) Clarify completion text in the ELisp manual 30b0b0e Fix handling of abbreviated control command in gdb-mi.el 5cf282d Clarify documentation of functions reading character events 96281c5 Record :version for built-in variables while dumping 82160cf * src/process.c (connect_network_socket): Fix memory leak. (... 6c616e4 * Makefile.in (appdatadir): Use the non-obsolete location "me... 9618e16 Better fix for bug#32550 30d94e4 Fix Bug#32550 57bcdc7 Don't call XGetGeometry for frames without outer X window (Bu... 82fc6b6 * lisp/calculator.el: Fix doc typo. ddc7c64 Standardize calc bug reporting instructions Conflicts: lisp/cus-start.el commit 6e050694f247671e67c1eabace36cf9792ab4451 Merge: 3807f3185b f9efbb599f Author: Glenn Morris Date: Mon Sep 10 13:08:50 2018 -0700 ; Merge from origin/emacs-26 The following commit was skipped: f9efbb5 ; Auto-commit of loaddefs files. commit 3807f3185b302f70272642e317be8e6901b79465 Author: Glenn Morris Date: Mon Sep 10 15:01:07 2018 -0400 * lisp/thread.el: Remove more useless runtime requires. diff --git a/lisp/thread.el b/lisp/thread.el index 199fac279e..7974a2603c 100644 --- a/lisp/thread.el +++ b/lisp/thread.el @@ -25,9 +25,9 @@ ;;; Code: -(require 'cl-lib) +(eval-when-compile (require 'cl-lib)) (require 'backtrace) -(require 'pcase) +(eval-when-compile (require 'pcase)) (eval-when-compile (require 'subr-x)) ;;;###autoload commit 9e297f35a093b4d684a0f5034293b8b8279ff29e Author: Glenn Morris Date: Mon Sep 10 14:55:14 2018 -0400 Remove useless requires of subr-x at runtime * lisp/thread.el, lisp/net/nsm.el, lisp/erc/erc.el: Don't require subr-x at runtime. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 8c4da32e83..fc51009641 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -75,7 +75,7 @@ (require 'thingatpt) (require 'auth-source) (require 'erc-compat) -(require 'subr-x) +(eval-when-compile (require 'subr-x)) (defvar erc-official-location "https://www.emacswiki.org/emacs/ERC (mailing list: erc-discuss@gnu.org)" diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el index dab9003e02..9eb914e107 100644 --- a/lisp/net/nsm.el +++ b/lisp/net/nsm.el @@ -26,7 +26,7 @@ (require 'cl-lib) (require 'rmc) ; read-multiple-choice -(require 'subr-x) +(eval-when-compile (require 'subr-x)) (defvar nsm-permanent-host-settings nil) (defvar nsm-temporary-host-settings nil) diff --git a/lisp/thread.el b/lisp/thread.el index 1c5dccf5ce..199fac279e 100644 --- a/lisp/thread.el +++ b/lisp/thread.el @@ -28,7 +28,7 @@ (require 'cl-lib) (require 'backtrace) (require 'pcase) -(require 'subr-x) +(eval-when-compile (require 'subr-x)) ;;;###autoload (defun thread-handle-event (event) commit ea9982d262a9b528c832c38c6c05def6657d72d1 Author: Karl Fogel Date: Mon Sep 10 12:17:06 2018 -0500 Fix build error: use string :version in defcustom * lisp/textmodes/flyspell.el (flyspell-case-fold-duplications): Use a string value for the :version keyword to `defcustom'. Otherwise, building Emacs will fail with an error like this: Scanning ./textmodes for custom Scanning ./url for custom Scanning ./vc for custom Generating ./cus-load.el... Version must be a string make[2]: *** [Makefile:152: cus-load.el] Error 255 This follows up to Reuben Thomas's commit 61f3a4b4fc of 10 Sep 2018. diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index e5a7639e20..37f2245ede 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -72,7 +72,7 @@ Detection of repeated words is not implemented in "Non-nil means Flyspell matches duplicate words case-insensitively." :group 'flyspell :type 'boolean - :version 27.1) + :version "27.1") (defcustom flyspell-mark-duplications-exceptions '((nil . ("that" "had")) ; Common defaults for English. commit 10a45096988f6f19e36e2e7865b6eb35c0929b6d Author: Paul Eggert Date: Mon Sep 10 08:59:39 2018 -0700 Fix misleading name â€double_to_bignum’ * src/bignum.c (double_to_integer): Rename from double_to_bignum, since the result is not necessarily a bignum. All uses changed. diff --git a/src/bignum.c b/src/bignum.c index 35894f5647..f4c24d132b 100644 --- a/src/bignum.c +++ b/src/bignum.c @@ -64,9 +64,9 @@ bignum_to_double (Lisp_Object n) return mpz_get_d (XBIGNUM (n)->value); } -/* Return D, converted to a bignum. Discard any fraction. */ +/* Return D, converted to a Lisp integer. Discard any fraction. */ Lisp_Object -double_to_bignum (double d) +double_to_integer (double d) { mpz_set_d (mpz[0], d); return make_integer_mpz (); diff --git a/src/editfns.c b/src/editfns.c index f19c3f1dca..8c7491beed 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -4657,7 +4657,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) /* Characters to be inserted after spaces and before leading zeros. This can occur with bignums, since - string_to_bignum does only leading '-'. */ + bignum_to_string does only leading '-'. */ char prefix[sizeof "-0x" - 1]; int prefixlen = 0; diff --git a/src/floatfns.c b/src/floatfns.c index dc7236353c..8e56fed9d0 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -391,7 +391,7 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor, if (! FIXNUM_OVERFLOW_P (ir)) return make_fixnum (ir); } - return double_to_bignum (dr); + return double_to_integer (dr); } static EMACS_INT diff --git a/src/lisp.h b/src/lisp.h index f2a3ac9213..454d728f9e 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3327,7 +3327,7 @@ extern ptrdiff_t bignum_bufsize (Lisp_Object, int); extern ptrdiff_t bignum_to_c_string (char *, ptrdiff_t, Lisp_Object, int); extern Lisp_Object bignum_to_string (Lisp_Object, int); extern Lisp_Object make_bignum_str (char const *, int); -extern Lisp_Object double_to_bignum (double); +extern Lisp_Object double_to_integer (double); /* Converthe integer NUM to *N. Return true if successful, false (possibly setting *N) otherwise. */ commit fe859a07870d5204adfd5c9a7f83bf69658d37c8 Author: Paul Eggert Date: Mon Sep 10 08:49:04 2018 -0700 * src/charset.c (Fencode_char): Tweak comment. diff --git a/src/charset.c b/src/charset.c index 6e2bf17cdf..c1a237835c 100644 --- a/src/charset.c +++ b/src/charset.c @@ -1892,7 +1892,7 @@ Return nil if CHARSET doesn't support CH. */) can fit in 22bit. Yet we encode GB-10830's chars in a sparse way (we just take the 4byte sequences as a 32bit int), so some GB-10830 chars (such as 0x81308130 in etc/charsets/gb108304.map) end - up represented as bignums here. */ + up represented as bignums if EMACS_INT is 32 bits. */ return INT_TO_INTEGER (code); } commit 61f3a4b4fcc43241caaac63195205774ab1a5732 Author: Reuben Thomas Date: Mon Sep 10 15:06:02 2018 +0100 Add flyspell option to ignore duplicates of different case * lisp/textmodes/flyspell.el (flyspell-case-fold-duplications): Add option. diff --git a/etc/NEWS b/etc/NEWS index 9ab26222ec..fa93112c91 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -231,6 +231,13 @@ characters that quote text "like this" are replaced by double typographic quotes, “like this”, in text modes, and in comments in non-text modes. +--- +** New user option 'flyspell-case-fold-duplications'. +This option controls whether Flyspell mode considers consecutive words +to be duplicates if they are not in the same case. If non-nil, the +default, words are considered to be duplicates even if their letters' +case does not match. + --- ** 'write-abbrev-file' now includes special properties. 'write-abbrev-file' now writes special properties like ':case-fixed' diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index f6a809b18e..e5a7639e20 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -68,6 +68,12 @@ Detection of repeated words is not implemented in :group 'flyspell :type 'boolean) +(defcustom flyspell-case-fold-duplications t + "Non-nil means Flyspell matches duplicate words case-insensitively." + :group 'flyspell + :type 'boolean + :version 27.1) + (defcustom flyspell-mark-duplications-exceptions '((nil . ("that" "had")) ; Common defaults for English. ("\\`francais" . ("nous" "vous"))) @@ -1154,7 +1160,8 @@ spell-check." (- (save-excursion (skip-chars-backward " \t\n\f"))))) (p (when (>= bound (point-min)) - (flyspell-word-search-backward word bound t)))) + (flyspell-word-search-backward + word bound flyspell-case-fold-duplications)))) (and p (/= p start))))) ;; yes, this is a doublon (flyspell-highlight-incorrect-region start end 'doublon) commit 7efcdf7b3e70f0334caa328cbb5b05a4e30099bd Author: Eli Zaretskii Date: Mon Sep 10 16:20:42 2018 +0300 Clarify completion text in the ELisp manual * doc/lispref/minibuf.texi (Programmed Completion): Clarify text. Suggested by Stefan Monnier . diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 1d1c93dd14..8fac1c3e76 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -1770,12 +1770,9 @@ flag may be one of the following values. @table @code @item nil This specifies a @code{try-completion} operation. The function should -return @code{t} if the specified string is a unique and exact match; -if there is more than one match, it should return the common substring -of all matches (if the string is an exact match for one completion -alternative but also matches other longer alternatives, the return -value is the string); if there are no matches, it should return -@code{nil}. +return @code{nil} if there are no matches; it should return @code{t} +if the specified string is a unique and exact match; and it should +return the longest common prefix substring of all matches otherwise. @item t This specifies an @code{all-completions} operation. The function commit 30b0b0e2e20fe2b944aec4be816aab2cf489eb91 Author: Eli Zaretskii Date: Mon Sep 10 16:11:05 2018 +0300 Fix handling of abbreviated control command in gdb-mi.el * lisp/progmodes/gdb-mi.el (gdb-control-commands-regexp): Support unambiguous abbreviations of commands. (Bug#32576) diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 32d5ced67d..0506386a75 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -1782,9 +1782,10 @@ static char *magick[] = { (defvar gdb-control-commands-regexp (concat "^\\(" - "commands\\|if\\|while\\|define\\|document\\|" + "comm\\(a\\(n\\(ds?\\)?\\)?\\)?\\|if\\|while" + "\\|def\\(i\\(ne?\\)?\\)?\\|doc\\(u\\(m\\(e\\(nt?\\)?\\)?\\)?\\)?\\|" gdb-python-guile-commands-regexp - "\\|while-stepping\\|stepping\\|ws\\|actions" + "\\|while-stepping\\|stepp\\(i\\(ng?\\)?\\)?\\|ws\\|actions" "\\)\\([[:blank:]]+\\([^[:blank:]]*\\)\\)?$") "Regexp matching GDB commands that enter a recursive reading loop. As long as GDB is in the recursive reading loop, it does not expect commit 80ca2b81097520164e002c04a25813996d3aeb54 Author: Eli Zaretskii Date: Mon Sep 10 15:44:48 2018 +0300 Avoid compiler warnings due to get_proc_addr * src/w32common.h (get_proc_addr): Add prototype, to shut up GCC compilation warning. Reported by Martin Rudalics . diff --git a/src/w32common.h b/src/w32common.h index 4981bdfd89..e860dbce03 100644 --- a/src/w32common.h +++ b/src/w32common.h @@ -55,6 +55,7 @@ typedef void (* VOIDFNPTR) (void); /* Load a function address from a DLL. Cast the result via VOIDFNPTR to pacify -Wcast-function-type in GCC 8.1. The return value must be cast to the correct function pointer type. */ +INLINE VOIDFNPTR get_proc_addr (HINSTANCE, LPCSTR); INLINE VOIDFNPTR get_proc_addr (HINSTANCE handle, LPCSTR fname) { commit a65fe6fbf6f05789bb69c50de7b0946adf8773ac Author: Stefan Monnier Date: Mon Sep 10 08:11:26 2018 -0400 * src/charset.c (Fencode_char): Explain when/why bignums are used diff --git a/src/charset.c b/src/charset.c index e11a8366d5..6e2bf17cdf 100644 --- a/src/charset.c +++ b/src/charset.c @@ -1886,6 +1886,13 @@ Return nil if CHARSET doesn't support CH. */) code = ENCODE_CHAR (charsetp, c); if (code == CHARSET_INVALID_CODE (charsetp)) return Qnil; + /* There are much fewer codepoints in the world than we have positive + fixnums, so it could be argued that we never really need a bignum, + e.g. Unicode codepoints only need 21bit, and China's GB-10830 + can fit in 22bit. Yet we encode GB-10830's chars in a sparse way + (we just take the 4byte sequences as a 32bit int), so some + GB-10830 chars (such as 0x81308130 in etc/charsets/gb108304.map) end + up represented as bignums here. */ return INT_TO_INTEGER (code); } commit 80a35ff2774b297baf0f12f02e1d8b521de640d5 Author: Martin Rudalics Date: Mon Sep 10 14:07:05 2018 +0200 Fix last change of 'run_window_size_change_functions' * src/window.c (run_window_size_change_functions): Fix two type mixups in last change. Reported by Michael Albinus on emacs-devel. diff --git a/src/window.c b/src/window.c index b81469b9d6..6cdc52f90e 100644 --- a/src/window.c +++ b/src/window.c @@ -3470,8 +3470,8 @@ run_window_size_change_functions (Lisp_Object frame) with FRAME as its argument and as such oblivious to the window checked below. */ if (window_size_changed (XWINDOW (window)) - && !Fmemq (buffer, buffers) - && Flocal_variable_p (Qwindow_size_change_functions, buffer)) + && !NILP (Flocal_variable_p (Qwindow_size_change_functions, buffer)) + && NILP (Fmemq (buffer, buffers))) { Lisp_Object locals = Fbuffer_local_value (Qwindow_size_change_functions, buffer); commit 5cf282d65f10f59f7efa63359dfd2b2e124943da Author: Eli Zaretskii Date: Mon Sep 10 12:46:22 2018 +0300 Clarify documentation of functions reading character events * doc/lispref/help.texi (Describing Characters): * doc/lispref/commands.texi (Keyboard Events) (Reading One Event, Classifying Events): Make the distinction between characters and character events more explicit. * src/keymap.c (Ftext_char_description) (Fsingle_key_description): * src/lread.c (Fread_char, Fread_char_exclusive): Doc fixes, to make a clear distinction between a character input event and a character code. (Bug#32562) diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 0753d6fb67..3e74f05e4c 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -1076,9 +1076,10 @@ the current Emacs session. If a symbol has not yet been so used, @cindex keyboard events There are two kinds of input you can get from the keyboard: ordinary -keys, and function keys. Ordinary keys correspond to characters; the -events they generate are represented in Lisp as characters. The event -type of a character event is the character itself (an integer); see +keys, and function keys. Ordinary keys correspond to (possibly +modified) characters; the events they generate are represented in Lisp +as characters. The event type of a character event is the character +itself (an integer), which might have some modifier bits set; see @ref{Classifying Events}. @cindex modifier bits (of input character) @@ -1123,7 +1124,7 @@ for @kbd{%} plus 2**26 @end ifnottex (assuming the terminal supports non-@acronym{ASCII} -control characters). +control characters), i.e.@: with the 27th bit set. @item shift The @@ -1133,8 +1134,8 @@ The @ifnottex 2**25 @end ifnottex -bit in the character code indicates an @acronym{ASCII} control -character typed with the shift key held down. +bit (the 26th bit) in the character event code indicates an +@acronym{ASCII} control character typed with the shift key held down. For letters, the basic code itself indicates upper versus lower case; for digits and punctuation, the shift key selects an entirely different @@ -1146,7 +1147,7 @@ character with a different basic code. In order to keep within the @ifnottex 2**25 @end ifnottex -bit for those characters. +bit for those character events. However, @acronym{ASCII} provides no way to distinguish @kbd{C-A} from @kbd{C-a}, so Emacs uses the @@ -1167,7 +1168,7 @@ The @ifnottex 2**24 @end ifnottex -bit in the character code indicates a character +bit in the character event code indicates a character typed with the hyper key held down. @item super @@ -1178,7 +1179,7 @@ The @ifnottex 2**23 @end ifnottex -bit in the character code indicates a character +bit in the character event code indicates a character typed with the super key held down. @item alt @@ -1189,9 +1190,9 @@ The @ifnottex 2**22 @end ifnottex -bit in the character code indicates a character typed with the alt key -held down. (The key labeled @key{Alt} on most keyboards is actually -treated as the meta key, not this.) +bit in the character event code indicates a character typed with the +alt key held down. (The key labeled @key{Alt} on most keyboards is +actually treated as the meta key, not this.) @end table It is best to avoid mentioning specific bit numbers in your program. @@ -1949,6 +1950,10 @@ Here are some examples: The modifiers list for a click event explicitly contains @code{click}, but the event symbol name itself does not contain @samp{click}. +Similarly, the modifiers list for an @acronym{ASCII} control +character, such as @samp{C-a}, contains @code{control}, even though +reading such an event via @code{read-char} will return the value 1 +with the control modifier bit removed. @end defun @defun event-basic-type event @@ -2545,17 +2550,31 @@ right-arrow function key: @end defun @defun read-char &optional prompt inherit-input-method seconds -This function reads and returns a character of command input. If the +This function reads and returns a character input event. If the user generates an event which is not a character (i.e., a mouse click or function key event), @code{read-char} signals an error. The arguments work as in @code{read-event}. -In the first example, the user types the character @kbd{1} (@acronym{ASCII} -code 49). The second example shows a keyboard macro definition that -calls @code{read-char} from the minibuffer using @code{eval-expression}. -@code{read-char} reads the keyboard macro's very next character, which -is @kbd{1}. Then @code{eval-expression} displays its return value in -the echo area. +If the event has modifiers, Emacs attempts to resolve them and return +the code of the corresponding character. For example, if the user +types @kbd{C-a}, the function returns 1, which is the @acronym{ASCII} +code of the @samp{C-a} character. If some of the modifiers cannot be +reflected in the character code, @code{read-char} leaves the +unresolved modifier bits set in the returned event. For example, if +the user types @kbd{C-M-a}, the function returns 134217729, 8000001 in +hex, i.e.@: @samp{C-a} with the Meta modifier bit set. This value is +not a valid character code: it fails the @code{characterp} test +(@pxref{Character Codes}). Use @code{event-basic-type} +(@pxref{Classifying Events}) to recover the character code with the +modifier bits removed; use @code{event-modifiers} to test for +modifiers in the character event returned by @code{read-char}. + +In the first example below, the user types the character @kbd{1} +(@acronym{ASCII} code 49). The second example shows a keyboard macro +definition that calls @code{read-char} from the minibuffer using +@code{eval-expression}. @code{read-char} reads the keyboard macro's +very next character, which is @kbd{1}. Then @code{eval-expression} +displays its return value in the echo area. @example @group @@ -2577,10 +2596,11 @@ the echo area. @end defun @defun read-char-exclusive &optional prompt inherit-input-method seconds -This function reads and returns a character of command input. If the -user generates an event which is not a character, +This function reads and returns a character input event. If the +user generates an event which is not a character event, @code{read-char-exclusive} ignores it and reads another event, until it -gets a character. The arguments work as in @code{read-event}. +gets a character. The arguments work as in @code{read-event}. The +returned value may include modifier bits, as with @code{read-char}. @end defun None of the above functions suppress quitting. diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi index 6dd55d0b25..a23bc413d2 100644 --- a/doc/lispref/help.texi +++ b/doc/lispref/help.texi @@ -556,13 +556,13 @@ brackets. @defun text-char-description character This function returns a string describing @var{character} in the -standard Emacs notation for characters that appear in text---like -@code{single-key-description}, except that control characters are -represented with a leading caret (which is how control characters in -Emacs buffers are usually displayed). Another difference is that -@code{text-char-description} recognizes the 2**7 bit as the Meta -character, whereas @code{single-key-description} uses the 2**27 bit -for Meta. +standard Emacs notation for characters that can appear in text---like +@code{single-key-description}, except that the argument must be a +valid character code that passes a @code{characterp} test +(@pxref{Character Codes}), control characters are represented with a +leading caret (which is how control characters in Emacs buffers are +usually displayed), and the 2**7 bit is treated as the Meta bit, +whereas @code{single-key-description} uses the 2**27 bit for Meta. @smallexample @group diff --git a/src/keymap.c b/src/keymap.c index c8cc933e78..ec483c7a63 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -2205,10 +2205,12 @@ push_key_description (EMACS_INT ch, char *p) DEFUN ("single-key-description", Fsingle_key_description, Ssingle_key_description, 1, 2, 0, - doc: /* Return a pretty description of command character KEY. + doc: /* Return a pretty description of a character event KEY. Control characters turn into C-whatever, etc. Optional argument NO-ANGLES non-nil means don't put angle brackets -around function keys and event symbols. */) +around function keys and event symbols. + +See `text-char-description' for describing character codes. */) (Lisp_Object key, Lisp_Object no_angles) { USE_SAFE_ALLOCA; @@ -2282,11 +2284,12 @@ push_text_char_description (register unsigned int c, register char *p) /* This function cannot GC. */ DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0, - doc: /* Return a pretty description of file-character CHARACTER. -Control characters turn into "^char", etc. This differs from -`single-key-description' which turns them into "C-char". -Also, this function recognizes the 2**7 bit as the Meta character, -whereas `single-key-description' uses the 2**27 bit for Meta. + doc: /* Return the description of CHARACTER in standard Emacs notation. +CHARACTER must be a valid character code that passes the `characterp' test. +Control characters turn into "^char", the 2**7 bit is treated as Meta, etc. +This differs from `single-key-description' which accepts character events, +and thus doesn't enforce the `characterp' condition, turns control +characters into "C-char", and uses the 2**27 bit for Meta. See Info node `(elisp)Describing Characters' for examples. */) (Lisp_Object character) { diff --git a/src/lread.c b/src/lread.c index d5ba48a170..2e5cba510c 100644 --- a/src/lread.c +++ b/src/lread.c @@ -735,10 +735,14 @@ read_filtered_event (bool no_switch_frame, bool ascii_required, } DEFUN ("read-char", Fread_char, Sread_char, 0, 3, 0, - doc: /* Read a character from the command input (keyboard or macro). + doc: /* Read a character event from the command input (keyboard or macro). It is returned as a number. -If the character has modifiers, they are resolved and reflected to the -character code if possible (e.g. C-SPC -> 0). +If the event has modifiers, they are resolved and reflected in the +returned character code if possible (e.g. C-SPC yields 0 and C-a yields 97). +If some of the modifiers cannot be reflected in the character code, the +returned value will include those modifiers, and will not be a valid +character code: it will fail the `characterp' test. Use `event-basic-type' +to recover the character code with the modifiers removed. If the user generates an event which is not a character (i.e. a mouse click or function key event), `read-char' signals an error. As an @@ -785,10 +789,14 @@ floating-point value. */) } DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 3, 0, - doc: /* Read a character from the command input (keyboard or macro). + doc: /* Read a character event from the command input (keyboard or macro). It is returned as a number. Non-character events are ignored. -If the character has modifiers, they are resolved and reflected to the -character code if possible (e.g. C-SPC -> 0). +If the event has modifiers, they are resolved and reflected in the +returned character code if possible (e.g. C-SPC yields 0 and C-a yields 97). +If some of the modifiers cannot be reflected in the character code, the +returned value will include those modifiers, and will not be a valid +character code: it will fail the `characterp' test. Use `event-basic-type' +to recover the character code with the modifiers removed. If the optional argument PROMPT is non-nil, display that as a prompt. If the optional argument INHERIT-INPUT-METHOD is non-nil and some commit 6a00f2babf84f309fa00269bff3abef7eb502023 Author: Martin Rudalics Date: Mon Sep 10 10:05:20 2018 +0200 Handle buffer-local 'window-size-change-functions' specially (Bug#32637) * src/window.c (run_window_size_change_functions): Run a buffer-local value once per each frame and only if at least one window showing the buffer on that frame has changed its size. (Bug#32637) * doc/lispref/windows.texi (Window Hooks): Describe new behavior of buffer-local 'window-size-change-functions'. diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 3eaa15a603..7cfa5ead5f 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -5205,6 +5205,14 @@ whether a specific window has changed size, compare the return values of @code{window-pixel-height-before-size-change} and @code{window-pixel-height} for that window (@pxref{Window Sizes}). +The buffer-local value of this hook is run once for the buffer and the +frame in question, provided at least one window showing the buffer on +that frame has changed its size. As it still receives the frame as +its sole argument, any function called on a buffer-local basis will be +oblivious to which window(s) showing the buffer changed its (their) +size and has to check out these windows by using the method described +in the previous paragraph. + These function are usually only called when at least one window was added or has changed size since the last time this hook was run for the associated frame. In some rare cases this hook also runs when a window diff --git a/etc/NEWS b/etc/NEWS index ff65a5520d..9ab26222ec 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -963,6 +963,11 @@ now support filters, allowing faces to vary between different windows displaying the same buffer. See the Info node "Face Remapping" of the Emacs Lisp Reference manual for more detail. ++++ +** Special handling of buffer-local 'window-size-change-functions'. +A buffer-local value of this hook is now run only if at least one +window showing the buffer has changed its size. + +++ ** New function assoc-delete-all. diff --git a/src/window.c b/src/window.c index 04de965680..b81469b9d6 100644 --- a/src/window.c +++ b/src/window.c @@ -3442,7 +3442,11 @@ run_window_size_change_functions (Lisp_Object frame) { struct frame *f = XFRAME (frame); struct window *r = XWINDOW (FRAME_ROOT_WINDOW (f)); - Lisp_Object functions = Vwindow_size_change_functions; + + if (NILP (Vrun_hooks) + || !(f->can_x_set_window_size) + || !(f->after_make_frame)) + return; if (FRAME_WINDOW_CONFIGURATION_CHANGED (f) /* Here we implicitly exclude the possibility that the height of @@ -3450,11 +3454,44 @@ run_window_size_change_functions (Lisp_Object frame) of FRAME's root window alone. */ || window_size_changed (r)) { - while (CONSP (functions)) + Lisp_Object globals = Fdefault_value (Qwindow_size_change_functions); + Lisp_Object windows = Fwindow_list (frame, Qlambda, Qnil); + /* The buffers for which the local hook was already run. */ + Lisp_Object buffers = Qnil; + + for (; CONSP (windows); windows = XCDR (windows)) + { + Lisp_Object window = XCAR (windows); + Lisp_Object buffer = Fwindow_buffer (window); + + /* Run a buffer-local value only once for that buffer and + only if at least one window showing that buffer on FRAME + actually changed its size. Note that the function is run + with FRAME as its argument and as such oblivious to the + window checked below. */ + if (window_size_changed (XWINDOW (window)) + && !Fmemq (buffer, buffers) + && Flocal_variable_p (Qwindow_size_change_functions, buffer)) + { + Lisp_Object locals + = Fbuffer_local_value (Qwindow_size_change_functions, buffer); + + while (CONSP (locals)) + { + if (!EQ (XCAR (locals), Qt)) + safe_call1 (XCAR (locals), frame); + locals = XCDR (locals); + } + + buffers = Fcons (buffer, buffers); + } + } + + while (CONSP (globals)) { - if (!EQ (XCAR (functions), Qt)) - safe_call1 (XCAR (functions), frame); - functions = XCDR (functions); + if (!EQ (XCAR (globals), Qt)) + safe_call1 (XCAR (globals), frame); + globals = XCDR (globals); } window_set_before_size_change_sizes (r); @@ -7556,6 +7593,7 @@ syms_of_window (void) Fput (Qscroll_down, Qscroll_command, Qt); DEFSYM (Qwindow_configuration_change_hook, "window-configuration-change-hook"); + DEFSYM (Qwindow_size_change_functions, "window-size-change-functions"); DEFSYM (Qwindowp, "windowp"); DEFSYM (Qwindow_configuration_p, "window-configuration-p"); DEFSYM (Qwindow_live_p, "window-live-p"); commit a704bad5e69e278086ea895061be496287b5c277 Merge: e489685617 b7719f0cde Author: Gemini Lasswell Date: Sun Sep 9 08:19:54 2018 -0700 Merge branch 'scratch/list-threads' commit b7719f0cdee4aa21dce16304d410f156c65011e2 Author: Gemini Lasswell Date: Fri Sep 7 17:41:24 2018 -0700 Use thread-live-p instead of obsolete thread-alive-p * lisp/thread.el (thread-list--get-status) (thread-list--send-signal, thread-list-pop-to-backtrace) (thread-list-backtrace--revert-hook-function) (thread-list-backtrace--insert-header): Use thread-live-p instead of thread-alive-p. diff --git a/lisp/thread.el b/lisp/thread.el index 53208851b7..1c5dccf5ce 100644 --- a/lisp/thread.el +++ b/lisp/thread.el @@ -121,7 +121,7 @@ An EVENT has the format Return a list of two strings, one describing THREAD's status, the other describing THREAD's blocker, if any." (cond - ((not (thread-alive-p thread)) '("Finished" "")) + ((not (thread-live-p thread)) '("Finished" "")) ((eq thread (current-thread)) '("Running" "")) (t (if-let ((blocker (thread--blocker thread))) `("Blocked" ,(prin1-to-string blocker)) @@ -141,9 +141,9 @@ other describing THREAD's blocker, if any." "Send the specified SIGNAL to the thread at point. Ask for user confirmation before signaling the thread." (let ((thread (tabulated-list-get-id))) - (if (thread-alive-p thread) + (if (thread-live-p thread) (when (y-or-n-p (format "Send %s signal to %s? " signal thread)) - (if (thread-alive-p thread) + (if (thread-live-p thread) (thread-signal thread signal nil) (message "This thread is no longer alive"))) (message "This thread is no longer alive")))) @@ -155,7 +155,7 @@ Ask for user confirmation before signaling the thread." "Display the backtrace for the thread at point." (interactive) (let ((thread (tabulated-list-get-id))) - (if (thread-alive-p thread) + (if (thread-live-p thread) (let ((buffer (get-buffer-create "*Thread Backtrace*"))) (pop-to-buffer buffer) (unless (derived-mode-p 'backtrace-mode) @@ -172,7 +172,7 @@ Ask for user confirmation before signaling the thread." (defun thread-list-backtrace--revert-hook-function () (setq backtrace-frames - (when (thread-alive-p thread-list-backtrace--thread) + (when (thread-live-p thread-list-backtrace--thread) (mapcar #'thread-list--make-backtrace-frame (backtrace--frames-from-thread thread-list-backtrace--thread))))) @@ -182,7 +182,7 @@ Ask for user confirmation before signaling the thread." (defun thread-list-backtrace--insert-header () (let ((name (thread-list--name thread-list-backtrace--thread))) - (if (thread-alive-p thread-list-backtrace--thread) + (if (thread-live-p thread-list-backtrace--thread) (progn (insert (substitute-command-keys "Backtrace for thread `")) (insert name) commit 8adc0e518fe36b6251d79ac61b6de9d4766a6afd Author: Gemini Lasswell Date: Wed Sep 5 16:55:45 2018 -0700 Improve documentation of thread list buffer * doc/lispref/threads.texi (The Thread List): Cross-reference 'Basic Thread Functions'. Use defvar for thread-list-refresh-seconds. Improve descriptions of the backtrace and signal commands. diff --git a/doc/lispref/threads.texi b/doc/lispref/threads.texi index a4a1af3085..c9d5f79048 100644 --- a/doc/lispref/threads.texi +++ b/doc/lispref/threads.texi @@ -281,15 +281,17 @@ mutex cannot be changed. @findex list-threads The @code{list-threads} command lists all the currently alive threads. In the resulting buffer, each thread is identified either by the name -passed to @code{make-thread}, or by its unique internal identifier if -it was not created with a name. The status of each thread at the time -of the creation or last update of the buffer is shown, in addition to -the object the thread was blocked on at the time, if it was blocked. +passed to @code{make-thread} (@pxref{Basic Thread Functions}), or by +its unique internal identifier if it was not created with a name. The +status of each thread at the time of the creation or last update of +the buffer is shown, in addition to the object the thread was blocked +on at the time, if it was blocked. -@vindex thread-list-refresh-seconds +@defvar thread-list-refresh-seconds The @file{*Threads*} buffer will automatically update twice per -second. To make the refresh rate faster or slower, customize -@code{thread-list-refresh-seconds}. +second. You can make the refresh rate faster or slower by customizing +this variable. +@end defvar Here are the commands available in the thread list buffer: @@ -300,9 +302,9 @@ Here are the commands available in the thread list buffer: @item b Show a backtrace of the thread at point. This will show where in its code the thread had yielded or was blocked at the moment you pressed -@kbd{b}. Be aware that by the time you see the backtrace, the thread -may have resumed execution, and be in a different section of code, or -be completed. +@kbd{b}. Be aware that the backtrace is a snapshot; the thread could +have meanwhile resumed execution, and be in a different state, or +could have exited. You may use @kbd{g} in the thread's backtrace buffer to get an updated backtrace, as backtrace buffers do not automatically update. @@ -310,10 +312,12 @@ backtrace, as backtrace buffers do not automatically update. commands which work on them. @item s -Send a signal to the thread at point. After @kbd{s}, type @kbd{q} to -send a quit signal or @kbd{e} to send an error signal. Only do this -if you understand how to restart the target thread, because your Emacs -session may behave incorrectly if necessary threads are killed. +Signal the thread at point. After @kbd{s}, type @kbd{q} to send a +quit signal or @kbd{e} to send an error signal. Threads may implement +handling of signals, but the default behavior is to exit on any +signal. Therefore you should only use this command if you understand +how to restart the target thread, because your Emacs session may +behave incorrectly if necessary threads are killed. @item g Update the list of threads and their statuses. diff --git a/etc/NEWS b/etc/NEWS index 2e4ed5ddf9..ff65a5520d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -738,7 +738,11 @@ Instead, error messages are just printed in the main thread. *** 'thread-alive-p' is now obsolete, use 'thread-live-p' instead. +++ -*** 'list-threads' displays the live threads in a tabulated-list buffer. +*** New command 'list-threads' shows Lisp threads. +See the current list of live threads in a tabulated-list buffer which +automatically updates. In the buffer, you can use 's q' or 's e' to +signal a thread with quit or error respectively, or get a snapshot +backtrace with 'b'. --- ** thingatpt.el supports a new "thing" called 'uuid'. commit 2f5a65a7691060adfc50bc34f5a12e33358fe19a Author: Gemini Lasswell Date: Sat Aug 11 19:19:23 2018 -0700 Add tests for list-threads and the *Threads* buffer * test/lisp/thread-tests.el: New file. diff --git a/test/lisp/thread-tests.el b/test/lisp/thread-tests.el new file mode 100644 index 0000000000..0d57d38779 --- /dev/null +++ b/test/lisp/thread-tests.el @@ -0,0 +1,96 @@ +;;; thread-tests.el --- Test suite for thread.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2018 Free Software Foundation, Inc. + +;; Author: Gemini Lasswell +;; Keywords: threads + +;; 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 . + +;;; Commentary: + + +;;; Code: + +(require 'ert) +(require 'thread) + +;; Declare the functions used here in case Emacs has been configured +;; --without-threads. +(declare-function make-mutex "thread.c" (&optional name)) +(declare-function mutex-lock "thread.c" (mutex)) +(declare-function mutex-unlock "thread.c" (mutex)) +(declare-function make-thread "thread.c" (function &optional name)) +(declare-function thread-join "thread.c" (thread)) +(declare-function thread-yield "thread.c" ()) + +(defvar thread-tests-flag) +(defvar thread-tests-mutex (when (featurep 'threads) (make-mutex "mutex1"))) + +(defun thread-tests--thread-function () + (setq thread-tests-flag t) + (with-mutex thread-tests-mutex + (sleep-for 0.01))) + +(ert-deftest thread-tests-thread-list-send-error () + "A thread can be sent an error signal from the *Thread List* buffer." + (skip-unless (featurep 'threads)) + (cl-letf (((symbol-function 'y-or-n-p) (lambda (_prompt) t))) + (with-mutex thread-tests-mutex + (setq thread-tests-flag nil) + (let ((thread (make-thread #'thread-tests--thread-function + "thread-tests-wait"))) + (while (not thread-tests-flag) + (thread-yield)) + (list-threads) + (goto-char (point-min)) + (re-search-forward + "^thread-tests.+[[:blank:]]+Blocked[[:blank:]]+.+mutex1.+?") + (thread-list-send-error-signal) + (should-error (thread-join thread)) + (list-threads) + (goto-char (point-min)) + (should-error (re-search-forward "thread-tests")))))) + +(ert-deftest thread-tests-thread-list-show-backtrace () + "Show a backtrace for another thread from the *Thread List* buffer." + (skip-unless (featurep 'threads)) + (let (thread) + (with-mutex thread-tests-mutex + (setq thread-tests-flag nil) + (setq thread + (make-thread #'thread-tests--thread-function "thread-tests-back")) + (while (not thread-tests-flag) + (thread-yield)) + (list-threads) + (goto-char (point-min)) + (re-search-forward + "^thread-tests.+[[:blank:]]+Blocked[[:blank:]]+.+mutex1.+?") + (thread-list-pop-to-backtrace) + (goto-char (point-min)) + (re-search-forward "thread-tests-back") + (re-search-forward "mutex-lock") + (re-search-forward "thread-tests--thread-function")) + (thread-join thread))) + +(ert-deftest thread-tests-list-threads-error-when-not-configured () + "Signal an error running `list-threads' if threads are not configured." + (skip-unless (not (featurep 'threads))) + (should-error (list-threads))) + +(provide 'thread-tests) + +;;; thread-tests.el ends here commit 703b1cf9e232061648af11e9772d86895735158d Author: Gemini Lasswell Date: Thu Aug 23 12:19:04 2018 -0700 Add check in list-threads for --without-threads configuration * lisp/thread.el (list-threads): Signal an error if the Emacs configuration doesn't have threads. diff --git a/lisp/thread.el b/lisp/thread.el index c9f50ff5db..53208851b7 100644 --- a/lisp/thread.el +++ b/lisp/thread.el @@ -82,6 +82,9 @@ An EVENT has the format (defun list-threads () "Display a list of threads." (interactive) + ;; Threads may not exist, if Emacs was configured --without-threads. + (unless (bound-and-true-p main-thread) + (error "Threads are not supported in this configuration")) ;; Generate the Threads list buffer, and switch to it. (let ((buf (get-buffer-create "*Threads*"))) (with-current-buffer buf commit e19ca77534002ae118acb707cf6313df1a908814 Author: Gemini Lasswell Date: Tue Aug 14 11:08:28 2018 -0700 Document list-threads and its buffer * doc/lispref/threads.texi (Threads): Add menu item. (The Thread List): New node. * doc/lispref/elisp.texi (Top): Add menu item. diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index 1d861fbced..0a445a36bd 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -1346,6 +1346,7 @@ Threads * Basic Thread Functions:: Basic thread functions. * Mutexes:: Mutexes allow exclusive access to data. * Condition Variables:: Inter-thread events. +* The Thread List:: Show the active threads. Processes diff --git a/doc/lispref/threads.texi b/doc/lispref/threads.texi index 9cdeb798c1..a4a1af3085 100644 --- a/doc/lispref/threads.texi +++ b/doc/lispref/threads.texi @@ -45,6 +45,7 @@ closure are shared by any threads invoking the closure. * Basic Thread Functions:: Basic thread functions. * Mutexes:: Mutexes allow exclusive access to data. * Condition Variables:: Inter-thread events. +* The Thread List:: Show the active threads. @end menu @node Basic Thread Functions @@ -271,3 +272,49 @@ Return the name of @var{cond}, as passed to Return the mutex associated with @var{cond}. Note that the associated mutex cannot be changed. @end defun + +@node The Thread List +@section The Thread List + +@cindex thread list +@cindex list of threads +@findex list-threads +The @code{list-threads} command lists all the currently alive threads. +In the resulting buffer, each thread is identified either by the name +passed to @code{make-thread}, or by its unique internal identifier if +it was not created with a name. The status of each thread at the time +of the creation or last update of the buffer is shown, in addition to +the object the thread was blocked on at the time, if it was blocked. + +@vindex thread-list-refresh-seconds +The @file{*Threads*} buffer will automatically update twice per +second. To make the refresh rate faster or slower, customize +@code{thread-list-refresh-seconds}. + +Here are the commands available in the thread list buffer: + +@table @kbd + +@cindex backtrace of thread +@cindex thread backtrace +@item b +Show a backtrace of the thread at point. This will show where in its +code the thread had yielded or was blocked at the moment you pressed +@kbd{b}. Be aware that by the time you see the backtrace, the thread +may have resumed execution, and be in a different section of code, or +be completed. + +You may use @kbd{g} in the thread's backtrace buffer to get an updated +backtrace, as backtrace buffers do not automatically update. +@xref{Backtraces}, for a description of backtraces and the other +commands which work on them. + +@item s +Send a signal to the thread at point. After @kbd{s}, type @kbd{q} to +send a quit signal or @kbd{e} to send an error signal. Only do this +if you understand how to restart the target thread, because your Emacs +session may behave incorrectly if necessary threads are killed. + +@item g +Update the list of threads and their statuses. +@end table diff --git a/etc/NEWS b/etc/NEWS index 61b6d4e0e2..2e4ed5ddf9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -737,6 +737,9 @@ Instead, error messages are just printed in the main thread. --- *** 'thread-alive-p' is now obsolete, use 'thread-live-p' instead. ++++ +*** 'list-threads' displays the live threads in a tabulated-list buffer. + --- ** thingatpt.el supports a new "thing" called 'uuid'. A symbol 'uuid' can be passed to thing-at-point and it returns the commit 3fb8f306475a87a30a7dd68387d8da859cffc90a Author: Gemini Lasswell Date: Thu Aug 9 14:21:57 2018 -0700 Show backtraces of threads from thread list buffer * src/eval.c (backtrace_thread_p, backtrace_thread_top) (backtrace_thread_next, Fbacktrace_frames_from_thread): New functions. * lisp/thread.el (thread-list-mode-map): Add keybinding and menu item for 'thread-list-pop-to-backtrace'. (thread-list-mode): Make "Thread Name" column wide enough for the result of printing a thread with no name with 'prin1'. (thread-list--get-entries): Use 'thread-list--name'. (thread-list--send-signal): Remove unnecessary calls to 'threadp'. (thread-list-backtrace--thread): New variable. (thread-list-pop-to-backtrace): New command. (thread-list-backtrace--revert-hook-function) (thread-list--make-backtrace-frame) (thread-list-backtrace--insert-header, thread-list--name): New functions. diff --git a/lisp/thread.el b/lisp/thread.el index 4cd253e2cf..c9f50ff5db 100644 --- a/lisp/thread.el +++ b/lisp/thread.el @@ -26,6 +26,7 @@ ;;; Code: (require 'cl-lib) +(require 'backtrace) (require 'pcase) (require 'subr-x) @@ -55,11 +56,13 @@ An EVENT has the format (defvar thread-list-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map tabulated-list-mode-map) + (define-key map "b" #'thread-list-pop-to-backtrace) (define-key map "s" nil) (define-key map "sq" #'thread-list-send-quit-signal) (define-key map "se" #'thread-list-send-error-signal) (easy-menu-define nil map "" '("Threads" + ["Show backtrace" thread-list-pop-to-backtrace t] ["Send Quit Signal" thread-list-send-quit-signal t] ["Send Error Signal" thread-list-send-error-signal t])) map) @@ -68,7 +71,7 @@ An EVENT has the format (define-derived-mode thread-list-mode tabulated-list-mode "Thread-List" "Major mode for monitoring Lisp threads." (setq tabulated-list-format - [("Thread Name" 15 t) + [("Thread Name" 20 t) ("Status" 10 t) ("Blocked On" 30 t)]) (setq tabulated-list-sort-key (cons (car (aref tabulated-list-format 0)) nil)) @@ -105,9 +108,7 @@ An EVENT has the format (let (entries) (dolist (thread (all-threads)) (pcase-let ((`(,status ,blocker) (thread-list--get-status thread))) - (push `(,thread [,(or (thread-name thread) - (and (eq thread main-thread) "Main") - (prin1-to-string thread)) + (push `(,thread [,(thread-list--name thread) ,status ,blocker]) entries))) entries)) @@ -137,12 +138,60 @@ other describing THREAD's blocker, if any." "Send the specified SIGNAL to the thread at point. Ask for user confirmation before signaling the thread." (let ((thread (tabulated-list-get-id))) - (if (and (threadp thread) (thread-alive-p thread)) + (if (thread-alive-p thread) (when (y-or-n-p (format "Send %s signal to %s? " signal thread)) - (if (and (threadp thread) (thread-alive-p thread)) + (if (thread-alive-p thread) (thread-signal thread signal nil) (message "This thread is no longer alive"))) (message "This thread is no longer alive")))) +(defvar-local thread-list-backtrace--thread nil + "Thread whose backtrace is displayed in the current buffer.") + +(defun thread-list-pop-to-backtrace () + "Display the backtrace for the thread at point." + (interactive) + (let ((thread (tabulated-list-get-id))) + (if (thread-alive-p thread) + (let ((buffer (get-buffer-create "*Thread Backtrace*"))) + (pop-to-buffer buffer) + (unless (derived-mode-p 'backtrace-mode) + (backtrace-mode) + (add-hook 'backtrace-revert-hook + #'thread-list-backtrace--revert-hook-function) + (setq backtrace-insert-header-function + #'thread-list-backtrace--insert-header)) + (setq thread-list-backtrace--thread thread) + (thread-list-backtrace--revert-hook-function) + (backtrace-print) + (goto-char (point-min))) + (message "This thread is no longer alive")))) + +(defun thread-list-backtrace--revert-hook-function () + (setq backtrace-frames + (when (thread-alive-p thread-list-backtrace--thread) + (mapcar #'thread-list--make-backtrace-frame + (backtrace--frames-from-thread + thread-list-backtrace--thread))))) + +(cl-defun thread-list--make-backtrace-frame ((evald fun &rest args)) + (backtrace-make-frame :evald evald :fun fun :args args)) + +(defun thread-list-backtrace--insert-header () + (let ((name (thread-list--name thread-list-backtrace--thread))) + (if (thread-alive-p thread-list-backtrace--thread) + (progn + (insert (substitute-command-keys "Backtrace for thread `")) + (insert name) + (insert (substitute-command-keys "':\n"))) + (insert (substitute-command-keys "Thread `")) + (insert name) + (insert (substitute-command-keys "' is no longer running\n"))))) + +(defun thread-list--name (thread) + (or (thread-name thread) + (and (eq thread main-thread) "Main") + (prin1-to-string thread))) + (provide 'thread) ;;; thread.el ends here diff --git a/src/eval.c b/src/eval.c index 1011fc888b..60dd6f1e8d 100644 --- a/src/eval.c +++ b/src/eval.c @@ -204,6 +204,10 @@ bool backtrace_p (union specbinding *pdl) { return pdl >= specpdl; } +static bool +backtrace_thread_p (struct thread_state *tstate, union specbinding *pdl) +{ return pdl >= tstate->m_specpdl; } + union specbinding * backtrace_top (void) { @@ -213,6 +217,15 @@ backtrace_top (void) return pdl; } +static union specbinding * +backtrace_thread_top (struct thread_state *tstate) +{ + union specbinding *pdl = tstate->m_specpdl_ptr - 1; + while (backtrace_thread_p (tstate, pdl) && pdl->kind != SPECPDL_BACKTRACE) + pdl--; + return pdl; +} + union specbinding * backtrace_next (union specbinding *pdl) { @@ -222,6 +235,15 @@ backtrace_next (union specbinding *pdl) return pdl; } +static union specbinding * +backtrace_thread_next (struct thread_state *tstate, union specbinding *pdl) +{ + pdl--; + while (backtrace_thread_p (tstate, pdl) && pdl->kind != SPECPDL_BACKTRACE) + pdl--; + return pdl; +} + void init_eval_once (void) { @@ -3730,6 +3752,42 @@ Return the result of FUNCTION, or nil if no matching frame could be found. */) return backtrace_frame_apply (function, get_backtrace_frame (nframes, base)); } +DEFUN ("backtrace--frames-from-thread", Fbacktrace_frames_from_thread, + Sbacktrace_frames_from_thread, 1, 1, NULL, + doc: /* Return the list of backtrace frames from current execution point in THREAD. +If a frame has not evaluated the arguments yet (or is a special form), +the value of the list element is (nil FUNCTION ARG-FORMS...). +If a frame has evaluated its arguments and called its function already, +the value of the list element is (t FUNCTION ARG-VALUES...). +A &rest arg is represented as the tail of the list ARG-VALUES. +FUNCTION is whatever was supplied as car of evaluated list, +or a lambda expression for macro calls. */) + (Lisp_Object thread) +{ + struct thread_state *tstate; + CHECK_THREAD (thread); + tstate = XTHREAD (thread); + + union specbinding *pdl = backtrace_thread_top (tstate); + Lisp_Object list = Qnil; + + while (backtrace_thread_p (tstate, pdl)) + { + Lisp_Object frame; + if (backtrace_nargs (pdl) == UNEVALLED) + frame = Fcons (Qnil, + Fcons (backtrace_function (pdl), *backtrace_args (pdl))); + else + { + Lisp_Object tem = Flist (backtrace_nargs (pdl), backtrace_args (pdl)); + frame = Fcons (Qt, Fcons (backtrace_function (pdl), tem)); + } + list = Fcons (frame, list); + pdl = backtrace_thread_next (tstate, pdl); + } + return Fnreverse (list); +} + /* For backtrace-eval, we want to temporarily unwind the last few elements of the specpdl stack, and then rewind them. We store the pre-unwind values directly in the pre-existing specpdl elements (i.e. we swap the current @@ -4205,6 +4263,7 @@ alist of active lexical bindings. */); DEFSYM (QCdebug_on_exit, ":debug-on-exit"); defsubr (&Smapbacktrace); defsubr (&Sbacktrace_frame_internal); + defsubr (&Sbacktrace_frames_from_thread); defsubr (&Sbacktrace_eval); defsubr (&Sbacktrace__locals); defsubr (&Sspecial_variable_p); commit dc5c76c37488d6fd546eefb33cea1edf4d13859e Author: Gemini Lasswell Date: Tue Aug 14 11:06:04 2018 -0700 Make small fixes to Edebug and debugger documentation * doc/lispref/elisp.texi (Top): Update menu. * doc/lispref/edebug.texi (Edebug Misc): Index edebug-backtrace-show-instrumentation and edebug-backtrace-hide-instrumentation. diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index 54200b9990..b1a6511716 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -445,6 +445,8 @@ Display a backtrace, excluding Edebug's own functions for clarity @xref{Backtraces}, for a description of backtraces and the commands which work on them. +@findex edebug-backtrace-show-instrumentation +@findex edebug-backtrace-hide-instrumentation If you would like to see Edebug's functions in the backtrace, use @kbd{M-x edebug-backtrace-show-instrumentation}. To hide them again use @kbd{M-x edebug-backtrace-hide-instrumentation}. diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index 7ac9198bf8..1d861fbced 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -655,7 +655,8 @@ The Lisp Debugger * Function Debugging:: Entering it when a certain function is called. * Variable Debugging:: Entering it when a variable is modified. * Explicit Debug:: Entering it at a certain point in the program. -* Using Debugger:: What the debugger does; what you see while in it. +* Using Debugger:: What the debugger does. +* Backtraces:: What you see while in the debugger. * Debugger Commands:: Commands used while in the debugger. * Invoking the Debugger:: How to call the function @code{debug}. * Internals of Debugger:: Subroutines of the debugger, and global variables. commit bdba72b67199c0899b2e416bf818d240252f8700 Author: Gemini Lasswell Date: Mon Aug 13 15:45:11 2018 -0700 Make list-threads refresh the *Threads* buffer if it already exists * lisp/thread.el (list-threads): Call revert-buffer instead of waiting for the timer function to do it. diff --git a/lisp/thread.el b/lisp/thread.el index c4a4c11357..4cd253e2cf 100644 --- a/lisp/thread.el +++ b/lisp/thread.el @@ -84,7 +84,9 @@ An EVENT has the format (with-current-buffer buf (unless (derived-mode-p 'thread-list-mode) (thread-list-mode) - (run-at-time 0 nil #'thread-list--timer-func buf))) + (run-at-time thread-list-refresh-seconds nil + #'thread-list--timer-func buf)) + (revert-buffer)) (switch-to-buffer buf))) ;; This command can be destructive if they don't know what they are ;; doing. Kids, don't try this at home! commit ea1ec0ed2e6ebbd4650aa5a7d662f2568f1d858f Author: Gemini Lasswell Date: Wed Aug 1 09:25:28 2018 -0700 Improve docstrings of thread-list functions * lisp/thread.el (thread-list--timer-func): Change argument from 'buf' to 'buffer'. (thread-list--get-entries, thread-list--get-status): Improve docstring. (thread-list--send-signal): Change argument from 'sgnl' to 'signal'. Tell the user when the thread is no longer alive. diff --git a/lisp/thread.el b/lisp/thread.el index cb1e7721de..c4a4c11357 100644 --- a/lisp/thread.el +++ b/lisp/thread.el @@ -90,16 +90,16 @@ An EVENT has the format ;; doing. Kids, don't try this at home! ;;;###autoload (put 'list-threads 'disabled "Beware: manually canceling threads can ruin your Emacs session.") -(defun thread-list--timer-func (buf) - "Revert BUF and set a timer to do it again." - (when (buffer-live-p buf) - (with-current-buffer buf +(defun thread-list--timer-func (buffer) + "Revert BUFFER and set a timer to do it again." + (when (buffer-live-p buffer) + (with-current-buffer buffer (revert-buffer)) (run-at-time thread-list-refresh-seconds nil - #'thread-list--timer-func buf))) + #'thread-list--timer-func buffer))) (defun thread-list--get-entries () - "Return tabulated list entries for the threads currently active." + "Return tabulated list entries for the currently live threads." (let (entries) (dolist (thread (all-threads)) (pcase-let ((`(,status ,blocker) (thread-list--get-status thread))) @@ -112,9 +112,8 @@ An EVENT has the format (defun thread-list--get-status (thread) "Describe the status of THREAD. -Return a list of two strings, the first describing THREAD's -status and the second describing what it is blocked on if it is -blocked." +Return a list of two strings, one describing THREAD's status, the +other describing THREAD's blocker, if any." (cond ((not (thread-alive-p thread)) '("Finished" "")) ((eq thread (current-thread)) '("Running" "")) @@ -132,14 +131,16 @@ blocked." (interactive) (thread-list--send-signal 'error)) -(defun thread-list--send-signal (sgnl) - "Send the signal SGNL to the thread at point. -Confirm with the user first." +(defun thread-list--send-signal (signal) + "Send the specified SIGNAL to the thread at point. +Ask for user confirmation before signaling the thread." (let ((thread (tabulated-list-get-id))) - (when (and (threadp thread) (thread-alive-p thread)) - (when (y-or-n-p (format "Send %s signal to %s? " sgnl thread)) - (when (and (threadp thread) (thread-alive-p thread)) - (thread-signal thread sgnl nil)))))) + (if (and (threadp thread) (thread-alive-p thread)) + (when (y-or-n-p (format "Send %s signal to %s? " signal thread)) + (if (and (threadp thread) (thread-alive-p thread)) + (thread-signal thread signal nil) + (message "This thread is no longer alive"))) + (message "This thread is no longer alive")))) (provide 'thread) ;;; thread.el ends here commit 3ca82c59de839f9c10318438ecc87f931b8a0208 Author: Gemini Lasswell Date: Wed Aug 1 09:22:32 2018 -0700 Make lisp/thread.el the new home for thread-related Lisp functions * lisp/emacs-lisp/thread-list.el: Remove. * lisp/emacs-lisp/thread.el: Remove. * lisp/thread.el: New file. diff --git a/lisp/emacs-lisp/thread.el b/lisp/emacs-lisp/thread.el deleted file mode 100644 index 5d7b90c26e..0000000000 --- a/lisp/emacs-lisp/thread.el +++ /dev/null @@ -1,44 +0,0 @@ -;;; thread.el --- List active threads in a buffer -*- lexical-binding: t -*- - -;; Copyright (C) 2018 Free Software Foundation, Inc. - -;; Author: Gemini Lasswell -;; Maintainer: emacs-devel@gnu.org -;; Keywords: lisp, tools, maint - -;; 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 . - -;;; Commentary: - -;;; Code: - -;;;###autoload -(defun thread-handle-event (event) - "Handle thread events, propagated by `thread-signal'. -An EVENT has the format - (thread-event THREAD ERROR-SYMBOL DATA)" - (interactive "e") - (if (and (consp event) - (eq (car event) 'thread-event) - (= (length event) 4)) - (let ((thread (cadr event)) - (err (cddr event))) - (message "Error %s: %S" thread err)))) - -(make-obsolete 'thread-alive-p 'thread-live-p "27.1") - -(provide 'thread) -;;; thread.el ends here diff --git a/lisp/emacs-lisp/thread-list.el b/lisp/thread.el similarity index 87% rename from lisp/emacs-lisp/thread-list.el rename to lisp/thread.el index af1177764b..cb1e7721de 100644 --- a/lisp/emacs-lisp/thread-list.el +++ b/lisp/thread.el @@ -1,10 +1,10 @@ -;;; thread-list.el --- List active threads in a buffer -*- lexical-binding: t -*- +;;; thread.el --- Thread support in Emacs Lisp -*- lexical-binding: t -*- ;; Copyright (C) 2018 Free Software Foundation, Inc. ;; Author: Gemini Lasswell ;; Maintainer: emacs-devel@gnu.org -;; Keywords: lisp, tools, maint +;; Keywords: thread, tools ;; This file is part of GNU Emacs. @@ -29,6 +29,23 @@ (require 'pcase) (require 'subr-x) +;;;###autoload +(defun thread-handle-event (event) + "Handle thread events, propagated by `thread-signal'. +An EVENT has the format + (thread-event THREAD ERROR-SYMBOL DATA)" + (interactive "e") + (if (and (consp event) + (eq (car event) 'thread-event) + (= (length event) 4)) + (let ((thread (cadr event)) + (err (cddr event))) + (message "Error %s: %S" thread err)))) + +(make-obsolete 'thread-alive-p 'thread-live-p "27.1") + +;;; The thread list buffer and list-threads command + (defcustom thread-list-refresh-seconds 0.5 "Seconds between automatic refreshes of the *Threads* buffer." :group 'thread-list @@ -124,5 +141,5 @@ Confirm with the user first." (when (and (threadp thread) (thread-alive-p thread)) (thread-signal thread sgnl nil)))))) -(provide 'thread-list) -;;; thread-list.el ends here +(provide 'thread) +;;; thread.el ends here commit a133b1f7d6a6961cdb59217918ce7f7c106f420e Author: Gemini Lasswell Date: Sat Jul 28 15:18:49 2018 -0700 Add list-threads command and thread-list-mode * lisp/emacs-lisp/thread-list.el: New file. diff --git a/lisp/emacs-lisp/thread-list.el b/lisp/emacs-lisp/thread-list.el new file mode 100644 index 0000000000..af1177764b --- /dev/null +++ b/lisp/emacs-lisp/thread-list.el @@ -0,0 +1,128 @@ +;;; thread-list.el --- List active threads in a buffer -*- lexical-binding: t -*- + +;; Copyright (C) 2018 Free Software Foundation, Inc. + +;; Author: Gemini Lasswell +;; Maintainer: emacs-devel@gnu.org +;; Keywords: lisp, tools, maint + +;; 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 . + +;;; Commentary: + +;;; Code: + +(require 'cl-lib) +(require 'pcase) +(require 'subr-x) + +(defcustom thread-list-refresh-seconds 0.5 + "Seconds between automatic refreshes of the *Threads* buffer." + :group 'thread-list + :type 'number + :version "27.1") + +(defvar thread-list-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map tabulated-list-mode-map) + (define-key map "s" nil) + (define-key map "sq" #'thread-list-send-quit-signal) + (define-key map "se" #'thread-list-send-error-signal) + (easy-menu-define nil map "" + '("Threads" + ["Send Quit Signal" thread-list-send-quit-signal t] + ["Send Error Signal" thread-list-send-error-signal t])) + map) + "Local keymap for `thread-list-mode' buffers.") + +(define-derived-mode thread-list-mode tabulated-list-mode "Thread-List" + "Major mode for monitoring Lisp threads." + (setq tabulated-list-format + [("Thread Name" 15 t) + ("Status" 10 t) + ("Blocked On" 30 t)]) + (setq tabulated-list-sort-key (cons (car (aref tabulated-list-format 0)) nil)) + (setq tabulated-list-entries #'thread-list--get-entries) + (tabulated-list-init-header)) + +;;;###autoload +(defun list-threads () + "Display a list of threads." + (interactive) + ;; Generate the Threads list buffer, and switch to it. + (let ((buf (get-buffer-create "*Threads*"))) + (with-current-buffer buf + (unless (derived-mode-p 'thread-list-mode) + (thread-list-mode) + (run-at-time 0 nil #'thread-list--timer-func buf))) + (switch-to-buffer buf))) +;; This command can be destructive if they don't know what they are +;; doing. Kids, don't try this at home! +;;;###autoload (put 'list-threads 'disabled "Beware: manually canceling threads can ruin your Emacs session.") + +(defun thread-list--timer-func (buf) + "Revert BUF and set a timer to do it again." + (when (buffer-live-p buf) + (with-current-buffer buf + (revert-buffer)) + (run-at-time thread-list-refresh-seconds nil + #'thread-list--timer-func buf))) + +(defun thread-list--get-entries () + "Return tabulated list entries for the threads currently active." + (let (entries) + (dolist (thread (all-threads)) + (pcase-let ((`(,status ,blocker) (thread-list--get-status thread))) + (push `(,thread [,(or (thread-name thread) + (and (eq thread main-thread) "Main") + (prin1-to-string thread)) + ,status ,blocker]) + entries))) + entries)) + +(defun thread-list--get-status (thread) + "Describe the status of THREAD. +Return a list of two strings, the first describing THREAD's +status and the second describing what it is blocked on if it is +blocked." + (cond + ((not (thread-alive-p thread)) '("Finished" "")) + ((eq thread (current-thread)) '("Running" "")) + (t (if-let ((blocker (thread--blocker thread))) + `("Blocked" ,(prin1-to-string blocker)) + '("Yielded" ""))))) + +(defun thread-list-send-quit-signal () + "Send a quit signal to the thread at point." + (interactive) + (thread-list--send-signal 'quit)) + +(defun thread-list-send-error-signal () + "Send an error signal to the thread at point." + (interactive) + (thread-list--send-signal 'error)) + +(defun thread-list--send-signal (sgnl) + "Send the signal SGNL to the thread at point. +Confirm with the user first." + (let ((thread (tabulated-list-get-id))) + (when (and (threadp thread) (thread-alive-p thread)) + (when (y-or-n-p (format "Send %s signal to %s? " sgnl thread)) + (when (and (threadp thread) (thread-alive-p thread)) + (thread-signal thread sgnl nil)))))) + +(provide 'thread-list) +;;; thread-list.el ends here commit e48968561728d6c1d9e4e8753cd7eafa08e37ac7 Author: Eli Zaretskii Date: Sat Sep 8 12:20:55 2018 +0300 Fix documentation for conversion to bignums * src/xselect.c (selection_data_to_lisp_data): * src/w32fns.c (Fw32_read_registry): * src/process.c (Fprocess_id): * src/font.c (Ffont_variation_glyphs, Finternal_char_font): * src/fns.c (Fsafe_length): * src/editfns.c (Fuser_uid, Fuser_real_uid, Fgroup_gid) (Fgroup_real_gid, Femacs_pid): * src/dired.c (Ffile_attributes): * src/charset.c (Fencode_char): Update commentary and doc strings for recent changes that produce bignums where previously cons cells of integers were produced. diff --git a/src/charset.c b/src/charset.c index 7b272a204a..e11a8366d5 100644 --- a/src/charset.c +++ b/src/charset.c @@ -1870,7 +1870,9 @@ although this usage is obsolescent. */) DEFUN ("encode-char", Fencode_char, Sencode_char, 2, 2, 0, doc: /* Encode the character CH into a code-point of CHARSET. -Return nil if CHARSET doesn't include CH. */) +Return the encoded code-point, a fixnum if its value is small enough, +otherwise a bignum. +Return nil if CHARSET doesn't support CH. */) (Lisp_Object ch, Lisp_Object charset) { int c, id; diff --git a/src/dired.c b/src/dired.c index c4cda400a0..70c5bb24b4 100644 --- a/src/dired.c +++ b/src/dired.c @@ -867,7 +867,8 @@ Elements of the attribute list are: 0. t for directory, string (name linked to) for symbolic link, or nil. 1. Number of links to file. 2. File uid as a string or a number. If a string value cannot be - looked up, an integer value is returned. + looked up, an integer value is returned, which could be a fixnum, + if it's small enough, otherwise a bignum. 3. File gid, likewise. 4. Last access time, as a list of integers (HIGH LOW USEC PSEC) in the same style as (current-time). @@ -876,16 +877,14 @@ Elements of the attribute list are: change to the file's contents. 6. Last status change time, likewise. This is the time of last change to the file's attributes: owner and group, access mode bits, etc. - 7. Size in bytes. + 7. Size in bytes, which could be a fixnum, if it's small enough, + otherwise a bignum. 8. File modes, as a string of ten letters or dashes as in ls -l. 9. An unspecified value, present only for backward compatibility. -10. inode number. If it is larger than what an Emacs integer can hold, - this is of the form (HIGH . LOW): first the high bits, then the low 16 bits. - If even HIGH is too large for an Emacs integer, this is instead of the form - (HIGH MIDDLE . LOW): first the high bits, then the middle 24 bits, - and finally the low 16 bits. -11. Filesystem device number. If it is larger than what the Emacs - integer can hold, this is a cons cell, similar to the inode number. +10. inode number, which could be a fixnum, if it's small enough, + otherwise a bignum. +11. Filesystem device number. If it is larger than what a fixnum + can hold, it is a bignum. On most filesystems, the combination of the inode and the device number uniquely identifies the file. diff --git a/src/editfns.c b/src/editfns.c index 191a9ab8f8..f19c3f1dca 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -1377,7 +1377,8 @@ This ignores the environment variables LOGNAME and USER, so it differs from } DEFUN ("user-uid", Fuser_uid, Suser_uid, 0, 0, 0, - doc: /* Return the effective uid of Emacs. */) + doc: /* Return the effective uid of Emacs. +Value is a fixnum, if it's small enough, otherwise a bignum. */) (void) { uid_t euid = geteuid (); @@ -1385,7 +1386,8 @@ DEFUN ("user-uid", Fuser_uid, Suser_uid, 0, 0, 0, } DEFUN ("user-real-uid", Fuser_real_uid, Suser_real_uid, 0, 0, 0, - doc: /* Return the real uid of Emacs. */) + doc: /* Return the real uid of Emacs. +Value is a fixnum, if it's small enough, otherwise a bignum. */) (void) { uid_t uid = getuid (); @@ -1393,7 +1395,8 @@ DEFUN ("user-real-uid", Fuser_real_uid, Suser_real_uid, 0, 0, 0, } DEFUN ("group-gid", Fgroup_gid, Sgroup_gid, 0, 0, 0, - doc: /* Return the effective gid of Emacs. */) + doc: /* Return the effective gid of Emacs. +Value is a fixnum, if it's small enough, otherwise a bignum. */) (void) { gid_t egid = getegid (); @@ -1401,7 +1404,8 @@ DEFUN ("group-gid", Fgroup_gid, Sgroup_gid, 0, 0, 0, } DEFUN ("group-real-gid", Fgroup_real_gid, Sgroup_real_gid, 0, 0, 0, - doc: /* Return the real gid of Emacs. */) + doc: /* Return the real gid of Emacs. +Value is a fixnum, if it's small enough, otherwise a bignum. */) (void) { gid_t gid = getgid (); @@ -1481,7 +1485,8 @@ DEFUN ("system-name", Fsystem_name, Ssystem_name, 0, 0, 0, } DEFUN ("emacs-pid", Femacs_pid, Semacs_pid, 0, 0, 0, - doc: /* Return the process ID of Emacs, as a number. */) + doc: /* Return the process ID of Emacs, as a number. +Value is a fixnum, if it's small enough, otherwise a bignum. */) (void) { pid_t pid = getpid (); diff --git a/src/fns.c b/src/fns.c index 5a98f14881..c9a6dd6de1 100644 --- a/src/fns.c +++ b/src/fns.c @@ -133,7 +133,8 @@ DEFUN ("safe-length", Fsafe_length, Ssafe_length, 1, 1, 0, doc: /* Return the length of a list, but avoid error or infinite loop. This function never gets an error. If LIST is not really a list, it returns 0. If LIST is circular, it returns an integer that is at -least the number of distinct elements. */) +least the number of distinct elements. +Value is a fixnum, if it's small enough, otherwise a bignum. */) (Lisp_Object list) { intptr_t len = 0; diff --git a/src/font.c b/src/font.c index 50ec39a9a4..799d5db205 100644 --- a/src/font.c +++ b/src/font.c @@ -4485,7 +4485,8 @@ Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID), where VARIATION-SELECTOR is a character code of variation selection (#xFE00..#xFE0F or #xE0100..#xE01EF) - GLYPH-ID is a glyph code of the corresponding variation glyph. */) + GLYPH-ID is a glyph code of the corresponding variation glyph, +a fixnum, if it's small enough, otherwise a bignum. */) (Lisp_Object font_object, Lisp_Object character) { unsigned variations[256]; @@ -4522,7 +4523,8 @@ where that apply to POSITION. POSITION may be nil, in which case, FONT-SPEC is the font for displaying the character CH with the default face. GLYPH-CODE is the glyph code in the font to use for - the character. + the character, it is a fixnum, if it is small enough, otherwise a + bignum. For a text terminal, return a nonnegative integer glyph code for the character, or a negative integer if the character is not diff --git a/src/process.c b/src/process.c index 454278a5a2..ebaaf33e57 100644 --- a/src/process.c +++ b/src/process.c @@ -1157,6 +1157,7 @@ If PROCESS has not yet exited or died, return 0. */) DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0, doc: /* Return the process id of PROCESS. This is the pid of the external process which PROCESS uses or talks to. +It is a fixnum if the value is small enough, otherwise a bignum. For a network, serial, and pipe connections, this value is nil. */) (register Lisp_Object process) { diff --git a/src/w32fns.c b/src/w32fns.c index 153cba9f75..9a9789d8af 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -10100,19 +10100,16 @@ the return value depends on the type of the data stored in Registry: If the data type is REG_NONE, the function returns t. If the data type is REG_DWORD or REG_QWORD, the function returns - its integer value. If the value is too large for a Lisp integer, - the function returns a cons (HIGH . LOW) of 2 integers, with LOW - the low 16 bits and HIGH the high bits. If HIGH is too large for - a Lisp integer, the function returns (HIGH MIDDLE . LOW), first - the high bits, then the middle 24 bits, and finally the low 16 bits. + its integer value. If the value is too large for a fixnum, + the function returns a bignum. If the data type is REG_BINARY, the function returns a vector whose elements are individual bytes of the value. If the data type is REG_SZ, the function returns a string. - If the data type REG_EXPAND_SZ, the function returns a string with - all the %..% references to environment variables replaced by the - values of those variables. If the expansion fails, or some - variables are not defined in the environment, some or all of - the environment variables will remain unexpanded. + If the data type is REG_EXPAND_SZ, the function returns a string + with all the %..% references to environment variables replaced + by the values of those variables. If the expansion fails, or + some variables are not defined in the environment, some or all + of the environment variables will remain unexpanded. If the data type is REG_MULTI_SZ, the function returns a list whose elements are the individual strings. diff --git a/src/xselect.c b/src/xselect.c index 53e788523c..a87784fb4b 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -1536,17 +1536,10 @@ x_get_window_property_as_lisp_data (struct x_display_info *dpyinfo, ATOM 32 > 1 Vector of Symbols * 16 1 Integer * 16 > 1 Vector of Integers - * 32 1 if <=16 bits: Integer - if > 16 bits: Cons of top16, bot16 + * 32 1 if small enough: fixnum + otherwise: bignum * 32 > 1 Vector of the above - When converting a Lisp number to C, it is assumed to be of format 16 if - it is an integer, and of format 32 if it is a cons of two integers. - - When converting a vector of numbers from Lisp to C, it is assumed to be - of format 16 if every element in the vector is an integer, and is assumed - to be of format 32 if any element is a cons of two integers. - When converting an object to C, it may be of the form (SYMBOL . ) where SYMBOL is what we should claim that the type is. Format and representation are as above. @@ -1611,8 +1604,8 @@ selection_data_to_lisp_data (struct x_display_info *dpyinfo, } /* Convert a single 16-bit number or a small 32-bit number to a Lisp_Int. - If the number is 32 bits and won't fit in a Lisp_Int, - convert it to a cons of integers, 16 bits in each half. + If the number is 32 bits and won't fit in a Lisp_Int, convert it + to a bignum. INTEGER is a signed type, CARDINAL is unsigned. Assume any other types are unsigned as well. commit f9a72b83abc0f8de85840269b59c228b55496dd4 Author: Paul Eggert Date: Fri Sep 7 11:16:45 2018 -0700 * src/puresize.h (BASE_PURESIZE): Bump to 2000000. Needed on Fedora 28 x86. diff --git a/src/puresize.h b/src/puresize.h index e6319ff2d2..b37ab977ac 100644 --- a/src/puresize.h +++ b/src/puresize.h @@ -47,7 +47,7 @@ INLINE_HEADER_BEGIN #endif #ifndef BASE_PURESIZE -#define BASE_PURESIZE (1900000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA) +#define BASE_PURESIZE (2000000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA) #endif /* Increase BASE_PURESIZE by a ratio depending on the machine's word size. */ commit 28da6accb037b32dddf172a35d522587465d3da3 Author: Paul Eggert Date: Fri Sep 7 09:50:19 2018 -0700 One more GC-aligned struct * src/lisp.h (struct Lisp_Sub_Char_Table): Mark this with GCALIGNED_STRUCT, too. diff --git a/src/lisp.h b/src/lisp.h index 56623a75f7..f2a3ac9213 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1890,7 +1890,7 @@ struct Lisp_Sub_Char_Table /* Use set_sub_char_table_contents to set this. */ Lisp_Object contents[FLEXIBLE_ARRAY_MEMBER]; - }; + } GCALIGNED_STRUCT; INLINE bool SUB_CHAR_TABLE_P (Lisp_Object a) commit cab3ca9d3d9449867e9fe1f954fec386a3bb7d46 Author: Paul Eggert Date: Fri Sep 7 09:17:25 2018 -0700 Fix overenthusiastic header size check Problem reported by Eli Zaretskii in: https://lists.gnu.org/r/emacs-devel/2018-09/msg00222.html * doc/lispref/internals.texi (Garbage Collection): Document vector sizes and slot counts more accurately. * src/lisp.h: Omit header_size sanity check that was too picky. Add some less-picky checks. diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 3fe28446ea..d42e2444e6 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -382,7 +382,7 @@ This is used for convenience and equals to @code{sizeof (char)}. The total size of all string data in bytes. @item vector-size -Internal size of a vector header, i.e., @code{sizeof (struct Lisp_Vector)}. +Size in bytes of a vector of length 1, including its header. @item used-vectors The number of vector headers allocated from the vector blocks. @@ -392,6 +392,8 @@ Internal size of a vector slot, always equal to @code{sizeof (Lisp_Object)}. @item used-slots The number of slots in all used vectors. +Slot counts might include some or all overhead from vector headers, +depending on the platform. @item free-slots The number of free slots in all vector blocks. diff --git a/src/lisp.h b/src/lisp.h index 7e365e8f47..56623a75f7 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1619,7 +1619,16 @@ struct Lisp_Bool_Vector } GCALIGNED_STRUCT; /* Some handy constants for calculating sizes - and offsets, mostly of vectorlike objects. */ + and offsets, mostly of vectorlike objects. + + The garbage collector assumes that the initial part of any struct + that starts with a union vectorlike_header followed by N + Lisp_Objects (some possibly in arrays and/or a trailing flexible + array) will be laid out like a struct Lisp_Vector with N + Lisp_Objects. This assumption is true in practice on known Emacs + targets even though the C standard does not guarantee it. This + header contains a few sanity checks that should suffice to detect + violations of this assumption on plausible practical hosts. */ enum { @@ -1627,7 +1636,6 @@ enum bool_header_size = offsetof (struct Lisp_Bool_Vector, data), word_size = sizeof (Lisp_Object) }; -verify (header_size == sizeof (union vectorlike_header)); /* The number of data words and bytes in a bool vector with SIZE bits. */ @@ -1989,6 +1997,13 @@ enum char_table_specials SUB_CHAR_TABLE_OFFSET = PSEUDOVECSIZE (struct Lisp_Sub_Char_Table, contents) }; +/* Sanity-check pseudovector layout. */ +verify (offsetof (struct Lisp_Char_Table, defalt) == header_size); +verify (offsetof (struct Lisp_Char_Table, extras) + == header_size + CHAR_TABLE_STANDARD_SLOTS * sizeof (Lisp_Object)); +verify (offsetof (struct Lisp_Sub_Char_Table, contents) + == header_size + SUB_CHAR_TABLE_OFFSET * sizeof (Lisp_Object)); + /* Return the number of "extra" slots in the char table CT. */ INLINE int @@ -1998,11 +2013,6 @@ CHAR_TABLE_EXTRA_SLOTS (struct Lisp_Char_Table *ct) - CHAR_TABLE_STANDARD_SLOTS); } -/* Make sure that sub char-table contents slot is where we think it is. */ -verify (offsetof (struct Lisp_Sub_Char_Table, contents) - == (offsetof (struct Lisp_Vector, contents) - + SUB_CHAR_TABLE_OFFSET * sizeof (Lisp_Object))); - /* Save and restore the instruction and environment pointers, without affecting the signal mask. */ @@ -2216,6 +2226,8 @@ struct Lisp_Hash_Table struct Lisp_Hash_Table *next_weak; } GCALIGNED_STRUCT; +/* Sanity-check pseudovector layout. */ +verify (offsetof (struct Lisp_Hash_Table, weak) == header_size); INLINE bool HASH_TABLE_P (Lisp_Object a) commit 752a05b17dfb1bfb27867f1cf3a7548dbb570d26 Author: Eli Zaretskii Date: Fri Sep 7 17:41:21 2018 +0300 Read Windows OS info for report-emacs-bug from Registry * lisp/w32-fns.el (w32--os-description): New function. * lisp/mail/emacsbug.el (report-emacs-bug--os-description): Use 'w32--os-description' instead of launching the 'systeminfo' program, which can be very slow, and is also missing on versions of Windows before XP Professional. diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index 92b005d47d..8cacad8726 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -134,22 +134,7 @@ This requires either the macOS \"open\" command, or the freedesktop os)) ((eq system-type 'windows-nt) (or report-emacs-bug--os-description - (setq - report-emacs-bug--os-description - (let (os) - (with-temp-buffer - ;; Seems like this command can be slow, because it - ;; unconditionally queries a bunch of other stuff - ;; we don't care about. - (when (eq 0 (ignore-errors - (call-process "systeminfo" nil '(t nil) nil))) - (dolist (s '("OS Name" "OS Version")) - (goto-char (point-min)) - (if (re-search-forward - (format "^%s\\s-*:\\s-+\\(.*\\)$" s) - nil t) - (setq os (concat os " " (match-string 1))))))) - os)))) + (setq report-emacs-bug--os-description (w32--os-description)))) ((eq system-type 'berkeley-unix) (with-temp-buffer (when diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el index a8a41c453a..91fe5186bc 100644 --- a/lisp/w32-fns.el +++ b/lisp/w32-fns.el @@ -39,6 +39,8 @@ ;; same buffer. (setq find-file-visit-truename t)) +;;;; Shells + (defun w32-shell-name () "Return the name of the shell being used." (or (bound-and-true-p shell-file-name) @@ -120,6 +122,8 @@ You should set this to t when using a non-system shell.\n\n")))) (add-hook 'after-init-hook 'w32-check-shell-configuration) +;;;; Coding-systems, locales, etc. + ;; Override setting chosen at startup. (defun w32-set-default-process-coding-system () ;; Most programs on Windows will accept Unix line endings on input @@ -187,31 +191,6 @@ You should set this to t when using a non-system shell.\n\n")))) ;; (setq source-directory (file-name-as-directory ;; (expand-file-name ".." exec-directory))))) -(defun w32-convert-standard-filename (filename) - "Convert a standard file's name to something suitable for MS-Windows. -This means to guarantee valid names and perhaps to canonicalize -certain patterns. - -This function is called by `convert-standard-filename'. - -Replace invalid characters and turn Cygwin names into native -names." - (save-match-data - (let ((name - (if (string-match "\\`/cygdrive/\\([a-zA-Z]\\)/" filename) - (replace-match "\\1:/" t nil filename) - (copy-sequence filename))) - (start 0)) - ;; leave ':' if part of drive specifier - (if (and (> (length name) 1) - (eq (aref name 1) ?:)) - (setq start 2)) - ;; destructively replace invalid filename characters with ! - (while (string-match "[?*:<>|\"\000-\037]" name start) - (aset name (match-beginning 0) ?!) - (setq start (match-end 0))) - name))) - (defun w32-set-system-coding-system (coding-system) "Set the coding system used by the Windows system to CODING-SYSTEM. This is used for things like passing font names with non-ASCII @@ -297,6 +276,76 @@ bit output with no translation." (w32-add-charset-info "tis620-0" 'w32-charset-thai 874) (w32-add-charset-info "iso8859-1" 'w32-charset-ansi 1252)) +;;;; Standard filenames + +(defun w32-convert-standard-filename (filename) + "Convert a standard file's name to something suitable for MS-Windows. +This means to guarantee valid names and perhaps to canonicalize +certain patterns. + +This function is called by `convert-standard-filename'. + +Replace invalid characters and turn Cygwin names into native +names." + (save-match-data + (let ((name + (if (string-match "\\`/cygdrive/\\([a-zA-Z]\\)/" filename) + (replace-match "\\1:/" t nil filename) + (copy-sequence filename))) + (start 0)) + ;; leave ':' if part of drive specifier + (if (and (> (length name) 1) + (eq (aref name 1) ?:)) + (setq start 2)) + ;; destructively replace invalid filename characters with ! + (while (string-match "[?*:<>|\"\000-\037]" name start) + (aset name (match-beginning 0) ?!) + (setq start (match-end 0))) + name))) + +;;;; System name and version for emacsbug.el + +(defun w32--os-description () + "Return a string describing the underlying OS and its version." + (let* ((w32ver (car (w32-version))) + (w9x-p (< w32ver 5)) + (key (if w9x-p + "SOFTWARE/Microsoft/Windows/CurrentVersion" + "SOFTWARE/Microsoft/Windows NT/CurrentVersion")) + (os-name (w32-read-registry 'HKLM key "ProductName")) + (os-version (if w9x-p + (w32-read-registry 'HKLM key "VersionNumber") + (let ((vmajor + (w32-read-registry 'HKLM key + "CurrentMajorVersionNumber")) + (vminor + (w32-read-registry 'HKLM key + "CurrentMinorVersionNumber"))) + (if (and vmajor vmajor) + (format "%d.%d" vmajor vminor) + (w32-read-registry 'HKLM key "CurrentVersion"))))) + (os-csd (w32-read-registry 'HKLM key "CSDVersion")) + (os-rel (or (w32-read-registry 'HKLM key "ReleaseID") + (w32-read-registry 'HKLM key "CSDBuildNumber") + "0")) ; No Release ID before Windows Vista + (os-build (w32-read-registry 'HKLM key "CurrentBuildNumber")) + (os-rev (w32-read-registry 'HKLM key "UBR")) + (os-rev (if os-rev (format "%d" os-rev)))) + (if w9x-p + (concat + (if (not (string-match "\\`Microsoft " os-name)) "Microsoft ") + os-name + " (v" os-version ")") + (concat + (if (not (string-match "\\`Microsoft " os-name)) "Microsoft ") + os-name ; Windows 7 Enterprise + " " + os-csd ; Service Pack 1 + (if (and os-csd (> (length os-csd) 0)) " " "") + "(v" + os-version "." os-rel "." os-build (if os-rev (concat "." os-rev)) + ")")))) + ;;;; Support for build process commit 96281c5ee1582ac0c329d09797ab7ab3dbae26d1 Author: Eli Zaretskii Date: Fri Sep 7 10:35:59 2018 +0300 Record :version for built-in variables while dumping * lisp/cus-start.el (standard): Record the ':version; of the symbols when dumping, so that 'describe-variable' could tell which built-in variables were added/changed in recent versions. diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 451e7f762f..8ed0f805d0 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -706,6 +706,8 @@ since it could result in memory overflow and make Emacs crash." (put symbol 'risky-local-variable (cadr prop))) (if (setq prop (memq :set rest)) (put symbol 'custom-set (cadr prop))) + ;; This is used by describe-variable. + (if version (put symbol 'custom-version version)) ;; Note this is the _only_ initialize property we handle. (if (eq (cadr (memq :initialize rest)) 'custom-initialize-delay) ;; These vars are defined early and should hence be initialized @@ -724,7 +726,6 @@ since it could result in memory overflow and make Emacs crash." (custom-add-to-group group symbol 'custom-variable)) ;; Set the type. (put symbol 'custom-type type) - (if version (put symbol 'custom-version version)) (while rest (setq prop (car rest) propval (cadr rest) commit 2c8520e19c0fe72d046033e39953b7a0a87be24e Author: Paul Eggert Date: Thu Sep 6 19:17:14 2018 -0700 Shrink pseudovectors a bit sizeof (struct Lisp_Marker) was 32 on x86, where 24 would do. Problem noted by Stefan Monnier in: https://lists.gnu.org/r/emacs-devel/2018-09/msg00165.html * src/bignum.h (struct Lisp_Bignum): * src/frame.h (struct frame): * src/lisp.h (struct Lisp_Vector, struct Lisp_Bool_Vector) (struct Lisp_Char_Table, struct Lisp_Hash_Table) (struct Lisp_Marker, struct Lisp_Overlay) (struct Lisp_Misc_Ptr, struct Lisp_User_Ptr) (struct Lisp_Finalizer, struct Lisp_Float) (struct Lisp_Module_Function): * src/process.h (struct Lisp_Process): * src/termhooks.h (struct terminal): * src/thread.h (struct thread_state, struct Lisp_Mutex) (struct Lisp_CondVar): * src/window.c (struct save_window_data): * src/window.h (struct window): * src/xterm.h (struct scroll_bar): * src/xwidget.h (struct xwidget, struct xwidget_view): Add GCALIGNED_STRUCT attribute. * src/lisp.h (GCALIGNED_UNION_MEMBER): Renamed from GCALIGNED_UNION. All uses changed. (GCALIGNED_STRUCT_MEMBER, GCALIGNED_STRUCT, GCALIGNED): New macros. All uses of open-coded GCALIGNED changed to use GCALIGNED. (union vectorlike_header): No longer GC-aligned. (PSEUDOVECSIZE): Yield 0 for pseudovectors without Lisp objects that place a member before where the first Lisp object member would be. diff --git a/src/alloc.c b/src/alloc.c index 28ca7804ee..abb98a9eb6 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -641,9 +641,11 @@ buffer_memory_full (ptrdiff_t nbytes) implement Lisp objects; since pseudovectors can contain any C type, this is max_align_t. On recent GNU/Linux x86 and x86-64 this can often waste up to 8 bytes, since alignof (max_align_t) is 16 but - typical vectors need only an alignment of 8. However, it is not - worth the hassle to avoid this waste. */ -enum { LISP_ALIGNMENT = alignof (union { max_align_t x; GCALIGNED_UNION }) }; + typical vectors need only an alignment of 8. Although shrinking + the alignment to 8 would save memory, it cost a 20% hit to Emacs + CPU performance on Fedora 28 x86-64 when compiled with gcc -m32. */ +enum { LISP_ALIGNMENT = alignof (union { max_align_t x; + GCALIGNED_UNION_MEMBER }) }; verify (LISP_ALIGNMENT % GCALIGNMENT == 0); /* True if malloc (N) is known to return storage suitably aligned for diff --git a/src/bignum.h b/src/bignum.h index 0e38c615ee..6551549343 100644 --- a/src/bignum.h +++ b/src/bignum.h @@ -39,7 +39,7 @@ struct Lisp_Bignum { union vectorlike_header header; mpz_t value; -}; +} GCALIGNED_STRUCT; extern mpz_t mpz[4]; diff --git a/src/fileio.c b/src/fileio.c index 66b2333317..5ca7c595f7 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -3394,9 +3394,9 @@ union read_non_regular int fd; ptrdiff_t inserted, trytry; } s; - GCALIGNED_UNION + GCALIGNED_UNION_MEMBER }; -verify (alignof (union read_non_regular) % GCALIGNMENT == 0); +verify (GCALIGNED (union read_non_regular)); static Lisp_Object read_non_regular (Lisp_Object state) diff --git a/src/frame.h b/src/frame.h index a3bb633e57..ad7376a653 100644 --- a/src/frame.h +++ b/src/frame.h @@ -578,7 +578,7 @@ struct frame enum ns_appearance_type ns_appearance; bool_bf ns_transparent_titlebar; #endif -}; +} GCALIGNED_STRUCT; /* Most code should use these functions to set Lisp fields in struct frame. */ diff --git a/src/keymap.c b/src/keymap.c index 52db7b491f..79dce15a81 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -554,9 +554,9 @@ union map_keymap Lisp_Object args; void *data; } s; - GCALIGNED_UNION + GCALIGNED_UNION_MEMBER }; -verify (alignof (union map_keymap) % GCALIGNMENT == 0); +verify (GCALIGNED (union map_keymap)); static void map_keymap_char_table_item (Lisp_Object args, Lisp_Object key, Lisp_Object val) diff --git a/src/lisp.h b/src/lisp.h index 78c25f97dc..7e365e8f47 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -229,7 +229,7 @@ extern bool suppress_checking EXTERNALLY_VISIBLE; USE_LSB_TAG not only requires the least 3 bits of pointers returned by malloc to be 0 but also needs to be able to impose a mult-of-8 alignment on some non-GC Lisp_Objects, all of which are aligned via - GCALIGNED_UNION at the end of a union. */ + GCALIGNED_UNION_MEMBER, GCALIGNED_STRUCT_MEMBER, and GCALIGNED_STRUCT. */ enum Lisp_Bits { @@ -282,7 +282,35 @@ error !; # define GCALIGNMENT 1 #endif -#define GCALIGNED_UNION char alignas (GCALIGNMENT) gcaligned; +/* If a struct is always allocated by the GC and is therefore always + GC-aligned, put GCALIGNED_STRUCT after its closing '}'; this can + help the compiler generate better code. + + To cause a union to have alignment of at least GCALIGNMENT, put + GCALIGNED_UNION_MEMBER in its member list. Similarly for a struct + and GCALIGNED_STRUCT_MEMBER, although this may make the struct a + bit bigger on non-GCC platforms. Any struct using + GCALIGNED_STRUCT_MEMBER should also use GCALIGNED_STRUCT. + + Although these macros are reasonably portable, they are not + guaranteed on non-GCC platforms, as C11 does not require support + for alignment to GCALIGNMENT and older compilers may ignore + alignment requests. For any type T where garbage collection + requires alignment, use verify (GCALIGNED (T)) to verify the + requirement on the current platform. Types need this check if + their objects can be allocated outside the garbage collector. For + example, struct Lisp_Symbol needs the check because of lispsym and + struct Lisp_Cons needs it because of STACK_CONS. */ + +#define GCALIGNED_UNION_MEMBER char alignas (GCALIGNMENT) gcaligned; +#if HAVE_STRUCT_ATTRIBUTE_ALIGNED +# define GCALIGNED_STRUCT_MEMBER +# define GCALIGNED_STRUCT __attribute__ ((aligned (GCALIGNMENT))) +#else +# define GCALIGNED_STRUCT_MEMBER GCALIGNED_UNION_MEMBER +# define GCALIGNED_STRUCT +#endif +#define GCALIGNED(type) (alignof (type) % GCALIGNMENT == 0) /* Lisp_Word is a scalar word suitable for holding a tagged pointer or integer. Usually it is a pointer to a deliberately-incomplete type @@ -751,10 +779,10 @@ struct Lisp_Symbol /* Next symbol in obarray bucket, if the symbol is interned. */ struct Lisp_Symbol *next; } s; - GCALIGNED_UNION + GCALIGNED_UNION_MEMBER } u; }; -verify (alignof (struct Lisp_Symbol) % GCALIGNMENT == 0); +verify (GCALIGNED (struct Lisp_Symbol)); /* Declare a Lisp-callable function. The MAXARGS parameter has the same meaning as in the DEFUN macro, and is used to construct a prototype. */ @@ -843,7 +871,9 @@ typedef EMACS_UINT Lisp_Word_tag; and PSEUDOVECTORP cast their pointers to union vectorlike_header *, because when two such pointers potentially alias, a compiler won't incorrectly reorder loads and stores to their size fields. See - Bug#8546. */ + Bug#8546. This union formerly contained more members, and there's + no compelling reason to change it to a struct merely because the + number of members has been reduced to one. */ union vectorlike_header { /* The main member contains various pieces of information: @@ -866,20 +896,7 @@ union vectorlike_header Current layout limits the pseudovectors to 63 PVEC_xxx subtypes, 4095 Lisp_Objects in GC-ed area and 4095 word-sized other slots. */ ptrdiff_t size; - /* Align the union so that there is no padding after it. - This is needed for the following reason: - If the alignment constraint of Lisp_Object is greater than the size of - vectorlike_header (e.g. with-wide-int), vectorlike objects which have - 0 Lisp_Object fields and whose 1st field has a smaller alignment - constraint than Lisp_Object may end up with their 1st field "before - pseudovector index 0", in which case PSEUDOVECSIZE will return - a "negative" number. We could fix PSEUDOVECSIZE, but it's easier to - just force rounding up the size of vectorlike_header to the alignment - of Lisp_Object. */ - Lisp_Object align; - GCALIGNED_UNION }; -verify (alignof (union vectorlike_header) % GCALIGNMENT == 0); INLINE bool (SYMBOLP) (Lisp_Object x) @@ -1251,10 +1268,10 @@ struct Lisp_Cons struct Lisp_Cons *chain; } u; } s; - GCALIGNED_UNION + GCALIGNED_UNION_MEMBER } u; }; -verify (alignof (struct Lisp_Cons) % GCALIGNMENT == 0); +verify (GCALIGNED (struct Lisp_Cons)); INLINE bool (NILP) (Lisp_Object x) @@ -1373,10 +1390,10 @@ struct Lisp_String unsigned char *data; } s; struct Lisp_String *next; - GCALIGNED_UNION + GCALIGNED_UNION_MEMBER } u; }; -verify (alignof (struct Lisp_String) % GCALIGNMENT == 0); +verify (GCALIGNED (struct Lisp_String)); INLINE bool STRINGP (Lisp_Object x) @@ -1507,7 +1524,7 @@ struct Lisp_Vector { union vectorlike_header header; Lisp_Object contents[FLEXIBLE_ARRAY_MEMBER]; - }; + } GCALIGNED_STRUCT; INLINE bool (VECTORLIKEP) (Lisp_Object x) @@ -1599,7 +1616,7 @@ struct Lisp_Bool_Vector The bits are in little-endian order in the bytes, and the bytes are in little-endian order in the words. */ bits_word data[FLEXIBLE_ARRAY_MEMBER]; - }; + } GCALIGNED_STRUCT; /* Some handy constants for calculating sizes and offsets, mostly of vectorlike objects. */ @@ -1765,7 +1782,8 @@ memclear (void *p, ptrdiff_t nbytes) ones that the GC needs to trace). */ #define PSEUDOVECSIZE(type, nonlispfield) \ - ((offsetof (type, nonlispfield) - header_size) / word_size) + (offsetof (type, nonlispfield) < header_size \ + ? 0 : (offsetof (type, nonlispfield) - header_size) / word_size) /* Compute A OP B, using the unsigned comparison operator OP. A and B should be integer expressions. This is not the same as @@ -1830,7 +1848,7 @@ struct Lisp_Char_Table /* These hold additional data. It is a vector. */ Lisp_Object extras[FLEXIBLE_ARRAY_MEMBER]; - }; + } GCALIGNED_STRUCT; INLINE bool CHAR_TABLE_P (Lisp_Object a) @@ -1942,7 +1960,9 @@ struct Lisp_Subr const char *symbol_name; const char *intspec; EMACS_INT doc; - }; + GCALIGNED_STRUCT_MEMBER + } GCALIGNED_STRUCT; +verify (GCALIGNED (struct Lisp_Subr)); INLINE bool SUBRP (Lisp_Object a) @@ -2194,7 +2214,7 @@ struct Lisp_Hash_Table /* Next weak hash table if this is a weak hash table. The head of the list is in weak_hash_tables. */ struct Lisp_Hash_Table *next_weak; -}; +} GCALIGNED_STRUCT; INLINE bool @@ -2313,7 +2333,7 @@ struct Lisp_Marker used to implement the functionality of markers, but rather to (ab)use markers as a cache for char<->byte mappings). */ ptrdiff_t bytepos; -}; +} GCALIGNED_STRUCT; /* START and END are markers in the overlay's buffer, and PLIST is the overlay's property list. */ @@ -2335,13 +2355,13 @@ struct Lisp_Overlay Lisp_Object end; Lisp_Object plist; struct Lisp_Overlay *next; - }; + } GCALIGNED_STRUCT; struct Lisp_Misc_Ptr { union vectorlike_header header; void *pointer; - }; + } GCALIGNED_STRUCT; extern Lisp_Object make_misc_ptr (void *); @@ -2388,7 +2408,7 @@ struct Lisp_User_Ptr union vectorlike_header header; void (*finalizer) (void *); void *p; -}; +} GCALIGNED_STRUCT; #endif /* A finalizer sentinel. */ @@ -2404,7 +2424,7 @@ struct Lisp_Finalizer /* Circular list of all active weak references. */ struct Lisp_Finalizer *prev; struct Lisp_Finalizer *next; - }; + } GCALIGNED_STRUCT; INLINE bool FINALIZERP (Lisp_Object x) @@ -2616,7 +2636,7 @@ struct Lisp_Float double data; struct Lisp_Float *chain; } u; - }; + } GCALIGNED_STRUCT; INLINE bool (FLOATP) (Lisp_Object x) @@ -3946,7 +3966,7 @@ struct Lisp_Module_Function ptrdiff_t min_arity, max_arity; emacs_subr subr; void *data; -}; +} GCALIGNED_STRUCT; INLINE bool MODULE_FUNCTIONP (Lisp_Object o) diff --git a/src/process.h b/src/process.h index 6bc22146a7..3c6dd7b91f 100644 --- a/src/process.h +++ b/src/process.h @@ -203,7 +203,7 @@ struct Lisp_Process bool_bf gnutls_p : 1; bool_bf gnutls_complete_negotiation_p : 1; #endif -}; + } GCALIGNED_STRUCT; INLINE bool PROCESSP (Lisp_Object a) diff --git a/src/termhooks.h b/src/termhooks.h index 8b5f648b43..211429169b 100644 --- a/src/termhooks.h +++ b/src/termhooks.h @@ -661,7 +661,7 @@ struct terminal frames on the terminal when it calls this hook, so infinite recursion is prevented. */ void (*delete_terminal_hook) (struct terminal *); -}; +} GCALIGNED_STRUCT; INLINE bool TERMINALP (Lisp_Object a) diff --git a/src/thread.h b/src/thread.h index 8ecb00824d..28d8d864fb 100644 --- a/src/thread.h +++ b/src/thread.h @@ -184,7 +184,7 @@ struct thread_state /* Threads are kept on a linked list. */ struct thread_state *next_thread; -}; +} GCALIGNED_STRUCT; INLINE bool THREADP (Lisp_Object a) @@ -231,7 +231,7 @@ struct Lisp_Mutex /* The lower-level mutex object. */ lisp_mutex_t mutex; -}; +} GCALIGNED_STRUCT; INLINE bool MUTEXP (Lisp_Object a) @@ -265,7 +265,7 @@ struct Lisp_CondVar /* The lower-level condition variable object. */ sys_cond_t cond; -}; +} GCALIGNED_STRUCT; INLINE bool CONDVARP (Lisp_Object a) diff --git a/src/window.c b/src/window.c index d4fc5568a5..04de965680 100644 --- a/src/window.c +++ b/src/window.c @@ -6268,7 +6268,7 @@ struct save_window_data /* These are currently unused. We need them as soon as we convert to pixels. */ int frame_menu_bar_height, frame_tool_bar_height; - }; + } GCALIGNED_STRUCT; /* This is saved as a Lisp_Vector. */ struct saved_window diff --git a/src/window.h b/src/window.h index 013083eb9a..cc0b6b6667 100644 --- a/src/window.h +++ b/src/window.h @@ -400,7 +400,7 @@ struct window /* Z_BYTE - buffer position of the last glyph in the current matrix of W. Should be nonnegative, and only valid if window_end_valid is true. */ ptrdiff_t window_end_bytepos; - }; + } GCALIGNED_STRUCT; INLINE bool WINDOWP (Lisp_Object a) diff --git a/src/xterm.h b/src/xterm.h index 1849a5c953..2ea8a93f8c 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -937,7 +937,7 @@ struct scroll_bar /* True if the scroll bar is horizontal. */ bool horizontal; -}; +} GCALIGNED_STRUCT; /* Turning a lisp vector value into a pointer to a struct scroll_bar. */ #define XSCROLL_BAR(vec) ((struct scroll_bar *) XVECTOR (vec)) diff --git a/src/xwidget.h b/src/xwidget.h index 89fc7ff458..c203d4f60c 100644 --- a/src/xwidget.h +++ b/src/xwidget.h @@ -61,7 +61,7 @@ struct xwidget /* Kill silently if Emacs is exited. */ bool_bf kill_without_query : 1; -}; +} GCALIGNED_STRUCT; struct xwidget_view { @@ -88,7 +88,7 @@ struct xwidget_view int clip_left; long handler_id; -}; +} GCALIGNED_STRUCT; #endif /* Test for xwidget pseudovector. */ commit 82160cf0c16e22bddfd90254e4a4e03ed383c9ae Author: YAMAMOTO Mitsuharu Date: Fri Sep 7 08:35:36 2018 +0900 * src/process.c (connect_network_socket): Fix memory leak. (Bug#32604) diff --git a/src/process.c b/src/process.c index 676f38446e..b0a327229c 100644 --- a/src/process.c +++ b/src/process.c @@ -3321,11 +3321,9 @@ static void connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, Lisp_Object use_external_socket_p) { - ptrdiff_t count = SPECPDL_INDEX (); int s = -1, outch, inch; int xerrno = 0; int family; - struct sockaddr *sa = NULL; int ret; ptrdiff_t addrlen; struct Lisp_Process *p = XPROCESS (proc); @@ -3344,6 +3342,11 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, /* Do this in case we never enter the while-loop below. */ s = -1; + struct sockaddr *sa = NULL; + ptrdiff_t count = SPECPDL_INDEX (); + record_unwind_protect_nothing (); + ptrdiff_t count1 = SPECPDL_INDEX (); + while (!NILP (addrinfos)) { Lisp_Object addrinfo = XCAR (addrinfos); @@ -3356,9 +3359,8 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, #endif addrlen = get_lisp_to_sockaddr_size (ip_address, &family); - if (sa) - free (sa); - sa = xmalloc (addrlen); + sa = xrealloc (sa, addrlen); + set_unwind_protect_ptr (count, xfree, sa); conv_lisp_to_sockaddr (family, ip_address, sa, addrlen); s = socket_to_use; @@ -3520,7 +3522,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, #endif /* !WINDOWSNT */ /* Discard the unwind protect closing S. */ - specpdl_ptr = specpdl + count; + specpdl_ptr = specpdl + count1; emacs_close (s); s = -1; if (0 <= socket_to_use) @@ -3591,6 +3593,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, Lisp_Object data = get_file_errno_data (err, contact, xerrno); pset_status (p, list2 (Fcar (data), Fcdr (data))); + unbind_to (count, Qnil); return; } @@ -3610,7 +3613,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, p->outfd = outch; /* Discard the unwind protect for closing S, if any. */ - specpdl_ptr = specpdl + count; + specpdl_ptr = specpdl + count1; if (p->is_server && p->socktype != SOCK_DGRAM) pset_status (p, Qlisten); @@ -3671,6 +3674,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, } #endif + unbind_to (count, Qnil); } /* Create a network stream/datagram client/server process. Treated commit bca35315e16cb53415649e5c0ac2ec0cc1368679 Author: Michael Albinus Date: Thu Sep 6 12:16:00 2018 +0200 Fix Bug#31704 * lisp/eshell/esh-proc.el (eshell-gather-process-output): Do not let `expand-file-name' prefix remote file names with MS Windows volume letter. * lisp/net/tramp.el (tramp-eshell-directory-change): Use `path-separator' as it does eshell. (Bug#31704) diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index a7855d81db..3735f30c30 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -282,11 +282,10 @@ See `eshell-needs-pipe'." (let ((process-connection-type (unless (eshell-needs-pipe-p command) process-connection-type)) - (command (file-local-name command))) + ;; `start-process' can't deal with relative filenames. + (command (file-local-name (expand-file-name command)))) (apply 'start-file-process - (file-name-nondirectory command) nil - ;; `start-process' can't deal with relative filenames. - (append (list (expand-file-name command)) args)))) + (file-name-nondirectory command) nil command args))) (eshell-record-process-object proc) (set-process-buffer proc (current-buffer)) (if (eshell-interactive-output-p) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 0033f2c170..07154b57f2 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4623,8 +4623,10 @@ Only works for Bourne-like shells." (defun tramp-eshell-directory-change () "Set `eshell-path-env' to $PATH of the host related to `default-directory'." ;; Remove last element of `(exec-path)', which is `exec-directory'. + ;; Use `path-separator' as it does eshell. (setq eshell-path-env - (mapconcat 'identity (butlast (tramp-compat-exec-path)) ":"))) + (mapconcat + 'identity (butlast (tramp-compat-exec-path)) path-separator))) (eval-after-load "esh-util" '(progn commit 79d7138c187a5a950e4d226de333db6404700332 Author: Michael Albinus Date: Thu Sep 6 10:12:02 2018 +0200 * test/lisp/autorevert-tests.el (auto-revert-test02-auto-revert-deleted-file): Extend test. diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el index 05d24b51ee..b378c9b8b0 100644 --- a/test/lisp/autorevert-tests.el +++ b/test/lisp/autorevert-tests.el @@ -167,6 +167,7 @@ This expects `auto-revert--messages' to be bound by (write-region "any text" nil tmpfile nil 'no-message) (setq buf (find-file-noselect tmpfile)) (with-current-buffer buf + (should-not auto-revert-notify-watch-descriptor) (should (string-equal (buffer-string) "any text")) ;; `buffer-stale--default-function' checks for ;; `verify-visited-file-modtime'. We must ensure that commit 67475a59e95919e2dbe25ae950450578afdfd0dc Author: Paul Eggert Date: Wed Sep 5 16:19:47 2018 -0700 Fix timer.el minor rounding error * lisp/emacs-lisp/timer.el (timer-next-integral-multiple-of-time): Fix rounding error by using integers rather than floats. * test/lisp/emacs-lisp/timer-tests.el (timer-test-multiple-of-time): New test. diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el index 795554fec5..74d37b0eae 100644 --- a/lisp/emacs-lisp/timer.el +++ b/lisp/emacs-lisp/timer.el @@ -102,14 +102,14 @@ fire each time Emacs is idle for that many seconds." "Yield the next value after TIME that is an integral multiple of SECS. More precisely, the next value, after TIME, that is an integral multiple of SECS seconds since the epoch. SECS may be a fraction." - (let* ((trillion 1e12) + (let* ((trillion 1000000000000) (time-sec (+ (nth 1 time) - (* 65536.0 (nth 0 time)))) + (* 65536 (nth 0 time)))) (delta-sec (mod (- time-sec) secs)) - (next-sec (+ time-sec (ffloor delta-sec))) - (next-sec-psec (ffloor (* trillion (mod delta-sec 1)))) + (next-sec (+ time-sec (floor delta-sec))) + (next-sec-psec (floor (* trillion (mod delta-sec 1)))) (sub-time-psec (+ (or (nth 3 time) 0) - (* 1e6 (nth 2 time)))) + (* 1000000 (nth 2 time)))) (psec-diff (- sub-time-psec next-sec-psec))) (if (and (<= next-sec time-sec) (< 0 psec-diff)) (setq next-sec-psec (+ sub-time-psec diff --git a/test/lisp/emacs-lisp/timer-tests.el b/test/lisp/emacs-lisp/timer-tests.el index 65e5dc9bde..fa92c1b64a 100644 --- a/test/lisp/emacs-lisp/timer-tests.el +++ b/test/lisp/emacs-lisp/timer-tests.el @@ -39,4 +39,9 @@ (if (fboundp 'debug-timer-check) (should (debug-timer-check)) t)) +(ert-deftest timer-test-multiple-of-time () + (should (equal + (timer-next-integral-multiple-of-time '(0 0 0 1) (1+ (ash 1 53))) + (list (ash 1 (- 53 16)) 1 0 0)))) + ;;; timer-tests.el ends here commit 6c616e465cc83cf376d4df75f9c4afdbdf0ef6ca Author: Glenn Morris Date: Wed Sep 5 16:37:56 2018 -0400 * Makefile.in (appdatadir): Use the non-obsolete location "metainfo". ; https://www.freedesktop.org/software/appstream/docs/chap-Metadata.html ; "AppStream tools scan the /usr/share/appdata/ path for legacy ; compatibility as well. It should not be used anymore by new ; software though, even on older Linux distributions (like RHEL 7 ; and Ubuntu 16.04 LTS) the metainfo path is well supported. Support ; for the legacy path might be dropped completely in future." diff --git a/Makefile.in b/Makefile.in index 238df40ded..19bf7c423f 100644 --- a/Makefile.in +++ b/Makefile.in @@ -192,7 +192,7 @@ x_default_search_path=@x_default_search_path@ desktopdir=$(datarootdir)/applications # Where the etc/emacs.appdata.xml file is to be installed. -appdatadir=$(datarootdir)/appdata +appdatadir=$(datarootdir)/metainfo # Where the etc/emacs.service file is to be installed. # The system value (typically /usr/lib/systemd/user) can be commit e932395656b80cc30ba3a53d83bddf57339aef7d Author: Stephen Gildea Date: Sun Sep 2 17:06:29 2018 -0700 Do not call mh-next-msg from mh-junk-process-* fns * mh-junk.el (mh-junk-process-blacklist, mh-junk-process-whitelist): Do not call mh-next-msg. Now that these functions are called from mh-execute-commands, they should not change the current message pointer. The calls to mh-next-msg are probably left over from when blacklist and whitelist message processing was done immediately. diff --git a/lisp/mh-e/mh-junk.el b/lisp/mh-e/mh-junk.el index 61226066ed..0a50e027ce 100644 --- a/lisp/mh-e/mh-junk.el +++ b/lisp/mh-e/mh-junk.el @@ -108,8 +108,7 @@ message(s) as specified by the option `mh-junk-disposition'." (mh-iterate-on-range msg range (message "Blacklisting message %d..." msg) (funcall (symbol-function blacklist-func) msg) - (message "Blacklisting message %d...done" msg)) - (mh-next-msg))) + (message "Blacklisting message %d...done" msg)))) ;;;###mh-autoload (defun mh-junk-whitelist (range) @@ -164,8 +163,7 @@ classified as spam (see the option `mh-junk-program')." (mh-iterate-on-range msg range (message "Whitelisting message %d..." msg) (funcall (symbol-function whitelist-func) msg) - (message "Whitelisting message %d...done" msg)) - (mh-next-msg))) + (message "Whitelisting message %d...done" msg)))) commit baa6ae8724fd4cd7631164a89bf8eed4ff79cfc0 Author: Paul Eggert Date: Wed Sep 5 00:21:02 2018 -0700 Improve (round FIXNUM FIXNUM) performance * src/floatfns.c (rounding_driver): New arg fixnum_divide. All callers changed. (ceiling2, floor2, truncate2, round2): New functions. Not that new, actually; these are essentially taken from Emacs 26. (Fceiling, Ffloor, Fround, Ftruncate): Use them. diff --git a/src/floatfns.c b/src/floatfns.c index 13ab7b0359..dc7236353c 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -339,6 +339,7 @@ static Lisp_Object rounding_driver (Lisp_Object arg, Lisp_Object divisor, double (*double_round) (double), void (*int_divide) (mpz_t, mpz_t const, mpz_t const), + EMACS_INT (*fixnum_divide) (EMACS_INT, EMACS_INT), const char *name) { CHECK_NUMBER (arg); @@ -357,8 +358,14 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor, { /* Divide as integers. Converting to double might lose info, even for fixnums; also see the FIXME below. */ - if (EQ (divisor, make_fixnum (0))) - xsignal0 (Qarith_error); + if (FIXNUMP (divisor)) + { + if (XFIXNUM (divisor) == 0) + xsignal0 (Qarith_error); + if (FIXNUMP (arg)) + return make_int (fixnum_divide (XFIXNUM (arg), + XFIXNUM (divisor))); + } int_divide (mpz[0], *bignum_integer (&mpz[0], arg), *bignum_integer (&mpz[1], divisor)); @@ -387,26 +394,47 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor, return double_to_bignum (dr); } -static void -rounddiv_q (mpz_t q, mpz_t const n, mpz_t const d) +static EMACS_INT +ceiling2 (EMACS_INT n, EMACS_INT d) { - /* mpz_tdiv_qr gives us one remainder R, but we want the remainder - R1 on the other side of 0 if R1 is closer to 0 than R is; because - we want to round to even, we also want R1 if R and R1 are the - same distance from 0 and if the quotient is odd. + return n / d + ((n % d != 0) & ((n < 0) == (d < 0))); +} - If we were using EMACS_INT arithmetic instead of bignums, - the following code could look something like this: +static EMACS_INT +floor2 (EMACS_INT n, EMACS_INT d) +{ + return n / d - ((n % d != 0) & ((n < 0) != (d < 0))); +} - q = n / d; - r = n % d; - neg_d = d < 0; - neg_r = r < 0; - abs_r = eabs (r); - abs_r1 = eabs (d) - abs_r; - if (abs_r1 < abs_r + (q & 1)) - q += neg_d == neg_r ? 1 : -1; */ +static EMACS_INT +truncate2 (EMACS_INT n, EMACS_INT d) +{ + return n / d; +} +static EMACS_INT +round2 (EMACS_INT n, EMACS_INT d) +{ + /* The C language's division operator gives us the remainder R + corresponding to truncated division, but we want the remainder R1 + on the other side of 0 if R1 is closer to 0 than R is; because we + want to round to even, we also want R1 if R and R1 are the same + distance from 0 and if the truncated quotient is odd. */ + EMACS_INT q = n / d; + EMACS_INT r = n % d; + bool neg_d = d < 0; + bool neg_r = r < 0; + EMACS_INT abs_r = eabs (r); + EMACS_INT abs_r1 = eabs (d) - abs_r; + if (abs_r1 < abs_r + (q & 1)) + q += neg_d == neg_r ? 1 : -1; + return q; +} + +static void +rounddiv_q (mpz_t q, mpz_t const n, mpz_t const d) +{ + /* Mimic the source code of round2, using mpz_t instead of EMACS_INT. */ mpz_t *r = &mpz[2], *abs_r = r, *abs_r1 = &mpz[3]; mpz_tdiv_qr (q, *r, n, d); bool neg_d = mpz_sgn (d) < 0; @@ -446,7 +474,7 @@ This rounds the value towards +inf. With optional DIVISOR, return the smallest integer no less than ARG/DIVISOR. */) (Lisp_Object arg, Lisp_Object divisor) { - return rounding_driver (arg, divisor, ceil, mpz_cdiv_q, "ceiling"); + return rounding_driver (arg, divisor, ceil, mpz_cdiv_q, ceiling2, "ceiling"); } DEFUN ("floor", Ffloor, Sfloor, 1, 2, 0, @@ -455,7 +483,7 @@ This rounds the value towards -inf. With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR. */) (Lisp_Object arg, Lisp_Object divisor) { - return rounding_driver (arg, divisor, floor, mpz_fdiv_q, "floor"); + return rounding_driver (arg, divisor, floor, mpz_fdiv_q, floor2, "floor"); } DEFUN ("round", Fround, Sround, 1, 2, 0, @@ -468,7 +496,8 @@ your machine. For example, (round 2.5) can return 3 on some systems, but 2 on others. */) (Lisp_Object arg, Lisp_Object divisor) { - return rounding_driver (arg, divisor, emacs_rint, rounddiv_q, "round"); + return rounding_driver (arg, divisor, emacs_rint, rounddiv_q, round2, + "round"); } /* Since rounding_driver truncates anyway, no need to call 'trunc'. */ @@ -484,7 +513,8 @@ Rounds ARG toward zero. With optional DIVISOR, truncate ARG/DIVISOR. */) (Lisp_Object arg, Lisp_Object divisor) { - return rounding_driver (arg, divisor, identity, mpz_tdiv_q, "truncate"); + return rounding_driver (arg, divisor, identity, mpz_tdiv_q, truncate2, + "truncate"); } commit ccb3891ff5446b578b9306aec0fd9c5ec3ed8e98 Author: Paul Eggert Date: Tue Sep 4 19:14:01 2018 -0700 Fix format-time-string bignum bug The problem can occur on 32-bit platforms with current timestamps. * src/editfns.c (disassemble_lisp_time, decode_time_components): Support seconds counts that are bignums. * test/src/editfns-tests.el (editfns-tests--have-leap-seconds): New function. (format-time-string-with-bignum-on-32-bit): New test. diff --git a/src/editfns.c b/src/editfns.c index 4ea7025379..191a9ab8f8 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -1743,10 +1743,10 @@ disassemble_lisp_time (Lisp_Object specified_time, Lisp_Object *phigh, /* When combining components, require LOW to be an integer, as otherwise it would be a pain to add up times. */ - if (! FIXNUMP (low)) + if (! INTEGERP (low)) return 0; } - else if (FIXNUMP (specified_time)) + else if (INTEGERP (specified_time)) len = 2; *phigh = high; @@ -1807,11 +1807,12 @@ decode_time_components (Lisp_Object high, Lisp_Object low, Lisp_Object usec, Lisp_Object psec, struct lisp_time *result, double *dresult) { - EMACS_INT hi, lo, us, ps; + EMACS_INT hi, us, ps; + intmax_t lo; if (! (FIXNUMP (high) && FIXNUMP (usec) && FIXNUMP (psec))) return 0; - if (! FIXNUMP (low)) + if (! INTEGERP (low)) { if (FLOATP (low)) { @@ -1841,7 +1842,8 @@ decode_time_components (Lisp_Object high, Lisp_Object low, Lisp_Object usec, } hi = XFIXNUM (high); - lo = XFIXNUM (low); + if (! integer_to_intmax (low, &lo)) + return -1; us = XFIXNUM (usec); ps = XFIXNUM (psec); @@ -1849,7 +1851,8 @@ decode_time_components (Lisp_Object high, Lisp_Object low, Lisp_Object usec, each overflow into the next higher-order component. */ us += ps / 1000000 - (ps % 1000000 < 0); lo += us / 1000000 - (us % 1000000 < 0); - hi += lo >> LO_TIME_BITS; + if (INT_ADD_WRAPV (lo >> LO_TIME_BITS, hi, &hi)) + return -1; ps = ps % 1000000 + 1000000 * (ps % 1000000 < 0); us = us % 1000000 + 1000000 * (us % 1000000 < 0); lo &= (1 << LO_TIME_BITS) - 1; diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index 487f3aaa66..4a840c8d7d 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -253,6 +253,16 @@ (format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" nil (concat (make-string 2048 ?X) "0"))))) +(defun editfns-tests--have-leap-seconds () + (string-equal (format-time-string "%Y-%m-%d %H:%M:%S" 78796800 t) + "1972-06-30 23:59:60")) + +(ert-deftest format-time-string-with-bignum-on-32-bit () + (should (or (string-equal + (format-time-string "%Y-%m-%d %H:%M:%S" (- (ash 1 31) 3600) t) + "2038-01-19 02:14:08") + (editfns-tests--have-leap-seconds)))) + (ert-deftest format-with-field () (should (equal (format "First argument %2$s, then %3$s, then %1$s" 1 2 3) "First argument 2, then 3, then 1")) commit ecb985c10d5241a65ab9552ebfcecaa150b35427 Author: Paul Eggert Date: Tue Sep 4 19:14:01 2018 -0700 Simplify bignum->intmax conversion * src/lisp.h (integer_to_intmax, integer_to_uintmax): New functions. * src/data.c (cons_to_unsigned, cons_to_signed) (arith_driver): * src/dbusbind.c (xd_extract_signed, xd_extract_unsigned): * src/dispnew.c (sit_for): * src/editfns.c (styled_format): * src/emacs-module.c (module_extract_integer): * src/fileio.c (file_offset): * src/font.c (font_unparse_xlfd, Fopen_font): * src/xdisp.c (calc_line_height_property): * src/process.c (handle_child_signal): diff --git a/src/data.c b/src/data.c index 7be2052362..66f69e7e83 100644 --- a/src/data.c +++ b/src/data.c @@ -2653,17 +2653,7 @@ cons_to_unsigned (Lisp_Object c, uintmax_t max) else { Lisp_Object hi = CONSP (c) ? XCAR (c) : c; - - if (FIXNUMP (hi)) - { - val = XFIXNUM (hi); - valid = 0 <= val; - } - else - { - val = bignum_to_uintmax (hi); - valid = val != 0; - } + valid = integer_to_uintmax (hi, &val); if (valid && CONSP (c)) { @@ -2724,17 +2714,7 @@ cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max) else { Lisp_Object hi = CONSP (c) ? XCAR (c) : c; - - if (FIXNUMP (hi)) - { - val = XFIXNUM (hi); - valid = true; - } - else if (BIGNUMP (hi)) - { - val = bignum_to_intmax (hi); - valid = val != 0; - } + valid = integer_to_intmax (hi, &val); if (valid && CONSP (c)) { @@ -2972,16 +2952,8 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args, /* Set NEXT to the next value if it fits, else exit the loop. */ intmax_t next; - if (FIXNUMP (val)) - next = XFIXNUM (val); - else if (FLOATP (val)) + if (! (INTEGERP (val) && integer_to_intmax (val, &next))) break; - else - { - next = bignum_to_intmax (val); - if (next == 0) - break; - } /* Set ACCUM to the next operation's result if it fits, else exit the loop. */ diff --git a/src/dbusbind.c b/src/dbusbind.c index 47346a7d4d..9bc344e961 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -520,12 +520,13 @@ static intmax_t xd_extract_signed (Lisp_Object x, intmax_t lo, intmax_t hi) { CHECK_NUMBER (x); - if (FIXNUMP (x)) + if (INTEGERP (x)) { - if (lo <= XFIXNUM (x) && XFIXNUM (x) <= hi) - return XFIXNUM (x); + intmax_t i; + if (integer_to_intmax (x, &i) && lo <= i && i <= hi) + return i; } - else if (FLOATP (x)) + else { double d = XFLOAT_DATA (x); if (lo <= d && d < 1.0 + hi) @@ -535,12 +536,6 @@ xd_extract_signed (Lisp_Object x, intmax_t lo, intmax_t hi) return n; } } - else if (! (MOST_NEGATIVE_FIXNUM <= lo && hi <= MOST_POSITIVE_FIXNUM)) - { - intmax_t i = bignum_to_intmax (x); - if (i != 0 && lo <= i && i <= hi) - return i; - } if (xd_in_read_queued_messages) Fthrow (Qdbus_error, Qnil); @@ -553,12 +548,13 @@ static uintmax_t xd_extract_unsigned (Lisp_Object x, uintmax_t hi) { CHECK_NUMBER (x); - if (FIXNUMP (x)) + if (INTEGERP (x)) { - if (0 <= XFIXNUM (x) && XFIXNUM (x) <= hi) - return XFIXNUM (x); + uintmax_t i; + if (integer_to_uintmax (x, &i) && i <= hi) + return i; } - else if (FLOATP (x)) + else { double d = XFLOAT_DATA (x); if (0 <= d && d < 1.0 + hi) @@ -568,12 +564,6 @@ xd_extract_unsigned (Lisp_Object x, uintmax_t hi) return n; } } - else if (! (hi <= MOST_POSITIVE_FIXNUM)) - { - uintmax_t i = bignum_to_uintmax (x); - if (i != 0 && i <= hi) - return i; - } if (xd_in_read_queued_messages) Fthrow (Qdbus_error, Qnil); diff --git a/src/dispnew.c b/src/dispnew.c index bd246799b2..798413d091 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -5765,20 +5765,20 @@ sit_for (Lisp_Object timeout, bool reading, int display_option) if (display_option > 1) redisplay_preserve_echo_area (2); - if (FIXNUMP (timeout)) + if (INTEGERP (timeout)) { - sec = XFIXNUM (timeout); - if (sec <= 0) - return Qt; - nsec = 0; - } - else if (BIGNUMP (timeout)) - { - if (NILP (Fnatnump (timeout))) - return Qt; - sec = bignum_to_intmax (timeout); - if (sec == 0) - sec = WAIT_READING_MAX; + if (integer_to_intmax (timeout, &sec)) + { + if (sec <= 0) + return Qt; + sec = min (sec, WAIT_READING_MAX); + } + else + { + if (NILP (Fnatnump (timeout))) + return Qt; + sec = WAIT_READING_MAX; + } nsec = 0; } else if (FLOATP (timeout)) diff --git a/src/editfns.c b/src/editfns.c index 3b1c21a178..4ea7025379 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -4691,21 +4691,16 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) } else { - if (FIXNUMP (arg)) - ldarg = XFIXNUM (arg); - else + if (INTEGERP (arg)) { - intmax_t iarg = bignum_to_intmax (arg); - if (iarg != 0) + intmax_t iarg; + uintmax_t uarg; + if (integer_to_intmax (arg, &iarg)) ldarg = iarg; + else if (integer_to_uintmax (arg, &uarg)) + ldarg = uarg; else - { - uintmax_t uarg = bignum_to_uintmax (arg); - if (uarg != 0) - ldarg = uarg; - else - format_bignum_as_double = true; - } + format_bignum_as_double = true; } if (!format_bignum_as_double) { diff --git a/src/emacs-module.c b/src/emacs-module.c index 2ba5540d9a..6155535f86 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -519,14 +519,10 @@ module_extract_integer (emacs_env *env, emacs_value n) MODULE_FUNCTION_BEGIN (0); Lisp_Object l = value_to_lisp (n); CHECK_INTEGER (l); - if (BIGNUMP (l)) - { - intmax_t i = bignum_to_intmax (l); - if (i == 0) - xsignal1 (Qoverflow_error, l); - return i; - } - return XFIXNUM (l); + intmax_t i; + if (! integer_to_intmax (l, &i)) + xsignal1 (Qoverflow_error, l); + return i; } static emacs_value diff --git a/src/fileio.c b/src/fileio.c index a91bdaa53d..66b2333317 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -3424,17 +3424,13 @@ read_non_regular_quit (Lisp_Object ignore) static off_t file_offset (Lisp_Object val) { - if (RANGED_FIXNUMP (0, val, TYPE_MAXIMUM (off_t))) - return XFIXNUM (val); - - if (BIGNUMP (val)) + if (INTEGERP (val)) { - intmax_t v = bignum_to_intmax (val); - if (0 < v && v <= TYPE_MAXIMUM (off_t)) + intmax_t v; + if (integer_to_intmax (val, &v) && 0 <= v && v <= TYPE_MAXIMUM (off_t)) return v; } - - if (FLOATP (val)) + else if (FLOATP (val)) { double v = XFLOAT_DATA (val); if (0 <= v && v < 1.0 + TYPE_MAXIMUM (off_t)) diff --git a/src/font.c b/src/font.c index e2414582f6..50ec39a9a4 100644 --- a/src/font.c +++ b/src/font.c @@ -1289,8 +1289,9 @@ font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes) 1 + DBL_MAX_10_EXP + 1)]; if (INTEGERP (val)) { - intmax_t v = FIXNUMP (val) ? XFIXNUM (val) : bignum_to_intmax (val); - if (! (0 < v && v <= TYPE_MAXIMUM (uprintmax_t))) + intmax_t v; + if (! (integer_to_intmax (val, &v) + && 0 < v && v <= TYPE_MAXIMUM (uprintmax_t))) v = pixel_size; if (v > 0) { @@ -4747,16 +4748,10 @@ DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0, else { CHECK_NUMBER (size); - if (BIGNUMP (size)) - { - isize = bignum_to_intmax (size); - if (isize == 0) - args_out_of_range (font_entity, size); - } - else - isize = (FLOATP (size) - ? POINT_TO_PIXEL (XFLOAT_DATA (size), FRAME_RES_Y (f)) - : XFIXNUM (size)); + if (FLOATP (size)) + isize = POINT_TO_PIXEL (XFLOAT_DATA (size), FRAME_RES_Y (f)); + else if (! integer_to_intmax (size, &isize)) + args_out_of_range (font_entity, size); if (! (INT_MIN <= isize && isize <= INT_MAX)) args_out_of_range (font_entity, size); if (isize == 0) diff --git a/src/lisp.h b/src/lisp.h index d244bc02d4..78c25f97dc 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3297,6 +3297,39 @@ extern Lisp_Object bignum_to_string (Lisp_Object, int); extern Lisp_Object make_bignum_str (char const *, int); extern Lisp_Object double_to_bignum (double); +/* Converthe integer NUM to *N. Return true if successful, false + (possibly setting *N) otherwise. */ +INLINE bool +integer_to_intmax (Lisp_Object num, intmax_t *n) +{ + if (FIXNUMP (num)) + { + *n = XFIXNUM (num); + return true; + } + else + { + intmax_t i = bignum_to_intmax (num); + *n = i; + return i != 0; + } +} +INLINE bool +integer_to_uintmax (Lisp_Object num, uintmax_t *n) +{ + if (FIXNUMP (num)) + { + *n = XFIXNUM (num); + return 0 <= XFIXNUM (num); + } + else + { + uintmax_t i = bignum_to_uintmax (num); + *n = i; + return i != 0; + } +} + /* Defined in data.c. */ extern _Noreturn void wrong_choice (Lisp_Object, Lisp_Object); extern void notify_variable_watchers (Lisp_Object, Lisp_Object, diff --git a/src/process.c b/src/process.c index 9d03eb9774..454278a5a2 100644 --- a/src/process.c +++ b/src/process.c @@ -7055,8 +7055,9 @@ handle_child_signal (int sig) xpid = XCAR (head); if (all_pids_are_fixnums ? FIXNUMP (xpid) : INTEGERP (xpid)) { - pid_t deleted_pid = (FIXNUMP (xpid) ? XFIXNUM (xpid) - : bignum_to_intmax (xpid)); + intmax_t deleted_pid; + bool ok = integer_to_intmax (xpid, &deleted_pid); + eassert (ok); if (child_status_changed (deleted_pid, 0, 0)) { if (STRINGP (XCDR (head))) diff --git a/src/xdisp.c b/src/xdisp.c index 04033665d7..47286e25c8 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -27910,10 +27910,12 @@ calc_line_height_property (struct it *it, Lisp_Object val, struct font *font, /* FIXME: Check for overflow in multiplication or conversion. */ if (FLOATP (val)) height = (int)(XFLOAT_DATA (val) * height); - else if (FIXNUMP (val)) - height *= XFIXNUM (val); else - height *= bignum_to_intmax (val); + { + intmax_t v; + if (integer_to_intmax (val, &v)) + height *= v; + } return make_fixnum (height); } commit e3661f8c35b3057c58e8c0b474f597697ce413ba Author: Federico Tedin Date: Sat Sep 1 18:46:16 2018 -0300 Add variable vc-git-grep-template * lisp/vc/vc-git.el (vc-git-grep-template): New variable, allows changing the default arguments passed to git-grep when using 'vc-git-grep'. * etc/NEWS: Mention 'vc-git-grep-template'. (Bug#32549) diff --git a/etc/NEWS b/etc/NEWS index f66bcb1138..61b6d4e0e2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -277,6 +277,10 @@ still be used if it exists.) Set the variable to nil to get the previous behavior of always creating a buffer that visits a ChangeLog file. +*** New customizable variable 'vc-git-grep-template'. +This new variable allows customizing the default arguments passed to +git-grep when 'vc-git-grep' is used. + ** diff-mode *** Hunks are now automatically refined by default. To disable it, set the new defcustom 'diff-font-lock-refine' to nil. diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 96c2f38af4..69d6295702 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -179,6 +179,14 @@ Should be consistent with the Git config value i18n.logOutputEncoding." :type '(coding-system :tag "Coding system to decode Git log output") :version "25.1") +(defcustom vc-git-grep-template "git --no-pager grep -n -e -- " + "The default command to run for \\[vc-git-grep]. +The following place holders should be present in the string: + - file names and wildcards to search. + - the regular expression searched for." + :type 'string + :version "27.1") + ;; History of Git commands. (defvar vc-git-history nil) @@ -1449,7 +1457,7 @@ This command shares argument histories with \\[rgrep] and \\[grep]." (setq command nil)) (setq dir (file-name-as-directory (expand-file-name dir))) (setq command - (grep-expand-template "git --no-pager grep -n -e -- " + (grep-expand-template vc-git-grep-template regexp files)) (when command (if (equal current-prefix-arg '(4)) commit c0f688808eadb670ffa9d442891adb7bb70c4ade Author: Noam Postavsky Date: Sun Sep 2 18:56:38 2018 -0400 Handle non-error signals in emacsclient --eval (Bug#10989) * lisp/server.el (server-process-filter): Handle any signal, not just errors. diff --git a/lisp/server.el b/lisp/server.el index 77850e49da..fd024480bd 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -1297,7 +1297,7 @@ The following commands are accepted by the client: (server-execute-continuation proc)))) ;; condition-case - (error (server-return-error proc err)))) + (t (server-return-error proc err)))) (defun server-execute (proc files nowait commands dontkill create-frame-func tty-name) ;; This is run from timers and process-filters, i.e. "asynchronously". commit 425c2811641a6b8ec4549cad5f6bd15a46bc95d5 Author: Noam Postavsky Date: Thu Aug 9 21:26:30 2018 -0400 Allow t as a catch-all condition-case handler (Bug#24618) * src/eval.c (find_handler_clause): Accept a handler of t as always matching. (Fcondition_case): * doc/lispref/control.texi (Handling Errors): Document this. * etc/NEWS: Announce it. diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index 975ab3d075..8a6cf73af5 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -1878,9 +1878,10 @@ error occurs during @var{protected-form}. Each of the @var{handlers} is a list of the form @code{(@var{conditions} @var{body}@dots{})}. Here @var{conditions} is an error condition name to be handled, or a list of condition names (which can include @code{debug} -to allow the debugger to run before the handler); @var{body} is one or more -Lisp expressions to be executed when this handler handles an error. -Here are examples of handlers: +to allow the debugger to run before the handler). A condition name of +@code{t} matches any condition. @var{body} is one or more Lisp +expressions to be executed when this handler handles an error. Here +are examples of handlers: @example @group diff --git a/etc/NEWS b/etc/NEWS index 1fe662ffff..f66bcb1138 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -874,6 +874,9 @@ removed. ** lookup-key can take a list of keymaps as argument. ++++ +** 'condition-case' now accepts 't' to match any error symbol. + +++ ** New function 'proper-list-p'. Given a proper list as argument, this predicate returns its length; diff --git a/src/eval.c b/src/eval.c index 50de60c936..1011fc888b 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1215,9 +1215,9 @@ Executes BODYFORM and returns its value if no error happens. Each element of HANDLERS looks like (CONDITION-NAME BODY...) where the BODY is made of Lisp expressions. -A handler is applicable to an error -if CONDITION-NAME is one of the error's condition names. -If an error happens, the first applicable handler is run. +A handler is applicable to an error if CONDITION-NAME is one of the +error's condition names. A CONDITION-NAME of t applies to any error +symbol. If an error happens, the first applicable handler is run. The car of a handler may be a list of condition names instead of a single condition name; then it handles all of them. If the special @@ -1854,7 +1854,9 @@ find_handler_clause (Lisp_Object handlers, Lisp_Object conditions) for (h = handlers; CONSP (h); h = XCDR (h)) { Lisp_Object handler = XCAR (h); - if (!NILP (Fmemq (handler, conditions))) + if (!NILP (Fmemq (handler, conditions)) + /* t is also used as a catch-all by Lisp code. */ + || EQ (handler, Qt)) return handlers; } commit 21637d5e5b29d5ec8fb966c0ddfbfba3eb33da38 Author: Paul Eggert Date: Tue Sep 4 11:49:41 2018 -0700 Fix (round FLOAT BIGNUM) bug * src/floatfns.c (rounding_driver): Fix bug when one argument is a float and the other is a bignum. * test/src/floatfns-tests.el (bignum-round): Test for the bug. diff --git a/src/floatfns.c b/src/floatfns.c index 2f33b8652b..13ab7b0359 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -355,6 +355,8 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor, CHECK_NUMBER (divisor); if (!FLOATP (arg) && !FLOATP (divisor)) { + /* Divide as integers. Converting to double might lose + info, even for fixnums; also see the FIXME below. */ if (EQ (divisor, make_fixnum (0))) xsignal0 (Qarith_error); int_divide (mpz[0], @@ -363,10 +365,11 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor, return make_integer_mpz (); } - double f1 = FLOATP (arg) ? XFLOAT_DATA (arg) : XFIXNUM (arg); - double f2 = FLOATP (divisor) ? XFLOAT_DATA (divisor) : XFIXNUM (divisor); + double f1 = XFLOATINT (arg); + double f2 = XFLOATINT (divisor); if (! IEEE_FLOATING_POINT && f2 == 0) xsignal0 (Qarith_error); + /* FIXME: This division rounds, so the result is double-rounded. */ d = f1 / f2; } diff --git a/test/src/floatfns-tests.el b/test/src/floatfns-tests.el index d41b08f796..9a382058b4 100644 --- a/test/src/floatfns-tests.el +++ b/test/src/floatfns-tests.el @@ -70,6 +70,11 @@ (should (= n (floor n))) (should (= n (round n))) (should (= n (truncate n))) + (let ((-n (- n)) + (f (float n)) + (-f (- (float n)))) + (should (= 1 (round n f) (round -n -f) (round f n) (round -f -n))) + (should (= -1 (round -n f) (round n -f) (round f -n) (round -f n)))) (dolist (d ns) (let ((q (/ n d)) (r (% n d)) commit 628f6a2c7a9fe476b7e71efed3a8f8784a00cc54 Author: Paul Eggert Date: Tue Sep 4 10:24:51 2018 -0700 Tweak nthcdr for bignum efficiency * src/fns.c (Fnthcdr): Use mpz_tdiv_ui and mpz_tdiv_r instead of mpz_mod_ui and mpz_mod, as they are more efficient. Suggested by Pip Cet in: https://lists.gnu.org/r/emacs-devel/2018-09/msg00073.html diff --git a/src/fns.c b/src/fns.c index 8b25492eae..5a98f14881 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1470,11 +1470,11 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0, CYCLE_LENGTH. */ /* Add N mod CYCLE_LENGTH to NUM. */ if (cycle_length <= ULONG_MAX) - num += mpz_mod_ui (mpz[0], XBIGNUM (n)->value, cycle_length); + num += mpz_tdiv_ui (XBIGNUM (n)->value, cycle_length); else { mpz_set_intmax (mpz[0], cycle_length); - mpz_mod (mpz[0], XBIGNUM (n)->value, mpz[0]); + mpz_tdiv_r (mpz[0], XBIGNUM (n)->value, mpz[0]); intptr_t iz; mpz_export (&iz, NULL, -1, sizeof iz, 0, 0, mpz[0]); num += iz; commit 1d84e6523250ab6d14f40fba3922c56d7a40416f Author: Paul Eggert Date: Tue Sep 4 09:30:57 2018 -0700 Fix bignum initialization Problem reported by Andy Moreton in: https://lists.gnu.org/r/emacs-devel/2018-09/msg00072.html and crystal-ball diagnosis by Eli Zaretskii in: https://lists.gnu.org/r/emacs-devel/2018-09/msg00075.html * src/alloc.c (xrealloc_for_gmp, xfree_for_gmp): Move to bignum.c. (init_alloc): Move bignum initialization to init_bignum. * src/bignum.c (init_bignum): Rename from init_bignum_once. All users changed. * src/emacs.c (main): Call init_bignum after init_alloc, instead of calling init_bignum_once after init_bignum. diff --git a/src/alloc.c b/src/alloc.c index 1eab82d1c2..28ca7804ee 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -7126,18 +7126,6 @@ range_error (void) xsignal0 (Qrange_error); } -static void * -xrealloc_for_gmp (void *ptr, size_t ignore, size_t size) -{ - return xrealloc (ptr, size); -} - -static void -xfree_for_gmp (void *ptr, size_t ignore) -{ - xfree (ptr); -} - /* Initialization. */ void @@ -7171,10 +7159,6 @@ init_alloc_once (void) void init_alloc (void) { - eassert (mp_bits_per_limb == GMP_NUMB_BITS); - integer_width = 1 << 16; - mp_set_memory_functions (xmalloc, xrealloc_for_gmp, xfree_for_gmp); - Vgc_elapsed = make_float (0.0); gcs_done = 0; diff --git a/src/bignum.c b/src/bignum.c index 2ce7412d06..35894f5647 100644 --- a/src/bignum.c +++ b/src/bignum.c @@ -34,9 +34,25 @@ along with GNU Emacs. If not, see . */ mpz_t mpz[4]; +static void * +xrealloc_for_gmp (void *ptr, size_t ignore, size_t size) +{ + return xrealloc (ptr, size); +} + +static void +xfree_for_gmp (void *ptr, size_t ignore) +{ + xfree (ptr); +} + void -init_bignum_once (void) +init_bignum (void) { + eassert (mp_bits_per_limb == GMP_NUMB_BITS); + integer_width = 1 << 16; + mp_set_memory_functions (xmalloc, xrealloc_for_gmp, xfree_for_gmp); + for (int i = 0; i < ARRAYELTS (mpz); i++) mpz_init (mpz[i]); } diff --git a/src/bignum.h b/src/bignum.h index 07622a37af..0e38c615ee 100644 --- a/src/bignum.h +++ b/src/bignum.h @@ -43,7 +43,7 @@ struct Lisp_Bignum extern mpz_t mpz[4]; -extern void init_bignum_once (void); +extern void init_bignum (void); extern Lisp_Object make_integer_mpz (void); extern void mpz_set_intmax_slow (mpz_t, intmax_t) ARG_NONNULL ((1)); diff --git a/src/emacs.c b/src/emacs.c index 5b399eca64..b1c96d1828 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1209,7 +1209,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem if (!initialized) { init_alloc_once (); - init_bignum_once (); init_threads_once (); init_obarray (); init_eval_once (); @@ -1257,6 +1256,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem } init_alloc (); + init_bignum (); init_threads (); if (do_initial_setlocale) commit 9618e16efa5607664b794795fb80bdf5862fbe4b Author: Stefan Monnier Date: Tue Sep 4 12:03:52 2018 -0400 Better fix for bug#32550 * lisp/rfn-eshadow.el (rfn-eshadow-overlay): Give it a global default. * lisp/net/tramp.el (rfn-eshadow-overlay): Declare it as dynamically scoped. (tramp-rfn-eshadow-update-overlay): Revert the corresponding part of last change. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 22fcccb8b6..452e70ec35 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1923,6 +1923,13 @@ special handling of `substitute-in-file-name'." (defun tramp-rfn-eshadow-update-overlay-regexp () (format "[^%s/~]*\\(/\\|~\\)" tramp-postfix-host-format)) +;; Package rfn-eshadow is preloaded in Emacs, but for some reason, +;; it only did (defvar rfn-eshadow-overlay) without giving it a global +;; value, so it was only declared as dynamically-scoped within the +;; rfn-eshadow.el file. This is now fixed in Emacs>26.1 but we still need +;; this defvar here for older releases. +(defvar rfn-eshadow-overlay) + (defun tramp-rfn-eshadow-update-overlay () "Update `rfn-eshadow-overlay' to cover shadowed part of minibuffer input. This is intended to be used as a minibuffer `post-command-hook' for @@ -1944,8 +1951,9 @@ been set up by `rfn-eshadow-setup-minibuffer'." (buffer-string) end) end)) (point-max)) - (setq rfn-eshadow-overlay tramp-rfn-eshadow-overlay) - (let (rfn-eshadow-update-overlay-hook file-name-handler-alist) + (let ((rfn-eshadow-overlay tramp-rfn-eshadow-overlay) + (rfn-eshadow-update-overlay-hook nil) + file-name-handler-alist) (move-overlay rfn-eshadow-overlay (point-max) (point-max)) (rfn-eshadow-update-overlay))))))) diff --git a/lisp/rfn-eshadow.el b/lisp/rfn-eshadow.el index 847db68a77..cf71996660 100644 --- a/lisp/rfn-eshadow.el +++ b/lisp/rfn-eshadow.el @@ -132,9 +132,7 @@ system, `file-name-shadow-properties' is used instead." ;; An overlay covering the shadowed part of the filename (local to the ;; minibuffer). -(defvar rfn-eshadow-overlay) -(make-variable-buffer-local 'rfn-eshadow-overlay) - +(defvar-local rfn-eshadow-overlay nil) ;;; Hook functions commit 30d94e4b926fb62c4cb0d2635c7bb6b580c68c4a Author: Michael Albinus Date: Tue Sep 4 11:59:39 2018 +0200 Fix Bug#32550 * lisp/net/tramp.el (tramp-rfn-eshadow-setup-minibuffer): Do not use `symbol-value'. (tramp-rfn-eshadow-update-overlay): Do not use `symbol-value'. Do not let-bind `rfn-eshadow-overlay', assign it directly (due to lexical binding). (Bug#32550) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 1344757559..22fcccb8b6 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1892,7 +1892,6 @@ For definition of that list see `tramp-set-completion-function'." ;; The method related defaults. (cdr (assoc method tramp-completion-function-alist)))) - ;;; Fontification of `read-file-name': (defvar tramp-rfn-eshadow-overlay) @@ -1902,11 +1901,11 @@ For definition of that list see `tramp-set-completion-function'." "Set up a minibuffer for `file-name-shadow-mode'. Adds another overlay hiding filename parts according to Tramp's special handling of `substitute-in-file-name'." - (when (symbol-value 'minibuffer-completing-file-name) + (when minibuffer-completing-file-name (setq tramp-rfn-eshadow-overlay (make-overlay (minibuffer-prompt-end) (minibuffer-prompt-end))) ;; Copy rfn-eshadow-overlay properties. - (let ((props (overlay-properties (symbol-value 'rfn-eshadow-overlay)))) + (let ((props (overlay-properties rfn-eshadow-overlay))) (while props ;; The `field' property prevents correct minibuffer ;; completion; we exclude it. @@ -1931,26 +1930,24 @@ This is intended to be used as a minibuffer `post-command-hook' for been set up by `rfn-eshadow-setup-minibuffer'." ;; In remote files name, there is a shadowing just for the local part. (ignore-errors - (let ((end (or (overlay-end (symbol-value 'rfn-eshadow-overlay)) + (let ((end (or (overlay-end rfn-eshadow-overlay) (minibuffer-prompt-end))) ;; We do not want to send any remote command. (non-essential t)) (when (tramp-tramp-file-p (buffer-substring-no-properties end (point-max))) - (save-excursion - (save-restriction - (narrow-to-region - (1+ (or (string-match - (tramp-rfn-eshadow-update-overlay-regexp) - (buffer-string) end) - end)) - (point-max)) - (let ((rfn-eshadow-overlay tramp-rfn-eshadow-overlay) - (rfn-eshadow-update-overlay-hook nil) - file-name-handler-alist) - (move-overlay rfn-eshadow-overlay (point-max) (point-max)) - (rfn-eshadow-update-overlay)))))))) + (save-restriction + (narrow-to-region + (1+ (or (string-match + (tramp-rfn-eshadow-update-overlay-regexp) + (buffer-string) end) + end)) + (point-max)) + (setq rfn-eshadow-overlay tramp-rfn-eshadow-overlay) + (let (rfn-eshadow-update-overlay-hook file-name-handler-alist) + (move-overlay rfn-eshadow-overlay (point-max) (point-max)) + (rfn-eshadow-update-overlay))))))) (add-hook 'rfn-eshadow-update-overlay-hook 'tramp-rfn-eshadow-update-overlay) @@ -4616,8 +4613,6 @@ Only works for Bourne-like shells." ;; strange when doing zerop, we should kill the process and start ;; again. (Greg Stark) ;; -;; * Make shadowfile.el grok Tramp filenames. (Bug#4526, Bug#4846) -;; ;; * I was wondering if it would be possible to use tramp even if I'm ;; actually using sshfs. But when I launch a command I would like ;; to get it executed on the remote machine where the files really commit 57bcdc76e0518f53cd171c76e726e6bdf646bf9a Author: Martin Rudalics Date: Tue Sep 4 08:53:49 2018 +0200 Don't call XGetGeometry for frames without outer X window (Bug#32615) * src/xfns.c (frame_geometry): Don't call XGetGeometry when FRAME has no outer X window; return nil instead. (Bug#32615) diff --git a/src/xfns.c b/src/xfns.c index 3da853ede8..1381fee57e 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -5054,7 +5054,7 @@ frame_geometry (Lisp_Object frame, Lisp_Object attribute) int menu_bar_height = 0, menu_bar_width = 0; int tool_bar_height = 0, tool_bar_width = 0; - if (FRAME_INITIAL_P (f) || !FRAME_X_P (f)) + if (FRAME_INITIAL_P (f) || !FRAME_X_P (f) || !FRAME_OUTER_WINDOW (f)) return Qnil; block_input (); commit fe042e9d15da7863b5beb4c2cc326a62d2c7fccb Author: Paul Eggert Date: Mon Sep 3 18:37:40 2018 -0700 Speed up (+ 2 2) by a factor of 10 Improve arithmetic performance by avoiding bignums until needed. Also, simplify bignum memory management, fixing some unlikely leaks. This patch improved the performance of (+ 2 2) by a factor of ten on a simple microbenchmark computing (+ x 2), byte-compiled, with x a local variable initialized to 2 via means the byte compiler could not predict: performance improved from 135 to 13 ns. The platform was Fedora 28 x86-64, AMD Phenom II X4 910e. Performance also improved 0.6% on â€make compile-always’. * src/bignum.c (init_bignum_once): New function. * src/emacs.c (main): Use it. * src/bignum.c (mpz): New global var. (make_integer_mpz): Rename from make_integer. All uses changed. * src/bignum.c (double_to_bignum, make_bignum_bits) (make_bignum, make_bigint, make_biguint, make_integer_mpz): * src/data.c (bignum_arith_driver, Frem, Flogcount, Fash) (expt_integer, Fadd1, Fsub1, Flognot): * src/floatfns.c (Fabs, rounding_driver, rounddiv_q): * src/fns.c (Fnthcdr): Use mpz rather than mpz_initting and mpz_clearing private temporaries. * src/bignum.h (bignum_integer): New function. * src/data.c (Frem, Fmod, Fash, expt_integer): * src/floatfns.c (rounding_driver): Use it to simplify code. * src/data.c (FIXNUMS_FIT_IN_LONG, free_mpz_value): Remove. All uses removed. (floating_point_op): New function. (floatop_arith_driver): New function, with much of the guts of the old float_arith_driver. (float_arith_driver): Use it. (floatop_arith_driver, arith_driver): Simplify by assuming NARGS is at least 2. All callers changed. (float_arith_driver): New arg, containing the partly converted value of the next arg. Reorder args for consistency. All uses changed. (bignum_arith_driver): New function. (arith_driver): Use it. Do fixnum-only integer calculations in intmax_t instead of mpz_t, when they fit. Break out mpz_t calculations into bignum_arith_driver. (Fquo): Use floatop_arith_driver instead of float_arith_driver, since the op is known to be valid. (Flogcount, Fash): Simplify by coalescing bignum and fixnum code. (Fadd1, Fsub1): Simplify by using make_int. diff --git a/src/bignum.c b/src/bignum.c index b18ceccb59..2ce7412d06 100644 --- a/src/bignum.c +++ b/src/bignum.c @@ -25,6 +25,22 @@ along with GNU Emacs. If not, see . */ #include +/* mpz global temporaries. Making them global saves the trouble of + properly using mpz_init and mpz_clear on temporaries even when + storage is exhausted. Admittedly this is not ideal. An mpz value + in a temporary is made permanent by mpz_swapping it with a bignum's + value. Although typically at most two temporaries are needed, + rounding_driver and rounddiv_q need four altogther. */ + +mpz_t mpz[4]; + +void +init_bignum_once (void) +{ + for (int i = 0; i < ARRAYELTS (mpz); i++) + mpz_init (mpz[i]); +} + /* Return the value of the Lisp bignum N, as a double. */ double bignum_to_double (Lisp_Object n) @@ -36,17 +52,14 @@ bignum_to_double (Lisp_Object n) Lisp_Object double_to_bignum (double d) { - mpz_t z; - mpz_init_set_d (z, d); - Lisp_Object result = make_integer (z); - mpz_clear (z); - return result; + mpz_set_d (mpz[0], d); + return make_integer_mpz (); } -/* Return a Lisp integer equal to OP, which has BITS bits and which - must not be in fixnum range. */ +/* Return a Lisp integer equal to mpz[0], which has BITS bits and which + must not be in fixnum range. Set mpz[0] to a junk value. */ static Lisp_Object -make_bignum_bits (mpz_t const op, size_t bits) +make_bignum_bits (size_t bits) { /* The documentation says integer-width should be nonnegative, so a single comparison suffices even though 'bits' is unsigned. */ @@ -55,18 +68,17 @@ make_bignum_bits (mpz_t const op, size_t bits) struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value, PVEC_BIGNUM); - /* We could mpz_init + mpz_swap here, to avoid a copy, but the - resulting API seemed possibly confusing. */ - mpz_init_set (b->value, op); - + mpz_init (b->value); + mpz_swap (b->value, mpz[0]); return make_lisp_ptr (b, Lisp_Vectorlike); } -/* Return a Lisp integer equal to OP, which must not be in fixnum range. */ +/* Return a Lisp integer equal to mpz[0], which must not be in fixnum range. + Set mpz[0] to a junk value. */ static Lisp_Object -make_bignum (mpz_t const op) +make_bignum (void) { - return make_bignum_bits (op, mpz_sizeinbase (op, 2)); + return make_bignum_bits (mpz_sizeinbase (mpz[0], 2)); } static void mpz_set_uintmax_slow (mpz_t, uintmax_t); @@ -86,30 +98,23 @@ Lisp_Object make_bigint (intmax_t n) { eassert (FIXNUM_OVERFLOW_P (n)); - mpz_t z; - mpz_init (z); - mpz_set_intmax (z, n); - Lisp_Object result = make_bignum (z); - mpz_clear (z); - return result; + mpz_set_intmax (mpz[0], n); + return make_bignum (); } Lisp_Object make_biguint (uintmax_t n) { eassert (FIXNUM_OVERFLOW_P (n)); - mpz_t z; - mpz_init (z); - mpz_set_uintmax (z, n); - Lisp_Object result = make_bignum (z); - mpz_clear (z); - return result; + mpz_set_uintmax (mpz[0], n); + return make_bignum (); } -/* Return a Lisp integer with value taken from OP. */ +/* Return a Lisp integer with value taken from mpz[0]. + Set mpz[0] to a junk value. */ Lisp_Object -make_integer (mpz_t const op) +make_integer_mpz (void) { - size_t bits = mpz_sizeinbase (op, 2); + size_t bits = mpz_sizeinbase (mpz[0], 2); if (bits <= FIXNUM_BITS) { @@ -118,20 +123,20 @@ make_integer (mpz_t const op) do { - EMACS_INT limb = mpz_getlimbn (op, i++); + EMACS_INT limb = mpz_getlimbn (mpz[0], i++); v += limb << shift; shift += GMP_NUMB_BITS; } while (shift < bits); - if (mpz_sgn (op) < 0) + if (mpz_sgn (mpz[0]) < 0) v = -v; if (!FIXNUM_OVERFLOW_P (v)) return make_fixnum (v); } - return make_bignum_bits (op, bits); + return make_bignum_bits (bits); } /* Set RESULT to V. This code is for when intmax_t is wider than long. */ diff --git a/src/bignum.h b/src/bignum.h index a368333d77..07622a37af 100644 --- a/src/bignum.h +++ b/src/bignum.h @@ -41,7 +41,10 @@ struct Lisp_Bignum mpz_t value; }; -extern Lisp_Object make_integer (mpz_t const) ARG_NONNULL ((1)); +extern mpz_t mpz[4]; + +extern void init_bignum_once (void); +extern Lisp_Object make_integer_mpz (void); extern void mpz_set_intmax_slow (mpz_t, intmax_t) ARG_NONNULL ((1)); INLINE_HEADER_BEGIN @@ -65,6 +68,20 @@ mpz_set_intmax (mpz_t result, intmax_t v) mpz_set_intmax_slow (result, v); } +/* Return a pointer to an mpz_t that is equal to the Lisp integer I. + If I is a bignum this returns a pointer to I's representation; + otherwise this sets *TMP to I's value and returns TMP. */ +INLINE mpz_t * +bignum_integer (mpz_t *tmp, Lisp_Object i) +{ + if (FIXNUMP (i)) + { + mpz_set_intmax (*tmp, XFIXNUM (i)); + return tmp; + } + return &XBIGNUM (i)->value; +} + INLINE_HEADER_END #endif /* BIGNUM_H */ diff --git a/src/data.c b/src/data.c index 6afda1e6fb..7be2052362 100644 --- a/src/data.c +++ b/src/data.c @@ -2832,232 +2832,186 @@ enum arithop Alogior, Alogxor }; - -enum { FIXNUMS_FIT_IN_LONG = (LONG_MIN <= MOST_NEGATIVE_FIXNUM - && MOST_POSITIVE_FIXNUM <= LONG_MAX) }; - -static void -free_mpz_value (void *value_ptr) +static bool +floating_point_op (enum arithop code) { - mpz_clear (*(mpz_t *) value_ptr); + return code <= Adiv; } -static Lisp_Object float_arith_driver (double, ptrdiff_t, enum arithop, - ptrdiff_t, Lisp_Object *); +/* Return the result of applying the floating-point operation CODE to + the NARGS arguments starting at ARGS. If ARGNUM is positive, + ARGNUM of the arguments were already consumed, yielding ACCUM. + 0 <= ARGNUM < NARGS, 2 <= NARGS, and NEXT is the value of + ARGS[ARGSNUM], converted to double. */ static Lisp_Object -arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) +floatop_arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args, + ptrdiff_t argnum, double accum, double next) { - Lisp_Object val = Qnil; - ptrdiff_t argnum; - ptrdiff_t count = SPECPDL_INDEX (); - mpz_t accum; - - mpz_init (accum); - record_unwind_protect_ptr (free_mpz_value, &accum); - - switch (code) + if (argnum == 0) { - case Alogior: - case Alogxor: - case Aadd: - case Asub: - /* ACCUM is already 0. */ - break; - case Amult: - case Adiv: - mpz_set_si (accum, 1); - break; - case Alogand: - mpz_set_si (accum, -1); - break; - default: - break; + accum = next; + goto next_arg; } - for (argnum = 0; argnum < nargs; argnum++) + while (true) { - /* Using args[argnum] as argument to CHECK_NUMBER... */ - val = args[argnum]; - CHECK_NUMBER_COERCE_MARKER (val); - - if (FLOATP (val)) - return unbind_to (count, - float_arith_driver (mpz_get_d (accum), argnum, code, - nargs, args)); switch (code) { - case Aadd: - if (BIGNUMP (val)) - mpz_add (accum, accum, XBIGNUM (val)->value); - else if (! FIXNUMS_FIT_IN_LONG) - { - mpz_t tem; - mpz_init (tem); - mpz_set_intmax (tem, XFIXNUM (val)); - mpz_add (accum, accum, tem); - mpz_clear (tem); - } - else if (XFIXNUM (val) < 0) - mpz_sub_ui (accum, accum, - XFIXNUM (val)); - else - mpz_add_ui (accum, accum, XFIXNUM (val)); - break; - case Asub: - if (! argnum) - { - if (BIGNUMP (val)) - mpz_set (accum, XBIGNUM (val)->value); - else - mpz_set_intmax (accum, XFIXNUM (val)); - if (nargs == 1) - mpz_neg (accum, accum); - } - else if (BIGNUMP (val)) - mpz_sub (accum, accum, XBIGNUM (val)->value); - else if (! FIXNUMS_FIT_IN_LONG) - { - mpz_t tem; - mpz_init (tem); - mpz_set_intmax (tem, XFIXNUM (val)); - mpz_sub (accum, accum, tem); - mpz_clear (tem); - } - else if (XFIXNUM (val) < 0) - mpz_add_ui (accum, accum, - XFIXNUM (val)); - else - mpz_sub_ui (accum, accum, XFIXNUM (val)); - break; - case Amult: - if (BIGNUMP (val)) - emacs_mpz_mul (accum, accum, XBIGNUM (val)->value); - else if (! FIXNUMS_FIT_IN_LONG) - { - mpz_t tem; - mpz_init (tem); - mpz_set_intmax (tem, XFIXNUM (val)); - emacs_mpz_mul (accum, accum, tem); - mpz_clear (tem); - } - else - mpz_mul_si (accum, accum, XFIXNUM (val)); - break; + case Aadd : accum += next; break; + case Asub : accum -= next; break; + case Amult: accum *= next; break; case Adiv: - if (! (argnum || nargs == 1)) - { - if (BIGNUMP (val)) - mpz_set (accum, XBIGNUM (val)->value); - else - mpz_set_intmax (accum, XFIXNUM (val)); - } - else - { - /* Note that a bignum can never be 0, so we don't need - to check that case. */ - if (BIGNUMP (val)) - mpz_tdiv_q (accum, accum, XBIGNUM (val)->value); - else if (XFIXNUM (val) == 0) - xsignal0 (Qarith_error); - else if (ULONG_MAX < -MOST_NEGATIVE_FIXNUM) - { - mpz_t tem; - mpz_init (tem); - mpz_set_intmax (tem, XFIXNUM (val)); - mpz_tdiv_q (accum, accum, tem); - mpz_clear (tem); - } - else - { - EMACS_INT value = XFIXNUM (val); - mpz_tdiv_q_ui (accum, accum, eabs (value)); - if (value < 0) - mpz_neg (accum, accum); - } - } - break; - case Alogand: - if (BIGNUMP (val)) - mpz_and (accum, accum, XBIGNUM (val)->value); - else - { - mpz_t tem; - mpz_init (tem); - mpz_set_intmax (tem, XFIXNUM (val)); - mpz_and (accum, accum, tem); - mpz_clear (tem); - } - break; - case Alogior: - if (BIGNUMP (val)) - mpz_ior (accum, accum, XBIGNUM (val)->value); - else - { - mpz_t tem; - mpz_init (tem); - mpz_set_intmax (tem, XFIXNUM (val)); - mpz_ior (accum, accum, tem); - mpz_clear (tem); - } - break; - case Alogxor: - if (BIGNUMP (val)) - mpz_xor (accum, accum, XBIGNUM (val)->value); - else - { - mpz_t tem; - mpz_init (tem); - mpz_set_intmax (tem, XFIXNUM (val)); - mpz_xor (accum, accum, tem); - mpz_clear (tem); - } + if (! IEEE_FLOATING_POINT && next == 0) + xsignal0 (Qarith_error); + accum /= next; break; + default: eassume (false); } + + next_arg: + argnum++; + if (argnum == nargs) + return make_float (accum); + Lisp_Object val = args[argnum]; + CHECK_NUMBER_COERCE_MARKER (val); + next = XFLOATINT (val); } +} + +/* Like floatop_arith_driver, except CODE might not be a floating-point + operation, and NEXT is a Lisp float rather than a C double. */ - return unbind_to (count, make_integer (accum)); +static Lisp_Object +float_arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args, + ptrdiff_t argnum, double accum, Lisp_Object next) +{ + if (! floating_point_op (code)) + wrong_type_argument (Qinteger_or_marker_p, next); + return floatop_arith_driver (code, nargs, args, argnum, accum, + XFLOAT_DATA (next)); } +/* Return the result of applying the arithmetic operation CODE to the + NARGS arguments starting at ARGS. If ARGNUM is positive, ARGNUM of + the arguments were already consumed, yielding IACCUM. 0 <= ARGNUM + < NARGS, 2 <= NARGS, and VAL is the value of ARGS[ARGSNUM], + converted to integer. */ + static Lisp_Object -float_arith_driver (double accum, ptrdiff_t argnum, enum arithop code, - ptrdiff_t nargs, Lisp_Object *args) +bignum_arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args, + ptrdiff_t argnum, intmax_t iaccum, Lisp_Object val) { - for (; argnum < nargs; argnum++) + mpz_t *accum; + if (argnum == 0) { - Lisp_Object val = args[argnum]; - CHECK_NUMBER_COERCE_MARKER (val); - double next = (FIXNUMP (val) ? XFIXNUM (val) - : FLOATP (val) ? XFLOAT_DATA (val) - : mpz_get_d (XBIGNUM (val)->value)); + accum = bignum_integer (&mpz[0], val); + goto next_arg; + } + mpz_set_intmax (mpz[0], iaccum); + accum = &mpz[0]; + + while (true) + { + mpz_t *next = bignum_integer (&mpz[1], val); switch (code) { - case Aadd: - accum += next; - break; - case Asub: - accum = argnum ? accum - next : nargs == 1 ? - next : next; - break; - case Amult: - accum *= next; - break; + case Aadd : mpz_add (mpz[0], *accum, *next); break; + case Asub : mpz_sub (mpz[0], *accum, *next); break; + case Amult : emacs_mpz_mul (mpz[0], *accum, *next); break; + case Alogand: mpz_and (mpz[0], *accum, *next); break; + case Alogior: mpz_ior (mpz[0], *accum, *next); break; + case Alogxor: mpz_xor (mpz[0], *accum, *next); break; case Adiv: - if (! (argnum || nargs == 1)) - accum = next; - else - { - if (! IEEE_FLOATING_POINT && next == 0) - xsignal0 (Qarith_error); - accum /= next; - } + if (mpz_sgn (*next) == 0) + xsignal0 (Qarith_error); + mpz_tdiv_q (mpz[0], *accum, *next); break; - case Alogand: - case Alogior: - case Alogxor: - wrong_type_argument (Qinteger_or_marker_p, val); + default: + eassume (false); } + accum = &mpz[0]; + + next_arg: + argnum++; + if (argnum == nargs) + return make_integer_mpz (); + val = args[argnum]; + CHECK_NUMBER_COERCE_MARKER (val); + if (FLOATP (val)) + float_arith_driver (code, nargs, args, argnum, + mpz_get_d (*accum), val); } +} + +/* Return the result of applying the arithmetic operation CODE to the + NARGS arguments starting at ARGS, with the first argument being the + number VAL. 2 <= NARGS. Check that the remaining arguments are + numbers or markers. */ + +static Lisp_Object +arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args, + Lisp_Object val) +{ + eassume (2 <= nargs); + + ptrdiff_t argnum = 0; + /* Set ACCUM to VAL's value if it is a fixnum, otherwise to some + ignored value to avoid using an uninitialized variable later. */ + intmax_t accum = XFIXNUM (val); + + if (FIXNUMP (val)) + while (true) + { + argnum++; + if (argnum == nargs) + return make_int (accum); + val = args[argnum]; + CHECK_NUMBER_COERCE_MARKER (val); + + /* Set NEXT to the next value if it fits, else exit the loop. */ + intmax_t next; + if (FIXNUMP (val)) + next = XFIXNUM (val); + else if (FLOATP (val)) + break; + else + { + next = bignum_to_intmax (val); + if (next == 0) + break; + } + + /* Set ACCUM to the next operation's result if it fits, + else exit the loop. */ + bool overflow = false; + intmax_t a; + switch (code) + { + case Aadd : overflow = INT_ADD_WRAPV (accum, next, &a); break; + case Amult: overflow = INT_MULTIPLY_WRAPV (accum, next, &a); break; + case Asub : overflow = INT_SUBTRACT_WRAPV (accum, next, &a); break; + case Adiv: + if (next == 0) + xsignal0 (Qarith_error); + overflow = INT_DIVIDE_OVERFLOW (accum, next); + if (!overflow) + a = accum / next; + break; + case Alogand: accum &= next; continue; + case Alogior: accum |= next; continue; + case Alogxor: accum ^= next; continue; + default: eassume (false); + } + if (overflow) + break; + accum = a; + } - return make_float (accum); + return (FLOATP (val) + ? float_arith_driver (code, nargs, args, argnum, accum, val) + : bignum_arith_driver (code, nargs, args, argnum, accum, val)); } @@ -3066,7 +3020,11 @@ DEFUN ("+", Fplus, Splus, 0, MANY, 0, usage: (+ &rest NUMBERS-OR-MARKERS) */) (ptrdiff_t nargs, Lisp_Object *args) { - return arith_driver (Aadd, nargs, args); + if (nargs == 0) + return make_fixnum (0); + Lisp_Object a = args[0]; + CHECK_NUMBER_COERCE_MARKER (a); + return nargs == 1 ? a : arith_driver (Aadd, nargs, args, a); } DEFUN ("-", Fminus, Sminus, 0, MANY, 0, @@ -3076,7 +3034,20 @@ subtracts all but the first from the first. usage: (- &optional NUMBER-OR-MARKER &rest MORE-NUMBERS-OR-MARKERS) */) (ptrdiff_t nargs, Lisp_Object *args) { - return arith_driver (Asub, nargs, args); + if (nargs == 0) + return make_fixnum (0); + Lisp_Object a = args[0]; + CHECK_NUMBER_COERCE_MARKER (a); + if (nargs == 1) + { + if (FIXNUMP (a)) + return make_int (-XFIXNUM (a)); + if (FLOATP (a)) + return make_float (-XFLOAT_DATA (a)); + mpz_neg (mpz[0], XBIGNUM (a)->value); + return make_integer_mpz (); + } + return arith_driver (Asub, nargs, args, a); } DEFUN ("*", Ftimes, Stimes, 0, MANY, 0, @@ -3084,7 +3055,11 @@ DEFUN ("*", Ftimes, Stimes, 0, MANY, 0, usage: (* &rest NUMBERS-OR-MARKERS) */) (ptrdiff_t nargs, Lisp_Object *args) { - return arith_driver (Amult, nargs, args); + if (nargs == 0) + return make_fixnum (1); + Lisp_Object a = args[0]; + CHECK_NUMBER_COERCE_MARKER (a); + return nargs == 1 ? a : arith_driver (Amult, nargs, args, a); } DEFUN ("/", Fquo, Squo, 1, MANY, 0, @@ -3095,11 +3070,31 @@ The arguments must be numbers or markers. usage: (/ NUMBER &rest DIVISORS) */) (ptrdiff_t nargs, Lisp_Object *args) { - ptrdiff_t argnum; - for (argnum = 2; argnum < nargs; argnum++) + Lisp_Object a = args[0]; + CHECK_NUMBER_COERCE_MARKER (a); + if (nargs == 1) + { + if (FIXNUMP (a)) + { + if (XFIXNUM (a) == 0) + xsignal0 (Qarith_error); + return make_fixnum (1 / XFIXNUM (a)); + } + if (FLOATP (a)) + { + if (! IEEE_FLOATING_POINT && XFLOAT_DATA (a) == 0) + xsignal0 (Qarith_error); + return make_float (1 / XFLOAT_DATA (a)); + } + /* Dividing 1 by any bignum yields 0. */ + return make_fixnum (0); + } + + /* Do all computation in floating-point if any arg is a float. */ + for (ptrdiff_t argnum = 2; argnum < nargs; argnum++) if (FLOATP (args[argnum])) - return float_arith_driver (0, 0, Adiv, nargs, args); - return arith_driver (Adiv, nargs, args); + return floatop_arith_driver (Adiv, nargs, args, 0, 0, XFLOATINT (a)); + return arith_driver (Adiv, nargs, args, a); } DEFUN ("%", Frem, Srem, 2, 2, 0, @@ -3107,52 +3102,22 @@ DEFUN ("%", Frem, Srem, 2, 2, 0, Both must be integers or markers. */) (register Lisp_Object x, Lisp_Object y) { - Lisp_Object val; - CHECK_INTEGER_COERCE_MARKER (x); CHECK_INTEGER_COERCE_MARKER (y); - /* Note that a bignum can never be 0, so we don't need to check that - case. */ + /* A bignum can never be 0, so don't check that case. */ if (FIXNUMP (y) && XFIXNUM (y) == 0) xsignal0 (Qarith_error); if (FIXNUMP (x) && FIXNUMP (y)) - XSETINT (val, XFIXNUM (x) % XFIXNUM (y)); + return make_fixnum (XFIXNUM (x) % XFIXNUM (y)); else { - mpz_t xm, ym, *xmp, *ymp; - mpz_t result; - - if (BIGNUMP (x)) - xmp = &XBIGNUM (x)->value; - else - { - mpz_init (xm); - mpz_set_intmax (xm, XFIXNUM (x)); - xmp = &xm; - } - - if (BIGNUMP (y)) - ymp = &XBIGNUM (y)->value; - else - { - mpz_init (ym); - mpz_set_intmax (ym, XFIXNUM (y)); - ymp = &ym; - } - - mpz_init (result); - mpz_tdiv_r (result, *xmp, *ymp); - val = make_integer (result); - mpz_clear (result); - - if (xmp == &xm) - mpz_clear (xm); - if (ymp == &ym) - mpz_clear (ym); + mpz_tdiv_r (mpz[0], + *bignum_integer (&mpz[0], x), + *bignum_integer (&mpz[1], y)); + return make_integer_mpz (); } - return val; } DEFUN ("mod", Fmod, Smod, 2, 2, 0, @@ -3161,9 +3126,6 @@ The result falls between zero (inclusive) and Y (exclusive). Both X and Y must be numbers or markers. */) (register Lisp_Object x, Lisp_Object y) { - Lisp_Object val; - EMACS_INT i1, i2; - CHECK_NUMBER_COERCE_MARKER (x); CHECK_NUMBER_COERCE_MARKER (y); @@ -3177,8 +3139,7 @@ Both X and Y must be numbers or markers. */) if (FIXNUMP (x) && FIXNUMP (y)) { - i1 = XFIXNUM (x); - i2 = XFIXNUM (y); + EMACS_INT i1 = XFIXNUM (x), i2 = XFIXNUM (y); if (i2 == 0) xsignal0 (Qarith_error); @@ -3189,51 +3150,21 @@ Both X and Y must be numbers or markers. */) if (i2 < 0 ? i1 > 0 : i1 < 0) i1 += i2; - XSETINT (val, i1); + return make_fixnum (i1); } else { - mpz_t xm, ym, *xmp, *ymp; - mpz_t result; - int cmpr, cmpy; - - if (BIGNUMP (x)) - xmp = &XBIGNUM (x)->value; - else - { - mpz_init (xm); - mpz_set_intmax (xm, XFIXNUM (x)); - xmp = &xm; - } - - if (BIGNUMP (y)) - ymp = &XBIGNUM (y)->value; - else - { - mpz_init (ym); - mpz_set_intmax (ym, XFIXNUM (y)); - ymp = &ym; - } - - mpz_init (result); - mpz_mod (result, *xmp, *ymp); + mpz_t *ym = bignum_integer (&mpz[1], y); + bool neg_y = mpz_sgn (*ym) < 0; + mpz_mod (mpz[0], *bignum_integer (&mpz[0], x), *ym); /* Fix the sign if needed. */ - cmpr = mpz_sgn (result); - cmpy = mpz_sgn (*ymp); - if (cmpy < 0 ? cmpr > 0 : cmpr < 0) - mpz_add (result, result, *ymp); - - val = make_integer (result); - mpz_clear (result); - - if (xmp == &xm) - mpz_clear (xm); - if (ymp == &ym) - mpz_clear (ym); - } + int sgn_r = mpz_sgn (mpz[0]); + if (neg_y ? sgn_r > 0 : sgn_r < 0) + mpz_add (mpz[0], mpz[0], *ym); - return val; + return make_integer_mpz (); + } } static Lisp_Object @@ -3278,7 +3209,11 @@ Arguments may be integers, or markers converted to integers. usage: (logand &rest INTS-OR-MARKERS) */) (ptrdiff_t nargs, Lisp_Object *args) { - return arith_driver (Alogand, nargs, args); + if (nargs == 0) + return make_fixnum (-1); + Lisp_Object a = args[0]; + CHECK_INTEGER_COERCE_MARKER (a); + return nargs == 1 ? a : arith_driver (Alogand, nargs, args, a); } DEFUN ("logior", Flogior, Slogior, 0, MANY, 0, @@ -3287,7 +3222,11 @@ Arguments may be integers, or markers converted to integers. usage: (logior &rest INTS-OR-MARKERS) */) (ptrdiff_t nargs, Lisp_Object *args) { - return arith_driver (Alogior, nargs, args); + if (nargs == 0) + return make_fixnum (0); + Lisp_Object a = args[0]; + CHECK_INTEGER_COERCE_MARKER (a); + return nargs == 1 ? a : arith_driver (Alogior, nargs, args, a); } DEFUN ("logxor", Flogxor, Slogxor, 0, MANY, 0, @@ -3296,7 +3235,11 @@ Arguments may be integers, or markers converted to integers. usage: (logxor &rest INTS-OR-MARKERS) */) (ptrdiff_t nargs, Lisp_Object *args) { - return arith_driver (Alogxor, nargs, args); + if (nargs == 0) + return make_fixnum (0); + Lisp_Object a = args[0]; + CHECK_INTEGER_COERCE_MARKER (a); + return nargs == 1 ? a : arith_driver (Alogxor, nargs, args, a); } DEFUN ("logcount", Flogcount, Slogcount, 1, 1, 0, @@ -3310,14 +3253,13 @@ representation. */) if (BIGNUMP (value)) { - if (mpz_sgn (XBIGNUM (value)->value) >= 0) - return make_fixnum (mpz_popcount (XBIGNUM (value)->value)); - mpz_t tem; - mpz_init (tem); - mpz_com (tem, XBIGNUM (value)->value); - Lisp_Object result = make_fixnum (mpz_popcount (tem)); - mpz_clear (tem); - return result; + mpz_t *nonneg = &XBIGNUM (value)->value; + if (mpz_sgn (*nonneg) < 0) + { + mpz_com (mpz[0], *nonneg); + nonneg = &mpz[0]; + } + return make_fixnum (mpz_popcount (*nonneg)); } eassume (FIXNUMP (value)); @@ -3335,8 +3277,6 @@ If COUNT is negative, shifting is actually to the right. In this case, the sign bit is duplicated. */) (Lisp_Object value, Lisp_Object count) { - Lisp_Object val; - /* The negative of the minimum value of COUNT that fits into a fixnum, such that mpz_fdiv_q_exp supports -COUNT. */ EMACS_INT minus_count_min = min (-MOST_NEGATIVE_FIXNUM, @@ -3344,48 +3284,27 @@ In this case, the sign bit is duplicated. */) CHECK_INTEGER (value); CHECK_RANGED_INTEGER (count, - minus_count_min, TYPE_MAXIMUM (mp_bitcnt_t)); - if (BIGNUMP (value)) + if (XFIXNUM (count) <= 0) { if (XFIXNUM (count) == 0) return value; - mpz_t result; - mpz_init (result); - if (XFIXNUM (count) > 0) - emacs_mpz_mul_2exp (result, XBIGNUM (value)->value, XFIXNUM (count)); - else - mpz_fdiv_q_2exp (result, XBIGNUM (value)->value, - XFIXNUM (count)); - val = make_integer (result); - mpz_clear (result); - } - else if (XFIXNUM (count) <= 0) - { - /* This code assumes that signed right shifts are arithmetic. */ - verify ((EMACS_INT) -1 >> 1 == -1); - - EMACS_INT shift = -XFIXNUM (count); - EMACS_INT result = (shift < EMACS_INT_WIDTH ? XFIXNUM (value) >> shift - : XFIXNUM (value) < 0 ? -1 : 0); - val = make_fixnum (result); - } - else - { - /* Just do the work as bignums to make the code simpler. */ - mpz_t result; - eassume (FIXNUMP (value)); - mpz_init (result); - - mpz_set_intmax (result, XFIXNUM (value)); - - if (XFIXNUM (count) >= 0) - emacs_mpz_mul_2exp (result, result, XFIXNUM (count)); - else - mpz_fdiv_q_2exp (result, result, - XFIXNUM (count)); - val = make_integer (result); - mpz_clear (result); + if ((EMACS_INT) -1 >> 1 == -1 && FIXNUMP (value)) + { + EMACS_INT shift = -XFIXNUM (count); + EMACS_INT result + = (shift < EMACS_INT_WIDTH ? XFIXNUM (value) >> shift + : XFIXNUM (value) < 0 ? -1 : 0); + return make_fixnum (result); + } } - return val; + mpz_t *zval = bignum_integer (&mpz[0], value); + if (XFIXNUM (count) < 0) + mpz_fdiv_q_2exp (mpz[0], *zval, - XFIXNUM (count)); + else + emacs_mpz_mul_2exp (mpz[0], *zval, XFIXNUM (count)); + return make_integer_mpz (); } /* Return X ** Y as an integer. X and Y must be integers, and Y must @@ -3403,16 +3322,8 @@ expt_integer (Lisp_Object x, Lisp_Object y) else range_error (); - mpz_t val; - mpz_init (val); - emacs_mpz_pow_ui (val, - (FIXNUMP (x) - ? (mpz_set_intmax (val, XFIXNUM (x)), val) - : XBIGNUM (x)->value), - exp); - Lisp_Object res = make_integer (val); - mpz_clear (val); - return res; + emacs_mpz_pow_ui (mpz[0], *bignum_integer (&mpz[0], x), exp); + return make_integer_mpz (); } DEFUN ("1+", Fadd1, Sadd1, 1, 1, 0, @@ -3422,32 +3333,12 @@ Markers are converted to integers. */) { CHECK_NUMBER_COERCE_MARKER (number); + if (FIXNUMP (number)) + return make_int (XFIXNUM (number) + 1); if (FLOATP (number)) return (make_float (1.0 + XFLOAT_DATA (number))); - - if (BIGNUMP (number)) - { - mpz_t num; - mpz_init (num); - mpz_add_ui (num, XBIGNUM (number)->value, 1); - number = make_integer (num); - mpz_clear (num); - } - else - { - eassume (FIXNUMP (number)); - if (XFIXNUM (number) < MOST_POSITIVE_FIXNUM) - XSETINT (number, XFIXNUM (number) + 1); - else - { - mpz_t num; - mpz_init (num); - mpz_set_intmax (num, XFIXNUM (number) + 1); - number = make_integer (num); - mpz_clear (num); - } - } - return number; + mpz_add_ui (mpz[0], XBIGNUM (number)->value, 1); + return make_integer_mpz (); } DEFUN ("1-", Fsub1, Ssub1, 1, 1, 0, @@ -3457,32 +3348,12 @@ Markers are converted to integers. */) { CHECK_NUMBER_COERCE_MARKER (number); + if (FIXNUMP (number)) + return make_int (XFIXNUM (number) - 1); if (FLOATP (number)) return (make_float (-1.0 + XFLOAT_DATA (number))); - - if (BIGNUMP (number)) - { - mpz_t num; - mpz_init (num); - mpz_sub_ui (num, XBIGNUM (number)->value, 1); - number = make_integer (num); - mpz_clear (num); - } - else - { - eassume (FIXNUMP (number)); - if (XFIXNUM (number) > MOST_NEGATIVE_FIXNUM) - XSETINT (number, XFIXNUM (number) - 1); - else - { - mpz_t num; - mpz_init (num); - mpz_set_intmax (num, XFIXNUM (number) - 1); - number = make_integer (num); - mpz_clear (num); - } - } - return number; + mpz_sub_ui (mpz[0], XBIGNUM (number)->value, 1); + return make_integer_mpz (); } DEFUN ("lognot", Flognot, Slognot, 1, 1, 0, @@ -3490,20 +3361,10 @@ DEFUN ("lognot", Flognot, Slognot, 1, 1, 0, (register Lisp_Object number) { CHECK_INTEGER (number); - if (BIGNUMP (number)) - { - mpz_t value; - mpz_init (value); - mpz_com (value, XBIGNUM (number)->value); - number = make_integer (value); - mpz_clear (value); - } - else - { - eassume (FIXNUMP (number)); - XSETINT (number, ~XFIXNUM (number)); - } - return number; + if (FIXNUMP (number)) + return make_fixnum (~XFIXNUM (number)); + mpz_com (mpz[0], XBIGNUM (number)->value); + return make_integer_mpz (); } DEFUN ("byteorder", Fbyteorder, Sbyteorder, 0, 0, 0, diff --git a/src/emacs.c b/src/emacs.c index 07a1aff9b0..5b399eca64 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1209,6 +1209,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem if (!initialized) { init_alloc_once (); + init_bignum_once (); init_threads_once (); init_obarray (); init_eval_once (); diff --git a/src/floatfns.c b/src/floatfns.c index 77e20d5640..2f33b8652b 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -270,11 +270,8 @@ DEFUN ("abs", Fabs, Sabs, 1, 1, 0, { if (mpz_sgn (XBIGNUM (arg)->value) < 0) { - mpz_t val; - mpz_init (val); - mpz_neg (val, XBIGNUM (arg)->value); - arg = make_integer (val); - mpz_clear (val); + mpz_neg (mpz[0], XBIGNUM (arg)->value); + arg = make_integer_mpz (); } } @@ -360,20 +357,10 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor, { if (EQ (divisor, make_fixnum (0))) xsignal0 (Qarith_error); - mpz_t d, q; - mpz_init (d); - mpz_init (q); - int_divide (q, - (FIXNUMP (arg) - ? (mpz_set_intmax (q, XFIXNUM (arg)), q) - : XBIGNUM (arg)->value), - (FIXNUMP (divisor) - ? (mpz_set_intmax (d, XFIXNUM (divisor)), d) - : XBIGNUM (divisor)->value)); - Lisp_Object result = make_integer (q); - mpz_clear (d); - mpz_clear (q); - return result; + int_divide (mpz[0], + *bignum_integer (&mpz[0], arg), + *bignum_integer (&mpz[1], divisor)); + return make_integer_mpz (); } double f1 = FLOATP (arg) ? XFLOAT_DATA (arg) : XFIXNUM (arg); @@ -417,20 +404,15 @@ rounddiv_q (mpz_t q, mpz_t const n, mpz_t const d) if (abs_r1 < abs_r + (q & 1)) q += neg_d == neg_r ? 1 : -1; */ - mpz_t r, abs_r1; - mpz_init (r); - mpz_init (abs_r1); - mpz_tdiv_qr (q, r, n, d); + mpz_t *r = &mpz[2], *abs_r = r, *abs_r1 = &mpz[3]; + mpz_tdiv_qr (q, *r, n, d); bool neg_d = mpz_sgn (d) < 0; - bool neg_r = mpz_sgn (r) < 0; - mpz_t *abs_r = &r; - mpz_abs (*abs_r, r); - mpz_abs (abs_r1, d); - mpz_sub (abs_r1, abs_r1, *abs_r); - if (mpz_cmp (abs_r1, *abs_r) < (mpz_odd_p (q) != 0)) + bool neg_r = mpz_sgn (*r) < 0; + mpz_abs (*abs_r, *r); + mpz_abs (*abs_r1, d); + mpz_sub (*abs_r1, *abs_r1, *abs_r); + if (mpz_cmp (*abs_r1, *abs_r) < (mpz_odd_p (q) != 0)) (neg_d == neg_r ? mpz_add_ui : mpz_sub_ui) (q, q, 1); - mpz_clear (r); - mpz_clear (abs_r1); } /* The code uses emacs_rint, so that it works to undefine HAVE_RINT diff --git a/src/fns.c b/src/fns.c index 17a869e1ab..8b25492eae 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1468,19 +1468,17 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0, /* Undo any error introduced when LARGE_NUM was substituted for N, by adding N - LARGE_NUM to NUM, using arithmetic modulo CYCLE_LENGTH. */ - mpz_t z; /* N mod CYCLE_LENGTH. */ - mpz_init (z); + /* Add N mod CYCLE_LENGTH to NUM. */ if (cycle_length <= ULONG_MAX) - num += mpz_mod_ui (z, XBIGNUM (n)->value, cycle_length); + num += mpz_mod_ui (mpz[0], XBIGNUM (n)->value, cycle_length); else { - mpz_set_intmax (z, cycle_length); - mpz_mod (z, XBIGNUM (n)->value, z); + mpz_set_intmax (mpz[0], cycle_length); + mpz_mod (mpz[0], XBIGNUM (n)->value, mpz[0]); intptr_t iz; - mpz_export (&iz, NULL, -1, sizeof iz, 0, 0, z); + mpz_export (&iz, NULL, -1, sizeof iz, 0, 0, mpz[0]); num += iz; } - mpz_clear (z); num += cycle_length - large_num % cycle_length; } num %= cycle_length; commit 40f8ade7c81ab6f99537691ae00d2d42069bdb20 Author: Stephen Berman Date: Mon Sep 3 22:40:24 2018 +0200 Make todo-show work when adding and deleting a new todo file * lisp/calendar/todo-mode.el (todo-add-file): Since todo-current-todo-file must be set before calling todo-show, but the buffer is not yet in todo-mode, which makes it buffer local, explicitly set it buffer locally (bug#32627). * test/lisp/calendar/todo-mode-tests.el (todo-test--add-file) (todo-test--delete-file): New functions. (todo-test-add-and-delete-file): New test. diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index 08da75dbd6..7d01fe31fb 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -1106,7 +1106,9 @@ Noninteractively, return the name of the new file." (progn (set-window-buffer (selected-window) (set-buffer (find-file-noselect file))) - (setq todo-current-todo-file file) + ;; Since buffer is not yet in todo-mode, we need to + ;; explicitly make todo-current-todo-file buffer local. + (setq-local todo-current-todo-file file) (todo-show)) file))) diff --git a/test/lisp/calendar/todo-mode-tests.el b/test/lisp/calendar/todo-mode-tests.el index 6cd2bfe35b..015fbaccf4 100644 --- a/test/lisp/calendar/todo-mode-tests.el +++ b/test/lisp/calendar/todo-mode-tests.el @@ -603,7 +603,7 @@ separator, otherwise, return the position at the beginning." (forward-line -1)) (if eol (forward-char))) -(ert-deftest todo-test-done-items-separator01-bol () +(ert-deftest todo-test-done-items-separator01-bol () ; bug#32343 "Test item copying and here insertion at BOL of separator. Both should be user errors." (with-todo-test @@ -616,7 +616,7 @@ Both should be user errors." (should (string= copy-err (cadr (funcall insert-item-test 'copy)))) (should (string= here-err (cadr (funcall insert-item-test 'here))))))) -(ert-deftest todo-test-done-items-separator01-eol () +(ert-deftest todo-test-done-items-separator01-eol () ; bug#32343 "Test item copying and here insertion at EOL of separator. Both should be user errors." (with-todo-test @@ -629,7 +629,7 @@ Both should be user errors." (should (string= copy-err (cadr (funcall insert-item-test 'copy)))) (should (string= here-err (cadr (funcall insert-item-test 'here))))))) -(ert-deftest todo-test-done-items-separator02-bol () +(ert-deftest todo-test-done-items-separator02-bol () ; bug#32343 "Test item editing commands at BOL of done items separator. They should all be noops." (with-todo-test @@ -642,7 +642,7 @@ They should all be noops." (should-not (called-interactively-p #'todo-delete-item)) (should-not (called-interactively-p #'todo-edit-item)))) -(ert-deftest todo-test-done-items-separator02-eol () +(ert-deftest todo-test-done-items-separator02-eol () ; bug#32343 "Test item editing command at EOL of done items separator. They should all be noops." (with-todo-test @@ -655,7 +655,7 @@ They should all be noops." (should-not (called-interactively-p #'todo-delete-item)) (should-not (called-interactively-p #'todo-edit-item)))) -(ert-deftest todo-test-done-items-separator03-bol () +(ert-deftest todo-test-done-items-separator03-bol () ; bug#32343 "Test item marking at BOL of done items separator. This should be a noop, adding no marks to the category." (with-todo-test @@ -663,7 +663,7 @@ This should be a noop, adding no marks to the category." (call-interactively #'todo-toggle-mark-item) (should-not (assoc (todo-current-category) todo-categories-with-marks)))) -(ert-deftest todo-test-done-items-separator03-eol () +(ert-deftest todo-test-done-items-separator03-eol () ; bug#32343 "Test item marking at EOL of done items separator. This should be a noop, adding no marks to the category." (with-todo-test @@ -671,7 +671,7 @@ This should be a noop, adding no marks to the category." (call-interactively #'todo-toggle-mark-item) (should-not (assoc (todo-current-category) todo-categories-with-marks)))) -(ert-deftest todo-test-done-items-separator04-bol () +(ert-deftest todo-test-done-items-separator04-bol () ; bug#32343 "Test moving to previous item from BOL of done items separator. This should move point to the last not done todo item." (with-todo-test @@ -685,7 +685,7 @@ This should move point to the last not done todo item." (todo-previous-item) (todo-item-string))))))) -(ert-deftest todo-test-done-items-separator04-eol () +(ert-deftest todo-test-done-items-separator04-eol () ; bug#32343 "Test moving to previous item from EOL of done items separator. This should move point to the last not done todo item." (with-todo-test @@ -699,7 +699,7 @@ This should move point to the last not done todo item." (todo-previous-item) (todo-item-string))))))) -(ert-deftest todo-test-done-items-separator05-bol () +(ert-deftest todo-test-done-items-separator05-bol () ; bug#32343 "Test moving to next item from BOL of done items separator. This should move point to the first done todo item." (with-todo-test @@ -713,7 +713,7 @@ This should move point to the first done todo item." (todo-next-item) (todo-item-string))))))) -(ert-deftest todo-test-done-items-separator05-eol () +(ert-deftest todo-test-done-items-separator05-eol () ; bug#32343 "Test moving to next item from EOL of done items separator. This should move point to the first done todo item." (with-todo-test @@ -732,7 +732,7 @@ This should move point to the first done todo item." ;; hook function is not automatically run, so after enabling item ;; highlighting, use ert-simulate-command around the next command, ;; which explicitly runs the hook function. -(ert-deftest todo-test-done-items-separator06-bol () +(ert-deftest todo-test-done-items-separator06-bol () ; bug#32343 "Test enabling item highlighting at BOL of done items separator. Subsequently moving to an item should show it highlighted." (with-todo-test @@ -741,7 +741,7 @@ Subsequently moving to an item should show it highlighted." (ert-simulate-command '(todo-previous-item)) (should (eq 'hl-line (get-char-property (point) 'face))))) -(ert-deftest todo-test-done-items-separator06-eol () +(ert-deftest todo-test-done-items-separator06-eol () ; bug#32343 "Test enabling item highlighting at EOL of done items separator. Subsequently moving to an item should show it highlighted." (with-todo-test @@ -751,7 +751,7 @@ Subsequently moving to an item should show it highlighted." (ert-simulate-command '(todo-previous-item)) (should (eq 'hl-line (get-char-property (point) 'face))))) -(ert-deftest todo-test-done-items-separator07 () +(ert-deftest todo-test-done-items-separator07 () ; bug#32343 "Test item highlighting when crossing done items separator. The highlighting should remain enabled." (with-todo-test @@ -763,11 +763,11 @@ The highlighting should remain enabled." (ert-simulate-command '(forward-line)) ; Now on first done item. (should (eq 'hl-line (get-char-property (point) 'face))))) -(ert-deftest todo-test-current-file-in-edit-mode () +(ert-deftest todo-test-current-file-in-edit-mode () ; bug#32437 "Test the value of todo-current-todo-file in todo-edit-mode." (with-todo-test (todo-test--show 1) - ;; The preceding call todo-mode but does not run pre-command-hook + ;; The preceding calls todo-mode but does not run pre-command-hook ;; in the test environment, thus failing to set ;; todo-global-current-todo-file, which is needed for the test ;; after todo-edit-item--text. So force the hook function to run. @@ -786,7 +786,7 @@ The highlighting should remain enabled." (todo-edit-file) (should (equal todo-current-todo-file curfile))))) -(ert-deftest todo-test-edit-quit () +(ert-deftest todo-test-edit-quit () ; bug#32437 "Test result of exiting todo-edit-mode on a whole file. Exiting should return to the same todo-mode or todo-archive-mode buffer from which the editing command was invoked." @@ -804,6 +804,50 @@ buffer from which the editing command was invoked." (should (eq (current-buffer) buf)) (should (eq major-mode 'todo-archive-mode)))))) +(defun todo-test--add-file (file cat) + "Add file FILE with category CAT to todo-files and show it. +This provides a noninteractive API for todo-add-file for use in +automatic testing." + (let ((file0 (file-truename (concat todo-test-data-dir file ".todo"))) + todo-add-item-if-new-category) ; Don't need an item in cat. + (cl-letf (((symbol-function 'todo-read-file-name) + (lambda (_prompt) file0)) + ((symbol-function 'todo-read-category) + (lambda (_prompt &optional _match-type _file) (cons cat file0)))) + (call-interactively 'todo-add-file) ; Interactive to call todo-show. + (todo-add-category file0 cat)))) + +(defun todo-test--delete-file () + "Delete current todo file without prompting." + (cl-letf (((symbol-function 'yes-or-no-p) + (lambda (_prompt) t))) + (todo-delete-file))) + +(ert-deftest todo-test-add-and-delete-file () ; bug#32627 + "Test adding a new todo file and then deleting it. +Calling todo-show should display the last current todo file, not +necessarily the new file. After deleting the new file, todo-show +should display the previously current (or default) todo file." + (with-todo-test + (todo-show) + (should (equal todo-current-todo-file todo-test-file-1)) + (let* ((file (concat todo-directory "todo-test-2.todo")) + (file-nb (file-name-base file)) + (cat "cat21")) + (todo-test--add-file file-nb cat) ; Add new file and show it. + (should (equal todo-current-todo-file file)) + (todo-quit) ; Quitting todo-mode displays previous buffer. + (should (equal todo-current-todo-file todo-test-file-1)) + (switch-to-buffer "*scratch*") + (todo-show) ; Show the last current todo-file (not the new one). + (should (equal todo-current-todo-file todo-test-file-1)) + (switch-to-buffer (get-file-buffer file)) ; Back to new file. + (should (equal todo-current-todo-file file)) + (todo-test--delete-file) + (todo-show) ; Back to old file. + (should (equal todo-current-todo-file todo-test-file-1)) + (delete-file (concat file "~"))))) + (provide 'todo-mode-tests) ;;; todo-mode-tests.el ends here commit 82fc6b631306bd42f29a189a3cc9e8f449fa7501 Author: Paul Eggert Date: Mon Sep 3 12:57:10 2018 -0700 * lisp/calculator.el: Fix doc typo. diff --git a/lisp/calculator.el b/lisp/calculator.el index b6959af795..f559fb4828 100644 --- a/lisp/calculator.el +++ b/lisp/calculator.el @@ -627,7 +627,7 @@ Here are the editing keys: These operators are pre-defined: * `+' `-' `*' `/' the common binary operators -* `\\' `%' integer division and reminder +* `\\' `%' integer division and remainder * `_' `;' postfix unary negation and reciprocal * `^' `L' binary operators for x^y and log(x) in base y * `Q' `!' unary square root and factorial commit ddc7c648d2cba328f8812c678fbae23d96dfaf49 Author: Glenn Morris Date: Mon Sep 3 10:28:07 2018 -0700 Standardize calc bug reporting instructions * doc/misc/calc.texi (Reporting Bugs): Use standard commands. * lisp/calc/calc-misc.el (report-calc-bug, calc-report-bug): * lisp/calc/calc.el (calc-bug-address): Change to be obsolete aliases for standard Emacs bug reporting items. diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index 9f821baf60..5e11d35e90 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi @@ -35724,19 +35724,12 @@ The default value of @code{calc-gregorian-switch} is @code{nil}. @appendix Reporting Bugs @noindent -If you find a bug in Calc, send e-mail to Jay Belanger, - -@example -jay.p.belanger@@gmail.com -@end example - -@noindent -There is an automatic command @kbd{M-x report-calc-bug} which helps +If you find a bug in Calc, send e-mail to @email{bug-gnu-emacs@@gnu.org}. +There is an automatic command @kbd{M-x report-emacs-bug} which helps you to report bugs. This command prompts you for a brief subject line, then leaves you in a mail editing buffer. Type @kbd{C-c C-c} to send your mail. Make sure your subject line indicates that you are -reporting a Calc bug; this command sends mail to the maintainer's -regular mailbox. +reporting a Calc bug. If you have suggestions for additional features for Calc, please send them. Some have dared to suggest that Calc is already top-heavy with @@ -35745,7 +35738,7 @@ them right in. At the front of the source file, @file{calc.el}, is a list of ideas for future work. If any enthusiastic souls wish to take it upon themselves -to work on these, please send a message (using @kbd{M-x report-calc-bug}) +to work on these, please send a message (using @kbd{M-x report-emacs-bug}) so any efforts can be coordinated. The latest version of Calc is available from Savannah, in the Emacs diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el index 29e8510413..6543920d07 100644 --- a/lisp/calc/calc-misc.el +++ b/lisp/calc/calc-misc.el @@ -943,19 +943,9 @@ loaded and the keystroke automatically re-typed." ;;; Bug reporting ;;;###autoload -(defun report-calc-bug () - "Report a bug in Calc, the GNU Emacs calculator. -Prompts for bug subject. Leaves you in a mail buffer." - (interactive) - (let ((reporter-prompt-for-summary-p t)) - (reporter-submit-bug-report calc-bug-address "Calc" - nil nil nil - "Please describe exactly what actions triggered the bug and the -precise symptoms of the bug. If possible, include a backtrace by -doing `\\[toggle-debug-on-error]', then reproducing the bug. -" ))) -;;;###autoload -(defalias 'calc-report-bug 'report-calc-bug) +(define-obsolete-function-alias 'report-calc-bug 'report-emacs-bug "26.2") +;;;###autoload +(define-obsolete-function-alias 'calc-report-bug 'report-emacs-bug "26.2") (provide 'calc-misc) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 4bebd5f47b..871e65a2cb 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -486,8 +486,8 @@ to be identified as that note." "Face used to show the selected portion of a formula." :group 'calc) -(defvar calc-bug-address "emacs-devel@gnu.org" - "Address of the maintainer of Calc, for use by `report-calc-bug'.") +(define-obsolete-variable-alias 'calc-bug-address 'report-emacs-bug-address + "26.2") (defvar calc-scan-for-dels t "If t, scan keymaps to find all DEL-like keys. commit 7e24039a9747cc1117b17631511e42cb3576362b Author: Stefan Monnier Date: Sat Sep 1 18:51:26 2018 -0400 * src/lisp.h: Add explanation in a comment diff --git a/src/lisp.h b/src/lisp.h index 36ca32c3c0..d244bc02d4 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -866,7 +866,16 @@ union vectorlike_header Current layout limits the pseudovectors to 63 PVEC_xxx subtypes, 4095 Lisp_Objects in GC-ed area and 4095 word-sized other slots. */ ptrdiff_t size; - /* Align the union so that there is no padding after it. */ + /* Align the union so that there is no padding after it. + This is needed for the following reason: + If the alignment constraint of Lisp_Object is greater than the size of + vectorlike_header (e.g. with-wide-int), vectorlike objects which have + 0 Lisp_Object fields and whose 1st field has a smaller alignment + constraint than Lisp_Object may end up with their 1st field "before + pseudovector index 0", in which case PSEUDOVECSIZE will return + a "negative" number. We could fix PSEUDOVECSIZE, but it's easier to + just force rounding up the size of vectorlike_header to the alignment + of Lisp_Object. */ Lisp_Object align; GCALIGNED_UNION }; commit 321b06b8d1b3a341f89b9f4794242ddc294036ff Author: Glenn Morris Date: Sat Sep 1 07:22:46 2018 -0400 ; Auto-commit of loaddefs files. diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 3bd775f515..bdf4c31529 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -1900,6 +1900,21 @@ definition of \"random distance\".) ;;;*** +;;;### (autoloads nil "backtrace" "emacs-lisp/backtrace.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from emacs-lisp/backtrace.el +(push (purecopy '(backtrace 1 0)) package--builtin-versions) + +(autoload 'backtrace "backtrace" "\ +Print a trace of Lisp function calls currently active. +Output stream used is value of `standard-output'. + +\(fn)" nil nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "backtrace" '("backtrace-"))) + +;;;*** + ;;;### (autoloads nil "bat-mode" "progmodes/bat-mode.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/bat-mode.el @@ -3850,6 +3865,7 @@ the absolute file name of the file if STYLE-NAME is nil. ;;;### (autoloads nil "cc-mode" "progmodes/cc-mode.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/cc-mode.el +(push (purecopy '(cc-mode 5 33 1)) package--builtin-versions) (autoload 'c-initialize-cc-mode "cc-mode" "\ Initialize CC Mode for use in the current buffer. @@ -4998,6 +5014,13 @@ call other entry points instead, such as `cl-prin1'. \(fn OBJECT STREAM)" nil nil) +(autoload 'cl-print-expand-ellipsis "cl-print" "\ +Print the expansion of an ellipsis to STREAM. +VALUE should be the value of the `cl-print-ellipsis' text property +which was attached to the ellipsis by `cl-prin1'. + +\(fn VALUE STREAM)" nil nil) + (autoload 'cl-prin1 "cl-print" "\ Print OBJECT on STREAM according to its type. Output is further controlled by the variables @@ -5012,6 +5035,24 @@ Return a string containing the `cl-prin1'-printed representation of OBJECT. \(fn OBJECT)" nil nil) +(autoload 'cl-print-to-string-with-limit "cl-print" "\ +Return a string containing a printed representation of VALUE. +Attempt to get the length of the returned string under LIMIT +characters with appropriate settings of `print-level' and +`print-length.' Use PRINT-FUNCTION to print, which should take +the arguments VALUE and STREAM and which should respect +`print-length' and `print-level'. LIMIT may be nil or zero in +which case PRINT-FUNCTION will be called with `print-level' and +`print-length' bound to nil. + +Use this function with `cl-prin1' to print an object, +abbreviating it with ellipses to fit within a size limit. Use +this function with `cl-prin1-expand-ellipsis' to expand an +ellipsis, abbreviating the expansion to stay within a size +limit. + +\(fn PRINT-FUNCTION VALUE LIMIT)" nil nil) + (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cl-print" '("cl-print-" "help-byte-code"))) ;;;*** @@ -11725,7 +11766,9 @@ This does nothing except loading eudc by autoload side-effect. \(fn)" t nil) -(cond ((not (featurep 'xemacs)) (defvar eudc-tools-menu (let ((map (make-sparse-keymap "Directory Servers"))) (define-key map [phone] `(menu-item ,(purecopy "Get Phone") eudc-get-phone :help ,(purecopy "Get the phone field of name from the directory server"))) (define-key map [email] `(menu-item ,(purecopy "Get Email") eudc-get-email :help ,(purecopy "Get the email field of NAME from the directory server"))) (define-key map [separator-eudc-email] menu-bar-separator) (define-key map [expand-inline] `(menu-item ,(purecopy "Expand Inline Query") eudc-expand-inline :help ,(purecopy "Query the directory server, and expand the query string before point"))) (define-key map [query] `(menu-item ,(purecopy "Query with Form") eudc-query-form :help ,(purecopy "Display a form to query the directory server"))) (define-key map [separator-eudc-query] menu-bar-separator) (define-key map [new] `(menu-item ,(purecopy "New Server") eudc-set-server :help ,(purecopy "Set the directory server to SERVER using PROTOCOL"))) (define-key map [load] `(menu-item ,(purecopy "Load Hotlist of Servers") eudc-load-eudc :help ,(purecopy "Load the Emacs Unified Directory Client"))) map)) (fset 'eudc-tools-menu (symbol-value 'eudc-tools-menu))) (t (let ((menu '("Directory Servers" ["Load Hotlist of Servers" eudc-load-eudc t] ["New Server" eudc-set-server t] ["---" nil nil] ["Query with Form" eudc-query-form t] ["Expand Inline Query" eudc-expand-inline t] ["---" nil nil] ["Get Email" eudc-get-email t] ["Get Phone" eudc-get-phone t]))) (if (not (featurep 'eudc-autoloads)) (if (featurep 'xemacs) (if (and (featurep 'menubar) (not (featurep 'infodock))) (add-submenu '("Tools") menu)) (require 'easymenu) (cond ((fboundp 'easy-menu-add-item) (easy-menu-add-item nil '("tools") (easy-menu-create-menu (car menu) (cdr menu)))) ((fboundp 'easy-menu-create-keymaps) (define-key global-map [menu-bar tools eudc] (cons "Directory Servers" (easy-menu-create-keymaps "Directory Servers" (cdr menu))))))))))) +(defvar eudc-tools-menu (let ((map (make-sparse-keymap "Directory Servers"))) (define-key map [phone] `(menu-item ,(purecopy "Get Phone") eudc-get-phone :help ,(purecopy "Get the phone field of name from the directory server"))) (define-key map [email] `(menu-item ,(purecopy "Get Email") eudc-get-email :help ,(purecopy "Get the email field of NAME from the directory server"))) (define-key map [separator-eudc-email] menu-bar-separator) (define-key map [expand-inline] `(menu-item ,(purecopy "Expand Inline Query") eudc-expand-inline :help ,(purecopy "Query the directory server, and expand the query string before point"))) (define-key map [query] `(menu-item ,(purecopy "Query with Form") eudc-query-form :help ,(purecopy "Display a form to query the directory server"))) (define-key map [separator-eudc-query] menu-bar-separator) (define-key map [new] `(menu-item ,(purecopy "New Server") eudc-set-server :help ,(purecopy "Set the directory server to SERVER using PROTOCOL"))) (define-key map [load] `(menu-item ,(purecopy "Load Hotlist of Servers") eudc-load-eudc :help ,(purecopy "Load the Emacs Unified Directory Client"))) map)) + +(fset 'eudc-tools-menu (symbol-value 'eudc-tools-menu)) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eudc" '("eudc-"))) @@ -16192,13 +16235,15 @@ highlighting will not update as you type. (autoload 'hi-lock-face-buffer "hi-lock" "\ Set face of each match of REGEXP to FACE. Interactively, prompt for REGEXP using `read-regexp', then FACE. -Use the global history list for FACE. +Use the global history list for FACE. Limit face setting to the +corresponding SUBEXP (interactively, the prefix argument) of REGEXP. +If SUBEXP is omitted or nil, the entire REGEXP is highlighted. Use Font lock mode, if enabled, to highlight REGEXP. Otherwise, use overlays for highlighting. If overlays are used, the highlighting will not update as you type. -\(fn REGEXP &optional FACE)" t nil) +\(fn REGEXP &optional FACE SUBEXP)" t nil) (defalias 'highlight-phrase 'hi-lock-face-phrase-buffer) @@ -19201,7 +19246,7 @@ locally, like so: ;;;### (autoloads nil "jsonrpc" "jsonrpc.el" (0 0 0 0)) ;;; Generated autoloads from jsonrpc.el -(push (purecopy '(jsonrpc 1 0 0)) package--builtin-versions) +(push (purecopy '(jsonrpc 1 0 6)) package--builtin-versions) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "jsonrpc" '("jrpc-default-request-timeout" "jsonrpc-"))) @@ -33694,7 +33739,7 @@ Compose Thai characters in the current buffer. Move forward to the end of the Nth next THING. THING should be a symbol specifying a type of syntactic entity. Possibilities include `symbol', `list', `sexp', `defun', -`filename', `url', `email', `word', `sentence', `whitespace', +`filename', `url', `email', `uuid', `word', `sentence', `whitespace', `line', and `page'. \(fn THING &optional N)" nil nil) @@ -33703,7 +33748,7 @@ Possibilities include `symbol', `list', `sexp', `defun', Determine the start and end buffer locations for the THING at point. THING should be a symbol specifying a type of syntactic entity. Possibilities include `symbol', `list', `sexp', `defun', -`filename', `url', `email', `word', `sentence', `whitespace', +`filename', `url', `email', `uuid', `word', `sentence', `whitespace', `line', and `page'. See the file `thingatpt.el' for documentation on how to define a @@ -33718,7 +33763,7 @@ positions of the thing found. Return the THING at point. THING should be a symbol specifying a type of syntactic entity. Possibilities include `symbol', `list', `sexp', `defun', -`filename', `url', `email', `word', `sentence', `whitespace', +`filename', `url', `email', `uuid', `word', `sentence', `whitespace', `line', `number', and `page'. When the optional argument NO-PROPERTIES is non-nil, @@ -33753,6 +33798,18 @@ Return the Lisp list at point, or nil if none is found. ;;;*** +;;;### (autoloads nil "thread" "emacs-lisp/thread.el" (0 0 0 0)) +;;; Generated autoloads from emacs-lisp/thread.el + +(autoload 'thread-handle-event "thread" "\ +Handle thread events, propagated by `thread-signal'. +An EVENT has the format + (thread-event THREAD ERROR-SYMBOL DATA) + +\(fn EVENT)" t nil) + +;;;*** + ;;;### (autoloads nil "thumbs" "thumbs.el" (0 0 0 0)) ;;; Generated autoloads from thumbs.el @@ -34100,8 +34157,6 @@ The \"%z\" specifier does not print anything. When it is used, specifiers must be given in order of decreasing size. To the left of \"%z\", nothing is output until the first non-zero unit is encountered. -This function does not work for SECONDS greater than `most-positive-fixnum'. - \(fn STRING SECONDS)" nil nil) (autoload 'seconds-to-string "time-date" "\ @@ -34569,6 +34624,7 @@ the output buffer or changing the window configuration. ;;;### (autoloads nil "tramp" "net/tramp.el" (0 0 0 0)) ;;; Generated autoloads from net/tramp.el +(push (purecopy '(tramp 2 4 1 -1)) package--builtin-versions) (defvar tramp-mode t "\ Whether Tramp is enabled. @@ -34719,7 +34775,6 @@ Reenable Ange-FTP, when Tramp is unloaded. ;;;### (autoloads nil "trampver" "net/trampver.el" (0 0 0 0)) ;;; Generated autoloads from net/trampver.el -(push (purecopy '(tramp 2 4 0)) package--builtin-versions) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "trampver" '("tramp-"))) @@ -38647,7 +38702,11 @@ Like `xref-find-definitions' but switch to the other frame. (autoload 'xref-find-references "xref" "\ Find references to the identifier at point. -With prefix argument, prompt for the identifier. +This command might prompt for the identifier as needed, perhaps +offering the symbol at point as the default. +With prefix argument, or if `xref-prompt-for-identifier' is t, +always prompt for the identifier. If `xref-prompt-for-identifier' +is nil, prompt only if there's no usable symbol at point. \(fn IDENTIFIER)" t nil) commit a6577d4bc4175298ee99fae266b31e3566565ffb Author: Charles A. Roelli Date: Sat Sep 1 13:00:28 2018 +0200 * src/process.c (send_process): Fix typo in commentary. diff --git a/src/process.c b/src/process.c index ff81485d26..9d03eb9774 100644 --- a/src/process.c +++ b/src/process.c @@ -6410,7 +6410,7 @@ send_process (Lisp_Object proc, const char *buf, ptrdiff_t len, } #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */ - /* Put what we should have written in wait_queue. */ + /* Put what we should have written in write_queue. */ write_queue_push (p, cur_object, cur_buf, cur_len, 1); wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0); commit f9efbb599f9f8b3dc4ef8603cdfcd0c3b4a23a29 Author: Glenn Morris Date: Sat Sep 1 06:23:14 2018 -0400 ; Auto-commit of loaddefs files. diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 93b321a5dc..2ff94d333b 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -38505,7 +38505,11 @@ Like `xref-find-definitions' but switch to the other frame. (autoload 'xref-find-references "xref" "\ Find references to the identifier at point. -With prefix argument, prompt for the identifier. +This command might prompt for the identifier as needed, perhaps +offering the symbol at point as the default. +With prefix argument, or if `xref-prompt-for-identifier' is t, +always prompt for the identifier. If `xref-prompt-for-identifier' +is nil, prompt only if there's no usable symbol at point. \(fn IDENTIFIER)" t nil) commit 222b5970c42c2b85df67042c0c5db198859b478a Author: Paul Eggert Date: Fri Aug 31 09:13:31 2018 -0700 Rename Emacs-specific INFINITY constants Although these constants were not erroneous, as they were used only in modules that did not include , it's less confusing to names that cannot be confused with the now-standard INFINITY macro. * src/dispextern.h (SCROLL_INFINITY): New constant. * src/dispnew.c, src/scroll.c (INFINITY): Remove. All uses replaced with SCROLL_INFINITY. * src/process.c (wait_reading_process_output): Rename private constant. diff --git a/src/dispextern.h b/src/dispextern.h index 9cc65f6a3d..579665c2ff 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -3569,6 +3569,10 @@ extern void create_tty_output (struct frame *); extern struct terminal *init_tty (const char *, const char *, bool); extern void tty_append_glyph (struct it *); +/* All scrolling costs measured in characters. + So no cost can exceed the area of a frame, measured in characters. + Let's hope this is never more than 1000000 characters. */ +enum { SCROLL_INFINITY = 1000000 }; /* Defined in scroll.c */ diff --git a/src/dispnew.c b/src/dispnew.c index 61ca717079..bd246799b2 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -4677,8 +4677,7 @@ scrolling (struct frame *frame) { /* This line cannot be redrawn, so don't let scrolling mess it. */ new_hash[i] = old_hash[i]; -#define INFINITY 1000000 /* Taken from scroll.c */ - draw_cost[i] = INFINITY; + draw_cost[i] = SCROLL_INFINITY; } else { diff --git a/src/process.c b/src/process.c index 29cedd7ad6..ff81485d26 100644 --- a/src/process.c +++ b/src/process.c @@ -5009,7 +5009,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, Lisp_Object proc; struct timespec timeout, end_time, timer_delay; struct timespec got_output_end_time = invalid_timespec (); - enum { MINIMUM = -1, TIMEOUT, INFINITY } wait; + enum { MINIMUM = -1, TIMEOUT, FOREVER } wait; int got_some_output = -1; uintmax_t prev_wait_proc_nbytes_read = wait_proc ? wait_proc->nbytes_read : 0; #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS @@ -5048,7 +5048,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, end_time = timespec_add (now, make_timespec (time_limit, nsecs)); } else - wait = INFINITY; + wait = FOREVER; while (1) { @@ -7515,7 +7515,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, { register int nfds; struct timespec end_time, timeout; - enum { MINIMUM = -1, TIMEOUT, INFINITY } wait; + enum { MINIMUM = -1, TIMEOUT, FOREVER } wait; if (TYPE_MAXIMUM (time_t) < time_limit) time_limit = TYPE_MAXIMUM (time_t); @@ -7529,7 +7529,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, make_timespec (time_limit, nsecs)); } else - wait = INFINITY; + wait = FOREVER; /* Turn off periodic alarms (in case they are in use) and then turn off any other atimers, @@ -7635,7 +7635,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, /* If we woke up due to SIGWINCH, actually change size now. */ do_pending_window_change (0); - if (wait < INFINITY && nfds == 0 && ! timeout_reduced_for_timers) + if (wait < FOREVER && nfds == 0 && ! timeout_reduced_for_timers) /* We waited the full specified time, so return now. */ break; diff --git a/src/scroll.c b/src/scroll.c index 8a53f9614f..a29f2d37f5 100644 --- a/src/scroll.c +++ b/src/scroll.c @@ -28,12 +28,6 @@ along with GNU Emacs. If not, see . */ #include "frame.h" #include "termhooks.h" -/* All costs measured in characters. - So no cost can exceed the area of a frame, measured in characters. - Let's hope this is never more than 1000000 characters. */ - -#define INFINITY 1000000 - struct matrix_elt { /* Cost of outputting through this line @@ -120,8 +114,8 @@ calculate_scrolling (struct frame *frame, /* initialize the top left corner of the matrix */ matrix->writecost = 0; - matrix->insertcost = INFINITY; - matrix->deletecost = INFINITY; + matrix->insertcost = SCROLL_INFINITY; + matrix->deletecost = SCROLL_INFINITY; matrix->insertcount = 0; matrix->deletecount = 0; @@ -132,8 +126,8 @@ calculate_scrolling (struct frame *frame, p = matrix + i * (window_size + 1); cost += draw_cost[i] + next_insert_cost[i] + extra_cost; p->insertcost = cost; - p->writecost = INFINITY; - p->deletecost = INFINITY; + p->writecost = SCROLL_INFINITY; + p->deletecost = SCROLL_INFINITY; p->insertcount = i; p->deletecount = 0; } @@ -144,8 +138,8 @@ calculate_scrolling (struct frame *frame, { cost += next_delete_cost[j]; matrix[j].deletecost = cost; - matrix[j].writecost = INFINITY; - matrix[j].insertcost = INFINITY; + matrix[j].writecost = SCROLL_INFINITY; + matrix[j].insertcost = SCROLL_INFINITY; matrix[j].deletecount = j; matrix[j].insertcount = 0; } @@ -465,8 +459,8 @@ calculate_direct_scrolling (struct frame *frame, /* initialize the top left corner of the matrix */ matrix->writecost = 0; - matrix->insertcost = INFINITY; - matrix->deletecost = INFINITY; + matrix->insertcost = SCROLL_INFINITY; + matrix->deletecost = SCROLL_INFINITY; matrix->writecount = 0; matrix->insertcount = 0; matrix->deletecount = 0; @@ -478,8 +472,8 @@ calculate_direct_scrolling (struct frame *frame, p = matrix + i * (window_size + 1); cost += draw_cost[i]; p->insertcost = cost; - p->writecost = INFINITY; - p->deletecost = INFINITY; + p->writecost = SCROLL_INFINITY; + p->deletecost = SCROLL_INFINITY; p->insertcount = i; p->writecount = 0; p->deletecount = 0; @@ -489,8 +483,8 @@ calculate_direct_scrolling (struct frame *frame, for (j = 1; j <= window_size; j++) { matrix[j].deletecost = 0; - matrix[j].writecost = INFINITY; - matrix[j].insertcost = INFINITY; + matrix[j].writecost = SCROLL_INFINITY; + matrix[j].insertcost = SCROLL_INFINITY; matrix[j].deletecount = j; matrix[j].writecount = 0; matrix[j].insertcount = 0; commit ab871981125393d89202932284eda6e507bfc6fd Author: Paul Eggert Date: Fri Aug 31 08:50:45 2018 -0700 Port better to non-IEEE platforms * src/lread.c (string_to_number) [!IEEE_FLOATING_POINT]: Do not use the INFINITY macro, since the C standard requires it to provoke a compile-time error on platforms that do not support infinities. diff --git a/src/lread.c b/src/lread.c index a7c5b0bb69..e43929a8c6 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3762,6 +3762,7 @@ string_to_number (char const *string, int base, int flags) cp++; while ('0' <= *cp && *cp <= '9'); } +#if IEEE_FLOATING_POINT else if (cp[-1] == '+' && cp[0] == 'I' && cp[1] == 'N' && cp[2] == 'F') { @@ -3769,7 +3770,6 @@ string_to_number (char const *string, int base, int flags) cp += 3; value = INFINITY; } -#if IEEE_FLOATING_POINT else if (cp[-1] == '+' && cp[0] == 'N' && cp[1] == 'a' && cp[2] == 'N') { commit ee2509bd828070ae5d17fcc766f81715050ba673 Author: Michael Albinus Date: Fri Aug 31 11:45:37 2018 +0200 Mark thread-alive-p as obsolete * etc/NEWS (thread-alive-p): * lisp/emacs-lisp/thread.el (thread-alive-p): Mark it as obsolete. * test/src/thread-tests.el (threads-join-error) (threads-signal-main-thread): Use `thread-live-p'. diff --git a/etc/NEWS b/etc/NEWS index d536faaa2d..1fe662ffff 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -730,6 +730,9 @@ to signal the main thread, e.g., when they encounter an error. *** 'thread-signal' does not propagate errors to the main thread. Instead, error messages are just printed in the main thread. +--- +*** 'thread-alive-p' is now obsolete, use 'thread-live-p' instead. + --- ** thingatpt.el supports a new "thing" called 'uuid'. A symbol 'uuid' can be passed to thing-at-point and it returns the diff --git a/lisp/emacs-lisp/thread.el b/lisp/emacs-lisp/thread.el index 02cf9b9e53..5d7b90c26e 100644 --- a/lisp/emacs-lisp/thread.el +++ b/lisp/emacs-lisp/thread.el @@ -38,5 +38,7 @@ An EVENT has the format (err (cddr event))) (message "Error %s: %S" thread err)))) +(make-obsolete 'thread-alive-p 'thread-live-p "27.1") + (provide 'thread) ;;; thread.el ends here diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el index a87eb3e159..109e71128a 100644 --- a/test/src/thread-tests.el +++ b/test/src/thread-tests.el @@ -116,7 +116,7 @@ :tags '(:unstable) (skip-unless (featurep 'threads)) (let ((thread (make-thread #'threads-call-error))) - (while (thread-alive-p thread) + (while (thread-live-p thread) (thread-yield)) (should-error (thread-join thread)))) @@ -332,7 +332,7 @@ (erase-buffer)) (let ((thread (make-thread #'(lambda () (thread-signal main-thread 'error nil))))) - (while (thread-alive-p thread) + (while (thread-live-p thread) (thread-yield)) (read-event nil nil 0.1) ;; No error has been raised, which is part of the test. commit 6f3cf12e4fb6c810ebf37c8819dc2ee39b02199e Merge: db2fed3bdf ac7936cb8f Author: Michael Albinus Date: Fri Aug 31 11:15:48 2018 +0200 Merge from origin/emacs-26 ac7936cb8f Rename thread-alive-p to thread-live-p 3d09d533d1 rcirc: Document /reconnect as a built-in command (Bug#29656) a1e615618d * test/lisp/calc/calc-tests.el (calc-imaginary-i): New test. commit ac7936cb8f4d4d6706535bfcea0d97741c2ca15f Author: Michael Albinus Date: Fri Aug 31 10:47:03 2018 +0200 Rename thread-alive-p to thread-live-p * doc/lispref/threads.texi (Basic Thread Functions): Use thread-live-p. * etc/NEWS: 'thread-alive-p' has been renamed to 'thread-live-p'. * src/thread.c (thread_live_p): Rename from thread_alive_p. Adapt all callees. (Fthread_live_p): Rename from Fthread_alive_p. (syms_of_threads): Make thread-alive-p an alias of thread-live-p. * test/src/thread-tests.el (all): Replace `thread-alive-p' by `thread-live-p'. (threads-live): Rename from `threads-alive'. diff --git a/doc/lispref/threads.texi b/doc/lispref/threads.texi index f05af49618..ddeb2e923f 100644 --- a/doc/lispref/threads.texi +++ b/doc/lispref/threads.texi @@ -97,7 +97,7 @@ Yield execution to the next runnable thread. Return the name of @var{thread}, as specified to @code{make-thread}. @end defun -@defun thread-alive-p thread +@defun thread-live-p thread Return @code{t} if @var{thread} is alive, or @code{nil} if it is not. A thread is alive as long as its function is still executing. @end defun diff --git a/etc/NEWS b/etc/NEWS index ffea247dd5..f575d4dd00 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -112,6 +112,11 @@ option 'vc-hg-symbolic-revision-styles' to the value '("{rev}")'. Existing files "~/.emacs.d/shadows" and "~/.emacs.d/shadow_todo" must be removed prior using the changed 'shadow-*' commands. ++++ +** 'thread-alive-p' has been renamed to 'thread-live-p'. +The old name is an alias of the new name. Future Emacs version will +obsolete it. + * Lisp Changes in Emacs 26.2 diff --git a/src/thread.c b/src/thread.c index 04c2808e5c..9b450ee0a4 100644 --- a/src/thread.c +++ b/src/thread.c @@ -41,7 +41,7 @@ extern volatile int interrupt_input_blocked; /* m_specpdl is set when the thread is created and cleared when the thread dies. */ -#define thread_alive_p(STATE) ((STATE)->m_specpdl != NULL) +#define thread_live_p(STATE) ((STATE)->m_specpdl != NULL) @@ -884,7 +884,7 @@ or `thread-join' in the target thread. */) return Qnil; } -DEFUN ("thread-alive-p", Fthread_alive_p, Sthread_alive_p, 1, 1, 0, +DEFUN ("thread-live-p", Fthread_live_p, Sthread_live_p, 1, 1, 0, doc: /* Return t if THREAD is alive, or nil if it has exited. */) (Lisp_Object thread) { @@ -893,7 +893,7 @@ DEFUN ("thread-alive-p", Fthread_alive_p, Sthread_alive_p, 1, 1, 0, CHECK_THREAD (thread); tstate = XTHREAD (thread); - return thread_alive_p (tstate) ? Qt : Qnil; + return thread_live_p (tstate) ? Qt : Qnil; } DEFUN ("thread--blocker", Fthread_blocker, Sthread_blocker, 1, 1, 0, @@ -923,7 +923,7 @@ thread_join_callback (void *arg) XSETTHREAD (thread, tstate); self->event_object = thread; self->wait_condvar = &tstate->thread_condvar; - while (thread_alive_p (tstate) && NILP (self->error_symbol)) + while (thread_live_p (tstate) && NILP (self->error_symbol)) sys_cond_wait (self->wait_condvar, &global_lock); self->wait_condvar = NULL; @@ -946,7 +946,7 @@ It is an error for a thread to try to join itself. */) if (tstate == current_thread) error ("Cannot join current thread"); - if (thread_alive_p (tstate)) + if (thread_live_p (tstate)) flush_stack_call_func (thread_join_callback, tstate); return Qnil; @@ -961,7 +961,7 @@ DEFUN ("all-threads", Fall_threads, Sall_threads, 0, 0, 0, for (iter = all_threads; iter; iter = iter->next_thread) { - if (thread_alive_p (iter)) + if (thread_live_p (iter)) { Lisp_Object thread; @@ -1051,7 +1051,7 @@ syms_of_threads (void) defsubr (&Scurrent_thread); defsubr (&Sthread_name); defsubr (&Sthread_signal); - defsubr (&Sthread_alive_p); + defsubr (&Sthread_live_p); defsubr (&Sthread_join); defsubr (&Sthread_blocker); defsubr (&Sall_threads); @@ -1069,6 +1069,9 @@ syms_of_threads (void) staticpro (&last_thread_error); last_thread_error = Qnil; + Fdefalias (intern_c_string ("thread-alive-p"), + intern_c_string ("thread-live-p"), Qnil); + Fprovide (intern_c_string ("threads"), Qnil); } diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el index a00a9c84bd..e721e0f962 100644 --- a/test/src/thread-tests.el +++ b/test/src/thread-tests.el @@ -32,7 +32,7 @@ (declare-function mutex-lock "thread.c" (mutex)) (declare-function mutex-unlock "thread.c" (mutex)) (declare-function thread--blocker "thread.c" (thread)) -(declare-function thread-alive-p "thread.c" (thread)) +(declare-function thread-live-p "thread.c" (thread)) (declare-function thread-join "thread.c" (thread)) (declare-function thread-last-error "thread.c" ()) (declare-function thread-name "thread.c" (thread)) @@ -60,11 +60,11 @@ (should (string= "hi bob" (thread-name (make-thread #'ignore "hi bob"))))) -(ert-deftest threads-alive () +(ert-deftest threads-live () "Test for thread liveness." (skip-unless (featurep 'threads)) (should - (thread-alive-p (make-thread #'ignore)))) + (thread-live-p (make-thread #'ignore)))) (ert-deftest threads-all-threads () "Simple test for all-threads." @@ -96,7 +96,7 @@ (let ((thread (make-thread #'threads-test-thread1))) (thread-join thread) (and threads-test-global - (not (thread-alive-p thread))))))) + (not (thread-live-p thread))))))) (ert-deftest threads-join-self () "Cannot `thread-join' the current thread." @@ -271,7 +271,7 @@ (let (th1 th2) (setq th1 (make-thread #'threads-call-error "call-error")) (should (threadp th1)) - (while (thread-alive-p th1) + (while (thread-live-p th1) (thread-yield)) (should (equal (thread-last-error) '(error "Error is called"))) @@ -297,7 +297,7 @@ (while t (thread-yield)))))) (thread-signal thread 'error nil) (sit-for 1) - (should-not (thread-alive-p thread)) + (should-not (thread-live-p thread)) (should (equal (thread-last-error) '(error))))) (defvar threads-condvar nil) @@ -323,7 +323,7 @@ (setq new-thread (make-thread #'threads-test-condvar-wait)) ;; Make sure new-thread is alive. - (should (thread-alive-p new-thread)) + (should (thread-live-p new-thread)) (should (= (length (all-threads)) 2)) ;; Wait for new-thread to become blocked on the condvar. (while (not (eq (thread--blocker new-thread) threads-condvar)) @@ -336,7 +336,7 @@ (sleep-for 0.1) ;; Make sure the thread is still there. This used to fail due to ;; a bug in thread.c:condition_wait_callback. - (should (thread-alive-p new-thread)) + (should (thread-live-p new-thread)) (should (= (length (all-threads)) 2)) (should (eq (thread--blocker new-thread) threads-condvar)) commit db2fed3bdfb351c3283e481829ce687931d27a3d Author: Paul Eggert Date: Fri Aug 31 00:25:07 2018 -0700 Several fixes for formatting bignums * src/bignum.c: Include stdlib.h, for abs. (bignum_bufsize, bignum_to_c_string): New functions. * src/bignum.c (bignum_to_string): * src/print.c (print_vectorlike): Use them. * src/editfns.c (styled_format): Instead of having a separate buffer for sprintf (which does not work for bignums), just append to the main buffer. When formatting bignums, add support for the standard integer flags -, #, 0, + and space. Fix some comments. Capitalize properly when formatting bignums with %X. Use functions like c_isdigit rather than reinventing the wheel. Simplify computation of excess precision. * src/print.c: Do not include bignum.h; no longer needed. (print_vectorlike): Avoid recalculating string length. * test/src/editfns-tests.el (format-bignum): Test some of the above fixes. diff --git a/src/bignum.c b/src/bignum.c index 5dbfdb9319..b18ceccb59 100644 --- a/src/bignum.c +++ b/src/bignum.c @@ -23,6 +23,8 @@ along with GNU Emacs. If not, see . */ #include "lisp.h" +#include + /* Return the value of the Lisp bignum N, as a double. */ double bignum_to_double (Lisp_Object n) @@ -223,18 +225,39 @@ bignum_to_uintmax (Lisp_Object x) return v; } -/* Convert NUM to a base-BASE Lisp string. */ +/* Yield an upper bound on the buffer size needed to contain a C + string representing the bignum NUM in base BASE. This includes any + preceding '-' and the terminating null. */ +ptrdiff_t +bignum_bufsize (Lisp_Object num, int base) +{ + return mpz_sizeinbase (XBIGNUM (num)->value, base) + 2; +} + +/* Store into BUF (of size SIZE) the value of NUM as a base-BASE string. + If BASE is negative, use upper-case digits in base -BASE. + Return the string's length. + SIZE must equal bignum_bufsize (NUM, abs (BASE)). */ +ptrdiff_t +bignum_to_c_string (char *buf, ptrdiff_t size, Lisp_Object num, int base) +{ + eassert (bignum_bufsize (num, abs (base)) == size); + mpz_get_str (buf, base, XBIGNUM (num)->value); + ptrdiff_t n = size - 2; + return !buf[n - 1] ? n - 1 : n + !!buf[n]; +} + +/* Convert NUM to a base-BASE Lisp string. + If BASE is negative, use upper-case digits in base -BASE. */ Lisp_Object bignum_to_string (Lisp_Object num, int base) { - ptrdiff_t n = mpz_sizeinbase (XBIGNUM (num)->value, base) - 1; + ptrdiff_t size = bignum_bufsize (num, abs (base)); USE_SAFE_ALLOCA; - char *str = SAFE_ALLOCA (n + 3); - mpz_get_str (str, base, XBIGNUM (num)->value); - while (str[n]) - n++; - Lisp_Object result = make_unibyte_string (str, n); + char *str = SAFE_ALLOCA (size); + ptrdiff_t len = bignum_to_c_string (str, size, num, base); + Lisp_Object result = make_unibyte_string (str, len); SAFE_FREE (); return result; } diff --git a/src/editfns.c b/src/editfns.c index b4c597feda..3b1c21a178 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -4232,8 +4232,26 @@ usage: (format-message STRING &rest OBJECTS) */) static Lisp_Object styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) { + enum + { + /* Maximum precision for a %f conversion such that the trailing + output digit might be nonzero. Any precision larger than this + will not yield useful information. */ + USEFUL_PRECISION_MAX = ((1 - LDBL_MIN_EXP) + * (FLT_RADIX == 2 || FLT_RADIX == 10 ? 1 + : FLT_RADIX == 16 ? 4 + : -1)), + + /* Maximum number of bytes (including terminating null) generated + by any format, if precision is no more than USEFUL_PRECISION_MAX. + On all practical hosts, %Lf is the worst case. */ + SPRINTF_BUFSIZE = (sizeof "-." + (LDBL_MAX_10_EXP + 1) + + USEFUL_PRECISION_MAX) + }; + verify (USEFUL_PRECISION_MAX > 0); + ptrdiff_t n; /* The number of the next arg to substitute. */ - char initial_buffer[4000]; + char initial_buffer[1000 + SPRINTF_BUFSIZE]; char *buf = initial_buffer; ptrdiff_t bufsize = sizeof initial_buffer; ptrdiff_t max_bufsize = STRING_BYTES_BOUND + 1; @@ -4338,8 +4356,14 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) char const *convsrc = format; unsigned char format_char = *format++; - /* Bytes needed to represent the output of this conversion. */ + /* Number of bytes to be preallocated for the next directive's + output. At the end of each iteration this is at least + CONVBYTES_ROOM, and is greater if the current directive + output was so large that it will be retried after buffer + reallocation. */ ptrdiff_t convbytes = 1; + enum { CONVBYTES_ROOM = SPRINTF_BUFSIZE - 1 }; + eassert (p <= buf + bufsize - SPRINTF_BUFSIZE); if (format_char == '%') { @@ -4473,23 +4497,6 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) conversion = 's'; zero_flag = false; } - else if ((conversion == 'd' || conversion == 'i' - || conversion == 'o' || conversion == 'x' - || conversion == 'X') - && BIGNUMP (arg)) - { - int base = 10; - - if (conversion == 'o') - base = 8; - else if (conversion == 'x') - base = 16; - else if (conversion == 'X') - base = -16; - - arg = bignum_to_string (arg, base); - conversion = 's'; - } if (SYMBOLP (arg)) { @@ -4592,7 +4599,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) spec->intervals = arg_intervals = true; new_result = true; - continue; + convbytes = CONVBYTES_ROOM; } } else if (! (conversion == 'c' || conversion == 'd' @@ -4606,28 +4613,8 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) error ("Format specifier doesn't match argument type"); else { - enum - { - /* Maximum precision for a %f conversion such that the - trailing output digit might be nonzero. Any precision - larger than this will not yield useful information. */ - USEFUL_PRECISION_MAX = - ((1 - LDBL_MIN_EXP) - * (FLT_RADIX == 2 || FLT_RADIX == 10 ? 1 - : FLT_RADIX == 16 ? 4 - : -1)), - - /* Maximum number of bytes generated by any format, if - precision is no more than USEFUL_PRECISION_MAX. - On all practical hosts, %f is the worst case. */ - SPRINTF_BUFSIZE = - sizeof "-." + (LDBL_MAX_10_EXP + 1) + USEFUL_PRECISION_MAX, - - /* Length of pM (that is, of pMd without the - trailing "d"). */ - pMlen = sizeof pMd - 2 - }; - verify (USEFUL_PRECISION_MAX > 0); + /* Length of pM (that is, of pMd without the trailing "d"). */ + enum { pMlen = sizeof pMd - 2 }; /* Avoid undefined behavior in underlying sprintf. */ if (conversion == 'd' || conversion == 'i') @@ -4660,18 +4647,24 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) if (precision_given) prec = min (precision, USEFUL_PRECISION_MAX); - /* Use sprintf to format this number into sprintf_buf. Omit + /* Characters to be inserted after spaces and before + leading zeros. This can occur with bignums, since + string_to_bignum does only leading '-'. */ + char prefix[sizeof "-0x" - 1]; + int prefixlen = 0; + + /* Use sprintf or bignum_to_string to format this number. Omit padding and excess precision, though, because sprintf limits - output length to INT_MAX. + output length to INT_MAX and bignum_to_string doesn't + do padding or precision. - There are four types of conversion: double, unsigned + Use five sprintf conversions: double, long double, unsigned char (passed as int), wide signed int, and wide unsigned int. Treat them separately because the sprintf ABI is sensitive to which type is passed. Be careful about integer overflow, NaNs, infinities, and conversions; for example, the min and max macros are not suitable here. */ - char sprintf_buf[SPRINTF_BUFSIZE]; ptrdiff_t sprintf_bytes; if (float_conversion) { @@ -4729,26 +4722,43 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) f[-1] = 'L'; *f++ = conversion; *f = '\0'; - sprintf_bytes = sprintf (sprintf_buf, convspec, prec, - ldarg); + sprintf_bytes = sprintf (p, convspec, prec, ldarg); } else - sprintf_bytes = sprintf (sprintf_buf, convspec, prec, - darg); + sprintf_bytes = sprintf (p, convspec, prec, darg); } else if (conversion == 'c') { /* Don't use sprintf here, as it might mishandle prec. */ - sprintf_buf[0] = XFIXNUM (arg); + p[0] = XFIXNUM (arg); + p[1] = '\0'; sprintf_bytes = prec != 0; - sprintf_buf[sprintf_bytes] = '\0'; + } + else if (BIGNUMP (arg)) + { + int base = ((conversion == 'd' || conversion == 'i') ? 10 + : conversion == 'o' ? 8 : 16); + sprintf_bytes = bignum_bufsize (arg, base); + if (sprintf_bytes <= buf + bufsize - p) + { + int signedbase = conversion == 'X' ? -base : base; + sprintf_bytes = bignum_to_c_string (p, sprintf_bytes, + arg, signedbase); + bool negative = p[0] == '-'; + prec = min (precision, sprintf_bytes - prefixlen); + prefix[prefixlen] = plus_flag ? '+' : ' '; + prefixlen += (plus_flag | space_flag) & !negative; + prefix[prefixlen] = '0'; + prefix[prefixlen + 1] = conversion; + prefixlen += sharp_flag && base == 16 ? 2 : 0; + } } else if (conversion == 'd' || conversion == 'i') { if (FIXNUMP (arg)) { printmax_t x = XFIXNUM (arg); - sprintf_bytes = sprintf (sprintf_buf, convspec, prec, x); + sprintf_bytes = sprintf (p, convspec, prec, x); } else { @@ -4760,9 +4770,8 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) x = trunc (x); x = x ? x : 0; - sprintf_bytes = sprintf (sprintf_buf, convspec, 0, x); - char c0 = sprintf_buf[0]; - bool signedp = ! ('0' <= c0 && c0 <= '9'); + sprintf_bytes = sprintf (p, convspec, 0, x); + bool signedp = ! c_isdigit (p[0]); prec = min (precision, sprintf_bytes - signedp); } } @@ -4793,10 +4802,9 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) x = d; negative = false; } - sprintf_buf[0] = negative ? '-' : plus_flag ? '+' : ' '; + p[0] = negative ? '-' : plus_flag ? '+' : ' '; bool signedp = negative | plus_flag | space_flag; - sprintf_bytes = sprintf (sprintf_buf + signedp, - convspec, prec, x); + sprintf_bytes = sprintf (p + signedp, convspec, prec, x); sprintf_bytes += signedp; } @@ -4804,112 +4812,126 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) padding and excess precision. Deal with excess precision first. This happens when the format specifies ridiculously large precision, or when %d or %i formats a float that would - ordinarily need fewer digits than a specified precision. */ + ordinarily need fewer digits than a specified precision, + or when a bignum is formatted using an integer format + with enough precision. */ ptrdiff_t excess_precision = precision_given ? precision - prec : 0; - ptrdiff_t leading_zeros = 0, trailing_zeros = 0; - if (excess_precision) + ptrdiff_t trailing_zeros = 0; + if (excess_precision != 0 && float_conversion) { - if (float_conversion) - { - if ((conversion == 'g' && ! sharp_flag) - || ! ('0' <= sprintf_buf[sprintf_bytes - 1] - && sprintf_buf[sprintf_bytes - 1] <= '9')) - excess_precision = 0; - else - { - if (conversion == 'g') - { - char *dot = strchr (sprintf_buf, '.'); - if (!dot) - excess_precision = 0; - } - } - trailing_zeros = excess_precision; - } - else - leading_zeros = excess_precision; + if (! c_isdigit (p[sprintf_bytes - 1]) + || (conversion == 'g' + && ! (sharp_flag && strchr (p, '.')))) + excess_precision = 0; + trailing_zeros = excess_precision; } + ptrdiff_t leading_zeros = excess_precision - trailing_zeros; /* Compute the total bytes needed for this item, including excess precision and padding. */ ptrdiff_t numwidth; - if (INT_ADD_WRAPV (sprintf_bytes, excess_precision, &numwidth)) + if (INT_ADD_WRAPV (prefixlen + sprintf_bytes, excess_precision, + &numwidth)) numwidth = PTRDIFF_MAX; ptrdiff_t padding = numwidth < field_width ? field_width - numwidth : 0; - if (max_bufsize - sprintf_bytes <= excess_precision + if (max_bufsize - (prefixlen + sprintf_bytes) <= excess_precision || max_bufsize - padding <= numwidth) string_overflow (); convbytes = numwidth + padding; if (convbytes <= buf + bufsize - p) { - /* Copy the formatted item from sprintf_buf into buf, - inserting padding and excess-precision zeros. */ - - char *src = sprintf_buf; - char src0 = src[0]; - int exponent_bytes = 0; - bool signedp = src0 == '-' || src0 == '+' || src0 == ' '; - int prefix_bytes = (signedp - + ((src[signedp] == '0' - && (src[signedp + 1] == 'x' - || src[signedp + 1] == 'X')) - ? 2 : 0)); - if (zero_flag) + bool signedp = p[0] == '-' || p[0] == '+' || p[0] == ' '; + int beglen = (signedp + + ((p[signedp] == '0' + && (p[signedp + 1] == 'x' + || p[signedp + 1] == 'X')) + ? 2 : 0)); + eassert (prefixlen == 0 || beglen == 0 + || (beglen == 1 && p[0] == '-' + && ! (prefix[0] == '-' || prefix[0] == '+' + || prefix[0] == ' '))); + if (zero_flag && 0 <= char_hexdigit (p[beglen])) { - unsigned char after_prefix = src[prefix_bytes]; - if (0 <= char_hexdigit (after_prefix)) - { - leading_zeros += padding; - padding = 0; - } + leading_zeros += padding; + padding = 0; + } + if (leading_zeros == 0 && sharp_flag && conversion == 'o' + && p[beglen] != '0') + { + leading_zeros++; + padding -= padding != 0; } - if (excess_precision + int endlen = 0; + if (trailing_zeros && (conversion == 'e' || conversion == 'g')) { - char *e = strchr (src, 'e'); + char *e = strchr (p, 'e'); if (e) - exponent_bytes = src + sprintf_bytes - e; + endlen = p + sprintf_bytes - e; } - spec->start = nchars; - if (! minus_flag) - { - memset (p, ' ', padding); - p += padding; - nchars += padding; - } + ptrdiff_t midlen = sprintf_bytes - beglen - endlen; + ptrdiff_t leading_padding = minus_flag ? 0 : padding; + ptrdiff_t trailing_padding = padding - leading_padding; - memcpy (p, src, prefix_bytes); - p += prefix_bytes; - src += prefix_bytes; - memset (p, '0', leading_zeros); - p += leading_zeros; - int significand_bytes - = sprintf_bytes - prefix_bytes - exponent_bytes; - memcpy (p, src, significand_bytes); - p += significand_bytes; - src += significand_bytes; - memset (p, '0', trailing_zeros); - p += trailing_zeros; - memcpy (p, src, exponent_bytes); - p += exponent_bytes; - - nchars += leading_zeros + sprintf_bytes + trailing_zeros; + /* Insert padding and excess-precision zeros. The output + contains the following components, in left-to-right order: - if (minus_flag) + LEADING_PADDING spaces. + BEGLEN bytes taken from the start of sprintf output. + PREFIXLEN bytes taken from the start of the prefix array. + LEADING_ZEROS zeros. + MIDLEN bytes taken from the middle of sprintf output. + TRAILING_ZEROS zeros. + ENDLEN bytes taken from the end of sprintf output. + TRAILING_PADDING spaces. + + The sprintf output is taken from the buffer starting at + P and continuing for SPRINTF_BYTES bytes. */ + + ptrdiff_t incr + = (padding + leading_zeros + prefixlen + + sprintf_bytes + trailing_zeros); + + /* Optimize for the typical case with padding or zeros. */ + if (incr != sprintf_bytes) { - memset (p, ' ', padding); - p += padding; - nchars += padding; + /* Move data to make room to insert spaces and '0's. + As this may entail overlapping moves, process + the output right-to-left and use memmove. + With any luck this code is rarely executed. */ + char *src = p + sprintf_bytes; + char *dst = p + incr; + dst -= trailing_padding; + memset (dst, ' ', trailing_padding); + src -= endlen; + dst -= endlen; + memmove (dst, src, endlen); + dst -= trailing_zeros; + memset (dst, '0', trailing_zeros); + src -= midlen; + dst -= midlen; + memmove (dst, src, midlen); + dst -= leading_zeros; + memset (dst, '0', leading_zeros); + dst -= prefixlen; + memcpy (dst, prefix, prefixlen); + src -= beglen; + dst -= beglen; + memmove (dst, src, beglen); + dst -= leading_padding; + memset (dst, ' ', leading_padding); } - spec->end = nchars; + p += incr; + spec->start = nchars; + spec->end = nchars += incr; new_result = true; - continue; + convbytes = CONVBYTES_ROOM; } } } @@ -4962,42 +4984,51 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) } copy_char: - if (convbytes <= buf + bufsize - p) - { - memcpy (p, convsrc, convbytes); - p += convbytes; - nchars++; - continue; - } + memcpy (p, convsrc, convbytes); + p += convbytes; + nchars++; + convbytes = CONVBYTES_ROOM; } - /* There wasn't enough room to store this conversion or single - character. CONVBYTES says how much room is needed. Allocate - enough room (and then some) and do it again. */ - ptrdiff_t used = p - buf; - if (max_bufsize - used < convbytes) + ptrdiff_t buflen_needed; + if (INT_ADD_WRAPV (used, convbytes, &buflen_needed)) string_overflow (); - bufsize = used + convbytes; - bufsize = bufsize < max_bufsize / 2 ? bufsize * 2 : max_bufsize; - - if (buf == initial_buffer) + if (bufsize <= buflen_needed) { - buf = xmalloc (bufsize); - buf_save_value_index = SPECPDL_INDEX (); - record_unwind_protect_ptr (xfree, buf); - memcpy (buf, initial_buffer, used); - } - else - { - buf = xrealloc (buf, bufsize); - set_unwind_protect_ptr (buf_save_value_index, xfree, buf); - } + if (max_bufsize <= buflen_needed) + string_overflow (); - p = buf + used; - format = format0; - n = n0; - ispec = ispec0; + /* Either there wasn't enough room to store this conversion, + or there won't be enough room to do a sprintf the next + time through the loop. Allocate enough room (and then some). */ + + bufsize = (buflen_needed <= max_bufsize / 2 + ? buflen_needed * 2 : max_bufsize); + + if (buf == initial_buffer) + { + buf = xmalloc (bufsize); + buf_save_value_index = SPECPDL_INDEX (); + record_unwind_protect_ptr (xfree, buf); + memcpy (buf, initial_buffer, used); + } + else + { + buf = xrealloc (buf, bufsize); + set_unwind_protect_ptr (buf_save_value_index, xfree, buf); + } + + p = buf + used; + if (convbytes != CONVBYTES_ROOM) + { + /* There wasn't enough room for this conversion; do it over. */ + eassert (CONVBYTES_ROOM < convbytes); + format = format0; + n = n0; + ispec = ispec0; + } + } } if (bufsize < p - buf) diff --git a/src/lisp.h b/src/lisp.h index c5b51ba3b3..36ca32c3c0 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3278,9 +3278,12 @@ set_sub_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val) XSUB_CHAR_TABLE (table)->contents[idx] = val; } -/* Defined in bignum.c. */ +/* Defined in bignum.c. This part of bignum.c's API does not require + the caller to access bignum internals; see bignum.h for that. */ extern intmax_t bignum_to_intmax (Lisp_Object); extern uintmax_t bignum_to_uintmax (Lisp_Object); +extern ptrdiff_t bignum_bufsize (Lisp_Object, int); +extern ptrdiff_t bignum_to_c_string (char *, ptrdiff_t, Lisp_Object, int); extern Lisp_Object bignum_to_string (Lisp_Object, int); extern Lisp_Object make_bignum_str (char const *, int); extern Lisp_Object double_to_bignum (double); diff --git a/src/print.c b/src/print.c index 49d9e38e7d..c0c90bc7e9 100644 --- a/src/print.c +++ b/src/print.c @@ -23,7 +23,6 @@ along with GNU Emacs. If not, see . */ #include "sysstdio.h" #include "lisp.h" -#include "bignum.h" #include "character.h" #include "coding.h" #include "buffer.h" @@ -1370,11 +1369,11 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, { case PVEC_BIGNUM: { + ptrdiff_t size = bignum_bufsize (obj, 10); USE_SAFE_ALLOCA; - char *str = SAFE_ALLOCA (mpz_sizeinbase (XBIGNUM (obj)->value, 10) - + 2); - mpz_get_str (str, 10, XBIGNUM (obj)->value); - print_c_string (str, printcharfun); + char *str = SAFE_ALLOCA (size); + ptrdiff_t len = bignum_to_c_string (str, size, obj, 10); + strout (str, len, len, printcharfun); SAFE_FREE (); } break; diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index 964ff08836..487f3aaa66 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -381,10 +381,23 @@ (let* ((s1 "FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF") (v1 (read (concat "#x" s1))) (s2 "99999999999999999999999999999999") - (v2 (read s2))) + (v2 (read s2)) + (v3 #x-3ffffffffffffffe000000000000000)) (should (> v1 most-positive-fixnum)) (should (equal (format "%X" v1) s1)) (should (> v2 most-positive-fixnum)) - (should (equal (format "%d" v2) s2)))) + (should (equal (format "%d" v2) s2)) + (should (equal (format "%d" v3) "-5316911983139663489309385231907684352")) + (should (equal (format "%+d" v3) "-5316911983139663489309385231907684352")) + (should (equal (format "%+d" (- v3)) + "+5316911983139663489309385231907684352")) + (should (equal (format "% d" (- v3)) + " 5316911983139663489309385231907684352")) + (should (equal (format "%o" v3) + "-37777777777777777777600000000000000000000")) + (should (equal (format "%#50.40x" v3) + " -0x000000003ffffffffffffffe000000000000000")) + (should (equal (format "%-#50.40x" v3) + "-0x000000003ffffffffffffffe000000000000000 ")))) ;;; editfns-tests.el ends here commit a451c6ec12b7b024f347364becb10c49807513ed Author: Paul Eggert Date: Fri Aug 31 00:22:15 2018 -0700 * src/alloc.c (sweep_vectors): Simplify. diff --git a/src/alloc.c b/src/alloc.c index 350b668ec6..1eab82d1c2 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3254,8 +3254,7 @@ sweep_vectors (void) for (block = vector_blocks; block; block = *bprev) { - bool free_this_block = 0; - ptrdiff_t nbytes; + bool free_this_block = false; for (vector = (struct Lisp_Vector *) block->data; VECTOR_IN_BLOCK (vector, block); vector = next) @@ -3264,31 +3263,26 @@ sweep_vectors (void) { VECTOR_UNMARK (vector); total_vectors++; - nbytes = vector_nbytes (vector); + ptrdiff_t nbytes = vector_nbytes (vector); total_vector_slots += nbytes / word_size; next = ADVANCE (vector, nbytes); } else { - ptrdiff_t total_bytes; - - cleanup_vector (vector); - nbytes = vector_nbytes (vector); - total_bytes = nbytes; - next = ADVANCE (vector, nbytes); + ptrdiff_t total_bytes = 0; /* While NEXT is not marked, try to coalesce with VECTOR, thus making VECTOR of the largest possible size. */ - while (VECTOR_IN_BLOCK (next, block)) + next = vector; + do { - if (VECTOR_MARKED_P (next)) - break; cleanup_vector (next); - nbytes = vector_nbytes (next); + ptrdiff_t nbytes = vector_nbytes (next); total_bytes += nbytes; next = ADVANCE (next, nbytes); } + while (VECTOR_IN_BLOCK (next, block) && !VECTOR_MARKED_P (next)); eassert (total_bytes % roundup_size == 0); @@ -3296,7 +3290,7 @@ sweep_vectors (void) && !VECTOR_IN_BLOCK (next, block)) /* This block should be freed because all of its space was coalesced into the only free vector. */ - free_this_block = 1; + free_this_block = true; else setup_on_free_list (vector, total_bytes); } commit 76978462bbb55eb4b5cfe4d70856e18ed1e21076 Author: Michael Albinus Date: Fri Aug 31 09:04:13 2018 +0200 Construct a thread_event only if THREADS_ENABLED * src/thread.c (Fthread_signal): Construct a thread_event only if THREADS_ENABLED. diff --git a/src/thread.c b/src/thread.c index 78cb216199..081569f8a3 100644 --- a/src/thread.c +++ b/src/thread.c @@ -875,6 +875,7 @@ If THREAD is the main thread, just the error message is shown. */) if (tstate == current_thread) Fsignal (error_symbol, data); +#ifdef THREADS_ENABLED if (main_thread_p (tstate)) { /* Construct an event. */ @@ -889,6 +890,7 @@ If THREAD is the main thread, just the error message is shown. */) } else +#endif { /* What to do if thread is already signaled? */ /* What if error_symbol is Qnil? */ commit 7c0675af3c9aa7971c37aa9e7afdceae6bfea767 Author: Paul Eggert Date: Thu Aug 30 18:10:18 2018 -0700 Fix bignum FIXME in emacs-module.c * src/emacs-module.c: Do not include bignum.h; no longer needed. (module_extract_integer): Use bignum_to_intmax to avoid incorrectly signaling overflow on platforms where intmax_t is wider than long int. diff --git a/src/emacs-module.c b/src/emacs-module.c index cf92b0fdb5..2ba5540d9a 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -27,7 +27,6 @@ along with GNU Emacs. If not, see . */ #include #include "lisp.h" -#include "bignum.h" #include "dynlib.h" #include "coding.h" #include "keyboard.h" @@ -522,11 +521,10 @@ module_extract_integer (emacs_env *env, emacs_value n) CHECK_INTEGER (l); if (BIGNUMP (l)) { - /* FIXME: This can incorrectly signal overflow on platforms - where long is narrower than intmax_t. */ - if (!mpz_fits_slong_p (XBIGNUM (l)->value)) + intmax_t i = bignum_to_intmax (l); + if (i == 0) xsignal1 (Qoverflow_error, l); - return mpz_get_si (XBIGNUM (l)->value); + return i; } return XFIXNUM (l); } commit 15006cf1dd9ec873c4b1cad1ba1bacf0a5b6229d Author: Juri Linkov Date: Fri Aug 31 01:20:14 2018 +0300 * lisp/vc/vc.el (vc-log-internal-common): Reuse the buffer object. (Bug#32475) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index b2bedfae93..487594b2d5 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -2268,11 +2268,11 @@ earlier revisions. Show up to LIMIT entries (non-nil means unlimited)." setup-buttons-func goto-location-func rev-buff-func) - (let (retval) - (with-current-buffer (get-buffer-create buffer-name) + (let (retval (buffer (get-buffer-create buffer-name))) + (with-current-buffer buffer (set (make-local-variable 'vc-log-view-type) type)) (setq retval (funcall backend-func backend buffer-name type files)) - (with-current-buffer (get-buffer buffer-name) + (with-current-buffer buffer (let ((inhibit-read-only t)) ;; log-view-mode used to be called with inhibit-read-only bound ;; to t, so let's keep doing it, just in case. @@ -2283,7 +2283,7 @@ earlier revisions. Show up to LIMIT entries (non-nil means unlimited)." rev-buff-func))) ;; Display after setting up major-mode, so display-buffer-alist can know ;; the major-mode. - (pop-to-buffer buffer-name) + (pop-to-buffer buffer) (vc-run-delayed (let ((inhibit-read-only t)) (funcall setup-buttons-func backend files retval) commit eb5588db69b3134832f79447dfba59333be41e8b Author: Juri Linkov Date: Fri Aug 31 01:15:56 2018 +0300 * lisp/gnus/mm-view.el (mm-display-inline-fontify): Carry diff-mode overlays to inline MIME attachments from the temp buffer along with text properties. (Bug#32474) diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index 50a927bce2..15eac11fb9 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -452,7 +452,7 @@ "Insert HANDLE inline fontifying with MODE. If MODE is not set, try to find mode automatically." (let ((charset (mail-content-type-get (mm-handle-type handle) 'charset)) - text coding-system) + text coding-system ovs) (unless (eq charset 'gnus-decoded) (mm-with-unibyte-buffer (mm-insert-part handle) @@ -498,10 +498,18 @@ If MODE is not set, try to find mode automatically." (eq major-mode 'fundamental-mode)) (font-lock-ensure)))) (setq text (buffer-string)) + (when (eq mode 'diff-mode) + (setq ovs (mapcar (lambda (ov) (list ov (overlay-start ov) + (overlay-end ov))) + (overlays-in (point-min) (point-max))))) ;; Set buffer unmodified to avoid confirmation when killing the ;; buffer. (set-buffer-modified-p nil)) - (mm-insert-inline handle text))) + (let ((b (1- (point)))) + (mm-insert-inline handle text) + (dolist (ov ovs) + (move-overlay (nth 0 ov) (+ (nth 1 ov) b) + (+ (nth 2 ov) b) (current-buffer)))))) ;; Shouldn't these functions check whether the user even wants to use ;; font-lock? Also, it would be nice to change for the size of the commit 6d6f45e21830a57b4a12af0f89913752a137a653 Author: Paul Eggert Date: Thu Aug 30 14:28:19 2018 -0700 Fix off-by-1 typo in recent bignum changes Problem reported by Yuri D’Elia in: https://lists.gnu.org/r/emacs-devel/2018-08/msg00977.html and crucial clue provided by Michael Heerdegen in: https://lists.gnu.org/r/emacs-devel/2018-08/msg01043.html * src/font.c (font_unparse_xlfd): Fix off-by-1 typo. diff --git a/src/font.c b/src/font.c index 4a63700f79..e2414582f6 100644 --- a/src/font.c +++ b/src/font.c @@ -1290,7 +1290,7 @@ font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes) if (INTEGERP (val)) { intmax_t v = FIXNUMP (val) ? XFIXNUM (val) : bignum_to_intmax (val); - if (! (0 <= v && v <= TYPE_MAXIMUM (uprintmax_t))) + if (! (0 < v && v <= TYPE_MAXIMUM (uprintmax_t))) v = pixel_size; if (v > 0) { commit 54b92132e1ec16565d59d6d9f8ff8910f38843b2 Author: Michael Albinus Date: Thu Aug 30 21:29:04 2018 +0200 Handle thread-signal towards the main thread (Bug#32502) * doc/lispref/threads.texi (Basic Thread Functions): * etc/NEWS: Document thread-signal towards the main thread. * lisp/emacs-lisp/thread.el: New package. * src/keyboard.c (read_char): Check for Qthread_event. (kbd_buffer_get_event, make_lispy_event): Handle THREAD_EVENT. (syms_of_keyboard): Declare Qthread_event. (keys_of_keyboard): Add thread-handle-event to special-event-map. * src/termhooks.h (enum event_kind): Add THREAD_EVENT. * src/thread.c: Include "keyboard.h". (poll_suppress_count) Don't declare extern. (Fthread_signal): Raise event if THREAD is the main thread. (Bug#32502) * test/src/thread-tests.el (thread): Require it. (threads-signal-main-thread): New test. diff --git a/doc/lispref/threads.texi b/doc/lispref/threads.texi index 58a3a918ef..9830198411 100644 --- a/doc/lispref/threads.texi +++ b/doc/lispref/threads.texi @@ -88,14 +88,8 @@ If @var{thread} was blocked by a call to @code{mutex-lock}, @code{condition-wait}, or @code{thread-join}; @code{thread-signal} will unblock it. -Since signal handlers in Emacs are located in the main thread, a -signal must be propagated there in order to become visible. The -second @code{signal} call let the thread die: - -@example -(thread-signal main-thread 'error data) -(signal 'error data) -@end example +If @var{thread} is the main thread, the signal is not propagated +there. Instead, it is shown as message in the main thread. @end defun @defun thread-yield diff --git a/etc/NEWS b/etc/NEWS index 8a774d81c5..d536faaa2d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -726,6 +726,10 @@ to signal the main thread, e.g., when they encounter an error. +++ *** 'thread-join' returns the result of the finished thread now. ++++ +*** 'thread-signal' does not propagate errors to the main thread. +Instead, error messages are just printed in the main thread. + --- ** thingatpt.el supports a new "thing" called 'uuid'. A symbol 'uuid' can be passed to thing-at-point and it returns the diff --git a/lisp/emacs-lisp/thread.el b/lisp/emacs-lisp/thread.el new file mode 100644 index 0000000000..02cf9b9e53 --- /dev/null +++ b/lisp/emacs-lisp/thread.el @@ -0,0 +1,42 @@ +;;; thread.el --- List active threads in a buffer -*- lexical-binding: t -*- + +;; Copyright (C) 2018 Free Software Foundation, Inc. + +;; Author: Gemini Lasswell +;; Maintainer: emacs-devel@gnu.org +;; Keywords: lisp, tools, maint + +;; 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 . + +;;; Commentary: + +;;; Code: + +;;;###autoload +(defun thread-handle-event (event) + "Handle thread events, propagated by `thread-signal'. +An EVENT has the format + (thread-event THREAD ERROR-SYMBOL DATA)" + (interactive "e") + (if (and (consp event) + (eq (car event) 'thread-event) + (= (length event) 4)) + (let ((thread (cadr event)) + (err (cddr event))) + (message "Error %s: %S" thread err)))) + +(provide 'thread) +;;; thread.el ends here diff --git a/src/keyboard.c b/src/keyboard.c index 7fafb41fcc..008d3b9d7c 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -2827,6 +2827,9 @@ read_char (int commandflag, Lisp_Object map, #endif #ifdef USE_FILE_NOTIFY || EQ (XCAR (c), Qfile_notify) +#endif +#ifdef THREADS_ENABLED + || EQ (XCAR (c), Qthread_event) #endif || EQ (XCAR (c), Qconfig_changed_event)) && !end_time) @@ -3739,7 +3742,7 @@ kbd_buffer_get_event (KBOARD **kbp, } #endif /* subprocesses */ -#if !defined HAVE_DBUS && !defined USE_FILE_NOTIFY +#if !defined HAVE_DBUS && !defined USE_FILE_NOTIFY && !defined THREADS_ENABLED if (noninteractive /* In case we are running as a daemon, only do this before detaching from the terminal. */ @@ -3750,7 +3753,7 @@ kbd_buffer_get_event (KBOARD **kbp, *kbp = current_kboard; return obj; } -#endif /* !defined HAVE_DBUS && !defined USE_FILE_NOTIFY */ +#endif /* !defined HAVE_DBUS && !defined USE_FILE_NOTIFY && !defined THREADS_ENABLED */ /* Wait until there is input available. */ for (;;) @@ -3900,6 +3903,9 @@ kbd_buffer_get_event (KBOARD **kbp, #ifdef HAVE_DBUS case DBUS_EVENT: #endif +#ifdef THREADS_ENABLED + case THREAD_EVENT: +#endif #ifdef HAVE_XWIDGETS case XWIDGET_EVENT: #endif @@ -5983,6 +5989,13 @@ make_lispy_event (struct input_event *event) } #endif /* HAVE_DBUS */ +#ifdef THREADS_ENABLED + case THREAD_EVENT: + { + return Fcons (Qthread_event, event->arg); + } +#endif /* THREADS_ENABLED */ + #ifdef HAVE_XWIDGETS case XWIDGET_EVENT: { @@ -11078,6 +11091,10 @@ syms_of_keyboard (void) DEFSYM (Qdbus_event, "dbus-event"); #endif +#ifdef THREADS_ENABLED + DEFSYM (Qthread_event, "thread-event"); +#endif + #ifdef HAVE_XWIDGETS DEFSYM (Qxwidget_event, "xwidget-event"); #endif @@ -11929,6 +11946,12 @@ keys_of_keyboard (void) "dbus-handle-event"); #endif +#ifdef THREADS_ENABLED + /* Define a special event which is raised for thread signals. */ + initial_define_lispy_key (Vspecial_event_map, "thread-event", + "thread-handle-event"); +#endif + #ifdef USE_FILE_NOTIFY /* Define a special event which is raised for notification callback functions. */ diff --git a/src/termhooks.h b/src/termhooks.h index 160bd2f480..8b5f648b43 100644 --- a/src/termhooks.h +++ b/src/termhooks.h @@ -222,6 +222,10 @@ enum event_kind , DBUS_EVENT #endif +#ifdef THREADS_ENABLED + , THREAD_EVENT +#endif + , CONFIG_CHANGED_EVENT #ifdef HAVE_NTGUI diff --git a/src/thread.c b/src/thread.c index 1c73d93865..78cb216199 100644 --- a/src/thread.c +++ b/src/thread.c @@ -25,6 +25,7 @@ along with GNU Emacs. If not, see . */ #include "process.h" #include "coding.h" #include "syssignal.h" +#include "keyboard.h" static struct thread_state main_thread; @@ -34,7 +35,6 @@ static struct thread_state *all_threads = &main_thread; static sys_mutex_t global_lock; -extern int poll_suppress_count; extern volatile int interrupt_input_blocked; @@ -863,7 +863,8 @@ DEFUN ("thread-signal", Fthread_signal, Sthread_signal, 3, 3, 0, This acts like `signal', but arranges for the signal to be raised in THREAD. If THREAD is the current thread, acts just like `signal'. This will interrupt a blocked call to `mutex-lock', `condition-wait', -or `thread-join' in the target thread. */) +or `thread-join' in the target thread. +If THREAD is the main thread, just the error message is shown. */) (Lisp_Object thread, Lisp_Object error_symbol, Lisp_Object data) { struct thread_state *tstate; @@ -874,13 +875,29 @@ or `thread-join' in the target thread. */) if (tstate == current_thread) Fsignal (error_symbol, data); - /* What to do if thread is already signaled? */ - /* What if error_symbol is Qnil? */ - tstate->error_symbol = error_symbol; - tstate->error_data = data; + if (main_thread_p (tstate)) + { + /* Construct an event. */ + struct input_event event; + EVENT_INIT (event); + event.kind = THREAD_EVENT; + event.frame_or_window = Qnil; + event.arg = list3 (Fcurrent_thread (), error_symbol, data); + + /* Store it into the input event queue. */ + kbd_buffer_store_event (&event); + } + + else + { + /* What to do if thread is already signaled? */ + /* What if error_symbol is Qnil? */ + tstate->error_symbol = error_symbol; + tstate->error_data = data; - if (tstate->wait_condvar) - flush_stack_call_func (thread_signal_callback, tstate); + if (tstate->wait_condvar) + flush_stack_call_func (thread_signal_callback, tstate); + } return Qnil; } diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el index 364f6d61f0..cc1dff8a28 100644 --- a/test/src/thread-tests.el +++ b/test/src/thread-tests.el @@ -19,6 +19,8 @@ ;;; Code: +(require 'thread) + ;; Declare the functions in case Emacs has been configured --without-threads. (declare-function all-threads "thread.c" ()) (declare-function condition-mutex "thread.c" (cond)) @@ -320,6 +322,25 @@ (should-not (thread-alive-p thread)) (should (equal (thread-last-error) '(error))))) +(ert-deftest threads-signal-main-thread () + "Test signaling the main thread." + (skip-unless (featurep 'threads)) + ;; We cannot use `ert-with-message-capture', because threads do not + ;; know let-bound variables. + (with-current-buffer "*Messages*" + (let (buffer-read-only) + (erase-buffer)) + (let ((thread + (make-thread #'(lambda () (thread-signal main-thread 'error nil))))) + (while (thread-alive-p thread) + (thread-yield)) + (read-event nil nil 0.1) + ;; No error has been raised, which is part of the test. + (should + (string-match + (format-message "Error %s: (error nil)" thread) + (buffer-string )))))) + (defvar threads-condvar nil) (defun threads-test-condvar-wait () commit 3cc42bb60099c32f64e57d2ee33c8321adba7942 Author: Glenn Morris Date: Thu Aug 30 13:56:08 2018 -0400 * configure.ac: Fix goofs in my recent ImageMagick change. diff --git a/configure.ac b/configure.ac index 85ac932688..6f3d7338c3 100644 --- a/configure.ac +++ b/configure.ac @@ -2515,10 +2515,9 @@ if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" = "yes" || test "${HAVE_W32}" export PKG_CONFIG_PATH="$PKG_CONFIG_PATH$PATH_SEPARATOR`$BREW --prefix imagemagick@6 2>/dev/null`/lib/pkgconfig" fi - EMACS_CHECK_MODULES([IMAGEMAGICK7], [MagickWand >= 7]) - if test $HAVE_IMAGEMAGICK7 = yes; then + EMACS_CHECK_MODULES([IMAGEMAGICK], [MagickWand >= 7]) + if test $HAVE_IMAGEMAGICK = yes; then AC_DEFINE([HAVE_IMAGEMAGICK7], 1, [Define to 1 if using ImageMagick7.]) - HAVE_IMAGEMAGICK = yes else ## 6.3.5 is the earliest version known to work; see Bug#17339. ## 6.8.2 makes Emacs crash; see Bug#13867. @@ -2543,8 +2542,6 @@ if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" = "yes" || test "${HAVE_W32}" fi if test $HAVE_IMAGEMAGICK = yes; then AC_DEFINE([HAVE_IMAGEMAGICK], 1, [Define to 1 if using ImageMagick.]) - AC_DEFINE_UNQUOTED([IMAGEMAGICK_MAJOR], [$IMAGEMAGICK_MAJOR], - [ImageMagick major version number (from configure).]) else IMAGEMAGICK_CFLAGS= IMAGEMAGICK_LIBS= commit 42ed35c68b7c199aa797e655fdc3547c5c3087d2 Author: Paul Eggert Date: Thu Aug 30 10:03:43 2018 -0700 Pacify -Wdouble-promotion in ImageMagick code * src/image.c (imagemagick_load_image): Use double division, and eliminate a cast. This avoids a -Wdouble-promotion warning with GCC 7.3 on Ubuntu 18.04. diff --git a/src/image.c b/src/image.c index 69aeab5d65..24decbc099 100644 --- a/src/image.c +++ b/src/image.c @@ -8824,7 +8824,8 @@ imagemagick_load_image (struct frame *f, struct image *img, #endif /* HAVE_MAGICKEXPORTIMAGEPIXELS */ { size_t image_height; - MagickRealType color_scale = 65535.0 / (MagickRealType) QuantumRange; + double quantum_range = QuantumRange; + MagickRealType color_scale = 65535.0 / quantum_range; #ifdef USE_CAIRO data = xmalloc (width * height * 4); color_scale /= 256; commit 3d09d533d15eae2974f3858df43746cf6e8f897b Author: Miciah Masters Date: Sun Dec 10 19:56:48 2017 -0500 rcirc: Document /reconnect as a built-in command (Bug#29656) The change "New command rcirc-cmd-reconnect" from 2014-04-09 (shipped in Emacs 25.1) added a /reconnect command to rcirc but did not document it and did not delete the example /reconnect command definition in the manual. * doc/misc/rcirc.texi (rcirc commands): Document the built-in /reconnect command. (Hacking and Tweaking): Delete example reconnect command. Copyright-paperwork-exempt: yes diff --git a/doc/misc/rcirc.texi b/doc/misc/rcirc.texi index 2437e020ee..0287054b1d 100644 --- a/doc/misc/rcirc.texi +++ b/doc/misc/rcirc.texi @@ -88,7 +88,6 @@ Hacking and Tweaking * Scrolling conservatively:: * Changing the time stamp format:: * Defining a new command:: -* Reconnecting after you have lost the connection:: @end detailmenu @end menu @@ -401,6 +400,23 @@ This disconnects from the server and parts all channels. You can optionally provide a reason for quitting. When you kill the server buffer, you automatically quit the server and part all channels. (Also @code{/quit ZZZzzz...}.) + +@item /reconnect +@cindex /reconnect +@cindex reconnect +@cindex lost connection +@cindex disconnecting servers, reconnecting +This reconnects after you have lost the connection. + +If you're chatting from a laptop, then you might be familiar with this +problem: When your laptop falls asleep and wakes up later, your IRC +client doesn't realize that it has been disconnected. It takes several +minutes until the client decides that the connection has in fact been +lost. The simple solution is to use @kbd{M-x rcirc}. The problem is +that this opens an @emph{additional} connection, so you'll have two +copies of every channel buffer, one dead and one live. + +The real answer, therefore, is the @code{/reconnect} command. @end table @node Useful IRC commands @@ -787,7 +803,6 @@ Here are some examples of stuff you can do to configure @code{rcirc}. * Scrolling conservatively:: * Changing the time stamp format:: * Defining a new command:: -* Reconnecting after you have lost the connection:: @end menu @node Skipping /away messages using handlers @@ -888,47 +903,6 @@ because @code{defun-rcirc-command} is not yet available, and without (concat "I use " rcirc-id-string)))) @end smallexample -@node Reconnecting after you have lost the connection -@section Reconnecting after you have lost the connection -@cindex reconnecting -@cindex disconnecting servers, reconnecting - -If you're chatting from a laptop, then you might be familiar with this -problem: When your laptop falls asleep and wakes up later, your IRC -client doesn't realize that it has been disconnected. It takes several -minutes until the client decides that the connection has in fact been -lost. The simple solution is to use @kbd{M-x rcirc}. The problem is -that this opens an @emph{additional} connection, so you'll have two -copies of every channel buffer, one dead and one live. - -The real answer, therefore, is a @code{/reconnect} command: - -@smallexample -(with-eval-after-load 'rcirc - (defun-rcirc-command reconnect (arg) - "Reconnect the server process." - (interactive "i") - (unless process - (error "There's no process for this target")) - (let* ((server (car (process-contact process))) - (port (process-contact process :service)) - (nick (rcirc-nick process)) - channels query-buffers) - (dolist (buf (buffer-list)) - (with-current-buffer buf - (when (eq process (rcirc-buffer-process)) - (remove-hook 'change-major-mode-hook - 'rcirc-change-major-mode-hook) - (if (rcirc-channel-p rcirc-target) - (setq channels (cons rcirc-target channels)) - (setq query-buffers (cons buf query-buffers)))))) - (delete-process process) - (rcirc-connect server port nick - rcirc-default-user-name - rcirc-default-full-name - channels)))) -@end smallexample - @node GNU Free Documentation License @appendix GNU Free Documentation License @include doclicense.texi commit a1e615618dfef25c7fd14cbe1a16bdacca1148f4 Author: Noam Postavsky Date: Wed Aug 29 22:47:00 2018 -0400 * test/lisp/calc/calc-tests.el (calc-imaginary-i): New test. diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el index fbd5f0e3a1..101786c30e 100644 --- a/test/lisp/calc/calc-tests.el +++ b/test/lisp/calc/calc-tests.el @@ -86,6 +86,13 @@ An existing calc stack is reused, otherwise a new one is created." (math-read-expr "1m") "cm") '(* -100 (var cm var-cm))))) +(ert-deftest calc-imaginary-i () + "Test `math-imaginary-i' for non-special-const values." + (let ((var-i (calcFunc-polar (calcFunc-sqrt -1)))) + (should (math-imaginary-i))) + (let ((var-i (calcFunc-sqrt -1))) + (should (math-imaginary-i)))) + (ert-deftest test-calc-23889 () "Test for https://debbugs.gnu.org/23889 and 25652." (skip-unless (>= math-bignum-digit-length 9)) commit d8bef4b519624de20baa1428dd103f61dfb220fa Merge: b28d5333e0 2670cbf9a8 Author: Glenn Morris Date: Wed Aug 29 08:24:03 2018 -0700 Merge from origin/emacs-26 2670cbf (origin/emacs-26) ; * configure.ac: Remove outdated comment (... 3b71bef admin.el: respect environment settings for makeinfo etc 3764ab4 * etc/PROBLEMS: New entry about GTK+ 3 crash with some X serv... 9d61344 Index profiler commands in elisp manual f088817 Fix math-imaginary-i check fca935e ; Let pre-commit git hook check merged in changes (Bug#29197) fe06fcc Avoid infinite hscrolling loops when line numbers are displayed 63e59c8 Avoid crashes in malformed defvar 785682c * configure.ac (emacs_config_features): Add GLIB, XDBE, XIM. 2695b7e * configure.ac: Doc fixes related to --with-xim. d0d162c Small checkdoc quoting fix (bug#32546) Conflicts: configure.ac commit b28d5333e0144acc7385339578d907196c4b6f3e Author: Stefan Monnier Date: Wed Aug 29 10:43:41 2018 -0400 * src/keymap.c: Make better use of access_keymap's functionality (Flookup_key): Allow `keymap' to be a list of keymaps. (Fcommand_remapping, Fkey_binding): Simplify accordingly. (shadow_lookup, describe_map_tree): Simplify. diff --git a/etc/NEWS b/etc/NEWS index ed7be1fc20..8a774d81c5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -865,6 +865,8 @@ removed. * Lisp Changes in Emacs 27.1 +** lookup-key can take a list of keymaps as argument. + +++ ** New function 'proper-list-p'. Given a proper list as argument, this predicate returns its length; diff --git a/src/keymap.c b/src/keymap.c index bdd3af2cdc..52db7b491f 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1186,7 +1186,7 @@ number or marker, in which case the keymap properties at the specified buffer position instead of point are used. The KEYMAPS argument is ignored if POSITION is non-nil. -If the optional argument KEYMAPS is non-nil, it should be a list of +If the optional argument KEYMAPS is non-nil, it should be a keymap or list of keymaps to search for command remapping. Otherwise, search for the remapping in all currently active keymaps. */) (Lisp_Object command, Lisp_Object position, Lisp_Object keymaps) @@ -1199,8 +1199,7 @@ remapping in all currently active keymaps. */) if (NILP (keymaps)) command = Fkey_binding (command_remapping_vector, Qnil, Qt, position); else - command = Flookup_key (Fcons (Qkeymap, keymaps), - command_remapping_vector, Qnil); + command = Flookup_key (keymaps, command_remapping_vector, Qnil); return FIXNUMP (command) ? Qnil : command; } @@ -1208,7 +1207,7 @@ remapping in all currently active keymaps. */) /* GC is possible in this function. */ DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0, - doc: /* In keymap KEYMAP, look up key sequence KEY. Return the definition. + doc: /* Look up key sequence KEY in KEYMAP. Return the definition. A value of nil means undefined. See doc of `define-key' for kinds of definitions. @@ -1217,6 +1216,7 @@ that is, characters or symbols in it except for the last one fail to be a valid sequence of prefix characters in KEYMAP. The number is how many characters at the front of KEY it takes to reach a non-prefix key. +KEYMAP can also be a list of keymaps. Normally, `lookup-key' ignores bindings for t, which act as default bindings, used when nothing else in the keymap applies; this makes it @@ -1231,7 +1231,8 @@ recognize the default bindings, just as `read-key-sequence' does. */) ptrdiff_t length; bool t_ok = !NILP (accept_default); - keymap = get_keymap (keymap, 1, 1); + if (!CONSP (keymap) && !NILP (keymap)) + keymap = get_keymap (keymap, true, true); length = CHECK_VECTOR_OR_STRING (key); if (length == 0) @@ -1664,7 +1665,7 @@ specified buffer position instead of point are used. } } - value = Flookup_key (Fcons (Qkeymap, Fcurrent_active_maps (Qt, position)), + value = Flookup_key (Fcurrent_active_maps (Qt, position), key, accept_default); if (NILP (value) || FIXNUMP (value)) @@ -2359,39 +2360,24 @@ preferred_sequence_p (Lisp_Object seq) static void where_is_internal_1 (Lisp_Object key, Lisp_Object binding, Lisp_Object args, void *data); -/* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map. - Returns the first non-nil binding found in any of those maps. - If REMAP is true, pass the result of the lookup through command - remapping before returning it. */ +/* Like Flookup_key, but with command remapping; just returns nil + if the key sequence is too long. */ static Lisp_Object -shadow_lookup (Lisp_Object shadow, Lisp_Object key, Lisp_Object flag, +shadow_lookup (Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default, bool remap) { - Lisp_Object tail, value; + Lisp_Object value = Flookup_key (keymap, key, accept_default); - for (tail = shadow; CONSP (tail); tail = XCDR (tail)) + if (FIXNATP (value)) /* `key' is too long! */ + return Qnil; + else if (!NILP (value) && remap && SYMBOLP (value)) { - value = Flookup_key (XCAR (tail), key, flag); - if (FIXNATP (value)) - { - value = Flookup_key (XCAR (tail), - Fsubstring (key, make_fixnum (0), value), flag); - if (!NILP (value)) - return Qnil; - } - else if (!NILP (value)) - { - Lisp_Object remapping; - if (remap && SYMBOLP (value) - && (remapping = Fcommand_remapping (value, Qnil, shadow), - !NILP (remapping))) - return remapping; - else - return value; - } + Lisp_Object remapping = Fcommand_remapping (value, Qnil, keymap); + return (!NILP (remapping) ? remapping : value); } - return Qnil; + else + return value; } static Lisp_Object Vmouse_events; @@ -2565,7 +2551,7 @@ The optional 5th arg NO-REMAP alters how command remapping is handled: keymaps = Fcurrent_active_maps (Qnil, Qnil); tem = Fcommand_remapping (definition, Qnil, keymaps); - /* If `definition' is remapped to tem', then OT1H no key will run + /* If `definition' is remapped to `tem', then OT1H no key will run that command (since they will run `tem' instead), so we should return nil; but OTOH all keys bound to `definition' (or to `tem') will run the same command. @@ -2587,6 +2573,8 @@ The optional 5th arg NO-REMAP alters how command remapping is handled: && !NILP (tem = Fget (definition, QCadvertised_binding))) { /* We have a list of advertised bindings. */ + /* FIXME: Not sure why we use false for shadow_lookup's remapping, + nor why we use `EQ' here but `Fequal' in the call further down. */ while (CONSP (tem)) if (EQ (shadow_lookup (keymaps, XCAR (tem), Qnil, 0), definition)) return XCAR (tem); @@ -2992,38 +2980,17 @@ key binding\n\ elt = XCAR (maps); elt_prefix = Fcar (elt); - sub_shadows = Qnil; - - for (tail = shadow; CONSP (tail); tail = XCDR (tail)) - { - Lisp_Object shmap; - - shmap = XCAR (tail); - - /* If the sequence by which we reach this keymap is zero-length, - then the shadow map for this keymap is just SHADOW. */ - if ((STRINGP (elt_prefix) && SCHARS (elt_prefix) == 0) - || (VECTORP (elt_prefix) && ASIZE (elt_prefix) == 0)) - ; - /* If the sequence by which we reach this keymap actually has - some elements, then the sequence's definition in SHADOW is - what we should use. */ - else - { - shmap = Flookup_key (shmap, Fcar (elt), Qt); - if (FIXNUMP (shmap)) - shmap = Qnil; - } - - /* If shmap is not nil and not a keymap, + sub_shadows = Flookup_key (shadow, elt_prefix, Qt); + if (FIXNATP (sub_shadows)) + sub_shadows = Qnil; + else if (!KEYMAPP (sub_shadows) + && !NILP (sub_shadows) + && !(CONSP (sub_shadows) + && KEYMAPP (XCAR (sub_shadows)))) + /* If elt_prefix is bound to something that's not a keymap, it completely shadows this map, so don't describe this map at all. */ - if (!NILP (shmap) && !KEYMAPP (shmap)) - goto skip; - - if (!NILP (shmap)) - sub_shadows = Fcons (shmap, sub_shadows); - } + goto skip; /* Maps we have already listed in this loop shadow this map. */ for (tail = orig_maps; !EQ (tail, maps); tail = XCDR (tail)) commit c252cd9d207ab8442f011630005e467ad118bd3a Author: Michael Albinus Date: Wed Aug 29 10:05:34 2018 +0200 Improve tramp-convert-file-attributes backward compatibility * lisp/net/tramp-sh.el (tramp-convert-file-attributes): Use `seconds-to-time' for {access, modification, status change} time. Simplify check for inode. * test/lisp/net/tramp-tests.el (tramp-test22-file-times): Use `seconds-to-time'. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 8cf7318ada..64d208175f 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -5116,19 +5116,13 @@ Return ATTR." (setcar (nthcdr 3 attr) (round (nth 3 attr)))) ;; Convert last access time. (unless (listp (nth 4 attr)) - (setcar (nthcdr 4 attr) - (list (floor (nth 4 attr) 65536) - (floor (mod (nth 4 attr) 65536))))) + (setcar (nthcdr 4 attr) (seconds-to-time (nth 4 attr)))) ;; Convert last modification time. (unless (listp (nth 5 attr)) - (setcar (nthcdr 5 attr) - (list (floor (nth 5 attr) 65536) - (floor (mod (nth 5 attr) 65536))))) + (setcar (nthcdr 5 attr) (seconds-to-time (nth 5 attr)))) ;; Convert last status change time. (unless (listp (nth 6 attr)) - (setcar (nthcdr 6 attr) - (list (floor (nth 6 attr) 65536) - (floor (mod (nth 6 attr) 65536))))) + (setcar (nthcdr 6 attr) (seconds-to-time (nth 6 attr)))) ;; Convert file size. (when (< (nth 7 attr) 0) (setcar (nthcdr 7 attr) -1)) @@ -5158,8 +5152,8 @@ Return ATTR." (not (string-equal (nth 3 attr) (tramp-get-remote-gid vec 'string))))) - ;; Convert inode. Big numbers have been added to Emacs 27. - (unless (or (fboundp 'bignump) (listp (nth 10 attr))) + ;; Convert inode. + (when (floatp (nth 10 attr)) (setcar (nthcdr 10 attr) (condition-case nil (let ((high (nth 10 attr)) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 293a005456..55884f30a7 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3219,11 +3219,12 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; `current-time'. Therefore, we use '(0 1). We skip the ;; test, if the remote handler is not able to set the ;; correct time. - (skip-unless (set-file-times tmp-name1 '(0 1))) + (skip-unless (set-file-times tmp-name1 (seconds-to-time 1))) ;; Dumb remote shells without perl(1) or stat(1) are not ;; able to return the date correctly. They say "don't know". (unless (equal (nth 5 (file-attributes tmp-name1)) '(0 0)) - (should (equal (nth 5 (file-attributes tmp-name1)) '(0 1))) + (should + (equal (nth 5 (file-attributes tmp-name1)) (seconds-to-time 1))) (write-region "bla" nil tmp-name2) (should (file-exists-p tmp-name2)) (should (file-newer-than-file-p tmp-name2 tmp-name1)) commit 190e85b8d286408a88bb611967e658639c48d6c5 Author: Glenn Morris Date: Tue Aug 28 21:22:37 2018 -0400 * lisp/mail/emacsbug.el (report-emacs-bug--os-description): Add BSD. diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index 43ecddf265..92b005d47d 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -150,8 +150,20 @@ This requires either the macOS \"open\" command, or the freedesktop nil t) (setq os (concat os " " (match-string 1))))))) os)))) - ;; TODO include other branches here. - ;; Cygwin, *BSD, etc: ? + ((eq system-type 'berkeley-unix) + (with-temp-buffer + (when + (or (eq 0 (ignore-errors (call-process "freebsd-version" nil + '(t nil) nil "-u"))) + (progn (erase-buffer) + (eq 0 (ignore-errors + (call-process "uname" nil + '(t nil) nil "-a"))))) + (unless (zerop (buffer-size)) + (goto-char (point-min)) + (buffer-substring (line-beginning-position) + (line-end-position)))))) + ;; TODO Cygwin, Solaris (usg-unix-v). (t (or (let ((file "/etc/os-release")) (and (file-readable-p file) commit 2670cbf9a87eb498d73770c381ca51657d390a1e Author: Glenn Morris Date: Tue Aug 28 21:03:12 2018 -0400 ; * configure.ac: Remove outdated comment (it was about CRT_DIR). diff --git a/configure.ac b/configure.ac index 4dadf661d8..029f451cd4 100644 --- a/configure.ac +++ b/configure.ac @@ -1575,7 +1575,6 @@ case $opsys in LIB_MATH= SYSTEM_TYPE=windows-nt ;; - dnl NB this may be adjusted below. netbsd | openbsd ) SYSTEM_TYPE=berkeley-unix ;; commit d0fc4f3f578ac33b4e11adea4a2281d2b849840e Author: Glenn Morris Date: Tue Aug 28 20:35:09 2018 -0400 * lisp/mail/emacsbug.el (report-emacs-bug--os-description): Add MS Windows. diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index d4caeed788..43ecddf265 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -116,6 +116,9 @@ This requires either the macOS \"open\" command, or the freedesktop (concat "mailto:" to))) (error "Subject, To or body not found"))))) +(defvar report-emacs-bug--os-description nil + "Cached value of operating system description.") + (defun report-emacs-bug--os-description () "Return a string describing the operating system, or nil." (cond ((eq system-type 'darwin) @@ -129,8 +132,25 @@ This requires either the macOS \"open\" command, or the freedesktop nil t) (setq os (concat os " " (match-string 1))))))) os)) + ((eq system-type 'windows-nt) + (or report-emacs-bug--os-description + (setq + report-emacs-bug--os-description + (let (os) + (with-temp-buffer + ;; Seems like this command can be slow, because it + ;; unconditionally queries a bunch of other stuff + ;; we don't care about. + (when (eq 0 (ignore-errors + (call-process "systeminfo" nil '(t nil) nil))) + (dolist (s '("OS Name" "OS Version")) + (goto-char (point-min)) + (if (re-search-forward + (format "^%s\\s-*:\\s-+\\(.*\\)$" s) + nil t) + (setq os (concat os " " (match-string 1))))))) + os)))) ;; TODO include other branches here. - ;; MS Windows: systeminfo ? ;; Cygwin, *BSD, etc: ? (t (or (let ((file "/etc/os-release")) commit 3b71befdfb2e073d025471133be87d4d4d853708 Author: Glenn Morris Date: Tue Aug 28 16:34:25 2018 -0400 admin.el: respect environment settings for makeinfo etc * admin/admin.el (manual-makeinfo, manual-texi2pdf, manual-texi2dvi): New variables. (manual-html-mono, manual-html-node, manual-pdf, manual-ps): Use them. diff --git a/admin/admin.el b/admin/admin.el index 3cb5dbc2d9..1cad7ae277 100644 --- a/admin/admin.el +++ b/admin/admin.el @@ -352,13 +352,22 @@ Optional argument TYPE is type of output (nil means all)." (manual-html-mono texi (expand-file-name (concat name ".html") html-mono-dir)))) +(defvar manual-makeinfo (or (getenv "MAKEINFO") "makeinfo") + "The `makeinfo' program to use.") + +(defvar manual-texi2pdf (or (getenv "TEXI2PDF") "texi2pdf") + "The `texi2pdf' program to use.") + +(defvar manual-texi2dvi (or (getenv "TEXI2DVI") "texi2dvi") + "The `texi2dvi' program to use.") + (defun manual-html-mono (texi-file dest) "Run Makeinfo on TEXI-FILE, emitting mono HTML output to DEST. This function also edits the HTML files so that they validate as HTML 4.01 Transitional, and pulls in the gnu.org stylesheet using the @import directive." (make-directory (or (file-name-directory dest) ".") t) - (call-process "makeinfo" nil nil nil + (call-process manual-makeinfo nil nil nil "-D" "WWW_GNU_ORG" "-I" (expand-file-name "../emacs" (file-name-directory texi-file)) @@ -386,7 +395,7 @@ the @import directive." (unless (file-exists-p texi-file) (user-error "Manual file %s not found" texi-file)) (make-directory dir t) - (call-process "makeinfo" nil nil nil + (call-process manual-makeinfo nil nil nil "-D" "WWW_GNU_ORG" "-I" (expand-file-name "../emacs" (file-name-directory texi-file)) @@ -425,7 +434,7 @@ the @import directive." "Run texi2pdf on TEXI-FILE, emitting PDF output to DEST." (make-directory (or (file-name-directory dest) ".") t) (let ((default-directory (file-name-directory texi-file))) - (call-process "texi2pdf" nil nil nil + (call-process manual-texi2pdf nil nil nil "-I" "../emacs" "-I" "../misc" texi-file "-o" dest))) @@ -435,7 +444,7 @@ the @import directive." (let ((dvi-dest (concat (file-name-sans-extension dest) ".dvi")) (default-directory (file-name-directory texi-file))) ;; FIXME: Use `texi2dvi --ps'? --xfq - (call-process "texi2dvi" nil nil nil + (call-process manual-texi2dvi nil nil nil "-I" "../emacs" "-I" "../misc" texi-file "-o" dvi-dest) (call-process "dvips" nil nil nil dvi-dest "-o" dest) commit 3764ab4186bb4479aee5241705f91c1edf4cccfb Author: Glenn Morris Date: Tue Aug 28 16:05:04 2018 -0400 * etc/PROBLEMS: New entry about GTK+ 3 crash with some X servers. diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 9507a5d975..15e2b3359d 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -217,6 +217,26 @@ result in an endless loop. If you need Emacs to be able to recover from closing displays, compile it with the Lucid toolkit instead of GTK. +** Emacs compiled with GTK+ 3 crashes when run under some X servers. +This happens when the X server does not provide certain display +features that the underlying GTK+ 3 toolkit assumes. For example, this +issue has been seen with remote X servers like X2Go. The symptoms +are an Emacs crash, possibly triggered by the mouse entering the Emacs +window, or an attempt to resize the Emacs window. The crash backtrace +contains a call to XQueryPointer. + +This issue was fixed in the GTK+ 3 toolkit in commit 4b1c0256 in February 2018. + +If your GTK+ 3 is still affected, you can avoid the issue by recompiling +Emacs with a different X toolkit, eg --with-toolkit=gtk2. + +References: +https://gitlab.gnome.org/GNOME/gtk/commit/4b1c02560f0d8097bf5a11932e52fb72f3e9e94b +https://debbugs.gnu.org/24280 +https://bugs.debian.org/901038 +https://bugzilla.redhat.com/1483942 +https://access.redhat.com/solutions/3410101 + ** Emacs compiled with GTK crashes at startup due to X protocol error. This is known to happen on elementary OS GNU/Linux systems. commit d4586b7a9cea6aac7d710d59fd29ce1b9a705449 Author: Paul Eggert Date: Tue Aug 28 11:59:21 2018 -0700 Improve (format "%g" bignum) precision * src/editfns.c (styled_format): When formatting bignums with floating-point conversions like %g, use long double if that would lose less information than double, which is what the code was already doing for fixnums. On Fedora 28 x86-64, for example, (format "%.100g" (1- (ash 1 64))) now yields "18446744073709551615" instead of the numerically incorrect "18446744073709549568". Also, fix a stray INTEGERP that can just be FIXNUMP, since bignums are not possible there. diff --git a/src/editfns.c b/src/editfns.c index ad5a26606b..b4c597feda 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -4608,17 +4608,6 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) { enum { - /* Lower bound on the number of bits per - base-FLT_RADIX digit. */ - DIG_BITS_LBOUND = FLT_RADIX < 16 ? 1 : 4, - - /* 1 if integers should be formatted as long doubles, - because they may be so large that there is a rounding - error when converting them to double, and long doubles - are wider than doubles. */ - INT_AS_LDBL = (DIG_BITS_LBOUND * DBL_MANT_DIG < FIXNUM_BITS - 1 - && DBL_MANT_DIG < LDBL_MANT_DIG), - /* Maximum precision for a %f conversion such that the trailing output digit might be nonzero. Any precision larger than this will not yield useful information. */ @@ -4649,7 +4638,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) with "L" possibly inserted for floating-point formats, and with pM inserted for integer formats. At most two flags F can be specified at once. */ - char convspec[sizeof "%FF.*d" + max (INT_AS_LDBL, pMlen)]; + char convspec[sizeof "%FF.*d" + max (sizeof "L" - 1, pMlen)]; char *f = convspec; *f++ = '%'; /* MINUS_FLAG and ZERO_FLAG are dealt with later. */ @@ -4658,15 +4647,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) *f = '#'; f += sharp_flag; *f++ = '.'; *f++ = '*'; - if (float_conversion) - { - if (INT_AS_LDBL) - { - *f = 'L'; - f += FIXNUMP (arg); - } - } - else if (conversion != 'c') + if (! (float_conversion || conversion == 'c')) { memcpy (f, pMd, pMlen); f += pMlen; @@ -4694,17 +4675,66 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) ptrdiff_t sprintf_bytes; if (float_conversion) { - if (INT_AS_LDBL && FIXNUMP (arg)) + /* Format as a long double if the arg is an integer + that would lose less information than when formatting + it as a double. Otherwise, format as a double; + this is likely to be faster and better-tested. */ + + bool format_as_long_double = false; + double darg; + long double ldarg; + + if (FLOATP (arg)) + darg = XFLOAT_DATA (arg); + else { - /* Although long double may have a rounding error if - DIG_BITS_LBOUND * LDBL_MANT_DIG < FIXNUM_BITS - 1, - it is more accurate than plain 'double'. */ - long double x = XFIXNUM (arg); - sprintf_bytes = sprintf (sprintf_buf, convspec, prec, x); + bool format_bignum_as_double = false; + if (LDBL_MANT_DIG <= DBL_MANT_DIG) + { + if (FIXNUMP (arg)) + darg = XFIXNUM (arg); + else + format_bignum_as_double = true; + } + else + { + if (FIXNUMP (arg)) + ldarg = XFIXNUM (arg); + else + { + intmax_t iarg = bignum_to_intmax (arg); + if (iarg != 0) + ldarg = iarg; + else + { + uintmax_t uarg = bignum_to_uintmax (arg); + if (uarg != 0) + ldarg = uarg; + else + format_bignum_as_double = true; + } + } + if (!format_bignum_as_double) + { + darg = ldarg; + format_as_long_double = darg != ldarg; + } + } + if (format_bignum_as_double) + darg = bignum_to_double (arg); + } + + if (format_as_long_double) + { + f[-1] = 'L'; + *f++ = conversion; + *f = '\0'; + sprintf_bytes = sprintf (sprintf_buf, convspec, prec, + ldarg); } else sprintf_bytes = sprintf (sprintf_buf, convspec, prec, - XFLOATINT (arg)); + darg); } else if (conversion == 'c') { @@ -4740,7 +4770,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) { uprintmax_t x; bool negative; - if (INTEGERP (arg)) + if (FIXNUMP (arg)) { if (binary_as_unsigned) { commit 5cb057a854a848be85dc2b81f6497964f5a93dbb Author: Paul Eggert Date: Tue Aug 28 09:51:49 2018 -0700 Fix Fnatnump typos Problem reported by Glenn Morris in: https://lists.gnu.org/r/emacs-devel/2018-08/msg00946.html * src/floatfns.c (Fexpt): * src/xselect.c (cons_to_x_long): Don't assume Lisp_Object values are scalars. diff --git a/src/floatfns.c b/src/floatfns.c index 8008929be6..77e20d5640 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -210,7 +210,7 @@ DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, /* Common Lisp spec: don't promote if both are integers, and if the result is not fractional. */ - if (INTEGERP (arg1) && Fnatnump (arg2)) + if (INTEGERP (arg1) && !NILP (Fnatnump (arg2))) return expt_integer (arg1, arg2); return make_float (pow (XFLOATINT (arg1), XFLOATINT (arg2))); diff --git a/src/xselect.c b/src/xselect.c index 4b28d474a0..53e788523c 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -1693,7 +1693,7 @@ static unsigned long cons_to_x_long (Lisp_Object obj) { if (X_ULONG_MAX <= INTMAX_MAX - || !Fnatnump (CONSP (obj) ? XCAR (obj) : obj)) + || NILP (Fnatnump (CONSP (obj) ? XCAR (obj) : obj))) return cons_to_signed (obj, X_LONG_MIN, min (X_ULONG_MAX, INTMAX_MAX)); else return cons_to_unsigned (obj, X_ULONG_MAX); commit c39ca701d3ffa3a7fcb987170436ad441e8f8ad6 Author: Eli Zaretskii Date: Tue Aug 28 19:36:02 2018 +0300 Fix a recent change * src/dispnew.c (sit_for): Don;t treat nil as zero. Reported by Glenn Morris . diff --git a/src/dispnew.c b/src/dispnew.c index 97c6a446a6..61ca717079 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -5775,7 +5775,7 @@ sit_for (Lisp_Object timeout, bool reading, int display_option) } else if (BIGNUMP (timeout)) { - if (!Fnatnump (timeout)) + if (NILP (Fnatnump (timeout))) return Qt; sec = bignum_to_intmax (timeout); if (sec == 0) commit adcf904b3a7f8c5b8a82a40725ef7baa3a76c993 Author: Michael Albinus Date: Tue Aug 28 16:27:02 2018 +0200 Add bignum support in Tramp * lisp/net/tramp-adb.el (tramp-adb-handle-file-system-info): * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-system-info): * lisp/net/tramp-sh.el (tramp-do-file-attributes-with-stat) (tramp-do-directory-files-and-attributes-with-stat) (tramp-sh-handle-file-system-info): * lisp/net/tramp-smb.el (tramp-smb-handle-file-system-info): Do not add "e0" to integers. * lisp/net/tramp-sh.el (tramp-perl-file-attributes) (tramp-convert-file-attributes): Do not use a consp for the inode if there is bignum support. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 297bdd712f..35b0fdda62 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -265,12 +265,12 @@ pass to the OPERATION." "[[:space:]]+\\([[:digit:]]+\\)")) ;; The values are given as 1k numbers, so we must change ;; them to number of bytes. - (list (* 1024 (string-to-number (concat (match-string 1) "e0"))) + (list (* 1024 (string-to-number (match-string 1))) ;; The second value is the used size. We need the ;; free size. - (* 1024 (- (string-to-number (concat (match-string 1) "e0")) - (string-to-number (concat (match-string 2) "e0")))) - (* 1024 (string-to-number (concat (match-string 3) "e0"))))))))) + (* 1024 (- (string-to-number (match-string 1)) + (string-to-number (match-string 2)))) + (* 1024 (string-to-number (match-string 3))))))))) ;; This is derived from `tramp-sh-handle-file-truename'. Maybe the ;; code could be shared? diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 84af410de0..f46ddc68ae 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1273,10 +1273,9 @@ file-notify events." (used (cdr (assoc "filesystem::used" attr))) (free (cdr (assoc "filesystem::free" attr)))) (when (and (stringp size) (stringp used) (stringp free)) - (list (string-to-number (concat size "e0")) - (- (string-to-number (concat size "e0")) - (string-to-number (concat used "e0"))) - (string-to-number (concat free "e0"))))))) + (list (string-to-number size) + (- (string-to-number size) (string-to-number used)) + (string-to-number free)))))) (defun tramp-gvfs-handle-file-writable-p (filename) "Like `file-writable-p' for Tramp files." diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 86e82d4092..8cf7318ada 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -694,7 +694,7 @@ else $uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\"; $gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\"; printf( - \"(%%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u.0 %%u t (%%u . %%u) -1)\\n\", + \"(%%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u %%u t %%u -1)\\n\", $type, $stat[3], $uid, @@ -707,8 +707,7 @@ printf( $stat[10] & 0xffff, $stat[7], $stat[2], - $stat[1] >> 16 & 0xffff, - $stat[1] & 0xffff + $stat[1] );' \"$1\" \"$2\" 2>/dev/null" "Perl script to produce output suitable for use with `file-attributes' on the remote file system. @@ -1393,7 +1392,7 @@ component is used as the target of the symlink." ;; `tramp-stat-marker', in order to make a proper shell escape of ;; them in file names. "( (%s %s || %s -h %s) && (%s -c " - "'((%s%%N%s) %%h %s %s %%Xe0 %%Ye0 %%Ze0 %%se0 %s%%A%s t %%ie0 -1)' " + "'((%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' " "%s | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g') || echo nil)") (tramp-get-file-exists-command vec) (tramp-shell-quote-argument localname) @@ -1402,9 +1401,9 @@ component is used as the target of the symlink." (tramp-get-remote-stat vec) tramp-stat-marker tramp-stat-marker (if (eq id-format 'integer) - "%ue0" (concat tramp-stat-marker "%U" tramp-stat-marker)) + "%u" (concat tramp-stat-marker "%U" tramp-stat-marker)) (if (eq id-format 'integer) - "%ge0" (concat tramp-stat-marker "%G" tramp-stat-marker)) + "%g" (concat tramp-stat-marker "%G" tramp-stat-marker)) tramp-stat-marker tramp-stat-marker (tramp-shell-quote-argument localname) tramp-stat-quoted-marker))) @@ -1825,7 +1824,7 @@ be non-negative integers." ;; make a proper shell escape of them in file names. "cd %s && echo \"(\"; (%s %s -a | " "xargs %s -c " - "'(%s%%n%s (%s%%N%s) %%h %s %s %%Xe0 %%Ye0 %%Ze0 %%se0 %s%%A%s t %%ie0 -1)' " + "'(%s%%n%s (%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' " "-- 2>/dev/null | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'); echo \")\"") (tramp-shell-quote-argument localname) (tramp-get-ls-command vec) @@ -1836,9 +1835,9 @@ be non-negative integers." tramp-stat-marker tramp-stat-marker tramp-stat-marker tramp-stat-marker (if (eq id-format 'integer) - "%ue0" (concat tramp-stat-marker "%U" tramp-stat-marker)) + "%u" (concat tramp-stat-marker "%U" tramp-stat-marker)) (if (eq id-format 'integer) - "%ge0" (concat tramp-stat-marker "%G" tramp-stat-marker)) + "%g" (concat tramp-stat-marker "%G" tramp-stat-marker)) tramp-stat-marker tramp-stat-marker tramp-stat-quoted-marker))) @@ -3806,12 +3805,12 @@ file-notify events." (concat "[[:space:]]*\\([[:digit:]]+\\)" "[[:space:]]+\\([[:digit:]]+\\)" "[[:space:]]+\\([[:digit:]]+\\)")) - (list (string-to-number (concat (match-string 1) "e0")) + (list (string-to-number (match-string 1)) ;; The second value is the used size. We need the ;; free size. - (- (string-to-number (concat (match-string 1) "e0")) - (string-to-number (concat (match-string 2) "e0"))) - (string-to-number (concat (match-string 3) "e0"))))))))) + (- (string-to-number (match-string 1)) + (string-to-number (match-string 2))) + (string-to-number (match-string 3))))))))) ;;; Internal Functions: @@ -5159,8 +5158,8 @@ Return ATTR." (not (string-equal (nth 3 attr) (tramp-get-remote-gid vec 'string))))) - ;; Convert inode. - (unless (listp (nth 10 attr)) + ;; Convert inode. Big numbers have been added to Emacs 27. + (unless (or (fboundp 'bignump) (listp (nth 10 attr))) (setcar (nthcdr 10 attr) (condition-case nil (let ((high (nth 10 attr)) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 335f05cfce..583acbde03 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -959,18 +959,15 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (concat "[[:space:]]*\\([[:digit:]]+\\)" " blocks of size \\([[:digit:]]+\\)" "\\. \\([[:digit:]]+\\) blocks available")) - (setq blocksize (string-to-number (concat (match-string 2) "e0")) - total (* blocksize - (string-to-number (concat (match-string 1) "e0"))) - avail (* blocksize - (string-to-number (concat (match-string 3) "e0"))))) + (setq blocksize (string-to-number (match-string 2)) + total (* blocksize (string-to-number (match-string 1))) + avail (* blocksize (string-to-number (match-string 3))))) (forward-line) (when (looking-at "Total number of bytes: \\([[:digit:]]+\\)") ;; The used number of bytes is not part of the result. As ;; side effect, we store it as file property. (tramp-set-file-property - v localname "used-bytes" - (string-to-number (concat (match-string 1) "e0")))) + v localname "used-bytes" (string-to-number (match-string 1)))) ;; Result. (when (and total avail) (list total (- total avail) avail))))))) commit 9d613444994a2e5827c23e8c0a5e2a975903764f Author: Noam Postavsky Date: Tue Aug 28 07:49:49 2018 -0400 Index profiler commands in elisp manual * doc/lispref/debugging.texi (Profiling): Add index entries for profiler-start, profiler-report, profiler-stop. diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi index fdd92a3780..cbf8778ca8 100644 --- a/doc/lispref/debugging.texi +++ b/doc/lispref/debugging.texi @@ -930,6 +930,9 @@ the execution time. If you find that one particular function is responsible for a significant portion of the execution time, you can start looking for ways to optimize that piece. +@findex profiler-start +@findex profiler-report +@findex profiler-stop Emacs has built-in support for this. To begin profiling, type @kbd{M-x profiler-start}. You can choose to profile by processor usage, memory usage, or both. Then run the code you'd like to speed commit f0888179237b25e32b46a8a855acb3d3453e4c69 Author: Noam Postavsky Date: Tue Aug 14 23:26:50 2018 -0400 Fix math-imaginary-i check Reported by Bastian ErdnĂĽĂź at . * lisp/calc/calc-cplx.el (math-imaginary-i): Check for a value of (polar 1 ). diff --git a/lisp/calc/calc-cplx.el b/lisp/calc/calc-cplx.el index 4a453a73d7..35cd31dfb4 100644 --- a/lisp/calc/calc-cplx.el +++ b/lisp/calc/calc-cplx.el @@ -273,8 +273,8 @@ (or (eq (car-safe val) 'special-const) (equal val '(cplx 0 1)) (and (eq (car-safe val) 'polar) - (eq (nth 1 val) 0) - (Math-equal (nth 1 val) (math-quarter-circle nil)))))) + (eq (nth 1 val) 1) + (Math-equal (nth 2 val) (math-quarter-circle nil)))))) ;;; Extract the real or complex part of a complex number. [R N] [Public] ;;; Also extracts the real part of a modulo form. commit fca935e4abe817130abb2676ec2f37b73e4f45f4 Author: Noam Postavsky Date: Wed Feb 14 19:58:07 2018 -0500 ; Let pre-commit git hook check merged in changes (Bug#29197) * build-aux/git-hooks/pre-commit: If GIT_MERGE_CHECK_OTHER is 'true', check changes against the merge target, rather than the current branch. Include file name when giving error message about non-standard characters. diff --git a/build-aux/git-hooks/pre-commit b/build-aux/git-hooks/pre-commit index 5e42dab233..c0455fb2fa 100755 --- a/build-aux/git-hooks/pre-commit +++ b/build-aux/git-hooks/pre-commit @@ -28,7 +28,7 @@ exec >&2 # When doing a two-way merge, ignore problems that came from the other # side of the merge. head=HEAD -if test -r "$GIT_DIR"/MERGE_HEAD; then +if test -r "$GIT_DIR"/MERGE_HEAD && test "$GIT_MERGE_CHECK_OTHER" != true; then merge_heads=`cat "$GIT_DIR"/MERGE_HEAD` || exit for merge_head in $merge_heads; do case $head in @@ -42,15 +42,10 @@ if test -r "$GIT_DIR"/MERGE_HEAD; then fi git_diff='git diff --cached --name-only --diff-filter=A' -ok_chars='\0+[=-=]./0-9A-Z_a-z' -nbadchars=`$git_diff -z $head | tr -d "$ok_chars" | wc -c` -if test "$nbadchars" -ne 0; then - echo "File name does not consist of -+./_ or ASCII letters or digits." - exit 1 -fi - -for new_name in `$git_diff $head`; do +# 'git diff' will backslash escape tabs and newlines, so we don't have +# to worry about word splitting here. +$git_diff $head | sane_egrep 'ChangeLog|^-|/-|[^-+./_0-9A-Z_a-z]' | while IFS= read -r new_name; do case $new_name in -* | */-*) echo "$new_name: File name component begins with '-'." @@ -58,6 +53,9 @@ for new_name in `$git_diff $head`; do ChangeLog | */ChangeLog) echo "$new_name: Please use git commit messages, not ChangeLog files." exit 1;; + *) + echo "$new_name: File name does not consist of -+./_ or ASCII letters or digits." + exit 1;; esac done commit fe06fcc5955731b1373aa74a586da04f5c2c11f7 Author: Eli Zaretskii Date: Tue Aug 28 14:11:12 2018 +0300 Avoid infinite hscrolling loops when line numbers are displayed * src/xdisp.c (maybe_produce_line_number): Don't produce line numbers if we don't have enough screen estate. (Bug#32351) diff --git a/src/xdisp.c b/src/xdisp.c index 9a82953952..eccefa41cf 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -21166,8 +21166,12 @@ maybe_produce_line_number (struct it *it) an L2R paragraph. */ tem_it.bidi_it.resolved_level = 2; + /* We must leave space for 2 glyphs for continuation and truncation, + and at least one glyph for buffer text. */ + int width_limit = + tem_it.last_visible_x - tem_it.first_visible_x + - 3 * FRAME_COLUMN_WIDTH (it->f); /* Produce glyphs for the line number in a scratch glyph_row. */ - int n_glyphs_before; for (const char *p = lnum_buf; *p; p++) { /* For continuation lines and lines after ZV, instead of a line @@ -21191,18 +21195,18 @@ maybe_produce_line_number (struct it *it) else tem_it.c = tem_it.char_to_display = *p; tem_it.len = 1; - n_glyphs_before = scratch_glyph_row.used[TEXT_AREA]; /* Make sure these glyphs will have a "position" of -1. */ SET_TEXT_POS (tem_it.position, -1, -1); PRODUCE_GLYPHS (&tem_it); - /* Stop producing glyphs if we don't have enough space on - this line. FIXME: should we refrain from producing the - line number at all in that case? */ - if (tem_it.current_x > tem_it.last_visible_x) + /* Stop producing glyphs, and refrain from producing the line + number, if we don't have enough space on this line. */ + if (tem_it.current_x >= width_limit) { - scratch_glyph_row.used[TEXT_AREA] = n_glyphs_before; - break; + it->lnum_width = 0; + it->lnum_pixel_width = 0; + bidi_unshelve_cache (itdata, false); + return; } } commit 63e59c8ca51ced6c4d5951281cb21288da32ced3 Author: Eli Zaretskii Date: Tue Aug 28 10:20:46 2018 +0300 Avoid crashes in malformed defvar * src/eval.c (Fdefvar): Don't call XSYMBOL on something that might not be a symbol. This avoids crashes due to malformed 'defvar' forms. (Bug#32552) diff --git a/src/eval.c b/src/eval.c index 40cba3bb1c..f9563a3f80 100644 --- a/src/eval.c +++ b/src/eval.c @@ -773,7 +773,7 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) LOADHIST_ATTACH (sym); } else if (!NILP (Vinternal_interpreter_environment) - && !XSYMBOL (sym)->u.s.declared_special) + && (SYMBOLP (sym) && !XSYMBOL (sym)->u.s.declared_special)) /* A simple (defvar foo) with lexical scoping does "nothing" except declare that var to be dynamically scoped *locally* (i.e. within the current file or let-block). */ commit d77d01d22902acdc45c2c7059de4f1b158ab5806 Author: Paul Eggert Date: Mon Aug 27 21:27:50 2018 -0700 Improve bignum support for system types Use bignums when Emacs converts to and from system types like off_t for file sizes whose values can exceed fixnum range. Formerly, Emacs sometimes generted floats and sometimes ad-hoc conses of integers. Emacs still accepts floats and conses for these system types, in case some stray Lisp code is generating them, though this usage is obsolescent. * doc/lispref/files.texi (File Attributes): * doc/lispref/hash.texi (Defining Hash): * doc/lispref/nonascii.texi (Character Sets): * doc/lispref/os.texi (User Identification): * doc/lispref/processes.texi (System Processes): * etc/NEWS: Document changes. * src/bignum.c (mpz_set_uintmax, make_biguint) (mpz_set_uintmax_slow, bignum_to_intmax, bignum_to_uintmax): New functions. (mpz_set_intmax_slow): Implement via mpz_limbs_write, to avoid the need for an extra pass through a negative number. * src/charset.c (Fencode_char): * src/composite.h (LGLYPH_SET_CODE): * src/dired.c (file_attributes): * src/dosfns.c, src/w32.c (list_system_processes) (system_process_attributes): * src/editfns.c (init_editfns, Fuser_uid, Fuser_real_uid) (Fgroup_gid, Fgroup_real_gid, Femacs_pid): * src/emacs-module.c (check_vec_index): * src/fns.c (Fsafe_length): * src/process.c (record_deleted_pid, Fprocess_id): * src/sysdep.c (list_system_processes, system_process_attributes): * src/xselect.c (x_own_selection, selection_data_to_lisp_data): * src/xterm.c (set_wm_state): * src/inotify.c (inotifyevent_to_event, add_watch) (inotify_callback): If an integer is out of fixnum range, use a bignum instead of converting it to a float or a cons of integers. * src/coding.c (Fdefine_coding_system_internal): * src/frame.c (frame_windows_min_size) (x_set_frame_parameters): * src/fringe.c (Fdefine_fringe_bitmap): * src/nsterm.m (mouseDown:): * src/syntax.c (find_defun_start): * src/w32fns.c (x_set_undecorated, w32_createwindow) (w32_wnd_proc, Fx_create_frame, Fx_show_tip) (w32_console_toggle_lock_key): * src/w32inevt.c (key_event): * src/w32proc.c (Fw32_get_locale_info): Do not mishandle floats by treating their addresses as their values. * src/data.c (store_symval_forwarding): * src/gnutls.c (Fgnutls_error_fatalp, Fgnutls_error_string): * src/keyboard.c (command_loop_1, make_lispy_event): * src/lread.c (read_filtered_event, read1) (substitute_object_recurse): * src/window.c (Fcoordinates_in_window_p, Fwindow_at) (window_resize_apply, Fset_window_vscroll): * src/xdisp.c (handle_single_display_spec, try_scrolling) (redisplay_window, calc_pixel_width_or_height) (calc_line_height_property, on_hot_spot_p): * src/xfaces.c (check_lface_attrs): * src/xselect.c (x_get_local_selection, cons_to_x_long) (lisp_data_to_selection_data, clean_local_selection_data) (x_check_property_data, x_fill_property_data): (x_send_client_event): Do not reject bignums. * src/data.c (INTBIG_TO_LISP, intbig_to_lisp) (uintbig_to_lisp): Remove. All uses removed. * src/data.c (cons_to_unsigned, cons_to_signed): * src/dbusbind.c (xd_signature, xd_extract_signed) (xd_extract_unsigned): * src/dispnew.c (sit_for): * src/dosfns.c, src/w32.c (system_process_attributes): * src/editfns.c (Fuser_full_name): * src/fileio.c (file_offset): * src/fileio.c (write_region): * src/font.c (font_unparse_xlfd, font_open_for_lface, Fopen_font): * src/frame.c (x_set_screen_gamma): * src/frame.h (NUMVAL, FRAME_PIXEL_X_FROM_CANON_X) (FRAME_PIXEL_Y_FROM_CANON_Y): * src/image.c (parse_image_spec, x_edge_detection) (compute_image_size): * src/json.c (json_to_lisp): * src/lcms.c (PARSE_LAB_LIST_FIELD, Flcms_cie_de2000) (PARSE_XYZ_LIST_FIELD, PARSE_JCH_LIST_FIELD) (PARSE_JAB_LIST_FIELD, PARSE_VIEW_CONDITION_FLOAT) (Flcms_temp_to_white_point): * src/nsimage.m (ns_load_image, setSizeFromSpec): * src/process.c (Fsignal_process, handle_child_signal): * src/sysdep.c (system_process_attributes): * src/xdisp.c (calc_line_height_property): Handle bignums. * src/data.c (Fnumber_to_string): Use proper predicate name in signal if the argument is not a number. * src/lisp.h (make_uint): New function. (INT_TO_INTEGER): New macro. (FIXED_OR_FLOATP, CHECK_FIXNUM_OR_FLOAT) (CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER, INTEGER_TO_CONS) (make_fixnum_or_float): Remove; no longer used. * src/nsfns.m, src/w32fns.c, src/xfns.c (Fx_create_frame): Reject floating-point min-width or min-height. * src/process.c (handle_child_signal): Do not worry about floating-point pids, as they are no longer generated. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 25fabe1ea5..c50e358beb 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -1327,8 +1327,7 @@ other information recorded in the filesystem for the file, beyond the file's contents. @item -The size of the file in bytes (@code{file-attribute-size}). This is -floating point if the size is too large to fit in a Lisp integer. +The size of the file in bytes (@code{file-attribute-size}). @item The file's modes, as a string of ten letters or dashes, as in @@ -1338,21 +1337,12 @@ The file's modes, as a string of ten letters or dashes, as in An unspecified value, present for backward compatibility. @item -The file's inode number (@code{file-attribute-inode-number}). If -possible, this is an integer. If the inode number is too large to be -represented as an integer in Emacs Lisp but dividing it by -@math{2^{16}} yields a representable integer, then the value has the -form @code{(@var{high} . @var{low})}, where @var{low} holds the low 16 -bits. If the inode number is too wide for even that, the value is of -the form @code{(@var{high} @var{middle} . @var{low})}, where -@code{high} holds the high bits, @var{middle} the middle 24 bits, and -@var{low} the low 16 bits. +The file's inode number (@code{file-attribute-inode-number}). @item The filesystem number of the device that the file is on -@code{file-attribute-device-number}). Depending on the magnitude of -the value, this can be either an integer or a cons cell, in the same -manner as the inode number. This element and the file's inode number +@code{file-attribute-device-number}). +This element and the file's inode number together give enough information to distinguish any two files on the system---no two files can have the same values for both of these numbers. @@ -1368,8 +1358,8 @@ For example, here are the file attributes for @file{files.texi}: (20000 23 0 0) (20614 64555 902289 872000) 122295 "-rw-rw-rw-" - t (5888 2 . 43978) - (15479 . 46724)) + t 6473924464520138 + 1014478468) @end group @end example @@ -1410,10 +1400,10 @@ has a mode of read and write access for the owner, group, and world. @item t is merely a placeholder; it carries no information. -@item (5888 2 . 43978) +@item 6473924464520138 has an inode number of 6473924464520138. -@item (15479 . 46724) +@item 1014478468 is on the file-system device whose number is 1014478468. @end table @end defun diff --git a/doc/lispref/hash.texi b/doc/lispref/hash.texi index f7d33eafa3..9c4b56d8dc 100644 --- a/doc/lispref/hash.texi +++ b/doc/lispref/hash.texi @@ -300,8 +300,8 @@ the same integer. @defun sxhash-eql obj This function returns a hash code for Lisp object @var{obj} suitable for @code{eql} comparison. I.e. it reflects identity of @var{obj} -except for the case where the object is a float number, in which case -hash code is generated for the value. +except for the case where the object is a bignum or a float number, +in which case a hash code is generated for the value. If two objects @var{obj1} and @var{obj2} are @code{eql}, then @code{(sxhash-eql @var{obj1})} and @code{(sxhash-eql @var{obj2})} are diff --git a/doc/lispref/nonascii.texi b/doc/lispref/nonascii.texi index 4d75d6a1f1..9fb5587521 100644 --- a/doc/lispref/nonascii.texi +++ b/doc/lispref/nonascii.texi @@ -829,18 +829,18 @@ two functions support these conversions. This function decodes a character that is assigned a @var{code-point} in @var{charset}, to the corresponding Emacs character, and returns it. If @var{charset} doesn't contain a character of that code point, -the value is @code{nil}. If @var{code-point} doesn't fit in a Lisp -integer (@pxref{Integer Basics, most-positive-fixnum}), it can be +the value is @code{nil}. + +For backward compatibility, if @var{code-point} doesn't fit in a Lisp +fixnum (@pxref{Integer Basics, most-positive-fixnum}), it can be specified as a cons cell @code{(@var{high} . @var{low})}, where @var{low} are the lower 16 bits of the value and @var{high} are the -high 16 bits. +high 16 bits. This usage is obsolescent. @end defun @defun encode-char char charset This function returns the code point assigned to the character -@var{char} in @var{charset}. If the result does not fit in a Lisp -integer, it is returned as a cons cell @code{(@var{high} . @var{low})} -that fits the second argument of @code{decode-char} above. If +@var{char} in @var{charset}. If @var{charset} doesn't have a codepoint for @var{char}, the value is @code{nil}. @end defun diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index c48d08490f..0b9dd1c9cc 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -1197,24 +1197,19 @@ Titles}). @cindex UID @defun user-real-uid This function returns the real @acronym{UID} of the user. -The value may be floating point, in the (unlikely) event that -the UID is too large to fit in a Lisp integer. @end defun @defun user-uid This function returns the effective @acronym{UID} of the user. -The value may be floating point. @end defun @cindex GID @defun group-gid This function returns the effective @acronym{GID} of the Emacs process. -The value may be floating point. @end defun @defun group-real-gid This function returns the real @acronym{GID} of the Emacs process. -The value may be floating point. @end defun @defun system-users diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 447644022c..f9ba703300 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -2075,8 +2075,6 @@ attribute and @var{value} is the value of that attribute. The various attribute @var{key}s that this function can return are listed below. Not all platforms support all of these attributes; if an attribute is not supported, its association will not appear in the returned alist. -Values that are numbers can be either integer or floating point, -depending on the magnitude of the value. @table @code @item euid diff --git a/etc/NEWS b/etc/NEWS index 049863822a..ed7be1fc20 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -891,6 +891,14 @@ nonnegative value of the new variable 'integer-width' specifies the maximum number of bits allowed in a bignum. Emacs signals an integer overflow error if this limit is exceeded. +Several primitive functions formerly returned floats or lists of +integers to represent integers that did not fit into fixnums. These +functions now simply return integers instead. Affected functions +include functions like encode-char that compute code-points, functions +like file-attributes that compute file sizes and other attributes, +functions like process-id that compute process IDs, and functions like +user-uid and group-gid that compute user and group IDs. + ** define-minor-mode automatically documents the meaning of ARG. +++ diff --git a/src/bignum.c b/src/bignum.c index 18f94e7ed6..5dbfdb9319 100644 --- a/src/bignum.c +++ b/src/bignum.c @@ -67,6 +67,18 @@ make_bignum (mpz_t const op) return make_bignum_bits (op, mpz_sizeinbase (op, 2)); } +static void mpz_set_uintmax_slow (mpz_t, uintmax_t); + +/* Set RESULT to V. */ +static void +mpz_set_uintmax (mpz_t result, uintmax_t v) +{ + if (v <= ULONG_MAX) + mpz_set_ui (result, v); + else + mpz_set_uintmax_slow (result, v); +} + /* Return a Lisp integer equal to N, which must not be in fixnum range. */ Lisp_Object make_bigint (intmax_t n) @@ -79,6 +91,17 @@ make_bigint (intmax_t n) mpz_clear (z); return result; } +Lisp_Object +make_biguint (uintmax_t n) +{ + eassert (FIXNUM_OVERFLOW_P (n)); + mpz_t z; + mpz_init (z); + mpz_set_uintmax (z, n); + Lisp_Object result = make_bignum (z); + mpz_clear (z); + return result; +} /* Return a Lisp integer with value taken from OP. */ Lisp_Object @@ -109,23 +132,95 @@ make_integer (mpz_t const op) return make_bignum_bits (op, bits); } +/* Set RESULT to V. This code is for when intmax_t is wider than long. */ void mpz_set_intmax_slow (mpz_t result, intmax_t v) { - bool complement = v < 0; - if (complement) - v = -1 - v; - - enum { nails = sizeof v * CHAR_BIT - INTMAX_WIDTH }; -# ifndef HAVE_GMP - /* mini-gmp requires NAILS to be zero, which is true for all - likely Emacs platforms. Sanity-check this. */ - verify (nails == 0); -# endif - - mpz_import (result, 1, -1, sizeof v, 0, nails, &v); - if (complement) - mpz_com (result, result); + int maxlimbs = (INTMAX_WIDTH + GMP_NUMB_BITS - 1) / GMP_NUMB_BITS; + mp_limb_t *limb = mpz_limbs_write (result, maxlimbs); + int n = 0; + uintmax_t u = v; + bool negative = v < 0; + if (negative) + { + uintmax_t two = 2; + u = -u & ((two << (UINTMAX_WIDTH - 1)) - 1); + } + + do + { + limb[n++] = u; + u = GMP_NUMB_BITS < UINTMAX_WIDTH ? u >> GMP_NUMB_BITS : 0; + } + while (u != 0); + + mpz_limbs_finish (result, negative ? -n : n); +} +static void +mpz_set_uintmax_slow (mpz_t result, uintmax_t v) +{ + int maxlimbs = (UINTMAX_WIDTH + GMP_NUMB_BITS - 1) / GMP_NUMB_BITS; + mp_limb_t *limb = mpz_limbs_write (result, maxlimbs); + int n = 0; + + do + { + limb[n++] = v; + v = GMP_NUMB_BITS < INTMAX_WIDTH ? v >> GMP_NUMB_BITS : 0; + } + while (v != 0); + + mpz_limbs_finish (result, n); +} + +/* Return the value of the bignum X if it fits, 0 otherwise. + A bignum cannot be zero, so 0 indicates failure reliably. */ +intmax_t +bignum_to_intmax (Lisp_Object x) +{ + ptrdiff_t bits = mpz_sizeinbase (XBIGNUM (x)->value, 2); + bool negative = mpz_sgn (XBIGNUM (x)->value) < 0; + + if (bits < INTMAX_WIDTH) + { + intmax_t v = 0; + int i = 0, shift = 0; + + do + { + intmax_t limb = mpz_getlimbn (XBIGNUM (x)->value, i++); + v += limb << shift; + shift += GMP_NUMB_BITS; + } + while (shift < bits); + + return negative ? -v : v; + } + return ((bits == INTMAX_WIDTH && INTMAX_MIN < -INTMAX_MAX && negative + && mpz_scan1 (XBIGNUM (x)->value, 0) == INTMAX_WIDTH - 1) + ? INTMAX_MIN : 0); +} +uintmax_t +bignum_to_uintmax (Lisp_Object x) +{ + uintmax_t v = 0; + if (0 <= mpz_sgn (XBIGNUM (x)->value)) + { + ptrdiff_t bits = mpz_sizeinbase (XBIGNUM (x)->value, 2); + if (bits <= UINTMAX_WIDTH) + { + int i = 0, shift = 0; + + do + { + uintmax_t limb = mpz_getlimbn (XBIGNUM (x)->value, i++); + v += limb << shift; + shift += GMP_NUMB_BITS; + } + while (shift < bits); + } + } + return v; } /* Convert NUM to a base-BASE Lisp string. */ diff --git a/src/charset.c b/src/charset.c index e77a3900b8..7b272a204a 100644 --- a/src/charset.c +++ b/src/charset.c @@ -929,8 +929,8 @@ usage: (define-charset-internal ...) */) if (code < charset.min_code || code > charset.max_code) - args_out_of_range_3 (make_fixnum_or_float (charset.min_code), - make_fixnum_or_float (charset.max_code), val); + args_out_of_range_3 (INT_TO_INTEGER (charset.min_code), + INT_TO_INTEGER (charset.max_code), val); charset.char_index_offset = CODE_POINT_TO_INDEX (&charset, code); charset.min_code = code; } @@ -942,8 +942,8 @@ usage: (define-charset-internal ...) */) if (code < charset.min_code || code > charset.max_code) - args_out_of_range_3 (make_fixnum_or_float (charset.min_code), - make_fixnum_or_float (charset.max_code), val); + args_out_of_range_3 (INT_TO_INTEGER (charset.min_code), + INT_TO_INTEGER (charset.max_code), val); charset.max_code = code; } @@ -1852,7 +1852,8 @@ DEFUN ("decode-char", Fdecode_char, Sdecode_char, 2, 2, 0, doc: /* Decode the pair of CHARSET and CODE-POINT into a character. Return nil if CODE-POINT is not valid in CHARSET. -CODE-POINT may be a cons (HIGHER-16-BIT-VALUE . LOWER-16-BIT-VALUE). */) +CODE-POINT may be a cons (HIGHER-16-BIT-VALUE . LOWER-16-BIT-VALUE), +although this usage is obsolescent. */) (Lisp_Object charset, Lisp_Object code_point) { int c, id; @@ -1883,7 +1884,7 @@ Return nil if CHARSET doesn't include CH. */) code = ENCODE_CHAR (charsetp, c); if (code == CHARSET_INVALID_CODE (charsetp)) return Qnil; - return INTEGER_TO_CONS (code); + return INT_TO_INTEGER (code); } diff --git a/src/coding.c b/src/coding.c index 53e98f8981..966492a322 100644 --- a/src/coding.c +++ b/src/coding.c @@ -10214,7 +10214,7 @@ usage: (define-coding-system-internal ...) */) tmp = AREF (val, i); if (NILP (tmp)) tmp = XCAR (tail); - else if (FIXED_OR_FLOATP (tmp)) + else if (FIXNATP (tmp)) { dim2 = CHARSET_DIMENSION (CHARSET_FROM_ID (XFIXNAT (tmp))); if (dim < dim2) diff --git a/src/composite.h b/src/composite.h index 2d03e48ecc..8039113d87 100644 --- a/src/composite.h +++ b/src/composite.h @@ -294,7 +294,7 @@ enum lglyph_indices /* Callers must assure that VAL is not negative! */ #define LGLYPH_SET_CODE(g, val) \ ASET (g, LGLYPH_IX_CODE, \ - val == FONT_INVALID_CODE ? Qnil : INTEGER_TO_CONS (val)) + val == FONT_INVALID_CODE ? Qnil : INT_TO_INTEGER (val)) #define LGLYPH_SET_WIDTH(g, val) ASET ((g), LGLYPH_IX_WIDTH, make_fixnum (val)) #define LGLYPH_SET_LBEARING(g, val) ASET ((g), LGLYPH_IX_LBEARING, make_fixnum (val)) diff --git a/src/data.c b/src/data.c index ece76a5bc6..6afda1e6fb 100644 --- a/src/data.c +++ b/src/data.c @@ -1132,7 +1132,7 @@ store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newva else if ((prop = Fget (predicate, Qrange), !NILP (prop))) { Lisp_Object min = XCAR (prop), max = XCDR (prop); - if (! FIXED_OR_FLOATP (newval) + if (! NUMBERP (newval) || NILP (CALLN (Fleq, min, newval, max))) wrong_range (min, max, newval); } @@ -2627,48 +2627,21 @@ DEFUN ("/=", Fneq, Sneq, 2, 2, 0, return arithcompare (num1, num2, ARITH_NOTEQUAL); } -/* Convert the integer I to a cons-of-integers, where I is not in - fixnum range. */ - -#define INTBIG_TO_LISP(i, extremum) \ - (eassert (FIXNUM_OVERFLOW_P (i)), \ - (! (FIXNUM_OVERFLOW_P ((extremum) >> 16) \ - && FIXNUM_OVERFLOW_P ((i) >> 16)) \ - ? Fcons (make_fixnum ((i) >> 16), make_fixnum ((i) & 0xffff)) \ - : ! (FIXNUM_OVERFLOW_P ((extremum) >> 16 >> 24) \ - && FIXNUM_OVERFLOW_P ((i) >> 16 >> 24)) \ - ? Fcons (make_fixnum ((i) >> 16 >> 24), \ - Fcons (make_fixnum ((i) >> 16 & 0xffffff), \ - make_fixnum ((i) & 0xffff))) \ - : make_float (i))) - -Lisp_Object -intbig_to_lisp (intmax_t i) -{ - return INTBIG_TO_LISP (i, INTMAX_MIN); -} - -Lisp_Object -uintbig_to_lisp (uintmax_t i) -{ - return INTBIG_TO_LISP (i, UINTMAX_MAX); -} - /* Convert the cons-of-integers, integer, or float value C to an unsigned value with maximum value MAX, where MAX is one less than a power of 2. Signal an error if C does not have a valid format or - is out of range. */ + is out of range. + + Although Emacs represents large integers with bignums instead of + cons-of-integers or floats, for now this function still accepts the + obsolete forms in case some old Lisp code still generates them. */ uintmax_t cons_to_unsigned (Lisp_Object c, uintmax_t max) { bool valid = false; uintmax_t val UNINIT; - if (FIXNUMP (c)) - { - valid = XFIXNUM (c) >= 0; - val = XFIXNUM (c); - } - else if (FLOATP (c)) + + if (FLOATP (c)) { double d = XFLOAT_DATA (c); if (d >= 0 && d < 1.0 + max) @@ -2677,27 +2650,44 @@ cons_to_unsigned (Lisp_Object c, uintmax_t max) valid = val == d; } } - else if (CONSP (c) && FIXNATP (XCAR (c))) + else { - uintmax_t top = XFIXNAT (XCAR (c)); - Lisp_Object rest = XCDR (c); - if (top <= UINTMAX_MAX >> 24 >> 16 - && CONSP (rest) - && FIXNATP (XCAR (rest)) && XFIXNAT (XCAR (rest)) < 1 << 24 - && FIXNATP (XCDR (rest)) && XFIXNAT (XCDR (rest)) < 1 << 16) + Lisp_Object hi = CONSP (c) ? XCAR (c) : c; + + if (FIXNUMP (hi)) { - uintmax_t mid = XFIXNAT (XCAR (rest)); - val = top << 24 << 16 | mid << 16 | XFIXNAT (XCDR (rest)); - valid = true; + val = XFIXNUM (hi); + valid = 0 <= val; } - else if (top <= UINTMAX_MAX >> 16) + else { - if (CONSP (rest)) - rest = XCAR (rest); - if (FIXNATP (rest) && XFIXNAT (rest) < 1 << 16) + val = bignum_to_uintmax (hi); + valid = val != 0; + } + + if (valid && CONSP (c)) + { + uintmax_t top = val; + Lisp_Object rest = XCDR (c); + if (top <= UINTMAX_MAX >> 24 >> 16 + && CONSP (rest) + && FIXNATP (XCAR (rest)) && XFIXNAT (XCAR (rest)) < 1 << 24 + && FIXNATP (XCDR (rest)) && XFIXNAT (XCDR (rest)) < 1 << 16) { - val = top << 16 | XFIXNAT (rest); - valid = true; + uintmax_t mid = XFIXNAT (XCAR (rest)); + val = top << 24 << 16 | mid << 16 | XFIXNAT (XCDR (rest)); + } + else + { + valid = top <= UINTMAX_MAX >> 16; + if (valid) + { + if (CONSP (rest)) + rest = XCAR (rest); + valid = FIXNATP (rest) && XFIXNAT (rest) < 1 << 16; + if (valid) + val = top << 16 | XFIXNAT (rest); + } } } } @@ -2711,18 +2701,18 @@ cons_to_unsigned (Lisp_Object c, uintmax_t max) value with extrema MIN and MAX. MAX should be one less than a power of 2, and MIN should be zero or the negative of a power of 2. Signal an error if C does not have a valid format or is out of - range. */ + range. + + Although Emacs represents large integers with bignums instead of + cons-of-integers or floats, for now this function still accepts the + obsolete forms in case some old Lisp code still generates them. */ intmax_t cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max) { bool valid = false; intmax_t val UNINIT; - if (FIXNUMP (c)) - { - val = XFIXNUM (c); - valid = true; - } - else if (FLOATP (c)) + + if (FLOATP (c)) { double d = XFLOAT_DATA (c); if (d >= min && d < 1.0 + max) @@ -2731,27 +2721,44 @@ cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max) valid = val == d; } } - else if (CONSP (c) && FIXNUMP (XCAR (c))) + else { - intmax_t top = XFIXNUM (XCAR (c)); - Lisp_Object rest = XCDR (c); - if (top >= INTMAX_MIN >> 24 >> 16 && top <= INTMAX_MAX >> 24 >> 16 - && CONSP (rest) - && FIXNATP (XCAR (rest)) && XFIXNAT (XCAR (rest)) < 1 << 24 - && FIXNATP (XCDR (rest)) && XFIXNAT (XCDR (rest)) < 1 << 16) + Lisp_Object hi = CONSP (c) ? XCAR (c) : c; + + if (FIXNUMP (hi)) { - intmax_t mid = XFIXNAT (XCAR (rest)); - val = top << 24 << 16 | mid << 16 | XFIXNAT (XCDR (rest)); + val = XFIXNUM (hi); valid = true; } - else if (top >= INTMAX_MIN >> 16 && top <= INTMAX_MAX >> 16) + else if (BIGNUMP (hi)) { - if (CONSP (rest)) - rest = XCAR (rest); - if (FIXNATP (rest) && XFIXNAT (rest) < 1 << 16) + val = bignum_to_intmax (hi); + valid = val != 0; + } + + if (valid && CONSP (c)) + { + intmax_t top = val; + Lisp_Object rest = XCDR (c); + if (top >= INTMAX_MIN >> 24 >> 16 && top <= INTMAX_MAX >> 24 >> 16 + && CONSP (rest) + && FIXNATP (XCAR (rest)) && XFIXNAT (XCAR (rest)) < 1 << 24 + && FIXNATP (XCDR (rest)) && XFIXNAT (XCDR (rest)) < 1 << 16) + { + intmax_t mid = XFIXNAT (XCAR (rest)); + val = top << 24 << 16 | mid << 16 | XFIXNAT (XCDR (rest)); + } + else { - val = top << 16 | XFIXNAT (rest); - valid = true; + valid = INTMAX_MIN >> 16 <= top && top <= INTMAX_MAX >> 16; + if (valid) + { + if (CONSP (rest)) + rest = XCAR (rest); + valid = FIXNATP (rest) && XFIXNAT (rest) < 1 << 16; + if (valid) + val = top << 16 | XFIXNAT (rest); + } } } } @@ -2770,11 +2777,11 @@ NUMBER may be an integer or a floating point number. */) char buffer[max (FLOAT_TO_STRING_BUFSIZE, INT_BUFSIZE_BOUND (EMACS_INT))]; int len; + CHECK_NUMBER (number); + if (BIGNUMP (number)) return bignum_to_string (number, 10); - CHECK_FIXNUM_OR_FLOAT (number); - if (FLOATP (number)) len = float_to_string (buffer, XFLOAT_DATA (number)); else diff --git a/src/dbusbind.c b/src/dbusbind.c index fe92d3997b..47346a7d4d 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -378,7 +378,7 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) case DBUS_TYPE_INT32: case DBUS_TYPE_INT64: case DBUS_TYPE_DOUBLE: - CHECK_FIXNUM_OR_FLOAT (object); + CHECK_NUMBER (object); sprintf (signature, "%c", dtype); break; @@ -519,13 +519,13 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) static intmax_t xd_extract_signed (Lisp_Object x, intmax_t lo, intmax_t hi) { - CHECK_FIXNUM_OR_FLOAT (x); + CHECK_NUMBER (x); if (FIXNUMP (x)) { if (lo <= XFIXNUM (x) && XFIXNUM (x) <= hi) return XFIXNUM (x); } - else + else if (FLOATP (x)) { double d = XFLOAT_DATA (x); if (lo <= d && d < 1.0 + hi) @@ -535,25 +535,30 @@ xd_extract_signed (Lisp_Object x, intmax_t lo, intmax_t hi) return n; } } + else if (! (MOST_NEGATIVE_FIXNUM <= lo && hi <= MOST_POSITIVE_FIXNUM)) + { + intmax_t i = bignum_to_intmax (x); + if (i != 0 && lo <= i && i <= hi) + return i; + } + if (xd_in_read_queued_messages) Fthrow (Qdbus_error, Qnil); else - args_out_of_range_3 (x, - make_fixnum_or_float (lo), - make_fixnum_or_float (hi)); + args_out_of_range_3 (x, INT_TO_INTEGER (lo), INT_TO_INTEGER (hi)); } /* Convert X to an unsigned integer with bounds 0 and HI. */ static uintmax_t xd_extract_unsigned (Lisp_Object x, uintmax_t hi) { - CHECK_FIXNUM_OR_FLOAT (x); + CHECK_NUMBER (x); if (FIXNUMP (x)) { if (0 <= XFIXNUM (x) && XFIXNUM (x) <= hi) return XFIXNUM (x); } - else + else if (FLOATP (x)) { double d = XFLOAT_DATA (x); if (0 <= d && d < 1.0 + hi) @@ -563,10 +568,17 @@ xd_extract_unsigned (Lisp_Object x, uintmax_t hi) return n; } } + else if (! (hi <= MOST_POSITIVE_FIXNUM)) + { + uintmax_t i = bignum_to_uintmax (x); + if (i != 0 && i <= hi) + return i; + } + if (xd_in_read_queued_messages) Fthrow (Qdbus_error, Qnil); else - args_out_of_range_3 (x, make_fixnum (0), make_fixnum_or_float (hi)); + args_out_of_range_3 (x, make_fixnum (0), INT_TO_INTEGER (hi)); } /* Append C value, extracted from Lisp OBJECT, to iteration ITER. @@ -848,7 +860,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter) dbus_message_iter_get_basic (iter, &val); pval = val; XD_DEBUG_MESSAGE ("%c %d", dtype, pval); - return make_fixnum_or_float (val); + return INT_TO_INTEGER (val); } case DBUS_TYPE_UINT32: @@ -861,7 +873,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter) dbus_message_iter_get_basic (iter, &val); pval = val; XD_DEBUG_MESSAGE ("%c %u", dtype, pval); - return make_fixnum_or_float (val); + return INT_TO_INTEGER (val); } case DBUS_TYPE_INT64: @@ -871,7 +883,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter) dbus_message_iter_get_basic (iter, &val); pval = val; XD_DEBUG_MESSAGE ("%c %"pMd, dtype, pval); - return make_fixnum_or_float (val); + return INT_TO_INTEGER (val); } case DBUS_TYPE_UINT64: @@ -881,7 +893,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter) dbus_message_iter_get_basic (iter, &val); pval = val; XD_DEBUG_MESSAGE ("%c %"pMu, dtype, pval); - return make_fixnum_or_float (val); + return INT_TO_INTEGER (val); } case DBUS_TYPE_DOUBLE: @@ -1454,7 +1466,7 @@ usage: (dbus-message-internal &rest REST) */) /* The result is the key in Vdbus_registered_objects_table. */ serial = dbus_message_get_serial (dmessage); - result = list3 (QCserial, bus, make_fixnum_or_float (serial)); + result = list3 (QCserial, bus, INT_TO_INTEGER (serial)); /* Create a hash table entry. */ Fputhash (result, handler, Vdbus_registered_objects_table); @@ -1541,7 +1553,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) || (mtype == DBUS_MESSAGE_TYPE_ERROR)) { /* Search for a registered function of the message. */ - key = list3 (QCserial, bus, make_fixnum_or_float (serial)); + key = list3 (QCserial, bus, INT_TO_INTEGER (serial)); value = Fgethash (key, Vdbus_registered_objects_table, Qnil); /* There shall be exactly one entry. Construct an event. */ @@ -1608,7 +1620,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) event.arg); event.arg = Fcons ((uname == NULL ? Qnil : build_string (uname)), event.arg); - event.arg = Fcons (make_fixnum_or_float (serial), event.arg); + event.arg = Fcons (INT_TO_INTEGER (serial), event.arg); event.arg = Fcons (make_fixnum (mtype), event.arg); /* Add the bus symbol to the event. */ diff --git a/src/dired.c b/src/dired.c index b92cd2b9f0..c4cda400a0 100644 --- a/src/dired.c +++ b/src/dired.c @@ -867,7 +867,7 @@ Elements of the attribute list are: 0. t for directory, string (name linked to) for symbolic link, or nil. 1. Number of links to file. 2. File uid as a string or a number. If a string value cannot be - looked up, a numeric value, either an integer or a float, is returned. + looked up, an integer value is returned. 3. File gid, likewise. 4. Last access time, as a list of integers (HIGH LOW USEC PSEC) in the same style as (current-time). @@ -877,7 +877,6 @@ Elements of the attribute list are: 6. Last status change time, likewise. This is the time of last change to the file's attributes: owner and group, access mode bits, etc. 7. Size in bytes. - This is a floating point number if the size is too large for an integer. 8. File modes, as a string of ten letters or dashes as in ls -l. 9. An unspecified value, present only for backward compatibility. 10. inode number. If it is larger than what an Emacs integer can hold, @@ -1012,10 +1011,10 @@ file_attributes (int fd, char const *name, make_fixnum (s.st_nlink), (uname ? DECODE_SYSTEM (build_unibyte_string (uname)) - : make_fixnum_or_float (s.st_uid)), + : INT_TO_INTEGER (s.st_uid)), (gname ? DECODE_SYSTEM (build_unibyte_string (gname)) - : make_fixnum_or_float (s.st_gid)), + : INT_TO_INTEGER (s.st_gid)), make_lisp_time (get_stat_atime (&s)), make_lisp_time (get_stat_mtime (&s)), make_lisp_time (get_stat_ctime (&s)), @@ -1024,14 +1023,14 @@ file_attributes (int fd, char const *name, files of sizes in the 2-4 GiB range wrap around to negative values, as this is a common bug on older 32-bit platforms. */ - make_fixnum_or_float (sizeof (s.st_size) == 4 - ? s.st_size & 0xffffffffu - : s.st_size), + INT_TO_INTEGER (sizeof (s.st_size) == 4 + ? s.st_size & 0xffffffffu + : s.st_size), make_string (modes, 10), Qt, - INTEGER_TO_CONS (s.st_ino), - INTEGER_TO_CONS (s.st_dev)); + INT_TO_INTEGER (s.st_ino), + INT_TO_INTEGER (s.st_dev)); } DEFUN ("file-attributes-lessp", Ffile_attributes_lessp, Sfile_attributes_lessp, 2, 2, 0, diff --git a/src/dispnew.c b/src/dispnew.c index b54ae88364..97c6a446a6 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -5773,6 +5773,15 @@ sit_for (Lisp_Object timeout, bool reading, int display_option) return Qt; nsec = 0; } + else if (BIGNUMP (timeout)) + { + if (!Fnatnump (timeout)) + return Qt; + sec = bignum_to_intmax (timeout); + if (sec == 0) + sec = WAIT_READING_MAX; + nsec = 0; + } else if (FLOATP (timeout)) { double seconds = XFLOAT_DATA (timeout); diff --git a/src/dosfns.c b/src/dosfns.c index 25932ff1e1..c159b26014 100644 --- a/src/dosfns.c +++ b/src/dosfns.c @@ -509,7 +509,7 @@ list_system_processes (void) { Lisp_Object proclist = Qnil; - proclist = Fcons (make_fixnum_or_float (getpid ()), proclist); + proclist = Fcons (INT_TO_INTEGER (getpid ()), proclist); return proclist; } @@ -520,8 +520,8 @@ system_process_attributes (Lisp_Object pid) int proc_id; Lisp_Object attrs = Qnil; - CHECK_FIXNUM_OR_FLOAT (pid); - proc_id = FLOATP (pid) ? XFLOAT_DATA (pid) : XFIXNUM (pid); + CHECK_NUMBER (pid); + proc_id = XFLOATINT (pid); if (proc_id == getpid ()) { @@ -539,12 +539,12 @@ system_process_attributes (Lisp_Object pid) #endif uid = getuid (); - attrs = Fcons (Fcons (Qeuid, make_fixnum_or_float (uid)), attrs); + attrs = Fcons (Fcons (Qeuid, INT_TO_INTEGER (uid)), attrs); usr = getlogin (); if (usr) attrs = Fcons (Fcons (Quser, build_string (usr)), attrs); gid = getgid (); - attrs = Fcons (Fcons (Qegid, make_fixnum_or_float (gid)), attrs); + attrs = Fcons (Fcons (Qegid, INT_TO_INTEGER (gid)), attrs); gr = getgrgid (gid); if (gr) attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs); @@ -566,7 +566,7 @@ system_process_attributes (Lisp_Object pid) Fsymbol_value (intern ("before-init-time"))), attrs); attrs = Fcons (Fcons (Qvsize, - make_fixnum_or_float ((unsigned long)sbrk (0)/1024)), + INT_TO_INTEGER ((unsigned long) sbrk (0) / 1024)), attrs); attrs = Fcons (Fcons (Qetime, tem), attrs); #ifndef SYSTEM_MALLOC diff --git a/src/editfns.c b/src/editfns.c index 9ca6f373e0..ad5a26606b 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -329,7 +329,7 @@ init_editfns (bool dumping) else { uid_t euid = geteuid (); - tem = make_fixnum_or_float (euid); + tem = INT_TO_INTEGER (euid); } Vuser_full_name = Fuser_full_name (tem); @@ -1338,7 +1338,7 @@ This is based on the effective uid, not the real uid. Also, if the environment variables LOGNAME or USER are set, that determines the value of this function. -If optional argument UID is an integer or a float, return the login name +If optional argument UID is an integer, return the login name of the user with that uid, or nil if there is no such user. */) (Lisp_Object uid) { @@ -1377,39 +1377,35 @@ This ignores the environment variables LOGNAME and USER, so it differs from } DEFUN ("user-uid", Fuser_uid, Suser_uid, 0, 0, 0, - doc: /* Return the effective uid of Emacs. -Value is an integer or a float, depending on the value. */) + doc: /* Return the effective uid of Emacs. */) (void) { uid_t euid = geteuid (); - return make_fixnum_or_float (euid); + return INT_TO_INTEGER (euid); } DEFUN ("user-real-uid", Fuser_real_uid, Suser_real_uid, 0, 0, 0, - doc: /* Return the real uid of Emacs. -Value is an integer or a float, depending on the value. */) + doc: /* Return the real uid of Emacs. */) (void) { uid_t uid = getuid (); - return make_fixnum_or_float (uid); + return INT_TO_INTEGER (uid); } DEFUN ("group-gid", Fgroup_gid, Sgroup_gid, 0, 0, 0, - doc: /* Return the effective gid of Emacs. -Value is an integer or a float, depending on the value. */) + doc: /* Return the effective gid of Emacs. */) (void) { gid_t egid = getegid (); - return make_fixnum_or_float (egid); + return INT_TO_INTEGER (egid); } DEFUN ("group-real-gid", Fgroup_real_gid, Sgroup_real_gid, 0, 0, 0, - doc: /* Return the real gid of Emacs. -Value is an integer or a float, depending on the value. */) + doc: /* Return the real gid of Emacs. */) (void) { gid_t gid = getgid (); - return make_fixnum_or_float (gid); + return INT_TO_INTEGER (gid); } DEFUN ("user-full-name", Fuser_full_name, Suser_full_name, 0, 1, 0, @@ -1417,7 +1413,7 @@ DEFUN ("user-full-name", Fuser_full_name, Suser_full_name, 0, 1, 0, If the full name corresponding to Emacs's userid is not known, return "unknown". -If optional argument UID is an integer or float, return the full name +If optional argument UID is an integer, return the full name of the user with that uid, or nil if there is no such user. If UID is a string, return the full name of the user with that login name, or nil if there is no such user. */) @@ -1429,7 +1425,7 @@ name, or nil if there is no such user. */) if (NILP (uid)) return Vuser_full_name; - else if (FIXED_OR_FLOATP (uid)) + else if (NUMBERP (uid)) { uid_t u; CONS_TO_INTEGER (uid, uid_t, u); @@ -1489,7 +1485,7 @@ DEFUN ("emacs-pid", Femacs_pid, Semacs_pid, 0, 0, 0, (void) { pid_t pid = getpid (); - return make_fixnum_or_float (pid); + return INT_TO_INTEGER (pid); } diff --git a/src/emacs-module.c b/src/emacs-module.c index a1bed491b6..cf92b0fdb5 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -646,7 +646,7 @@ check_vec_index (Lisp_Object lvec, ptrdiff_t i) { CHECK_VECTOR (lvec); if (! (0 <= i && i < ASIZE (lvec))) - args_out_of_range_3 (make_fixnum_or_float (i), + args_out_of_range_3 (INT_TO_INTEGER (i), make_fixnum (0), make_fixnum (ASIZE (lvec) - 1)); } diff --git a/src/fileio.c b/src/fileio.c index 04e763f83b..a91bdaa53d 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -3427,6 +3427,13 @@ file_offset (Lisp_Object val) if (RANGED_FIXNUMP (0, val, TYPE_MAXIMUM (off_t))) return XFIXNUM (val); + if (BIGNUMP (val)) + { + intmax_t v = bignum_to_intmax (val); + if (0 < v && v <= TYPE_MAXIMUM (off_t)) + return v; + } + if (FLOATP (val)) { double v = XFLOAT_DATA (val); @@ -4946,7 +4953,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, fn = SSDATA (encoded_filename); open_flags = O_WRONLY | O_CREAT; open_flags |= EQ (mustbenew, Qexcl) ? O_EXCL : !NILP (append) ? 0 : O_TRUNC; - if (FIXED_OR_FLOATP (append)) + if (NUMBERP (append)) offset = file_offset (append); else if (!NILP (append)) open_flags |= O_APPEND; @@ -4971,7 +4978,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, record_unwind_protect_int (close_file_unwind, desc); } - if (FIXED_OR_FLOATP (append)) + if (NUMBERP (append)) { off_t ret = lseek (desc, offset, SEEK_SET); if (ret < 0) @@ -5154,7 +5161,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, } if (!auto_saving && !noninteractive) - message_with_string ((FIXED_OR_FLOATP (append) + message_with_string ((NUMBERP (append) ? "Updated %s" : ! NILP (append) ? "Added to %s" diff --git a/src/fns.c b/src/fns.c index 3f7dfeddb6..17a869e1ab 100644 --- a/src/fns.c +++ b/src/fns.c @@ -132,14 +132,14 @@ To get the number of bytes, use `string-bytes'. */) DEFUN ("safe-length", Fsafe_length, Ssafe_length, 1, 1, 0, doc: /* Return the length of a list, but avoid error or infinite loop. This function never gets an error. If LIST is not really a list, -it returns 0. If LIST is circular, it returns a finite value -which is at least the number of distinct elements. */) +it returns 0. If LIST is circular, it returns an integer that is at +least the number of distinct elements. */) (Lisp_Object list) { intptr_t len = 0; FOR_EACH_TAIL_SAFE (list) len++; - return make_fixnum_or_float (len); + return INT_TO_INTEGER (len); } DEFUN ("proper-list-p", Fproper_list_p, Sproper_list_p, 1, 1, 0, diff --git a/src/font.c b/src/font.c index 920ec1e02b..4a63700f79 100644 --- a/src/font.c +++ b/src/font.c @@ -1283,19 +1283,20 @@ font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes) } val = AREF (font, FONT_SIZE_INDEX); - eassert (FIXED_OR_FLOATP (val) || NILP (val)); + eassert (NUMBERP (val) || NILP (val)); char font_size_index_buf[sizeof "-*" + max (INT_STRLEN_BOUND (EMACS_INT), 1 + DBL_MAX_10_EXP + 1)]; - if (FIXNUMP (val)) + if (INTEGERP (val)) { - EMACS_INT v = XFIXNUM (val); - if (v <= 0) + intmax_t v = FIXNUMP (val) ? XFIXNUM (val) : bignum_to_intmax (val); + if (! (0 <= v && v <= TYPE_MAXIMUM (uprintmax_t))) v = pixel_size; if (v > 0) { + uprintmax_t u = v; f[XLFD_PIXEL_INDEX] = p = font_size_index_buf; - sprintf (p, "%"pI"d-*", v); + sprintf (p, "%"pMu"-*", u); } else f[XLFD_PIXEL_INDEX] = "*-*"; @@ -3324,8 +3325,9 @@ font_open_for_lface (struct frame *f, Lisp_Object entity, Lisp_Object *attrs, Li if (size == 0) { Lisp_Object ffsize = get_frame_param (f, Qfontsize); - size = (FIXED_OR_FLOATP (ffsize) - ? POINT_TO_PIXEL (XFIXNUM (ffsize), FRAME_RES_Y (f)) : 0); + size = (NUMBERP (ffsize) + ? POINT_TO_PIXEL (XFLOATINT (ffsize), FRAME_RES_Y (f)) + : 0); } #endif } @@ -4503,7 +4505,7 @@ where if (variations[i]) { int vs = (i < 16 ? 0xFE00 + i : 0xE0100 + (i - 16)); - Lisp_Object code = INTEGER_TO_CONS (variations[i]); + Lisp_Object code = INT_TO_INTEGER (variations[i]); val = Fcons (Fcons (make_fixnum (vs), code), val); } return val; @@ -4606,7 +4608,7 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0, return Qnil; Lisp_Object font_object; XSETFONT (font_object, face->font); - return Fcons (font_object, INTEGER_TO_CONS (code)); + return Fcons (font_object, INT_TO_INTEGER (code)); } #if 0 @@ -4735,7 +4737,7 @@ DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0, doc: /* Open FONT-ENTITY. */) (Lisp_Object font_entity, Lisp_Object size, Lisp_Object frame) { - EMACS_INT isize; + intmax_t isize; struct frame *f = decode_live_frame (frame); CHECK_FONT_ENTITY (font_entity); @@ -4744,11 +4746,17 @@ DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0, isize = XFIXNUM (AREF (font_entity, FONT_SIZE_INDEX)); else { - CHECK_FIXNUM_OR_FLOAT (size); - if (FLOATP (size)) - isize = POINT_TO_PIXEL (XFLOAT_DATA (size), FRAME_RES_Y (f)); + CHECK_NUMBER (size); + if (BIGNUMP (size)) + { + isize = bignum_to_intmax (size); + if (isize == 0) + args_out_of_range (font_entity, size); + } else - isize = XFIXNUM (size); + isize = (FLOATP (size) + ? POINT_TO_PIXEL (XFLOAT_DATA (size), FRAME_RES_Y (f)) + : XFIXNUM (size)); if (! (INT_MIN <= isize && isize <= INT_MAX)) args_out_of_range (font_entity, size); if (isize == 0) diff --git a/src/frame.c b/src/frame.c index ece8971d5b..4371ef7f06 100644 --- a/src/frame.c +++ b/src/frame.c @@ -350,9 +350,13 @@ frame_windows_min_size (Lisp_Object frame, Lisp_Object horizontal, int retval; if ((!NILP (horizontal) - && FIXED_OR_FLOATP (par_size = get_frame_param (f, Qmin_width))) + && RANGED_FIXNUMP (INT_MIN, + par_size = get_frame_param (f, Qmin_width), + INT_MAX)) || (NILP (horizontal) - && FIXED_OR_FLOATP (par_size = get_frame_param (f, Qmin_height)))) + && RANGED_FIXNUMP (INT_MIN, + par_size = get_frame_param (f, Qmin_height), + INT_MAX))) { int min_size = XFIXNUM (par_size); @@ -3974,8 +3978,8 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist) if ((!NILP (left) || !NILP (top)) && ! (left_no_change && top_no_change) - && ! (FIXED_OR_FLOATP (left) && XFIXNUM (left) == f->left_pos - && FIXED_OR_FLOATP (top) && XFIXNUM (top) == f->top_pos)) + && ! (FIXNUMP (left) && XFIXNUM (left) == f->left_pos + && FIXNUMP (top) && XFIXNUM (top) == f->top_pos)) { int leftpos = 0; int toppos = 0; @@ -4208,7 +4212,7 @@ x_set_screen_gamma (struct frame *f, Lisp_Object new_value, Lisp_Object old_valu if (NILP (new_value)) f->gamma = 0; - else if (FIXED_OR_FLOATP (new_value) && XFLOATINT (new_value) > 0) + else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0) /* The value 0.4545 is the normal viewing gamma. */ f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value)); else diff --git a/src/frame.h b/src/frame.h index 87d0d5a341..a3bb633e57 100644 --- a/src/frame.h +++ b/src/frame.h @@ -699,7 +699,7 @@ fset_desired_tool_bar_string (struct frame *f, Lisp_Object val) INLINE double NUMVAL (Lisp_Object x) { - return FIXED_OR_FLOATP (x) ? XFLOATINT (x) : -1; + return NUMBERP (x) ? XFLOATINT (x) : -1; } INLINE double @@ -1360,17 +1360,13 @@ FRAME_BOTTOM_DIVIDER_WIDTH (struct frame *f) canonical char width is to be used. X must be a Lisp integer or float. Value is a C integer. */ #define FRAME_PIXEL_X_FROM_CANON_X(F, X) \ - (FIXNUMP (X) \ - ? XFIXNUM (X) * FRAME_COLUMN_WIDTH (F) \ - : (int) (XFLOAT_DATA (X) * FRAME_COLUMN_WIDTH (F))) + ((int) (XFLOATINT (X) * FRAME_COLUMN_WIDTH (F))) /* Convert canonical value Y to pixels. F is the frame whose canonical character height is to be used. X must be a Lisp integer or float. Value is a C integer. */ #define FRAME_PIXEL_Y_FROM_CANON_Y(F, Y) \ - (FIXNUMP (Y) \ - ? XFIXNUM (Y) * FRAME_LINE_HEIGHT (F) \ - : (int) (XFLOAT_DATA (Y) * FRAME_LINE_HEIGHT (F))) + ((int) (XFLOATINT (Y) * FRAME_LINE_HEIGHT (F))) /* Convert pixel-value X to canonical units. F is the frame whose canonical character width is to be used. X is a C integer. Result diff --git a/src/fringe.c b/src/fringe.c index 583bba4e51..6a44de1bf2 100644 --- a/src/fringe.c +++ b/src/fringe.c @@ -1605,7 +1605,7 @@ If BITMAP already exists, the existing definition is replaced. */) for (i = 0; i < h && j < fb.height; i++) { Lisp_Object elt = Faref (bits, make_fixnum (i)); - b[j++] = FIXED_OR_FLOATP (elt) ? XFIXNUM (elt) : 0; + b[j++] = FIXNUMP (elt) ? XFIXNUM (elt) : 0; } for (i = 0; i < fill2 && j < fb.height; i++) b[j++] = 0; diff --git a/src/gnutls.c b/src/gnutls.c index aa5c97532f..a48d99832a 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -924,7 +924,7 @@ Usage: (gnutls-error-fatalp ERROR) */) if (SYMBOLP (err)) { code = Fget (err, Qgnutls_code); - if (FIXED_OR_FLOATP (code)) + if (NUMBERP (code)) { err = code; } @@ -956,7 +956,7 @@ usage: (gnutls-error-string ERROR) */) if (SYMBOLP (err)) { code = Fget (err, Qgnutls_code); - if (FIXED_OR_FLOATP (code)) + if (NUMBERP (code)) { err = code; } diff --git a/src/image.c b/src/image.c index 36a909ba05..69aeab5d65 100644 --- a/src/image.c +++ b/src/image.c @@ -800,7 +800,7 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords, return 0; case IMAGE_NUMBER_VALUE: - if (! FIXED_OR_FLOATP (value)) + if (! NUMBERP (value)) return 0; break; @@ -4929,20 +4929,20 @@ x_edge_detection (struct frame *f, struct image *img, Lisp_Object matrix, if (CONSP (matrix)) { for (i = 0; - i < 9 && CONSP (matrix) && FIXED_OR_FLOATP (XCAR (matrix)); + i < 9 && CONSP (matrix) && NUMBERP (XCAR (matrix)); ++i, matrix = XCDR (matrix)) trans[i] = XFLOATINT (XCAR (matrix)); } else if (VECTORP (matrix) && ASIZE (matrix) >= 9) { - for (i = 0; i < 9 && FIXED_OR_FLOATP (AREF (matrix, i)); ++i) + for (i = 0; i < 9 && NUMBERP (AREF (matrix, i)); ++i) trans[i] = XFLOATINT (AREF (matrix, i)); } if (NILP (color_adjust)) color_adjust = make_fixnum (0xffff / 2); - if (i == 9 && FIXED_OR_FLOATP (color_adjust)) + if (i == 9 && NUMBERP (color_adjust)) x_detect_edges (f, img, trans, XFLOATINT (color_adjust)); } @@ -8103,7 +8103,7 @@ compute_image_size (size_t width, size_t height, double scale = 1; value = image_spec_value (spec, QCscale, NULL); - if (FIXED_OR_FLOATP (value)) + if (NUMBERP (value)) scale = XFLOATINT (value); value = image_spec_value (spec, QCmax_width, NULL); diff --git a/src/inotify.c b/src/inotify.c index 9e76060ee9..6e54c185c5 100644 --- a/src/inotify.c +++ b/src/inotify.c @@ -190,10 +190,10 @@ inotifyevent_to_event (Lisp_Object watch, struct inotify_event const *ev) else name = XCAR (XCDR (watch)); - return list2 (list4 (Fcons (INTEGER_TO_CONS (ev->wd), XCAR (watch)), + return list2 (list4 (Fcons (INT_TO_INTEGER (ev->wd), XCAR (watch)), mask_to_aspects (ev->mask), name, - INTEGER_TO_CONS (ev->cookie)), + INT_TO_INTEGER (ev->cookie)), Fnth (make_fixnum (2), watch)); } @@ -204,10 +204,10 @@ static Lisp_Object add_watch (int wd, Lisp_Object filename, uint32_t imask, Lisp_Object callback) { - Lisp_Object descriptor = INTEGER_TO_CONS (wd); + Lisp_Object descriptor = INT_TO_INTEGER (wd); Lisp_Object tail = assoc_no_quit (descriptor, watch_list); Lisp_Object watch, watch_id; - Lisp_Object mask = INTEGER_TO_CONS (imask); + Lisp_Object mask = INT_TO_INTEGER (imask); EMACS_INT id = 0; if (NILP (tail)) @@ -332,7 +332,7 @@ inotify_callback (int fd, void *_) for (ssize_t i = 0; i < n; ) { struct inotify_event *ev = (struct inotify_event *) &buffer[i]; - Lisp_Object descriptor = INTEGER_TO_CONS (ev->wd); + Lisp_Object descriptor = INT_TO_INTEGER (ev->wd); Lisp_Object prevtail = find_descriptor (descriptor); if (! NILP (prevtail)) diff --git a/src/json.c b/src/json.c index d525d1b757..976783d785 100644 --- a/src/json.c +++ b/src/json.c @@ -721,14 +721,10 @@ json_to_lisp (json_t *json, struct json_configuration *conf) case JSON_TRUE: return Qt; case JSON_INTEGER: - /* Return an integer if possible, a floating-point number - otherwise. This loses precision for integers with large - magnitude; however, such integers tend to be nonportable - anyway because many JSON implementations use only 64-bit - floating-point numbers with 53 mantissa bits. See - https://tools.ietf.org/html/rfc7159#section-6 for some - discussion. */ - return make_fixnum_or_float (json_integer_value (json)); + { + json_int_t i = json_integer_value (json); + return INT_TO_INTEGER (i); + } case JSON_REAL: return make_float (json_real_value (json)); case JSON_STRING: diff --git a/src/keyboard.c b/src/keyboard.c index 0b38e0987a..7fafb41fcc 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1298,7 +1298,7 @@ command_loop_1 (void) if (minibuf_level && !NILP (echo_area_buffer[0]) && EQ (minibuf_window, echo_area_window) - && FIXED_OR_FLOATP (Vminibuffer_message_timeout)) + && NUMBERP (Vminibuffer_message_timeout)) { /* Bind inhibit-quit to t so that C-g gets read in rather than quitting back to the minibuffer. */ @@ -5834,7 +5834,7 @@ make_lispy_event (struct input_event *event) ASIZE (wheel_syms)); } - if (FIXED_OR_FLOATP (event->arg)) + if (NUMBERP (event->arg)) return list4 (head, position, make_fixnum (double_click_count), event->arg); else if (event->modifiers & (double_modifier | triple_modifier)) diff --git a/src/lcms.c b/src/lcms.c index f37f843e50..d5cfafa60a 100644 --- a/src/lcms.c +++ b/src/lcms.c @@ -93,7 +93,7 @@ static bool parse_lab_list (Lisp_Object lab_list, cmsCIELab *color) { #define PARSE_LAB_LIST_FIELD(field) \ - if (CONSP (lab_list) && FIXED_OR_FLOATP (XCAR (lab_list))) \ + if (CONSP (lab_list) && NUMBERP (XCAR (lab_list))) \ { \ color->field = XFLOATINT (XCAR (lab_list)); \ lab_list = XCDR (lab_list); \ @@ -138,15 +138,15 @@ chroma, and hue, respectively. The parameters each default to 1. */) signal_error ("Invalid color", color1); if (NILP (kL)) Kl = 1.0f; - else if (!(FIXED_OR_FLOATP (kL) && (Kl = XFLOATINT(kL)))) + else if (!(NUMBERP (kL) && (Kl = XFLOATINT(kL)))) wrong_type_argument(Qnumberp, kL); if (NILP (kC)) Kc = 1.0f; - else if (!(FIXED_OR_FLOATP (kC) && (Kc = XFLOATINT(kC)))) + else if (!(NUMBERP (kC) && (Kc = XFLOATINT(kC)))) wrong_type_argument(Qnumberp, kC); if (NILP (kL)) Kh = 1.0f; - else if (!(FIXED_OR_FLOATP (kH) && (Kh = XFLOATINT(kH)))) + else if (!(NUMBERP (kH) && (Kh = XFLOATINT(kH)))) wrong_type_argument(Qnumberp, kH); return make_float (cmsCIE2000DeltaE (&Lab1, &Lab2, Kl, Kc, Kh)); @@ -184,7 +184,7 @@ static bool parse_xyz_list (Lisp_Object xyz_list, cmsCIEXYZ *color) { #define PARSE_XYZ_LIST_FIELD(field) \ - if (CONSP (xyz_list) && FIXED_OR_FLOATP (XCAR (xyz_list))) \ + if (CONSP (xyz_list) && NUMBERP (XCAR (xyz_list))) \ { \ color->field = 100.0 * XFLOATINT (XCAR (xyz_list)); \ xyz_list = XCDR (xyz_list); \ @@ -203,7 +203,7 @@ static bool parse_jch_list (Lisp_Object jch_list, cmsJCh *color) { #define PARSE_JCH_LIST_FIELD(field) \ - if (CONSP (jch_list) && FIXED_OR_FLOATP (XCAR (jch_list))) \ + if (CONSP (jch_list) && NUMBERP (XCAR (jch_list))) \ { \ color->field = XFLOATINT (XCAR (jch_list)); \ jch_list = XCDR (jch_list); \ @@ -224,7 +224,7 @@ static bool parse_jab_list (Lisp_Object jab_list, lcmsJab_t *color) { #define PARSE_JAB_LIST_FIELD(field) \ - if (CONSP (jab_list) && FIXED_OR_FLOATP (XCAR (jab_list))) \ + if (CONSP (jab_list) && NUMBERP (XCAR (jab_list))) \ { \ color->field = XFLOATINT (XCAR (jab_list)); \ jab_list = XCDR (jab_list); \ @@ -244,7 +244,7 @@ parse_viewing_conditions (Lisp_Object view, const cmsCIEXYZ *wp, cmsViewingConditions *vc) { #define PARSE_VIEW_CONDITION_FLOAT(field) \ - if (CONSP (view) && FIXED_OR_FLOATP (XCAR (view))) \ + if (CONSP (view) && NUMBERP (XCAR (view))) \ { \ vc->field = XFLOATINT (XCAR (view)); \ view = XCDR (view); \ @@ -555,7 +555,7 @@ Valid range of TEMPERATURE is from 4000K to 25000K. */) } #endif - CHECK_FIXNUM_OR_FLOAT (temperature); + CHECK_NUMBER (temperature); tempK = XFLOATINT (temperature); if (!(cmsWhitePointFromTemp (&whitepoint, tempK))) diff --git a/src/lisp.h b/src/lisp.h index 555496bc27..c5b51ba3b3 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -586,6 +586,7 @@ INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t, /* Defined in bignum.c. */ extern double bignum_to_double (Lisp_Object); extern Lisp_Object make_bigint (intmax_t); +extern Lisp_Object make_biguint (uintmax_t); /* Defined in chartab.c. */ extern Lisp_Object char_table_ref (Lisp_Object, int); @@ -2468,6 +2469,15 @@ make_int (intmax_t n) { return FIXNUM_OVERFLOW_P (n) ? make_bigint (n) : make_fixnum (n); } +INLINE Lisp_Object +make_uint (uintmax_t n) +{ + return FIXNUM_OVERFLOW_P (n) ? make_biguint (n) : make_fixnum (n); +} + +/* Return a Lisp integer equal to the value of the C integer EXPR. */ +#define INT_TO_INTEGER(expr) \ + (EXPR_SIGNED (expr) ? make_int (expr) : make_uint (expr)) /* Forwarding pointer to an int variable. @@ -2671,11 +2681,6 @@ enum char_bits /* Data type checking. */ -INLINE bool -FIXED_OR_FLOATP (Lisp_Object x) -{ - return FIXNUMP (x) || FLOATP (x); -} INLINE bool FIXNATP (Lisp_Object x) { @@ -2830,12 +2835,6 @@ XFLOATINT (Lisp_Object n) : bignum_to_double (n)); } -INLINE void -CHECK_FIXNUM_OR_FLOAT (Lisp_Object x) -{ - CHECK_TYPE (FIXED_OR_FLOATP (x), Qnumberp, x); -} - INLINE void CHECK_NUMBER (Lisp_Object x) { @@ -2848,14 +2847,6 @@ CHECK_INTEGER (Lisp_Object x) CHECK_TYPE (INTEGERP (x), Qnumberp, x); } -#define CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER(x) \ - do { \ - if (MARKERP (x)) \ - XSETFASTINT (x, marker_position (x)); \ - else \ - CHECK_TYPE (FIXED_OR_FLOATP (x), Qnumber_or_marker_p, x); \ - } while (false) - #define CHECK_NUMBER_COERCE_MARKER(x) \ do { \ if (MARKERP (x)) \ @@ -3288,6 +3279,8 @@ set_sub_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val) } /* Defined in bignum.c. */ +extern intmax_t bignum_to_intmax (Lisp_Object); +extern uintmax_t bignum_to_uintmax (Lisp_Object); extern Lisp_Object bignum_to_string (Lisp_Object, int); extern Lisp_Object make_bignum_str (char const *, int); extern Lisp_Object double_to_bignum (double); @@ -3309,16 +3302,6 @@ enum Arith_Comparison { extern Lisp_Object arithcompare (Lisp_Object num1, Lisp_Object num2, enum Arith_Comparison comparison); -/* Convert the integer I to an Emacs representation, either the integer - itself, or a cons of two or three integers, or if all else fails a float. - I should not have side effects. */ -#define INTEGER_TO_CONS(i) \ - (! FIXNUM_OVERFLOW_P (i) \ - ? make_fixnum (i) \ - : EXPR_SIGNED (i) ? intbig_to_lisp (i) : uintbig_to_lisp (i)) -extern Lisp_Object intbig_to_lisp (intmax_t); -extern Lisp_Object uintbig_to_lisp (uintmax_t); - /* Convert the Emacs representation CONS back to an integer of type TYPE, storing the result the variable VAR. Signal an error if CONS is not a valid representation or is out of range for TYPE. */ @@ -4473,12 +4456,6 @@ extern void init_system_name (void); because 'abs' is reserved by the C standard. */ #define eabs(x) ((x) < 0 ? -(x) : (x)) -/* Return a fixnum or float, depending on whether the integer VAL fits - in a Lisp fixnum. */ - -#define make_fixnum_or_float(val) \ - (FIXNUM_OVERFLOW_P (val) ? make_float (val) : make_fixnum (val)) - /* SAFE_ALLOCA normally allocates memory on the stack, but if size is larger than MAX_ALLOCA, use xmalloc to avoid overflowing the stack. */ diff --git a/src/lread.c b/src/lread.c index 5e1bd419fa..a7c5b0bb69 100644 --- a/src/lread.c +++ b/src/lread.c @@ -665,7 +665,7 @@ read_filtered_event (bool no_switch_frame, bool ascii_required, delayed_switch_frame = Qnil; /* Compute timeout. */ - if (FIXED_OR_FLOATP (seconds)) + if (NUMBERP (seconds)) { double duration = XFLOATINT (seconds); struct timespec wait_time = dtotimespec (duration); @@ -676,7 +676,7 @@ read_filtered_event (bool no_switch_frame, bool ascii_required, retry: do val = read_char (0, Qnil, (input_method ? Qnil : Qt), 0, - FIXED_OR_FLOATP (seconds) ? &end_time : NULL); + NUMBERP (seconds) ? &end_time : NULL); while (FIXNUMP (val) && XFIXNUM (val) == -2); /* wrong_kboard_jmpbuf */ if (BUFFERP (val)) @@ -695,7 +695,7 @@ read_filtered_event (bool no_switch_frame, bool ascii_required, goto retry; } - if (ascii_required && !(FIXED_OR_FLOATP (seconds) && NILP (val))) + if (ascii_required && !(NUMBERP (seconds) && NILP (val))) { /* Convert certain symbols to their ASCII equivalents. */ if (SYMBOLP (val)) @@ -3161,7 +3161,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) /* If it can be recursive, remember it for future substitutions. */ if (! SYMBOLP (tem) - && ! FIXED_OR_FLOATP (tem) + && ! NUMBERP (tem) && ! (STRINGP (tem) && !string_intervals (tem))) { struct Lisp_Hash_Table *h2 @@ -3616,7 +3616,7 @@ substitute_object_recurse (struct subst *subst, Lisp_Object subtree) bother looking them up; we're done. */ if (SYMBOLP (subtree) || (STRINGP (subtree) && !string_intervals (subtree)) - || FIXED_OR_FLOATP (subtree)) + || NUMBERP (subtree)) return subtree; /* If we've been to this node before, don't explore it again. */ diff --git a/src/nsfns.m b/src/nsfns.m index ece21c69bf..659bce8fc5 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -1226,10 +1226,10 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side. /* Read comment about this code in corresponding place in xfns.c. */ tem = x_get_arg (dpyinfo, parms, Qmin_width, NULL, NULL, RES_TYPE_NUMBER); - if (FIXED_OR_FLOATP (tem)) + if (FIXNUMP (tem)) store_frame_param (f, Qmin_width, tem); tem = x_get_arg (dpyinfo, parms, Qmin_height, NULL, NULL, RES_TYPE_NUMBER); - if (FIXED_OR_FLOATP (tem)) + if (FIXNUMP (tem)) store_frame_param (f, Qmin_height, tem); adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f), FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, 1, diff --git a/src/nsimage.m b/src/nsimage.m index f657c49c0b..0ae1b88edd 100644 --- a/src/nsimage.m +++ b/src/nsimage.m @@ -88,7 +88,7 @@ Updated by Christian Limpach (chris@nice.ch) index = FIXNUMP (lisp_index) ? XFIXNAT (lisp_index) : 0; lisp_rotation = Fplist_get (XCDR (img->spec), QCrotation); - rotation = FIXED_OR_FLOATP (lisp_rotation) ? XFLOATINT (lisp_rotation) : 0; + rotation = NUMBERP (lisp_rotation) ? XFLOATINT (lisp_rotation) : 0; if (STRINGP (spec_file)) { @@ -532,19 +532,19 @@ - (void)setSizeFromSpec: (Lisp_Object) spec double width = -1, height = -1, max_width = -1, max_height = -1; value = Fplist_get (spec, QCscale); - if (FIXED_OR_FLOATP (value)) + if (NUMBERP (value)) scale = XFLOATINT (value) ; value = Fplist_get (spec, QCmax_width); - if (FIXED_OR_FLOATP (value)) + if (NUMBERP (value)) max_width = XFLOATINT (value); value = Fplist_get (spec, QCmax_height); - if (FIXED_OR_FLOATP (value)) + if (NUMBERP (value)) max_height = XFLOATINT (value); value = Fplist_get (spec, QCwidth); - if (FIXED_OR_FLOATP (value)) + if (NUMBERP (value)) { width = XFLOATINT (value) * scale; /* :width overrides :max-width. */ @@ -552,7 +552,7 @@ - (void)setSizeFromSpec: (Lisp_Object) spec } value = Fplist_get (spec, QCheight); - if (FIXED_OR_FLOATP (value)) + if (NUMBERP (value)) { height = XFLOATINT (value) * scale; /* :height overrides :max-height. */ diff --git a/src/nsterm.m b/src/nsterm.m index 90758d1032..961271f2d0 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -6684,7 +6684,7 @@ - (void)mouseDown: (NSEvent *)theEvent static int totalDeltaX, totalDeltaY; int lineHeight; - if (FIXED_OR_FLOATP (ns_mwheel_line_height)) + if (FIXNUMP (ns_mwheel_line_height)) lineHeight = XFIXNUM (ns_mwheel_line_height); else { diff --git a/src/process.c b/src/process.c index a266da1c1b..29cedd7ad6 100644 --- a/src/process.c +++ b/src/process.c @@ -1025,7 +1025,7 @@ static Lisp_Object deleted_pid_list; void record_deleted_pid (pid_t pid, Lisp_Object filename) { - deleted_pid_list = Fcons (Fcons (make_fixnum_or_float (pid), filename), + deleted_pid_list = Fcons (Fcons (INT_TO_INTEGER (pid), filename), /* GC treated elements set to nil. */ Fdelq (Qnil, deleted_pid_list)); @@ -1164,7 +1164,7 @@ For a network, serial, and pipe connections, this value is nil. */) CHECK_PROCESS (process); pid = XPROCESS (process)->pid; - return (pid ? make_fixnum_or_float (pid) : Qnil); + return pid ? INT_TO_INTEGER (pid) : Qnil; } DEFUN ("process-name", Fprocess_name, Sprocess_name, 1, 1, 0, @@ -6850,13 +6850,13 @@ SIGCODE may be an integer, or a symbol whose name is a signal name. */) tem = string_to_number (SSDATA (process), 10, 0); process = tem; } - else if (!FIXED_OR_FLOATP (process)) + else if (!NUMBERP (process)) process = get_process (process); if (NILP (process)) return process; - if (FIXED_OR_FLOATP (process)) + if (NUMBERP (process)) CONS_TO_INTEGER (process, pid_t, pid); else { @@ -7053,13 +7053,10 @@ handle_child_signal (int sig) if (! CONSP (head)) continue; xpid = XCAR (head); - if (all_pids_are_fixnums ? FIXNUMP (xpid) : FIXED_OR_FLOATP (xpid)) + if (all_pids_are_fixnums ? FIXNUMP (xpid) : INTEGERP (xpid)) { - pid_t deleted_pid; - if (FIXNUMP (xpid)) - deleted_pid = XFIXNUM (xpid); - else - deleted_pid = XFLOAT_DATA (xpid); + pid_t deleted_pid = (FIXNUMP (xpid) ? XFIXNUM (xpid) + : bignum_to_intmax (xpid)); if (child_status_changed (deleted_pid, 0, 0)) { if (STRINGP (XCDR (head))) diff --git a/src/syntax.c b/src/syntax.c index a9bc36ae9f..432d82cdf0 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -614,7 +614,7 @@ find_defun_start (ptrdiff_t pos, ptrdiff_t pos_byte) error ("syntax-ppss modified the buffer!"); TEMP_SET_PT_BOTH (opoint, opoint_byte); Lisp_Object boc = Fnth (make_fixnum (8), ppss); - if (FIXED_OR_FLOATP (boc)) + if (FIXNUMP (boc)) { find_start_value = XFIXNUM (boc); find_start_value_byte = CHAR_TO_BYTE (find_start_value); diff --git a/src/sysdep.c b/src/sysdep.c index 889ad6bdb0..52afa2f0e1 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -3045,9 +3045,9 @@ list_system_processes (void) for (i = 0; i < len; i++) { #ifdef DARWIN_OS - proclist = Fcons (make_fixnum_or_float (procs[i].kp_proc.p_pid), proclist); + proclist = Fcons (INT_TO_INTEGER (procs[i].kp_proc.p_pid), proclist); #else - proclist = Fcons (make_fixnum_or_float (procs[i].ki_pid), proclist); + proclist = Fcons (INT_TO_INTEGER (procs[i].ki_pid), proclist); #endif } @@ -3261,7 +3261,7 @@ system_process_attributes (Lisp_Object pid) Lisp_Object decoded_cmd; ptrdiff_t count; - CHECK_FIXNUM_OR_FLOAT (pid); + CHECK_NUMBER (pid); CONS_TO_INTEGER (pid, pid_t, proc_id); sprintf (procfn, "/proc/%"pMd, proc_id); if (stat (procfn, &st) < 0) @@ -3269,7 +3269,7 @@ system_process_attributes (Lisp_Object pid) /* euid egid */ uid = st.st_uid; - attrs = Fcons (Fcons (Qeuid, make_fixnum_or_float (uid)), attrs); + attrs = Fcons (Fcons (Qeuid, INT_TO_INTEGER (uid)), attrs); block_input (); pw = getpwuid (uid); unblock_input (); @@ -3277,7 +3277,7 @@ system_process_attributes (Lisp_Object pid) attrs = Fcons (Fcons (Quser, build_string (pw->pw_name)), attrs); gid = st.st_gid; - attrs = Fcons (Fcons (Qegid, make_fixnum_or_float (gid)), attrs); + attrs = Fcons (Fcons (Qegid, INT_TO_INTEGER (gid)), attrs); block_input (); gr = getgrgid (gid); unblock_input (); @@ -3335,17 +3335,15 @@ system_process_attributes (Lisp_Object pid) state_str[0] = c; state_str[1] = '\0'; attrs = Fcons (Fcons (Qstate, build_string (state_str)), attrs); - attrs = Fcons (Fcons (Qppid, make_fixnum_or_float (ppid)), attrs); - attrs = Fcons (Fcons (Qpgrp, make_fixnum_or_float (pgrp)), attrs); - attrs = Fcons (Fcons (Qsess, make_fixnum_or_float (sess)), attrs); + attrs = Fcons (Fcons (Qppid, INT_TO_INTEGER (ppid)), attrs); + attrs = Fcons (Fcons (Qpgrp, INT_TO_INTEGER (pgrp)), attrs); + attrs = Fcons (Fcons (Qsess, INT_TO_INTEGER (sess)), attrs); attrs = Fcons (Fcons (Qttname, procfs_ttyname (tty)), attrs); - attrs = Fcons (Fcons (Qtpgid, make_fixnum_or_float (tpgid)), attrs); - attrs = Fcons (Fcons (Qminflt, make_fixnum_or_float (minflt)), attrs); - attrs = Fcons (Fcons (Qmajflt, make_fixnum_or_float (majflt)), attrs); - attrs = Fcons (Fcons (Qcminflt, make_fixnum_or_float (cminflt)), - attrs); - attrs = Fcons (Fcons (Qcmajflt, make_fixnum_or_float (cmajflt)), - attrs); + attrs = Fcons (Fcons (Qtpgid, INT_TO_INTEGER (tpgid)), attrs); + attrs = Fcons (Fcons (Qminflt, INT_TO_INTEGER (minflt)), attrs); + attrs = Fcons (Fcons (Qmajflt, INT_TO_INTEGER (majflt)), attrs); + attrs = Fcons (Fcons (Qcminflt, INT_TO_INTEGER (cminflt)), attrs); + attrs = Fcons (Fcons (Qcmajflt, INT_TO_INTEGER (cmajflt)), attrs); clocks_per_sec = sysconf (_SC_CLK_TCK); if (clocks_per_sec < 0) clocks_per_sec = 100; @@ -3371,17 +3369,15 @@ system_process_attributes (Lisp_Object pid) attrs); attrs = Fcons (Fcons (Qpri, make_fixnum (priority)), attrs); attrs = Fcons (Fcons (Qnice, make_fixnum (niceness)), attrs); - attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (thcount)), - attrs); + attrs = Fcons (Fcons (Qthcount, INT_TO_INTEGER (thcount)), attrs); tnow = current_timespec (); telapsed = get_up_time (); tboot = timespec_sub (tnow, telapsed); tstart = time_from_jiffies (start, clocks_per_sec); tstart = timespec_add (tboot, tstart); attrs = Fcons (Fcons (Qstart, make_lisp_time (tstart)), attrs); - attrs = Fcons (Fcons (Qvsize, make_fixnum_or_float (vsize / 1024)), - attrs); - attrs = Fcons (Fcons (Qrss, make_fixnum_or_float (4 * rss)), attrs); + attrs = Fcons (Fcons (Qvsize, INT_TO_INTEGER (vsize / 1024)), attrs); + attrs = Fcons (Fcons (Qrss, INT_TO_INTEGER (4 * rss)), attrs); telapsed = timespec_sub (tnow, tstart); attrs = Fcons (Fcons (Qetime, make_lisp_time (telapsed)), attrs); us_time = time_from_jiffies (u_time + s_time, clocks_per_sec); @@ -3495,7 +3491,7 @@ system_process_attributes (Lisp_Object pid) Lisp_Object decoded_cmd; ptrdiff_t count; - CHECK_FIXNUM_OR_FLOAT (pid); + CHECK_NUMBER (pid); CONS_TO_INTEGER (pid, pid_t, proc_id); sprintf (procfn, "/proc/%"pMd, proc_id); if (stat (procfn, &st) < 0) @@ -3503,7 +3499,7 @@ system_process_attributes (Lisp_Object pid) /* euid egid */ uid = st.st_uid; - attrs = Fcons (Fcons (Qeuid, make_fixnum_or_float (uid)), attrs); + attrs = Fcons (Fcons (Qeuid, INT_TO_INTEGER (uid)), attrs); block_input (); pw = getpwuid (uid); unblock_input (); @@ -3511,7 +3507,7 @@ system_process_attributes (Lisp_Object pid) attrs = Fcons (Fcons (Quser, build_string (pw->pw_name)), attrs); gid = st.st_gid; - attrs = Fcons (Fcons (Qegid, make_fixnum_or_float (gid)), attrs); + attrs = Fcons (Fcons (Qegid, INT_TO_INTEGER (gid)), attrs); block_input (); gr = getgrgid (gid); unblock_input (); @@ -3533,9 +3529,9 @@ system_process_attributes (Lisp_Object pid) if (nread == sizeof pinfo) { - attrs = Fcons (Fcons (Qppid, make_fixnum_or_float (pinfo.pr_ppid)), attrs); - attrs = Fcons (Fcons (Qpgrp, make_fixnum_or_float (pinfo.pr_pgid)), attrs); - attrs = Fcons (Fcons (Qsess, make_fixnum_or_float (pinfo.pr_sid)), attrs); + attrs = Fcons (Fcons (Qppid, INT_TO_INTEGER (pinfo.pr_ppid)), attrs); + attrs = Fcons (Fcons (Qpgrp, INT_TO_INTEGER (pinfo.pr_pgid)), attrs); + attrs = Fcons (Fcons (Qsess, INT_TO_INTEGER (pinfo.pr_sid)), attrs); { char state_str[2]; @@ -3565,14 +3561,11 @@ system_process_attributes (Lisp_Object pid) attrs = Fcons (Fcons (Qctime, make_lisp_time (pinfo.pr_ctime)), attrs); attrs = Fcons (Fcons (Qpri, make_fixnum (pinfo.pr_lwp.pr_pri)), attrs); attrs = Fcons (Fcons (Qnice, make_fixnum (pinfo.pr_lwp.pr_nice)), attrs); - attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (pinfo.pr_nlwp)), - attrs); + attrs = Fcons (Fcons (Qthcount, INT_TO_INTEGER (pinfo.pr_nlwp)), attrs); attrs = Fcons (Fcons (Qstart, make_lisp_time (pinfo.pr_start)), attrs); - attrs = Fcons (Fcons (Qvsize, make_fixnum_or_float (pinfo.pr_size)), - attrs); - attrs = Fcons (Fcons (Qrss, make_fixnum_or_float (pinfo.pr_rssize)), - attrs); + attrs = Fcons (Fcons (Qvsize, INT_TO_INTEGER (pinfo.pr_size)), attrs); + attrs = Fcons (Fcons (Qrss, INT_TO_INTEGER (pinfo.pr_rssize)), attrs); /* pr_pctcpu and pr_pctmem are unsigned integers in the range 0 .. 2**15, representing 0.0 .. 1.0. */ @@ -3630,14 +3623,14 @@ system_process_attributes (Lisp_Object pid) Lisp_Object attrs = Qnil; Lisp_Object decoded_comm; - CHECK_FIXNUM_OR_FLOAT (pid); + CHECK_NUMBER (pid); CONS_TO_INTEGER (pid, int, proc_id); mib[3] = proc_id; if (sysctl (mib, 4, &proc, &proclen, NULL, 0) != 0) return attrs; - attrs = Fcons (Fcons (Qeuid, make_fixnum_or_float (proc.ki_uid)), attrs); + attrs = Fcons (Fcons (Qeuid, INT_TO_INTEGER (proc.ki_uid)), attrs); block_input (); pw = getpwuid (proc.ki_uid); @@ -3645,7 +3638,7 @@ system_process_attributes (Lisp_Object pid) if (pw) attrs = Fcons (Fcons (Quser, build_string (pw->pw_name)), attrs); - attrs = Fcons (Fcons (Qegid, make_fixnum_or_float (proc.ki_svgid)), attrs); + attrs = Fcons (Fcons (Qegid, INT_TO_INTEGER (proc.ki_svgid)), attrs); block_input (); gr = getgrgid (proc.ki_svgid); @@ -3684,9 +3677,9 @@ system_process_attributes (Lisp_Object pid) attrs = Fcons (Fcons (Qstate, build_string (state)), attrs); } - attrs = Fcons (Fcons (Qppid, make_fixnum_or_float (proc.ki_ppid)), attrs); - attrs = Fcons (Fcons (Qpgrp, make_fixnum_or_float (proc.ki_pgid)), attrs); - attrs = Fcons (Fcons (Qsess, make_fixnum_or_float (proc.ki_sid)), attrs); + attrs = Fcons (Fcons (Qppid, INT_TO_INTEGER (proc.ki_ppid)), attrs); + attrs = Fcons (Fcons (Qpgrp, INT_TO_INTEGER (proc.ki_pgid)), attrs); + attrs = Fcons (Fcons (Qsess, INT_TO_INTEGER (proc.ki_sid)), attrs); block_input (); ttyname = proc.ki_tdev == NODEV ? NULL : devname (proc.ki_tdev, S_IFCHR); @@ -3694,9 +3687,11 @@ system_process_attributes (Lisp_Object pid) if (ttyname) attrs = Fcons (Fcons (Qtty, build_string (ttyname)), attrs); - attrs = Fcons (Fcons (Qtpgid, make_fixnum_or_float (proc.ki_tpgid)), attrs); - attrs = Fcons (Fcons (Qminflt, make_fixnum_or_float (proc.ki_rusage.ru_minflt)), attrs); - attrs = Fcons (Fcons (Qmajflt, make_fixnum_or_float (proc.ki_rusage.ru_majflt)), attrs); + attrs = Fcons (Fcons (Qtpgid, INT_TO_INTEGER (proc.ki_tpgid)), attrs); + attrs = Fcons (Fcons (Qminflt, INT_TO_INTEGER (proc.ki_rusage.ru_minflt)), + attrs); + attrs = Fcons (Fcons (Qmajflt, INT_TO_INTEGER (proc.ki_rusage.ru_majflt)), + attrs); attrs = Fcons (Fcons (Qcminflt, make_fixnum (proc.ki_rusage_ch.ru_minflt)), attrs); attrs = Fcons (Fcons (Qcmajflt, make_fixnum (proc.ki_rusage_ch.ru_majflt)), attrs); @@ -3718,8 +3713,7 @@ system_process_attributes (Lisp_Object pid) timeval_to_timespec (proc.ki_rusage_ch.ru_stime)); attrs = Fcons (Fcons (Qctime, make_lisp_time (t)), attrs); - attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (proc.ki_numthreads)), - attrs); + attrs = Fcons (Fcons (Qthcount, INT_TO_INTEGER (proc.ki_numthreads)), attrs); attrs = Fcons (Fcons (Qpri, make_fixnum (proc.ki_pri.pri_native)), attrs); attrs = Fcons (Fcons (Qnice, make_fixnum (proc.ki_nice)), attrs); attrs = Fcons (Fcons (Qstart, make_lisp_timeval (proc.ki_start)), attrs); @@ -3741,7 +3735,7 @@ system_process_attributes (Lisp_Object pid) { pcpu = (100.0 * proc.ki_pctcpu / fscale / (1 - exp (proc.ki_swtime * log ((double) ccpu / fscale)))); - attrs = Fcons (Fcons (Qpcpu, make_fixnum_or_float (pcpu)), attrs); + attrs = Fcons (Fcons (Qpcpu, INT_TO_INTEGER (pcpu)), attrs); } } @@ -3751,7 +3745,7 @@ system_process_attributes (Lisp_Object pid) double pmem = (proc.ki_flag & P_INMEM ? 100.0 * proc.ki_rssize / npages : 0); - attrs = Fcons (Fcons (Qpmem, make_fixnum_or_float (pmem)), attrs); + attrs = Fcons (Fcons (Qpmem, INT_TO_INTEGER (pmem)), attrs); } mib[2] = KERN_PROC_ARGS; @@ -3810,7 +3804,7 @@ system_process_attributes (Lisp_Object pid) Lisp_Object attrs = Qnil; Lisp_Object decoded_comm; - CHECK_FIXNUM_OR_FLOAT (pid); + CHECK_NUMBER (pid); CONS_TO_INTEGER (pid, int, proc_id); mib[3] = proc_id; @@ -3818,7 +3812,7 @@ system_process_attributes (Lisp_Object pid) return attrs; uid = proc.kp_eproc.e_ucred.cr_uid; - attrs = Fcons (Fcons (Qeuid, make_fixnum_or_float (uid)), attrs); + attrs = Fcons (Fcons (Qeuid, INT_TO_INTEGER (uid)), attrs); block_input (); pw = getpwuid (uid); @@ -3827,7 +3821,7 @@ system_process_attributes (Lisp_Object pid) attrs = Fcons (Fcons (Quser, build_string (pw->pw_name)), attrs); gid = proc.kp_eproc.e_pcred.p_svgid; - attrs = Fcons (Fcons (Qegid, make_fixnum_or_float (gid)), attrs); + attrs = Fcons (Fcons (Qegid, INT_TO_INTEGER (gid)), attrs); block_input (); gr = getgrgid (gid); @@ -3867,10 +3861,8 @@ system_process_attributes (Lisp_Object pid) attrs = Fcons (Fcons (Qstate, build_string (state)), attrs); } - attrs = Fcons (Fcons (Qppid, make_fixnum_or_float (proc.kp_eproc.e_ppid)), - attrs); - attrs = Fcons (Fcons (Qpgrp, make_fixnum_or_float (proc.kp_eproc.e_pgid)), - attrs); + attrs = Fcons (Fcons (Qppid, INT_TO_INTEGER (proc.kp_eproc.e_ppid)), attrs); + attrs = Fcons (Fcons (Qpgrp, INT_TO_INTEGER (proc.kp_eproc.e_pgid)), attrs); tdev = proc.kp_eproc.e_tdev; block_input (); @@ -3879,15 +3871,15 @@ system_process_attributes (Lisp_Object pid) if (ttyname) attrs = Fcons (Fcons (Qtty, build_string (ttyname)), attrs); - attrs = Fcons (Fcons (Qtpgid, make_fixnum_or_float (proc.kp_eproc.e_tpgid)), + attrs = Fcons (Fcons (Qtpgid, INT_TO_INTEGER (proc.kp_eproc.e_tpgid)), attrs); rusage = proc.kp_proc.p_ru; if (rusage) { - attrs = Fcons (Fcons (Qminflt, make_fixnum_or_float (rusage->ru_minflt)), + attrs = Fcons (Fcons (Qminflt, INT_TO_INTEGER (rusage->ru_minflt)), attrs); - attrs = Fcons (Fcons (Qmajflt, make_fixnum_or_float (rusage->ru_majflt)), + attrs = Fcons (Fcons (Qmajflt, INT_TO_INTEGER (rusage->ru_majflt)), attrs); attrs = Fcons (Fcons (Qutime, make_lisp_timeval (rusage->ru_utime)), diff --git a/src/w32.c b/src/w32.c index 78f946c634..4b57d91641 100644 --- a/src/w32.c +++ b/src/w32.c @@ -6873,7 +6873,7 @@ list_system_processes (void) res = process32_next (h_snapshot, &proc_entry)) { proc_id = proc_entry.th32ProcessID; - proclist = Fcons (make_fixnum_or_float (proc_id), proclist); + proclist = Fcons (INT_TO_INTEGER (proc_id), proclist); } CloseHandle (h_snapshot); @@ -7031,7 +7031,7 @@ system_process_attributes (Lisp_Object pid) double pcpu; BOOL result = FALSE; - CHECK_FIXNUM_OR_FLOAT (pid); + CHECK_NUMBER (pid); proc_id = FLOATP (pid) ? XFLOAT_DATA (pid) : XFIXNUM (pid); h_snapshot = create_toolhelp32_snapshot (TH32CS_SNAPPROCESS, 0); @@ -7061,12 +7061,12 @@ system_process_attributes (Lisp_Object pid) } attrs = Fcons (Fcons (Qcomm, decoded_cmd), attrs); attrs = Fcons (Fcons (Qppid, - make_fixnum_or_float (pe.th32ParentProcessID)), + INT_TO_INTEGER (pe.th32ParentProcessID)), attrs); attrs = Fcons (Fcons (Qpri, make_fixnum (pe.pcPriClassBase)), attrs); attrs = Fcons (Fcons (Qthcount, - make_fixnum_or_float (pe.cntThreads)), + INT_TO_INTEGER (pe.cntThreads)), attrs); found_proc = 1; break; @@ -7214,12 +7214,12 @@ system_process_attributes (Lisp_Object pid) CloseHandle (token); } - attrs = Fcons (Fcons (Qeuid, make_fixnum_or_float (euid)), attrs); + attrs = Fcons (Fcons (Qeuid, INT_TO_INTEGER (euid)), attrs); tem = make_unibyte_string (uname, ulength); attrs = Fcons (Fcons (Quser, code_convert_string_norecord (tem, Vlocale_coding_system, 0)), attrs); - attrs = Fcons (Fcons (Qegid, make_fixnum_or_float (egid)), attrs); + attrs = Fcons (Fcons (Qegid, INT_TO_INTEGER (egid)), attrs); tem = make_unibyte_string (gname, glength); attrs = Fcons (Fcons (Qgroup, code_convert_string_norecord (tem, Vlocale_coding_system, 0)), @@ -7249,12 +7249,12 @@ system_process_attributes (Lisp_Object pid) SIZE_T rss = mem_ex.WorkingSetSize / 1024; attrs = Fcons (Fcons (Qmajflt, - make_fixnum_or_float (mem_ex.PageFaultCount)), + INT_TO_INTEGER (mem_ex.PageFaultCount)), attrs); attrs = Fcons (Fcons (Qvsize, - make_fixnum_or_float (mem_ex.PrivateUsage / 1024)), + INT_TO_INTEGER (mem_ex.PrivateUsage / 1024)), attrs); - attrs = Fcons (Fcons (Qrss, make_fixnum_or_float (rss)), attrs); + attrs = Fcons (Fcons (Qrss, INT_TO_INTEGER (rss)), attrs); if (totphys) attrs = Fcons (Fcons (Qpmem, make_float (100. * rss / totphys)), attrs); } @@ -7264,9 +7264,9 @@ system_process_attributes (Lisp_Object pid) SIZE_T rss = mem_ex.WorkingSetSize / 1024; attrs = Fcons (Fcons (Qmajflt, - make_fixnum_or_float (mem.PageFaultCount)), + INT_TO_INTEGER (mem.PageFaultCount)), attrs); - attrs = Fcons (Fcons (Qrss, make_fixnum_or_float (rss)), attrs); + attrs = Fcons (Fcons (Qrss, INT_TO_INTEGER (rss)), attrs); if (totphys) attrs = Fcons (Fcons (Qpmem, make_float (100. * rss / totphys)), attrs); } @@ -7275,7 +7275,7 @@ system_process_attributes (Lisp_Object pid) { DWORD rss = maxrss / 1024; - attrs = Fcons (Fcons (Qrss, make_fixnum_or_float (maxrss / 1024)), attrs); + attrs = Fcons (Fcons (Qrss, INT_TO_INTEGER (maxrss / 1024)), attrs); if (totphys) attrs = Fcons (Fcons (Qpmem, make_float (100. * rss / totphys)), attrs); } @@ -9433,10 +9433,10 @@ w32_read_registry (HKEY rootkey, Lisp_Object lkey, Lisp_Object lname) retval = Qt; break; case REG_DWORD: - retval = INTEGER_TO_CONS (*((DWORD *)pvalue)); + retval = INT_TO_INTEGER (*((DWORD *)pvalue)); break; case REG_QWORD: - retval = INTEGER_TO_CONS (*((long long *)pvalue)); + retval = INT_TO_INTEGER (*((long long *)pvalue)); break; case REG_BINARY: { diff --git a/src/w32fns.c b/src/w32fns.c index b587677f09..153cba9f75 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -2027,7 +2027,7 @@ x_set_undecorated (struct frame *f, Lisp_Object new_value, Lisp_Object old_value if (!NILP (new_value) && !FRAME_UNDECORATED (f)) { dwStyle = ((dwStyle & ~WS_THICKFRAME & ~WS_CAPTION) - | ((FIXED_OR_FLOATP (border_width) && (XFIXNUM (border_width) > 0)) + | ((FIXNUMP (border_width) && (XFIXNUM (border_width) > 0)) ? WS_BORDER : false)); SetWindowLong (hwnd, GWL_STYLE, dwStyle); SetWindowPos (hwnd, HWND_TOP, 0, 0, 0, 0, @@ -2334,7 +2334,7 @@ w32_createwindow (struct frame *f, int *coords) if (FRAME_UNDECORATED (f)) { /* If we want a thin border, specify it here. */ - if (FIXED_OR_FLOATP (border_width) && (XFIXNUM (border_width) > 0)) + if (FIXNUMP (border_width) && (XFIXNUM (border_width) > 0)) f->output_data.w32->dwStyle |= WS_BORDER; } else @@ -2350,7 +2350,7 @@ w32_createwindow (struct frame *f, int *coords) f->output_data.w32->dwStyle = WS_POPUP; /* If we want a thin border, specify it here. */ - if (FIXED_OR_FLOATP (border_width) && (XFIXNUM (border_width) > 0)) + if (FIXNUMP (border_width) && (XFIXNUM (border_width) > 0)) f->output_data.w32->dwStyle |= WS_BORDER; } else @@ -4199,7 +4199,7 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) press of Space which we will ignore. */ if (GetAsyncKeyState (wParam) & 1) { - if (FIXED_OR_FLOATP (Vw32_phantom_key_code)) + if (FIXNUMP (Vw32_phantom_key_code)) key = XUFIXNUM (Vw32_phantom_key_code) & 255; else key = VK_SPACE; @@ -4215,7 +4215,7 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) { if (GetAsyncKeyState (wParam) & 1) { - if (FIXED_OR_FLOATP (Vw32_phantom_key_code)) + if (FIXNUMP (Vw32_phantom_key_code)) key = XUFIXNUM (Vw32_phantom_key_code) & 255; else key = VK_SPACE; @@ -5921,11 +5921,11 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, because `frame-windows-min-size' needs them. */ tem = x_get_arg (dpyinfo, parameters, Qmin_width, NULL, NULL, RES_TYPE_NUMBER); - if (FIXED_OR_FLOATP (tem)) + if (FIXNUMP (tem)) store_frame_param (f, Qmin_width, tem); tem = x_get_arg (dpyinfo, parameters, Qmin_height, NULL, NULL, RES_TYPE_NUMBER); - if (FIXED_OR_FLOATP (tem)) + if (FIXNUMP (tem)) store_frame_param (f, Qmin_height, tem); adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f), FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, true, @@ -7430,7 +7430,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, /* Show tooltip frame. */ { RECT rect; - int pad = (FIXED_OR_FLOATP (Vw32_tooltip_extra_pixels) + int pad = (FIXNUMP (Vw32_tooltip_extra_pixels) ? max (0, XFIXNUM (Vw32_tooltip_extra_pixels)) : FRAME_COLUMN_WIDTH (tip_f)); @@ -9431,7 +9431,7 @@ w32_console_toggle_lock_key (int vk_code, Lisp_Object new_state) int cur_state = (GetKeyState (vk_code) & 1); if (NILP (new_state) - || (FIXED_OR_FLOATP (new_state) + || (FIXNUMP (new_state) && ((XUFIXNUM (new_state)) & 1) != cur_state)) { #ifdef WINDOWSNT diff --git a/src/w32inevt.c b/src/w32inevt.c index e8494c88bc..f5558bb3d5 100644 --- a/src/w32inevt.c +++ b/src/w32inevt.c @@ -181,7 +181,7 @@ key_event (KEY_EVENT_RECORD *event, struct input_event *emacs_ev, int *isdead) Space which we will ignore. */ if ((mod_key_state & LEFT_WIN_PRESSED) == 0) { - if (FIXED_OR_FLOATP (Vw32_phantom_key_code)) + if (FIXNUMP (Vw32_phantom_key_code)) faked_key = XUFIXNUM (Vw32_phantom_key_code) & 255; else faked_key = VK_SPACE; @@ -198,7 +198,7 @@ key_event (KEY_EVENT_RECORD *event, struct input_event *emacs_ev, int *isdead) { if ((mod_key_state & RIGHT_WIN_PRESSED) == 0) { - if (FIXED_OR_FLOATP (Vw32_phantom_key_code)) + if (FIXNUMP (Vw32_phantom_key_code)) faked_key = XUFIXNUM (Vw32_phantom_key_code) & 255; else faked_key = VK_SPACE; diff --git a/src/w32proc.c b/src/w32proc.c index 5c2cb32749..cb02ba6341 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -3206,7 +3206,7 @@ If LCID (a 16-bit number) is not a valid locale, the result is nil. */) if (got_full) return DECODE_SYSTEM (build_string (full_name)); } - else if (FIXED_OR_FLOATP (longform)) + else if (FIXNUMP (longform)) { got_full = GetLocaleInfo (XFIXNUM (lcid), XFIXNUM (longform), diff --git a/src/window.c b/src/window.c index 67cfdc12b5..d4fc5568a5 100644 --- a/src/window.c +++ b/src/window.c @@ -1383,8 +1383,8 @@ If they are in the windows's left or right marginal areas, `left-margin'\n\ CHECK_CONS (coordinates); lx = Fcar (coordinates); ly = Fcdr (coordinates); - CHECK_FIXNUM_OR_FLOAT (lx); - CHECK_FIXNUM_OR_FLOAT (ly); + CHECK_NUMBER (lx); + CHECK_NUMBER (ly); x = FRAME_PIXEL_X_FROM_CANON_X (f, lx) + FRAME_INTERNAL_BORDER_WIDTH (f); y = FRAME_PIXEL_Y_FROM_CANON_Y (f, ly) + FRAME_INTERNAL_BORDER_WIDTH (f); @@ -1533,9 +1533,8 @@ column 0. */) { struct frame *f = decode_live_frame (frame); - /* Check that arguments are integers or floats. */ - CHECK_FIXNUM_OR_FLOAT (x); - CHECK_FIXNUM_OR_FLOAT (y); + CHECK_NUMBER (x); + CHECK_NUMBER (y); return window_from_coordinates (f, (FRAME_PIXEL_X_FROM_CANON_X (f, x) @@ -1972,7 +1971,7 @@ though when run from an idle timer with a delay of zero seconds. */) row = (NILP (body) ? MATRIX_ROW (w->current_matrix, 0) : MATRIX_FIRST_TEXT_ROW (w->current_matrix)); - else if (FIXED_OR_FLOATP (first)) + else if (FIXNUMP (first)) { CHECK_RANGED_INTEGER (first, 0, w->current_matrix->nrows); row = MATRIX_ROW (w->current_matrix, XFIXNUM (first)); @@ -1985,7 +1984,7 @@ though when run from an idle timer with a delay of zero seconds. */) end_row = (NILP (body) ? MATRIX_ROW (w->current_matrix, w->current_matrix->nrows) : MATRIX_BOTTOM_TEXT_ROW (w->current_matrix, w)); - else if (FIXED_OR_FLOATP (last)) + else if (FIXNUMP (last)) { CHECK_RANGED_INTEGER (last, 0, w->current_matrix->nrows); end_row = MATRIX_ROW (w->current_matrix, XFIXNUM (last)); @@ -3994,7 +3993,7 @@ window_resize_apply (struct window *w, bool horflag) { w->pixel_width = XFIXNAT (w->new_pixel); w->total_cols = w->pixel_width / unit; - if (FIXED_OR_FLOATP (w->new_normal)) + if (NUMBERP (w->new_normal)) wset_normal_cols (w, w->new_normal); edge = w->pixel_left; @@ -4003,7 +4002,7 @@ window_resize_apply (struct window *w, bool horflag) { w->pixel_height = XFIXNAT (w->new_pixel); w->total_lines = w->pixel_height / unit; - if (FIXED_OR_FLOATP (w->new_normal)) + if (NUMBERP (w->new_normal)) wset_normal_lines (w, w->new_normal); edge = w->pixel_top; @@ -7360,7 +7359,7 @@ If PIXELS-P is non-nil, the return value is VSCROLL. */) struct window *w = decode_live_window (window); struct frame *f = XFRAME (w->frame); - CHECK_FIXNUM_OR_FLOAT (vscroll); + CHECK_NUMBER (vscroll); if (FRAME_WINDOW_P (f)) { diff --git a/src/xdisp.c b/src/xdisp.c index 0835ccafd4..11b14e2cf9 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -4978,10 +4978,10 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, Lisp_Object height; height = safe_call1 (it->font_height, face->lface[LFACE_HEIGHT_INDEX]); - if (FIXED_OR_FLOATP (height)) + if (NUMBERP (height)) new_height = XFLOATINT (height); } - else if (FIXED_OR_FLOATP (it->font_height)) + else if (NUMBERP (it->font_height)) { /* Value is a multiple of the canonical char height. */ struct face *f; @@ -5002,7 +5002,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, value = safe_eval (it->font_height); value = unbind_to (count, value); - if (FIXED_OR_FLOATP (value)) + if (NUMBERP (value)) new_height = XFLOATINT (value); } @@ -5025,7 +5025,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, return 0; value = XCAR (XCDR (spec)); - if (FIXED_OR_FLOATP (value) && XFLOATINT (value) > 0) + if (NUMBERP (value) && XFLOATINT (value) > 0) it->space_width = value; } @@ -5074,7 +5074,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, #ifdef HAVE_WINDOW_SYSTEM value = XCAR (XCDR (spec)); - if (FIXED_OR_FLOATP (value)) + if (NUMBERP (value)) { struct face *face = FACE_FROM_ID (it->f, it->face_id); it->voffset = - (XFLOATINT (value) @@ -15729,8 +15729,8 @@ try_scrolling (Lisp_Object window, bool just_this_one_p, scroll_max = (max (scroll_step, max (arg_scroll_conservatively, temp_scroll_step)) * frame_line_height); - else if (FIXED_OR_FLOATP (BVAR (current_buffer, scroll_down_aggressively)) - || FIXED_OR_FLOATP (BVAR (current_buffer, scroll_up_aggressively))) + else if (NUMBERP (BVAR (current_buffer, scroll_down_aggressively)) + || NUMBERP (BVAR (current_buffer, scroll_up_aggressively))) /* We're trying to scroll because of aggressive scrolling but no scroll_step is set. Choose an arbitrary one. */ scroll_max = 10 * frame_line_height; @@ -15830,7 +15830,7 @@ try_scrolling (Lisp_Object window, bool just_this_one_p, { aggressive = BVAR (current_buffer, scroll_up_aggressively); height = WINDOW_BOX_TEXT_HEIGHT (w); - if (FIXED_OR_FLOATP (aggressive)) + if (NUMBERP (aggressive)) { double float_amount = XFLOATINT (aggressive) * height; int aggressive_scroll = float_amount; @@ -15946,7 +15946,7 @@ try_scrolling (Lisp_Object window, bool just_this_one_p, { aggressive = BVAR (current_buffer, scroll_down_aggressively); height = WINDOW_BOX_TEXT_HEIGHT (w); - if (FIXED_OR_FLOATP (aggressive)) + if (NUMBERP (aggressive)) { double float_amount = XFLOATINT (aggressive) * height; int aggressive_scroll = float_amount; @@ -17223,8 +17223,8 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) if ((scroll_conservatively || emacs_scroll_step || temp_scroll_step - || FIXED_OR_FLOATP (BVAR (current_buffer, scroll_up_aggressively)) - || FIXED_OR_FLOATP (BVAR (current_buffer, scroll_down_aggressively))) + || NUMBERP (BVAR (current_buffer, scroll_up_aggressively)) + || NUMBERP (BVAR (current_buffer, scroll_down_aggressively))) && CHARPOS (startp) >= BEGV && CHARPOS (startp) <= ZV) { @@ -17299,13 +17299,13 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) : BVAR (current_buffer, scroll_down_aggressively); if (!MINI_WINDOW_P (w) - && (scroll_conservatively > SCROLL_LIMIT || FIXED_OR_FLOATP (aggressive))) + && (scroll_conservatively > SCROLL_LIMIT || NUMBERP (aggressive))) { int pt_offset = 0; /* Setting scroll-conservatively overrides scroll-*-aggressively. */ - if (!scroll_conservatively && FIXED_OR_FLOATP (aggressive)) + if (!scroll_conservatively && NUMBERP (aggressive)) { double float_amount = XFLOATINT (aggressive); @@ -25520,7 +25520,7 @@ calc_pixel_width_or_height (double *res, struct it *it, Lisp_Object prop, prop = Qnil; } - if (FIXED_OR_FLOATP (prop)) + if (NUMBERP (prop)) { int base_unit = (width_p ? FRAME_COLUMN_WIDTH (it->f) @@ -25584,8 +25584,8 @@ calc_pixel_width_or_height (double *res, struct it *it, Lisp_Object prop, } /* '(NUM)': absolute number of pixels. */ - if (FIXED_OR_FLOATP (car)) - { + if (NUMBERP (car)) +{ double fact; int offset = width_p && align_to && *align_to < 0 ? it->lnum_pixel_width : 0; @@ -27852,14 +27852,14 @@ calc_line_height_property (struct it *it, Lisp_Object val, struct font *font, Lisp_Object face_name = Qnil; int ascent, descent, height; - if (NILP (val) || FIXNUMP (val) || (override && EQ (val, Qt))) + if (NILP (val) || INTEGERP (val) || (override && EQ (val, Qt))) return val; if (CONSP (val)) { face_name = XCAR (val); val = XCDR (val); - if (!FIXED_OR_FLOATP (val)) + if (!NUMBERP (val)) val = make_fixnum (1); if (NILP (face_name)) { @@ -27903,10 +27903,13 @@ calc_line_height_property (struct it *it, Lisp_Object val, struct font *font, height = ascent + descent; scale: + /* FIXME: Check for overflow in multiplication or conversion. */ if (FLOATP (val)) height = (int)(XFLOAT_DATA (val) * height); else if (FIXNUMP (val)) height *= XFIXNUM (val); + else + height *= bignum_to_intmax (val); return make_fixnum (height); } @@ -30770,7 +30773,7 @@ on_hot_spot_p (Lisp_Object hot_spot, int x, int y) Lisp_Object lr, lx0, ly0; if (CONSP (circ) && CONSP (XCAR (circ)) - && (lr = XCDR (circ), FIXED_OR_FLOATP (lr)) + && (lr = XCDR (circ), NUMBERP (lr)) && (lx0 = XCAR (XCAR (circ)), FIXNUMP (lx0)) && (ly0 = XCDR (XCAR (circ)), FIXNUMP (ly0))) { diff --git a/src/xfaces.c b/src/xfaces.c index 23822b1126..50593f6804 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -1659,7 +1659,7 @@ check_lface_attrs (Lisp_Object attrs[LFACE_VECTOR_SIZE]) || SYMBOLP (attrs[LFACE_SWIDTH_INDEX])); eassert (UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX]) || IGNORE_DEFFACE_P (attrs[LFACE_HEIGHT_INDEX]) - || FIXED_OR_FLOATP (attrs[LFACE_HEIGHT_INDEX]) + || NUMBERP (attrs[LFACE_HEIGHT_INDEX]) || FUNCTIONP (attrs[LFACE_HEIGHT_INDEX])); eassert (UNSPECIFIEDP (attrs[LFACE_WEIGHT_INDEX]) || IGNORE_DEFFACE_P (attrs[LFACE_WEIGHT_INDEX]) diff --git a/src/xfns.c b/src/xfns.c index f365241bdb..e19fcff9b0 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -3866,10 +3866,10 @@ This function is an internal primitive--use `make-frame' instead. */) Also process `min-width' and `min-height' parameters right here because `frame-windows-min-size' needs them. */ tem = x_get_arg (dpyinfo, parms, Qmin_width, NULL, NULL, RES_TYPE_NUMBER); - if (FIXED_OR_FLOATP (tem)) + if (FIXNUMP (tem)) store_frame_param (f, Qmin_width, tem); tem = x_get_arg (dpyinfo, parms, Qmin_height, NULL, NULL, RES_TYPE_NUMBER); - if (FIXED_OR_FLOATP (tem)) + if (FIXNUMP (tem)) store_frame_param (f, Qmin_height, tem); adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f), FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, true, diff --git a/src/xselect.c b/src/xselect.c index dd3da8e124..4b28d474a0 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -321,7 +321,7 @@ x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value, Lisp_Object prev_value; selection_data = list4 (selection_name, selection_value, - INTEGER_TO_CONS (timestamp), frame); + INT_TO_INTEGER (timestamp), frame); prev_value = LOCAL_SELECTION (selection_name, dpyinfo); tset_selection_alist @@ -401,16 +401,16 @@ x_get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type, if (STRINGP (check) || VECTORP (check) || SYMBOLP (check) - || FIXNUMP (check) + || INTEGERP (check) || NILP (value)) return value; /* Check for a value that CONS_TO_INTEGER could handle. */ else if (CONSP (check) - && FIXNUMP (XCAR (check)) - && (FIXNUMP (XCDR (check)) + && INTEGERP (XCAR (check)) + && (INTEGERP (XCDR (check)) || (CONSP (XCDR (check)) - && FIXNUMP (XCAR (XCDR (check))) + && INTEGERP (XCAR (XCDR (check))) && NILP (XCDR (XCDR (check)))))) return value; @@ -1620,9 +1620,9 @@ selection_data_to_lisp_data (struct x_display_info *dpyinfo, else if (format == 32 && size == sizeof (int)) { if (type == XA_INTEGER) - return INTEGER_TO_CONS (((int *) data) [0]); + return INT_TO_INTEGER (((int *) data) [0]); else - return INTEGER_TO_CONS (((unsigned int *) data) [0]); + return INT_TO_INTEGER (((unsigned int *) data) [0]); } else if (format == 16 && size == sizeof (short)) { @@ -1668,7 +1668,7 @@ selection_data_to_lisp_data (struct x_display_info *dpyinfo, for (i = 0; i < size / X_LONG_SIZE; i++) { int j = ((int *) data) [i]; - ASET (v, i, INTEGER_TO_CONS (j)); + ASET (v, i, INT_TO_INTEGER (j)); } } else @@ -1676,7 +1676,7 @@ selection_data_to_lisp_data (struct x_display_info *dpyinfo, for (i = 0; i < size / X_LONG_SIZE; i++) { unsigned int j = ((unsigned int *) data) [i]; - ASET (v, i, INTEGER_TO_CONS (j)); + ASET (v, i, INT_TO_INTEGER (j)); } } return v; @@ -1693,7 +1693,7 @@ static unsigned long cons_to_x_long (Lisp_Object obj) { if (X_ULONG_MAX <= INTMAX_MAX - || XFIXNUM (FIXNUMP (obj) ? obj : XCAR (obj)) < 0) + || !Fnatnump (CONSP (obj) ? XCAR (obj) : obj)) return cons_to_signed (obj, X_LONG_MIN, min (X_ULONG_MAX, INTMAX_MAX)); else return cons_to_unsigned (obj, X_ULONG_MAX); @@ -1759,8 +1759,8 @@ lisp_data_to_selection_data (struct x_display_info *dpyinfo, *short_ptr = XFIXNUM (obj); if (NILP (type)) type = QINTEGER; } - else if (FIXNUMP (obj) - || (CONSP (obj) && FIXNUMP (XCAR (obj)) + else if (INTEGERP (obj) + || (CONSP (obj) && INTEGERP (XCAR (obj)) && (FIXNUMP (XCDR (obj)) || (CONSP (XCDR (obj)) && FIXNUMP (XCAR (XCDR (obj))))))) @@ -1846,19 +1846,19 @@ static Lisp_Object clean_local_selection_data (Lisp_Object obj) { if (CONSP (obj) - && FIXNUMP (XCAR (obj)) + && INTEGERP (XCAR (obj)) && CONSP (XCDR (obj)) && FIXNUMP (XCAR (XCDR (obj))) && NILP (XCDR (XCDR (obj)))) obj = Fcons (XCAR (obj), XCDR (obj)); if (CONSP (obj) - && FIXNUMP (XCAR (obj)) + && INTEGERP (XCAR (obj)) && FIXNUMP (XCDR (obj))) { - if (XFIXNUM (XCAR (obj)) == 0) + if (EQ (XCAR (obj), make_fixnum (0))) return XCDR (obj); - if (XFIXNUM (XCAR (obj)) == -1) + if (EQ (XCAR (obj), make_fixnum (-1))) return make_fixnum (- XFIXNUM (XCDR (obj))); } if (VECTORP (obj)) @@ -2264,10 +2264,10 @@ x_check_property_data (Lisp_Object data) { Lisp_Object o = XCAR (iter); - if (! FIXED_OR_FLOATP (o) && ! STRINGP (o) && ! CONSP (o)) + if (! NUMBERP (o) && ! STRINGP (o) && ! CONSP (o)) return -1; else if (CONSP (o) && - (! FIXED_OR_FLOATP (XCAR (o)) || ! FIXED_OR_FLOATP (XCDR (o)))) + (! NUMBERP (XCAR (o)) || ! NUMBERP (XCDR (o)))) return -1; if (size == INT_MAX) return -1; @@ -2303,7 +2303,7 @@ x_fill_property_data (Display *dpy, Lisp_Object data, void *ret, int format) { Lisp_Object o = XCAR (iter); - if (FIXED_OR_FLOATP (o) || CONSP (o)) + if (NUMBERP (o) || CONSP (o)) { if (CONSP (o) && RANGED_FIXNUMP (X_LONG_MIN >> 16, XCAR (o), X_LONG_MAX >> 16) @@ -2580,7 +2580,7 @@ x_send_client_event (Lisp_Object display, Lisp_Object dest, Lisp_Object from, else error ("DEST as a string must be one of PointerWindow or InputFocus"); } - else if (FIXED_OR_FLOATP (dest) || CONSP (dest)) + else if (NUMBERP (dest) || CONSP (dest)) CONS_TO_INTEGER (dest, Window, wdest); else error ("DEST must be a frame, nil, string, number or cons"); diff --git a/src/xterm.c b/src/xterm.c index 06c84463c6..f8ea787e8d 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10507,9 +10507,9 @@ set_wm_state (Lisp_Object frame, bool add, Atom atom, Atom value) Fcons (make_fixnum (add), Fcons - (make_fixnum_or_float (atom), + (INT_TO_INTEGER (atom), (value != 0 - ? list1 (make_fixnum_or_float (value)) + ? list1 (INT_TO_INTEGER (value)) : Qnil)))); } commit 9abaf5f3581ecb76f30e8a6e7ee0e9633c133d1c Author: Paul Eggert Date: Mon Aug 27 21:27:50 2018 -0700 Modularize bignums better * src/bignum.c, src/bignum.h: New files. Only modules that need to know how bignums are implemented should include bignum.h. Currently these are alloc.c, bignum.c (of course), data.c, emacs.c, emacs-module.c, floatfns.c, fns.c, print.c. * src/Makefile.in (base_obj): Add bignum.o. * src/alloc.c (make_bignum_str): Move to bignum.c. (make_number): Remove; replaced by bignum.c’s make_integer. All callers changed. * src/conf_post.h (ARG_NONNULL): New macro. * src/json.c (json_to_lisp): Use it. * src/data.c (Fnatnump): Move NATNUMP’s implementation here from lisp.h. * src/data.c (Fnumber_to_string): * src/editfns.c (styled_format): Move conversion of string to bignum to bignum_to_string, and call it here. * src/emacs-module.c (module_make_integer): * src/floatfns.c (Fabs): Simplify by using make_int. * src/emacs.c: Include bignum.h, to expand its inline fns. * src/floatfns.c (Ffloat): Simplify by using XFLOATINT. (rounding_driver): Simplify by using double_to_bignum. (rounddiv_q): Clarify use of temporaries. * src/lisp.h: Move decls that need to know bignum internals to bignum.h. Do not include gmp.h or mini-gmp.h; that is now bignum.h’s job. (GMP_NUM_BITS, struct Lisp_Bignum, XBIGNUM, mpz_set_intmax): Move to bignum.h. (make_int): New function. (NATNUMP): Remove; all callers changed to use Fnatnump. (XFLOATINT): If arg is a bignum, use bignum_to_double, so that bignum internals are not exposed here. * src/print.c (print_vectorlike): Use SAFE_ALLOCA to avoid the need for a record_unwind_protect_ptr. diff --git a/src/Makefile.in b/src/Makefile.in index 52ce7605f7..7d9c2361a9 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -392,7 +392,7 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \ charset.o coding.o category.o ccl.o character.o chartab.o bidi.o \ $(CM_OBJ) term.o terminal.o xfaces.o $(XOBJ) $(GTK_OBJ) $(DBUS_OBJ) \ emacs.o keyboard.o macros.o keymap.o sysdep.o \ - buffer.o filelock.o insdel.o marker.o \ + bignum.o buffer.o filelock.o insdel.o marker.o \ minibuf.o fileio.o dired.o \ cmds.o casetab.o casefiddle.o indent.o search.o regex-emacs.o undo.o \ alloc.o data.o doc.o editfns.o callint.o \ diff --git a/src/alloc.c b/src/alloc.c index c9788ab4c6..350b668ec6 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -31,6 +31,7 @@ along with GNU Emacs. If not, see . */ #endif #include "lisp.h" +#include "bignum.h" #include "dispextern.h" #include "intervals.h" #include "ptr-bounds.h" @@ -3728,83 +3729,6 @@ build_marker (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t bytepos) } - -Lisp_Object -make_bignum_str (const char *num, int base) -{ - struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value, - PVEC_BIGNUM); - mpz_init (b->value); - int check = mpz_set_str (b->value, num, base); - eassert (check == 0); - return make_lisp_ptr (b, Lisp_Vectorlike); -} - -/* Given an mpz_t, make a number. This may return a bignum or a - fixnum depending on VALUE. */ - -Lisp_Object -make_number (mpz_t value) -{ - size_t bits = mpz_sizeinbase (value, 2); - - if (bits <= FIXNUM_BITS) - { - EMACS_INT v = 0; - int i = 0, shift = 0; - - do - { - EMACS_INT limb = mpz_getlimbn (value, i++); - v += limb << shift; - shift += GMP_NUMB_BITS; - } - while (shift < bits); - - if (mpz_sgn (value) < 0) - v = -v; - - if (!FIXNUM_OVERFLOW_P (v)) - return make_fixnum (v); - } - - /* The documentation says integer-width should be nonnegative, so - a single comparison suffices even though 'bits' is unsigned. */ - if (integer_width < bits) - range_error (); - - struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value, - PVEC_BIGNUM); - /* We could mpz_init + mpz_swap here, to avoid a copy, but the - resulting API seemed possibly confusing. */ - mpz_init_set (b->value, value); - - return make_lisp_ptr (b, Lisp_Vectorlike); -} - -void -mpz_set_intmax_slow (mpz_t result, intmax_t v) -{ - /* If V fits in long, a faster path is taken. */ - eassert (! (LONG_MIN <= v && v <= LONG_MAX)); - - bool complement = v < 0; - if (complement) - v = -1 - v; - - enum { nails = sizeof v * CHAR_BIT - INTMAX_WIDTH }; -# ifndef HAVE_GMP - /* mini-gmp requires NAILS to be zero, which is true for all - likely Emacs platforms. Sanity-check this. */ - verify (nails == 0); -# endif - - mpz_import (result, 1, -1, sizeof v, 0, nails, &v); - if (complement) - mpz_com (result, result); -} - - /* Return a newly created vector or string with specified arguments as elements. If all the arguments are characters that can fit in a string of events, make a string; otherwise, make a vector. diff --git a/src/bignum.c b/src/bignum.c new file mode 100644 index 0000000000..18f94e7ed6 --- /dev/null +++ b/src/bignum.c @@ -0,0 +1,161 @@ +/* Big numbers for Emacs. + +Copyright 2018 Free Software Foundation, Inc. + +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 . */ + +#include + +#include "bignum.h" + +#include "lisp.h" + +/* Return the value of the Lisp bignum N, as a double. */ +double +bignum_to_double (Lisp_Object n) +{ + return mpz_get_d (XBIGNUM (n)->value); +} + +/* Return D, converted to a bignum. Discard any fraction. */ +Lisp_Object +double_to_bignum (double d) +{ + mpz_t z; + mpz_init_set_d (z, d); + Lisp_Object result = make_integer (z); + mpz_clear (z); + return result; +} + +/* Return a Lisp integer equal to OP, which has BITS bits and which + must not be in fixnum range. */ +static Lisp_Object +make_bignum_bits (mpz_t const op, size_t bits) +{ + /* The documentation says integer-width should be nonnegative, so + a single comparison suffices even though 'bits' is unsigned. */ + if (integer_width < bits) + range_error (); + + struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value, + PVEC_BIGNUM); + /* We could mpz_init + mpz_swap here, to avoid a copy, but the + resulting API seemed possibly confusing. */ + mpz_init_set (b->value, op); + + return make_lisp_ptr (b, Lisp_Vectorlike); +} + +/* Return a Lisp integer equal to OP, which must not be in fixnum range. */ +static Lisp_Object +make_bignum (mpz_t const op) +{ + return make_bignum_bits (op, mpz_sizeinbase (op, 2)); +} + +/* Return a Lisp integer equal to N, which must not be in fixnum range. */ +Lisp_Object +make_bigint (intmax_t n) +{ + eassert (FIXNUM_OVERFLOW_P (n)); + mpz_t z; + mpz_init (z); + mpz_set_intmax (z, n); + Lisp_Object result = make_bignum (z); + mpz_clear (z); + return result; +} + +/* Return a Lisp integer with value taken from OP. */ +Lisp_Object +make_integer (mpz_t const op) +{ + size_t bits = mpz_sizeinbase (op, 2); + + if (bits <= FIXNUM_BITS) + { + EMACS_INT v = 0; + int i = 0, shift = 0; + + do + { + EMACS_INT limb = mpz_getlimbn (op, i++); + v += limb << shift; + shift += GMP_NUMB_BITS; + } + while (shift < bits); + + if (mpz_sgn (op) < 0) + v = -v; + + if (!FIXNUM_OVERFLOW_P (v)) + return make_fixnum (v); + } + + return make_bignum_bits (op, bits); +} + +void +mpz_set_intmax_slow (mpz_t result, intmax_t v) +{ + bool complement = v < 0; + if (complement) + v = -1 - v; + + enum { nails = sizeof v * CHAR_BIT - INTMAX_WIDTH }; +# ifndef HAVE_GMP + /* mini-gmp requires NAILS to be zero, which is true for all + likely Emacs platforms. Sanity-check this. */ + verify (nails == 0); +# endif + + mpz_import (result, 1, -1, sizeof v, 0, nails, &v); + if (complement) + mpz_com (result, result); +} + +/* Convert NUM to a base-BASE Lisp string. */ + +Lisp_Object +bignum_to_string (Lisp_Object num, int base) +{ + ptrdiff_t n = mpz_sizeinbase (XBIGNUM (num)->value, base) - 1; + USE_SAFE_ALLOCA; + char *str = SAFE_ALLOCA (n + 3); + mpz_get_str (str, base, XBIGNUM (num)->value); + while (str[n]) + n++; + Lisp_Object result = make_unibyte_string (str, n); + SAFE_FREE (); + return result; +} + +/* Create a bignum by scanning NUM, with digits in BASE. + NUM must consist of an optional '-', a nonempty sequence + of base-BASE digits, and a terminating null byte, and + the represented number must not be in fixnum range. */ + +Lisp_Object +make_bignum_str (char const *num, int base) +{ + struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value, + PVEC_BIGNUM); + mpz_init (b->value); + int check = mpz_set_str (b->value, num, base); + eassert (check == 0); + return make_lisp_ptr (b, Lisp_Vectorlike); +} diff --git a/src/bignum.h b/src/bignum.h new file mode 100644 index 0000000000..a368333d77 --- /dev/null +++ b/src/bignum.h @@ -0,0 +1,70 @@ +/* Big numbers for Emacs. + +Copyright 2018 Free Software Foundation, Inc. + +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 . */ + +/* Include this header only if access to bignum internals is needed. */ + +#ifndef BIGNUM_H +#define BIGNUM_H + +#ifdef HAVE_GMP +# include +#else +# include "mini-gmp.h" +#endif + +#include "lisp.h" + +/* Number of data bits in a limb. */ +#ifndef GMP_NUMB_BITS +enum { GMP_NUMB_BITS = TYPE_WIDTH (mp_limb_t) }; +#endif + +struct Lisp_Bignum +{ + union vectorlike_header header; + mpz_t value; +}; + +extern Lisp_Object make_integer (mpz_t const) ARG_NONNULL ((1)); +extern void mpz_set_intmax_slow (mpz_t, intmax_t) ARG_NONNULL ((1)); + +INLINE_HEADER_BEGIN + +INLINE struct Lisp_Bignum * +XBIGNUM (Lisp_Object a) +{ + eassert (BIGNUMP (a)); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Bignum); +} + +INLINE void ARG_NONNULL ((1)) +mpz_set_intmax (mpz_t result, intmax_t v) +{ + /* mpz_set_si works in terms of long, but Emacs may use a wider + integer type, and so sometimes will have to construct the mpz_t + by hand. */ + if (LONG_MIN <= v && v <= LONG_MAX) + mpz_set_si (result, v); + else + mpz_set_intmax_slow (result, v); +} + +INLINE_HEADER_END + +#endif /* BIGNUM_H */ diff --git a/src/conf_post.h b/src/conf_post.h index f9838bc662..683a96f936 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -277,6 +277,7 @@ extern int emacs_setenv_TZ (char const *); #define ATTRIBUTE_FORMAT_PRINTF(string_index, first_to_check) \ ATTRIBUTE_FORMAT ((PRINTF_ARCHETYPE, string_index, first_to_check)) +#define ARG_NONNULL _GL_ARG_NONNULL #define ATTRIBUTE_CONST _GL_ATTRIBUTE_CONST #define ATTRIBUTE_UNUSED _GL_UNUSED diff --git a/src/data.c b/src/data.c index 170a74a658..ece76a5bc6 100644 --- a/src/data.c +++ b/src/data.c @@ -29,6 +29,7 @@ along with GNU Emacs. If not, see . */ #include #include "lisp.h" +#include "bignum.h" #include "puresize.h" #include "character.h" #include "buffer.h" @@ -525,9 +526,9 @@ DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0, attributes: const) (Lisp_Object object) { - if (NATNUMP (object)) - return Qt; - return Qnil; + return ((FIXNUMP (object) ? 0 <= XFIXNUM (object) + : BIGNUMP (object) && 0 <= mpz_sgn (XBIGNUM (object)->value)) + ? Qt : Qnil); } DEFUN ("numberp", Fnumberp, Snumberp, 1, 1, 0, @@ -2400,7 +2401,7 @@ emacs_mpz_size (mpz_t const op) the library code aborts when a number is too large. These wrappers avoid the problem for functions that can return numbers much larger than their arguments. For slowly-growing numbers, the integer - width check in make_number should suffice. */ + width checks in bignum.c should suffice. */ static void emacs_mpz_mul (mpz_t rop, mpz_t const op1, mpz_t const op2) @@ -2770,12 +2771,7 @@ NUMBER may be an integer or a floating point number. */) int len; if (BIGNUMP (number)) - { - ptrdiff_t count = SPECPDL_INDEX (); - char *str = mpz_get_str (NULL, 10, XBIGNUM (number)->value); - record_unwind_protect_ptr (xfree, str); - return unbind_to (count, make_unibyte_string (str, strlen (str))); - } + return bignum_to_string (number, 10); CHECK_FIXNUM_OR_FLOAT (number); @@ -3011,7 +3007,7 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) } } - return unbind_to (count, make_number (accum)); + return unbind_to (count, make_integer (accum)); } static Lisp_Object @@ -3141,7 +3137,7 @@ Both must be integers or markers. */) mpz_init (result); mpz_tdiv_r (result, *xmp, *ymp); - val = make_number (result); + val = make_integer (result); mpz_clear (result); if (xmp == &xm) @@ -3221,7 +3217,7 @@ Both X and Y must be numbers or markers. */) if (cmpy < 0 ? cmpr > 0 : cmpr < 0) mpz_add (result, result, *ymp); - val = make_number (result); + val = make_integer (result); mpz_clear (result); if (xmp == &xm) @@ -3351,7 +3347,7 @@ In this case, the sign bit is duplicated. */) emacs_mpz_mul_2exp (result, XBIGNUM (value)->value, XFIXNUM (count)); else mpz_fdiv_q_2exp (result, XBIGNUM (value)->value, - XFIXNUM (count)); - val = make_number (result); + val = make_integer (result); mpz_clear (result); } else if (XFIXNUM (count) <= 0) @@ -3378,7 +3374,7 @@ In this case, the sign bit is duplicated. */) else mpz_fdiv_q_2exp (result, result, - XFIXNUM (count)); - val = make_number (result); + val = make_integer (result); mpz_clear (result); } @@ -3407,7 +3403,7 @@ expt_integer (Lisp_Object x, Lisp_Object y) ? (mpz_set_intmax (val, XFIXNUM (x)), val) : XBIGNUM (x)->value), exp); - Lisp_Object res = make_number (val); + Lisp_Object res = make_integer (val); mpz_clear (val); return res; } @@ -3427,7 +3423,7 @@ Markers are converted to integers. */) mpz_t num; mpz_init (num); mpz_add_ui (num, XBIGNUM (number)->value, 1); - number = make_number (num); + number = make_integer (num); mpz_clear (num); } else @@ -3440,7 +3436,7 @@ Markers are converted to integers. */) mpz_t num; mpz_init (num); mpz_set_intmax (num, XFIXNUM (number) + 1); - number = make_number (num); + number = make_integer (num); mpz_clear (num); } } @@ -3462,7 +3458,7 @@ Markers are converted to integers. */) mpz_t num; mpz_init (num); mpz_sub_ui (num, XBIGNUM (number)->value, 1); - number = make_number (num); + number = make_integer (num); mpz_clear (num); } else @@ -3475,7 +3471,7 @@ Markers are converted to integers. */) mpz_t num; mpz_init (num); mpz_set_intmax (num, XFIXNUM (number) - 1); - number = make_number (num); + number = make_integer (num); mpz_clear (num); } } @@ -3492,7 +3488,7 @@ DEFUN ("lognot", Flognot, Slognot, 1, 1, 0, mpz_t value; mpz_init (value); mpz_com (value, XBIGNUM (number)->value); - number = make_number (value); + number = make_integer (value); mpz_clear (value); } else diff --git a/src/editfns.c b/src/editfns.c index d2281d7e81..9ca6f373e0 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -4491,9 +4491,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) else if (conversion == 'X') base = -16; - char *str = mpz_get_str (NULL, base, XBIGNUM (arg)->value); - arg = make_unibyte_string (str, strlen (str)); - xfree (str); + arg = bignum_to_string (arg, base); conversion = 's'; } diff --git a/src/emacs-module.c b/src/emacs-module.c index f2844c40d0..a1bed491b6 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -27,6 +27,7 @@ along with GNU Emacs. If not, see . */ #include #include "lisp.h" +#include "bignum.h" #include "dynlib.h" #include "coding.h" #include "keyboard.h" @@ -521,6 +522,8 @@ module_extract_integer (emacs_env *env, emacs_value n) CHECK_INTEGER (l); if (BIGNUMP (l)) { + /* FIXME: This can incorrectly signal overflow on platforms + where long is narrower than intmax_t. */ if (!mpz_fits_slong_p (XBIGNUM (l)->value)) xsignal1 (Qoverflow_error, l); return mpz_get_si (XBIGNUM (l)->value); @@ -531,19 +534,8 @@ module_extract_integer (emacs_env *env, emacs_value n) static emacs_value module_make_integer (emacs_env *env, intmax_t n) { - Lisp_Object obj; MODULE_FUNCTION_BEGIN (module_nil); - if (FIXNUM_OVERFLOW_P (n)) - { - mpz_t val; - mpz_init (val); - mpz_set_intmax (val, n); - obj = make_number (val); - mpz_clear (val); - } - else - obj = make_fixnum (n); - return lisp_to_value (env, obj); + return lisp_to_value (env, make_int (n)); } static double diff --git a/src/emacs.c b/src/emacs.c index 7d07ec8502..07a1aff9b0 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -66,6 +66,7 @@ along with GNU Emacs. If not, see . */ #include TERM_HEADER #endif /* HAVE_WINDOW_SYSTEM */ +#include "bignum.h" #include "intervals.h" #include "character.h" #include "buffer.h" diff --git a/src/floatfns.c b/src/floatfns.c index e7884864ee..8008929be6 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -42,6 +42,7 @@ along with GNU Emacs. If not, see . */ #include #include "lisp.h" +#include "bignum.h" #include @@ -209,7 +210,7 @@ DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, /* Common Lisp spec: don't promote if both are integers, and if the result is not fractional. */ - if (INTEGERP (arg1) && NATNUMP (arg2)) + if (INTEGERP (arg1) && Fnatnump (arg2)) return expt_integer (arg1, arg2); return make_float (pow (XFLOATINT (arg1), XFLOATINT (arg2))); @@ -258,19 +259,7 @@ DEFUN ("abs", Fabs, Sabs, 1, 1, 0, if (FIXNUMP (arg)) { if (XFIXNUM (arg) < 0) - { - EMACS_INT absarg = -XFIXNUM (arg); - if (absarg <= MOST_POSITIVE_FIXNUM) - arg = make_fixnum (absarg); - else - { - mpz_t val; - mpz_init (val); - mpz_set_intmax (val, absarg); - arg = make_number (val); - mpz_clear (val); - } - } + arg = make_int (-XFIXNUM (arg)); } else if (FLOATP (arg)) { @@ -284,7 +273,7 @@ DEFUN ("abs", Fabs, Sabs, 1, 1, 0, mpz_t val; mpz_init (val); mpz_neg (val, XBIGNUM (arg)->value); - arg = make_number (val); + arg = make_integer (val); mpz_clear (val); } } @@ -297,13 +286,8 @@ DEFUN ("float", Ffloat, Sfloat, 1, 1, 0, (register Lisp_Object arg) { CHECK_NUMBER (arg); - - if (BIGNUMP (arg)) - return make_float (mpz_get_d (XBIGNUM (arg)->value)); - if (FIXNUMP (arg)) - return make_float ((double) XFIXNUM (arg)); - else /* give 'em the same float back */ - return arg; + /* If ARG is a float, give 'em the same float back. */ + return FLOATP (arg) ? arg : make_float (XFLOATINT (arg)); } static int @@ -386,7 +370,7 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor, (FIXNUMP (divisor) ? (mpz_set_intmax (d, XFIXNUM (divisor)), d) : XBIGNUM (divisor)->value)); - Lisp_Object result = make_number (q); + Lisp_Object result = make_integer (q); mpz_clear (d); mpz_clear (q); return result; @@ -410,12 +394,7 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor, if (! FIXNUM_OVERFLOW_P (ir)) return make_fixnum (ir); } - mpz_t drz; - mpz_init (drz); - mpz_set_d (drz, dr); - Lisp_Object rounded = make_number (drz); - mpz_clear (drz); - return rounded; + return double_to_bignum (dr); } static void @@ -433,9 +412,9 @@ rounddiv_q (mpz_t q, mpz_t const n, mpz_t const d) r = n % d; neg_d = d < 0; neg_r = r < 0; - r = eabs (r); - abs_r1 = eabs (d) - r; - if (abs_r1 < r + (q & 1)) + abs_r = eabs (r); + abs_r1 = eabs (d) - abs_r; + if (abs_r1 < abs_r + (q & 1)) q += neg_d == neg_r ? 1 : -1; */ mpz_t r, abs_r1; @@ -444,10 +423,11 @@ rounddiv_q (mpz_t q, mpz_t const n, mpz_t const d) mpz_tdiv_qr (q, r, n, d); bool neg_d = mpz_sgn (d) < 0; bool neg_r = mpz_sgn (r) < 0; - mpz_abs (r, r); + mpz_t *abs_r = &r; + mpz_abs (*abs_r, r); mpz_abs (abs_r1, d); - mpz_sub (abs_r1, abs_r1, r); - if (mpz_cmp (abs_r1, r) < (mpz_odd_p (q) != 0)) + mpz_sub (abs_r1, abs_r1, *abs_r); + if (mpz_cmp (abs_r1, *abs_r) < (mpz_odd_p (q) != 0)) (neg_d == neg_r ? mpz_add_ui : mpz_sub_ui) (q, q, 1); mpz_clear (r); mpz_clear (abs_r1); diff --git a/src/fns.c b/src/fns.c index b368ffd58f..3f7dfeddb6 100644 --- a/src/fns.c +++ b/src/fns.c @@ -28,6 +28,7 @@ along with GNU Emacs. If not, see . */ #include #include "lisp.h" +#include "bignum.h" #include "character.h" #include "coding.h" #include "composite.h" diff --git a/src/json.c b/src/json.c index 4e46640a0c..d525d1b757 100644 --- a/src/json.c +++ b/src/json.c @@ -709,7 +709,7 @@ usage: (json-insert OBJECT &rest ARGS) */) /* Convert a JSON object to a Lisp object. */ -static _GL_ARG_NONNULL ((1)) Lisp_Object +static Lisp_Object ARG_NONNULL ((1)) json_to_lisp (json_t *json, struct json_configuration *conf) { switch (json_typeof (json)) diff --git a/src/lisp.h b/src/lisp.h index fb11a11fda..555496bc27 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -31,12 +31,6 @@ along with GNU Emacs. If not, see . */ #include #include -#ifdef HAVE_GMP -# include -#else -# include "mini-gmp.h" -#endif - #include #include @@ -589,6 +583,10 @@ enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = false }; INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t, Lisp_Object); +/* Defined in bignum.c. */ +extern double bignum_to_double (Lisp_Object); +extern Lisp_Object make_bigint (intmax_t); + /* Defined in chartab.c. */ extern Lisp_Object char_table_ref (Lisp_Object, int); extern void char_table_set (Lisp_Object, int, Lisp_Object); @@ -1013,14 +1011,6 @@ enum More_Lisp_Bits #define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS) #define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM) - -/* GMP-related limits. */ - -/* Number of data bits in a limb. */ -#ifndef GMP_NUMB_BITS -enum { GMP_NUMB_BITS = TYPE_WIDTH (mp_limb_t) }; -#endif - #if USE_LSB_TAG INLINE Lisp_Object @@ -2460,31 +2450,25 @@ XUSER_PTR (Lisp_Object a) } #endif -struct Lisp_Bignum -{ - union vectorlike_header header; - mpz_t value; -}; - INLINE bool BIGNUMP (Lisp_Object x) { return PSEUDOVECTORP (x, PVEC_BIGNUM); } -INLINE struct Lisp_Bignum * -XBIGNUM (Lisp_Object a) -{ - eassert (BIGNUMP (a)); - return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Bignum); -} - INLINE bool INTEGERP (Lisp_Object x) { return FIXNUMP (x) || BIGNUMP (x); } +/* Return a Lisp integer with value taken from n. */ +INLINE Lisp_Object +make_int (intmax_t n) +{ + return FIXNUM_OVERFLOW_P (n) ? make_bigint (n) : make_fixnum (n); +} + /* Forwarding pointer to an int variable. This is allowed only in the value cell of a symbol, @@ -2698,13 +2682,6 @@ FIXNATP (Lisp_Object x) return FIXNUMP (x) && 0 <= XFIXNUM (x); } INLINE bool -NATNUMP (Lisp_Object x) -{ - if (BIGNUMP (x)) - return mpz_sgn (XBIGNUM (x)->value) >= 0; - return FIXNUMP (x) && 0 <= XFIXNUM (x); -} -INLINE bool NUMBERP (Lisp_Object x) { return INTEGERP (x) || FLOATP (x); @@ -2848,9 +2825,9 @@ CHECK_FIXNAT (Lisp_Object x) INLINE double XFLOATINT (Lisp_Object n) { - if (BIGNUMP (n)) - return mpz_get_d (XBIGNUM (n)->value); - return FLOATP (n) ? XFLOAT_DATA (n) : XFIXNUM (n); + return (FIXNUMP (n) ? XFIXNUM (n) + : FLOATP (n) ? XFLOAT_DATA (n) + : bignum_to_double (n)); } INLINE void @@ -3310,6 +3287,11 @@ set_sub_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val) XSUB_CHAR_TABLE (table)->contents[idx] = val; } +/* Defined in bignum.c. */ +extern Lisp_Object bignum_to_string (Lisp_Object, int); +extern Lisp_Object make_bignum_str (char const *, int); +extern Lisp_Object double_to_bignum (double); + /* Defined in data.c. */ extern _Noreturn void wrong_choice (Lisp_Object, Lisp_Object); extern void notify_variable_watchers (Lisp_Object, Lisp_Object, @@ -3582,22 +3564,6 @@ extern Lisp_Object list5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, enum constype {CONSTYPE_HEAP, CONSTYPE_PURE}; extern Lisp_Object listn (enum constype, ptrdiff_t, Lisp_Object, ...); -extern Lisp_Object make_bignum_str (const char *num, int base); -extern Lisp_Object make_number (mpz_t value); -extern void mpz_set_intmax_slow (mpz_t result, intmax_t v); - -INLINE void -mpz_set_intmax (mpz_t result, intmax_t v) -{ - /* mpz_set_si works in terms of long, but Emacs may use a wider - integer type, and so sometimes will have to construct the mpz_t - by hand. */ - if (LONG_MIN <= v && v <= LONG_MAX) - mpz_set_si (result, v); - else - mpz_set_intmax_slow (result, v); -} - /* Build a frequently used 2/3/4-integer lists. */ INLINE Lisp_Object diff --git a/src/print.c b/src/print.c index 824f8d7577..49d9e38e7d 100644 --- a/src/print.c +++ b/src/print.c @@ -23,6 +23,7 @@ along with GNU Emacs. If not, see . */ #include "sysstdio.h" #include "lisp.h" +#include "bignum.h" #include "character.h" #include "coding.h" #include "buffer.h" @@ -1369,10 +1370,12 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, { case PVEC_BIGNUM: { - struct Lisp_Bignum *b = XBIGNUM (obj); - char *str = mpz_get_str (NULL, 10, b->value); - record_unwind_protect_ptr (xfree, str); + USE_SAFE_ALLOCA; + char *str = SAFE_ALLOCA (mpz_sizeinbase (XBIGNUM (obj)->value, 10) + + 2); + mpz_get_str (str, 10, XBIGNUM (obj)->value); print_c_string (str, printcharfun); + SAFE_FREE (); } break; commit bf1b147b55e1328efca6e40181e79dd9a369895d Author: Glenn Morris Date: Mon Aug 27 22:03:25 2018 -0400 * configure.ac, src/image.c: Tweak previous ImageMagick change. diff --git a/configure.ac b/configure.ac index f9bbccda0c..31750ef66a 100644 --- a/configure.ac +++ b/configure.ac @@ -2516,18 +2516,15 @@ if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" = "yes" || test "${HAVE_W32}" export PKG_CONFIG_PATH="$PKG_CONFIG_PATH$PATH_SEPARATOR`$BREW --prefix imagemagick@6 2>/dev/null`/lib/pkgconfig" fi - ## 6.3.5 is the earliest version known to work; see Bug#17339. - ## 6.8.2 makes Emacs crash; see Bug#13867. - IMAGEMAGICK7_MODULE="MagickWand >= 7" - IMAGEMAGICK6_MODULE="Wand >= 6.3.5 Wand != 6.8.2" - # As we check for ImageMagick 7 then 6 track which version we find - EMACS_CHECK_MODULES([IMAGEMAGICK], [$IMAGEMAGICK7_MODULE]) - AS_IF([test $HAVE_IMAGEMAGICK = yes], - [IMAGEMAGICK_MAJOR=7], - [ - EMACS_CHECK_MODULES([IMAGEMAGICK], [$IMAGEMAGICK6_MODULE]) - AS_IF([test $HAVE_IMAGEMAGICK = yes], [IMAGEMAGICK_MAJOR=6]) - ]) + EMACS_CHECK_MODULES([IMAGEMAGICK7], [MagickWand >= 7]) + if test $HAVE_IMAGEMAGICK7 = yes; then + AC_DEFINE([HAVE_IMAGEMAGICK7], 1, [Define to 1 if using ImageMagick7.]) + HAVE_IMAGEMAGICK = yes + else + ## 6.3.5 is the earliest version known to work; see Bug#17339. + ## 6.8.2 makes Emacs crash; see Bug#13867. + EMACS_CHECK_MODULES([IMAGEMAGICK], [Wand >= 6.3.5 Wand != 6.8.2]) + fi if test $HAVE_IMAGEMAGICK = yes; then OLD_CFLAGS=$CFLAGS diff --git a/src/image.c b/src/image.c index 7e518ce34f..36a909ba05 100644 --- a/src/image.c +++ b/src/image.c @@ -8274,15 +8274,15 @@ imagemagick_image_p (Lisp_Object object) Therefore rename the function so it doesn't collide with ImageMagick. */ #define DrawRectangle DrawRectangleGif -#if IMAGEMAGICK_MAJOR == 6 -# include -# include -#else +#ifdef HAVE_IMAGEMAGICK7 # include # include -/* ImageMagick 7 compatibility definitions */ +/* ImageMagick 7 compatibility definitions. */ # define PixelSetMagickColor PixelSetPixelColor typedef PixelInfo MagickPixelPacket; +#else +# include +# include #endif /* ImageMagick 6.5.3 through 6.6.5 hid PixelGetMagickColor for some reason. commit 5729486951e6a60db55ea17ee3bac9baf8b54f6a Author: Karl Otness Date: Mon Aug 27 21:57:44 2018 -0400 Support ImageMagick version 7 (bug#25967) * configure.ac, src/image.c: Add support for ImageMagick version 7. Copyright-paperwork-exempt: yes diff --git a/configure.ac b/configure.ac index e5d094cf9e..f9bbccda0c 100644 --- a/configure.ac +++ b/configure.ac @@ -2518,9 +2518,16 @@ if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" = "yes" || test "${HAVE_W32}" ## 6.3.5 is the earliest version known to work; see Bug#17339. ## 6.8.2 makes Emacs crash; see Bug#13867. - ## 7 and later have not been ported to; See Bug#25967. - IMAGEMAGICK_MODULE="Wand >= 6.3.5 Wand != 6.8.2 Wand < 7" - EMACS_CHECK_MODULES([IMAGEMAGICK], [$IMAGEMAGICK_MODULE]) + IMAGEMAGICK7_MODULE="MagickWand >= 7" + IMAGEMAGICK6_MODULE="Wand >= 6.3.5 Wand != 6.8.2" + # As we check for ImageMagick 7 then 6 track which version we find + EMACS_CHECK_MODULES([IMAGEMAGICK], [$IMAGEMAGICK7_MODULE]) + AS_IF([test $HAVE_IMAGEMAGICK = yes], + [IMAGEMAGICK_MAJOR=7], + [ + EMACS_CHECK_MODULES([IMAGEMAGICK], [$IMAGEMAGICK6_MODULE]) + AS_IF([test $HAVE_IMAGEMAGICK = yes], [IMAGEMAGICK_MAJOR=6]) + ]) if test $HAVE_IMAGEMAGICK = yes; then OLD_CFLAGS=$CFLAGS @@ -2540,6 +2547,8 @@ if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" = "yes" || test "${HAVE_W32}" fi if test $HAVE_IMAGEMAGICK = yes; then AC_DEFINE([HAVE_IMAGEMAGICK], 1, [Define to 1 if using ImageMagick.]) + AC_DEFINE_UNQUOTED([IMAGEMAGICK_MAJOR], [$IMAGEMAGICK_MAJOR], + [ImageMagick major version number (from configure).]) else IMAGEMAGICK_CFLAGS= IMAGEMAGICK_LIBS= @@ -5460,7 +5469,7 @@ AS_ECHO([" Does Emacs use -lXaw3d? ${HAVE_XAW3D Does Emacs use -lrsvg-2? ${HAVE_RSVG} Does Emacs use cairo? ${HAVE_CAIRO} Does Emacs use -llcms2? ${HAVE_LCMS2} - Does Emacs use imagemagick (version 6)? ${HAVE_IMAGEMAGICK} + Does Emacs use imagemagick? ${HAVE_IMAGEMAGICK} Does Emacs support sound? ${HAVE_SOUND} Does Emacs use -lgpm? ${HAVE_GPM} Does Emacs use -ldbus? ${HAVE_DBUS} diff --git a/src/image.c b/src/image.c index b9ff3f25c4..7e518ce34f 100644 --- a/src/image.c +++ b/src/image.c @@ -8273,11 +8273,20 @@ imagemagick_image_p (Lisp_Object object) /* The GIF library also defines DrawRectangle, but its never used in Emacs. Therefore rename the function so it doesn't collide with ImageMagick. */ #define DrawRectangle DrawRectangleGif -#include + +#if IMAGEMAGICK_MAJOR == 6 +# include +# include +#else +# include +# include +/* ImageMagick 7 compatibility definitions */ +# define PixelSetMagickColor PixelSetPixelColor +typedef PixelInfo MagickPixelPacket; +#endif /* ImageMagick 6.5.3 through 6.6.5 hid PixelGetMagickColor for some reason. Emacs seems to work fine with the hidden version, so unhide it. */ -#include #if 0x653 <= MagickLibVersion && MagickLibVersion <= 0x665 extern WandExport void PixelGetMagickColor (const PixelWand *, MagickPixelPacket *); @@ -8815,7 +8824,7 @@ imagemagick_load_image (struct frame *f, struct image *img, #endif /* HAVE_MAGICKEXPORTIMAGEPIXELS */ { size_t image_height; - MagickRealType color_scale = 65535.0 / QuantumRange; + MagickRealType color_scale = 65535.0 / (MagickRealType) QuantumRange; #ifdef USE_CAIRO data = xmalloc (width * height * 4); color_scale /= 256; commit f1acdff5e04df90821732333c1bb9d8f586f08d2 Author: Paul Eggert Date: Mon Aug 27 18:59:46 2018 -0700 Update from Gnulib * build-aux/config.sub, lib/intprops.h, lib/regex_internal.c: * lib/regex_internal.h, lib/unistd.in.h, m4/limits-h.m4: * m4/stdint.m4, m4/unistd_h.m4: Copy from Gnulib. * lib/gnulib.mk.in: Regenerate. diff --git a/build-aux/config.sub b/build-aux/config.sub index 6e8fa65549..49b16732eb 100755 --- a/build-aux/config.sub +++ b/build-aux/config.sub @@ -2,7 +2,7 @@ # Configuration validation subroutine script. # Copyright 1992-2018 Free Software Foundation, Inc. -timestamp='2018-08-13' +timestamp='2018-08-24' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -692,6 +692,9 @@ case $basic_machine in mac | mpw | mac-mpw) basic_machine=m68k-apple ;; + microblaze | microblazeel) + basic_machine=$basic_machine-xilinx + ;; pmac | pmac-mpw) basic_machine=powerpc-apple ;; @@ -699,226 +702,6 @@ case $basic_machine in basic_machine=xps100-honeywell ;; - # Recognize the basic CPU types without company name. - # Some are omitted here because they have special meanings below. - 1750a | 580 \ - | a29k \ - | aarch64 | aarch64_be \ - | abacus \ - | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ - | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ - | am33_2.0 \ - | arc | arceb \ - | arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv6m | armv[78][arm] \ - | avr | avr32 \ - | asmjs \ - | ba \ - | be32 | be64 \ - | bfin \ - | c4x | c8051 | clipper | csky \ - | d10v | d30v | dlx | dsp16xx \ - | e2k | epiphany \ - | fido | fr30 | frv | ft32 \ - | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ - | hexagon \ - | i370 | i860 | i960 | ia16 | ia64 \ - | ip2k | iq2000 \ - | k1om \ - | le32 | le64 \ - | lm32 \ - | m32c | m32r | m32rle | m68000 | m68k | m88k \ - | m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | nvptx | picochip \ - | maxq | mb | microblaze | microblazeel | mcore | mep | metag \ - | mips | mipsbe | mipseb | mipsel | mipsle \ - | mips16 \ - | mips64 | mips64el \ - | mips64octeon | mips64octeonel \ - | mips64orion | mips64orionel \ - | mips64r5900 | mips64r5900el \ - | mips64vr | mips64vrel \ - | mips64vr4100 | mips64vr4100el \ - | mips64vr4300 | mips64vr4300el \ - | mips64vr5000 | mips64vr5000el \ - | mips64vr5900 | mips64vr5900el \ - | mipsisa32 | mipsisa32el \ - | mipsisa32r2 | mipsisa32r2el \ - | mipsisa32r6 | mipsisa32r6el \ - | mipsisa64 | mipsisa64el \ - | mipsisa64r2 | mipsisa64r2el \ - | mipsisa64r6 | mipsisa64r6el \ - | mipsisa64sb1 | mipsisa64sb1el \ - | mipsisa64sr71k | mipsisa64sr71kel \ - | mipsr5900 | mipsr5900el \ - | mipstx39 | mipstx39el \ - | mn10200 | mn10300 \ - | moxie \ - | mt \ - | msp430 \ - | nds32 | nds32le | nds32be \ - | nfp \ - | nios | nios2 | nios2eb | nios2el \ - | ns16k | ns32k \ - | open8 | or1k | or1knd | or32 \ - | pdp10 | pj | pjl \ - | powerpc | powerpc64 | powerpc64le | powerpcle \ - | pru \ - | pyramid \ - | riscv | riscv32 | riscv64 \ - | rl78 | rx \ - | score \ - | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[234]eb | sheb | shbe | shle | sh[1234]le | sh[23]ele \ - | sh64 | sh64le \ - | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \ - | sparcv8 | sparcv9 | sparcv9b | sparcv9v \ - | spu \ - | tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \ - | ubicom32 \ - | v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \ - | visium \ - | wasm32 \ - | x86 | xc16x | xstormy16 | xgate | xtensa \ - | z8k | z80) - basic_machine=$basic_machine-unknown - ;; - c54x) - basic_machine=tic54x-unknown - ;; - c55x) - basic_machine=tic55x-unknown - ;; - c6x) - basic_machine=tic6x-unknown - ;; - leon|leon[3-9]) - basic_machine=sparc-$basic_machine - ;; - m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65) - ;; - m9s12z | m68hcs12z | hcs12z | s12z) - basic_machine=s12z-unknown - ;; - m9s12z-* | m68hcs12z-* | hcs12z-* | s12z-*) - basic_machine=s12z-`echo "$basic_machine" | sed 's/^[^-]*-//'` - ;; - ms1) - basic_machine=mt-unknown - ;; - strongarm | thumb | xscale) - basic_machine=arm-unknown - ;; - xscaleeb) - basic_machine=armeb-unknown - ;; - - xscaleel) - basic_machine=armel-unknown - ;; - - # We use `pc' rather than `unknown' - # because (1) that's what they normally are, and - # (2) the word "unknown" tends to confuse beginning users. - i*86 | x86_64) - basic_machine=$basic_machine-pc - ;; - # Recognize the basic CPU types with company name. - 1750a-* | 580-* \ - | a29k-* \ - | aarch64-* | aarch64_be-* \ - | abacus-* \ - | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ - | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ - | alphapca5[67]-* | alpha64pca5[67]-* \ - | am33_2.0-* \ - | arc-* | arceb-* \ - | arm-* | arm[lb]e-* | arme[lb]-* | armv*-* \ - | avr-* | avr32-* \ - | asmjs-* \ - | ba-* \ - | be32-* | be64-* \ - | bfin-* | bs2000-* \ - | c[123]* | c30-* | [cjt]90-* | c4x-* \ - | c8051-* | clipper-* | craynv-* | csky-* | cydra-* \ - | d10v-* | d30v-* | dlx-* | dsp16xx-* \ - | e2k-* | elxsi-* | epiphany-* \ - | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | ft32-* | fx80-* \ - | h8300-* | h8500-* \ - | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ - | hexagon-* \ - | i370-* | i*86-* | i860-* | i960-* | ia16-* | ia64-* \ - | ip2k-* | iq2000-* \ - | k1om-* \ - | le32-* | le64-* \ - | lm32-* \ - | m32c-* | m32r-* | m32rle-* \ - | m5200-* | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* | v70-* | w65-* \ - | m6811-* | m68hc11-* | m6812-* | m68hc12-* | m68hcs12x-* | nvptx-* | picochip-* \ - | m88110-* | m88k-* | maxq-* | mb-* | mcore-* | mep-* | metag-* \ - | microblaze-* | microblazeel-* \ - | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ - | mips16-* \ - | mips64-* | mips64el-* \ - | mips64octeon-* | mips64octeonel-* \ - | mips64orion-* | mips64orionel-* \ - | mips64r5900-* | mips64r5900el-* \ - | mips64vr-* | mips64vrel-* \ - | mips64vr4100-* | mips64vr4100el-* \ - | mips64vr4300-* | mips64vr4300el-* \ - | mips64vr5000-* | mips64vr5000el-* \ - | mips64vr5900-* | mips64vr5900el-* \ - | mipsisa32-* | mipsisa32el-* \ - | mipsisa32r2-* | mipsisa32r2el-* \ - | mipsisa32r6-* | mipsisa32r6el-* \ - | mipsisa64-* | mipsisa64el-* \ - | mipsisa64r2-* | mipsisa64r2el-* \ - | mipsisa64r6-* | mipsisa64r6el-* \ - | mipsisa64sb1-* | mipsisa64sb1el-* \ - | mipsisa64sr71k-* | mipsisa64sr71kel-* \ - | mipsr5900-* | mipsr5900el-* \ - | mipstx39-* | mipstx39el-* \ - | mmix-* \ - | mn10200-* | mn10300-* \ - | moxie-* \ - | mt-* \ - | msp430-* \ - | nds32-* | nds32le-* | nds32be-* \ - | nfp-* \ - | nios-* | nios2-* | nios2eb-* | nios2el-* \ - | none-* | np1-* | ns16k-* | ns32k-* \ - | open8-* \ - | or1k*-* \ - | or32-* \ - | orion-* \ - | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ - | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \ - | pru-* \ - | pyramid-* \ - | riscv-* | riscv32-* | riscv64-* \ - | rl78-* | romp-* | rs6000-* | rx-* \ - | score-* \ - | sh-* | sh[1234]-* | sh[24]a-* | sh[24]ae[lb]-* | sh[23]e-* | she[lb]-* | sh[lb]e-* \ - | sh[1234]e[lb]-* | sh[12345][lb]e-* | sh[23]ele-* | sh64-* | sh64le-* \ - | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \ - | sparclite-* \ - | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx*-* \ - | spu-* \ - | tahoe-* \ - | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \ - | tron-* \ - | ubicom32-* \ - | v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \ - | vax-* \ - | visium-* \ - | wasm32-* \ - | we32k-* \ - | x86-* | x86_64-* | xc16x-* | xgate-* | xps100-* \ - | xstormy16-* | xtensa*-* \ - | ymp-* \ - | z8k-* | z80-*) - ;; - # Recognize the basic CPU types without company name, with glob match. - xtensa*) - basic_machine=$basic_machine-unknown - ;; # Recognize the various machine names and aliases which stand # for a CPU type and a company and sometimes even an OS. 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc) @@ -927,12 +710,6 @@ case $basic_machine in 3b*) basic_machine=we32k-att ;; - amd64) - basic_machine=x86_64-pc - ;; - amd64-*) - basic_machine=x86_64-`echo "$basic_machine" | sed 's/^[^-]*-//'` - ;; blackfin-*) basic_machine=bfin-`echo "$basic_machine" | sed 's/^[^-]*-//'` os=linux @@ -954,20 +731,6 @@ case $basic_machine in basic_machine=c90-cray os=${os:-unicos} ;; - cr16 | cr16-*) - basic_machine=cr16-unknown - os=${os:-elf} - ;; - crisv32 | crisv32-* | etraxfs*) - basic_machine=crisv32-axis - ;; - cris | cris-* | etrax*) - basic_machine=cris-axis - ;; - crx) - basic_machine=crx-unknown - os=${os:-elf} - ;; decsystem10* | dec10*) basic_machine=pdp10-dec os=tops10 @@ -1079,9 +842,6 @@ case $basic_machine in basic_machine=m68k-`echo "$basic_machine" | sed 's/^[^-]*-//'` os=linux ;; - microblaze*) - basic_machine=microblaze-xilinx - ;; miniframe) basic_machine=m68000-convergent ;; @@ -1118,21 +878,6 @@ case $basic_machine in np1) basic_machine=np1-gould ;; - neo-tandem) - basic_machine=neo-tandem - ;; - nse-tandem) - basic_machine=nse-tandem - ;; - nsr-tandem) - basic_machine=nsr-tandem - ;; - nsv-tandem) - basic_machine=nsv-tandem - ;; - nsx-tandem) - basic_machine=nsx-tandem - ;; op50n-* | op60c-*) basic_machine=hppa1.1-oki os=proelf @@ -1157,9 +902,6 @@ case $basic_machine in pc532 | pc532-*) basic_machine=ns32k-pc532 ;; - pc98) - basic_machine=i386-pc - ;; pc98-*) basic_machine=i386-`echo "$basic_machine" | sed 's/^[^-]*-//'` ;; @@ -1222,12 +964,6 @@ case $basic_machine in rtpc | rtpc-*) basic_machine=romp-ibm ;; - s390 | s390-*) - basic_machine=s390-ibm - ;; - s390x | s390x-*) - basic_machine=s390x-ibm - ;; sb1) basic_machine=mipsisa64sb1-unknown ;; @@ -1254,14 +990,8 @@ case $basic_machine in strongarm-* | thumb-*) basic_machine=arm-`echo "$basic_machine" | sed 's/^[^-]*-//'` ;; - tile*-*) - ;; - tile*) - basic_machine=$basic_machine-unknown - os=${os:-linux-gnu} - ;; - tx39) - basic_machine=mipstx39-unknown + tx39) + basic_machine=mipstx39-unknown ;; tx39el) basic_machine=mipstx39el-unknown @@ -1272,17 +1002,13 @@ case $basic_machine in vpp*|vx|vx-*) basic_machine=f301-fujitsu ;; - w65*) + w65) basic_machine=w65-wdc - os=none ;; w89k-*) basic_machine=hppa1.1-winbond os=proelf ;; - x64) - basic_machine=x86_64-pc - ;; xscale-* | xscalee[bl]-*) basic_machine=`echo "$basic_machine" | sed 's/^xscale/arm/'` ;; @@ -1290,6 +1016,288 @@ case $basic_machine in basic_machine=none-none ;; + c54x) + basic_machine=tic54x-unknown + ;; + c55x) + basic_machine=tic55x-unknown + ;; + c6x) + basic_machine=tic6x-unknown + ;; + leon | leon[3-9]) + basic_machine=sparc-$basic_machine + ;; + m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70) + ;; + ms1) + basic_machine=mt-unknown + ;; + strongarm | thumb | xscale) + basic_machine=arm-unknown + ;; + xscaleeb) + basic_machine=armeb-unknown + ;; + + xscaleel) + basic_machine=armel-unknown + ;; + + # We use `pc' rather than `unknown' + # because (1) that's what they normally are, and + # (2) the word "unknown" tends to confuse beginning users. + i*86 | x86_64) + basic_machine=$basic_machine-pc + ;; + # These rules are duplicated from below for sake of the special case above; + # i.e. things that normalized to x86 arches should also default to "pc" + pc98) + basic_machine=i386-pc + ;; + x64 | amd64) + basic_machine=x86_64-pc + ;; + + # Recognize the cannonical CPU Types that limit and/or modify the + # company names they are paired with. + amd64-*) + basic_machine=x86_64-`echo "$basic_machine" | sed 's/^[^-]*-//'` + ;; + cr16) + basic_machine=cr16-unknown + os=${os:-elf} + ;; + cr16-*) + os=${os:-elf} + ;; + crisv32 | crisv32-* | etraxfs*) + basic_machine=crisv32-axis + ;; + cris | cris-* | etrax*) + basic_machine=cris-axis + ;; + crx-*) + os=${os:-elf} + ;; + crx) + basic_machine=crx-unknown + os=${os:-elf} + ;; + m9s12z | m68hcs12z | hcs12z | s12z) + basic_machine=s12z-unknown + ;; + m9s12z-* | m68hcs12z-* | hcs12z-* | s12z-*) + basic_machine=s12z-`echo "$basic_machine" | sed 's/^[^-]*-//'` + ;; + neo-tandem) + basic_machine=neo-tandem + ;; + nse-tandem) + basic_machine=nse-tandem + ;; + nsr-tandem) + basic_machine=nsr-tandem + ;; + nsv-tandem) + basic_machine=nsv-tandem + ;; + nsx-tandem) + basic_machine=nsx-tandem + ;; + s390 | s390-*) + basic_machine=s390-ibm + ;; + s390x | s390x-*) + basic_machine=s390x-ibm + ;; + tile*-*) + os=${os:-linux-gnu} + ;; + tile*) + basic_machine=$basic_machine-unknown + os=${os:-linux-gnu} + ;; + + # Recognize the cannonical CPU types that are allowed with any + # company name. + 1750a-* | 580-* \ + | a29k-* \ + | aarch64-* | aarch64_be-* \ + | abacus-* \ + | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ + | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ + | alphapca5[67]-* | alpha64pca5[67]-* \ + | am33_2.0-* \ + | arc-* | arceb-* \ + | arm-* | arm[lb]e-* | arme[lb]-* | armv*-* \ + | avr-* | avr32-* \ + | asmjs-* \ + | ba-* \ + | be32-* | be64-* \ + | bfin-* | bs2000-* \ + | c[123]* | c30-* | [cjt]90-* | c4x-* \ + | c8051-* | clipper-* | craynv-* | csky-* | cydra-* \ + | d10v-* | d30v-* | dlx-* | dsp16xx-* \ + | e2k-* | elxsi-* | epiphany-* \ + | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | ft32-* | fx80-* \ + | h8300-* | h8500-* \ + | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ + | hexagon-* \ + | i370-* | i*86-* | i860-* | i960-* | ia16-* | ia64-* \ + | ip2k-* | iq2000-* \ + | k1om-* \ + | le32-* | le64-* \ + | lm32-* \ + | m32c-* | m32r-* | m32rle-* \ + | m5200-* | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* | v70-* | w65-* \ + | m6811-* | m68hc11-* | m6812-* | m68hc12-* | m68hcs12x-* | nvptx-* | picochip-* \ + | m88110-* | m88k-* | maxq-* | mb-* | mcore-* | mep-* | metag-* \ + | microblaze-* | microblazeel-* \ + | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ + | mips16-* \ + | mips64-* | mips64el-* \ + | mips64octeon-* | mips64octeonel-* \ + | mips64orion-* | mips64orionel-* \ + | mips64r5900-* | mips64r5900el-* \ + | mips64vr-* | mips64vrel-* \ + | mips64vr4100-* | mips64vr4100el-* \ + | mips64vr4300-* | mips64vr4300el-* \ + | mips64vr5000-* | mips64vr5000el-* \ + | mips64vr5900-* | mips64vr5900el-* \ + | mipsisa32-* | mipsisa32el-* \ + | mipsisa32r2-* | mipsisa32r2el-* \ + | mipsisa32r6-* | mipsisa32r6el-* \ + | mipsisa64-* | mipsisa64el-* \ + | mipsisa64r2-* | mipsisa64r2el-* \ + | mipsisa64r6-* | mipsisa64r6el-* \ + | mipsisa64sb1-* | mipsisa64sb1el-* \ + | mipsisa64sr71k-* | mipsisa64sr71kel-* \ + | mipsr5900-* | mipsr5900el-* \ + | mipstx39-* | mipstx39el-* \ + | mmix-* \ + | mn10200-* | mn10300-* \ + | moxie-* \ + | mt-* \ + | msp430-* \ + | nds32-* | nds32le-* | nds32be-* \ + | nfp-* \ + | nios-* | nios2-* | nios2eb-* | nios2el-* \ + | none-* | np1-* | ns16k-* | ns32k-* \ + | open8-* \ + | or1k*-* \ + | or32-* \ + | orion-* \ + | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ + | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | powerpcspe-* \ + | pru-* \ + | pyramid-* \ + | riscv-* | riscv32-* | riscv64-* \ + | rl78-* | romp-* | rs6000-* | rx-* \ + | score-* \ + | sh-* | sh[1234]-* | sh[24]a-* | sh[24]ae[lb]-* | sh[23]e-* | she[lb]-* | sh[lb]e-* \ + | sh[1234]e[lb]-* | sh[12345][lb]e-* | sh[23]ele-* | sh64-* | sh64le-* \ + | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \ + | sparclite-* \ + | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx*-* \ + | spu-* \ + | tahoe-* \ + | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \ + | tron-* \ + | ubicom32-* \ + | v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \ + | vax-* \ + | visium-* \ + | wasm32-* \ + | we32k-* \ + | x86-* | x86_64-* | xc16x-* | xgate-* | xps100-* \ + | xstormy16-* | xtensa*-* \ + | ymp-* \ + | z8k-* | z80-*) + ;; + + # Recognize the basic CPU types without company name. + # Some are omitted here because they have special meanings below. + 1750a | 580 \ + | a29k \ + | aarch64 | aarch64_be \ + | abacus \ + | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ + | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ + | am33_2.0 \ + | arc | arceb \ + | arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv6m | armv[78][arm] \ + | avr | avr32 \ + | asmjs \ + | ba \ + | be32 | be64 \ + | bfin \ + | c4x | c8051 | clipper | csky \ + | d10v | d30v | dlx | dsp16xx \ + | e2k | epiphany \ + | fido | fr30 | frv | ft32 \ + | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ + | hexagon \ + | i370 | i860 | i960 | ia16 | ia64 \ + | ip2k | iq2000 \ + | k1om \ + | le32 | le64 \ + | lm32 \ + | m32c | m32r | m32rle | m68000 | m68k | m88k \ + | m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | nvptx | picochip \ + | maxq | mb | mcore | mep | metag \ + | mips | mipsbe | mipseb | mipsel | mipsle \ + | mips16 \ + | mips64 | mips64el \ + | mips64octeon | mips64octeonel \ + | mips64orion | mips64orionel \ + | mips64r5900 | mips64r5900el \ + | mips64vr | mips64vrel \ + | mips64vr4100 | mips64vr4100el \ + | mips64vr4300 | mips64vr4300el \ + | mips64vr5000 | mips64vr5000el \ + | mips64vr5900 | mips64vr5900el \ + | mipsisa32 | mipsisa32el \ + | mipsisa32r2 | mipsisa32r2el \ + | mipsisa32r6 | mipsisa32r6el \ + | mipsisa64 | mipsisa64el \ + | mipsisa64r2 | mipsisa64r2el \ + | mipsisa64r6 | mipsisa64r6el \ + | mipsisa64sb1 | mipsisa64sb1el \ + | mipsisa64sr71k | mipsisa64sr71kel \ + | mipsr5900 | mipsr5900el \ + | mipstx39 | mipstx39el \ + | mn10200 | mn10300 \ + | moxie \ + | mt \ + | msp430 \ + | nds32 | nds32le | nds32be \ + | nfp \ + | nios | nios2 | nios2eb | nios2el \ + | ns16k | ns32k \ + | open8 | or1k | or1knd | or32 \ + | pdp10 | pj | pjl \ + | powerpc | powerpc64 | powerpc64le | powerpcle | powerpcspe \ + | pru \ + | pyramid \ + | riscv | riscv32 | riscv64 \ + | rl78 | rx \ + | score \ + | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[234]eb | sheb | shbe | shle | sh[1234]le | sh[23]ele \ + | sh64 | sh64le \ + | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \ + | sparcv8 | sparcv9 | sparcv9b | sparcv9v \ + | spu \ + | tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \ + | ubicom32 \ + | v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \ + | visium \ + | wasm32 \ + | x86 | xc16x | xstormy16 | xgate | xtensa* \ + | z8k | z80) + basic_machine=$basic_machine-unknown + ;; + *) echo Invalid configuration \`"$1"\': machine \`"$basic_machine"\' not recognized 1>&2 exit 1 diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 666105b74b..2e265b3068 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -303,6 +303,7 @@ GNULIB_GETLOADAVG = @GNULIB_GETLOADAVG@ GNULIB_GETLOGIN = @GNULIB_GETLOGIN@ GNULIB_GETLOGIN_R = @GNULIB_GETLOGIN_R@ GNULIB_GETPAGESIZE = @GNULIB_GETPAGESIZE@ +GNULIB_GETPASS = @GNULIB_GETPASS@ GNULIB_GETSUBOPT = @GNULIB_GETSUBOPT@ GNULIB_GETTIMEOFDAY = @GNULIB_GETTIMEOFDAY@ GNULIB_GETUSERSHELL = @GNULIB_GETUSERSHELL@ @@ -548,6 +549,7 @@ HAVE_GETHOSTNAME = @HAVE_GETHOSTNAME@ HAVE_GETLOGIN = @HAVE_GETLOGIN@ HAVE_GETOPT_H = @HAVE_GETOPT_H@ HAVE_GETPAGESIZE = @HAVE_GETPAGESIZE@ +HAVE_GETPASS = @HAVE_GETPASS@ HAVE_GETSUBOPT = @HAVE_GETSUBOPT@ HAVE_GETTIMEOFDAY = @HAVE_GETTIMEOFDAY@ HAVE_GRANTPT = @HAVE_GRANTPT@ @@ -854,6 +856,7 @@ REPLACE_GETGROUPS = @REPLACE_GETGROUPS@ REPLACE_GETLINE = @REPLACE_GETLINE@ REPLACE_GETLOGIN_R = @REPLACE_GETLOGIN_R@ REPLACE_GETPAGESIZE = @REPLACE_GETPAGESIZE@ +REPLACE_GETPASS = @REPLACE_GETPASS@ REPLACE_GETTIMEOFDAY = @REPLACE_GETTIMEOFDAY@ REPLACE_GMTIME = @REPLACE_GMTIME@ REPLACE_ISATTY = @REPLACE_ISATTY@ @@ -3098,6 +3101,7 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H -e 's/@''GNULIB_GETLOGIN''@/$(GNULIB_GETLOGIN)/g' \ -e 's/@''GNULIB_GETLOGIN_R''@/$(GNULIB_GETLOGIN_R)/g' \ -e 's/@''GNULIB_GETPAGESIZE''@/$(GNULIB_GETPAGESIZE)/g' \ + -e 's/@''GNULIB_GETPASS''@/$(GNULIB_GETPASS)/g' \ -e 's/@''GNULIB_GETUSERSHELL''@/$(GNULIB_GETUSERSHELL)/g' \ -e 's/@''GNULIB_GROUP_MEMBER''@/$(GNULIB_GROUP_MEMBER)/g' \ -e 's/@''GNULIB_ISATTY''@/$(GNULIB_ISATTY)/g' \ @@ -3141,6 +3145,7 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H -e 's|@''HAVE_GETGROUPS''@|$(HAVE_GETGROUPS)|g' \ -e 's|@''HAVE_GETHOSTNAME''@|$(HAVE_GETHOSTNAME)|g' \ -e 's|@''HAVE_GETPAGESIZE''@|$(HAVE_GETPAGESIZE)|g' \ + -e 's|@''HAVE_GETPASS''@|$(HAVE_GETPASS)|g' \ -e 's|@''HAVE_GROUP_MEMBER''@|$(HAVE_GROUP_MEMBER)|g' \ -e 's|@''HAVE_LCHOWN''@|$(HAVE_LCHOWN)|g' \ -e 's|@''HAVE_LINK''@|$(HAVE_LINK)|g' \ @@ -3184,6 +3189,7 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H -e 's|@''REPLACE_GETLOGIN_R''@|$(REPLACE_GETLOGIN_R)|g' \ -e 's|@''REPLACE_GETGROUPS''@|$(REPLACE_GETGROUPS)|g' \ -e 's|@''REPLACE_GETPAGESIZE''@|$(REPLACE_GETPAGESIZE)|g' \ + -e 's|@''REPLACE_GETPASS''@|$(REPLACE_GETPASS)|g' \ -e 's|@''REPLACE_ISATTY''@|$(REPLACE_ISATTY)|g' \ -e 's|@''REPLACE_LCHOWN''@|$(REPLACE_LCHOWN)|g' \ -e 's|@''REPLACE_LINK''@|$(REPLACE_LINK)|g' \ diff --git a/lib/intprops.h b/lib/intprops.h index 15e470cbc6..3d6b3cf4d9 100644 --- a/lib/intprops.h +++ b/lib/intprops.h @@ -22,12 +22,13 @@ #include -/* Return a value with the common real type of E and V and the value of V. */ -#define _GL_INT_CONVERT(e, v) (0 * (e) + (v)) +/* Return a value with the common real type of E and V and the value of V. + Do not evaluate E. */ +#define _GL_INT_CONVERT(e, v) ((1 ? 0 : (e)) + (v)) /* Act like _GL_INT_CONVERT (E, -V) but work around a bug in IRIX 6.5 cc; see . */ -#define _GL_INT_NEGATE_CONVERT(e, v) (0 * (e) - (v)) +#define _GL_INT_NEGATE_CONVERT(e, v) ((1 ? 0 : (e)) - (v)) /* The extra casts in the following macros work around compiler bugs, e.g., in Cray C 5.0.3.0. */ @@ -40,13 +41,14 @@ #define TYPE_SIGNED(t) (! ((t) 0 < (t) -1)) /* Return 1 if the real expression E, after promotion, has a - signed or floating type. */ + signed or floating type. Do not evaluate E. */ #define EXPR_SIGNED(e) (_GL_INT_NEGATE_CONVERT (e, 1) < 0) /* Minimum and maximum values for integer types and expressions. */ /* The width in bits of the integer type or expression T. + Do not evaluate T. Padding bits are not supported; this is checked at compile-time below. */ #define TYPE_WIDTH(t) (sizeof (t) * CHAR_BIT) @@ -58,7 +60,7 @@ : ((((t) 1 << (TYPE_WIDTH (t) - 2)) - 1) * 2 + 1))) /* The maximum and minimum values for the type of the expression E, - after integer promotion. E should not have side effects. */ + after integer promotion. E is not evaluated. */ #define _GL_INT_MINIMUM(e) \ (EXPR_SIGNED (e) \ ? ~ _GL_SIGNED_INT_MAXIMUM (e) \ @@ -340,8 +342,8 @@ Arguments should be free of side effects. */ #define _GL_BINARY_OP_OVERFLOW(a, b, op_result_overflow) \ op_result_overflow (a, b, \ - _GL_INT_MINIMUM (0 * (b) + (a)), \ - _GL_INT_MAXIMUM (0 * (b) + (a))) + _GL_INT_MINIMUM ((1 ? 0 : (b)) + (a)), \ + _GL_INT_MAXIMUM ((1 ? 0 : (b)) + (a))) /* Store the low-order bits of A + B, A - B, A * B, respectively, into *R. Return 1 if the result overflows. See above for restrictions. */ diff --git a/lib/regex_internal.c b/lib/regex_internal.c index 32373565e6..e3ce4abfa6 100644 --- a/lib/regex_internal.c +++ b/lib/regex_internal.c @@ -317,7 +317,7 @@ build_wcs_upper_buffer (re_string_t *pstr) mbclen = __mbrtowc (&wc, ((const char *) pstr->raw_mbs + pstr->raw_mbs_idx + byte_idx), remain_len, &pstr->cur_state); - if (BE (mbclen < (size_t) -2, 1)) + if (BE (0 < mbclen && mbclen < (size_t) -2, 1)) { wchar_t wcu = __towupper (wc); if (wcu != wc) @@ -386,7 +386,7 @@ build_wcs_upper_buffer (re_string_t *pstr) else p = (const char *) pstr->raw_mbs + pstr->raw_mbs_idx + src_idx; mbclen = __mbrtowc (&wc, p, remain_len, &pstr->cur_state); - if (BE (mbclen < (size_t) -2, 1)) + if (BE (0 < mbclen && mbclen < (size_t) -2, 1)) { wchar_t wcu = __towupper (wc); if (wcu != wc) diff --git a/lib/regex_internal.h b/lib/regex_internal.h index 7bbe802bc5..dd0900b719 100644 --- a/lib/regex_internal.h +++ b/lib/regex_internal.h @@ -149,7 +149,10 @@ /* Rename to standard API for using out of glibc. */ #ifndef _LIBC # undef __wctype +# undef __iswalnum # undef __iswctype +# undef __towlower +# undef __towupper # define __wctype wctype # define __iswalnum iswalnum # define __iswctype iswctype diff --git a/lib/unistd.in.h b/lib/unistd.in.h index 55bbb6ca3b..66f254d60f 100644 --- a/lib/unistd.in.h +++ b/lib/unistd.in.h @@ -935,6 +935,36 @@ _GL_WARN_ON_USE (getpagesize, "getpagesize is unportable - " #endif +#if @GNULIB_GETPASS@ +/* Function getpass() from module 'getpass': + Read a password from /dev/tty or stdin. + Function getpass() from module 'getpass-gnu': + Read a password of arbitrary length from /dev/tty or stdin. */ +# if @REPLACE_GETPASS@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef getpass +# define getpass rpl_getpass +# endif +_GL_FUNCDECL_RPL (getpass, char *, (const char *prompt) + _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (getpass, char *, (const char *prompt)); +# else +# if !@HAVE_GETPASS@ +_GL_FUNCDECL_SYS (getpass, char *, (const char *prompt) + _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (getpass, char *, (const char *prompt)); +# endif +_GL_CXXALIASWARN (getpass); +#elif defined GNULIB_POSIXCHECK +# undef getpass +# if HAVE_RAW_DECL_GETPASS +_GL_WARN_ON_USE (getpass, "getpass is unportable - " + "use gnulib module getpass or getpass-gnu for portability"); +# endif +#endif + + #if @GNULIB_GETUSERSHELL@ /* Return the next valid login shell on the system, or NULL when the end of the list has been reached. */ diff --git a/m4/limits-h.m4 b/m4/limits-h.m4 index 511dcef5e0..8388663439 100644 --- a/m4/limits-h.m4 +++ b/m4/limits-h.m4 @@ -29,3 +29,11 @@ AC_DEFUN_ONCE([gl_LIMITS_H], AC_SUBST([LIMITS_H]) AM_CONDITIONAL([GL_GENERATE_LIMITS_H], [test -n "$LIMITS_H"]) ]) + +dnl Unconditionally enables the replacement of . +AC_DEFUN([gl_REPLACE_LIMITS_H], +[ + AC_REQUIRE([gl_LIMITS_H]) + LIMITS_H='limits.h' + AM_CONDITIONAL([GL_GENERATE_LIMITS_H], [test -n "$LIMITS_H"]) +]) diff --git a/m4/stdint.m4 b/m4/stdint.m4 index b86184c2ea..38dbbedffe 100644 --- a/m4/stdint.m4 +++ b/m4/stdint.m4 @@ -1,4 +1,4 @@ -# stdint.m4 serial 51 +# stdint.m4 serial 52 dnl Copyright (C) 2001-2018 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -364,8 +364,7 @@ int32_t i32 = INT32_C (0x7fffffff); esac dnl The substitute stdint.h needs the substitute limit.h's _GL_INTEGER_WIDTH. - LIMITS_H=limits.h - AM_CONDITIONAL([GL_GENERATE_LIMITS_H], [test -n "$LIMITS_H"]) + gl_REPLACE_LIMITS_H AC_SUBST([HAVE_C99_STDINT_H]) AC_SUBST([HAVE_SYS_BITYPES_H]) diff --git a/m4/unistd_h.m4 b/m4/unistd_h.m4 index 159c48aeef..3ba64da8a0 100644 --- a/m4/unistd_h.m4 +++ b/m4/unistd_h.m4 @@ -1,4 +1,4 @@ -# unistd_h.m4 serial 73 +# unistd_h.m4 serial 74 dnl Copyright (C) 2006-2018 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -43,7 +43,7 @@ AC_DEFUN([gl_UNISTD_H], #endif ]], [chdir chown dup dup2 dup3 environ euidaccess faccessat fchdir fchownat fdatasync fsync ftruncate getcwd getdomainname getdtablesize getgroups - gethostname getlogin getlogin_r getpagesize + gethostname getlogin getlogin_r getpagesize getpass getusershell setusershell endusershell group_member isatty lchown link linkat lseek pipe pipe2 pread pwrite readlink readlinkat rmdir sethostname sleep symlink symlinkat @@ -83,6 +83,7 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS], GNULIB_GETLOGIN=0; AC_SUBST([GNULIB_GETLOGIN]) GNULIB_GETLOGIN_R=0; AC_SUBST([GNULIB_GETLOGIN_R]) GNULIB_GETPAGESIZE=0; AC_SUBST([GNULIB_GETPAGESIZE]) + GNULIB_GETPASS=0; AC_SUBST([GNULIB_GETPASS]) GNULIB_GETUSERSHELL=0; AC_SUBST([GNULIB_GETUSERSHELL]) GNULIB_GROUP_MEMBER=0; AC_SUBST([GNULIB_GROUP_MEMBER]) GNULIB_ISATTY=0; AC_SUBST([GNULIB_ISATTY]) @@ -126,6 +127,7 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS], HAVE_GETHOSTNAME=1; AC_SUBST([HAVE_GETHOSTNAME]) HAVE_GETLOGIN=1; AC_SUBST([HAVE_GETLOGIN]) HAVE_GETPAGESIZE=1; AC_SUBST([HAVE_GETPAGESIZE]) + HAVE_GETPASS=1; AC_SUBST([HAVE_GETPASS]) HAVE_GROUP_MEMBER=1; AC_SUBST([HAVE_GROUP_MEMBER]) HAVE_LCHOWN=1; AC_SUBST([HAVE_LCHOWN]) HAVE_LINK=1; AC_SUBST([HAVE_LINK]) @@ -168,6 +170,7 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS], REPLACE_GETLOGIN_R=0; AC_SUBST([REPLACE_GETLOGIN_R]) REPLACE_GETGROUPS=0; AC_SUBST([REPLACE_GETGROUPS]) REPLACE_GETPAGESIZE=0; AC_SUBST([REPLACE_GETPAGESIZE]) + REPLACE_GETPASS=0; AC_SUBST([REPLACE_GETPASS]) REPLACE_ISATTY=0; AC_SUBST([REPLACE_ISATTY]) REPLACE_LCHOWN=0; AC_SUBST([REPLACE_LCHOWN]) REPLACE_LINK=0; AC_SUBST([REPLACE_LINK]) commit 785682c26df4ced5c62075c88477b7bc50afb332 Author: Glenn Morris Date: Mon Aug 27 21:46:14 2018 -0400 * configure.ac (emacs_config_features): Add GLIB, XDBE, XIM. diff --git a/configure.ac b/configure.ac index 868930bb5e..4dadf661d8 100644 --- a/configure.ac +++ b/configure.ac @@ -5367,12 +5367,13 @@ Configured for '${canonical}'. optsep= emacs_config_features= for opt in XAW3D XPM JPEG TIFF GIF PNG RSVG CAIRO IMAGEMAGICK SOUND GPM DBUS \ - GCONF GSETTINGS NOTIFY ACL LIBSELINUX GNUTLS LIBXML2 FREETYPE M17N_FLT \ - LIBOTF XFT ZLIB TOOLKIT_SCROLL_BARS X_TOOLKIT OLDXMENU X11 NS MODULES \ - THREADS XWIDGETS LIBSYSTEMD CANNOT_DUMP LCMS2; do + GCONF GSETTINGS GLIB NOTIFY ACL LIBSELINUX GNUTLS LIBXML2 FREETYPE M17N_FLT \ + LIBOTF XFT ZLIB TOOLKIT_SCROLL_BARS X_TOOLKIT OLDXMENU X11 XDBE XIM \ + NS MODULES THREADS XWIDGETS LIBSYSTEMD CANNOT_DUMP LCMS2; do case $opt in CANNOT_DUMP) eval val=\${$opt} ;; + GLIB) val=${emacs_cv_links_glib} ;; NOTIFY|ACL) eval val=\${${opt}_SUMMARY} ;; TOOLKIT_SCROLL_BARS|X_TOOLKIT) eval val=\${USE_$opt} ;; THREADS) val=${threads_enabled} ;; commit 2695b7e74559318cee2b4e69c2f94ac22421d134 Author: Glenn Morris Date: Mon Aug 27 21:44:29 2018 -0400 * configure.ac: Doc fixes related to --with-xim. diff --git a/configure.ac b/configure.ac index 3d39cd0c3b..868930bb5e 100644 --- a/configure.ac +++ b/configure.ac @@ -362,7 +362,7 @@ OPTION_DEFAULT_ON([m17n-flt],[don't use m17n-flt for text shaping]) OPTION_DEFAULT_ON([toolkit-scroll-bars],[don't use Motif or Xaw3d scroll bars]) OPTION_DEFAULT_ON([xaw3d],[don't use Xaw3d]) -OPTION_DEFAULT_ON([xim],[don't use X11 XIM]) +OPTION_DEFAULT_ON([xim],[at runtime, default X11 XIM to off]) AC_ARG_WITH([ns],[AS_HELP_STRING([--with-ns], [use Nextstep (macOS Cocoa or GNUstep) windowing system. On by default on macOS.])],[],[with_ns=maybe]) @@ -3149,11 +3149,12 @@ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ AC_DEFINE(HAVE_XIM, 1, [Define to 1 if XIM is available])], HAVE_XIM=no) -dnl '--with-xim' now controls only the initial value of use_xim at run time. - +dnl Note this is non-standard. --with-xim does not control whether +dnl XIM support is compiled in, it only affects the runtime default of +dnl use_xim in xterm.c. if test "${with_xim}" != "no"; then AC_DEFINE(USE_XIM, 1, - [Define to 1 if we should use XIM, if it is available.]) + [Define to 1 to default runtime use of XIM to on.]) fi commit 717b0341aafb9ae9b93395dba1192b12c4459f0c Author: Alex Branham Date: Tue Aug 21 10:21:39 2018 -0500 New commands bibtex-next/previous-entry (Bug#32378) * lisp/textmodes/bibtex.el (bibtex-next-entry) (bibtex-previous-entry): New commands. (bibtex-mode-map): Bind to to forward-paragraph and backward-paragraph. Add to menu under "Moving inside an Entry". diff --git a/etc/NEWS b/etc/NEWS index 4fc02e8f2a..049863822a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -255,6 +255,12 @@ navigation and editing of large files. * Changes in Specialized Modes and Packages in Emacs 27.1 +--- +** bibtex +*** New commands 'bibtex-next-entry' and 'bibtex-previous-entry'. +In bibtex-mode-map, forward-paragraph and backward-paragraph are +remapped to these, respectively. + +++ ** Dired diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 6f6b06266e..57e5ef8017 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -1356,6 +1356,8 @@ Set this variable before loading BibTeX mode." ;; The Key `C-c&' is reserved for reftex.el (define-key km "\t" 'bibtex-find-text) (define-key km "\n" 'bibtex-next-field) + (define-key km [remap forward-paragraph] 'bibtex-next-entry) + (define-key km [remap backward-paragraph] 'bibtex-previous-entry) (define-key km "\M-\t" 'completion-at-point) (define-key km "\C-c\"" 'bibtex-remove-delimiters) (define-key km "\C-c{" 'bibtex-remove-delimiters) @@ -1415,6 +1417,8 @@ Set this variable before loading BibTeX mode." ("Moving inside an Entry" ["End of Field" bibtex-find-text t] ["Next Field" bibtex-next-field t] + ["Next entry" bibtex-next-entry t] + ["Previous entry" bibtex-previous-entry t] ["Beginning of Entry" bibtex-beginning-of-entry t] ["End of Entry" bibtex-end-of-entry t] "--" @@ -4452,6 +4456,24 @@ is as in `bibtex-enclosing-field'. It is t for interactive calls." (goto-char (match-beginning 0))) (bibtex-find-text begin nil bibtex-help-message))) +(defun bibtex-next-entry (&optional arg) + "Move point ARG entries forward. +ARG defaults to one. Called interactively, ARG is the prefix +argument." + (interactive "p") + (bibtex-end-of-entry) + (when (re-search-forward bibtex-entry-maybe-empty-head nil t (or arg 1)) + (goto-char (match-beginning 0)))) + +(defun bibtex-previous-entry (&optional arg) + "Move point ARG entries backward. +ARG defaults to one. Called interactively, ARG is the prefix +argument." + (interactive "p") + (bibtex-beginning-of-entry) + (when (re-search-backward bibtex-entry-maybe-empty-head nil t (or arg 1)) + (goto-char (match-beginning 0)))) + (defun bibtex-find-text (&optional begin noerror help comma) "Move point to end of text of current BibTeX field or entry head. With optional prefix BEGIN non-nil, move point to its beginning. commit 0250d22eeb8427cb87c58f528f337dc83d0419a5 Author: Noam Postavsky Date: Tue Aug 7 20:40:56 2018 -0400 shr: Allow skipping tags with aria-hidden (Bug#32348) * lisp/net/shr.el (shr-discard-aria-hidden): New option. (shr-descend): Suppress aria-hidden=true tags if it's set. * doc/misc/eww.texi (Advanced): Document shr-discard-aria-hidden. * etc/NEWS: Announce it. diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi index 43adc2eda0..aa17eee9d9 100644 --- a/doc/misc/eww.texi +++ b/doc/misc/eww.texi @@ -262,6 +262,16 @@ contrast. If that is still too low for you, you can customize the variables @code{shr-color-visible-distance-min} and @code{shr-color-visible-luminance-min} to get a better contrast. +@vindex shr-discard-aria-hidden +@cindex @code{aria-hidden}, HTML attribute + The HTML attribute @code{aria-hidden} is meant to tell screen +readers to ignore a tag's contents. You can customize the variable +@code{shr-discard-aria-hidden} to tell @code{shr} to ignore such tags. +This can be useful when using a screen reader on the output of +@code{shr} (e.g., on EWW buffer text). It can be useful even when not +using a screen reader, since web authors often put this attribute on +non-essential decorative elements. + @cindex Desktop Support @cindex Saving Sessions In addition to maintaining the history at run-time, EWW will also diff --git a/etc/NEWS b/etc/NEWS index d757f52466..4fc02e8f2a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -405,6 +405,11 @@ and its value has been changed to Duck Duck Go. 'shr-selected-link' face to give the user feedback that the command has been executed. ++++ +*** New option 'shr-discard-aria-hidden'. +If set, shr will not render tags with attribute 'aria-hidden="true"'. +This attribute is meant to tell screen readers to ignore a tag. + ** Htmlfontify *** The functions 'hfy-color', 'hfy-color-vals' and diff --git a/lisp/net/shr.el b/lisp/net/shr.el index edea7cb297..bc86fe5a38 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -68,6 +68,13 @@ fit these criteria." :group 'shr :type 'boolean) +(defcustom shr-discard-aria-hidden nil + "If non-nil, don't render tags with `aria-hidden=\"true\"'. +This attribute is meant to tell screen readers to ignore a tag." + :version "27.1" + :group 'shr + :type 'boolean) + (defcustom shr-use-colors t "If non-nil, respect color specifications in the HTML." :version "26.1" @@ -509,7 +516,9 @@ size, and full-buffer size." shr-stylesheet)) (setq style nil))) ;; If we have a display:none, then just ignore this part of the DOM. - (unless (equal (cdr (assq 'display shr-stylesheet)) "none") + (unless (or (equal (cdr (assq 'display shr-stylesheet)) "none") + (and shr-discard-aria-hidden + (equal (dom-attr dom 'aria-hidden) "true"))) ;; We don't use shr-indirect-call here, since shr-descend is ;; the central bit of shr.el, and should be as fast as ;; possible. Having one more level of indirection with its commit c8b86362d45a07e0aec0041cade551c3c663ea8c Author: Noam Postavsky Date: Mon Jul 16 22:14:32 2018 -0400 Allow setf of buffer-modified-p without argument (Bug#21201) * lisp/emacs-lisp/cl-lib.el (setf buffer-modified-p): Take current buffer if optional argument BUF is not passed. diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index d7e72ce99a..592235d2de 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -531,8 +531,9 @@ If ALIST is non-nil, the new pairs are prepended to it." ;; Some more Emacs-related place types. (gv-define-simple-setter buffer-file-name set-visited-file-name t) (gv-define-setter buffer-modified-p (flag &optional buf) - `(with-current-buffer ,buf - (set-buffer-modified-p ,flag))) + (macroexp-let2 nil buffer `(or ,buf (current-buffer)) + `(with-current-buffer ,buffer + (set-buffer-modified-p ,flag)))) (gv-define-simple-setter buffer-name rename-buffer t) (gv-define-setter buffer-string (store) `(insert (prog1 ,store (erase-buffer)))) commit d0d162c2d63600435622ad4cb5e67e98d1a36da4 Author: Glenn Morris Date: Mon Aug 27 18:27:01 2018 -0400 Small checkdoc quoting fix (bug#32546) * lisp/emacs-lisp/checkdoc.el (checkdoc-this-string-valid-engine): Fix quoting thinko. diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 4e8ecba4a1..f2bf15d72d 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -1868,7 +1868,7 @@ Replace with \"%s\"? " original replace) (if (checkdoc-autofix-ask-replace (match-beginning 1) (+ (match-beginning 1) (length ms)) - msg (format-message "`%s'" ms) t) + msg (format "`%s'" ms) t) (setq msg nil) (setq msg (format-message commit 66bf12b6a1777d8dd09f8ddcefe96314555d0134 Author: Alan Mackenzie Date: Mon Aug 27 20:37:49 2018 +0000 CC Mode: Fix syntactic context of BOD sometimes being 'topmost-intro-cont This happened when the type of the previous function was a struct, etc., declaration. * lisp/progmodes/cc-mode (c-guess-basic-syntax CASE 5N): Check here (for 'topmost-intro-cont) that the first opening brace after BOD is the opening brace preceding the starting point. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index d1eb3c3d06..278ade0560 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -12280,7 +12280,18 @@ comment at the start of cc-engine.el for more info." ;; The '}' is unbalanced. nil (c-end-of-decl-1) - (>= (point) indent-point)))))) + (>= (point) indent-point)))) + ;; Check that we only have one brace block here, i.e. that we + ;; don't have something like a function with a struct + ;; declaration as its type. + (save-excursion + (or (not (and state-cache (consp (car state-cache)))) + ;; The above probably can't happen. + (progn + (goto-char placeholder) + (and (c-syntactic-re-search-forward + "{" indent-point t) + (eq (1- (point)) (caar state-cache)))))))) (goto-char placeholder) (c-add-stmt-syntax 'topmost-intro-cont nil nil containing-sexp paren-state)) commit 3266e69dabfb36b2c9886a5e31b87e322d01ca7f Author: Alan Mackenzie Date: Mon Aug 27 19:49:25 2018 +0000 c-where-wrt-brace-construct: deal with point following a struct's semicolon. More precisely, when point is right after the terminating semicolon of a construct like "struct foo { .... } bar;", the function must return 'at-function-end. * lisp/progmodes/cc-cmds.el (c-where-wrt-brace-construct): Surround an existing test for 'at-function-end with an `or' form, the other arm testing for being after the semicolon above. diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index 478ccf1802..4f256e1008 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -1441,21 +1441,23 @@ No indentation or other \"electric\" behavior is performed." 'in-block) ((c-in-function-trailer-p) 'in-trailer) - ((and (not least-enclosing) - (consp paren-state) - (consp (car paren-state)) - (eq start (cdar paren-state)) - (or - (save-excursion - (c-forward-syntactic-ws) - (or (not (looking-at c-symbol-start)) - (looking-at c-keywords-regexp))) - (save-excursion - (goto-char (caar paren-state)) - (c-beginning-of-decl-1 - (and least-enclosing - (c-safe-position least-enclosing paren-state))) - (not (looking-at c-defun-type-name-decl-key))))) + ((or (and (eq (char-before) ?\;) + (save-excursion + (backward-char) + (c-in-function-trailer-p))) + (and (not least-enclosing) + (consp paren-state) + (consp (car paren-state)) + (eq start (cdar paren-state)) + (or + (save-excursion + (c-forward-syntactic-ws) + (or (not (looking-at c-symbol-start)) + (looking-at c-keywords-regexp))) + (save-excursion + (goto-char (caar paren-state)) + (c-beginning-of-decl-1) + (not (looking-at c-defun-type-name-decl-key)))))) 'at-function-end) (t ;; Find the start of the current declaration. NOTE: If we're in the commit 674f276c0ab3e9759d33f37971ef87f84a3b0683 Author: Gemini Lasswell Date: Tue Aug 7 19:39:06 2018 -0700 Fix links in backtraces to work on advised built-ins (Bug#25393) * lisp/emacs-lisp/backtrace.el (backtrace--print-func-and-args): Make links to the original definition of advised functions. Handle the case when the function slot of the backtrace frame contains the definition of a built-in function. diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el index f13b43b465..e82d4f5a5a 100644 --- a/lisp/emacs-lisp/backtrace.el +++ b/lisp/emacs-lisp/backtrace.el @@ -34,6 +34,7 @@ (eval-when-compile (require 'cl-lib)) (eval-when-compile (require 'pcase)) (eval-when-compile (require 'subr-x)) ; if-let +(require 'find-func) (require 'help-mode) ; Define `help-function-def' button type. (require 'lisp-mode) @@ -735,11 +736,11 @@ Format it according to VIEW." (evald (backtrace-frame-evald frame)) (fun (backtrace-frame-fun frame)) (args (backtrace-frame-args frame)) - (def (and (symbolp fun) (fboundp fun) (symbol-function fun))) + (def (find-function-advised-original fun)) (fun-file (or (symbol-file fun 'defun) - (and (subrp def) - (not (eq 'unevalled (cdr (subr-arity def)))) - (find-lisp-object-file-name fun def)))) + (and (subrp def) + (not (eq 'unevalled (cdr (subr-arity def)))) + (find-lisp-object-file-name fun def)))) (fun-pt (point))) (cond ((and evald (not debugger-stack-frame-as-list)) @@ -762,7 +763,8 @@ Format it according to VIEW." (insert (backtrace--print-to-string fun-and-args))) (cl-incf fun-pt))) (when fun-file - (make-text-button fun-pt (+ fun-pt (length (symbol-name fun))) + (make-text-button fun-pt (+ fun-pt + (length (backtrace--print-to-string fun))) :type 'help-function-def 'help-args (list fun fun-file))) ;; After any frame that uses eval-buffer, insert a comment that commit f2701917e28b2aca6d98d8214e5ef2ff648a11f8 Author: Michael Albinus Date: Mon Aug 27 16:45:50 2018 +0200 Bump Tramp version to 2.4.1-pre * doc/misc/trampver.texi: * lisp/net/trampver.el: Change version to "2.4.1-pre". * lisp/net/tramp.el: Add "Package-Requires" header. diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index 6d02b043b6..807330bb9b 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -8,7 +8,7 @@ @c In the Tramp GIT, the version number is auto-frobbed from @c configure.ac, so you should edit that file and run @c "autoconf && ./configure" to change the version number. -@set trampver 2.4.0 +@set trampver 2.4.1-pre @c Other flags from configuration @set instprefix /usr/local diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 457fd7fbcc..0033f2c170 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -8,6 +8,7 @@ ;; Keywords: comm, processes ;; Package: tramp ;; Version: 2.4.1-pre +;; Package-Requires: ((emacs "24.1")) ;; This file is part of GNU Emacs. @@ -36,8 +37,6 @@ ;; Notes: ;; ----- ;; -;; This package only works for Emacs 24.1 and higher. -;; ;; Also see the todo list at the bottom of this file. ;; ;; The current version of Tramp can be retrieved from the following URL: diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 9bc8768384..1956ab648b 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -7,7 +7,6 @@ ;; Maintainer: Michael Albinus ;; Keywords: comm, processes ;; Package: tramp -;; Version: 2.4.0 ;; This file is part of GNU Emacs. @@ -33,7 +32,7 @@ ;; should be changed only there. ;;;###tramp-autoload -(defconst tramp-version "2.4.0" +(defconst tramp-version "2.4.1-pre" "This version of Tramp.") ;;;###tramp-autoload @@ -53,10 +52,10 @@ (replace-regexp-in-string "\n" "" (buffer-string)))))))) ;; Check for Emacs version. -(let ((x (if (>= emacs-major-version 24) - "ok" - (format "Tramp 2.4.0 is not fit for %s" - (replace-regexp-in-string "\n" "" (emacs-version)))))) +(let ((x (if (not (string-lessp emacs-version "24.1")) + "ok" + (format "Tramp 2.4.1-pre is not fit for %s" + (replace-regexp-in-string "\n" "" (emacs-version)))))) (unless (string-equal "ok" x) (error "%s" x))) ;; Tramp versions integrated into Emacs. commit c61fbc529343194923ca11dfe10e9afb8b2546d3 Merge: e1370c36ce 1afd313334 Author: Michael Albinus Date: Mon Aug 27 12:51:44 2018 +0200 Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs commit 1afd313334c93cb5b0a7a378bd635a54dc1d6a9e Merge: 18d52b90a1 54fb383af6 Author: Glenn Morris Date: Sun Aug 26 15:10:50 2018 -0700 Merge from origin/emacs-26 54fb383 (origin/emacs-26) Fix detection of freed emacs_values (Bug#32... 769d0cd ; Fix out-of-tree build for mod-test.so 9a1329e Avoid crashes with very wide TTY frames on MS-Windows 9a613d3 Prevent `modify-file-local-variable-prop-line' from adding ex... 624e7dc Update GNOME bugtracker URLs 51ef6d5 Clarify in the Emacs manual that ChangeLog files are not used 6e08019 Recognize codepage 65001 as a valid encoding 1a350d7 ; * etc/NEWS: Fix format of first lines of some entries. 22d1f53 Avoid compilation warning in nt/addpm.c 7bc9ce7 Fix duplicate custom group names in bibtex.el a9cf938 Fix outdated text in the Calc manual Conflicts: etc/NEWS etc/PROBLEMS src/emacs-module.c src/gtkutil.c src/image.c src/xterm.c test/Makefile.in commit 18d52b90a1692a47cea5b5e905a58a3b2c6c9a64 Author: Eli Zaretskii Date: Sun Aug 26 17:53:05 2018 +0300 Fix a typo in alloc.c * src/alloc.c (Fmemory_use_counts): The list we return now has only 7 elements, not 8. (Bug#32531) diff --git a/src/alloc.c b/src/alloc.c index cdcd465ac5..c9788ab4c6 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -7017,7 +7017,7 @@ Frames, windows, buffers, and subprocesses count as vectors (but the contents of a buffer's text do not count here). */) (void) { - return listn (CONSTYPE_HEAP, 8, + return listn (CONSTYPE_HEAP, 7, bounded_number (cons_cells_consed), bounded_number (floats_consed), bounded_number (vector_cells_consed), commit 5c642b2dc1b666ae488225b76251750a8cf331be Author: Alan Mackenzie Date: Sun Aug 26 11:05:22 2018 +0000 CC Mode: make c-display-defun-name work with a pointer return type. Fixes bug #32403. * lisp/progmodes/cc-cmds.el (c-in-function-trailer-p): No longer insist on c-beginning-of-decl-1 returning 'same. (c-where-wrt-brace-construct): Tighten up the test for looking at a symbol by excluding keywords. When point is after a }, do not return 'at-function-end for a struct/union/class/... (c-defun-name-1): Considerably simplify, by amalgamating the two cond arms which find structs etc., and by using functions like c-forward-declarator rather than the faulty analysis of the source by hand. diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index 31cf0b1159..478ccf1802 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -1383,7 +1383,7 @@ No indentation or other \"electric\" behavior is performed." (let ((eo-block (point)) bod) (and (eq (char-before) ?\}) - (eq (car (c-beginning-of-decl-1 lim)) 'previous) + (memq (car (c-beginning-of-decl-1 lim)) '(same previous)) (setq bod (point)) ;; Look for struct or union or ... If we find one, it might ;; be the return type of a function, or the like. Exclude @@ -1445,10 +1445,17 @@ No indentation or other \"electric\" behavior is performed." (consp paren-state) (consp (car paren-state)) (eq start (cdar paren-state)) - (not - (progn + (or + (save-excursion (c-forward-syntactic-ws) - (looking-at c-symbol-start)))) + (or (not (looking-at c-symbol-start)) + (looking-at c-keywords-regexp))) + (save-excursion + (goto-char (caar paren-state)) + (c-beginning-of-decl-1 + (and least-enclosing + (c-safe-position least-enclosing paren-state))) + (not (looking-at c-defun-type-name-decl-key))))) 'at-function-end) (t ;; Find the start of the current declaration. NOTE: If we're in the @@ -1841,7 +1848,7 @@ or NIL if there isn't one. \"Defun\" here means a function, or other top level construct with a brace block." (c-save-buffer-state (beginning-of-defun-function end-of-defun-function - where pos decl name-start name-end case-fold-search) + where pos decl0 decl type-pos tag-pos case-fold-search) (save-excursion ;; Move back out of any macro/comment/string we happen to be in. @@ -1861,31 +1868,10 @@ other top level construct with a brace block." (when (looking-at c-typedef-key) (goto-char (match-end 0)) (c-forward-syntactic-ws)) + (setq type-pos (point)) ;; Pick out the defun name, according to the type of defun. (cond - ;; struct, union, enum, or similar: - ((save-excursion - (and - (looking-at c-defun-type-name-decl-key) - (consp (c-forward-decl-or-cast-1 (c-point 'bosws) 'top nil)) - (or (not (or (eq (char-after) ?{) - (and c-recognize-knr-p - (c-in-knr-argdecl)))) - (progn (c-backward-syntactic-ws) - (not (eq (char-before) ?\))))))) - (let ((key-pos (point))) - (c-forward-over-token-and-ws) ; over "struct ". - (cond - ((looking-at c-symbol-key) ; "struct foo { ..." - (buffer-substring-no-properties key-pos (match-end 0))) - ((eq (char-after) ?{) ; "struct { ... } foo" - (when (c-go-list-forward) - (c-forward-syntactic-ws) - (when (looking-at c-symbol-key) ; a bit bogus - there might - ; be several identifiers. - (match-string-no-properties 0))))))) - ((looking-at "DEFUN\\s-*(") ;"DEFUN\\_>") think of XEmacs! ;; DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory, ...) ==> Ffile_name_directory ;; DEFUN(POSIX::STREAM-LOCK, stream lockp &key BLOCK SHARED START LENGTH) ==> POSIX::STREAM-LOCK @@ -1901,32 +1887,23 @@ other top level construct with a brace block." (c-backward-syntactic-ws) (point)))) - (t - ;; Normal function or initializer. - (when - (and - (consp - (setq decl - (c-forward-decl-or-cast-1 (c-point 'bosws) 'top nil))) - (setq name-start (car decl)) - (progn (if (and (looking-at c-after-suffixed-type-decl-key) - (match-beginning 1)) - (c-forward-keyword-clause 1)) - t) - (or (eq (char-after) ?{) - (and c-recognize-knr-p - (c-in-knr-argdecl))) - (goto-char name-start) - (c-forward-name) - (eq (char-after) ?\()) - (c-backward-syntactic-ws) - (when (eq (char-before) ?\=) ; struct foo bar = {0, 0} ; - (c-backward-token-2) - (c-backward-syntactic-ws)) - (setq name-end (point)) - (c-back-over-compound-identifier) - (and (looking-at c-symbol-start) - (buffer-substring-no-properties (point) name-end))))))))) + (t ; Normal function or initializer. + (when (looking-at c-defun-type-name-decl-key) ; struct, etc. + (goto-char (match-end 0)) + (c-forward-syntactic-ws) + (setq tag-pos (point)) + (goto-char type-pos)) + (setq decl0 (c-forward-decl-or-cast-1 (c-point 'bosws) 'top nil)) + (when (consp decl0) + (goto-char (car decl0)) + (setq decl (c-forward-declarator))) + (and decl + (car decl) (cadr decl) + (buffer-substring-no-properties + (if (eq (car decl) tag-pos) + type-pos + (car decl)) + (cadr decl))))))))) (defun c-defun-name () "Return the name of the current defun, or NIL if there isn't one. commit e1370c36cef12e4ffdf4519a2eec6bb5b7727883 Author: Stefan Monnier Date: Sun Aug 26 10:33:09 2018 +0200 * lisp/net/tramp.el: Add "Version" header. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 8e6c911850..457fd7fbcc 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -7,6 +7,7 @@ ;; Maintainer: Michael Albinus ;; Keywords: comm, processes ;; Package: tramp +;; Version: 2.4.1-pre ;; This file is part of GNU Emacs. commit 0edf60583245cc6f3fd53ddae2f21748a4a1b239 Author: Paul Eggert Date: Sat Aug 25 19:03:26 2018 -0700 Improve format-seconds accuracy * doc/lispref/os.texi (Time Parsing): It works with bignums. * lisp/calendar/time-date.el (format-seconds): Take the floor so that the resulting arithmetic is exact. diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index adf554e843..c48d08490f 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -1681,10 +1681,6 @@ You can also specify the field width by following the @samp{%} with a number; shorter numbers will be padded with blanks. An optional period before the width requests zero-padding instead. For example, @code{"%.3Y"} might produce @code{"004 years"}. - -@emph{Warning:} This function works only with values of @var{seconds} -that don't exceed @code{most-positive-fixnum} (@pxref{Integer Basics, -most-positive-fixnum}). @end defun @node Processor Run Time diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index 467915e3d9..74c607ccb6 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -303,6 +303,7 @@ is output until the first non-zero unit is encountered." (push match usedunits))) (and zeroflag larger (error "Units are not in decreasing order of size")) + (setq seconds (floor seconds)) (dolist (u units) (setq spec (car u) name (cadr u) commit 54fb383af6f6af7b72c28f38b308d9b24d2af4f6 Author: Sergey Vinokurov Date: Sun Aug 19 21:31:01 2018 +0100 Fix detection of freed emacs_values (Bug#32479) * src/emacs-module.c (module_free_global_ref): Compare a value to be freed with all entries of the list. * test/data/emacs-module/mod-test.c (Fmod_test_globref_free): New function. (emacs_module_init): Make it accessible from Lisp. * test/src/emacs-module-tests.el (mod-test-globref-free-test): New test which uses it. diff --git a/src/emacs-module.c b/src/emacs-module.c index 1b19e8033d..c20902d072 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -334,20 +334,20 @@ module_free_global_ref (emacs_env *env, emacs_value ref) Lisp_Object globals = global_env_private.values; Lisp_Object prev = Qnil; ptrdiff_t count = 0; - for (Lisp_Object tail = global_env_private.values; CONSP (tail); + for (Lisp_Object tail = globals; CONSP (tail); tail = XCDR (tail)) { - emacs_value global = XSAVE_POINTER (XCAR (globals), 0); + emacs_value global = XSAVE_POINTER (XCAR (tail), 0); if (global == ref) { if (NILP (prev)) global_env_private.values = XCDR (globals); else - XSETCDR (prev, XCDR (globals)); + XSETCDR (prev, XCDR (tail)); return; } ++count; - prev = globals; + prev = tail; } module_abort ("Global value was not found in list of %"pD"d globals", count); diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c index a1c115f00d..4c783faeea 100644 --- a/test/data/emacs-module/mod-test.c +++ b/test/data/emacs-module/mod-test.c @@ -156,6 +156,24 @@ Fmod_test_globref_make (emacs_env *env, ptrdiff_t nargs, emacs_value args[], return env->make_global_ref (env, lisp_str); } +/* Create a few global references from arguments and free them. */ +static emacs_value +Fmod_test_globref_free (emacs_env *env, ptrdiff_t nargs, emacs_value args[], + void *data) +{ + emacs_value refs[10]; + for (int i = 0; i < 10; i++) + { + refs[i] = env->make_global_ref (env, args[i % nargs]); + } + for (int i = 0; i < 10; i++) + { + env->free_global_ref (env, refs[i]); + } + return env->intern (env, "ok"); +} + + /* Return a copy of the argument string where every 'a' is replaced with 'b'. */ @@ -339,6 +357,7 @@ emacs_module_init (struct emacs_runtime *ert) DEFUN ("mod-test-non-local-exit-funcall", Fmod_test_non_local_exit_funcall, 1, 1, NULL, NULL); DEFUN ("mod-test-globref-make", Fmod_test_globref_make, 0, 0, NULL, NULL); + DEFUN ("mod-test-globref-free", Fmod_test_globref_free, 4, 4, NULL, NULL); DEFUN ("mod-test-string-a-to-b", Fmod_test_string_a_to_b, 1, 1, NULL, NULL); DEFUN ("mod-test-userptr-make", Fmod_test_userptr_make, 1, 1, NULL, NULL); DEFUN ("mod-test-userptr-get", Fmod_test_userptr_get, 1, 1, NULL, NULL); diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index d9406a9609..9f598c6827 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -136,6 +136,9 @@ changes." (garbage-collect) ;; XXX: not enough to really test but it's something.. (should (string= ref-str mod-str)))) +(ert-deftest mod-test-globref-free-test () + (should (eq (mod-test-globref-free 1 'a "test" 'b) 'ok))) + (ert-deftest mod-test-string-a-to-b-test () (should (string= (mod-test-string-a-to-b "aaa") "bbb"))) commit 769d0cdaa9a986b74e30dfc589e1fa8115e1d401 Author: Noam Postavsky Date: Sat Aug 25 18:55:11 2018 -0400 ; Fix out-of-tree build for mod-test.so * test/Makefile.in: Don't look for emacs-module.h in $(srcdir), since it is generated. diff --git a/test/Makefile.in b/test/Makefile.in index 597ef91311..c0a073338e 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -231,12 +231,14 @@ else FPIC_CFLAGS = -fPIC endif -MODULE_CFLAGS = -I$(srcdir)/../src $(FPIC_CFLAGS) $(PROFILING_CFLAGS) \ +# Note: emacs-module.h is generated from emacs-module.h.in, hence we +# look in ../src, not $(srcdir)/../src. +MODULE_CFLAGS = -I../src $(FPIC_CFLAGS) $(PROFILING_CFLAGS) \ $(WARN_CFLAGS) $(WERROR_CFLAGS) $(CFLAGS) test_module = $(test_module_dir)/mod-test${SO} src/emacs-module-tests.log: $(test_module) -$(test_module): $(test_module:${SO}=.c) $(srcdir)/../src/emacs-module.h +$(test_module): $(test_module:${SO}=.c) ../src/emacs-module.h $(AM_V_CCLD)$(CC) -shared $(CPPFLAGS) $(MODULE_CFLAGS) $(LDFLAGS) \ -o $@ $< endif commit 2daf8b7e55698cc58f9b0a82aac591f957041cc6 Author: Paul Eggert Date: Sat Aug 25 14:20:02 2018 -0700 Prefer CONSP etc. to XTYPE * src/nsmenu.m (process_dialog:): (initFromContents:isQuestion:): Prefer CONSP (x) to XTYPE (x) == Lisp_Cons, and similarly for STRINGP (x). diff --git a/src/nsmenu.m b/src/nsmenu.m index 7010b773e3..983e77763b 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -1632,24 +1632,24 @@ - (void)process_dialog: (Lisp_Object) list int row = 0; int buttons = 0, btnnr = 0; - for (; XTYPE (lst) == Lisp_Cons; lst = XCDR (lst)) + for (; CONSP (lst); lst = XCDR (lst)) { item = XCAR (list); - if (XTYPE (item) == Lisp_Cons) + if (CONSP (item)) ++buttons; } if (buttons > 0) button_values = xmalloc (buttons * sizeof *button_values); - for (; XTYPE (list) == Lisp_Cons; list = XCDR (list)) + for (; CONSP (list); list = XCDR (list)) { item = XCAR (list); - if (XTYPE (item) == Lisp_String) + if (STRINGP (item)) { [self addString: SSDATA (item) row: row++]; } - else if (XTYPE (item) == Lisp_Cons) + else if (CONSP (item)) { button_values[btnnr] = XCDR (item); [self addButton: SSDATA (XCAR (item)) value: btnnr row: row++]; @@ -1726,7 +1726,7 @@ - (instancetype)initFromContents: (Lisp_Object)contents isQuestion: (BOOL)isQ Lisp_Object head; [super init]; - if (XTYPE (contents) == Lisp_Cons) + if (CONSP (contents)) { head = Fcar (contents); [self process_dialog: Fcdr (contents)]; @@ -1734,7 +1734,7 @@ - (instancetype)initFromContents: (Lisp_Object)contents isQuestion: (BOOL)isQ else head = contents; - if (XTYPE (head) == Lisp_String) + if (STRINGP (head)) [title setStringValue: [NSString stringWithUTF8String: SSDATA (head)]]; else if (isQ == YES) commit ccdb08ef4ed8f96e79aa06cf5e806c9c487d58ad Author: Paul Eggert Date: Sat Aug 25 13:39:18 2018 -0700 Improve performance of CONSP, FIXNUMP, etc. Optimization opportunity noted by Pip Cet in: https://lists.gnu.org/r/emacs-devel/2018-08/msg00828.html On my platform (Fedora 28 x86-64, AMD Phenom II X4 910e, user+system time), this improved â€make compile-always’ performance by 0.4% and shrank text size by a similar amount. * src/lisp.h (TAGGEDP, lisp_h_TAGGEDP): New macros and function. (lisp_h_CONSP, lisp_h_FLOATP, lisp_h_SYMBOLP) (lisp_h_VECTORLIKEP, make_lisp_ptr, STRINGP): Use them. (lisp_h_FIXNUMP): Use the same idea that lisp_h_TAGGEDP uses. diff --git a/src/lisp.h b/src/lisp.h index bca4dfbb60..fb11a11fda 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -362,10 +362,13 @@ typedef EMACS_INT Lisp_Word; #define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) #define lisp_h_CHECK_TYPE(ok, predicate, x) \ ((ok) ? (void) 0 : wrong_type_argument (predicate, x)) -#define lisp_h_CONSP(x) (XTYPE (x) == Lisp_Cons) +#define lisp_h_CONSP(x) TAGGEDP (x, Lisp_Cons) #define lisp_h_EQ(x, y) (XLI (x) == XLI (y)) -#define lisp_h_FLOATP(x) (XTYPE (x) == Lisp_Float) -#define lisp_h_FIXNUMP(x) ((XTYPE (x) & (Lisp_Int0 | ~Lisp_Int1)) == Lisp_Int0) +#define lisp_h_FIXNUMP(x) \ + (! (((unsigned) (XLI (x) >> (USE_LSB_TAG ? 0 : FIXNUM_BITS)) \ + - (unsigned) (Lisp_Int0 >> !USE_LSB_TAG)) \ + & ((1 << INTTYPEBITS) - 1))) +#define lisp_h_FLOATP(x) TAGGEDP (x, Lisp_Float) #define lisp_h_NILP(x) EQ (x, Qnil) #define lisp_h_SET_SYMBOL_VAL(sym, v) \ (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), \ @@ -375,8 +378,12 @@ typedef EMACS_INT Lisp_Word; #define lisp_h_SYMBOL_TRAPPED_WRITE_P(sym) (XSYMBOL (sym)->u.s.trapped_write) #define lisp_h_SYMBOL_VAL(sym) \ (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), (sym)->u.s.val.value) -#define lisp_h_SYMBOLP(x) (XTYPE (x) == Lisp_Symbol) -#define lisp_h_VECTORLIKEP(x) (XTYPE (x) == Lisp_Vectorlike) +#define lisp_h_SYMBOLP(x) TAGGEDP (x, Lisp_Symbol) +#define lisp_h_TAGGEDP(a, tag) \ + (! (((unsigned) (XLI (a) >> (USE_LSB_TAG ? 0 : VALBITS)) \ + - (unsigned) (tag)) \ + & ((1 << GCTYPEBITS) - 1))) +#define lisp_h_VECTORLIKEP(x) TAGGEDP (x, Lisp_Vectorlike) #define lisp_h_XCAR(c) XCONS (c)->u.s.car #define lisp_h_XCDR(c) XCONS (c)->u.s.u.cdr #define lisp_h_XCONS(a) \ @@ -435,6 +442,7 @@ typedef EMACS_INT Lisp_Word; # define SYMBOL_TRAPPED_WRITE_P(sym) lisp_h_SYMBOL_TRAPPED_WRITE_P (sym) # define SYMBOL_VAL(sym) lisp_h_SYMBOL_VAL (sym) # define SYMBOLP(x) lisp_h_SYMBOLP (x) +# define TAGGEDP(a, tag) lisp_h_TAGGEDP (a, tag) # define VECTORLIKEP(x) lisp_h_VECTORLIKEP (x) # define XCAR(c) lisp_h_XCAR (c) # define XCDR(c) lisp_h_XCDR (c) @@ -647,6 +655,15 @@ INLINE enum Lisp_Type #endif } +/* True if A has type tag TAG. + Equivalent to XTYPE (a) == TAG, but often faster. */ + +INLINE bool +(TAGGEDP) (Lisp_Object a, enum Lisp_Type tag) +{ + return lisp_h_TAGGEDP (a, tag); +} + INLINE void (CHECK_TYPE) (int ok, Lisp_Object predicate, Lisp_Object x) { @@ -1131,7 +1148,7 @@ INLINE Lisp_Object make_lisp_ptr (void *ptr, enum Lisp_Type type) { Lisp_Object a = TAG_PTR (type, ptr); - eassert (XTYPE (a) == type && XUNTAG (a, type, char) == ptr); + eassert (TAGGEDP (a, type) && XUNTAG (a, type, char) == ptr); return a; } @@ -1364,7 +1381,7 @@ verify (alignof (struct Lisp_String) % GCALIGNMENT == 0); INLINE bool STRINGP (Lisp_Object x) { - return XTYPE (x) == Lisp_String; + return TAGGEDP (x, Lisp_String); } INLINE void commit 9a1329e966ecbd22464f607456153bdd4fa0d5ea Author: Eli Zaretskii Date: Sat Aug 25 15:26:41 2018 +0300 Avoid crashes with very wide TTY frames on MS-Windows * src/w32console.c : Reduce the number of elements to 80. : New static variables. (w32con_clear_end_of_line): If the line is wider than the current size of the "empty row" in 'glyphs', reallocate 'glyphs' to support the full width of the frame. This avoids segfaults when the frame is wider than 256 columns. (Bug#32445) diff --git a/src/w32console.c b/src/w32console.c index ea30853bad..36a6ced298 100644 --- a/src/w32console.c +++ b/src/w32console.c @@ -140,23 +140,36 @@ w32con_clear_frame (struct frame *f) } -static struct glyph glyph_base[256]; +static struct glyph glyph_base[80]; +static struct glyph *glyphs = glyph_base; +static size_t glyphs_len = ARRAYELTS (glyph_base); static BOOL ceol_initialized = FALSE; /* Clear from Cursor to end (what's "standout marker"?). */ static void w32con_clear_end_of_line (struct frame *f, int end) { + /* Time to reallocate our "empty row"? With today's large screens, + it is not unthinkable to see TTY frames well in excess of + 80-character width. */ + if (end - cursor_coords.X > glyphs_len) + { + if (glyphs == glyph_base) + glyphs = NULL; + glyphs = xrealloc (glyphs, FRAME_COLS (f) * sizeof (struct glyph)); + glyphs_len = FRAME_COLS (f); + ceol_initialized = FALSE; + } if (!ceol_initialized) { int i; - for (i = 0; i < 256; i++) + for (i = 0; i < glyphs_len; i++) { - memcpy (&glyph_base[i], &space_glyph, sizeof (struct glyph)); + memcpy (&glyphs[i], &space_glyph, sizeof (struct glyph)); } ceol_initialized = TRUE; } - w32con_write_glyphs (f, glyph_base, end - cursor_coords.X); /* fencepost ? */ + w32con_write_glyphs (f, glyphs, end - cursor_coords.X); } /* Insert n lines at vpos. if n is negative delete -n lines. */ @@ -772,6 +785,15 @@ initialize_w32_display (struct terminal *term, int *width, int *height) *width = 1 + info.srWindow.Right - info.srWindow.Left; } + /* Force reinitialization of the "empty row" buffer, in case they + dumped from a running session. */ + if (glyphs != glyph_base) + { + glyphs = NULL; + glyphs_len = 0; + ceol_initialized = FALSE; + } + if (os_subtype == OS_NT) w32_console_unicode_input = 1; else commit 9a613d3ed0331f9fd2528520a96d977ebba57d7d Author: Wenjamin Petrenko Date: Tue Aug 14 11:44:18 2018 +0300 Prevent `modify-file-local-variable-prop-line' from adding extra ';' * lisp/files-x.el (modify-file-local-variable-prop-line): Handle whitespace when checking if there's already a ';' before the variable (Bug#23294). Copyright-paperwork-exempt: yes diff --git a/lisp/files-x.el b/lisp/files-x.el index 2a52792222..92532e85f4 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -377,7 +377,9 @@ from the -*- line ignoring the input argument VALUE." ((eq variable 'mode) (goto-char beg)) ((null replaced-pos) (goto-char end)) (replaced-pos (goto-char replaced-pos))) - (if (and (not (eq (char-before) ?\;)) + (if (and (save-excursion + (skip-chars-backward " \t") + (not (eq (char-before) ?\;))) (not (equal (point) (marker-position beg))) ;; When existing `-*- -*-' is empty, beg > end. (not (> (marker-position beg) (marker-position end)))) commit 624e7dc77865e0a9359dd7f7b0e861743d091313 Author: Glenn Morris Date: Fri Aug 24 13:13:08 2018 -0400 Update GNOME bugtracker URLs * configure.ac, admin/notes/multi-tty, etc/PROBLEMS: * src/emacs.c (main): * src/xterm.c (x_connection_closed): Update GNOME bugtracker URLs. ; * src/gtkutil.c (xg_display_close): ; * src/image.c (svg_load_image): Update URLs in comments. diff --git a/admin/notes/multi-tty b/admin/notes/multi-tty index 9cfe7aacd3..5b34bb598e 100644 --- a/admin/notes/multi-tty +++ b/admin/notes/multi-tty @@ -305,7 +305,7 @@ THINGS TO DO multidisplay (and don't mind core dumps), you can edit src/config.h and define HAVE_GTK_MULTIDISPLAY there by hand. - http://bugzilla.gnome.org/show_bug.cgi?id=85715 + https://gitlab.gnome.org/GNOME/gtk/issues/221 Update: Han reports that GTK+ version 2.8.9 almost gets display disconnects right. GTK will probably be fully fixed by the time diff --git a/configure.ac b/configure.ac index 9542d441d7..3d39cd0c3b 100644 --- a/configure.ac +++ b/configure.ac @@ -2659,7 +2659,7 @@ if test x"$pkg_check_gtk" = xyes; then closing open displays. This is no problem if you just use one display, but if you use more than one and close one of them Emacs may crash. - See https://bugzilla.gnome.org/show_bug.cgi?id=85715]]) + See https://gitlab.gnome.org/GNOME/gtk/issues/221]]) fi fi diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 1e103e9af0..9507a5d975 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -207,7 +207,7 @@ configuring your compiler to use the native linker instead of GNU ld. ** When Emacs is compiled with Gtk+, closing a display kills Emacs. There is a long-standing bug in GTK that prevents it from recovering -from disconnects: http://bugzilla.gnome.org/show_bug.cgi?id=85715. +from disconnects: https://gitlab.gnome.org/GNOME/gtk/issues/221. Thus, for instance, when Emacs is run as a server on a text terminal, and an X frame is created, and the X server for that frame crashes or @@ -225,7 +225,7 @@ The error message is: X protocol error: BadMatch (invalid parameter attributes) on protocol request 140 When compiled with GTK, Emacs cannot recover from X disconnects. - This is a GTK bug: https://bugzilla.gnome.org/show_bug.cgi?id=85715 + This is a GTK bug: https://gitlab.gnome.org/GNOME/gtk/issues/221 For details, see etc/PROBLEMS. Fatal error 6: Aborted @@ -1164,7 +1164,7 @@ is running. If gnome-settings-daemon is not running, Emacs receives input through XIM without any problem. Furthermore, this seems only to happen in *.UTF-8 locales; zh_CN.GB2312 and zh_CN.GBK locales, for example, work fine. A bug report has been filed in the Gnome -bugzilla: http://bugzilla.gnome.org/show_bug.cgi?id=357032 +bugzilla: https://bugzilla.gnome.org/show_bug.cgi?id=357032 *** Gnome: GPaste clipboard manager causes erratic behavior of 'yank' diff --git a/src/emacs.c b/src/emacs.c index f5e47428ef..483e848f6d 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1067,7 +1067,7 @@ main (int argc, char **argv) #endif /* HAVE_LIBSYSTEMD */ #ifdef USE_GTK - fprintf (stderr, "\nWarning: due to a long standing Gtk+ bug\nhttp://bugzilla.gnome.org/show_bug.cgi?id=85715\n\ + fprintf (stderr, "\nWarning: due to a long standing Gtk+ bug\nhttps://gitlab.gnome.org/GNOME/gtk/issues/221\n\ Emacs might crash when run in daemon mode and the X11 connection is unexpectedly lost.\n\ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem.\n"); #endif /* USE_GTK */ diff --git a/src/gtkutil.c b/src/gtkutil.c index 83b306a730..6b72671da9 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -259,7 +259,7 @@ xg_display_close (Display *dpy) #if GTK_CHECK_VERSION (2, 0, 0) && ! GTK_CHECK_VERSION (2, 10, 0) /* GTK 2.2-2.8 has a bug that makes gdk_display_close crash (bug - http://bugzilla.gnome.org/show_bug.cgi?id=85715). This way we + https://gitlab.gnome.org/GNOME/gtk/issues/221). This way we can continue running, but there will be memory leaks. */ g_object_run_dispose (G_OBJECT (gdpy)); #else diff --git a/src/image.c b/src/image.c index 4d5a1bf5e6..767979e63b 100644 --- a/src/image.c +++ b/src/image.c @@ -9302,7 +9302,7 @@ svg_load_image (struct frame *f, struct image *img, char *contents, /* Set base_uri for properly handling referenced images (via 'href'). See rsvg bug 596114 - "image refs are relative to curdir, not .svg file" - (https://bugzilla.gnome.org/show_bug.cgi?id=596114). */ + (https://gitlab.gnome.org/GNOME/librsvg/issues/33). */ if (filename) rsvg_handle_set_base_uri(rsvg_handle, filename); diff --git a/src/xterm.c b/src/xterm.c index a564691033..b2d1b5c198 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -9812,13 +9812,13 @@ x_connection_closed (Display *dpy, const char *error_message, bool ioerror) current Xt versions, this isn't needed either. */ #ifdef USE_GTK /* A long-standing GTK bug prevents proper disconnect handling - (https://bugzilla.gnome.org/show_bug.cgi?id=85715). Once, + (https://gitlab.gnome.org/GNOME/gtk/issues/221). Once, the resulting Glib error message loop filled a user's disk. To avoid this, kill Emacs unconditionally on disconnect. */ shut_down_emacs (0, Qnil); fprintf (stderr, "%s\n\ When compiled with GTK, Emacs cannot recover from X disconnects.\n\ -This is a GTK bug: https://bugzilla.gnome.org/show_bug.cgi?id=85715\n\ +This is a GTK bug: https://gitlab.gnome.org/GNOME/gtk/issues/221\n\ For details, see etc/PROBLEMS.\n", error_msg); emacs_abort (); commit 161139a42c02cce051c51fb80c6ae00c9e6beaa6 Author: Noam Postavsky Date: Mon Jun 25 19:11:41 2018 -0400 Detect Chinese sudo password prompts (Bug#31075) * lisp/comint.el (comint-password-prompt-regexp): Allow text between the prompt prefix and password equivalent. * lisp/eshell/esh-mode.el (eshell-password-prompt-regexp): Accept some unicode alternatives to ":". * test/lisp/comint-tests.el (comint-testsuite-password-strings): Add test case. diff --git a/lisp/comint.el b/lisp/comint.el index 51c7e81e09..5928804fe7 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -360,7 +360,8 @@ This variable is buffer-local." "Kerberos" "CVS" "UNIX" " SMB" "LDAP" "PEM" "SUDO" "[sudo]" "Repeat" "Bad" "Retype") t) - " +\\)" + ;; Allow for user name to precede password equivalent (Bug#31075). + " +.*\\)" "\\(?:" (regexp-opt password-word-equivalents) "\\|Response\\)" "\\(?:\\(?:, try\\)? *again\\| (empty for no passphrase)\\| (again)\\)?" ;; "[[:alpha:]]" used to be "for", which fails to match non-English. diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index 9f854c7d90..0c25f412c2 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -182,10 +182,11 @@ inserted. They return the string as it should be inserted." :group 'eshell-mode) (defcustom eshell-password-prompt-regexp - (format "\\(%s\\).*:\\s *\\'" (regexp-opt password-word-equivalents)) + (format "\\(%s\\)[^:：៖]*[:：៖]\\s *\\'" (regexp-opt password-word-equivalents)) "Regexp matching prompts for passwords in the inferior process. This is used by `eshell-watch-for-password-prompt'." :type 'regexp + :version "27.1" :group 'eshell-mode) (defcustom eshell-skip-prompt-function nil diff --git a/test/lisp/comint-tests.el b/test/lisp/comint-tests.el index 366fcc9ad8..eab2709cea 100644 --- a/test/lisp/comint-tests.el +++ b/test/lisp/comint-tests.el @@ -36,6 +36,7 @@ "Enter same passphrase again: " ; ssh-keygen "Passphrase for key root@GNU.ORG: " ; plink "[sudo] password for user:" ; Ubuntu sudo + "[sudo] user 的密ç ďĽš" ; localized "Password (again):" "Enter password:" "Mot de Passe :" ; localized (Bug#29729) commit 74277b0e88197c169acfc16025e0e116230c021e Author: Noam Postavsky Date: Fri Aug 17 06:29:35 2018 -0400 Fix comint-password-prompt-regexp The change from 2017-12-22 "Support French password prompts in shell" tried to allow nonbreaking space in addition to whitespace syntax characters around the colon, but used square brackets which cause "\s" to be interpreted literally rather than as a backslash construct. * lisp/comint.el (comint-password-prompt-regexp): Use [[:blank:]] instead, which also has the benefit of not relying on the major mode's whitespace syntax setting. * test/lisp/comint-tests.el (comint-testsuite-password-strings): Update French localized entry to have a space before the colon, as reported in Bug#29729. diff --git a/lisp/comint.el b/lisp/comint.el index a9c3e47f88..51c7e81e09 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -364,7 +364,7 @@ This variable is buffer-local." "\\(?:" (regexp-opt password-word-equivalents) "\\|Response\\)" "\\(?:\\(?:, try\\)? *again\\| (empty for no passphrase)\\| (again)\\)?" ;; "[[:alpha:]]" used to be "for", which fails to match non-English. - "\\(?: [[:alpha:]]+ .+\\)?[\\s  ]*[:：៖][\\s  ]*\\'") + "\\(?: [[:alpha:]]+ .+\\)?[[:blank:]]*[:：៖][[:blank:]]*\\'") "Regexp matching prompts for passwords in the inferior process. This is used by `comint-watch-for-password-prompt'." :version "27.1" diff --git a/test/lisp/comint-tests.el b/test/lisp/comint-tests.el index 64898888ba..366fcc9ad8 100644 --- a/test/lisp/comint-tests.el +++ b/test/lisp/comint-tests.el @@ -38,7 +38,7 @@ "[sudo] password for user:" ; Ubuntu sudo "Password (again):" "Enter password:" - "Mot de Passe:" ; localized + "Mot de Passe :" ; localized (Bug#29729) "Passwort:") ; localized "List of strings that should match `comint-password-prompt-regexp'.") commit ca8dbde14b2b2025aa69c52378904ee5c573a0d7 Author: Charles A. Roelli Date: Thu Aug 23 22:10:08 2018 +0200 Replace 2 checks in rmailsum.el with 'pos-visible-in-window-p' * lisp/mail/rmailsum.el (rmail-summary-scroll-msg-up) (rmail-summary-scroll-msg-down): Use 'pos-visible-in-window-p' instead of checking the condition by hand. diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el index e5363d2198..10345b63ae 100644 --- a/lisp/mail/rmailsum.el +++ b/lisp/mail/rmailsum.el @@ -1315,11 +1315,7 @@ advance to the next message." (select-window rmail-buffer-window) (prog1 ;; Is EOB visible in the buffer? - (save-excursion - (let ((ht (window-height))) - (move-to-window-line (- ht 2)) - (end-of-line) - (eobp))) + (pos-visible-in-window-p (point-max)) (select-window rmail-summary-window))) (if (not rmail-summary-scroll-between-messages) (error "End of buffer") @@ -1342,10 +1338,7 @@ move to the previous message." (select-window rmail-buffer-window) (prog1 ;; Is BOB visible in the buffer? - (save-excursion - (move-to-window-line 0) - (beginning-of-line) - (bobp)) + (pos-visible-in-window-p (point-min)) (select-window rmail-summary-window))) (if (not rmail-summary-scroll-between-messages) (error "Beginning of buffer") commit 51ef6d5576ac5ae2315619e8c7972585d6526d9b Author: Eli Zaretskii Date: Thu Aug 23 20:02:27 2018 +0300 Clarify in the Emacs manual that ChangeLog files are not used * doc/emacs/trouble.texi (Sending Patches): Use "commit log" instead of "change log", to avoid the interpretation that we are talking about literal ChangeLog files. (Bug#32359) diff --git a/doc/emacs/trouble.texi b/doc/emacs/trouble.texi index 37a7304167..bb05378f4c 100644 --- a/doc/emacs/trouble.texi +++ b/doc/emacs/trouble.texi @@ -1162,11 +1162,11 @@ name that indicates whether it is the old version or your new changed one. @item -Write the change log entries for your changes. This is both to save us +Write the commit log entries for your changes. This is both to save us the extra work of writing them, and to help explain your changes so we can understand them. -The purpose of the change log is to show people where to find what was +The purpose of the commit log is to show people where to find what was changed. So you need to be specific about what functions you changed; in large functions, it's often helpful to indicate where within the function the change was. @@ -1177,9 +1177,9 @@ new function, all you need to say about it is that it is new. If you feel that the purpose needs explaining, it probably does---but put the explanation in comments in the code. It will be more useful there. -Please look at the change log entries of recent commits to see what -sorts of information to put in, and to learn the style that we use. Note that, -unlike some other projects, we do require change logs for +Please look at the commit log entries of recent commits to see what +sorts of information to put in, and to learn the style that we use. +Note that, unlike some other projects, we do require commit logs for documentation, i.e., Texinfo files. @xref{Change Log}, @ifset WWW_GNU_ORG commit 3946e1db2461c6851b83cb088ad66191f797ed08 Author: Lars Ingebrigtsen Date: Thu Aug 23 16:55:35 2018 +0200 Fix binding error in nnfolder-read-folder * lisp/gnus/nnfolder.el (nnfolder-read-folder): Fix previous checkin that left `active' unbound before using it. diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el index e0d31126b6..11a3986668 100644 --- a/lisp/gnus/nnfolder.el +++ b/lisp/gnus/nnfolder.el @@ -877,16 +877,16 @@ deleted. Point is left where the deleted region was." (delete-char 1)) (nnmail-activate 'nnfolder) ;; Read in the file. - (let ((delim "^From ") - (marker (concat "\n" nnfolder-article-marker)) - (number "[0-9]+") - (active (or (cadr (assoc group nnfolder-group-alist)) - (cons 1 0))) - (scantime (assoc group nnfolder-scantime-alist)) - (minid (cdr active)) - maxid start end newscantime - novbuf articles newnum - buffer-read-only) + (let* ((delim "^From ") + (marker (concat "\n" nnfolder-article-marker)) + (number "[0-9]+") + (active (or (cadr (assoc group nnfolder-group-alist)) + (cons 1 0))) + (scantime (assoc group nnfolder-scantime-alist)) + (minid (cdr active)) + maxid start end newscantime + novbuf articles newnum + buffer-read-only) (setq maxid minid) (unless (or gnus-nov-is-evil nnfolder-nov-is-evil @@ -958,7 +958,7 @@ deleted. Point is left where the deleted region was." (while (not (= end (point-max))) (setq start (marker-position end)) (goto-char end) - ;; There may be more than one "From " line, so we skip past + ;; There may be more than one "From " line, so we skip past ;; them. (while (looking-at delim) (forward-line 1)) commit a4a3c92e9de59bd0251f36326375cce898919edc Author: Paul Eggert Date: Wed Aug 22 20:45:47 2018 -0700 Prune most-positive-fixnum from Lisp source I looked through all instances of most-negative-fixnum and most-positive-fixnum in the Lisp source code, and when it was easy I removed assumptions that integers fit in fixnums. The remaining instances are either nontrivial to fix, or are inherent to the algorithm. * lisp/arc-mode.el (archive-l-e): Do not convert to float, since we have bignums now. All uses changed. * lisp/calc/calc.el (math-bignum): Don’t special-case most-negative-fixnum. * lisp/calendar/parse-time.el (parse-time-string): * lisp/emacs-lisp/edebug.el (edebug-read-special): * lisp/emacs-lisp/package.el (package--remove-hidden): * lisp/gnus/nnfolder.el (nnfolder-read-folder): * lisp/international/mule-util.el (filepos-to-bufferpos--dos): * lisp/menu-bar.el (menu-bar-update-buffers): * lisp/net/rcirc.el (rcirc-handler-317): * lisp/org/org-agenda.el (org-cmp-ts): * lisp/window.el (window--resize-child-windows): Avoid arbitrary limit to most-positive-fixnum or to most-negative-fixnum. * lisp/calendar/time-date.el (days-to-time): * lisp/erc/erc-dcc.el (erc-unpack-int): Don’t worry about integer overflow. * lisp/cedet/semantic/wisent/comp.el (wisent-BITS-PER-WORD): * lisp/gnus/message.el (message-unique-id): * lisp/org/org-footnote.el (org-footnote-new): Simplify. * lisp/erc/erc-dcc.el (erc-most-positive-int-bytes) (erc-most-positive-int-msb): Remove; no longer needed. * lisp/net/imap.el (imap-string-to-integer): Remove; unused. * lisp/org/org-element.el (org-element--cache-generate-key): Document fixnum limitation. diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index e45c6004b9..50048c0cb3 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -531,12 +531,10 @@ Each descriptor is a vector of the form (defsubst archive-name (suffix) (intern (concat "archive-" (symbol-name archive-subtype) "-" suffix))) -(defun archive-l-e (str &optional len float) +(defun archive-l-e (str &optional len) "Convert little endian string/vector STR to integer. Alternatively, STR may be a buffer position in the current buffer -in which case a second argument, length LEN, should be supplied. -FLOAT, if non-nil, means generate and return a float instead of an integer -\(use this for numbers that can overflow the Emacs integer)." +in which case a second argument, length LEN, should be supplied." (if (stringp str) (setq len (length str)) (setq str (buffer-substring str (+ str len)))) @@ -545,7 +543,7 @@ FLOAT, if non-nil, means generate and return a float instead of an integer (i 0)) (while (< i len) (setq i (1+ i) - result (+ (if float (* result 256.0) (ash result 8)) + result (+ (ash result 8) (aref str (- len i))))) result)) @@ -1501,14 +1499,13 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (fnlen (or (string-match "\0" namefld) 13)) (efnname (decode-coding-string (substring namefld 0 fnlen) archive-file-name-coding-system)) - ;; Convert to float to avoid overflow for very large files. - (csize (archive-l-e (+ p 15) 4 'float)) + (csize (archive-l-e (+ p 15) 4)) (moddate (archive-l-e (+ p 19) 2)) (modtime (archive-l-e (+ p 21) 2)) - (ucsize (archive-l-e (+ p 25) 4 'float)) + (ucsize (archive-l-e (+ p 25) 4)) (fiddle (string= efnname (upcase efnname))) (ifnname (if fiddle (downcase efnname) efnname)) - (text (format " %8.0f %-11s %-8s %s" + (text (format " %8d %-11s %-8s %s" ucsize (archive-dosdate moddate) (archive-dostime modtime) @@ -1521,11 +1518,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." visual) files (cons (vector efnname ifnname fiddle nil (1- p)) files) - ;; p needs to stay an integer, since we use it in char-after - ;; above. Passing through `round' limits the compressed size - ;; to most-positive-fixnum, but if the compressed size exceeds - ;; that, we cannot visit the archive anyway. - p (+ p 29 (round csize))))) + p (+ p 29 csize)))) (goto-char (point-min)) (let ((dash (concat "- -------- ----------- -------- " (make-string maxlen ?-) @@ -1534,7 +1527,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." dash) (archive-summarize-files (nreverse visual)) (insert dash - (format " %8.0f %d file%s" + (format " %8d %d file%s" totalsize (length files) (if (= 1 (length files)) "" "s")) @@ -1567,10 +1560,9 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (while (progn (goto-char p) ;beginning of a base header. (looking-at "\\(.\\|\n\\)\\(.\\|\n\\)-l[hz][0-9ds]-")) (let* ((hsize (byte-after p)) ;size of the base header (level 0 and 1) - ;; Convert to float to avoid overflow for very large files. - (csize (archive-l-e (+ p 7) 4 'float)) ;size of a compressed file to follow (level 0 and 2), + (csize (archive-l-e (+ p 7) 4)) ;size of a compressed file to follow (level 0 and 2), ;size of extended headers + the compressed file to follow (level 1). - (ucsize (archive-l-e (+ p 11) 4 'float)) ;size of an uncompressed file. + (ucsize (archive-l-e (+ p 11) 4)) ;size of an uncompressed file. (time1 (archive-l-e (+ p 15) 2)) ;date/time (MSDOS format in level 0, 1 headers (time2 (archive-l-e (+ p 17) 2)) ;and UNIX format in level 2 header.) (hdrlvl (byte-after (+ p 20))) ;header level @@ -1660,12 +1652,12 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (archive-unixtime time1 time2) (archive-dostime time1))) (setq text (if archive-alternate-display - (format " %8.0f %5S %5S %s" + (format " %8d %5S %5S %s" ucsize (or uid "?") (or gid "?") ifnname) - (format " %10s %8.0f %-11s %-8s %s" + (format " %10s %8d %-11s %-8s %s" modestr ucsize moddate @@ -1680,13 +1672,9 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." files (cons (vector prname ifnname fiddle mode (1- p)) files)) (cond ((= hdrlvl 1) - ;; p needs to stay an integer, since we use it in goto-char - ;; above. Passing through `round' limits the compressed size - ;; to most-positive-fixnum, but if the compressed size exceeds - ;; that, we cannot visit the archive anyway. - (setq p (+ p hsize 2 (round csize)))) + (setq p (+ p hsize 2 csize))) ((or (= hdrlvl 2) (= hdrlvl 0)) - (setq p (+ p thsize 2 (round csize))))) + (setq p (+ p thsize 2 csize)))) )) (goto-char (point-min)) (let ((dash (concat (if archive-alternate-display @@ -1824,32 +1812,21 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ;; ;; First, find the Zip64 end-of-central-directory locator. (search-backward "PK\006\007") - ;; Pay attention: the offset of Zip64 end-of-central-directory - ;; is a 64-bit field, so it could overflow the Emacs integer - ;; even on a 64-bit host, let alone 32-bit one. But since we've - ;; already read the zip file into a buffer, and this is a byte - ;; offset into the file we've read, it must be short enough, so - ;; such an overflow can never happen, and we can safely read - ;; these 8 bytes into an Emacs integer. Moreover, on host with - ;; 32-bit Emacs integer we can only read 4 bytes, since they are - ;; stored in little-endian byte order. - (setq emacs-int-has-32bits (<= most-positive-fixnum #x1fffffff)) (setq p (+ (point-min) - (archive-l-e (+ (point) 8) (if emacs-int-has-32bits 4 8)))) + (archive-l-e (+ (point) 8) 8))) (goto-char p) ;; We should be at Zip64 end-of-central-directory record now. (or (string= "PK\006\006" (buffer-substring p (+ p 4))) (error "Unrecognized ZIP file format")) ;; Offset to central directory: - (setq p (archive-l-e (+ p 48) (if emacs-int-has-32bits 4 8)))) + (setq p (archive-l-e (+ p 48) 8))) (setq p (+ p (point-min))) (while (string= "PK\001\002" (buffer-substring p (+ p 4))) (let* ((creator (byte-after (+ p 5))) ;; (method (archive-l-e (+ p 10) 2)) (modtime (archive-l-e (+ p 12) 2)) (moddate (archive-l-e (+ p 14) 2)) - ;; Convert to float to avoid overflow for very large files. - (ucsize (archive-l-e (+ p 24) 4 'float)) + (ucsize (archive-l-e (+ p 24) 4)) (fnlen (archive-l-e (+ p 28) 2)) (exlen (archive-l-e (+ p 30) 2)) (fclen (archive-l-e (+ p 32) 2)) @@ -1874,7 +1851,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (string= (upcase efnname) efnname))) (ifnname (if fiddle (downcase efnname) efnname)) (width (string-width ifnname)) - (text (format " %10s %8.0f %-11s %-8s %s" + (text (format " %10s %8d %-11s %-8s %s" modestr ucsize (archive-dosdate moddate) @@ -1900,7 +1877,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." dash) (archive-summarize-files (nreverse visual)) (insert dash - (format " %8.0f %d file%s" + (format " %8d %d file%s" totalsize (length files) (if (= 1 (length files)) "" "s")) @@ -1971,8 +1948,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (let* ((next (1+ (archive-l-e (+ p 6) 4))) (moddate (archive-l-e (+ p 14) 2)) (modtime (archive-l-e (+ p 16) 2)) - ;; Convert to float to avoid overflow for very large files. - (ucsize (archive-l-e (+ p 20) 4 'float)) + (ucsize (archive-l-e (+ p 20) 4)) (namefld (buffer-substring (+ p 38) (+ p 38 13))) (dirtype (byte-after (+ p 4))) (lfnlen (if (= dirtype 2) (byte-after (+ p 56)) 0)) @@ -1995,7 +1971,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (fiddle (and (= lfnlen 0) (string= efnname (upcase efnname)))) (ifnname (if fiddle (downcase efnname) efnname)) (width (string-width ifnname)) - (text (format " %8.0f %-11s %-8s %s" + (text (format " %8d %-11s %-8s %s" ucsize (archive-dosdate moddate) (archive-dostime modtime) @@ -2017,7 +1993,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." dash) (archive-summarize-files (nreverse visual)) (insert dash - (format " %8.0f %d file%s" + (format " %8d %d file%s" totalsize (length files) (if (= 1 (length files)) "" "s")) @@ -2211,8 +2187,6 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (while (looking-at archive-ar-file-header-re) (let ((name (match-string 1)) extname - ;; Emacs will automatically use float here because those - ;; timestamps don't fit in our ints. (time (string-to-number (match-string 2))) (user (match-string 3)) (group (match-string 4)) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 4bebd5f47b..364b44bfcf 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -2781,13 +2781,6 @@ largest Emacs integer.") (cond ((>= a 0) (cons 'bigpos (math-bignum-big a))) - ((= a most-negative-fixnum) - ;; Note: cannot get the negation directly because - ;; (- most-negative-fixnum) is most-negative-fixnum. - ;; - ;; most-negative-fixnum := -most-positive-fixnum - 1 - (math-sub (cons 'bigneg (math-bignum-big most-positive-fixnum)) - 1)) (t (cons 'bigneg (math-bignum-big (- a)))))) diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el index c472733904..2f9e557dab 100644 --- a/lisp/calendar/parse-time.el +++ b/lisp/calendar/parse-time.el @@ -98,7 +98,7 @@ letters, digits, plus or minus signs or colons." `(((6) parse-time-weekdays) ((3) (1 31)) ((4) parse-time-months) - ((5) (100 ,most-positive-fixnum)) + ((5) (100)) ((2 1 0) ,#'(lambda () (and (stringp parse-time-elt) (= (length parse-time-elt) 8) @@ -170,7 +170,9 @@ any values that are unknown are returned as nil." 'lambda))) (and (numberp parse-time-elt) (<= (car predicate) parse-time-elt) - (<= parse-time-elt (cadr predicate)) + (or (not (cdr predicate)) + (<= parse-time-elt + (cadr predicate))) parse-time-elt)) ((symbolp predicate) (cdr (assoc parse-time-elt diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index e266dd62df..467915e3d9 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -175,8 +175,7 @@ If DATE lacks timezone information, GMT is assumed." ;;;###autoload (defun days-to-time (days) "Convert DAYS into a time value." - (let ((time (condition-case nil (seconds-to-time (* 86400.0 days)) - (range-error (list most-positive-fixnum 65535))))) + (let ((time (seconds-to-time (* 86400 days)))) (if (integerp days) (setcdr (cdr time) nil)) time)) @@ -277,9 +276,7 @@ return something of the form \"001 year\". The \"%z\" specifier does not print anything. When it is used, specifiers must be given in order of decreasing size. To the left of \"%z\", nothing -is output until the first non-zero unit is encountered. - -This function does not work for SECONDS greater than `most-positive-fixnum'." +is output until the first non-zero unit is encountered." (let ((start 0) (units '(("y" "year" 31536000) ("d" "day" 86400) diff --git a/lisp/cedet/semantic/wisent/comp.el b/lisp/cedet/semantic/wisent/comp.el index 74ca4f4a43..21ea7ed066 100644 --- a/lisp/cedet/semantic/wisent/comp.el +++ b/lisp/cedet/semantic/wisent/comp.el @@ -139,14 +139,7 @@ If optional LEFT is non-nil insert spaces on left." ;;;; Environment dependencies ;;;; ------------------------ -(defconst wisent-BITS-PER-WORD - (let ((i 1) - (do-shift (if (boundp 'most-positive-fixnum) - (lambda (i) (ash most-positive-fixnum (- i))) - (lambda (i) (ash 1 i))))) - (while (not (zerop (funcall do-shift i))) - (setq i (1+ i))) - i)) +(defconst wisent-BITS-PER-WORD (logcount most-positive-fixnum)) (defsubst wisent-WORDSIZE (n) "(N + BITS-PER-WORD - 1) / BITS-PER-WORD." diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index fa418c6828..fb567c9cce 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -894,8 +894,7 @@ circular objects. Let `read' read everything else." (while (and (>= (following-char) ?0) (<= (following-char) ?9)) (forward-char 1)) (let ((n (string-to-number (buffer-substring start (point))))) - (when (and read-circle - (<= n most-positive-fixnum)) + (when read-circle (cond ((eq ?= (following-char)) ;; Make a placeholder for #n# to use temporarily. @@ -910,7 +909,7 @@ circular objects. Let `read' read everything else." (throw 'return (setf (cdr elem) obj))))) ((eq ?# (following-char)) ;; #n# returns a previously read object. - (let ((elem (assq n edebug-read-objects))) + (let ((elem (assoc n edebug-read-objects))) (when (consp elem) (forward-char 1) (throw 'return (cdr elem)))))))))) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index cacc8b0c18..2ddab65363 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2673,12 +2673,11 @@ to their archives." ((not package-menu-hide-low-priority) pkg-list) ((eq package-menu-hide-low-priority 'archive) - (let* ((max-priority most-negative-fixnum) - (out)) + (let (max-priority out) (while pkg-list (let ((p (pop pkg-list))) (let ((priority (package-desc-priority p))) - (if (< priority max-priority) + (if (and max-priority (< priority max-priority)) (setq pkg-list nil) (push p out) (setq max-priority priority))))) diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 8bf4c3e166..8de0007058 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -224,14 +224,6 @@ which is big-endian." (setq i (1- i))) str)) -(defconst erc-most-positive-int-bytes - (ceiling (/ (ceiling (/ (log most-positive-fixnum) (log 2))) 8.0)) - "Maximum number of bytes for a fixnum.") - -(defconst erc-most-positive-int-msb - (ash most-positive-fixnum (- 0 (* 8 (1- erc-most-positive-int-bytes)))) - "Content of the most significant byte of most-positive-fixnum.") - (defun erc-unpack-int (str) "Unpack a packed string into an integer." (let ((len (length str))) @@ -242,11 +234,6 @@ which is big-endian." (when (> start 0) (setq str (substring str start)) (setq len (- len start)))) - ;; make sure size is not larger than Emacs can handle - (when (or (> len (min 4 erc-most-positive-int-bytes)) - (and (eq len erc-most-positive-int-bytes) - (> (aref str 0) erc-most-positive-int-msb))) - (error "ERC-DCC (erc-unpack-int): packet to send is too large")) ;; unpack (let ((num 0) (count 0)) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 0bd9442afc..66356b6fda 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -5564,7 +5564,7 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'." ;; Instead we use this randomly inited counter. (setq message-unique-id-char (% (1+ (or message-unique-id-char - (logand (random most-positive-fixnum) (1- (ash 1 20))))) + (random (ash 1 20)))) ;; (current-time) returns 16-bit ints, ;; and 2^16*25 just fits into 4 digits i base 36. (* 25 25))) diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el index 826fd8d855..e0d31126b6 100644 --- a/lisp/gnus/nnfolder.el +++ b/lisp/gnus/nnfolder.el @@ -883,11 +883,11 @@ deleted. Point is left where the deleted region was." (active (or (cadr (assoc group nnfolder-group-alist)) (cons 1 0))) (scantime (assoc group nnfolder-scantime-alist)) - (minid most-positive-fixnum) + (minid (cdr active)) maxid start end newscantime novbuf articles newnum buffer-read-only) - (setq maxid (cdr active)) + (setq maxid minid) (unless (or gnus-nov-is-evil nnfolder-nov-is-evil (and (file-exists-p nov) diff --git a/lisp/international/mule-util.el b/lisp/international/mule-util.el index 661001afea..cf2b29c04c 100644 --- a/lisp/international/mule-util.el +++ b/lisp/international/mule-util.el @@ -342,7 +342,7 @@ per-character basis, this may not be accurate." (let ((eol-offset 0) ;; Make sure we terminate, even if BYTE falls right in the middle ;; of a CRLF or some other weird corner case. - (omin 0) (omax most-positive-fixnum) + (omin 0) omax pos lines) (while (progn @@ -355,9 +355,9 @@ per-character basis, this may not be accurate." (setq pos (point-max)))) ;; Adjust POS for DOS EOL format. (setq lines (1- (line-number-at-pos pos))) - (and (not (= lines eol-offset)) (> omax omin))) + (and (not (= lines eol-offset)) (or (not omax) (> omax omin)))) (if (> lines eol-offset) - (setq omax (min (1- omax) lines) + (setq omax (if omax (min (1- omax) lines) lines) eol-offset omax) (setq omin (max (1+ omin) lines) eol-offset omin))) diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index ad59533e26..20d5ad95d8 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -2135,9 +2135,9 @@ It must accept a buffer as its only required argument.") ;; Make the menu of buffers proper. (setq buffers-menu (let ((i 0) - (limit (if (and (integerp buffers-menu-max-size) - (> buffers-menu-max-size 1)) - buffers-menu-max-size most-positive-fixnum)) + (limit (and (integerp buffers-menu-max-size) + (> buffers-menu-max-size 1) + buffers-menu-max-size)) alist) ;; Put into each element of buffer-list ;; the name for actual display, @@ -2161,7 +2161,7 @@ It must accept a buffer as its only required argument.") alist) ;; If requested, list only the N most recently ;; selected buffers. - (when (= limit (setq i (1+ i))) + (when (eql limit (setq i (1+ i))) (setq buffers nil))))) (list (menu-bar-buffer-vector alist)))) diff --git a/lisp/net/imap.el b/lisp/net/imap.el index 2a2ce8b9c9..042b0f9a2c 100644 --- a/lisp/net/imap.el +++ b/lisp/net/imap.el @@ -1696,18 +1696,6 @@ MAILBOX specifies a mailbox on the server in BUFFER." (concat "UID STORE " articles " +FLAGS" (if silent ".SILENT") " (" flags ")")))))) -;; Cf. http://thread.gmane.org/gmane.emacs.gnus.general/65317/focus=65343 -;; Signal an error if we'd get an integer overflow. -;; -;; FIXME: Identify relevant calls to `string-to-number' and replace them with -;; `imap-string-to-integer'. -(defun imap-string-to-integer (string &optional base) - (let ((number (string-to-number string base))) - (if (> number most-positive-fixnum) - (error - (format "String %s cannot be converted to a Lisp integer" number)) - number))) - (defun imap-fetch-safe (uids props &optional receive nouidfetch buffer) "Like `imap-fetch', but DTRT with Exchange 2007 bug. However, UIDS here is a cons, where the car is the canonical form diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 108e368373..fe9c71a21c 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2787,10 +2787,7 @@ the only argument." "RPL_WHOISIDLE" (let* ((nick (nth 1 args)) (idle-secs (string-to-number (nth 2 args))) - (idle-string - (if (< idle-secs most-positive-fixnum) - (format-seconds "%yy %dd %hh %mm %z%ss" idle-secs) - "a very long time")) + (idle-string (format-seconds "%yy %dd %hh %mm %z%ss" idle-secs)) (signon-time (seconds-to-time (string-to-number (nth 3 args)))) (signon-string (format-time-string "%c" signon-time)) (message (format "%s idle for %s, signed on %s" diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index cbfaf88fb4..98e89eb1c4 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -7009,15 +7009,15 @@ When TYPE is \"scheduled\", \"deadline\", \"timestamp\" or \"timestamp_ia\", compare within each of these type. When TYPE is the empty string, compare all timestamps without respect of their type." - (let* ((def (if org-sort-agenda-notime-is-late most-positive-fixnum -1)) + (let* ((def (and (not org-sort-agenda-notime-is-late) -1)) (ta (or (and (string-match type (or (get-text-property 1 'type a) "")) (get-text-property 1 'ts-date a)) def)) (tb (or (and (string-match type (or (get-text-property 1 'type b) "")) (get-text-property 1 'ts-date b)) def))) - (cond ((< ta tb) -1) - ((< tb ta) +1)))) + (cond ((if ta (and tb (< ta tb)) tb) -1) + ((if tb (and ta (< tb ta)) ta) +1)))) (defsubst org-cmp-habit-p (a b) "Compare the todo states of strings A and B." diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el index b32f852ded..b8f1467022 100644 --- a/lisp/org/org-element.el +++ b/lisp/org/org-element.el @@ -4856,7 +4856,7 @@ table is cleared once the synchronization is complete." (defun org-element--cache-generate-key (lower upper) "Generate a key between LOWER and UPPER. -LOWER and UPPER are integers or lists, possibly empty. +LOWER and UPPER are fixnums or lists of same, possibly empty. If LOWER and UPPER are equals, return LOWER. Otherwise, return a unique key, as an integer or a list of integers, according to diff --git a/lisp/org/org-footnote.el b/lisp/org/org-footnote.el index c6376ca5dc..5d472bdb18 100644 --- a/lisp/org/org-footnote.el +++ b/lisp/org/org-footnote.el @@ -636,7 +636,7 @@ or new, let the user edit the definition of the footnote." (let* ((all (org-footnote-all-labels)) (label (if (eq org-footnote-auto-label 'random) - (format "%x" (random most-positive-fixnum)) + (format "%x" (abs (random))) (org-footnote-normalize-label (let ((propose (org-footnote-unique-label all))) (if (eq org-footnote-auto-label t) propose diff --git a/lisp/window.el b/lisp/window.el index d56bed63da..76de4207e7 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -3084,11 +3084,12 @@ already set by this routine." (while (and best-window (not (zerop delta))) (setq sub last) (setq best-window nil) - (setq best-value most-negative-fixnum) + (setq best-value nil) (while sub (when (and (consp (window-new-normal sub)) (not (<= (car (window-new-normal sub)) 0)) - (> (cdr (window-new-normal sub)) best-value)) + (or (not best-value) + (> (cdr (window-new-normal sub)) best-value))) (setq best-window sub) (setq best-value (cdr (window-new-normal sub)))) @@ -3113,10 +3114,11 @@ already set by this routine." (while (and best-window (not (zerop delta))) (setq sub last) (setq best-window nil) - (setq best-value most-positive-fixnum) + (setq best-value nil) (while sub (when (and (numberp (window-new-normal sub)) - (< (window-new-normal sub) best-value)) + (or (not best-value) + (< (window-new-normal sub) best-value))) (setq best-window sub) (setq best-value (window-new-normal sub))) commit ee641b87cf220250ba89f219fb47a4406a05deb7 Author: Paul Eggert Date: Wed Aug 22 19:30:24 2018 -0700 Fix bugs when rounding to bignums Also, since Emacs historically reported a range error when rounding operations overflowed, do that consistently for all bignum overflows. * doc/lispref/errors.texi (Standard Errors): * doc/lispref/numbers.texi (Integer Basics): Document range errors. * src/alloc.c (range_error): Rename from integer_overflow. All uses changed. * src/floatfns.c (rounding_driver): When the result of a floating point rounding operation does not fit into a fixnum, put it into a bignum instead of always signaling an range error. * test/src/floatfns-tests.el (divide-extreme-sign): These tests now return the mathematically-correct answer instead of signaling an error. (bignum-round): Check that integers round to themselves. diff --git a/doc/lispref/errors.texi b/doc/lispref/errors.texi index a0e32c5631..e61ea98e21 100644 --- a/doc/lispref/errors.texi +++ b/doc/lispref/errors.texi @@ -159,6 +159,11 @@ The message is @samp{No catch for tag}. @xref{Catch and Throw}. The message is @samp{Attempt to modify a protected file}. @end ignore +@item range-error +The message is @code{Arithmetic range error}. +This can happen with integers exceeding the @code{integer-width} limit. +@xref{Integer Basics}. + @item scan-error The message is @samp{Scan error}. This happens when certain syntax-parsing functions find invalid syntax or mismatched @@ -223,9 +228,6 @@ The message is @samp{Arithmetic domain error}. The message is @samp{Arithmetic overflow error}. This is a subcategory of @code{domain-error}. -@item range-error -The message is @code{Arithmetic range error}. - @item singularity-error The message is @samp{Arithmetic singularity error}. This is a subcategory of @code{domain-error}. diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi index a815047861..d03113674f 100644 --- a/doc/lispref/numbers.texi +++ b/doc/lispref/numbers.texi @@ -201,7 +201,7 @@ range are limited to absolute values less than @math{2^{n}}, @end tex where @var{n} is this variable's value. Attempts to create bignums outside -this range result in an integer overflow error. Setting this variable +this range signal a range error. Setting this variable to zero disables creation of bignums; setting it to a large number can cause Emacs to consume large quantities of memory if a computation creates huge integers. diff --git a/src/alloc.c b/src/alloc.c index 24a24aab96..cdcd465ac5 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3771,7 +3771,7 @@ make_number (mpz_t value) /* The documentation says integer-width should be nonnegative, so a single comparison suffices even though 'bits' is unsigned. */ if (integer_width < bits) - integer_overflow (); + range_error (); struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value, PVEC_BIGNUM); @@ -7203,9 +7203,9 @@ verify_alloca (void) /* Memory allocation for GMP. */ void -integer_overflow (void) +range_error (void) { - error ("Integer too large to be represented"); + xsignal0 (Qrange_error); } static void * diff --git a/src/data.c b/src/data.c index 08c7271dd7..170a74a658 100644 --- a/src/data.c +++ b/src/data.c @@ -2406,7 +2406,7 @@ static void emacs_mpz_mul (mpz_t rop, mpz_t const op1, mpz_t const op2) { if (NLIMBS_LIMIT - emacs_mpz_size (op1) < emacs_mpz_size (op2)) - integer_overflow (); + range_error (); mpz_mul (rop, op1, op2); } @@ -2420,7 +2420,7 @@ emacs_mpz_mul_2exp (mpz_t rop, mpz_t const op1, mp_bitcnt_t op2) mp_bitcnt_t op2limbs = op2 / GMP_NUMB_BITS; if (lim - emacs_mpz_size (op1) < op2limbs) - integer_overflow (); + range_error (); mpz_mul_2exp (rop, op1, op2); } @@ -2434,7 +2434,7 @@ emacs_mpz_pow_ui (mpz_t rop, mpz_t const base, unsigned long exp) int nbase = emacs_mpz_size (base), n; if (INT_MULTIPLY_WRAPV (nbase, exp, &n) || lim < n) - integer_overflow (); + range_error (); mpz_pow_ui (rop, base, exp); } @@ -3398,7 +3398,7 @@ expt_integer (Lisp_Object x, Lisp_Object y) && mpz_fits_ulong_p (XBIGNUM (y)->value)) exp = mpz_get_ui (XBIGNUM (y)->value); else - integer_overflow (); + range_error (); mpz_t val; mpz_init (val); diff --git a/src/floatfns.c b/src/floatfns.c index c09fe9d6a5..e7884864ee 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -410,7 +410,12 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor, if (! FIXNUM_OVERFLOW_P (ir)) return make_fixnum (ir); } - xsignal2 (Qrange_error, build_string (name), arg); + mpz_t drz; + mpz_init (drz); + mpz_set_d (drz, dr); + Lisp_Object rounded = make_number (drz); + mpz_clear (drz); + return rounded; } static void @@ -501,13 +506,20 @@ systems, but 2 on others. */) return rounding_driver (arg, divisor, emacs_rint, rounddiv_q, "round"); } +/* Since rounding_driver truncates anyway, no need to call 'trunc'. */ +static double +identity (double x) +{ + return x; +} + DEFUN ("truncate", Ftruncate, Struncate, 1, 2, 0, doc: /* Truncate a floating point number to an int. Rounds ARG toward zero. With optional DIVISOR, truncate ARG/DIVISOR. */) (Lisp_Object arg, Lisp_Object divisor) { - return rounding_driver (arg, divisor, trunc, mpz_tdiv_q, "truncate"); + return rounding_driver (arg, divisor, identity, mpz_tdiv_q, "truncate"); } diff --git a/src/lisp.h b/src/lisp.h index c5593b2100..bca4dfbb60 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3708,7 +3708,7 @@ extern void display_malloc_warning (void); extern ptrdiff_t inhibit_garbage_collection (void); extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object); extern void free_cons (struct Lisp_Cons *); -extern _Noreturn void integer_overflow (void); +extern _Noreturn void range_error (void); extern void init_alloc_once (void); extern void init_alloc (void); extern void syms_of_alloc (void); diff --git a/test/src/floatfns-tests.el b/test/src/floatfns-tests.el index 592efce359..d41b08f796 100644 --- a/test/src/floatfns-tests.el +++ b/test/src/floatfns-tests.el @@ -20,10 +20,10 @@ (require 'ert) (ert-deftest divide-extreme-sign () - (should-error (ceiling most-negative-fixnum -1.0)) - (should-error (floor most-negative-fixnum -1.0)) - (should-error (round most-negative-fixnum -1.0)) - (should-error (truncate most-negative-fixnum -1.0))) + (should (= (ceiling most-negative-fixnum -1.0) (- most-negative-fixnum))) + (should (= (floor most-negative-fixnum -1.0) (- most-negative-fixnum))) + (should (= (round most-negative-fixnum -1.0) (- most-negative-fixnum))) + (should (= (truncate most-negative-fixnum -1.0) (- most-negative-fixnum)))) (ert-deftest logb-extreme-fixnum () (should (= (logb most-negative-fixnum) (1+ (logb most-positive-fixnum))))) @@ -66,6 +66,10 @@ (1+ most-positive-fixnum) (* most-positive-fixnum most-positive-fixnum)))) (dolist (n ns) + (should (= n (ceiling n))) + (should (= n (floor n))) + (should (= n (round n))) + (should (= n (truncate n))) (dolist (d ns) (let ((q (/ n d)) (r (% n d)) commit be5fe6183e95f3afe3a62ec43504b99df90bc794 Author: Paul Eggert Date: Wed Aug 22 14:11:25 2018 -0700 Undo part of previous change Issue spotted by Pip Cet in: https://lists.gnu.org/r/emacs-devel/2018-08/msg00758.html * lisp/vc/vc-hg.el (vc-hg--raw-dirstate-search): Go back to using eq on flen, since it must be a fixnum. diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index d11dc4c5f4..76eec884a1 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -629,7 +629,7 @@ Return the byte's value as an integer." ;; 1+4*4 is the length of the dirstate item header. (forward-char (1+ (* 3 4))) (let ((this-flen (vc-hg--read-u32-be))) - (if (and (or (eql this-flen flen) + (if (and (or (eq this-flen flen) (and (> this-flen flen) (eq (char-after (+ (point) flen)) 0))) (search-forward fname (+ (point) flen) t)) commit ae38a3b8208a71c32f723776297290ee5096d8d4 Author: Paul Eggert Date: Wed Aug 22 10:18:34 2018 -0700 Make vc-hg safe for bignums * lisp/vc/vc-hg.el (vc-hg--raw-dirstate-search): Use eql, not eq, on integers that could be bignums. (vc-hg--time-to-integer): Rename from vc-hg--time-to-fixnum. All uses changed. (vc-hg-state-fast): Remove test that 32-bit unsigned values must be fixnums. diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index da4fc2bdf7..d11dc4c5f4 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -583,15 +583,14 @@ back to running Mercurial directly." (defsubst vc-hg--read-u8 () "Read and advance over an unsigned byte. -Return a fixnum." +Return the byte's value as an integer." (prog1 (char-after) (forward-char))) (defsubst vc-hg--read-u32-be () - "Read and advance over a big-endian unsigned 32-bit integer. -Return a fixnum; on overflow, result is undefined." + "Read and advance over a big-endian unsigned 32-bit integer." ;; Because elisp bytecode has an instruction for multiply and - ;; doesn't have one for lsh, it's somewhat counter-intuitively + ;; doesn't have one for shift, it's somewhat counter-intuitively ;; faster to multiply than to shift. (+ (* (vc-hg--read-u8) (* 256 256 256)) (* (vc-hg--read-u8) (* 256 256)) @@ -627,12 +626,10 @@ Return a fixnum; on overflow, result is undefined." ;; hundreds of thousands of times, so performance is important ;; here (while (< (point) search-limit) - ;; 1+4*4 is the length of the dirstate item header, which we - ;; spell as a literal for performance, since the elisp - ;; compiler lacks constant propagation + ;; 1+4*4 is the length of the dirstate item header. (forward-char (1+ (* 3 4))) (let ((this-flen (vc-hg--read-u32-be))) - (if (and (or (eq this-flen flen) + (if (and (or (eql this-flen flen) (and (> this-flen flen) (eq (char-after (+ (point) flen)) 0))) (search-forward fname (+ (point) flen) t)) @@ -917,7 +914,7 @@ FILENAME must be the file's true absolute name." (setf ignored (string-match (pop patterns) filename))) ignored)) -(defun vc-hg--time-to-fixnum (ts) +(defun vc-hg--time-to-integer (ts) (+ (* 65536 (car ts)) (cadr ts))) (defvar vc-hg--cached-ignore-patterns nil @@ -1016,8 +1013,6 @@ hg binary." (not (vc-hg--requirements-understood-p repo)) ;; Dirstate too small to be valid (< (nth 7 dirstate-attr) 40) - ;; We want to store 32-bit unsigned values in fixnums. - (zerop (ash most-positive-fixnum -32)) (progn (setf repo-relative-filename (file-relative-name truename repo)) @@ -1042,7 +1037,7 @@ hg binary." (let ((vc-hg-size (nth 2 dirstate-entry)) (vc-hg-mtime (nth 3 dirstate-entry)) (fs-size (nth 7 stat)) - (fs-mtime (vc-hg--time-to-fixnum (nth 5 stat)))) + (fs-mtime (vc-hg--time-to-integer (nth 5 stat)))) (if (and (eql vc-hg-size fs-size) (eql vc-hg-mtime fs-mtime)) 'up-to-date 'edited))) commit 91a62c4b21cdc60905a4320f2c8fd3b1276a23a0 Author: Paul Eggert Date: Tue Aug 21 22:02:47 2018 -0700 * src/buffer.h (DECODE_POSITION): Remove; unused. diff --git a/src/buffer.h b/src/buffer.h index c6247506d7..4ea7fa627e 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -288,28 +288,6 @@ extern void enlarge_buffer_text (struct buffer *, ptrdiff_t); or convert between a byte position and an address. These macros do not check that the position is in range. */ -/* Access a Lisp position value in POS, - and store the charpos in CHARPOS and the bytepos in BYTEPOS. */ - -#define DECODE_POSITION(charpos, bytepos, pos) \ - do \ - { \ - Lisp_Object __pos = (pos); \ - if (FIXED_OR_FLOATP (__pos)) \ - { \ - charpos = __pos; \ - bytepos = buf_charpos_to_bytepos (current_buffer, __pos); \ - } \ - else if (MARKERP (__pos)) \ - { \ - charpos = marker_position (__pos); \ - bytepos = marker_byte_position (__pos); \ - } \ - else \ - wrong_type_argument (Qinteger_or_marker_p, __pos); \ - } \ - while (false) - /* Maximum number of bytes in a buffer. A buffer cannot contain more bytes than a 1-origin fixnum can represent, nor can it be so large that C pointer arithmetic stops working. commit 30efb8ed6c0968ca486081112f8d4dc147af9e6c Author: Paul Eggert Date: Tue Aug 21 19:23:45 2018 -0700 Add bignum support to floor, ceiling, etc. Problem reported by Andy Moreton (Bug#32463#35 (d)). * src/floatfns.c (rounding_driver): Change the signature of the integer rounder to use mpz_t rather than EMACS_INT. All uses changed. Support bignums. (ceiling2, floor2, truncate2, round2): Remove. All uses changed to rounddiv_q or to a GMP library function. (rounddiv_q): New function. * test/src/floatfns-tests.el (bignum-round): New test. diff --git a/src/floatfns.c b/src/floatfns.c index ea9000b90a..c09fe9d6a5 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -357,10 +357,10 @@ This is the same as the exponent of a float. */) static Lisp_Object rounding_driver (Lisp_Object arg, Lisp_Object divisor, double (*double_round) (double), - EMACS_INT (*int_round2) (EMACS_INT, EMACS_INT), + void (*int_divide) (mpz_t, mpz_t const, mpz_t const), const char *name) { - CHECK_FIXNUM_OR_FLOAT (arg); + CHECK_NUMBER (arg); double d; if (NILP (divisor)) @@ -371,12 +371,25 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor, } else { - CHECK_FIXNUM_OR_FLOAT (divisor); + CHECK_NUMBER (divisor); if (!FLOATP (arg) && !FLOATP (divisor)) { - if (XFIXNUM (divisor) == 0) + if (EQ (divisor, make_fixnum (0))) xsignal0 (Qarith_error); - return make_fixnum (int_round2 (XFIXNUM (arg), XFIXNUM (divisor))); + mpz_t d, q; + mpz_init (d); + mpz_init (q); + int_divide (q, + (FIXNUMP (arg) + ? (mpz_set_intmax (q, XFIXNUM (arg)), q) + : XBIGNUM (arg)->value), + (FIXNUMP (divisor) + ? (mpz_set_intmax (d, XFIXNUM (divisor)), d) + : XBIGNUM (divisor)->value)); + Lisp_Object result = make_number (q); + mpz_clear (d); + mpz_clear (q); + return result; } double f1 = FLOATP (arg) ? XFLOAT_DATA (arg) : XFIXNUM (arg); @@ -400,37 +413,39 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor, xsignal2 (Qrange_error, build_string (name), arg); } -static EMACS_INT -ceiling2 (EMACS_INT i1, EMACS_INT i2) -{ - return i1 / i2 + ((i1 % i2 != 0) & ((i1 < 0) == (i2 < 0))); -} - -static EMACS_INT -floor2 (EMACS_INT i1, EMACS_INT i2) -{ - return i1 / i2 - ((i1 % i2 != 0) & ((i1 < 0) != (i2 < 0))); -} - -static EMACS_INT -truncate2 (EMACS_INT i1, EMACS_INT i2) -{ - return i1 / i2; -} - -static EMACS_INT -round2 (EMACS_INT i1, EMACS_INT i2) -{ - /* The C language's division operator gives us one remainder R, but - we want the remainder R1 on the other side of 0 if R1 is closer - to 0 than R is; because we want to round to even, we also want R1 - if R and R1 are the same distance from 0 and if C's quotient is - odd. */ - EMACS_INT q = i1 / i2; - EMACS_INT r = i1 % i2; - EMACS_INT abs_r = eabs (r); - EMACS_INT abs_r1 = eabs (i2) - abs_r; - return q + (abs_r + (q & 1) <= abs_r1 ? 0 : (i2 ^ r) < 0 ? -1 : 1); +static void +rounddiv_q (mpz_t q, mpz_t const n, mpz_t const d) +{ + /* mpz_tdiv_qr gives us one remainder R, but we want the remainder + R1 on the other side of 0 if R1 is closer to 0 than R is; because + we want to round to even, we also want R1 if R and R1 are the + same distance from 0 and if the quotient is odd. + + If we were using EMACS_INT arithmetic instead of bignums, + the following code could look something like this: + + q = n / d; + r = n % d; + neg_d = d < 0; + neg_r = r < 0; + r = eabs (r); + abs_r1 = eabs (d) - r; + if (abs_r1 < r + (q & 1)) + q += neg_d == neg_r ? 1 : -1; */ + + mpz_t r, abs_r1; + mpz_init (r); + mpz_init (abs_r1); + mpz_tdiv_qr (q, r, n, d); + bool neg_d = mpz_sgn (d) < 0; + bool neg_r = mpz_sgn (r) < 0; + mpz_abs (r, r); + mpz_abs (abs_r1, d); + mpz_sub (abs_r1, abs_r1, r); + if (mpz_cmp (abs_r1, r) < (mpz_odd_p (q) != 0)) + (neg_d == neg_r ? mpz_add_ui : mpz_sub_ui) (q, q, 1); + mpz_clear (r); + mpz_clear (abs_r1); } /* The code uses emacs_rint, so that it works to undefine HAVE_RINT @@ -461,7 +476,7 @@ This rounds the value towards +inf. With optional DIVISOR, return the smallest integer no less than ARG/DIVISOR. */) (Lisp_Object arg, Lisp_Object divisor) { - return rounding_driver (arg, divisor, ceil, ceiling2, "ceiling"); + return rounding_driver (arg, divisor, ceil, mpz_cdiv_q, "ceiling"); } DEFUN ("floor", Ffloor, Sfloor, 1, 2, 0, @@ -470,7 +485,7 @@ This rounds the value towards -inf. With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR. */) (Lisp_Object arg, Lisp_Object divisor) { - return rounding_driver (arg, divisor, floor, floor2, "floor"); + return rounding_driver (arg, divisor, floor, mpz_fdiv_q, "floor"); } DEFUN ("round", Fround, Sround, 1, 2, 0, @@ -483,7 +498,7 @@ your machine. For example, (round 2.5) can return 3 on some systems, but 2 on others. */) (Lisp_Object arg, Lisp_Object divisor) { - return rounding_driver (arg, divisor, emacs_rint, round2, "round"); + return rounding_driver (arg, divisor, emacs_rint, rounddiv_q, "round"); } DEFUN ("truncate", Ftruncate, Struncate, 1, 2, 0, @@ -492,7 +507,7 @@ Rounds ARG toward zero. With optional DIVISOR, truncate ARG/DIVISOR. */) (Lisp_Object arg, Lisp_Object divisor) { - return rounding_driver (arg, divisor, trunc, truncate2, "truncate"); + return rounding_driver (arg, divisor, trunc, mpz_tdiv_q, "truncate"); } diff --git a/test/src/floatfns-tests.el b/test/src/floatfns-tests.el index e4caaa1e49..592efce359 100644 --- a/test/src/floatfns-tests.el +++ b/test/src/floatfns-tests.el @@ -58,4 +58,31 @@ (ert-deftest bignum-mod () (should (= 0 (mod (1+ most-positive-fixnum) 2.0)))) +(ert-deftest bignum-round () + (let ((ns (list (* most-positive-fixnum most-negative-fixnum) + (1- most-negative-fixnum) most-negative-fixnum + (1+ most-negative-fixnum) -2 1 1 2 + (1- most-positive-fixnum) most-positive-fixnum + (1+ most-positive-fixnum) + (* most-positive-fixnum most-positive-fixnum)))) + (dolist (n ns) + (dolist (d ns) + (let ((q (/ n d)) + (r (% n d)) + (same-sign (eq (< n 0) (< d 0)))) + (should (= (ceiling n d) + (+ q (if (and same-sign (not (zerop r))) 1 0)))) + (should (= (floor n d) + (- q (if (and (not same-sign) (not (zerop r))) 1 0)))) + (should (= (truncate n d) q)) + (let ((cdelta (abs (- n (* d (ceiling n d))))) + (fdelta (abs (- n (* d (floor n d))))) + (rdelta (abs (- n (* d (round n d)))))) + (should (<= rdelta cdelta)) + (should (<= rdelta fdelta)) + (should (if (zerop r) + (= 0 cdelta fdelta rdelta) + (or (/= cdelta fdelta) + (zerop (% (round n d) 2))))))))))) + (provide 'floatfns-tests) commit c79444c5b7b8ead1ea98ed5603bf2a49c13dbf16 Author: Paul Eggert Date: Tue Aug 21 16:06:58 2018 -0700 Move bignump, fixnump from C to Lisp * doc/lispref/objects.texi (Integer Type): Mention most-negative-fixnum and most-positive-fixnum as alternatives to fixnump and bignump. * lisp/subr.el (fixnump, bignump): Now written in Lisp. * src/data.c (Ffixnump, Fbignump): No longer written in C, as these new functions are not crucial for performance. diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index 8c92de123c..a0940032ee 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -190,9 +190,10 @@ but many machines provide a wider range. fixnum will return a bignum instead. Fixnums can be compared with @code{eq}, but bignums require -@code{eql} or @code{=}. The @code{fixnump} predicate can be used to -detect such small integers, and @code{bignump} can be used to detect -large integers. +@code{eql} or @code{=}. To test whether an integer is a fixnum or a +bignum, you can compare it to @code{most-negative-fixnum} and +@code{most-positive-fixnum}, or you can use the convenience predicates +@code{fixnump} and @code{bignump} on any object. The read syntax for integers is a sequence of (base ten) digits with an optional sign at the beginning and an optional period at the end. The diff --git a/lisp/subr.el b/lisp/subr.el index cafa4835ea..9e880bc880 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -366,6 +366,15 @@ was called." (declare (compiler-macro (lambda (_) `(= 0 ,number)))) (= 0 number)) +(defun fixnump (object) + "Return t if OBJECT is a fixnum." + (and (integerp object) + (<= most-negative-fixnum object most-positive-fixnum))) + +(defun bignump (object) + "Return t if OBJECT is a bignum." + (and (integerp object) (not (fixnump object)))) + (defun lsh (value count) "Return VALUE with its bits shifted left by COUNT. If COUNT is negative, shifting is actually to the right. diff --git a/src/data.c b/src/data.c index 4c6d33f294..08c7271dd7 100644 --- a/src/data.c +++ b/src/data.c @@ -511,16 +511,6 @@ DEFUN ("integerp", Fintegerp, Sintegerp, 1, 1, 0, return Qnil; } -DEFUN ("fixnump", Ffixnump, Sfixnump, 1, 1, 0, - doc: /* Return t if OBJECT is an fixnum. */ - attributes: const) - (Lisp_Object object) -{ - if (FIXNUMP (object)) - return Qt; - return Qnil; -} - DEFUN ("integer-or-marker-p", Finteger_or_marker_p, Sinteger_or_marker_p, 1, 1, 0, doc: /* Return t if OBJECT is an integer or a marker (editor pointer). */) (register Lisp_Object object) @@ -598,15 +588,6 @@ DEFUN ("condition-variable-p", Fcondition_variable_p, Scondition_variable_p, return Qt; return Qnil; } - -DEFUN ("bignump", Fbignump, Sbignump, 1, 1, 0, - doc: /* Return t if OBJECT is a bignum. */) - (Lisp_Object object) -{ - if (BIGNUMP (object)) - return Qt; - return Qnil; -} /* Extract and set components of lists. */ @@ -4153,7 +4134,6 @@ syms_of_data (void) defsubr (&Sconsp); defsubr (&Satom); defsubr (&Sintegerp); - defsubr (&Sfixnump); defsubr (&Sinteger_or_marker_p); defsubr (&Snumberp); defsubr (&Snumber_or_marker_p); @@ -4179,7 +4159,6 @@ syms_of_data (void) defsubr (&Sthreadp); defsubr (&Smutexp); defsubr (&Scondition_variable_p); - defsubr (&Sbignump); defsubr (&Scar); defsubr (&Scdr); defsubr (&Scar_safe); commit f8069952abf147d090032ad6b941a728cad2c496 Author: Paul Eggert Date: Tue Aug 21 15:49:01 2018 -0700 Fix assertion failure when reading 'BIGNUM.' Problem reported by Stefan Monnier (Bug#32476). * src/lread.c (string_to_number): Don't pass leading "+" or trailing "." or junk to make_bignum_str. * test/src/lread-tests.el (lread-string-to-number-trailing-dot): New test. diff --git a/src/lread.c b/src/lread.c index df2fe58120..5e1bd419fa 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3710,8 +3710,9 @@ string_to_number (char const *string, int base, int flags) IEEE floating point hosts, and works around a formerly-common bug where atof ("-0.0") drops the sign. */ bool negative = *cp == '-'; + bool positive = *cp == '+'; - bool signedp = negative || *cp == '+'; + bool signedp = negative | positive; cp += signedp; enum { INTOVERFLOW = 1, LEAD_INT = 2, DOT_CHAR = 4, TRAIL_INT = 8, @@ -3732,6 +3733,7 @@ string_to_number (char const *string, int base, int flags) n += digit; } } + char const *after_digits = cp; if (*cp == '.') { state |= DOT_CHAR; @@ -3807,10 +3809,19 @@ string_to_number (char const *string, int base, int flags) return make_fixnum (negative ? -signed_n : signed_n); } - /* Skip a leading "+". */ - if (signedp && !negative) - ++string; - return make_bignum_str (string, base); + /* Trim any leading "+" and trailing nondigits, then convert to + bignum. */ + string += positive; + if (!*after_digits) + return make_bignum_str (string, base); + ptrdiff_t trimmed_len = after_digits - string; + USE_SAFE_ALLOCA; + char *trimmed = SAFE_ALLOCA (trimmed_len + 1); + memcpy (trimmed, string, trimmed_len); + trimmed[trimmed_len] = '\0'; + Lisp_Object result = make_bignum_str (trimmed, base); + SAFE_FREE (); + return result; } /* Either the number uses float syntax, or it does not fit into a fixnum. diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index 17381340c7..f19d98320a 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -209,4 +209,13 @@ literals (Bug#20852)." (should-error (let ((load-force-doc-strings t)) (read "#[0 \"\"]")))) +(ert-deftest lread-string-to-number-trailing-dot () + (dolist (n (list (* most-negative-fixnum most-negative-fixnum) + (1- most-negative-fixnum) most-negative-fixnum + (1+ most-negative-fixnum) -1 0 1 + (1- most-positive-fixnum) most-positive-fixnum + (1+ most-positive-fixnum) + (* most-positive-fixnum most-positive-fixnum))) + (should (= n (string-to-number (format "%d." n)))))) + ;;; lread-tests.el ends here commit f18af6cd5cb7dbbf7420ec2d3efed4e202c4f0dd Author: Paul Eggert Date: Tue Aug 21 13:44:03 2018 -0700 Audit use of lsh and fix glitches I audited use of lsh in the Lisp source code, and fixed the glitches that I found. While I was at it, I replaced uses of lsh with ash when either will do. Replacement is OK when either argument is known to be nonnegative, or when only the low-order bits of the result matter, and is a (minor) win since ash is a bit more solid than lsh nowadays, and is a bit faster. * lisp/calc/calc-ext.el (math-check-fixnum): Prefer most-positive-fixnum to (lsh -1 -1). * lisp/vc/vc-hg.el (vc-hg-state-fast): When testing fixnum width, prefer (zerop (ash most-positive-fixnum -32)) to (zerop (lsh -1 32)) (Bug#32485#11). * lisp/emacs-lisp/bytecomp.el (byte-compile-lapcode): Tighten sanity-check for bytecode overflow, by checking that the result of (ash pc -8) is nonnegative. Formerly this check was not needed since lsh was used and the number overflowed differently. * lisp/net/dns.el (dns-write): Fix some obvious sign typos in shift counts. Evidently this part of the code has never been exercised. * lisp/progmodes/hideif.el (hif-shiftleft, hif-shiftright): * lisp/term/common-win.el (x-setup-function-keys): Simplify. * admin/unidata/unidata-gen.el, admin/unidata/uvs.el: * doc/lispref/keymaps.texi, doc/lispref/syntax.texi: * doc/misc/calc.texi, doc/misc/cl.texi, etc/NEWS.19: * lisp/arc-mode.el, lisp/calc/calc-bin.el, lisp/calc/calc-comb.el: * lisp/calc/calc-ext.el, lisp/calc/calc-math.el: * lisp/cedet/semantic/wisent/comp.el, lisp/composite.el: * lisp/disp-table.el, lisp/dos-fns.el, lisp/edmacro.el: * lisp/emacs-lisp/bindat.el, lisp/emacs-lisp/byte-opt.el: * lisp/emacs-lisp/bytecomp.el, lisp/emacs-lisp/cl-extra.el: * lisp/erc/erc-dcc.el, lisp/facemenu.el, lisp/gnus/message.el: * lisp/gnus/nndoc.el, lisp/gnus/nnmaildir.el, lisp/image.el: * lisp/international/ccl.el, lisp/international/fontset.el: * lisp/international/mule-cmds.el, lisp/international/mule.el: * lisp/json.el, lisp/mail/binhex.el, lisp/mail/rmail.el: * lisp/mail/uudecode.el, lisp/md4.el, lisp/net/dns.el: * lisp/net/ntlm.el, lisp/net/sasl.el, lisp/net/socks.el: * lisp/net/tramp.el, lisp/obsolete/levents.el: * lisp/obsolete/pgg-parse.el, lisp/org/org.el: * lisp/org/ox-publish.el, lisp/progmodes/cc-defs.el: * lisp/progmodes/ebnf2ps.el, lisp/progmodes/hideif.el: * lisp/ps-bdf.el, lisp/ps-print.el, lisp/simple.el: * lisp/tar-mode.el, lisp/term/common-win.el: * lisp/term/tty-colors.el, lisp/term/xterm.el, lisp/vc/vc-git.el: * lisp/vc/vc-hg.el, lisp/x-dnd.el, test/src/data-tests.el: Prefer ash to lsh when either will do. diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el index 8cc1893adb..e520d18909 100644 --- a/admin/unidata/unidata-gen.el +++ b/admin/unidata/unidata-gen.el @@ -401,7 +401,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (if (consp range) (if val (set-char-table-range table range val)) - (let* ((start (lsh (lsh range -7) 7)) + (let* ((start (ash (ash range -7) 7)) (limit (+ start 127)) first-index last-index) (fillarray vec 0) @@ -548,7 +548,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (if (< from (logand to #x1FFF80)) (setq from (logand to #x1FFF80))) (setq prev-range-data (cons (cons from to) val-code))))) - (let* ((start (lsh (lsh range -7) 7)) + (let* ((start (ash (ash range -7) 7)) (limit (+ start 127)) str count new-val from to vcode) (fillarray vec (car default-value)) @@ -761,7 +761,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." ((stringp val) (if (> (aref val 0) 0) val - (let* ((first-char (lsh (lsh char -7) 7)) + (let* ((first-char (ash (ash char -7) 7)) (word-table (aref (char-table-extra-slot table 4) 0)) (i 1) (len (length val)) @@ -865,7 +865,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." ((stringp val) (if (> (aref val 0) 0) val - (let* ((first-char (lsh (lsh char -7) 7)) + (let* ((first-char (ash (ash char -7) 7)) (word-table (char-table-extra-slot table 4)) (i 1) (len (length val)) @@ -982,7 +982,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (if slot (nconc slot (list range)) (push (list val range) block-list)))) - (let* ((start (lsh (lsh range -7) 7)) + (let* ((start (ash (ash range -7) 7)) (limit (+ start 127)) (first tail) (vec (make-vector 128 nil)) diff --git a/admin/unidata/uvs.el b/admin/unidata/uvs.el index 6bb6a2ab76..31840fb182 100644 --- a/admin/unidata/uvs.el +++ b/admin/unidata/uvs.el @@ -107,7 +107,7 @@ The most significant byte comes first." (let (result) (dotimes (i size) (push (logand value #xff) result) - (setq value (lsh value -8))) + (setq value (ash value -8))) result)) (defun uvs-insert-fields-as-bytes (fields &rest values) diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index cc2e11e0b6..38e89c6cfd 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -1660,7 +1660,7 @@ to turn the character that follows into a Hyper character: (defun hyperify (prompt) (let ((e (read-event))) (vector (if (numberp e) - (logior (lsh 1 24) e) + (logior (ash 1 24) e) (if (memq 'hyper (event-modifiers e)) e (add-event-modifier "H-" e)))))) diff --git a/doc/lispref/syntax.texi b/doc/lispref/syntax.texi index 71c97fdae8..dcfade3f67 100644 --- a/doc/lispref/syntax.texi +++ b/doc/lispref/syntax.texi @@ -1014,13 +1014,13 @@ corresponds to each syntax flag. @item @i{Prefix} @tab @i{Flag} @tab @i{Prefix} @tab @i{Flag} @item -@samp{1} @tab @code{(lsh 1 16)} @tab @samp{p} @tab @code{(lsh 1 20)} +@samp{1} @tab @code{(ash 1 16)} @tab @samp{p} @tab @code{(ash 1 20)} @item -@samp{2} @tab @code{(lsh 1 17)} @tab @samp{b} @tab @code{(lsh 1 21)} +@samp{2} @tab @code{(ash 1 17)} @tab @samp{b} @tab @code{(ash 1 21)} @item -@samp{3} @tab @code{(lsh 1 18)} @tab @samp{n} @tab @code{(lsh 1 22)} +@samp{3} @tab @code{(ash 1 18)} @tab @samp{n} @tab @code{(ash 1 22)} @item -@samp{4} @tab @code{(lsh 1 19)} @tab @samp{c} @tab @code{(lsh 1 23)} +@samp{4} @tab @code{(ash 1 19)} @tab @samp{c} @tab @code{(ash 1 23)} @end multitable @defun string-to-syntax desc diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index b1b38620ff..98ef6daa2c 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi @@ -32717,7 +32717,7 @@ create an intermediate set. (while (> n 0) (if (oddp n) (setq count (1+ count))) - (setq n (lsh n -1))) + (setq n (ash n -1))) count)) @end smallexample @@ -32761,7 +32761,7 @@ routines are especially fast when dividing by an integer less than (let ((count 0)) (while (> n 0) (setq count (+ count (logand n 1)) - n (lsh n -1))) + n (ash n -1))) count)) @end smallexample @@ -32774,7 +32774,7 @@ uses. The @code{idivmod} function does an integer division, returning both the quotient and the remainder at once. Again, note that while it -might seem that @samp{(logand n 511)} and @samp{(lsh n -9)} are +might seem that @samp{(logand n 511)} and @samp{(ash n -9)} are more efficient ways to split off the bottom nine bits of @code{n}, actually they are less efficient because each operation is really a division by 512 in disguise; @code{idivmod} allows us to do the diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi index 77105d3364..6985f19421 100644 --- a/doc/misc/cl.texi +++ b/doc/misc/cl.texi @@ -784,7 +784,7 @@ default. Some examples: (cl-deftype null () '(satisfies null)) ; predefined (cl-deftype list () '(or null cons)) ; predefined (cl-deftype unsigned-byte (&optional bits) - (list 'integer 0 (if (eq bits '*) bits (1- (lsh 1 bits))))) + (list 'integer 0 (if (eq bits '*) bits (1- (ash 1 bits))))) (unsigned-byte 8) @equiv{} (integer 0 255) (unsigned-byte) @equiv{} (integer 0 *) unsigned-byte @equiv{} (integer 0 *) diff --git a/etc/NEWS.19 b/etc/NEWS.19 index efe0f0e7f7..1f84e87cef 100644 --- a/etc/NEWS.19 +++ b/etc/NEWS.19 @@ -4341,7 +4341,7 @@ turn the character that follows into a hyper character: (defun hyperify (prompt) (let ((e (read-event))) (vector (if (numberp e) - (logior (lsh 1 20) e) + (logior (ash 1 20) e) (if (memq 'hyper (event-modifiers e)) e (add-event-modifier "H-" e)))))) diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 4ddb29dcbb..e45c6004b9 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -583,7 +583,7 @@ the mode is invalid. If ERROR is nil then nil will be returned." (len (length newmode)) (i 1)) (while (< i len) - (setq result (+ (lsh result 3) (aref newmode i) (- ?0)) + (setq result (+ (ash result 3) (aref newmode i) (- ?0)) i (1+ i))) (logior (logand oldmode 65024) result))) ((string-match "^\\([agou]+\\)\\([---+=]\\)\\([rwxst]+\\)$" newmode) @@ -1759,7 +1759,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (setq newval (funcall newval (archive-l-e (+ p2 ofs) 2)))) (goto-char (+ p2 ofs)) (delete-char 2) - (insert-unibyte (logand newval 255) (lsh newval -8)) + (insert-unibyte (logand newval 255) (ash newval -8)) (goto-char (1+ p)) (delete-char 1) (insert-unibyte (archive-lzh-resum (1+ p) hsize))) @@ -1949,11 +1949,11 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (cond ((memq creator '(2 3)) ; Unix (goto-char (+ p 40)) (delete-char 2) - (insert-unibyte (logand newval 255) (lsh newval -8))) + (insert-unibyte (logand newval 255) (ash newval -8))) ((memq creator '(0 5 6 7 10 11 15)) ; Dos etc. (goto-char (+ p 38)) (insert-unibyte (logior (logand (byte-after (point)) 254) - (logand (logxor 1 (lsh newval -7)) 1))) + (logand (logxor 1 (ash newval -7)) 1))) (delete-char 1)) (t (message "Don't know how to change mode for this member")))) )))) diff --git a/lisp/calc/calc-bin.el b/lisp/calc/calc-bin.el index c05a71a2d7..a61cecf357 100644 --- a/lisp/calc/calc-bin.el +++ b/lisp/calc/calc-bin.el @@ -420,7 +420,7 @@ the size of a Calc bignum digit.") (let ((q (math-div-bignum-digit a math-bignum-digit-power-of-two))) (if (<= w math-bignum-logb-digit-size) (list (logand (lognot (cdr q)) - (1- (lsh 1 w)))) + (1- (ash 1 w)))) (math-mul-bignum-digit (math-not-bignum (math-norm-bignum (car q)) (- w math-bignum-logb-digit-size)) math-bignum-digit-power-of-two @@ -529,7 +529,7 @@ the size of a Calc bignum digit.") ((and (integerp a) (< a math-small-integer-size)) (if (> w (logb math-small-integer-size)) a - (logand a (1- (lsh 1 w))))) + (logand a (1- (ash 1 w))))) (t (math-normalize (cons 'bigpos @@ -542,7 +542,7 @@ the size of a Calc bignum digit.") (let ((q (math-div-bignum-digit a math-bignum-digit-power-of-two))) (if (<= w math-bignum-logb-digit-size) (list (logand (cdr q) - (1- (lsh 1 w)))) + (1- (ash 1 w)))) (math-mul-bignum-digit (math-clip-bignum (math-norm-bignum (car q)) (- w math-bignum-logb-digit-size)) math-bignum-digit-power-of-two diff --git a/lisp/calc/calc-comb.el b/lisp/calc/calc-comb.el index 7c88230f86..f1d3daeed9 100644 --- a/lisp/calc/calc-comb.el +++ b/lisp/calc/calc-comb.el @@ -580,7 +580,7 @@ ;; deduce a better value for RAND_MAX. (let ((i 0)) (while (< (setq i (1+ i)) 30) - (if (> (lsh (math-abs (random)) math-random-shift) 4095) + (if (> (ash (math-abs (random)) math-random-shift) 4095) (setq math-random-shift (1- math-random-shift)))))) (setq math-last-RandSeed var-RandSeed math-gaussian-cache nil)) @@ -592,11 +592,11 @@ (cdr math-random-table)) math-random-ptr2 (or (cdr math-random-ptr2) (cdr math-random-table))) - (logand (lsh (setcar math-random-ptr1 + (logand (ash (setcar math-random-ptr1 (logand (- (car math-random-ptr1) (car math-random-ptr2)) 524287)) -6) 1023)) - (logand (lsh (random) math-random-shift) 1023))) + (logand (ash (random) math-random-shift) 1023))) ;;; Produce a random digit in the range 0..999. diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index 5feff23f72..f983ebe414 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el @@ -2294,14 +2294,14 @@ calc-kill calc-kill-region calc-yank)))) (let ((a (math-trunc a))) (if (integerp a) a - (if (or (Math-lessp (lsh -1 -1) a) - (Math-lessp a (- (lsh -1 -1)))) + (if (or (Math-lessp most-positive-fixnum a) + (Math-lessp a (- most-positive-fixnum))) (math-reject-arg a 'fixnump) (math-fixnum a))))) ((and allow-inf (equal a '(var inf var-inf))) - (lsh -1 -1)) + most-positive-fixnum) ((and allow-inf (equal a '(neg (var inf var-inf)))) - (- (lsh -1 -1))) + (- most-positive-fixnum)) (t (math-reject-arg a 'fixnump)))) ;;; Verify that A is an integer >= 0 and return A in integer form. [I N; - x] diff --git a/lisp/calc/calc-math.el b/lisp/calc/calc-math.el index 4b8abbf4f8..483907a325 100644 --- a/lisp/calc/calc-math.el +++ b/lisp/calc/calc-math.el @@ -1697,7 +1697,7 @@ If this can't be done, return NIL." (while (not (Math-lessp x pow)) (setq pows (cons pow pows) pow (math-sqr pow))) - (setq n (lsh 1 (1- (length pows))) + (setq n (ash 1 (1- (length pows))) sum n pow (car pows)) (while (and (setq pows (cdr pows)) diff --git a/lisp/cedet/semantic/wisent/comp.el b/lisp/cedet/semantic/wisent/comp.el index 837222ad4b..74ca4f4a43 100644 --- a/lisp/cedet/semantic/wisent/comp.el +++ b/lisp/cedet/semantic/wisent/comp.el @@ -142,8 +142,8 @@ If optional LEFT is non-nil insert spaces on left." (defconst wisent-BITS-PER-WORD (let ((i 1) (do-shift (if (boundp 'most-positive-fixnum) - (lambda (i) (lsh most-positive-fixnum (- i))) - (lambda (i) (lsh 1 i))))) + (lambda (i) (ash most-positive-fixnum (- i))) + (lambda (i) (ash 1 i))))) (while (not (zerop (funcall do-shift i))) (setq i (1+ i))) i)) @@ -156,18 +156,18 @@ If optional LEFT is non-nil insert spaces on left." "X[I/BITS-PER-WORD] |= 1 << (I % BITS-PER-WORD)." (let ((k (/ i wisent-BITS-PER-WORD))) (aset x k (logior (aref x k) - (lsh 1 (% i wisent-BITS-PER-WORD)))))) + (ash 1 (% i wisent-BITS-PER-WORD)))))) (defsubst wisent-RESETBIT (x i) "X[I/BITS-PER-WORD] &= ~(1 << (I % BITS-PER-WORD))." (let ((k (/ i wisent-BITS-PER-WORD))) (aset x k (logand (aref x k) - (lognot (lsh 1 (% i wisent-BITS-PER-WORD))))))) + (lognot (ash 1 (% i wisent-BITS-PER-WORD))))))) (defsubst wisent-BITISSET (x i) "(X[I/BITS-PER-WORD] & (1 << (I % BITS-PER-WORD))) != 0." (not (zerop (logand (aref x (/ i wisent-BITS-PER-WORD)) - (lsh 1 (% i wisent-BITS-PER-WORD)))))) + (ash 1 (% i wisent-BITS-PER-WORD)))))) (defsubst wisent-noninteractive () "Return non-nil if running without interactive terminal." diff --git a/lisp/composite.el b/lisp/composite.el index 7daea54c9e..3d4805e8fa 100644 --- a/lisp/composite.el +++ b/lisp/composite.el @@ -119,7 +119,7 @@ RULE is a cons of global and new reference point symbols (setq nref (cdr (assq nref reference-point-alist)))) (or (and (>= gref 0) (< gref 12) (>= nref 0) (< nref 12)) (error "Invalid composition rule: %S" rule)) - (logior (lsh xoff 16) (lsh yoff 8) (+ (* gref 12) nref))) + (logior (ash xoff 16) (ash yoff 8) (+ (* gref 12) nref))) (error "Invalid composition rule: %S" rule)))) ;; Decode encoded composition rule RULE-CODE. The value is a cons of @@ -130,8 +130,8 @@ RULE is a cons of global and new reference point symbols (defun decode-composition-rule (rule-code) (or (and (natnump rule-code) (< rule-code #x1000000)) (error "Invalid encoded composition rule: %S" rule-code)) - (let ((xoff (lsh rule-code -16)) - (yoff (logand (lsh rule-code -8) #xFF)) + (let ((xoff (ash rule-code -16)) + (yoff (logand (ash rule-code -8) #xFF)) gref nref) (setq rule-code (logand rule-code #xFF) gref (car (rassq (/ rule-code 12) reference-point-alist)) diff --git a/lisp/disp-table.el b/lisp/disp-table.el index 13d73a98d0..95224f2b2a 100644 --- a/lisp/disp-table.el +++ b/lisp/disp-table.el @@ -226,7 +226,7 @@ X frame." char (let ((fid (face-id face))) (if (< fid 64) ; we have 32 - 3(LSB) - 1(SIGN) - 22(CHAR) = 6 bits for face id - (logior char (lsh fid 22)) + (logior char (ash fid 22)) (cons char fid))))) ;;;###autoload @@ -239,7 +239,7 @@ X frame." ;;;###autoload (defun glyph-face (glyph) "Return the face of glyph code GLYPH, or nil if glyph has default face." - (let ((face-id (if (consp glyph) (cdr glyph) (lsh glyph -22)))) + (let ((face-id (if (consp glyph) (cdr glyph) (ash glyph -22)))) (and (> face-id 0) (catch 'face (dolist (face (face-list)) diff --git a/lisp/dos-fns.el b/lisp/dos-fns.el index ebb8acb860..aeb8da4d48 100644 --- a/lisp/dos-fns.el +++ b/lisp/dos-fns.el @@ -269,7 +269,7 @@ returned unaltered." (car where) (if (zerop (cdr where)) (logior (logand tem 65280) value) - (logior (logand tem 255) (lsh value 8)))))) + (logior (logand tem 255) (ash value 8)))))) ((numberp where) (aset regs where (logand value 65535)))))) regs) diff --git a/lisp/edmacro.el b/lisp/edmacro.el index 7818062795..c3d9bc5a98 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -547,7 +547,7 @@ doubt, use whitespace." ?\M-\^@ ?\s-\^@ ?\S-\^@) when (/= (logand ch bit) 0) concat (format "%c-" pf)) - (let ((ch2 (logand ch (1- (lsh 1 18))))) + (let ((ch2 (logand ch (1- (ash 1 18))))) (cond ((<= ch2 32) (pcase ch2 (0 "NUL") (9 "TAB") (10 "LFD") diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el index c134376590..3124217303 100644 --- a/lisp/emacs-lisp/bindat.el +++ b/lisp/emacs-lisp/bindat.el @@ -205,22 +205,22 @@ (setq bindat-idx (1+ bindat-idx)))) (defun bindat--unpack-u16 () - (logior (lsh (bindat--unpack-u8) 8) (bindat--unpack-u8))) + (logior (ash (bindat--unpack-u8) 8) (bindat--unpack-u8))) (defun bindat--unpack-u24 () - (logior (lsh (bindat--unpack-u16) 8) (bindat--unpack-u8))) + (logior (ash (bindat--unpack-u16) 8) (bindat--unpack-u8))) (defun bindat--unpack-u32 () - (logior (lsh (bindat--unpack-u16) 16) (bindat--unpack-u16))) + (logior (ash (bindat--unpack-u16) 16) (bindat--unpack-u16))) (defun bindat--unpack-u16r () - (logior (bindat--unpack-u8) (lsh (bindat--unpack-u8) 8))) + (logior (bindat--unpack-u8) (ash (bindat--unpack-u8) 8))) (defun bindat--unpack-u24r () - (logior (bindat--unpack-u16r) (lsh (bindat--unpack-u8) 16))) + (logior (bindat--unpack-u16r) (ash (bindat--unpack-u8) 16))) (defun bindat--unpack-u32r () - (logior (bindat--unpack-u16r) (lsh (bindat--unpack-u16r) 16))) + (logior (bindat--unpack-u16r) (ash (bindat--unpack-u16r) 16))) (defun bindat--unpack-item (type len &optional vectype) (if (eq type 'ip) @@ -250,7 +250,7 @@ (if (/= 0 (logand m j)) (setq bits (cons bnum bits))) (setq bnum (1- bnum) - j (lsh j -1))))) + j (ash j -1))))) bits)) ((eq type 'str) (let ((s (substring bindat-raw bindat-idx (+ bindat-idx len)))) @@ -459,30 +459,30 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (setq bindat-idx (1+ bindat-idx))) (defun bindat--pack-u16 (v) - (aset bindat-raw bindat-idx (logand (lsh v -8) 255)) + (aset bindat-raw bindat-idx (logand (ash v -8) 255)) (aset bindat-raw (1+ bindat-idx) (logand v 255)) (setq bindat-idx (+ bindat-idx 2))) (defun bindat--pack-u24 (v) - (bindat--pack-u8 (lsh v -16)) + (bindat--pack-u8 (ash v -16)) (bindat--pack-u16 v)) (defun bindat--pack-u32 (v) - (bindat--pack-u16 (lsh v -16)) + (bindat--pack-u16 (ash v -16)) (bindat--pack-u16 v)) (defun bindat--pack-u16r (v) - (aset bindat-raw (1+ bindat-idx) (logand (lsh v -8) 255)) + (aset bindat-raw (1+ bindat-idx) (logand (ash v -8) 255)) (aset bindat-raw bindat-idx (logand v 255)) (setq bindat-idx (+ bindat-idx 2))) (defun bindat--pack-u24r (v) (bindat--pack-u16r v) - (bindat--pack-u8 (lsh v -16))) + (bindat--pack-u8 (ash v -16))) (defun bindat--pack-u32r (v) (bindat--pack-u16r v) - (bindat--pack-u16r (lsh v -16))) + (bindat--pack-u16r (ash v -16))) (defun bindat--pack-item (v type len &optional vectype) (if (eq type 'ip) @@ -515,7 +515,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (if (memq bnum v) (setq m (logior m j))) (setq bnum (1- bnum) - j (lsh j -1)))) + j (ash j -1)))) (bindat--pack-u8 m)))) ((memq type '(str strz)) (let ((l (length v)) (i 0)) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 1920503b8c..4854808fd0 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1283,7 +1283,7 @@ (setq bytedecomp-ptr (1+ bytedecomp-ptr)) (+ (aref bytes bytedecomp-ptr) (progn (setq bytedecomp-ptr (1+ bytedecomp-ptr)) - (lsh (aref bytes bytedecomp-ptr) 8)))) + (ash (aref bytes bytedecomp-ptr) 8)))) (t tem)))) ;Offset was in opcode. ((>= bytedecomp-op byte-constant) (prog1 (- bytedecomp-op byte-constant) ;Offset in opcode. @@ -1297,7 +1297,7 @@ (setq bytedecomp-ptr (1+ bytedecomp-ptr)) (+ (aref bytes bytedecomp-ptr) (progn (setq bytedecomp-ptr (1+ bytedecomp-ptr)) - (lsh (aref bytes bytedecomp-ptr) 8)))) + (ash (aref bytes bytedecomp-ptr) 8)))) ((and (>= bytedecomp-op byte-listN) (<= bytedecomp-op byte-discardN)) (setq bytedecomp-ptr (1+ bytedecomp-ptr)) ;Offset in next byte. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index ee28e61800..0b8f8824b4 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -835,7 +835,7 @@ all the arguments. (defmacro byte-compile-push-bytecode-const2 (opcode const2 bytes pc) "Push OPCODE and the two-byte constant CONST2 onto BYTES, and add 3 to PC. CONST2 may be evaluated multiple times." - `(byte-compile-push-bytecodes ,opcode (logand ,const2 255) (lsh ,const2 -8) + `(byte-compile-push-bytecodes ,opcode (logand ,const2 255) (ash ,const2 -8) ,bytes ,pc)) (defun byte-compile-lapcode (lap) @@ -925,9 +925,9 @@ CONST2 may be evaluated multiple times." ;; Splits PC's value into 2 bytes. The jump address is ;; "reconstructed" by the `FETCH2' macro in `bytecode.c'. (setcar (cdr bytes-tail) (logand pc 255)) - (setcar bytes-tail (lsh pc -8)) + (setcar bytes-tail (ash pc -8)) ;; FIXME: Replace this by some workaround. - (if (> (car bytes-tail) 255) (error "Bytecode overflow"))) + (or (<= 0 (car bytes-tail) 255) (error "Bytecode overflow"))) ;; Similarly, replace TAGs in all jump tables with the correct PC index. (dolist (hash-table byte-compile-jump-tables) @@ -2793,8 +2793,8 @@ If FORM is a lambda or a macro, byte-compile it as a function." (if (> mandatory 127) (byte-compile-report-error "Too many (>127) mandatory arguments") (logior mandatory - (lsh nonrest 8) - (lsh rest 7))))) + (ash nonrest 8) + (ash rest 7))))) (defun byte-compile-lambda (fun &optional add-lambda reserved-csts) @@ -3258,7 +3258,7 @@ for symbols generated by the byte compiler itself." (fun (car form)) (fargs (aref fun 0)) (start-depth byte-compile-depth) - (fmax2 (if (numberp fargs) (lsh fargs -7))) ;2*max+rest. + (fmax2 (if (numberp fargs) (ash fargs -7))) ;2*max+rest. ;; (fmin (if (numberp fargs) (logand fargs 127))) (alen (length (cdr form))) (dynbinds ()) diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 36b65f97b0..bea38a0509 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -472,7 +472,7 @@ Optional second arg STATE is a random-state object." (n (logand 8388607 (aset vec i (- (aref vec i) (aref vec j)))))) (if (integerp lim) (if (<= lim 512) (% n lim) - (if (> lim 8388607) (setq n (+ (lsh n 9) (cl-random 512 state)))) + (if (> lim 8388607) (setq n (+ (ash n 9) (cl-random 512 state)))) (let ((mask 1023)) (while (< mask (1- lim)) (setq mask (1+ (+ mask mask)))) (if (< (setq n (logand n mask)) lim) n (cl-random lim state)))) diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index fdc209991a..8bf4c3e166 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -229,7 +229,7 @@ which is big-endian." "Maximum number of bytes for a fixnum.") (defconst erc-most-positive-int-msb - (lsh most-positive-fixnum (- 0 (* 8 (1- erc-most-positive-int-bytes)))) + (ash most-positive-fixnum (- 0 (* 8 (1- erc-most-positive-int-bytes)))) "Content of the most significant byte of most-positive-fixnum.") (defun erc-unpack-int (str) @@ -251,7 +251,7 @@ which is big-endian." (let ((num 0) (count 0)) (while (< count len) - (setq num (+ num (lsh (aref str (- len count 1)) (* 8 count)))) + (setq num (+ num (ash (aref str (- len count 1)) (* 8 count)))) (setq count (1+ count))) num))) diff --git a/lisp/facemenu.el b/lisp/facemenu.el index a4f675b8c1..7c10d6097c 100644 --- a/lisp/facemenu.el +++ b/lisp/facemenu.el @@ -638,7 +638,7 @@ color. The function should accept a single argument, the color name." (insert " ") (insert (propertize (apply 'format "#%02x%02x%02x" - (mapcar (lambda (c) (lsh c -8)) + (mapcar (lambda (c) (ash c -8)) color-values)) 'mouse-face 'highlight 'help-echo diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index dde9c28656..0bd9442afc 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -5564,7 +5564,7 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'." ;; Instead we use this randomly inited counter. (setq message-unique-id-char (% (1+ (or message-unique-id-char - (logand (random most-positive-fixnum) (1- (lsh 1 20))))) + (logand (random most-positive-fixnum) (1- (ash 1 20))))) ;; (current-time) returns 16-bit ints, ;; and 2^16*25 just fits into 4 digits i base 36. (* 25 25))) @@ -5579,9 +5579,9 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'." user) (message-number-base36 (user-uid) -1)) (message-number-base36 (+ (car tm) - (lsh (% message-unique-id-char 25) 16)) 4) + (ash (% message-unique-id-char 25) 16)) 4) (message-number-base36 (+ (nth 1 tm) - (lsh (/ message-unique-id-char 25) 16)) 4) + (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/gnus/nndoc.el b/lisp/gnus/nndoc.el index 149406a9a2..76e785d2ad 100644 --- a/lisp/gnus/nndoc.el +++ b/lisp/gnus/nndoc.el @@ -769,9 +769,9 @@ from the document.") (defun nndoc-read-little-endian () (+ (prog1 (char-after) (forward-char 1)) - (lsh (prog1 (char-after) (forward-char 1)) 8) - (lsh (prog1 (char-after) (forward-char 1)) 16) - (lsh (prog1 (char-after) (forward-char 1)) 24))) + (ash (prog1 (char-after) (forward-char 1)) 8) + (ash (prog1 (char-after) (forward-char 1)) 16) + (ash (prog1 (char-after) (forward-char 1)) 24))) (defun nndoc-oe-dbx-decode-block () (list diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index d5cfa27c21..c8480ddda4 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -651,7 +651,7 @@ This variable is set by `nnmaildir-request-article'.") (funcall func (cdr entry))))))) (defun nnmaildir--up2-1 (n) - (if (zerop n) 1 (1- (lsh 1 (1+ (logb n)))))) + (if (zerop n) 1 (1- (ash 1 (1+ (logb n)))))) (defun nnmaildir--system-name () (replace-regexp-in-string diff --git a/lisp/image.el b/lisp/image.el index 8d12b680ea..74a23046e9 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -261,7 +261,7 @@ We accept the tag Exif because that is the same format." (setq i (1+ i)) (when (>= (+ i 2) len) (throw 'jfif nil)) - (let ((nbytes (+ (lsh (aref data (+ i 1)) 8) + (let ((nbytes (+ (ash (aref data (+ i 1)) 8) (aref data (+ i 2)))) (code (aref data i))) (when (and (>= code #xe0) (<= code #xef)) diff --git a/lisp/international/ccl.el b/lisp/international/ccl.el index 58083f05d9..a80452f742 100644 --- a/lisp/international/ccl.el +++ b/lisp/international/ccl.el @@ -1152,9 +1152,9 @@ is a list of CCL-BLOCKs." (progn (insert (logand code #xFFFFFF)) (setq i (1+ i))) - (insert (format "%c" (lsh code -16))) + (insert (format "%c" (ash code -16))) (if (< (1+ i) len) - (insert (format "%c" (logand (lsh code -8) 255)))) + (insert (format "%c" (logand (ash code -8) 255)))) (if (< (+ i 2) len) (insert (format "%c" (logand code 255)))) (setq i (+ i 3))))) diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index 9bd05ceb4a..529262a1e7 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -487,7 +487,7 @@ (data (list (vconcat (mapcar 'car cjk)))) (i 0)) (dolist (elt cjk) - (let ((mask (lsh 1 i))) + (let ((mask (ash 1 i))) (map-charset-chars #'(lambda (range _arg) (let ((from (car range)) (to (cdr range))) @@ -867,7 +867,7 @@ (spec (cdr target-spec))) (if (integerp spec) (dotimes (i (length registries)) - (if (> (logand spec (lsh 1 i)) 0) + (if (> (logand spec (ash 1 i)) 0) (set-fontset-font "fontset-default" target (cons nil (aref registries i)) nil 'append))) diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 2bde83f4ea..817a26b1fe 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -451,8 +451,8 @@ non-nil, it is used to sort CODINGS instead." ;; E: 1 if not XXX-with-esc ;; II: if iso-2022 based, 0..3, else 1. (logior - (lsh (if (eq base most-preferred) 1 0) 7) - (lsh + (ash (if (eq base most-preferred) 1 0) 7) + (ash (let ((mime (coding-system-get base :mime-charset))) ;; Prefer coding systems corresponding to a ;; MIME charset. @@ -468,9 +468,9 @@ non-nil, it is used to sort CODINGS instead." (t 3)) 0)) 5) - (lsh (if (memq base lang-preferred) 1 0) 4) - (lsh (if (memq base from-priority) 1 0) 3) - (lsh (if (string-match-p "-with-esc\\'" + (ash (if (memq base lang-preferred) 1 0) 4) + (ash (if (memq base from-priority) 1 0) 3) + (ash (if (string-match-p "-with-esc\\'" (symbol-name base)) 0 1) 2) (if (eq (coding-system-type base) 'iso-2022) diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 0267b15440..a4f344192c 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -911,7 +911,7 @@ non-ASCII files. This attribute is meaningful only when (i 0)) (dolist (elt coding-system-iso-2022-flags) (if (memq elt flags) - (setq bits (logior bits (lsh 1 i)))) + (setq bits (logior bits (ash 1 i)))) (setq i (1+ i))) (setcdr (assq :flags spec-attrs) bits)))) diff --git a/lisp/json.el b/lisp/json.el index cd95ec2832..112f26944b 100644 --- a/lisp/json.el +++ b/lisp/json.el @@ -370,7 +370,7 @@ representation will be parsed correctly." (defun json--decode-utf-16-surrogates (high low) "Return the code point represented by the UTF-16 surrogates HIGH and LOW." - (+ (lsh (- high #xD800) 10) (- low #xDC00) #x10000)) + (+ (ash (- high #xD800) 10) (- low #xDC00) #x10000)) (defun json-read-escaped-char () "Read the JSON string escaped character at point." diff --git a/lisp/mail/binhex.el b/lisp/mail/binhex.el index 299fc0b234..fa2ea3d847 100644 --- a/lisp/mail/binhex.el +++ b/lisp/mail/binhex.el @@ -136,9 +136,9 @@ input and write the converted data to its standard output." (defun binhex-update-crc (crc char &optional count) (if (null count) (setq count 1)) (while (> count 0) - (setq crc (logxor (logand (lsh crc 8) 65280) + (setq crc (logxor (logand (ash crc 8) 65280) (aref binhex-crc-table - (logxor (logand (lsh crc -8) 255) + (logxor (logand (ash crc -8) 255) char))) count (1- count))) crc) @@ -156,14 +156,14 @@ input and write the converted data to its standard output." (defun binhex-string-big-endian (string) (let ((ret 0) (i 0) (len (length string))) (while (< i len) - (setq ret (+ (lsh ret 8) (binhex-char-int (aref string i))) + (setq ret (+ (ash ret 8) (binhex-char-int (aref string i))) i (1+ i))) ret)) (defun binhex-string-little-endian (string) (let ((ret 0) (i 0) (shift 0) (len (length string))) (while (< i len) - (setq ret (+ ret (lsh (binhex-char-int (aref string i)) shift)) + (setq ret (+ ret (ash (binhex-char-int (aref string i)) shift)) i (1+ i) shift (+ shift 8))) ret)) @@ -239,13 +239,13 @@ If HEADER-ONLY is non-nil only decode header and return filename." counter (1+ counter) inputpos (1+ inputpos)) (cond ((= counter 4) - (binhex-push-char (lsh bits -16) nil work-buffer) - (binhex-push-char (logand (lsh bits -8) 255) nil + (binhex-push-char (ash bits -16) nil work-buffer) + (binhex-push-char (logand (ash bits -8) 255) nil work-buffer) (binhex-push-char (logand bits 255) nil work-buffer) (setq bits 0 counter 0)) - (t (setq bits (lsh bits 6))))) + (t (setq bits (ash bits 6))))) (if (null file-name-length) (with-current-buffer work-buffer (setq file-name-length (char-after (point-min)) @@ -261,12 +261,12 @@ If HEADER-ONLY is non-nil only decode header and return filename." (setq tmp (and tmp (not (eq inputpos end))))) (cond ((= counter 3) - (binhex-push-char (logand (lsh bits -16) 255) nil + (binhex-push-char (logand (ash bits -16) 255) nil work-buffer) - (binhex-push-char (logand (lsh bits -8) 255) nil + (binhex-push-char (logand (ash bits -8) 255) nil work-buffer)) ((= counter 2) - (binhex-push-char (logand (lsh bits -10) 255) nil + (binhex-push-char (logand (ash bits -10) 255) nil work-buffer)))) (if header-only nil (binhex-verify-crc work-buffer diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 12a58b293d..9416d04902 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -4515,7 +4515,7 @@ encoded string (and the same mask) will decode the string." (if (= curmask 0) (setq curmask mask)) (setq charmask (% curmask 256)) - (setq curmask (lsh curmask -8)) + (setq curmask (ash curmask -8)) (aset string-vector i (logxor charmask (aref string-vector i))) (setq i (1+ i))) (concat string-vector))) diff --git a/lisp/mail/uudecode.el b/lisp/mail/uudecode.el index 0cdceca6ff..b8f74e3a83 100644 --- a/lisp/mail/uudecode.el +++ b/lisp/mail/uudecode.el @@ -171,12 +171,12 @@ If FILE-NAME is non-nil, save the result to FILE-NAME." (cond ((= counter 4) (setq result (cons (concat - (char-to-string (lsh bits -16)) - (char-to-string (logand (lsh bits -8) 255)) + (char-to-string (ash bits -16)) + (char-to-string (logand (ash bits -8) 255)) (char-to-string (logand bits 255))) result)) (setq bits 0 counter 0)) - (t (setq bits (lsh bits 6))))))) + (t (setq bits (ash bits 6))))))) (cond (done) ((> 0 remain) @@ -188,12 +188,12 @@ If FILE-NAME is non-nil, save the result to FILE-NAME." ((= counter 3) (setq result (cons (concat - (char-to-string (logand (lsh bits -16) 255)) - (char-to-string (logand (lsh bits -8) 255))) + (char-to-string (logand (ash bits -16) 255)) + (char-to-string (logand (ash bits -8) 255))) result))) ((= counter 2) (setq result (cons - (char-to-string (logand (lsh bits -10) 255)) + (char-to-string (logand (ash bits -10) 255)) result)))) (skip-chars-forward non-data-chars end)) (if file-name diff --git a/lisp/md4.el b/lisp/md4.el index 09b54fc9a7..788846ab35 100644 --- a/lisp/md4.el +++ b/lisp/md4.el @@ -91,15 +91,15 @@ strings containing the character 0." (let* ((h1 (+ (car a) (,func (car b) (car c) (car d)) (car xk) (car ac))) (l1 (+ (cdr a) (,func (cdr b) (cdr c) (cdr d)) (cdr xk) (cdr ac))) - (h2 (logand 65535 (+ h1 (lsh l1 -16)))) + (h2 (logand 65535 (+ h1 (ash l1 -16)))) (l2 (logand 65535 l1)) ;; cyclic shift of 32 bits integer (h3 (logand 65535 (if (> s 15) - (+ (lsh h2 (- s 32)) (lsh l2 (- s 16))) - (+ (lsh h2 s) (lsh l2 (- s 16)))))) + (+ (ash h2 (- s 32)) (ash l2 (- s 16))) + (+ (ash h2 s) (ash l2 (- s 16)))))) (l3 (logand 65535 (if (> s 15) - (+ (lsh l2 (- s 32)) (lsh h2 (- s 16))) - (+ (lsh l2 s) (lsh h2 (- s 16))))))) + (+ (ash l2 (- s 32)) (ash h2 (- s 16))) + (+ (ash l2 s) (ash h2 (- s 16))))))) (cons h3 l3)))) (md4-make-step md4-round1 md4-F) @@ -110,7 +110,7 @@ strings containing the character 0." "Return 32-bit sum of 32-bit integers X and Y." (let ((h (+ (car x) (car y))) (l (+ (cdr x) (cdr y)))) - (cons (logand 65535 (+ h (lsh l -16))) (logand 65535 l)))) + (cons (logand 65535 (+ h (ash l -16))) (logand 65535 l)))) (defsubst md4-and (x y) (cons (logand (car x) (car y)) (logand (cdr x) (cdr y)))) @@ -185,8 +185,8 @@ The resulting MD4 value is placed in `md4-buffer'." (let ((int32s (make-vector 16 0)) (i 0) j) (while (< i 16) (setq j (* i 4)) - (aset int32s i (cons (+ (aref seq (+ j 2)) (lsh (aref seq (+ j 3)) 8)) - (+ (aref seq j) (lsh (aref seq (1+ j)) 8)))) + (aset int32s i (cons (+ (aref seq (+ j 2)) (ash (aref seq (+ j 3)) 8)) + (+ (aref seq j) (ash (aref seq (1+ j)) 8)))) (setq i (1+ i))) int32s)) @@ -197,7 +197,7 @@ The resulting MD4 value is placed in `md4-buffer'." "Pack 16 bits integer in 2 bytes string as little endian." (let ((str (make-string 2 0))) (aset str 0 (logand int16 255)) - (aset str 1 (lsh int16 -8)) + (aset str 1 (ash int16 -8)) str)) (defun md4-pack-int32 (int32) @@ -207,20 +207,20 @@ integers (cons high low)." (let ((str (make-string 4 0)) (h (car int32)) (l (cdr int32))) (aset str 0 (logand l 255)) - (aset str 1 (lsh l -8)) + (aset str 1 (ash l -8)) (aset str 2 (logand h 255)) - (aset str 3 (lsh h -8)) + (aset str 3 (ash h -8)) str)) (defun md4-unpack-int16 (str) (if (eq 2 (length str)) - (+ (lsh (aref str 1) 8) (aref str 0)) + (+ (ash (aref str 1) 8) (aref str 0)) (error "%s is not 2 bytes long" str))) (defun md4-unpack-int32 (str) (if (eq 4 (length str)) - (cons (+ (lsh (aref str 3) 8) (aref str 2)) - (+ (lsh (aref str 1) 8) (aref str 0))) + (cons (+ (ash (aref str 3) 8) (aref str 2)) + (+ (ash (aref str 1) 8) (aref str 0))) (error "%s is not 4 bytes long" str))) (provide 'md4) diff --git a/lisp/net/dns.el b/lisp/net/dns.el index 057ae3219e..b3b430d2ba 100644 --- a/lisp/net/dns.el +++ b/lisp/net/dns.el @@ -117,7 +117,7 @@ updated. Set this variable to t to disable the check.") length) (while (not ended) (setq length (dns-read-bytes 1)) - (if (= 192 (logand length (lsh 3 6))) + (if (= 192 (logand length (ash 3 6))) (let ((offset (+ (* (logand 63 length) 256) (dns-read-bytes 1)))) (save-excursion @@ -144,17 +144,17 @@ If TCP-P, the first two bytes of the package with be the length field." (dns-write-bytes (dns-get 'id spec) 2) (dns-write-bytes (logior - (lsh (if (dns-get 'response-p spec) 1 0) -7) - (lsh + (ash (if (dns-get 'response-p spec) 1 0) 7) + (ash (cond ((eq (dns-get 'opcode spec) 'query) 0) ((eq (dns-get 'opcode spec) 'inverse-query) 1) ((eq (dns-get 'opcode spec) 'status) 2) (t (error "No such opcode: %s" (dns-get 'opcode spec)))) - -3) - (lsh (if (dns-get 'authoritative-p spec) 1 0) -2) - (lsh (if (dns-get 'truncated-p spec) 1 0) -1) - (lsh (if (dns-get 'recursion-desired-p spec) 1 0) 0))) + 3) + (ash (if (dns-get 'authoritative-p spec) 1 0) 2) + (ash (if (dns-get 'truncated-p spec) 1 0) 1) + (ash (if (dns-get 'recursion-desired-p spec) 1 0) 0))) (dns-write-bytes (cond ((eq (dns-get 'response-code spec) 'no-error) 0) @@ -198,20 +198,20 @@ If TCP-P, the first two bytes of the package with be the length field." (goto-char (point-min)) (push (list 'id (dns-read-bytes 2)) spec) (let ((byte (dns-read-bytes 1))) - (push (list 'response-p (if (zerop (logand byte (lsh 1 7))) nil t)) + (push (list 'response-p (if (zerop (logand byte (ash 1 7))) nil t)) spec) - (let ((opcode (logand byte (lsh 7 3)))) + (let ((opcode (logand byte (ash 7 3)))) (push (list 'opcode (cond ((eq opcode 0) 'query) ((eq opcode 1) 'inverse-query) ((eq opcode 2) 'status))) spec)) - (push (list 'authoritative-p (if (zerop (logand byte (lsh 1 2))) + (push (list 'authoritative-p (if (zerop (logand byte (ash 1 2))) nil t)) spec) - (push (list 'truncated-p (if (zerop (logand byte (lsh 1 2))) nil t)) + (push (list 'truncated-p (if (zerop (logand byte (ash 1 2))) nil t)) spec) (push (list 'recursion-desired-p - (if (zerop (logand byte (lsh 1 0))) nil t)) spec)) + (if (zerop (logand byte (ash 1 0))) nil t)) spec)) (let ((rc (logand (dns-read-bytes 1) 15))) (push (list 'response-code (cond diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el index 8366bc14e9..217f0b859f 100644 --- a/lisp/net/ntlm.el +++ b/lisp/net/ntlm.el @@ -411,9 +411,9 @@ a string KEY of length 8. FORW is t or nil." (key2 (ntlm-smb-str-to-key key)) (i 0) aa) (while (< i 64) - (unless (zerop (logand (aref in (/ i 8)) (lsh 1 (- 7 (% i 8))))) + (unless (zerop (logand (aref in (/ i 8)) (ash 1 (- 7 (% i 8))))) (aset inb i 1)) - (unless (zerop (logand (aref key2 (/ i 8)) (lsh 1 (- 7 (% i 8))))) + (unless (zerop (logand (aref key2 (/ i 8)) (ash 1 (- 7 (% i 8))))) (aset keyb i 1)) (setq i (1+ i))) (setq outb (ntlm-smb-dohash inb keyb forw)) @@ -422,7 +422,7 @@ a string KEY of length 8. FORW is t or nil." (unless (zerop (aref outb i)) (setq aa (aref out (/ i 8))) (aset out (/ i 8) - (logior aa (lsh 1 (- 7 (% i 8)))))) + (logior aa (ash 1 (- 7 (% i 8)))))) (setq i (1+ i))) out)) @@ -430,28 +430,28 @@ a string KEY of length 8. FORW is t or nil." "Return a string of length 8 for the given string STR of length 7." (let ((key (make-string 8 0)) (i 7)) - (aset key 0 (lsh (aref str 0) -1)) + (aset key 0 (ash (aref str 0) -1)) (aset key 1 (logior - (lsh (logand (aref str 0) 1) 6) - (lsh (aref str 1) -2))) + (ash (logand (aref str 0) 1) 6) + (ash (aref str 1) -2))) (aset key 2 (logior - (lsh (logand (aref str 1) 3) 5) - (lsh (aref str 2) -3))) + (ash (logand (aref str 1) 3) 5) + (ash (aref str 2) -3))) (aset key 3 (logior - (lsh (logand (aref str 2) 7) 4) - (lsh (aref str 3) -4))) + (ash (logand (aref str 2) 7) 4) + (ash (aref str 3) -4))) (aset key 4 (logior - (lsh (logand (aref str 3) 15) 3) - (lsh (aref str 4) -5))) + (ash (logand (aref str 3) 15) 3) + (ash (aref str 4) -5))) (aset key 5 (logior - (lsh (logand (aref str 4) 31) 2) - (lsh (aref str 5) -6))) + (ash (logand (aref str 4) 31) 2) + (ash (aref str 5) -6))) (aset key 6 (logior - (lsh (logand (aref str 5) 63) 1) - (lsh (aref str 6) -7))) + (ash (logand (aref str 5) 63) 1) + (ash (aref str 6) -7))) (aset key 7 (logand (aref str 6) 127)) (while (>= i 0) - (aset key i (lsh (aref key i) 1)) + (aset key i (ash (aref key i) 1)) (setq i (1- i))) key)) @@ -619,16 +619,16 @@ backward." (setq j 0) (while (< j 8) (setq bj (aref b j)) - (setq m (logior (lsh (aref bj 0) 1) (aref bj 5))) - (setq n (logior (lsh (aref bj 1) 3) - (lsh (aref bj 2) 2) - (lsh (aref bj 3) 1) + (setq m (logior (ash (aref bj 0) 1) (aref bj 5))) + (setq n (logior (ash (aref bj 1) 3) + (ash (aref bj 2) 2) + (ash (aref bj 3) 1) (aref bj 4))) (setq k 0) (setq sbox-jmn (aref (aref (aref ntlm-smb-sbox j) m) n)) (while (< k 4) (aset bj k - (if (zerop (logand sbox-jmn (lsh 1 (- 3 k)))) + (if (zerop (logand sbox-jmn (ash 1 (- 3 k)))) 0 1)) (setq k (1+ k))) (setq j (1+ j))) diff --git a/lisp/net/sasl.el b/lisp/net/sasl.el index b4f0fffc71..ca0b66b2fb 100644 --- a/lisp/net/sasl.el +++ b/lisp/net/sasl.el @@ -183,7 +183,7 @@ It contain at least 64 bits of entropy." ;; Don't use microseconds from (current-time), 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- (lsh 1 20))))) + (% (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))) @@ -191,10 +191,10 @@ It contain at least 64 bits of entropy." (concat (sasl-unique-id-number-base36 (+ (car tm) - (lsh (% sasl-unique-id-char 25) 16)) 4) + (ash (% sasl-unique-id-char 25) 16)) 4) (sasl-unique-id-number-base36 (+ (nth 1 tm) - (lsh (/ sasl-unique-id-char 25) 16)) 4)))) + (ash (/ sasl-unique-id-char 25) 16)) 4)))) (defun sasl-unique-id-number-base36 (num len) (if (if (< len 0) diff --git a/lisp/net/socks.el b/lisp/net/socks.el index 4a3b13282c..5ee6eea933 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -420,7 +420,7 @@ (unibyte-string version ; version command ; command - (lsh port -8) ; port, high byte + (ash port -8) ; port, high byte (logand port #xff)) ; port, low byte addr ; address (user-full-name) ; username @@ -434,7 +434,7 @@ atype) ; address type addr ; address (unibyte-string - (lsh port -8) ; port, high byte + (ash port -8) ; port, high byte (logand port #xff))))) ; port, low byte (t (error "Unknown protocol version: %d" version))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 1af2defd58..8e6c911850 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4108,13 +4108,13 @@ This is used to map a mode number to a permission string.") (defun tramp-file-mode-from-int (mode) "Turn an integer representing a file mode into an ls(1)-like string." (let ((type (cdr - (assoc (logand (lsh mode -12) 15) tramp-file-mode-type-map))) - (user (logand (lsh mode -6) 7)) - (group (logand (lsh mode -3) 7)) - (other (logand (lsh mode -0) 7)) - (suid (> (logand (lsh mode -9) 4) 0)) - (sgid (> (logand (lsh mode -9) 2) 0)) - (sticky (> (logand (lsh mode -9) 1) 0))) + (assoc (logand (ash mode -12) 15) tramp-file-mode-type-map))) + (user (logand (ash mode -6) 7)) + (group (logand (ash mode -3) 7)) + (other (logand (ash mode -0) 7)) + (suid (> (logand (ash mode -9) 4) 0)) + (sgid (> (logand (ash mode -9) 2) 0)) + (sticky (> (logand (ash mode -9) 1) 0))) (setq user (tramp-file-mode-permissions user suid "s")) (setq group (tramp-file-mode-permissions group sgid "s")) (setq other (tramp-file-mode-permissions other sticky "t")) diff --git a/lisp/obsolete/levents.el b/lisp/obsolete/levents.el index 7fb3be83ee..48afe7551d 100644 --- a/lisp/obsolete/levents.el +++ b/lisp/obsolete/levents.el @@ -145,7 +145,7 @@ It will be the next event read after all pending events." The value is an ASCII printing character (not upper case) or a symbol." (if (symbolp event) (car (get event 'event-symbol-elements)) - (let ((base (logand event (1- (lsh 1 18))))) + (let ((base (logand event (1- (ash 1 18))))) (downcase (if (< base 32) (logior base 64) base))))) (defun event-object (event) diff --git a/lisp/obsolete/pgg-parse.el b/lisp/obsolete/pgg-parse.el index 34ec96ec12..a747024649 100644 --- a/lisp/obsolete/pgg-parse.el +++ b/lisp/obsolete/pgg-parse.el @@ -116,9 +116,9 @@ ) (defmacro pgg-parse-time-field (bytes) - `(list (logior (lsh (car ,bytes) 8) + `(list (logior (ash (car ,bytes) 8) (nth 1 ,bytes)) - (logior (lsh (nth 2 ,bytes) 8) + (logior (ash (nth 2 ,bytes) 8) (nth 3 ,bytes)) 0)) @@ -184,21 +184,21 @@ (ccl-execute-on-string pgg-parse-crc24 h string) (format "%c%c%c" (logand (aref h 1) 255) - (logand (lsh (aref h 2) -8) 255) + (logand (ash (aref h 2) -8) 255) (logand (aref h 2) 255))))) (defmacro pgg-parse-length-type (c) `(cond ((< ,c 192) (cons ,c 1)) ((< ,c 224) - (cons (+ (lsh (- ,c 192) 8) + (cons (+ (ash (- ,c 192) 8) (pgg-byte-after (+ 2 (point))) 192) 2)) ((= ,c 255) - (cons (cons (logior (lsh (pgg-byte-after (+ 2 (point))) 8) + (cons (cons (logior (ash (pgg-byte-after (+ 2 (point))) 8) (pgg-byte-after (+ 3 (point)))) - (logior (lsh (pgg-byte-after (+ 4 (point))) 8) + (logior (ash (pgg-byte-after (+ 4 (point))) 8) (pgg-byte-after (+ 5 (point))))) 5)) (t;partial body length @@ -210,13 +210,13 @@ (if (zerop (logand 64 ptag));Old format (progn (setq length-type (logand ptag 3) - length-type (if (= 3 length-type) 0 (lsh 1 length-type)) - content-tag (logand 15 (lsh ptag -2)) + length-type (if (= 3 length-type) 0 (ash 1 length-type)) + content-tag (logand 15 (ash ptag -2)) packet-bytes 0 header-bytes (1+ length-type)) (dotimes (i length-type) (setq packet-bytes - (logior (lsh packet-bytes 8) + (logior (ash packet-bytes 8) (pgg-byte-after (+ 1 i (point))))))) (setq content-tag (logand 63 ptag) length-type (pgg-parse-length-type @@ -317,10 +317,10 @@ (let ((name-bytes (pgg-read-bytes 2)) (value-bytes (pgg-read-bytes 2))) (cons (pgg-read-bytes-string - (logior (lsh (car name-bytes) 8) + (logior (ash (car name-bytes) 8) (nth 1 name-bytes))) (pgg-read-bytes-string - (logior (lsh (car value-bytes) 8) + (logior (ash (car value-bytes) 8) (nth 1 value-bytes))))))) (21 ;preferred hash algorithms (cons 'preferred-hash-algorithm @@ -380,7 +380,7 @@ (pgg-set-alist result 'hash-algorithm (pgg-read-byte)) (when (>= 10000 (setq n (pgg-read-bytes 2) - n (logior (lsh (car n) 8) + n (logior (ash (car n) 8) (nth 1 n)))) (save-restriction (narrow-to-region (point)(+ n (point))) @@ -391,7 +391,7 @@ #'pgg-parse-signature-subpacket))) (goto-char (point-max)))) (when (>= 10000 (setq n (pgg-read-bytes 2) - n (logior (lsh (car n) 8) + n (logior (ash (car n) 8) (nth 1 n)))) (save-restriction (narrow-to-region (point)(+ n (point))) diff --git a/lisp/org/org.el b/lisp/org/org.el index e45bc55b24..21d9cd8785 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -10058,7 +10058,7 @@ Note: this function also decodes single byte encodings like (cons 6 128)))) (when (>= val 192) (setq eat (car shift-xor))) (setq val (logxor val (cdr shift-xor))) - (setq sum (+ (lsh sum (car shift-xor)) val)) + (setq sum (+ (ash sum (car shift-xor)) val)) (when (> eat 0) (setq eat (- eat 1))) (cond ((= 0 eat) ;multi byte diff --git a/lisp/org/ox-publish.el b/lisp/org/ox-publish.el index 8901dba34c..ba5a0232e4 100644 --- a/lisp/org/ox-publish.el +++ b/lisp/org/ox-publish.el @@ -794,8 +794,8 @@ Default for SITEMAP-FILENAME is `sitemap.org'." ((or `anti-chronologically `chronologically) (let* ((adate (org-publish-find-date a project)) (bdate (org-publish-find-date b project)) - (A (+ (lsh (car adate) 16) (cadr adate))) - (B (+ (lsh (car bdate) 16) (cadr bdate)))) + (A (+ (ash (car adate) 16) (cadr adate))) + (B (+ (ash (car bdate) 16) (cadr bdate)))) (setq retval (if (eq sort-files 'chronologically) (<= A B) @@ -1348,7 +1348,7 @@ does not exist." (expand-file-name (or (file-symlink-p file) file) (file-name-directory file))))) (if (not attr) (error "No such file: \"%s\"" file) - (+ (lsh (car (nth 5 attr)) 16) + (+ (ash (car (nth 5 attr)) 16) (cadr (nth 5 attr)))))) diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 53d665477c..f41a7cf028 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -1858,7 +1858,7 @@ non-nil, a caret is prepended to invert the set." (setq entry (get-char-table ?a table))) ;; incompatible (t (error "CC Mode is incompatible with this version of Emacs"))) - (setq list (cons (if (= (logand (lsh entry -16) 255) 255) + (setq list (cons (if (= (logand (ash entry -16) 255) 255) '8-bit '1-bit) list))) diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el index 74ec569214..e29eb74a05 100644 --- a/lisp/progmodes/ebnf2ps.el +++ b/lisp/progmodes/ebnf2ps.el @@ -5130,7 +5130,7 @@ killed after process termination." (defsubst ebnf-font-background (font) (nth 3 font)) (defsubst ebnf-font-list (font) (nthcdr 4 font)) (defsubst ebnf-font-attributes (font) - (lsh (ps-extension-bit (cdr font)) -2)) + (ash (ps-extension-bit (cdr font)) -2)) (defconst ebnf-font-name-select diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 24ad2ff6c7..62e8c45338 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -1039,16 +1039,12 @@ preprocessing token" (defun hif-shiftleft (a b) (setq a (hif-mathify a)) (setq b (hif-mathify b)) - (if (< a 0) - (ash a b) - (lsh a b))) + (ash a b)) (defun hif-shiftright (a b) (setq a (hif-mathify a)) (setq b (hif-mathify b)) - (if (< a 0) - (ash a (- b)) - (lsh a (- b)))) + (ash a (- b))) (defalias 'hif-multiply (hif-mathify-binop *)) diff --git a/lisp/ps-bdf.el b/lisp/ps-bdf.el index c8f88234a0..301142ed48 100644 --- a/lisp/ps-bdf.el +++ b/lisp/ps-bdf.el @@ -145,7 +145,7 @@ See the documentation of the function `bdf-read-font-info' for more detail." (if (or (< code (aref code-range 4)) (> code (aref code-range 5))) (setq code (aref code-range 6))) - (+ (* (- (lsh code -8) (aref code-range 0)) + (+ (* (- (ash code -8) (aref code-range 0)) (1+ (- (aref code-range 3) (aref code-range 2)))) (- (logand code 255) (aref code-range 2)))) @@ -262,7 +262,7 @@ CODE, where N and CODE are in the following relation: (setq code (read (current-buffer))) (if (< code 0) (search-forward "ENDCHAR") - (setq code0 (lsh code -8) + (setq code0 (ash code -8) code1 (logand code 255) min-code (min min-code code) max-code (max max-code code) diff --git a/lisp/ps-print.el b/lisp/ps-print.el index 28f93f4e20..7dd1103c2e 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -6299,7 +6299,7 @@ If FACE is not a valid face name, use default face." (ps-font-number 'ps-font-for-text (or (aref ps-font-type (logand effect 3)) face)) - fg-color bg-color (lsh effect -2))))) + fg-color bg-color (ash effect -2))))) (goto-char to)) diff --git a/lisp/simple.el b/lisp/simple.el index 6040d48a99..0ccf2f1d22 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -8348,16 +8348,16 @@ PREFIX is the string that represents this modifier in an event type symbol." (cond ((eq symbol 'control) (if (<= 64 (upcase event) 95) (- (upcase event) 64) - (logior (lsh 1 lshiftby) event))) + (logior (ash 1 lshiftby) event))) ((eq symbol 'shift) ;; FIXME: Should we also apply this "upcase" behavior of shift ;; to non-ascii letters? (if (and (<= (downcase event) ?z) (>= (downcase event) ?a)) (upcase event) - (logior (lsh 1 lshiftby) event))) + (logior (ash 1 lshiftby) event))) (t - (logior (lsh 1 lshiftby) event))) + (logior (ash 1 lshiftby) event))) (if (memq symbol (event-modifiers event)) event (let ((event-type (if (symbolp event) event (car event)))) diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index 9860c8b30c..19e5159816 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -1279,8 +1279,8 @@ for this to be permanent." ;; Format a timestamp as 11 octal digits. Ghod, I hope this works... (let ((hibits (car timeval)) (lobits (car (cdr timeval)))) (format "%05o%01o%05o" - (lsh hibits -2) - (logior (lsh (logand 3 hibits) 1) + (ash hibits -2) + (logior (ash (logand 3 hibits) 1) (if (> (logand lobits 32768) 0) 1 0)) (logand 32767 lobits) ))) diff --git a/lisp/term/common-win.el b/lisp/term/common-win.el index 6ef686a996..a482067ef3 100644 --- a/lisp/term/common-win.el +++ b/lisp/term/common-win.el @@ -59,20 +59,20 @@ (setq system-key-alist (list ;; These are special "keys" used to pass events from C to lisp. - (cons (logior (lsh 0 16) 1) 'ns-power-off) - (cons (logior (lsh 0 16) 2) 'ns-open-file) - (cons (logior (lsh 0 16) 3) 'ns-open-temp-file) - (cons (logior (lsh 0 16) 4) 'ns-drag-file) - (cons (logior (lsh 0 16) 5) 'ns-drag-color) - (cons (logior (lsh 0 16) 6) 'ns-drag-text) - (cons (logior (lsh 0 16) 7) 'ns-change-font) - (cons (logior (lsh 0 16) 8) 'ns-open-file-line) -;;; (cons (logior (lsh 0 16) 9) 'ns-insert-working-text) -;;; (cons (logior (lsh 0 16) 10) 'ns-delete-working-text) - (cons (logior (lsh 0 16) 11) 'ns-spi-service-call) - (cons (logior (lsh 0 16) 12) 'ns-new-frame) - (cons (logior (lsh 0 16) 13) 'ns-toggle-toolbar) - (cons (logior (lsh 0 16) 14) 'ns-show-prefs) + (cons 1 'ns-power-off) + (cons 2 'ns-open-file) + (cons 3 'ns-open-temp-file) + (cons 4 'ns-drag-file) + (cons 5 'ns-drag-color) + (cons 6 'ns-drag-text) + (cons 7 'ns-change-font) + (cons 8 'ns-open-file-line) +;;; (cons 9 'ns-insert-working-text) +;;; (cons 10 'ns-delete-working-text) + (cons 11 'ns-spi-service-call) + (cons 12 'ns-new-frame) + (cons 13 'ns-toggle-toolbar) + (cons 14 'ns-show-prefs) )))) (set-terminal-parameter frame 'x-setup-function-keys t))) diff --git a/lisp/term/tty-colors.el b/lisp/term/tty-colors.el index a776c830a2..d9b272693b 100644 --- a/lisp/term/tty-colors.el +++ b/lisp/term/tty-colors.el @@ -830,10 +830,10 @@ DISPLAY can be a display name or a frame, and defaults to the selected frame's display. If DISPLAY is not on a 24-but TTY terminal, return nil." (when (and rgb (= (display-color-cells display) 16777216)) - (let ((r (lsh (car rgb) -8)) - (g (lsh (cadr rgb) -8)) - (b (lsh (nth 2 rgb) -8))) - (logior (lsh r 16) (lsh g 8) b)))) + (let ((r (ash (car rgb) -8)) + (g (ash (cadr rgb) -8)) + (b (ash (nth 2 rgb) -8))) + (logior (ash r 16) (ash g 8) b)))) (defun tty-color-define (name index &optional rgb frame) "Specify a tty color by its NAME, terminal INDEX and RGB values. @@ -895,9 +895,9 @@ FRAME defaults to the selected frame." ;; never consider it for approximating another color. (if try-rgb (progn - (setq try-r (lsh (car try-rgb) -8) - try-g (lsh (cadr try-rgb) -8) - try-b (lsh (nth 2 try-rgb) -8)) + (setq try-r (ash (car try-rgb) -8) + try-g (ash (cadr try-rgb) -8) + try-b (ash (nth 2 try-rgb) -8)) (setq dif-r (- r try-r) dif-g (- g try-g) dif-b (- b try-b)) @@ -938,13 +938,13 @@ should be the same regardless of what display is being used." (i2 (+ i1 ndig)) (i3 (+ i2 ndig))) (list - (lsh + (ash (string-to-number (substring color i1 i2) 16) (* 4 (- 4 ndig))) - (lsh + (ash (string-to-number (substring color i2 i3) 16) (* 4 (- 4 ndig))) - (lsh + (ash (string-to-number (substring color i3) 16) (* 4 (- 4 ndig)))))) ((and (>= len 9) ;; X-style RGB:xx/yy/zz color spec diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index ce4e18efff..00747afbdc 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -1009,7 +1009,7 @@ hitting screen's max DCS length." (defun xterm-rgb-convert-to-16bit (prim) "Convert an 8-bit primary color value PRIM to a corresponding 16-bit value." - (logior prim (lsh prim 8))) + (logior prim (ash prim 8))) (defun xterm-register-default-colors (colors) "Register the default set of colors for xterm or compatible emulator. diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 75f458233e..96c2f38af4 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -367,8 +367,8 @@ in the order given by 'git status'." (defun vc-git-file-type-as-string (old-perm new-perm) "Return a string describing the file type based on its permissions." - (let* ((old-type (lsh (or old-perm 0) -9)) - (new-type (lsh (or new-perm 0) -9)) + (let* ((old-type (ash (or old-perm 0) -9)) + (new-type (ash (or new-perm 0) -9)) (str (pcase new-type (?\100 ;; File. (pcase old-type diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 14df9d8b67..da4fc2bdf7 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -1017,7 +1017,7 @@ hg binary." ;; Dirstate too small to be valid (< (nth 7 dirstate-attr) 40) ;; We want to store 32-bit unsigned values in fixnums. - (zerop (lsh -1 32)) + (zerop (ash most-positive-fixnum -32)) (progn (setf repo-relative-filename (file-relative-name truename repo)) diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el index 5f8578444a..080cd4d13f 100644 --- a/lisp/x-dnd.el +++ b/lisp/x-dnd.el @@ -556,18 +556,18 @@ FORMAT is 32 (not used). MESSAGE is the data part of an XClientMessageEvent." (defun x-dnd-motif-value-to-list (value size byteorder) (let ((bytes (cond ((eq size 2) - (list (logand (lsh value -8) ?\xff) + (list (logand (ash value -8) ?\xff) (logand value ?\xff))) ((eq size 4) (if (consp value) - (list (logand (lsh (car value) -8) ?\xff) + (list (logand (ash (car value) -8) ?\xff) (logand (car value) ?\xff) - (logand (lsh (cdr value) -8) ?\xff) + (logand (ash (cdr value) -8) ?\xff) (logand (cdr value) ?\xff)) - (list (logand (lsh value -24) ?\xff) - (logand (lsh value -16) ?\xff) - (logand (lsh value -8) ?\xff) + (list (logand (ash value -24) ?\xff) + (logand (ash value -16) ?\xff) + (logand (ash value -8) ?\xff) (logand value ?\xff))))))) (if (eq byteorder ?l) (reverse bytes) diff --git a/test/src/data-tests.el b/test/src/data-tests.el index 688c32d6ee..701e579ae2 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -123,7 +123,7 @@ most-positive-fixnum, which is just less than a power of 2.") (setq byte (lognot byte))) (if (zerop byte) 0 - (+ (logand byte 1) (data-tests-popcnt (lsh byte -1))))) + (+ (logand byte 1) (data-tests-popcnt (ash byte -1))))) (ert-deftest data-tests-logcount () (should (cl-loop for n in (number-sequence -255 255) @@ -186,17 +186,17 @@ most-positive-fixnum, which is just less than a power of 2.") (dotimes (_ 4) (aset bv i (> (logand 1 n) 0)) (cl-incf i) - (setf n (lsh n -1))))) + (setf n (ash n -1))))) bv)) (defun test-bool-vector-to-hex-string (bv) (let (nibbles (v (cl-coerce bv 'list))) (while v (push (logior - (lsh (if (nth 0 v) 1 0) 0) - (lsh (if (nth 1 v) 1 0) 1) - (lsh (if (nth 2 v) 1 0) 2) - (lsh (if (nth 3 v) 1 0) 3)) + (ash (if (nth 0 v) 1 0) 0) + (ash (if (nth 1 v) 1 0) 1) + (ash (if (nth 2 v) 1 0) 2) + (ash (if (nth 3 v) 1 0) 3)) nibbles) (setf v (nthcdr 4 v))) (mapconcat (lambda (n) (format "%X" n)) commit 81e7eef8224c8a99a207b7a7b9dae1d598392ef7 Author: Paul Eggert Date: Tue Aug 21 11:40:23 2018 -0700 Fix bignum bugs with nth, elt, = * src/bytecode.c (exec_byte_code): Support bignums when implementing nth, elt, and =. * src/lisp.h (SMALL_LIST_LEN_MAX): New constant. * src/fns.c (Fnthcdr): Use it. (Felt): Do not reject bignum indexes. diff --git a/src/bytecode.c b/src/bytecode.c index b27fa7c5c6..17457fc574 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -832,13 +832,14 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Bnth): { Lisp_Object v2 = POP, v1 = TOP; - CHECK_FIXNUM (v1); - for (EMACS_INT n = XFIXNUM (v1); 0 < n && CONSP (v2); n--) + if (RANGED_FIXNUMP (0, v1, SMALL_LIST_LEN_MAX)) { - v2 = XCDR (v2); - rarely_quit (n); + for (EMACS_INT n = XFIXNUM (v1); 0 < n && CONSP (v2); n--) + v2 = XCDR (v2); + TOP = CAR (v2); } - TOP = CAR (v2); + else + TOP = Fnth (v1, v2); NEXT; } @@ -985,15 +986,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Beqlsign): { - Lisp_Object v2 = POP, v1 = TOP; - if (FLOATP (v1) || FLOATP (v2)) - TOP = arithcompare (v1, v2, ARITH_EQUAL); - else - { - CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (v1); - CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (v2); - TOP = EQ (v1, v2) ? Qt : Qnil; - } + Lisp_Object v1 = POP; + TOP = arithcompare (TOP, v1, ARITH_EQUAL); NEXT; } @@ -1264,23 +1258,16 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Belt): { - if (CONSP (TOP)) + Lisp_Object v2 = POP, v1 = TOP; + if (CONSP (v1) && RANGED_FIXNUMP (0, v2, SMALL_LIST_LEN_MAX)) { - /* Exchange args and then do nth. */ - Lisp_Object v2 = POP, v1 = TOP; - CHECK_FIXNUM (v2); + /* Like the fast case for Bnth, but with args reversed. */ for (EMACS_INT n = XFIXNUM (v2); 0 < n && CONSP (v1); n--) - { - v1 = XCDR (v1); - rarely_quit (n); - } + v1 = XCDR (v1); TOP = CAR (v1); } else - { - Lisp_Object v1 = POP; - TOP = Felt (TOP, v1); - } + TOP = Felt (v1, v2); NEXT; } diff --git a/src/fns.c b/src/fns.c index 9d681017c1..b368ffd58f 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1418,7 +1418,7 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0, num = XFIXNUM (n); /* Speed up small lists by omitting circularity and quit checking. */ - if (num < 128) + if (num <= SMALL_LIST_LEN_MAX) { for (; 0 < num; num--, tail = XCDR (tail)) if (! CONSP (tail)) @@ -1503,9 +1503,8 @@ N counts from zero. If LIST is not that long, nil is returned. */) DEFUN ("elt", Felt, Selt, 2, 2, 0, doc: /* Return element of SEQUENCE at index N. */) - (register Lisp_Object sequence, Lisp_Object n) + (Lisp_Object sequence, Lisp_Object n) { - CHECK_FIXNUM (n); if (CONSP (sequence) || NILP (sequence)) return Fcar (Fnthcdr (n, sequence)); diff --git a/src/lisp.h b/src/lisp.h index 8f48a33484..c5593b2100 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4694,6 +4694,11 @@ enum Lisp_String)) \ : make_unibyte_string (str, len)) +/* The maximum length of "small" lists, as a heuristic. These lists + are so short that code need not check for cycles or quits while + traversing. */ +enum { SMALL_LIST_LEN_MAX = 127 }; + /* Loop over conses of the list TAIL, signaling if a cycle is found, and possibly quitting after each loop iteration. In the loop body, set TAIL to the current cons. If the loop exits normally, commit ad31afc35be2c64863a03b8f3995847332870cb6 Author: Glenn Morris Date: Tue Aug 21 13:05:31 2018 -0400 Restore compatibility with Texinfo < 6 * doc/lispref/numbers.texi (Integer Basics, Bitwise Operations): Don't use Texinfo 6.0's "@sup" command. diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi index dd78bce4c9..a815047861 100644 --- a/doc/lispref/numbers.texi +++ b/doc/lispref/numbers.texi @@ -193,8 +193,14 @@ on 64-bit platforms. @defvar integer-width The value of this variable is a nonnegative integer that is an upper bound on the number of bits in a bignum. Integers outside the fixnum -range are limited to absolute values less than 2@sup{@var{n}}, where -@var{n} is this variable's value. Attempts to create bignums outside +range are limited to absolute values less than +@ifnottex +2**@var{n}, +@end ifnottex +@tex +@math{2^{n}}, +@end tex +where @var{n} is this variable's value. Attempts to create bignums outside this range result in an integer overflow error. Setting this variable to zero disables creation of bignums; setting it to a large number can cause Emacs to consume large quantities of memory if a computation @@ -857,8 +863,14 @@ reproducing the same pattern moved over. to the left @var{count} places, or to the right if @var{count} is negative. Left shifts introduce zero bits on the right; right shifts discard the rightmost bits. Considered as an integer operation, -@code{ash} multiplies @var{integer1} by 2@sup{@var{count}} and then -converts the result to an integer by rounding downward, toward +@code{ash} multiplies @var{integer1} by +@ifnottex +2**@var{count}, +@end ifnottex +@tex +@math{2^{count}}, +@end tex +and then converts the result to an integer by rounding downward, toward minus infinity. Here are examples of @code{ash}, shifting a pattern of bits one place commit 6e08019af72932ee9decdfa14b6d62b8147839c4 Author: Eli Zaretskii Date: Tue Aug 21 19:35:31 2018 +0300 Recognize codepage 65001 as a valid encoding * lisp/international/mule-conf.el (cp65001): Define it as an alias for UTF-8. diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el index ea687f0ae5..2af10ac7fe 100644 --- a/lisp/international/mule-conf.el +++ b/lisp/international/mule-conf.el @@ -1305,6 +1305,11 @@ is treated as a character." :bom '(utf-8-with-signature . utf-8)) (define-coding-system-alias 'mule-utf-8 'utf-8) +;; See this page: +;; https://docs.microsoft.com/en-us/windows/desktop/intl/code-page-identifiers +;; Starting with Windows 10, people are trying to set their systems to +;; use UTF-8 , so we had better recognized this alias: +(define-coding-system-alias 'cp65001 'utf-8) (define-coding-system 'utf-8-emacs "Support for all Emacs characters (including non-Unicode characters)." commit b2ffcdeae66719d886c9410ac07f6e0a4fe4459e Author: Eli Zaretskii Date: Tue Aug 21 19:07:53 2018 +0300 ; * etc/NEWS: Fix format of the first lines of some entries. diff --git a/etc/NEWS b/etc/NEWS index 892797b2dd..d757f52466 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -272,10 +272,10 @@ previous behavior of always creating a buffer that visits a ChangeLog file. ** diff-mode -*** Hunks are now automatically refined by default +*** Hunks are now automatically refined by default. To disable it, set the new defcustom 'diff-font-lock-refine' to nil. -*** File headers can be shortened, mimicking Magit's diff format +*** File headers can be shortened, mimicking Magit's diff format. To enable it, set the new defcustom 'diff-font-lock-prettify to t. ** Browse-url @@ -287,7 +287,7 @@ shown in the currently selected window. ** Comint +++ -*** 'send-invisible' is now an obsolete alias for `comint-send-invisible' +*** 'send-invisible' is now an obsolete alias for `comint-send-invisible'. Also, 'shell-strip-ctrl-m' is declared obsolete. +++ @@ -315,20 +315,20 @@ end. ** Flymake +++ -*** The variable 'flymake-diagnostic-types-alist' is obsolete +*** The variable 'flymake-diagnostic-types-alist' is obsolete. You should instead set properties on known diagnostic symbols, like ':error' and ':warning', as demonstrated in the Flymake manual. -*** New customizable variable 'flymake-start-on-save-buffer' +*** New customizable variable 'flymake-start-on-save-buffer'. Control whether Flymake starts checking the buffer on save. -*** Flymake and backend functions may exchange hints about buffer changes +*** Flymake and backend functions may exchange hints about buffer changes. This enables more efficient backends. See the docstring of 'flymake-diagnostic-functions' or the Flymake manual for details. ** Package -*** New 'package-quickstart' feature +*** New 'package-quickstart' feature. When 'package-quickstart' is non-nil, package.el precomputes a big autoloads file so that activation of packages can be done much faster, which can speed up your startup significantly. @@ -359,13 +359,13 @@ mouse click event, and is intended to be bound to a mouse event. *** The ecomplete sorting has changed to a decay-based algorithm. This can be controlled by the new 'ecomplete-sort-predicate' variable. -*** The 'ecompleterc' file is now placed in ~/.emacs.d/ecompleterc by default +*** The 'ecompleterc' file is now placed in ~/.emacs.d/ecompleterc by default. Of course it will still find it if you have it in ~/.ecompleterc ** Gnus +++ -*** A prefix argument to 'gnus-summary-limit-to-score' will limit reverse +*** A prefix argument to 'gnus-summary-limit-to-score' will limit reverse. Limit to articles with score at below. *** The function 'gnus-score-find-favorite-words' has been renamed @@ -376,8 +376,8 @@ from 'gnus-score-find-favourite-words'. has a search engine. +++ -*** Splitting mail on common mailing list headers has been added. See -the concept index in the Gnus manual for the 'match-list' entry. +*** Splitting mail on common mailing list headers has been added. +See the concept index in the Gnus manual for the 'match-list' entry. +++ *** nil is no longer an allowed value for 'mm-text-html-renderer'. @@ -421,6 +421,7 @@ saved with the charset properties, and those properties will be restored when the file is visited. ** Smtpmail + Authentication mechanisms can be added via external packages, by defining new cl-defmethod of smtpmail-try-auth-method. @@ -772,6 +773,7 @@ The variable 'custom--inhibit-theme-enable' controls this behavior; its default value changed in Emacs 27.1. ** The 'repetitions' argument of 'benchmark-run' can now also be a variable. + ** The FILENAME argument to 'file-name-base' is now mandatory and no longer defaults to 'buffer-file-name'. @@ -782,9 +784,10 @@ them through 'format' first. Even that is discouraged: for ElDoc support, you should set 'eldoc-documentation-function' instead of calling 'eldoc-message' directly. -** Old-style backquotes now generate an error. They have been -generating warnings for a decade. To interpret old-style backquotes -as new-style, bind the new variable 'force-new-style-backquotes' to t. +** Old-style backquotes now generate an error. +They have been generating warnings for a decade. To interpret +old-style backquotes as new-style, bind the new variable +'force-new-style-backquotes' to t. ** Defining a Common Lisp structure using 'cl-defstruct' or 'cl-struct-define' whose name clashes with a builtin type (e.g., @@ -877,7 +880,7 @@ nonnegative value of the new variable 'integer-width' specifies the maximum number of bits allowed in a bignum. Emacs signals an integer overflow error if this limit is exceeded. -** define-minor-mode automatically documents the meaning of ARG +** define-minor-mode automatically documents the meaning of ARG. +++ ** The function 'recenter' now accepts an additional optional argument. commit 1a350d771a2bc905f4b8da032a4afb0c1d006c6b Author: Eli Zaretskii Date: Tue Aug 21 18:58:15 2018 +0300 ; * etc/NEWS: Fix format of first lines of some entries. diff --git a/etc/NEWS b/etc/NEWS index e563473661..ffea247dd5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -19,7 +19,7 @@ with a prefix argument or by typing C-u C-h C-n. * Installation Changes in Emacs 26.2 --- -** Building Emacs with the '--with-xwidgets' option now requires WebKit2 +** Building Emacs with the '--with-xwidgets' option now requires WebKit2. To build Emacs with xwidgets support, you will need to install the webkit2gtk-4.0 package; version 2.12 or later is required. (This change was actually made in Emacs 26.1, but was not called out @@ -151,17 +151,17 @@ now the default in developer builds. As before, use ** When GCC warnings are enabled, '--enable-check-lisp-object-type' is now enabled by default when configuring. -** The Emacs server now has socket-launching support. This allows -socket based activation, where an external process like systemd can -invoke the Emacs server process upon a socket connection event and -hand the socket over to Emacs. Emacs uses this socket to service -emacsclient commands. This new functionality can be disabled with the -configure option '--disable-libsystemd'. +** The Emacs server now has socket-launching support. +This allows socket based activation, where an external process like +systemd can invoke the Emacs server process upon a socket connection +event and hand the socket over to Emacs. Emacs uses this socket to +service emacsclient commands. This new functionality can be disabled +with the configure option '--disable-libsystemd'. -** A systemd user unit file is provided. Use it in the standard way: -'systemctl --user enable emacs'. -(If your Emacs is installed in a non-standard location, you may -need to copy the emacs.service file to eg ~/.config/systemd/user/) +** A systemd user unit file is provided. +Use it in the standard way: 'systemctl --user enable emacs'. (If your +Emacs is installed in a non-standard location, you may need to copy +the emacs.service file to eg ~/.config/systemd/user/) ** New configure option '--disable-build-details' attempts to build an Emacs that is more likely to be reproducible; that is, if you build @@ -172,7 +172,6 @@ following variables nil: 'emacs-build-system', 'emacs-build-time', 'erc-emacs-build-time'. ** Emacs can now be built with support for Little CMS. - If the lcms2 library is installed, Emacs will enable features built on top of that library. The new configure option '--without-lcms2' can be used to build without lcms2 support even if it is installed. Emacs @@ -215,9 +214,9 @@ The effect is similar to that of "toolBar" resource on the tool bar. * Changes in Emacs 26.1 -** Option 'buffer-offer-save' can be set to new value, 'always'. When -set to 'always', the command 'save-some-buffers' will always offer -this buffer for saving. +** Option 'buffer-offer-save' can be set to new value, 'always'. +When set to 'always', the command 'save-some-buffers' will always +offer this buffer for saving. ** Security vulnerability related to Enriched Text mode is removed. @@ -703,7 +702,7 @@ This can be customized via the 'info-menu' category in A new option 'ediff-show-ancestor' and a new toggle 'ediff-toggle-show-ancestor'. -** TeX: Add luatex and xetex as alternatives to pdftex +** TeX: Add luatex and xetex as alternatives to pdftex. ** Electric-Buffer-menu @@ -1107,7 +1106,6 @@ to a format suitable for reverse lookup zone files. ** Ispell *** Enchant is now supported as a spell-checker. - Enchant is a meta-spell-checker that uses providers such as Hunspell to do the actual checking. With it, users can use spell-checkers not directly supported by Emacs, such as Voikko, Hspell and AppleSpell, @@ -1117,8 +1115,7 @@ configure different spelling-checkers for different languages. ** Flymake -*** Flymake has been completely redesigned - +*** Flymake has been completely redesigned. Flymake now annotates arbitrary buffer regions, not just lines. It supports arbitrary diagnostic types, not just errors and warnings (see variable 'flymake-diagnostic-types-alist'). @@ -1134,7 +1131,6 @@ backend", which has been updated to benefit from the new UI features. ** Term *** 'term-char-mode' now makes its buffer read-only. - The buffer is made read-only to prevent changes from being made by anything other than the process filter; and movements of point away from the process mark are counter-acted so that the cursor is in the @@ -1150,7 +1146,6 @@ the previous behavior. ** Xref *** When an *xref* buffer is needed, 'TAB' quits and jumps to an xref. - A new command 'xref-quit-and-goto-xref', bound to 'TAB' in *xref* buffers, quits the window before jumping to the destination. In many situations, the intended window configuration is restored, just as if @@ -1246,11 +1241,11 @@ change FOO, respectively. The exhaustive list of removed variables is: *** Many variables obsoleted in 22.1 referring to face symbols. -** The variable 'text-quoting-style' is now a customizable option. It -controls whether to and how to translate ASCII quotes in messages and -help output. Its possible values and their semantics remain unchanged -from Emacs 25. In particular, when this variable's value is 'grave', -all quotes in formats are output as-is. +** The variable 'text-quoting-style' is now a customizable option. +It controls whether to and how to translate ASCII quotes in messages +and help output. Its possible values and their semantics remain +unchanged from Emacs 25. In particular, when this variable's value is +'grave', all quotes in formats are output as-is. ** Functions like 'check-declare-file' and 'check-declare-directory' now generate less chatter and more-compact diagnostics. The auxiliary @@ -1521,10 +1516,11 @@ to provide region boundaries (for rectangular regions more than one) to an interactively callable function as a single argument instead of two separate arguments 'region-beginning' and 'region-end'. -** 'parse-partial-sexp' state has a new element. Element 10 is -non-nil when the last character scanned might be the first character -of a two character construct, i.e., a comment delimiter or escaped -character. Its value is the syntax of that last character. +** 'parse-partial-sexp' state has a new element. +Element 10 is non-nil when the last character scanned might be the +first character of a two character construct, i.e., a comment +delimiter or escaped character. Its value is the syntax of that last +character. ** 'parse-partial-sexp's state, element 9, has now been confirmed as permanent and documented, and may be used by Lisp programs. Its value @@ -1788,8 +1784,9 @@ the ELisp manual. *** 'select-frame-by-name' now may return a frame on another display if it does not find a suitable one on the current display. -** 'tcl-auto-fill-mode' is now declared obsolete. Its functionality -can be replicated simply by setting 'comment-auto-fill-only-comments'. +** 'tcl-auto-fill-mode' is now declared obsolete. +Its functionality can be replicated simply by setting +'comment-auto-fill-only-comments'. ** New pcase pattern 'rx' to match against an rx-style regular expression. For details, see the doc string of 'rx--pcase-macroexpander'. commit 43b1bf355a8a3ec4c6175b0e76007b8bf3a32eca Author: Eli Zaretskii Date: Tue Aug 21 17:56:47 2018 +0300 Improve documentation of 'integer-width' * etc/NEWS: Minor rewording of the recent addition. * doc/lispref/numbers.texi (Bitwise Operations): Use @dots{} for ellipsis. Improve indexing. diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi index 9c16b1a64c..dd78bce4c9 100644 --- a/doc/lispref/numbers.texi +++ b/doc/lispref/numbers.texi @@ -112,18 +112,18 @@ view the numbers in their binary form. In binary, the decimal integer 5 looks like this: @example -...000101 +@dots{}000101 @end example @noindent -(The @samp{...} stands for a conceptually infinite number of bits that -match the leading bit; here, an infinite number of 0 bits. Later -examples also use this @samp{...} notation.) +(The ellipsis @samp{@dots{}} stands for a conceptually infinite number +of bits that match the leading bit; here, an infinite number of 0 +bits. Later examples also use this @samp{@dots{}} notation.) The integer @minus{}1 looks like this: @example -...111111 +@dots{}111111 @end example @noindent @@ -136,7 +136,7 @@ In binary, the decimal integer 4 is 100. Consequently, @minus{}5 looks like this: @example -...111011 +@dots{}111011 @end example Many of the functions described in this chapter accept markers for @@ -189,15 +189,16 @@ on 64-bit platforms. @cindex bignum range @cindex integer range +@cindex number of bignum bits, limit on @defvar integer-width The value of this variable is a nonnegative integer that is an upper bound on the number of bits in a bignum. Integers outside the fixnum range are limited to absolute values less than 2@sup{@var{n}}, where @var{n} is this variable's value. Attempts to create bignums outside -this range result in integer overflow. Setting this variable to zero -disables creation of bignums; setting it to a large number can cause -Emacs to consume large quantities of memory if a computation creates -huge integers. +this range result in an integer overflow error. Setting this variable +to zero disables creation of bignums; setting it to a large number can +cause Emacs to consume large quantities of memory if a computation +creates huge integers. @end defvar In Emacs Lisp, text characters are represented by integers. Any @@ -871,30 +872,30 @@ equivalent to dividing by two and then rounding toward minus infinity. @group (ash 7 1) @result{} 14 ;; @r{Decimal 7 becomes decimal 14.} -...000111 +@dots{}000111 @result{} -...001110 +@dots{}001110 @end group @group (ash 7 -1) @result{} 3 -...000111 +@dots{}000111 @result{} -...000011 +@dots{}000011 @end group @group (ash -7 1) @result{} -14 -...111001 +@dots{}111001 @result{} -...110010 +@dots{}110010 @end group @group (ash -7 -1) @result{} -4 -...111001 +@dots{}111001 @result{} -...111100 +@dots{}111100 @end group @end example @@ -903,18 +904,18 @@ Here are examples of shifting left or right by two bits: @smallexample @group ; @r{ binary values} -(ash 5 2) ; 5 = @r{...000101} - @result{} 20 ; = @r{...010100} -(ash -5 2) ; -5 = @r{...111011} - @result{} -20 ; = @r{...101100} +(ash 5 2) ; 5 = @r{@dots{}000101} + @result{} 20 ; = @r{@dots{}010100} +(ash -5 2) ; -5 = @r{@dots{}111011} + @result{} -20 ; = @r{@dots{}101100} @end group @group (ash 5 -2) - @result{} 1 ; = @r{...000001} + @result{} 1 ; = @r{@dots{}000001} @end group @group (ash -5 -2) - @result{} -2 ; = @r{...111110} + @result{} -2 ; = @r{@dots{}111110} @end group @end smallexample @end defun @@ -938,16 +939,16 @@ exceptional cases. These examples assume 30-bit fixnums. @smallexample @group ; @r{ binary values} -(ash -7 -1) ; -7 = @r{...111111111111111111111111111001} - @result{} -4 ; = @r{...111111111111111111111111111100} +(ash -7 -1) ; -7 = @r{@dots{}111111111111111111111111111001} + @result{} -4 ; = @r{@dots{}111111111111111111111111111100} (lsh -7 -1) - @result{} 536870908 ; = @r{...011111111111111111111111111100} + @result{} 536870908 ; = @r{@dots{}011111111111111111111111111100} @end group @group -(ash -5 -2) ; -5 = @r{...111111111111111111111111111011} - @result{} -2 ; = @r{...111111111111111111111111111110} +(ash -5 -2) ; -5 = @r{@dots{}111111111111111111111111111011} + @result{} -2 ; = @r{@dots{}111111111111111111111111111110} (lsh -5 -2) - @result{} 268435454 ; = @r{...001111111111111111111111111110} + @result{} 268435454 ; = @r{@dots{}001111111111111111111111111110} @end group @end smallexample @end defun @@ -983,21 +984,21 @@ because its binary representation consists entirely of ones. If @group ; @r{ binary values} -(logand 14 13) ; 14 = @r{...001110} - ; 13 = @r{...001101} - @result{} 12 ; 12 = @r{...001100} +(logand 14 13) ; 14 = @r{@dots{}001110} + ; 13 = @r{@dots{}001101} + @result{} 12 ; 12 = @r{@dots{}001100} @end group @group -(logand 14 13 4) ; 14 = @r{...001110} - ; 13 = @r{...001101} - ; 4 = @r{...000100} - @result{} 4 ; 4 = @r{...000100} +(logand 14 13 4) ; 14 = @r{@dots{}001110} + ; 13 = @r{@dots{}001101} + ; 4 = @r{@dots{}000100} + @result{} 4 ; 4 = @r{@dots{}000100} @end group @group (logand) - @result{} -1 ; -1 = @r{...111111} + @result{} -1 ; -1 = @r{@dots{}111111} @end group @end smallexample @end defun @@ -1013,16 +1014,16 @@ passed just one argument, it returns that argument. @group ; @r{ binary values} -(logior 12 5) ; 12 = @r{...001100} - ; 5 = @r{...000101} - @result{} 13 ; 13 = @r{...001101} +(logior 12 5) ; 12 = @r{@dots{}001100} + ; 5 = @r{@dots{}000101} + @result{} 13 ; 13 = @r{@dots{}001101} @end group @group -(logior 12 5 7) ; 12 = @r{...001100} - ; 5 = @r{...000101} - ; 7 = @r{...000111} - @result{} 15 ; 15 = @r{...001111} +(logior 12 5 7) ; 12 = @r{@dots{}001100} + ; 5 = @r{@dots{}000101} + ; 7 = @r{@dots{}000111} + @result{} 15 ; 15 = @r{@dots{}001111} @end group @end smallexample @end defun @@ -1038,16 +1039,16 @@ result is 0, which is an identity element for this operation. If @group ; @r{ binary values} -(logxor 12 5) ; 12 = @r{...001100} - ; 5 = @r{...000101} - @result{} 9 ; 9 = @r{...001001} +(logxor 12 5) ; 12 = @r{@dots{}001100} + ; 5 = @r{@dots{}000101} + @result{} 9 ; 9 = @r{@dots{}001001} @end group @group -(logxor 12 5 7) ; 12 = @r{...001100} - ; 5 = @r{...000101} - ; 7 = @r{...000111} - @result{} 14 ; 14 = @r{...001110} +(logxor 12 5 7) ; 12 = @r{@dots{}001100} + ; 5 = @r{@dots{}000101} + ; 7 = @r{@dots{}000111} + @result{} 14 ; 14 = @r{@dots{}001110} @end group @end smallexample @end defun @@ -1060,9 +1061,9 @@ bit is one in the result if, and only if, the @var{n}th bit is zero in @example (lognot 5) @result{} -6 -;; 5 = @r{...000101} +;; 5 = @r{@dots{}000101} ;; @r{becomes} -;; -6 = @r{...111010} +;; -6 = @r{@dots{}111010} @end example @end defun @@ -1077,9 +1078,9 @@ its two's complement binary representation. The result is always nonnegative. @example -(logcount 43) ; 43 = @r{...000101011} +(logcount 43) ; 43 = @r{@dots{}000101011} @result{} 4 -(logcount -43) ; -43 = @r{...111010101} +(logcount -43) ; -43 = @r{@dots{}111010101} @result{} 3 @end example @end defun diff --git a/etc/NEWS b/etc/NEWS index 9a74164421..892797b2dd 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -871,11 +871,11 @@ bignums. However, note that unlike fixnums, bignums will not compare equal with 'eq', you must use 'eql' instead. (Numerical comparison with '=' works on both, of course.) -+++ -** New variable 'integer-width'. -It is a nonnegative integer specifying the maximum number of bits -allowed in a bignum. Integer overflow occurs if this limit is -exceeded. +Since large bignums consume a lot of memory, Emacs limits the size of +the largest bignum a Lisp program is allowed to create. The +nonnegative value of the new variable 'integer-width' specifies the +maximum number of bits allowed in a bignum. Emacs signals an integer +overflow error if this limit is exceeded. ** define-minor-mode automatically documents the meaning of ARG commit d6a497dd887cdbb35c5b4e2929e83962ba708159 Author: Paul Eggert Date: Tue Aug 21 02:16:50 2018 -0700 Avoid libgmp aborts by imposing limits libgmp calls â€abort’ when given numbers too big for its internal data structures. The numeric limit is large and platform-dependent; with 64-bit GMP 6.1.2 it is around 2**2**37. Work around the problem by refusing to call libgmp functions with arguments that would cause an abort. With luck libgmp will have a better way to do this in the future. Also, introduce a variable integer-width that lets the user control how large bignums can be. This currently defaults to 2**16, i.e., it allows bignums up to 2**2**16. This should be enough for ordinary computation, and should help Emacs to avoid thrashing or hanging. Problem noted by Pip Cet (Bug#32463#71). * doc/lispref/numbers.texi, etc/NEWS: Document recent bignum changes, including this one. Improve documentation for bitwise operations, in the light of bignums. * src/alloc.c (make_number): Enforce integer-width. (integer_overflow): New function. (xrealloc_for_gmp, xfree_for_gmp): Move here from emacs.c, as it's memory allocation. (init_alloc): Initialize GMP here, rather than in emacs.c. (integer_width): New var. * src/data.c (GMP_NLIMBS_MAX, NLIMBS_LIMIT): New constants. (emacs_mpz_size, emacs_mpz_mul) (emacs_mpz_mul_2exp, emacs_mpz_pow_ui): New functions. (arith_driver, Fash, expt_integer): Use them. (expt_integer): New function, containing integer code that was out of place in floatfns.c. (check_bignum_size, xmalloc_for_gmp): Remove. * src/emacs.c (main): Do not initialize GMP here. * src/floatfns.c (Fexpt): Use expt_integer, which now contains integer code moved from here. * src/lisp.h (GMP_NUMB_BITS): Define if gmp.h doesn’t. diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi index 209e9f139a..9c16b1a64c 100644 --- a/doc/lispref/numbers.texi +++ b/doc/lispref/numbers.texi @@ -34,13 +34,21 @@ numbers have a fixed amount of precision. @node Integer Basics @section Integer Basics - Integers in Emacs Lisp can have arbitrary precision. + Integers in Emacs Lisp are not limited to the machine word size. Under the hood, though, there are two kinds of integers: smaller ones, called @dfn{fixnums}, and larger ones, called @dfn{bignums}. -Some functions in Emacs only accept fixnums. Also, while fixnums can -always be compared for equality with @code{eq}, bignums require the -use of @code{eql}. +Some functions in Emacs accept only fixnums. Also, while fixnums can +always be compared for numeric equality with @code{eq}, bignums +require more-heavyweight equality predicates like @code{eql}. + + The range of values for bignums is limited by the amount of main +memory, by machine characteristics such as the size of the word used +to represent a bignum's exponent, and by the @code{integer-width} +variable. These limits are typically much more generous than the +limits for fixnums. A bignum is never numerically equal to a fixnum; +if Emacs computes an integer in fixnum range, it represents the +integer as a fixnum, not a bignum. The range of values for a fixnum depends on the machine. The minimum range is @minus{}536,870,912 to 536,870,911 (30 bits; i.e., @@ -97,33 +105,30 @@ For example: #24r1k @result{} 44 @end example - An integer is read as a fixnum if it is in the correct range. -Otherwise, it will be read as a bignum. - To understand how various functions work on integers, especially the bitwise operators (@pxref{Bitwise Operations}), it is often helpful to view the numbers in their binary form. - In 30-bit binary, the decimal integer 5 looks like this: + In binary, the decimal integer 5 looks like this: @example -0000...000101 (30 bits total) +...000101 @end example @noindent -(The @samp{...} stands for enough bits to fill out a 30-bit word; in -this case, @samp{...} stands for twenty 0 bits. Later examples also -use the @samp{...} notation to make binary integers easier to read.) +(The @samp{...} stands for a conceptually infinite number of bits that +match the leading bit; here, an infinite number of 0 bits. Later +examples also use this @samp{...} notation.) The integer @minus{}1 looks like this: @example -1111...111111 (30 bits total) +...111111 @end example @noindent @cindex two's complement -@minus{}1 is represented as 30 ones. (This is called @dfn{two's +@minus{}1 is represented as all ones. (This is called @dfn{two's complement} notation.) Subtracting 4 from @minus{}1 returns the negative integer @minus{}5. @@ -131,14 +136,7 @@ In binary, the decimal integer 4 is 100. Consequently, @minus{}5 looks like this: @example -1111...111011 (30 bits total) -@end example - - In this implementation, the largest 30-bit binary integer is -536,870,911 in decimal. In binary, it looks like this: - -@example -0111...111111 (30 bits total) +...111011 @end example Many of the functions described in this chapter accept markers for @@ -147,10 +145,10 @@ arguments to such functions may be either numbers or markers, we often give these arguments the name @var{number-or-marker}. When the argument value is a marker, its position value is used and its buffer is ignored. -@cindex largest Lisp integer -@cindex maximum Lisp integer +@cindex largest fixnum +@cindex maximum fixnum @defvar most-positive-fixnum -The value of this variable is the largest ``small'' integer that Emacs +The value of this variable is the greatest ``small'' integer that Emacs Lisp can handle. Typical values are @ifnottex 2**29 @minus{} 1 @@ -168,11 +166,11 @@ on 32-bit and on 64-bit platforms. @end defvar -@cindex smallest Lisp integer -@cindex minimum Lisp integer +@cindex smallest fixnum +@cindex minimum fixnum @defvar most-negative-fixnum -The value of this variable is the smallest small integer that Emacs -Lisp can handle. It is negative. Typical values are +The value of this variable is the numerically least ``small'' integer +that Emacs Lisp can handle. It is negative. Typical values are @ifnottex @minus{}2**29 @end ifnottex @@ -187,6 +185,19 @@ on 32-bit and @math{-2^{61}} @end tex on 64-bit platforms. +@end defvar + +@cindex bignum range +@cindex integer range +@defvar integer-width +The value of this variable is a nonnegative integer that is an upper +bound on the number of bits in a bignum. Integers outside the fixnum +range are limited to absolute values less than 2@sup{@var{n}}, where +@var{n} is this variable's value. Attempts to create bignums outside +this range result in integer overflow. Setting this variable to zero +disables creation of bignums; setting it to a large number can cause +Emacs to consume large quantities of memory if a computation creates +huge integers. @end defvar In Emacs Lisp, text characters are represented by integers. Any @@ -378,17 +389,17 @@ comparison, and sometimes returns @code{t} when a non-numeric comparison would return @code{nil} and vice versa. @xref{Float Basics}. - In Emacs Lisp, each small integer is a unique Lisp object. -Therefore, @code{eq} is equivalent to @code{=} where small integers are -concerned. It is sometimes convenient to use @code{eq} for comparing -an unknown value with an integer, because @code{eq} does not report an + In Emacs Lisp, if two fixnums are numerically equal, they are the +same Lisp object. That is, @code{eq} is equivalent to @code{=} on +fixnums. It is sometimes convenient to use @code{eq} for comparing +an unknown value with a fixnum, because @code{eq} does not report an error if the unknown value is not a number---it accepts arguments of any type. By contrast, @code{=} signals an error if the arguments are not numbers or markers. However, it is better programming practice to use @code{=} if you can, even for comparing integers. - Sometimes it is useful to compare numbers with @code{equal}, which -treats two numbers as equal if they have the same data type (both + Sometimes it is useful to compare numbers with @code{eql} or @code{equal}, +which treat two numbers as equal if they have the same data type (both integers, or both floating point) and the same value. By contrast, @code{=} can treat an integer and a floating-point number as equal. @xref{Equality Predicates}. @@ -830,142 +841,113 @@ Rounding a value equidistant between two integers returns the even integer. @cindex logical arithmetic In a computer, an integer is represented as a binary number, a -sequence of @dfn{bits} (digits which are either zero or one). A bitwise +sequence of @dfn{bits} (digits which are either zero or one). +Conceptually the bit sequence is infinite on the left, with the +most-significant bits being all zeros or all ones. A bitwise operation acts on the individual bits of such a sequence. For example, @dfn{shifting} moves the whole sequence left or right one or more places, reproducing the same pattern moved over. The bitwise operations in Emacs Lisp apply only to integers. -@defun lsh integer1 count -@cindex logical shift -@code{lsh}, which is an abbreviation for @dfn{logical shift}, shifts the -bits in @var{integer1} to the left @var{count} places, or to the right -if @var{count} is negative, bringing zeros into the vacated bits. If -@var{count} is negative, @code{lsh} shifts zeros into the leftmost -(most-significant) bit, producing a nonnegative result even if -@var{integer1} is negative fixnum. (If @var{integer1} is a negative -bignum, @var{count} must be nonnegative.) Contrast this with -@code{ash}, below. - -Here are two examples of @code{lsh}, shifting a pattern of bits one -place to the left. We show only the low-order eight bits of the binary -pattern; the rest are all zero. +@defun ash integer1 count +@cindex arithmetic shift +@code{ash} (@dfn{arithmetic shift}) shifts the bits in @var{integer1} +to the left @var{count} places, or to the right if @var{count} is +negative. Left shifts introduce zero bits on the right; right shifts +discard the rightmost bits. Considered as an integer operation, +@code{ash} multiplies @var{integer1} by 2@sup{@var{count}} and then +converts the result to an integer by rounding downward, toward +minus infinity. + +Here are examples of @code{ash}, shifting a pattern of bits one place +to the left and to the right. These examples show only the low-order +bits of the binary pattern; leading bits all agree with the +highest-order bit shown. As you can see, shifting left by one is +equivalent to multiplying by two, whereas shifting right by one is +equivalent to dividing by two and then rounding toward minus infinity. @example @group -(lsh 5 1) - @result{} 10 -;; @r{Decimal 5 becomes decimal 10.} -00000101 @result{} 00001010 - -(lsh 7 1) - @result{} 14 +(ash 7 1) @result{} 14 ;; @r{Decimal 7 becomes decimal 14.} -00000111 @result{} 00001110 -@end group -@end example - -@noindent -As the examples illustrate, shifting the pattern of bits one place to -the left produces a number that is twice the value of the previous -number. - -Shifting a pattern of bits two places to the left produces results -like this (with 8-bit binary numbers): - -@example -@group -(lsh 3 2) - @result{} 12 -;; @r{Decimal 3 becomes decimal 12.} -00000011 @result{} 00001100 +...000111 + @result{} +...001110 @end group -@end example - -On the other hand, shifting one place to the right looks like this: -@example @group -(lsh 6 -1) - @result{} 3 -;; @r{Decimal 6 becomes decimal 3.} -00000110 @result{} 00000011 +(ash 7 -1) @result{} 3 +...000111 + @result{} +...000011 @end group @group -(lsh 5 -1) - @result{} 2 -;; @r{Decimal 5 becomes decimal 2.} -00000101 @result{} 00000010 +(ash -7 1) @result{} -14 +...111001 + @result{} +...110010 @end group -@end example - -@noindent -As the example illustrates, shifting one place to the right divides the -value of a positive integer by two, rounding downward. -@end defun - -@defun ash integer1 count -@cindex arithmetic shift -@code{ash} (@dfn{arithmetic shift}) shifts the bits in @var{integer1} -to the left @var{count} places, or to the right if @var{count} -is negative. - -@code{ash} gives the same results as @code{lsh} except when -@var{integer1} and @var{count} are both negative. In that case, -@code{ash} puts ones in the empty bit positions on the left, while -@code{lsh} puts zeros in those bit positions and requires -@var{integer1} to be a fixnum. -Thus, with @code{ash}, shifting the pattern of bits one place to the right -looks like this: - -@example @group -(ash -6 -1) @result{} -3 -;; @r{Decimal @minus{}6 becomes decimal @minus{}3.} -1111...111010 (30 bits total) +(ash -7 -1) @result{} -4 +...111001 @result{} -1111...111101 (30 bits total) +...111100 @end group @end example -Here are other examples: +Here are examples of shifting left or right by two bits: -@c !!! Check if lined up in smallbook format! XDVI shows problem -@c with smallbook but not with regular book! --rjc 16mar92 @smallexample @group - ; @r{ 30-bit binary values} - -(lsh 5 2) ; 5 = @r{0000...000101} - @result{} 20 ; = @r{0000...010100} -@end group -@group -(ash 5 2) - @result{} 20 -(lsh -5 2) ; -5 = @r{1111...111011} - @result{} -20 ; = @r{1111...101100} -(ash -5 2) - @result{} -20 + ; @r{ binary values} +(ash 5 2) ; 5 = @r{...000101} + @result{} 20 ; = @r{...010100} +(ash -5 2) ; -5 = @r{...111011} + @result{} -20 ; = @r{...101100} @end group @group -(lsh 5 -2) ; 5 = @r{0000...000101} - @result{} 1 ; = @r{0000...000001} +(ash 5 -2) + @result{} 1 ; = @r{...000001} @end group @group -(ash 5 -2) - @result{} 1 +(ash -5 -2) + @result{} -2 ; = @r{...111110} @end group +@end smallexample +@end defun + +@defun lsh integer1 count +@cindex logical shift +@code{lsh}, which is an abbreviation for @dfn{logical shift}, shifts the +bits in @var{integer1} to the left @var{count} places, or to the right +if @var{count} is negative, bringing zeros into the vacated bits. If +@var{count} is negative, then @var{integer1} must be either a fixnum +or a positive bignum, and @code{lsh} treats a negative fixnum as if it +were unsigned by subtracting twice @code{most-negative-fixnum} before +shifting, producing a nonnegative result. This quirky behavior dates +back to when Emacs supported only fixnums; nowadays @code{ash} is a +better choice. + +As @code{lsh} behaves like @code{ash} except when @var{integer1} and +@var{count1} are both negative, the following examples focus on these +exceptional cases. These examples assume 30-bit fixnums. + +@smallexample @group -(lsh -5 -2) ; -5 = @r{1111...111011} - @result{} 268435454 - ; = @r{0011...111110} + ; @r{ binary values} +(ash -7 -1) ; -7 = @r{...111111111111111111111111111001} + @result{} -4 ; = @r{...111111111111111111111111111100} +(lsh -7 -1) + @result{} 536870908 ; = @r{...011111111111111111111111111100} @end group @group -(ash -5 -2) ; -5 = @r{1111...111011} - @result{} -2 ; = @r{1111...111110} +(ash -5 -2) ; -5 = @r{...111111111111111111111111111011} + @result{} -2 ; = @r{...111111111111111111111111111110} +(lsh -5 -2) + @result{} 268435454 ; = @r{...001111111111111111111111111110} @end group @end smallexample @end defun @@ -999,23 +981,23 @@ because its binary representation consists entirely of ones. If @smallexample @group - ; @r{ 30-bit binary values} + ; @r{ binary values} -(logand 14 13) ; 14 = @r{0000...001110} - ; 13 = @r{0000...001101} - @result{} 12 ; 12 = @r{0000...001100} +(logand 14 13) ; 14 = @r{...001110} + ; 13 = @r{...001101} + @result{} 12 ; 12 = @r{...001100} @end group @group -(logand 14 13 4) ; 14 = @r{0000...001110} - ; 13 = @r{0000...001101} - ; 4 = @r{0000...000100} - @result{} 4 ; 4 = @r{0000...000100} +(logand 14 13 4) ; 14 = @r{...001110} + ; 13 = @r{...001101} + ; 4 = @r{...000100} + @result{} 4 ; 4 = @r{...000100} @end group @group (logand) - @result{} -1 ; -1 = @r{1111...111111} + @result{} -1 ; -1 = @r{...111111} @end group @end smallexample @end defun @@ -1029,18 +1011,18 @@ passed just one argument, it returns that argument. @smallexample @group - ; @r{ 30-bit binary values} + ; @r{ binary values} -(logior 12 5) ; 12 = @r{0000...001100} - ; 5 = @r{0000...000101} - @result{} 13 ; 13 = @r{0000...001101} +(logior 12 5) ; 12 = @r{...001100} + ; 5 = @r{...000101} + @result{} 13 ; 13 = @r{...001101} @end group @group -(logior 12 5 7) ; 12 = @r{0000...001100} - ; 5 = @r{0000...000101} - ; 7 = @r{0000...000111} - @result{} 15 ; 15 = @r{0000...001111} +(logior 12 5 7) ; 12 = @r{...001100} + ; 5 = @r{...000101} + ; 7 = @r{...000111} + @result{} 15 ; 15 = @r{...001111} @end group @end smallexample @end defun @@ -1054,18 +1036,18 @@ result is 0, which is an identity element for this operation. If @smallexample @group - ; @r{ 30-bit binary values} + ; @r{ binary values} -(logxor 12 5) ; 12 = @r{0000...001100} - ; 5 = @r{0000...000101} - @result{} 9 ; 9 = @r{0000...001001} +(logxor 12 5) ; 12 = @r{...001100} + ; 5 = @r{...000101} + @result{} 9 ; 9 = @r{...001001} @end group @group -(logxor 12 5 7) ; 12 = @r{0000...001100} - ; 5 = @r{0000...000101} - ; 7 = @r{0000...000111} - @result{} 14 ; 14 = @r{0000...001110} +(logxor 12 5 7) ; 12 = @r{...001100} + ; 5 = @r{...000101} + ; 7 = @r{...000111} + @result{} 14 ; 14 = @r{...001110} @end group @end smallexample @end defun @@ -1078,9 +1060,9 @@ bit is one in the result if, and only if, the @var{n}th bit is zero in @example (lognot 5) @result{} -6 -;; 5 = @r{0000...000101} (30 bits total) +;; 5 = @r{...000101} ;; @r{becomes} -;; -6 = @r{1111...111010} (30 bits total) +;; -6 = @r{...111010} @end example @end defun @@ -1095,9 +1077,9 @@ its two's complement binary representation. The result is always nonnegative. @example -(logcount 43) ; 43 = #b101011 +(logcount 43) ; 43 = @r{...000101011} @result{} 4 -(logcount -43) ; -43 = #b111...1010101 +(logcount -43) ; -43 = @r{...111010101} @result{} 3 @end example @end defun diff --git a/etc/NEWS b/etc/NEWS index a9f8ed2ef8..9a74164421 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -871,6 +871,12 @@ bignums. However, note that unlike fixnums, bignums will not compare equal with 'eq', you must use 'eql' instead. (Numerical comparison with '=' works on both, of course.) ++++ +** New variable 'integer-width'. +It is a nonnegative integer specifying the maximum number of bits +allowed in a bignum. Integer overflow occurs if this limit is +exceeded. + ** define-minor-mode automatically documents the meaning of ARG +++ diff --git a/src/alloc.c b/src/alloc.c index ddc0696ba9..24a24aab96 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3746,33 +3746,33 @@ make_bignum_str (const char *num, int base) Lisp_Object make_number (mpz_t value) { - if (mpz_fits_slong_p (value)) - { - long l = mpz_get_si (value); - if (!FIXNUM_OVERFLOW_P (l)) - return make_fixnum (l); - } - else if (LONG_WIDTH < FIXNUM_BITS) + size_t bits = mpz_sizeinbase (value, 2); + + if (bits <= FIXNUM_BITS) { - size_t bits = mpz_sizeinbase (value, 2); + EMACS_INT v = 0; + int i = 0, shift = 0; - if (bits <= FIXNUM_BITS) - { - EMACS_INT v = 0; - int i = 0; - for (int shift = 0; shift < bits; shift += mp_bits_per_limb) - { - EMACS_INT limb = mpz_getlimbn (value, i++); - v += limb << shift; - } - if (mpz_sgn (value) < 0) - v = -v; + do + { + EMACS_INT limb = mpz_getlimbn (value, i++); + v += limb << shift; + shift += GMP_NUMB_BITS; + } + while (shift < bits); - if (!FIXNUM_OVERFLOW_P (v)) - return make_fixnum (v); - } + if (mpz_sgn (value) < 0) + v = -v; + + if (!FIXNUM_OVERFLOW_P (v)) + return make_fixnum (v); } + /* The documentation says integer-width should be nonnegative, so + a single comparison suffices even though 'bits' is unsigned. */ + if (integer_width < bits) + integer_overflow (); + struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value, PVEC_BIGNUM); /* We could mpz_init + mpz_swap here, to avoid a copy, but the @@ -7200,6 +7200,26 @@ verify_alloca (void) #endif /* ENABLE_CHECKING && USE_STACK_LISP_OBJECTS */ +/* Memory allocation for GMP. */ + +void +integer_overflow (void) +{ + error ("Integer too large to be represented"); +} + +static void * +xrealloc_for_gmp (void *ptr, size_t ignore, size_t size) +{ + return xrealloc (ptr, size); +} + +static void +xfree_for_gmp (void *ptr, size_t ignore) +{ + xfree (ptr); +} + /* Initialization. */ void @@ -7233,6 +7253,10 @@ init_alloc_once (void) void init_alloc (void) { + eassert (mp_bits_per_limb == GMP_NUMB_BITS); + integer_width = 1 << 16; + mp_set_memory_functions (xmalloc, xrealloc_for_gmp, xfree_for_gmp); + Vgc_elapsed = make_float (0.0); gcs_done = 0; @@ -7335,6 +7359,11 @@ The time is in seconds as a floating point value. */); DEFVAR_INT ("gcs-done", gcs_done, doc: /* Accumulated number of garbage collections done. */); + DEFVAR_INT ("integer-width", integer_width, + doc: /* Maximum number of bits in bignums. +Integers outside the fixnum range are limited to absolute values less +than 2**N, where N is this variable's value. N should be nonnegative. */); + defsubr (&Scons); defsubr (&Slist); defsubr (&Svector); diff --git a/src/data.c b/src/data.c index 8a6975da3a..4c6d33f294 100644 --- a/src/data.c +++ b/src/data.c @@ -2384,6 +2384,80 @@ bool-vector. IDX starts at 0. */) return newelt; } +/* GMP tests for this value and aborts (!) if it is exceeded. + This is as of GMP 6.1.2 (2016); perhaps future versions will differ. */ +enum { GMP_NLIMBS_MAX = min (INT_MAX, ULONG_MAX / GMP_NUMB_BITS) }; + +/* An upper bound on limb counts, needed to prevent libgmp and/or + Emacs from aborting or otherwise misbehaving. This bound applies + to estimates of mpz_t sizes before the mpz_t objects are created, + as opposed to integer-width which operates on mpz_t values after + creation and before conversion to Lisp bignums. */ +enum + { + NLIMBS_LIMIT = min (min (/* libgmp needs to store limb counts. */ + GMP_NLIMBS_MAX, + + /* Size calculations need to work. */ + min (PTRDIFF_MAX, SIZE_MAX) / sizeof (mp_limb_t)), + + /* Emacs puts bit counts into fixnums. */ + MOST_POSITIVE_FIXNUM / GMP_NUMB_BITS) + }; + +/* Like mpz_size, but tell the compiler the result is a nonnegative int. */ + +static int +emacs_mpz_size (mpz_t const op) +{ + mp_size_t size = mpz_size (op); + eassume (0 <= size && size <= INT_MAX); + return size; +} + +/* Wrappers to work around GMP limitations. As of GMP 6.1.2 (2016), + the library code aborts when a number is too large. These wrappers + avoid the problem for functions that can return numbers much larger + than their arguments. For slowly-growing numbers, the integer + width check in make_number should suffice. */ + +static void +emacs_mpz_mul (mpz_t rop, mpz_t const op1, mpz_t const op2) +{ + if (NLIMBS_LIMIT - emacs_mpz_size (op1) < emacs_mpz_size (op2)) + integer_overflow (); + mpz_mul (rop, op1, op2); +} + +static void +emacs_mpz_mul_2exp (mpz_t rop, mpz_t const op1, mp_bitcnt_t op2) +{ + /* Fudge factor derived from GMP 6.1.2, to avoid an abort in + mpz_mul_2exp (look for the '+ 1' in its source code). */ + enum { mul_2exp_extra_limbs = 1 }; + enum { lim = min (NLIMBS_LIMIT, GMP_NLIMBS_MAX - mul_2exp_extra_limbs) }; + + mp_bitcnt_t op2limbs = op2 / GMP_NUMB_BITS; + if (lim - emacs_mpz_size (op1) < op2limbs) + integer_overflow (); + mpz_mul_2exp (rop, op1, op2); +} + +static void +emacs_mpz_pow_ui (mpz_t rop, mpz_t const base, unsigned long exp) +{ + /* This fudge factor is derived from GMP 6.1.2, to avoid an abort in + mpz_n_pow_ui (look for the '5' in its source code). */ + enum { pow_ui_extra_limbs = 5 }; + enum { lim = min (NLIMBS_LIMIT, GMP_NLIMBS_MAX - pow_ui_extra_limbs) }; + + int nbase = emacs_mpz_size (base), n; + if (INT_MULTIPLY_WRAPV (nbase, exp, &n) || lim < n) + integer_overflow (); + mpz_pow_ui (rop, base, exp); +} + + /* Arithmetic functions */ Lisp_Object @@ -2872,13 +2946,13 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) break; case Amult: if (BIGNUMP (val)) - mpz_mul (accum, accum, XBIGNUM (val)->value); + emacs_mpz_mul (accum, accum, XBIGNUM (val)->value); else if (! FIXNUMS_FIT_IN_LONG) { mpz_t tem; mpz_init (tem); mpz_set_intmax (tem, XFIXNUM (val)); - mpz_mul (accum, accum, tem); + emacs_mpz_mul (accum, accum, tem); mpz_clear (tem); } else @@ -3293,7 +3367,7 @@ In this case, the sign bit is duplicated. */) mpz_t result; mpz_init (result); if (XFIXNUM (count) > 0) - mpz_mul_2exp (result, XBIGNUM (value)->value, XFIXNUM (count)); + emacs_mpz_mul_2exp (result, XBIGNUM (value)->value, XFIXNUM (count)); else mpz_fdiv_q_2exp (result, XBIGNUM (value)->value, - XFIXNUM (count)); val = make_number (result); @@ -3319,7 +3393,7 @@ In this case, the sign bit is duplicated. */) mpz_set_intmax (result, XFIXNUM (value)); if (XFIXNUM (count) >= 0) - mpz_mul_2exp (result, result, XFIXNUM (count)); + emacs_mpz_mul_2exp (result, result, XFIXNUM (count)); else mpz_fdiv_q_2exp (result, result, - XFIXNUM (count)); @@ -3330,6 +3404,33 @@ In this case, the sign bit is duplicated. */) return val; } +/* Return X ** Y as an integer. X and Y must be integers, and Y must + be nonnegative. */ + +Lisp_Object +expt_integer (Lisp_Object x, Lisp_Object y) +{ + unsigned long exp; + if (TYPE_RANGED_FIXNUMP (unsigned long, y)) + exp = XFIXNUM (y); + else if (MOST_POSITIVE_FIXNUM < ULONG_MAX && BIGNUMP (y) + && mpz_fits_ulong_p (XBIGNUM (y)->value)) + exp = mpz_get_ui (XBIGNUM (y)->value); + else + integer_overflow (); + + mpz_t val; + mpz_init (val); + emacs_mpz_pow_ui (val, + (FIXNUMP (x) + ? (mpz_set_intmax (val, XFIXNUM (x)), val) + : XBIGNUM (x)->value), + exp); + Lisp_Object res = make_number (val); + mpz_clear (val); + return res; +} + DEFUN ("1+", Fadd1, Sadd1, 1, 1, 0, doc: /* Return NUMBER plus one. NUMBER may be a number or a marker. Markers are converted to integers. */) diff --git a/src/emacs.c b/src/emacs.c index 11ee0b8118..7d07ec8502 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -673,38 +673,6 @@ close_output_streams (void) _exit (EXIT_FAILURE); } -/* Memory allocation functions for GMP. */ - -static void -check_bignum_size (size_t size) -{ - /* Do not create a bignum whose log base 2 could exceed fixnum range. - This way, functions like mpz_popcount return values in fixnum range. - It may also help to avoid other problems with outlandish bignums. */ - if (MOST_POSITIVE_FIXNUM / CHAR_BIT < size) - error ("Integer too large to be represented"); -} - -static void * ATTRIBUTE_MALLOC -xmalloc_for_gmp (size_t size) -{ - check_bignum_size (size); - return xmalloc (size); -} - -static void * -xrealloc_for_gmp (void *ptr, size_t ignore, size_t size) -{ - check_bignum_size (size); - return xrealloc (ptr, size); -} - -static void -xfree_for_gmp (void *ptr, size_t ignore) -{ - xfree (ptr); -} - /* ARGSUSED */ int main (int argc, char **argv) @@ -803,8 +771,6 @@ main (int argc, char **argv) init_standard_fds (); atexit (close_output_streams); - mp_set_memory_functions (xmalloc_for_gmp, xrealloc_for_gmp, xfree_for_gmp); - sort_args (argc, argv); argc = 0; while (argv[argc]) argc++; diff --git a/src/floatfns.c b/src/floatfns.c index 7c52a0a9a2..ea9000b90a 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -210,29 +210,7 @@ DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, /* Common Lisp spec: don't promote if both are integers, and if the result is not fractional. */ if (INTEGERP (arg1) && NATNUMP (arg2)) - { - unsigned long exp; - if (TYPE_RANGED_FIXNUMP (unsigned long, arg2)) - exp = XFIXNUM (arg2); - else if (MOST_POSITIVE_FIXNUM < ULONG_MAX && BIGNUMP (arg2) - && mpz_fits_ulong_p (XBIGNUM (arg2)->value)) - exp = mpz_get_ui (XBIGNUM (arg2)->value); - else - xsignal3 (Qrange_error, build_string ("expt"), arg1, arg2); - - mpz_t val; - mpz_init (val); - if (FIXNUMP (arg1)) - { - mpz_set_intmax (val, XFIXNUM (arg1)); - mpz_pow_ui (val, val, exp); - } - else - mpz_pow_ui (val, XBIGNUM (arg1)->value, exp); - Lisp_Object res = make_number (val); - mpz_clear (val); - return res; - } + return expt_integer (arg1, arg2); return make_float (pow (XFLOATINT (arg1), XFLOATINT (arg2))); } diff --git a/src/lisp.h b/src/lisp.h index fe384d1844..8f48a33484 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -996,6 +996,14 @@ enum More_Lisp_Bits #define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS) #define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM) + +/* GMP-related limits. */ + +/* Number of data bits in a limb. */ +#ifndef GMP_NUMB_BITS +enum { GMP_NUMB_BITS = TYPE_WIDTH (mp_limb_t) }; +#endif + #if USE_LSB_TAG INLINE Lisp_Object @@ -3338,7 +3346,7 @@ extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object, enum Set_Internal_Bind); extern void set_default_internal (Lisp_Object, Lisp_Object, enum Set_Internal_Bind bindflag); - +extern Lisp_Object expt_integer (Lisp_Object, Lisp_Object); extern void syms_of_data (void); extern void swap_in_global_binding (struct Lisp_Symbol *); @@ -3700,6 +3708,7 @@ extern void display_malloc_warning (void); extern ptrdiff_t inhibit_garbage_collection (void); extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object); extern void free_cons (struct Lisp_Cons *); +extern _Noreturn void integer_overflow (void); extern void init_alloc_once (void); extern void init_alloc (void); extern void syms_of_alloc (void); commit 77fc2725985b4e5ef977ae6930835c7f0771c61c Author: Paul Eggert Date: Tue Aug 21 02:05:07 2018 -0700 Fix glitches introduced by nthcdr changes * src/fns.c (Fnthcdr): Fix recently-introduced bug when nthcdr is supposed to yield a non-nil non-cons. Reported by Glenn Morris and by Pip Cet here: https://lists.gnu.org/r/emacs-devel/2018-08/msg00699.html https://lists.gnu.org/r/emacs-devel/2018-08/msg00708.html Speed up nthcdr for small N, as suggested by Pip Cet here: https://lists.gnu.org/r/emacs-devel/2018-08/msg00707.html * test/src/fns-tests.el (test-nthcdr-simple): New test. diff --git a/src/fns.c b/src/fns.c index 8cff6b1b6c..9d681017c1 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1402,6 +1402,8 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0, doc: /* Take cdr N times on LIST, return the result. */) (Lisp_Object n, Lisp_Object list) { + Lisp_Object tail = list; + CHECK_INTEGER (n); /* A huge but in-range EMACS_INT that can be substituted for a @@ -1412,24 +1414,41 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0, EMACS_INT num; if (FIXNUMP (n)) - num = XFIXNUM (n); + { + num = XFIXNUM (n); + + /* Speed up small lists by omitting circularity and quit checking. */ + if (num < 128) + { + for (; 0 < num; num--, tail = XCDR (tail)) + if (! CONSP (tail)) + { + CHECK_LIST_END (tail, list); + return Qnil; + } + return tail; + } + } else { - num = mpz_sgn (XBIGNUM (n)->value); - if (0 < num) - num = large_num; + if (mpz_sgn (XBIGNUM (n)->value) < 0) + return tail; + num = large_num; } EMACS_INT tortoise_num = num; - Lisp_Object tail = list, saved_tail = tail; + Lisp_Object saved_tail = tail; FOR_EACH_TAIL_SAFE (tail) { - if (num <= 0) - return tail; - if (tail == li.tortoise) + /* If the tortoise just jumped (which is rare), + update TORTOISE_NUM accordingly. */ + if (EQ (tail, li.tortoise)) tortoise_num = num; + saved_tail = XCDR (tail); num--; + if (num == 0) + return saved_tail; rarely_quit (num); } diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index 92dc18fa03..b180f30f28 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -624,6 +624,11 @@ (should (eq (gethash b2 hash) (funcall test b1 b2))))))) +(ert-deftest test-nthcdr-simple () + (should (eq (nthcdr 0 'x) 'x)) + (should (eq (nthcdr 1 '(x . y)) 'y)) + (should (eq (nthcdr 2 '(x y . z)) 'z))) + (ert-deftest test-nthcdr-circular () (dolist (len '(1 2 5 37 120 997 1024)) (let ((cycle (make-list len nil))) commit eb83344fc7c08ec08b51e7700f1ac2632afa462c Author: Paul Eggert Date: Mon Aug 20 15:52:29 2018 -0700 Speed up (nthcdr N L) when L is circular Also, fix bug when N is a positive bignum, a problem reported by Eli Zaretskii and Pip Cet in: https://lists.gnu.org/r/emacs-devel/2018-08/msg00690.html * src/fns.c (Fnthcdr): If a cycle is found, reduce the count modulo the cycle length before continuing. This reduces the worst-case cost of (nthcdr N L) from N to min(N, C) where C is the number of distinct cdrs of L. Reducing modulo the cycle length also allows us to do arithmetic with machine words instead of with GMP. * test/src/fns-tests.el (test-nthcdr-circular): New test. diff --git a/src/fns.c b/src/fns.c index aeb9308d22..8cff6b1b6c 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1403,7 +1403,12 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0, (Lisp_Object n, Lisp_Object list) { CHECK_INTEGER (n); - Lisp_Object tail = list; + + /* A huge but in-range EMACS_INT that can be substituted for a + positive bignum while counting down. It does not introduce + miscounts because a list or cycle cannot possibly be this long, + and any counting error is fixed up later. */ + EMACS_INT large_num = EMACS_INT_MAX; EMACS_INT num; if (FIXNUMP (n)) @@ -1412,16 +1417,57 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0, { num = mpz_sgn (XBIGNUM (n)->value); if (0 < num) - num = EMACS_INT_MAX; /* LIST cannot possibly be this long. */ + num = large_num; } - for (; 0 < num; num--) + EMACS_INT tortoise_num = num; + Lisp_Object tail = list, saved_tail = tail; + FOR_EACH_TAIL_SAFE (tail) { - if (! CONSP (tail)) + if (num <= 0) + return tail; + if (tail == li.tortoise) + tortoise_num = num; + saved_tail = XCDR (tail); + num--; + rarely_quit (num); + } + + tail = saved_tail; + if (! CONSP (tail)) + { + CHECK_LIST_END (tail, list); + return Qnil; + } + + /* TAIL is part of a cycle. Reduce NUM modulo the cycle length to + avoid going around this cycle repeatedly. */ + intptr_t cycle_length = tortoise_num - num; + if (! FIXNUMP (n)) + { + /* Undo any error introduced when LARGE_NUM was substituted for + N, by adding N - LARGE_NUM to NUM, using arithmetic modulo + CYCLE_LENGTH. */ + mpz_t z; /* N mod CYCLE_LENGTH. */ + mpz_init (z); + if (cycle_length <= ULONG_MAX) + num += mpz_mod_ui (z, XBIGNUM (n)->value, cycle_length); + else { - CHECK_LIST_END (tail, list); - return Qnil; + mpz_set_intmax (z, cycle_length); + mpz_mod (z, XBIGNUM (n)->value, z); + intptr_t iz; + mpz_export (&iz, NULL, -1, sizeof iz, 0, 0, z); + num += iz; } + mpz_clear (z); + num += cycle_length - large_num % cycle_length; + } + num %= cycle_length; + + /* One last time through the cycle. */ + for (; 0 < num; num--) + { tail = XCDR (tail); rarely_quit (num); } diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index f722ed6333..92dc18fa03 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -624,4 +624,20 @@ (should (eq (gethash b2 hash) (funcall test b1 b2))))))) +(ert-deftest test-nthcdr-circular () + (dolist (len '(1 2 5 37 120 997 1024)) + (let ((cycle (make-list len nil))) + (setcdr (last cycle) cycle) + (dolist (n (list (1- most-negative-fixnum) most-negative-fixnum + -1 0 1 + (1- len) len (1+ len) + most-positive-fixnum (1+ most-positive-fixnum) + (* 2 most-positive-fixnum) + (* most-positive-fixnum most-positive-fixnum) + (ash 1 12345))) + (let ((a (nthcdr n cycle)) + (b (if (<= n 0) cycle (nthcdr (mod n len) cycle)))) + (should (equal (list (eq a b) n len) + (list t n len)))))))) + (provide 'fns-tests) commit 36de7bd7b0b9fcd038c440b4705e9186bfbaaa41 Author: Andy Moreton Date: Mon Aug 20 17:00:27 2018 -0400 Define get_proc_addr in Cygwin-w32 build * src/w32common.h (get_proc_addr, DEF_DLL_FN, LOAD_DLL_FN): Move definitions here from src/w32.h. * src/decompress.c [WINDOWSNT]: * src/gnutls.c [WINDOWSNT]: * src/image.c [WINDOWSNT]: * src/json.c [WINDOWSNT]: * src/lcms.c [WINDOWSNT]: * src/w32font.c [WINDOWSNT]: * src/w32uniscribe.c: * src/xml.c [WINDOWSNT]: Include w32common.h. diff --git a/src/decompress.c b/src/decompress.c index 9f7fbe4195..2836338216 100644 --- a/src/decompress.c +++ b/src/decompress.c @@ -30,6 +30,7 @@ along with GNU Emacs. If not, see . */ #ifdef WINDOWSNT # include +# include "w32common.h" # include "w32.h" DEF_DLL_FN (int, inflateInit2_, diff --git a/src/gnutls.c b/src/gnutls.c index 2d455ea1ba..aa5c97532f 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -58,6 +58,7 @@ along with GNU Emacs. If not, see . */ # ifdef WINDOWSNT # include +# include "w32common.h" # include "w32.h" # endif diff --git a/src/image.c b/src/image.c index 7866b9cc46..b9ff3f25c4 100644 --- a/src/image.c +++ b/src/image.c @@ -77,6 +77,7 @@ typedef struct x_bitmap_record Bitmap_Record; /* We need (or want) w32.h only when we're _not_ compiling for Cygwin. */ #ifdef WINDOWSNT +# include "w32common.h" # include "w32.h" #endif diff --git a/src/json.c b/src/json.c index 4e413a2bd5..4e46640a0c 100644 --- a/src/json.c +++ b/src/json.c @@ -34,6 +34,7 @@ along with GNU Emacs. If not, see . */ #ifdef WINDOWSNT # include +# include "w32common.h" # include "w32.h" DEF_DLL_FN (void, json_set_alloc_funcs, diff --git a/src/lcms.c b/src/lcms.c index a3a9822306..f37f843e50 100644 --- a/src/lcms.c +++ b/src/lcms.c @@ -34,6 +34,7 @@ typedef struct #ifdef WINDOWSNT # include +# include "w32common.h" # include "w32.h" DEF_DLL_FN (cmsFloat64Number, cmsCIE2000DeltaE, diff --git a/src/w32.h b/src/w32.h index a053ee0fc4..9c219cdda6 100644 --- a/src/w32.h +++ b/src/w32.h @@ -164,10 +164,6 @@ extern void reset_standard_handles (int in, int out, /* Return the string resource associated with KEY of type TYPE. */ extern LPBYTE w32_get_resource (const char * key, LPDWORD type); -/* Load a function from a DLL. Defined in this file. */ -typedef void (* VOIDFNPTR) (void); -INLINE VOIDFNPTR get_proc_addr (HINSTANCE handle, LPCSTR fname); - extern void release_listen_threads (void); extern void init_ntproc (int); extern void term_ntproc (int); @@ -245,33 +241,4 @@ extern ssize_t emacs_gnutls_push (gnutls_transport_ptr_t p, const void* buf, size_t sz); #endif /* HAVE_GNUTLS */ - - -/* Load a function address from a DLL. Cast the result via "VOIDFNPTR" - to pacify -Wcast-function-type in GCC 8.1. */ -INLINE VOIDFNPTR -get_proc_addr (HINSTANCE handle, LPCSTR fname) -{ - return (VOIDFNPTR) GetProcAddress (handle, fname); -} - -/* Define a function that will be loaded from a DLL. The variable - arguments should contain the argument list for the function, and - optionally be followed by function attributes. For example: - DEF_DLL_FN (void, png_longjmp, (png_structp, int) PNG_NORETURN); - */ -#define DEF_DLL_FN(type, func, ...) \ - typedef type (CDECL *W32_PFN_##func) __VA_ARGS__; \ - static W32_PFN_##func fn_##func - -/* Load a function from the DLL. */ -#define LOAD_DLL_FN(lib, func) \ - do \ - { \ - fn_##func = (W32_PFN_##func) get_proc_addr (lib, #func); \ - if (!fn_##func) \ - return false; \ - } \ - while (false) - #endif /* EMACS_W32_H */ diff --git a/src/w32common.h b/src/w32common.h index af548dd8ea..4981bdfd89 100644 --- a/src/w32common.h +++ b/src/w32common.h @@ -50,4 +50,34 @@ extern int os_subtype; /* Cache system info, e.g., the NT page size. */ extern void cache_system_info (void); +typedef void (* VOIDFNPTR) (void); + +/* Load a function address from a DLL. Cast the result via VOIDFNPTR + to pacify -Wcast-function-type in GCC 8.1. The return value must + be cast to the correct function pointer type. */ +INLINE VOIDFNPTR +get_proc_addr (HINSTANCE handle, LPCSTR fname) +{ + return (VOIDFNPTR) GetProcAddress (handle, fname); +} + +/* Define a function that will be loaded from a DLL. The variable + arguments should contain the argument list for the function, and + optionally be followed by function attributes. For example: + DEF_DLL_FN (void, png_longjmp, (png_structp, int) PNG_NORETURN); + */ +#define DEF_DLL_FN(type, func, ...) \ + typedef type (CDECL *W32_PFN_##func) __VA_ARGS__; \ + static W32_PFN_##func fn_##func + +/* Load a function from the DLL. */ +#define LOAD_DLL_FN(lib, func) \ + do \ + { \ + fn_##func = (W32_PFN_##func) get_proc_addr (lib, #func); \ + if (!fn_##func) \ + return false; \ + } \ + while (false) + #endif /* W32COMMON_H */ diff --git a/src/w32font.c b/src/w32font.c index f613061832..798869b5ca 100644 --- a/src/w32font.c +++ b/src/w32font.c @@ -29,6 +29,7 @@ along with GNU Emacs. If not, see . */ #include "coding.h" /* for ENCODE_SYSTEM, DECODE_SYSTEM */ #include "w32font.h" #ifdef WINDOWSNT +#include "w32common.h" #include "w32.h" #endif diff --git a/src/w32uniscribe.c b/src/w32uniscribe.c index 54f161690b..29c9c7a0bd 100644 --- a/src/w32uniscribe.c +++ b/src/w32uniscribe.c @@ -36,6 +36,7 @@ along with GNU Emacs. If not, see . */ #include "composite.h" #include "font.h" #include "w32font.h" +#include "w32common.h" struct uniscribe_font_info { diff --git a/src/xml.c b/src/xml.c index 5f3ccc85c8..e85891d2a2 100644 --- a/src/xml.c +++ b/src/xml.c @@ -31,6 +31,7 @@ along with GNU Emacs. If not, see . */ #ifdef WINDOWSNT # include +# include "w32common.h" # include "w32.h" DEF_DLL_FN (htmlDocPtr, htmlReadMemory, commit 21397837eaf0801e7b1cd4155a811a939a7667de Author: Paul Eggert Date: Mon Aug 20 10:24:19 2018 -0700 nthcdr now works with bignums Problem reported by Karl Fogel in: https://lists.gnu.org/r/emacs-devel/2018-08/msg00671.html * src/fns.c (Fnthcdr): Support bignum counts. diff --git a/src/fns.c b/src/fns.c index a11de1b082..aeb9308d22 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1402,9 +1402,20 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0, doc: /* Take cdr N times on LIST, return the result. */) (Lisp_Object n, Lisp_Object list) { - CHECK_FIXNUM (n); + CHECK_INTEGER (n); Lisp_Object tail = list; - for (EMACS_INT num = XFIXNUM (n); 0 < num; num--) + + EMACS_INT num; + if (FIXNUMP (n)) + num = XFIXNUM (n); + else + { + num = mpz_sgn (XBIGNUM (n)->value); + if (0 < num) + num = EMACS_INT_MAX; /* LIST cannot possibly be this long. */ + } + + for (; 0 < num; num--) { if (! CONSP (tail)) { commit ecd7a9407711ebe24d7e07d4402a2d66754ee693 Author: Paul Eggert Date: Sun Aug 19 10:05:41 2018 -0700 Fix expt signedness bug --without-wide-int Problem reported by Federico in: https://lists.gnu.org/r/emacs-devel/2018-08/msg00619.html * src/floatfns.c (Fexpt): Use TYPE_RANGED_FIXNUMP, not RANGED_FIXNUMP, to fix bug with unsigned comparison on platforms built --without-wide-int. diff --git a/src/floatfns.c b/src/floatfns.c index 54d068c29e..7c52a0a9a2 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -212,7 +212,7 @@ DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, if (INTEGERP (arg1) && NATNUMP (arg2)) { unsigned long exp; - if (RANGED_FIXNUMP (0, arg2, ULONG_MAX)) + if (TYPE_RANGED_FIXNUMP (unsigned long, arg2)) exp = XFIXNUM (arg2); else if (MOST_POSITIVE_FIXNUM < ULONG_MAX && BIGNUMP (arg2) && mpz_fits_ulong_p (XBIGNUM (arg2)->value)) commit 5c3dba24ef5f40825a01e30d2790c66df202b8b1 Author: Stefan Monnier Date: Sun Aug 19 08:47:02 2018 -0400 * lisp/progmodes/cc-mode.el: Add version header diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index f09ca04cff..09c30e2bd1 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -11,6 +11,8 @@ ;; Maintainer: bug-cc-mode@gnu.org ;; Created: a long, long, time ago. adapted from the original c-mode.el ;; Keywords: c languages +;; The version header below is used for ELPA packaging. +;; Version: 5.33.1 ;; This file is part of GNU Emacs. commit 47b7a5bd492e92dda928843e28a707b9682cb32f Author: Paul Eggert Date: Sun Aug 19 01:22:08 2018 -0700 Add bignum support to expt Problem and initial solution reported by Andy Moreton in: https://lists.gnu.org/r/emacs-devel/2018-08/msg00503.html * doc/lispref/numbers.texi (Math Functions): expt integer overflow no longer causes truncation; it now signals an error since bignum overflow is a big deal. * src/floatfns.c (Fexpt): Support bignum arguments. * test/src/floatfns-tests.el (bignum-expt): New test. diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi index 74a313e2e1..209e9f139a 100644 --- a/doc/lispref/numbers.texi +++ b/doc/lispref/numbers.texi @@ -1185,7 +1185,7 @@ returns a NaN. @defun expt x y This function returns @var{x} raised to power @var{y}. If both arguments are integers and @var{y} is nonnegative, the result is an -integer; in this case, overflow causes truncation, so watch out. +integer; in this case, overflow signals an error, so watch out. If @var{x} is a finite negative number and @var{y} is a finite non-integer, @code{expt} returns a NaN. @end defun diff --git a/src/floatfns.c b/src/floatfns.c index 713d42694f..54d068c29e 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -204,29 +204,36 @@ DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, doc: /* Return the exponential ARG1 ** ARG2. */) (Lisp_Object arg1, Lisp_Object arg2) { - CHECK_FIXNUM_OR_FLOAT (arg1); - CHECK_FIXNUM_OR_FLOAT (arg2); - if (FIXNUMP (arg1) /* common lisp spec */ - && FIXNUMP (arg2) /* don't promote, if both are ints, and */ - && XFIXNUM (arg2) >= 0) /* we are sure the result is not fractional */ - { /* this can be improved by pre-calculating */ - EMACS_INT y; /* some binary powers of x then accumulating */ - EMACS_UINT acc, x; /* Unsigned so that overflow is well defined. */ - Lisp_Object val; - - x = XFIXNUM (arg1); - y = XFIXNUM (arg2); - acc = (y & 1 ? x : 1); - - while ((y >>= 1) != 0) + CHECK_NUMBER (arg1); + CHECK_NUMBER (arg2); + + /* Common Lisp spec: don't promote if both are integers, and if the + result is not fractional. */ + if (INTEGERP (arg1) && NATNUMP (arg2)) + { + unsigned long exp; + if (RANGED_FIXNUMP (0, arg2, ULONG_MAX)) + exp = XFIXNUM (arg2); + else if (MOST_POSITIVE_FIXNUM < ULONG_MAX && BIGNUMP (arg2) + && mpz_fits_ulong_p (XBIGNUM (arg2)->value)) + exp = mpz_get_ui (XBIGNUM (arg2)->value); + else + xsignal3 (Qrange_error, build_string ("expt"), arg1, arg2); + + mpz_t val; + mpz_init (val); + if (FIXNUMP (arg1)) { - x *= x; - if (y & 1) - acc *= x; + mpz_set_intmax (val, XFIXNUM (arg1)); + mpz_pow_ui (val, val, exp); } - XSETINT (val, acc); - return val; + else + mpz_pow_ui (val, XBIGNUM (arg1)->value, exp); + Lisp_Object res = make_number (val); + mpz_clear (val); + return res; } + return make_float (pow (XFLOATINT (arg1), XFLOATINT (arg2))); } diff --git a/test/src/floatfns-tests.el b/test/src/floatfns-tests.el index 43a2e27829..e4caaa1e49 100644 --- a/test/src/floatfns-tests.el +++ b/test/src/floatfns-tests.el @@ -42,6 +42,15 @@ (should (= most-positive-fixnum (- (abs most-negative-fixnum) 1)))) +(ert-deftest bignum-expt () + (dolist (n (list most-positive-fixnum (1+ most-positive-fixnum) + most-negative-fixnum (1- most-negative-fixnum) + -2 -1 0 1 2)) + (should (= (expt n 0) 1)) + (should (= (expt n 1) n)) + (should (= (expt n 2) (* n n))) + (should (= (expt n 3) (* n n n))))) + (ert-deftest bignum-logb () (should (= (+ (logb most-positive-fixnum) 1) (logb (+ most-positive-fixnum 1))))) commit 06b5bcd639bf97fc77dc89dd52f136d4f262e888 Author: Paul Eggert Date: Sat Aug 18 23:27:47 2018 -0700 Fix bug with â€mod’ and float+bignum Problem reported by Andy Moreton in: https://lists.gnu.org/r/emacs-devel/2018-08/msg00442.html * src/floatfns.c (fmod_float): Work even if an arg is a bignum. * test/src/floatfns-tests.el (bignum-mod): New test. diff --git a/src/floatfns.c b/src/floatfns.c index ea2eb1016b..713d42694f 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -514,10 +514,8 @@ With optional DIVISOR, truncate ARG/DIVISOR. */) Lisp_Object fmod_float (Lisp_Object x, Lisp_Object y) { - double f1, f2; - - f1 = FLOATP (x) ? XFLOAT_DATA (x) : XFIXNUM (x); - f2 = FLOATP (y) ? XFLOAT_DATA (y) : XFIXNUM (y); + double f1 = XFLOATINT (x); + double f2 = XFLOATINT (y); f1 = fmod (f1, f2); diff --git a/test/src/floatfns-tests.el b/test/src/floatfns-tests.el index 7714c05d60..43a2e27829 100644 --- a/test/src/floatfns-tests.el +++ b/test/src/floatfns-tests.el @@ -46,4 +46,7 @@ (should (= (+ (logb most-positive-fixnum) 1) (logb (+ most-positive-fixnum 1))))) +(ert-deftest bignum-mod () + (should (= 0 (mod (1+ most-positive-fixnum) 2.0)))) + (provide 'floatfns-tests) commit 351859238d8b72c514f6714bd0f6b4dd39941606 Author: Paul Eggert Date: Sat Aug 18 23:14:13 2018 -0700 Update from Gnulib This incorporates: 2018-08-18 Avoid -Wcast-function-type warnings from casts * build-aux/config.sub, lib/gettimeofday.c: Copy from Gnulib. diff --git a/build-aux/config.sub b/build-aux/config.sub index 97d38aa6ec..6e8fa65549 100755 --- a/build-aux/config.sub +++ b/build-aux/config.sub @@ -2,7 +2,7 @@ # Configuration validation subroutine script. # Copyright 1992-2018 Free Software Foundation, Inc. -timestamp='2018-07-25' +timestamp='2018-08-13' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -149,29 +149,39 @@ case $1 in esac ;; *-*) - # Second component is usually, but not always the OS - case $field2 in - # Prevent following clause from handling this valid os - sun*os*) - basic_machine=$field1 - os=$field2 - ;; - # Manufacturers - dec* | mips* | sequent* | encore* | pc532* | sgi* | sony* \ - | att* | 7300* | 3300* | delta* | motorola* | sun[234]* \ - | unicom* | ibm* | next | hp | isi* | apollo | altos* \ - | convergent* | ncr* | news | 32* | 3600* | 3100* | hitachi* \ - | c[123]* | convex* | sun | crds | omron* | dg | ultra | tti* \ - | harris | dolphin | highlevel | gould | cbm | ns | masscomp \ - | apple | axis | knuth | cray | microblaze* \ - | sim | cisco | oki | wec | wrs | winbond) - basic_machine=$field1-$field2 + # A lone config we happen to match not fitting any patern + case $field1-$field2 in + decstation-3100) + basic_machine=mips-dec os= ;; - *) - basic_machine=$field1 - os=$field2 - ;; + *-*) + # Second component is usually, but not always the OS + case $field2 in + # Prevent following clause from handling this valid os + sun*os*) + basic_machine=$field1 + os=$field2 + ;; + # Manufacturers + dec* | mips* | sequent* | encore* | pc533* | sgi* | sony* \ + | att* | 7300* | 3300* | delta* | motorola* | sun[234]* \ + | unicom* | ibm* | next | hp | isi* | apollo | altos* \ + | convergent* | ncr* | news | 32* | 3600* | 3100* \ + | hitachi* | c[123]* | convex* | sun | crds | omron* | dg \ + | ultra | tti* | harris | dolphin | highlevel | gould \ + | cbm | ns | masscomp | apple | axis | knuth | cray \ + | microblaze* | sim | cisco \ + | oki | wec | wrs | winbond) + basic_machine=$field1-$field2 + os= + ;; + *) + basic_machine=$field1 + os=$field2 + ;; + esac + ;; esac ;; *) @@ -190,6 +200,14 @@ case $1 in basic_machine=m68010-adobe os=scout ;; + alliant) + basic_machine=fx80-alliant + os= + ;; + altos | altos3068) + basic_machine=m68k-altos + os= + ;; am29k) basic_machine=a29k-none os=bsd @@ -198,6 +216,10 @@ case $1 in basic_machine=580-amdahl os=sysv ;; + amiga) + basic_machine=m68k-unknown + os= + ;; amigaos | amigados) basic_machine=m68k-unknown os=amigaos @@ -234,13 +256,41 @@ case $1 in basic_machine=arm-unknown os=cegcc ;; + convex-c1) + basic_machine=c1-convex + os=bsd + ;; + convex-c2) + basic_machine=c2-convex + os=bsd + ;; + convex-c32) + basic_machine=c32-convex + os=bsd + ;; + convex-c34) + basic_machine=c34-convex + os=bsd + ;; + convex-c38) + basic_machine=c38-convex + os=bsd + ;; cray) basic_machine=j90-cray os=unicos ;; - craynv) - basic_machine=craynv-cray - os=unicosmp + crds | unos) + basic_machine=m68k-crds + os= + ;; + da30) + basic_machine=m68k-da30 + os= + ;; + decstation | pmax | pmin | dec3100 | decstatn) + basic_machine=mips-dec + os= ;; delta88) basic_machine=m88k-motorola @@ -286,6 +336,9 @@ case $1 in basic_machine=m88k-harris os=sysv3 ;; + hp300) + basic_machine=m68k-hp + ;; hp300bsd) basic_machine=m68k-hp os=bsd @@ -454,14 +507,26 @@ case $1 in basic_machine=mips-sei os=seiux ;; + sequent) + basic_machine=i386-sequent + os= + ;; sps7) basic_machine=m68k-bull os=sysv2 ;; + st2000) + basic_machine=m68k-tandem + os= + ;; stratus) basic_machine=i860-stratus os=sysv4 ;; + sun2) + basic_machine=m68000-sun + os= + ;; sun2os3) basic_machine=m68000-sun os=sunos3 @@ -470,6 +535,10 @@ case $1 in basic_machine=m68000-sun os=sunos4 ;; + sun3) + basic_machine=m68k-sun + os= + ;; sun3os3) basic_machine=m68k-sun os=sunos3 @@ -478,6 +547,10 @@ case $1 in basic_machine=m68k-sun os=sunos4 ;; + sun4) + basic_machine=sparc-sun + os= + ;; sun4os3) basic_machine=sparc-sun os=sunos3 @@ -490,6 +563,10 @@ case $1 in basic_machine=sparc-sun os=solaris2 ;; + sun386 | sun386i | roadrunner) + basic_machine=i386-sun + os= + ;; sv1) basic_machine=sv1-cray os=unicos @@ -564,6 +641,64 @@ esac # Decode aliases for certain CPU-COMPANY combinations. case $basic_machine in + # Here we handle the default manufacturer of certain CPU types. It is in + # some cases the only manufacturer, in others, it is the most popular. + craynv) + basic_machine=craynv-cray + os=${os:-unicosmp} + ;; + fx80) + basic_machine=fx80-alliant + ;; + w89k) + basic_machine=hppa1.1-winbond + ;; + op50n) + basic_machine=hppa1.1-oki + ;; + op60c) + basic_machine=hppa1.1-oki + ;; + romp) + basic_machine=romp-ibm + ;; + mmix) + basic_machine=mmix-knuth + ;; + rs6000) + basic_machine=rs6000-ibm + ;; + vax) + basic_machine=vax-dec + ;; + pdp11) + basic_machine=pdp11-dec + ;; + we32k) + basic_machine=we32k-att + ;; + cydra) + basic_machine=cydra-cydrome + ;; + i370-ibm* | ibm*) + basic_machine=i370-ibm + ;; + orion) + basic_machine=orion-highlevel + ;; + orion105) + basic_machine=clipper-highlevel + ;; + mac | mpw | mac-mpw) + basic_machine=m68k-apple + ;; + pmac | pmac-mpw) + basic_machine=powerpc-apple + ;; + xps | xps100) + basic_machine=xps100-honeywell + ;; + # Recognize the basic CPU types without company name. # Some are omitted here because they have special meanings below. 1750a | 580 \ @@ -592,6 +727,7 @@ case $basic_machine in | le32 | le64 \ | lm32 \ | m32c | m32r | m32rle | m68000 | m68k | m88k \ + | m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | nvptx | picochip \ | maxq | mb | microblaze | microblazeel | mcore | mep | metag \ | mips | mipsbe | mipseb | mipsel | mipsle \ | mips16 \ @@ -640,7 +776,7 @@ case $basic_machine in | v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \ | visium \ | wasm32 \ - | x86 | xc16x | xstormy16 | xtensa \ + | x86 | xc16x | xstormy16 | xgate | xtensa \ | z8k | z80) basic_machine=$basic_machine-unknown ;; @@ -656,11 +792,6 @@ case $basic_machine in leon|leon[3-9]) basic_machine=sparc-$basic_machine ;; - m6811-* | m68hc11-* | m6812-* | m68hc12-* | m68hcs12x-* | nvptx-* | picochip-*) - ;; - m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | nvptx | picochip) - basic_machine=$basic_machine-unknown - ;; m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65) ;; m9s12z | m68hcs12z | hcs12z | s12z) @@ -675,11 +806,6 @@ case $basic_machine in strongarm | thumb | xscale) basic_machine=arm-unknown ;; - xgate) - basic_machine=$basic_machine-unknown - ;; - xgate-*) - ;; xscaleeb) basic_machine=armeb-unknown ;; @@ -718,13 +844,14 @@ case $basic_machine in | h8300-* | h8500-* \ | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ | hexagon-* \ - | i*86-* | i860-* | i960-* | ia16-* | ia64-* \ + | i370-* | i*86-* | i860-* | i960-* | ia16-* | ia64-* \ | ip2k-* | iq2000-* \ | k1om-* \ | le32-* | le64-* \ | lm32-* \ | m32c-* | m32r-* | m32rle-* \ | m5200-* | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* | v70-* | w65-* \ + | m6811-* | m68hc11-* | m6812-* | m68hc12-* | m68hcs12x-* | nvptx-* | picochip-* \ | m88110-* | m88k-* | maxq-* | mb-* | mcore-* | mep-* | metag-* \ | microblaze-* | microblazeel-* \ | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ @@ -783,7 +910,7 @@ case $basic_machine in | visium-* \ | wasm32-* \ | we32k-* \ - | x86-* | x86_64-* | xc16x-* | xps100-* \ + | x86-* | x86_64-* | xc16x-* | xgate-* | xps100-* \ | xstormy16-* | xtensa*-* \ | ymp-* \ | z8k-* | z80-*) @@ -800,21 +927,12 @@ case $basic_machine in 3b*) basic_machine=we32k-att ;; - alliant | fx80) - basic_machine=fx80-alliant - ;; - altos | altos3068) - basic_machine=m68k-altos - ;; amd64) basic_machine=x86_64-pc ;; amd64-*) basic_machine=x86_64-`echo "$basic_machine" | sed 's/^[^-]*-//'` ;; - amiga | amiga-*) - basic_machine=m68k-unknown - ;; blackfin-*) basic_machine=bfin-`echo "$basic_machine" | sed 's/^[^-]*-//'` os=linux @@ -836,33 +954,10 @@ case $basic_machine in basic_machine=c90-cray os=${os:-unicos} ;; - convex-c1) - basic_machine=c1-convex - os=bsd - ;; - convex-c2) - basic_machine=c2-convex - os=bsd - ;; - convex-c32) - basic_machine=c32-convex - os=bsd - ;; - convex-c34) - basic_machine=c34-convex - os=bsd - ;; - convex-c38) - basic_machine=c38-convex - os=bsd - ;; cr16 | cr16-*) basic_machine=cr16-unknown os=${os:-elf} ;; - crds | unos) - basic_machine=m68k-crds - ;; crisv32 | crisv32-* | etraxfs*) basic_machine=crisv32-axis ;; @@ -873,12 +968,6 @@ case $basic_machine in basic_machine=crx-unknown os=${os:-elf} ;; - da30 | da30-*) - basic_machine=m68k-da30 - ;; - decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn) - basic_machine=mips-dec - ;; decsystem10* | dec10*) basic_machine=pdp10-dec os=tops10 @@ -924,9 +1013,6 @@ case $basic_machine in basic_machine=hppa1.1-hitachi os=hiuxwe2 ;; - hp300-*) - basic_machine=m68k-hp - ;; hp3k9[0-9][0-9] | hp9[0-9][0-9]) basic_machine=hppa1.0-hp ;; @@ -956,9 +1042,6 @@ case $basic_machine in hp9k8[0-9][0-9] | hp8[0-9][0-9]) basic_machine=hppa1.0-hp ;; - i370-ibm* | ibm*) - basic_machine=i370-ibm - ;; i*86v32) basic_machine=`echo "$1" | sed -e 's/86.*/86-pc/'` os=sysv32 @@ -1155,9 +1238,6 @@ case $basic_machine in basic_machine=mipsisa32-sde os=${os:-elf} ;; - sequent) - basic_machine=i386-sequent - ;; sh5el) basic_machine=sh5le-unknown ;; @@ -1171,24 +1251,9 @@ case $basic_machine in spur) basic_machine=spur-unknown ;; - st2000) - basic_machine=m68k-tandem - ;; strongarm-* | thumb-*) basic_machine=arm-`echo "$basic_machine" | sed 's/^[^-]*-//'` ;; - sun2) - basic_machine=m68000-sun - ;; - sun3 | sun3-*) - basic_machine=m68k-sun - ;; - sun4) - basic_machine=sparc-sun - ;; - sun386 | sun386i | roadrunner) - basic_machine=i386-sun - ;; tile*-*) ;; tile*) @@ -1218,9 +1283,6 @@ case $basic_machine in x64) basic_machine=x86_64-pc ;; - xps | xps100) - basic_machine=xps100-honeywell - ;; xscale-* | xscalee[bl]-*) basic_machine=`echo "$basic_machine" | sed 's/^xscale/arm/'` ;; @@ -1228,50 +1290,6 @@ case $basic_machine in basic_machine=none-none ;; -# Here we handle the default manufacturer of certain CPU types. It is in -# some cases the only manufacturer, in others, it is the most popular. - w89k) - basic_machine=hppa1.1-winbond - ;; - op50n) - basic_machine=hppa1.1-oki - ;; - op60c) - basic_machine=hppa1.1-oki - ;; - romp) - basic_machine=romp-ibm - ;; - mmix) - basic_machine=mmix-knuth - ;; - rs6000) - basic_machine=rs6000-ibm - ;; - vax) - basic_machine=vax-dec - ;; - pdp11) - basic_machine=pdp11-dec - ;; - we32k) - basic_machine=we32k-att - ;; - cydra) - basic_machine=cydra-cydrome - ;; - orion) - basic_machine=orion-highlevel - ;; - orion105) - basic_machine=clipper-highlevel - ;; - mac | mpw | mac-mpw) - basic_machine=m68k-apple - ;; - pmac | pmac-mpw) - basic_machine=powerpc-apple - ;; *) echo Invalid configuration \`"$1"\': machine \`"$basic_machine"\' not recognized 1>&2 exit 1 diff --git a/lib/gettimeofday.c b/lib/gettimeofday.c index fd44f45ca3..1bd50fa3d3 100644 --- a/lib/gettimeofday.c +++ b/lib/gettimeofday.c @@ -33,6 +33,10 @@ #ifdef WINDOWS_NATIVE +/* Avoid warnings from gcc -Wcast-function-type. */ +# define GetProcAddress \ + (void *) GetProcAddress + /* GetSystemTimePreciseAsFileTime was introduced only in Windows 8. */ typedef void (WINAPI * GetSystemTimePreciseAsFileTimeFuncType) (FILETIME *lpTime); static GetSystemTimePreciseAsFileTimeFuncType GetSystemTimePreciseAsFileTimeFunc = NULL; commit 7ea369e5f22d6e3bcf1e55225c0ff356d9cabb2e Author: Paul Eggert Date: Sat Aug 18 23:06:41 2018 -0700 Tweak integer division * src/data.c (arith_driver): Reorder to remove unnecessary FIXNUMP. Tighten test for whether to convert the divisor from fixnum to mpz_t. Simplify. diff --git a/src/data.c b/src/data.c index 5ef0ef8557..8a6975da3a 100644 --- a/src/data.c +++ b/src/data.c @@ -2896,11 +2896,11 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) { /* Note that a bignum can never be 0, so we don't need to check that case. */ - if (FIXNUMP (val) && XFIXNUM (val) == 0) - xsignal0 (Qarith_error); if (BIGNUMP (val)) mpz_tdiv_q (accum, accum, XBIGNUM (val)->value); - else if (sizeof (EMACS_INT) > sizeof (long)) + else if (XFIXNUM (val) == 0) + xsignal0 (Qarith_error); + else if (ULONG_MAX < -MOST_NEGATIVE_FIXNUM) { mpz_t tem; mpz_init (tem); @@ -2911,11 +2911,8 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) else { EMACS_INT value = XFIXNUM (val); - bool negate = value < 0; - if (negate) - value = -value; - mpz_tdiv_q_ui (accum, accum, value); - if (negate) + mpz_tdiv_q_ui (accum, accum, eabs (value)); + if (value < 0) mpz_neg (accum, accum); } } commit a1b79567a8253a8e8a1ceed02145a64b87a4768d Author: Paul Eggert Date: Sat Aug 18 20:47:24 2018 -0700 Simplify float_arith_driver * src/data.c (float_arith_driver): Simplify, as we needn’t worry about that 30-year-old compiler bug any more. diff --git a/src/data.c b/src/data.c index 7a8179ed38..5ef0ef8557 100644 --- a/src/data.c +++ b/src/data.c @@ -2966,26 +2966,14 @@ static Lisp_Object float_arith_driver (double accum, ptrdiff_t argnum, enum arithop code, ptrdiff_t nargs, Lisp_Object *args) { - register Lisp_Object val; - double next; - for (; argnum < nargs; argnum++) { - /* using args[argnum] as argument to CHECK_NUMBER_... */ - val = args[argnum]; + Lisp_Object val = args[argnum]; CHECK_NUMBER_COERCE_MARKER (val); + double next = (FIXNUMP (val) ? XFIXNUM (val) + : FLOATP (val) ? XFLOAT_DATA (val) + : mpz_get_d (XBIGNUM (val)->value)); - if (FLOATP (val)) - { - next = XFLOAT_DATA (val); - } - else if (BIGNUMP (val)) - next = mpz_get_d (XBIGNUM (val)->value); - else - { - args[argnum] = val; /* runs into a compiler bug. */ - next = XFIXNUM (args[argnum]); - } switch (code) { case Aadd: commit b1840206ff22359fc099236602928e0fb3828d66 Author: Paul Eggert Date: Sat Aug 18 20:40:10 2018 -0700 Minor fixups for intmax_t→mpz_t conversion * src/alloc.c (mpz_set_intmax_slow): Tighten assertion. Work even in the unlikely case where libgmp uses nails. * src/data.c (FIXNUMS_FIT_IN_LONG): New constant. (arith_driver): Use it to tighten compile-time checks. * src/lisp.h (mpz_set_intmax): Do not assume that converting an out-of-range value to â€long’ is harmless, as it might raise a signal. Use simpler expression; compiler can optimize. diff --git a/src/alloc.c b/src/alloc.c index 60850f73d5..ddc0696ba9 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3785,18 +3785,21 @@ make_number (mpz_t value) void mpz_set_intmax_slow (mpz_t result, intmax_t v) { - /* If long is larger then a faster path is taken. */ - eassert (sizeof (intmax_t) > sizeof (long)); + /* If V fits in long, a faster path is taken. */ + eassert (! (LONG_MIN <= v && v <= LONG_MAX)); bool complement = v < 0; if (complement) v = -1 - v; - /* COUNT = 1 means just a single word of the given size. ORDER = -1 - is arbitrary since there's only a single word. ENDIAN = 0 means - use the native endian-ness. NAILS = 0 means use the whole - word. */ - mpz_import (result, 1, -1, sizeof v, 0, 0, &v); + enum { nails = sizeof v * CHAR_BIT - INTMAX_WIDTH }; +# ifndef HAVE_GMP + /* mini-gmp requires NAILS to be zero, which is true for all + likely Emacs platforms. Sanity-check this. */ + verify (nails == 0); +# endif + + mpz_import (result, 1, -1, sizeof v, 0, nails, &v); if (complement) mpz_com (result, result); } diff --git a/src/data.c b/src/data.c index 0754d4c176..7a8179ed38 100644 --- a/src/data.c +++ b/src/data.c @@ -2775,6 +2775,9 @@ enum arithop Alogxor }; +enum { FIXNUMS_FIT_IN_LONG = (LONG_MIN <= MOST_NEGATIVE_FIXNUM + && MOST_POSITIVE_FIXNUM <= LONG_MAX) }; + static void free_mpz_value (void *value_ptr) { @@ -2829,7 +2832,7 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) case Aadd: if (BIGNUMP (val)) mpz_add (accum, accum, XBIGNUM (val)->value); - else if (sizeof (EMACS_INT) > sizeof (long)) + else if (! FIXNUMS_FIT_IN_LONG) { mpz_t tem; mpz_init (tem); @@ -2854,7 +2857,7 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) } else if (BIGNUMP (val)) mpz_sub (accum, accum, XBIGNUM (val)->value); - else if (sizeof (EMACS_INT) > sizeof (long)) + else if (! FIXNUMS_FIT_IN_LONG) { mpz_t tem; mpz_init (tem); @@ -2870,7 +2873,7 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) case Amult: if (BIGNUMP (val)) mpz_mul (accum, accum, XBIGNUM (val)->value); - else if (sizeof (EMACS_INT) > sizeof (long)) + else if (! FIXNUMS_FIT_IN_LONG) { mpz_t tem; mpz_init (tem); diff --git a/src/lisp.h b/src/lisp.h index f2cfe81ca7..fe384d1844 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -30,10 +30,11 @@ along with GNU Emacs. If not, see . */ #include #include #include + #ifdef HAVE_GMP -#include +# include #else -#include "mini-gmp.h" +# include "mini-gmp.h" #endif #include @@ -3566,10 +3567,10 @@ mpz_set_intmax (mpz_t result, intmax_t v) /* mpz_set_si works in terms of long, but Emacs may use a wider integer type, and so sometimes will have to construct the mpz_t by hand. */ - if (sizeof (intmax_t) > sizeof (long) && (long) v != v) - mpz_set_intmax_slow (result, v); - else + if (LONG_MIN <= v && v <= LONG_MAX) mpz_set_si (result, v); + else + mpz_set_intmax_slow (result, v); } /* Build a frequently used 2/3/4-integer lists. */ commit 6eade1efde873d0b048d8f2841646924cb2ceb16 Author: Paul Eggert Date: Sat Aug 18 19:40:24 2018 -0700 Improve --with-wide-int mpz_t→fixnum conversion These tuneups and minor simplifications should affect only platforms with EMACS_INT wider than â€long’. * src/alloc.c (make_number): If the number fits in long but not in fixnum, do not attempt to convert to fixnum again. Tighten the compile-time check for whether the second attempt is worth trying, from sizeof (long) < sizeof (EMACS_INT) to LONG_WIDTH < FIXNUM_BITS. Do not bother computing the sign of the value to tighten the bounds for whether to try the second attempt, as it’s not worth the effort. Do not call mpz_size, which is unnecessary since the number of bits is already known and the loop can iterate over a shift count instead. Avoid unnecessary casts. Use + instead of | where either will do, as + is typically better for optimization. Improve mpz_t to fixnum when --with-wide-int * src/alloc.c (make_number): Avoid undefined behavior when shifting an EMACS_UINT by more than EMACS_UINT_WIDTH bits. Check for integer overflow when shifting. diff --git a/src/alloc.c b/src/alloc.c index 0cd3f0c0c3..60850f73d5 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3752,25 +3752,20 @@ make_number (mpz_t value) if (!FIXNUM_OVERFLOW_P (l)) return make_fixnum (l); } - - /* Check if fixnum can be larger than long. */ - if (sizeof (EMACS_INT) > sizeof (long)) + else if (LONG_WIDTH < FIXNUM_BITS) { size_t bits = mpz_sizeinbase (value, 2); - int sign = mpz_sgn (value); - if (bits < FIXNUM_BITS + (sign < 0)) + if (bits <= FIXNUM_BITS) { EMACS_INT v = 0; - size_t limbs = mpz_size (value); - mp_size_t i; - - for (i = 0; i < limbs; i++) + int i = 0; + for (int shift = 0; shift < bits; shift += mp_bits_per_limb) { - mp_limb_t limb = mpz_getlimbn (value, i); - v |= (EMACS_INT) ((EMACS_UINT) limb << (i * mp_bits_per_limb)); + EMACS_INT limb = mpz_getlimbn (value, i++); + v += limb << shift; } - if (sign < 0) + if (mpz_sgn (value) < 0) v = -v; if (!FIXNUM_OVERFLOW_P (v)) commit 1d2df2fd03f35ca8d8dfc8b999d8bba3c7c13157 Author: Paul Eggert Date: Sat Aug 18 16:13:04 2018 -0700 Improve bignum comparison (Bug#32463#50) * src/data.c (isnan): Remove, as we can assume C99. (bignumcompare): Remove, folding its functionality into arithcompare. (arithcompare): Compare bignums directly here. Fix bugs when comparing NaNs to bignums. When comparing a bignum to a fixnum, just look at the bignum’s sign, as that’s all that is needed. Decrease scope of locals when this is easy. * test/src/data-tests.el (data-tests-bignum): Test bignum vs NaN. diff --git a/src/data.c b/src/data.c index a39978ab1d..0754d4c176 100644 --- a/src/data.c +++ b/src/data.c @@ -2386,140 +2386,37 @@ bool-vector. IDX starts at 0. */) /* Arithmetic functions */ -#ifndef isnan -# define isnan(x) ((x) != (x)) -#endif - -static Lisp_Object -bignumcompare (Lisp_Object num1, Lisp_Object num2, - enum Arith_Comparison comparison) -{ - int cmp; - bool test; - - if (BIGNUMP (num1)) - { - if (FLOATP (num2)) - { - /* Note that GMP doesn't define comparisons against NaN, so - we need to handle them specially. */ - if (isnan (XFLOAT_DATA (num2))) - return Qnil; - cmp = mpz_cmp_d (XBIGNUM (num1)->value, XFLOAT_DATA (num2)); - } - else if (FIXNUMP (num2)) - { - if (sizeof (EMACS_INT) > sizeof (long) && XFIXNUM (num2) > LONG_MAX) - { - mpz_t tem; - mpz_init (tem); - mpz_set_intmax (tem, XFIXNUM (num2)); - cmp = mpz_cmp (XBIGNUM (num1)->value, tem); - mpz_clear (tem); - } - else - cmp = mpz_cmp_si (XBIGNUM (num1)->value, XFIXNUM (num2)); - } - else - { - eassume (BIGNUMP (num2)); - cmp = mpz_cmp (XBIGNUM (num1)->value, XBIGNUM (num2)->value); - } - } - else - { - eassume (BIGNUMP (num2)); - if (FLOATP (num1)) - { - /* Note that GMP doesn't define comparisons against NaN, so - we need to handle them specially. */ - if (isnan (XFLOAT_DATA (num1))) - return Qnil; - cmp = - mpz_cmp_d (XBIGNUM (num2)->value, XFLOAT_DATA (num1)); - } - else - { - eassume (FIXNUMP (num1)); - if (sizeof (EMACS_INT) > sizeof (long) && XFIXNUM (num1) > LONG_MAX) - { - mpz_t tem; - mpz_init (tem); - mpz_set_intmax (tem, XFIXNUM (num1)); - cmp = - mpz_cmp (XBIGNUM (num2)->value, tem); - mpz_clear (tem); - } - else - cmp = - mpz_cmp_si (XBIGNUM (num2)->value, XFIXNUM (num1)); - } - } - - switch (comparison) - { - case ARITH_EQUAL: - test = cmp == 0; - break; - - case ARITH_NOTEQUAL: - test = cmp != 0; - break; - - case ARITH_LESS: - test = cmp < 0; - break; - - case ARITH_LESS_OR_EQUAL: - test = cmp <= 0; - break; - - case ARITH_GRTR: - test = cmp > 0; - break; - - case ARITH_GRTR_OR_EQUAL: - test = cmp >= 0; - break; - - default: - eassume (false); - } - - return test ? Qt : Qnil; -} - Lisp_Object arithcompare (Lisp_Object num1, Lisp_Object num2, enum Arith_Comparison comparison) { - double f1, f2; - EMACS_INT i1, i2; - bool lt, eq, gt; + EMACS_INT i1 = 0, i2 = 0; + bool lt, eq = true, gt; bool test; CHECK_NUMBER_COERCE_MARKER (num1); CHECK_NUMBER_COERCE_MARKER (num2); - if (BIGNUMP (num1) || BIGNUMP (num2)) - return bignumcompare (num1, num2, comparison); - - /* If either arg is floating point, set F1 and F2 to the 'double' - approximations of the two arguments, and set LT, EQ, and GT to - the <, ==, > floating-point comparisons of F1 and F2 + /* If the comparison is mostly done by comparing two doubles, + set LT, EQ, and GT to the <, ==, > results of that comparison, respectively, taking care to avoid problems if either is a NaN, and trying to avoid problems on platforms where variables (in violation of the C standard) can contain excess precision. Regardless, set I1 and I2 to integers that break ties if the - floating-point comparison is either not done or reports + two-double comparison is either not done or reports equality. */ if (FLOATP (num1)) { - f1 = XFLOAT_DATA (num1); + double f1 = XFLOAT_DATA (num1); if (FLOATP (num2)) { - i1 = i2 = 0; - f2 = XFLOAT_DATA (num2); + double f2 = XFLOAT_DATA (num2); + lt = f1 < f2; + eq = f1 == f2; + gt = f1 > f2; } - else + else if (FIXNUMP (num2)) { /* Compare a float NUM1 to an integer NUM2 by converting the integer I2 (i.e., NUM2) to the double F2 (a conversion that @@ -2529,35 +2426,56 @@ arithcompare (Lisp_Object num1, Lisp_Object num2, floating-point comparison reports a tie, NUM1 = F1 = F2 = I1 (exactly) so I1 - I2 = NUM1 - NUM2 (exactly), so comparing I1 to I2 will break the tie correctly. */ - i1 = f2 = i2 = XFIXNUM (num2); + double f2 = XFIXNUM (num2); + lt = f1 < f2; + eq = f1 == f2; + gt = f1 > f2; + i1 = f2; + i2 = XFIXNUM (num2); } - lt = f1 < f2; - eq = f1 == f2; - gt = f1 > f2; + else if (isnan (f1)) + lt = eq = gt = false; + else + i2 = mpz_cmp_d (XBIGNUM (num2)->value, f1); } - else + else if (FIXNUMP (num1)) { - i1 = XFIXNUM (num1); if (FLOATP (num2)) { /* Compare an integer NUM1 to a float NUM2. This is the converse of comparing float to integer (see above). */ - i2 = f1 = i1; - f2 = XFLOAT_DATA (num2); + double f1 = XFIXNUM (num1), f2 = XFLOAT_DATA (num2); lt = f1 < f2; eq = f1 == f2; gt = f1 > f2; + i1 = XFIXNUM (num1); + i2 = f1; } - else + else if (FIXNUMP (num2)) { + i1 = XFIXNUM (num1); i2 = XFIXNUM (num2); - eq = true; } + else + i2 = mpz_sgn (XBIGNUM (num2)->value); } + else if (FLOATP (num2)) + { + double f2 = XFLOAT_DATA (num2); + if (isnan (f2)) + lt = eq = gt = false; + else + i1 = mpz_cmp_d (XBIGNUM (num1)->value, f2); + } + else if (FIXNUMP (num2)) + i1 = mpz_sgn (XBIGNUM (num1)->value); + else + i1 = mpz_cmp (XBIGNUM (num1)->value, XBIGNUM (num2)->value); if (eq) { - /* Break a floating-point tie by comparing the integers. */ + /* The two-double comparison either reported equality, or was not done. + Break the tie by comparing the integers. */ lt = i1 < i2; eq = i1 == i2; gt = i1 > i2; diff --git a/test/src/data-tests.el b/test/src/data-tests.el index 85cbab2610..688c32d6ee 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -551,7 +551,10 @@ comparing the subr with a much slower lisp implementation." (should (= b0 b0)) (should (/= b0 f-1)) - (should (/= b0 b-1)))) + (should (/= b0 b-1)) + + (should (/= b0 0.0e+NaN)) + (should (/= b-1 0.0e+NaN)))) (ert-deftest data-tests-+ () (should-not (fixnump (+ most-positive-fixnum most-positive-fixnum))) commit 97d273033b523bc07911c848d4e8bf96cdce0c90 Author: Paul Eggert Date: Sat Aug 18 15:39:05 2018 -0700 Document that â€random’ is limited to fixnums Problem reported by Pip Cet (Bug#32463#20). * doc/lispref/numbers.texi (Random Numbers): * src/fns.c (Frandom): Adjust doc. diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi index ee6456b1be..74a313e2e1 100644 --- a/doc/lispref/numbers.texi +++ b/doc/lispref/numbers.texi @@ -1236,11 +1236,10 @@ other strings to choose various seed values. This function returns a pseudo-random integer. Repeated calls return a series of pseudo-random integers. -If @var{limit} is a positive integer, the value is chosen to be +If @var{limit} is a positive fixnum, the value is chosen to be nonnegative and less than @var{limit}. Otherwise, the value might be -any integer representable in Lisp, i.e., an integer between -@code{most-negative-fixnum} and @code{most-positive-fixnum} -(@pxref{Integer Basics}). +any fixnum, i.e., any integer from @code{most-negative-fixnum} through +@code{most-positive-fixnum} (@pxref{Integer Basics}). If @var{limit} is @code{t}, it means to choose a new seed as if Emacs were restarting, typically from the system entropy. On systems diff --git a/src/fns.c b/src/fns.c index f6e6803641..a11de1b082 100644 --- a/src/fns.c +++ b/src/fns.c @@ -56,15 +56,12 @@ DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, } DEFUN ("random", Frandom, Srandom, 0, 1, 0, - doc: /* Return a pseudo-random number. -All integers representable in Lisp, i.e. between `most-negative-fixnum' -and `most-positive-fixnum', inclusive, are equally likely. - -With positive integer LIMIT, return random number in interval [0,LIMIT). + doc: /* Return a pseudo-random integer. +By default, return a fixnum; all fixnums are equally likely. +With positive fixnum LIMIT, return random integer in interval [0,LIMIT). With argument t, set the random number seed from the system's entropy pool if available, otherwise from less-random volatile data such as the time. With a string argument, set the seed based on the string's contents. -Other values of LIMIT are ignored. See Info node `(elisp)Random Numbers' for more details. */) (Lisp_Object limit) commit 673b1785db4604efe81b8045a9d8ab68936af719 Author: Paul Eggert Date: Sat Aug 18 15:20:46 2018 -0700 Restore traditional lsh behavior on fixnums * doc/lispref/numbers.texi (Bitwise Operations): Document that the traditional (lsh A B) behavior is for fixnums, and that it is an error if A and B are both negative and A is a bignum. See Bug#32463. * lisp/subr.el (lsh): New function, moved here from src/data.c. * src/data.c (ash_lsh_impl): Remove, moving body into Fash since it’s the only caller now. (Fash): Check for out-of-range counts. If COUNT is zero, return first argument instead of going through libgmp. Omit lsh code since lsh is now done in Lisp. Add code for shifting fixnums right, to avoid a round trip through libgmp. (Flsh): Remove; moved to lisp/subr.el. * test/lisp/international/ccl-tests.el (shift): Test for traditional lsh behavior, instead of assuming lsh is like ash when bignums are present. * test/src/data-tests.el (data-tests-logand) (data-tests-logior, data-tests-logxor, data-tests-ash-lsh): New tests. diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi index 37d2c31649..ee6456b1be 100644 --- a/doc/lispref/numbers.texi +++ b/doc/lispref/numbers.texi @@ -844,7 +844,9 @@ bits in @var{integer1} to the left @var{count} places, or to the right if @var{count} is negative, bringing zeros into the vacated bits. If @var{count} is negative, @code{lsh} shifts zeros into the leftmost (most-significant) bit, producing a nonnegative result even if -@var{integer1} is negative. Contrast this with @code{ash}, below. +@var{integer1} is negative fixnum. (If @var{integer1} is a negative +bignum, @var{count} must be nonnegative.) Contrast this with +@code{ash}, below. Here are two examples of @code{lsh}, shifting a pattern of bits one place to the left. We show only the low-order eight bits of the binary @@ -913,7 +915,8 @@ is negative. @code{ash} gives the same results as @code{lsh} except when @var{integer1} and @var{count} are both negative. In that case, @code{ash} puts ones in the empty bit positions on the left, while -@code{lsh} puts zeros in those bit positions. +@code{lsh} puts zeros in those bit positions and requires +@var{integer1} to be a fixnum. Thus, with @code{ash}, shifting the pattern of bits one place to the right looks like this: diff --git a/lisp/subr.el b/lisp/subr.el index fbb3e49a35..cafa4835ea 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -366,6 +366,18 @@ was called." (declare (compiler-macro (lambda (_) `(= 0 ,number)))) (= 0 number)) +(defun lsh (value count) + "Return VALUE with its bits shifted left by COUNT. +If COUNT is negative, shifting is actually to the right. +In this case, if VALUE is a negative fixnum treat it as unsigned, +i.e., subtract 2 * most-negative-fixnum from VALUE before shifting it." + (when (and (< value 0) (< count 0)) + (when (< value most-negative-fixnum) + (signal 'args-out-of-range (list value count))) + (setq value (logand (ash value -1) most-positive-fixnum)) + (setq count (1+ count))) + (ash value count)) + ;;;; List functions. diff --git a/src/data.c b/src/data.c index 5a355d9787..a39978ab1d 100644 --- a/src/data.c +++ b/src/data.c @@ -3365,30 +3365,44 @@ representation. */) : count_one_bits_ll (v)); } -static Lisp_Object -ash_lsh_impl (Lisp_Object value, Lisp_Object count, bool lsh) +DEFUN ("ash", Fash, Sash, 2, 2, 0, + doc: /* Return VALUE with its bits shifted left by COUNT. +If COUNT is negative, shifting is actually to the right. +In this case, the sign bit is duplicated. */) + (Lisp_Object value, Lisp_Object count) { - /* This code assumes that signed right shifts are arithmetic. */ - verify ((EMACS_INT) -1 >> 1 == -1); - Lisp_Object val; + /* The negative of the minimum value of COUNT that fits into a fixnum, + such that mpz_fdiv_q_exp supports -COUNT. */ + EMACS_INT minus_count_min = min (-MOST_NEGATIVE_FIXNUM, + TYPE_MAXIMUM (mp_bitcnt_t)); CHECK_INTEGER (value); - CHECK_FIXNUM (count); + CHECK_RANGED_INTEGER (count, - minus_count_min, TYPE_MAXIMUM (mp_bitcnt_t)); if (BIGNUMP (value)) { + if (XFIXNUM (count) == 0) + return value; mpz_t result; mpz_init (result); - if (XFIXNUM (count) >= 0) + if (XFIXNUM (count) > 0) mpz_mul_2exp (result, XBIGNUM (value)->value, XFIXNUM (count)); - else if (lsh) - mpz_tdiv_q_2exp (result, XBIGNUM (value)->value, - XFIXNUM (count)); else mpz_fdiv_q_2exp (result, XBIGNUM (value)->value, - XFIXNUM (count)); val = make_number (result); mpz_clear (result); } + else if (XFIXNUM (count) <= 0) + { + /* This code assumes that signed right shifts are arithmetic. */ + verify ((EMACS_INT) -1 >> 1 == -1); + + EMACS_INT shift = -XFIXNUM (count); + EMACS_INT result = (shift < EMACS_INT_WIDTH ? XFIXNUM (value) >> shift + : XFIXNUM (value) < 0 ? -1 : 0); + val = make_fixnum (result); + } else { /* Just do the work as bignums to make the code simpler. */ @@ -3400,14 +3414,7 @@ ash_lsh_impl (Lisp_Object value, Lisp_Object count, bool lsh) if (XFIXNUM (count) >= 0) mpz_mul_2exp (result, result, XFIXNUM (count)); - else if (lsh) - { - if (mpz_sgn (result) > 0) - mpz_fdiv_q_2exp (result, result, - XFIXNUM (count)); - else - mpz_fdiv_q_2exp (result, result, - XFIXNUM (count)); - } - else /* ash */ + else mpz_fdiv_q_2exp (result, result, - XFIXNUM (count)); val = make_number (result); @@ -3417,24 +3424,6 @@ ash_lsh_impl (Lisp_Object value, Lisp_Object count, bool lsh) return val; } -DEFUN ("ash", Fash, Sash, 2, 2, 0, - doc: /* Return VALUE with its bits shifted left by COUNT. -If COUNT is negative, shifting is actually to the right. -In this case, the sign bit is duplicated. */) - (register Lisp_Object value, Lisp_Object count) -{ - return ash_lsh_impl (value, count, false); -} - -DEFUN ("lsh", Flsh, Slsh, 2, 2, 0, - doc: /* Return VALUE with its bits shifted left by COUNT. -If COUNT is negative, shifting is actually to the right. -In this case, zeros are shifted in on the left. */) - (register Lisp_Object value, Lisp_Object count) -{ - return ash_lsh_impl (value, count, true); -} - DEFUN ("1+", Fadd1, Sadd1, 1, 1, 0, doc: /* Return NUMBER plus one. NUMBER may be a number or a marker. Markers are converted to integers. */) @@ -4235,7 +4224,6 @@ syms_of_data (void) defsubr (&Slogior); defsubr (&Slogxor); defsubr (&Slogcount); - defsubr (&Slsh); defsubr (&Sash); defsubr (&Sadd1); defsubr (&Ssub1); diff --git a/test/lisp/international/ccl-tests.el b/test/lisp/international/ccl-tests.el index b41b8c1ff6..7dd7224726 100644 --- a/test/lisp/international/ccl-tests.el +++ b/test/lisp/international/ccl-tests.el @@ -37,18 +37,9 @@ ;; shift right -ve -5628 #x3fffffffffffea04 (should (= (ash -5628 -8) -22)) ; #x3fffffffffffffea - - ;; shift right -5628 #x3fffffffffffea04 - (cond - ((fboundp 'bignump) - (should (= (lsh -5628 -8) -22))) ; #x3fffffffffffffea bignum - ((= (logb most-negative-fixnum) 61) - (should (= (lsh -5628 -8) - (string-to-number - "18014398509481962")))) ; #x003fffffffffffea master (64bit) - ((= (logb most-negative-fixnum) 29) - (should (= (lsh -5628 -8) 4194282))) ; #x003fffea master (32bit) - )) + (should (= (lsh -5628 -8) + (ash (- -5628 (ash most-negative-fixnum 1)) -8) + (ash (logand (ash -5628 -1) most-positive-fixnum) -7)))) ;; CCl program from `pgg-parse-crc24' in lisp/obsolete/pgg-parse.el (defconst prog-pgg-source @@ -177,11 +168,11 @@ At EOF: 82169 240 2555 18 128 81943 15 276 529 305 81 -17660 -17916 22]) (defconst prog-midi-dump -"Out-buffer must be 2 times bigger than in-buffer. +(concat "Out-buffer must be 2 times bigger than in-buffer. Main-body: 2:[read-jump-cond-expr-const] read r0, if !(r0 < 128), jump to 22(+20) 5:[branch] jump to array[r3] of length 4 - 11 12 15 18 22 + 11 12 15 18 22 "" 11:[jump] jump to 2(-9) 12:[set-register] r1 = r0 13:[set-register] r0 = r4 @@ -227,7 +218,7 @@ Main-body: 71:[jump] jump to 2(-69) At EOF: 72:[end] end -") +")) (ert-deftest ccl-compile-midi () (should (equal (ccl-compile prog-midi-source) prog-midi-code))) diff --git a/test/src/data-tests.el b/test/src/data-tests.el index a4c6b0e491..85cbab2610 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -598,7 +598,9 @@ comparing the subr with a much slower lisp implementation." (should (fixnump (1- (1+ most-positive-fixnum))))) (ert-deftest data-tests-logand () - (should (= -1 (logand -1))) + (should (= -1 (logand) (logand -1) (logand -1 -1))) + (let ((n (1+ most-positive-fixnum))) + (should (= (logand -1 n) n))) (let ((n (* 2 most-negative-fixnum))) (should (= (logand -1 n) n)))) @@ -606,11 +608,11 @@ comparing the subr with a much slower lisp implementation." (should (= (logcount (read "#xffffffffffffffffffffffffffffffff")) 128))) (ert-deftest data-tests-logior () - (should (= -1 (logior -1))) + (should (= -1 (logior -1) (logior -1 -1))) (should (= -1 (logior most-positive-fixnum most-negative-fixnum)))) (ert-deftest data-tests-logxor () - (should (= -1 (logxor -1))) + (should (= -1 (logxor -1) (logxor -1 -1 -1))) (let ((n (1+ most-positive-fixnum))) (should (= (logxor -1 n) (lognot n))))) @@ -642,6 +644,12 @@ comparing the subr with a much slower lisp implementation." (should (= (ash most-negative-fixnum 1) (* most-negative-fixnum 2))) (should (= (lsh most-negative-fixnum 1) - (* most-negative-fixnum 2)))) + (* most-negative-fixnum 2))) + (should (= (ash (* 2 most-negative-fixnum) -1) + most-negative-fixnum)) + (should (= (lsh most-positive-fixnum -1) (/ most-positive-fixnum 2))) + (should (= (lsh most-negative-fixnum -1) (lsh (- most-negative-fixnum) -1))) + (should (= (lsh -1 -1) most-positive-fixnum)) + (should-error (lsh (1- most-negative-fixnum) -1))) ;;; data-tests.el ends here commit 22d1f534a19b2382c8621f9778aac8a94b43ef0d Author: Eli Zaretskii Date: Sat Aug 18 16:10:28 2018 +0300 Avoid compilation warning in nt/addpm.c * nt/addpm.c [!MINGW_W64]: Undefine _WIN32_IE before redefining it, to avoid compilation warnings. diff --git a/nt/addpm.c b/nt/addpm.c index ec7d7ff52d..21320206d6 100644 --- a/nt/addpm.c +++ b/nt/addpm.c @@ -38,9 +38,12 @@ along with GNU Emacs. If not, see . */ #include #include -/* MinGW64 barfs if _WIN32_IE is defined to anything below 0x500. */ +/* MinGW64 barfs if _WIN32_IE is defined to anything below 0x0500. */ #ifndef MINGW_W64 -#define _WIN32_IE 0x400 +# ifdef _WIN32_IE +# undef _WIN32_IE +# endif +#define _WIN32_IE 0x0400 #endif /* Request C Object macros for COM interfaces. */ #define COBJMACROS 1 commit 877cd22f553624b6d7f24141acd134f9cf839259 Author: Eli Zaretskii Date: Sat Aug 18 09:24:38 2018 +0300 Avoid compilation warning in w32fns.c * src/w32fns.c (Fw32_read_registry): Avoid compiler warning regarding possible use of 'rootkey' without initializing it first. Reported by Andy Moreton . diff --git a/src/w32fns.c b/src/w32fns.c index c32868fa69..b587677f09 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -10125,7 +10125,7 @@ to be converted to forward slashes by the caller. */) CHECK_STRING (key); CHECK_STRING (name); - HKEY rootkey; + HKEY rootkey = HKEY_CURRENT_USER; if (EQ (root, QHKCR)) rootkey = HKEY_CLASSES_ROOT; else if (EQ (root, QHKCU)) @@ -10139,10 +10139,7 @@ to be converted to forward slashes by the caller. */) else if (!NILP (root)) error ("unknown root key: %s", SDATA (SYMBOL_NAME (root))); - Lisp_Object val = w32_read_registry (NILP (root) - ? HKEY_CURRENT_USER - : rootkey, - key, name); + Lisp_Object val = w32_read_registry (rootkey, key, name); if (NILP (val) && NILP (root)) val = w32_read_registry (HKEY_LOCAL_MACHINE, key, name); commit 33002872364c69e2e6004fb981a8c975c3b38413 Author: Paul Eggert Date: Fri Aug 17 12:37:57 2018 -0700 Improve â€abs’ performance * src/floatfns.c (Fabs): Improve performance by not copying the argument if it would eql the result. As a minor detail, don't assume fixnums are two’s complement. diff --git a/src/floatfns.c b/src/floatfns.c index bbf7df4db3..ea2eb1016b 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -266,30 +266,43 @@ DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0, DEFUN ("abs", Fabs, Sabs, 1, 1, 0, doc: /* Return the absolute value of ARG. */) - (register Lisp_Object arg) + (Lisp_Object arg) { CHECK_NUMBER (arg); - if (BIGNUMP (arg)) + if (FIXNUMP (arg)) { - mpz_t val; - mpz_init (val); - mpz_abs (val, XBIGNUM (arg)->value); - arg = make_number (val); - mpz_clear (val); + if (XFIXNUM (arg) < 0) + { + EMACS_INT absarg = -XFIXNUM (arg); + if (absarg <= MOST_POSITIVE_FIXNUM) + arg = make_fixnum (absarg); + else + { + mpz_t val; + mpz_init (val); + mpz_set_intmax (val, absarg); + arg = make_number (val); + mpz_clear (val); + } + } } - else if (FIXNUMP (arg) && XFIXNUM (arg) == MOST_NEGATIVE_FIXNUM) + else if (FLOATP (arg)) { - mpz_t val; - mpz_init (val); - mpz_set_intmax (val, - MOST_NEGATIVE_FIXNUM); - arg = make_number (val); - mpz_clear (val); + if (signbit (XFLOAT_DATA (arg))) + arg = make_float (- XFLOAT_DATA (arg)); + } + else + { + if (mpz_sgn (XBIGNUM (arg)->value) < 0) + { + mpz_t val; + mpz_init (val); + mpz_neg (val, XBIGNUM (arg)->value); + arg = make_number (val); + mpz_clear (val); + } } - else if (FLOATP (arg)) - arg = make_float (fabs (XFLOAT_DATA (arg))); - else if (XFIXNUM (arg) < 0) - XSETINT (arg, - XFIXNUM (arg)); return arg; } commit 7bc9ce7431ae6ab4e6828015f75caf1f2196a97c Author: Basil L. Contovounesios Date: Wed Aug 15 10:03:23 2018 +0300 Fix duplicate custom group names in bibtex.el * lisp/textmodes/bibtex.el (bibtex-BibTeX-entry-alist): Change :group from BibTeX to bibtex. (bug#32436) diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index efab9d8e3b..6294b8026c 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -457,7 +457,7 @@ INIT is either the initial content of the field or a function, which is called to determine the initial content of the field. ALTERNATIVE if non-nil is an integer that numbers sets of alternatives, starting from zero." - :group 'BibTeX + :group 'bibtex :version "26.1" ; add Conference :type 'bibtex-entry-alist) (put 'bibtex-BibTeX-entry-alist 'risky-local-variable t) commit 9189afc1a823703e1cef648538ac4b22182eb099 Author: Eli Zaretskii Date: Fri Aug 17 17:56:53 2018 +0300 Improve documentation of bignums * etc/NEWS: Enhance the announcement of bignums. * doc/lispref/numbers.texi (Integer Basics): Add a missing period. Reported by Basil L. Contovounesios . diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi index bd633b77c3..37d2c31649 100644 --- a/doc/lispref/numbers.texi +++ b/doc/lispref/numbers.texi @@ -37,7 +37,7 @@ numbers have a fixed amount of precision. Integers in Emacs Lisp can have arbitrary precision. Under the hood, though, there are two kinds of integers: smaller -ones, called @dfn{fixnums}, and larger ones, called @dfn{bignums} +ones, called @dfn{fixnums}, and larger ones, called @dfn{bignums}. Some functions in Emacs only accept fixnums. Also, while fixnums can always be compared for equality with @code{eq}, bignums require the use of @code{eql}. diff --git a/etc/NEWS b/etc/NEWS index d1a6868794..a9f8ed2ef8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -858,9 +858,18 @@ otherwise, it returns nil. 'format-proper-list-p' is now an obsolete alias for the new function. +++ -** Emacs Lisp integers can be of arbitrary precision. The new -predicates 'bignump' and 'fixnump' can be used to distinguish between -the types of integers. +** Emacs Lisp integers can now be of arbitrary size. +Emacs uses the GNU Multiple Precision (GMP) library to support +integers whose size is too large to support natively. The integers +supported natively are known as "fixnums", while the larger ones are +"bignums". The new predicates 'bignump' and 'fixnump' can be used to +distinguish between these two types of integers. + +All the arithmetic, comparison, and logical (a.k.a. "bitwise") +operations where bignums make sense now support both fixnums and +bignums. However, note that unlike fixnums, bignums will not compare +equal with 'eq', you must use 'eql' instead. (Numerical comparison +with '=' works on both, of course.) ** define-minor-mode automatically documents the meaning of ARG commit cc5325b0bea13bd93478fcee0b035877b3a72290 Author: Andy Moreton Date: Tue Aug 14 13:59:08 2018 +0100 Pacify -Wcast-function-type warnings in GCC 8.1 * src/image.c: Move attributes into DEF_DLL_FN call. * src/dynlib.c (dynlib_addr): Use get_proc_addr. * src/w32.h: (get_proc_addr): New function. (LOAD_DLL_FN): Use it. (DEF_DLL_FN): Allow function attributes after argument list. Add function pointer type used by LOAD_DLL_FN. * src/w32.c (open_process_token, get_token_information) (lookup_account_sid, get_sid_sub_authority) (get_sid_sub_authority_count, get_security_info) (get_file_security, set_file_security) (set_named_security_info) (get_security_descriptor_owner, get_security_descriptor_group) (get_security_descriptor_dacl, is_valid_sid, equal_sid) (get_length_sid, copy_sid, get_native_system_info) (get_system_times, create_symbolic_link) (is_valid_security_descriptor, convert_sd_to_sddl) (convert_sddl_to_sd, get_adapters_info, reg_open_key_ex_w) (reg_query_value_ex_w, expand_environment_strings_w) (init_environment, create_toolhelp32_snapshot) (process32_first, process32_next, open_thread_token) (impersonate_self, revert_to_self, get_process_memory_info) (get_process_working_set_size, global_memory_status) (global_memory_status_ex, init_winsock) (maybe_load_unicows_dll, globals_of_w32): Use get_proc_addr. * src/w32fns.c (setup_w32_kbdhook, Ffile_system_info) (get_dll_version, w32_reset_stack_overflow_guard) (w32_backtrace, globals_of_w32fns): Use get_proc_addr. * src/w32font.c (get_outline_metrics_w, get_text_metrics_w) (get_glyph_outline_w, get_char_width_32_w): Use get_proc_addr. * src/w32heap.c (init_heap): Use get_proc_addr. * src/w32menu.c (globals_of_w32menu): Use get_proc_addr. * src/w32proc.c (init_timers, sys_kill, w32_compare_strings): Use get_proc_addr. * src/w32uniscribe.c (syms_of_w32uniscribe): Use get_proc_addr. diff --git a/src/dynlib.c b/src/dynlib.c index 53afdafa2d..d40aa67f41 100644 --- a/src/dynlib.c +++ b/src/dynlib.c @@ -156,9 +156,8 @@ dynlib_addr (void *addr, const char **fname, const char **symname) address we pass to it is not an address of a string, but an address of a function. So we don't care about the Unicode version. */ - s_pfn_Get_Module_HandleExA = - (GetModuleHandleExA_Proc) GetProcAddress (hm_kernel32, - "GetModuleHandleExA"); + s_pfn_Get_Module_HandleExA = (GetModuleHandleExA_Proc) + get_proc_addr (hm_kernel32, "GetModuleHandleExA"); } if (s_pfn_Get_Module_HandleExA) { diff --git a/src/image.c b/src/image.c index 499c1b6aed..7866b9cc46 100644 --- a/src/image.c +++ b/src/image.c @@ -5734,7 +5734,7 @@ DEF_DLL_FN (void, png_read_end, (png_structp, png_infop)); DEF_DLL_FN (void, png_error, (png_structp, png_const_charp)); # if (PNG_LIBPNG_VER >= 10500) -DEF_DLL_FN (void, png_longjmp, (png_structp, int)) PNG_NORETURN; +DEF_DLL_FN (void, png_longjmp, (png_structp, int) PNG_NORETURN); DEF_DLL_FN (jmp_buf *, png_set_longjmp_fn, (png_structp, png_longjmp_ptr, size_t)); # endif /* libpng version >= 1.5 */ diff --git a/src/w32.c b/src/w32.c index ef6047580e..78f946c634 100644 --- a/src/w32.c +++ b/src/w32.c @@ -576,8 +576,8 @@ open_process_token (HANDLE ProcessHandle, { g_b_init_open_process_token = 1; hm_advapi32 = LoadLibrary ("Advapi32.dll"); - s_pfn_Open_Process_Token = - (OpenProcessToken_Proc) GetProcAddress (hm_advapi32, "OpenProcessToken"); + s_pfn_Open_Process_Token = (OpenProcessToken_Proc) + get_proc_addr (hm_advapi32, "OpenProcessToken"); } if (s_pfn_Open_Process_Token == NULL) { @@ -608,8 +608,8 @@ get_token_information (HANDLE TokenHandle, { g_b_init_get_token_information = 1; hm_advapi32 = LoadLibrary ("Advapi32.dll"); - s_pfn_Get_Token_Information = - (GetTokenInformation_Proc) GetProcAddress (hm_advapi32, "GetTokenInformation"); + s_pfn_Get_Token_Information = (GetTokenInformation_Proc) + get_proc_addr (hm_advapi32, "GetTokenInformation"); } if (s_pfn_Get_Token_Information == NULL) { @@ -644,8 +644,8 @@ lookup_account_sid (LPCTSTR lpSystemName, { g_b_init_lookup_account_sid = 1; hm_advapi32 = LoadLibrary ("Advapi32.dll"); - s_pfn_Lookup_Account_Sid = - (LookupAccountSid_Proc) GetProcAddress (hm_advapi32, LookupAccountSid_Name); + s_pfn_Lookup_Account_Sid = (LookupAccountSid_Proc) + get_proc_addr (hm_advapi32, LookupAccountSid_Name); } if (s_pfn_Lookup_Account_Sid == NULL) { @@ -677,9 +677,8 @@ get_sid_sub_authority (PSID pSid, DWORD n) { g_b_init_get_sid_sub_authority = 1; hm_advapi32 = LoadLibrary ("Advapi32.dll"); - s_pfn_Get_Sid_Sub_Authority = - (GetSidSubAuthority_Proc) GetProcAddress ( - hm_advapi32, "GetSidSubAuthority"); + s_pfn_Get_Sid_Sub_Authority = (GetSidSubAuthority_Proc) + get_proc_addr (hm_advapi32, "GetSidSubAuthority"); } if (s_pfn_Get_Sid_Sub_Authority == NULL) { @@ -702,9 +701,8 @@ get_sid_sub_authority_count (PSID pSid) { g_b_init_get_sid_sub_authority_count = 1; hm_advapi32 = LoadLibrary ("Advapi32.dll"); - s_pfn_Get_Sid_Sub_Authority_Count = - (GetSidSubAuthorityCount_Proc) GetProcAddress ( - hm_advapi32, "GetSidSubAuthorityCount"); + s_pfn_Get_Sid_Sub_Authority_Count = (GetSidSubAuthorityCount_Proc) + get_proc_addr (hm_advapi32, "GetSidSubAuthorityCount"); } if (s_pfn_Get_Sid_Sub_Authority_Count == NULL) { @@ -733,9 +731,8 @@ get_security_info (HANDLE handle, { g_b_init_get_security_info = 1; hm_advapi32 = LoadLibrary ("Advapi32.dll"); - s_pfn_Get_Security_Info = - (GetSecurityInfo_Proc) GetProcAddress ( - hm_advapi32, "GetSecurityInfo"); + s_pfn_Get_Security_Info = (GetSecurityInfo_Proc) + get_proc_addr (hm_advapi32, "GetSecurityInfo"); } if (s_pfn_Get_Security_Info == NULL) { @@ -769,9 +766,8 @@ get_file_security (const char *lpFileName, { g_b_init_get_file_security_w = 1; hm_advapi32 = LoadLibrary ("Advapi32.dll"); - s_pfn_Get_File_SecurityW = - (GetFileSecurityW_Proc) GetProcAddress (hm_advapi32, - "GetFileSecurityW"); + s_pfn_Get_File_SecurityW = (GetFileSecurityW_Proc) + get_proc_addr (hm_advapi32, "GetFileSecurityW"); } if (s_pfn_Get_File_SecurityW == NULL) { @@ -791,9 +787,8 @@ get_file_security (const char *lpFileName, { g_b_init_get_file_security_a = 1; hm_advapi32 = LoadLibrary ("Advapi32.dll"); - s_pfn_Get_File_SecurityA = - (GetFileSecurityA_Proc) GetProcAddress (hm_advapi32, - "GetFileSecurityA"); + s_pfn_Get_File_SecurityA = (GetFileSecurityA_Proc) + get_proc_addr (hm_advapi32, "GetFileSecurityA"); } if (s_pfn_Get_File_SecurityA == NULL) { @@ -828,9 +823,8 @@ set_file_security (const char *lpFileName, { g_b_init_set_file_security_w = 1; hm_advapi32 = LoadLibrary ("Advapi32.dll"); - s_pfn_Set_File_SecurityW = - (SetFileSecurityW_Proc) GetProcAddress (hm_advapi32, - "SetFileSecurityW"); + s_pfn_Set_File_SecurityW = (SetFileSecurityW_Proc) + get_proc_addr (hm_advapi32, "SetFileSecurityW"); } if (s_pfn_Set_File_SecurityW == NULL) { @@ -849,9 +843,8 @@ set_file_security (const char *lpFileName, { g_b_init_set_file_security_a = 1; hm_advapi32 = LoadLibrary ("Advapi32.dll"); - s_pfn_Set_File_SecurityA = - (SetFileSecurityA_Proc) GetProcAddress (hm_advapi32, - "SetFileSecurityA"); + s_pfn_Set_File_SecurityA = (SetFileSecurityA_Proc) + get_proc_addr (hm_advapi32, "SetFileSecurityA"); } if (s_pfn_Set_File_SecurityA == NULL) { @@ -889,9 +882,8 @@ set_named_security_info (LPCTSTR lpObjectName, { g_b_init_set_named_security_info_w = 1; hm_advapi32 = LoadLibrary ("Advapi32.dll"); - s_pfn_Set_Named_Security_InfoW = - (SetNamedSecurityInfoW_Proc) GetProcAddress (hm_advapi32, - "SetNamedSecurityInfoW"); + s_pfn_Set_Named_Security_InfoW = (SetNamedSecurityInfoW_Proc) + get_proc_addr (hm_advapi32, "SetNamedSecurityInfoW"); } if (s_pfn_Set_Named_Security_InfoW == NULL) { @@ -911,9 +903,8 @@ set_named_security_info (LPCTSTR lpObjectName, { g_b_init_set_named_security_info_a = 1; hm_advapi32 = LoadLibrary ("Advapi32.dll"); - s_pfn_Set_Named_Security_InfoA = - (SetNamedSecurityInfoA_Proc) GetProcAddress (hm_advapi32, - "SetNamedSecurityInfoA"); + s_pfn_Set_Named_Security_InfoA = (SetNamedSecurityInfoA_Proc) + get_proc_addr (hm_advapi32, "SetNamedSecurityInfoA"); } if (s_pfn_Set_Named_Security_InfoA == NULL) { @@ -943,9 +934,8 @@ get_security_descriptor_owner (PSECURITY_DESCRIPTOR pSecurityDescriptor, { g_b_init_get_security_descriptor_owner = 1; hm_advapi32 = LoadLibrary ("Advapi32.dll"); - s_pfn_Get_Security_Descriptor_Owner = - (GetSecurityDescriptorOwner_Proc) GetProcAddress ( - hm_advapi32, "GetSecurityDescriptorOwner"); + s_pfn_Get_Security_Descriptor_Owner = (GetSecurityDescriptorOwner_Proc) + get_proc_addr (hm_advapi32, "GetSecurityDescriptorOwner"); } if (s_pfn_Get_Security_Descriptor_Owner == NULL) { @@ -972,9 +962,8 @@ get_security_descriptor_group (PSECURITY_DESCRIPTOR pSecurityDescriptor, { g_b_init_get_security_descriptor_group = 1; hm_advapi32 = LoadLibrary ("Advapi32.dll"); - s_pfn_Get_Security_Descriptor_Group = - (GetSecurityDescriptorGroup_Proc) GetProcAddress ( - hm_advapi32, "GetSecurityDescriptorGroup"); + s_pfn_Get_Security_Descriptor_Group = (GetSecurityDescriptorGroup_Proc) + get_proc_addr (hm_advapi32, "GetSecurityDescriptorGroup"); } if (s_pfn_Get_Security_Descriptor_Group == NULL) { @@ -1002,9 +991,8 @@ get_security_descriptor_dacl (PSECURITY_DESCRIPTOR pSecurityDescriptor, { g_b_init_get_security_descriptor_dacl = 1; hm_advapi32 = LoadLibrary ("Advapi32.dll"); - s_pfn_Get_Security_Descriptor_Dacl = - (GetSecurityDescriptorDacl_Proc) GetProcAddress ( - hm_advapi32, "GetSecurityDescriptorDacl"); + s_pfn_Get_Security_Descriptor_Dacl = (GetSecurityDescriptorDacl_Proc) + get_proc_addr (hm_advapi32, "GetSecurityDescriptorDacl"); } if (s_pfn_Get_Security_Descriptor_Dacl == NULL) { @@ -1029,9 +1017,8 @@ is_valid_sid (PSID sid) { g_b_init_is_valid_sid = 1; hm_advapi32 = LoadLibrary ("Advapi32.dll"); - s_pfn_Is_Valid_Sid = - (IsValidSid_Proc) GetProcAddress ( - hm_advapi32, "IsValidSid"); + s_pfn_Is_Valid_Sid = (IsValidSid_Proc) + get_proc_addr (hm_advapi32, "IsValidSid"); } if (s_pfn_Is_Valid_Sid == NULL) { @@ -1053,9 +1040,8 @@ equal_sid (PSID sid1, PSID sid2) { g_b_init_equal_sid = 1; hm_advapi32 = LoadLibrary ("Advapi32.dll"); - s_pfn_Equal_Sid = - (EqualSid_Proc) GetProcAddress ( - hm_advapi32, "EqualSid"); + s_pfn_Equal_Sid = (EqualSid_Proc) + get_proc_addr (hm_advapi32, "EqualSid"); } if (s_pfn_Equal_Sid == NULL) { @@ -1077,9 +1063,8 @@ get_length_sid (PSID sid) { g_b_init_get_length_sid = 1; hm_advapi32 = LoadLibrary ("Advapi32.dll"); - s_pfn_Get_Length_Sid = - (GetLengthSid_Proc) GetProcAddress ( - hm_advapi32, "GetLengthSid"); + s_pfn_Get_Length_Sid = (GetLengthSid_Proc) + get_proc_addr (hm_advapi32, "GetLengthSid"); } if (s_pfn_Get_Length_Sid == NULL) { @@ -1101,9 +1086,8 @@ copy_sid (DWORD destlen, PSID dest, PSID src) { g_b_init_copy_sid = 1; hm_advapi32 = LoadLibrary ("Advapi32.dll"); - s_pfn_Copy_Sid = - (CopySid_Proc) GetProcAddress ( - hm_advapi32, "CopySid"); + s_pfn_Copy_Sid = (CopySid_Proc) + get_proc_addr (hm_advapi32, "CopySid"); } if (s_pfn_Copy_Sid == NULL) { @@ -1127,9 +1111,9 @@ get_native_system_info (LPSYSTEM_INFO lpSystemInfo) if (g_b_init_get_native_system_info == 0) { g_b_init_get_native_system_info = 1; - s_pfn_Get_Native_System_Info = - (GetNativeSystemInfo_Proc)GetProcAddress (GetModuleHandle ("kernel32.dll"), - "GetNativeSystemInfo"); + s_pfn_Get_Native_System_Info = (GetNativeSystemInfo_Proc) + get_proc_addr (GetModuleHandle ("kernel32.dll"), + "GetNativeSystemInfo"); } if (s_pfn_Get_Native_System_Info != NULL) s_pfn_Get_Native_System_Info (lpSystemInfo); @@ -1151,9 +1135,9 @@ get_system_times (LPFILETIME lpIdleTime, if (g_b_init_get_system_times == 0) { g_b_init_get_system_times = 1; - s_pfn_Get_System_times = - (GetSystemTimes_Proc)GetProcAddress (GetModuleHandle ("kernel32.dll"), - "GetSystemTimes"); + s_pfn_Get_System_times = (GetSystemTimes_Proc) + get_proc_addr (GetModuleHandle ("kernel32.dll"), + "GetSystemTimes"); } if (s_pfn_Get_System_times == NULL) return FALSE; @@ -1181,9 +1165,9 @@ create_symbolic_link (LPCSTR lpSymlinkFilename, if (g_b_init_create_symbolic_link_w == 0) { g_b_init_create_symbolic_link_w = 1; - s_pfn_Create_Symbolic_LinkW = - (CreateSymbolicLinkW_Proc)GetProcAddress (GetModuleHandle ("kernel32.dll"), - "CreateSymbolicLinkW"); + s_pfn_Create_Symbolic_LinkW = (CreateSymbolicLinkW_Proc) + get_proc_addr (GetModuleHandle ("kernel32.dll"), + "CreateSymbolicLinkW"); } if (s_pfn_Create_Symbolic_LinkW == NULL) { @@ -1216,9 +1200,9 @@ create_symbolic_link (LPCSTR lpSymlinkFilename, if (g_b_init_create_symbolic_link_a == 0) { g_b_init_create_symbolic_link_a = 1; - s_pfn_Create_Symbolic_LinkA = - (CreateSymbolicLinkA_Proc)GetProcAddress (GetModuleHandle ("kernel32.dll"), - "CreateSymbolicLinkA"); + s_pfn_Create_Symbolic_LinkA = (CreateSymbolicLinkA_Proc) + get_proc_addr (GetModuleHandle ("kernel32.dll"), + "CreateSymbolicLinkA"); } if (s_pfn_Create_Symbolic_LinkA == NULL) { @@ -1261,9 +1245,9 @@ is_valid_security_descriptor (PSECURITY_DESCRIPTOR pSecurityDescriptor) if (g_b_init_is_valid_security_descriptor == 0) { g_b_init_is_valid_security_descriptor = 1; - s_pfn_Is_Valid_Security_Descriptor_Proc = - (IsValidSecurityDescriptor_Proc)GetProcAddress (GetModuleHandle ("Advapi32.dll"), - "IsValidSecurityDescriptor"); + s_pfn_Is_Valid_Security_Descriptor_Proc = (IsValidSecurityDescriptor_Proc) + get_proc_addr (GetModuleHandle ("Advapi32.dll"), + "IsValidSecurityDescriptor"); } if (s_pfn_Is_Valid_Security_Descriptor_Proc == NULL) { @@ -1295,12 +1279,14 @@ convert_sd_to_sddl (PSECURITY_DESCRIPTOR SecurityDescriptor, g_b_init_convert_sd_to_sddl = 1; #ifdef _UNICODE s_pfn_Convert_SD_To_SDDL = - (ConvertSecurityDescriptorToStringSecurityDescriptor_Proc)GetProcAddress (GetModuleHandle ("Advapi32.dll"), - "ConvertSecurityDescriptorToStringSecurityDescriptorW"); + (ConvertSecurityDescriptorToStringSecurityDescriptor_Proc) + get_proc_addr (GetModuleHandle ("Advapi32.dll"), + "ConvertSecurityDescriptorToStringSecurityDescriptorW"); #else s_pfn_Convert_SD_To_SDDL = - (ConvertSecurityDescriptorToStringSecurityDescriptor_Proc)GetProcAddress (GetModuleHandle ("Advapi32.dll"), - "ConvertSecurityDescriptorToStringSecurityDescriptorA"); + (ConvertSecurityDescriptorToStringSecurityDescriptor_Proc) + get_proc_addr (GetModuleHandle ("Advapi32.dll"), + "ConvertSecurityDescriptorToStringSecurityDescriptorA"); #endif } if (s_pfn_Convert_SD_To_SDDL == NULL) @@ -1338,12 +1324,14 @@ convert_sddl_to_sd (LPCTSTR StringSecurityDescriptor, g_b_init_convert_sddl_to_sd = 1; #ifdef _UNICODE s_pfn_Convert_SDDL_To_SD = - (ConvertStringSecurityDescriptorToSecurityDescriptor_Proc)GetProcAddress (GetModuleHandle ("Advapi32.dll"), - "ConvertStringSecurityDescriptorToSecurityDescriptorW"); + (ConvertStringSecurityDescriptorToSecurityDescriptor_Proc) + get_proc_addr (GetModuleHandle ("Advapi32.dll"), + "ConvertStringSecurityDescriptorToSecurityDescriptorW"); #else s_pfn_Convert_SDDL_To_SD = - (ConvertStringSecurityDescriptorToSecurityDescriptor_Proc)GetProcAddress (GetModuleHandle ("Advapi32.dll"), - "ConvertStringSecurityDescriptorToSecurityDescriptorA"); + (ConvertStringSecurityDescriptorToSecurityDescriptor_Proc) + get_proc_addr (GetModuleHandle ("Advapi32.dll"), + "ConvertStringSecurityDescriptorToSecurityDescriptorA"); #endif } if (s_pfn_Convert_SDDL_To_SD == NULL) @@ -1375,7 +1363,7 @@ get_adapters_info (PIP_ADAPTER_INFO pAdapterInfo, PULONG pOutBufLen) hm_iphlpapi = LoadLibrary ("Iphlpapi.dll"); if (hm_iphlpapi) s_pfn_Get_Adapters_Info = (GetAdaptersInfo_Proc) - GetProcAddress (hm_iphlpapi, "GetAdaptersInfo"); + get_proc_addr (hm_iphlpapi, "GetAdaptersInfo"); } if (s_pfn_Get_Adapters_Info == NULL) return ERROR_NOT_SUPPORTED; @@ -1398,7 +1386,7 @@ reg_open_key_ex_w (HKEY hkey, LPCWSTR lpSubKey, DWORD ulOptions, hm_advapi32 = LoadLibrary ("Advapi32.dll"); if (hm_advapi32) s_pfn_Reg_Open_Key_Ex_w = (RegOpenKeyExW_Proc) - GetProcAddress (hm_advapi32, "RegOpenKeyExW"); + get_proc_addr (hm_advapi32, "RegOpenKeyExW"); } if (s_pfn_Reg_Open_Key_Ex_w == NULL) return ERROR_NOT_SUPPORTED; @@ -1422,7 +1410,7 @@ reg_query_value_ex_w (HKEY hkey, LPCWSTR lpValueName, LPDWORD lpReserved, hm_advapi32 = LoadLibrary ("Advapi32.dll"); if (hm_advapi32) s_pfn_Reg_Query_Value_Ex_w = (RegQueryValueExW_Proc) - GetProcAddress (hm_advapi32, "RegQueryValueExW"); + get_proc_addr (hm_advapi32, "RegQueryValueExW"); } if (s_pfn_Reg_Query_Value_Ex_w == NULL) return ERROR_NOT_SUPPORTED; @@ -1445,7 +1433,7 @@ expand_environment_strings_w (LPCWSTR lpSrc, LPWSTR lpDst, DWORD nSize) hm_kernel32 = LoadLibrary ("Kernel32.dll"); if (hm_kernel32) s_pfn_Expand_Environment_Strings_w = (ExpandEnvironmentStringsW_Proc) - GetProcAddress (hm_kernel32, "ExpandEnvironmentStringsW"); + get_proc_addr (hm_kernel32, "ExpandEnvironmentStringsW"); } if (s_pfn_Expand_Environment_Strings_w == NULL) { @@ -2807,7 +2795,8 @@ init_environment (char ** argv) MSIE 5. */ ShGetFolderPath_fn get_folder_path; get_folder_path = (ShGetFolderPath_fn) - GetProcAddress (GetModuleHandle ("shell32.dll"), "SHGetFolderPathA"); + get_proc_addr (GetModuleHandle ("shell32.dll"), + "SHGetFolderPathA"); if (get_folder_path != NULL) { @@ -6639,8 +6628,8 @@ create_toolhelp32_snapshot (DWORD Flags, DWORD Ignored) { g_b_init_create_toolhelp32_snapshot = 1; s_pfn_Create_Toolhelp32_Snapshot = (CreateToolhelp32Snapshot_Proc) - GetProcAddress (GetModuleHandle ("kernel32.dll"), - "CreateToolhelp32Snapshot"); + get_proc_addr (GetModuleHandle ("kernel32.dll"), + "CreateToolhelp32Snapshot"); } if (s_pfn_Create_Toolhelp32_Snapshot == NULL) { @@ -6658,8 +6647,8 @@ process32_first (HANDLE hSnapshot, LPPROCESSENTRY32 lppe) { g_b_init_process32_first = 1; s_pfn_Process32_First = (Process32First_Proc) - GetProcAddress (GetModuleHandle ("kernel32.dll"), - "Process32First"); + get_proc_addr (GetModuleHandle ("kernel32.dll"), + "Process32First"); } if (s_pfn_Process32_First == NULL) { @@ -6677,8 +6666,8 @@ process32_next (HANDLE hSnapshot, LPPROCESSENTRY32 lppe) { g_b_init_process32_next = 1; s_pfn_Process32_Next = (Process32Next_Proc) - GetProcAddress (GetModuleHandle ("kernel32.dll"), - "Process32Next"); + get_proc_addr (GetModuleHandle ("kernel32.dll"), + "Process32Next"); } if (s_pfn_Process32_Next == NULL) { @@ -6704,8 +6693,8 @@ open_thread_token (HANDLE ThreadHandle, { g_b_init_open_thread_token = 1; hm_advapi32 = LoadLibrary ("Advapi32.dll"); - s_pfn_Open_Thread_Token = - (OpenThreadToken_Proc) GetProcAddress (hm_advapi32, "OpenThreadToken"); + s_pfn_Open_Thread_Token = (OpenThreadToken_Proc) + get_proc_addr (hm_advapi32, "OpenThreadToken"); } if (s_pfn_Open_Thread_Token == NULL) { @@ -6734,8 +6723,8 @@ impersonate_self (SECURITY_IMPERSONATION_LEVEL ImpersonationLevel) { g_b_init_impersonate_self = 1; hm_advapi32 = LoadLibrary ("Advapi32.dll"); - s_pfn_Impersonate_Self = - (ImpersonateSelf_Proc) GetProcAddress (hm_advapi32, "ImpersonateSelf"); + s_pfn_Impersonate_Self = (ImpersonateSelf_Proc) + get_proc_addr (hm_advapi32, "ImpersonateSelf"); } if (s_pfn_Impersonate_Self == NULL) { @@ -6757,8 +6746,8 @@ revert_to_self (void) { g_b_init_revert_to_self = 1; hm_advapi32 = LoadLibrary ("Advapi32.dll"); - s_pfn_Revert_To_Self = - (RevertToSelf_Proc) GetProcAddress (hm_advapi32, "RevertToSelf"); + s_pfn_Revert_To_Self = (RevertToSelf_Proc) + get_proc_addr (hm_advapi32, "RevertToSelf"); } if (s_pfn_Revert_To_Self == NULL) { @@ -6784,7 +6773,7 @@ get_process_memory_info (HANDLE h_proc, hm_psapi = LoadLibrary ("Psapi.dll"); if (hm_psapi) s_pfn_Get_Process_Memory_Info = (GetProcessMemoryInfo_Proc) - GetProcAddress (hm_psapi, "GetProcessMemoryInfo"); + get_proc_addr (hm_psapi, "GetProcessMemoryInfo"); } if (s_pfn_Get_Process_Memory_Info == NULL) { @@ -6809,8 +6798,8 @@ get_process_working_set_size (HANDLE h_proc, { g_b_init_get_process_working_set_size = 1; s_pfn_Get_Process_Working_Set_Size = (GetProcessWorkingSetSize_Proc) - GetProcAddress (GetModuleHandle ("kernel32.dll"), - "GetProcessWorkingSetSize"); + get_proc_addr (GetModuleHandle ("kernel32.dll"), + "GetProcessWorkingSetSize"); } if (s_pfn_Get_Process_Working_Set_Size == NULL) { @@ -6832,8 +6821,8 @@ global_memory_status (MEMORYSTATUS *buf) { g_b_init_global_memory_status = 1; s_pfn_Global_Memory_Status = (GlobalMemoryStatus_Proc) - GetProcAddress (GetModuleHandle ("kernel32.dll"), - "GlobalMemoryStatus"); + get_proc_addr (GetModuleHandle ("kernel32.dll"), + "GlobalMemoryStatus"); } if (s_pfn_Global_Memory_Status == NULL) { @@ -6855,8 +6844,8 @@ global_memory_status_ex (MEMORY_STATUS_EX *buf) { g_b_init_global_memory_status_ex = 1; s_pfn_Global_Memory_Status_Ex = (GlobalMemoryStatusEx_Proc) - GetProcAddress (GetModuleHandle ("kernel32.dll"), - "GlobalMemoryStatusEx"); + get_proc_addr (GetModuleHandle ("kernel32.dll"), + "GlobalMemoryStatusEx"); } if (s_pfn_Global_Memory_Status_Ex == NULL) { @@ -7428,8 +7417,8 @@ init_winsock (int load_now) return TRUE; pfn_SetHandleInformation - = (void *) GetProcAddress (GetModuleHandle ("kernel32.dll"), - "SetHandleInformation"); + = (void *) get_proc_addr (GetModuleHandle ("kernel32.dll"), + "SetHandleInformation"); winsock_lib = LoadLibrary ("Ws2_32.dll"); @@ -7438,7 +7427,7 @@ init_winsock (int load_now) /* dynamically link to socket functions */ #define LOAD_PROC(fn) \ - if ((pfn_##fn = (void *) GetProcAddress (winsock_lib, #fn)) == NULL) \ + if ((pfn_##fn = (void *) get_proc_addr (winsock_lib, #fn)) == NULL) \ goto fail; LOAD_PROC (WSAStartup); @@ -7473,8 +7462,8 @@ init_winsock (int load_now) #undef LOAD_PROC /* Try loading functions not available before XP. */ - pfn_getaddrinfo = (void *) GetProcAddress (winsock_lib, "getaddrinfo"); - pfn_freeaddrinfo = (void *) GetProcAddress (winsock_lib, "freeaddrinfo"); + pfn_getaddrinfo = (void *) get_proc_addr (winsock_lib, "getaddrinfo"); + pfn_freeaddrinfo = (void *) get_proc_addr (winsock_lib, "freeaddrinfo"); /* Paranoia: these two functions should go together, so if one is absent, we cannot use the other. */ if (pfn_getaddrinfo == NULL) @@ -9892,10 +9881,10 @@ maybe_load_unicows_dll (void) pointers, and assign the correct addresses to these pointers at program startup (see emacs.c, which calls this function early on). */ - pMultiByteToWideChar = - (MultiByteToWideChar_Proc)GetProcAddress (ret, "MultiByteToWideChar"); - pWideCharToMultiByte = - (WideCharToMultiByte_Proc)GetProcAddress (ret, "WideCharToMultiByte"); + pMultiByteToWideChar = (MultiByteToWideChar_Proc) + get_proc_addr (ret, "MultiByteToWideChar"); + pWideCharToMultiByte = (WideCharToMultiByte_Proc) + get_proc_addr (ret, "WideCharToMultiByte"); multiByteToWideCharFlags = MB_ERR_INVALID_CHARS; return ret; } @@ -9946,7 +9935,7 @@ globals_of_w32 (void) HMODULE kernel32 = GetModuleHandle ("kernel32.dll"); get_process_times_fn = (GetProcessTimes_Proc) - GetProcAddress (kernel32, "GetProcessTimes"); + get_proc_addr (kernel32, "GetProcessTimes"); DEFSYM (QCloaded_from, ":loaded-from"); diff --git a/src/w32.h b/src/w32.h index fe8689a07b..a053ee0fc4 100644 --- a/src/w32.h +++ b/src/w32.h @@ -164,6 +164,10 @@ extern void reset_standard_handles (int in, int out, /* Return the string resource associated with KEY of type TYPE. */ extern LPBYTE w32_get_resource (const char * key, LPDWORD type); +/* Load a function from a DLL. Defined in this file. */ +typedef void (* VOIDFNPTR) (void); +INLINE VOIDFNPTR get_proc_addr (HINSTANCE handle, LPCSTR fname); + extern void release_listen_threads (void); extern void init_ntproc (int); extern void term_ntproc (int); @@ -241,14 +245,30 @@ extern ssize_t emacs_gnutls_push (gnutls_transport_ptr_t p, const void* buf, size_t sz); #endif /* HAVE_GNUTLS */ -/* Definine a function that will be loaded from a DLL. */ -#define DEF_DLL_FN(type, func, args) static type (FAR CDECL *fn_##func) args + + +/* Load a function address from a DLL. Cast the result via "VOIDFNPTR" + to pacify -Wcast-function-type in GCC 8.1. */ +INLINE VOIDFNPTR +get_proc_addr (HINSTANCE handle, LPCSTR fname) +{ + return (VOIDFNPTR) GetProcAddress (handle, fname); +} + +/* Define a function that will be loaded from a DLL. The variable + arguments should contain the argument list for the function, and + optionally be followed by function attributes. For example: + DEF_DLL_FN (void, png_longjmp, (png_structp, int) PNG_NORETURN); + */ +#define DEF_DLL_FN(type, func, ...) \ + typedef type (CDECL *W32_PFN_##func) __VA_ARGS__; \ + static W32_PFN_##func fn_##func /* Load a function from the DLL. */ #define LOAD_DLL_FN(lib, func) \ do \ { \ - fn_##func = (void *) GetProcAddress (lib, #func); \ + fn_##func = (W32_PFN_##func) get_proc_addr (lib, #func); \ if (!fn_##func) \ return false; \ } \ diff --git a/src/w32fns.c b/src/w32fns.c index 8d5293c1af..c32868fa69 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -2640,7 +2640,7 @@ setup_w32_kbdhook (void) if (w32_kbdhook_active) { IsDebuggerPresent_Proc is_debugger_present = (IsDebuggerPresent_Proc) - GetProcAddress (GetModuleHandle ("kernel32.dll"), "IsDebuggerPresent"); + get_proc_addr (GetModuleHandle ("kernel32.dll"), "IsDebuggerPresent"); if (is_debugger_present && is_debugger_present ()) return; } @@ -2655,7 +2655,7 @@ setup_w32_kbdhook (void) (https://support.microsoft.com/en-us/kb/124103) is used for NT 4 systems. */ GetConsoleWindow_Proc get_console = (GetConsoleWindow_Proc) - GetProcAddress (GetModuleHandle ("kernel32.dll"), "GetConsoleWindow"); + get_proc_addr (GetModuleHandle ("kernel32.dll"), "GetConsoleWindow"); if (get_console != NULL) kbdhook.console = get_console (); @@ -9117,9 +9117,9 @@ DEFUN ("file-system-info", Ffile_system_info, Sfile_system_info, 1, 1, 0, { HMODULE hKernel = GetModuleHandle ("kernel32"); GetDiskFreeSpaceExW_Proc pfn_GetDiskFreeSpaceExW = - (GetDiskFreeSpaceExW_Proc) GetProcAddress (hKernel, "GetDiskFreeSpaceExW"); + (GetDiskFreeSpaceExW_Proc) get_proc_addr (hKernel, "GetDiskFreeSpaceExW"); GetDiskFreeSpaceExA_Proc pfn_GetDiskFreeSpaceExA = - (GetDiskFreeSpaceExA_Proc) GetProcAddress (hKernel, "GetDiskFreeSpaceExA"); + (GetDiskFreeSpaceExA_Proc) get_proc_addr (hKernel, "GetDiskFreeSpaceExA"); bool have_pfn_GetDiskFreeSpaceEx = ((w32_unicode_filenames && pfn_GetDiskFreeSpaceExW) || (!w32_unicode_filenames && pfn_GetDiskFreeSpaceExA)); @@ -9694,8 +9694,8 @@ get_dll_version (const char *dll_name) if (hdll) { - DLLGETVERSIONPROC pDllGetVersion - = (DLLGETVERSIONPROC) GetProcAddress (hdll, "DllGetVersion"); + DLLGETVERSIONPROC pDllGetVersion = (DLLGETVERSIONPROC) + get_proc_addr (hdll, "DllGetVersion"); if (pDllGetVersion) { @@ -10662,9 +10662,8 @@ void w32_reset_stack_overflow_guard (void) { if (resetstkoflw == NULL) - resetstkoflw = - (_resetstkoflw_proc)GetProcAddress (GetModuleHandle ("msvcrt.dll"), - "_resetstkoflw"); + resetstkoflw = (_resetstkoflw_proc) + get_proc_addr (GetModuleHandle ("msvcrt.dll"), "_resetstkoflw"); /* We ignore the return value. If _resetstkoflw fails, the next stack overflow will crash the program. */ if (resetstkoflw != NULL) @@ -10738,9 +10737,8 @@ w32_backtrace (void **buffer, int limit) if (!s_pfn_CaptureStackBackTrace) { hm_kernel32 = LoadLibrary ("Kernel32.dll"); - s_pfn_CaptureStackBackTrace = - (CaptureStackBackTrace_proc) GetProcAddress (hm_kernel32, - "RtlCaptureStackBackTrace"); + s_pfn_CaptureStackBackTrace = (CaptureStackBackTrace_proc) + get_proc_addr (hm_kernel32, "RtlCaptureStackBackTrace"); } if (s_pfn_CaptureStackBackTrace) return s_pfn_CaptureStackBackTrace (0, min (BACKTRACE_LIMIT_MAX, limit), @@ -10873,29 +10871,29 @@ globals_of_w32fns (void) it dynamically. Do it once, here, instead of every time it is used. */ track_mouse_event_fn = (TrackMouseEvent_Proc) - GetProcAddress (user32_lib, "TrackMouseEvent"); + get_proc_addr (user32_lib, "TrackMouseEvent"); monitor_from_point_fn = (MonitorFromPoint_Proc) - GetProcAddress (user32_lib, "MonitorFromPoint"); + get_proc_addr (user32_lib, "MonitorFromPoint"); get_monitor_info_fn = (GetMonitorInfo_Proc) - GetProcAddress (user32_lib, "GetMonitorInfoA"); + get_proc_addr (user32_lib, "GetMonitorInfoA"); monitor_from_window_fn = (MonitorFromWindow_Proc) - GetProcAddress (user32_lib, "MonitorFromWindow"); + get_proc_addr (user32_lib, "MonitorFromWindow"); enum_display_monitors_fn = (EnumDisplayMonitors_Proc) - GetProcAddress (user32_lib, "EnumDisplayMonitors"); + get_proc_addr (user32_lib, "EnumDisplayMonitors"); get_title_bar_info_fn = (GetTitleBarInfo_Proc) - GetProcAddress (user32_lib, "GetTitleBarInfo"); + get_proc_addr (user32_lib, "GetTitleBarInfo"); { HMODULE imm32_lib = GetModuleHandle ("imm32.dll"); get_composition_string_fn = (ImmGetCompositionString_Proc) - GetProcAddress (imm32_lib, "ImmGetCompositionStringW"); + get_proc_addr (imm32_lib, "ImmGetCompositionStringW"); get_ime_context_fn = (ImmGetContext_Proc) - GetProcAddress (imm32_lib, "ImmGetContext"); + get_proc_addr (imm32_lib, "ImmGetContext"); release_ime_context_fn = (ImmReleaseContext_Proc) - GetProcAddress (imm32_lib, "ImmReleaseContext"); + get_proc_addr (imm32_lib, "ImmReleaseContext"); set_ime_composition_window_fn = (ImmSetCompositionWindow_Proc) - GetProcAddress (imm32_lib, "ImmSetCompositionWindow"); + get_proc_addr (imm32_lib, "ImmSetCompositionWindow"); } except_code = 0; diff --git a/src/w32font.c b/src/w32font.c index c2f5dc3746..f613061832 100644 --- a/src/w32font.c +++ b/src/w32font.c @@ -153,7 +153,7 @@ get_outline_metrics_w(HDC hdc, UINT cbData, LPOUTLINETEXTMETRICW lpotmw) hm_unicows = w32_load_unicows_or_gdi32 (); if (hm_unicows) s_pfn_Get_Outline_Text_MetricsW = (GetOutlineTextMetricsW_Proc) - GetProcAddress (hm_unicows, "GetOutlineTextMetricsW"); + get_proc_addr (hm_unicows, "GetOutlineTextMetricsW"); } eassert (s_pfn_Get_Outline_Text_MetricsW != NULL); return s_pfn_Get_Outline_Text_MetricsW (hdc, cbData, lpotmw); @@ -170,7 +170,7 @@ get_text_metrics_w(HDC hdc, LPTEXTMETRICW lptmw) hm_unicows = w32_load_unicows_or_gdi32 (); if (hm_unicows) s_pfn_Get_Text_MetricsW = (GetTextMetricsW_Proc) - GetProcAddress (hm_unicows, "GetTextMetricsW"); + get_proc_addr (hm_unicows, "GetTextMetricsW"); } eassert (s_pfn_Get_Text_MetricsW != NULL); return s_pfn_Get_Text_MetricsW (hdc, lptmw); @@ -188,7 +188,7 @@ get_glyph_outline_w (HDC hdc, UINT uChar, UINT uFormat, LPGLYPHMETRICS lpgm, hm_unicows = w32_load_unicows_or_gdi32 (); if (hm_unicows) s_pfn_Get_Glyph_OutlineW = (GetGlyphOutlineW_Proc) - GetProcAddress (hm_unicows, "GetGlyphOutlineW"); + get_proc_addr (hm_unicows, "GetGlyphOutlineW"); } eassert (s_pfn_Get_Glyph_OutlineW != NULL); return s_pfn_Get_Glyph_OutlineW (hdc, uChar, uFormat, lpgm, cbBuffer, @@ -206,7 +206,7 @@ get_char_width_32_w (HDC hdc, UINT uFirstChar, UINT uLastChar, LPINT lpBuffer) hm_unicows = w32_load_unicows_or_gdi32 (); if (hm_unicows) s_pfn_Get_Char_Width_32W = (GetCharWidth32W_Proc) - GetProcAddress (hm_unicows, "GetCharWidth32W"); + get_proc_addr (hm_unicows, "GetCharWidth32W"); } eassert (s_pfn_Get_Char_Width_32W != NULL); return s_pfn_Get_Char_Width_32W (hdc, uFirstChar, uLastChar, lpBuffer); diff --git a/src/w32heap.c b/src/w32heap.c index df79f8c2ce..8c94682506 100644 --- a/src/w32heap.c +++ b/src/w32heap.c @@ -250,7 +250,9 @@ init_heap (void) #ifndef MINGW_W64 /* Set the low-fragmentation heap for OS before Vista. */ HMODULE hm_kernel32dll = LoadLibrary ("kernel32.dll"); - HeapSetInformation_Proc s_pfn_Heap_Set_Information = (HeapSetInformation_Proc) GetProcAddress (hm_kernel32dll, "HeapSetInformation"); + HeapSetInformation_Proc s_pfn_Heap_Set_Information = + (HeapSetInformation_Proc) get_proc_addr (hm_kernel32dll, + "HeapSetInformation"); if (s_pfn_Heap_Set_Information != NULL) { if (s_pfn_Heap_Set_Information ((PVOID) heap, @@ -281,7 +283,7 @@ init_heap (void) in ntdll.dll since XP. */ HMODULE hm_ntdll = LoadLibrary ("ntdll.dll"); RtlCreateHeap_Proc s_pfn_Rtl_Create_Heap - = (RtlCreateHeap_Proc) GetProcAddress (hm_ntdll, "RtlCreateHeap"); + = (RtlCreateHeap_Proc) get_proc_addr (hm_ntdll, "RtlCreateHeap"); /* Specific parameters for the private heap. */ RTL_HEAP_PARAMETERS params; ZeroMemory (¶ms, sizeof(params)); diff --git a/src/w32menu.c b/src/w32menu.c index ece5836498..a2d39c5edf 100644 --- a/src/w32menu.c +++ b/src/w32menu.c @@ -1607,9 +1607,13 @@ globals_of_w32menu (void) #ifndef NTGUI_UNICODE /* See if Get/SetMenuItemInfo functions are available. */ HMODULE user32 = GetModuleHandle ("user32.dll"); - get_menu_item_info = (GetMenuItemInfoA_Proc) GetProcAddress (user32, "GetMenuItemInfoA"); - set_menu_item_info = (SetMenuItemInfoA_Proc) GetProcAddress (user32, "SetMenuItemInfoA"); - unicode_append_menu = (AppendMenuW_Proc) GetProcAddress (user32, "AppendMenuW"); - unicode_message_box = (MessageBoxW_Proc) GetProcAddress (user32, "MessageBoxW"); + get_menu_item_info = (GetMenuItemInfoA_Proc) + get_proc_addr (user32, "GetMenuItemInfoA"); + set_menu_item_info = (SetMenuItemInfoA_Proc) + get_proc_addr (user32, "SetMenuItemInfoA"); + unicode_append_menu = (AppendMenuW_Proc) + get_proc_addr (user32, "AppendMenuW"); + unicode_message_box = (MessageBoxW_Proc) + get_proc_addr (user32, "MessageBoxW"); #endif /* !NTGUI_UNICODE */ } diff --git a/src/w32proc.c b/src/w32proc.c index 61ce157b55..5c2cb32749 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -548,9 +548,8 @@ init_timers (void) through a pointer. */ s_pfn_Get_Thread_Times = NULL; /* in case dumped Emacs comes with a value */ if (os_subtype != OS_9X) - s_pfn_Get_Thread_Times = - (GetThreadTimes_Proc)GetProcAddress (GetModuleHandle ("kernel32.dll"), - "GetThreadTimes"); + s_pfn_Get_Thread_Times = (GetThreadTimes_Proc) + get_proc_addr (GetModuleHandle ("kernel32.dll"), "GetThreadTimes"); /* Make sure we start with zeroed out itimer structures, since dumping may have left there traces of threads long dead. */ @@ -2691,8 +2690,8 @@ sys_kill (pid_t pid, int sig) { g_b_init_debug_break_process = 1; s_pfn_Debug_Break_Process = (DebugBreakProcess_Proc) - GetProcAddress (GetModuleHandle ("kernel32.dll"), - "DebugBreakProcess"); + get_proc_addr (GetModuleHandle ("kernel32.dll"), + "DebugBreakProcess"); } if (s_pfn_Debug_Break_Process == NULL) @@ -3608,9 +3607,9 @@ w32_compare_strings (const char *s1, const char *s2, char *locname, { if (os_subtype == OS_9X) { - pCompareStringW = - (CompareStringW_Proc) GetProcAddress (LoadLibrary ("Unicows.dll"), - "CompareStringW"); + pCompareStringW = (CompareStringW_Proc) + get_proc_addr (LoadLibrary ("Unicows.dll"), + "CompareStringW"); if (!pCompareStringW) { errno = EINVAL; diff --git a/src/w32uniscribe.c b/src/w32uniscribe.c index 11bfa5490b..54f161690b 100644 --- a/src/w32uniscribe.c +++ b/src/w32uniscribe.c @@ -1194,11 +1194,11 @@ syms_of_w32uniscribe (void) register_font_driver (&uniscribe_font_driver, NULL); script_get_font_scripts_fn = (ScriptGetFontScriptTags_Proc) - GetProcAddress (uniscribe, "ScriptGetFontScriptTags"); + get_proc_addr (uniscribe, "ScriptGetFontScriptTags"); script_get_font_languages_fn = (ScriptGetFontLanguageTags_Proc) - GetProcAddress (uniscribe, "ScriptGetFontLanguageTags"); + get_proc_addr (uniscribe, "ScriptGetFontLanguageTags"); script_get_font_features_fn = (ScriptGetFontFeatureTags_Proc) - GetProcAddress (uniscribe, "ScriptGetFontFeatureTags"); + get_proc_addr (uniscribe, "ScriptGetFontFeatureTags"); if (script_get_font_scripts_fn && script_get_font_languages_fn && script_get_font_features_fn) commit a9cf9387d97c26711b57fdedb986eec1adb442ec Author: Eli Zaretskii Date: Fri Aug 17 17:22:44 2018 +0300 Fix outdated text in the Calc manual * doc/misc/calc.texi (Internals): Don't advertise 'calc-extensions' which no longer exists. Reported by Francis Wright . diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index b1b38620ff..9f821baf60 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi @@ -33275,19 +33275,18 @@ prefer them, or if you are calling these functions from regular Lisp. The functions described here are scattered throughout the various Calc component files. Note that @file{calc.el} includes @code{autoload}s -for only a few component files; when Calc wants to call an advanced -function it calls @samp{(calc-extensions)} first; this function -autoloads @file{calc-ext.el}, which in turn autoloads all the functions -in the remaining component files. +for only a few component files; to get autoloads of the more advanced +function, one needs to load @file{calc-ext.el}, which in turn +autoloads all the functions in the remaining component files. Because @code{defmath} itself uses the extensions, user-written code generally always executes with the extensions already loaded, so normally you can use any Calc function and be confident that it will be autoloaded for you when necessary. If you are doing something special, check carefully to make sure each function you are using is -from @file{calc.el} or its components, and call @samp{(calc-extensions)} -before using any function based in @file{calc-ext.el} if you can't -prove this file will already be loaded. +from @file{calc.el} or its components, and use @w{@code{(require +'calc-ext)}} before using any function based in @file{calc-ext.el} if +you can't prove this file will already be loaded. @menu * Data Type Formats:: commit 58e5f10f884f70faea2dc577e890ccc9e8c5d0f5 Author: Allen Li Date: Wed Aug 8 00:03:36 2018 -0700 Don't include text properties when making autoloads * lisp/emacs-lisp/autoload.el (autoload-generate-file-autoloads): Ignore text properties when finding autoload defs. Otherwise, autoload generation is less deterministic, as the exact format of the generated autoloads depends on whether the files are visited in Emacs. (Bug#32395) diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index c458e7b1cb..efeb056204 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -768,7 +768,7 @@ FILE's modification time." "define-erc-module" "define-erc-response-handler" "defun-rcirc-command")))) - (push (match-string 2) defs)) + (push (match-string-no-properties 2) defs)) (forward-sexp 1) (forward-line 1))))))) commit 64eb9b71da7c3c34541929c1b0dfb7f0c11d3d88 Author: Paul Eggert Date: Fri Aug 17 00:25:20 2018 -0700 Fix problems with logxor etc. and fixnums These operations incorrectly treated negative fixnums as bignums greater than most-positive-fixnum. * src/alloc.c (mpz_set_intmax_slow): Avoid undefined behavior if signed unary negation overflows, while we’re in the neighborhood. (mpz_set_uintmax_slow): Remove. All uses removed. * src/data.c (arith_driver): Treat fixnums as signed, not unsigned, even for logical operations. * src/lisp.h (mpz_set_uintmax): Remove. All uses removed. * test/src/data-tests.el (data-tests-logand) (data-tests-logior, data-tests-logxor): New tests. diff --git a/src/alloc.c b/src/alloc.c index 6a93821159..0cd3f0c0c3 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3793,28 +3793,17 @@ mpz_set_intmax_slow (mpz_t result, intmax_t v) /* If long is larger then a faster path is taken. */ eassert (sizeof (intmax_t) > sizeof (long)); - bool negate = false; - if (v < 0) - { - v = -v; - negate = true; - } - mpz_set_uintmax_slow (result, (uintmax_t) v); - if (negate) - mpz_neg (result, result); -} - -void -mpz_set_uintmax_slow (mpz_t result, uintmax_t v) -{ - /* If long is larger then a faster path is taken. */ - eassert (sizeof (uintmax_t) > sizeof (unsigned long)); + bool complement = v < 0; + if (complement) + v = -1 - v; /* COUNT = 1 means just a single word of the given size. ORDER = -1 is arbitrary since there's only a single word. ENDIAN = 0 means use the native endian-ness. NAILS = 0 means use the whole word. */ - mpz_import (result, 1, -1, sizeof (uintmax_t), 0, 0, &v); + mpz_import (result, 1, -1, sizeof v, 0, 0, &v); + if (complement) + mpz_com (result, result); } diff --git a/src/data.c b/src/data.c index 66f508c8f4..5a355d9787 100644 --- a/src/data.c +++ b/src/data.c @@ -3006,7 +3006,7 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) { mpz_t tem; mpz_init (tem); - mpz_set_uintmax (tem, XUFIXNUM (val)); + mpz_set_intmax (tem, XFIXNUM (val)); mpz_and (accum, accum, tem); mpz_clear (tem); } @@ -3018,7 +3018,7 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) { mpz_t tem; mpz_init (tem); - mpz_set_uintmax (tem, XUFIXNUM (val)); + mpz_set_intmax (tem, XFIXNUM (val)); mpz_ior (accum, accum, tem); mpz_clear (tem); } @@ -3030,7 +3030,7 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) { mpz_t tem; mpz_init (tem); - mpz_set_uintmax (tem, XUFIXNUM (val)); + mpz_set_intmax (tem, XFIXNUM (val)); mpz_xor (accum, accum, tem); mpz_clear (tem); } diff --git a/src/lisp.h b/src/lisp.h index da93efdd93..f2cfe81ca7 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3559,7 +3559,6 @@ extern Lisp_Object listn (enum constype, ptrdiff_t, Lisp_Object, ...); extern Lisp_Object make_bignum_str (const char *num, int base); extern Lisp_Object make_number (mpz_t value); extern void mpz_set_intmax_slow (mpz_t result, intmax_t v); -extern void mpz_set_uintmax_slow (mpz_t result, uintmax_t v); INLINE void mpz_set_intmax (mpz_t result, intmax_t v) @@ -3573,18 +3572,6 @@ mpz_set_intmax (mpz_t result, intmax_t v) mpz_set_si (result, v); } -INLINE void -mpz_set_uintmax (mpz_t result, uintmax_t v) -{ - /* mpz_set_ui works in terms of unsigned long, but Emacs may use a - wider integer type, and so sometimes will have to construct the - mpz_t by hand. */ - if (sizeof (uintmax_t) > sizeof (unsigned long) && (unsigned long) v != v) - mpz_set_uintmax_slow (result, v); - else - mpz_set_ui (result, v); -} - /* Build a frequently used 2/3/4-integer lists. */ INLINE Lisp_Object diff --git a/test/src/data-tests.el b/test/src/data-tests.el index 8264902257..a4c6b0e491 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -597,9 +597,23 @@ comparing the subr with a much slower lisp implementation." (should (< (1- most-negative-fixnum) most-negative-fixnum)) (should (fixnump (1- (1+ most-positive-fixnum))))) +(ert-deftest data-tests-logand () + (should (= -1 (logand -1))) + (let ((n (* 2 most-negative-fixnum))) + (should (= (logand -1 n) n)))) + (ert-deftest data-tests-logcount () (should (= (logcount (read "#xffffffffffffffffffffffffffffffff")) 128))) +(ert-deftest data-tests-logior () + (should (= -1 (logior -1))) + (should (= -1 (logior most-positive-fixnum most-negative-fixnum)))) + +(ert-deftest data-tests-logxor () + (should (= -1 (logxor -1))) + (let ((n (1+ most-positive-fixnum))) + (should (= (logxor -1 n) (lognot n))))) + (ert-deftest data-tests-minmax () (let ((a (- most-negative-fixnum 1)) (b (+ most-positive-fixnum 1)) commit 3b9017b5ba6b7041fbf70691092533286cc9b98d Author: Paul Eggert Date: Thu Aug 16 20:44:19 2018 -0700 Reject outlandishly-wide bignums Do not allow bignums that are so wide that their log base 2 might not fit into a fixnum, as this will cause problems elsewhere. We already have a similar limitation for bool-vectors. * src/emacs.c (check_bignum_size, xmalloc_for_gmp): New function. (xrealloc_for_gmp): Check for too-large bignum. (main): Use xmalloc_for_gmp. diff --git a/src/emacs.c b/src/emacs.c index 97205d2b2a..11ee0b8118 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -673,14 +673,32 @@ close_output_streams (void) _exit (EXIT_FAILURE); } -/* Wrapper function for GMP. */ +/* Memory allocation functions for GMP. */ + +static void +check_bignum_size (size_t size) +{ + /* Do not create a bignum whose log base 2 could exceed fixnum range. + This way, functions like mpz_popcount return values in fixnum range. + It may also help to avoid other problems with outlandish bignums. */ + if (MOST_POSITIVE_FIXNUM / CHAR_BIT < size) + error ("Integer too large to be represented"); +} + +static void * ATTRIBUTE_MALLOC +xmalloc_for_gmp (size_t size) +{ + check_bignum_size (size); + return xmalloc (size); +} + static void * xrealloc_for_gmp (void *ptr, size_t ignore, size_t size) { + check_bignum_size (size); return xrealloc (ptr, size); } -/* Wrapper function for GMP. */ static void xfree_for_gmp (void *ptr, size_t ignore) { @@ -785,7 +803,7 @@ main (int argc, char **argv) init_standard_fds (); atexit (close_output_streams); - mp_set_memory_functions (xmalloc, xrealloc_for_gmp, xfree_for_gmp); + mp_set_memory_functions (xmalloc_for_gmp, xrealloc_for_gmp, xfree_for_gmp); sort_args (argc, argv); argc = 0; commit bb7e0338919d1c7068a64b3855e50fac345e4e05 Author: Paul Eggert Date: Thu Aug 16 19:53:21 2018 -0700 Speed up logcount on bignums * src/data.c (Flogcount): Speed up by using the mpz equivalent of ~X instead of -X-1. diff --git a/src/data.c b/src/data.c index a1215b9d6b..66f508c8f4 100644 --- a/src/data.c +++ b/src/data.c @@ -3350,8 +3350,7 @@ representation. */) return make_fixnum (mpz_popcount (XBIGNUM (value)->value)); mpz_t tem; mpz_init (tem); - mpz_neg (tem, XBIGNUM (value)->value); - mpz_sub_ui (tem, tem, 1); + mpz_com (tem, XBIGNUM (value)->value); Lisp_Object result = make_fixnum (mpz_popcount (tem)); mpz_clear (tem); return result; commit 44ad4a15a0099285a16018ad790419cb60df5815 Author: Michael Albinus Date: Thu Aug 16 17:26:37 2018 +0200 Fix Bug#32454 * lisp/files.el (find-alternate-file): Handle the wildcards case. (Bug#32454) diff --git a/lisp/files.el b/lisp/files.el index 8057def525..da4f2cd78f 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1831,7 +1831,7 @@ killed." ;; in some corner cases, e.g. when the selected window is ;; softly-dedicated. (let ((newbuf (find-file-noselect filename nil nil wildcards))) - (switch-to-buffer newbuf))) + (switch-to-buffer (if (consp newbuf) (car newbuf) newbuf)))) (when (eq obuf (current-buffer)) ;; This executes if find-file gets an error ;; and does not really find anything. commit 5f39f203eeadc7fad8aecd5269a487abad2fad6f Author: Ken Brown Date: Thu Aug 16 09:05:56 2018 -0400 Pacify GCC with -Wunused-but-set-variable * src/unexcw.c (read_exe_header): (fixup_executable): (unexec): Specify the "unused" attribute for variables that are used only in assertions. diff --git a/src/unexcw.c b/src/unexcw.c index 762b996e4b..dea9f6a746 100644 --- a/src/unexcw.c +++ b/src/unexcw.c @@ -48,7 +48,7 @@ static exe_header_t * read_exe_header (int fd, exe_header_t * exe_header_buffer) { int i; - int ret; + int ret ATTRIBUTE_UNUSED; assert (fd >= 0); assert (exe_header_buffer != 0); @@ -111,7 +111,7 @@ fixup_executable (int fd) exe_header_t exe_header_buffer; exe_header_t *exe_header; int i; - int ret; + int ret ATTRIBUTE_UNUSED; int found_data = 0; int found_bss = 0; @@ -269,7 +269,7 @@ unexec (const char *outfile, const char *infile) int fd_in; int fd_out; int ret; - int ret2; + int ret2 ATTRIBUTE_UNUSED; infile = add_exe_suffix_if_necessary (infile, infile_buffer); outfile = add_exe_suffix_if_necessary (outfile, outfile_buffer); commit decd9839819277c34c13f1771ef73626208cbdd9 Author: Thomas Fitzsimmons Date: Wed Aug 15 14:32:00 2018 -0400 EUDC: Add more BBDB >= 3 support * lisp/net/eudcb-bbdb.el Declare BBDB >= 3 functions. (eudc-bbdb-field): Add translation from company to organization. (eudc-bbdb-extract-phones, eudc-bbdb-extract-addresses) (eudc-bbdb-format-record-as-result): Call BBDB >= 3 functions. diff --git a/lisp/net/eudcb-bbdb.el b/lisp/net/eudcb-bbdb.el index fb618d1209..ac4814a25c 100644 --- a/lisp/net/eudcb-bbdb.el +++ b/lisp/net/eudcb-bbdb.el @@ -47,10 +47,13 @@ BBDB < 3 used `net'; BBDB >= 3 uses `mail'." ;; This just-in-time translation permits upgrading from BBDB 2 to ;; BBDB 3 without restarting Emacs. - (if (and (eq field-symbol 'net) - (eudc--using-bbdb-3-or-newer-p)) - 'mail - field-symbol)) + (cond ((and (eq field-symbol 'net) + (eudc--using-bbdb-3-or-newer-p)) + 'mail) + ((and (eq field-symbol 'company) + (eudc--using-bbdb-3-or-newer-p)) + 'organization) + (t field-symbol))) (defvar eudc-bbdb-attributes-translation-alist '((name . lastname) @@ -124,18 +127,31 @@ BBDB < 3 used `net'; BBDB >= 3 uses `mail'." (declare-function bbdb-record-addresses "ext:bbdb" t) ; via bbdb-defstruct (declare-function bbdb-records "ext:bbdb" (&optional dont-check-disk already-in-db-buffer)) +(declare-function bbdb-record-notes "ext:bbdb" t) ; via bbdb-defstruct + +;; External, BBDB >= 3. +(declare-function bbdb-phone-label "ext:bbdb" t) ; via bbdb-defstruct +(declare-function bbdb-record-phone "ext:bbdb" t) ; via bbdb-defstruct +(declare-function bbdb-record-address "ext:bbdb" t) ; via bbdb-defstruct +(declare-function bbdb-record-xfield "ext:bbdb" t) ; via bbdb-defstruct (defun eudc-bbdb-extract-phones (record) (require 'bbdb) (mapcar (function (lambda (phone) (if eudc-bbdb-use-locations-as-attribute-names - (cons (intern (bbdb-phone-location phone)) + (cons (intern (if (eudc--using-bbdb-3-or-newer-p) + (bbdb-phone-label phone) + (bbdb-phone-location phone))) (bbdb-phone-string phone)) (cons 'phones (format "%s: %s" - (bbdb-phone-location phone) + (if (eudc--using-bbdb-3-or-newer-p) + (bbdb-phone-label phone) + (bbdb-phone-location phone)) (bbdb-phone-string phone)))))) - (bbdb-record-phones record))) + (if (eudc--using-bbdb-3-or-newer-p) + (bbdb-record-phone record) + (bbdb-record-phones record)))) (defun eudc-bbdb-extract-addresses (record) (require 'bbdb) @@ -157,7 +173,9 @@ BBDB < 3 used `net'; BBDB >= 3 uses `mail'." (cons (intern (bbdb-address-location address)) val) (cons 'addresses (concat (bbdb-address-location address) "\n" val)))) - (bbdb-record-addresses record)))) + (if (eudc--using-bbdb-3-or-newer-p) + (bbdb-record-address record) + (bbdb-record-addresses record))))) (defun eudc-bbdb-format-record-as-result (record) "Format the BBDB RECORD as a EUDC query result record. @@ -176,7 +194,11 @@ The record is filtered according to `eudc-bbdb-current-return-attributes'" (setq val (eudc-bbdb-extract-phones record))) ((eq attr 'addresses) (setq val (eudc-bbdb-extract-addresses record))) - ((memq attr '(firstname lastname aka company net notes)) + ((eq attr 'notes) + (if (eudc--using-bbdb-3-or-newer-p) + (setq val (bbdb-record-xfield record 'notes)) + (setq val (bbdb-record-notes record)))) + ((memq attr '(firstname lastname aka company net)) (setq val (eval (list (intern (concat "bbdb-record-" commit af991f15e6d6479e3b4c5a545df4fb09458d100a Author: Thomas Fitzsimmons Date: Wed Aug 15 13:16:25 2018 -0400 EUDC: Remove XEmacs support * lisp/net/eudc.el (eudc-mode, eudc-install-menu): Remove XEmacs support. * lisp/net/eudc-hotlist.el (eudc-hotlist-mode) (eudc-hotlist-emacs-menu): Likewise. * lisp/net/eudc-bob.el (eudc-bob-toggle-inline-display) (eudc-bob-popup-menu, eudc-bob-generic-keymap) (eudc-bob-sound-keymap, eudc-bob-url-keymap) (eudc-bob-mail-keymap): Likewise. * etc/NEWS (EUDC): Mention removal of XEmacs support. diff --git a/etc/NEWS b/etc/NEWS index 6f23f7ee42..d1a6868794 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -394,6 +394,10 @@ buffer with the article(s) attached. *** 'erc-button-google-url' has been renamed 'erc-button-search-url' and its value has been changed to Duck Duck Go. +** EUDC + +*** XEmacs support has been removed. + ** eww/shr *** When opening external links in eww/shr (typically with the diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el index 425f99a503..f63e807b68 100644 --- a/lisp/net/eudc-bob.el +++ b/lisp/net/eudc-bob.el @@ -155,40 +155,21 @@ display a button." "Toggle inline display of an image." (interactive) (when (eudc-bob-can-display-inline-images) - (cond ((featurep 'xemacs) - (let ((overlays (append (overlays-at (1- (point))) - (overlays-at (point)))) - overlay glyph) - (setq overlay (car overlays)) - (while (and overlay - (not (setq glyph (overlay-get overlay 'glyph)))) - (setq overlays (cdr overlays)) - (setq overlay (car overlays))) - (if overlay - (if (overlay-get overlay 'end-glyph) - (progn - (overlay-put overlay 'end-glyph nil) - (overlay-put overlay 'invisible nil)) - (overlay-put overlay 'end-glyph glyph) - (overlay-put overlay 'invisible t))))) - (t - (let* ((overlays (append (overlays-at (1- (point))) - (overlays-at (point)))) - image) - - ;; Search overlay with an image. - (while (and overlays (null image)) - (let ((prop (overlay-get (car overlays) 'eudc-image))) - (if (eq 'image (car-safe prop)) - (setq image prop) - (setq overlays (cdr overlays))))) - - ;; Toggle that overlay's image display. - (when overlays - (let ((overlay (car overlays))) - (overlay-put overlay 'display - (if (overlay-get overlay 'display) - nil image))))))))) + (let* ((overlays (append (overlays-at (1- (point))) + (overlays-at (point)))) + image) + ;; Search overlay with an image. + (while (and overlays (null image)) + (let ((prop (overlay-get (car overlays) 'eudc-image))) + (if (eq 'image (car-safe prop)) + (setq image prop) + (setq overlays (cdr overlays))))) + ;; Toggle that overlay's image display. + (when overlays + (let ((overlay (car overlays))) + (overlay-put overlay 'display + (if (overlay-get overlay 'display) + nil image))))))) (defun eudc-bob-display-audio (data) "Display a button for audio DATA." @@ -272,25 +253,19 @@ display a button." (interactive "@e") (run-hooks 'activate-menubar-hook) (eudc-jump-to-event event) - (if (featurep 'xemacs) - (progn - (run-hooks 'activate-popup-menu-hook) - (popup-menu (eudc-bob-menu))) - (let ((result (x-popup-menu t (eudc-bob-menu))) - command) - (if result - (progn - (setq command (lookup-key (eudc-bob-menu) - (apply 'vector result))) - (command-execute command)))))) + (let ((result (x-popup-menu t (eudc-bob-menu))) + command) + (if result + (progn + (setq command (lookup-key (eudc-bob-menu) + (apply 'vector result))) + (command-execute command))))) (setq eudc-bob-generic-keymap (let ((map (make-sparse-keymap))) (define-key map "s" 'eudc-bob-save-object) (define-key map "!" 'eudc-bob-pipe-object-to-external-program) - (define-key map (if (featurep 'xemacs) - [button3] - [down-mouse-3]) 'eudc-bob-popup-menu) + (define-key map [down-mouse-3] 'eudc-bob-popup-menu) map)) (setq eudc-bob-image-keymap @@ -301,25 +276,19 @@ display a button." (setq eudc-bob-sound-keymap (let ((map (make-sparse-keymap))) (define-key map [return] 'eudc-bob-play-sound-at-point) - (define-key map (if (featurep 'xemacs) - [button2] - [down-mouse-2]) 'eudc-bob-play-sound-at-mouse) + (define-key map [down-mouse-2] 'eudc-bob-play-sound-at-mouse) map)) (setq eudc-bob-url-keymap (let ((map (make-sparse-keymap))) (define-key map [return] 'browse-url-at-point) - (define-key map (if (featurep 'xemacs) - [button2] - [down-mouse-2]) 'browse-url-at-mouse) + (define-key map [down-mouse-2] 'browse-url-at-mouse) map)) (setq eudc-bob-mail-keymap (let ((map (make-sparse-keymap))) (define-key map [return] 'goto-address-at-point) - (define-key map (if (featurep 'xemacs) - [button2] - [down-mouse-2]) 'goto-address-at-point) + (define-key map [down-mouse-2] 'goto-address-at-point) map)) (set-keymap-parent eudc-bob-image-keymap eudc-bob-generic-keymap) @@ -327,19 +296,18 @@ display a button." ;; If the first arguments can be nil here, then these 3 can be ;; defconsts once more. -(when (not (featurep 'xemacs)) - (easy-menu-define eudc-bob-generic-menu - eudc-bob-generic-keymap - "" - eudc-bob-generic-menu) - (easy-menu-define eudc-bob-image-menu - eudc-bob-image-keymap - "" - eudc-bob-image-menu) - (easy-menu-define eudc-bob-sound-menu - eudc-bob-sound-keymap - "" - eudc-bob-sound-menu)) +(easy-menu-define eudc-bob-generic-menu + eudc-bob-generic-keymap + "" + eudc-bob-generic-menu) +(easy-menu-define eudc-bob-image-menu + eudc-bob-image-keymap + "" + eudc-bob-image-menu) +(easy-menu-define eudc-bob-sound-menu + eudc-bob-sound-keymap + "" + eudc-bob-sound-menu) ;;;###autoload (defun eudc-display-generic-binary (data) diff --git a/lisp/net/eudc-hotlist.el b/lisp/net/eudc-hotlist.el index a739561c7d..0762445c23 100644 --- a/lisp/net/eudc-hotlist.el +++ b/lisp/net/eudc-hotlist.el @@ -55,11 +55,6 @@ These are the special commands of this mode: t -- Transpose the server at point and the previous one q -- Commit the changes and quit. x -- Quit without committing the changes." - (when (featurep 'xemacs) - (setq mode-popup-menu eudc-hotlist-menu) - (when (featurep 'menubar) - (set-buffer-menubar current-menubar) - (add-submenu nil (cons "EUDC-Hotlist" (cdr (cdr eudc-hotlist-menu)))))) (setq buffer-read-only t)) ;;;###autoload @@ -179,10 +174,9 @@ These are the special commands of this mode: ["Save and Quit" eudc-hotlist-quit-edit t] ["Exit without Saving" kill-this-buffer t])) -(when (not (featurep 'xemacs)) - (easy-menu-define eudc-hotlist-emacs-menu +(easy-menu-define eudc-hotlist-emacs-menu eudc-hotlist-mode-map "" - eudc-hotlist-menu)) + eudc-hotlist-menu) ;;; eudc-hotlist.el ends here diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el index ff8ed2c139..a28fa6aa17 100644 --- a/lisp/net/eudc.el +++ b/lisp/net/eudc.el @@ -630,9 +630,7 @@ These are the special commands of EUDC mode: n -- Move to next record. p -- Move to previous record. b -- Insert record at point into the BBDB database." - (if (not (featurep 'xemacs)) - (easy-menu-define eudc-emacs-menu eudc-mode-map "" (eudc-menu)) - (setq mode-popup-menu (eudc-menu)))) + (easy-menu-define eudc-emacs-menu eudc-mode-map "" (eudc-menu))) ;;}}} @@ -1140,33 +1138,11 @@ queries the server for the existing fields and displays a corresponding form." eudc-tail-menu))) (defun eudc-install-menu () - (cond - ((and (featurep 'xemacs) (featurep 'menubar)) - (add-submenu '("Tools") (eudc-menu))) - ((not (featurep 'xemacs)) - (cond - ((fboundp 'easy-menu-create-menu) - (define-key - global-map - [menu-bar tools directory-search] - (cons "Directory Servers" - (easy-menu-create-menu "Directory Servers" (cdr (eudc-menu)))))) - ((fboundp 'easy-menu-add-item) - (let ((menu (eudc-menu))) - (easy-menu-add-item nil '("tools") (easy-menu-create-menu (car menu) - (cdr menu))))) - ((fboundp 'easy-menu-create-keymaps) - (easy-menu-define eudc-menu-map eudc-mode-map "Directory Client Menu" (eudc-menu)) - (define-key - global-map - [menu-bar tools eudc] - (cons "Directory Servers" - (easy-menu-create-keymaps "Directory Servers" - (cdr (eudc-menu)))))) - (t - (error "Unknown version of easymenu")))) - )) - + (define-key + global-map + [menu-bar tools directory-search] + (cons "Directory Servers" + (easy-menu-create-menu "Directory Servers" (cdr (eudc-menu)))))) ;;; Load time initializations : @@ -1182,7 +1158,7 @@ queries the server for the existing fields and displays a corresponding form." (eudc-install-menu)) -;; The following installs a short menu for EUDC at XEmacs startup. +;; The following installs a short menu for EUDC at Emacs startup. ;;;###autoload (defun eudc-load-eudc () commit 36d17ef44a2c9f034992e921b350664dddffb58f Author: Thomas Fitzsimmons Date: Tue Jun 12 15:28:43 2018 -0400 EUDC: Shorten eudc-tools-menu autoload * lisp/net/eudc.el: Remove XEmacs support from eudc-tools-menu autoload. diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el index 00d8c60311..ff8ed2c139 100644 --- a/lisp/net/eudc.el +++ b/lisp/net/eudc.el @@ -1196,8 +1196,7 @@ This does nothing except loading eudc by autoload side-effect." nil) ;;;###autoload -(cond - ((not (featurep 'xemacs)) +(progn (defvar eudc-tools-menu (let ((map (make-sparse-keymap "Directory Servers"))) (define-key map [phone] @@ -1222,34 +1221,6 @@ This does nothing except loading eudc by autoload side-effect." :help ,(purecopy "Load the Emacs Unified Directory Client"))) map)) (fset 'eudc-tools-menu (symbol-value 'eudc-tools-menu))) - (t - (let ((menu '("Directory Servers" - ["Load Hotlist of Servers" eudc-load-eudc t] - ["New Server" eudc-set-server t] - ["---" nil nil] - ["Query with Form" eudc-query-form t] - ["Expand Inline Query" eudc-expand-inline t] - ["---" nil nil] - ["Get Email" eudc-get-email t] - ["Get Phone" eudc-get-phone t]))) - (if (not (featurep 'eudc-autoloads)) - (if (featurep 'xemacs) - (if (and (featurep 'menubar) - (not (featurep 'infodock))) - (add-submenu '("Tools") menu)) - (require 'easymenu) - (cond - ((fboundp 'easy-menu-add-item) - (easy-menu-add-item nil '("tools") - (easy-menu-create-menu (car menu) - (cdr menu)))) - ((fboundp 'easy-menu-create-keymaps) - (define-key - global-map - [menu-bar tools eudc] - (cons "Directory Servers" - (easy-menu-create-keymaps "Directory Servers" - (cdr menu))))))))))) ;;}}} commit 6b178acfd1d29c9368b29e3b3291bdbde5f61d0d Author: Thomas Fitzsimmons Date: Tue Jun 12 14:50:48 2018 -0400 EUDC: Add commentary to eudc-bob.el * lisp/net/eudc-bob.el: Add commentary. diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el index 584d1a9d0d..425f99a503 100644 --- a/lisp/net/eudc-bob.el +++ b/lisp/net/eudc-bob.el @@ -25,8 +25,15 @@ ;;; Commentary: +;; eudc-bob.el presents binary entries in LDAP results in interactive +;; ways. For example, it will display JPEG binary data as an inline +;; image in the results buffer. See also +;; https://tools.ietf.org/html/rfc2798. + ;;; Usage: -;; See the corresponding info file + +;; The eudc-bob interactive functions are invoked when the user +;; interacts with an `eudc-query-form' results buffer. ;;; Code: commit bcdb2d9733118a6529a66e12c3f2dc7662370c15 Author: Eli Zaretskii Date: Wed Aug 15 05:37:45 2018 +0300 Improve documentation of last change * lisp/hi-lock.el (hi-lock-set-pattern, hi-lock-face-buffer): Improve the doc strings. (Bug#32365) * etc/NEWS: * doc/emacs/display.texi (Highlight Interactively): Clarify wording. diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index fe4936d85a..d9a08b974f 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -974,9 +974,10 @@ the buffer is loaded. For example, to highlight all occurrences of the word ``whim'' using the default face (a yellow background), type @kbd{M-s h r whim @key{RET} @key{RET}}. Any face can be used for highlighting, Hi Lock provides several of its own and these are -pre-loaded into a list of default values. While being prompted -for a face use @kbd{M-n} and @kbd{M-p} to cycle through them. A prefix -argument limits the highlighting to the corresponding subexpression. +pre-loaded into a list of default values. While being prompted for a +face use @kbd{M-n} and @kbd{M-p} to cycle through them. A prefix +numeric argument limits the highlighting to the corresponding +subexpression. @vindex hi-lock-auto-select-face Setting the option @code{hi-lock-auto-select-face} to a non-@code{nil} diff --git a/etc/NEWS b/etc/NEWS index 5146e756d0..6f23f7ee42 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -720,7 +720,8 @@ UUID at point. +++ *** 'highlight-regexp' can now highlight subexpressions. -The command accepts a prefix argument to choose the subexpression. +The now command accepts a prefix numeric argument to choose the +subexpression. * New Modes and Packages in Emacs 27.1 diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index 23820cda58..08b58117dd 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -433,7 +433,8 @@ highlighting will not update as you type." "Set face of each match of REGEXP to FACE. Interactively, prompt for REGEXP using `read-regexp', then FACE. Use the global history list for FACE. Limit face setting to the -corresponding SUBEXP of REGEXP. +corresponding SUBEXP (interactively, the prefix argument) of REGEXP. +If SUBEXP is omitted or nil, the entire REGEXP is highlighted. Use Font lock mode, if enabled, to highlight REGEXP. Otherwise, use overlays for highlighting. If overlays are used, the @@ -689,7 +690,9 @@ with completion and history." (intern face))) (defun hi-lock-set-pattern (regexp face &optional subexp) - "Highlight SUBEXP of REGEXP with face FACE." + "Highlight SUBEXP of REGEXP with face FACE. +If omitted or nil, SUBEXP defaults to zero, i.e. the entire +REGEXP is highlighted." ;; Hashcons the regexp, so it can be passed to remove-overlays later. (setq regexp (hi-lock--hashcons regexp)) (setq subexp (or subexp 0)) commit cc5a23d40bfa7a832f7a6fb7a016557ac1416559 Author: GrĂ©gory MouniĂ© Date: Fri Aug 3 23:08:10 2018 +0200 Interactive Highlighting: prefix argument to select subexp * doc/emacs/display.texi (Highlight Interactively): * etc/NEWS: Document the change. * lisp/hi-lock.el (hi-lock-face-buffer, hi-lock-set-pattern): Use the prefix argument to highlight only the corresponding sub-expression of the regexp (Bug#32365). Copyright-paperwork-exempt: yes diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 2f5ce80d60..fe4936d85a 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -975,7 +975,8 @@ the word ``whim'' using the default face (a yellow background), type @kbd{M-s h r whim @key{RET} @key{RET}}. Any face can be used for highlighting, Hi Lock provides several of its own and these are pre-loaded into a list of default values. While being prompted -for a face use @kbd{M-n} and @kbd{M-p} to cycle through them. +for a face use @kbd{M-n} and @kbd{M-p} to cycle through them. A prefix +argument limits the highlighting to the corresponding subexpression. @vindex hi-lock-auto-select-face Setting the option @code{hi-lock-auto-select-face} to a non-@code{nil} diff --git a/etc/NEWS b/etc/NEWS index 3ae956c788..5146e756d0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -716,6 +716,12 @@ A symbol 'uuid' can be passed to thing-at-point and it returns the UUID at point. +** Interactive automatic highlighting + ++++ +*** 'highlight-regexp' can now highlight subexpressions. +The command accepts a prefix argument to choose the subexpression. + * New Modes and Packages in Emacs 27.1 diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index 13ebffb1af..23820cda58 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -429,10 +429,11 @@ highlighting will not update as you type." ;;;###autoload (defalias 'highlight-regexp 'hi-lock-face-buffer) ;;;###autoload -(defun hi-lock-face-buffer (regexp &optional face) +(defun hi-lock-face-buffer (regexp &optional face subexp) "Set face of each match of REGEXP to FACE. Interactively, prompt for REGEXP using `read-regexp', then FACE. -Use the global history list for FACE. +Use the global history list for FACE. Limit face setting to the +corresponding SUBEXP of REGEXP. Use Font lock mode, if enabled, to highlight REGEXP. Otherwise, use overlays for highlighting. If overlays are used, the @@ -441,10 +442,11 @@ highlighting will not update as you type." (list (hi-lock-regexp-okay (read-regexp "Regexp to highlight" 'regexp-history-last)) - (hi-lock-read-face-name))) + (hi-lock-read-face-name) + current-prefix-arg)) (or (facep face) (setq face 'hi-yellow)) (unless hi-lock-mode (hi-lock-mode 1)) - (hi-lock-set-pattern regexp face)) + (hi-lock-set-pattern regexp face subexp)) ;;;###autoload (defalias 'highlight-phrase 'hi-lock-face-phrase-buffer) @@ -686,11 +688,12 @@ with completion and history." (add-to-list 'hi-lock-face-defaults face t)) (intern face))) -(defun hi-lock-set-pattern (regexp face) - "Highlight REGEXP with face FACE." +(defun hi-lock-set-pattern (regexp face &optional subexp) + "Highlight SUBEXP of REGEXP with face FACE." ;; Hashcons the regexp, so it can be passed to remove-overlays later. (setq regexp (hi-lock--hashcons regexp)) - (let ((pattern (list regexp (list 0 (list 'quote face) 'prepend))) + (setq subexp (or subexp 0)) + (let ((pattern (list regexp (list subexp (list 'quote face) 'prepend))) (no-matches t)) ;; Refuse to highlight a text that is already highlighted. (if (assoc regexp hi-lock-interactive-patterns) @@ -712,7 +715,8 @@ with completion and history." (goto-char search-start) (while (re-search-forward regexp search-end t) (when no-matches (setq no-matches nil)) - (let ((overlay (make-overlay (match-beginning 0) (match-end 0)))) + (let ((overlay (make-overlay (match-beginning subexp) + (match-end subexp)))) (overlay-put overlay 'hi-lock-overlay t) (overlay-put overlay 'hi-lock-overlay-regexp regexp) (overlay-put overlay 'face face)) commit 1164d49ba6a3ce59a2bd404219851d8e27b54611 Author: Paul Eggert Date: Tue Aug 14 16:06:05 2018 -0700 Rename --without-mini-gmp to --with-libgmp * configure.ac (HAVE_GMP): Rename â€configure’ option from --without-mini-gmp to --with-libgmp. All uses changed. * doc/lispref/numbers.texi (Predicates on Numbers): Large integers are always available. Clarify how eq works on them. diff --git a/configure.ac b/configure.ac index 7b9448e13b..e5d094cf9e 100644 --- a/configure.ac +++ b/configure.ac @@ -4303,17 +4303,16 @@ AC_SUBST(KRB5LIB) AC_SUBST(DESLIB) AC_SUBST(KRB4LIB) -AC_ARG_WITH([mini-gmp], - [AS_HELP_STRING([--without-mini-gmp], - [don't compile and use mini-gmp, a substitute for the - GNU Multiple Precision (GMP) library; this is the - default on systems with recent-enough GMP.])]) +AC_ARG_WITH([libgmp], + [AS_HELP_STRING([--without-libgmp], + [don't use the GNU Multiple Precision (GMP) library; + this is the default on systems lacking libgmp.])]) GMP_LIB= GMP_OBJ=mini-gmp-emacs.o HAVE_GMP=no -case $with_mini_gmp in - yes) ;; - no) HAVE_GMP=yes GMP_LIB=-lgmp;; +case $with_libgmp in + no) ;; + yes) HAVE_GMP=yes GMP_LIB=-lgmp;; *) AC_CHECK_HEADERS([gmp.h], [OLIBS=$LIBS AC_SEARCH_LIBS([__gmpz_roinit_n], [gmp]) diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi index 89205f9df3..bd633b77c3 100644 --- a/doc/lispref/numbers.texi +++ b/doc/lispref/numbers.texi @@ -319,10 +319,8 @@ its argument. See also @code{integer-or-marker-p} and @defun bignump object This predicate tests whether its argument is a large integer, and -returns @code{t} if so, @code{nil} otherwise. Large integers cannot -be compared with @code{eq}, only with @code{=} or @code{eql}. Also, -large integers are only available if Emacs was compiled with the GMP -library. +returns @code{t} if so, @code{nil} otherwise. Unlike small integers, +large integers can be @code{=} or @code{eql} even if they are not @code{eq}. @end defun @defun fixnump object diff --git a/etc/NEWS b/etc/NEWS index f1d09a2b63..3ae956c788 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -27,7 +27,7 @@ When you add a new item, use the appropriate mark if you are sure it applies, ** Emacs now uses GMP, the GNU Multiple Precision library. By default, if 'configure' does not find a suitable libgmp, it arranges for the included mini-gmp library to be built and used. -The new 'configure' option --with-mini-gmp uses mini-gmp even if a +The new 'configure' option --without-libgmp uses mini-gmp even if a suitable libgmp is available. ** The new configure option '--with-json' adds support for JSON using commit 6d24402d6358b2e6ccf78a6cb909723a5d18dd27 Author: Stephen Berman Date: Wed Aug 15 00:14:41 2018 +0200 Fix last todo-edit-mode change * lisp/calendar/todo-mode.el (todo-edit-mode): For editing an item instead of the whole file, the current todo-file must be set from todo-global-current-todo-file. * test/lisp/calendar/todo-mode-tests.el (todo-test-current-file-in-edit-mode): New test. diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index 1623c6e2ec..08da75dbd6 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -6726,9 +6726,13 @@ Added to `window-configuration-change-hook' in Todo mode." \\{todo-edit-mode-map}" (todo-modes-set-1) - (setq-local todo-current-todo-file (file-truename (buffer-file-name))) - (when (= (buffer-size) (- (point-max) (point-min))) - ;; Only need this when editing the whole file not just an item. + (if (> (buffer-size) (- (point-max) (point-min))) + ;; Editing one item in an indirect buffer, so buffer-file-name is nil. + (setq-local todo-current-todo-file todo-global-current-todo-file) + ;; When editing archive file, make sure it is current todo file. + (setq-local todo-current-todo-file (file-truename (buffer-file-name))) + ;; Need this when editing the whole file to return to the category + ;; editing was invoked from. (setq-local todo-categories (todo-set-categories))) (setq buffer-read-only nil)) diff --git a/test/lisp/calendar/todo-mode-tests.el b/test/lisp/calendar/todo-mode-tests.el index 9028204506..6cd2bfe35b 100644 --- a/test/lisp/calendar/todo-mode-tests.el +++ b/test/lisp/calendar/todo-mode-tests.el @@ -763,6 +763,29 @@ The highlighting should remain enabled." (ert-simulate-command '(forward-line)) ; Now on first done item. (should (eq 'hl-line (get-char-property (point) 'face))))) +(ert-deftest todo-test-current-file-in-edit-mode () + "Test the value of todo-current-todo-file in todo-edit-mode." + (with-todo-test + (todo-test--show 1) + ;; The preceding call todo-mode but does not run pre-command-hook + ;; in the test environment, thus failing to set + ;; todo-global-current-todo-file, which is needed for the test + ;; after todo-edit-item--text. So force the hook function to run. + (ert-simulate-command '(todo-mode)) + (let ((curfile todo-current-todo-file)) + (should (equal curfile todo-test-file-1)) + (todo-edit-item--text 'multiline) + (should (equal todo-current-todo-file curfile)) + (todo-edit-quit) + (todo-edit-file) + (should (equal todo-current-todo-file curfile)) + (todo-edit-quit)) + (todo-find-archive) + (let ((curfile todo-current-todo-file)) + (should (equal curfile todo-test-archive-1)) + (todo-edit-file) + (should (equal todo-current-todo-file curfile))))) + (ert-deftest todo-test-edit-quit () "Test result of exiting todo-edit-mode on a whole file. Exiting should return to the same todo-mode or todo-archive-mode commit 5620d591ee67e5b31ca8d5aa0dcc1a13116b09a7 Author: Stephen Berman Date: Tue Aug 14 21:50:15 2018 +0200 ; * lisp/calendar/todo-mode.el: Remove leftover commented out lines. diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index f7af65c36b..1623c6e2ec 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -6721,32 +6721,11 @@ Added to `window-configuration-change-hook' in Todo mode." (setq-local todo-current-todo-file (file-truename (buffer-file-name))) (setq-local todo-show-done-only t)) -;; (defun todo-mode-external-set () -;; "Set `todo-categories' externally to `todo-current-todo-file'." -;; (setq-local todo-current-todo-file todo-global-current-todo-file) -;; (let ((cats (with-current-buffer -;; ;; Can't use find-buffer-visiting when -;; ;; `todo-show-categories-table' is called on first -;; ;; invocation of `todo-show', since there is then -;; ;; no buffer visiting the current file. -;; (find-file-noselect todo-current-todo-file 'nowarn) -;; (or todo-categories -;; ;; In Todo Edit mode todo-categories is now nil -;; ;; since it uses same buffer as Todo mode but -;; ;; doesn't have the latter's local variables. -;; (save-excursion -;; (goto-char (point-min)) -;; (read (buffer-substring-no-properties -;; (line-beginning-position) -;; (line-end-position)))))))) -;; (setq-local todo-categories cats))) - (define-derived-mode todo-edit-mode text-mode "Todo-Ed" "Major mode for editing multiline todo items. \\{todo-edit-mode-map}" (todo-modes-set-1) - ;; (todo-mode-external-set) (setq-local todo-current-todo-file (file-truename (buffer-file-name))) (when (= (buffer-size) (- (point-max) (point-min))) ;; Only need this when editing the whole file not just an item. @@ -6759,7 +6738,6 @@ Added to `window-configuration-change-hook' in Todo mode." "Major mode for displaying and editing todo categories. \\{todo-categories-mode-map}" - ;; (todo-mode-external-set) (setq-local todo-current-todo-file todo-global-current-todo-file) (setq-local todo-categories ;; Can't use find-buffer-visiting when commit a2ec595e5d7cf95715312a9cd0a6f4ef0f6e370f Author: Stephen Berman Date: Tue Aug 14 21:39:24 2018 +0200 Fix exiting from editing todo archive file (bug#32437) * lisp/calendar/todo-mode.el (todo-edit-file): Make the warning also suitable for Todo Archive mode, and add more space to it. (todo-edit-quit): On quitting editing an archive file, return to the Todo Archive mode buffer editing was invoked in. (todo-check-format): Display a warning instead of a message when the categories sexp isn't as expected. (todo-mode-external-set): Remove. (todo-edit-mode): Set buffer local values of todo-current-todo-file and todo-categories from the todo or archive file being edited. (todo-categories-mode): Set buffer local values of todo-current-todo-file and todo-categories as before but directly instead of using superfluous todo-mode-external-set function. * test/lisp/calendar/todo-mode-tests.el (todo-test-edit-quit): New test. diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index 9c770f17fb..f7af65c36b 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -1242,9 +1242,10 @@ this command should be used with caution." (widen) (todo-edit-mode) (remove-overlays) - (display-warning 'todo (format "\ + (display-warning + 'todo (format "\ -Type %s to return to Todo mode. +Type %s to return to Todo%s mode. This also runs a file format check and signals an error if the format has become invalid. However, this check cannot @@ -1254,7 +1255,12 @@ You can repair this inconsistency by invoking the command `todo-repair-categories-sexp', but this will revert any renumbering of the categories you have made, so you will have to renumber them again (see `(todo-mode) Reordering -Categories')." (substitute-command-keys "\\[todo-edit-quit]")))) +Categories'). +" + (substitute-command-keys "\\[todo-edit-quit]") + (if (equal "toda" (file-name-extension + (buffer-file-name))) + " Archive" "")))) (defun todo-add-category (&optional file cat) "Add a new category to a todo file. @@ -2240,7 +2246,9 @@ made in the number or names of categories." ;; (todo-repair-categories-sexp) ;; Compare (todo-make-categories-list t) with sexp and if ;; different ask (todo-update-categories-sexp) ? - (todo-mode) + (if (equal (file-name-extension (buffer-file-name)) "toda") + (todo-archive-mode) + (todo-mode)) (let* ((cat-beg (concat "^" (regexp-quote todo-category-beg) "\\(.*\\)$")) (curline (buffer-substring-no-properties @@ -5094,7 +5102,7 @@ again." (defun todo-check-format () "Signal an error if the current todo file is ill-formatted. -Otherwise return t. Display a message if the file is well-formed +Otherwise return t. Display a warning if the file is well-formed but the categories sexp differs from the current value of `todo-categories'." (save-excursion @@ -5128,12 +5136,14 @@ but the categories sexp differs from the current value of (forward-line))) ;; Warn user if categories sexp has changed. (unless (string= ssexp cats) - (message (concat "The sexp at the beginning of the file differs " - "from the value of `todo-categories'.\n" - "If the sexp is wrong, you can fix it with " - "M-x todo-repair-categories-sexp,\n" - "but note this reverts any changes you have " - "made in the order of the categories.")))))) + (display-warning 'todo "\ + +The sexp at the beginning of the file differs from the value of +`todo-categories'. If the sexp is wrong, you can fix it with +M-x todo-repair-categories-sexp, but note this reverts any +changes you have made in the order of the categories. +" + ))))) t) (defun todo-item-start () @@ -6711,32 +6721,36 @@ Added to `window-configuration-change-hook' in Todo mode." (setq-local todo-current-todo-file (file-truename (buffer-file-name))) (setq-local todo-show-done-only t)) -(defun todo-mode-external-set () - "Set `todo-categories' externally to `todo-current-todo-file'." - (setq-local todo-current-todo-file todo-global-current-todo-file) - (let ((cats (with-current-buffer - ;; Can't use find-buffer-visiting when - ;; `todo-show-categories-table' is called on first - ;; invocation of `todo-show', since there is then - ;; no buffer visiting the current file. - (find-file-noselect todo-current-todo-file 'nowarn) - (or todo-categories - ;; In Todo Edit mode todo-categories is now nil - ;; since it uses same buffer as Todo mode but - ;; doesn't have the latter's local variables. - (save-excursion - (goto-char (point-min)) - (read (buffer-substring-no-properties - (line-beginning-position) - (line-end-position)))))))) - (setq-local todo-categories cats))) +;; (defun todo-mode-external-set () +;; "Set `todo-categories' externally to `todo-current-todo-file'." +;; (setq-local todo-current-todo-file todo-global-current-todo-file) +;; (let ((cats (with-current-buffer +;; ;; Can't use find-buffer-visiting when +;; ;; `todo-show-categories-table' is called on first +;; ;; invocation of `todo-show', since there is then +;; ;; no buffer visiting the current file. +;; (find-file-noselect todo-current-todo-file 'nowarn) +;; (or todo-categories +;; ;; In Todo Edit mode todo-categories is now nil +;; ;; since it uses same buffer as Todo mode but +;; ;; doesn't have the latter's local variables. +;; (save-excursion +;; (goto-char (point-min)) +;; (read (buffer-substring-no-properties +;; (line-beginning-position) +;; (line-end-position)))))))) +;; (setq-local todo-categories cats))) (define-derived-mode todo-edit-mode text-mode "Todo-Ed" "Major mode for editing multiline todo items. \\{todo-edit-mode-map}" (todo-modes-set-1) - (todo-mode-external-set) + ;; (todo-mode-external-set) + (setq-local todo-current-todo-file (file-truename (buffer-file-name))) + (when (= (buffer-size) (- (point-max) (point-min))) + ;; Only need this when editing the whole file not just an item. + (setq-local todo-categories (todo-set-categories))) (setq buffer-read-only nil)) (put 'todo-categories-mode 'mode-class 'special) @@ -6745,7 +6759,16 @@ Added to `window-configuration-change-hook' in Todo mode." "Major mode for displaying and editing todo categories. \\{todo-categories-mode-map}" - (todo-mode-external-set)) + ;; (todo-mode-external-set) + (setq-local todo-current-todo-file todo-global-current-todo-file) + (setq-local todo-categories + ;; Can't use find-buffer-visiting when + ;; `todo-show-categories-table' is called on first + ;; invocation of `todo-show', since there is then no + ;; buffer visiting the current file. + (with-current-buffer (find-file-noselect + todo-current-todo-file 'nowarn) + todo-categories))) (put 'todo-filtered-items-mode 'mode-class 'special) diff --git a/test/lisp/calendar/todo-mode-tests.el b/test/lisp/calendar/todo-mode-tests.el index 325faeff51..9028204506 100644 --- a/test/lisp/calendar/todo-mode-tests.el +++ b/test/lisp/calendar/todo-mode-tests.el @@ -763,6 +763,24 @@ The highlighting should remain enabled." (ert-simulate-command '(forward-line)) ; Now on first done item. (should (eq 'hl-line (get-char-property (point) 'face))))) +(ert-deftest todo-test-edit-quit () + "Test result of exiting todo-edit-mode on a whole file. +Exiting should return to the same todo-mode or todo-archive-mode +buffer from which the editing command was invoked." + (with-todo-test + (todo-test--show 1) + (let ((buf (current-buffer))) + (todo-edit-file) + (todo-edit-quit) + (should (eq (current-buffer) buf)) + (should (eq major-mode 'todo-mode)) + (todo-find-archive) + (let ((buf (current-buffer))) + (todo-edit-file) + (todo-edit-quit) + (should (eq (current-buffer) buf)) + (should (eq major-mode 'todo-archive-mode)))))) + (provide 'todo-mode-tests) ;;; todo-mode-tests.el ends here commit 11c7c2f758f8f07e7b917fbc93267cee236a80e5 Author: Paul Eggert Date: Tue Aug 14 12:07:09 2018 -0700 Remove more traces of misc (Bug#32405) Remove misc-objects-consed and the misc component of memory-use-count, since misc objects no longer exist. * doc/lispref/internals.texi, etc/NEWS: Mention this, and adjust better to recent removal of misc objects. * src/alloc.c (MEM_TYPE_MISC): Remove; no longer used. (Fmemory_use_counts): Omit misc count, since miscs no longer exist. (misc-objects-consed): Remove. diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index c72dbb5079..3fe28446ea 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -246,8 +246,8 @@ of 8k bytes, and small vectors are packed into blocks of 4k bytes). @cindex vector-like objects, storage @cindex storage of vector-like Lisp objects - Beyond the basic vector, a lot of objects like window, buffer, and -frame are managed as if they were vectors. The corresponding C data + Beyond the basic vector, a lot of objects like markers, overlays and +buffers are managed as if they were vectors. The corresponding C data structures include the @code{union vectorlike_header} field whose @code{size} member contains the subtype enumerated by @code{enum pvec_type} and an information about how many @code{Lisp_Object} fields this structure @@ -579,6 +579,8 @@ in this Emacs session. @defvar vector-cells-consed The total number of vector cells that have been allocated so far in this Emacs session. +This includes vector-like objects such as markers and overlays, plus +certain objects not visible to users. @end defvar @defvar symbols-consed @@ -591,12 +593,6 @@ The total number of string characters that have been allocated so far in this session. @end defvar -@defvar misc-objects-consed -The total number of miscellaneous objects that have been allocated so -far in this session. These include markers and overlays, plus -certain objects not visible to users. -@end defvar - @defvar intervals-consed The total number of intervals that have been allocated so far in this Emacs session. @@ -987,7 +983,7 @@ a special type to represent the pointers to all of them, which is known as In C, the tagged pointer is an object of type @code{Lisp_Object}. Any initialized variable of such a type always holds the value of one of the following basic data types: integer, symbol, string, cons cell, float, -vectorlike or miscellaneous object. Each of these data types has the +or vectorlike object. Each of these data types has the corresponding tag value. All tags are enumerated by @code{enum Lisp_Type} and placed into a 3-bit bitfield of the @code{Lisp_Object}. The rest of the bits is the value itself. Integers are immediate, i.e., directly @@ -1019,18 +1015,13 @@ Symbol, the unique-named entity commonly used as an identifier. @item struct Lisp_Float Floating-point value. - -@item union Lisp_Misc -Miscellaneous kinds of objects which don't fit into any of the above. @end table These types are the first-class citizens of an internal type system. -Since the tag space is limited, all other types are the subtypes of either -@code{Lisp_Vectorlike} or @code{Lisp_Misc}. Vector subtypes are enumerated +Since the tag space is limited, all other types are the subtypes of +@code{Lisp_Vectorlike}. Vector subtypes are enumerated by @code{enum pvec_type}, and nearly all complex objects like windows, buffers, -frames, and processes fall into this category. The rest of special types, -including markers and overlays, are enumerated by @code{enum Lisp_Misc_Type} -and form the set of subtypes of @code{Lisp_Misc}. +frames, and processes fall into this category. Below there is a description of a few subtypes of @code{Lisp_Vectorlike}. Buffer object represents the text to display and edit. Window is the part diff --git a/etc/NEWS b/etc/NEWS index e381a546a9..f1d09a2b63 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -831,9 +831,11 @@ is backwards-compatible with versions of Emacs in which the old function exists. See the node "Displaying Buffers in Side Windows" in the ELisp manual for more details. -** The 'garbage-collect' function no longer returns a 'misc' component -because garbage collection no longer treats miscellaneous objects -specially; they are now allocated like any other pseudovector. +** garbage collection no longer treats miscellaneous objects specially; +they are now allocated like any other pseudovector. As a result, the +'garbage-collect' and 'memory-use-count' functions no longer return a +'misc' component, and the 'misc-objects-consed' variable has been +removed. * Lisp Changes in Emacs 27.1 diff --git a/src/alloc.c b/src/alloc.c index fb8a8c98b0..6a93821159 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -379,7 +379,6 @@ enum mem_type MEM_TYPE_BUFFER, MEM_TYPE_CONS, MEM_TYPE_STRING, - MEM_TYPE_MISC, MEM_TYPE_SYMBOL, MEM_TYPE_FLOAT, /* Since all non-bool pseudovectors are small enough to be @@ -7023,11 +7022,10 @@ Each of these counters increments for a certain kind of object. The counters wrap around from the largest positive integer to zero. Garbage collection does not decrease them. The elements of the value are as follows: - (CONSES FLOATS VECTOR-CELLS SYMBOLS STRING-CHARS MISCS INTERVALS STRINGS) + (CONSES FLOATS VECTOR-CELLS SYMBOLS STRING-CHARS INTERVALS STRINGS) All are in units of 1 = one object consed except for VECTOR-CELLS and STRING-CHARS, which count the total length of objects consed. -MISCS include overlays, markers, and some internal types. Frames, windows, buffers, and subprocesses count as vectors (but the contents of a buffer's text do not count here). */) (void) @@ -7038,7 +7036,6 @@ Frames, windows, buffers, and subprocesses count as vectors bounded_number (vector_cells_consed), bounded_number (symbols_consed), bounded_number (string_chars_consed), - bounded_number (misc_objects_consed), bounded_number (intervals_consed), bounded_number (strings_consed)); } @@ -7297,11 +7294,6 @@ If this portion is smaller than `gc-cons-threshold', this is ignored. */); DEFVAR_INT ("string-chars-consed", string_chars_consed, doc: /* Number of string characters that have been consed so far. */); - DEFVAR_INT ("misc-objects-consed", misc_objects_consed, - doc: /* Number of miscellaneous objects that have been consed so far. -These include markers and overlays, plus certain objects not visible -to users. */); - DEFVAR_INT ("intervals-consed", intervals_consed, doc: /* Number of intervals that have been consed so far. */); commit db6f511eb709def49280ca5ff2f05b2b7cbfd98d Merge: 2eabf4c13c f882de8b80 Author: Glenn Morris Date: Tue Aug 14 09:06:43 2018 -0700 ; Merge from origin/emacs-26 The following commit was skipped: f882de8 (origin/emacs-26) Port better to x86 -fexcess-precision=fast commit 2eabf4c13c16b58bddfa232adada667f1ebf9135 Merge: 2e08ca25fd 34e75c144e Author: Glenn Morris Date: Tue Aug 14 09:06:43 2018 -0700 Merge from origin/emacs-26 34e75c1 Add comment about floating point test e73e683 Ibuffer: Add toggle ibuffer-do-toggle-lock 12f7116 Ibuffer: Detect correctly the buffers running a process commit 2e08ca25fd2cdc00dd1fa1067dd351228f58049e Merge: d113142a8b 184229766f Author: Glenn Morris Date: Tue Aug 14 09:06:43 2018 -0700 ; Merge from origin/emacs-26 The following commit was skipped: 1842297 Backport fix for Bug#32226 commit d113142a8b8c815ecd6ff1418694cb878db5f45c Merge: 396a33a365 614cc65f2d Author: Glenn Morris Date: Tue Aug 14 09:06:43 2018 -0700 Merge from origin/emacs-26 614cc65 ; * lisp/simple.el (line-move-visual): Fix typo. d2ad4ba Do not consider external packages to be removable (Bug#27822) ec0995c * src/alloc.c: Remove obsolete comments. ec6f588 Better support utf-8-with-signature and utf-8-hfs in HTML eb026a8 Don't use -Wabi compiler option commit 396a33a3656a0e2bbe2f24a81df64914491c44e5 Author: Paul Eggert Date: Tue Aug 14 04:38:44 2018 -0700 Port recent changes to older GCC Problem reported by Glenn Morris in: https://lists.gnu.org/r/emacs-devel/2018-08/msg00446.html * src/lisp.h (make_pointer_integer_unsafe): Port to older GCC. diff --git a/src/lisp.h b/src/lisp.h index 18d53537cc..da93efdd93 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1191,7 +1191,8 @@ XFIXNUMPTR (Lisp_Object a) INLINE Lisp_Object make_pointer_integer_unsafe (void *p) { - return TAG_PTR (Lisp_Int0, p); + Lisp_Object a = TAG_PTR (Lisp_Int0, p); + return a; } INLINE Lisp_Object commit dc18a0917a5531ef3e1c9b4921bb4d8f317bc7a4 Author: Paul Eggert Date: Mon Aug 13 15:55:06 2018 -0700 Update doc strings for fixnum constants * src/data.c (most-positive-fixnum, most-negative-fixnum): Update doc strings in the light of fixnums. diff --git a/src/data.c b/src/data.c index 7b8dd45c94..a1215b9d6b 100644 --- a/src/data.c +++ b/src/data.c @@ -4260,13 +4260,13 @@ syms_of_data (void) set_symbol_function (Qwholenump, XSYMBOL (Qnatnump)->u.s.function); DEFVAR_LISP ("most-positive-fixnum", Vmost_positive_fixnum, - doc: /* The largest value that is representable in a Lisp integer. + doc: /* The greatest integer that is represented efficiently. This variable cannot be set; trying to do so will signal an error. */); Vmost_positive_fixnum = make_fixnum (MOST_POSITIVE_FIXNUM); make_symbol_constant (intern_c_string ("most-positive-fixnum")); DEFVAR_LISP ("most-negative-fixnum", Vmost_negative_fixnum, - doc: /* The smallest value that is representable in a Lisp integer. + doc: /* The least integer that is represented efficiently. This variable cannot be set; trying to do so will signal an error. */); Vmost_negative_fixnum = make_fixnum (MOST_NEGATIVE_FIXNUM); make_symbol_constant (intern_c_string ("most-negative-fixnum")); commit 76101698a770d389f22b547c331ec78473040c47 Author: Paul Eggert Date: Mon Aug 13 15:45:17 2018 -0700 Fix check for unsafe watch descriptor * src/lisp.h (make_pointer_integer_unsafe): New function. (make_pointer_integer): Use it. * src/gfilenotify.c (dir_monitor_callback): Omit redundant eassert. (Fgfile_add_watch): Signal an error instead of failing an assertion if the pointer does not work. diff --git a/src/gfilenotify.c b/src/gfilenotify.c index 7eea2cfac1..798f308b31 100644 --- a/src/gfilenotify.c +++ b/src/gfilenotify.c @@ -77,7 +77,6 @@ dir_monitor_callback (GFileMonitor *monitor, /* Determine callback function. */ monitor_object = make_pointer_integer (monitor); - eassert (FIXNUMP (monitor_object)); watch_object = assq_no_quit (monitor_object, watch_list); if (CONSP (watch_object)) @@ -203,10 +202,10 @@ will be reported only in case of the `moved' event. */) if (! monitor) xsignal2 (Qfile_notify_error, build_string ("Cannot watch file"), file); - Lisp_Object watch_descriptor = make_pointer_integer (monitor); + Lisp_Object watch_descriptor = make_pointer_integer_unsafe (monitor); - /* Check the dicey assumption that make_pointer_integer is safe. */ - if (! FIXNUMP (watch_descriptor)) + if (! (FIXNUMP (watch_descriptor) + && XFIXNUMPTR (watch_descriptor) == monitor)) { g_object_unref (monitor); xsignal2 (Qfile_notify_error, build_string ("Unsupported file watcher"), diff --git a/src/lisp.h b/src/lisp.h index b7ef8dc63a..18d53537cc 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1188,10 +1188,16 @@ XFIXNUMPTR (Lisp_Object a) return XUNTAG (a, Lisp_Int0, char); } +INLINE Lisp_Object +make_pointer_integer_unsafe (void *p) +{ + return TAG_PTR (Lisp_Int0, p); +} + INLINE Lisp_Object make_pointer_integer (void *p) { - Lisp_Object a = TAG_PTR (Lisp_Int0, p); + Lisp_Object a = make_pointer_integer_unsafe (p); eassert (FIXNUMP (a) && XFIXNUMPTR (a) == p); return a; } commit f882de8b8095c3a42d1f6d22ed3f7aed57e9f5e0 Author: Paul Eggert Date: Sun Aug 12 15:28:20 2018 -0700 Port better to x86 -fexcess-precision=fast Problem reported by Eli Zaretskii in: https://lists.gnu.org/r/emacs-devel/2018-08/msg00380.html * src/data.c (arithcompare): Work around incompatibility between gcc -fexcess-precision=fast and the C standard on x86, by capturing the results of floating-point comparisons before the excess precision spontaneously decays. Although this fix might not work in general, it does work here and is probably good enough for the platforms we care about. (cherry picked from commit a84cef90957f2379cc0df6bd908317fc441971ce) diff --git a/src/data.c b/src/data.c index 4bee194e29..4569f00242 100644 --- a/src/data.c +++ b/src/data.c @@ -2411,17 +2411,20 @@ arithcompare (Lisp_Object num1, Lisp_Object num2, { double f1, f2; EMACS_INT i1, i2; - bool fneq; + bool lt, eq, gt; bool test; CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1); CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2); /* If either arg is floating point, set F1 and F2 to the 'double' - approximations of the two arguments, and set FNEQ if floating-point - comparison reports that F1 is not equal to F2, possibly because F1 - or F2 is a NaN. Regardless, set I1 and I2 to integers that break - ties if the floating-point comparison is either not done or reports + approximations of the two arguments, and set LT, EQ, and GT to + the <, ==, > floating-point comparisons of F1 and F2 + respectively, taking care to avoid problems if either is a NaN, + and trying to avoid problems on platforms where variables (in + violation of the C standard) can contain excess precision. + Regardless, set I1 and I2 to integers that break ties if the + floating-point comparison is either not done or reports equality. */ if (FLOATP (num1)) @@ -2444,7 +2447,9 @@ arithcompare (Lisp_Object num1, Lisp_Object num2, to I2 will break the tie correctly. */ i1 = f2 = i2 = XINT (num2); } - fneq = f1 != f2; + lt = f1 < f2; + eq = f1 == f2; + gt = f1 > f2; } else { @@ -2455,39 +2460,49 @@ arithcompare (Lisp_Object num1, Lisp_Object num2, converse of comparing float to integer (see above). */ i2 = f1 = i1; f2 = XFLOAT_DATA (num2); - fneq = f1 != f2; + lt = f1 < f2; + eq = f1 == f2; + gt = f1 > f2; } else { i2 = XINT (num2); - fneq = false; + eq = true; } } + if (eq) + { + /* Break a floating-point tie by comparing the integers. */ + lt = i1 < i2; + eq = i1 == i2; + gt = i1 > i2; + } + switch (comparison) { case ARITH_EQUAL: - test = !fneq && i1 == i2; + test = eq; break; case ARITH_NOTEQUAL: - test = fneq || i1 != i2; + test = !eq; break; case ARITH_LESS: - test = fneq ? f1 < f2 : i1 < i2; + test = lt; break; case ARITH_LESS_OR_EQUAL: - test = fneq ? f1 <= f2 : i1 <= i2; + test = lt | eq; break; case ARITH_GRTR: - test = fneq ? f1 > f2 : i1 > i2; + test = gt; break; case ARITH_GRTR_OR_EQUAL: - test = fneq ? f1 >= f2 : i1 >= i2; + test = gt | eq; break; default: commit 34e75c144efe54dd6063fbb65d5a40176952422c Author: Paul Eggert Date: Mon Aug 13 09:36:11 2018 -0700 Add comment about floating point test * test/src/data-tests.el (data-tests--float-greater-than-fixnums): New constant. (data-tests-=, data-tests-<, data-tests->, data-tests-<=) (data-tests->=, data-tests-min): Use it. diff --git a/test/src/data-tests.el b/test/src/data-tests.el index 91463db113..b444dc70f1 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -23,13 +23,21 @@ (require 'cl-lib) +(defconst data-tests--float-greater-than-fixnums (+ 1.0 most-positive-fixnum) + "A floating-point value that is greater than all fixnums. +It is also as small as conveniently possible, to make the tests sharper. +Adding 1.0 to most-positive-fixnum should suffice on all +practical Emacs platforms, since the result is a power of 2 and +this is exactly representable and is greater than +most-positive-fixnum, which is just less than a power of 2.") + (ert-deftest data-tests-= () (should-error (=)) (should (= 1)) (should (= 2 2)) (should (= 9 9 9 9 9 9 9 9 9)) (should (= most-negative-fixnum (float most-negative-fixnum))) - (should-not (= most-positive-fixnum (+ 1.0 most-positive-fixnum))) + (should-not (= most-positive-fixnum data-tests--float-greater-than-fixnums)) (should-not (apply #'= '(3 8 3))) (should-error (= 9 9 'foo)) ;; Short circuits before getting to bad arg @@ -40,7 +48,7 @@ (should (< 1)) (should (< 2 3)) (should (< -6 -1 0 2 3 4 8 9 999)) - (should (< 0.5 most-positive-fixnum (+ 1.0 most-positive-fixnum))) + (should (< 0.5 most-positive-fixnum data-tests--float-greater-than-fixnums)) (should-not (apply #'< '(3 8 3))) (should-error (< 9 10 'foo)) ;; Short circuits before getting to bad arg @@ -51,7 +59,7 @@ (should (> 1)) (should (> 3 2)) (should (> 6 1 0 -2 -3 -4 -8 -9 -999)) - (should (> (+ 1.0 most-positive-fixnum) most-positive-fixnum 0.5)) + (should (> data-tests--float-greater-than-fixnums most-positive-fixnum 0.5)) (should-not (apply #'> '(3 8 3))) (should-error (> 9 8 'foo)) ;; Short circuits before getting to bad arg @@ -62,7 +70,7 @@ (should (<= 1)) (should (<= 2 3)) (should (<= -6 -1 -1 0 0 0 2 3 4 8 999)) - (should (<= 0.5 most-positive-fixnum (+ 1.0 most-positive-fixnum))) + (should (<= 0.5 most-positive-fixnum data-tests--float-greater-than-fixnums)) (should-not (apply #'<= '(3 8 3 3))) (should-error (<= 9 10 'foo)) ;; Short circuits before getting to bad arg @@ -73,7 +81,7 @@ (should (>= 1)) (should (>= 3 2)) (should (>= 666 1 0 0 -2 -3 -3 -3 -4 -8 -8 -9 -999)) - (should (>= (+ 1.0 most-positive-fixnum) most-positive-fixnum)) + (should (>= data-tests--float-greater-than-fixnums most-positive-fixnum)) (should-not (apply #'>= '(3 8 3))) (should-error (>= 9 8 'foo)) ;; Short circuits before getting to bad arg @@ -97,7 +105,7 @@ (should (= 2 (min 3 2))) (should (= -999 (min 666 1 0 0 -2 -3 -3 -3 -4 -8 -8 -9 -999))) (should (= most-positive-fixnum - (min (+ 1.0 most-positive-fixnum) most-positive-fixnum))) + (min data-tests--float-greater-than-fixnums most-positive-fixnum))) (should (= 3 (apply #'min '(3 8 3)))) (should-error (min 9 8 'foo)) (should-error (min (make-marker))) commit eb787d749f28583906428269b926fa83aef092b9 Author: Raimon Grau Date: Sun Aug 5 22:47:30 2018 +0100 Add uuid as allowed thingatpt symbol (Bug#32372) * etc/NEWS: Mention changes in thingatpt.el. * lisp/thingatpt.el (thing-at-point-uuid-regexp): Add regexp for uuid. (top-level): Add 'bounds-of-thing-at-point' operation for 'uuid'. * test/lisp/thingatpt-tests.el: Add tests for uuid at point. diff --git a/etc/NEWS b/etc/NEWS index decc5e3954..7695a96bb2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -705,6 +705,12 @@ to signal the main thread, e.g., when they encounter an error. +++ *** 'thread-join' returns the result of the finished thread now. +--- +** thingatpt.el supports a new "thing" called 'uuid'. +A symbol 'uuid' can be passed to thing-at-point and it returns the +UUID at point. + + * New Modes and Packages in Emacs 27.1 diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index 7fcb3bc2b7..679401eef1 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -61,7 +61,7 @@ "Move forward to the end of the Nth next THING. THING should be a symbol specifying a type of syntactic entity. Possibilities include `symbol', `list', `sexp', `defun', -`filename', `url', `email', `word', `sentence', `whitespace', +`filename', `url', `email', `uuid', `word', `sentence', `whitespace', `line', and `page'." (let ((forward-op (or (get thing 'forward-op) (intern-soft (format "forward-%s" thing))))) @@ -76,7 +76,7 @@ Possibilities include `symbol', `list', `sexp', `defun', "Determine the start and end buffer locations for the THING at point. THING should be a symbol specifying a type of syntactic entity. Possibilities include `symbol', `list', `sexp', `defun', -`filename', `url', `email', `word', `sentence', `whitespace', +`filename', `url', `email', `uuid', `word', `sentence', `whitespace', `line', and `page'. See the file `thingatpt.el' for documentation on how to define a @@ -134,7 +134,7 @@ positions of the thing found." "Return the THING at point. THING should be a symbol specifying a type of syntactic entity. Possibilities include `symbol', `list', `sexp', `defun', -`filename', `url', `email', `word', `sentence', `whitespace', +`filename', `url', `email', `uuid', `word', `sentence', `whitespace', `line', `number', and `page'. When the optional argument NO-PROPERTIES is non-nil, @@ -564,6 +564,24 @@ with angle brackets.") (put 'buffer 'end-op (lambda () (goto-char (point-max)))) (put 'buffer 'beginning-op (lambda () (goto-char (point-min)))) +;; UUID + +(defconst thing-at-point-uuid-regexp + (rx bow + (repeat 8 hex-digit) "-" + (repeat 4 hex-digit) "-" + (repeat 4 hex-digit) "-" + (repeat 4 hex-digit) "-" + (repeat 12 hex-digit) + eow) + "A regular expression matching a UUID. +See RFC 4122 for the description of the format.") + +(put 'uuid 'bounds-of-thing-at-point + (lambda () + (when (thing-at-point-looking-at thing-at-point-uuid-regexp 36) + (cons (match-beginning 0) (match-end 0))))) + ;; Aliases (defun word-at-point () diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el index cfb57de618..b4a5fd90ce 100644 --- a/test/lisp/thingatpt-tests.el +++ b/test/lisp/thingatpt-tests.el @@ -65,7 +65,10 @@ ("http://example.com/ab)c" 4 url "http://example.com/ab)c") ;; URL markup, lacking schema ("" 1 url "mailto:foo@example.com") - ("" 1 url "ftp://ftp.example.net/abc/")) + ("" 1 url "ftp://ftp.example.net/abc/") + ;; UUID, only hex is allowed + ("01234567-89ab-cdef-ABCD-EF0123456789" 1 uuid "01234567-89ab-cdef-ABCD-EF0123456789") + ("01234567-89ab-cdef-ABCD-EF012345678G" 1 uuid nil)) "List of thing-at-point tests. Each list element should have the form commit e73e6838aa595e5a3d217480c96b1d04d3d1cb16 Author: Tino Calancha Date: Mon Aug 13 19:24:31 2018 +0900 Ibuffer: Add toggle ibuffer-do-toggle-lock Toggle the locked status in marked buffers or the buffer at point (Bug#32421). * lisp/ibuffer.el (ibuffer-do-toggle-lock): New command. (ibuffer-mode-map): Bind it to 'L'. (ibuffer-mode-operate-map): Add entries for `ibuffer-do-toggle-read-only' and `ibuffer-do-toggle-lock'. * etc/NEWS (Changes in Specialized Modes and Packages in Emacs 26.2): Announce the change. diff --git a/etc/NEWS b/etc/NEWS index a1c12a6766..e563473661 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -45,6 +45,11 @@ often cause crashes. Set it to nil if you really need those fonts. * Changes in Specialized Modes and Packages in Emacs 26.2 +** Ibuffer + +--- +*** New toggle 'ibuffer-do-toggle-lock', bound to 'L'. + ** Gnus --- diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 03018d08a5..08b0801cb5 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -590,6 +590,7 @@ directory, like `default-directory'." (define-key map (kbd "R") 'ibuffer-do-rename-uniquely) (define-key map (kbd "S") 'ibuffer-do-save) (define-key map (kbd "T") 'ibuffer-do-toggle-read-only) + (define-key map (kbd "L") 'ibuffer-do-toggle-lock) (define-key map (kbd "r") 'ibuffer-do-replace-regexp) (define-key map (kbd "V") 'ibuffer-do-revert) (define-key map (kbd "W") 'ibuffer-do-view-and-eval) @@ -862,6 +863,10 @@ directory, like `default-directory'." '(menu-item "Print" ibuffer-do-print)) (define-key-after operate-map [do-toggle-modified] '(menu-item "Toggle modification flag" ibuffer-do-toggle-modified)) + (define-key-after operate-map [do-toggle-read-only] + '(menu-item "Toggle read-only flag" ibuffer-do-toggle-read-only)) + (define-key-after operate-map [do-toggle-lock] + '(menu-item "Toggle lock flag" ibuffer-do-toggle-lock)) (define-key-after operate-map [do-revert] '(menu-item "Revert" ibuffer-do-revert :help "Revert marked buffers to their associated file")) @@ -1361,6 +1366,16 @@ Otherwise, toggle read only status." :modifier-p t) (read-only-mode (if (integerp arg) arg 'toggle))) +(define-ibuffer-op ibuffer-do-toggle-lock (&optional arg) + "Toggle locked status in marked buffers. +If optional ARG is a non-negative integer, lock buffers. +If ARG is a negative integer or 0, unlock buffers. +Otherwise, toggle lock status." + (:opstring "toggled lock status in" + :interactive "P" + :modifier-p t) + (emacs-lock-mode (if (integerp arg) arg 'toggle))) + (define-ibuffer-op ibuffer-do-delete () "Kill marked buffers as with `kill-this-buffer'." (:opstring "killed" @@ -2513,6 +2528,7 @@ Operations on marked buffers: `\\[ibuffer-do-view-other-frame]' - View the marked buffers in another frame. `\\[ibuffer-do-revert]' - Revert the marked buffers. `\\[ibuffer-do-toggle-read-only]' - Toggle read-only state of marked buffers. + `\\[ibuffer-do-toggle-lock]' - Toggle lock state of marked buffers. `\\[ibuffer-do-delete]' - Kill the marked buffers. `\\[ibuffer-do-isearch]' - Do incremental search in the marked buffers. `\\[ibuffer-do-isearch-regexp]' - Isearch for regexp in the marked buffers. commit 12f7116714cf0cc3566ea2a5b1184c99cbfe7b90 Author: Tino Calancha Date: Mon Aug 13 19:22:49 2018 +0900 Ibuffer: Detect correctly the buffers running a process * lisp/ibuffer.el (filename-and-process): Store the process buffer as a text property; check for such property to detect a buffer with a process (Bug#32420). diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 0a7bfe00a9..03018d08a5 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -1912,11 +1912,9 @@ If point is on a group name, this function operates on that group." (let ((procs 0) (files 0)) (dolist (string strings) - (if (string-match "\\(?:\\`([[:ascii:]]+)\\)" string) - (progn (setq procs (1+ procs)) - (if (< (match-end 0) (length string)) - (setq files (1+ files)))) - (setq files (1+ files)))) + (when (get-text-property 1 'ibuffer-process string) + (setq procs (1+ procs))) + (setq files (1+ files))) (concat (cond ((zerop files) "No files") ((= 1 files) "1 file") (t (format "%d files" files))) @@ -1928,7 +1926,8 @@ If point is on a group name, this function operates on that group." (filename (ibuffer-make-column-filename buffer mark))) (if proc (concat (propertize (format "(%s %s)" proc (process-status proc)) - 'font-lock-face 'italic) + 'font-lock-face 'italic + 'ibuffer-process proc) (if (> (length filename) 0) (format " %s" filename) "")) commit a1e0868f74f7b2b6b77026734102bd453cf1933b Author: Paul Eggert Date: Sun Aug 12 17:25:37 2018 -0700 Pacify gcc -Og -Wuninitialized This addresses the -Og uninitialized variable warnings I ran into on Fedora 28, which uses 8.1.1 20180712 (Red Hat 8.1.1-5). It also changes some explicit initializations to UNINIT when the variable does not actually need to be initialized. * src/process.c (connect_network_socket): * src/sysdep.c (system_process_attributes): * src/xfns.c (x_real_pos_and_offsets): * src/xterm.c (get_current_wm_state) [USE_XCB]: Add UNINIT. * src/editfns.c (tzlookup): * src/fns.c (Fnconc): * src/font.c (font_parse_fcname): * src/frame.c (x_set_frame_parameters): Prefer UNINIT to explicit initialization. diff --git a/src/editfns.c b/src/editfns.c index 71eb2a8809..d2281d7e81 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -174,7 +174,7 @@ tzlookup (Lisp_Object zone, bool settz) else if (plain_integer || (CONSP (zone) && FIXNUMP (XCAR (zone)) && CONSP (XCDR (zone)))) { - Lisp_Object abbr = Qnil; + Lisp_Object abbr UNINIT; if (!plain_integer) { abbr = XCAR (XCDR (zone)); diff --git a/src/fns.c b/src/fns.c index 7af2273f7e..f6e6803641 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2522,7 +2522,7 @@ usage: (nconc &rest LISTS) */) CHECK_CONS (tem); - Lisp_Object tail = Qnil; + Lisp_Object tail UNINIT; FOR_EACH_TAIL (tem) tail = tem; diff --git a/src/font.c b/src/font.c index 9a0a9babd2..920ec1e02b 100644 --- a/src/font.c +++ b/src/font.c @@ -1468,7 +1468,7 @@ font_parse_fcname (char *name, ptrdiff_t len, Lisp_Object font) else { /* KEY=VAL pairs */ - Lisp_Object key = Qnil; + Lisp_Object key UNINIT; int prop; if (q - p == 10 && memcmp (p + 1, "pixelsize", 9) == 0) diff --git a/src/frame.c b/src/frame.c index 81642ccded..ece8971d5b 100644 --- a/src/frame.c +++ b/src/frame.c @@ -3798,7 +3798,7 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist) Lisp_Object icon_left, icon_top; /* And with this. */ - Lisp_Object fullscreen = Qnil; + Lisp_Object fullscreen UNINIT; bool fullscreen_change = false; /* Record in these vectors all the parms specified. */ diff --git a/src/process.c b/src/process.c index c8123be28e..a266da1c1b 100644 --- a/src/process.c +++ b/src/process.c @@ -3336,7 +3336,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, int family; struct sockaddr *sa = NULL; int ret; - ptrdiff_t addrlen; + ptrdiff_t addrlen UNINIT; struct Lisp_Process *p = XPROCESS (proc); Lisp_Object contact = p->childp; int optbits = 0; diff --git a/src/sysdep.c b/src/sysdep.c index cf2982bca1..889ad6bdb0 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -3239,7 +3239,7 @@ system_process_attributes (Lisp_Object pid) struct group *gr; long clocks_per_sec; char *procfn_end; - char procbuf[1025], *p, *q; + char procbuf[1025], *p, *q UNINIT; int fd; ssize_t nread; static char const default_cmd[] = "???"; diff --git a/src/xfns.c b/src/xfns.c index 6ed9ecaab5..f365241bdb 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -274,7 +274,7 @@ x_real_pos_and_offsets (struct frame *f, should be the outer WM window. */ for (;;) { - Window wm_window, rootw; + Window wm_window UNINIT, rootw UNINIT; #ifdef USE_XCB xcb_query_tree_cookie_t query_tree_cookie; diff --git a/src/xterm.c b/src/xterm.c index 7131497e69..06c84463c6 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10637,7 +10637,7 @@ get_current_wm_state (struct frame *f, #ifdef USE_XCB xcb_get_property_cookie_t prop_cookie; xcb_get_property_reply_t *prop; - xcb_atom_t *reply_data; + xcb_atom_t *reply_data UNINIT; #else Display *dpy = FRAME_X_DISPLAY (f); unsigned long bytes_remaining; commit ca10011898e2ceeded4027413a1488837199ad7a Author: Paul Eggert Date: Sun Aug 12 17:14:43 2018 -0700 * configure.ac (GMP_LIB): Set to -lgmp if --without-mini-gmp. diff --git a/configure.ac b/configure.ac index c40b3bd290..0b8849eea2 100644 --- a/configure.ac +++ b/configure.ac @@ -4312,7 +4312,7 @@ GMP_OBJ=mini-gmp-emacs.o HAVE_GMP=no case $with_mini_gmp in yes) ;; - no) HAVE_GMP=yes;; + no) HAVE_GMP=yes GMP_LIB=-lgmp;; *) AC_CHECK_HEADERS([gmp.h], [OLIBS=$LIBS AC_SEARCH_LIBS([__gmpz_roinit_n], [gmp]) commit a84cef90957f2379cc0df6bd908317fc441971ce Author: Paul Eggert Date: Sun Aug 12 15:28:20 2018 -0700 Port better to x86 -fexcess-precision=fast Problem reported by Eli Zaretskii in: https://lists.gnu.org/r/emacs-devel/2018-08/msg00380.html * src/data.c (arithcompare): Work around incompatibility between gcc -fexcess-precision=fast and the C standard on x86, by capturing the results of floating-point comparisons before the excess precision spontaneously decays. Although this fix might not work in general, it does work here and is probably good enough for the platforms we care about. diff --git a/src/data.c b/src/data.c index c8a9c6b378..7b8dd45c94 100644 --- a/src/data.c +++ b/src/data.c @@ -2492,7 +2492,7 @@ arithcompare (Lisp_Object num1, Lisp_Object num2, { double f1, f2; EMACS_INT i1, i2; - bool fneq; + bool lt, eq, gt; bool test; CHECK_NUMBER_COERCE_MARKER (num1); @@ -2502,10 +2502,13 @@ arithcompare (Lisp_Object num1, Lisp_Object num2, return bignumcompare (num1, num2, comparison); /* If either arg is floating point, set F1 and F2 to the 'double' - approximations of the two arguments, and set FNEQ if floating-point - comparison reports that F1 is not equal to F2, possibly because F1 - or F2 is a NaN. Regardless, set I1 and I2 to integers that break - ties if the floating-point comparison is either not done or reports + approximations of the two arguments, and set LT, EQ, and GT to + the <, ==, > floating-point comparisons of F1 and F2 + respectively, taking care to avoid problems if either is a NaN, + and trying to avoid problems on platforms where variables (in + violation of the C standard) can contain excess precision. + Regardless, set I1 and I2 to integers that break ties if the + floating-point comparison is either not done or reports equality. */ if (FLOATP (num1)) @@ -2528,7 +2531,9 @@ arithcompare (Lisp_Object num1, Lisp_Object num2, to I2 will break the tie correctly. */ i1 = f2 = i2 = XFIXNUM (num2); } - fneq = f1 != f2; + lt = f1 < f2; + eq = f1 == f2; + gt = f1 > f2; } else { @@ -2539,39 +2544,49 @@ arithcompare (Lisp_Object num1, Lisp_Object num2, converse of comparing float to integer (see above). */ i2 = f1 = i1; f2 = XFLOAT_DATA (num2); - fneq = f1 != f2; + lt = f1 < f2; + eq = f1 == f2; + gt = f1 > f2; } else { i2 = XFIXNUM (num2); - fneq = false; + eq = true; } } + if (eq) + { + /* Break a floating-point tie by comparing the integers. */ + lt = i1 < i2; + eq = i1 == i2; + gt = i1 > i2; + } + switch (comparison) { case ARITH_EQUAL: - test = !fneq && i1 == i2; + test = eq; break; case ARITH_NOTEQUAL: - test = fneq || i1 != i2; + test = !eq; break; case ARITH_LESS: - test = fneq ? f1 < f2 : i1 < i2; + test = lt; break; case ARITH_LESS_OR_EQUAL: - test = fneq ? f1 <= f2 : i1 <= i2; + test = lt | eq; break; case ARITH_GRTR: - test = fneq ? f1 > f2 : i1 > i2; + test = gt; break; case ARITH_GRTR_OR_EQUAL: - test = fneq ? f1 >= f2 : i1 >= i2; + test = gt | eq; break; default: commit 2b1cac26855b99644b00a839f7ea25446d997572 Author: Stephen Berman Date: Sun Aug 12 23:25:53 2018 +0200 Update and improve todo-mode item insertion and editing code * lisp/calendar/todo-mode.el (todo-insert-item--param-key-alist) (todo-insert-item--keyof, todo-insert-item--this-key) (todo-insert-item--keys-so-far, todo-insert-item--args) (todo-insert-item--argleft. todo-insert-item--argsleft) (todo-insert-item--newargsleft, todo-insert-item--apply-args) (todo-edit-item--param-key-alist, todo-edit-item--prompt) (todo-edit-item--date-param-key-alist) (todo-edit-done-item--param-key-alist): Remove. (todo-insert-item--next-param): Reimplement to take advantage of lexical binding. (todo-insert-item): Adjust to new implementation of the above. (todo-edit-item--next-key): Incorporate now removed global variables, adjust signature accordingly, update use of pcase. (todo-edit-item): Adjust to changed signature of the above. diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index c1c292129e..9c770f17fb 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -1830,7 +1830,6 @@ consist of the last todo items and the first done items." (defvar todo-date-from-calendar nil "Helper variable for setting item date from the Emacs Calendar.") -(defvar todo-insert-item--keys-so-far) (defvar todo-insert-item--parameters) (defun todo-insert-item (&optional arg) @@ -1852,8 +1851,7 @@ already been entered and which remain available. See `(todo-mode) Inserting New Items' for details of the parameters, their associated keys and their effects." (interactive "P") - (setq todo-insert-item--keys-so-far "i") - (todo-insert-item--next-param nil (list arg) todo-insert-item--parameters)) + (todo-insert-item--next-param (list arg) todo-insert-item--parameters nil "i")) (defun todo-insert-item--basic (&optional arg diary-type date-type time where) "Function implementing the core of `todo-insert-item'." @@ -2101,17 +2099,14 @@ the item at point." (let (todo-show-with-done) (todo-category-select))))) (if ov (delete-overlay ov))))) -(defvar todo-edit-item--param-key-alist) -(defvar todo-edit-done-item--param-key-alist) - (defun todo-edit-item (&optional arg) "Choose an editing operation for the current item and carry it out." (interactive "P") (let ((marked (assoc (todo-current-category) todo-categories-with-marks))) (cond ((and (todo-done-item-p) (not marked)) - (todo-edit-item--next-key todo-edit-done-item--param-key-alist)) + (todo-edit-item--next-key 'done arg)) ((or marked (todo-item-string)) - (todo-edit-item--next-key todo-edit-item--param-key-alist arg))))) + (todo-edit-item--next-key 'todo arg))))) (defun todo-edit-item--text (&optional arg) "Function providing the text editing facilities of `todo-edit-item'." @@ -5523,12 +5518,14 @@ of each other." ;;; Generating and applying item insertion and editing key sequences ;; ----------------------------------------------------------------------------- -;; Thanks to Stefan Monnier for suggesting dynamically generating item -;; insertion commands and their key bindings, and offering an elegant -;; implementation, which, however, relies on lexical scoping and so -;; cannot be used here until the Calendar code used by todo-mode.el is -;; converted to lexical binding. Hence, the following implementation -;; uses dynamic binding. +;; Thanks to Stefan Monnier for (i) not only suggesting dynamically +;; generating item insertion commands and their key bindings but also +;; offering an elegant implementation which, however, since it used +;; lexical binding, was at the time incompatible with the Calendar and +;; Diary code in todo-mode.el; and (ii) later making that code +;; compatible with lexical binding, so that his implementation, of +;; which the following is a somewhat expanded version, could be +;; realized in todo-mode.el. (defconst todo-insert-item--parameters '((default copy) (diary nonmarking) (calendar date dayname) time (here region)) @@ -5536,91 +5533,33 @@ of each other." Passed by `todo-insert-item' to `todo-insert-item--next-param' to dynamically create item insertion commands.") -(defconst todo-insert-item--param-key-alist - '((default . "i") - (copy . "p") - (diary . "y") - (nonmarking . "k") - (calendar . "c") - (date . "d") - (dayname . "n") - (time . "t") - (here . "h") - (region . "r")) - "List pairing item insertion parameters with their completion keys.") - -(defsubst todo-insert-item--keyof (param) - "Return key paired with item insertion PARAM." - (cdr (assoc param todo-insert-item--param-key-alist))) - -(defun todo-insert-item--argsleft (key list) - "Return sublist of LIST whose first member corresponds to KEY." - (let (l sym) - (mapc (lambda (m) - (when (consp m) - (catch 'found1 - (dolist (s m) - (when (equal key (todo-insert-item--keyof s)) - (throw 'found1 (setq sym s)))))) - (if sym - (progn - (push sym l) - (setq sym nil)) - (push m l))) - list) - (setq list (reverse l))) - (memq (catch 'found2 - (dolist (e todo-insert-item--param-key-alist) - (when (equal key (cdr e)) - (throw 'found2 (car e))))) - list)) - -(defsubst todo-insert-item--this-key () (char-to-string last-command-event)) - -(defvar todo-insert-item--keys-so-far "" - "String of item insertion keys so far entered for this command.") - -(defvar todo-insert-item--args nil) -(defvar todo-insert-item--argleft nil) -(defvar todo-insert-item--argsleft nil) -(defvar todo-insert-item--newargsleft nil) - -(defun todo-insert-item--apply-args () - "Build list of arguments for item insertion and apply them. -The list consists of item insertion parameters that can be passed -as insertion command arguments in fixed positions. If a position -in the list is not occupied by the corresponding parameter, it is -occupied by nil." - (let* ((arg (list (car todo-insert-item--args))) - (args (nconc (cdr todo-insert-item--args) - (list (car (todo-insert-item--argsleft - (todo-insert-item--this-key) - todo-insert-item--argsleft))))) - (arglist (if (= 4 (length args)) - args - (let ((v (make-vector 4 nil)) elt) - (while args - (setq elt (pop args)) - (cond ((memq elt '(diary nonmarking)) - (aset v 0 elt)) - ((memq elt '(calendar date dayname)) - (aset v 1 elt)) - ((eq elt 'time) - (aset v 2 elt)) - ((memq elt '(copy here region)) - (aset v 3 elt)))) - (append v nil))))) - (apply #'todo-insert-item--basic (nconc arg arglist)))) - -(defun todo-insert-item--next-param (last args argsleft) - "Build item insertion command from LAST, ARGS and ARGSLEFT and call it. -Dynamically generate key bindings, prompting with the keys -already entered and those still available." - (cl-assert argsleft) +(defun todo-insert-item--next-param (args params last keys-so-far) + "Generate and invoke an item insertion command. +Dynamically generate the command, its arguments ARGS and its key +binding by recursing through the list of parameters PARAMS, +taking the LAST from a sublist and prompting with KEYS-SO-FAR +keys already entered and those still available." + (cl-assert params) (let* ((map (make-sparse-keymap)) + (param-key-alist '((default . "i") + (copy . "p") + (diary . "y") + (nonmarking . "k") + (calendar . "c") + (date . "d") + (dayname . "n") + (time . "t") + (here . "h") + (region . "r"))) + ;; Return key paired with given item insertion parameter. + (key-of (lambda (param) (cdr (assoc param param-key-alist)))) + ;; The key just typed. + (this-key (lambda () (char-to-string last-command-event))) (prompt nil) - (addprompt - (lambda (k name) + ;; Add successively entered keys to the prompt and show what + ;; possibilities remain. + (add-to-prompt + (lambda (key name) (setq prompt (concat prompt (format @@ -5630,80 +5569,119 @@ already entered and those still available." "%s=>%s" (when (memq name '(copy nonmarking dayname region)) " }")) - (propertize k 'face 'todo-key-prompt) - name)))))) - (setq todo-insert-item--args args) - (setq todo-insert-item--argsleft argsleft) + (propertize key 'face 'todo-key-prompt) + name))))) + ;; Return the sublist of the given list of parameters whose + ;; first member is paired with the given key. + (get-params + (lambda (key lst) + (setq lst (if (consp lst) lst (list lst))) + (let (l sym) + (mapc (lambda (m) + (when (consp m) + (catch 'found1 + (dolist (s m) + (when (equal key (funcall key-of s)) + (throw 'found1 (setq sym s)))))) + (if sym + (progn + (push sym l) + (setq sym nil)) + (push m l))) + lst) + (setq lst (reverse l))) + (memq (catch 'found2 + (dolist (e param-key-alist) + (when (equal key (cdr e)) + (throw 'found2 (car e))))) + lst))) + ;; Build list of arguments for item insertion and then + ;; execute the basic insertion function. The list consists of + ;; item insertion parameters that can be passed as insertion + ;; command arguments in fixed positions. If a position in + ;; the list is not occupied by the corresponding parameter, + ;; it is occupied by nil. + (gen-and-exec + (lambda () + (let* ((arg (list (car args))) ; Possible prefix argument. + (rest (nconc (cdr args) + (list (car (funcall get-params + (funcall this-key) + params))))) + (parlist (if (= 4 (length rest)) + rest + (let ((v (make-vector 4 nil)) elt) + (while rest + (setq elt (pop rest)) + (cond ((memq elt '(diary nonmarking)) + (aset v 0 elt)) + ((memq elt '(calendar date dayname)) + (aset v 1 elt)) + ((eq elt 'time) + (aset v 2 elt)) + ((memq elt '(copy here region)) + (aset v 3 elt)))) + (append v nil))))) + (apply #'todo-insert-item--basic (nconc arg parlist))))) + ;; Operate on a copy of the parameter list so the original is + ;; not consumed, thus available for the next key typed. + (params0 params)) (when last (if (memq last '(default copy)) (progn - (setq todo-insert-item--argsleft nil) - (todo-insert-item--apply-args)) - (let ((k (todo-insert-item--keyof last))) - (funcall addprompt k (make-symbol (concat (symbol-name last) ":GO!"))) - (define-key map (todo-insert-item--keyof last) + (setq params0 nil) + (funcall gen-and-exec)) + (let ((key (funcall key-of last))) + (funcall add-to-prompt key (make-symbol + (concat (symbol-name last) ":GO!"))) + (define-key map (funcall key-of last) (lambda () (interactive) - (todo-insert-item--apply-args)))))) - (while todo-insert-item--argsleft - (let ((x (car todo-insert-item--argsleft))) - (setq todo-insert-item--newargsleft (cdr todo-insert-item--argsleft)) - (dolist (argleft (if (consp x) x (list x))) - (let ((k (todo-insert-item--keyof argleft))) - (funcall addprompt k argleft) - (define-key map k - (if (null todo-insert-item--newargsleft) - (lambda () (interactive) - (todo-insert-item--apply-args)) - (lambda () (interactive) - (setq todo-insert-item--keys-so-far - (concat todo-insert-item--keys-so-far " " - (todo-insert-item--this-key))) - (todo-insert-item--next-param - (car (todo-insert-item--argsleft - (todo-insert-item--this-key) - todo-insert-item--argsleft)) - (nconc todo-insert-item--args - (list (car (todo-insert-item--argsleft - (todo-insert-item--this-key) - todo-insert-item--argsleft)))) - (cdr (todo-insert-item--argsleft - (todo-insert-item--this-key) - todo-insert-item--argsleft))))))))) - (setq todo-insert-item--argsleft todo-insert-item--newargsleft)) - (when prompt (message "Press a key (so far `%s'): %s" - todo-insert-item--keys-so-far prompt)) + (funcall gen-and-exec)))))) + (while params0 + (let* ((x (car params0)) + (restparams (cdr params0))) + (dolist (param (if (consp x) x (list x))) + (let ((key (funcall key-of param))) + (funcall add-to-prompt key param) + (define-key map key + (if (null restparams) + (lambda () (interactive) + (funcall gen-and-exec)) + (lambda () (interactive) + (setq keys-so-far (concat keys-so-far " " (funcall this-key))) + (todo-insert-item--next-param + (nconc args (list (car (funcall get-params + (funcall this-key) param)))) + (cdr (funcall get-params (funcall this-key) params)) + (car (funcall get-params (funcall this-key) param)) + keys-so-far)))))) + (setq params0 restparams))) (set-transient-map map) - (setq todo-insert-item--argsleft argsleft))) - -(defconst todo-edit-item--param-key-alist - '((edit . "e") - (header . "h") - (multiline . "m") - (diary . "y") - (nonmarking . "k") - (date . "d") - (time . "t")) - "Alist of item editing parameters and their keys.") - -(defconst todo-edit-item--date-param-key-alist - '((full . "f") - (calendar . "c") - (today . "a") - (dayname . "n") - (year . "y") - (month . "m") - (daynum . "d")) - "Alist of item date editing parameters and their keys.") - -(defconst todo-edit-done-item--param-key-alist - '((add/edit . "c") - (delete . "d")) - "Alist of done item comment editing parameters and their keys.") - -(defvar todo-edit-item--prompt "Press a key (so far `e'): ") - -(defun todo-edit-item--next-key (params &optional arg) - (let* ((p->k (mapconcat (lambda (elt) + (when prompt (message "Press a key (so far `%s'): %s" keys-so-far prompt)) + (setq params0 params))) + +(defun todo-edit-item--next-key (type &optional arg) + (let* ((todo-param-key-alist '((edit . "e") + (header . "h") + (multiline . "m") + (diary . "y") + (nonmarking . "k") + (date . "d") + (time . "t"))) + (done-param-key-alist '((add/edit . "c") + (delete . "d"))) + (date-param-key-alist '((full . "f") + (calendar . "c") + (today . "a") + (dayname . "n") + (year . "y") + (month . "m") + (daynum . "d"))) + (params (pcase type + ('todo todo-param-key-alist) + ('done done-param-key-alist) + ('date date-param-key-alist))) + (p->k (mapconcat (lambda (elt) (format "%s=>%s" (propertize (cdr elt) 'face 'todo-key-prompt) @@ -5712,31 +5690,32 @@ already entered and those still available." '(add/edit delete)) " comment")))) params " ")) - (key-prompt (substitute-command-keys todo-edit-item--prompt)) + (key-prompt (substitute-command-keys + (concat "Press a key (so far `e" + (if (eq type 'date) " d" "") + "'): "))) (this-key (let ((key (read-key (concat key-prompt p->k)))) (and (characterp key) (char-to-string key)))) (this-param (car (rassoc this-key params)))) (pcase this-param - (`edit (todo-edit-item--text)) - (`header (todo-edit-item--text 'include-header)) - (`multiline (todo-edit-item--text 'multiline)) - (`add/edit (todo-edit-item--text 'comment-edit)) - (`delete (todo-edit-item--text 'comment-delete)) - (`diary (todo-edit-item--diary-inclusion)) - (`nonmarking (todo-edit-item--diary-inclusion 'nonmarking)) - (`date (let ((todo-edit-item--prompt "Press a key (so far `e d'): ")) - (todo-edit-item--next-key - todo-edit-item--date-param-key-alist arg))) - (`full (progn (todo-edit-item--header 'date) + ('edit (todo-edit-item--text)) + ('header (todo-edit-item--text 'include-header)) + ('multiline (todo-edit-item--text 'multiline)) + ('add/edit (todo-edit-item--text 'comment-edit)) + ('delete (todo-edit-item--text 'comment-delete)) + ('diary (todo-edit-item--diary-inclusion)) + ('nonmarking (todo-edit-item--diary-inclusion 'nonmarking)) + ('date (todo-edit-item--next-key 'date arg)) + ('full (progn (todo-edit-item--header 'date) (when todo-always-add-time-string (todo-edit-item--header 'time)))) - (`calendar (todo-edit-item--header 'calendar)) - (`today (todo-edit-item--header 'today)) - (`dayname (todo-edit-item--header 'dayname)) - (`year (todo-edit-item--header 'year arg)) - (`month (todo-edit-item--header 'month arg)) - (`daynum (todo-edit-item--header 'day arg)) - (`time (todo-edit-item--header 'time))))) + ('calendar (todo-edit-item--header 'calendar)) + ('today (todo-edit-item--header 'today)) + ('dayname (todo-edit-item--header 'dayname)) + ('year (todo-edit-item--header 'year arg)) + ('month (todo-edit-item--header 'month arg)) + ('daynum (todo-edit-item--header 'day arg)) + ('time (todo-edit-item--header 'time))))) ;; ----------------------------------------------------------------------------- ;;; Todo minibuffer utilities commit f99ee7378f8529e748f894859f305d4cca2483e4 Author: Paul Eggert Date: Sun Aug 12 11:46:07 2018 -0700 Adjust .gdbinit to removal of misc objects * src/.gdbinit (xtype, xpr): Adjust. (xmisctype, xmiscfree): Remove. diff --git a/src/.gdbinit b/src/.gdbinit index 3cebdff5e7..ae6f13a103 100644 --- a/src/.gdbinit +++ b/src/.gdbinit @@ -649,17 +649,13 @@ define xtype xgettype $ output $type echo \n - if $type == Lisp_Misc - xmisctype - else - if $type == Lisp_Vectorlike - xvectype - end + if $type == Lisp_Vectorlike + xvectype end end document xtype Print the type of $, assuming it is an Emacs Lisp value. -If the first type printed is Lisp_Vector or Lisp_Misc, +If the first type printed is Lisp_Vectorlike, a second line gives the more precise type. end @@ -711,15 +707,6 @@ Print the size of $ This command assumes that $ is a Lisp_Object. end -define xmisctype - xgetptr $ - output (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type) - echo \n -end -document xmisctype -Assume that $ is some misc type and print its specific type. -end - define xint xgetint $ print $int @@ -754,15 +741,6 @@ Print $ as a overlay pointer. This command assumes that $ is an Emacs Lisp overlay value. end -define xmiscfree - xgetptr $ - print (struct Lisp_Free *) $ptr -end -document xmiscfree -Print $ as a misc free-cell pointer. -This command assumes that $ is an Emacs Lisp Misc value. -end - define xsymbol set $sym = $ xgetsym $sym @@ -1015,18 +993,6 @@ define xpr if $type == Lisp_Float xfloat end - if $type == Lisp_Misc - set $misc = (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type) - if $misc == Lisp_Misc_Free - xmiscfree - end - if $misc == Lisp_Misc_Marker - xmarker - end - if $misc == Lisp_Misc_Overlay - xoverlay - end - end if $type == Lisp_Vectorlike set $size = ((struct Lisp_Vector *) $ptr)->header.size if ($size & PSEUDOVECTOR_FLAG) @@ -1034,6 +1000,12 @@ define xpr if $vec == PVEC_NORMAL_VECTOR xvector end + if $vec == PVEC_MARKER + xmarker + end + if $vec == PVEC_OVERLAY + xoverlay + end if $vec == PVEC_PROCESS xprocess end commit d966f8d29110f74d84187e013ca8c7e7411951aa Author: Paul Eggert Date: Sun Aug 12 11:10:11 2018 -0700 Make mini-gmp safe for --enable-gcc-warnings * configure.ac (GMP_OBJ): When building mini-gmp, compile mini-gmp-emacs.c, not mini-gmp.c. * lib-src/etags.c (NDEBUG): Don't attempt to redefine, in case the builder compiles with -DNDEBUG. * src/conf_post.h (NDEBUG) [!ENABLE_CHECKING && !NDEBUG]: Define. This avoids bloat in mini-gmp-emacs.o. * src/mini-gmp-emacs.c: New file, which pacifies --enable-gcc-warnings. diff --git a/configure.ac b/configure.ac index 58bdefab6d..c40b3bd290 100644 --- a/configure.ac +++ b/configure.ac @@ -4308,7 +4308,7 @@ AC_ARG_WITH([mini-gmp], GNU Multiple Precision (GMP) library; this is the default on systems with recent-enough GMP.])]) GMP_LIB= -GMP_OBJ=mini-gmp.o +GMP_OBJ=mini-gmp-emacs.o HAVE_GMP=no case $with_mini_gmp in yes) ;; diff --git a/lib-src/etags.c b/lib-src/etags.c index ee50670343..102d867b38 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -85,7 +85,9 @@ char pot_etags_version[] = "@(#) pot revision number is 17.38.1.4"; # define DEBUG true #else # define DEBUG false -# define NDEBUG /* disable assert */ +# ifndef NDEBUG +# define NDEBUG /* disable assert */ +# endif #endif #include diff --git a/src/conf_post.h b/src/conf_post.h index 0927fca7ca..f9838bc662 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -20,9 +20,16 @@ along with GNU Emacs. If not, see . */ /* Put the code here rather than in configure.ac using AH_BOTTOM. This way, the code does not get processed by autoheader. For - example, undefs here are not commented out. + example, undefs here are not commented out. */ - To help make dependencies clearer elsewhere, this file typically +/* Disable 'assert' unless enabling checking. Do this early, in + case some misguided implementation depends on NDEBUG in some + include file other than assert.h. */ +#if !defined ENABLE_CHECKING && !defined NDEBUG +# define NDEBUG +#endif + +/* To help make dependencies clearer elsewhere, this file typically does not #include other files. The exceptions are first stdbool.h because it is unlikely to interfere with configuration and bool is such a core part of the C language, and second ms-w32.h (DOS_NT diff --git a/src/mini-gmp-emacs.c b/src/mini-gmp-emacs.c new file mode 100644 index 0000000000..7a1b7ab5de --- /dev/null +++ b/src/mini-gmp-emacs.c @@ -0,0 +1,32 @@ +/* Tailor mini-gmp.c for GNU Emacs + +Copyright 2018 Free Software Foundation, Inc. + +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 . */ + +#include + +#include + +/* Pacify GCC -Wsuggest-attribute=malloc. */ +static void *gmp_default_alloc (size_t) ATTRIBUTE_MALLOC; + +/* Pacify GCC -Wunused-variable for variables used only in 'assert' calls. */ +#if defined NDEBUG && GNUC_PREREQ (4, 6, 0) +# pragma GCC diagnostic ignored "-Wunused-variable" +#endif + +#include "mini-gmp.c" commit 184229766f9c009119c986a255f2e9f7455c30af Author: Michael Albinus Date: Sun Aug 12 18:15:24 2018 +0200 Backport fix for Bug#32226 * test/lisp/shadowfile-tests.el: Set Tramp variables for hydra. (shadow-test06-literal-groups, shadow-test07-regexp-groups) (shadow-test08-shadow-todo, shadow-test09-shadow-copy-files): Use `set-visited-file-name' instead of setting the value in `buffer-file-name' directly. (shadow-test08-shadow-todo, shadow-test09-shadow-copy-files): Test for writable temporary directory. Suppress errors in cleanup. (Bug#32226) diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el index f7b14250d7..3bab22f8d6 100644 --- a/test/lisp/shadowfile-tests.el +++ b/test/lisp/shadowfile-tests.el @@ -63,6 +63,14 @@ (format "/mock::%s" temporary-file-directory))) "Temporary directory for Tramp tests.") +(setq password-cache-expiry nil + tramp-verbose 0 + tramp-message-show-message nil) + +;; This should happen on hydra only. +(when (getenv "EMACS_HYDRA_CI") + (add-to-list 'tramp-remote-path 'tramp-own-remote-path)) + (defconst shadow-test-info-file (expand-file-name "shadows_test" temporary-file-directory) "File to keep shadow information in during tests.") @@ -618,7 +626,7 @@ guaranteed by the originator of a cluster definition." shadow-test-remote-temporary-file-directory)) mocked-input `(,cluster1 ,file1 ,cluster2 ,file2 ,(kbd "RET"))) (with-temp-buffer - (setq-local buffer-file-name file1) + (set-visited-file-name file1) (call-interactively 'shadow-define-literal-group)) ;; `shadow-literal-groups' is a list of lists. @@ -679,7 +687,7 @@ guaranteed by the originator of a cluster definition." mocked-input `(,(shadow-regexp-superquote file) ,cluster1 ,cluster2 ,(kbd "RET"))) (with-temp-buffer - (setq-local buffer-file-name nil) + (set-visited-file-name nil) (call-interactively 'shadow-define-regexp-group)) ;; `shadow-regexp-groups' is a list of lists. @@ -708,6 +716,7 @@ guaranteed by the originator of a cluster definition." "Check that needed shadows are added to todo." (skip-unless (not (memq system-type '(windows-nt ms-dos)))) (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) + (skip-unless (file-writable-p shadow-test-remote-temporary-file-directory)) (let ((backup-inhibited t) (shadow-info-file shadow-test-info-file) @@ -745,7 +754,7 @@ guaranteed by the originator of a cluster definition." ;; Save file from "cluster1" definition. (with-temp-buffer - (setq buffer-file-name file) + (set-visited-file-name file) (insert "foo") (save-buffer)) (should @@ -755,7 +764,7 @@ guaranteed by the originator of a cluster definition." ;; Save file from "cluster2" definition. (with-temp-buffer - (setq buffer-file-name (concat (shadow-site-primary cluster2) file)) + (set-visited-file-name (concat (shadow-site-primary cluster2) file)) (insert "foo") (save-buffer)) (should @@ -775,7 +784,7 @@ guaranteed by the originator of a cluster definition." ;; Save file from "cluster1" definition. (with-temp-buffer - (setq buffer-file-name file) + (set-visited-file-name file) (insert "foo") (save-buffer)) (should @@ -785,7 +794,7 @@ guaranteed by the originator of a cluster definition." ;; Save file from "cluster2" definition. (with-temp-buffer - (setq buffer-file-name (concat (shadow-site-primary cluster2) file)) + (set-visited-file-name (concat (shadow-site-primary cluster2) file)) (insert "foo") (save-buffer)) (should @@ -800,15 +809,18 @@ guaranteed by the originator of a cluster definition." (delete-file shadow-info-file)) (when (file-exists-p shadow-todo-file) (delete-file shadow-todo-file)) - (when (file-exists-p file) - (delete-file file)) - (when (file-exists-p (concat (shadow-site-primary cluster2) file)) - (delete-file (concat (shadow-site-primary cluster2) file)))))) + (ignore-errors + (when (file-exists-p file) + (delete-file file))) + (ignore-errors + (when (file-exists-p (concat (shadow-site-primary cluster2) file)) + (delete-file (concat (shadow-site-primary cluster2) file))))))) (ert-deftest shadow-test09-shadow-copy-files () "Check that needed shadow files are copied." (skip-unless (not (memq system-type '(windows-nt ms-dos)))) (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) + (skip-unless (file-writable-p shadow-test-remote-temporary-file-directory)) (let ((backup-inhibited t) (shadow-info-file shadow-test-info-file) @@ -855,11 +867,11 @@ guaranteed by the originator of a cluster definition." ;; Save files. (with-temp-buffer - (setq buffer-file-name file) + (set-visited-file-name file) (insert "foo") (save-buffer)) (with-temp-buffer - (setq buffer-file-name (concat (shadow-site-primary cluster2) file)) + (set-visited-file-name (concat (shadow-site-primary cluster2) file)) (insert "foo") (save-buffer)) @@ -886,10 +898,12 @@ guaranteed by the originator of a cluster definition." (delete-file shadow-info-file)) (when (file-exists-p shadow-todo-file) (delete-file shadow-todo-file)) - (when (file-exists-p file) - (delete-file file)) - (when (file-exists-p (concat (shadow-site-primary cluster2) file)) - (delete-file (concat (shadow-site-primary cluster2) file)))))) + (ignore-errors + (when (file-exists-p file) + (delete-file file))) + (ignore-errors + (when (file-exists-p (concat (shadow-site-primary cluster2) file)) + (delete-file (concat (shadow-site-primary cluster2) file))))))) (defun shadowfile-test-all (&optional interactive) "Run all tests for \\[shadowfile]." commit 135037397a568bbeb4af43f9cb98ff35fd86e03f Merge: d9806a55a0 21c2fd724d Author: Eli Zaretskii Date: Sun Aug 12 19:03:27 2018 +0300 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit d9806a55a05157165dceb48727791954c1656ab1 Author: Eli Zaretskii Date: Sun Aug 12 19:02:32 2018 +0300 ; Avoid compilation warnings under -Og * src/w32.c (w32_read_registry): * src/font.c (font_parse_fcname): * src/fns.c (Fnconc): * src/editfns.c (tzlookup): * src/frame.c (x_set_frame_parameters): Avoid compiler warnings about maybe-uninitialized variables. diff --git a/src/editfns.c b/src/editfns.c index 92566fe3bb..71eb2a8809 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -174,7 +174,7 @@ tzlookup (Lisp_Object zone, bool settz) else if (plain_integer || (CONSP (zone) && FIXNUMP (XCAR (zone)) && CONSP (XCDR (zone)))) { - Lisp_Object abbr; + Lisp_Object abbr = Qnil; if (!plain_integer) { abbr = XCAR (XCDR (zone)); diff --git a/src/fns.c b/src/fns.c index ac5edc2cdb..7af2273f7e 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2522,7 +2522,7 @@ usage: (nconc &rest LISTS) */) CHECK_CONS (tem); - Lisp_Object tail; + Lisp_Object tail = Qnil; FOR_EACH_TAIL (tem) tail = tem; diff --git a/src/font.c b/src/font.c index f31d9c21e7..9a0a9babd2 100644 --- a/src/font.c +++ b/src/font.c @@ -1468,7 +1468,7 @@ font_parse_fcname (char *name, ptrdiff_t len, Lisp_Object font) else { /* KEY=VAL pairs */ - Lisp_Object key; + Lisp_Object key = Qnil; int prop; if (q - p == 10 && memcmp (p + 1, "pixelsize", 9) == 0) diff --git a/src/frame.c b/src/frame.c index f9a73c8ffe..81642ccded 100644 --- a/src/frame.c +++ b/src/frame.c @@ -3798,7 +3798,7 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist) Lisp_Object icon_left, icon_top; /* And with this. */ - Lisp_Object fullscreen; + Lisp_Object fullscreen = Qnil; bool fullscreen_change = false; /* Record in these vectors all the parms specified. */ diff --git a/src/w32.c b/src/w32.c index 299bba7be4..ef6047580e 100644 --- a/src/w32.c +++ b/src/w32.c @@ -9358,7 +9358,7 @@ w32_read_registry (HKEY rootkey, Lisp_Object lkey, Lisp_Object lname) DWORD vsize, vtype; LPBYTE pvalue; Lisp_Object val, retval; - const char *key, *value_name; + const char *key, *value_name = NULL; /* The following sizes are according to size limitations documented in MSDN. */ wchar_t key_w[255+1]; commit 21c2fd724dcae8a2342f256a0dd8c3c78fb5e931 Author: Paul Eggert Date: Sun Aug 12 09:01:00 2018 -0700 Fix typo caught by zsh * lisp/Makefile.in (compile-clean): Fix typo; missing ";" (Bug#32423). diff --git a/lisp/Makefile.in b/lisp/Makefile.in index ccc5323b52..c447598298 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -341,7 +341,7 @@ compile-clean: if test -f "$$el" || test ! -f "$${el}c"; then :; else \ echo rm "$${el}c"; \ rm "$${el}c"; \ - fi \ + fi; \ done .PHONY: gen-lisp leim semantic commit 4532def340f8f3f40fccb42b6c265278323bff02 Author: Michael Albinus Date: Sun Aug 12 17:38:24 2018 +0200 ; Remove instrumentation for Bug#32226 diff --git a/lisp/files.el b/lisp/files.el index 3482524900..8057def525 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5078,29 +5078,19 @@ Before and after saving the buffer, this function runs (set-visited-file-name filename))) ;; Support VC version backups. (vc-before-save) - ;; We are hunting a nasty error, which happens on hydra. - ;; Adding traces might help. - (if (getenv "BUG_32226") (message "BUG_32226")) (or (run-hook-with-args-until-success 'local-write-file-hooks) (run-hook-with-args-until-success 'write-file-functions) - (progn - (if (getenv "BUG_32226") - (message "BUG_32226 %s" buffer-file-name)) - nil) ;; If a hook returned t, file is already "written". ;; Otherwise, write it the usual way now. (let ((dir (file-name-directory (expand-file-name buffer-file-name)))) - (if (getenv "BUG_32226") (message "BUG_32226 %s" dir)) (unless (file-exists-p dir) (if (y-or-n-p (format-message "Directory `%s' does not exist; create? " dir)) (make-directory dir t) (error "Canceled"))) - (if (getenv "BUG_32226") (message "BUG_32226 %s" dir)) (setq setmodes (basic-save-buffer-1))))) - (if (getenv "BUG_32226") (message "BUG_32226")) ;; Now we have saved the current buffer. Let's make sure ;; that buffer-file-coding-system is fixed to what ;; actually used for saving by binding it locally. @@ -5147,7 +5137,6 @@ Before and after saving the buffer, this function runs ;; backup-buffer. (defun basic-save-buffer-2 () (let (tempsetmodes setmodes) - (if (getenv "BUG_32226") (message "BUG_32226 %s" 1)) (if (not (file-writable-p buffer-file-name)) (let ((dir (file-name-directory buffer-file-name))) (if (not (file-directory-p dir)) @@ -5163,12 +5152,10 @@ Before and after saving the buffer, this function runs buffer-file-name))) (setq tempsetmodes t) (error "Attempt to save to a file which you aren't allowed to write")))))) - (if (getenv "BUG_32226") (message "BUG_32226 %s" 2)) (or buffer-backed-up (setq setmodes (backup-buffer))) (let* ((dir (file-name-directory buffer-file-name)) (dir-writable (file-writable-p dir))) - (if (getenv "BUG_32226") (message "BUG_32226 %s" 3)) (if (or (and file-precious-flag dir-writable) (and break-hardlink-on-save (file-exists-p buffer-file-name) @@ -5186,7 +5173,6 @@ Before and after saving the buffer, this function runs ;; Create temp files with strict access rights. It's easy to ;; loosen them later, whereas it's impossible to close the ;; time-window of loose permissions otherwise. - (if (getenv "BUG_32226") (message "BUG_32226 %s" 4)) (condition-case err (progn (clear-visited-file-modtime) @@ -5204,7 +5190,6 @@ Before and after saving the buffer, this function runs ;; If we failed, restore the buffer's modtime. (error (set-visited-file-modtime old-modtime) (signal (car err) (cdr err)))) - (if (getenv "BUG_32226") (message "BUG_32226 %s" 5)) ;; Since we have created an entirely new file, ;; make sure it gets the right permission bits set. (setq setmodes (or setmodes @@ -5214,13 +5199,11 @@ Before and after saving the buffer, this function runs buffer-file-name))) ;; We succeeded in writing the temp file, ;; so rename it. - (if (getenv "BUG_32226") (message "BUG_32226 %s" 6)) (rename-file tempname buffer-file-name t)) ;; If file not writable, see if we can make it writable ;; temporarily while we write it. ;; But no need to do so if we have just backed it up ;; (setmodes is set) because that says we're superseding. - (if (getenv "BUG_32226") (message "BUG_32226 %s" 7)) (cond ((and tempsetmodes (not setmodes)) ;; Change the mode back, after writing. (setq setmodes (list (file-modes buffer-file-name) @@ -5234,7 +5217,6 @@ Before and after saving the buffer, this function runs (nth 1 setmodes))) (set-file-modes buffer-file-name (logior (car setmodes) 128)))))) - (if (getenv "BUG_32226") (message "BUG_32226 %s %s %s" 8 buffer-file-name buffer-file-truename)) (let (success) (unwind-protect (progn @@ -5243,16 +5225,13 @@ Before and after saving the buffer, this function runs ;; write-region-annotate-functions may make use of it. (write-region nil nil buffer-file-name nil t buffer-file-truename) - (if (getenv "BUG_32226") (message "BUG_32226 %s" 9)) (when save-silently (message nil)) (setq success t)) ;; If we get an error writing the new file, and we made ;; the backup by renaming, undo the backing-up. - (if (getenv "BUG_32226") (message "BUG_32226 %s %s %s" 10 (nth 2 setmodes) buffer-file-name)) (and setmodes (not success) (progn (rename-file (nth 2 setmodes) buffer-file-name t) - (if (getenv "BUG_32226") (message "BUG_32226 %s" 11)) (setq buffer-backed-up nil)))))) setmodes)) diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el index 86280c38ad..180d5026b6 100644 --- a/lisp/shadowfile.el +++ b/lisp/shadowfile.el @@ -628,26 +628,17 @@ Consider them as regular expressions if third arg REGEXP is true." (defun shadow-add-to-todo () "If current buffer has shadows, add them to the list needing to be copied." - (message "shadow-add-to-todo 1 %s" (current-buffer)) - (message "shadow-add-to-todo 2 %s" (buffer-file-name)) - (message "shadow-add-to-todo 3 %s" (shadow-expand-file-name (buffer-file-name (current-buffer)))) - (message "shadow-add-to-todo 4 %s" (shadow-shadows-of (shadow-expand-file-name (buffer-file-name (current-buffer))))) (let ((shadows (shadow-shadows-of (shadow-expand-file-name (buffer-file-name (current-buffer)))))) (when shadows - (message "shadow-add-to-todo 5 %s" shadows) - (message "shadow-add-to-todo 6 %s" shadow-files-to-copy) - (message "shadow-add-to-todo 7 %s" (shadow-union shadows shadow-files-to-copy)) (setq shadow-files-to-copy (shadow-union shadows shadow-files-to-copy)) (when (not shadow-inhibit-message) (message "%s" (substitute-command-keys "Use \\[shadow-copy-files] to update shadows.")) (sit-for 1)) - (message "shadow-add-to-todo 8") - (shadow-write-todo-file) - (message "shadow-add-to-todo 9"))) + (shadow-write-todo-file))) nil) ; Return nil for write-file-functions (defun shadow-remove-from-todo (pair) @@ -714,26 +705,18 @@ defined, the old hashtable info is invalid." "Write out information to `shadow-todo-file'. With non-nil argument also saves the buffer." (save-excursion - (message "shadow-write-todo-file 1 %s" shadow-todo-buffer) (if (not shadow-todo-buffer) (setq shadow-todo-buffer (find-file-noselect shadow-todo-file))) - (message "shadow-write-todo-file 2 %s" shadow-todo-buffer) (set-buffer shadow-todo-buffer) - (message "shadow-write-todo-file 3 %s" shadow-todo-buffer) (setq buffer-read-only nil) (delete-region (point-min) (point-max)) - (message "shadow-write-todo-file 4 %s" shadow-todo-buffer) (shadow-insert-var 'shadow-files-to-copy) - (message "shadow-write-todo-file 5 %s" save) - (if save (shadow-save-todo-file)) - (message "shadow-write-todo-file 6 %s" save))) + (if save (shadow-save-todo-file)))) (defun shadow-save-todo-file () - (message "shadow-save-todo-file 1 %s" shadow-todo-buffer) (if (and shadow-todo-buffer (buffer-modified-p shadow-todo-buffer)) (with-current-buffer shadow-todo-buffer - (message "shadow-save-todo-file 2 %s" shadow-todo-buffer) - (condition-case nil ; have to continue even in case of + (condition-case nil ; have to continue even in case of (basic-save-buffer) ; error, otherwise kill-emacs might (error ; not work! (message "WARNING: Can't save shadow todo file; it is locked!") diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el index ed2ab9b329..3bab22f8d6 100644 --- a/test/lisp/shadowfile-tests.el +++ b/test/lisp/shadowfile-tests.el @@ -726,26 +726,13 @@ guaranteed by the originator of a cluster definition." shadow-files-to-copy cluster1 cluster2 primary regexp file) (unwind-protect - (condition-case err (progn - (require 'trace) - (dolist (elt (all-completions "shadow-" obarray 'functionp)) - (trace-function-background (intern elt))) - (dolist (elt (all-completions "tramp-" obarray 'functionp)) - (trace-function-background (intern elt))) - (trace-function-background 'save-buffer) - (trace-function-background 'basic-save-buffer) - (trace-function-background 'basic-save-buffer-1) - (trace-function-background 'basic-save-buffer-2) - (dolist (elt write-file-functions) - (trace-function-background elt)) ;; Cleanup. (when (file-exists-p shadow-info-file) (delete-file shadow-info-file)) (when (file-exists-p shadow-todo-file) (delete-file shadow-todo-file)) - (message "Point 1") ;; Define clusters. (setq cluster1 "cluster1" primary shadow-system-name @@ -758,7 +745,6 @@ guaranteed by the originator of a cluster definition." regexp (shadow-regexp-superquote primary)) (shadow-set-cluster cluster2 primary regexp) - (message "Point 2") ;; Define a literal group. (setq file (make-temp-name @@ -766,38 +752,21 @@ guaranteed by the originator of a cluster definition." shadow-literal-groups `((,(concat "/cluster1:" file) ,(concat "/cluster2:" file)))) - (message "Point 3") ;; Save file from "cluster1" definition. (with-temp-buffer (set-visited-file-name file) (insert "foo") (save-buffer)) - (message "%s" file) - (message "%s" (shadow-contract-file-name (concat "/cluster2:" file))) - (message "%s" shadow-files-to-copy) (should (member (cons file (shadow-contract-file-name (concat "/cluster2:" file))) shadow-files-to-copy)) - (message "Point 4") ;; Save file from "cluster2" definition. (with-temp-buffer - (message "Point 4.1") - (message "%s" file) - (message "%s" (shadow-site-primary cluster2)) (set-visited-file-name (concat (shadow-site-primary cluster2) file)) - (message "Point 4.2") (insert "foo") - (message "%s" buffer-file-name) - (message "%s" write-file-functions) - (setenv "BUG_32226" "1") (save-buffer)) - (setenv "BUG_32226") - (message "Point 4.3") - (message "%s" (shadow-site-primary cluster2)) - (message "%s" (shadow-contract-file-name (concat "/cluster1:" file))) - (message "%s" shadow-files-to-copy) (should (member (cons @@ -805,7 +774,6 @@ guaranteed by the originator of a cluster definition." (shadow-contract-file-name (concat "/cluster1:" file))) shadow-files-to-copy)) - (message "Point 5") ;; Define a regexp group. (setq shadow-files-to-copy nil shadow-regexp-groups @@ -814,7 +782,6 @@ guaranteed by the originator of a cluster definition." ,(concat (shadow-site-primary cluster2) (shadow-regexp-superquote file))))) - (message "Point 6") ;; Save file from "cluster1" definition. (with-temp-buffer (set-visited-file-name file) @@ -825,7 +792,6 @@ guaranteed by the originator of a cluster definition." (cons file (shadow-contract-file-name (concat "/cluster2:" file))) shadow-files-to-copy)) - (message "Point 7") ;; Save file from "cluster2" definition. (with-temp-buffer (set-visited-file-name (concat (shadow-site-primary cluster2) file)) @@ -837,11 +803,6 @@ guaranteed by the originator of a cluster definition." (concat (shadow-site-primary cluster2) file) (shadow-contract-file-name (concat "/cluster1:" file))) shadow-files-to-copy))) - (error (message "Error: %s" err) (signal (car err) (cdr err)))) - - (setenv "BUG_32226") - (untrace-all) - (message "%s" (with-current-buffer trace-buffer (buffer-string))) ;; Cleanup. (when (file-exists-p shadow-info-file) @@ -859,6 +820,7 @@ guaranteed by the originator of a cluster definition." "Check that needed shadow files are copied." (skip-unless (not (memq system-type '(windows-nt ms-dos)))) (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) + (skip-unless (file-writable-p shadow-test-remote-temporary-file-directory)) (let ((backup-inhibited t) (shadow-info-file shadow-test-info-file) commit 6a7c84d09569b509779ad91ba70d82d550d57115 Author: JoĂŁo Távora Date: Sun Aug 12 13:26:06 2018 +0100 jsonrpc-shutdown's cleanup also kills stderr buffer * lisp/jsonrpc.el (Version): Bump to 1.0.6 (jsonrpc-shutdown): Also kill stderr buffer diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 3d88bbf67c..14d730abb2 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -6,7 +6,7 @@ ;; Maintainer: JoĂŁo Távora ;; Keywords: processes, languages, extensions ;; Package-Requires: ((emacs "25.2")) -;; Version: 1.0.5 +;; Version: 1.0.6 ;; This is an Elpa :core package. Don't use functionality that is not ;; compatible with Emacs 25.2. @@ -429,7 +429,8 @@ With optional CLEANUP, kill any associated buffers. " do (jsonrpc--warn "Sentinel for %s still hasn't run, deleting it!" proc)) (when cleanup - (kill-buffer (process-buffer (jsonrpc--process conn)))))) + (kill-buffer (process-buffer (jsonrpc--process conn))) + (kill-buffer (jsonrpc-stderr-buffer conn))))) (defun jsonrpc-stderr-buffer (conn) "Get CONN's standard error buffer, if any." commit a5cd6cb2b55a40e3f72e5354d87b3290708f60bf Author: JoĂŁo Távora Date: Sun Aug 12 13:22:27 2018 +0100 Revert "Make jsonrpc-shutdown a noop if process isn't running" This reverts commit c580443325a3d071625185876a8f28e04793c625. It leads to situations where the sentinel hasn't run yet, which brings problems if the normal process isn't running, but the stderr pseudo-process still is. * lisp/jsonrpc.el (jsonrpc-shutdown): Always enter loop. diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 43b570cfd9..3d88bbf67c 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -417,21 +417,19 @@ connection object, called when the process dies .") (cl-defmethod jsonrpc-shutdown ((conn jsonrpc-process-connection) &optional cleanup) - "Wait for JSONRPC connection CONN to shutdown and return t. -If the server wasn't running, do nothing and return nil. With -optional CLEANUP, kill any associated buffers. " + "Wait for JSONRPC connection CONN to shutdown. +With optional CLEANUP, kill any associated buffers. " (unwind-protect - (when (jsonrpc-running-p conn) - (cl-loop - with proc = (jsonrpc--process conn) - do - (delete-process proc) - (accept-process-output nil 0.1) - while (not (process-get proc 'jsonrpc-sentinel-done)) - do (jsonrpc--warn - "Sentinel for %s still hasn't run, deleting it!" proc) - finally return t)) - (when cleanup (kill-buffer (process-buffer (jsonrpc--process conn)))))) + (cl-loop + with proc = (jsonrpc--process conn) + do + (delete-process proc) + (accept-process-output nil 0.1) + while (not (process-get proc 'jsonrpc-sentinel-done)) + do (jsonrpc--warn + "Sentinel for %s still hasn't run, deleting it!" proc)) + (when cleanup + (kill-buffer (process-buffer (jsonrpc--process conn)))))) (defun jsonrpc-stderr-buffer (conn) "Get CONN's standard error buffer, if any." commit 614cc65f2dae346b2e30326cd5de01f891933eed Author: Charles A. Roelli Date: Sun Aug 12 13:05:27 2018 +0200 ; * lisp/simple.el (line-move-visual): Fix typo. diff --git a/lisp/simple.el b/lisp/simple.el index 90fea11dc1..a51a5205ce 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -5994,7 +5994,7 @@ into account variable-width characters and line continuation. If nil, `line-move' moves point by logical lines. A non-nil setting of `goal-column' overrides the value of this variable and forces movement by logical lines. -A window that is horizontally scrolled also forces movement by logical +A window that is horizontally scrolled also forces movement by logical lines." :type 'boolean :group 'editing-basics commit a04829d1b498fd63c534acae629580822ec66a7a Author: Andreas Schwab Date: Sun Aug 12 12:05:46 2018 +0200 Ensure no padding after union vectorlike_header Instead of increasing GCALIGNMENT align union vectorlike_header by adding a Lisp_Object member. * src/lisp.h (GCALIGNMENT): Revert last change. (union vectorlike_header): Add align member. (header_size): Verify the same as sizeof (union vectorlike_header) diff --git a/src/lisp.h b/src/lisp.h index 9625638621..b7ef8dc63a 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -276,17 +276,15 @@ error !; /* Minimum alignment requirement for Lisp objects, imposed by the internal representation of tagged pointers. It is 2**GCTYPEBITS if - USE_LSB_TAG, otherwise the alignment of Lisp_Object to avoid - padding after union vectorlike_header. It must be a literal - integer constant, for older versions of GCC (through at least - 4.9). */ + USE_LSB_TAG, 1 otherwise. It must be a literal integer constant, + for older versions of GCC (through at least 4.9). */ #if USE_LSB_TAG # define GCALIGNMENT 8 # if GCALIGNMENT != 1 << GCTYPEBITS # error "GCALIGNMENT and GCTYPEBITS are inconsistent" # endif #else -# define GCALIGNMENT alignof (Lisp_Object) +# define GCALIGNMENT 1 #endif #define GCALIGNED_UNION char alignas (GCALIGNMENT) gcaligned; @@ -851,6 +849,8 @@ union vectorlike_header Current layout limits the pseudovectors to 63 PVEC_xxx subtypes, 4095 Lisp_Objects in GC-ed area and 4095 word-sized other slots. */ ptrdiff_t size; + /* Align the union so that there is no padding after it. */ + Lisp_Object align; GCALIGNED_UNION }; verify (alignof (union vectorlike_header) % GCALIGNMENT == 0); @@ -1577,6 +1577,7 @@ enum bool_header_size = offsetof (struct Lisp_Bool_Vector, data), word_size = sizeof (Lisp_Object) }; +verify (header_size == sizeof (union vectorlike_header)); /* The number of data words and bytes in a bool vector with SIZE bits. */ commit 3d0a0ca7ca58cdb8f07be63df28ad30e4367167d Author: Andreas Schwab Date: Sun Aug 12 11:03:36 2018 +0200 Avoid padding after union vectorlike_header The PSEUDOVECTORSIZE macro requires that the first member after union vectorlike_header has the same offset in all pseudo vector structures. * src/lisp.h (GCALIGNMENT) [!USE_LSB_TAG]: Use alignment of Lisp_Object. diff --git a/src/lisp.h b/src/lisp.h index dcc157e0b9..9625638621 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -276,15 +276,17 @@ error !; /* Minimum alignment requirement for Lisp objects, imposed by the internal representation of tagged pointers. It is 2**GCTYPEBITS if - USE_LSB_TAG, 1 otherwise. It must be a literal integer constant, - for older versions of GCC (through at least 4.9). */ + USE_LSB_TAG, otherwise the alignment of Lisp_Object to avoid + padding after union vectorlike_header. It must be a literal + integer constant, for older versions of GCC (through at least + 4.9). */ #if USE_LSB_TAG # define GCALIGNMENT 8 # if GCALIGNMENT != 1 << GCTYPEBITS # error "GCALIGNMENT and GCTYPEBITS are inconsistent" # endif #else -# define GCALIGNMENT 1 +# define GCALIGNMENT alignof (Lisp_Object) #endif #define GCALIGNED_UNION char alignas (GCALIGNMENT) gcaligned; commit 3fc948a36c0f70f73d2e8eb688b1599fa6b73036 Author: Paul Eggert Date: Sun Aug 12 01:06:15 2018 -0700 New 'configure' arg --with-mini-gmp * configure.ac: It lets the builder override default of whther mini-gmp is used. Use AC_SEARCH_LIBS as per Autoconf manual. diff --git a/configure.ac b/configure.ac index 690b999125..58bdefab6d 100644 --- a/configure.ac +++ b/configure.ac @@ -4302,19 +4302,32 @@ AC_SUBST(KRB5LIB) AC_SUBST(DESLIB) AC_SUBST(KRB4LIB) +AC_ARG_WITH([mini-gmp], + [AS_HELP_STRING([--without-mini-gmp], + [don't compile and use mini-gmp, a substitute for the + GNU Multiple Precision (GMP) library; this is the + default on systems with recent-enough GMP.])]) GMP_LIB= -GMP_OBJ= +GMP_OBJ=mini-gmp.o HAVE_GMP=no -AC_CHECK_LIB(gmp, __gmpz_roinit_n, [ - AC_CHECK_HEADERS(gmp.h, [ - GMP_LIB=-lgmp - HAVE_GMP=yes - AC_DEFINE(HAVE_GMP, 1, [Define to 1 if you have gmp.h and -lgmp])])]) -if test $HAVE_GMP = no; then - GMP_OBJ=mini-gmp.o -fi -AC_SUBST(GMP_LIB) -AC_SUBST(GMP_OBJ) +case $with_mini_gmp in + yes) ;; + no) HAVE_GMP=yes;; + *) AC_CHECK_HEADERS([gmp.h], + [OLIBS=$LIBS + AC_SEARCH_LIBS([__gmpz_roinit_n], [gmp]) + LIBS=$OLIBS + case $ac_cv_search___gmpz_roinit_n in + 'none needed') HAVE_GMP=yes;; + -*) HAVE_GMP=yes GMP_LIB=$ac_cv_search___gmpz_roinit_n;; + esac]);; +esac +if test "$HAVE_GMP" = yes; then + GMP_OBJ= + AC_DEFINE([HAVE_GMP], 1, [Define to 1 if you have recent-enough GMP.]) +fi +AC_SUBST([GMP_LIB]) +AC_SUBST([GMP_OBJ]) AC_CHECK_HEADERS(valgrind/valgrind.h) diff --git a/etc/NEWS b/etc/NEWS index d684e35524..decc5e3954 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -24,8 +24,11 @@ When you add a new item, use the appropriate mark if you are sure it applies, * Installation Changes in Emacs 27.1 -** configure now checks for the GMP library. If not found, the -included "mini-gmp" library is used instead. +** Emacs now uses GMP, the GNU Multiple Precision library. +By default, if 'configure' does not find a suitable libgmp, it +arranges for the included mini-gmp library to be built and used. +The new 'configure' option --with-mini-gmp uses mini-gmp even if a +suitable libgmp is available. ** The new configure option '--with-json' adds support for JSON using the Jansson library. It is on by default; use 'configure commit d64c1be99036d083d1d0db97ed1f41b1dd1005bc Author: Paul Eggert Date: Sat Aug 11 19:07:43 2018 -0700 Update from Gnulib This incorporates: 2018-08-11 verify: port 'assume' to traditional tools * build-aux/config.sub, lib/regcomp.c, lib/verify.h: Copy from Gnulib. * lib/gnulib.mk.in: Regenerate. diff --git a/build-aux/config.sub b/build-aux/config.sub index 52eb02e29a..97d38aa6ec 100755 --- a/build-aux/config.sub +++ b/build-aux/config.sub @@ -569,12 +569,14 @@ case $basic_machine in 1750a | 580 \ | a29k \ | aarch64 | aarch64_be \ + | abacus \ | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ | am33_2.0 \ | arc | arceb \ | arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv6m | armv[78][arm] \ | avr | avr32 \ + | asmjs \ | ba \ | be32 | be64 \ | bfin \ @@ -628,7 +630,7 @@ case $basic_machine in | riscv | riscv32 | riscv64 \ | rl78 | rx \ | score \ - | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[234]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ + | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[234]eb | sheb | shbe | shle | sh[1234]le | sh[23]ele \ | sh64 | sh64le \ | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \ | sparcv8 | sparcv9 | sparcv9b | sparcv9v \ @@ -654,15 +656,18 @@ case $basic_machine in leon|leon[3-9]) basic_machine=sparc-$basic_machine ;; + m6811-* | m68hc11-* | m6812-* | m68hc12-* | m68hcs12x-* | nvptx-* | picochip-*) + ;; m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | nvptx | picochip) basic_machine=$basic_machine-unknown - os=${os:-none} ;; m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65) ;; m9s12z | m68hcs12z | hcs12z | s12z) basic_machine=s12z-unknown - os=${os:-none} + ;; + m9s12z-* | m68hcs12z-* | hcs12z-* | s12z-*) + basic_machine=s12z-`echo "$basic_machine" | sed 's/^[^-]*-//'` ;; ms1) basic_machine=mt-unknown @@ -672,7 +677,8 @@ case $basic_machine in ;; xgate) basic_machine=$basic_machine-unknown - os=${os:-none} + ;; + xgate-*) ;; xscaleeb) basic_machine=armeb-unknown @@ -689,22 +695,26 @@ case $basic_machine in basic_machine=$basic_machine-pc ;; # Recognize the basic CPU types with company name. - 580-* \ + 1750a-* | 580-* \ | a29k-* \ | aarch64-* | aarch64_be-* \ + | abacus-* \ | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ - | alphapca5[67]-* | alpha64pca5[67]-* | arc-* | arceb-* \ - | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ + | alphapca5[67]-* | alpha64pca5[67]-* \ + | am33_2.0-* \ + | arc-* | arceb-* \ + | arm-* | arm[lb]e-* | arme[lb]-* | armv*-* \ | avr-* | avr32-* \ + | asmjs-* \ | ba-* \ | be32-* | be64-* \ | bfin-* | bs2000-* \ | c[123]* | c30-* | [cjt]90-* | c4x-* \ | c8051-* | clipper-* | craynv-* | csky-* | cydra-* \ - | d10v-* | d30v-* | dlx-* \ - | e2k-* | elxsi-* \ - | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \ + | d10v-* | d30v-* | dlx-* | dsp16xx-* \ + | e2k-* | elxsi-* | epiphany-* \ + | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | ft32-* | fx80-* \ | h8300-* | h8500-* \ | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ | hexagon-* \ @@ -714,8 +724,8 @@ case $basic_machine in | le32-* | le64-* \ | lm32-* \ | m32c-* | m32r-* | m32rle-* \ - | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ - | m88110-* | m88k-* | maxq-* | mcore-* | metag-* \ + | m5200-* | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* | v70-* | w65-* \ + | m88110-* | m88k-* | maxq-* | mb-* | mcore-* | mep-* | metag-* \ | microblaze-* | microblazeel-* \ | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ | mips16-* \ @@ -739,6 +749,7 @@ case $basic_machine in | mipsr5900-* | mipsr5900el-* \ | mipstx39-* | mipstx39el-* \ | mmix-* \ + | mn10200-* | mn10300-* \ | moxie-* \ | mt-* \ | msp430-* \ @@ -748,6 +759,7 @@ case $basic_machine in | none-* | np1-* | ns16k-* | ns32k-* \ | open8-* \ | or1k*-* \ + | or32-* \ | orion-* \ | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \ @@ -755,14 +767,15 @@ case $basic_machine in | pyramid-* \ | riscv-* | riscv32-* | riscv64-* \ | rl78-* | romp-* | rs6000-* | rx-* \ - | sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ - | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ + | score-* \ + | sh-* | sh[1234]-* | sh[24]a-* | sh[24]ae[lb]-* | sh[23]e-* | she[lb]-* | sh[lb]e-* \ + | sh[1234]e[lb]-* | sh[12345][lb]e-* | sh[23]ele-* | sh64-* | sh64le-* \ | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \ | sparclite-* \ | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx*-* \ + | spu-* \ | tahoe-* \ | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \ - | tile*-* \ | tron-* \ | ubicom32-* \ | v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \ @@ -787,9 +800,6 @@ case $basic_machine in 3b*) basic_machine=we32k-att ;; - abacus) - basic_machine=abacus-unknown - ;; alliant | fx80) basic_machine=fx80-alliant ;; @@ -805,9 +815,6 @@ case $basic_machine in amiga | amiga-*) basic_machine=m68k-unknown ;; - asmjs) - basic_machine=asmjs-unknown - ;; blackfin-*) basic_machine=bfin-`echo "$basic_machine" | sed 's/^[^-]*-//'` os=linux @@ -1154,6 +1161,9 @@ case $basic_machine in sh5el) basic_machine=sh5le-unknown ;; + sh5el-*) + basic_machine=sh5le-`echo "$basic_machine" | sed 's/^[^-]*-//'` + ;; simso-wrs) basic_machine=sparclite-wrs os=vxworks @@ -1179,9 +1189,11 @@ case $basic_machine in sun386 | sun386i | roadrunner) basic_machine=i386-sun ;; + tile*-*) + ;; tile*) basic_machine=$basic_machine-unknown - os=linux-gnu + os=${os:-linux-gnu} ;; tx39) basic_machine=mipstx39-unknown @@ -1214,7 +1226,6 @@ case $basic_machine in ;; none) basic_machine=none-none - os=${os:-none} ;; # Here we handle the default manufacturer of certain CPU types. It is in @@ -1246,9 +1257,6 @@ case $basic_machine in we32k) basic_machine=we32k-att ;; - sh[1234] | sh[24]a | sh[24]aeb | sh[34]eb | sh[1234]le | sh[23]ele) - basic_machine=sh-unknown - ;; cydra) basic_machine=cydra-cydrome ;; @@ -1354,7 +1362,7 @@ case $os in | amigaos* | amigados* | msdos* | newsos* | unicos* | aof* \ | aos* | aros* | cloudabi* | sortix* \ | nindy* | vxsim* | vxworks* | ebmon* | hms* | mvs* \ - | clix* | riscos* | uniplus* | iris* | rtu* | xenix* \ + | clix* | riscos* | uniplus* | iris* | isc* | rtu* | xenix* \ | knetbsd* | mirbsd* | netbsd* \ | bitrig* | openbsd* | solidbsd* | libertybsd* \ | ekkobsd* | kfreebsd* | freebsd* | riscix* | lynxos* \ diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 7ad390875b..666105b74b 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -238,6 +238,8 @@ GL_GENERATE_STDALIGN_H = @GL_GENERATE_STDALIGN_H@ GL_GENERATE_STDDEF_H = @GL_GENERATE_STDDEF_H@ GL_GENERATE_STDINT_H = @GL_GENERATE_STDINT_H@ GMALLOC_OBJ = @GMALLOC_OBJ@ +GMP_LIB = @GMP_LIB@ +GMP_OBJ = @GMP_OBJ@ GNULIB_ALPHASORT = @GNULIB_ALPHASORT@ GNULIB_ATOLL = @GNULIB_ATOLL@ GNULIB_CALLOC_POSIX = @GNULIB_CALLOC_POSIX@ @@ -1720,7 +1722,7 @@ BUILT_SOURCES += $(GETOPT_H) $(GETOPT_CDEFS_H) # We need the following in order to create when the system # doesn't have one that works with the given compiler. -getopt.h: getopt.in.h $(top_builddir)/config.status +getopt.h: getopt.in.h $(top_builddir)/config.status $(ARG_NONNULL_H) $(AM_V_GEN)rm -f $@-t $@ && \ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ sed -e 's|@''GUARD_PREFIX''@|GL|g' \ diff --git a/lib/regcomp.c b/lib/regcomp.c index 53eb226374..0e4816c89c 100644 --- a/lib/regcomp.c +++ b/lib/regcomp.c @@ -2684,15 +2684,14 @@ parse_dup_op (bin_tree_t *elem, re_string_t *regexp, re_dfa_t *dfa, # ifdef RE_ENABLE_I18N /* Convert the byte B to the corresponding wide character. In a - unibyte locale, treat B as itself if it is an encoding error. - In a multibyte locale, return WEOF if B is an encoding error. */ + unibyte locale, treat B as itself. In a multibyte locale, return + WEOF if B is an encoding error. */ static wint_t parse_byte (unsigned char b, re_charset_t *mbcset) { - wint_t wc = __btowc (b); - return wc == WEOF && !mbcset ? b : wc; + return mbcset == NULL ? b : __btowc (b); } -#endif +# endif /* Local function for parse_bracket_exp only used in case of NOT _LIBC. Build the range expression which starts from START_ELEM, and ends @@ -3531,18 +3530,10 @@ build_equiv_class (bitset_t sbcset, const unsigned char *name) continue; /* Compare only if the length matches and the collation rule index is the same. */ - if (len == weights[idx2 & 0xffffff] && (idx1 >> 24) == (idx2 >> 24)) - { - int cnt = 0; - - while (cnt <= len && - weights[(idx1 & 0xffffff) + 1 + cnt] - == weights[(idx2 & 0xffffff) + 1 + cnt]) - ++cnt; - - if (cnt > len) - bitset_set (sbcset, ch); - } + if (len == weights[idx2 & 0xffffff] && (idx1 >> 24) == (idx2 >> 24) + && memcmp (weights + (idx1 & 0xffffff) + 1, + weights + (idx2 & 0xffffff) + 1, len) == 0) + bitset_set (sbcset, ch); } /* Check whether the array has enough space. */ if (BE (*equiv_class_alloc == mbcset->nequiv_classes, 0)) @@ -3802,9 +3793,9 @@ free_charset (re_charset_t *cset) # ifdef _LIBC re_free (cset->coll_syms); re_free (cset->equiv_classes); +# endif re_free (cset->range_starts); re_free (cset->range_ends); -# endif re_free (cset->char_classes); re_free (cset); } diff --git a/lib/verify.h b/lib/verify.h index bc7f99dbd7..3b57ddee0a 100644 --- a/lib/verify.h +++ b/lib/verify.h @@ -276,7 +276,8 @@ template when 'assume' silences warnings even with older GCCs. */ # define assume(R) ((R) ? (void) 0 : __builtin_trap ()) #else -# define assume(R) ((void) (0 && (R))) + /* Some tools grok NOTREACHED, e.g., Oracle Studio 12.6. */ +# define assume(R) ((R) ? (void) 0 : /*NOTREACHED*/ (void) 0) #endif /* @assert.h omit end@ */ commit 1145bd0ef97630473746fb96da00951ae81c358c Author: Paul Eggert Date: Thu Aug 9 11:13:17 2018 -0700 Remove stray union Lisp_Misc doc (Bug#32405#35). diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 1dc5de0a69..c72dbb5079 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -365,11 +365,6 @@ The number of symbols in use. The number of symbols for which space has been obtained from the operating system, but that are not currently being used. -@item misc-size -Internal size of a miscellaneous entity, i.e., -@code{sizeof (union Lisp_Misc)}, which is a size of the -largest type enumerated in @code{enum Lisp_Misc_Type}. - @item string-size Internal size of a string header, i.e., @code{sizeof (struct Lisp_String)}. commit 6c12f4e63f60eb280c5fc08dc76f11d097184dc7 Author: Paul Eggert Date: Thu Aug 9 00:35:47 2018 -0700 Simplify mark_object for pseudovectors Suggested by Pip Cet (Bug#32405#14). * src/alloc.c (mark_object): Remove unnecessary special cases for PVEC_MARKER, PVEC_BOOL_VECTOR, PVEC_MISC_PTR, PVEC_USER_PTR, and PVEC_FINALIZER. change is to free up an enum Lisp_Type tag value, a scarce diff --git a/src/alloc.c b/src/alloc.c index fea0cec383..337668f9c3 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -6495,28 +6495,10 @@ mark_object (Lisp_Object arg) mark_char_table (ptr, (enum pvec_type) pvectype); break; - case PVEC_MARKER: - /* DO NOT mark thru the marker's chain. - The buffer's markers chain does not preserve markers from gc; - instead, markers are removed from the chain when freed by gc. */ - case PVEC_BOOL_VECTOR: - case PVEC_MISC_PTR: -#ifdef HAVE_MODULES - case PVEC_USER_PTR: -#endif - /* No Lisp_Objects to mark in these. */ - VECTOR_MARK (ptr); - break; - case PVEC_OVERLAY: mark_overlay (XOVERLAY (obj)); break; - case PVEC_FINALIZER: - VECTOR_MARK (ptr); - mark_object (XFINALIZER (obj)->function); - break; - case PVEC_SUBR: break; @@ -6524,6 +6506,8 @@ mark_object (Lisp_Object arg) emacs_abort (); default: + /* A regular vector, or a pseudovector needing no special + treatment. */ mark_vectorlike (ptr); } } diff --git a/src/lisp.h b/src/lisp.h index c080cc6b14..dcc157e0b9 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2264,7 +2264,9 @@ struct Lisp_Marker does not point anywhere. */ /* For markers that point somewhere, - this is used to chain of all the markers in a given buffer. */ + this is used to chain of all the markers in a given buffer. + The chain does not preserve markers from garbage collection; + instead, markers are removed from the chain when freed by GC. */ /* We could remove it and use an array in buffer_text instead. That would also allow us to preserve it ordered. */ struct Lisp_Marker *next; commit d614e4a8cd2d5fe37b38bb4d8191013a7d917731 Author: Paul Eggert Date: Wed Aug 8 19:46:29 2018 -0700 Turn misc objects into pseudovectors Eliminate the category of miscellaneous objects, and turn all such objects into pseudovectors. The immediate motivation for this change is to free up an enum Lisp_Type tag value, a scarce resource that can be better used elsewhere. However, this change is worthwhile in its own right, as it improves performance slightly on my platform, 0.3% faster for 'make compile-always' on Fedora 28, and it simplifies the garbage collector and interpreter (Bug#32405). * doc/lispref/internals.texi (Garbage Collection): * etc/NEWS: Document change to garbage-collect return value. * src/alloc.c (total_markers, total_free_markers): (union aligned_Lisp_Misc, MARKER_BLOCK_SIZE) (struct marker_block, marker_block, marker_block_index) (misc_free_list, allocate_misc, live_misc_holding) (live_misc_p, sweep_misc): * src/lisp.h (lisp_h_MARKERP, lisp_h_MISCP, MARKERP, MISCP) (Lisp_Misc, enum Lisp_Misc_Type, Lisp_Misc_Free) (Lisp_Misc_Marker, Lisp_Misc_Overlay, Lisp_Misc_Finalizer) (Lisp_Misc_Ptr, Lisp_Misc_User_Ptr, Lisp_Misc_Limit) (Lisp_Misc_Bignum) (XSETMISC, struct Lisp_Misc_Any, XMISCANY, XMISCTYPE) (struct Lisp_Free, union Lisp_Misc, XMISC): Remove. All uses removed. (cleanup_vector): Clean up objects that were formerly misc and are now pseudovectors. (make_misc_ptr, build_overlay, Fmake_marker, build_marker) (make_bignum_str, make_number, make_pure_bignum) (make_user_ptr, Fmake_finalizer): Build as pseudovectors, not as misc objects. (mark_finalizer_list, queue_doomed_finalizers) (compact_undo_list, mark_overlay, mark_object) (unchain_dead_markers): Mark as vector-like objects, not as misc objects. (mark_maybe_object, mark_maybe_pointer, valid_lisp_object_p) (total_bytes_of_live_objects, survives_gc_p): * src/fns.c (sxhash): No need to worry about misc objects. (garbage_collect_1): Do not generate a 'misc' component. (syms_of_alloc): No need for 'misc' symbol. * src/buffer.c (overlays_at, overlays_in, overlay_touches_p) (overlay_strings, recenter_overlay_lists) (fix_start_end_in_overlays, fix_overlays_before) (Foverlay_lists, report_overlay_modification) (evaporate_overlays): * src/editfns.c (overlays_around): * src/data.c (Ftype_of): * src/fns.c (internal_equal): * src/lisp.h (mint_ptrp, xmint_pointer, FINALIZERP) (XFINALIZER, MARKERP, XMARKER, OVERLAYP, XOVERLAY, USER_PTRP) (XUSER_PTR, BIGNUMP, XBIGNUM): * src/print.c (print_vectorlike, print_object): * src/undo.c (record_marker_adjustments): * src/xdisp.c (load_overlay_strings): Formerly misc objects are now pseudovectors. * src/lisp.h (PVEC_MARKER, PVEC_OVERLAY, PVEC_FINALIZER) (PVEC_BIGNUM, PVEC_MISC_PTR, PVEC_USER_PTR): New constants, replacing their misc versions. All uses changed. (struct Lisp_Marker, struct Lisp_Overlay, struct Lisp_Misc_Ptr) (struct Lisp_Bignum, struct Lisp_User_Ptr, struct Lisp_Finalizer): Make usable as a pseudovector by using a pseudovector header, replacing any DIY components, and putting Lisp_Object members first. All uses changed. diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 65752860bf..1dc5de0a69 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -318,7 +318,6 @@ future allocations. So an overall result is: @example ((@code{conses} @var{cons-size} @var{used-conses} @var{free-conses}) (@code{symbols} @var{symbol-size} @var{used-symbols} @var{free-symbols}) - (@code{miscs} @var{misc-size} @var{used-miscs} @var{free-miscs}) (@code{strings} @var{string-size} @var{used-strings} @var{free-strings}) (@code{string-bytes} @var{byte-size} @var{used-bytes}) (@code{vectors} @var{vector-size} @var{used-vectors}) @@ -334,7 +333,7 @@ Here is an example: @example (garbage-collect) @result{} ((conses 16 49126 8058) (symbols 48 14607 0) - (miscs 40 34 56) (strings 32 2942 2607) + (strings 32 2942 2607) (string-bytes 1 78607) (vectors 16 7247) (vector-slots 8 341609 29474) (floats 8 71 102) (intervals 56 27 26) (buffers 944 8) @@ -371,14 +370,6 @@ Internal size of a miscellaneous entity, i.e., @code{sizeof (union Lisp_Misc)}, which is a size of the largest type enumerated in @code{enum Lisp_Misc_Type}. -@item used-miscs -The number of miscellaneous objects in use. These include markers -and overlays, plus certain objects not visible to users. - -@item free-miscs -The number of miscellaneous objects for which space has been obtained -from the operating system, but that are not currently being used. - @item string-size Internal size of a string header, i.e., @code{sizeof (struct Lisp_String)}. diff --git a/etc/NEWS b/etc/NEWS index 3f673ff103..d684e35524 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -817,6 +817,10 @@ is backwards-compatible with versions of Emacs in which the old function exists. See the node "Displaying Buffers in Side Windows" in the ELisp manual for more details. +** The 'garbage-collect' function no longer returns a 'misc' component +because garbage collection no longer treats miscellaneous objects +specially; they are now allocated like any other pseudovector. + * Lisp Changes in Emacs 27.1 diff --git a/src/alloc.c b/src/alloc.c index c3e02c20f8..fea0cec383 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -247,8 +247,8 @@ bool gc_in_progress; /* Number of live and free conses etc. */ -static EMACS_INT total_conses, total_markers, total_symbols, total_buffers; -static EMACS_INT total_free_conses, total_free_markers, total_free_symbols; +static EMACS_INT total_conses, total_symbols, total_buffers; +static EMACS_INT total_free_conses, total_free_symbols; static EMACS_INT total_free_floats, total_floats; /* Points to memory space allocated as "spare", to be freed if we run @@ -356,6 +356,7 @@ no_sanitize_memcpy (void *dest, void const *src, size_t size) #endif /* MAX_SAVE_STACK > 0 */ +static void unchain_finalizer (struct Lisp_Finalizer *); static void mark_terminals (void); static void gc_sweep (void); static Lisp_Object make_pure_vector (ptrdiff_t); @@ -3197,7 +3198,12 @@ static void cleanup_vector (struct Lisp_Vector *vector) { detect_suspicious_free (vector); - if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FONT)) + + if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_BIGNUM)) + mpz_clear (PSEUDOVEC_STRUCT (vector, Lisp_Bignum)->value); + else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FINALIZER)) + unchain_finalizer (PSEUDOVEC_STRUCT (vector, Lisp_Finalizer)); + else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FONT)) { if ((vector->header.size & PSEUDOVECTOR_SIZE_MASK) == FONT_OBJECT_MAX) { @@ -3220,6 +3226,19 @@ cleanup_vector (struct Lisp_Vector *vector) finalize_one_mutex (PSEUDOVEC_STRUCT (vector, Lisp_Mutex)); else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_CONDVAR)) finalize_one_condvar (PSEUDOVEC_STRUCT (vector, Lisp_CondVar)); + else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_MARKER)) + { + /* sweep_buffer should already have unchained this from its buffer. */ + eassert (! PSEUDOVEC_STRUCT (vector, Lisp_Marker)->buffer); + } +#ifdef HAVE_MODULES + else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_USER_PTR)) + { + struct Lisp_User_Ptr *uptr = PSEUDOVEC_STRUCT (vector, Lisp_User_Ptr); + if (uptr->finalizer) + uptr->finalizer (uptr->p); + } +#endif } /* Reclaim space used by unmarked vectors. */ @@ -3650,96 +3669,27 @@ Its value is void, and its function definition and property list are nil. */) -/*********************************************************************** - Marker (Misc) Allocation - ***********************************************************************/ - -/* Like union Lisp_Misc, but padded so that its size is a multiple of - the required alignment. */ - -union aligned_Lisp_Misc -{ - union Lisp_Misc m; - unsigned char c[(sizeof (union Lisp_Misc) + LISP_ALIGNMENT - 1) - & -LISP_ALIGNMENT]; -}; - -/* Allocation of markers and other objects that share that structure. - Works like allocation of conses. */ - -#define MARKER_BLOCK_SIZE \ - ((1020 - sizeof (struct marker_block *)) / sizeof (union aligned_Lisp_Misc)) - -struct marker_block -{ - /* Place `markers' first, to preserve alignment. */ - union aligned_Lisp_Misc markers[MARKER_BLOCK_SIZE]; - struct marker_block *next; -}; - -static struct marker_block *marker_block; -static int marker_block_index = MARKER_BLOCK_SIZE; - -static union Lisp_Misc *misc_free_list; - -/* Return a newly allocated Lisp_Misc object of specified TYPE. */ - -static Lisp_Object -allocate_misc (enum Lisp_Misc_Type type) -{ - Lisp_Object val; - - MALLOC_BLOCK_INPUT; - - if (misc_free_list) - { - XSETMISC (val, misc_free_list); - misc_free_list = misc_free_list->u_free.chain; - } - else - { - if (marker_block_index == MARKER_BLOCK_SIZE) - { - struct marker_block *new = lisp_malloc (sizeof *new, MEM_TYPE_MISC); - new->next = marker_block; - marker_block = new; - marker_block_index = 0; - total_free_markers += MARKER_BLOCK_SIZE; - } - XSETMISC (val, &marker_block->markers[marker_block_index].m); - marker_block_index++; - } - - MALLOC_UNBLOCK_INPUT; - - --total_free_markers; - consing_since_gc += sizeof (union Lisp_Misc); - misc_objects_consed++; - XMISCANY (val)->type = type; - XMISCANY (val)->gcmarkbit = 0; - return val; -} - Lisp_Object make_misc_ptr (void *a) { - Lisp_Object val = allocate_misc (Lisp_Misc_Ptr); - XUNTAG (val, Lisp_Misc, struct Lisp_Misc_Ptr)->pointer = a; - return val; + struct Lisp_Misc_Ptr *p = ALLOCATE_PSEUDOVECTOR (struct Lisp_Misc_Ptr, pointer, + PVEC_MISC_PTR); + p->pointer = a; + return make_lisp_ptr (p, Lisp_Vectorlike); } -/* Return a Lisp_Misc_Overlay object with specified START, END and PLIST. */ +/* Return a new overlay with specified START, END and PLIST. */ Lisp_Object build_overlay (Lisp_Object start, Lisp_Object end, Lisp_Object plist) { - register Lisp_Object overlay; - - overlay = allocate_misc (Lisp_Misc_Overlay); + struct Lisp_Overlay *p = ALLOCATE_PSEUDOVECTOR (struct Lisp_Overlay, next, + PVEC_OVERLAY); + Lisp_Object overlay = make_lisp_ptr (p, Lisp_Vectorlike); OVERLAY_START (overlay) = start; OVERLAY_END (overlay) = end; set_overlay_plist (overlay, plist); - XOVERLAY (overlay)->next = NULL; + p->next = NULL; return overlay; } @@ -3747,18 +3697,15 @@ DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0, doc: /* Return a newly allocated marker which does not point at any place. */) (void) { - register Lisp_Object val; - register struct Lisp_Marker *p; - - val = allocate_misc (Lisp_Misc_Marker); - p = XMARKER (val); + struct Lisp_Marker *p = ALLOCATE_PSEUDOVECTOR (struct Lisp_Marker, buffer, + PVEC_MARKER); p->buffer = 0; p->bytepos = 0; p->charpos = 0; p->next = NULL; p->insertion_type = 0; p->need_adjustment = 0; - return val; + return make_lisp_ptr (p, Lisp_Vectorlike); } /* Return a newly allocated marker which points into BUF @@ -3767,17 +3714,14 @@ DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0, Lisp_Object build_marker (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t bytepos) { - Lisp_Object obj; - struct Lisp_Marker *m; - /* No dead buffers here. */ eassert (BUFFER_LIVE_P (buf)); /* Every character is at least one byte. */ eassert (charpos <= bytepos); - obj = allocate_misc (Lisp_Misc_Marker); - m = XMARKER (obj); + struct Lisp_Marker *m = ALLOCATE_PSEUDOVECTOR (struct Lisp_Marker, buffer, + PVEC_MARKER); m->buffer = buf; m->charpos = charpos; m->bytepos = bytepos; @@ -3785,7 +3729,7 @@ build_marker (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t bytepos) m->need_adjustment = 0; m->next = BUF_MARKERS (buf); BUF_MARKERS (buf) = m; - return obj; + return make_lisp_ptr (m, Lisp_Vectorlike); } @@ -3793,16 +3737,12 @@ build_marker (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t bytepos) Lisp_Object make_bignum_str (const char *num, int base) { - Lisp_Object obj; - struct Lisp_Bignum *b; - int check; - - obj = allocate_misc (Lisp_Misc_Bignum); - b = XBIGNUM (obj); + struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value, + PVEC_BIGNUM); mpz_init (b->value); - check = mpz_set_str (b->value, num, base); + int check = mpz_set_str (b->value, num, base); eassert (check == 0); - return obj; + return make_lisp_ptr (b, Lisp_Vectorlike); } /* Given an mpz_t, make a number. This may return a bignum or a @@ -3811,17 +3751,11 @@ make_bignum_str (const char *num, int base) Lisp_Object make_number (mpz_t value) { - Lisp_Object obj; - struct Lisp_Bignum *b; - if (mpz_fits_slong_p (value)) { long l = mpz_get_si (value); if (!FIXNUM_OVERFLOW_P (l)) - { - XSETINT (obj, l); - return obj; - } + return make_fixnum (l); } /* Check if fixnum can be larger than long. */ @@ -3845,20 +3779,17 @@ make_number (mpz_t value) v = -v; if (!FIXNUM_OVERFLOW_P (v)) - { - XSETINT (obj, v); - return obj; - } + return make_fixnum (v); } } - obj = allocate_misc (Lisp_Misc_Bignum); - b = XBIGNUM (obj); + struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value, + PVEC_BIGNUM); /* We could mpz_init + mpz_swap here, to avoid a copy, but the resulting API seemed possibly confusing. */ mpz_init_set (b->value, value); - return obj; + return make_lisp_ptr (b, Lisp_Vectorlike); } void @@ -3934,14 +3865,11 @@ make_event_array (ptrdiff_t nargs, Lisp_Object *args) Lisp_Object make_user_ptr (void (*finalizer) (void *), void *p) { - Lisp_Object obj; - struct Lisp_User_Ptr *uptr; - - obj = allocate_misc (Lisp_Misc_User_Ptr); - uptr = XUSER_PTR (obj); + struct Lisp_User_Ptr *uptr = ALLOCATE_PSEUDOVECTOR (struct Lisp_User_Ptr, + finalizer, PVEC_USER_PTR); uptr->finalizer = finalizer; uptr->p = p; - return obj; + return make_lisp_ptr (uptr, Lisp_Vectorlike); } #endif @@ -3984,7 +3912,7 @@ mark_finalizer_list (struct Lisp_Finalizer *head) finalizer != head; finalizer = finalizer->next) { - finalizer->base.gcmarkbit = true; + VECTOR_MARK (finalizer); mark_object (finalizer->function); } } @@ -4001,7 +3929,7 @@ queue_doomed_finalizers (struct Lisp_Finalizer *dest, while (finalizer != src) { struct Lisp_Finalizer *next = finalizer->next; - if (!finalizer->base.gcmarkbit && !NILP (finalizer->function)) + if (!VECTOR_MARKED_P (finalizer) && !NILP (finalizer->function)) { unchain_finalizer (finalizer); finalizer_insert (dest, finalizer); @@ -4037,7 +3965,6 @@ run_finalizers (struct Lisp_Finalizer *finalizers) while (finalizers->next != finalizers) { finalizer = finalizers->next; - eassert (finalizer->base.type == Lisp_Misc_Finalizer); unchain_finalizer (finalizer); function = finalizer->function; if (!NILP (function)) @@ -4057,12 +3984,12 @@ count as reachable for the purpose of deciding whether to run FUNCTION. FUNCTION will be run once per finalizer object. */) (Lisp_Object function) { - Lisp_Object val = allocate_misc (Lisp_Misc_Finalizer); - struct Lisp_Finalizer *finalizer = XFINALIZER (val); + struct Lisp_Finalizer *finalizer + = ALLOCATE_PSEUDOVECTOR (struct Lisp_Finalizer, prev, PVEC_FINALIZER); finalizer->function = function; finalizer->prev = finalizer->next = NULL; finalizer_insert (&finalizers, finalizer); - return val; + return make_lisp_ptr (finalizer, Lisp_Vectorlike); } @@ -4683,41 +4610,6 @@ live_float_p (struct mem_node *m, void *p) return 0; } - -/* If P is a pointer to a live Lisp Misc on the heap, return the object. - Otherwise, return nil. M is a pointer to the mem_block for P. */ - -static Lisp_Object -live_misc_holding (struct mem_node *m, void *p) -{ - if (m->type == MEM_TYPE_MISC) - { - struct marker_block *b = m->start; - char *cp = p; - ptrdiff_t offset = cp - (char *) &b->markers[0]; - - /* P must point into a Lisp_Misc, not be - one of the unused cells in the current misc block, - and not be on the free-list. */ - if (0 <= offset && offset < MARKER_BLOCK_SIZE * sizeof b->markers[0] - && (b != marker_block - || offset / sizeof b->markers[0] < marker_block_index)) - { - cp = ptr_bounds_copy (cp, b); - union Lisp_Misc *s = p = cp -= offset % sizeof b->markers[0]; - if (s->u_any.type != Lisp_Misc_Free) - return make_lisp_ptr (s, Lisp_Misc); - } - } - return Qnil; -} - -static bool -live_misc_p (struct mem_node *m, void *p) -{ - return !NILP (live_misc_holding (m, p)); -} - /* If P is a pointer to a live vector-like object, return the object. Otherwise, return nil. M is a pointer to the mem_block for P. */ @@ -4836,10 +4728,6 @@ mark_maybe_object (Lisp_Object obj) || EQ (obj, live_buffer_holding (m, po))); break; - case Lisp_Misc: - mark_p = EQ (obj, live_misc_holding (m, po)); - break; - default: break; } @@ -4921,10 +4809,6 @@ mark_maybe_pointer (void *p) obj = live_string_holding (m, p); break; - case MEM_TYPE_MISC: - obj = live_misc_holding (m, p); - break; - case MEM_TYPE_SYMBOL: obj = live_symbol_holding (m, p); break; @@ -5325,9 +5209,6 @@ valid_lisp_object_p (Lisp_Object obj) case MEM_TYPE_STRING: return live_string_p (m, p); - case MEM_TYPE_MISC: - return live_misc_p (m, p); - case MEM_TYPE_SYMBOL: return live_symbol_p (m, p); @@ -5550,14 +5431,13 @@ make_pure_float (double num) static Lisp_Object make_pure_bignum (struct Lisp_Bignum *value) { - Lisp_Object new; size_t i, nlimbs = mpz_size (value->value); size_t nbytes = nlimbs * sizeof (mp_limb_t); mp_limb_t *pure_limbs; mp_size_t new_size; - struct Lisp_Bignum *b = pure_alloc (sizeof (struct Lisp_Bignum), Lisp_Misc); - b->type = Lisp_Misc_Bignum; + struct Lisp_Bignum *b = pure_alloc (sizeof *b, Lisp_Vectorlike); + XSETPVECTYPESIZE (b, PVEC_BIGNUM, 0, VECSIZE (struct Lisp_Bignum)); pure_limbs = pure_alloc (nbytes, -1); for (i = 0; i < nlimbs; ++i) @@ -5569,8 +5449,7 @@ make_pure_bignum (struct Lisp_Bignum *value) mpz_roinit_n (b->value, pure_limbs, new_size); - XSETMISC (new, b); - return new; + return make_lisp_ptr (b, Lisp_Vectorlike); } /* Return a vector with room for LEN Lisp_Objects allocated from @@ -5777,7 +5656,6 @@ total_bytes_of_live_objects (void) size_t tot = 0; tot += total_conses * sizeof (struct Lisp_Cons); tot += total_symbols * sizeof (struct Lisp_Symbol); - tot += total_markers * sizeof (union Lisp_Misc); tot += total_string_bytes; tot += total_vector_slots * word_size; tot += total_floats * sizeof (struct Lisp_Float); @@ -5898,7 +5776,7 @@ compact_undo_list (Lisp_Object list) { if (CONSP (XCAR (tail)) && MARKERP (XCAR (XCAR (tail))) - && !XMARKER (XCAR (XCAR (tail)))->gcmarkbit) + && !VECTOR_MARKED_P (XMARKER (XCAR (XCAR (tail))))) *prev = XCDR (tail); else prev = xcdr_addr (tail); @@ -6125,9 +6003,6 @@ garbage_collect_1 (void *end) list4 (Qsymbols, make_fixnum (sizeof (struct Lisp_Symbol)), bounded_number (total_symbols), bounded_number (total_free_symbols)), - list4 (Qmiscs, make_fixnum (sizeof (union Lisp_Misc)), - bounded_number (total_markers), - bounded_number (total_free_markers)), list4 (Qstrings, make_fixnum (sizeof (struct Lisp_String)), bounded_number (total_strings), bounded_number (total_free_strings)), @@ -6314,12 +6189,12 @@ mark_compiled (struct Lisp_Vector *ptr) static void mark_overlay (struct Lisp_Overlay *ptr) { - for (; ptr && !ptr->gcmarkbit; ptr = ptr->next) + for (; ptr && !VECTOR_MARKED_P (ptr); ptr = ptr->next) { - ptr->gcmarkbit = 1; + VECTOR_MARK (ptr); /* These two are always markers and can be marked fast. */ - XMARKER (ptr->start)->gcmarkbit = 1; - XMARKER (ptr->end)->gcmarkbit = 1; + VECTOR_MARK (XMARKER (ptr->start)); + VECTOR_MARK (XMARKER (ptr->end)); mark_object (ptr->plist); } } @@ -6620,9 +6495,26 @@ mark_object (Lisp_Object arg) mark_char_table (ptr, (enum pvec_type) pvectype); break; + case PVEC_MARKER: + /* DO NOT mark thru the marker's chain. + The buffer's markers chain does not preserve markers from gc; + instead, markers are removed from the chain when freed by gc. */ case PVEC_BOOL_VECTOR: - /* No Lisp_Objects to mark in a bool vector. */ + case PVEC_MISC_PTR: +#ifdef HAVE_MODULES + case PVEC_USER_PTR: +#endif + /* No Lisp_Objects to mark in these. */ + VECTOR_MARK (ptr); + break; + + case PVEC_OVERLAY: + mark_overlay (XOVERLAY (obj)); + break; + + case PVEC_FINALIZER: VECTOR_MARK (ptr); + mark_object (XFINALIZER (obj)->function); break; case PVEC_SUBR: @@ -6680,49 +6572,9 @@ mark_object (Lisp_Object arg) } break; - case Lisp_Misc: - CHECK_ALLOCATED_AND_LIVE (live_misc_p); - - if (XMISCANY (obj)->gcmarkbit) - break; - - switch (XMISCTYPE (obj)) - { - case Lisp_Misc_Marker: - /* DO NOT mark thru the marker's chain. - The buffer's markers chain does not preserve markers from gc; - instead, markers are removed from the chain when freed by gc. */ - XMISCANY (obj)->gcmarkbit = 1; - break; - - case Lisp_Misc_Ptr: - case Lisp_Misc_Bignum: - XMISCANY (obj)->gcmarkbit = true; - break; - - case Lisp_Misc_Overlay: - mark_overlay (XOVERLAY (obj)); - break; - - case Lisp_Misc_Finalizer: - XMISCANY (obj)->gcmarkbit = true; - mark_object (XFINALIZER (obj)->function); - break; - -#ifdef HAVE_MODULES - case Lisp_Misc_User_Ptr: - XMISCANY (obj)->gcmarkbit = true; - break; -#endif - - default: - emacs_abort (); - } - break; - case Lisp_Cons: { - register struct Lisp_Cons *ptr = XCONS (obj); + struct Lisp_Cons *ptr = XCONS (obj); if (CONS_MARKED_P (ptr)) break; CHECK_ALLOCATED_AND_LIVE (live_cons_p); @@ -6799,10 +6651,6 @@ survives_gc_p (Lisp_Object obj) survives_p = XSYMBOL (obj)->u.s.gcmarkbit; break; - case Lisp_Misc: - survives_p = XMISCANY (obj)->gcmarkbit; - break; - case Lisp_String: survives_p = STRING_MARKED_P (XSTRING (obj)); break; @@ -7079,81 +6927,6 @@ sweep_symbols (void) total_free_symbols = num_free; } -NO_INLINE /* For better stack traces. */ -static void -sweep_misc (void) -{ - register struct marker_block *mblk; - struct marker_block **mprev = &marker_block; - register int lim = marker_block_index; - EMACS_INT num_free = 0, num_used = 0; - - /* Put all unmarked misc's on free list. For a marker, first - unchain it from the buffer it points into. */ - - misc_free_list = 0; - - for (mblk = marker_block; mblk; mblk = *mprev) - { - register int i; - int this_free = 0; - - for (i = 0; i < lim; i++) - { - if (!mblk->markers[i].m.u_any.gcmarkbit) - { - if (mblk->markers[i].m.u_any.type == Lisp_Misc_Marker) - /* Make sure markers have been unchained from their buffer - in sweep_buffer before we collect them. */ - eassert (!mblk->markers[i].m.u_marker.buffer); - else if (mblk->markers[i].m.u_any.type == Lisp_Misc_Finalizer) - unchain_finalizer (&mblk->markers[i].m.u_finalizer); -#ifdef HAVE_MODULES - else if (mblk->markers[i].m.u_any.type == Lisp_Misc_User_Ptr) - { - struct Lisp_User_Ptr *uptr = &mblk->markers[i].m.u_user_ptr; - if (uptr->finalizer) - uptr->finalizer (uptr->p); - } -#endif - else if (mblk->markers[i].m.u_any.type == Lisp_Misc_Bignum) - mpz_clear (mblk->markers[i].m.u_bignum.value); - /* Set the type of the freed object to Lisp_Misc_Free. - We could leave the type alone, since nobody checks it, - but this might catch bugs faster. */ - mblk->markers[i].m.u_marker.type = Lisp_Misc_Free; - mblk->markers[i].m.u_free.chain = misc_free_list; - misc_free_list = &mblk->markers[i].m; - this_free++; - } - else - { - num_used++; - mblk->markers[i].m.u_any.gcmarkbit = 0; - } - } - lim = MARKER_BLOCK_SIZE; - /* If this block contains only free markers and we have already - seen more than two blocks worth of free markers then deallocate - this block. */ - if (this_free == MARKER_BLOCK_SIZE && num_free > MARKER_BLOCK_SIZE) - { - *mprev = mblk->next; - /* Unhook from the free list. */ - misc_free_list = mblk->markers[0].m.u_free.chain; - lisp_free (mblk); - } - else - { - num_free += this_free; - mprev = &mblk->next; - } - } - - total_markers = num_used; - total_free_markers = num_free; -} - /* Remove BUFFER's markers that are due to be swept. This is needed since we treat BUF_MARKERS and markers's `next' field as weak pointers. */ static void @@ -7162,7 +6935,7 @@ unchain_dead_markers (struct buffer *buffer) struct Lisp_Marker *this, **prev = &BUF_MARKERS (buffer); while ((this = *prev)) - if (this->gcmarkbit) + if (VECTOR_MARKED_P (this)) prev = &this->next; else { @@ -7210,7 +6983,6 @@ gc_sweep (void) sweep_intervals (); sweep_symbols (); sweep_buffers (); - sweep_misc (); sweep_vectors (); check_string_bytes (!noninteractive); } @@ -7585,7 +7357,6 @@ do hash-consing of the objects allocated to pure space. */); DEFSYM (Qconses, "conses"); DEFSYM (Qsymbols, "symbols"); - DEFSYM (Qmiscs, "miscs"); DEFSYM (Qstrings, "strings"); DEFSYM (Qvectors, "vectors"); DEFSYM (Qfloats, "floats"); diff --git a/src/buffer.c b/src/buffer.c index ec6f464711..878844dd02 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -2789,8 +2789,6 @@ overlays_at (EMACS_INT pos, bool extend, Lisp_Object **vec_ptr, ptrdiff_t *len_ptr, ptrdiff_t *next_ptr, ptrdiff_t *prev_ptr, bool change_req) { - Lisp_Object overlay, start, end; - struct Lisp_Overlay *tail; ptrdiff_t idx = 0; ptrdiff_t len = *len_ptr; Lisp_Object *vec = *vec_ptr; @@ -2798,22 +2796,20 @@ overlays_at (EMACS_INT pos, bool extend, Lisp_Object **vec_ptr, ptrdiff_t prev = BEGV; bool inhibit_storing = 0; - for (tail = current_buffer->overlays_before; tail; tail = tail->next) + for (struct Lisp_Overlay *tail = current_buffer->overlays_before; + tail; tail = tail->next) { - ptrdiff_t startpos, endpos; - - XSETMISC (overlay, tail); - - start = OVERLAY_START (overlay); - end = OVERLAY_END (overlay); - endpos = OVERLAY_POSITION (end); + Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike); + Lisp_Object start = OVERLAY_START (overlay); + Lisp_Object end = OVERLAY_END (overlay); + ptrdiff_t endpos = OVERLAY_POSITION (end); if (endpos < pos) { if (prev < endpos) prev = endpos; break; } - startpos = OVERLAY_POSITION (start); + ptrdiff_t startpos = OVERLAY_POSITION (start); /* This one ends at or after POS so its start counts for PREV_PTR if it's before POS. */ if (prev < startpos && startpos < pos) @@ -2846,22 +2842,20 @@ overlays_at (EMACS_INT pos, bool extend, Lisp_Object **vec_ptr, next = startpos; } - for (tail = current_buffer->overlays_after; tail; tail = tail->next) + for (struct Lisp_Overlay *tail = current_buffer->overlays_after; + tail; tail = tail->next) { - ptrdiff_t startpos, endpos; - - XSETMISC (overlay, tail); - - start = OVERLAY_START (overlay); - end = OVERLAY_END (overlay); - startpos = OVERLAY_POSITION (start); + Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike); + Lisp_Object start = OVERLAY_START (overlay); + Lisp_Object end = OVERLAY_END (overlay); + ptrdiff_t startpos = OVERLAY_POSITION (start); if (pos < startpos) { if (startpos < next) next = startpos; break; } - endpos = OVERLAY_POSITION (end); + ptrdiff_t endpos = OVERLAY_POSITION (end); if (pos < endpos) { if (idx == len) @@ -2923,8 +2917,6 @@ overlays_in (EMACS_INT beg, EMACS_INT end, bool extend, Lisp_Object **vec_ptr, ptrdiff_t *len_ptr, ptrdiff_t *next_ptr, ptrdiff_t *prev_ptr) { - Lisp_Object overlay, ostart, oend; - struct Lisp_Overlay *tail; ptrdiff_t idx = 0; ptrdiff_t len = *len_ptr; Lisp_Object *vec = *vec_ptr; @@ -2933,22 +2925,20 @@ overlays_in (EMACS_INT beg, EMACS_INT end, bool extend, bool inhibit_storing = 0; bool end_is_Z = end == Z; - for (tail = current_buffer->overlays_before; tail; tail = tail->next) + for (struct Lisp_Overlay *tail = current_buffer->overlays_before; + tail; tail = tail->next) { - ptrdiff_t startpos, endpos; - - XSETMISC (overlay, tail); - - ostart = OVERLAY_START (overlay); - oend = OVERLAY_END (overlay); - endpos = OVERLAY_POSITION (oend); + Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike); + Lisp_Object ostart = OVERLAY_START (overlay); + Lisp_Object oend = OVERLAY_END (overlay); + ptrdiff_t endpos = OVERLAY_POSITION (oend); if (endpos < beg) { if (prev < endpos) prev = endpos; break; } - startpos = OVERLAY_POSITION (ostart); + ptrdiff_t startpos = OVERLAY_POSITION (ostart); /* Count an interval if it overlaps the range, is empty at the start of the range, or is empty at END provided END denotes the end of the buffer. */ @@ -2980,22 +2970,20 @@ overlays_in (EMACS_INT beg, EMACS_INT end, bool extend, next = startpos; } - for (tail = current_buffer->overlays_after; tail; tail = tail->next) + for (struct Lisp_Overlay *tail = current_buffer->overlays_after; + tail; tail = tail->next) { - ptrdiff_t startpos, endpos; - - XSETMISC (overlay, tail); - - ostart = OVERLAY_START (overlay); - oend = OVERLAY_END (overlay); - startpos = OVERLAY_POSITION (ostart); + Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike); + Lisp_Object ostart = OVERLAY_START (overlay); + Lisp_Object oend = OVERLAY_END (overlay); + ptrdiff_t startpos = OVERLAY_POSITION (ostart); if (end < startpos) { if (startpos < next) next = startpos; break; } - endpos = OVERLAY_POSITION (oend); + ptrdiff_t endpos = OVERLAY_POSITION (oend); /* Count an interval if it overlaps the range, is empty at the start of the range, or is empty at END provided END denotes the end of the buffer. */ @@ -3097,31 +3085,26 @@ disable_line_numbers_overlay_at_eob (void) bool overlay_touches_p (ptrdiff_t pos) { - Lisp_Object overlay; - struct Lisp_Overlay *tail; - - for (tail = current_buffer->overlays_before; tail; tail = tail->next) + for (struct Lisp_Overlay *tail = current_buffer->overlays_before; + tail; tail = tail->next) { - ptrdiff_t endpos; - - XSETMISC (overlay ,tail); + Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike); eassert (OVERLAYP (overlay)); - endpos = OVERLAY_POSITION (OVERLAY_END (overlay)); + ptrdiff_t endpos = OVERLAY_POSITION (OVERLAY_END (overlay)); if (endpos < pos) break; if (endpos == pos || OVERLAY_POSITION (OVERLAY_START (overlay)) == pos) return 1; } - for (tail = current_buffer->overlays_after; tail; tail = tail->next) + for (struct Lisp_Overlay *tail = current_buffer->overlays_after; + tail; tail = tail->next) { - ptrdiff_t startpos; - - XSETMISC (overlay, tail); + Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike); eassert (OVERLAYP (overlay)); - startpos = OVERLAY_POSITION (OVERLAY_START (overlay)); + ptrdiff_t startpos = OVERLAY_POSITION (OVERLAY_START (overlay)); if (pos < startpos) break; if (startpos == pos || OVERLAY_POSITION (OVERLAY_END (overlay)) == pos) @@ -3337,27 +3320,26 @@ record_overlay_string (struct sortstrlist *ssl, Lisp_Object str, ptrdiff_t overlay_strings (ptrdiff_t pos, struct window *w, unsigned char **pstr) { - Lisp_Object overlay, window, str; - struct Lisp_Overlay *ov; - ptrdiff_t startpos, endpos; bool multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); overlay_heads.used = overlay_heads.bytes = 0; overlay_tails.used = overlay_tails.bytes = 0; - for (ov = current_buffer->overlays_before; ov; ov = ov->next) + for (struct Lisp_Overlay *ov = current_buffer->overlays_before; + ov; ov = ov->next) { - XSETMISC (overlay, ov); + Lisp_Object overlay = make_lisp_ptr (ov, Lisp_Vectorlike); eassert (OVERLAYP (overlay)); - startpos = OVERLAY_POSITION (OVERLAY_START (overlay)); - endpos = OVERLAY_POSITION (OVERLAY_END (overlay)); + ptrdiff_t startpos = OVERLAY_POSITION (OVERLAY_START (overlay)); + ptrdiff_t endpos = OVERLAY_POSITION (OVERLAY_END (overlay)); if (endpos < pos) break; if (endpos != pos && startpos != pos) continue; - window = Foverlay_get (overlay, Qwindow); + Lisp_Object window = Foverlay_get (overlay, Qwindow); if (WINDOWP (window) && XWINDOW (window) != w) continue; + Lisp_Object str; if (startpos == pos && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str))) record_overlay_string (&overlay_heads, str, @@ -3372,20 +3354,22 @@ overlay_strings (ptrdiff_t pos, struct window *w, unsigned char **pstr) Foverlay_get (overlay, Qpriority), endpos - startpos); } - for (ov = current_buffer->overlays_after; ov; ov = ov->next) + for (struct Lisp_Overlay *ov = current_buffer->overlays_after; + ov; ov = ov->next) { - XSETMISC (overlay, ov); + Lisp_Object overlay = make_lisp_ptr (ov, Lisp_Vectorlike); eassert (OVERLAYP (overlay)); - startpos = OVERLAY_POSITION (OVERLAY_START (overlay)); - endpos = OVERLAY_POSITION (OVERLAY_END (overlay)); + ptrdiff_t startpos = OVERLAY_POSITION (OVERLAY_START (overlay)); + ptrdiff_t endpos = OVERLAY_POSITION (OVERLAY_END (overlay)); if (startpos > pos) break; if (endpos != pos && startpos != pos) continue; - window = Foverlay_get (overlay, Qwindow); + Lisp_Object window = Foverlay_get (overlay, Qwindow); if (WINDOWP (window) && XWINDOW (window) != w) continue; + Lisp_Object str; if (startpos == pos && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str))) record_overlay_string (&overlay_heads, str, @@ -3460,8 +3444,7 @@ overlay_strings (ptrdiff_t pos, struct window *w, unsigned char **pstr) void recenter_overlay_lists (struct buffer *buf, ptrdiff_t pos) { - Lisp_Object overlay, beg, end; - struct Lisp_Overlay *prev, *tail, *next; + struct Lisp_Overlay *prev, *next; /* See if anything in overlays_before should move to overlays_after. */ @@ -3469,14 +3452,15 @@ recenter_overlay_lists (struct buffer *buf, ptrdiff_t pos) But we use it for symmetry and in case that should cease to be true with some future change. */ prev = NULL; - for (tail = buf->overlays_before; tail; prev = tail, tail = next) + for (struct Lisp_Overlay *tail = buf->overlays_before; + tail; prev = tail, tail = next) { next = tail->next; - XSETMISC (overlay, tail); + Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike); eassert (OVERLAYP (overlay)); - beg = OVERLAY_START (overlay); - end = OVERLAY_END (overlay); + Lisp_Object beg = OVERLAY_START (overlay); + Lisp_Object end = OVERLAY_END (overlay); if (OVERLAY_POSITION (end) > pos) { @@ -3495,12 +3479,10 @@ recenter_overlay_lists (struct buffer *buf, ptrdiff_t pos) for (other = buf->overlays_after; other; other_prev = other, other = other->next) { - Lisp_Object otherbeg, otheroverlay; - - XSETMISC (otheroverlay, other); + Lisp_Object otheroverlay = make_lisp_ptr (other, Lisp_Vectorlike); eassert (OVERLAYP (otheroverlay)); - otherbeg = OVERLAY_START (otheroverlay); + Lisp_Object otherbeg = OVERLAY_START (otheroverlay); if (OVERLAY_POSITION (otherbeg) >= where) break; } @@ -3522,14 +3504,15 @@ recenter_overlay_lists (struct buffer *buf, ptrdiff_t pos) /* See if anything in overlays_after should be in overlays_before. */ prev = NULL; - for (tail = buf->overlays_after; tail; prev = tail, tail = next) + for (struct Lisp_Overlay *tail = buf->overlays_after; + tail; prev = tail, tail = next) { next = tail->next; - XSETMISC (overlay, tail); + Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike); eassert (OVERLAYP (overlay)); - beg = OVERLAY_START (overlay); - end = OVERLAY_END (overlay); + Lisp_Object beg = OVERLAY_START (overlay); + Lisp_Object end = OVERLAY_END (overlay); /* Stop looking, when we know that nothing further can possibly end before POS. */ @@ -3553,12 +3536,10 @@ recenter_overlay_lists (struct buffer *buf, ptrdiff_t pos) for (other = buf->overlays_before; other; other_prev = other, other = other->next) { - Lisp_Object otherend, otheroverlay; - - XSETMISC (otheroverlay, other); + Lisp_Object otheroverlay = make_lisp_ptr (other, Lisp_Vectorlike); eassert (OVERLAYP (otheroverlay)); - otherend = OVERLAY_END (otheroverlay); + Lisp_Object otherend = OVERLAY_END (otheroverlay); if (OVERLAY_POSITION (otherend) <= where) break; } @@ -3613,7 +3594,6 @@ adjust_overlays_for_delete (ptrdiff_t pos, ptrdiff_t length) void fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end) { - Lisp_Object overlay; struct Lisp_Overlay *before_list UNINIT; struct Lisp_Overlay *after_list UNINIT; /* These are either nil, indicating that before_list or after_list @@ -3623,8 +3603,7 @@ fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end) /* 'Parent', likewise, indicates a cons cell or current_buffer->overlays_before or overlays_after, depending which loop we're in. */ - struct Lisp_Overlay *tail, *parent; - ptrdiff_t startpos, endpos; + struct Lisp_Overlay *parent; /* This algorithm shifts links around instead of consing and GCing. The loop invariant is that before_list (resp. after_list) is a @@ -3633,12 +3612,14 @@ fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end) (after_list) if it is, is still uninitialized. So it's not a bug that before_list isn't initialized, although it may look strange. */ - for (parent = NULL, tail = current_buffer->overlays_before; tail;) + parent = NULL; + for (struct Lisp_Overlay *tail = current_buffer->overlays_before; + tail; tail = tail->next) { - XSETMISC (overlay, tail); + Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike); - endpos = OVERLAY_POSITION (OVERLAY_END (overlay)); - startpos = OVERLAY_POSITION (OVERLAY_START (overlay)); + ptrdiff_t endpos = OVERLAY_POSITION (OVERLAY_END (overlay)); + ptrdiff_t startpos = OVERLAY_POSITION (OVERLAY_START (overlay)); /* If the overlay is backwards, make it empty. */ if (endpos < startpos) @@ -3676,17 +3657,18 @@ fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end) set_buffer_overlays_before (current_buffer, tail->next); else parent->next = tail->next; - tail = tail->next; } else - parent = tail, tail = parent->next; + parent = tail; } - for (parent = NULL, tail = current_buffer->overlays_after; tail;) + parent = NULL; + for (struct Lisp_Overlay *tail = current_buffer->overlays_after; + tail; tail = tail->next) { - XSETMISC (overlay, tail); + Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike); - startpos = OVERLAY_POSITION (OVERLAY_START (overlay)); - endpos = OVERLAY_POSITION (OVERLAY_END (overlay)); + ptrdiff_t startpos = OVERLAY_POSITION (OVERLAY_START (overlay)); + ptrdiff_t endpos = OVERLAY_POSITION (OVERLAY_END (overlay)); /* If the overlay is backwards, make it empty. */ if (endpos < startpos) @@ -3722,10 +3704,9 @@ fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end) set_buffer_overlays_after (current_buffer, tail->next); else parent->next = tail->next; - tail = tail->next; } else - parent = tail, tail = parent->next; + parent = tail; } /* Splice the constructed (wrong) lists into the buffer's lists, @@ -3776,7 +3757,7 @@ fix_overlays_before (struct buffer *bp, ptrdiff_t prev, ptrdiff_t pos) overlay whose ending marker is after-insertion-marker if disorder exists). */ while (tail - && (XSETMISC (tem, tail), + && (tem = make_lisp_ptr (tail, Lisp_Vectorlike), (end = OVERLAY_POSITION (OVERLAY_END (tem))) >= pos)) { parent = tail; @@ -3801,7 +3782,7 @@ fix_overlays_before (struct buffer *bp, ptrdiff_t prev, ptrdiff_t pos) overlays are in correct order. */ while (tail) { - XSETMISC (tem, tail); + tem = make_lisp_ptr (tail, Lisp_Vectorlike); end = OVERLAY_POSITION (OVERLAY_END (tem)); if (end == pos) @@ -4308,19 +4289,14 @@ The lists you get are copies, so that changing them has no effect. However, the overlays you get are the real objects that the buffer uses. */) (void) { - struct Lisp_Overlay *ol; - Lisp_Object before = Qnil, after = Qnil, tmp; + Lisp_Object before = Qnil, after = Qnil; - for (ol = current_buffer->overlays_before; ol; ol = ol->next) - { - XSETMISC (tmp, ol); - before = Fcons (tmp, before); - } - for (ol = current_buffer->overlays_after; ol; ol = ol->next) - { - XSETMISC (tmp, ol); - after = Fcons (tmp, after); - } + for (struct Lisp_Overlay *ol = current_buffer->overlays_before; + ol; ol = ol->next) + before = Fcons (make_lisp_ptr (ol, Lisp_Vectorlike), before); + for (struct Lisp_Overlay *ol = current_buffer->overlays_after; + ol; ol = ol->next) + after = Fcons (make_lisp_ptr (ol, Lisp_Vectorlike), after); return Fcons (Fnreverse (before), Fnreverse (after)); } @@ -4439,14 +4415,9 @@ void report_overlay_modification (Lisp_Object start, Lisp_Object end, bool after, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3) { - Lisp_Object prop, overlay; - struct Lisp_Overlay *tail; /* True if this change is an insertion. */ bool insertion = (after ? XFIXNAT (arg3) == 0 : EQ (start, end)); - overlay = Qnil; - tail = NULL; - /* We used to run the functions as soon as we found them and only register them in last_overlay_modification_hooks for the purpose of the `after' case. But running elisp code as we traverse the list of overlays is @@ -4460,12 +4431,13 @@ report_overlay_modification (Lisp_Object start, Lisp_Object end, bool after, /* We are being called before a change. Scan the overlays to find the functions to call. */ last_overlay_modification_hooks_used = 0; - for (tail = current_buffer->overlays_before; tail; tail = tail->next) + for (struct Lisp_Overlay *tail = current_buffer->overlays_before; + tail; tail = tail->next) { ptrdiff_t startpos, endpos; Lisp_Object ostart, oend; - XSETMISC (overlay, tail); + Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike); ostart = OVERLAY_START (overlay); oend = OVERLAY_END (overlay); @@ -4476,14 +4448,14 @@ report_overlay_modification (Lisp_Object start, Lisp_Object end, bool after, if (insertion && (XFIXNAT (start) == startpos || XFIXNAT (end) == startpos)) { - prop = Foverlay_get (overlay, Qinsert_in_front_hooks); + Lisp_Object prop = Foverlay_get (overlay, Qinsert_in_front_hooks); if (!NILP (prop)) add_overlay_mod_hooklist (prop, overlay); } if (insertion && (XFIXNAT (start) == endpos || XFIXNAT (end) == endpos)) { - prop = Foverlay_get (overlay, Qinsert_behind_hooks); + Lisp_Object prop = Foverlay_get (overlay, Qinsert_behind_hooks); if (!NILP (prop)) add_overlay_mod_hooklist (prop, overlay); } @@ -4491,18 +4463,19 @@ report_overlay_modification (Lisp_Object start, Lisp_Object end, bool after, for both insertion and deletion. */ if (XFIXNAT (end) > startpos && XFIXNAT (start) < endpos) { - prop = Foverlay_get (overlay, Qmodification_hooks); + Lisp_Object prop = Foverlay_get (overlay, Qmodification_hooks); if (!NILP (prop)) add_overlay_mod_hooklist (prop, overlay); } } - for (tail = current_buffer->overlays_after; tail; tail = tail->next) + for (struct Lisp_Overlay *tail = current_buffer->overlays_after; + tail; tail = tail->next) { ptrdiff_t startpos, endpos; Lisp_Object ostart, oend; - XSETMISC (overlay, tail); + Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike); ostart = OVERLAY_START (overlay); oend = OVERLAY_END (overlay); @@ -4513,14 +4486,14 @@ report_overlay_modification (Lisp_Object start, Lisp_Object end, bool after, if (insertion && (XFIXNAT (start) == startpos || XFIXNAT (end) == startpos)) { - prop = Foverlay_get (overlay, Qinsert_in_front_hooks); + Lisp_Object prop = Foverlay_get (overlay, Qinsert_in_front_hooks); if (!NILP (prop)) add_overlay_mod_hooklist (prop, overlay); } if (insertion && (XFIXNAT (start) == endpos || XFIXNAT (end) == endpos)) { - prop = Foverlay_get (overlay, Qinsert_behind_hooks); + Lisp_Object prop = Foverlay_get (overlay, Qinsert_behind_hooks); if (!NILP (prop)) add_overlay_mod_hooklist (prop, overlay); } @@ -4528,7 +4501,7 @@ report_overlay_modification (Lisp_Object start, Lisp_Object end, bool after, for both insertion and deletion. */ if (XFIXNAT (end) > startpos && XFIXNAT (start) < endpos) { - prop = Foverlay_get (overlay, Qmodification_hooks); + Lisp_Object prop = Foverlay_get (overlay, Qmodification_hooks); if (!NILP (prop)) add_overlay_mod_hooklist (prop, overlay); } @@ -4596,16 +4569,13 @@ call_overlay_mod_hooks (Lisp_Object list, Lisp_Object overlay, bool after, void evaporate_overlays (ptrdiff_t pos) { - Lisp_Object overlay, hit_list; - struct Lisp_Overlay *tail; - - hit_list = Qnil; + Lisp_Object hit_list = Qnil; if (pos <= current_buffer->overlay_center) - for (tail = current_buffer->overlays_before; tail; tail = tail->next) + for (struct Lisp_Overlay *tail = current_buffer->overlays_before; + tail; tail = tail->next) { - ptrdiff_t endpos; - XSETMISC (overlay, tail); - endpos = OVERLAY_POSITION (OVERLAY_END (overlay)); + Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike); + ptrdiff_t endpos = OVERLAY_POSITION (OVERLAY_END (overlay)); if (endpos < pos) break; if (endpos == pos && OVERLAY_POSITION (OVERLAY_START (overlay)) == pos @@ -4613,11 +4583,11 @@ evaporate_overlays (ptrdiff_t pos) hit_list = Fcons (overlay, hit_list); } else - for (tail = current_buffer->overlays_after; tail; tail = tail->next) + for (struct Lisp_Overlay *tail = current_buffer->overlays_after; + tail; tail = tail->next) { - ptrdiff_t startpos; - XSETMISC (overlay, tail); - startpos = OVERLAY_POSITION (OVERLAY_START (overlay)); + Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike); + ptrdiff_t startpos = OVERLAY_POSITION (OVERLAY_START (overlay)); if (startpos > pos) break; if (startpos == pos && OVERLAY_POSITION (OVERLAY_END (overlay)) == pos diff --git a/src/data.c b/src/data.c index 7d701fde0e..c8a9c6b378 100644 --- a/src/data.c +++ b/src/data.c @@ -221,29 +221,17 @@ for example, (type-of 1) returns `integer'. */) case Lisp_Cons: return Qcons; - case Lisp_Misc: - switch (XMISCTYPE (object)) - { - case Lisp_Misc_Marker: - return Qmarker; - case Lisp_Misc_Overlay: - return Qoverlay; - case Lisp_Misc_Finalizer: - return Qfinalizer; -#ifdef HAVE_MODULES - case Lisp_Misc_User_Ptr: - return Quser_ptr; -#endif - case Lisp_Misc_Bignum: - return Qinteger; - default: - emacs_abort (); - } - case Lisp_Vectorlike: switch (PSEUDOVECTOR_TYPE (XVECTOR (object))) { case PVEC_NORMAL_VECTOR: return Qvector; + case PVEC_BIGNUM: return Qinteger; + case PVEC_MARKER: return Qmarker; + case PVEC_OVERLAY: return Qoverlay; + case PVEC_FINALIZER: return Qfinalizer; +#ifdef HAVE_MODULES + case PVEC_USER_PTR: return Quser_ptr; +#endif case PVEC_WINDOW_CONFIGURATION: return Qwindow_configuration; case PVEC_PROCESS: return Qprocess; case PVEC_WINDOW: return Qwindow; @@ -279,6 +267,7 @@ for example, (type-of 1) returns `integer'. */) case PVEC_MODULE_FUNCTION: return Qmodule_function; /* "Impossible" cases. */ + case PVEC_MISC_PTR: case PVEC_XWIDGET: case PVEC_OTHER: case PVEC_XWIDGET_VIEW: diff --git a/src/editfns.c b/src/editfns.c index a0a66bd19a..92566fe3bb 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -484,21 +484,18 @@ If you set the marker not to point anywhere, the buffer will have no mark. */) static ptrdiff_t overlays_around (EMACS_INT pos, Lisp_Object *vec, ptrdiff_t len) { - Lisp_Object overlay, start, end; - struct Lisp_Overlay *tail; - ptrdiff_t startpos, endpos; ptrdiff_t idx = 0; - for (tail = current_buffer->overlays_before; tail; tail = tail->next) + for (struct Lisp_Overlay *tail = current_buffer->overlays_before; + tail; tail = tail->next) { - XSETMISC (overlay, tail); - - end = OVERLAY_END (overlay); - endpos = OVERLAY_POSITION (end); + Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike); + Lisp_Object end = OVERLAY_END (overlay); + ptrdiff_t endpos = OVERLAY_POSITION (end); if (endpos < pos) break; - start = OVERLAY_START (overlay); - startpos = OVERLAY_POSITION (start); + Lisp_Object start = OVERLAY_START (overlay); + ptrdiff_t startpos = OVERLAY_POSITION (start); if (startpos <= pos) { if (idx < len) @@ -508,16 +505,16 @@ overlays_around (EMACS_INT pos, Lisp_Object *vec, ptrdiff_t len) } } - for (tail = current_buffer->overlays_after; tail; tail = tail->next) + for (struct Lisp_Overlay *tail = current_buffer->overlays_after; + tail; tail = tail->next) { - XSETMISC (overlay, tail); - - start = OVERLAY_START (overlay); - startpos = OVERLAY_POSITION (start); + Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike); + Lisp_Object start = OVERLAY_START (overlay); + ptrdiff_t startpos = OVERLAY_POSITION (start); if (pos < startpos) break; - end = OVERLAY_END (overlay); - endpos = OVERLAY_POSITION (end); + Lisp_Object end = OVERLAY_END (overlay); + ptrdiff_t endpos = OVERLAY_POSITION (end); if (pos <= endpos) { if (idx < len) diff --git a/src/fns.c b/src/fns.c index 825880643a..ac5edc2cdb 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2287,7 +2287,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, ht = CALLN (Fmake_hash_table, QCtest, Qeq); switch (XTYPE (o1)) { - case Lisp_Cons: case Lisp_Misc: case Lisp_Vectorlike: + case Lisp_Cons: case Lisp_Vectorlike: { struct Lisp_Hash_Table *h = XHASH_TABLE (ht); EMACS_UINT hash; @@ -2344,31 +2344,6 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, depth++; goto tail_recurse; - case Lisp_Misc: - if (XMISCTYPE (o1) != XMISCTYPE (o2)) - return false; - if (OVERLAYP (o1)) - { - if (!internal_equal (OVERLAY_START (o1), OVERLAY_START (o2), - equal_kind, depth + 1, ht) - || !internal_equal (OVERLAY_END (o1), OVERLAY_END (o2), - equal_kind, depth + 1, ht)) - return false; - o1 = XOVERLAY (o1)->plist; - o2 = XOVERLAY (o2)->plist; - depth++; - goto tail_recurse; - } - if (MARKERP (o1)) - { - return (XMARKER (o1)->buffer == XMARKER (o2)->buffer - && (XMARKER (o1)->buffer == 0 - || XMARKER (o1)->bytepos == XMARKER (o2)->bytepos)); - } - if (BIGNUMP (o1)) - return mpz_cmp (XBIGNUM (o1)->value, XBIGNUM (o2)->value) == 0; - break; - case Lisp_Vectorlike: { register int i; @@ -2378,6 +2353,26 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, same size. */ if (ASIZE (o2) != size) return false; + if (BIGNUMP (o1)) + return mpz_cmp (XBIGNUM (o1)->value, XBIGNUM (o2)->value) == 0; + if (OVERLAYP (o1)) + { + if (!internal_equal (OVERLAY_START (o1), OVERLAY_START (o2), + equal_kind, depth + 1, ht) + || !internal_equal (OVERLAY_END (o1), OVERLAY_END (o2), + equal_kind, depth + 1, ht)) + return false; + o1 = XOVERLAY (o1)->plist; + o2 = XOVERLAY (o2)->plist; + depth++; + goto tail_recurse; + } + if (MARKERP (o1)) + { + return (XMARKER (o1)->buffer == XMARKER (o2)->buffer + && (XMARKER (o1)->buffer == 0 + || XMARKER (o1)->bytepos == XMARKER (o2)->bytepos)); + } /* Boolvectors are compared much like strings. */ if (BOOL_VECTOR_P (o1)) { @@ -4477,13 +4472,6 @@ sxhash (Lisp_Object obj, int depth) hash = XUFIXNUM (obj); break; - case Lisp_Misc: - if (XMISCTYPE (obj) == Lisp_Misc_Bignum) - { - hash = sxhash_bignum (XBIGNUM (obj)); - break; - } - FALLTHROUGH; case Lisp_Symbol: hash = XHASH (obj); break; @@ -4494,7 +4482,9 @@ sxhash (Lisp_Object obj, int depth) /* This can be everything from a vector to an overlay. */ case Lisp_Vectorlike: - if (VECTORP (obj) || RECORDP (obj)) + if (BIGNUMP (obj)) + hash = sxhash_bignum (XBIGNUM (obj)); + else if (VECTORP (obj) || RECORDP (obj)) /* According to the CL HyperSpec, two arrays are equal only if they are `eq', except for strings and bit-vectors. In Emacs, this works differently. We have to compare element diff --git a/src/lisp.h b/src/lisp.h index 6ca3416892..c080cc6b14 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -365,8 +365,6 @@ typedef EMACS_INT Lisp_Word; #define lisp_h_EQ(x, y) (XLI (x) == XLI (y)) #define lisp_h_FLOATP(x) (XTYPE (x) == Lisp_Float) #define lisp_h_FIXNUMP(x) ((XTYPE (x) & (Lisp_Int0 | ~Lisp_Int1)) == Lisp_Int0) -#define lisp_h_MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker) -#define lisp_h_MISCP(x) (XTYPE (x) == Lisp_Misc) #define lisp_h_NILP(x) EQ (x, Qnil) #define lisp_h_SET_SYMBOL_VAL(sym, v) \ (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), \ @@ -430,8 +428,6 @@ typedef EMACS_INT Lisp_Word; # define EQ(x, y) lisp_h_EQ (x, y) # define FLOATP(x) lisp_h_FLOATP (x) # define FIXNUMP(x) lisp_h_FIXNUMP (x) -# define MARKERP(x) lisp_h_MARKERP (x) -# define MISCP(x) lisp_h_MISCP (x) # define NILP(x) lisp_h_NILP (x) # define SET_SYMBOL_VAL(sym, v) lisp_h_SET_SYMBOL_VAL (sym, v) # define SYMBOL_CONSTANT_P(sym) lisp_h_SYMBOL_CONSTANT_P (sym) @@ -482,11 +478,9 @@ enum Lisp_Type /* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */ Lisp_Symbol = 0, - /* Miscellaneous. XMISC (object) points to a union Lisp_Misc, - whose first member indicates the subtype. */ - Lisp_Misc = 1, + /* Type 1 is currently unused. */ - /* Integer. XFIXNUM (obj) is the integer value. */ + /* Fixnum. XFIXNUM (obj) is the integer value. */ Lisp_Int0 = 2, Lisp_Int1 = USE_LSB_TAG ? 6 : 3, @@ -506,26 +500,6 @@ enum Lisp_Type Lisp_Float = 7 }; -/* This is the set of data types that share a common structure. - The first member of the structure is a type code from this set. - The enum values are arbitrary, but we'll use large numbers to make it - more likely that we'll spot the error if a random word in memory is - mistakenly interpreted as a Lisp_Misc. */ -enum Lisp_Misc_Type - { - Lisp_Misc_Free = 0x5eab, - Lisp_Misc_Marker, - Lisp_Misc_Overlay, - Lisp_Misc_Finalizer, - Lisp_Misc_Ptr, -#ifdef HAVE_MODULES - Lisp_Misc_User_Ptr, -#endif - Lisp_Misc_Bignum, - /* This is not a type code. It is for range checking. */ - Lisp_Misc_Limit - }; - /* These are the types of forwarding objects used in the value slot of symbols for special built-in variables whose value is stored in C variables. */ @@ -539,14 +513,12 @@ enum Lisp_Fwd_Type }; /* If you want to define a new Lisp data type, here are some - instructions. See the thread at - https://lists.gnu.org/r/emacs-devel/2012-10/msg00561.html - for more info. + instructions. First, there are already a couple of Lisp types that can be used if your new type does not need to be exposed to Lisp programs nor - displayed to users. These are Lisp_Misc_Ptr, a Lisp_Misc - subtype; and PVEC_OTHER, a kind of vectorlike object. The former + displayed to users. These are Lisp_Misc_Ptr and PVEC_OTHER, + which are both vectorlike objects. The former is suitable for stashing a pointer in a Lisp object; the pointer might be to some low-level C object that contains auxiliary information. The latter is useful for vector-like Lisp objects @@ -557,30 +529,14 @@ enum Lisp_Fwd_Type These two types don't look pretty when printed, so they are unsuitable for Lisp objects that can be exposed to users. - To define a new data type, add one more Lisp_Misc subtype or one - more pseudovector subtype. Pseudovectors are more suitable for - objects with several slots that need to support fast random access, - while Lisp_Misc types are for everything else. A pseudovector object - provides one or more slots for Lisp objects, followed by struct - members that are accessible only from C. A Lisp_Misc object is a - wrapper for a C struct that can contain anything you like. + To define a new data type, add a pseudovector subtype by extending + the pvec_type enumeration. A pseudovector provides one or more + slots for Lisp objects, followed by struct members that are + accessible only from C. There is no way to explicitly free a Lisp Object; only the garbage collector frees them. - To add a new pseudovector type, extend the pvec_type enumeration; - to add a new Lisp_Misc, extend the Lisp_Misc_Type enumeration. - - For a Lisp_Misc, you will also need to add your entry to union - Lisp_Misc, but make sure the first word has the same structure as - the others, starting with a 16-bit member of the Lisp_Misc_Type - enumeration and a 1-bit GC markbit. Also make sure the overall - size of the union is not increased by your addition. The latter - requirement is to keep Lisp_Misc objects small enough, so they - are handled faster: since all Lisp_Misc types use the same space, - enlarging any of them will affect all the rest. If you really - need a larger object, it is best to use Lisp_Vectorlike instead. - For a new pseudovector, it's highly desirable to limit the size of your data type by VBLOCK_BYTES_MAX bytes (defined in alloc.c). Otherwise you will need to change sweep_vectors (also in alloc.c). @@ -973,6 +929,14 @@ enum pvec_type { PVEC_NORMAL_VECTOR, PVEC_FREE, + PVEC_BIGNUM, + PVEC_MARKER, + PVEC_OVERLAY, + PVEC_FINALIZER, + PVEC_MISC_PTR, +#ifdef HAVE_MODULES + PVEC_USER_PTR, +#endif PVEC_PROCESS, PVEC_FRAME, PVEC_WINDOW, @@ -1173,7 +1137,6 @@ INLINE bool #define XSETSTRING(a, b) ((a) = make_lisp_ptr (b, Lisp_String)) #define XSETSYMBOL(a, b) ((a) = make_lisp_symbol (b)) #define XSETFLOAT(a, b) ((a) = make_lisp_ptr (b, Lisp_Float)) -#define XSETMISC(a, b) ((a) = make_lisp_ptr (b, Lisp_Misc)) /* Pseudovector types. */ @@ -2273,46 +2236,10 @@ SXHASH_REDUCE (EMACS_UINT x) return (x ^ x >> (EMACS_INT_WIDTH - FIXNUM_BITS)) & INTMASK; } -/* These structures are used for various misc types. */ - -struct Lisp_Misc_Any /* Supertype of all Misc types. */ -{ - ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_??? */ - bool_bf gcmarkbit : 1; - unsigned spacer : 15; -}; - -INLINE bool -(MISCP) (Lisp_Object x) -{ - return lisp_h_MISCP (x); -} - -INLINE struct Lisp_Misc_Any * -XMISCANY (Lisp_Object a) -{ - eassert (MISCP (a)); - return XUNTAG (a, Lisp_Misc, struct Lisp_Misc_Any); -} - -INLINE enum Lisp_Misc_Type -XMISCTYPE (Lisp_Object a) -{ - return XMISCANY (a)->type; -} - struct Lisp_Marker { - ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Marker */ - bool_bf gcmarkbit : 1; - unsigned spacer : 13; - /* This flag is temporarily used in the functions - decode/encode_coding_object to record that the marker position - must be adjusted after the conversion. */ - bool_bf need_adjustment : 1; - /* True means normal insertion at the marker's position - leaves the marker after the inserted text. */ - bool_bf insertion_type : 1; + union vectorlike_header header; + /* This is the buffer that the marker points into, or 0 if it points nowhere. Note: a chain of markers can contain markers pointing into different buffers (the chain is per buffer_text rather than per buffer, so it's @@ -2325,6 +2252,14 @@ struct Lisp_Marker */ struct buffer *buffer; + /* This flag is temporarily used in the functions + decode/encode_coding_object to record that the marker position + must be adjusted after the conversion. */ + bool_bf need_adjustment : 1; + /* True means normal insertion at the marker's position + leaves the marker after the inserted text. */ + bool_bf insertion_type : 1; + /* The remaining fields are meaningless in a marker that does not point anywhere. */ @@ -2357,20 +2292,16 @@ struct Lisp_Overlay I.e. 9words plus 2 bits, 3words of which are for external linked lists. */ { - ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Overlay */ - bool_bf gcmarkbit : 1; - unsigned spacer : 15; - struct Lisp_Overlay *next; + union vectorlike_header header; Lisp_Object start; Lisp_Object end; Lisp_Object plist; + struct Lisp_Overlay *next; }; struct Lisp_Misc_Ptr { - ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Ptr */ - bool_bf gcmarkbit : 1; - unsigned spacer : 15; + union vectorlike_header header; void *pointer; }; @@ -2388,7 +2319,7 @@ extern Lisp_Object make_misc_ptr (void *); C code, it should not be given a mint_ptr generated from Lisp code as that would allow Lisp code to coin pointers from integers and could lead to crashes. To package a C pointer into a Lisp-visible - object you can put the pointer into a Lisp_Misc object instead; see + object you can put the pointer into a pseudovector instead; see Lisp_User_Ptr for an example. */ INLINE Lisp_Object @@ -2401,7 +2332,7 @@ make_mint_ptr (void *a) INLINE bool mint_ptrp (Lisp_Object x) { - return FIXNUMP (x) || (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Ptr); + return FIXNUMP (x) || PSEUDOVECTORP (x, PVEC_MISC_PTR); } INLINE void * @@ -2410,16 +2341,13 @@ xmint_pointer (Lisp_Object a) eassert (mint_ptrp (a)); if (FIXNUMP (a)) return XFIXNUMPTR (a); - return XUNTAG (a, Lisp_Misc, struct Lisp_Misc_Ptr)->pointer; + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Misc_Ptr)->pointer; } #ifdef HAVE_MODULES struct Lisp_User_Ptr { - ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_User_Ptr */ - bool_bf gcmarkbit : 1; - unsigned spacer : 15; - + union vectorlike_header header; void (*finalizer) (void *); void *p; }; @@ -2428,123 +2356,89 @@ struct Lisp_User_Ptr /* A finalizer sentinel. */ struct Lisp_Finalizer { - struct Lisp_Misc_Any base; - - /* Circular list of all active weak references. */ - struct Lisp_Finalizer *prev; - struct Lisp_Finalizer *next; + union vectorlike_header header; /* Call FUNCTION when the finalizer becomes unreachable, even if FUNCTION contains a reference to the finalizer; i.e., call FUNCTION when it is reachable _only_ through finalizers. */ Lisp_Object function; + + /* Circular list of all active weak references. */ + struct Lisp_Finalizer *prev; + struct Lisp_Finalizer *next; }; INLINE bool FINALIZERP (Lisp_Object x) { - return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Finalizer; + return PSEUDOVECTORP (x, PVEC_FINALIZER); } INLINE struct Lisp_Finalizer * XFINALIZER (Lisp_Object a) { eassert (FINALIZERP (a)); - return XUNTAG (a, Lisp_Misc, struct Lisp_Finalizer); -} - -/* A miscellaneous object, when it's on the free list. */ -struct Lisp_Free - { - ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Free */ - bool_bf gcmarkbit : 1; - unsigned spacer : 15; - union Lisp_Misc *chain; - }; - -struct Lisp_Bignum - { - ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Bignum */ - bool_bf gcmarkbit : 1; - unsigned spacer : 15; - mpz_t value; - }; - -/* To get the type field of a union Lisp_Misc, use XMISCTYPE. - It uses one of these struct subtypes to get the type field. */ - -union Lisp_Misc - { - struct Lisp_Misc_Any u_any; /* Supertype of all Misc types. */ - struct Lisp_Free u_free; - struct Lisp_Marker u_marker; - struct Lisp_Overlay u_overlay; - struct Lisp_Finalizer u_finalizer; - struct Lisp_Misc_Ptr u_misc_ptr; -#ifdef HAVE_MODULES - struct Lisp_User_Ptr u_user_ptr; -#endif - struct Lisp_Bignum u_bignum; - }; - -INLINE union Lisp_Misc * -XMISC (Lisp_Object a) -{ - return XUNTAG (a, Lisp_Misc, union Lisp_Misc); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Finalizer); } INLINE bool -(MARKERP) (Lisp_Object x) +MARKERP (Lisp_Object x) { - return lisp_h_MARKERP (x); + return PSEUDOVECTORP (x, PVEC_MARKER); } INLINE struct Lisp_Marker * XMARKER (Lisp_Object a) { eassert (MARKERP (a)); - return XUNTAG (a, Lisp_Misc, struct Lisp_Marker); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Marker); } INLINE bool OVERLAYP (Lisp_Object x) { - return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay; + return PSEUDOVECTORP (x, PVEC_OVERLAY); } INLINE struct Lisp_Overlay * XOVERLAY (Lisp_Object a) { eassert (OVERLAYP (a)); - return XUNTAG (a, Lisp_Misc, struct Lisp_Overlay); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Overlay); } #ifdef HAVE_MODULES INLINE bool USER_PTRP (Lisp_Object x) { - return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_User_Ptr; + return PSEUDOVECTORP (x, PVEC_USER_PTR); } INLINE struct Lisp_User_Ptr * XUSER_PTR (Lisp_Object a) { eassert (USER_PTRP (a)); - return XUNTAG (a, Lisp_Misc, struct Lisp_User_Ptr); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_User_Ptr); } #endif +struct Lisp_Bignum +{ + union vectorlike_header header; + mpz_t value; +}; + INLINE bool BIGNUMP (Lisp_Object x) { - return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Bignum; + return PSEUDOVECTORP (x, PVEC_BIGNUM); } INLINE struct Lisp_Bignum * XBIGNUM (Lisp_Object a) { eassert (BIGNUMP (a)); - return XUNTAG (a, Lisp_Misc, struct Lisp_Bignum); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Bignum); } INLINE bool diff --git a/src/print.c b/src/print.c index 3819c505b1..824f8d7577 100644 --- a/src/print.c +++ b/src/print.c @@ -1367,6 +1367,76 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, { switch (PSEUDOVECTOR_TYPE (XVECTOR (obj))) { + case PVEC_BIGNUM: + { + struct Lisp_Bignum *b = XBIGNUM (obj); + char *str = mpz_get_str (NULL, 10, b->value); + record_unwind_protect_ptr (xfree, str); + print_c_string (str, printcharfun); + } + break; + + case PVEC_MARKER: + print_c_string ("#insertion_type != 0) + print_c_string ("(moves after insertion) ", printcharfun); + if (! XMARKER (obj)->buffer) + print_c_string ("in no buffer", printcharfun); + else + { + int len = sprintf (buf, "at %"pD"d in ", marker_position (obj)); + strout (buf, len, len, printcharfun); + print_string (BVAR (XMARKER (obj)->buffer, name), printcharfun); + } + printchar ('>', printcharfun); + break; + + case PVEC_OVERLAY: + print_c_string ("#buffer) + print_c_string ("in no buffer", printcharfun); + else + { + int len = sprintf (buf, "from %"pD"d to %"pD"d in ", + marker_position (OVERLAY_START (obj)), + marker_position (OVERLAY_END (obj))); + strout (buf, len, len, printcharfun); + print_string (BVAR (XMARKER (OVERLAY_START (obj))->buffer, name), + printcharfun); + } + printchar ('>', printcharfun); + break; + +#ifdef HAVE_MODULES + case PVEC_USER_PTR: + { + print_c_string ("#p, + XUSER_PTR (obj)->finalizer); + strout (buf, i, i, printcharfun); + printchar ('>', printcharfun); + } + break; +#endif + + case PVEC_FINALIZER: + print_c_string ("#function)) + print_c_string (" used", printcharfun); + printchar ('>', printcharfun); + break; + + case PVEC_MISC_PTR: + { + /* This shouldn't happen in normal usage, but let's + print it anyway for the benefit of the debugger. */ + int i = sprintf (buf, "#", xmint_pointer (obj)); + strout (buf, i, i, printcharfun); + } + break; + case PVEC_PROCESS: if (escapeflag) { @@ -2096,103 +2166,16 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) break; case Lisp_Vectorlike: - if (! print_vectorlike (obj, printcharfun, escapeflag, buf)) - goto badtype; - break; - - case Lisp_Misc: - switch (XMISCTYPE (obj)) - { - case Lisp_Misc_Marker: - print_c_string ("#insertion_type != 0) - print_c_string ("(moves after insertion) ", printcharfun); - if (! XMARKER (obj)->buffer) - print_c_string ("in no buffer", printcharfun); - else - { - int len = sprintf (buf, "at %"pD"d in ", marker_position (obj)); - strout (buf, len, len, printcharfun); - print_string (BVAR (XMARKER (obj)->buffer, name), printcharfun); - } - printchar ('>', printcharfun); - break; - - case Lisp_Misc_Overlay: - print_c_string ("#buffer) - print_c_string ("in no buffer", printcharfun); - else - { - int len = sprintf (buf, "from %"pD"d to %"pD"d in ", - marker_position (OVERLAY_START (obj)), - marker_position (OVERLAY_END (obj))); - strout (buf, len, len, printcharfun); - print_string (BVAR (XMARKER (OVERLAY_START (obj))->buffer, name), - printcharfun); - } - printchar ('>', printcharfun); - break; - -#ifdef HAVE_MODULES - case Lisp_Misc_User_Ptr: - { - print_c_string ("#p, - XUSER_PTR (obj)->finalizer); - strout (buf, i, i, printcharfun); - printchar ('>', printcharfun); - break; - } -#endif - - case Lisp_Misc_Finalizer: - print_c_string ("#function)) - print_c_string (" used", printcharfun); - printchar ('>', printcharfun); - break; - - /* Remaining cases shouldn't happen in normal usage, but let's - print them anyway for the benefit of the debugger. */ - - case Lisp_Misc_Free: - print_c_string ("#", printcharfun); - break; - - case Lisp_Misc_Ptr: - { - int i = sprintf (buf, "#", xmint_pointer (obj)); - strout (buf, i, i, printcharfun); - } - break; - - case Lisp_Misc_Bignum: - { - struct Lisp_Bignum *b = XBIGNUM (obj); - char *str = mpz_get_str (NULL, 10, b->value); - record_unwind_protect_ptr (xfree, str); - print_c_string (str, printcharfun); - } - break; - - default: - goto badtype; - } - break; - + if (print_vectorlike (obj, printcharfun, escapeflag, buf)) + break; + FALLTHROUGH; default: - badtype: { int len; /* We're in trouble if this happens! Probably should just emacs_abort (). */ print_c_string ("#next) + for (struct Lisp_Marker *m = BUF_MARKERS (current_buffer); m; m = m->next) { - charpos = m->charpos; + ptrdiff_t charpos = m->charpos; eassert (charpos <= Z); if (from <= charpos && charpos <= to) @@ -146,11 +142,11 @@ record_marker_adjustments (ptrdiff_t from, ptrdiff_t to) insertion_type t markers will automatically move forward upon re-inserting the deleted text, so we have to arrange for them to move backward to the correct position. */ - adjustment = (m->insertion_type ? to : from) - charpos; + ptrdiff_t adjustment = (m->insertion_type ? to : from) - charpos; if (adjustment) { - XSETMISC (marker, m); + Lisp_Object marker = make_lisp_ptr (m, Lisp_Vectorlike); bset_undo_list (current_buffer, Fcons (Fcons (marker, make_fixnum (adjustment)), diff --git a/src/xdisp.c b/src/xdisp.c index 76fde99f32..0835ccafd4 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -5819,11 +5819,7 @@ compare_overlay_entries (const void *e1, const void *e2) static void load_overlay_strings (struct it *it, ptrdiff_t charpos) { - Lisp_Object overlay, window, str, invisible; - struct Lisp_Overlay *ov; - ptrdiff_t start, end; - ptrdiff_t n = 0, i, j; - int invis; + ptrdiff_t n = 0; struct overlay_entry entriesbuf[20]; ptrdiff_t size = ARRAYELTS (entriesbuf); struct overlay_entry *entries = entriesbuf; @@ -5859,12 +5855,13 @@ load_overlay_strings (struct it *it, ptrdiff_t charpos) while (false) /* Process overlay before the overlay center. */ - for (ov = current_buffer->overlays_before; ov; ov = ov->next) + for (struct Lisp_Overlay *ov = current_buffer->overlays_before; + ov; ov = ov->next) { - XSETMISC (overlay, ov); + Lisp_Object overlay = make_lisp_ptr (ov, Lisp_Vectorlike); eassert (OVERLAYP (overlay)); - start = OVERLAY_POSITION (OVERLAY_START (overlay)); - end = OVERLAY_POSITION (OVERLAY_END (overlay)); + ptrdiff_t start = OVERLAY_POSITION (OVERLAY_START (overlay)); + ptrdiff_t end = OVERLAY_POSITION (OVERLAY_END (overlay)); if (end < charpos) break; @@ -5875,17 +5872,18 @@ load_overlay_strings (struct it *it, ptrdiff_t charpos) continue; /* Skip this overlay if it doesn't apply to IT->w. */ - window = Foverlay_get (overlay, Qwindow); + Lisp_Object window = Foverlay_get (overlay, Qwindow); if (WINDOWP (window) && XWINDOW (window) != it->w) continue; /* If the text ``under'' the overlay is invisible, both before- and after-strings from this overlay are visible; start and end position are indistinguishable. */ - invisible = Foverlay_get (overlay, Qinvisible); - invis = TEXT_PROP_MEANS_INVISIBLE (invisible); + Lisp_Object invisible = Foverlay_get (overlay, Qinvisible); + int invis = TEXT_PROP_MEANS_INVISIBLE (invisible); /* If overlay has a non-empty before-string, record it. */ + Lisp_Object str; if ((start == charpos || (end == charpos && invis != 0)) && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)) && SCHARS (str)) @@ -5899,12 +5897,13 @@ load_overlay_strings (struct it *it, ptrdiff_t charpos) } /* Process overlays after the overlay center. */ - for (ov = current_buffer->overlays_after; ov; ov = ov->next) + for (struct Lisp_Overlay *ov = current_buffer->overlays_after; + ov; ov = ov->next) { - XSETMISC (overlay, ov); + Lisp_Object overlay = make_lisp_ptr (ov, Lisp_Vectorlike); eassert (OVERLAYP (overlay)); - start = OVERLAY_POSITION (OVERLAY_START (overlay)); - end = OVERLAY_POSITION (OVERLAY_END (overlay)); + ptrdiff_t start = OVERLAY_POSITION (OVERLAY_START (overlay)); + ptrdiff_t end = OVERLAY_POSITION (OVERLAY_END (overlay)); if (start > charpos) break; @@ -5915,16 +5914,17 @@ load_overlay_strings (struct it *it, ptrdiff_t charpos) continue; /* Skip this overlay if it doesn't apply to IT->w. */ - window = Foverlay_get (overlay, Qwindow); + Lisp_Object window = Foverlay_get (overlay, Qwindow); if (WINDOWP (window) && XWINDOW (window) != it->w) continue; /* If the text ``under'' the overlay is invisible, it has a zero dimension, and both before- and after-strings apply. */ - invisible = Foverlay_get (overlay, Qinvisible); - invis = TEXT_PROP_MEANS_INVISIBLE (invisible); + Lisp_Object invisible = Foverlay_get (overlay, Qinvisible); + int invis = TEXT_PROP_MEANS_INVISIBLE (invisible); /* If overlay has a non-empty before-string, record it. */ + Lisp_Object str; if ((start == charpos || (end == charpos && invis != 0)) && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)) && SCHARS (str)) @@ -5950,12 +5950,11 @@ load_overlay_strings (struct it *it, ptrdiff_t charpos) /* IT->current.overlay_string_index is the number of overlay strings that have already been consumed by IT. Copy some of the remaining overlay strings to IT->overlay_strings. */ - i = 0; - j = it->current.overlay_string_index; - while (i < OVERLAY_STRING_CHUNK_SIZE && j < n) + ptrdiff_t j = it->current.overlay_string_index; + for (ptrdiff_t i = 0; i < OVERLAY_STRING_CHUNK_SIZE && j < n; i++, j++) { it->overlay_strings[i] = entries[j].string; - it->string_overlays[i++] = entries[j++].overlay; + it->string_overlays[i] = entries[j].overlay; } CHECK_IT (it); commit d2ad4ba4f3c5db6f6be7d73c17332e9bc4570e29 Author: Yuri D'Elia Date: Tue Jul 17 12:59:35 2018 +0200 Do not consider external packages to be removable (Bug#27822) Packages which are not directly user-installed shouldn't be autoremoved, since they can be setup through a different path (via `package-directory-list') where we have no authority over. * lisp/emacs-lisp/package.el (package--user-installed-p): New function. (package--removable-packages): Use it. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 576a9bc7e7..207c2e5c48 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1730,6 +1730,15 @@ if it is still empty." (indirect indirect-deps) (t (delete-dups (append direct-deps indirect-deps)))))) +(defun package--user-installed-p (package) + "Return non-nil if PACKAGE is a user-installed package. +PACKAGE is the package name, a symbol. Check whether the package +was installed into `package-user-dir' where we assume to have +control over." + (let* ((pkg-desc (cadr (assq package package-alist))) + (dir (package-desc-dir pkg-desc))) + (file-in-directory-p dir package-user-dir))) + (defun package--removable-packages () "Return a list of names of packages no longer needed. These are packages which are neither contained in @@ -1739,7 +1748,9 @@ These are packages which are neither contained in ;; `p' and its dependencies are needed. append (cons p (package--get-deps p))))) (cl-loop for p in (mapcar #'car package-alist) - unless (memq p needed) + unless (or (memq p needed) + ;; Do not auto-remove external packages. + (not (package--user-installed-p p))) collect p))) (defun package--used-elsewhere-p (pkg-desc &optional pkg-list all) commit d3ec5117da3146573cad5c1f8d01ab2e58f21e92 Author: Paul Eggert Date: Sat Aug 11 16:32:06 2018 -0700 Pacify Oracle Studio 12.6 * src/xfns.c (Fx_frame_restack): * src/xterm.c (x_io_error_quitter): Omit unreachable code. diff --git a/src/xfns.c b/src/xfns.c index c455cfe1f5..6ed9ecaab5 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -5421,16 +5421,10 @@ Some window managers may refuse to restack windows. */) struct frame *f1 = decode_live_frame (frame1); struct frame *f2 = decode_live_frame (frame2); - if (FRAME_OUTER_WINDOW (f1) && FRAME_OUTER_WINDOW (f2)) - { - x_frame_restack (f1, f2, !NILP (above)); - return Qt; - } - else - { - error ("Cannot restack frames"); - return Qnil; - } + if (! (FRAME_OUTER_WINDOW (f1) && FRAME_OUTER_WINDOW (f2))) + error ("Cannot restack frames"); + x_frame_restack (f1, f2, !NILP (above)); + return Qt; } diff --git a/src/xterm.c b/src/xterm.c index be8e3da372..7131497e69 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -9935,7 +9935,6 @@ x_io_error_quitter (Display *display) snprintf (buf, sizeof buf, "Connection lost to X server '%s'", DisplayString (display)); x_connection_closed (display, buf, true); - assume (false); } /* Changing the font of the frame. */ commit da7fc851dc21342bd8f33f92771fe78087b73e35 Author: Paul Eggert Date: Sat Aug 11 16:27:52 2018 -0700 Reject old libgmp that lack mpz_roinit_n * configure.ac (HAVE_GMP): Port to RHEL 6.9, which has libgmp 3.5, which predates mpz_roinit_n. diff --git a/configure.ac b/configure.ac index 3d0a787683..690b999125 100644 --- a/configure.ac +++ b/configure.ac @@ -4305,7 +4305,7 @@ AC_SUBST(KRB4LIB) GMP_LIB= GMP_OBJ= HAVE_GMP=no -AC_CHECK_LIB(gmp, __gmpz_init, [ +AC_CHECK_LIB(gmp, __gmpz_roinit_n, [ AC_CHECK_HEADERS(gmp.h, [ GMP_LIB=-lgmp HAVE_GMP=yes commit d0d7bd68166c59dd71e8682a185bd03c0e8048f8 Author: Glenn Morris Date: Sat Aug 11 14:44:49 2018 -0700 ; * test/lisp/international/ccl-tests.el: Add license notice. diff --git a/test/lisp/international/ccl-tests.el b/test/lisp/international/ccl-tests.el index ba6d2040e8..b41b8c1ff6 100644 --- a/test/lisp/international/ccl-tests.el +++ b/test/lisp/international/ccl-tests.el @@ -1,3 +1,22 @@ +;; Copyright (C) 2018 Free Software Foundation, Inc. + +;; 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 . + +;;; Code: + (require 'ert) (require 'ccl) (require 'seq) commit 78ec68e18f07a90a9ad400683b973ff51baa80e1 Merge: ba1c4f63e3 79f59d41a3 Author: Tom Tromey Date: Sat Aug 11 13:34:17 2018 -0600 Merge branch 'feature/bignum' commit ec0995c40901a5b11d42c8a5fafd26771c76b17c Author: Paul Eggert Date: Sat Aug 11 12:13:53 2018 -0700 * src/alloc.c: Remove obsolete comments. diff --git a/src/alloc.c b/src/alloc.c index 7baaa512c2..3654d30182 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2642,8 +2642,6 @@ make_float (double float_value) if (float_free_list) { - /* We use the data field for chaining the free list - so that we won't use the same field that has the mark bit. */ XSETFLOAT (val, float_free_list); float_free_list = float_free_list->u.chain; } @@ -2747,8 +2745,6 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0, if (cons_free_list) { - /* We use the cdr for chaining the free list - so that we won't use the same field that has the mark bit. */ XSETCONS (val, cons_free_list); cons_free_list = cons_free_list->u.s.u.chain; } commit ba1c4f63e3d2adbe9b590a3c51c2a0808c84723f Author: Michael Albinus Date: Sat Aug 11 20:30:39 2018 +0200 Fix Bug#32226, hopefully * test/lisp/shadowfile-tests.el: Set Tramp variables for hydra. diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el index 222c3fc202..ed2ab9b329 100644 --- a/test/lisp/shadowfile-tests.el +++ b/test/lisp/shadowfile-tests.el @@ -63,6 +63,14 @@ (format "/mock::%s" temporary-file-directory))) "Temporary directory for Tramp tests.") +(setq password-cache-expiry nil + tramp-verbose 0 + tramp-message-show-message nil) + +;; This should happen on hydra only. +(when (getenv "EMACS_HYDRA_CI") + (add-to-list 'tramp-remote-path 'tramp-own-remote-path)) + (defconst shadow-test-info-file (expand-file-name "shadows_test" temporary-file-directory) "File to keep shadow information in during tests.") commit bf1298c7d8aa80432cc357f988ecfb3d6eb4c11c Author: JoĂŁo Távora Date: Sat Aug 11 17:08:13 2018 +0100 Fix blunder in last commit for lisp/jsonrpc.el * lisp/jsonrpc.el (jsonrpc-shutdown): Use jsonrpc--process. diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 29a3de47a4..43b570cfd9 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -431,7 +431,7 @@ optional CLEANUP, kill any associated buffers. " do (jsonrpc--warn "Sentinel for %s still hasn't run, deleting it!" proc) finally return t)) - (when cleanup (kill-buffer (process-buffer conn))))) + (when cleanup (kill-buffer (process-buffer (jsonrpc--process conn)))))) (defun jsonrpc-stderr-buffer (conn) "Get CONN's standard error buffer, if any." commit 2304bc9b9748db481ee1e5cff6f51709eb625394 Author: JoĂŁo Távora Date: Sat Aug 11 16:53:26 2018 +0100 Add option to cleanup buffers to jsonrpc-shutdown * lisp/jsonrpc.el (Version): Bump to 1.0.5 (jsonrpc-shutdown): Add an option to cleanup process buffer. diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 691e7b2830..29a3de47a4 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -6,7 +6,7 @@ ;; Maintainer: JoĂŁo Távora ;; Keywords: processes, languages, extensions ;; Package-Requires: ((emacs "25.2")) -;; Version: 1.0.4 +;; Version: 1.0.5 ;; This is an Elpa :core package. Don't use functionality that is not ;; compatible with Emacs 25.2. @@ -415,19 +415,23 @@ connection object, called when the process dies .") "Return non-nil if JSONRPC connection CONN is running." (process-live-p (jsonrpc--process conn))) -(cl-defmethod jsonrpc-shutdown ((conn jsonrpc-process-connection)) +(cl-defmethod jsonrpc-shutdown ((conn jsonrpc-process-connection) + &optional cleanup) "Wait for JSONRPC connection CONN to shutdown and return t. -If the server wasn't running, do nothing and return nil." - (when (jsonrpc-running-p conn) - (cl-loop - with proc = (jsonrpc--process conn) - do - (delete-process proc) - (accept-process-output nil 0.1) - while (not (process-get proc 'jsonrpc-sentinel-done)) - do (jsonrpc--warn - "Sentinel for %s still hasn't run, deleting it!" proc) - finally return t))) +If the server wasn't running, do nothing and return nil. With +optional CLEANUP, kill any associated buffers. " + (unwind-protect + (when (jsonrpc-running-p conn) + (cl-loop + with proc = (jsonrpc--process conn) + do + (delete-process proc) + (accept-process-output nil 0.1) + while (not (process-get proc 'jsonrpc-sentinel-done)) + do (jsonrpc--warn + "Sentinel for %s still hasn't run, deleting it!" proc) + finally return t)) + (when cleanup (kill-buffer (process-buffer conn))))) (defun jsonrpc-stderr-buffer (conn) "Get CONN's standard error buffer, if any." commit 1d8fa1c9810dc78fe29449d865e9a5fb705284b9 Author: Michael Albinus Date: Sat Aug 11 17:02:38 2018 +0200 ; More instrumentation for shadowfile-tests.el and files.el diff --git a/lisp/files.el b/lisp/files.el index ffa926f63e..3482524900 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5234,7 +5234,7 @@ Before and after saving the buffer, this function runs (nth 1 setmodes))) (set-file-modes buffer-file-name (logior (car setmodes) 128)))))) - (if (getenv "BUG_32226") (message "BUG_32226 %s" 8)) + (if (getenv "BUG_32226") (message "BUG_32226 %s %s %s" 8 buffer-file-name buffer-file-truename)) (let (success) (unwind-protect (progn @@ -5248,7 +5248,7 @@ Before and after saving the buffer, this function runs (setq success t)) ;; If we get an error writing the new file, and we made ;; the backup by renaming, undo the backing-up. - (if (getenv "BUG_32226") (message "BUG_32226 %s" 10)) + (if (getenv "BUG_32226") (message "BUG_32226 %s %s %s" 10 (nth 2 setmodes) buffer-file-name)) (and setmodes (not success) (progn (rename-file (nth 2 setmodes) buffer-file-name t) diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el index f93845da61..222c3fc202 100644 --- a/test/lisp/shadowfile-tests.el +++ b/test/lisp/shadowfile-tests.el @@ -723,6 +723,8 @@ guaranteed by the originator of a cluster definition." (require 'trace) (dolist (elt (all-completions "shadow-" obarray 'functionp)) (trace-function-background (intern elt))) + (dolist (elt (all-completions "tramp-" obarray 'functionp)) + (trace-function-background (intern elt))) (trace-function-background 'save-buffer) (trace-function-background 'basic-save-buffer) (trace-function-background 'basic-save-buffer-1) commit d7b9737e69e44e90c45fab19255a0737c8f854ac Author: JoĂŁo Távora Date: Sat Aug 11 14:19:10 2018 +0100 * lisp/jsonrpc.el (jsonrpc-request): Clarify comment. diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index b41c30c516..691e7b2830 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -283,7 +283,7 @@ ignored." (let* ((tag (cl-gensym "jsonrpc-request-catch-tag")) id-and-timer cancelled (retval - (unwind-protect ; protect against user-quit, for example + (unwind-protect (catch tag (setq id-and-timer @@ -310,6 +310,10 @@ ignored." (setq cancelled t) `(cancelled ,cancel-on-input-retval)) (t (while t (accept-process-output nil 30))))) + ;; In normal operation, cancellation is handled by the + ;; timeout function and response filter, but we still have + ;; to protect against user-quit (C-g) or the + ;; `cancel-on-input' case. (pcase-let* ((`(,id ,timer) id-and-timer)) (remhash id (jsonrpc--request-continuations connection)) (remhash (list deferred (current-buffer)) commit c580443325a3d071625185876a8f28e04793c625 Author: JoĂŁo Távora Date: Sat Aug 11 14:18:17 2018 +0100 Make jsonrpc-shutdown a noop if process isn't running * lisp/jsonrpc.el (Version): Bump to 1.0.4 (jsonrpc-shutdown): Noop if server isn't running. diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index f3e0982139..b41c30c516 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -6,7 +6,7 @@ ;; Maintainer: JoĂŁo Távora ;; Keywords: processes, languages, extensions ;; Package-Requires: ((emacs "25.2")) -;; Version: 1.0.3 +;; Version: 1.0.4 ;; This is an Elpa :core package. Don't use functionality that is not ;; compatible with Emacs 25.2. @@ -412,15 +412,18 @@ connection object, called when the process dies .") (process-live-p (jsonrpc--process conn))) (cl-defmethod jsonrpc-shutdown ((conn jsonrpc-process-connection)) - "Shutdown the JSONRPC connection CONN." - (cl-loop - with proc = (jsonrpc--process conn) - do - (delete-process proc) - (accept-process-output nil 0.1) - while (not (process-get proc 'jsonrpc-sentinel-done)) - do (jsonrpc--warn - "Sentinel for %s still hasn't run, deleting it!" proc))) + "Wait for JSONRPC connection CONN to shutdown and return t. +If the server wasn't running, do nothing and return nil." + (when (jsonrpc-running-p conn) + (cl-loop + with proc = (jsonrpc--process conn) + do + (delete-process proc) + (accept-process-output nil 0.1) + while (not (process-get proc 'jsonrpc-sentinel-done)) + do (jsonrpc--warn + "Sentinel for %s still hasn't run, deleting it!" proc) + finally return t))) (defun jsonrpc-stderr-buffer (conn) "Get CONN's standard error buffer, if any." commit 914b0300bcca8ac016b85df54ed36c98d07c74a7 Author: Andy Moreton Date: Fri Jul 20 17:45:09 2018 +0100 Avoid calling vc backend if 'vc-display-status' is nil * lisp/vc/vc-hooks.el (vc-mode-line): Avoid calling VC backend if 'vc-display-status' is nil. (Bug#32225) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 55c0132bf2..f1b622b54a 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -692,24 +692,26 @@ visiting FILE. If BACKEND is passed use it as the VC backend when computing the result." (interactive (list buffer-file-name)) (setq backend (or backend (vc-backend file))) - (if (not backend) - (setq vc-mode nil) + (cond + ((not backend) + (setq vc-mode nil)) + ((null vc-display-status) + (setq vc-mode (concat " " (symbol-name backend)))) + (t (let* ((ml-string (vc-call-backend backend 'mode-line-string file)) (ml-echo (get-text-property 0 'help-echo ml-string))) (setq vc-mode (concat " " - (if (null vc-display-status) - (symbol-name backend) - (propertize - ml-string - 'mouse-face 'mode-line-highlight - 'help-echo - (concat (or ml-echo - (format "File under the %s version control system" - backend)) - "\nmouse-1: Version Control menu") - 'local-map vc-mode-line-map))))) + (propertize + ml-string + 'mouse-face 'mode-line-highlight + 'help-echo + (concat (or ml-echo + (format "File under the %s version control system" + backend)) + "\nmouse-1: Version Control menu") + 'local-map vc-mode-line-map)))) ;; If the user is root, and the file is not owner-writable, ;; then pretend that we can't write it ;; even though we can (because root can write anything). @@ -718,7 +720,7 @@ If BACKEND is passed use it as the VC backend when computing the result." (not buffer-read-only) (zerop (user-real-uid)) (zerop (logand (file-modes buffer-file-name) 128)) - (setq buffer-read-only t))) + (setq buffer-read-only t)))) (force-mode-line-update) backend) commit eefa51689cc9f33942ae58f34397aa9f71d7243c Author: Eli Zaretskii Date: Sat Aug 11 12:55:52 2018 +0300 Give auto-save-no-message a proper version attribute * lisp/cus-start.el (standard): Give 'auto-save-no-message' the proper version attribute. (Bug#31039) diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 0d4b968748..1a5b3caea2 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -345,7 +345,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of ;; keyboard.c (meta-prefix-char keyboard character) (auto-save-interval auto-save integer) - (auto-save-no-message auto-save boolean) + (auto-save-no-message auto-save boolean "27.1") (auto-save-timeout auto-save (choice (const :tag "off" nil) (integer :format "%v"))) (echo-keystrokes minibuffer number) commit c024a05e5990f0f9777ff88fffa02382b7522ccc Author: Federico Tedin Date: Mon Aug 6 19:53:05 2018 -0300 Add variable auto-save-no-message * src/keyboard.c (auto-save-no-message): New variable, allows suppressing auto-saving message. * lisp/cus-start.el (standard): Add 'auto-save-no-message' variable. * doc/emacs/files.texi (Auto Save): Document 'auto-save-no-message'. * etc/NEWS: Mention 'auto-save-no-message'. (Bug#31039) diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index a7cc57e4e9..c7d3b40f9d 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -1021,13 +1021,16 @@ separate file, without altering the file you actually use. This is called @dfn{auto-saving}. It prevents you from losing more than a limited amount of work if the system crashes. +@vindex auto-save-no-message When Emacs determines that it is time for auto-saving, it considers each buffer, and each is auto-saved if auto-saving is enabled for it -and it has been changed since the last time it was auto-saved. The -message @samp{Auto-saving...} is displayed in the echo area during -auto-saving, if any files are actually auto-saved. Errors occurring -during auto-saving are caught so that they do not interfere with the -execution of commands you have been typing. +and it has been changed since the last time it was auto-saved. When +the @code{auto-save-no-message} variable is set to @code{nil} (the +default), the message @samp{Auto-saving...} is displayed in the echo +area during auto-saving, if any files are actually auto-saved; to +disable these messages, customize the variable to a non-@code{nil} +value. Errors occurring during auto-saving are caught so that they do +not interfere with the execution of commands you have been typing. @menu * Files: Auto Save Files. The file where auto-saved changes are diff --git a/etc/NEWS b/etc/NEWS index 0b1e6499f4..d918ef3f8b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -196,6 +196,11 @@ from a remote host. This triggers to search the program on the remote host as indicated by 'default-directory'. ++++ +** New variable 'auto-save-no-message'. +When set to t, no message will be shown when auto-saving (default +value: nil). + * Editing Changes in Emacs 27.1 diff --git a/lisp/cus-start.el b/lisp/cus-start.el index f31d1df309..0d4b968748 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -345,6 +345,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of ;; keyboard.c (meta-prefix-char keyboard character) (auto-save-interval auto-save integer) + (auto-save-no-message auto-save boolean) (auto-save-timeout auto-save (choice (const :tag "off" nil) (integer :format "%v"))) (echo-keystrokes minibuffer number) diff --git a/src/keyboard.c b/src/keyboard.c index 7ab9a6069a..66041f317b 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -2626,7 +2626,7 @@ read_char (int commandflag, Lisp_Object map, && num_nonmacro_input_events - last_auto_save > max (auto_save_interval, 20) && !detect_input_pending_run_timers (0)) { - Fdo_auto_save (Qnil, Qnil); + Fdo_auto_save (auto_save_no_message ? Qt : Qnil, Qnil); /* Hooks can actually change some buffers in auto save. */ redisplay (); } @@ -2691,7 +2691,7 @@ read_char (int commandflag, Lisp_Object map, if (EQ (tem0, Qt) && ! CONSP (Vunread_command_events)) { - Fdo_auto_save (Qnil, Qnil); + Fdo_auto_save (auto_save_no_message ? Qt : Qnil, Qnil); redisplay (); } } @@ -11391,6 +11391,10 @@ result of looking up the original command in the active keymaps. */); Zero means disable autosaving due to number of characters typed. */); auto_save_interval = 300; + DEFVAR_BOOL ("auto-save-no-message", auto_save_no_message, + doc: /* Non-nil means do not print any message when auto-saving. */); + auto_save_no_message = false; + DEFVAR_LISP ("auto-save-timeout", Vauto_save_timeout, doc: /* Number of seconds idle time before auto-save. Zero or nil means disable auto-saving due to idleness. commit ec6f588940e51013435408a456c10d33ddf98fb2 Author: Eli Zaretskii Date: Sat Aug 11 12:01:37 2018 +0300 Better support utf-8-with-signature and utf-8-hfs in HTML * lisp/international/mule.el (sgml-html-meta-auto-coding-function): Support UTF-8 with BOM and utf-8-hfs as variants of UTF-8, and obey the buffer's encoding if it is one of these variants, instead of re-encoding in UTF-8 proper. (Bug#20623) diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 4d0081f577..1488810002 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -2544,7 +2544,17 @@ This function is intended to be added to `auto-coding-functions'." (let* ((match (match-string 2)) (sym (intern (downcase match)))) (if (coding-system-p sym) - sym + ;; If the encoding tag is UTF-8 and the buffer's + ;; encoding is one of the variants of UTF-8, use the + ;; buffer's encoding. This allows, e.g., saving an + ;; HTML file as UTF-8 with BOM when the tag says UTF-8. + (let ((sym-type (coding-system-type sym)) + (bfcs-type + (coding-system-type buffer-file-coding-system))) + (if (and (coding-system-equal 'utf-8 sym-type) + (coding-system-equal 'utf-8 bfcs-type)) + buffer-file-coding-system + sym)) (message "Warning: unknown coding system \"%s\"" match) nil))))) commit eb026a8d1b3c0cafb987fe5ef132ff078ec79f87 Author: Eli Zaretskii Date: Sat Aug 11 11:38:43 2018 +0300 Don't use -Wabi compiler option * configure.ac: Add -Wabi to the list of disabled warning options. For the details, see http://lists.gnu.org/archive/html/emacs-devel/2018-08/msg00123.html. diff --git a/configure.ac b/configure.ac index c6101d6353..9542d441d7 100644 --- a/configure.ac +++ b/configure.ac @@ -961,6 +961,7 @@ AS_IF([test $gl_gcc_warnings = no], nw="$nw -Wsync-nand" # irrelevant here, and provokes ObjC warning nw="$nw -Wunsafe-loop-optimizations" # OK to suppress unsafe optimizations nw="$nw -Wbad-function-cast" # These casts are no worse than others. + nw="$nw -Wabi" # Not useful, perceived as noise # Emacs doesn't care about shadowing; see # . commit 33344ab911ed6933294b501cb28ff63012f7a567 Merge: e9cda7a9d4 e33534f26a Author: Michael Albinus Date: Sat Aug 11 10:26:20 2018 +0200 Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs commit e9cda7a9d438b842fe1456715118a410862ab25b Author: Michael Albinus Date: Sat Aug 11 10:25:55 2018 +0200 ; More instrumentation for files.el diff --git a/lisp/files.el b/lisp/files.el index dac2ef75dc..ffa926f63e 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5147,6 +5147,7 @@ Before and after saving the buffer, this function runs ;; backup-buffer. (defun basic-save-buffer-2 () (let (tempsetmodes setmodes) + (if (getenv "BUG_32226") (message "BUG_32226 %s" 1)) (if (not (file-writable-p buffer-file-name)) (let ((dir (file-name-directory buffer-file-name))) (if (not (file-directory-p dir)) @@ -5162,10 +5163,12 @@ Before and after saving the buffer, this function runs buffer-file-name))) (setq tempsetmodes t) (error "Attempt to save to a file which you aren't allowed to write")))))) + (if (getenv "BUG_32226") (message "BUG_32226 %s" 2)) (or buffer-backed-up (setq setmodes (backup-buffer))) (let* ((dir (file-name-directory buffer-file-name)) (dir-writable (file-writable-p dir))) + (if (getenv "BUG_32226") (message "BUG_32226 %s" 3)) (if (or (and file-precious-flag dir-writable) (and break-hardlink-on-save (file-exists-p buffer-file-name) @@ -5183,6 +5186,7 @@ Before and after saving the buffer, this function runs ;; Create temp files with strict access rights. It's easy to ;; loosen them later, whereas it's impossible to close the ;; time-window of loose permissions otherwise. + (if (getenv "BUG_32226") (message "BUG_32226 %s" 4)) (condition-case err (progn (clear-visited-file-modtime) @@ -5200,6 +5204,7 @@ Before and after saving the buffer, this function runs ;; If we failed, restore the buffer's modtime. (error (set-visited-file-modtime old-modtime) (signal (car err) (cdr err)))) + (if (getenv "BUG_32226") (message "BUG_32226 %s" 5)) ;; Since we have created an entirely new file, ;; make sure it gets the right permission bits set. (setq setmodes (or setmodes @@ -5209,11 +5214,13 @@ Before and after saving the buffer, this function runs buffer-file-name))) ;; We succeeded in writing the temp file, ;; so rename it. + (if (getenv "BUG_32226") (message "BUG_32226 %s" 6)) (rename-file tempname buffer-file-name t)) ;; If file not writable, see if we can make it writable ;; temporarily while we write it. ;; But no need to do so if we have just backed it up ;; (setmodes is set) because that says we're superseding. + (if (getenv "BUG_32226") (message "BUG_32226 %s" 7)) (cond ((and tempsetmodes (not setmodes)) ;; Change the mode back, after writing. (setq setmodes (list (file-modes buffer-file-name) @@ -5227,6 +5234,7 @@ Before and after saving the buffer, this function runs (nth 1 setmodes))) (set-file-modes buffer-file-name (logior (car setmodes) 128)))))) + (if (getenv "BUG_32226") (message "BUG_32226 %s" 8)) (let (success) (unwind-protect (progn @@ -5235,13 +5243,16 @@ Before and after saving the buffer, this function runs ;; write-region-annotate-functions may make use of it. (write-region nil nil buffer-file-name nil t buffer-file-truename) + (if (getenv "BUG_32226") (message "BUG_32226 %s" 9)) (when save-silently (message nil)) (setq success t)) ;; If we get an error writing the new file, and we made ;; the backup by renaming, undo the backing-up. + (if (getenv "BUG_32226") (message "BUG_32226 %s" 10)) (and setmodes (not success) (progn (rename-file (nth 2 setmodes) buffer-file-name t) + (if (getenv "BUG_32226") (message "BUG_32226 %s" 11)) (setq buffer-backed-up nil)))))) setmodes)) commit e33534f26a27a6a10442fce8b735450d71568024 Merge: 5fbf13038d a0d00f17dd Author: Eli Zaretskii Date: Sat Aug 11 11:19:27 2018 +0300 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit 5fbf13038deefd9887222311f054d142d62f317f Author: Eli Zaretskii Date: Sat Aug 11 11:15:57 2018 +0300 Reinstate the 'tis620-2533' character set This is a partial revert of "Make 'tis620-2533' character set be an alias for 'thai-iso8859-11'" commit from Jul 28, 2018. * lisp/international/mule-conf.el (tis620-2533): No longer an alias for thai-iso8859-11. Instead, reinstate the original definition of tis620-2533, but without eight-bit-control in the :superset attribute. For the details, see http://lists.gnu.org/archive/html/emacs-devel/2018-08/msg00117.html and the surrounding discussions. * lisp/international/fontset.el (font-encoding-alist) (font-encoding-charset-alist): Reinstate tis620-2533 charset. * lisp/language/thai.el (thai-tis620): Restore the original :charset-list. ("Thai"): Restore the original nonascii-translation. * lisp/w32-fns.el: Use tis620-2533 instead of thai-iso8859-11. diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index d4ade3cc4c..9bd05ceb4a 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -79,7 +79,7 @@ ("cns11643.92p7-0" . chinese-cns11643-7) ("big5" . big5) ("viscii" . viscii) - ("tis620" . thai-iso8859-11) + ("tis620" . tis620-2533) ("microsoft-cp1251" . windows-1251) ("koi8-r" . koi8-r) ("jisx0213.2000-1" . japanese-jisx0213-1) @@ -139,7 +139,7 @@ (cyrillic-iso8859-5 . iso-8859-5) (greek-iso8859-7 . iso-8859-7) (arabic-iso8859-6 . iso-8859-6) - (thai-tis620 . thai-iso8859-11) + (thai-tis620 . tis620-2533) (latin-jisx0201 . jisx0201) (katakana-jisx0201 . jisx0201) (chinese-big5-1 . big5) diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el index a635c67770..3affeec03e 100644 --- a/lisp/international/mule-conf.el +++ b/lisp/international/mule-conf.el @@ -201,7 +201,6 @@ ;; plus nbsp (define-iso-single-byte-charset 'iso-8859-11 'thai-iso8859-11 "ISO/IEC 8859/11" "Latin/Thai" 166 ?T nil "8859-11") -(define-charset-alias 'tis620-2533 'thai-iso8859-11) ;; 8859-12 doesn't (yet?) exist. @@ -223,13 +222,20 @@ ;; Can this be shared with 8859-11? ;; N.b. not all of these are defined in Unicode. (define-charset 'thai-tis620 - "TIS620.2533" + "MULE charset for TIS620.2533" :short-name "TIS620.2533" :iso-final-char ?T :emacs-mule-id 133 :code-space [32 127] :code-offset #x0E00) +(define-charset 'tis620-2533 + "TIS620.2533, a.k.a. TIS-620. Like `thai-iso8859-11', but without NBSP." + :short-name "TIS620.2533" + :ascii-compatible-p t + :code-space [0 255] + :superset '(ascii (thai-tis620 . 128))) + (define-charset 'jisx0201 "JISX0201" :short-name "JISX0201" diff --git a/lisp/language/thai.el b/lisp/language/thai.el index c655845e95..a896fe59fd 100644 --- a/lisp/language/thai.el +++ b/lisp/language/thai.el @@ -36,7 +36,7 @@ "8-bit encoding for ASCII (MSB=0) and Thai TIS620 (MSB=1)." :coding-type 'charset :mnemonic ?T - :charset-list '(thai-iso8859-11)) + :charset-list '(tis620-2533)) (define-coding-system-alias 'th-tis620 'thai-tis620) (define-coding-system-alias 'tis620 'thai-tis620) @@ -47,7 +47,7 @@ (charset thai-tis620) (coding-system thai-tis620 iso-8859-11 cp874) (coding-priority thai-tis620) - (nonascii-translation . iso-8859-11) + (nonascii-translation . tis620-2533) (input-method . "thai-kesmanee") (unibyte-display . thai-tis620) (features thai-util) diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el index bdba32c806..a8a41c453a 100644 --- a/lisp/w32-fns.el +++ b/lisp/w32-fns.el @@ -279,7 +279,7 @@ bit output with no translation." (w32-add-charset-info "iso8859-9" 'w32-charset-turkish 1254) (w32-add-charset-info "iso8859-13" 'w32-charset-baltic 1257) (w32-add-charset-info "koi8-r" 'w32-charset-russian 20866) - (w32-add-charset-info "iso8859-5" 'w32-charset-russian 28595) + (w32-add-charset-info "tis620-2533" 'w32-charset-russian 28595) (w32-add-charset-info "iso8859-11" 'w32-charset-thai 874) (w32-add-charset-info "windows-1258" 'w32-charset-vietnamese 1258) (w32-add-charset-info "ksc5601.1992" 'w32-charset-johab 1361) commit a0d00f17dd714dbb712f6df90ca43cf39355d8a1 Author: Michael Albinus Date: Sat Aug 11 09:51:27 2018 +0200 Editorial changes in tramp.texi * doc/misc/tramp.texi (Bug Reports): Tramp buffers shall be appended as attachments to bug reports. (Frequently Asked Questions): New item, determining remote buffers. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 55c21b7efc..ca402013c7 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -3290,7 +3290,9 @@ When including @value{tramp}'s messages in the bug report, increase the verbosity level to 6 (@pxref{Traces and Profiles, Traces}) in the @file{~/.emacs} file before repeating steps to the bug. Include the contents of the @file{*tramp/foo*} and @file{*debug tramp/foo*} -buffers with the bug report. +buffers with the bug report. Both buffers could contain +non-@acronym{ASCII} characters which are relevant for analysis, append +the buffers as attachments to the bug report. @strong{Note} that a verbosity level greater than 6 is not necessary at this stage. Also note that a verbosity level of 6 or greater, the @@ -4021,6 +4023,15 @@ export EDITOR=/path/to/emacsclient.sh @end example +@item +How to determine wheter a buffer is remote? + +The buffer-local variable @code{default-directory} tells this. If the +form @code{(file-remote-p default-directory)} returns non-@code{nil}, +the buffer is remote. See the optional arguments of +@code{file-remote-p} for determining details of the remote connection. + + @item How to disable other packages from calling @value{tramp}? commit 31263d67d591cf2c074fad4f17b968b87c88b5e2 Author: Nikolaus Rath Date: Mon Jul 23 10:21:46 2018 +0100 Make nnimap support IMAP namespaces * lisp/gnus/nnimap.el (nnimap-use-namespaces): Introduce new server variable. (nnimap-group-to-imap, nnimap-get-groups): Transform IMAP group names to Gnus group name by stripping / prefixing personal namespace prefix. (nnimap-open-connection-1): Ask server for namespaces and store them. * lisp/gnus/nnimap.el (nnimap-request-group-scan) (nnimap-request-create-group, nnimap-request-delete-group) (nnimap-request-rename-group, nnimap-request-move-article) (nnimap-process-expiry-targets) (nnimap-request-update-group-status) (nnimap-request-accept-article, nnimap-request-list) (nnimap-retrieve-group-data-early, nnimap-change-group) (nnimap-split-incoming-mail): Use nnimap-group-to-imap. (nnimap-group-to-imap): New function to map Gnus group names to IMAP folder names. (Bug#21057) diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 6793ed2e9f..6ccb9e55f3 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -14320,6 +14320,12 @@ fetch all textual parts, while leaving the rest on the server. If non-@code{nil}, record all @acronym{IMAP} commands in the @samp{"*imap log*"} buffer. +@item nnimap-use-namespaces +If non-@code{nil}, omit the IMAP namespace prefix in nnimap group +names. If your IMAP mailboxes are called something like @samp{INBOX} +and @samp{INBOX.Lists.emacs}, but you'd like the nnimap group names to +be @samp{INBOX} and @samp{Lists.emacs}, you should enable this option. + @end table diff --git a/etc/NEWS b/etc/NEWS index 21887f5bfd..0b1e6499f4 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -53,6 +53,13 @@ option --enable-check-lisp-object-type is therefore no longer as useful and so is no longer enabled by default in developer builds, to reduce differences between developer and production builds. +** Gnus + ++++ +*** The nnimap backend now has support for IMAP namespaces. +This feature can be enabled by setting the new 'nnimap-use-namespaces' +server variable to non-nil. + * Startup Changes in Emacs 27.1 diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 3b39731927..12892c516a 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -55,6 +55,13 @@ If nnimap-stream is `ssl', this will default to `imaps'. If not, it will default to `imap'.") +(defvoo nnimap-use-namespaces nil + "Whether to use IMAP namespaces. +If in Gnus your folder names in all start with (e.g.) `INBOX', +you probably want to set this to t. The effects of this are +purely cosmetic, but changing this variable will affect the +names of your nnimap groups. ") + (defvoo nnimap-stream 'undecided "How nnimap talks to the IMAP server. The value should be either `undecided', `ssl' or `tls', @@ -110,6 +117,8 @@ some servers.") (defvoo nnimap-current-infos nil) +(defvoo nnimap-namespace nil) + (defun nnimap-decode-gnus-group (group) (decode-coding-string group 'utf-8)) @@ -166,6 +175,19 @@ textual parts.") (defvar nnimap-inhibit-logging nil) +(defun nnimap-group-to-imap (group) + "Convert Gnus group name to IMAP mailbox name." + (let* ((inbox (if nnimap-namespace + (substring nnimap-namespace 0 -1) nil))) + (utf7-encode + (cond ((or (not inbox) + (string-equal group inbox)) + group) + ((string-prefix-p "#" group) + (substring group 1)) + (t + (concat nnimap-namespace group))) t))) + (defun nnimap-buffer () (nnimap-find-process-buffer nntp-server-buffer)) @@ -442,7 +464,8 @@ textual parts.") (props (cdr stream-list)) (greeting (plist-get props :greeting)) (capabilities (plist-get props :capabilities)) - (stream-type (plist-get props :type))) + (stream-type (plist-get props :type)) + (server (nnoo-current-server 'nnimap))) (when (and stream (not (memq (process-status stream) '(open run)))) (setq stream nil)) @@ -475,9 +498,7 @@ textual parts.") ;; the virtual server name and the address (nnimap-credentials (gnus-delete-duplicates - (list - (nnoo-current-server 'nnimap) - nnimap-address)) + (list server nnimap-address)) ports nnimap-user)))) (setq nnimap-object nil) @@ -496,8 +517,17 @@ textual parts.") (dolist (response (cddr (nnimap-command "CAPABILITY"))) (when (string= "CAPABILITY" (upcase (car response))) (setf (nnimap-capabilities nnimap-object) - (mapcar #'upcase (cdr response)))))) - ;; If the login failed, then forget the credentials + (mapcar #'upcase (cdr response))))) + (when (and nnimap-use-namespaces + (nnimap-capability "NAMESPACE")) + (erase-buffer) + (nnimap-wait-for-response (nnimap-send-command "NAMESPACE")) + (let ((response (nnimap-last-response-string))) + (when (string-match + "^\\*\\W+NAMESPACE\\W+((\"\\([^\"\n]+\\)\"\\W+\"\\(.\\)\"))\\W+" + response) + (setq nnimap-namespace (match-string 1 response)))))) + ;; If the login failed, then forget the credentials ;; that are now possibly cached. (dolist (host (list (nnoo-current-server 'nnimap) nnimap-address)) @@ -837,7 +867,7 @@ textual parts.") (with-current-buffer (nnimap-buffer) (erase-buffer) (let ((group-sequence - (nnimap-send-command "SELECT %S" (utf7-encode group t))) + (nnimap-send-command "SELECT %S" (nnimap-group-to-imap group))) (flag-sequence (nnimap-send-command "UID FETCH 1:* FLAGS"))) (setf (nnimap-group nnimap-object) group) @@ -870,13 +900,13 @@ textual parts.") (setq group (nnimap-decode-gnus-group group)) (when (nnimap-change-group nil server) (with-current-buffer (nnimap-buffer) - (car (nnimap-command "CREATE %S" (utf7-encode group t)))))) + (car (nnimap-command "CREATE %S" (nnimap-group-to-imap group)))))) (deffoo nnimap-request-delete-group (group &optional _force server) (setq group (nnimap-decode-gnus-group group)) (when (nnimap-change-group nil server) (with-current-buffer (nnimap-buffer) - (car (nnimap-command "DELETE %S" (utf7-encode group t)))))) + (car (nnimap-command "DELETE %S" (nnimap-group-to-imap group)))))) (deffoo nnimap-request-rename-group (group new-name &optional server) (setq group (nnimap-decode-gnus-group group)) @@ -884,7 +914,7 @@ textual parts.") (with-current-buffer (nnimap-buffer) (nnimap-unselect-group) (car (nnimap-command "RENAME %S %S" - (utf7-encode group t) (utf7-encode new-name t)))))) + (nnimap-group-to-imap group) (nnimap-group-to-imap new-name)))))) (defun nnimap-unselect-group () ;; Make sure we don't have this group open read/write by asking @@ -944,7 +974,7 @@ textual parts.") "UID COPY %d %S")) (result (nnimap-command command article - (utf7-encode internal-move-group t)))) + (nnimap-group-to-imap internal-move-group)))) (when (and (car result) (not can-move)) (nnimap-delete-article article)) (cons internal-move-group @@ -1011,7 +1041,7 @@ textual parts.") "UID MOVE %s %S" "UID COPY %s %S") (nnimap-article-ranges (gnus-compress-sequence articles)) - (utf7-encode (gnus-group-real-name nnmail-expiry-target) t)) + (nnimap-group-to-imap (gnus-group-real-name nnmail-expiry-target))) (set (if can-move 'deleted-articles 'articles-to-delete) articles)))) t) (t @@ -1136,7 +1166,7 @@ If LIMIT, first try to limit the search to the N last articles." (unsubscribe "UNSUBSCRIBE"))))) (when command (with-current-buffer (nnimap-buffer) - (nnimap-command "%s %S" (cadr command) (utf7-encode group t))))))) + (nnimap-command "%s %S" (cadr command) (nnimap-group-to-imap group))))))) (deffoo nnimap-request-set-mark (group actions &optional server) (setq group (nnimap-decode-gnus-group group)) @@ -1191,7 +1221,7 @@ If LIMIT, first try to limit the search to the N last articles." (nnimap-unselect-group)) (erase-buffer) (setq sequence (nnimap-send-command - "APPEND %S {%d}" (utf7-encode group t) + "APPEND %S {%d}" (nnimap-group-to-imap group) (length message))) (unless nnimap-streaming (nnimap-wait-for-connection "^[+]")) @@ -1271,8 +1301,12 @@ If LIMIT, first try to limit the search to the N last articles." (defun nnimap-get-groups () (erase-buffer) - (let ((sequence (nnimap-send-command "LIST \"\" \"*\"")) - groups) + (let* ((sequence (nnimap-send-command "LIST \"\" \"*\"")) + (prefix nnimap-namespace) + (prefix-len (if prefix (length prefix) nil)) + (inbox (if prefix + (substring prefix 0 -1) nil)) + groups) (nnimap-wait-for-response sequence) (subst-char-in-region (point-min) (point-max) ?\\ ?% t) @@ -1289,11 +1323,16 @@ If LIMIT, first try to limit the search to the N last articles." (skip-chars-backward " \r\"") (point))))) (unless (member '%NoSelect flags) - (push (utf7-decode (if (stringp group) - group - (format "%s" group)) - t) - groups)))) + (let* ((group (utf7-decode (if (stringp group) group + (format "%s" group)) t)) + (group (cond ((or (not prefix) + (equal inbox group)) + group) + ((string-prefix-p prefix group) + (substring group prefix-len)) + (t + (concat "#" group))))) + (push group groups))))) (nreverse groups))) (defun nnimap-get-responses (sequences) @@ -1319,7 +1358,7 @@ If LIMIT, first try to limit the search to the N last articles." (dolist (group groups) (setf (nnimap-examined nnimap-object) group) (push (list (nnimap-send-command "EXAMINE %S" - (utf7-encode group t)) + (nnimap-group-to-imap group)) group) sequences)) (nnimap-wait-for-response (caar sequences)) @@ -1391,7 +1430,7 @@ If LIMIT, first try to limit the search to the N last articles." unexist) (push (list (nnimap-send-command "EXAMINE %S (%s (%s %s))" - (utf7-encode group t) + (nnimap-group-to-imap group) (nnimap-quirk "QRESYNC") uidvalidity modseq) 'qresync @@ -1413,7 +1452,7 @@ If LIMIT, first try to limit the search to the N last articles." (cl-incf (nnimap-initial-resync nnimap-object)) (setq start 1)) (push (list (nnimap-send-command "%s %S" command - (utf7-encode group t)) + (nnimap-group-to-imap group)) (nnimap-send-command "UID FETCH %d:* FLAGS" start) start group command) sequences)))) @@ -1847,7 +1886,7 @@ Return the server's response to the SELECT or EXAMINE command." (if read-only "EXAMINE" "SELECT") - (utf7-encode group t)))) + (nnimap-group-to-imap group)))) (when (car result) (setf (nnimap-group nnimap-object) group (nnimap-select-result nnimap-object) result) @@ -2105,7 +2144,7 @@ Return the server's response to the SELECT or EXAMINE command." (dolist (spec specs) (when (and (not (member (car spec) groups)) (not (eq (car spec) 'junk))) - (nnimap-command "CREATE %S" (utf7-encode (car spec) t)))) + (nnimap-command "CREATE %S" (nnimap-group-to-imap (car spec))))) ;; Then copy over all the messages. (erase-buffer) (dolist (spec specs) @@ -2121,7 +2160,7 @@ Return the server's response to the SELECT or EXAMINE command." "UID MOVE %s %S" "UID COPY %s %S") (nnimap-article-ranges ranges) - (utf7-encode group t)) + (nnimap-group-to-imap group)) ranges) sequences))))) ;; Wait for the last COPY response... commit 3f8324e0de182945a809f63766cf9611aa45610c Author: Eli Zaretskii Date: Sat Aug 11 10:34:10 2018 +0300 Improve error message when Hunspell dictionaries are misconfigured * lisp/textmodes/ispell.el (ispell-find-hunspell-dictionaries): Produce a meaningful error message if Hunspell dictionaries are misconfigured. (Bug#32319) diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index e6f436fa1a..87bcb5d651 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -1173,6 +1173,12 @@ dictionary from that list was found." ;; Parse and set values for default dictionary. (setq hunspell-default-dict (or hunspell-multi-dict (car hunspell-default-dict))) + ;; If hunspell-default-dict is nil, ispell-parse-hunspell-affix-file + ;; will barf with an error message that doesn't help users figure + ;; out what is wrong. Produce an error message that points to the + ;; root cause of the problem. + (or hunspell-default-dict + (error "Can't find Hunspell dictionary with a .aff affix file")) (setq hunspell-default-dict-entry (ispell-parse-hunspell-affix-file hunspell-default-dict)) ;; Create an alist of found dicts with only names, except for default dict. commit 110a7d1a6efd1a5046737b6179d99bdf193ccbfc Merge: bd6b6cdb62 5e42c349a0 Author: Glenn Morris Date: Fri Aug 10 11:37:11 2018 -0700 ; Merge from origin/emacs-26 The following commit was skipped: 5e42c34 (origin/emacs-26) Fix bugs in `auth-source-netrc-parse-one'. commit bd6b6cdb62aac5be34a8bb367f43d8367fc341f8 Merge: 506ea8a2f7 71c92d8913 Author: Glenn Morris Date: Fri Aug 10 11:37:11 2018 -0700 Merge from origin/emacs-26 71c92d8 Fix copying text properties by 'format' 96be6b6 Improve error messages regarding initial-buffer-choice (Bug#2... 00fb127 * test/lisp/wdired-tests.el (wdired-test-unfinished-edit-01):... Conflicts: lisp/startup.el commit 506ea8a2f70d8c9d53a34ea9469d3edbe6655f0c Merge: caa4d9c4e7 18588bce36 Author: Glenn Morris Date: Fri Aug 10 11:28:40 2018 -0700 ; Merge from origin/emacs-26 The following commit was skipped: 18588bc Make async :family 'local failures fail correctly again commit caa4d9c4e7205cc62a9f414903e965494a703763 Merge: 243b68f73f 5afbf62674 Author: Glenn Morris Date: Fri Aug 10 11:28:40 2018 -0700 Merge from origin/emacs-26 5afbf62 Fix emacsclient check for term.el buffer (Bug#21041) 5132a58 Improve documentation of 'set-fontset-font' cd90325 Improve documentation of M-? 155a885 Reinterpret Esperanto characters in iso-transl as iso-8859-3. a0ef733 Fix Flyspell mode when several languages are mixed in a buffer commit 5e42c349a0533602c23bf651d6b28eca25e95a46 Author: Filipp Gunbin Date: Tue May 15 03:02:49 2018 +0300 Fix bugs in `auth-source-netrc-parse-one'. * lisp/auth-source.el (auth-source-netrc-parse-one): Ensure that match data is not overwritten in `auth-source-netrc-parse-next-interesting'. Ensure that blanks are skipped before and after going over comments and eols. * test/lisp/auth-source-tests.el (auth-source-test-netrc-parse-one): New test. (cherry picked from commit 60ff8101449eea3a5ca4961299501efd83d011bd) diff --git a/lisp/auth-source.el b/lisp/auth-source.el index 374b7f1e86..afb35c8f04 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -984,12 +984,13 @@ Note that the MAX parameter is used so we can exit the parse early." (defun auth-source-netrc-parse-next-interesting () "Advance to the next interesting position in the current buffer." + (skip-chars-forward "\t ") ;; If we're looking at a comment or are at the end of the line, move forward - (while (or (looking-at "#") + (while (or (eq (char-after) ?#) (and (eolp) (not (eobp)))) - (forward-line 1)) - (skip-chars-forward "\t ")) + (forward-line 1) + (skip-chars-forward "\t "))) (defun auth-source-netrc-parse-one () "Read one thing from the current buffer." @@ -999,8 +1000,9 @@ Note that the MAX parameter is used so we can exit the parse early." (looking-at "\"\\([^\"]*\\)\"") (looking-at "\\([^ \t\n]+\\)")) (forward-char (length (match-string 0))) - (auth-source-netrc-parse-next-interesting) - (match-string-no-properties 1))) + (prog1 + (match-string-no-properties 1) + (auth-source-netrc-parse-next-interesting)))) ;; with thanks to org-mode (defsubst auth-source-current-line (&optional pos) diff --git a/test/lisp/auth-source-tests.el b/test/lisp/auth-source-tests.el index c1ee909374..90caac8e4a 100644 --- a/test/lisp/auth-source-tests.el +++ b/test/lisp/auth-source-tests.el @@ -210,6 +210,25 @@ ("login" . "user1") ("machine" . "mymachine1")))))) +(ert-deftest auth-source-test-netrc-parse-one () + (should (equal (auth-source--test-netrc-parse-one--all + "machine host1\n# comment\n") + '("machine" "host1"))) + (should (equal (auth-source--test-netrc-parse-one--all + "machine host1\n \n \nmachine host2\n") + '("machine" "host1" "machine" "host2")))) + +(defun auth-source--test-netrc-parse-one--all (text) + "Parse TEXT with `auth-source-netrc-parse-one' until end,return list." + (with-temp-buffer + (insert text) + (goto-char (point-min)) + (let ((one (auth-source-netrc-parse-one)) all) + (while one + (push one all) + (setq one (auth-source-netrc-parse-one))) + (nreverse all)))) + (ert-deftest auth-source-test-format-prompt () (should (equal (auth-source-format-prompt "test %u %h %p" '((?u "user") (?h "host"))) "test user host %p"))) commit 243b68f73ff7cbb4d89a3f4a15a1cd38cfc14fae Author: Michael Albinus Date: Fri Aug 10 13:34:10 2018 +0200 ; More instrumentation for shadowfile-tests.el and files.el * test/lisp/shadowfile-tests.el (shadow-test06-literal-groups) (shadow-test07-regexp-groups, shadow-test08-shadow-todo) (shadow-test09-shadow-copy-files): Use `set-visited-file-name' instead of setting the value in `buffer-file-name' directly. (Bug#32226) diff --git a/lisp/files.el b/lisp/files.el index 7f193a78b3..dac2ef75dc 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5091,13 +5091,16 @@ Before and after saving the buffer, this function runs ;; Otherwise, write it the usual way now. (let ((dir (file-name-directory (expand-file-name buffer-file-name)))) + (if (getenv "BUG_32226") (message "BUG_32226 %s" dir)) (unless (file-exists-p dir) (if (y-or-n-p (format-message "Directory `%s' does not exist; create? " dir)) (make-directory dir t) (error "Canceled"))) + (if (getenv "BUG_32226") (message "BUG_32226 %s" dir)) (setq setmodes (basic-save-buffer-1))))) + (if (getenv "BUG_32226") (message "BUG_32226")) ;; Now we have saved the current buffer. Let's make sure ;; that buffer-file-coding-system is fixed to what ;; actually used for saving by binding it locally. diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el index c549ad79a4..f93845da61 100644 --- a/test/lisp/shadowfile-tests.el +++ b/test/lisp/shadowfile-tests.el @@ -724,6 +724,9 @@ guaranteed by the originator of a cluster definition." (dolist (elt (all-completions "shadow-" obarray 'functionp)) (trace-function-background (intern elt))) (trace-function-background 'save-buffer) + (trace-function-background 'basic-save-buffer) + (trace-function-background 'basic-save-buffer-1) + (trace-function-background 'basic-save-buffer-2) (dolist (elt write-file-functions) (trace-function-background elt)) ;; Cleanup. commit 7fbf1247964cbfbbda207e34bfcd5c1863608e74 Author: Michael Albinus Date: Fri Aug 10 10:58:00 2018 +0200 Another try to fix Bug#32226 * test/lisp/shadowfile-tests.el (shadow-test06-literal-groups) (shadow-test07-regexp-groups, shadow-test08-shadow-todo) (shadow-test09-shadow-copy-files): Use `set-visited-file-name' instead of setting the value in `buffer-file-name' directly. (Bug#32226) diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el index 22f7b2de6e..c549ad79a4 100644 --- a/test/lisp/shadowfile-tests.el +++ b/test/lisp/shadowfile-tests.el @@ -618,7 +618,7 @@ guaranteed by the originator of a cluster definition." shadow-test-remote-temporary-file-directory)) mocked-input `(,cluster1 ,file1 ,cluster2 ,file2 ,(kbd "RET"))) (with-temp-buffer - (setq-local buffer-file-name file1) + (set-visited-file-name file1) (call-interactively 'shadow-define-literal-group)) ;; `shadow-literal-groups' is a list of lists. @@ -679,7 +679,7 @@ guaranteed by the originator of a cluster definition." mocked-input `(,(shadow-regexp-superquote file) ,cluster1 ,cluster2 ,(kbd "RET"))) (with-temp-buffer - (setq-local buffer-file-name nil) + (set-visited-file-name nil) (call-interactively 'shadow-define-regexp-group)) ;; `shadow-regexp-groups' is a list of lists. @@ -756,7 +756,7 @@ guaranteed by the originator of a cluster definition." (message "Point 3") ;; Save file from "cluster1" definition. (with-temp-buffer - (setq buffer-file-name file) + (set-visited-file-name file) (insert "foo") (save-buffer)) (message "%s" file) @@ -773,7 +773,7 @@ guaranteed by the originator of a cluster definition." (message "Point 4.1") (message "%s" file) (message "%s" (shadow-site-primary cluster2)) - (setq buffer-file-name (concat (shadow-site-primary cluster2) file)) + (set-visited-file-name (concat (shadow-site-primary cluster2) file)) (message "Point 4.2") (insert "foo") (message "%s" buffer-file-name) @@ -804,7 +804,7 @@ guaranteed by the originator of a cluster definition." (message "Point 6") ;; Save file from "cluster1" definition. (with-temp-buffer - (setq buffer-file-name file) + (set-visited-file-name file) (insert "foo") (save-buffer)) (should @@ -815,7 +815,7 @@ guaranteed by the originator of a cluster definition." (message "Point 7") ;; Save file from "cluster2" definition. (with-temp-buffer - (setq buffer-file-name (concat (shadow-site-primary cluster2) file)) + (set-visited-file-name (concat (shadow-site-primary cluster2) file)) (insert "foo") (save-buffer)) (should @@ -892,11 +892,11 @@ guaranteed by the originator of a cluster definition." ;; Save files. (with-temp-buffer - (setq buffer-file-name file) + (set-visited-file-name file) (insert "foo") (save-buffer)) (with-temp-buffer - (setq buffer-file-name (concat (shadow-site-primary cluster2) file)) + (set-visited-file-name (concat (shadow-site-primary cluster2) file)) (insert "foo") (save-buffer)) commit 9905c927b0c3bea0ae6142b10c83841f077cab67 Author: Michael Albinus Date: Fri Aug 10 09:53:37 2018 +0200 ; More instrumentation for files.el diff --git a/lisp/files.el b/lisp/files.el index 940bacde23..7f193a78b3 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5078,8 +5078,15 @@ Before and after saving the buffer, this function runs (set-visited-file-name filename))) ;; Support VC version backups. (vc-before-save) + ;; We are hunting a nasty error, which happens on hydra. + ;; Adding traces might help. + (if (getenv "BUG_32226") (message "BUG_32226")) (or (run-hook-with-args-until-success 'local-write-file-hooks) (run-hook-with-args-until-success 'write-file-functions) + (progn + (if (getenv "BUG_32226") + (message "BUG_32226 %s" buffer-file-name)) + nil) ;; If a hook returned t, file is already "written". ;; Otherwise, write it the usual way now. (let ((dir (file-name-directory @@ -5091,9 +5098,6 @@ Before and after saving the buffer, this function runs (make-directory dir t) (error "Canceled"))) (setq setmodes (basic-save-buffer-1))))) - ;; We are hunting a nasty error, which happens on hydra. - ;; Adding traces might help. - (if (getenv "BUG_32226") (message "BUG_32226")) ;; Now we have saved the current buffer. Let's make sure ;; that buffer-file-coding-system is fixed to what ;; actually used for saving by binding it locally. commit 9bb52a8e8fa9cd7ce65945373e694041f192ded8 Author: JoĂŁo Távora Date: Fri Aug 10 01:15:25 2018 +0100 Allow completely disabling event logging in jsonrpc.el Pretty printing the event sexp can be very slow when very big messages are involved. * lisp/jsonrpc.el (Version): Bump to 1.0.3 (jsonrpc-connection): Tweak docstring for jsonrpc--event-buffer-scrollback-size. (jsonrpc--log-event): Only log if max size is positive. diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index a137616eca..f3e0982139 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -6,7 +6,7 @@ ;; Maintainer: JoĂŁo Távora ;; Keywords: processes, languages, extensions ;; Package-Requires: ((emacs "25.2")) -;; Version: 1.0.2 +;; Version: 1.0.3 ;; This is an Elpa :core package. Don't use functionality that is not ;; compatible with Emacs 25.2. @@ -78,7 +78,7 @@ (-events-buffer-scrollback-size :initarg :events-buffer-scrollback-size :accessor jsonrpc--events-buffer-scrollback-size - :documentation "If non-nil, maximum size of events buffer.") + :documentation "Max size of events buffer. 0 disables, nil means infinite.") (-deferred-actions :initform (make-hash-table :test #'equal) :accessor jsonrpc--deferred-actions @@ -652,38 +652,39 @@ TIMEOUT is nil)." CONNECTION is the current connection. MESSAGE is a JSON-like plist. TYPE is a symbol saying if this is a client or server originated." - (with-current-buffer (jsonrpc-events-buffer connection) - (cl-destructuring-bind (&key method id error &allow-other-keys) message - (let* ((inhibit-read-only t) - (subtype (cond ((and method id) 'request) - (method 'notification) - (id 'reply) - (t 'message))) - (type - (concat (format "%s" (or type 'internal)) - (if type - (format "-%s" subtype))))) - (goto-char (point-max)) - (prog1 - (let ((msg (format "%s%s%s %s:\n%s\n" - type - (if id (format " (id:%s)" id) "") - (if error " ERROR" "") - (current-time-string) - (pp-to-string message)))) - (when error - (setq msg (propertize msg 'face 'error))) - (insert-before-markers msg)) - ;; Trim the buffer if it's too large - (let ((max (jsonrpc--events-buffer-scrollback-size connection))) - (when max - (save-excursion - (goto-char (point-min)) - (while (> (buffer-size) max) - (delete-region (point) (progn (forward-line 1) - (forward-sexp 1) - (forward-line 2) - (point)))))))))))) + (let ((max (jsonrpc--events-buffer-scrollback-size connection))) + (when (or (null max) (cl-plusp max)) + (with-current-buffer (jsonrpc-events-buffer connection) + (cl-destructuring-bind (&key method id error &allow-other-keys) message + (let* ((inhibit-read-only t) + (subtype (cond ((and method id) 'request) + (method 'notification) + (id 'reply) + (t 'message))) + (type + (concat (format "%s" (or type 'internal)) + (if type + (format "-%s" subtype))))) + (goto-char (point-max)) + (prog1 + (let ((msg (format "%s%s%s %s:\n%s\n" + type + (if id (format " (id:%s)" id) "") + (if error " ERROR" "") + (current-time-string) + (pp-to-string message)))) + (when error + (setq msg (propertize msg 'face 'error))) + (insert-before-markers msg)) + ;; Trim the buffer if it's too large + (when max + (save-excursion + (goto-char (point-min)) + (while (> (buffer-size) max) + (delete-region (point) (progn (forward-line 1) + (forward-sexp 1) + (forward-line 2) + (point))))))))))))) (provide 'jsonrpc) ;;; jsonrpc.el ends here commit 79f59d41a3d2ef3b4a9a87265bf517206a5837ad Author: Tom Tromey Date: Thu Aug 9 18:02:00 2018 -0600 Fix up for bignums after merge from trunk * src/character.c (char_width): Use XFIXNUM. * src/editfns.c (styled_format): Use XFIXNUM, XUFIXNUM. * src/fns.c (Fproper_list_p): Use make_fixnum. diff --git a/src/character.c b/src/character.c index 851e61e778..0b14e476c1 100644 --- a/src/character.c +++ b/src/character.c @@ -294,7 +294,7 @@ char_width (int c, struct Lisp_Char_Table *dp) if (GLYPH_CODE_P (ch)) c = GLYPH_CODE_CHAR (ch); else if (CHARACTERP (ch)) - c = XFASTINT (ch); + c = XFIXNUM (ch); if (c >= 0) { int w = CHARACTER_WIDTH (c); diff --git a/src/editfns.c b/src/editfns.c index b1b9eb632f..a109906e1d 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -4749,12 +4749,12 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) { if (binary_as_unsigned) { - x = XUINT (arg); + x = XUFIXNUM (arg); negative = false; } else { - EMACS_INT i = XINT (arg); + EMACS_INT i = XFIXNUM (arg); negative = i < 0; x = negative ? -i : i; } diff --git a/src/fns.c b/src/fns.c index 38b2d281f0..825880643a 100644 --- a/src/fns.c +++ b/src/fns.c @@ -163,7 +163,7 @@ A proper list is neither circular nor dotted (i.e., its last cdr is nil). */ return Qnil; if (MOST_POSITIVE_FIXNUM < len) xsignal0 (Qoverflow_error); - return make_number (len); + return make_fixnum (len); } DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0, commit accb7b7ecc19f85c2750ded1046a464bc73c6a52 Merge: f822a2516d 53483df0de Author: Tom Tromey Date: Thu Aug 9 17:56:53 2018 -0600 Merge remote-tracking branch 'origin/master' into feature/bignum commit f822a2516d88eeb2118fbbc8554f155e86dfd74e (refs/remotes/origin/feature/bignum) Author: Tom Tromey Date: Thu Aug 9 13:21:45 2018 -0600 Use mpz_sgn rather than comparisons against 0 * src/data.c (Fmod): Use mpz_sgn. * src/lisp.h (NATNUMP): Use mpz_sgn. diff --git a/src/data.c b/src/data.c index 6512e7e670..7d701fde0e 100644 --- a/src/data.c +++ b/src/data.c @@ -3251,8 +3251,8 @@ Both X and Y must be numbers or markers. */) mpz_mod (result, *xmp, *ymp); /* Fix the sign if needed. */ - cmpr = mpz_cmp_si (result, 0); - cmpy = mpz_cmp_si (*ymp, 0); + cmpr = mpz_sgn (result); + cmpy = mpz_sgn (*ymp); if (cmpy < 0 ? cmpr > 0 : cmpr < 0) mpz_add (result, result, *ymp); diff --git a/src/lisp.h b/src/lisp.h index 9047d21724..6726d69fce 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2772,7 +2772,7 @@ INLINE bool NATNUMP (Lisp_Object x) { if (BIGNUMP (x)) - return mpz_cmp_si (XBIGNUM (x)->value, 0) >= 0; + return mpz_sgn (XBIGNUM (x)->value) >= 0; return FIXNUMP (x) && 0 <= XFIXNUM (x); } INLINE bool commit f966753727741883c5d81a288ce5c20cebe3bad0 Author: Andy Moreton Date: Thu Aug 9 13:19:15 2018 -0600 Do not use GMP_NUMB_BITS * src/alloc.c (make_number): Use mp_bits_per_limb, not GMP_NUMB_BITS. diff --git a/src/alloc.c b/src/alloc.c index 1504d7912b..a8bc55beb4 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3830,7 +3830,7 @@ make_number (mpz_t value) for (i = 0; i < limbs; i++) { mp_limb_t limb = mpz_getlimbn (value, i); - v |= (EMACS_INT) ((EMACS_UINT) limb << (i * GMP_NUMB_BITS)); + v |= (EMACS_INT) ((EMACS_UINT) limb << (i * mp_bits_per_limb)); } if (sign < 0) v = -v; commit 71c92d89137b7fdde6c2bd4bed9b8dfda5fa53dd Author: Eli Zaretskii Date: Thu Aug 9 18:08:35 2018 +0300 Fix copying text properties by 'format' * src/editfns.c (styled_format): Add the spec beginning index to the info recorded for each format spec, and use it to detect the case that a format spec and its text property end where the next spec with another property begins. (Bug#32404) * test/src/editfns-tests.el (format-properties): Add tests for bug#32404. diff --git a/src/editfns.c b/src/editfns.c index a8acff659c..081ea0b3b7 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -4257,6 +4257,9 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) /* The start and end bytepos in the output string. */ ptrdiff_t start, end; + /* The start of the spec in the format string. */ + ptrdiff_t fbeg; + /* Whether the argument is a string with intervals. */ bool_bf intervals : 1; } *info; @@ -4408,6 +4411,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) char conversion = *format++; memset (&discarded[format0 - format_start], 1, format - format0 - (conversion == '%')); + info[ispec].fbeg = format0 - format_start; if (conversion == '%') { new_result = true; @@ -4981,7 +4985,9 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) else if (discarded[bytepos] == 1) { position++; - if (fieldn < nspec && translated == info[fieldn].start) + if (fieldn < nspec + && position > info[fieldn].fbeg + && translated == info[fieldn].start) { translated += info[fieldn].end - info[fieldn].start; fieldn++; @@ -5001,7 +5007,9 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) else if (discarded[bytepos] == 1) { position++; - if (fieldn < nspec && translated == info[fieldn].start) + if (fieldn < nspec + && position > info[fieldn].fbeg + && translated == info[fieldn].start) { translated += info[fieldn].end - info[fieldn].start; fieldn++; diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index ec411ff773..c2ec99d803 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -88,7 +88,21 @@ (format "%-10s" (concat (propertize "01" 'face 'bold) (propertize "23" 'face 'underline) (propertize "45" 'face 'italic))) - #("012345 " 0 2 (face bold) 2 4 (face underline) 4 10 (face italic))))) + #("012345 " + 0 2 (face bold) 2 4 (face underline) 4 10 (face italic)))) + ;; Bug #32404 + (should (ert-equal-including-properties + (format (concat (propertize "%s" 'face 'bold) + "" + (propertize "%s" 'face 'error)) + "foo" "bar") + #("foobar" 0 3 (face bold) 3 6 (face error)))) + (should (ert-equal-including-properties + (format (concat "%s" (propertize "%s" 'face 'error)) "foo" "bar") + #("foobar" 3 6 (face error)))) + (should (ert-equal-including-properties + (format (concat "%s " (propertize "%s" 'face 'error)) "foo" "bar") + #("foo bar" 4 7 (face error))))) ;; Tests for bug#5131. (defun transpose-test-reverse-word (start end) commit d0b279a50518ce61277cfd274349da8fcc0b0609 Author: Charles A. Roelli Date: Thu Aug 9 16:00:20 2018 +0200 Update src/{ns,mac}*.m to use bignum-compatible macros * src/nsterm.m: * src/nsselect.m: * src/nsmenu.m: * src/nsimage.m: * src/nsfont.m: * src/nsfns.m: * src/macfont.m: Replace "make_number" -> "make_fixnum", "XINT" -> "XFIXNUM", "XFASTINT" -> "XFIXNAT", "TYPE_RANGED_INTEGERP" -> "TYPE_RANGED_FIXNUMP", "RANGED_INTEGERP" -> "RANGED_FIXNUMP", "CHECK_NATNUM" -> "CHECK_FIXNAT", "CHECK_NUMBER" -> "CHECK_FIXNUM", "INTEGERP" -> "FIXNUMP", "NUMBERP" -> "FIXED_OR_FLOATP", as done in the following changes: 2018-07-06 Rename integerp->fixnum, etc, in preparation for bignums (42fe787b) 2018-08-07 More macro renamings for bignum (d1ec3a0a) diff --git a/src/macfont.m b/src/macfont.m index e0c704fac9..c9a1edaec8 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -851,7 +851,7 @@ static void mac_font_get_glyphs_for_variants (CFDataRef, UTF32Char, * ((point->y - (point - 1)->y) / (point->x - (point - 1)->x))); FONT_SET_STYLE (spec_or_entity, numeric_traits[i].index, - make_number (lround (floatval))); + make_fixnum (lround (floatval))); } } @@ -864,16 +864,16 @@ static void mac_font_get_glyphs_for_variants (CFDataRef, UTF32Char, cfnumber_get_font_symbolic_traits_value (num, &sym_traits); spacing = (sym_traits & kCTFontTraitMonoSpace ? FONT_SPACING_MONO : FONT_SPACING_PROPORTIONAL); - ASET (spec_or_entity, FONT_SPACING_INDEX, make_number (spacing)); + ASET (spec_or_entity, FONT_SPACING_INDEX, make_fixnum (spacing)); } CFRelease (dict); } num = CTFontDescriptorCopyAttribute (desc, kCTFontSizeAttribute); if (num && CFNumberGetValue (num, kCFNumberCGFloatType, &floatval)) - ASET (spec_or_entity, FONT_SIZE_INDEX, make_number (floatval)); + ASET (spec_or_entity, FONT_SIZE_INDEX, make_fixnum (floatval)); else - ASET (spec_or_entity, FONT_SIZE_INDEX, make_number (0)); + ASET (spec_or_entity, FONT_SIZE_INDEX, make_fixnum (0)); if (num) CFRelease (num); } @@ -903,22 +903,22 @@ static void mac_font_get_glyphs_for_variants (CFDataRef, UTF32Char, cfnumber_get_font_symbolic_traits_value (num, &sym_traits); CFRelease (dict); } - if (EQ (AREF (entity, FONT_SIZE_INDEX), make_number (0))) - ASET (entity, FONT_AVGWIDTH_INDEX, make_number (0)); + if (EQ (AREF (entity, FONT_SIZE_INDEX), make_fixnum (0))) + ASET (entity, FONT_AVGWIDTH_INDEX, make_fixnum (0)); ASET (entity, FONT_EXTRA_INDEX, Fcopy_sequence (extra)); name = CTFontDescriptorCopyAttribute (desc, kCTFontNameAttribute); font_put_extra (entity, QCfont_entity, Fcons (make_mint_ptr ((void *) name), - make_number (sym_traits))); + make_fixnum (sym_traits))); if (synth_sym_traits & kCTFontTraitItalic) FONT_SET_STYLE (entity, FONT_SLANT_INDEX, - make_number (FONT_SLANT_SYNTHETIC_ITALIC)); + make_fixnum (FONT_SLANT_SYNTHETIC_ITALIC)); if (synth_sym_traits & kCTFontTraitBold) FONT_SET_STYLE (entity, FONT_WEIGHT_INDEX, - make_number (FONT_WEIGHT_SYNTHETIC_BOLD)); + make_fixnum (FONT_WEIGHT_SYNTHETIC_BOLD)); if (synth_sym_traits & kCTFontTraitMonoSpace) ASET (entity, FONT_SPACING_INDEX, - make_number (FONT_SPACING_SYNTHETIC_MONO)); + make_fixnum (FONT_SPACING_SYNTHETIC_MONO)); return entity; } @@ -1798,9 +1798,9 @@ static int macfont_variation_glyphs (struct font *, int c, continue; len = Flength (val); spec->features[i] = - (min (PTRDIFF_MAX, SIZE_MAX) / sizeof (int) < XINT (len) + (min (PTRDIFF_MAX, SIZE_MAX) / sizeof (int) < XFIXNUM (len) ? 0 - : malloc (XINT (len) * sizeof *spec->features[i])); + : malloc (XFIXNUM (len) * sizeof *spec->features[i])); if (! spec->features[i]) { if (i > 0 && spec->features[0]) @@ -1940,9 +1940,9 @@ static int macfont_variation_glyphs (struct font *, int c, { UniChar unichars[2]; CFIndex count = - macfont_store_utf32char_to_unichars (XFASTINT (XCAR (chars)), + macfont_store_utf32char_to_unichars (XFIXNAT (XCAR (chars)), unichars); - CFRange range = CFRangeMake (XFASTINT (XCAR (chars)), 1); + CFRange range = CFRangeMake (XFIXNAT (XCAR (chars)), 1); CFStringAppendCharacters (string, unichars, count); CFCharacterSetAddCharactersInRange (cs, range); @@ -1981,10 +1981,10 @@ static int macfont_variation_glyphs (struct font *, int c, for (i = 0; i < ARRAYELTS (numeric_traits); i++) { tmp = AREF (spec, numeric_traits[i].index); - if (INTEGERP (tmp)) + if (FIXNUMP (tmp)) { CGPoint *point = numeric_traits[i].points; - CGFloat floatval = (XINT (tmp) >> 8); // XXX + CGFloat floatval = (XFIXNUM (tmp) >> 8); // XXX CFNumberRef num; while (point->y < floatval) @@ -2069,9 +2069,9 @@ static int macfont_variation_glyphs (struct font *, int c, ptrdiff_t j; for (j = 0; j < ASIZE (chars); j++) - if (TYPE_RANGED_INTEGERP (UTF32Char, AREF (chars, j)) + if (TYPE_RANGED_FIXNUMP (UTF32Char, AREF (chars, j)) && CFCharacterSetIsLongCharacterMember (desc_charset, - XFASTINT (AREF (chars, j)))) + XFIXNAT (AREF (chars, j)))) break; if (j == ASIZE (chars)) result = false; @@ -2161,8 +2161,8 @@ static int macfont_variation_glyphs (struct font *, int c, languages = CFDictionaryGetValue (attributes, kCTFontLanguagesAttribute); - if (INTEGERP (AREF (spec, FONT_SPACING_INDEX))) - spacing = XINT (AREF (spec, FONT_SPACING_INDEX)); + if (FIXNUMP (AREF (spec, FONT_SPACING_INDEX))) + spacing = XFIXNUM (AREF (spec, FONT_SPACING_INDEX)); traits = ((CFMutableDictionaryRef) CFDictionaryGetValue (attributes, kCTFontTraitsAttribute)); @@ -2532,9 +2532,9 @@ So we use CTFontDescriptorCreateMatchingFontDescriptor (no || ! CONSP (XCDR (val))) return Qnil; font_name = xmint_pointer (XCAR (XCDR (val))); - sym_traits = XINT (XCDR (XCDR (val))); + sym_traits = XFIXNUM (XCDR (XCDR (val))); - size = XINT (AREF (entity, FONT_SIZE_INDEX)); + size = XFIXNUM (AREF (entity, FONT_SIZE_INDEX)); if (size == 0) size = pixel_size; @@ -2563,7 +2563,7 @@ So we use CTFontDescriptorCreateMatchingFontDescriptor (no macfont_info->cgfont = CTFontCopyGraphicsFont (macfont, NULL); val = assq_no_quit (QCdestination, AREF (entity, FONT_EXTRA_INDEX)); - if (CONSP (val) && EQ (XCDR (val), make_number (1))) + if (CONSP (val) && EQ (XCDR (val), make_fixnum (1))) macfont_info->screen_font = mac_screen_font_create_with_name (font_name, size); else @@ -2584,8 +2584,8 @@ So we use CTFontDescriptorCreateMatchingFontDescriptor (no macfont_info->synthetic_bold_p = 1; if (sym_traits & kCTFontTraitMonoSpace) macfont_info->spacing = MACFONT_SPACING_MONO; - else if (INTEGERP (AREF (entity, FONT_SPACING_INDEX)) - && (XINT (AREF (entity, FONT_SPACING_INDEX)) + else if (FIXNUMP (AREF (entity, FONT_SPACING_INDEX)) + && (XFIXNUM (AREF (entity, FONT_SPACING_INDEX)) == FONT_SPACING_SYNTHETIC_MONO)) macfont_info->spacing = MACFONT_SPACING_SYNTHETIC_MONO; if (macfont_info->synthetic_italic_p || macfont_info->synthetic_bold_p) @@ -2992,7 +2992,7 @@ So we use CTFontDescriptorCreateMatchingFontDescriptor (no if (NILP (lglyph)) { - lglyph = Fmake_vector (make_number (LGLYPH_SIZE), Qnil); + lglyph = Fmake_vector (make_fixnum (LGLYPH_SIZE), Qnil); LGSTRING_SET_GLYPH (lgstring, i, lglyph); } @@ -3046,17 +3046,17 @@ So we use CTFontDescriptorCreateMatchingFontDescriptor (no { Lisp_Object vec; - vec = Fmake_vector (make_number (3), Qnil); - ASET (vec, 0, make_number (xoff)); - ASET (vec, 1, make_number (yoff)); - ASET (vec, 2, make_number (wadjust)); + vec = Fmake_vector (make_fixnum (3), Qnil); + ASET (vec, 0, make_fixnum (xoff)); + ASET (vec, 1, make_fixnum (yoff)); + ASET (vec, 2, make_fixnum (wadjust)); LGLYPH_SET_ADJUSTMENT (lglyph, vec); } } unblock_input (); - return make_number (used); + return make_fixnum (used); } /* Structures for the UVS subtable (format 14) in the cmap table. */ diff --git a/src/nsfns.m b/src/nsfns.m index 9ff7e88a8d..527dd77dc2 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -209,7 +209,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side. if (keys && [keys length] ) { key = [keys characterAtIndex: 0]; - res = make_number (key|super_modifier); + res = make_fixnum (key|super_modifier); } else { @@ -589,8 +589,8 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side. if (FRAME_MINIBUF_ONLY_P (f)) return; - if (TYPE_RANGED_INTEGERP (int, value)) - nlines = XINT (value); + if (TYPE_RANGED_FIXNUMP (int, value)) + nlines = XFIXNUM (value); else nlines = 0; @@ -627,8 +627,8 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side. if (FRAME_MINIBUF_ONLY_P (f)) return; - if (RANGED_INTEGERP (0, value, INT_MAX)) - nlines = XFASTINT (value); + if (RANGED_FIXNUMP (0, value, INT_MAX)) + nlines = XFIXNAT (value); else nlines = 0; @@ -686,7 +686,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side. int old_width = FRAME_INTERNAL_BORDER_WIDTH (f); CHECK_TYPE_RANGED_INTEGER (int, arg); - f->internal_border_width = XINT (arg); + f->internal_border_width = XFIXNUM (arg); if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0) f->internal_border_width = 0; @@ -884,10 +884,10 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side. icon_y = x_get_arg (dpyinfo, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER); if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound)) { - CHECK_NUMBER (icon_x); - CHECK_NUMBER (icon_y); - f->output_data.ns->icon_top = XINT (icon_y); - f->output_data.ns->icon_left = XINT (icon_x); + CHECK_FIXNUM (icon_x); + CHECK_FIXNUM (icon_y); + f->output_data.ns->icon_top = XFIXNUM (icon_y); + f->output_data.ns->icon_left = XFIXNUM (icon_x); } else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound)) error ("Both left and top icon corners of icon must be specified"); @@ -1086,7 +1086,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side. if (EQ (parent, Qunbound)) parent = Qnil; if (! NILP (parent)) - CHECK_NUMBER (parent); + CHECK_FIXNUM (parent); /* make_frame_without_minibuffer can run Lisp code and garbage collect. */ /* No need to protect DISPLAY because that's not used after passing @@ -1127,9 +1127,9 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side. record_unwind_protect (unwind_create_frame, frame); f->output_data.ns->window_desc = desc_ctr++; - if (TYPE_RANGED_INTEGERP (Window, parent)) + if (TYPE_RANGED_FIXNUMP (Window, parent)) { - f->output_data.ns->parent_desc = XFASTINT (parent); + f->output_data.ns->parent_desc = XFIXNAT (parent); f->output_data.ns->explicit_parent = 1; } else @@ -1170,7 +1170,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side. /* use for default font name */ id font = [NSFont userFixedPitchFontOfSize: -1.0]; /* default */ x_default_parameter (f, parms, Qfontsize, - make_number (0 /* (int)[font pointSize] */), + make_fixnum (0 /* (int)[font pointSize] */), "fontSize", "FontSize", RES_TYPE_NUMBER); // Remove ' Regular', not handled by backends. char *fontname = xstrdup ([[font displayName] UTF8String]); @@ -1184,14 +1184,14 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side. } unblock_input (); - x_default_parameter (f, parms, Qborder_width, make_number (0), + x_default_parameter (f, parms, Qborder_width, make_fixnum (0), "borderwidth", "BorderWidth", RES_TYPE_NUMBER); - x_default_parameter (f, parms, Qinternal_border_width, make_number (2), + x_default_parameter (f, parms, Qinternal_border_width, make_fixnum (2), "internalBorderWidth", "InternalBorderWidth", RES_TYPE_NUMBER); - x_default_parameter (f, parms, Qright_divider_width, make_number (0), + x_default_parameter (f, parms, Qright_divider_width, make_fixnum (0), NULL, NULL, RES_TYPE_NUMBER); - x_default_parameter (f, parms, Qbottom_divider_width, make_number (0), + x_default_parameter (f, parms, Qbottom_divider_width, make_fixnum (0), NULL, NULL, RES_TYPE_NUMBER); /* default vertical scrollbars on right on Mac */ @@ -1226,10 +1226,10 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side. /* Read comment about this code in corresponding place in xfns.c. */ tem = x_get_arg (dpyinfo, parms, Qmin_width, NULL, NULL, RES_TYPE_NUMBER); - if (NUMBERP (tem)) + if (FIXED_OR_FLOATP (tem)) store_frame_param (f, Qmin_width, tem); tem = x_get_arg (dpyinfo, parms, Qmin_height, NULL, NULL, RES_TYPE_NUMBER); - if (NUMBERP (tem)) + if (FIXED_OR_FLOATP (tem)) store_frame_param (f, Qmin_height, tem); adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f), FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, 1, @@ -1275,11 +1275,11 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side. variables; ignore them here. */ x_default_parameter (f, parms, Qmenu_bar_lines, NILP (Vmenu_bar_mode) - ? make_number (0) : make_number (1), + ? make_fixnum (0) : make_fixnum (1), NULL, NULL, RES_TYPE_NUMBER); x_default_parameter (f, parms, Qtool_bar_lines, NILP (Vtool_bar_mode) - ? make_number (0) : make_number (1), + ? make_fixnum (0) : make_fixnum (1), NULL, NULL, RES_TYPE_NUMBER); x_default_parameter (f, parms, Qbuffer_predicate, Qnil, "bufferPredicate", @@ -1781,7 +1781,7 @@ Frames are listed from topmost (first) to bottommost (last). */) (Lisp_Object terminal) { check_ns_display_info (terminal); - return make_number (1); + return make_fixnum (1); } @@ -1791,7 +1791,7 @@ Frames are listed from topmost (first) to bottommost (last). */) { struct ns_display_info *dpyinfo = check_ns_display_info (terminal); - return make_number (x_display_pixel_height (dpyinfo) / (92.0/25.4)); + return make_fixnum (x_display_pixel_height (dpyinfo) / (92.0/25.4)); } @@ -1801,7 +1801,7 @@ Frames are listed from topmost (first) to bottommost (last). */) { struct ns_display_info *dpyinfo = check_ns_display_info (terminal); - return make_number (x_display_pixel_width (dpyinfo) / (92.0/25.4)); + return make_fixnum (x_display_pixel_width (dpyinfo) / (92.0/25.4)); } @@ -2135,7 +2135,7 @@ Frames are listed from topmost (first) to bottommost (last). */) // coerce the result to the appropriate ObjC type desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text]; if (desc) - *result = make_number([desc int32Value]); + *result = make_fixnum([desc int32Value]); } } } @@ -2362,7 +2362,7 @@ Frames are listed from topmost (first) to bottommost (last). */) { struct ns_display_info *dpyinfo = check_ns_display_info (terminal); - return make_number (x_display_pixel_width (dpyinfo)); + return make_fixnum (x_display_pixel_width (dpyinfo)); } @@ -2373,7 +2373,7 @@ Frames are listed from topmost (first) to bottommost (last). */) { struct ns_display_info *dpyinfo = check_ns_display_info (terminal); - return make_number (x_display_pixel_height (dpyinfo)); + return make_fixnum (x_display_pixel_height (dpyinfo)); } #ifdef NS_IMPL_COCOA @@ -2476,7 +2476,7 @@ Frames are listed from topmost (first) to bottommost (last). */) int primary_monitor, const char *source) { - Lisp_Object monitor_frames = Fmake_vector (make_number (n_monitors), Qnil); + Lisp_Object monitor_frames = Fmake_vector (make_fixnum (n_monitors), Qnil); Lisp_Object frame, rest; NSArray *screens = [NSScreen screens]; int i; @@ -2617,7 +2617,7 @@ Frames are listed from topmost (first) to bottommost (last). */) (Lisp_Object terminal) { check_ns_display_info (terminal); - return make_number + return make_fixnum (NSBitsPerPixelFromDepth ([[[NSScreen screens] objectAtIndex:0] depth])); } @@ -2629,7 +2629,7 @@ Frames are listed from topmost (first) to bottommost (last). */) { struct ns_display_info *dpyinfo = check_ns_display_info (terminal); /* We force 24+ bit depths to 24-bit to prevent an overflow. */ - return make_number (1 << min (dpyinfo->n_planes, 24)); + return make_fixnum (1 << min (dpyinfo->n_planes, 24)); } /* TODO: move to xdisp or similar */ @@ -2653,15 +2653,15 @@ Frames are listed from topmost (first) to bottommost (last). */) right = Fcdr (Fassq (Qright, parms)); bottom = Fcdr (Fassq (Qbottom, parms)); - if ((!INTEGERP (left) && !INTEGERP (right)) - || (!INTEGERP (top) && !INTEGERP (bottom))) + if ((!FIXNUMP (left) && !FIXNUMP (right)) + || (!FIXNUMP (top) && !FIXNUMP (bottom))) pt = [NSEvent mouseLocation]; else { /* Absolute coordinates. */ - pt.x = INTEGERP (left) ? XINT (left) : XINT (right); + pt.x = FIXNUMP (left) ? XFIXNUM (left) : XFIXNUM (right); pt.y = (x_display_pixel_height (FRAME_DISPLAY_INFO (f)) - - (INTEGERP (top) ? XINT (top) : XINT (bottom)) + - (FIXNUMP (top) ? XFIXNUM (top) : XFIXNUM (bottom)) - height); } @@ -2681,30 +2681,30 @@ Frames are listed from topmost (first) to bottommost (last). */) versions of macOS and in GNUstep. */ /* Ensure in bounds. (Note, screen origin = lower left.) */ - if (INTEGERP (left) || INTEGERP (right)) + if (FIXNUMP (left) || FIXNUMP (right)) *root_x = pt.x; - else if (pt.x + XINT (dx) <= screen.frame.origin.x) + else if (pt.x + XFIXNUM (dx) <= screen.frame.origin.x) *root_x = screen.frame.origin.x; - else if (pt.x + XINT (dx) + width + else if (pt.x + XFIXNUM (dx) + width <= screen.frame.origin.x + screen.frame.size.width) /* It fits to the right of the pointer. */ - *root_x = pt.x + XINT (dx); - else if (width + XINT (dx) <= pt.x) + *root_x = pt.x + XFIXNUM (dx); + else if (width + XFIXNUM (dx) <= pt.x) /* It fits to the left of the pointer. */ - *root_x = pt.x - width - XINT (dx); + *root_x = pt.x - width - XFIXNUM (dx); else /* Put it left justified on the screen -- it ought to fit that way. */ *root_x = screen.frame.origin.x; - if (INTEGERP (top) || INTEGERP (bottom)) + if (FIXNUMP (top) || FIXNUMP (bottom)) *root_y = pt.y; - else if (pt.y - XINT (dy) - height >= screen.frame.origin.y) + else if (pt.y - XFIXNUM (dy) - height >= screen.frame.origin.y) /* It fits below the pointer. */ - *root_y = pt.y - height - XINT (dy); - else if (pt.y + XINT (dy) + height + *root_y = pt.y - height - XFIXNUM (dy); + else if (pt.y + XFIXNUM (dy) + height <= screen.frame.origin.y + screen.frame.size.height) /* It fits above the pointer. */ - *root_y = pt.y + XINT (dy); + *root_y = pt.y + XFIXNUM (dy); else /* Put it on the top. */ *root_y = screen.frame.origin.y + screen.frame.size.height - height; @@ -2729,19 +2729,19 @@ Frames are listed from topmost (first) to bottommost (last). */) str = SSDATA (string); f = decode_window_system_frame (frame); if (NILP (timeout)) - timeout = make_number (5); + timeout = make_fixnum (5); else - CHECK_NATNUM (timeout); + CHECK_FIXNAT (timeout); if (NILP (dx)) - dx = make_number (5); + dx = make_fixnum (5); else - CHECK_NUMBER (dx); + CHECK_FIXNUM (dx); if (NILP (dy)) - dy = make_number (-10); + dy = make_fixnum (-10); else - CHECK_NUMBER (dy); + CHECK_FIXNUM (dy); block_input (); if (ns_tooltip == nil) @@ -2765,7 +2765,7 @@ Frames are listed from topmost (first) to bottommost (last). */) compute_tip_xy (f, parms, dx, dy, (int)size.width, (int)size.height, &root_x, &root_y); - [ns_tooltip showAtX: root_x Y: root_y for: XINT (timeout)]; + [ns_tooltip showAtX: root_x Y: root_y for: XFIXNUM (timeout)]; unblock_input (); return unbind_to (count, Qnil); @@ -2812,44 +2812,44 @@ ATTRIBUTES return the outer edges of FRAME (Qouter_edges), the inner /* Construct list. */ if (EQ (attribute, Qouter_edges)) - return list4 (make_number (f->left_pos), make_number (f->top_pos), - make_number (f->left_pos + outer_width), - make_number (f->top_pos + outer_height)); + return list4 (make_fixnum (f->left_pos), make_fixnum (f->top_pos), + make_fixnum (f->left_pos + outer_width), + make_fixnum (f->top_pos + outer_height)); else if (EQ (attribute, Qnative_edges)) - return list4 (make_number (native_left), make_number (native_top), - make_number (native_right), make_number (native_bottom)); + return list4 (make_fixnum (native_left), make_fixnum (native_top), + make_fixnum (native_right), make_fixnum (native_bottom)); else if (EQ (attribute, Qinner_edges)) - return list4 (make_number (native_left + internal_border_width), - make_number (native_top + return list4 (make_fixnum (native_left + internal_border_width), + make_fixnum (native_top + tool_bar_height + internal_border_width), - make_number (native_right - internal_border_width), - make_number (native_bottom - internal_border_width)); + make_fixnum (native_right - internal_border_width), + make_fixnum (native_bottom - internal_border_width)); else return listn (CONSTYPE_HEAP, 10, Fcons (Qouter_position, - Fcons (make_number (f->left_pos), - make_number (f->top_pos))), + Fcons (make_fixnum (f->left_pos), + make_fixnum (f->top_pos))), Fcons (Qouter_size, - Fcons (make_number (outer_width), - make_number (outer_height))), + Fcons (make_fixnum (outer_width), + make_fixnum (outer_height))), Fcons (Qexternal_border_size, (fullscreen - ? Fcons (make_number (0), make_number (0)) - : Fcons (make_number (border), make_number (border)))), + ? Fcons (make_fixnum (0), make_fixnum (0)) + : Fcons (make_fixnum (border), make_fixnum (border)))), Fcons (Qtitle_bar_size, - Fcons (make_number (0), make_number (title_height))), + Fcons (make_fixnum (0), make_fixnum (title_height))), Fcons (Qmenu_bar_external, Qnil), - Fcons (Qmenu_bar_size, Fcons (make_number (0), make_number (0))), + Fcons (Qmenu_bar_size, Fcons (make_fixnum (0), make_fixnum (0))), Fcons (Qtool_bar_external, FRAME_EXTERNAL_TOOL_BAR (f) ? Qt : Qnil), Fcons (Qtool_bar_position, FRAME_TOOL_BAR_POSITION (f)), Fcons (Qtool_bar_size, - Fcons (make_number (tool_bar_width), - make_number (tool_bar_height))), + Fcons (make_fixnum (tool_bar_width), + make_fixnum (tool_bar_height))), Fcons (Qinternal_border_width, - make_number (internal_border_width))); + make_fixnum (internal_border_width))); } DEFUN ("ns-frame-geometry", Fns_frame_geometry, Sns_frame_geometry, 0, 1, 0, @@ -2947,13 +2947,13 @@ value is a list of the form (LEFT, TOP, RIGHT, BOTTOM). All values are CHECK_TYPE_RANGED_INTEGER (int, x); CHECK_TYPE_RANGED_INTEGER (int, y); - mouse_x = screen_frame.origin.x + XINT (x); + mouse_x = screen_frame.origin.x + XFIXNUM (x); if (screen == primary_screen) - mouse_y = screen_frame.origin.y + XINT (y); + mouse_y = screen_frame.origin.y + XFIXNUM (y); else mouse_y = (primary_screen_height - screen_frame.size.height - - screen_frame.origin.y) + XINT (y); + - screen_frame.origin.y) + XFIXNUM (y); CGPoint mouse_pos = CGPointMake(mouse_x, mouse_y); CGWarpMouseCursorPosition (mouse_pos); @@ -2976,8 +2976,8 @@ The position is returned as a cons cell (X . Y) of the NSScreen *screen = [[view window] screen]; NSPoint pt = [NSEvent mouseLocation]; - return Fcons(make_number(pt.x - screen.frame.origin.x), - make_number(screen.frame.size.height - + return Fcons(make_fixnum(pt.x - screen.frame.origin.x), + make_fixnum(screen.frame.size.height - (pt.y - screen.frame.origin.y))); } diff --git a/src/nsfont.m b/src/nsfont.m index 232e4962b7..b1ebb53c95 100644 --- a/src/nsfont.m +++ b/src/nsfont.m @@ -186,24 +186,24 @@ static void ns_glyph_metrics (struct nsfont_info *font_info, FONT_SET_STYLE (font_entity, FONT_WEIGHT_INDEX, traits & NSFontBoldTrait ? Qbold : Qmedium); /* FONT_SET_STYLE (font_entity, FONT_WEIGHT_INDEX, - make_number (100 + 100 + make_fixnum (100 + 100 * ns_attribute_fvalue (desc, NSFontWeightTrait)));*/ FONT_SET_STYLE (font_entity, FONT_SLANT_INDEX, traits & NSFontItalicTrait ? Qitalic : Qnormal); /* FONT_SET_STYLE (font_entity, FONT_SLANT_INDEX, - make_number (100 + 100 + make_fixnum (100 + 100 * ns_attribute_fvalue (desc, NSFontSlantTrait)));*/ FONT_SET_STYLE (font_entity, FONT_WIDTH_INDEX, traits & NSFontCondensedTrait ? Qcondensed : traits & NSFontExpandedTrait ? Qexpanded : Qnormal); /* FONT_SET_STYLE (font_entity, FONT_WIDTH_INDEX, - make_number (100 + 100 + make_fixnum (100 + 100 * ns_attribute_fvalue (desc, NSFontWidthTrait)));*/ - ASET (font_entity, FONT_SIZE_INDEX, make_number (0)); - ASET (font_entity, FONT_AVGWIDTH_INDEX, make_number (0)); + ASET (font_entity, FONT_SIZE_INDEX, make_fixnum (0)); + ASET (font_entity, FONT_AVGWIDTH_INDEX, make_fixnum (0)); ASET (font_entity, FONT_SPACING_INDEX, - make_number([desc symbolicTraits] & NSFontMonoSpaceTrait + make_fixnum([desc symbolicTraits] & NSFontMonoSpaceTrait ? FONT_SPACING_MONO : FONT_SPACING_PROPORTIONAL)); ASET (font_entity, FONT_EXTRA_INDEX, extra); @@ -445,8 +445,8 @@ but also for ascii (which causes unnecessary font substitution). */ { for (; CONSP (range_list); range_list = XCDR (range_list)) { - int start = XINT (XCAR (XCAR (range_list))); - int end = XINT (XCDR (XCAR (range_list))); + int start = XFIXNUM (XCAR (XCAR (range_list))); + int end = XFIXNUM (XCDR (XCAR (range_list))); if (NSFONT_TRACE) debug_print (XCAR (range_list)); if (end < 0x10000) @@ -576,7 +576,7 @@ but also for ascii (which causes unnecessary font substitution). */ /* Add synthItal member if needed. */ family = [fdesc objectForKey: NSFontFamilyAttribute]; - if (family != nil && !foundItal && XINT (Flength (list)) > 0) + if (family != nil && !foundItal && XFIXNUM (Flength (list)) > 0) { NSFontDescriptor *s1 = [NSFontDescriptor new]; NSFontDescriptor *sDesc @@ -596,7 +596,7 @@ but also for ascii (which causes unnecessary font substitution). */ if (NSFONT_TRACE) fprintf (stderr, " Returning %"pI"d entities.\n", - XINT (Flength (list))); + XFIXNUM (Flength (list))); return list; } @@ -668,7 +668,7 @@ Properties to be considered are same as for list(). */ if (NSFONT_TRACE) fprintf (stderr, "nsfont: list families returning %"pI"d entries\n", - XINT (Flength (list))); + XFIXNUM (Flength (list))); unblock_input (); return list; @@ -705,7 +705,7 @@ Properties to be considered are same as for list(). */ { /* try to get it out of frame params */ Lisp_Object tem = get_frame_param (f, Qfontsize); - pixel_size = NILP (tem) ? 0 : XFASTINT (tem); + pixel_size = NILP (tem) ? 0 : XFIXNAT (tem); } tem = AREF (font_entity, FONT_ADSTYLE_INDEX); diff --git a/src/nsimage.m b/src/nsimage.m index 2cc205a499..f657c49c0b 100644 --- a/src/nsimage.m +++ b/src/nsimage.m @@ -85,10 +85,10 @@ Updated by Christian Limpach (chris@nice.ch) eassert (valid_image_p (img->spec)); lisp_index = Fplist_get (XCDR (img->spec), QCindex); - index = INTEGERP (lisp_index) ? XFASTINT (lisp_index) : 0; + index = FIXNUMP (lisp_index) ? XFIXNAT (lisp_index) : 0; lisp_rotation = Fplist_get (XCDR (img->spec), QCrotation); - rotation = NUMBERP (lisp_rotation) ? XFLOATINT (lisp_rotation) : 0; + rotation = FIXED_OR_FLOATP (lisp_rotation) ? XFLOATINT (lisp_rotation) : 0; if (STRINGP (spec_file)) { @@ -113,7 +113,7 @@ Updated by Christian Limpach (chris@nice.ch) if (![eImg setFrame: index]) { add_to_log ("Unable to set index %d for image %s", - make_number (index), img->spec); + make_fixnum (index), img->spec); return 0; } @@ -495,7 +495,7 @@ - (Lisp_Object)getMetadata floatValue]; if (frames > 1) - metadata = Fcons (Qcount, Fcons (make_number (frames), metadata)); + metadata = Fcons (Qcount, Fcons (make_fixnum (frames), metadata)); if (delay > 0) metadata = Fcons (Qdelay, Fcons (make_float (delay), metadata)); } @@ -532,19 +532,19 @@ - (void)setSizeFromSpec: (Lisp_Object) spec double width = -1, height = -1, max_width = -1, max_height = -1; value = Fplist_get (spec, QCscale); - if (NUMBERP (value)) + if (FIXED_OR_FLOATP (value)) scale = XFLOATINT (value) ; value = Fplist_get (spec, QCmax_width); - if (NUMBERP (value)) + if (FIXED_OR_FLOATP (value)) max_width = XFLOATINT (value); value = Fplist_get (spec, QCmax_height); - if (NUMBERP (value)) + if (FIXED_OR_FLOATP (value)) max_height = XFLOATINT (value); value = Fplist_get (spec, QCwidth); - if (NUMBERP (value)) + if (FIXED_OR_FLOATP (value)) { width = XFLOATINT (value) * scale; /* :width overrides :max-width. */ @@ -552,7 +552,7 @@ - (void)setSizeFromSpec: (Lisp_Object) spec } value = Fplist_get (spec, QCheight); - if (NUMBERP (value)) + if (FIXED_OR_FLOATP (value)) { height = XFLOATINT (value) * scale; /* :height overrides :max-height. */ diff --git a/src/nsmenu.m b/src/nsmenu.m index a438952818..4e22d7b41b 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -377,7 +377,7 @@ { string = AREF (items, 4*i+1); - if (EQ (string, make_number (0))) // FIXME: Why??? --Stef + if (EQ (string, make_fixnum (0))) // FIXME: Why??? --Stef continue; if (NILP (string)) { diff --git a/src/nsselect.m b/src/nsselect.m index c72f179ab3..b7e134b546 100644 --- a/src/nsselect.m +++ b/src/nsselect.m @@ -90,20 +90,20 @@ Updated by Christian Limpach (chris@nice.ch) clean_local_selection_data (Lisp_Object obj) { if (CONSP (obj) - && INTEGERP (XCAR (obj)) + && FIXNUMP (XCAR (obj)) && CONSP (XCDR (obj)) - && INTEGERP (XCAR (XCDR (obj))) + && FIXNUMP (XCAR (XCDR (obj))) && NILP (XCDR (XCDR (obj)))) obj = Fcons (XCAR (obj), XCDR (obj)); if (CONSP (obj) - && INTEGERP (XCAR (obj)) - && INTEGERP (XCDR (obj))) + && FIXNUMP (XCAR (obj)) + && FIXNUMP (XCDR (obj))) { - if (XINT (XCAR (obj)) == 0) + if (XFIXNUM (XCAR (obj)) == 0) return XCDR (obj); - if (XINT (XCAR (obj)) == -1) - return make_number (- XINT (XCDR (obj))); + if (XFIXNUM (XCAR (obj)) == -1) + return make_fixnum (- XFIXNUM (XCDR (obj))); } if (VECTORP (obj)) diff --git a/src/nsterm.m b/src/nsterm.m index a15684d3bf..90758d1032 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -1913,11 +1913,11 @@ breaks live resize (resizing with a mouse), so don't do it if frame_size_history_add (f, Qx_set_window_size_1, width, height, - list5 (Fcons (make_number (pixelwidth), make_number (pixelheight)), - Fcons (make_number (wr.size.width), make_number (wr.size.height)), - make_number (f->border_width), - make_number (FRAME_NS_TITLEBAR_HEIGHT (f)), - make_number (FRAME_TOOLBAR_HEIGHT (f)))); + list5 (Fcons (make_fixnum (pixelwidth), make_fixnum (pixelheight)), + Fcons (make_fixnum (wr.size.width), make_fixnum (wr.size.height)), + make_fixnum (f->border_width), + make_fixnum (FRAME_NS_TITLEBAR_HEIGHT (f)), + make_fixnum (FRAME_TOOLBAR_HEIGHT (f)))); [window setFrame: wr display: YES]; @@ -2480,8 +2480,8 @@ so some key presses (TAB) are swallowed by the system. */ if (FLOATP (Vframe_alpha_lower_limit)) alpha_min = XFLOAT_DATA (Vframe_alpha_lower_limit); - else if (INTEGERP (Vframe_alpha_lower_limit)) - alpha_min = (XINT (Vframe_alpha_lower_limit)) / 100.0; + else if (FIXNUMP (Vframe_alpha_lower_limit)) + alpha_min = (XFIXNUM (Vframe_alpha_lower_limit)) / 100.0; if (alpha < 0.0) return; @@ -3520,8 +3520,8 @@ Note that CURSOR_WIDTH is meaningful only for (h)bar cursors. BOOL underline_at_descent_line, use_underline_position_properties; Lisp_Object val = buffer_local_value (Qunderline_minimum_offset, s->w->contents); - if (INTEGERP (val)) - minimum_offset = XFASTINT (val); + if (FIXNUMP (val)) + minimum_offset = XFIXNAT (val); else minimum_offset = 1; val = buffer_local_value (Qx_underline_at_descent_line, @@ -5342,7 +5342,7 @@ Needs to be here because ns_initialize_display_info () uses AppKit classes. { color = XCAR (color_map); name = SSDATA (XCAR (color)); - c = XINT (XCDR (color)); + c = XFIXNUM (XCDR (color)); [cl setColor: [NSColor colorForEmacsRed: RED_FROM_ULONG (c) / 255.0 green: GREEN_FROM_ULONG (c) / 255.0 @@ -6155,7 +6155,7 @@ - (void)changeFont: (id)sender emacs_event->code = KEY_NS_CHANGE_FONT; size = [newFont pointSize]; - ns_input_fontsize = make_number (lrint (size)); + ns_input_fontsize = make_fixnum (lrint (size)); ns_input_font = build_string ([[newFont familyName] UTF8String]); EV_TRAILER (e); } @@ -6234,7 +6234,7 @@ most recently updated (I guess), which is not the correct one. */ [NSCursor setHiddenUntilMouseMoves: YES]; - if (hlinfo->mouse_face_hidden && INTEGERP (Vmouse_highlight)) + if (hlinfo->mouse_face_hidden && FIXNUMP (Vmouse_highlight)) { clear_mouse_face (hlinfo); hlinfo->mouse_face_hidden = 1; @@ -6684,8 +6684,8 @@ - (void)mouseDown: (NSEvent *)theEvent static int totalDeltaX, totalDeltaY; int lineHeight; - if (NUMBERP (ns_mwheel_line_height)) - lineHeight = XINT (ns_mwheel_line_height); + if (FIXED_OR_FLOATP (ns_mwheel_line_height)) + lineHeight = XFIXNUM (ns_mwheel_line_height); else { /* FIXME: Use actual line height instead of the default. */ @@ -6754,7 +6754,7 @@ - (void)mouseDown: (NSEvent *)theEvent return; emacs_event->kind = horizontal ? HORIZ_WHEEL_EVENT : WHEEL_EVENT; - emacs_event->arg = (make_number (lines)); + emacs_event->arg = (make_fixnum (lines)); emacs_event->code = 0; emacs_event->modifiers = EV_MODIFIERS (theEvent) | @@ -9341,11 +9341,11 @@ Convert an X font name (XLFD) to an NS font name. DEFSYM (Qfile, "file"); DEFSYM (Qurl, "url"); - Fput (Qalt, Qmodifier_value, make_number (alt_modifier)); - Fput (Qhyper, Qmodifier_value, make_number (hyper_modifier)); - Fput (Qmeta, Qmodifier_value, make_number (meta_modifier)); - Fput (Qsuper, Qmodifier_value, make_number (super_modifier)); - Fput (Qcontrol, Qmodifier_value, make_number (ctrl_modifier)); + Fput (Qalt, Qmodifier_value, make_fixnum (alt_modifier)); + Fput (Qhyper, Qmodifier_value, make_fixnum (hyper_modifier)); + Fput (Qmeta, Qmodifier_value, make_fixnum (meta_modifier)); + Fput (Qsuper, Qmodifier_value, make_fixnum (super_modifier)); + Fput (Qcontrol, Qmodifier_value, make_fixnum (ctrl_modifier)); DEFVAR_LISP ("ns-input-file", ns_input_file, "The file specified in the last NS event."); commit 53483df0de0085dbc9ef0b15a0f629ab808b0147 Author: Michael Albinus Date: Thu Aug 9 15:40:37 2018 +0200 ; More instrumentation for shadowfile-tests.el and files.el diff --git a/lisp/files.el b/lisp/files.el index 8057def525..940bacde23 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5091,6 +5091,9 @@ Before and after saving the buffer, this function runs (make-directory dir t) (error "Canceled"))) (setq setmodes (basic-save-buffer-1))))) + ;; We are hunting a nasty error, which happens on hydra. + ;; Adding traces might help. + (if (getenv "BUG_32226") (message "BUG_32226")) ;; Now we have saved the current buffer. Let's make sure ;; that buffer-file-coding-system is fixed to what ;; actually used for saving by binding it locally. diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el index 0335caa516..22f7b2de6e 100644 --- a/test/lisp/shadowfile-tests.el +++ b/test/lisp/shadowfile-tests.el @@ -724,6 +724,8 @@ guaranteed by the originator of a cluster definition." (dolist (elt (all-completions "shadow-" obarray 'functionp)) (trace-function-background (intern elt))) (trace-function-background 'save-buffer) + (dolist (elt write-file-functions) + (trace-function-background elt)) ;; Cleanup. (when (file-exists-p shadow-info-file) (delete-file shadow-info-file)) @@ -775,7 +777,10 @@ guaranteed by the originator of a cluster definition." (message "Point 4.2") (insert "foo") (message "%s" buffer-file-name) + (message "%s" write-file-functions) + (setenv "BUG_32226" "1") (save-buffer)) + (setenv "BUG_32226") (message "Point 4.3") (message "%s" (shadow-site-primary cluster2)) (message "%s" (shadow-contract-file-name (concat "/cluster1:" file))) @@ -821,6 +826,7 @@ guaranteed by the originator of a cluster definition." shadow-files-to-copy))) (error (message "Error: %s" err) (signal (car err) (cdr err)))) + (setenv "BUG_32226") (untrace-all) (message "%s" (with-current-buffer trace-buffer (buffer-string))) commit 96be6b6eb99ae1d77702932c97e8b3a147c6265a Author: Alexander Gramiak Date: Tue Oct 31 21:10:52 2017 -0600 Improve error messages regarding initial-buffer-choice (Bug#29098) * lisp/startup.el (command-line-1) : Make the messages conform to Emacs conventions, and show the invalid return value in the message. diff --git a/lisp/startup.el b/lisp/startup.el index 33f8ca63f8..63b831ee38 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -2515,9 +2515,9 @@ nil default-directory" name) ((eq initial-buffer-choice t) (get-buffer-create "*scratch*")) (t - (error "initial-buffer-choice must be a string, a function, or t."))))) + (error "`initial-buffer-choice' must be a string, a function, or t"))))) (unless (buffer-live-p buf) - (error "initial-buffer-choice is not a live buffer.")) + (error "Value returned by `initial-buffer-choice' is not a live buffer: %S" buf)) (setq displayable-buffers (cons buf displayable-buffers)))) ;; Display the first two buffers in `displayable-buffers'. If commit f1a385ded23c22edc3f5005bcaa2129eb1d87448 Author: Michael Albinus Date: Thu Aug 9 14:08:25 2018 +0200 Fix Bug#32304 * test/lisp/net/tramp-tests.el (tramp-test45-unload): Handle tramp-archive autoloaded objects. Remove tag :unstable. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 7ca680087a..293a005456 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -5162,52 +5162,58 @@ process sentinels. They shall not disturb each other." (ert-deftest tramp-test44-unload () "Check that Tramp and its subpackages unload completely. Since it unloads Tramp, it shall be the last test to run." - :tags '(:expensive-test :unstable) + :tags '(:expensive-test) (skip-unless noninteractive) ;; The autoloaded Tramp objects are different since Emacs 26.1. We ;; cannot test older Emacsen, therefore. (skip-unless (tramp--test-emacs26-p)) - (when (featurep 'tramp) - ;; This unloads also tramp-archive.el if needed. - (unload-feature 'tramp 'force) - ;; No Tramp feature must be left. - (should-not (featurep 'tramp)) - (should-not (featurep 'tramp-archive)) - (should-not - (all-completions - "tramp" (delq 'tramp-tests (delq 'tramp-archive-tests features)))) - ;; `file-name-handler-alist' must be clean. - (should-not (all-completions "tramp" (mapcar 'cdr file-name-handler-alist))) - ;; There shouldn't be left a bound symbol, except buffer-local - ;; variables, and autoload functions. We do not regard our test - ;; symbols, and the Tramp unload hooks. - (mapatoms - (lambda (x) - (and (or (and (boundp x) (null (local-variable-if-set-p x))) - (and (functionp x) (null (autoloadp (symbol-function x))))) - (string-match "^tramp" (symbol-name x)) - (not (string-match "^tramp\\(-archive\\)?--?test" (symbol-name x))) - (not (string-match "unload-hook$" (symbol-name x))) - (ert-fail (format "`%s' still bound" x))))) - ;; The defstruct `tramp-file-name' and all its internal functions - ;; shall be purged. - (should-not (cl--find-class 'tramp-file-name)) - (mapatoms - (lambda (x) - (and (functionp x) - (string-match "tramp-file-name" (symbol-name x)) - (ert-fail (format "Structure function `%s' still exists" x))))) - ;; There shouldn't be left a hook function containing a Tramp - ;; function. We do not regard the Tramp unload hooks. - (mapatoms - (lambda (x) - (and (boundp x) - (string-match "-\\(hook\\|function\\)s?$" (symbol-name x)) - (not (string-match "unload-hook$" (symbol-name x))) - (consp (symbol-value x)) - (ignore-errors (all-completions "tramp" (symbol-value x))) - (ert-fail (format "Hook `%s' still contains Tramp function" x))))))) + ;; We have autoloaded objects from tramp.el and tramp-archive.el. + ;; In order to remove them, we first need to load both packages. + (require 'tramp) + (require 'tramp-archive) + (should (featurep 'tramp)) + (should (featurep 'tramp-archive)) + ;; This unloads also tramp-archive.el and tramp-theme.el if needed. + (unload-feature 'tramp 'force) + ;; No Tramp feature must be left. + (should-not (featurep 'tramp)) + (should-not (featurep 'tramp-archive)) + (should-not (featurep 'tramp-theme)) + (should-not + (all-completions + "tramp" (delq 'tramp-tests (delq 'tramp-archive-tests features)))) + ;; `file-name-handler-alist' must be clean. + (should-not (all-completions "tramp" (mapcar 'cdr file-name-handler-alist))) + ;; There shouldn't be left a bound symbol, except buffer-local + ;; variables, and autoload functions. We do not regard our test + ;; symbols, and the Tramp unload hooks. + (mapatoms + (lambda (x) + (and (or (and (boundp x) (null (local-variable-if-set-p x))) + (and (functionp x) (null (autoloadp (symbol-function x))))) + (string-match "^tramp" (symbol-name x)) + (not (string-match "^tramp\\(-archive\\)?--?test" (symbol-name x))) + (not (string-match "unload-hook$" (symbol-name x))) + (ert-fail (format "`%s' still bound" x))))) + ;; The defstruct `tramp-file-name' and all its internal functions + ;; shall be purged. + (should-not (cl--find-class 'tramp-file-name)) + (mapatoms + (lambda (x) + (and (functionp x) + (string-match "tramp-file-name" (symbol-name x)) + (ert-fail (format "Structure function `%s' still exists" x))))) + ;; There shouldn't be left a hook function containing a Tramp + ;; function. We do not regard the Tramp unload hooks. + (mapatoms + (lambda (x) + (and (boundp x) + (string-match "-\\(hook\\|function\\)s?$" (symbol-name x)) + (not (string-match "unload-hook$" (symbol-name x))) + (consp (symbol-value x)) + (ignore-errors (all-completions "tramp" (symbol-value x))) + (ert-fail (format "Hook `%s' still contains Tramp function" x)))))) (defun tramp-test-all (&optional interactive) "Run all tests for \\[tramp]." @@ -5232,7 +5238,6 @@ Since it unloads Tramp, it shall be the last test to run." ;; * Fix `tramp-test29-start-file-process' on MS Windows (`process-send-eof'?). ;; * Fix `tramp-test30-interrupt-process', timeout doesn't work reliably. ;; * Fix Bug#16928 in `tramp-test42-asynchronous-requests'. -;; * Check why `tramp-test44-unload' fails when running as only test. (provide 'tramp-tests) ;;; tramp-tests.el ends here commit 449954dda84aa392312ab714f918a756c12adb32 Author: JoĂŁo Távora Date: Thu Aug 9 13:04:03 2018 +0100 Trim JSONRPC events buffer when it's too large * lisp/jsonrpc.el (Version): Bump to 1.0.2 (jsonrpc--events-buffer-scrollback-size): New jsonrpc-connection slot. (jsonrpc--log-event): Use it to trim buffer. diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 8e1e2aba33..a137616eca 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -6,7 +6,7 @@ ;; Maintainer: JoĂŁo Távora ;; Keywords: processes, languages, extensions ;; Package-Requires: ((emacs "25.2")) -;; Version: 1.0.1 +;; Version: 1.0.2 ;; This is an Elpa :core package. Don't use functionality that is not ;; compatible with Emacs 25.2. @@ -74,7 +74,11 @@ :documentation "A hash table of request ID to continuation lambdas.") (-events-buffer :accessor jsonrpc--events-buffer - :documentation "A buffer pretty-printing the JSON-RPC RPC events") + :documentation "A buffer pretty-printing the JSONRPC events") + (-events-buffer-scrollback-size + :initarg :events-buffer-scrollback-size + :accessor jsonrpc--events-buffer-scrollback-size + :documentation "If non-nil, maximum size of events buffer.") (-deferred-actions :initform (make-hash-table :test #'equal) :accessor jsonrpc--deferred-actions @@ -660,15 +664,26 @@ originated." (if type (format "-%s" subtype))))) (goto-char (point-max)) - (let ((msg (format "%s%s%s %s:\n%s\n" - type - (if id (format " (id:%s)" id) "") - (if error " ERROR" "") - (current-time-string) - (pp-to-string message)))) - (when error - (setq msg (propertize msg 'face 'error))) - (insert-before-markers msg)))))) + (prog1 + (let ((msg (format "%s%s%s %s:\n%s\n" + type + (if id (format " (id:%s)" id) "") + (if error " ERROR" "") + (current-time-string) + (pp-to-string message)))) + (when error + (setq msg (propertize msg 'face 'error))) + (insert-before-markers msg)) + ;; Trim the buffer if it's too large + (let ((max (jsonrpc--events-buffer-scrollback-size connection))) + (when max + (save-excursion + (goto-char (point-min)) + (while (> (buffer-size) max) + (delete-region (point) (progn (forward-line 1) + (forward-sexp 1) + (forward-line 2) + (point)))))))))))) (provide 'jsonrpc) ;;; jsonrpc.el ends here commit cdafa8933d0b5a2261e1cdb959703951eae98f74 Author: JoĂŁo Távora Date: Thu Aug 9 10:43:41 2018 +0100 Synchronous JSONRPC requests can be cancelled on user input This allows building more responsive interfaces, such as a snappier completion backend. * lisp/jsonrpc.el (Version): Bump to 1.0.1 (jsonrpc-connection-receive): Don't warn when continuation isn't found. (jsonrpc-request): Add parameters CANCEL-ON-INPUT and CANCEL-ON-INPUT-RETVAL. diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index b2ccea5c14..8e1e2aba33 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -6,7 +6,7 @@ ;; Maintainer: JoĂŁo Távora ;; Keywords: processes, languages, extensions ;; Package-Requires: ((emacs "25.2")) -;; Version: 1.0.0 +;; Version: 1.0.1 ;; This is an Elpa :core package. Don't use functionality that is not ;; compatible with Emacs 25.2. @@ -193,9 +193,7 @@ dispatcher in CONNECTION." (when timer (cancel-timer timer))) (remhash id (jsonrpc--request-continuations connection)) (if error (funcall (nth 1 continuations) error) - (funcall (nth 0 continuations) result))) - (;; An abnormal situation - id (jsonrpc--warn "No continuation for id %s" id))) + (funcall (nth 0 continuations) result)))) (jsonrpc--call-deferred connection)))) @@ -256,17 +254,30 @@ Returns nil." (apply #'jsonrpc--async-request-1 connection method params args) nil) -(cl-defun jsonrpc-request (connection method params &key deferred timeout) +(cl-defun jsonrpc-request (connection + method params &key + deferred timeout + cancel-on-input + cancel-on-input-retval) "Make a request to CONNECTION, wait for a reply. Like `jsonrpc-async-request' for CONNECTION, METHOD and PARAMS, -but synchronous, i.e. this function doesn't exit until anything -interesting (success, error or timeout) happens. Furthermore, it -only exits locally (returning the JSONRPC result object) if the -request is successful, otherwise exit non-locally with an error -of type `jsonrpc-error'. +but synchronous. -DEFERRED is passed to `jsonrpc-async-request', which see." +Except in the case of a non-nil CANCEL-ON-INPUT (explained +below), this function doesn't exit until anything interesting +happens (success reply, error reply, or timeout). Furthermore, +it only exits locally (returning the JSONRPC result object) if +the request is successful, otherwise it exits non-locally with an +error of type `jsonrpc-error'. + +DEFERRED is passed to `jsonrpc-async-request', which see. + +If CANCEL-ON-INPUT is non-nil and the user inputs something while +the functino is waiting, then it exits immediately, returning +CANCEL-ON-INPUT-RETVAL. Any future replies (normal or error) are +ignored." (let* ((tag (cl-gensym "jsonrpc-request-catch-tag")) id-and-timer + cancelled (retval (unwind-protect ; protect against user-quit, for example (catch tag @@ -274,19 +285,27 @@ DEFERRED is passed to `jsonrpc-async-request', which see." id-and-timer (jsonrpc--async-request-1 connection method params - :success-fn (lambda (result) (throw tag `(done ,result))) + :success-fn (lambda (result) + (unless cancelled + (throw tag `(done ,result)))) :error-fn (jsonrpc-lambda (&key code message data) - (throw tag `(error (jsonrpc-error-code . ,code) - (jsonrpc-error-message . ,message) - (jsonrpc-error-data . ,data)))) + (unless cancelled + (throw tag `(error (jsonrpc-error-code . ,code) + (jsonrpc-error-message . ,message) + (jsonrpc-error-data . ,data))))) :timeout-fn (lambda () - (throw tag '(error (jsonrpc-error-message . "Timed out")))) + (unless cancelled + (throw tag '(error (jsonrpc-error-message . "Timed out"))))) :deferred deferred :timeout timeout)) - (while t (accept-process-output nil 30))) + (cond (cancel-on-input + (while (sit-for 30)) + (setq cancelled t) + `(cancelled ,cancel-on-input-retval)) + (t (while t (accept-process-output nil 30))))) (pcase-let* ((`(,id ,timer) id-and-timer)) (remhash id (jsonrpc--request-continuations connection)) (remhash (list deferred (current-buffer)) commit 63a8f4cfd78b6fbf6d56cdeeb5df1f6d0688435c Author: Paul Eggert Date: Wed Aug 8 18:51:35 2018 -0700 Minor pseudovector allocation cleanups * src/alloc.c (VECTOR_BLOCK_SIZE, VECTOR_BLOCK_BYTES) (VBLOCK_BYTES_MIN, VBLOCK_BYTES_MAX, VECTOR_MAX_FREE_LIST_INDEX): Prefer enums to macros where either will do. (allocate_vector_from_block): Arg is ptrdiff_t, not size_t. Use eassume instead of eassert. (PSEUDOVEC_STRUCT): New macro, which verifies the already-existing assumption that the vector-like objects are small. (cleanup_vector): Use it. Use if-then-else systematically; this lets GCC do a bit better job. 2018-08-08 Paul Eggert * src/alloc.c (VBLOCK_BYTES_MAX): Use vroundup_ct, not vroundup, so that can be used in static assertions. diff --git a/src/alloc.c b/src/alloc.c index ad716f543c..e4b54aba86 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2932,7 +2932,7 @@ set_next_vector (struct Lisp_Vector *v, struct Lisp_Vector *p) for the most common cases; it's not required to be a power of two, but it's expected to be a mult-of-ROUNDUP_SIZE (see below). */ -#define VECTOR_BLOCK_SIZE 4096 +enum { VECTOR_BLOCK_SIZE = 4096 }; /* Vector size requests are a multiple of this. */ enum { roundup_size = COMMON_MULTIPLE (LISP_ALIGNMENT, word_size) }; @@ -2948,22 +2948,21 @@ verify (VECTOR_BLOCK_SIZE <= (1 << PSEUDOVECTOR_SIZE_BITS)); /* Rounding helps to maintain alignment constraints if USE_LSB_TAG. */ -#define VECTOR_BLOCK_BYTES (VECTOR_BLOCK_SIZE - vroundup_ct (sizeof (void *))) +enum {VECTOR_BLOCK_BYTES = VECTOR_BLOCK_SIZE - vroundup_ct (sizeof (void *))}; /* Size of the minimal vector allocated from block. */ -#define VBLOCK_BYTES_MIN vroundup_ct (header_size + sizeof (Lisp_Object)) +enum { VBLOCK_BYTES_MIN = vroundup_ct (header_size + sizeof (Lisp_Object)) }; /* Size of the largest vector allocated from block. */ -#define VBLOCK_BYTES_MAX \ - vroundup ((VECTOR_BLOCK_BYTES / 2) - word_size) +enum { VBLOCK_BYTES_MAX = vroundup_ct ((VECTOR_BLOCK_BYTES / 2) - word_size) }; /* We maintain one free list for each possible block-allocated vector size, and this is the number of free lists we have. */ -#define VECTOR_MAX_FREE_LIST_INDEX \ - ((VECTOR_BLOCK_BYTES - VBLOCK_BYTES_MIN) / roundup_size + 1) +enum { VECTOR_MAX_FREE_LIST_INDEX = + (VECTOR_BLOCK_BYTES - VBLOCK_BYTES_MIN) / roundup_size + 1 }; /* Common shortcut to advance vector pointer over a block data. */ @@ -3090,14 +3089,14 @@ init_vectors (void) /* Allocate vector from a vector block. */ static struct Lisp_Vector * -allocate_vector_from_block (size_t nbytes) +allocate_vector_from_block (ptrdiff_t nbytes) { struct Lisp_Vector *vector; struct vector_block *block; size_t index, restbytes; - eassert (VBLOCK_BYTES_MIN <= nbytes && nbytes <= VBLOCK_BYTES_MAX); - eassert (nbytes % roundup_size == 0); + eassume (VBLOCK_BYTES_MIN <= nbytes && nbytes <= VBLOCK_BYTES_MAX); + eassume (nbytes % roundup_size == 0); /* First, try to allocate from a free list containing vectors of the requested size. */ @@ -3182,35 +3181,45 @@ vector_nbytes (struct Lisp_Vector *v) return vroundup (header_size + word_size * nwords); } +/* Convert a pseudovector pointer P to its underlying struct T pointer. + Verify that the struct is small, since cleanup_vector is called + only on small vector-like objects. */ + +#define PSEUDOVEC_STRUCT(p, t) \ + verify_expr ((header_size + VECSIZE (struct t) * word_size \ + <= VBLOCK_BYTES_MAX), \ + (struct t *) (p)) + /* Release extra resources still in use by VECTOR, which may be any - vector-like object. */ + small vector-like object. */ static void cleanup_vector (struct Lisp_Vector *vector) { detect_suspicious_free (vector); - if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FONT) - && ((vector->header.size & PSEUDOVECTOR_SIZE_MASK) - == FONT_OBJECT_MAX)) + if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FONT)) { - struct font_driver const *drv = ((struct font *) vector)->driver; - - /* The font driver might sometimes be NULL, e.g. if Emacs was - interrupted before it had time to set it up. */ - if (drv) + if ((vector->header.size & PSEUDOVECTOR_SIZE_MASK) == FONT_OBJECT_MAX) { - /* Attempt to catch subtle bugs like Bug#16140. */ - eassert (valid_font_driver (drv)); - drv->close ((struct font *) vector); + struct font *font = PSEUDOVEC_STRUCT (vector, font); + struct font_driver const *drv = font->driver; + + /* The font driver might sometimes be NULL, e.g. if Emacs was + interrupted before it had time to set it up. */ + if (drv) + { + /* Attempt to catch subtle bugs like Bug#16140. */ + eassert (valid_font_driver (drv)); + drv->close (font); + } } } - - if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_THREAD)) - finalize_one_thread ((struct thread_state *) vector); + else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_THREAD)) + finalize_one_thread (PSEUDOVEC_STRUCT (vector, thread_state)); else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_MUTEX)) - finalize_one_mutex ((struct Lisp_Mutex *) vector); + finalize_one_mutex (PSEUDOVEC_STRUCT (vector, Lisp_Mutex)); else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_CONDVAR)) - finalize_one_condvar ((struct Lisp_CondVar *) vector); + finalize_one_condvar (PSEUDOVEC_STRUCT (vector, Lisp_CondVar)); } /* Reclaim space used by unmarked vectors. */ commit 00fb12703142938e7dfcfb0b3373a38f1dddecc0 Author: Glenn Morris Date: Wed Aug 8 19:58:29 2018 -0400 * test/lisp/wdired-tests.el (wdired-test-unfinished-edit-01): Fix typo. diff --git a/test/lisp/wdired-tests.el b/test/lisp/wdired-tests.el index b4ef4ab248..f1ec4afb6c 100644 --- a/test/lisp/wdired-tests.el +++ b/test/lisp/wdired-tests.el @@ -116,13 +116,13 @@ wdired-mode." (kill-region (point) (progn (search-forward ".") (forward-char -1) (point))) (insert replace) - (should (equal (dired-get-filename) new-file)))) + (should (equal (dired-get-filename) new-file))) (when buf (with-current-buffer buf ;; Prevent kill-buffer-query-functions from chiming in. (set-buffer-modified-p nil) (kill-buffer buf))) - (delete-directory test-dir t)))) + (delete-directory test-dir t))))) (provide 'wdired-tests) commit 90dba077cff06b4f2566acb028286fbffa57f22f Author: Tom Tromey Date: Wed Aug 8 17:34:42 2018 -0600 Fix mod-test-sum-test for bignums * test/src/emacs-module-tests.el (mod-test-sum-test): Update for bignums. diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index 9ef5a47b15..90cd37a98a 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -68,10 +68,10 @@ (1+ #x1fffffff))) (should (= (mod-test-sum -1 (1+ #x1fffffff)) #x1fffffff))) - (should-error (mod-test-sum 1 most-positive-fixnum) - :type 'overflow-error) - (should-error (mod-test-sum -1 most-negative-fixnum) - :type 'overflow-error)) + (should (= (mod-test-sum 1 most-positive-fixnum) + (1+ most-positive-fixnum))) + (should (= (mod-test-sum -1 most-negative-fixnum) + (1- most-negative-fixnum)))) (ert-deftest mod-test-sum-docstring () (should (string= (documentation 'mod-test-sum) "Return A + B\n\n(fn a b)"))) commit 5ebf062ebe0ec0536efd4f1fb4f37d75f892664b Author: Tom Tromey Date: Wed Aug 8 17:33:24 2018 -0600 Handle leading "+" when converting string to bignum * src/lread.c (string_to_number): Skip leading "+" when calling make_bignum_str. diff --git a/src/lread.c b/src/lread.c index bcb695c3da..3a2d9c8a6d 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3792,21 +3792,16 @@ string_to_number (char const *string, int base, int flags) range, use its value, preferably as a fixnum. */ if (leading_digit >= 0 && ! float_syntax) { - if (state & INTOVERFLOW) - { - /* Unfortunately there's no simple and accurate way to convert - non-base-10 numbers that are out of C-language range. */ - if (base != 10) - flags = 0; - } - else if (n <= (negative ? -MOST_NEGATIVE_FIXNUM : MOST_POSITIVE_FIXNUM)) + if ((state & INTOVERFLOW) == 0 + && n <= (negative ? -MOST_NEGATIVE_FIXNUM : MOST_POSITIVE_FIXNUM)) { EMACS_INT signed_n = n; return make_fixnum (negative ? -signed_n : signed_n); } - else - value = n; + /* Skip a leading "+". */ + if (signedp && !negative) + ++string; return make_bignum_str (string, base); } commit 18588bce36617179cc7c8af74a6197c8e16819ea Author: Lars Ingebrigtsen Date: Sun Jul 22 13:39:10 2018 +0200 Make async :family 'local failures fail correctly again * src/fileio.c (get_file_errno_data): Refactor out into its own function so that we can reuse the error handling from an async context (bug#31901). * src/process.c (connect_network_socket): When an async :family 'local client fails (with a file error, for instance), mark the process as failed. (cherry picked from commit 92ba34d89ac4f5b5bbb818e1c39a3cc12a405790) diff --git a/src/fileio.c b/src/fileio.c index 9dbe3ad788..e2be7fe2c6 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -195,8 +195,8 @@ check_writable (const char *filename, int amode) list before reporting it; this saves report_file_errno's caller the trouble of preserving errno before calling list1. */ -void -report_file_errno (char const *string, Lisp_Object name, int errorno) +Lisp_Object +get_file_errno_data (char const *string, Lisp_Object name, int errorno) { Lisp_Object data = CONSP (name) || NILP (name) ? name : list1 (name); char *str = emacs_strerror (errorno); @@ -206,10 +206,18 @@ report_file_errno (char const *string, Lisp_Object name, int errorno) Lisp_Object errdata = Fcons (errstring, data); if (errorno == EEXIST) - xsignal (Qfile_already_exists, errdata); + return Fcons (Qfile_already_exists, errdata); else - xsignal (errorno == ENOENT ? Qfile_missing : Qfile_error, - Fcons (build_string (string), errdata)); + return Fcons (errorno == ENOENT ? Qfile_missing : Qfile_error, + Fcons (build_string (string), errdata)); +} + +void +report_file_errno (char const *string, Lisp_Object name, int errorno) +{ + Lisp_Object data = get_file_errno_data (string, name, errorno); + + xsignal (Fcar (data), Fcdr (data)); } /* Signal a file-access failure that set errno. STRING describes the diff --git a/src/lisp.h b/src/lisp.h index b2449cb87d..05d1cd8201 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4031,6 +4031,7 @@ extern Lisp_Object write_region (Lisp_Object, Lisp_Object, Lisp_Object, extern void close_file_unwind (int); extern void fclose_unwind (void *); extern void restore_point_unwind (Lisp_Object); +extern Lisp_Object get_file_errno_data (const char *, Lisp_Object, int); extern _Noreturn void report_file_errno (const char *, Lisp_Object, int); extern _Noreturn void report_file_error (const char *, Lisp_Object); extern _Noreturn void report_file_notify_error (const char *, Lisp_Object); diff --git a/src/process.c b/src/process.c index 8629f834e7..676f38446e 100644 --- a/src/process.c +++ b/src/process.c @@ -3578,17 +3578,23 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, if (s < 0) { + const char *err = (p->is_server + ? "make server process failed" + : "make client process failed"); + /* If non-blocking got this far - and failed - assume non-blocking is not supported after all. This is probably a wrong assumption, but the normal blocking calls to open-network-stream handles this error better. */ if (p->is_non_blocking_client) - return; + { + Lisp_Object data = get_file_errno_data (err, contact, xerrno); + + pset_status (p, list2 (Fcar (data), Fcdr (data))); + return; + } - report_file_errno ((p->is_server - ? "make server process failed" - : "make client process failed"), - contact, xerrno); + report_file_errno (err, contact, xerrno); } inch = s; commit 5afbf62674e741b06c01216fe37a5439e9d42307 Author: Noam Postavsky Date: Mon Jul 23 21:01:01 2018 -0400 Fix emacsclient check for term.el buffer (Bug#21041) * lib-src/emacsclient.c (find_tty): Check for any TERM value with prefix of "eterm", not just "eterm" itself. Also check for ",term:" in INSIDE_EMACS value. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index b139b2fe3f..b0243f99c2 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -1114,7 +1114,9 @@ find_tty (const char **tty_type, const char **tty_name, int noabort) } } - if (strcmp (type, "eterm") == 0) + const char *inside_emacs = egetenv ("INSIDE_EMACS"); + if (inside_emacs && strstr (inside_emacs, ",term:") + && strprefix ("eterm", type)) { if (noabort) return 0; commit d3549c190152921dd05e694d41e02a002789d191 Author: Tom Tromey Date: Wed Aug 8 17:01:55 2018 -0600 Use mpz_import in mpz_set_uintmax_slow * src/alloc.c (mpz_set_uintmax_slow): Use mpz_import. diff --git a/src/alloc.c b/src/alloc.c index edfb87e5cd..1504d7912b 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3874,12 +3874,12 @@ mpz_set_uintmax_slow (mpz_t result, uintmax_t v) { /* If long is larger then a faster path is taken. */ eassert (sizeof (uintmax_t) > sizeof (unsigned long)); - /* This restriction could be lifted if needed. */ - eassert (sizeof (uintmax_t) <= 2 * sizeof (unsigned long)); - mpz_set_ui (result, v >> (CHAR_BIT * sizeof (unsigned long))); - mpz_mul_2exp (result, result, CHAR_BIT * sizeof (unsigned long)); - mpz_add_ui (result, result, v & -1ul); + /* COUNT = 1 means just a single word of the given size. ORDER = -1 + is arbitrary since there's only a single word. ENDIAN = 0 means + use the native endian-ness. NAILS = 0 means use the whole + word. */ + mpz_import (result, 1, -1, sizeof (uintmax_t), 0, 0, &v); } commit fb26c9fd69d93aaa789e71365c030083c7f3c775 Author: Tom Tromey Date: Wed Aug 8 17:01:14 2018 -0600 Make purecopy work for bignums * src/alloc.c (make_pure_bignum): New function. (purecopy): Use it. diff --git a/src/alloc.c b/src/alloc.c index 512fdadfb2..edfb87e5cd 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -5535,6 +5535,34 @@ make_pure_float (double num) return new; } +/* Value is a bignum object with value VALUE allocated from pure + space. */ + +static Lisp_Object +make_pure_bignum (struct Lisp_Bignum *value) +{ + Lisp_Object new; + size_t i, nlimbs = mpz_size (value->value); + size_t nbytes = nlimbs * sizeof (mp_limb_t); + mp_limb_t *pure_limbs; + mp_size_t new_size; + + struct Lisp_Bignum *b = pure_alloc (sizeof (struct Lisp_Bignum), Lisp_Misc); + b->type = Lisp_Misc_Bignum; + + pure_limbs = pure_alloc (nbytes, -1); + for (i = 0; i < nlimbs; ++i) + pure_limbs[i] = mpz_getlimbn (value->value, i); + + new_size = nlimbs; + if (mpz_sgn (value->value) < 0) + new_size = -new_size; + + mpz_roinit_n (b->value, pure_limbs, new_size); + + XSETMISC (new, b); + return new; +} /* Return a vector with room for LEN Lisp_Objects allocated from pure space. */ @@ -5676,6 +5704,8 @@ purecopy (Lisp_Object obj) /* Don't hash-cons it. */ return obj; } + else if (BIGNUMP (obj)) + obj = make_pure_bignum (XBIGNUM (obj)); else { AUTO_STRING (fmt, "Don't know how to purify: %S"); commit 7eef590870a35008d55a04efcd76780b7668c3ec Author: Charles A. Roelli Date: Wed Aug 8 21:26:33 2018 +0200 ; Fix typos in commentary * src/xdisp.c (windows_or_buffers_changed, update_mode_lines) (get_phys_cursor_geometry, display_echo_area_1) (resize_mini_window_1): * src/dispextern.h (struct it): Fix typos in commentary. diff --git a/src/dispextern.h b/src/dispextern.h index 2180c9ae63..0822d71213 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -2482,7 +2482,7 @@ struct it If `what' is anything else, these two are undefined (will probably hold values for the last IT_CHARACTER or IT_COMPOSITION - traversed by the iterator. + traversed by the iterator). The values are updated by get_next_display_element, so they are out of sync with the value returned by IT_CHARPOS between the diff --git a/src/xdisp.c b/src/xdisp.c index 8f89ec559a..956535c2db 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -467,12 +467,12 @@ static bool message_enable_multibyte; looking for those `redisplay' bits (actually, there might be some such bits set, but then only on objects which aren't displayed anyway). - OTOH if it's non-zero we wil have to loop through all windows and then check - the `redisplay' bit of the corresponding window, frame, and buffer, in order - to decide whether that window needs attention or not. Note that we can't - just look at the frame's redisplay bit to decide that the whole frame can be - skipped, since even if the frame's redisplay bit is unset, some of its - windows's redisplay bits may be set. + OTOH if it's non-zero we will have to loop through all windows and then + check the `redisplay' bit of the corresponding window, frame, and buffer, in + order to decide whether that window needs attention or not. Note that we + can't just look at the frame's redisplay bit to decide that the whole frame + can be skipped, since even if the frame's redisplay bit is unset, some of + its windows's redisplay bits may be set. Mostly for historical reasons, windows_or_buffers_changed can also take other non-zero values. In that case, the precise value doesn't matter (it @@ -483,7 +483,7 @@ static bool message_enable_multibyte; int windows_or_buffers_changed; /* Nonzero if we should redraw the mode lines on the next redisplay. - Similarly to `windows_or_buffers_changed', If it has value REDISPLAY_SOME, + Similarly to `windows_or_buffers_changed', if it has value REDISPLAY_SOME, then only redisplay the mode lines in those buffers/windows/frames where the `redisplay' bit has been set. For any other value, redisplay all mode lines (the number used is then only @@ -2281,9 +2281,9 @@ get_phys_cursor_geometry (struct window *w, struct glyph_row *row, int x, y, wd, h, h0, y0, ascent; /* Compute the width of the rectangle to draw. If on a stretch - glyph, and `x-stretch-block-cursor' is nil, don't draw a - rectangle as wide as the glyph, but use a canonical character - width instead. */ + glyph, and `x-stretch-cursor' is nil, don't draw a rectangle + as wide as the glyph, but use a canonical character width + instead. */ wd = glyph->pixel_width; x = w->phys_cursor.x; @@ -11148,7 +11148,7 @@ display_echo_area (struct window *w) /* Helper for display_echo_area. Display the current buffer which contains the current echo area message in window W, a mini-window, - a pointer to which is passed in A1. A2..A4 are currently not used. + a pointer to which is passed in A1. A2 is currently not used. Change the height of W so that all of the message is displayed. Value is true if height of W was changed. */ @@ -11209,8 +11209,8 @@ resize_echo_area_exactly (void) /* Callback function for with_echo_area_buffer, when used from resize_echo_area_exactly. A1 contains a pointer to the window to resize, EXACTLY non-nil means resize the mini-window exactly to the - size of the text displayed. A3 and A4 are not used. Value is what - resize_mini_window returns. */ + size of the text displayed. Value is what resize_mini_window + returns. */ static bool resize_mini_window_1 (ptrdiff_t a1, Lisp_Object exactly) commit 5025fb617d19f08d907e89697616d4dfd912baa5 Author: Michael Albinus Date: Wed Aug 8 19:57:54 2018 +0200 Fix problems in tramp-tests * test/lisp/net/tramp-tests.el (tramp-test45-unload): Filter out tramp-archive objects. (Bug#32304) * test/lisp/net/tramp-tests.el (tramp-test43-auto-load): Add skip condition. (Bug#32304) (tramp-test43-unload): Tag as :unstable. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index da360fe566..7ca680087a 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -5056,6 +5056,8 @@ process sentinels. They shall not disturb each other." ;; This test is inspired by Bug#29163. (ert-deftest tramp-test43-auto-load () "Check that Tramp autoloads properly." + (skip-unless (tramp--test-enabled)) + (let ((default-directory (expand-file-name temporary-file-directory)) (code (format @@ -5160,7 +5162,7 @@ process sentinels. They shall not disturb each other." (ert-deftest tramp-test44-unload () "Check that Tramp and its subpackages unload completely. Since it unloads Tramp, it shall be the last test to run." - :tags '(:expensive-test) + :tags '(:expensive-test :unstable) (skip-unless noninteractive) ;; The autoloaded Tramp objects are different since Emacs 26.1. We ;; cannot test older Emacsen, therefore. @@ -5230,6 +5232,7 @@ Since it unloads Tramp, it shall be the last test to run." ;; * Fix `tramp-test29-start-file-process' on MS Windows (`process-send-eof'?). ;; * Fix `tramp-test30-interrupt-process', timeout doesn't work reliably. ;; * Fix Bug#16928 in `tramp-test42-asynchronous-requests'. +;; * Check why `tramp-test44-unload' fails when running as only test. (provide 'tramp-tests) ;;; tramp-tests.el ends here commit 5132a5856dcf0278811740551f435d8f301d2a72 Author: Eli Zaretskii Date: Wed Aug 8 18:24:45 2018 +0300 Improve documentation of 'set-fontset-font' * doc/lispref/display.texi (Fontsets): Fix description of 'set-fontset-font'. * src/fontset.c (Fset_fontset_font): Doc fix. (Bug#32401) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 0f7322a640..aed103ee2c 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -3457,11 +3457,15 @@ cons @code{(@var{from} . @var{to})}, where @var{from} and @var{to} are character codepoints. In that case, use @var{font-spec} for all the characters in the range @var{from} and @var{to} (inclusive). -@var{character} may be a charset. In that case, use -@var{font-spec} for all character in the charsets. +@var{character} may be a charset (@pxref{Character Sets}). In that +case, use @var{font-spec} for all the characters in the charset. -@var{character} may be a script name. In that case, use -@var{font-spec} for all character in the charsets. +@var{character} may be a script name (@pxref{Character Properties}). +In that case, use @var{font-spec} for all the characters belonging to +the script. + +@var{character} may be @code{nil}, which means to use @var{font-spec} +for any character which no font-spec is specified. @var{font-spec} may be a font-spec object created by the function @code{font-spec} (@pxref{Low-Level Font}). @@ -3471,7 +3475,7 @@ where @var{family} is a family name of a font (possibly including a foundry name at the head), @var{registry} is a registry name of a font (possibly including an encoding name at the tail). -@var{font-spec} may be a font name string. +@var{font-spec} may be a font name, a string. @var{font-spec} may be @code{nil}, which explicitly specifies that there's no font for the specified @var{character}. This is useful, diff --git a/src/fontset.c b/src/fontset.c index 6ca6406871..e72354078c 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -1442,23 +1442,26 @@ DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 5, 0, doc: /* Modify fontset NAME to use FONT-SPEC for TARGET characters. -NAME is a fontset name string, nil for the fontset of FRAME, or t for -the default fontset. +NAME is a fontset name (a string), nil for the fontset of FRAME, +or t for the default fontset. TARGET may be a single character to use FONT-SPEC for. Target may be a cons (FROM . TO), where FROM and TO are characters. -In that case, use FONT-SPEC for all characters in the range FROM -and TO (inclusive). +In that case, use FONT-SPEC for all the characters in the range +between FROM and TO (inclusive). -TARGET may be a script name symbol. In that case, use FONT-SPEC for -all characters that belong to the script. +TARGET may be a script symbol. In that case, use FONT-SPEC for +all the characters that belong to the script. See the variable +`script-representative-chars' for the list of known scripts. TARGET may be a charset. In that case, use FONT-SPEC for all -characters in the charset. +the characters in the charset. See `list-character-sets' and +`list-charset-chars' for the list of character sets and their +characters. -TARGET may be nil. In that case, use FONT-SPEC for any characters for -that no FONT-SPEC is specified. +TARGET may be nil. In that case, use FONT-SPEC for any character for +which no font-spec is specified. FONT-SPEC may one of these: * A font-spec object made by the function `font-spec' (which see). @@ -1468,11 +1471,11 @@ FONT-SPEC may one of these: * A font name string. * nil, which explicitly specifies that there's no font for TARGET. -Optional 4th argument FRAME is a frame or nil for the selected frame -that is concerned in the case that NAME is nil. +Optional 4th argument FRAME is a frame, or nil for the selected frame, +to be considered in the case that NAME is nil. Optional 5th argument ADD, if non-nil, specifies how to add FONT-SPEC -to the font specifications for TARGET previously set. If it is +to the previously set font specifications for TARGET. If it is `prepend', FONT-SPEC is prepended. If it is `append', FONT-SPEC is appended. By default, FONT-SPEC overrides the previous settings. */) (Lisp_Object name, Lisp_Object target, Lisp_Object font_spec, Lisp_Object frame, Lisp_Object add) commit c85ff212dcd0817b833032650f1d52850e8a3c2e Author: Michael Albinus Date: Wed Aug 8 16:22:23 2018 +0200 ; More instrumentation for shadowfile-tests.el diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el index 085ab476ff..0335caa516 100644 --- a/test/lisp/shadowfile-tests.el +++ b/test/lisp/shadowfile-tests.el @@ -720,6 +720,10 @@ guaranteed by the originator of a cluster definition." (unwind-protect (condition-case err (progn + (require 'trace) + (dolist (elt (all-completions "shadow-" obarray 'functionp)) + (trace-function-background (intern elt))) + (trace-function-background 'save-buffer) ;; Cleanup. (when (file-exists-p shadow-info-file) (delete-file shadow-info-file)) @@ -817,6 +821,9 @@ guaranteed by the originator of a cluster definition." shadow-files-to-copy))) (error (message "Error: %s" err) (signal (car err) (cdr err)))) + (untrace-all) + (message "%s" (with-current-buffer trace-buffer (buffer-string))) + ;; Cleanup. (when (file-exists-p shadow-info-file) (delete-file shadow-info-file)) commit c9f13b9ea3c6b8f1e70c722462c74caa25708c21 Author: Michael Albinus Date: Wed Aug 8 15:38:10 2018 +0200 Filter out tramp-archive objects in tramp-test45-unload * test/lisp/net/tramp-tests.el (tramp-test45-unload): Filter out tramp-archive objects. (Bug#32304) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index c0298bb709..da360fe566 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -5167,10 +5167,14 @@ Since it unloads Tramp, it shall be the last test to run." (skip-unless (tramp--test-emacs26-p)) (when (featurep 'tramp) + ;; This unloads also tramp-archive.el if needed. (unload-feature 'tramp 'force) ;; No Tramp feature must be left. (should-not (featurep 'tramp)) - (should-not (all-completions "tramp" (delq 'tramp-tests features))) + (should-not (featurep 'tramp-archive)) + (should-not + (all-completions + "tramp" (delq 'tramp-tests (delq 'tramp-archive-tests features)))) ;; `file-name-handler-alist' must be clean. (should-not (all-completions "tramp" (mapcar 'cdr file-name-handler-alist))) ;; There shouldn't be left a bound symbol, except buffer-local @@ -5181,7 +5185,7 @@ Since it unloads Tramp, it shall be the last test to run." (and (or (and (boundp x) (null (local-variable-if-set-p x))) (and (functionp x) (null (autoloadp (symbol-function x))))) (string-match "^tramp" (symbol-name x)) - (not (string-match "^tramp--?test" (symbol-name x))) + (not (string-match "^tramp\\(-archive\\)?--?test" (symbol-name x))) (not (string-match "unload-hook$" (symbol-name x))) (ert-fail (format "`%s' still bound" x))))) ;; The defstruct `tramp-file-name' and all its internal functions @@ -5222,7 +5226,7 @@ Since it unloads Tramp, it shall be the last test to run." ;; * Fix `tramp-test05-expand-file-name-relative' in `expand-file-name'. ;; * Fix `tramp-test06-directory-file-name' for `ftp'. ;; * Investigate, why `tramp-test11-copy-file' and `tramp-test12-rename-file' -;; do not work properly for `owncloud'. +;; do not work properly for `nextcloud'. ;; * Fix `tramp-test29-start-file-process' on MS Windows (`process-send-eof'?). ;; * Fix `tramp-test30-interrupt-process', timeout doesn't work reliably. ;; * Fix Bug#16928 in `tramp-test42-asynchronous-requests'. commit 31929031e38fae9ebaf221e4df27d2138b869e06 Author: Michael Albinus Date: Wed Aug 8 14:59:56 2018 +0200 Tag expensive tests in tramp-archive.el (Bug#30807) * test/lisp/net/tramp-archive-tests.el (tramp-archive-test44-auto-load) (tramp-archive-test44-delay-load): Rename. (tramp-archive-test07-file-exists-p) (tramp-archive-test08-file-local-copy) (tramp-archive-test09-insert-file-contents) (tramp-archive-test11-copy-file) (tramp-archive-test15-copy-directory) (tramp-archive-test16-directory-files) (tramp-archive-test17-insert-directory) (tramp-archive-test18-file-attributes) (tramp-archive-test19-directory-files-and-attributes) (tramp-archive-test20-file-modes) (tramp-archive-test21-file-links) (tramp-archive-test26-file-name-completion) (tramp-archive-test44-auto-load) (tramp-archive-test44-delay-load): Tag them as :expensive-test, because they run longer than 10 seconds. (Bug#30807) diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index 0a8716be0d..e7597864c6 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el @@ -311,6 +311,7 @@ This checks also `file-name-as-directory', `file-name-directory', (ert-deftest tramp-archive-test07-file-exists-p () "Check `file-exist-p', `write-region' and `delete-file'." + :tags '(:expensive-test) (skip-unless tramp-archive-enabled) (unwind-protect @@ -333,6 +334,7 @@ This checks also `file-name-as-directory', `file-name-directory', (ert-deftest tramp-archive-test08-file-local-copy () "Check `file-local-copy'." + :tags '(:expensive-test) (skip-unless tramp-archive-enabled) (let (tmp-name) @@ -359,6 +361,7 @@ This checks also `file-name-as-directory', `file-name-directory', (ert-deftest tramp-archive-test09-insert-file-contents () "Check `insert-file-contents'." + :tags '(:expensive-test) (skip-unless tramp-archive-enabled) (let ((tmp-name (expand-file-name "bar/bar" tramp-archive-test-archive))) @@ -385,6 +388,7 @@ This checks also `file-name-as-directory', `file-name-directory', (ert-deftest tramp-archive-test11-copy-file () "Check `copy-file'." + :tags '(:expensive-test) (skip-unless tramp-archive-enabled) ;; Copy simple file. @@ -450,6 +454,7 @@ This checks also `file-name-as-directory', `file-name-directory', (ert-deftest tramp-archive-test15-copy-directory () "Check `copy-directory'." + :tags '(:expensive-test) (skip-unless tramp-archive-enabled) (let* ((tmp-name1 (expand-file-name "bar" tramp-archive-test-archive)) @@ -504,6 +509,7 @@ This checks also `file-name-as-directory', `file-name-directory', (ert-deftest tramp-archive-test16-directory-files () "Check `directory-files'." + :tags '(:expensive-test) (skip-unless tramp-archive-enabled) (let ((tmp-name tramp-archive-test-archive) @@ -527,6 +533,7 @@ This checks also `file-name-as-directory', `file-name-directory', (ert-deftest tramp-archive-test17-insert-directory () "Check `insert-directory'." + :tags '(:expensive-test) (skip-unless tramp-archive-enabled) (let (;; We test for the summary line. Keyword "total" could be localized. @@ -569,6 +576,7 @@ This checks also `file-name-as-directory', `file-name-directory', (ert-deftest tramp-archive-test18-file-attributes () "Check `file-attributes'. This tests also `file-readable-p' and `file-regular-p'." + :tags '(:expensive-test) (skip-unless tramp-archive-enabled) (let ((tmp-name1 (expand-file-name "foo.txt" tramp-archive-test-archive)) @@ -619,6 +627,7 @@ This tests also `file-readable-p' and `file-regular-p'." (ert-deftest tramp-archive-test19-directory-files-and-attributes () "Check `directory-files-and-attributes'." + :tags '(:expensive-test) (skip-unless tramp-archive-enabled) (let ((tmp-name (expand-file-name "bar" tramp-archive-test-archive)) @@ -644,6 +653,7 @@ This tests also `file-readable-p' and `file-regular-p'." (ert-deftest tramp-archive-test20-file-modes () "Check `file-modes'. This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." + :tags '(:expensive-test) (skip-unless tramp-archive-enabled) (let ((tmp-name1 (expand-file-name "foo.txt" tramp-archive-test-archive)) @@ -673,6 +683,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (ert-deftest tramp-archive-test21-file-links () "Check `file-symlink-p' and `file-truename'" + :tags '(:expensive-test) (skip-unless tramp-archive-enabled) ;; We must use `file-truename' for the file archive, because it @@ -711,6 +722,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (ert-deftest tramp-archive-test26-file-name-completion () "Check `file-name-completion' and `file-name-all-completions'." + :tags '(:expensive-test) (skip-unless tramp-archive-enabled) (let ((tmp-name tramp-archive-test-archive)) @@ -802,8 +814,9 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (zerop (nth 1 fsi)) (zerop (nth 2 fsi)))))) -(ert-deftest tramp-archive-test43-auto-load () +(ert-deftest tramp-archive-test44-auto-load () "Check that `tramp-archive' autoloads properly." + :tags '(:expensive-test) (skip-unless tramp-archive-enabled) ;; Autoloading tramp-archive works since Emacs 27.1. (skip-unless (tramp-archive--test-emacs27-p)) @@ -832,8 +845,9 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (mapconcat 'shell-quote-argument load-path " -L ") (shell-quote-argument (format code file))))))))) -(ert-deftest tramp-archive-test43-delay-load () +(ert-deftest tramp-archive-test44-delay-load () "Check that `tramp-archive' is loaded lazily, only when needed." + :tags '(:expensive-test) (skip-unless tramp-archive-enabled) ;; Autoloading tramp-archive works since Emacs 27.1. (skip-unless (tramp-archive--test-emacs27-p)) commit d1ec3a0a8e4d7d56ebc1e4fa743130b9974ac6a8 Author: Tom Tromey Date: Tue Aug 7 18:08:53 2018 -0600 More macro renamings for bignum * src/alloc.c, src/bidi.c, src/buffer.c, src/buffer.h, src/bytecode.c, src/callint.c, src/callproc.c, src/casefiddle.c, src/casetab.c, src/category.c, src/ccl.c, src/character.c, src/character.h, src/charset.c, src/charset.h, src/chartab.c, src/cmds.c, src/coding.c, src/composite.c, src/composite.h, src/data.c, src/dbusbind.c, src/decompress.c, src/dired.c, src/dispextern.h, src/dispnew.c, src/disptab.h, src/doc.c, src/dosfns.c, src/editfns.c, src/emacs-module.c, src/emacs.c, src/eval.c, src/fileio.c, src/floatfns.c, src/fns.c, src/font.c, src/font.h, src/fontset.c, src/frame.c, src/frame.h, src/fringe.c, src/ftcrfont.c, src/ftfont.c, src/gfilenotify.c, src/gnutls.c, src/gtkutil.c, src/image.c, src/indent.c, src/insdel.c, src/intervals.c, src/json.c, src/keyboard.c, src/keymap.c, src/kqueue.c, src/lcms.c, src/lisp.h, src/lread.c, src/macros.c, src/marker.c, src/menu.c, src/minibuf.c, src/msdos.c, src/print.c, src/process.c, src/profiler.c, src/search.c, src/sound.c, src/syntax.c, src/syntax.h, src/sysdep.c, src/term.c, src/termhooks.h, src/textprop.c, src/undo.c, src/w32.c, src/w32console.c, src/w32fns.c, src/w32font.c, src/w32inevt.c, src/w32proc.c, src/w32select.c, src/w32term.c, src/w32term.h, src/w32uniscribe.c, src/window.c, src/xdisp.c, src/xfaces.c, src/xfns.c, src/xfont.c, src/xftfont.c, src/xmenu.c, src/xml.c, src/xrdb.c, src/xselect.c, src/xsettings.c, src/xterm.c, src/xwidget.c Rename XINT->XFIXNUM, XFASTINT->XFIXNAT, XUINT->XUFIXNUM. diff --git a/src/alloc.c b/src/alloc.c index 367bb73fc1..512fdadfb2 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2324,10 +2324,10 @@ a multibyte string even if INIT is an ASCII character. */) CHECK_FIXNAT (length); CHECK_CHARACTER (init); - c = XFASTINT (init); + c = XFIXNAT (init); if (ASCII_CHAR_P (c) && NILP (multibyte)) { - nbytes = XINT (length); + nbytes = XFIXNUM (length); val = make_uninit_string (nbytes); if (nbytes) { @@ -2339,7 +2339,7 @@ a multibyte string even if INIT is an ASCII character. */) { unsigned char str[MAX_MULTIBYTE_LENGTH]; ptrdiff_t len = CHAR_STRING (c, str); - EMACS_INT string_len = XINT (length); + EMACS_INT string_len = XFIXNUM (length); unsigned char *p, *beg, *end; if (INT_MULTIPLY_WRAPV (len, string_len, &nbytes)) @@ -2416,7 +2416,7 @@ LENGTH must be a number. INIT matters only in whether it is t or nil. */) Lisp_Object val; CHECK_FIXNAT (length); - val = make_uninit_bool_vector (XFASTINT (length)); + val = make_uninit_bool_vector (XFIXNAT (length)); return bool_vector_fill (val, init); } @@ -2896,7 +2896,7 @@ DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0, Lisp_Object val = Qnil; CHECK_FIXNAT (length); - for (EMACS_INT size = XFASTINT (length); 0 < size; size--) + for (EMACS_INT size = XFIXNAT (length); 0 < size; size--) { val = Fcons (init, val); rarely_quit (size); @@ -3440,7 +3440,7 @@ each initialized to INIT. */) (Lisp_Object type, Lisp_Object slots, Lisp_Object init) { CHECK_FIXNAT (slots); - EMACS_INT size = XFASTINT (slots) + 1; + EMACS_INT size = XFIXNAT (slots) + 1; struct Lisp_Vector *p = allocate_record (size); p->contents[0] = type; for (ptrdiff_t i = 1; i < size; i++) @@ -3469,8 +3469,8 @@ See also the function `vector'. */) (Lisp_Object length, Lisp_Object init) { CHECK_FIXNAT (length); - struct Lisp_Vector *p = allocate_vector (XFASTINT (length)); - for (ptrdiff_t i = 0; i < XFASTINT (length); i++) + struct Lisp_Vector *p = allocate_vector (XFIXNAT (length)); + for (ptrdiff_t i = 0; i < XFIXNAT (length); i++) p->contents[i] = init; return make_lisp_ptr (p, Lisp_Vectorlike); } @@ -3899,7 +3899,7 @@ make_event_array (ptrdiff_t nargs, Lisp_Object *args) are characters that are in 0...127, after discarding the meta bit and all the bits above it. */ if (!FIXNUMP (args[i]) - || (XINT (args[i]) & ~(-CHAR_META)) >= 0200) + || (XFIXNUM (args[i]) & ~(-CHAR_META)) >= 0200) return Fvector (nargs, args); /* Since the loop exited, we know that all the things in it are @@ -3910,9 +3910,9 @@ make_event_array (ptrdiff_t nargs, Lisp_Object *args) result = Fmake_string (make_fixnum (nargs), make_fixnum (0), Qnil); for (i = 0; i < nargs; i++) { - SSET (result, i, XINT (args[i])); + SSET (result, i, XFIXNUM (args[i])); /* Move the meta bit to the right place for a string char. */ - if (XINT (args[i]) & CHAR_META) + if (XFIXNUM (args[i]) & CHAR_META) SSET (result, i, SREF (result, i) | 0x80); } diff --git a/src/bidi.c b/src/bidi.c index 30a7d6673e..a53a2295c0 100644 --- a/src/bidi.c +++ b/src/bidi.c @@ -280,7 +280,7 @@ bidi_get_type (int ch, bidi_dir_t override) if (ch < 0 || ch > MAX_CHAR) emacs_abort (); - default_type = (bidi_type_t) XINT (CHAR_TABLE_REF (bidi_type_table, ch)); + default_type = (bidi_type_t) XFIXNUM (CHAR_TABLE_REF (bidi_type_table, ch)); /* Every valid character code, even those that are unassigned by the UCD, have some bidi-class property, according to DerivedBidiClass.txt file. Therefore, if we ever get UNKNOWN_BT @@ -385,9 +385,9 @@ bidi_mirror_char (int c) /* When debugging, check before assigning to V, so that the check isn't broken by undefined behavior due to int overflow. */ - eassert (CHAR_VALID_P (XINT (val))); + eassert (CHAR_VALID_P (XFIXNUM (val))); - v = XINT (val); + v = XFIXNUM (val); /* Minimal test we must do in optimized builds, to prevent weird crashes further down the road. */ @@ -409,7 +409,7 @@ bidi_paired_bracket_type (int c) if (c < 0 || c > MAX_CHAR) emacs_abort (); - return (bidi_bracket_type_t) XINT (CHAR_TABLE_REF (bidi_brackets_table, c)); + return (bidi_bracket_type_t) XFIXNUM (CHAR_TABLE_REF (bidi_brackets_table, c)); } /* Determine the start-of-sequence (sos) directional type given the two @@ -1805,7 +1805,7 @@ bidi_explicit_dir_char (int ch) eassert (ch == BIDI_EOB); return false; } - ch_type = (bidi_type_t) XINT (CHAR_TABLE_REF (bidi_type_table, ch)); + ch_type = (bidi_type_t) XFIXNUM (CHAR_TABLE_REF (bidi_type_table, ch)); return (ch_type == LRE || ch_type == LRO || ch_type == RLE || ch_type == RLO || ch_type == PDF); diff --git a/src/buffer.c b/src/buffer.c index 2a165c5f54..ec6f464711 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -1102,8 +1102,8 @@ is first appended to NAME, to speed up finding a non-existent buffer. */) { char number[sizeof "-999999"]; - /* Use XINT instead of XFASTINT to work around GCC bug 80776. */ - int i = XINT (Frandom (make_fixnum (1000000))); + /* Use XFIXNUM instead of XFIXNAT to work around GCC bug 80776. */ + int i = XFIXNUM (Frandom (make_fixnum (1000000))); eassume (0 <= i && i < 1000000); AUTO_STRING_WITH_LEN (lnumber, number, sprintf (number, "-%d", i)); @@ -2236,13 +2236,13 @@ validate_region (register Lisp_Object *b, register Lisp_Object *e) CHECK_FIXNUM_COERCE_MARKER (*b); CHECK_FIXNUM_COERCE_MARKER (*e); - if (XINT (*b) > XINT (*e)) + if (XFIXNUM (*b) > XFIXNUM (*e)) { Lisp_Object tem; tem = *b; *b = *e; *e = tem; } - if (! (BEGV <= XINT (*b) && XINT (*e) <= ZV)) + if (! (BEGV <= XFIXNUM (*b) && XFIXNUM (*e) <= ZV)) args_out_of_range_3 (Fcurrent_buffer (), *b, *e); } @@ -3214,15 +3214,15 @@ sort_overlays (Lisp_Object *overlay_vec, ptrdiff_t noverlays, struct window *w) } else if (FIXNUMP (tem)) { - sortvec[j].priority = XINT (tem); + sortvec[j].priority = XFIXNUM (tem); sortvec[j].spriority = 0; } else if (CONSP (tem)) { Lisp_Object car = XCAR (tem); Lisp_Object cdr = XCDR (tem); - sortvec[j].priority = FIXNUMP (car) ? XINT (car) : 0; - sortvec[j].spriority = FIXNUMP (cdr) ? XINT (cdr) : 0; + sortvec[j].priority = FIXNUMP (car) ? XFIXNUM (car) : 0; + sortvec[j].spriority = FIXNUMP (cdr) ? XFIXNUM (cdr) : 0; } j++; } @@ -3290,7 +3290,7 @@ record_overlay_string (struct sortstrlist *ssl, Lisp_Object str, ssl->buf[ssl->used].string = str; ssl->buf[ssl->used].string2 = str2; ssl->buf[ssl->used].size = size; - ssl->buf[ssl->used].priority = (FIXNUMP (pri) ? XINT (pri) : 0); + ssl->buf[ssl->used].priority = (FIXNUMP (pri) ? XFIXNUM (pri) : 0); ssl->used++; if (NILP (BVAR (current_buffer, enable_multibyte_characters))) @@ -3870,7 +3870,7 @@ for the rear of the overlay advance when text is inserted there CHECK_FIXNUM_COERCE_MARKER (beg); CHECK_FIXNUM_COERCE_MARKER (end); - if (XINT (beg) > XINT (end)) + if (XFIXNUM (beg) > XFIXNUM (end)) { Lisp_Object temp; temp = beg; beg = end; end = temp; @@ -3990,7 +3990,7 @@ buffer. */) CHECK_FIXNUM_COERCE_MARKER (beg); CHECK_FIXNUM_COERCE_MARKER (end); - if (XINT (beg) > XINT (end)) + if (XFIXNUM (beg) > XFIXNUM (end)) { Lisp_Object temp; temp = beg; beg = end; end = temp; @@ -4167,7 +4167,7 @@ If SORTED is non-nil, then sort them by decreasing priority. */) /* Put all the overlays we want in a vector in overlay_vec. Store the length in len. */ - noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len, + noverlays = overlays_at (XFIXNUM (pos), 1, &overlay_vec, &len, NULL, NULL, 0); if (!NILP (sorted)) @@ -4211,7 +4211,7 @@ end of the buffer. */) /* Put all the overlays we want in a vector in overlay_vec. Store the length in len. */ - noverlays = overlays_in (XINT (beg), XINT (end), 1, &overlay_vec, &len, + noverlays = overlays_in (XFIXNUM (beg), XFIXNUM (end), 1, &overlay_vec, &len, NULL, NULL); /* Make a list of them all. */ @@ -4243,7 +4243,7 @@ the value is (point-max). */) /* Put all the overlays we want in a vector in overlay_vec. Store the length in len. endpos gets the position where the next overlay starts. */ - noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len, + noverlays = overlays_at (XFIXNUM (pos), 1, &overlay_vec, &len, &endpos, 0, 1); /* If any of these overlays ends before endpos, @@ -4281,7 +4281,7 @@ the value is (point-min). */) /* At beginning of buffer, we know the answer; avoid bug subtracting 1 below. */ - if (XINT (pos) == BEGV) + if (XFIXNUM (pos) == BEGV) return pos; len = 10; @@ -4290,7 +4290,7 @@ the value is (point-min). */) /* Put all the overlays we want in a vector in overlay_vec. Store the length in len. prevpos gets the position of the previous change. */ - overlays_at (XINT (pos), 1, &overlay_vec, &len, + overlays_at (XFIXNUM (pos), 1, &overlay_vec, &len, 0, &prevpos, 1); xfree (overlay_vec); @@ -4334,7 +4334,7 @@ for positions far away from POS). */) ptrdiff_t p; CHECK_FIXNUM_COERCE_MARKER (pos); - p = clip_to_bounds (PTRDIFF_MIN, XINT (pos), PTRDIFF_MAX); + p = clip_to_bounds (PTRDIFF_MIN, XFIXNUM (pos), PTRDIFF_MAX); recenter_overlay_lists (current_buffer, p); return Qnil; } @@ -4442,7 +4442,7 @@ report_overlay_modification (Lisp_Object start, Lisp_Object end, bool after, Lisp_Object prop, overlay; struct Lisp_Overlay *tail; /* True if this change is an insertion. */ - bool insertion = (after ? XFASTINT (arg3) == 0 : EQ (start, end)); + bool insertion = (after ? XFIXNAT (arg3) == 0 : EQ (start, end)); overlay = Qnil; tail = NULL; @@ -4470,18 +4470,18 @@ report_overlay_modification (Lisp_Object start, Lisp_Object end, bool after, ostart = OVERLAY_START (overlay); oend = OVERLAY_END (overlay); endpos = OVERLAY_POSITION (oend); - if (XFASTINT (start) > endpos) + if (XFIXNAT (start) > endpos) break; startpos = OVERLAY_POSITION (ostart); - if (insertion && (XFASTINT (start) == startpos - || XFASTINT (end) == startpos)) + if (insertion && (XFIXNAT (start) == startpos + || XFIXNAT (end) == startpos)) { prop = Foverlay_get (overlay, Qinsert_in_front_hooks); if (!NILP (prop)) add_overlay_mod_hooklist (prop, overlay); } - if (insertion && (XFASTINT (start) == endpos - || XFASTINT (end) == endpos)) + if (insertion && (XFIXNAT (start) == endpos + || XFIXNAT (end) == endpos)) { prop = Foverlay_get (overlay, Qinsert_behind_hooks); if (!NILP (prop)) @@ -4489,7 +4489,7 @@ report_overlay_modification (Lisp_Object start, Lisp_Object end, bool after, } /* Test for intersecting intervals. This does the right thing for both insertion and deletion. */ - if (XFASTINT (end) > startpos && XFASTINT (start) < endpos) + if (XFIXNAT (end) > startpos && XFIXNAT (start) < endpos) { prop = Foverlay_get (overlay, Qmodification_hooks); if (!NILP (prop)) @@ -4508,17 +4508,17 @@ report_overlay_modification (Lisp_Object start, Lisp_Object end, bool after, oend = OVERLAY_END (overlay); startpos = OVERLAY_POSITION (ostart); endpos = OVERLAY_POSITION (oend); - if (XFASTINT (end) < startpos) + if (XFIXNAT (end) < startpos) break; - if (insertion && (XFASTINT (start) == startpos - || XFASTINT (end) == startpos)) + if (insertion && (XFIXNAT (start) == startpos + || XFIXNAT (end) == startpos)) { prop = Foverlay_get (overlay, Qinsert_in_front_hooks); if (!NILP (prop)) add_overlay_mod_hooklist (prop, overlay); } - if (insertion && (XFASTINT (start) == endpos - || XFASTINT (end) == endpos)) + if (insertion && (XFIXNAT (start) == endpos + || XFIXNAT (end) == endpos)) { prop = Foverlay_get (overlay, Qinsert_behind_hooks); if (!NILP (prop)) @@ -4526,7 +4526,7 @@ report_overlay_modification (Lisp_Object start, Lisp_Object end, bool after, } /* Test for intersecting intervals. This does the right thing for both insertion and deletion. */ - if (XFASTINT (end) > startpos && XFASTINT (start) < endpos) + if (XFIXNAT (end) > startpos && XFIXNAT (start) < endpos) { prop = Foverlay_get (overlay, Qmodification_hooks); if (!NILP (prop)) diff --git a/src/buffer.h b/src/buffer.h index c97e3d8fa5..c6247506d7 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -1349,7 +1349,7 @@ extern int last_per_buffer_idx; #define PER_BUFFER_IDX(OFFSET) \ - XINT (*(Lisp_Object *)((OFFSET) + (char *) &buffer_local_flags)) + XFIXNUM (*(Lisp_Object *)((OFFSET) + (char *) &buffer_local_flags)) /* Functions to get and set default value of the per-buffer variable at offset OFFSET in the buffer structure. */ @@ -1387,7 +1387,7 @@ downcase (int c) { Lisp_Object downcase_table = BVAR (current_buffer, downcase_table); Lisp_Object down = CHAR_TABLE_REF (downcase_table, c); - return FIXNATP (down) ? XFASTINT (down) : c; + return FIXNATP (down) ? XFIXNAT (down) : c; } /* Upcase a character C, or make no change if that cannot be done. */ @@ -1396,7 +1396,7 @@ upcase (int c) { Lisp_Object upcase_table = BVAR (current_buffer, upcase_table); Lisp_Object up = CHAR_TABLE_REF (upcase_table, c); - return FIXNATP (up) ? XFASTINT (up) : c; + return FIXNATP (up) ? XFIXNAT (up) : c; } /* True if C is upper case. */ diff --git a/src/bytecode.c b/src/bytecode.c index f87983a59c..b27fa7c5c6 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -63,14 +63,14 @@ along with GNU Emacs. If not, see . */ { \ if (byte_metering_on) \ { \ - if (XFASTINT (METER_1 (this_code)) < MOST_POSITIVE_FIXNUM) \ + if (XFIXNAT (METER_1 (this_code)) < MOST_POSITIVE_FIXNUM) \ XSETFASTINT (METER_1 (this_code), \ - XFASTINT (METER_1 (this_code)) + 1); \ + XFIXNAT (METER_1 (this_code)) + 1); \ if (last_code \ - && (XFASTINT (METER_2 (last_code, this_code)) \ + && (XFIXNAT (METER_2 (last_code, this_code)) \ < MOST_POSITIVE_FIXNUM)) \ XSETFASTINT (METER_2 (last_code, this_code), \ - XFASTINT (METER_2 (last_code, this_code)) + 1); \ + XFIXNAT (METER_2 (last_code, this_code)) + 1); \ } \ } @@ -362,7 +362,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, Lisp_Object *vectorp = XVECTOR (vector)->contents; unsigned char quitcounter = 1; - EMACS_INT stack_items = XFASTINT (maxdepth) + 1; + EMACS_INT stack_items = XFIXNAT (maxdepth) + 1; USE_SAFE_ALLOCA; void *alloc; SAFE_ALLOCA_LISP_EXTRA (alloc, stack_items, bytestr_length); @@ -379,7 +379,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, if (!NILP (args_template)) { eassert (FIXNUMP (args_template)); - ptrdiff_t at = XINT (args_template); + ptrdiff_t at = XFIXNUM (args_template); bool rest = (at & 128) != 0; int mandatory = at & 127; ptrdiff_t nonrest = at >> 8; @@ -622,9 +622,9 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, Lisp_Object v1 = TOP; Lisp_Object v2 = Fget (v1, Qbyte_code_meter); if (FIXNUMP (v2) - && XINT (v2) < MOST_POSITIVE_FIXNUM) + && XFIXNUM (v2) < MOST_POSITIVE_FIXNUM) { - XSETINT (v2, XINT (v2) + 1); + XSETINT (v2, XFIXNUM (v2) + 1); Fput (v1, Qbyte_code_meter, v2); } } @@ -833,7 +833,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, { Lisp_Object v2 = POP, v1 = TOP; CHECK_FIXNUM (v1); - for (EMACS_INT n = XINT (v1); 0 < n && CONSP (v2); n--) + for (EMACS_INT n = XFIXNUM (v1); 0 < n && CONSP (v2); n--) { v2 = XCDR (v2); rarely_quit (n); @@ -972,14 +972,14 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; CASE (Bsub1): - TOP = (FIXNUMP (TOP) && XINT (TOP) != MOST_NEGATIVE_FIXNUM - ? make_fixnum (XINT (TOP) - 1) + TOP = (FIXNUMP (TOP) && XFIXNUM (TOP) != MOST_NEGATIVE_FIXNUM + ? make_fixnum (XFIXNUM (TOP) - 1) : Fsub1 (TOP)); NEXT; CASE (Badd1): - TOP = (FIXNUMP (TOP) && XINT (TOP) != MOST_POSITIVE_FIXNUM - ? make_fixnum (XINT (TOP) + 1) + TOP = (FIXNUMP (TOP) && XFIXNUM (TOP) != MOST_POSITIVE_FIXNUM + ? make_fixnum (XFIXNUM (TOP) + 1) : Fadd1 (TOP)); NEXT; @@ -1031,8 +1031,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; CASE (Bnegate): - TOP = (FIXNUMP (TOP) && XINT (TOP) != MOST_NEGATIVE_FIXNUM - ? make_fixnum (- XINT (TOP)) + TOP = (FIXNUMP (TOP) && XFIXNUM (TOP) != MOST_NEGATIVE_FIXNUM + ? make_fixnum (- XFIXNUM (TOP)) : Fminus (1, &TOP)); NEXT; @@ -1175,7 +1175,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Bchar_syntax): { CHECK_CHARACTER (TOP); - int c = XFASTINT (TOP); + int c = XFIXNAT (TOP); if (NILP (BVAR (current_buffer, enable_multibyte_characters))) MAKE_CHAR_MULTIBYTE (c); XSETFASTINT (TOP, syntax_code_spec[SYNTAX (c)]); @@ -1269,7 +1269,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, /* Exchange args and then do nth. */ Lisp_Object v2 = POP, v1 = TOP; CHECK_FIXNUM (v2); - for (EMACS_INT n = XINT (v2); 0 < n && CONSP (v1); n--) + for (EMACS_INT n = XFIXNUM (v2); 0 < n && CONSP (v1); n--) { v1 = XCDR (v1); rarely_quit (n); @@ -1439,7 +1439,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, Lisp_Object val = HASH_VALUE (h, i); if (BYTE_CODE_SAFE && !FIXNUMP (val)) emacs_abort (); - op = XINT (val); + op = XFIXNUM (val); goto op_branch; } } @@ -1475,7 +1475,7 @@ Lisp_Object get_byte_code_arity (Lisp_Object args_template) { eassert (FIXNATP (args_template)); - EMACS_INT at = XINT (args_template); + EMACS_INT at = XFIXNUM (args_template); bool rest = (at & 128) != 0; int mandatory = at & 127; EMACS_INT nonrest = at >> 8; diff --git a/src/callint.c b/src/callint.c index c18eab488d..c8b75859e6 100644 --- a/src/callint.c +++ b/src/callint.c @@ -542,7 +542,7 @@ invoke it. If KEYS is omitted or nil, the return value of /* If the key sequence ends with a down-event, discard the following up-event. */ Lisp_Object teml - = Faref (args[i], make_fixnum (XINT (Flength (args[i])) - 1)); + = Faref (args[i], make_fixnum (XFIXNUM (Flength (args[i])) - 1)); if (CONSP (teml)) teml = XCAR (teml); if (SYMBOLP (teml)) @@ -572,7 +572,7 @@ invoke it. If KEYS is omitted or nil, the return value of /* If the key sequence ends with a down-event, discard the following up-event. */ Lisp_Object teml - = Faref (args[i], make_fixnum (XINT (Flength (args[i])) - 1)); + = Faref (args[i], make_fixnum (XFIXNUM (Flength (args[i])) - 1)); if (CONSP (teml)) teml = XCAR (teml); if (SYMBOLP (teml)) @@ -796,7 +796,7 @@ Its numeric meaning is what you would get from `(interactive "p")'. */) else if (EQ (raw, Qminus)) XSETINT (val, -1); else if (CONSP (raw) && FIXNUMP (XCAR (raw))) - XSETINT (val, XINT (XCAR (raw))); + XSETINT (val, XFIXNUM (XCAR (raw))); else if (FIXNUMP (raw)) val = raw; else diff --git a/src/callproc.c b/src/callproc.c index f959927d37..e6a8180293 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -1066,7 +1066,7 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r validate_region (&args[0], &args[1]); start = args[0]; end = args[1]; - empty_input = XINT (start) == XINT (end); + empty_input = XFIXNUM (start) == XFIXNUM (end); } if (!empty_input) diff --git a/src/casefiddle.c b/src/casefiddle.c index a6656b1e68..95857d6f36 100644 --- a/src/casefiddle.c +++ b/src/casefiddle.c @@ -152,7 +152,7 @@ case_character_impl (struct casing_str_buf *buf, prop = CHAR_TABLE_REF (ctx->titlecase_char_table, ch); if (CHARACTERP (prop)) { - cased = XFASTINT (prop); + cased = XFIXNAT (prop); cased_is_set = true; } } @@ -225,7 +225,7 @@ do_casify_natnum (struct casing_context *ctx, Lisp_Object obj) { int flagbits = (CHAR_ALT | CHAR_SUPER | CHAR_HYPER | CHAR_SHIFT | CHAR_CTL | CHAR_META); - int ch = XFASTINT (obj); + int ch = XFIXNAT (obj); /* If the character has higher bits set above the flags, return it unchanged. It is not a real character. */ @@ -485,8 +485,8 @@ casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e) struct casing_context ctx; validate_region (&b, &e); - ptrdiff_t start = XFASTINT (b); - ptrdiff_t end = XFASTINT (e); + ptrdiff_t start = XFIXNAT (b); + ptrdiff_t end = XFIXNAT (e); if (start == end) /* Not modifying because nothing marked. */ return end; @@ -602,9 +602,9 @@ static Lisp_Object casify_word (enum case_action flag, Lisp_Object arg) { CHECK_FIXNUM (arg); - ptrdiff_t farend = scan_words (PT, XINT (arg)); + ptrdiff_t farend = scan_words (PT, XFIXNUM (arg)); if (!farend) - farend = XINT (arg) <= 0 ? BEGV : ZV; + farend = XFIXNUM (arg) <= 0 ? BEGV : ZV; SET_PT (casify_region (flag, make_fixnum (PT), make_fixnum (farend))); return Qnil; } diff --git a/src/casetab.c b/src/casetab.c index 58847fc330..6b1c64f89e 100644 --- a/src/casetab.c +++ b/src/casetab.c @@ -196,11 +196,11 @@ set_identity (Lisp_Object table, Lisp_Object c, Lisp_Object elt) if (CONSP (c)) { - from = XINT (XCAR (c)); - to = XINT (XCDR (c)); + from = XFIXNUM (XCAR (c)); + to = XFIXNUM (XCDR (c)); } else - from = to = XINT (c); + from = to = XFIXNUM (c); to++; for (; from < to; from++) @@ -222,11 +222,11 @@ shuffle (Lisp_Object table, Lisp_Object c, Lisp_Object elt) if (CONSP (c)) { - from = XINT (XCAR (c)); - to = XINT (XCDR (c)); + from = XFIXNUM (XCAR (c)); + to = XFIXNUM (XCDR (c)); } else - from = to = XINT (c); + from = to = XFIXNUM (c); to++; for (; from < to; from++) diff --git a/src/category.c b/src/category.c index 72b589c790..d6ccde5369 100644 --- a/src/category.c +++ b/src/category.c @@ -130,11 +130,11 @@ the current buffer's category table. */) CHECK_STRING (docstring); table = check_category_table (table); - if (!NILP (CATEGORY_DOCSTRING (table, XFASTINT (category)))) - error ("Category `%c' is already defined", (int) XFASTINT (category)); + if (!NILP (CATEGORY_DOCSTRING (table, XFIXNAT (category)))) + error ("Category `%c' is already defined", (int) XFIXNAT (category)); if (!NILP (Vpurify_flag)) docstring = Fpurecopy (docstring); - SET_CATEGORY_DOCSTRING (table, XFASTINT (category), docstring); + SET_CATEGORY_DOCSTRING (table, XFIXNAT (category), docstring); return Qnil; } @@ -148,7 +148,7 @@ category table. */) CHECK_CATEGORY (category); table = check_category_table (table); - return CATEGORY_DOCSTRING (table, XFASTINT (category)); + return CATEGORY_DOCSTRING (table, XFIXNAT (category)); } DEFUN ("get-unused-category", Fget_unused_category, Sget_unused_category, @@ -220,9 +220,9 @@ copy_category_entry (Lisp_Object table, Lisp_Object c, Lisp_Object val) { val = Fcopy_sequence (val); if (CONSP (c)) - char_table_set_range (table, XINT (XCAR (c)), XINT (XCDR (c)), val); + char_table_set_range (table, XFIXNUM (XCAR (c)), XFIXNUM (XCDR (c)), val); else - char_table_set (table, XINT (c), val); + char_table_set (table, XFIXNUM (c), val); } /* Return a copy of category table TABLE. We can't simply use the @@ -303,7 +303,7 @@ usage: (char-category-set CHAR) */) (Lisp_Object ch) { CHECK_CHARACTER (ch); - return CATEGORY_SET (XFASTINT (ch)); + return CATEGORY_SET (XFIXNAT (ch)); } DEFUN ("category-set-mnemonics", Fcategory_set_mnemonics, @@ -349,22 +349,22 @@ then delete CATEGORY from the category set instead of adding it. */) if (FIXNUMP (character)) { CHECK_CHARACTER (character); - start = end = XFASTINT (character); + start = end = XFIXNAT (character); } else { CHECK_CONS (character); CHECK_CHARACTER_CAR (character); CHECK_CHARACTER_CDR (character); - start = XFASTINT (XCAR (character)); - end = XFASTINT (XCDR (character)); + start = XFIXNAT (XCAR (character)); + end = XFIXNAT (XCDR (character)); } CHECK_CATEGORY (category); table = check_category_table (table); - if (NILP (CATEGORY_DOCSTRING (table, XFASTINT (category)))) - error ("Undefined category: %c", (int) XFASTINT (category)); + if (NILP (CATEGORY_DOCSTRING (table, XFIXNAT (category)))) + error ("Undefined category: %c", (int) XFIXNAT (category)); set_value = NILP (reset); @@ -372,10 +372,10 @@ then delete CATEGORY from the category set instead of adding it. */) { from = start, to = end; category_set = char_table_ref_and_range (table, start, &from, &to); - if (CATEGORY_MEMBER (XFASTINT (category), category_set) != NILP (reset)) + if (CATEGORY_MEMBER (XFIXNAT (category), category_set) != NILP (reset)) { category_set = Fcopy_sequence (category_set); - set_category_set (category_set, XFASTINT (category), set_value); + set_category_set (category_set, XFIXNAT (category), set_value); category_set = hash_get_category_set (table, category_set); char_table_set_range (table, start, to, category_set); } @@ -423,12 +423,12 @@ word_boundary_p (int c1, int c2) if (CONSP (elt) && (NILP (XCAR (elt)) || (CATEGORYP (XCAR (elt)) - && CATEGORY_MEMBER (XFASTINT (XCAR (elt)), category_set1) - && ! CATEGORY_MEMBER (XFASTINT (XCAR (elt)), category_set2))) + && CATEGORY_MEMBER (XFIXNAT (XCAR (elt)), category_set1) + && ! CATEGORY_MEMBER (XFIXNAT (XCAR (elt)), category_set2))) && (NILP (XCDR (elt)) || (CATEGORYP (XCDR (elt)) - && ! CATEGORY_MEMBER (XFASTINT (XCDR (elt)), category_set1) - && CATEGORY_MEMBER (XFASTINT (XCDR (elt)), category_set2)))) + && ! CATEGORY_MEMBER (XFIXNAT (XCDR (elt)), category_set1) + && CATEGORY_MEMBER (XFIXNAT (XCDR (elt)), category_set2)))) return !default_result; } return default_result; diff --git a/src/ccl.c b/src/ccl.c index 529b302ed9..31d0a28c5a 100644 --- a/src/ccl.c +++ b/src/ccl.c @@ -629,7 +629,7 @@ do \ stack_idx++; \ ccl_prog = called_ccl.prog; \ ic = CCL_HEADER_MAIN; \ - eof_ic = XFASTINT (ccl_prog[CCL_HEADER_EOF]); \ + eof_ic = XFIXNAT (ccl_prog[CCL_HEADER_EOF]); \ goto ccl_repeat; \ } \ while (0) @@ -736,7 +736,7 @@ while (0) #define GET_CCL_RANGE(var, ccl_prog, ic, lo, hi) \ do \ { \ - EMACS_INT prog_word = XINT ((ccl_prog)[ic]); \ + EMACS_INT prog_word = XFIXNUM ((ccl_prog)[ic]); \ if (! ASCENDING_ORDER (lo, prog_word, hi)) \ CCL_INVALID_CMD; \ (var) = prog_word; \ @@ -769,12 +769,12 @@ while (0) CCL_INVALID_CMD; \ else if (dst + len <= dst_end) \ { \ - if (XFASTINT (ccl_prog[ic]) & 0x1000000) \ + if (XFIXNAT (ccl_prog[ic]) & 0x1000000) \ for (ccli = 0; ccli < len; ccli++) \ - *dst++ = XFASTINT (ccl_prog[ic + ccli]) & 0xFFFFFF; \ + *dst++ = XFIXNAT (ccl_prog[ic + ccli]) & 0xFFFFFF; \ else \ for (ccli = 0; ccli < len; ccli++) \ - *dst++ = ((XFASTINT (ccl_prog[ic + (ccli / 3)])) \ + *dst++ = ((XFIXNAT (ccl_prog[ic + (ccli / 3)])) \ >> ((2 - (ccli % 3)) * 8)) & 0xFF; \ } \ else \ @@ -926,14 +926,14 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size break; case CCL_SetConst: /* 00000000000000000000rrrXXXXX */ - reg[rrr] = XINT (ccl_prog[ic++]); + reg[rrr] = XFIXNUM (ccl_prog[ic++]); break; case CCL_SetArray: /* CCCCCCCCCCCCCCCCCCCCRRRrrrXXXXX */ i = reg[RRR]; j = field1 >> 3; if (0 <= i && i < j) - reg[rrr] = XINT (ccl_prog[ic + i]); + reg[rrr] = XFIXNUM (ccl_prog[ic + i]); ic += j; break; @@ -961,13 +961,13 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size break; case CCL_WriteConstJump: /* A--D--D--R--E--S--S-000XXXXX */ - i = XINT (ccl_prog[ic]); + i = XFIXNUM (ccl_prog[ic]); CCL_WRITE_CHAR (i); ic += ADDR; break; case CCL_WriteConstReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */ - i = XINT (ccl_prog[ic]); + i = XFIXNUM (ccl_prog[ic]); CCL_WRITE_CHAR (i); ic++; CCL_READ_CHAR (reg[rrr]); @@ -975,17 +975,17 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size break; case CCL_WriteStringJump: /* A--D--D--R--E--S--S-000XXXXX */ - j = XINT (ccl_prog[ic++]); + j = XFIXNUM (ccl_prog[ic++]); CCL_WRITE_STRING (j); ic += ADDR - 1; break; case CCL_WriteArrayReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */ i = reg[rrr]; - j = XINT (ccl_prog[ic]); + j = XFIXNUM (ccl_prog[ic]); if (0 <= i && i < j) { - i = XINT (ccl_prog[ic + 1 + i]); + i = XFIXNUM (ccl_prog[ic + 1 + i]); CCL_WRITE_CHAR (i); } ic += j + 2; @@ -1004,7 +1004,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size case CCL_Branch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */ { int ioff = 0 <= reg[rrr] && reg[rrr] < field1 ? reg[rrr] : field1; - int incr = XINT (ccl_prog[ic + ioff]); + int incr = XFIXNUM (ccl_prog[ic + ioff]); ic += incr; } break; @@ -1023,7 +1023,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size case CCL_WriteExprConst: /* 1:00000OPERATION000RRR000XXXXX */ rrr = 7; i = reg[RRR]; - j = XINT (ccl_prog[ic]); + j = XFIXNUM (ccl_prog[ic]); op = field1 >> 6; jump_address = ic + 1; goto ccl_set_expr; @@ -1056,7 +1056,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size /* If FFF is nonzero, the CCL program ID is in the following code. */ if (rrr) - prog_id = XINT (ccl_prog[ic++]); + prog_id = XFIXNUM (ccl_prog[ic++]); else prog_id = field1; @@ -1081,7 +1081,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size stack_idx++; ccl_prog = XVECTOR (AREF (slot, 1))->contents; ic = CCL_HEADER_MAIN; - eof_ic = XFASTINT (ccl_prog[CCL_HEADER_EOF]); + eof_ic = XFIXNAT (ccl_prog[CCL_HEADER_EOF]); } break; @@ -1099,7 +1099,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size i = reg[rrr]; if (0 <= i && i < field1) { - j = XINT (ccl_prog[ic + i]); + j = XFIXNUM (ccl_prog[ic + i]); CCL_WRITE_CHAR (j); } ic += field1; @@ -1124,7 +1124,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size CCL_SUCCESS; case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */ - i = XINT (ccl_prog[ic++]); + i = XFIXNUM (ccl_prog[ic++]); op = field1 >> 6; goto ccl_expr_self; @@ -1160,7 +1160,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size case CCL_SetExprConst: /* 00000OPERATION000RRRrrrXXXXX */ i = reg[RRR]; - j = XINT (ccl_prog[ic++]); + j = XFIXNUM (ccl_prog[ic++]); op = field1 >> 6; jump_address = ic; goto ccl_set_expr; @@ -1178,8 +1178,8 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size case CCL_JumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */ i = reg[rrr]; jump_address = ic + ADDR; - op = XINT (ccl_prog[ic++]); - j = XINT (ccl_prog[ic++]); + op = XFIXNUM (ccl_prog[ic++]); + j = XFIXNUM (ccl_prog[ic++]); rrr = 7; goto ccl_set_expr; @@ -1189,7 +1189,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size case CCL_JumpCondExprReg: i = reg[rrr]; jump_address = ic + ADDR; - op = XINT (ccl_prog[ic++]); + op = XFIXNUM (ccl_prog[ic++]); GET_CCL_RANGE (j, ccl_prog, ic++, 0, 7); j = reg[j]; rrr = 7; @@ -1323,9 +1323,9 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size { Lisp_Object opl; opl = HASH_VALUE (h, eop); - if (! (FIXNUMP (opl) && IN_INT_RANGE (XINT (opl)))) + if (! (FIXNUMP (opl) && IN_INT_RANGE (XFIXNUM (opl)))) CCL_INVALID_CMD; - reg[RRR] = XINT (opl); + reg[RRR] = XFIXNUM (opl); reg[7] = 1; /* r7 true for success */ } else @@ -1340,7 +1340,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size ptrdiff_t size; int fin_ic; - j = XINT (ccl_prog[ic++]); /* number of maps. */ + j = XFIXNUM (ccl_prog[ic++]); /* number of maps. */ fin_ic = ic + j; op = reg[rrr]; if ((j > reg[RRR]) && (j >= 0)) @@ -1359,7 +1359,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size { if (!VECTORP (Vcode_conversion_map_vector)) continue; size = ASIZE (Vcode_conversion_map_vector); - point = XINT (ccl_prog[ic++]); + point = XFIXNUM (ccl_prog[ic++]); if (! (0 <= point && point < size)) continue; map = AREF (Vcode_conversion_map_vector, point); @@ -1377,7 +1377,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size [t ELEMENT STARTPOINT ENDPOINT] */ if (FIXNUMP (content)) { - point = XINT (content); + point = XFIXNUM (content); if (!(point <= op && op - point + 1 < size)) continue; content = AREF (map, op - point + 1); } @@ -1385,9 +1385,9 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size { if (size != 4) continue; if (FIXNUMP (AREF (map, 2)) - && XINT (AREF (map, 2)) <= op + && XFIXNUM (AREF (map, 2)) <= op && FIXNUMP (AREF (map, 3)) - && op < XINT (AREF (map, 3))) + && op < XFIXNUM (AREF (map, 3))) content = AREF (map, 1); else continue; @@ -1397,10 +1397,10 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size if (NILP (content)) continue; - else if (FIXNUMP (content) && IN_INT_RANGE (XINT (content))) + else if (FIXNUMP (content) && IN_INT_RANGE (XFIXNUM (content))) { reg[RRR] = i; - reg[rrr] = XINT (content); + reg[rrr] = XFIXNUM (content); break; } else if (EQ (content, Qt) || EQ (content, Qlambda)) @@ -1413,10 +1413,10 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size attrib = XCAR (content); value = XCDR (content); if (! (FIXNUMP (attrib) && FIXNUMP (value) - && IN_INT_RANGE (XINT (value)))) + && IN_INT_RANGE (XFIXNUM (value)))) continue; reg[RRR] = i; - reg[rrr] = XINT (value); + reg[rrr] = XFIXNUM (value); break; } else if (SYMBOLP (content)) @@ -1453,7 +1453,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size stack_idx_of_map_multiple = 0; /* Get number of maps and separators. */ - map_set_rest_length = XINT (ccl_prog[ic++]); + map_set_rest_length = XFIXNUM (ccl_prog[ic++]); fin_ic = ic + map_set_rest_length; op = reg[rrr]; @@ -1524,7 +1524,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size do { for (;map_set_rest_length > 0;i++, ic++, map_set_rest_length--) { - point = XINT (ccl_prog[ic]); + point = XFIXNUM (ccl_prog[ic]); if (point < 0) { /* +1 is for including separator. */ @@ -1556,7 +1556,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size [t ELEMENT STARTPOINT ENDPOINT] */ if (FIXNUMP (content)) { - point = XINT (content); + point = XFIXNUM (content); if (!(point <= op && op - point + 1 < size)) continue; content = AREF (map, op - point + 1); } @@ -1564,9 +1564,9 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size { if (size != 4) continue; if (FIXNUMP (AREF (map, 2)) - && XINT (AREF (map, 2)) <= op + && XFIXNUM (AREF (map, 2)) <= op && FIXNUMP (AREF (map, 3)) - && op < XINT (AREF (map, 3))) + && op < XFIXNUM (AREF (map, 3))) content = AREF (map, 1); else continue; @@ -1578,9 +1578,9 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size continue; reg[RRR] = i; - if (FIXNUMP (content) && IN_INT_RANGE (XINT (content))) + if (FIXNUMP (content) && IN_INT_RANGE (XFIXNUM (content))) { - op = XINT (content); + op = XFIXNUM (content); i += map_set_rest_length - 1; ic += map_set_rest_length - 1; POP_MAPPING_STACK (map_set_rest_length, reg[rrr]); @@ -1591,9 +1591,9 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size attrib = XCAR (content); value = XCDR (content); if (! (FIXNUMP (attrib) && FIXNUMP (value) - && IN_INT_RANGE (XINT (value)))) + && IN_INT_RANGE (XFIXNUM (value)))) continue; - op = XINT (value); + op = XFIXNUM (value); i += map_set_rest_length - 1; ic += map_set_rest_length - 1; POP_MAPPING_STACK (map_set_rest_length, reg[rrr]); @@ -1639,7 +1639,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size { Lisp_Object map, attrib, value, content; int point; - j = XINT (ccl_prog[ic++]); /* map_id */ + j = XFIXNUM (ccl_prog[ic++]); /* map_id */ op = reg[rrr]; if (! (VECTORP (Vcode_conversion_map_vector) && j < ASIZE (Vcode_conversion_map_vector))) @@ -1657,19 +1657,19 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size if (! (VECTORP (map) && 0 < ASIZE (map) && FIXNUMP (AREF (map, 0)) - && XINT (AREF (map, 0)) <= op - && op - XINT (AREF (map, 0)) + 1 < ASIZE (map))) + && XFIXNUM (AREF (map, 0)) <= op + && op - XFIXNUM (AREF (map, 0)) + 1 < ASIZE (map))) { reg[RRR] = -1; break; } - point = op - XINT (AREF (map, 0)) + 1; + point = op - XFIXNUM (AREF (map, 0)) + 1; reg[RRR] = 0; content = AREF (map, point); if (NILP (content)) reg[RRR] = -1; else if (TYPE_RANGED_FIXNUMP (int, content)) - reg[rrr] = XINT (content); + reg[rrr] = XFIXNUM (content); else if (EQ (content, Qt)); else if (CONSP (content)) { @@ -1678,7 +1678,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size if (!FIXNUMP (attrib) || !TYPE_RANGED_FIXNUMP (int, value)) continue; - reg[rrr] = XINT (value); + reg[rrr] = XFIXNUM (value); break; } else if (SYMBOLP (content)) @@ -1852,8 +1852,8 @@ resolve_symbol_ccl_program (Lisp_Object ccl) return Qnil; } - if (! (0 <= XINT (AREF (result, CCL_HEADER_BUF_MAG)) - && ASCENDING_ORDER (0, XINT (AREF (result, CCL_HEADER_EOF)), + if (! (0 <= XFIXNUM (AREF (result, CCL_HEADER_BUF_MAG)) + && ASCENDING_ORDER (0, XFIXNUM (AREF (result, CCL_HEADER_EOF)), ASIZE (ccl)))) return Qnil; @@ -1882,14 +1882,14 @@ ccl_get_compiled_code (Lisp_Object ccl_prog, ptrdiff_t *idx) val = Fget (ccl_prog, Qccl_program_idx); if (! FIXNATP (val) - || XINT (val) >= ASIZE (Vccl_program_table)) + || XFIXNUM (val) >= ASIZE (Vccl_program_table)) return Qnil; - slot = AREF (Vccl_program_table, XINT (val)); + slot = AREF (Vccl_program_table, XFIXNUM (val)); if (! VECTORP (slot) || ASIZE (slot) != 4 || ! VECTORP (AREF (slot, 1))) return Qnil; - *idx = XINT (val); + *idx = XFIXNUM (val); if (NILP (AREF (slot, 2))) { val = resolve_symbol_ccl_program (AREF (slot, 1)); @@ -1920,8 +1920,8 @@ setup_ccl_program (struct ccl_program *ccl, Lisp_Object ccl_prog) vp = XVECTOR (ccl_prog); ccl->size = vp->header.size; ccl->prog = vp->contents; - ccl->eof_ic = XINT (vp->contents[CCL_HEADER_EOF]); - ccl->buf_magnification = XINT (vp->contents[CCL_HEADER_BUF_MAG]); + ccl->eof_ic = XFIXNUM (vp->contents[CCL_HEADER_EOF]); + ccl->buf_magnification = XFIXNUM (vp->contents[CCL_HEADER_BUF_MAG]); if (ccl->idx >= 0) { Lisp_Object slot; @@ -1957,7 +1957,7 @@ See the documentation of `define-ccl-program' for the detail of CCL program. */ val = Fget (object, Qccl_program_idx); return ((! FIXNATP (val) - || XINT (val) >= ASIZE (Vccl_program_table)) + || XFIXNUM (val) >= ASIZE (Vccl_program_table)) ? Qnil : Qt); } @@ -1991,7 +1991,7 @@ programs. */) for (i = 0; i < 8; i++) ccl.reg[i] = (TYPE_RANGED_FIXNUMP (int, AREF (reg, i)) - ? XINT (AREF (reg, i)) + ? XFIXNUM (AREF (reg, i)) : 0); ccl_driver (&ccl, NULL, NULL, 0, 0, Qnil); @@ -2060,11 +2060,11 @@ usage: (ccl-execute-on-string CCL-PROGRAM STATUS STRING &optional CONTINUE UNIBY if (NILP (AREF (status, i))) ASET (status, i, make_fixnum (0)); if (TYPE_RANGED_FIXNUMP (int, AREF (status, i))) - ccl.reg[i] = XINT (AREF (status, i)); + ccl.reg[i] = XFIXNUM (AREF (status, i)); } if (FIXNUMP (AREF (status, i))) { - i = XFASTINT (AREF (status, 8)); + i = XFIXNAT (AREF (status, 8)); if (ccl.ic < i && i < ccl.size) ccl.ic = i; } diff --git a/src/character.c b/src/character.c index f9b32e7a5b..97698d7789 100644 --- a/src/character.c +++ b/src/character.c @@ -206,7 +206,7 @@ translate_char (Lisp_Object table, int c) ch = CHAR_TABLE_REF (table, c); if (CHARACTERP (ch)) - c = XINT (ch); + c = XFIXNUM (ch); } else { @@ -244,7 +244,7 @@ DEFUN ("unibyte-char-to-multibyte", Funibyte_char_to_multibyte, int c; CHECK_CHARACTER (ch); - c = XFASTINT (ch); + c = XFIXNAT (ch); if (c >= 0x100) error ("Not a unibyte character: %d", c); MAKE_CHAR_MULTIBYTE (c); @@ -260,7 +260,7 @@ If the multibyte character does not represent a byte, return -1. */) int cm; CHECK_CHARACTER (ch); - cm = XFASTINT (ch); + cm = XFIXNAT (ch); if (cm < 256) /* Can't distinguish a byte read from a unibyte buffer from a latin1 char, so let's let it slide. */ @@ -291,7 +291,7 @@ char_width (int c, struct Lisp_Char_Table *dp) ch = AREF (disp, i); if (CHARACTERP (ch)) { - int w = CHARACTER_WIDTH (XFASTINT (ch)); + int w = CHARACTER_WIDTH (XFIXNAT (ch)); if (INT_ADD_WRAPV (width, w, &width)) string_overflow (); } @@ -312,7 +312,7 @@ usage: (char-width CHAR) */) ptrdiff_t width; CHECK_CHARACTER (ch); - c = XINT (ch); + c = XFIXNUM (ch); width = char_width (c, buffer_display_table ()); return make_fixnum (width); } @@ -855,7 +855,7 @@ usage: (string &rest CHARACTERS) */) for (i = 0; i < n; i++) { CHECK_CHARACTER (args[i]); - c = XINT (args[i]); + c = XFIXNUM (args[i]); p += CHAR_STRING (c, p); } @@ -878,7 +878,7 @@ usage: (unibyte-string &rest BYTES) */) for (i = 0; i < n; i++) { CHECK_RANGED_INTEGER (args[i], 0, 255); - *p++ = XINT (args[i]); + *p++ = XFIXNUM (args[i]); } str = make_string_from_bytes ((char *) buf, n, p - buf); @@ -897,7 +897,7 @@ usage: (char-resolve-modifiers CHAR) */) EMACS_INT c; CHECK_FIXNUM (character); - c = XINT (character); + c = XFIXNUM (character); return make_fixnum (char_resolve_modifier_mask (c)); } @@ -926,9 +926,9 @@ character is not ASCII nor 8-bit character, an error is signaled. */) else { CHECK_FIXNUM_COERCE_MARKER (position); - if (XINT (position) < BEGV || XINT (position) >= ZV) + if (XFIXNUM (position) < BEGV || XFIXNUM (position) >= ZV) args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV)); - pos = XFASTINT (position); + pos = XFIXNAT (position); p = CHAR_POS_ADDR (pos); } if (NILP (BVAR (current_buffer, enable_multibyte_characters))) @@ -944,9 +944,9 @@ character is not ASCII nor 8-bit character, an error is signaled. */) else { CHECK_FIXNAT (position); - if (XINT (position) >= SCHARS (string)) + if (XFIXNUM (position) >= SCHARS (string)) args_out_of_range (string, position); - pos = XFASTINT (position); + pos = XFIXNAT (position); p = SDATA (string) + string_char_to_byte (string, pos); } if (! STRING_MULTIBYTE (string)) @@ -967,7 +967,7 @@ alphabeticp (int c) Lisp_Object category = CHAR_TABLE_REF (Vunicode_category_table, c); if (! FIXNUMP (category)) return false; - EMACS_INT gen_cat = XINT (category); + EMACS_INT gen_cat = XFIXNUM (category); /* See UTS #18. There are additional characters that should be here, those designated as Other_uppercase, Other_lowercase, @@ -990,7 +990,7 @@ alphanumericp (int c) Lisp_Object category = CHAR_TABLE_REF (Vunicode_category_table, c); if (! FIXNUMP (category)) return false; - EMACS_INT gen_cat = XINT (category); + EMACS_INT gen_cat = XFIXNUM (category); /* See UTS #18. Same comment as for alphabeticp applies. FIXME. */ return (gen_cat == UNICODE_CATEGORY_Lu @@ -1012,7 +1012,7 @@ graphicp (int c) Lisp_Object category = CHAR_TABLE_REF (Vunicode_category_table, c); if (! FIXNUMP (category)) return false; - EMACS_INT gen_cat = XINT (category); + EMACS_INT gen_cat = XFIXNUM (category); /* See UTS #18. */ return (!(gen_cat == UNICODE_CATEGORY_Zs /* space separator */ @@ -1030,7 +1030,7 @@ printablep (int c) Lisp_Object category = CHAR_TABLE_REF (Vunicode_category_table, c); if (! FIXNUMP (category)) return false; - EMACS_INT gen_cat = XINT (category); + EMACS_INT gen_cat = XFIXNUM (category); /* See UTS #18. */ return (!(gen_cat == UNICODE_CATEGORY_Cc /* control */ @@ -1047,7 +1047,7 @@ blankp (int c) if (! FIXNUMP (category)) return false; - return XINT (category) == UNICODE_CATEGORY_Zs; /* separator, space */ + return XFIXNUM (category) == UNICODE_CATEGORY_Zs; /* separator, space */ } diff --git a/src/character.h b/src/character.h index 78b84870f5..5dff85aed4 100644 --- a/src/character.h +++ b/src/character.h @@ -123,7 +123,7 @@ enum #define MAX_MULTIBYTE_LENGTH 5 /* Nonzero iff X is a character. */ -#define CHARACTERP(x) (FIXNATP (x) && XFASTINT (x) <= MAX_CHAR) +#define CHARACTERP(x) (FIXNATP (x) && XFIXNAT (x) <= MAX_CHAR) /* Nonzero iff C is valid as a character code. */ #define CHAR_VALID_P(c) UNSIGNED_CMP (c, <=, MAX_CHAR) @@ -559,7 +559,7 @@ enum /* Return a non-outlandish value for the tab width. */ #define SANE_TAB_WIDTH(buf) \ - sanitize_tab_width (XFASTINT (BVAR (buf, tab_width))) + sanitize_tab_width (XFIXNAT (BVAR (buf, tab_width))) INLINE int sanitize_tab_width (EMACS_INT width) { @@ -595,7 +595,7 @@ sanitize_char_width (EMACS_INT width) #define CHARACTER_WIDTH(c) \ (ASCII_CHAR_P (c) \ ? ASCII_CHAR_WIDTH (c) \ - : sanitize_char_width (XINT (CHAR_TABLE_REF (Vchar_width_table, c)))) + : sanitize_char_width (XFIXNUM (CHAR_TABLE_REF (Vchar_width_table, c)))) /* If C is a variation selector, return the index of the variation selector (1..256). Otherwise, return 0. */ @@ -700,7 +700,7 @@ char_table_translate (Lisp_Object obj, int ch) eassert (CHAR_VALID_P (ch)); eassert (CHAR_TABLE_P (obj)); obj = CHAR_TABLE_REF (obj, ch); - return CHARACTERP (obj) ? XINT (obj) : ch; + return CHARACTERP (obj) ? XFIXNUM (obj) : ch; } #if defined __GNUC__ && !defined __STRICT_ANSI__ diff --git a/src/charset.c b/src/charset.c index 8d957abeb5..e77a3900b8 100644 --- a/src/charset.c +++ b/src/charset.c @@ -587,14 +587,14 @@ load_charset_map_from_vector (struct charset *charset, Lisp_Object vec, int cont { val2 = XCDR (val); val = XCAR (val); - from = XFASTINT (val); - to = XFASTINT (val2); + from = XFIXNAT (val); + to = XFIXNAT (val2); } else - from = to = XFASTINT (val); + from = to = XFIXNAT (val); val = AREF (vec, i + 1); CHECK_FIXNAT (val); - c = XFASTINT (val); + c = XFIXNAT (val); if (from < min_code || to > max_code || from > to || c > MAX_CHAR) continue; @@ -757,14 +757,14 @@ map_charset_chars (void (*c_function)(Lisp_Object, Lisp_Object), Lisp_Object fun int offset; subset_info = CHARSET_SUBSET (charset); - charset = CHARSET_FROM_ID (XFASTINT (AREF (subset_info, 0))); - offset = XINT (AREF (subset_info, 3)); + charset = CHARSET_FROM_ID (XFIXNAT (AREF (subset_info, 0))); + offset = XFIXNUM (AREF (subset_info, 3)); from -= offset; - if (from < XFASTINT (AREF (subset_info, 1))) - from = XFASTINT (AREF (subset_info, 1)); + if (from < XFIXNAT (AREF (subset_info, 1))) + from = XFIXNAT (AREF (subset_info, 1)); to -= offset; - if (to > XFASTINT (AREF (subset_info, 2))) - to = XFASTINT (AREF (subset_info, 2)); + if (to > XFIXNAT (AREF (subset_info, 2))) + to = XFIXNAT (AREF (subset_info, 2)); map_charset_chars (c_function, function, arg, charset, from, to); } else /* i.e. CHARSET_METHOD_SUPERSET */ @@ -777,8 +777,8 @@ map_charset_chars (void (*c_function)(Lisp_Object, Lisp_Object), Lisp_Object fun int offset; unsigned this_from, this_to; - charset = CHARSET_FROM_ID (XFASTINT (XCAR (XCAR (parents)))); - offset = XINT (XCDR (XCAR (parents))); + charset = CHARSET_FROM_ID (XFIXNAT (XCAR (XCAR (parents)))); + offset = XFIXNUM (XCDR (XCAR (parents))); this_from = from > offset ? from - offset : 0; this_to = to > offset ? to - offset : 0; if (this_from < CHARSET_MIN_CODE (charset)) @@ -811,7 +811,7 @@ range of code points (in CHARSET) of target characters. */) from = CHARSET_MIN_CODE (cs); else { - from = XINT (from_code); + from = XFIXNUM (from_code); if (from < CHARSET_MIN_CODE (cs)) from = CHARSET_MIN_CODE (cs); } @@ -819,7 +819,7 @@ range of code points (in CHARSET) of target characters. */) to = CHARSET_MAX_CODE (cs); else { - to = XINT (to_code); + to = XFIXNUM (to_code); if (to > CHARSET_MAX_CODE (cs)) to = CHARSET_MAX_CODE (cs); } @@ -870,9 +870,9 @@ usage: (define-charset-internal ...) */) min_byte_obj = Faref (val, make_fixnum (i * 2)); max_byte_obj = Faref (val, make_fixnum (i * 2 + 1)); CHECK_RANGED_INTEGER (min_byte_obj, 0, 255); - min_byte = XINT (min_byte_obj); + min_byte = XFIXNUM (min_byte_obj); CHECK_RANGED_INTEGER (max_byte_obj, min_byte, 255); - max_byte = XINT (max_byte_obj); + max_byte = XFIXNUM (max_byte_obj); charset.code_space[i * 4] = min_byte; charset.code_space[i * 4 + 1] = max_byte; charset.code_space[i * 4 + 2] = max_byte - min_byte + 1; @@ -890,7 +890,7 @@ usage: (define-charset-internal ...) */) else { CHECK_RANGED_INTEGER (val, 1, 4); - charset.dimension = XINT (val); + charset.dimension = XFIXNUM (val); } charset.code_linear_p @@ -971,9 +971,9 @@ usage: (define-charset-internal ...) */) else { CHECK_FIXNUM (val); - if (XINT (val) < '0' || XINT (val) > 127) - error ("Invalid iso-final-char: %"pI"d", XINT (val)); - charset.iso_final = XINT (val); + if (XFIXNUM (val) < '0' || XFIXNUM (val) > 127) + error ("Invalid iso-final-char: %"pI"d", XFIXNUM (val)); + charset.iso_final = XFIXNUM (val); } val = args[charset_arg_iso_revision]; @@ -982,7 +982,7 @@ usage: (define-charset-internal ...) */) else { CHECK_RANGED_INTEGER (val, -1, 63); - charset.iso_revision = XINT (val); + charset.iso_revision = XFIXNUM (val); } val = args[charset_arg_emacs_mule_id]; @@ -991,9 +991,9 @@ usage: (define-charset-internal ...) */) else { CHECK_FIXNAT (val); - if ((XINT (val) > 0 && XINT (val) <= 128) || XINT (val) >= 256) - error ("Invalid emacs-mule-id: %"pI"d", XINT (val)); - charset.emacs_mule_id = XINT (val); + if ((XFIXNUM (val) > 0 && XFIXNUM (val) <= 128) || XFIXNUM (val) >= 256) + error ("Invalid emacs-mule-id: %"pI"d", XFIXNUM (val)); + charset.emacs_mule_id = XFIXNUM (val); } charset.ascii_compatible_p = ! NILP (args[charset_arg_ascii_compatible_p]); @@ -1010,7 +1010,7 @@ usage: (define-charset-internal ...) */) CHECK_CHARACTER (val); charset.method = CHARSET_METHOD_OFFSET; - charset.code_offset = XINT (val); + charset.code_offset = XFIXNUM (val); i = CODE_POINT_TO_INDEX (&charset, charset.max_code); if (MAX_CHAR - charset.code_offset < i) @@ -1089,7 +1089,7 @@ usage: (define-charset-internal ...) */) cdr_part = XCDR (elt); CHECK_CHARSET_GET_ID (car_part, this_id); CHECK_TYPE_RANGED_INTEGER (int, cdr_part); - offset = XINT (cdr_part); + offset = XFIXNUM (cdr_part); } else { @@ -1123,7 +1123,7 @@ usage: (define-charset-internal ...) */) if (charset.hash_index >= 0) { new_definition_p = 0; - id = XFASTINT (CHARSET_SYMBOL_ID (args[charset_arg_name])); + id = XFIXNAT (CHARSET_SYMBOL_ID (args[charset_arg_name])); set_hash_value_slot (hash_table, charset.hash_index, attrs); } else @@ -1209,7 +1209,7 @@ usage: (define-charset-internal ...) */) for (tail = Vcharset_ordered_list; CONSP (tail); tail = XCDR (tail)) { - struct charset *cs = CHARSET_FROM_ID (XINT (XCAR (tail))); + struct charset *cs = CHARSET_FROM_ID (XFIXNUM (XCAR (tail))); if (cs->supplementary_p) break; @@ -1293,7 +1293,7 @@ define_charset_internal (Lisp_Object name, args[charset_arg_code_offset]); Fdefine_charset_internal (charset_arg_max, args); - return XINT (CHARSET_SYMBOL_ID (name)); + return XFIXNUM (CHARSET_SYMBOL_ID (name)); } @@ -1400,15 +1400,15 @@ check_iso_charset_parameter (Lisp_Object dimension, Lisp_Object chars, CHECK_FIXNUM (chars); CHECK_CHARACTER (final_char); - if (! (1 <= XINT (dimension) && XINT (dimension) <= 3)) + if (! (1 <= XFIXNUM (dimension) && XFIXNUM (dimension) <= 3)) error ("Invalid DIMENSION %"pI"d, it should be 1, 2, or 3", - XINT (dimension)); + XFIXNUM (dimension)); - bool chars_flag = XINT (chars) == 96; - if (! (chars_flag || XINT (chars) == 94)) - error ("Invalid CHARS %"pI"d, it should be 94 or 96", XINT (chars)); + bool chars_flag = XFIXNUM (chars) == 96; + if (! (chars_flag || XFIXNUM (chars) == 94)) + error ("Invalid CHARS %"pI"d, it should be 94 or 96", XFIXNUM (chars)); - int final_ch = XFASTINT (final_char); + int final_ch = XFIXNAT (final_char); if (! ('0' <= final_ch && final_ch <= '~')) error ("Invalid FINAL-CHAR `%c', it should be `0'..`~'", final_ch); @@ -1430,7 +1430,7 @@ return nil. */) bool chars_flag = check_iso_charset_parameter (dimension, chars, make_fixnum ('0')); for (int final_char = '0'; final_char <= '?'; final_char++) - if (ISO_CHARSET_TABLE (XINT (dimension), chars_flag, final_char) < 0) + if (ISO_CHARSET_TABLE (XFIXNUM (dimension), chars_flag, final_char) < 0) return make_fixnum (final_char); return Qnil; } @@ -1449,7 +1449,7 @@ if CHARSET is designated instead. */) CHECK_CHARSET_GET_ID (charset, id); bool chars_flag = check_iso_charset_parameter (dimension, chars, final_char); - ISO_CHARSET_TABLE (XINT (dimension), chars_flag, XFASTINT (final_char)) = id; + ISO_CHARSET_TABLE (XFIXNUM (dimension), chars_flag, XFIXNAT (final_char)) = id; return Qnil; } @@ -1550,8 +1550,8 @@ only `ascii', `eight-bit-control', and `eight-bit-graphic'. */) bool multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); validate_region (&beg, &end); - from = XFASTINT (beg); - stop = to = XFASTINT (end); + from = XFIXNAT (beg); + stop = to = XFIXNAT (end); if (from < GPT && GPT < to) { @@ -1622,7 +1622,7 @@ maybe_unify_char (int c, Lisp_Object val) struct charset *charset; if (FIXNUMP (val)) - return XFASTINT (val); + return XFIXNAT (val); if (NILP (val)) return c; @@ -1638,7 +1638,7 @@ maybe_unify_char (int c, Lisp_Object val) { val = CHAR_TABLE_REF (Vchar_unify_table, c); if (! NILP (val)) - c = XFASTINT (val); + c = XFIXNAT (val); } else { @@ -1672,10 +1672,10 @@ decode_char (struct charset *charset, unsigned int code) Lisp_Object subset_info; subset_info = CHARSET_SUBSET (charset); - charset = CHARSET_FROM_ID (XFASTINT (AREF (subset_info, 0))); - code -= XINT (AREF (subset_info, 3)); - if (code < XFASTINT (AREF (subset_info, 1)) - || code > XFASTINT (AREF (subset_info, 2))) + charset = CHARSET_FROM_ID (XFIXNAT (AREF (subset_info, 0))); + code -= XFIXNUM (AREF (subset_info, 3)); + if (code < XFIXNAT (AREF (subset_info, 1)) + || code > XFIXNAT (AREF (subset_info, 2))) c = -1; else c = DECODE_CHAR (charset, code); @@ -1688,8 +1688,8 @@ decode_char (struct charset *charset, unsigned int code) c = -1; for (; CONSP (parents); parents = XCDR (parents)) { - int id = XINT (XCAR (XCAR (parents))); - int code_offset = XINT (XCDR (XCAR (parents))); + int id = XFIXNUM (XCAR (XCAR (parents))); + int code_offset = XFIXNUM (XCDR (XCAR (parents))); unsigned this_code = code - code_offset; charset = CHARSET_FROM_ID (id); @@ -1714,7 +1714,7 @@ decode_char (struct charset *charset, unsigned int code) decoder = CHARSET_DECODER (charset); } if (VECTORP (decoder)) - c = XINT (AREF (decoder, char_index)); + c = XFIXNUM (AREF (decoder, char_index)); else c = GET_TEMP_CHARSET_WORK_DECODER (char_index); } @@ -1763,7 +1763,7 @@ encode_char (struct charset *charset, int c) Lisp_Object deunified = CHAR_TABLE_REF (deunifier, c); if (FIXNUMP (deunified)) - code_index = XINT (deunified); + code_index = XFIXNUM (deunified); } else { @@ -1779,13 +1779,13 @@ encode_char (struct charset *charset, int c) struct charset *this_charset; subset_info = CHARSET_SUBSET (charset); - this_charset = CHARSET_FROM_ID (XFASTINT (AREF (subset_info, 0))); + this_charset = CHARSET_FROM_ID (XFIXNAT (AREF (subset_info, 0))); code = ENCODE_CHAR (this_charset, c); if (code == CHARSET_INVALID_CODE (this_charset) - || code < XFASTINT (AREF (subset_info, 1)) - || code > XFASTINT (AREF (subset_info, 2))) + || code < XFIXNAT (AREF (subset_info, 1)) + || code > XFIXNAT (AREF (subset_info, 2))) return CHARSET_INVALID_CODE (charset); - code += XINT (AREF (subset_info, 3)); + code += XFIXNUM (AREF (subset_info, 3)); return code; } @@ -1796,8 +1796,8 @@ encode_char (struct charset *charset, int c) parents = CHARSET_SUPERSET (charset); for (; CONSP (parents); parents = XCDR (parents)) { - int id = XINT (XCAR (XCAR (parents))); - int code_offset = XINT (XCDR (XCAR (parents))); + int id = XFIXNUM (XCAR (XCAR (parents))); + int code_offset = XFIXNUM (XCDR (XCAR (parents))); struct charset *this_charset = CHARSET_FROM_ID (id); code = ENCODE_CHAR (this_charset, c); @@ -1827,7 +1827,7 @@ encode_char (struct charset *charset, int c) val = CHAR_TABLE_REF (encoder, c); if (NILP (val)) return CHARSET_INVALID_CODE (charset); - code = XINT (val); + code = XFIXNUM (val); if (! CHARSET_COMPACT_CODES_P (charset)) code = INDEX_TO_CODE_POINT (charset, code); } @@ -1878,7 +1878,7 @@ Return nil if CHARSET doesn't include CH. */) CHECK_CHARSET_GET_ID (charset, id); CHECK_CHARACTER (ch); - c = XFASTINT (ch); + c = XFIXNAT (ch); charsetp = CHARSET_FROM_ID (id); code = ENCODE_CHAR (charsetp, c); if (code == CHARSET_INVALID_CODE (charsetp)) @@ -1911,9 +1911,9 @@ is specified. */) else { CHECK_FIXNAT (code1); - if (XFASTINT (code1) >= 0x100) + if (XFIXNAT (code1) >= 0x100) args_out_of_range (make_fixnum (0xFF), code1); - code = XFASTINT (code1); + code = XFIXNAT (code1); if (dimension > 1) { @@ -1923,9 +1923,9 @@ is specified. */) else { CHECK_FIXNAT (code2); - if (XFASTINT (code2) >= 0x100) + if (XFIXNAT (code2) >= 0x100) args_out_of_range (make_fixnum (0xFF), code2); - code |= XFASTINT (code2); + code |= XFIXNAT (code2); } if (dimension > 2) @@ -1936,9 +1936,9 @@ is specified. */) else { CHECK_FIXNAT (code3); - if (XFASTINT (code3) >= 0x100) + if (XFIXNAT (code3) >= 0x100) args_out_of_range (make_fixnum (0xFF), code3); - code |= XFASTINT (code3); + code |= XFIXNAT (code3); } if (dimension > 3) @@ -1949,9 +1949,9 @@ is specified. */) else { CHECK_FIXNAT (code4); - if (XFASTINT (code4) >= 0x100) + if (XFIXNAT (code4) >= 0x100) args_out_of_range (make_fixnum (0xFF), code4); - code |= XFASTINT (code4); + code |= XFIXNAT (code4); } } } @@ -1983,7 +1983,7 @@ char_charset (int c, Lisp_Object charset_list, unsigned int *code_return) while (CONSP (charset_list)) { - struct charset *charset = CHARSET_FROM_ID (XINT (XCAR (charset_list))); + struct charset *charset = CHARSET_FROM_ID (XFIXNUM (XCAR (charset_list))); unsigned code = ENCODE_CHAR (charset, c); if (code != CHARSET_INVALID_CODE (charset)) @@ -2018,7 +2018,7 @@ CH in the charset. */) Lisp_Object val; CHECK_CHARACTER (ch); - c = XFASTINT (ch); + c = XFIXNAT (ch); charset = CHAR_CHARSET (c); if (! charset) emacs_abort (); @@ -2048,12 +2048,12 @@ that case, find the charset from what supported by that coding system. */) CHECK_CHARACTER (ch); if (NILP (restriction)) - charset = CHAR_CHARSET (XINT (ch)); + charset = CHAR_CHARSET (XFIXNUM (ch)); else { if (CONSP (restriction)) { - int c = XFASTINT (ch); + int c = XFIXNAT (ch); for (; CONSP (restriction); restriction = XCDR (restriction)) { @@ -2066,7 +2066,7 @@ that case, find the charset from what supported by that coding system. */) return Qnil; } restriction = coding_system_charset_list (restriction); - charset = char_charset (XINT (ch), restriction, NULL); + charset = char_charset (XFIXNUM (ch), restriction, NULL); if (! charset) return Qnil; } @@ -2087,7 +2087,7 @@ If POS is out of range, the value is nil. */) ch = Fchar_after (pos); if (! FIXNUMP (ch)) return ch; - charset = CHAR_CHARSET (XINT (ch)); + charset = CHAR_CHARSET (XFIXNUM (ch)); return (CHARSET_NAME (charset)); } @@ -2104,8 +2104,8 @@ DIMENSION, CHARS, and FINAL-CHAR. */) (Lisp_Object dimension, Lisp_Object chars, Lisp_Object final_char) { bool chars_flag = check_iso_charset_parameter (dimension, chars, final_char); - int id = ISO_CHARSET_TABLE (XINT (dimension), chars_flag, - XFASTINT (final_char)); + int id = ISO_CHARSET_TABLE (XFIXNUM (dimension), chars_flag, + XFIXNAT (final_char)); return (id >= 0 ? CHARSET_NAME (CHARSET_FROM_ID (id)) : Qnil); } @@ -2139,11 +2139,11 @@ HIGHESTP non-nil means just return the highest priority one. */) Lisp_Object val = Qnil, list = Vcharset_ordered_list; if (!NILP (highestp)) - return CHARSET_NAME (CHARSET_FROM_ID (XINT (Fcar (list)))); + return CHARSET_NAME (CHARSET_FROM_ID (XFIXNUM (Fcar (list)))); while (!NILP (list)) { - val = Fcons (CHARSET_NAME (CHARSET_FROM_ID (XINT (XCAR (list)))), val); + val = Fcons (CHARSET_NAME (CHARSET_FROM_ID (XFIXNUM (XCAR (list)))), val); list = XCDR (list); } return Fnreverse (val); @@ -2186,7 +2186,7 @@ usage: (set-charset-priority &rest charsets) */) list_emacs_mule = Fcons (XCAR (old_list), list_emacs_mule); if (charset_unibyte < 0) { - struct charset *charset = CHARSET_FROM_ID (XINT (XCAR (old_list))); + struct charset *charset = CHARSET_FROM_ID (XFIXNUM (XCAR (old_list))); if (CHARSET_DIMENSION (charset) == 1 && CHARSET_ASCII_COMPATIBLE_P (charset) @@ -2237,7 +2237,7 @@ See also `charset-priority-list' and `set-charset-priority'. */) (Lisp_Object charsets) { Lisp_Object len = Flength (charsets); - ptrdiff_t n = XFASTINT (len), i, j; + ptrdiff_t n = XFIXNAT (len), i, j; int done; Lisp_Object tail, elt, attrs; struct charset_sort_data *sort_data; @@ -2252,7 +2252,7 @@ See also `charset-priority-list' and `set-charset-priority'. */) elt = XCAR (tail); CHECK_CHARSET_GET_ATTR (elt, attrs); sort_data[i].charset = elt; - sort_data[i].id = id = XINT (CHARSET_ATTR_ID (attrs)); + sort_data[i].id = id = XFIXNUM (CHARSET_ATTR_ID (attrs)); if (id < min_id) min_id = id; if (id > max_id) @@ -2262,7 +2262,7 @@ See also `charset-priority-list' and `set-charset-priority'. */) done < n && CONSP (tail); tail = XCDR (tail), i++) { elt = XCAR (tail); - id = XFASTINT (elt); + id = XFIXNAT (elt); if (id >= min_id && id <= max_id) for (j = 0; j < n; j++) if (sort_data[j].id == id) diff --git a/src/charset.h b/src/charset.h index 8832af40d4..7b85a1a4e3 100644 --- a/src/charset.h +++ b/src/charset.h @@ -355,7 +355,7 @@ set_charset_attr (struct charset *charset, enum charset_attr_index idx, \ if (! SYMBOLP (x) || (idx = CHARSET_SYMBOL_HASH_INDEX (x)) < 0) \ wrong_type_argument (Qcharsetp, (x)); \ - id = XINT (AREF (HASH_VALUE (XHASH_TABLE (Vcharset_hash_table), idx), \ + id = XFIXNUM (AREF (HASH_VALUE (XHASH_TABLE (Vcharset_hash_table), idx), \ charset_id)); \ } while (false) @@ -416,7 +416,7 @@ extern Lisp_Object Vchar_charset_set; : (charset)->method == CHARSET_METHOD_MAP \ ? (((charset)->code_linear_p \ && VECTORP (CHARSET_DECODER (charset))) \ - ? XINT (AREF (CHARSET_DECODER (charset), \ + ? XFIXNUM (AREF (CHARSET_DECODER (charset), \ (code) - (charset)->min_code)) \ : decode_char ((charset), (code))) \ : decode_char ((charset), (code))) @@ -447,7 +447,7 @@ extern Lisp_Object charset_work; ? (charset_work = CHAR_TABLE_REF (CHARSET_ENCODER (charset), c), \ (NILP (charset_work) \ ? (charset)->invalid_code \ - : (unsigned) XFASTINT (charset_work))) \ + : (unsigned) XFIXNAT (charset_work))) \ : encode_char (charset, c)) \ : encode_char (charset, c)))) diff --git a/src/chartab.c b/src/chartab.c index f09e9738a5..0383a84a04 100644 --- a/src/chartab.c +++ b/src/chartab.c @@ -119,9 +119,9 @@ the char-table has no extra slot. */) else { CHECK_FIXNAT (n); - if (XINT (n) > 10) + if (XFIXNUM (n) > 10) args_out_of_range (n, Qnil); - n_extras = XINT (n); + n_extras = XFIXNUM (n); } size = CHAR_TABLE_STANDARD_SLOTS + n_extras; @@ -572,11 +572,11 @@ DEFUN ("char-table-extra-slot", Fchar_table_extra_slot, Schar_table_extra_slot, { CHECK_CHAR_TABLE (char_table); CHECK_FIXNUM (n); - if (XINT (n) < 0 - || XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table))) + if (XFIXNUM (n) < 0 + || XFIXNUM (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table))) args_out_of_range (char_table, n); - return XCHAR_TABLE (char_table)->extras[XINT (n)]; + return XCHAR_TABLE (char_table)->extras[XFIXNUM (n)]; } DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot, @@ -587,11 +587,11 @@ DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot, { CHECK_CHAR_TABLE (char_table); CHECK_FIXNUM (n); - if (XINT (n) < 0 - || XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table))) + if (XFIXNUM (n) < 0 + || XFIXNUM (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table))) args_out_of_range (char_table, n); - set_char_table_extras (char_table, XINT (n), value); + set_char_table_extras (char_table, XFIXNUM (n), value); return value; } @@ -608,15 +608,15 @@ a cons of character codes (for characters in the range), or a character code. * if (EQ (range, Qnil)) val = XCHAR_TABLE (char_table)->defalt; else if (CHARACTERP (range)) - val = CHAR_TABLE_REF (char_table, XFASTINT (range)); + val = CHAR_TABLE_REF (char_table, XFIXNAT (range)); else if (CONSP (range)) { int from, to; CHECK_CHARACTER_CAR (range); CHECK_CHARACTER_CDR (range); - from = XFASTINT (XCAR (range)); - to = XFASTINT (XCDR (range)); + from = XFIXNAT (XCAR (range)); + to = XFIXNAT (XCDR (range)); val = char_table_ref_and_range (char_table, from, &from, &to); /* Not yet implemented. */ } @@ -645,13 +645,13 @@ or a character code. Return VALUE. */) else if (EQ (range, Qnil)) set_char_table_defalt (char_table, value); else if (CHARACTERP (range)) - char_table_set (char_table, XINT (range), value); + char_table_set (char_table, XFIXNUM (range), value); else if (CONSP (range)) { CHECK_CHARACTER_CAR (range); CHECK_CHARACTER_CDR (range); char_table_set_range (char_table, - XINT (XCAR (range)), XINT (XCDR (range)), value); + XFIXNUM (XCAR (range)), XFIXNUM (XCDR (range)), value); } else error ("Invalid RANGE argument to `set-char-table-range'"); @@ -742,7 +742,7 @@ map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object), int min_char, max_char; /* Number of characters covered by one element of TABLE. */ int chars_in_block; - int from = XINT (XCAR (range)), to = XINT (XCDR (range)); + int from = XFIXNUM (XCAR (range)), to = XFIXNUM (XCDR (range)); int i, c; bool is_uniprop = UNIPROP_TABLE_P (top); uniprop_decoder_t decoder = UNIPROP_GET_DECODER (top); @@ -878,7 +878,7 @@ map_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object), while (NILP (val) && ! NILP (XCHAR_TABLE (table)->parent)) { Lisp_Object temp; - int from = XINT (XCAR (range)); + int from = XFIXNUM (XCAR (range)); parent = XCHAR_TABLE (table)->parent; temp = XCHAR_TABLE (parent)->parent; @@ -1174,8 +1174,8 @@ uniprop_decode_value_run_length (Lisp_Object table, Lisp_Object value) { Lisp_Object valvec = XCHAR_TABLE (table)->extras[4]; - if (XINT (value) >= 0 && XINT (value) < ASIZE (valvec)) - value = AREF (valvec, XINT (value)); + if (XFIXNUM (value) >= 0 && XFIXNUM (value) < ASIZE (valvec)) + value = AREF (valvec, XFIXNUM (value)); } return value; } @@ -1194,7 +1194,7 @@ uniprop_get_decoder (Lisp_Object table) if (! FIXNUMP (XCHAR_TABLE (table)->extras[1])) return NULL; - i = XINT (XCHAR_TABLE (table)->extras[1]); + i = XFIXNUM (XCHAR_TABLE (table)->extras[1]); if (i < 0 || i >= uniprop_decoder_count) return NULL; return uniprop_decoder[i]; @@ -1269,7 +1269,7 @@ uniprop_get_encoder (Lisp_Object table) if (! FIXNUMP (XCHAR_TABLE (table)->extras[2])) return NULL; - i = XINT (XCHAR_TABLE (table)->extras[2]); + i = XFIXNUM (XCHAR_TABLE (table)->extras[2]); if (i < 0 || i >= uniprop_encoder_count) return NULL; return uniprop_encoder[i]; @@ -1301,7 +1301,7 @@ uniprop_table (Lisp_Object prop) return Qnil; val = XCHAR_TABLE (table)->extras[1]; if (FIXNUMP (val) - ? (XINT (val) < 0 || XINT (val) >= uniprop_decoder_count) + ? (XFIXNUM (val) < 0 || XFIXNUM (val) >= uniprop_decoder_count) : ! NILP (val)) return Qnil; /* Prepare ASCII values in advance for CHAR_TABLE_REF. */ @@ -1337,7 +1337,7 @@ CHAR-TABLE must be what returned by `unicode-property-table-internal'. */) CHECK_CHARACTER (ch); if (! UNIPROP_TABLE_P (char_table)) error ("Invalid Unicode property table"); - val = CHAR_TABLE_REF (char_table, XINT (ch)); + val = CHAR_TABLE_REF (char_table, XFIXNUM (ch)); decoder = uniprop_get_decoder (char_table); return (decoder ? decoder (char_table, val) : val); } @@ -1357,7 +1357,7 @@ CHAR-TABLE must be what returned by `unicode-property-table-internal'. */) encoder = uniprop_get_encoder (char_table); if (encoder) value = encoder (char_table, value); - CHAR_TABLE_SET (char_table, XINT (ch), value); + CHAR_TABLE_SET (char_table, XFIXNUM (ch), value); return Qnil; } diff --git a/src/cmds.c b/src/cmds.c index 857197cf9b..1616efbb44 100644 --- a/src/cmds.c +++ b/src/cmds.c @@ -37,7 +37,7 @@ DEFUN ("forward-point", Fforward_point, Sforward_point, 1, 1, 0, { CHECK_FIXNUM (n); - return make_fixnum (PT + XINT (n)); + return make_fixnum (PT + XFIXNUM (n)); } /* Add N to point; or subtract N if FORWARD is false. N defaults to 1. @@ -45,7 +45,7 @@ DEFUN ("forward-point", Fforward_point, Sforward_point, 1, 1, 0, static Lisp_Object move_point (Lisp_Object n, bool forward) { - /* This used to just set point to point + XINT (n), and then check + /* This used to just set point to point + XFIXNUM (n), and then check to see if it was within boundaries. But now that SET_PT can potentially do a lot of stuff (calling entering and exiting hooks, etcetera), that's not a good approach. So we validate the @@ -58,7 +58,7 @@ move_point (Lisp_Object n, bool forward) else CHECK_FIXNUM (n); - new_point = PT + (forward ? XINT (n) : - XINT (n)); + new_point = PT + (forward ? XFIXNUM (n) : - XFIXNUM (n)); if (new_point < BEGV) { @@ -128,7 +128,7 @@ go to its beginning. */) else { CHECK_FIXNUM (n); - count = XINT (n); + count = XFIXNUM (n); } shortage = scan_newline_from_point (count, &pos, &pos_byte); @@ -164,7 +164,7 @@ instead. For instance, `(forward-line 0)' does the same thing as else CHECK_FIXNUM (n); - SET_PT (XINT (Fline_beginning_position (n))); + SET_PT (XFIXNUM (Fline_beginning_position (n))); return Qnil; } @@ -191,7 +191,7 @@ to t. */) while (1) { - newpos = XINT (Fline_end_position (n)); + newpos = XFIXNUM (Fline_end_position (n)); SET_PT (newpos); if (PT > newpos @@ -232,13 +232,13 @@ because it respects values of `delete-active-region' and `overwrite-mode'. */) CHECK_FIXNUM (n); - if (eabs (XINT (n)) < 2) + if (eabs (XFIXNUM (n)) < 2) call0 (Qundo_auto_amalgamate); - pos = PT + XINT (n); + pos = PT + XFIXNUM (n); if (NILP (killflag)) { - if (XINT (n) < 0) + if (XFIXNUM (n) < 0) { if (pos < BEGV) xsignal0 (Qbeginning_of_buffer); @@ -276,10 +276,10 @@ a non-nil value for the inserted character. At the end, it runs { CHECK_FIXNUM (n); - if (XINT (n) < 0) - error ("Negative repetition argument %"pI"d", XINT (n)); + if (XFIXNUM (n) < 0) + error ("Negative repetition argument %"pI"d", XFIXNUM (n)); - if (XFASTINT (n) < 2) + if (XFIXNAT (n) < 2) call0 (Qundo_auto_amalgamate); /* Barf if the key that invoked this was not a character. */ @@ -287,8 +287,8 @@ a non-nil value for the inserted character. At the end, it runs bitch_at_user (); else { int character = translate_char (Vtranslation_table_for_input, - XINT (last_command_event)); - int val = internal_self_insert (character, XFASTINT (n)); + XFIXNUM (last_command_event)); + int val = internal_self_insert (character, XFIXNAT (n)); if (val == 2) Fset (Qundo_auto__this_command_amalgamating, Qnil); frame_make_pointer_invisible (SELECTED_FRAME ()); @@ -360,7 +360,7 @@ internal_self_insert (int c, EMACS_INT n) if (EQ (overwrite, Qoverwrite_mode_binary)) chars_to_delete = min (n, PTRDIFF_MAX); else if (c != '\n' && c2 != '\n' - && (cwidth = XFASTINT (Fchar_width (make_fixnum (c)))) != 0) + && (cwidth = XFIXNAT (Fchar_width (make_fixnum (c)))) != 0) { ptrdiff_t pos = PT; ptrdiff_t pos_byte = PT_BYTE; @@ -378,7 +378,7 @@ internal_self_insert (int c, EMACS_INT n) character. In that case, the new point is set after that character. */ ptrdiff_t actual_clm - = XFASTINT (Fmove_to_column (make_fixnum (target_clm), Qnil)); + = XFIXNAT (Fmove_to_column (make_fixnum (target_clm), Qnil)); chars_to_delete = PT - pos; @@ -408,8 +408,8 @@ internal_self_insert (int c, EMACS_INT n) && NILP (BVAR (current_buffer, read_only)) && PT > BEGV && (SYNTAX (!NILP (BVAR (current_buffer, enable_multibyte_characters)) - ? XFASTINT (Fprevious_char ()) - : UNIBYTE_TO_CHAR (XFASTINT (Fprevious_char ()))) + ? XFIXNAT (Fprevious_char ()) + : UNIBYTE_TO_CHAR (XFIXNAT (Fprevious_char ()))) == Sword)) { EMACS_INT modiff = MODIFF; diff --git a/src/coding.c b/src/coding.c index a4bb45f350..53e98f8981 100644 --- a/src/coding.c +++ b/src/coding.c @@ -324,7 +324,7 @@ static Lisp_Object Vbig5_coding_system; /* ISO2022 section */ #define CODING_ISO_INITIAL(coding, reg) \ - (XINT (AREF (AREF (CODING_ID_ATTRS ((coding)->id), \ + (XFIXNUM (AREF (AREF (CODING_ID_ATTRS ((coding)->id), \ coding_attr_iso_initial), \ reg))) @@ -2888,7 +2888,7 @@ setup_iso_safe_charsets (Lisp_Object attrs) Lisp_Object reg_usage; Lisp_Object tail; EMACS_INT reg94, reg96; - int flags = XINT (AREF (attrs, coding_attr_iso_flags)); + int flags = XFIXNUM (AREF (attrs, coding_attr_iso_flags)); int max_charset_id; charset_list = CODING_ATTR_CHARSET_LIST (attrs); @@ -2906,7 +2906,7 @@ setup_iso_safe_charsets (Lisp_Object attrs) max_charset_id = 0; for (tail = charset_list; CONSP (tail); tail = XCDR (tail)) { - int id = XINT (XCAR (tail)); + int id = XFIXNUM (XCAR (tail)); if (max_charset_id < id) max_charset_id = id; } @@ -2915,8 +2915,8 @@ setup_iso_safe_charsets (Lisp_Object attrs) memset (SDATA (safe_charsets), 255, max_charset_id + 1); request = AREF (attrs, coding_attr_iso_request); reg_usage = AREF (attrs, coding_attr_iso_usage); - reg94 = XINT (XCAR (reg_usage)); - reg96 = XINT (XCDR (reg_usage)); + reg94 = XFIXNUM (XCAR (reg_usage)); + reg96 = XFIXNUM (XCDR (reg_usage)); for (tail = charset_list; CONSP (tail); tail = XCDR (tail)) { @@ -2925,19 +2925,19 @@ setup_iso_safe_charsets (Lisp_Object attrs) struct charset *charset; id = XCAR (tail); - charset = CHARSET_FROM_ID (XINT (id)); + charset = CHARSET_FROM_ID (XFIXNUM (id)); reg = Fcdr (Fassq (id, request)); if (! NILP (reg)) - SSET (safe_charsets, XINT (id), XINT (reg)); + SSET (safe_charsets, XFIXNUM (id), XFIXNUM (reg)); else if (charset->iso_chars_96) { if (reg96 < 4) - SSET (safe_charsets, XINT (id), reg96); + SSET (safe_charsets, XFIXNUM (id), reg96); } else { if (reg94 < 4) - SSET (safe_charsets, XINT (id), reg94); + SSET (safe_charsets, XFIXNUM (id), reg94); } } ASET (attrs, coding_attr_safe_charsets, safe_charsets); @@ -4612,7 +4612,7 @@ detect_coding_sjis (struct coding_system *coding, CODING_GET_INFO (coding, attrs, charset_list); max_first_byte_of_2_byte_code - = (XINT (Flength (charset_list)) > 3 ? 0xFC : 0xEF); + = (XFIXNUM (Flength (charset_list)) > 3 ? 0xFC : 0xEF); detect_info->checked |= CATEGORY_MASK_SJIS; /* A coding system of this category is always ASCII compatible. */ @@ -4725,10 +4725,10 @@ decode_coding_sjis (struct coding_system *coding) CODING_GET_INFO (coding, attrs, charset_list); val = charset_list; - charset_roman = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val); - charset_kana = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val); - charset_kanji = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val); - charset_kanji2 = NILP (val) ? NULL : CHARSET_FROM_ID (XINT (XCAR (val))); + charset_roman = CHARSET_FROM_ID (XFIXNUM (XCAR (val))), val = XCDR (val); + charset_kana = CHARSET_FROM_ID (XFIXNUM (XCAR (val))), val = XCDR (val); + charset_kanji = CHARSET_FROM_ID (XFIXNUM (XCAR (val))), val = XCDR (val); + charset_kanji2 = NILP (val) ? NULL : CHARSET_FROM_ID (XFIXNUM (XCAR (val))); while (1) { @@ -4840,8 +4840,8 @@ decode_coding_big5 (struct coding_system *coding) CODING_GET_INFO (coding, attrs, charset_list); val = charset_list; - charset_roman = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val); - charset_big5 = CHARSET_FROM_ID (XINT (XCAR (val))); + charset_roman = CHARSET_FROM_ID (XFIXNUM (XCAR (val))), val = XCDR (val); + charset_big5 = CHARSET_FROM_ID (XFIXNUM (XCAR (val))); while (1) { @@ -4936,9 +4936,9 @@ encode_coding_sjis (struct coding_system *coding) CODING_GET_INFO (coding, attrs, charset_list); val = XCDR (charset_list); - charset_kana = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val); - charset_kanji = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val); - charset_kanji2 = NILP (val) ? NULL : CHARSET_FROM_ID (XINT (XCAR (val))); + charset_kana = CHARSET_FROM_ID (XFIXNUM (XCAR (val))), val = XCDR (val); + charset_kanji = CHARSET_FROM_ID (XFIXNUM (XCAR (val))), val = XCDR (val); + charset_kanji2 = NILP (val) ? NULL : CHARSET_FROM_ID (XFIXNUM (XCAR (val))); ascii_compatible = ! NILP (CODING_ATTR_ASCII_COMPAT (attrs)); @@ -5029,7 +5029,7 @@ encode_coding_big5 (struct coding_system *coding) CODING_GET_INFO (coding, attrs, charset_list); val = XCDR (charset_list); - charset_big5 = CHARSET_FROM_ID (XINT (XCAR (val))); + charset_big5 = CHARSET_FROM_ID (XFIXNUM (XCAR (val))); ascii_compatible = ! NILP (CODING_ATTR_ASCII_COMPAT (attrs)); while (charbuf < charbuf_end) @@ -5442,7 +5442,7 @@ detect_coding_charset (struct coding_system *coding, } if (FIXNUMP (val)) { - charset = CHARSET_FROM_ID (XFASTINT (val)); + charset = CHARSET_FROM_ID (XFIXNAT (val)); dim = CHARSET_DIMENSION (charset); for (idx = 1; idx < dim; idx++) { @@ -5461,7 +5461,7 @@ detect_coding_charset (struct coding_system *coding, idx = 1; for (; CONSP (val); val = XCDR (val)) { - charset = CHARSET_FROM_ID (XFASTINT (XCAR (val))); + charset = CHARSET_FROM_ID (XFIXNAT (XCAR (val))); dim = CHARSET_DIMENSION (charset); while (idx < dim) { @@ -5555,7 +5555,7 @@ decode_coding_charset (struct coding_system *coding) goto invalid_code; if (FIXNUMP (val)) { - charset = CHARSET_FROM_ID (XFASTINT (val)); + charset = CHARSET_FROM_ID (XFIXNAT (val)); dim = CHARSET_DIMENSION (charset); while (len < dim) { @@ -5573,7 +5573,7 @@ decode_coding_charset (struct coding_system *coding) comes first). */ while (CONSP (val)) { - charset = CHARSET_FROM_ID (XFASTINT (XCAR (val))); + charset = CHARSET_FROM_ID (XFIXNAT (XCAR (val))); dim = CHARSET_DIMENSION (charset); while (len < dim) { @@ -5726,7 +5726,7 @@ setup_coding_system (Lisp_Object coding_system, struct coding_system *coding) val = CODING_ATTR_SAFE_CHARSETS (attrs); coding->max_charset_id = SCHARS (val) - 1; coding->safe_charsets = SDATA (val); - coding->default_char = XINT (CODING_ATTR_DEFAULT_CHAR (attrs)); + coding->default_char = XFIXNUM (CODING_ATTR_DEFAULT_CHAR (attrs)); coding->carryover_bytes = 0; coding->raw_destination = 0; @@ -5749,7 +5749,7 @@ setup_coding_system (Lisp_Object coding_system, struct coding_system *coding) else if (EQ (coding_type, Qiso_2022)) { int i; - int flags = XINT (AREF (attrs, coding_attr_iso_flags)); + int flags = XFIXNUM (AREF (attrs, coding_attr_iso_flags)); /* Invoke graphic register 0 to plane 0. */ CODING_ISO_INVOCATION (coding, 0) = 0; @@ -5852,13 +5852,13 @@ setup_coding_system (Lisp_Object coding_system, struct coding_system *coding) for (tail = Vemacs_mule_charset_list; CONSP (tail); tail = XCDR (tail)) - if (max_charset_id < XFASTINT (XCAR (tail))) - max_charset_id = XFASTINT (XCAR (tail)); + if (max_charset_id < XFIXNAT (XCAR (tail))) + max_charset_id = XFIXNAT (XCAR (tail)); safe_charsets = make_uninit_string (max_charset_id + 1); memset (SDATA (safe_charsets), 255, max_charset_id + 1); for (tail = Vemacs_mule_charset_list; CONSP (tail); tail = XCDR (tail)) - SSET (safe_charsets, XFASTINT (XCAR (tail)), 0); + SSET (safe_charsets, XFIXNAT (XCAR (tail)), 0); coding->max_charset_id = max_charset_id; coding->safe_charsets = SDATA (safe_charsets); } @@ -5908,7 +5908,7 @@ coding_charset_list (struct coding_system *coding) CODING_GET_INFO (coding, attrs, charset_list); if (EQ (CODING_ATTR_TYPE (attrs), Qiso_2022)) { - int flags = XINT (AREF (attrs, coding_attr_iso_flags)); + int flags = XFIXNUM (AREF (attrs, coding_attr_iso_flags)); if (flags & CODING_ISO_FLAG_FULL_SUPPORT) charset_list = Viso_2022_charset_list; @@ -5934,7 +5934,7 @@ coding_system_charset_list (Lisp_Object coding_system) if (EQ (CODING_ATTR_TYPE (attrs), Qiso_2022)) { - int flags = XINT (AREF (attrs, coding_attr_iso_flags)); + int flags = XFIXNUM (AREF (attrs, coding_attr_iso_flags)); if (flags & CODING_ISO_FLAG_FULL_SUPPORT) charset_list = Viso_2022_charset_list; @@ -6714,7 +6714,7 @@ detect_coding (struct coding_system *coding) } } } - else if (XINT (CODING_ATTR_CATEGORY (CODING_ID_ATTRS (coding->id))) + else if (XFIXNUM (CODING_ATTR_CATEGORY (CODING_ID_ATTRS (coding->id))) == coding_category_utf_8_auto) { Lisp_Object coding_systems; @@ -6740,7 +6740,7 @@ detect_coding (struct coding_system *coding) } } } - else if (XINT (CODING_ATTR_CATEGORY (CODING_ID_ATTRS (coding->id))) + else if (XFIXNUM (CODING_ATTR_CATEGORY (CODING_ID_ATTRS (coding->id))) == coding_category_utf_16_auto) { Lisp_Object coding_systems; @@ -6924,8 +6924,8 @@ get_translation_table (Lisp_Object attrs, bool encodep, int *max_lookup) && CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (translation_table)) > 1) { val = XCHAR_TABLE (translation_table)->extras[1]; - if (FIXNATP (val) && *max_lookup < XFASTINT (val)) - *max_lookup = min (XFASTINT (val), MAX_LOOKUP_MAX); + if (FIXNATP (val) && *max_lookup < XFIXNAT (val)) + *max_lookup = min (XFIXNAT (val), MAX_LOOKUP_MAX); } else if (CONSP (translation_table)) { @@ -6936,8 +6936,8 @@ get_translation_table (Lisp_Object attrs, bool encodep, int *max_lookup) && CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (XCAR (tail))) > 1) { Lisp_Object tailval = XCHAR_TABLE (XCAR (tail))->extras[1]; - if (FIXNATP (tailval) && *max_lookup < XFASTINT (tailval)) - *max_lookup = min (XFASTINT (tailval), MAX_LOOKUP_MAX); + if (FIXNATP (tailval) && *max_lookup < XFIXNAT (tailval)) + *max_lookup = min (XFIXNAT (tailval), MAX_LOOKUP_MAX); } } } @@ -6951,7 +6951,7 @@ get_translation_table (Lisp_Object attrs, bool encodep, int *max_lookup) { \ trans = CHAR_TABLE_REF (table, c); \ if (CHARACTERP (trans)) \ - c = XFASTINT (trans), trans = Qnil; \ + c = XFIXNAT (trans), trans = Qnil; \ } \ else if (CONSP (table)) \ { \ @@ -6962,7 +6962,7 @@ get_translation_table (Lisp_Object attrs, bool encodep, int *max_lookup) { \ trans = CHAR_TABLE_REF (XCAR (tail), c); \ if (CHARACTERP (trans)) \ - c = XFASTINT (trans), trans = Qnil; \ + c = XFIXNAT (trans), trans = Qnil; \ else if (! NILP (trans)) \ break; \ } \ @@ -6997,7 +6997,7 @@ get_translation (Lisp_Object trans, int *buf, int *buf_end, ptrdiff_t *nchars) { if (buf + i == buf_end) return Qt; - if (XINT (AREF (from, i)) != buf[i]) + if (XFIXNUM (AREF (from, i)) != buf[i]) break; } if (i == len) @@ -7049,11 +7049,11 @@ produce_chars (struct coding_system *coding, Lisp_Object translation_table, { trans = get_translation (trans, buf, buf_end, &from_nchars); if (FIXNUMP (trans)) - c = XINT (trans); + c = XFIXNUM (trans); else if (VECTORP (trans)) { to_nchars = ASIZE (trans); - c = XINT (AREF (trans, 0)); + c = XFIXNUM (AREF (trans, 0)); } else if (EQ (trans, Qt) && ! last_block) break; @@ -7081,7 +7081,7 @@ produce_chars (struct coding_system *coding, Lisp_Object translation_table, for (i = 0; i < to_nchars; i++) { if (i > 0) - c = XINT (AREF (trans, i)); + c = XFIXNUM (AREF (trans, i)); if (coding->dst_multibyte || ! CHAR_BYTE8_P (c)) CHAR_STRING_ADVANCE_NO_UNIFY (c, dst); @@ -7534,7 +7534,7 @@ handle_composition_annotation (ptrdiff_t pos, ptrdiff_t limit, { len = ASIZE (components); for (i = 0; i < len; i++) - *buf++ = XINT (AREF (components, i)); + *buf++ = XFIXNUM (AREF (components, i)); } else if (STRINGP (components)) { @@ -7549,13 +7549,13 @@ handle_composition_annotation (ptrdiff_t pos, ptrdiff_t limit, else if (FIXNUMP (components)) { len = 1; - *buf++ = XINT (components); + *buf++ = XFIXNUM (components); } else if (CONSP (components)) { for (len = 0; CONSP (components); len++, components = XCDR (components)) - *buf++ = XINT (XCAR (components)); + *buf++ = XFIXNUM (XCAR (components)); } else emacs_abort (); @@ -7593,14 +7593,14 @@ handle_charset_annotation (ptrdiff_t pos, ptrdiff_t limit, val = Fget_text_property (make_fixnum (pos), Qcharset, coding->src_object); if (! NILP (val) && CHARSETP (val)) - id = XINT (CHARSET_SYMBOL_ID (val)); + id = XFIXNUM (CHARSET_SYMBOL_ID (val)); else id = -1; ADD_CHARSET_DATA (buf, 0, id); next = Fnext_single_property_change (make_fixnum (pos), Qcharset, coding->src_object, make_fixnum (limit)); - *stop = XINT (next); + *stop = XFIXNUM (next); return buf; } @@ -7710,19 +7710,19 @@ consume_chars (struct coding_system *coding, Lisp_Object translation_table, trans = get_translation (trans, lookup_buf, lookup_buf_end, &from_nchars); if (FIXNUMP (trans)) - c = XINT (trans); + c = XFIXNUM (trans); else if (VECTORP (trans)) { to_nchars = ASIZE (trans); if (buf_end - buf < to_nchars) break; - c = XINT (AREF (trans, 0)); + c = XFIXNUM (AREF (trans, 0)); } else break; *buf++ = c; for (i = 1; i < to_nchars; i++) - *buf++ = XINT (AREF (trans, i)); + *buf++ = XFIXNUM (AREF (trans, i)); for (i = 1; i < from_nchars; i++, pos++) src += MULTIBYTE_LENGTH_NO_CHECK (src); } @@ -8618,7 +8618,7 @@ detect_coding_system (const unsigned char *src, detect_info.checked = detect_info.found = detect_info.rejected = 0; /* At first, detect text-format if necessary. */ - base_category = XINT (CODING_ATTR_CATEGORY (attrs)); + base_category = XFIXNUM (CODING_ATTR_CATEGORY (attrs)); if (base_category == coding_category_undecided) { enum coding_category category UNINIT; @@ -8826,7 +8826,7 @@ detect_coding_system (const unsigned char *src, } else { - detect_info.found = 1 << XINT (CODING_ATTR_CATEGORY (attrs)); + detect_info.found = 1 << XFIXNUM (CODING_ATTR_CATEGORY (attrs)); val = list1 (make_fixnum (coding.id)); } @@ -8869,9 +8869,9 @@ detect_coding_system (const unsigned char *src, enum coding_category category; int this_eol; - id = XINT (XCAR (tail)); + id = XFIXNUM (XCAR (tail)); attrs = CODING_ID_ATTRS (id); - category = XINT (CODING_ATTR_CATEGORY (attrs)); + category = XFIXNUM (CODING_ATTR_CATEGORY (attrs)); eol_type = CODING_ID_EOL_TYPE (id); if (VECTORP (eol_type)) { @@ -8922,7 +8922,7 @@ highest priority. */) ptrdiff_t from_byte, to_byte; validate_region (&start, &end); - from = XINT (start), to = XINT (end); + from = XFIXNUM (start), to = XFIXNUM (end); from_byte = CHAR_TO_BYTE (from); to_byte = CHAR_TO_BYTE (to); @@ -8975,7 +8975,7 @@ char_encodable_p (int c, Lisp_Object attrs) for (tail = CODING_ATTR_CHARSET_LIST (attrs); CONSP (tail); tail = XCDR (tail)) { - charset = CHARSET_FROM_ID (XINT (XCAR (tail))); + charset = CHARSET_FROM_ID (XFIXNUM (XCAR (tail))); if (CHAR_CHARSET_P (c, charset)) break; } @@ -9013,21 +9013,21 @@ DEFUN ("find-coding-systems-region-internal", { CHECK_FIXNUM_COERCE_MARKER (start); CHECK_FIXNUM_COERCE_MARKER (end); - if (XINT (start) < BEG || XINT (end) > Z || XINT (start) > XINT (end)) + if (XFIXNUM (start) < BEG || XFIXNUM (end) > Z || XFIXNUM (start) > XFIXNUM (end)) args_out_of_range (start, end); if (NILP (BVAR (current_buffer, enable_multibyte_characters))) return Qt; - start_byte = CHAR_TO_BYTE (XINT (start)); - end_byte = CHAR_TO_BYTE (XINT (end)); - if (XINT (end) - XINT (start) == end_byte - start_byte) + start_byte = CHAR_TO_BYTE (XFIXNUM (start)); + end_byte = CHAR_TO_BYTE (XFIXNUM (end)); + if (XFIXNUM (end) - XFIXNUM (start) == end_byte - start_byte) return Qt; - if (XINT (start) < GPT && XINT (end) > GPT) + if (XFIXNUM (start) < GPT && XFIXNUM (end) > GPT) { - if ((GPT - XINT (start)) < (XINT (end) - GPT)) - move_gap_both (XINT (start), start_byte); + if ((GPT - XFIXNUM (start)) < (XFIXNUM (end) - GPT)) + move_gap_both (XFIXNUM (start), start_byte); else - move_gap_both (XINT (end), end_byte); + move_gap_both (XFIXNUM (end), end_byte); } } @@ -9146,8 +9146,8 @@ to the string and treated as in `substring'. */) if (NILP (string)) { validate_region (&start, &end); - from = XINT (start); - to = XINT (end); + from = XFIXNUM (start); + to = XFIXNUM (end); if (NILP (BVAR (current_buffer, enable_multibyte_characters)) || (ascii_compatible && (to - from) == (CHAR_TO_BYTE (to) - (CHAR_TO_BYTE (from))))) @@ -9176,7 +9176,7 @@ to the string and treated as in `substring'. */) else { CHECK_FIXNAT (count); - n = XINT (count); + n = XFIXNUM (count); } positions = Qnil; @@ -9267,23 +9267,23 @@ is nil. */) { CHECK_FIXNUM_COERCE_MARKER (start); CHECK_FIXNUM_COERCE_MARKER (end); - if (XINT (start) < BEG || XINT (end) > Z || XINT (start) > XINT (end)) + if (XFIXNUM (start) < BEG || XFIXNUM (end) > Z || XFIXNUM (start) > XFIXNUM (end)) args_out_of_range (start, end); if (NILP (BVAR (current_buffer, enable_multibyte_characters))) return Qnil; - start_byte = CHAR_TO_BYTE (XINT (start)); - end_byte = CHAR_TO_BYTE (XINT (end)); - if (XINT (end) - XINT (start) == end_byte - start_byte) + start_byte = CHAR_TO_BYTE (XFIXNUM (start)); + end_byte = CHAR_TO_BYTE (XFIXNUM (end)); + if (XFIXNUM (end) - XFIXNUM (start) == end_byte - start_byte) return Qnil; - if (XINT (start) < GPT && XINT (end) > GPT) + if (XFIXNUM (start) < GPT && XFIXNUM (end) > GPT) { - if ((GPT - XINT (start)) < (XINT (end) - GPT)) - move_gap_both (XINT (start), start_byte); + if ((GPT - XFIXNUM (start)) < (XFIXNUM (end) - GPT)) + move_gap_both (XFIXNUM (start), start_byte); else - move_gap_both (XINT (end), end_byte); + move_gap_both (XFIXNUM (end), end_byte); } - pos = XINT (start); + pos = XFIXNUM (start); } list = Qnil; @@ -9369,9 +9369,9 @@ code_convert_region (Lisp_Object start, Lisp_Object end, CHECK_BUFFER (dst_object); validate_region (&start, &end); - from = XFASTINT (start); + from = XFIXNAT (start); from_byte = CHAR_TO_BYTE (from); - to = XFASTINT (end); + to = XFIXNAT (end); to_byte = CHAR_TO_BYTE (to); setup_coding_system (coding_system, &coding); @@ -9611,7 +9611,7 @@ Return the corresponding character. */) int c; CHECK_FIXNAT (code); - ch = XFASTINT (code); + ch = XFIXNAT (code); CHECK_CODING_SYSTEM_GET_SPEC (Vsjis_coding_system, spec); attrs = AREF (spec, 0); @@ -9620,9 +9620,9 @@ Return the corresponding character. */) return code; val = CODING_ATTR_CHARSET_LIST (attrs); - charset_roman = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val); - charset_kana = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val); - charset_kanji = CHARSET_FROM_ID (XINT (XCAR (val))); + charset_roman = CHARSET_FROM_ID (XFIXNUM (XCAR (val))), val = XCDR (val); + charset_kana = CHARSET_FROM_ID (XFIXNUM (XCAR (val))), val = XCDR (val); + charset_kanji = CHARSET_FROM_ID (XFIXNUM (XCAR (val))); if (ch <= 0x7F) { @@ -9664,7 +9664,7 @@ Return the corresponding code in SJIS. */) unsigned code; CHECK_CHARACTER (ch); - c = XFASTINT (ch); + c = XFIXNAT (ch); CHECK_CODING_SYSTEM_GET_SPEC (Vsjis_coding_system, spec); attrs = AREF (spec, 0); @@ -9692,7 +9692,7 @@ Return the corresponding character. */) int c; CHECK_FIXNAT (code); - ch = XFASTINT (code); + ch = XFIXNAT (code); CHECK_CODING_SYSTEM_GET_SPEC (Vbig5_coding_system, spec); attrs = AREF (spec, 0); @@ -9701,8 +9701,8 @@ Return the corresponding character. */) return code; val = CODING_ATTR_CHARSET_LIST (attrs); - charset_roman = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val); - charset_big5 = CHARSET_FROM_ID (XINT (XCAR (val))); + charset_roman = CHARSET_FROM_ID (XFIXNUM (XCAR (val))), val = XCDR (val); + charset_big5 = CHARSET_FROM_ID (XFIXNUM (XCAR (val))); if (ch <= 0x7F) { @@ -9736,7 +9736,7 @@ Return the corresponding character code in Big5. */) unsigned code; CHECK_CHARACTER (ch); - c = XFASTINT (ch); + c = XFIXNAT (ch); CHECK_CODING_SYSTEM_GET_SPEC (Vbig5_coding_system, spec); attrs = AREF (spec, 0); if (ASCII_CHAR_P (c) @@ -9885,17 +9885,17 @@ usage: (find-operation-coding-system OPERATION ARGUMENTS...) */) if (!SYMBOLP (operation) || (target_idx = Fget (operation, Qtarget_idx), !FIXNATP (target_idx))) error ("Invalid first argument"); - if (nargs <= 1 + XFASTINT (target_idx)) + if (nargs <= 1 + XFIXNAT (target_idx)) error ("Too few arguments for operation `%s'", SDATA (SYMBOL_NAME (operation))); - target = args[XFASTINT (target_idx) + 1]; + target = args[XFIXNAT (target_idx) + 1]; if (!(STRINGP (target) || (EQ (operation, Qinsert_file_contents) && CONSP (target) && STRINGP (XCAR (target)) && BUFFERP (XCDR (target))) || (EQ (operation, Qopen_network_stream) && (FIXNUMP (target) || EQ (target, Qt))))) error ("Invalid argument %"pI"d of operation `%s'", - XFASTINT (target_idx) + 1, SDATA (SYMBOL_NAME (operation))); + XFIXNAT (target_idx) + 1, SDATA (SYMBOL_NAME (operation))); if (CONSP (target)) target = XCAR (target); @@ -9967,7 +9967,7 @@ usage: (set-coding-system-priority &rest coding-systems) */) CHECK_CODING_SYSTEM_GET_SPEC (args[i], spec); attrs = AREF (spec, 0); - category = XINT (CODING_ATTR_CATEGORY (attrs)); + category = XFIXNUM (CODING_ATTR_CATEGORY (attrs)); if (changed[category]) /* Ignore this coding system because a coding system of the same category already had a higher priority. */ @@ -10110,8 +10110,8 @@ usage: (define-coding-system-internal ...) */) { if (! RANGED_FIXNUMP (0, XCAR (tail), INT_MAX - 1)) error ("Invalid charset-list"); - if (max_charset_id < XFASTINT (XCAR (tail))) - max_charset_id = XFASTINT (XCAR (tail)); + if (max_charset_id < XFIXNAT (XCAR (tail))) + max_charset_id = XFIXNAT (XCAR (tail)); } } else @@ -10141,7 +10141,7 @@ usage: (define-coding-system-internal ...) */) safe_charsets = make_uninit_string (max_charset_id + 1); memset (SDATA (safe_charsets), 255, max_charset_id + 1); for (tail = charset_list; CONSP (tail); tail = XCDR (tail)) - SSET (safe_charsets, XFASTINT (XCAR (tail)), 0); + SSET (safe_charsets, XFIXNAT (XCAR (tail)), 0); ASET (attrs, coding_attr_safe_charsets, safe_charsets); ASET (attrs, coding_attr_ascii_compat, args[coding_arg_ascii_compatible_p]); @@ -10198,7 +10198,7 @@ usage: (define-coding-system-internal ...) */) for (tail = charset_list; CONSP (tail); tail = XCDR (tail)) { - struct charset *charset = CHARSET_FROM_ID (XFASTINT (XCAR (tail))); + struct charset *charset = CHARSET_FROM_ID (XFIXNAT (XCAR (tail))); int dim = CHARSET_DIMENSION (charset); int idx = (dim - 1) * 4; @@ -10216,7 +10216,7 @@ usage: (define-coding-system-internal ...) */) tmp = XCAR (tail); else if (FIXED_OR_FLOATP (tmp)) { - dim2 = CHARSET_DIMENSION (CHARSET_FROM_ID (XFASTINT (tmp))); + dim2 = CHARSET_DIMENSION (CHARSET_FROM_ID (XFIXNAT (tmp))); if (dim < dim2) tmp = list2 (XCAR (tail), tmp); else @@ -10226,7 +10226,7 @@ usage: (define-coding-system-internal ...) */) { for (tmp2 = tmp; CONSP (tmp2); tmp2 = XCDR (tmp2)) { - dim2 = CHARSET_DIMENSION (CHARSET_FROM_ID (XFASTINT (XCAR (tmp2)))); + dim2 = CHARSET_DIMENSION (CHARSET_FROM_ID (XFIXNAT (XCAR (tmp2)))); if (dim < dim2) break; } @@ -10272,23 +10272,23 @@ usage: (define-coding-system-internal ...) */) val = XCAR (tail); if (FIXNUMP (val)) { - if (! (0 <= XINT (val) && XINT (val) <= 255)) + if (! (0 <= XFIXNUM (val) && XFIXNUM (val) <= 255)) args_out_of_range_3 (val, make_fixnum (0), make_fixnum (255)); - from = to = XINT (val); + from = to = XFIXNUM (val); } else { CHECK_CONS (val); CHECK_FIXNAT_CAR (val); CHECK_FIXNUM_CDR (val); - if (XINT (XCAR (val)) > 255) + if (XFIXNUM (XCAR (val)) > 255) args_out_of_range_3 (XCAR (val), make_fixnum (0), make_fixnum (255)); - from = XINT (XCAR (val)); - if (! (from <= XINT (XCDR (val)) && XINT (XCDR (val)) <= 255)) + from = XFIXNUM (XCAR (val)); + if (! (from <= XFIXNUM (XCDR (val)) && XFIXNUM (XCDR (val)) <= 255)) args_out_of_range_3 (XCDR (val), XCAR (val), make_fixnum (255)); - to = XINT (XCDR (val)); + to = XFIXNUM (XCDR (val)); } for (i = from; i <= to; i++) SSET (valids, i, 1); @@ -10376,14 +10376,14 @@ usage: (define-coding-system-internal ...) */) tmp1 = XCAR (val); CHECK_CHARSET_GET_ID (tmp1, id); CHECK_FIXNAT_CDR (val); - if (XINT (XCDR (val)) >= 4) - error ("Invalid graphic register number: %"pI"d", XINT (XCDR (val))); + if (XFIXNUM (XCDR (val)) >= 4) + error ("Invalid graphic register number: %"pI"d", XFIXNUM (XCDR (val))); XSETCAR (val, make_fixnum (id)); } flags = args[coding_arg_iso2022_flags]; CHECK_FIXNAT (flags); - i = XINT (flags) & INT_MAX; + i = XFIXNUM (flags) & INT_MAX; if (EQ (args[coding_arg_charset_list], Qiso_2022)) i |= CODING_ISO_FLAG_FULL_SUPPORT; flags = make_fixnum (i); @@ -10403,7 +10403,7 @@ usage: (define-coding-system-internal ...) */) : coding_category_iso_7_tight); else { - int id = XINT (AREF (initial, 1)); + int id = XFIXNUM (AREF (initial, 1)); category = (((i & CODING_ISO_FLAG_LOCKING_SHIFT) || EQ (args[coding_arg_charset_list], Qiso_2022) @@ -10429,11 +10429,11 @@ usage: (define-coding-system-internal ...) */) struct charset *charset; - if (XINT (Flength (charset_list)) != 3 - && XINT (Flength (charset_list)) != 4) + if (XFIXNUM (Flength (charset_list)) != 3 + && XFIXNUM (Flength (charset_list)) != 4) error ("There should be three or four charsets"); - charset = CHARSET_FROM_ID (XINT (XCAR (charset_list))); + charset = CHARSET_FROM_ID (XFIXNUM (XCAR (charset_list))); if (CHARSET_DIMENSION (charset) != 1) error ("Dimension of charset %s is not one", SDATA (SYMBOL_NAME (CHARSET_NAME (charset)))); @@ -10441,13 +10441,13 @@ usage: (define-coding-system-internal ...) */) ASET (attrs, coding_attr_ascii_compat, Qt); charset_list = XCDR (charset_list); - charset = CHARSET_FROM_ID (XINT (XCAR (charset_list))); + charset = CHARSET_FROM_ID (XFIXNUM (XCAR (charset_list))); if (CHARSET_DIMENSION (charset) != 1) error ("Dimension of charset %s is not one", SDATA (SYMBOL_NAME (CHARSET_NAME (charset)))); charset_list = XCDR (charset_list); - charset = CHARSET_FROM_ID (XINT (XCAR (charset_list))); + charset = CHARSET_FROM_ID (XFIXNUM (XCAR (charset_list))); if (CHARSET_DIMENSION (charset) != 2) error ("Dimension of charset %s is not two", SDATA (SYMBOL_NAME (CHARSET_NAME (charset)))); @@ -10455,7 +10455,7 @@ usage: (define-coding-system-internal ...) */) charset_list = XCDR (charset_list); if (! NILP (charset_list)) { - charset = CHARSET_FROM_ID (XINT (XCAR (charset_list))); + charset = CHARSET_FROM_ID (XFIXNUM (XCAR (charset_list))); if (CHARSET_DIMENSION (charset) != 2) error ("Dimension of charset %s is not two", SDATA (SYMBOL_NAME (CHARSET_NAME (charset)))); @@ -10468,10 +10468,10 @@ usage: (define-coding-system-internal ...) */) { struct charset *charset; - if (XINT (Flength (charset_list)) != 2) + if (XFIXNUM (Flength (charset_list)) != 2) error ("There should be just two charsets"); - charset = CHARSET_FROM_ID (XINT (XCAR (charset_list))); + charset = CHARSET_FROM_ID (XFIXNUM (XCAR (charset_list))); if (CHARSET_DIMENSION (charset) != 1) error ("Dimension of charset %s is not one", SDATA (SYMBOL_NAME (CHARSET_NAME (charset)))); @@ -10479,7 +10479,7 @@ usage: (define-coding-system-internal ...) */) ASET (attrs, coding_attr_ascii_compat, Qt); charset_list = XCDR (charset_list); - charset = CHARSET_FROM_ID (XINT (XCAR (charset_list))); + charset = CHARSET_FROM_ID (XFIXNUM (XCAR (charset_list))); if (CHARSET_DIMENSION (charset) != 2) error ("Dimension of charset %s is not two", SDATA (SYMBOL_NAME (CHARSET_NAME (charset)))); diff --git a/src/composite.c b/src/composite.c index f5e05d6875..39c54fcfab 100644 --- a/src/composite.c +++ b/src/composite.c @@ -196,9 +196,9 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars, if (FIXNUMP (id)) { /* PROP should be Form-B. */ - if (XINT (id) < 0 || XINT (id) >= n_compositions) + if (XFIXNUM (id) < 0 || XFIXNUM (id) >= n_compositions) goto invalid_composition; - return XINT (id); + return XFIXNUM (id); } /* PROP should be Form-A. @@ -206,7 +206,7 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars, if (!CONSP (id)) goto invalid_composition; length = XCAR (id); - if (!FIXNUMP (length) || XINT (length) != nchars) + if (!FIXNUMP (length) || XFIXNUM (length) != nchars) goto invalid_composition; components = XCDR (id); @@ -251,7 +251,7 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars, id = HASH_VALUE (hash_table, hash_index); XSETCAR (prop, id); XSETCDR (prop, Fcons (make_fixnum (nchars), Fcons (key, XCDR (prop)))); - return XINT (id); + return XFIXNUM (id); } /* This composition is a new one. We must register it. */ @@ -332,7 +332,7 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars, for (i = 0; i < glyph_len; i++) { int this_width; - ch = XINT (key_contents[i]); + ch = XFIXNUM (key_contents[i]); /* TAB in a composition means display glyphs with padding space on the left or right. */ this_width = (ch == '\t' ? 1 : CHARACTER_WIDTH (ch)); @@ -345,7 +345,7 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars, /* Rule-base composition. */ double leftmost = 0.0, rightmost; - ch = XINT (key_contents[0]); + ch = XFIXNUM (key_contents[0]); rightmost = ch != '\t' ? CHARACTER_WIDTH (ch) : 1; for (i = 1; i < glyph_len; i += 2) @@ -354,8 +354,8 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars, int this_width; double this_left; - rule = XINT (key_contents[i]); - ch = XINT (key_contents[i + 1]); + rule = XFIXNUM (key_contents[i]); + ch = XFIXNUM (key_contents[i + 1]); this_width = ch != '\t' ? CHARACTER_WIDTH (ch) : 1; /* A composition rule is specified by an integer value @@ -433,7 +433,7 @@ find_composition (ptrdiff_t pos, ptrdiff_t limit, { val = Fnext_single_property_change (make_fixnum (pos), Qcomposition, object, make_fixnum (limit)); - pos = XINT (val); + pos = XFIXNUM (val); if (pos == limit) return 0; } @@ -444,7 +444,7 @@ find_composition (ptrdiff_t pos, ptrdiff_t limit, return 1; val = Fprevious_single_property_change (make_fixnum (pos), Qcomposition, object, make_fixnum (limit)); - pos = XINT (val); + pos = XFIXNUM (val); if (pos == limit) return 0; pos--; @@ -836,7 +836,7 @@ fill_gstring_body (Lisp_Object gstring) for (i = 0; i < len; i++) { Lisp_Object g = LGSTRING_GLYPH (gstring, i); - int c = XFASTINT (AREF (header, i + 1)); + int c = XFIXNAT (AREF (header, i + 1)); if (NILP (g)) { @@ -852,7 +852,7 @@ fill_gstring_body (Lisp_Object gstring) } else { - int width = XFASTINT (CHAR_TABLE_REF (Vchar_width_table, c)); + int width = XFIXNAT (CHAR_TABLE_REF (Vchar_width_table, c)); LGLYPH_SET_CODE (g, c); LGLYPH_SET_LBEARING (g, 0); @@ -941,7 +941,7 @@ char_composable_p (int c) return (c > ' ' && (c == ZERO_WIDTH_NON_JOINER || c == ZERO_WIDTH_JOINER || (val = CHAR_TABLE_REF (Vunicode_category_table, c), - (FIXNUMP (val) && (XINT (val) <= UNICODE_CATEGORY_So))))); + (FIXNUMP (val) && (XFIXNUM (val) <= UNICODE_CATEGORY_So))))); } /* Update cmp_it->stop_pos to the next position after CHARPOS (and @@ -1031,10 +1031,10 @@ composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos, Lisp_Object elt = XCAR (val); if (VECTORP (elt) && ASIZE (elt) == 3 && FIXNATP (AREF (elt, 1)) - && charpos - 1 - XFASTINT (AREF (elt, 1)) >= start) + && charpos - 1 - XFIXNAT (AREF (elt, 1)) >= start) { cmp_it->rule_idx = ridx; - cmp_it->lookback = XFASTINT (AREF (elt, 1)); + cmp_it->lookback = XFIXNAT (AREF (elt, 1)); cmp_it->stop_pos = charpos - 1 - cmp_it->lookback; cmp_it->ch = c; return; @@ -1082,9 +1082,9 @@ composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos, Lisp_Object elt = XCAR (val); if (VECTORP (elt) && ASIZE (elt) == 3 && FIXNATP (AREF (elt, 1)) - && charpos - XFASTINT (AREF (elt, 1)) > endpos) + && charpos - XFIXNAT (AREF (elt, 1)) > endpos) { - ptrdiff_t back = XFASTINT (AREF (elt, 1)); + ptrdiff_t back = XFIXNAT (AREF (elt, 1)); ptrdiff_t cpos = charpos - back, bpos; if (back == 0) @@ -1223,7 +1223,7 @@ composition_reseat_it (struct composition_it *cmp_it, ptrdiff_t charpos, if (! VECTORP (elt) || ASIZE (elt) != 3 || ! FIXNUMP (AREF (elt, 1))) continue; - if (XFASTINT (AREF (elt, 1)) != cmp_it->lookback) + if (XFIXNAT (AREF (elt, 1)) != cmp_it->lookback) goto no_composition; lgstring = autocmp_chars (elt, charpos, bytepos, endpos, w, face, string); @@ -1262,7 +1262,7 @@ composition_reseat_it (struct composition_it *cmp_it, ptrdiff_t charpos, goto no_composition; if (NILP (LGSTRING_ID (lgstring))) lgstring = composition_gstring_put_cache (lgstring, -1); - cmp_it->id = XINT (LGSTRING_ID (lgstring)); + cmp_it->id = XFIXNUM (LGSTRING_ID (lgstring)); int i; for (i = 0; i < LGSTRING_GLYPH_LEN (lgstring); i++) if (NILP (LGSTRING_GLYPH (lgstring, i))) @@ -1391,7 +1391,7 @@ composition_update_it (struct composition_it *cmp_it, ptrdiff_t charpos, ptrdiff cmp_it->width = 0; for (i = cmp_it->nchars - 1; i >= 0; i--) { - c = XINT (LGSTRING_CHAR (gstring, from + i)); + c = XFIXNUM (LGSTRING_CHAR (gstring, from + i)); cmp_it->nbytes += CHAR_BYTES (c); cmp_it->width += CHARACTER_WIDTH (c); } @@ -1561,7 +1561,7 @@ find_automatic_composition (ptrdiff_t pos, ptrdiff_t limit, if (VECTORP (elt) && ASIZE (elt) == 3 && FIXNATP (AREF (elt, 1))) { - EMACS_INT check_pos = cur.pos - XFASTINT (AREF (elt, 1)); + EMACS_INT check_pos = cur.pos - XFIXNAT (AREF (elt, 1)); struct position_record check; if (check_pos < head @@ -1739,8 +1739,8 @@ should be ignored. */) if (NILP (BVAR (current_buffer, enable_multibyte_characters))) error ("Attempt to shape unibyte text"); validate_region (&from, &to); - frompos = XFASTINT (from); - topos = XFASTINT (to); + frompos = XFIXNAT (from); + topos = XFIXNAT (to); frombyte = CHAR_TO_BYTE (frompos); } else @@ -1785,7 +1785,7 @@ for the composition. See `compose-region' for more details. */) && !STRINGP (components)) CHECK_VECTOR (components); - compose_text (XINT (start), XINT (end), components, modification_func, Qnil); + compose_text (XFIXNUM (start), XFIXNUM (end), components, modification_func, Qnil); return Qnil; } @@ -1824,7 +1824,7 @@ See `find-composition' for more details. */) if (!NILP (limit)) { CHECK_FIXNUM_COERCE_MARKER (limit); - to = min (XINT (limit), ZV); + to = min (XFIXNUM (limit), ZV); } else to = -1; @@ -1832,15 +1832,15 @@ See `find-composition' for more details. */) if (!NILP (string)) { CHECK_STRING (string); - if (XINT (pos) < 0 || XINT (pos) > SCHARS (string)) + if (XFIXNUM (pos) < 0 || XFIXNUM (pos) > SCHARS (string)) args_out_of_range (string, pos); } else { - if (XINT (pos) < BEGV || XINT (pos) > ZV) + if (XFIXNUM (pos) < BEGV || XFIXNUM (pos) > ZV) args_out_of_range (Fcurrent_buffer (), pos); } - from = XINT (pos); + from = XFIXNUM (pos); if (!find_composition (from, to, &start, &end, &prop, string)) { @@ -1851,12 +1851,12 @@ See `find-composition' for more details. */) return list3 (make_fixnum (start), make_fixnum (end), gstring); return Qnil; } - if ((end <= XINT (pos) || start > XINT (pos))) + if ((end <= XFIXNUM (pos) || start > XFIXNUM (pos))) { ptrdiff_t s, e; if (find_automatic_composition (from, to, &s, &e, &gstring, string) - && (e <= XINT (pos) ? e > end : s < start)) + && (e <= XFIXNUM (pos) ? e > end : s < start)) return list3 (make_fixnum (s), make_fixnum (e), gstring); } if (!composition_valid_p (start, end, prop)) diff --git a/src/composite.h b/src/composite.h index 175381fad0..2d03e48ecc 100644 --- a/src/composite.h +++ b/src/composite.h @@ -63,13 +63,13 @@ composition_registered_p (Lisp_Object prop) } /* Return ID number of the already registered composition. */ -#define COMPOSITION_ID(prop) XINT (XCAR (prop)) +#define COMPOSITION_ID(prop) XFIXNUM (XCAR (prop)) /* Return length of the composition. */ #define COMPOSITION_LENGTH(prop) \ (composition_registered_p (prop) \ - ? XINT (XCAR (XCDR (prop))) \ - : XINT (XCAR (XCAR (prop)))) + ? XFIXNUM (XCAR (XCDR (prop))) \ + : XFIXNUM (XCAR (XCAR (prop)))) /* Return components of the composition. */ #define COMPOSITION_COMPONENTS(prop) \ @@ -86,7 +86,7 @@ composition_registered_p (Lisp_Object prop) /* Return the Nth glyph of composition specified by CMP. CMP is a pointer to `struct composition'. */ #define COMPOSITION_GLYPH(cmp, n) \ - XINT (XVECTOR (XVECTOR (XHASH_TABLE (composition_hash_table) \ + XFIXNUM (XVECTOR (XVECTOR (XHASH_TABLE (composition_hash_table) \ ->key_and_value) \ ->contents[cmp->hash_index * 2]) \ ->contents[cmp->method == COMPOSITION_WITH_RULE_ALTCHARS \ @@ -96,7 +96,7 @@ composition_registered_p (Lisp_Object prop) rule-base composition specified by CMP. CMP is a pointer to `struct composition'. */ #define COMPOSITION_RULE(cmp, n) \ - XINT (XVECTOR (XVECTOR (XHASH_TABLE (composition_hash_table) \ + XFIXNUM (XVECTOR (XVECTOR (XHASH_TABLE (composition_hash_table) \ ->key_and_value) \ ->contents[cmp->hash_index * 2]) \ ->contents[(n) * 2 - 1]) @@ -275,18 +275,18 @@ enum lglyph_indices }; #define LGLYPH_NEW() Fmake_vector (make_fixnum (LGLYPH_SIZE), Qnil) -#define LGLYPH_FROM(g) XINT (AREF ((g), LGLYPH_IX_FROM)) -#define LGLYPH_TO(g) XINT (AREF ((g), LGLYPH_IX_TO)) -#define LGLYPH_CHAR(g) XINT (AREF ((g), LGLYPH_IX_CHAR)) +#define LGLYPH_FROM(g) XFIXNUM (AREF ((g), LGLYPH_IX_FROM)) +#define LGLYPH_TO(g) XFIXNUM (AREF ((g), LGLYPH_IX_TO)) +#define LGLYPH_CHAR(g) XFIXNUM (AREF ((g), LGLYPH_IX_CHAR)) #define LGLYPH_CODE(g) \ (NILP (AREF ((g), LGLYPH_IX_CODE)) \ ? FONT_INVALID_CODE \ : cons_to_unsigned (AREF (g, LGLYPH_IX_CODE), TYPE_MAXIMUM (unsigned))) -#define LGLYPH_WIDTH(g) XINT (AREF ((g), LGLYPH_IX_WIDTH)) -#define LGLYPH_LBEARING(g) XINT (AREF ((g), LGLYPH_IX_LBEARING)) -#define LGLYPH_RBEARING(g) XINT (AREF ((g), LGLYPH_IX_RBEARING)) -#define LGLYPH_ASCENT(g) XINT (AREF ((g), LGLYPH_IX_ASCENT)) -#define LGLYPH_DESCENT(g) XINT (AREF ((g), LGLYPH_IX_DESCENT)) +#define LGLYPH_WIDTH(g) XFIXNUM (AREF ((g), LGLYPH_IX_WIDTH)) +#define LGLYPH_LBEARING(g) XFIXNUM (AREF ((g), LGLYPH_IX_LBEARING)) +#define LGLYPH_RBEARING(g) XFIXNUM (AREF ((g), LGLYPH_IX_RBEARING)) +#define LGLYPH_ASCENT(g) XFIXNUM (AREF ((g), LGLYPH_IX_ASCENT)) +#define LGLYPH_DESCENT(g) XFIXNUM (AREF ((g), LGLYPH_IX_DESCENT)) #define LGLYPH_ADJUSTMENT(g) AREF ((g), LGLYPH_IX_ADJUSTMENT) #define LGLYPH_SET_FROM(g, val) ASET ((g), LGLYPH_IX_FROM, make_fixnum (val)) #define LGLYPH_SET_TO(g, val) ASET ((g), LGLYPH_IX_TO, make_fixnum (val)) @@ -304,11 +304,11 @@ enum lglyph_indices #define LGLYPH_SET_ADJUSTMENT(g, val) ASET ((g), LGLYPH_IX_ADJUSTMENT, (val)) #define LGLYPH_XOFF(g) (VECTORP (LGLYPH_ADJUSTMENT (g)) \ - ? XINT (AREF (LGLYPH_ADJUSTMENT (g), 0)) : 0) + ? XFIXNUM (AREF (LGLYPH_ADJUSTMENT (g), 0)) : 0) #define LGLYPH_YOFF(g) (VECTORP (LGLYPH_ADJUSTMENT (g)) \ - ? XINT (AREF (LGLYPH_ADJUSTMENT (g), 1)) : 0) + ? XFIXNUM (AREF (LGLYPH_ADJUSTMENT (g), 1)) : 0) #define LGLYPH_WADJUST(g) (VECTORP (LGLYPH_ADJUSTMENT (g)) \ - ? XINT (AREF (LGLYPH_ADJUSTMENT (g), 2)) : 0) + ? XFIXNUM (AREF (LGLYPH_ADJUSTMENT (g), 2)) : 0) extern Lisp_Object composition_gstring_put_cache (Lisp_Object, ptrdiff_t); extern Lisp_Object composition_gstring_from_id (ptrdiff_t); diff --git a/src/data.c b/src/data.c index 4388a2b0ff..6512e7e670 100644 --- a/src/data.c +++ b/src/data.c @@ -74,7 +74,7 @@ XKBOARD_OBJFWD (union Lisp_Fwd *a) return &a->u_kboard_objfwd; } static struct Lisp_Intfwd * -XINTFWD (union Lisp_Fwd *a) +XFIXNUMFWD (union Lisp_Fwd *a) { eassert (INTFWDP (a)); return &a->u_intfwd; @@ -1013,7 +1013,7 @@ do_symval_forwarding (register union Lisp_Fwd *valcontents) switch (XFWDTYPE (valcontents)) { case Lisp_Fwd_Int: - XSETINT (val, *XINTFWD (valcontents)->intvar); + XSETINT (val, *XFIXNUMFWD (valcontents)->intvar); return val; case Lisp_Fwd_Bool: @@ -1050,7 +1050,7 @@ do_symval_forwarding (register union Lisp_Fwd *valcontents) void wrong_choice (Lisp_Object choice, Lisp_Object wrong) { - ptrdiff_t i = 0, len = XINT (Flength (choice)); + ptrdiff_t i = 0, len = XFIXNUM (Flength (choice)); Lisp_Object obj, *args; AUTO_STRING (one_of, "One of "); AUTO_STRING (comma, ", "); @@ -1106,7 +1106,7 @@ store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newva { case Lisp_Fwd_Int: CHECK_FIXNUM (newval); - *XINTFWD (valcontents)->intvar = XINT (newval); + *XFIXNUMFWD (valcontents)->intvar = XFIXNUM (newval); break; case Lisp_Fwd_Bool: @@ -2254,7 +2254,7 @@ or a byte-code object. IDX starts at 0. */) register EMACS_INT idxval; CHECK_FIXNUM (idx); - idxval = XINT (idx); + idxval = XFIXNUM (idx); if (STRINGP (array)) { int c; @@ -2305,7 +2305,7 @@ bool-vector. IDX starts at 0. */) register EMACS_INT idxval; CHECK_FIXNUM (idx); - idxval = XINT (idx); + idxval = XFIXNUM (idx); if (! RECORDP (array)) CHECK_ARRAY (array, Qarrayp); @@ -2341,7 +2341,7 @@ bool-vector. IDX starts at 0. */) if (idxval < 0 || idxval >= SCHARS (array)) args_out_of_range (array, idx); CHECK_CHARACTER (newelt); - c = XFASTINT (newelt); + c = XFIXNAT (newelt); if (STRING_MULTIBYTE (array)) { @@ -2420,16 +2420,16 @@ bignumcompare (Lisp_Object num1, Lisp_Object num2, } else if (FIXNUMP (num2)) { - if (sizeof (EMACS_INT) > sizeof (long) && XINT (num2) > LONG_MAX) + if (sizeof (EMACS_INT) > sizeof (long) && XFIXNUM (num2) > LONG_MAX) { mpz_t tem; mpz_init (tem); - mpz_set_intmax (tem, XINT (num2)); + mpz_set_intmax (tem, XFIXNUM (num2)); cmp = mpz_cmp (XBIGNUM (num1)->value, tem); mpz_clear (tem); } else - cmp = mpz_cmp_si (XBIGNUM (num1)->value, XINT (num2)); + cmp = mpz_cmp_si (XBIGNUM (num1)->value, XFIXNUM (num2)); } else { @@ -2451,16 +2451,16 @@ bignumcompare (Lisp_Object num1, Lisp_Object num2, else { eassume (FIXNUMP (num1)); - if (sizeof (EMACS_INT) > sizeof (long) && XINT (num1) > LONG_MAX) + if (sizeof (EMACS_INT) > sizeof (long) && XFIXNUM (num1) > LONG_MAX) { mpz_t tem; mpz_init (tem); - mpz_set_intmax (tem, XINT (num1)); + mpz_set_intmax (tem, XFIXNUM (num1)); cmp = - mpz_cmp (XBIGNUM (num2)->value, tem); mpz_clear (tem); } else - cmp = - mpz_cmp_si (XBIGNUM (num2)->value, XINT (num1)); + cmp = - mpz_cmp_si (XBIGNUM (num2)->value, XFIXNUM (num1)); } } @@ -2537,13 +2537,13 @@ arithcompare (Lisp_Object num1, Lisp_Object num2, floating-point comparison reports a tie, NUM1 = F1 = F2 = I1 (exactly) so I1 - I2 = NUM1 - NUM2 (exactly), so comparing I1 to I2 will break the tie correctly. */ - i1 = f2 = i2 = XINT (num2); + i1 = f2 = i2 = XFIXNUM (num2); } fneq = f1 != f2; } else { - i1 = XINT (num1); + i1 = XFIXNUM (num1); if (FLOATP (num2)) { /* Compare an integer NUM1 to a float NUM2. This is the @@ -2554,7 +2554,7 @@ arithcompare (Lisp_Object num1, Lisp_Object num2, } else { - i2 = XINT (num2); + i2 = XFIXNUM (num2); fneq = false; } } @@ -2687,8 +2687,8 @@ cons_to_unsigned (Lisp_Object c, uintmax_t max) uintmax_t val UNINIT; if (FIXNUMP (c)) { - valid = XINT (c) >= 0; - val = XINT (c); + valid = XFIXNUM (c) >= 0; + val = XFIXNUM (c); } else if (FLOATP (c)) { @@ -2701,24 +2701,24 @@ cons_to_unsigned (Lisp_Object c, uintmax_t max) } else if (CONSP (c) && FIXNATP (XCAR (c))) { - uintmax_t top = XFASTINT (XCAR (c)); + uintmax_t top = XFIXNAT (XCAR (c)); Lisp_Object rest = XCDR (c); if (top <= UINTMAX_MAX >> 24 >> 16 && CONSP (rest) - && FIXNATP (XCAR (rest)) && XFASTINT (XCAR (rest)) < 1 << 24 - && FIXNATP (XCDR (rest)) && XFASTINT (XCDR (rest)) < 1 << 16) + && FIXNATP (XCAR (rest)) && XFIXNAT (XCAR (rest)) < 1 << 24 + && FIXNATP (XCDR (rest)) && XFIXNAT (XCDR (rest)) < 1 << 16) { - uintmax_t mid = XFASTINT (XCAR (rest)); - val = top << 24 << 16 | mid << 16 | XFASTINT (XCDR (rest)); + uintmax_t mid = XFIXNAT (XCAR (rest)); + val = top << 24 << 16 | mid << 16 | XFIXNAT (XCDR (rest)); valid = true; } else if (top <= UINTMAX_MAX >> 16) { if (CONSP (rest)) rest = XCAR (rest); - if (FIXNATP (rest) && XFASTINT (rest) < 1 << 16) + if (FIXNATP (rest) && XFIXNAT (rest) < 1 << 16) { - val = top << 16 | XFASTINT (rest); + val = top << 16 | XFIXNAT (rest); valid = true; } } @@ -2741,7 +2741,7 @@ cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max) intmax_t val UNINIT; if (FIXNUMP (c)) { - val = XINT (c); + val = XFIXNUM (c); valid = true; } else if (FLOATP (c)) @@ -2755,24 +2755,24 @@ cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max) } else if (CONSP (c) && FIXNUMP (XCAR (c))) { - intmax_t top = XINT (XCAR (c)); + intmax_t top = XFIXNUM (XCAR (c)); Lisp_Object rest = XCDR (c); if (top >= INTMAX_MIN >> 24 >> 16 && top <= INTMAX_MAX >> 24 >> 16 && CONSP (rest) - && FIXNATP (XCAR (rest)) && XFASTINT (XCAR (rest)) < 1 << 24 - && FIXNATP (XCDR (rest)) && XFASTINT (XCDR (rest)) < 1 << 16) + && FIXNATP (XCAR (rest)) && XFIXNAT (XCAR (rest)) < 1 << 24 + && FIXNATP (XCDR (rest)) && XFIXNAT (XCDR (rest)) < 1 << 16) { - intmax_t mid = XFASTINT (XCAR (rest)); - val = top << 24 << 16 | mid << 16 | XFASTINT (XCDR (rest)); + intmax_t mid = XFIXNAT (XCAR (rest)); + val = top << 24 << 16 | mid << 16 | XFIXNAT (XCDR (rest)); valid = true; } else if (top >= INTMAX_MIN >> 16 && top <= INTMAX_MAX >> 16) { if (CONSP (rest)) rest = XCAR (rest); - if (FIXNATP (rest) && XFASTINT (rest) < 1 << 16) + if (FIXNATP (rest) && XFIXNAT (rest) < 1 << 16) { - val = top << 16 | XFASTINT (rest); + val = top << 16 | XFIXNAT (rest); valid = true; } } @@ -2805,7 +2805,7 @@ NUMBER may be an integer or a floating point number. */) if (FLOATP (number)) len = float_to_string (buffer, XFLOAT_DATA (number)); else - len = sprintf (buffer, "%"pI"d", XINT (number)); + len = sprintf (buffer, "%"pI"d", XFIXNUM (number)); return make_unibyte_string (buffer, len); } @@ -2829,9 +2829,9 @@ If the base used is not 10, STRING is always parsed as an integer. */) else { CHECK_FIXNUM (base); - if (! (XINT (base) >= 2 && XINT (base) <= 16)) + if (! (XFIXNUM (base) >= 2 && XFIXNUM (base) <= 16)) xsignal1 (Qargs_out_of_range, base); - b = XINT (base); + b = XFIXNUM (base); } char *p = SSDATA (string); @@ -2911,14 +2911,14 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) { mpz_t tem; mpz_init (tem); - mpz_set_intmax (tem, XINT (val)); + mpz_set_intmax (tem, XFIXNUM (val)); mpz_add (accum, accum, tem); mpz_clear (tem); } - else if (XINT (val) < 0) - mpz_sub_ui (accum, accum, - XINT (val)); + else if (XFIXNUM (val) < 0) + mpz_sub_ui (accum, accum, - XFIXNUM (val)); else - mpz_add_ui (accum, accum, XINT (val)); + mpz_add_ui (accum, accum, XFIXNUM (val)); break; case Asub: if (! argnum) @@ -2926,7 +2926,7 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) if (BIGNUMP (val)) mpz_set (accum, XBIGNUM (val)->value); else - mpz_set_intmax (accum, XINT (val)); + mpz_set_intmax (accum, XFIXNUM (val)); if (nargs == 1) mpz_neg (accum, accum); } @@ -2936,14 +2936,14 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) { mpz_t tem; mpz_init (tem); - mpz_set_intmax (tem, XINT (val)); + mpz_set_intmax (tem, XFIXNUM (val)); mpz_sub (accum, accum, tem); mpz_clear (tem); } - else if (XINT (val) < 0) - mpz_add_ui (accum, accum, - XINT (val)); + else if (XFIXNUM (val) < 0) + mpz_add_ui (accum, accum, - XFIXNUM (val)); else - mpz_sub_ui (accum, accum, XINT (val)); + mpz_sub_ui (accum, accum, XFIXNUM (val)); break; case Amult: if (BIGNUMP (val)) @@ -2952,12 +2952,12 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) { mpz_t tem; mpz_init (tem); - mpz_set_intmax (tem, XINT (val)); + mpz_set_intmax (tem, XFIXNUM (val)); mpz_mul (accum, accum, tem); mpz_clear (tem); } else - mpz_mul_si (accum, accum, XINT (val)); + mpz_mul_si (accum, accum, XFIXNUM (val)); break; case Adiv: if (! (argnum || nargs == 1)) @@ -2965,13 +2965,13 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) if (BIGNUMP (val)) mpz_set (accum, XBIGNUM (val)->value); else - mpz_set_intmax (accum, XINT (val)); + mpz_set_intmax (accum, XFIXNUM (val)); } else { /* Note that a bignum can never be 0, so we don't need to check that case. */ - if (FIXNUMP (val) && XINT (val) == 0) + if (FIXNUMP (val) && XFIXNUM (val) == 0) xsignal0 (Qarith_error); if (BIGNUMP (val)) mpz_tdiv_q (accum, accum, XBIGNUM (val)->value); @@ -2979,13 +2979,13 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) { mpz_t tem; mpz_init (tem); - mpz_set_intmax (tem, XINT (val)); + mpz_set_intmax (tem, XFIXNUM (val)); mpz_tdiv_q (accum, accum, tem); mpz_clear (tem); } else { - EMACS_INT value = XINT (val); + EMACS_INT value = XFIXNUM (val); bool negate = value < 0; if (negate) value = -value; @@ -3002,7 +3002,7 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) { mpz_t tem; mpz_init (tem); - mpz_set_uintmax (tem, XUINT (val)); + mpz_set_uintmax (tem, XUFIXNUM (val)); mpz_and (accum, accum, tem); mpz_clear (tem); } @@ -3014,7 +3014,7 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) { mpz_t tem; mpz_init (tem); - mpz_set_uintmax (tem, XUINT (val)); + mpz_set_uintmax (tem, XUFIXNUM (val)); mpz_ior (accum, accum, tem); mpz_clear (tem); } @@ -3026,7 +3026,7 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) { mpz_t tem; mpz_init (tem); - mpz_set_uintmax (tem, XUINT (val)); + mpz_set_uintmax (tem, XUFIXNUM (val)); mpz_xor (accum, accum, tem); mpz_clear (tem); } @@ -3059,7 +3059,7 @@ float_arith_driver (double accum, ptrdiff_t argnum, enum arithop code, else { args[argnum] = val; /* runs into a compiler bug. */ - next = XINT (args[argnum]); + next = XFIXNUM (args[argnum]); } switch (code) { @@ -3146,11 +3146,11 @@ Both must be integers or markers. */) /* Note that a bignum can never be 0, so we don't need to check that case. */ - if (FIXNUMP (y) && XINT (y) == 0) + if (FIXNUMP (y) && XFIXNUM (y) == 0) xsignal0 (Qarith_error); if (FIXNUMP (x) && FIXNUMP (y)) - XSETINT (val, XINT (x) % XINT (y)); + XSETINT (val, XFIXNUM (x) % XFIXNUM (y)); else { mpz_t xm, ym, *xmp, *ymp; @@ -3161,7 +3161,7 @@ Both must be integers or markers. */) else { mpz_init (xm); - mpz_set_intmax (xm, XINT (x)); + mpz_set_intmax (xm, XFIXNUM (x)); xmp = &xm; } @@ -3170,7 +3170,7 @@ Both must be integers or markers. */) else { mpz_init (ym); - mpz_set_intmax (ym, XINT (y)); + mpz_set_intmax (ym, XFIXNUM (y)); ymp = &ym; } @@ -3201,7 +3201,7 @@ Both X and Y must be numbers or markers. */) /* Note that a bignum can never be 0, so we don't need to check that case. */ - if (FIXNUMP (y) && XINT (y) == 0) + if (FIXNUMP (y) && XFIXNUM (y) == 0) xsignal0 (Qarith_error); if (FLOATP (x) || FLOATP (y)) @@ -3209,8 +3209,8 @@ Both X and Y must be numbers or markers. */) if (FIXNUMP (x) && FIXNUMP (y)) { - i1 = XINT (x); - i2 = XINT (y); + i1 = XFIXNUM (x); + i2 = XFIXNUM (y); if (i2 == 0) xsignal0 (Qarith_error); @@ -3234,7 +3234,7 @@ Both X and Y must be numbers or markers. */) else { mpz_init (xm); - mpz_set_intmax (xm, XINT (x)); + mpz_set_intmax (xm, XFIXNUM (x)); xmp = &xm; } @@ -3243,7 +3243,7 @@ Both X and Y must be numbers or markers. */) else { mpz_init (ym); - mpz_set_intmax (ym, XINT (y)); + mpz_set_intmax (ym, XFIXNUM (y)); ymp = &ym; } @@ -3354,7 +3354,7 @@ representation. */) } eassume (FIXNUMP (value)); - EMACS_INT v = XINT (value) < 0 ? -1 - XINT (value) : XINT (value); + EMACS_INT v = XFIXNUM (value) < 0 ? -1 - XFIXNUM (value) : XFIXNUM (value); return make_fixnum (EMACS_UINT_WIDTH <= UINT_WIDTH ? count_one_bits (v) : EMACS_UINT_WIDTH <= ULONG_WIDTH @@ -3377,12 +3377,12 @@ ash_lsh_impl (Lisp_Object value, Lisp_Object count, bool lsh) { mpz_t result; mpz_init (result); - if (XINT (count) >= 0) - mpz_mul_2exp (result, XBIGNUM (value)->value, XINT (count)); + if (XFIXNUM (count) >= 0) + mpz_mul_2exp (result, XBIGNUM (value)->value, XFIXNUM (count)); else if (lsh) - mpz_tdiv_q_2exp (result, XBIGNUM (value)->value, - XINT (count)); + mpz_tdiv_q_2exp (result, XBIGNUM (value)->value, - XFIXNUM (count)); else - mpz_fdiv_q_2exp (result, XBIGNUM (value)->value, - XINT (count)); + mpz_fdiv_q_2exp (result, XBIGNUM (value)->value, - XFIXNUM (count)); val = make_number (result); mpz_clear (result); } @@ -3393,19 +3393,19 @@ ash_lsh_impl (Lisp_Object value, Lisp_Object count, bool lsh) eassume (FIXNUMP (value)); mpz_init (result); - mpz_set_intmax (result, XINT (value)); + mpz_set_intmax (result, XFIXNUM (value)); - if (XINT (count) >= 0) - mpz_mul_2exp (result, result, XINT (count)); + if (XFIXNUM (count) >= 0) + mpz_mul_2exp (result, result, XFIXNUM (count)); else if (lsh) { if (mpz_sgn (result) > 0) - mpz_fdiv_q_2exp (result, result, - XINT (count)); + mpz_fdiv_q_2exp (result, result, - XFIXNUM (count)); else - mpz_fdiv_q_2exp (result, result, - XINT (count)); + mpz_fdiv_q_2exp (result, result, - XFIXNUM (count)); } else /* ash */ - mpz_fdiv_q_2exp (result, result, - XINT (count)); + mpz_fdiv_q_2exp (result, result, - XFIXNUM (count)); val = make_number (result); mpz_clear (result); @@ -3453,13 +3453,13 @@ Markers are converted to integers. */) else { eassume (FIXNUMP (number)); - if (XINT (number) < MOST_POSITIVE_FIXNUM) - XSETINT (number, XINT (number) + 1); + if (XFIXNUM (number) < MOST_POSITIVE_FIXNUM) + XSETINT (number, XFIXNUM (number) + 1); else { mpz_t num; mpz_init (num); - mpz_set_intmax (num, XINT (number) + 1); + mpz_set_intmax (num, XFIXNUM (number) + 1); number = make_number (num); mpz_clear (num); } @@ -3488,13 +3488,13 @@ Markers are converted to integers. */) else { eassume (FIXNUMP (number)); - if (XINT (number) > MOST_NEGATIVE_FIXNUM) - XSETINT (number, XINT (number) - 1); + if (XFIXNUM (number) > MOST_NEGATIVE_FIXNUM) + XSETINT (number, XFIXNUM (number) - 1); else { mpz_t num; mpz_init (num); - mpz_set_intmax (num, XINT (number) - 1); + mpz_set_intmax (num, XFIXNUM (number) - 1); number = make_number (num); mpz_clear (num); } @@ -3518,7 +3518,7 @@ DEFUN ("lognot", Flognot, Slognot, 1, 1, 0, else { eassume (FIXNUMP (number)); - XSETINT (number, ~XINT (number)); + XSETINT (number, ~XFIXNUM (number)); } return number; } @@ -3908,13 +3908,13 @@ A is a bool vector, B is t or nil, and I is an index into A. */) CHECK_FIXNAT (i); nr_bits = bool_vector_size (a); - if (XFASTINT (i) > nr_bits) /* Allow one past the end for convenience */ + if (XFIXNAT (i) > nr_bits) /* Allow one past the end for convenience */ args_out_of_range (a, i); adata = bool_vector_data (a); nr_words = bool_vector_words (nr_bits); - pos = XFASTINT (i) / BITS_PER_BITS_WORD; - offset = XFASTINT (i) % BITS_PER_BITS_WORD; + pos = XFIXNAT (i) / BITS_PER_BITS_WORD; + offset = XFIXNAT (i) % BITS_PER_BITS_WORD; count = 0; /* By XORing with twiddle, we transform the problem of "count diff --git a/src/dbusbind.c b/src/dbusbind.c index ac3e062600..4cf5604d74 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -522,8 +522,8 @@ xd_extract_signed (Lisp_Object x, intmax_t lo, intmax_t hi) CHECK_FIXNUM_OR_FLOAT (x); if (FIXNUMP (x)) { - if (lo <= XINT (x) && XINT (x) <= hi) - return XINT (x); + if (lo <= XFIXNUM (x) && XFIXNUM (x) <= hi) + return XFIXNUM (x); } else { @@ -550,8 +550,8 @@ xd_extract_unsigned (Lisp_Object x, uintmax_t hi) CHECK_FIXNUM_OR_FLOAT (x); if (FIXNUMP (x)) { - if (0 <= XINT (x) && XINT (x) <= hi) - return XINT (x); + if (0 <= XFIXNUM (x) && XFIXNUM (x) <= hi) + return XFIXNUM (x); } else { @@ -586,7 +586,7 @@ xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter) case DBUS_TYPE_BYTE: CHECK_FIXNAT (object); { - unsigned char val = XFASTINT (object) & 0xFF; + unsigned char val = XFIXNAT (object) & 0xFF; XD_DEBUG_MESSAGE ("%c %u", dtype, val); if (!dbus_message_iter_append_basic (iter, dtype, &val)) XD_SIGNAL2 (build_string ("Unable to append argument"), object); @@ -1276,10 +1276,10 @@ usage: (dbus-message-internal &rest REST) */) handler = Qnil; CHECK_FIXNAT (message_type); - if (! (DBUS_MESSAGE_TYPE_INVALID < XFASTINT (message_type) - && XFASTINT (message_type) < DBUS_NUM_MESSAGE_TYPES)) + if (! (DBUS_MESSAGE_TYPE_INVALID < XFIXNAT (message_type) + && XFIXNAT (message_type) < DBUS_NUM_MESSAGE_TYPES)) XD_SIGNAL2 (build_string ("Invalid message type"), message_type); - mtype = XFASTINT (message_type); + mtype = XFIXNAT (message_type); if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL) || (mtype == DBUS_MESSAGE_TYPE_SIGNAL)) @@ -1410,7 +1410,7 @@ usage: (dbus-message-internal &rest REST) */) if ((count + 2 <= nargs) && EQ (args[count], QCtimeout)) { CHECK_FIXNAT (args[count+1]); - timeout = min (XFASTINT (args[count+1]), INT_MAX); + timeout = min (XFIXNAT (args[count+1]), INT_MAX); count = count+2; } diff --git a/src/decompress.c b/src/decompress.c index 6f75f821c4..9f7fbe4195 100644 --- a/src/decompress.c +++ b/src/decompress.c @@ -149,8 +149,8 @@ This function can be called only in unibyte buffers. */) /* This is a unibyte buffer, so character positions and bytes are the same. */ - istart = XINT (start); - iend = XINT (end); + istart = XFIXNUM (start); + iend = XFIXNUM (end); /* Do the following before manipulating the gap. */ modify_text (istart, iend); diff --git a/src/dired.c b/src/dired.c index a0b10d070e..3bb5997bd6 100644 --- a/src/dired.c +++ b/src/dired.c @@ -704,7 +704,7 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, = Fcompare_strings (bestmatch, zero, make_fixnum (compare), name, zero, make_fixnum (compare), completion_ignore_case ? Qt : Qnil); - ptrdiff_t matchsize = EQ (cmp, Qt) ? compare : eabs (XINT (cmp)) - 1; + ptrdiff_t matchsize = EQ (cmp, Qt) ? compare : eabs (XFIXNUM (cmp)) - 1; if (completion_ignore_case) { diff --git a/src/dispextern.h b/src/dispextern.h index 0e70b3f724..944a37d488 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -306,24 +306,24 @@ INLINE int GLYPH_CODE_CHAR (Lisp_Object gc) { return (CONSP (gc) - ? XINT (XCAR (gc)) - : XINT (gc) & MAX_CHAR); + ? XFIXNUM (XCAR (gc)) + : XFIXNUM (gc) & MAX_CHAR); } INLINE int GLYPH_CODE_FACE (Lisp_Object gc) { - return CONSP (gc) ? XINT (XCDR (gc)) : XINT (gc) >> CHARACTERBITS; + return CONSP (gc) ? XFIXNUM (XCDR (gc)) : XFIXNUM (gc) >> CHARACTERBITS; } #define SET_GLYPH_FROM_GLYPH_CODE(glyph, gc) \ do \ { \ if (CONSP (gc)) \ - SET_GLYPH (glyph, XINT (XCAR (gc)), XINT (XCDR (gc))); \ + SET_GLYPH (glyph, XFIXNUM (XCAR (gc)), XFIXNUM (XCDR (gc))); \ else \ - SET_GLYPH (glyph, (XINT (gc) & ((1 << CHARACTERBITS)-1)), \ - (XINT (gc) >> CHARACTERBITS)); \ + SET_GLYPH (glyph, (XFIXNUM (gc) & ((1 << CHARACTERBITS)-1)), \ + (XFIXNUM (gc) >> CHARACTERBITS)); \ } \ while (false) diff --git a/src/dispnew.c b/src/dispnew.c index 0daa23e700..b54ae88364 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -5718,7 +5718,7 @@ additional wait period, in milliseconds; this is for backwards compatibility. if (!NILP (milliseconds)) { CHECK_FIXNUM (milliseconds); - duration += XINT (milliseconds) / 1000.0; + duration += XFIXNUM (milliseconds) / 1000.0; } if (duration > 0) @@ -5768,7 +5768,7 @@ sit_for (Lisp_Object timeout, bool reading, int display_option) if (FIXNUMP (timeout)) { - sec = XINT (timeout); + sec = XFIXNUM (timeout); if (sec <= 0) return Qt; nsec = 0; diff --git a/src/disptab.h b/src/disptab.h index 3911efcf4f..c8de011f7d 100644 --- a/src/disptab.h +++ b/src/disptab.h @@ -79,7 +79,7 @@ extern struct Lisp_Char_Table *buffer_display_table (void); #define GLYPH_FOLLOW_ALIASES(base, length, g) \ do { \ while (GLYPH_ALIAS_P ((base), (length), (g))) \ - SET_GLYPH_CHAR ((g), XINT ((base)[GLYPH_CHAR (g)])); \ + SET_GLYPH_CHAR ((g), XFIXNUM ((base)[GLYPH_CHAR (g)])); \ if (!GLYPH_CHAR_VALID_P (g)) \ SET_GLYPH_CHAR (g, ' '); \ } while (false) diff --git a/src/doc.c b/src/doc.c index a71c81b4e9..343734637f 100644 --- a/src/doc.c +++ b/src/doc.c @@ -102,7 +102,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition) else return Qnil; - position = eabs (XINT (pos)); + position = eabs (XFIXNUM (pos)); if (!STRINGP (Vdoc_directory)) return Qnil; diff --git a/src/dosfns.c b/src/dosfns.c index e68c1a7135..25932ff1e1 100644 --- a/src/dosfns.c +++ b/src/dosfns.c @@ -67,21 +67,21 @@ REGISTERS should be a vector produced by `make-register' and union REGS inregs, outregs; CHECK_FIXNUM (interrupt); - no = (unsigned long) XINT (interrupt); + no = (unsigned long) XFIXNUM (interrupt); CHECK_VECTOR (registers); if (no < 0 || no > 0xff || ASIZE (registers) != 8) return Qnil; for (i = 0; i < 8; i++) CHECK_FIXNUM (AREF (registers, i)); - inregs.x.ax = (unsigned long) XFASTINT (AREF (registers, 0)); - inregs.x.bx = (unsigned long) XFASTINT (AREF (registers, 1)); - inregs.x.cx = (unsigned long) XFASTINT (AREF (registers, 2)); - inregs.x.dx = (unsigned long) XFASTINT (AREF (registers, 3)); - inregs.x.si = (unsigned long) XFASTINT (AREF (registers, 4)); - inregs.x.di = (unsigned long) XFASTINT (AREF (registers, 5)); - inregs.x.cflag = (unsigned long) XFASTINT (AREF (registers, 6)); - inregs.x.flags = (unsigned long) XFASTINT (AREF (registers, 7)); + inregs.x.ax = (unsigned long) XFIXNAT (AREF (registers, 0)); + inregs.x.bx = (unsigned long) XFIXNAT (AREF (registers, 1)); + inregs.x.cx = (unsigned long) XFIXNAT (AREF (registers, 2)); + inregs.x.dx = (unsigned long) XFIXNAT (AREF (registers, 3)); + inregs.x.si = (unsigned long) XFIXNAT (AREF (registers, 4)); + inregs.x.di = (unsigned long) XFIXNAT (AREF (registers, 5)); + inregs.x.cflag = (unsigned long) XFIXNAT (AREF (registers, 6)); + inregs.x.flags = (unsigned long) XFIXNAT (AREF (registers, 7)); int86 (no, &inregs, &outregs); @@ -107,7 +107,7 @@ Return the updated VECTOR. */) char *buf; CHECK_FIXNUM (address); - offs = (unsigned long) XINT (address); + offs = (unsigned long) XFIXNUM (address); CHECK_VECTOR (vector); len = ASIZE (vector); if (len < 1 || len > 2048 || offs < 0 || offs > 0xfffff - len) @@ -130,7 +130,7 @@ DEFUN ("msdos-memput", Fdos_memput, Sdos_memput, 2, 2, 0, char *buf; CHECK_FIXNUM (address); - offs = (unsigned long) XINT (address); + offs = (unsigned long) XFIXNUM (address); CHECK_VECTOR (vector); len = ASIZE (vector); if (len < 1 || len > 2048 || offs < 0 || offs > 0xfffff - len) @@ -140,7 +140,7 @@ DEFUN ("msdos-memput", Fdos_memput, Sdos_memput, 2, 2, 0, for (i = 0; i < len; i++) { CHECK_FIXNUM (AREF (vector, i)); - buf[i] = (unsigned char) XFASTINT (AREF (vector, i)) & 0xFF; + buf[i] = (unsigned char) XFIXNAT (AREF (vector, i)) & 0xFF; } dosmemput (buf, len, offs); @@ -155,7 +155,7 @@ The current keyboard layout is available in dos-keyboard-code. */) (Lisp_Object country_code, Lisp_Object allkeys) { CHECK_FIXNUM (country_code); - if (!dos_set_keyboard (XINT (country_code), !NILP (allkeys))) + if (!dos_set_keyboard (XFIXNUM (country_code), !NILP (allkeys))) return Qnil; return Qt; } @@ -521,7 +521,7 @@ system_process_attributes (Lisp_Object pid) Lisp_Object attrs = Qnil; CHECK_FIXNUM_OR_FLOAT (pid); - proc_id = FLOATP (pid) ? XFLOAT_DATA (pid) : XINT (pid); + proc_id = FLOATP (pid) ? XFLOAT_DATA (pid) : XFIXNUM (pid); if (proc_id == getpid ()) { diff --git a/src/editfns.c b/src/editfns.c index 09c17cbd92..f9157cd844 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -181,7 +181,7 @@ tzlookup (Lisp_Object zone, bool settz) zone = XCAR (zone); } - EMACS_INT abszone = eabs (XINT (zone)), hour = abszone / (60 * 60); + EMACS_INT abszone = eabs (XFIXNUM (zone)), hour = abszone / (60 * 60); int hour_remainder = abszone % (60 * 60); int min = hour_remainder / 60, sec = hour_remainder % 60; @@ -196,8 +196,8 @@ tzlookup (Lisp_Object zone, bool settz) prec += 2, numzone = 100 * numzone + sec; } sprintf (tzbuf, tzbuf_format, prec, - XINT (zone) < 0 ? -numzone : numzone, - &"-"[XINT (zone) < 0], hour, min, sec); + XFIXNUM (zone) < 0 ? -numzone : numzone, + &"-"[XFIXNUM (zone) < 0], hour, min, sec); zone_string = tzbuf; } else @@ -205,7 +205,7 @@ tzlookup (Lisp_Object zone, bool settz) AUTO_STRING (leading, "<"); AUTO_STRING_WITH_LEN (trailing, tzbuf, sprintf (tzbuf, trailing_tzbuf_format, - &"-"[XINT (zone) < 0], + &"-"[XFIXNUM (zone) < 0], hour, min, sec)); zone_string = SSDATA (concat3 (leading, ENCODE_SYSTEM (abbr), trailing)); @@ -217,11 +217,11 @@ tzlookup (Lisp_Object zone, bool settz) new_tz = tzalloc (zone_string); if (HAVE_TZALLOC_BUG && !new_tz && errno != ENOMEM && plain_integer - && XINT (zone) % (60 * 60) == 0) + && XFIXNUM (zone) % (60 * 60) == 0) { /* tzalloc mishandles POSIX strings; fall back on tzdb if possible (Bug#30738). */ - sprintf (tzbuf, "Etc/GMT%+"pI"d", - (XINT (zone) / (60 * 60))); + sprintf (tzbuf, "Etc/GMT%+"pI"d", - (XFIXNUM (zone) / (60 * 60))); new_tz = tzalloc (zone_string); } @@ -359,7 +359,7 @@ usage: (char-to-string CHAR) */) unsigned char str[MAX_MULTIBYTE_LENGTH]; CHECK_CHARACTER (character); - c = XFASTINT (character); + c = XFIXNAT (character); len = CHAR_STRING (c, str); return make_string_from_bytes ((char *) str, 1, len); @@ -371,9 +371,9 @@ DEFUN ("byte-to-string", Fbyte_to_string, Sbyte_to_string, 1, 1, 0, { unsigned char b; CHECK_FIXNUM (byte); - if (XINT (byte) < 0 || XINT (byte) > 255) + if (XFIXNUM (byte) < 0 || XFIXNUM (byte) > 255) error ("Invalid byte"); - b = XINT (byte); + b = XFIXNUM (byte); return make_string_from_bytes ((char *) &b, 1, 1); } @@ -422,7 +422,7 @@ The return value is POSITION. */) if (MARKERP (position)) set_point_from_marker (position); else if (FIXNUMP (position)) - SET_PT (clip_to_bounds (BEGV, XINT (position), ZV)); + SET_PT (clip_to_bounds (BEGV, XFIXNUM (position), ZV)); else wrong_type_argument (Qinteger_or_marker_p, position); return position; @@ -448,9 +448,9 @@ region_limit (bool beginningp) error ("The mark is not set now, so there is no region"); /* Clip to the current narrowing (bug#11770). */ - return make_fixnum ((PT < XFASTINT (m)) == beginningp + return make_fixnum ((PT < XFIXNAT (m)) == beginningp ? PT - : clip_to_bounds (BEGV, XFASTINT (m), ZV)); + : clip_to_bounds (BEGV, XFIXNAT (m), ZV)); } DEFUN ("region-beginning", Fregion_beginning, Sregion_beginning, 0, 0, 0, @@ -553,7 +553,7 @@ at POSITION. */) return Fget_text_property (position, prop, object); else { - EMACS_INT posn = XINT (position); + EMACS_INT posn = XFIXNUM (position); ptrdiff_t noverlays; Lisp_Object *overlay_vec, tem; struct buffer *obuf = current_buffer; @@ -606,8 +606,8 @@ at POSITION. */) if (stickiness > 0) return Fget_text_property (position, prop, object); else if (stickiness < 0 - && XINT (position) > BUF_BEGV (XBUFFER (object))) - return Fget_text_property (make_fixnum (XINT (position) - 1), + && XFIXNUM (position) > BUF_BEGV (XBUFFER (object))) + return Fget_text_property (make_fixnum (XFIXNUM (position) - 1), prop, object); else return Qnil; @@ -655,8 +655,8 @@ find_field (Lisp_Object pos, Lisp_Object merge_at_boundary, after_field = get_char_property_and_overlay (pos, Qfield, Qnil, NULL); before_field - = (XFASTINT (pos) > BEGV - ? get_char_property_and_overlay (make_fixnum (XINT (pos) - 1), + = (XFIXNAT (pos) > BEGV + ? get_char_property_and_overlay (make_fixnum (XFIXNUM (pos) - 1), Qfield, Qnil, NULL) /* Using nil here would be a more obvious choice, but it would fail when the buffer starts with a non-sticky field. */ @@ -710,7 +710,7 @@ find_field (Lisp_Object pos, Lisp_Object merge_at_boundary, if (at_field_start) /* POS is at the edge of a field, and we should consider it as the beginning of the following field. */ - *beg = XFASTINT (pos); + *beg = XFIXNAT (pos); else /* Find the previous field boundary. */ { @@ -722,7 +722,7 @@ find_field (Lisp_Object pos, Lisp_Object merge_at_boundary, p = Fprevious_single_char_property_change (p, Qfield, Qnil, beg_limit); - *beg = NILP (p) ? BEGV : XFASTINT (p); + *beg = NILP (p) ? BEGV : XFIXNAT (p); } } @@ -731,7 +731,7 @@ find_field (Lisp_Object pos, Lisp_Object merge_at_boundary, if (at_field_end) /* POS is at the edge of a field, and we should consider it as the end of the previous field. */ - *end = XFASTINT (pos); + *end = XFIXNAT (pos); else /* Find the next field boundary. */ { @@ -742,7 +742,7 @@ find_field (Lisp_Object pos, Lisp_Object merge_at_boundary, pos = Fnext_single_char_property_change (pos, Qfield, Qnil, end_limit); - *end = NILP (pos) ? ZV : XFASTINT (pos); + *end = NILP (pos) ? ZV : XFIXNAT (pos); } } } @@ -859,10 +859,10 @@ Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil. */) CHECK_FIXNUM_COERCE_MARKER (new_pos); CHECK_FIXNUM_COERCE_MARKER (old_pos); - fwd = (XINT (new_pos) > XINT (old_pos)); + fwd = (XFIXNUM (new_pos) > XFIXNUM (old_pos)); - prev_old = make_fixnum (XINT (old_pos) - 1); - prev_new = make_fixnum (XINT (new_pos) - 1); + prev_old = make_fixnum (XFIXNUM (old_pos) - 1); + prev_new = make_fixnum (XFIXNUM (new_pos) - 1); if (NILP (Vinhibit_field_text_motion) && !EQ (new_pos, old_pos) @@ -872,16 +872,16 @@ Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil. */) previous positions; we could use `Fget_pos_property' instead, but in itself that would fail inside non-sticky fields (like comint prompts). */ - || (XFASTINT (new_pos) > BEGV + || (XFIXNAT (new_pos) > BEGV && !NILP (Fget_char_property (prev_new, Qfield, Qnil))) - || (XFASTINT (old_pos) > BEGV + || (XFIXNAT (old_pos) > BEGV && !NILP (Fget_char_property (prev_old, Qfield, Qnil)))) && (NILP (inhibit_capture_property) /* Field boundaries are again a problem; but now we must decide the case exactly, so we need to call `get_pos_property' as well. */ || (NILP (Fget_pos_property (old_pos, inhibit_capture_property, Qnil)) - && (XFASTINT (old_pos) <= BEGV + && (XFIXNAT (old_pos) <= BEGV || NILP (Fget_char_property (old_pos, inhibit_capture_property, Qnil)) || NILP (Fget_char_property @@ -901,7 +901,7 @@ Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil. */) other side of NEW_POS, which would mean that NEW_POS is already acceptable, and it's not necessary to constrain it to FIELD_BOUND. */ - ((XFASTINT (field_bound) < XFASTINT (new_pos)) ? fwd : !fwd) + ((XFIXNAT (field_bound) < XFIXNAT (new_pos)) ? fwd : !fwd) /* NEW_POS should be constrained, but only if either ONLY_IN_LINE is nil (in which case any constraint is OK), or NEW_POS and FIELD_BOUND are on the same line (in which @@ -910,16 +910,16 @@ Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil. */) /* This is the ONLY_IN_LINE case, check that NEW_POS and FIELD_BOUND are on the same line by seeing whether there's an intervening newline or not. */ - || (find_newline (XFASTINT (new_pos), -1, - XFASTINT (field_bound), -1, + || (find_newline (XFIXNAT (new_pos), -1, + XFIXNAT (field_bound), -1, fwd ? -1 : 1, &shortage, NULL, 1), shortage != 0))) /* Constrain NEW_POS to FIELD_BOUND. */ new_pos = field_bound; - if (orig_point && XFASTINT (new_pos) != orig_point) + if (orig_point && XFIXNAT (new_pos) != orig_point) /* The NEW_POS argument was originally nil, so automatically set PT. */ - SET_PT (XFASTINT (new_pos)); + SET_PT (XFIXNAT (new_pos)); } return new_pos; @@ -952,11 +952,11 @@ This function does not move point. */) else CHECK_FIXNUM (n); - scan_newline_from_point (XINT (n) - 1, &charpos, &bytepos); + scan_newline_from_point (XFIXNUM (n) - 1, &charpos, &bytepos); /* Return END constrained to the current input field. */ return Fconstrain_to_field (make_fixnum (charpos), make_fixnum (PT), - XINT (n) != 1 ? Qt : Qnil, + XFIXNUM (n) != 1 ? Qt : Qnil, Qt, Qnil); } @@ -987,7 +987,7 @@ This function does not move point. */) else CHECK_FIXNUM (n); - clipped_n = clip_to_bounds (PTRDIFF_MIN + 1, XINT (n), PTRDIFF_MAX); + clipped_n = clip_to_bounds (PTRDIFF_MIN + 1, XFIXNUM (n), PTRDIFF_MAX); end_pos = find_before_next_newline (orig, 0, clipped_n - (clipped_n <= 0), NULL); @@ -1161,9 +1161,9 @@ If POSITION is out of range, the value is nil. */) (Lisp_Object position) { CHECK_FIXNUM_COERCE_MARKER (position); - if (XINT (position) < BEG || XINT (position) > Z) + if (XFIXNUM (position) < BEG || XFIXNUM (position) > Z) return Qnil; - return make_fixnum (CHAR_TO_BYTE (XINT (position))); + return make_fixnum (CHAR_TO_BYTE (XFIXNUM (position))); } DEFUN ("byte-to-position", Fbyte_to_position, Sbyte_to_position, 1, 1, 0, @@ -1174,7 +1174,7 @@ If BYTEPOS is out of range, the value is nil. */) ptrdiff_t pos_byte; CHECK_FIXNUM (bytepos); - pos_byte = XINT (bytepos); + pos_byte = XFIXNUM (bytepos); if (pos_byte < BEG_BYTE || pos_byte > Z_BYTE) return Qnil; if (Z != Z_BYTE) @@ -1281,10 +1281,10 @@ If POS is out of range, the value is nil. */) else { CHECK_FIXNUM_COERCE_MARKER (pos); - if (XINT (pos) < BEGV || XINT (pos) >= ZV) + if (XFIXNUM (pos) < BEGV || XFIXNUM (pos) >= ZV) return Qnil; - pos_byte = CHAR_TO_BYTE (XINT (pos)); + pos_byte = CHAR_TO_BYTE (XFIXNUM (pos)); } return make_fixnum (FETCH_CHAR (pos_byte)); @@ -1316,10 +1316,10 @@ If POS is out of range, the value is nil. */) { CHECK_FIXNUM_COERCE_MARKER (pos); - if (XINT (pos) <= BEGV || XINT (pos) > ZV) + if (XFIXNUM (pos) <= BEGV || XFIXNUM (pos) > ZV) return Qnil; - pos_byte = CHAR_TO_BYTE (XINT (pos)); + pos_byte = CHAR_TO_BYTE (XFIXNUM (pos)); } if (!NILP (BVAR (current_buffer, enable_multibyte_characters))) @@ -1847,10 +1847,10 @@ decode_time_components (Lisp_Object high, Lisp_Object low, Lisp_Object usec, return 0; } - hi = XINT (high); - lo = XINT (low); - us = XINT (usec); - ps = XINT (psec); + hi = XFIXNUM (high); + lo = XFIXNUM (low); + us = XFIXNUM (usec); + ps = XFIXNUM (psec); /* Normalize out-of-range lower-order components by carrying each overflow into the next higher-order component. */ @@ -2207,7 +2207,7 @@ static int check_tm_member (Lisp_Object obj, int offset) { CHECK_FIXNUM (obj); - EMACS_INT n = XINT (obj); + EMACS_INT n = XFIXNUM (obj); int result; if (INT_SUBTRACT_WRAPV (n, offset, &result)) time_overflow (); @@ -2532,7 +2532,7 @@ general_insert_function (void (*insert_func) val = args[argnum]; if (CHARACTERP (val)) { - int c = XFASTINT (val); + int c = XFIXNAT (val); unsigned char str[MAX_MULTIBYTE_LENGTH]; int len; @@ -2689,17 +2689,17 @@ called interactively, INHERIT is t. */) if (NILP (count)) XSETFASTINT (count, 1); CHECK_FIXNUM (count); - c = XFASTINT (character); + c = XFIXNAT (character); if (!NILP (BVAR (current_buffer, enable_multibyte_characters))) len = CHAR_STRING (c, str); else str[0] = c, len = 1; - if (XINT (count) <= 0) + if (XFIXNUM (count) <= 0) return Qnil; - if (BUF_BYTES_MAX / len < XINT (count)) + if (BUF_BYTES_MAX / len < XFIXNUM (count)) buffer_overflow (); - n = XINT (count) * len; + n = XFIXNUM (count) * len; stringlen = min (n, sizeof string - sizeof string % len); for (i = 0; i < stringlen; i++) string[i] = str[i % len]; @@ -2733,11 +2733,11 @@ from adjoining text, if those properties are sticky. */) (Lisp_Object byte, Lisp_Object count, Lisp_Object inherit) { CHECK_FIXNUM (byte); - if (XINT (byte) < 0 || XINT (byte) > 255) + if (XFIXNUM (byte) < 0 || XFIXNUM (byte) > 255) args_out_of_range_3 (byte, make_fixnum (0), make_fixnum (255)); - if (XINT (byte) >= 128 + if (XFIXNUM (byte) >= 128 && ! NILP (BVAR (current_buffer, enable_multibyte_characters))) - XSETFASTINT (byte, BYTE8_TO_CHAR (XINT (byte))); + XSETFASTINT (byte, BYTE8_TO_CHAR (XFIXNUM (byte))); return Finsert_char (byte, count, inherit); } @@ -2823,7 +2823,7 @@ make_buffer_string_both (ptrdiff_t start, ptrdiff_t start_byte, tem = Fnext_property_change (make_fixnum (start), Qnil, make_fixnum (end)); tem1 = Ftext_properties_at (make_fixnum (start), Qnil); - if (XINT (tem) != end || !NILP (tem1)) + if (XFIXNUM (tem) != end || !NILP (tem1)) copy_intervals_to_string (result, current_buffer, start, end - start); } @@ -2872,8 +2872,8 @@ use `buffer-substring-no-properties' instead. */) register ptrdiff_t b, e; validate_region (&start, &end); - b = XINT (start); - e = XINT (end); + b = XFIXNUM (start); + e = XFIXNUM (end); return make_buffer_string (b, e, 1); } @@ -2888,8 +2888,8 @@ they can be in either order. */) register ptrdiff_t b, e; validate_region (&start, &end); - b = XINT (start); - e = XINT (end); + b = XFIXNUM (start); + e = XFIXNUM (end); return make_buffer_string (b, e, 0); } @@ -2935,14 +2935,14 @@ using `string-make-multibyte' or `string-make-unibyte', which see. */) else { CHECK_FIXNUM_COERCE_MARKER (start); - b = XINT (start); + b = XFIXNUM (start); } if (NILP (end)) e = BUF_ZV (bp); else { CHECK_FIXNUM_COERCE_MARKER (end); - e = XINT (end); + e = XFIXNUM (end); } if (b > e) @@ -3003,14 +3003,14 @@ determines whether case is significant or ignored. */) else { CHECK_FIXNUM_COERCE_MARKER (start1); - begp1 = XINT (start1); + begp1 = XFIXNUM (start1); } if (NILP (end1)) endp1 = BUF_ZV (bp1); else { CHECK_FIXNUM_COERCE_MARKER (end1); - endp1 = XINT (end1); + endp1 = XFIXNUM (end1); } if (begp1 > endp1) @@ -3041,14 +3041,14 @@ determines whether case is significant or ignored. */) else { CHECK_FIXNUM_COERCE_MARKER (start2); - begp2 = XINT (start2); + begp2 = XFIXNUM (start2); } if (NILP (end2)) endp2 = BUF_ZV (bp2); else { CHECK_FIXNUM_COERCE_MARKER (end2); - endp2 = XINT (end2); + endp2 = XFIXNUM (end2); } if (begp2 > endp2) @@ -3439,8 +3439,8 @@ Both characters must have the same length of multi-byte form. */) validate_region (&start, &end); CHECK_CHARACTER (fromchar); CHECK_CHARACTER (tochar); - fromc = XFASTINT (fromchar); - toc = XFASTINT (tochar); + fromc = XFIXNAT (fromchar); + toc = XFIXNAT (tochar); if (multibyte_p) { @@ -3466,9 +3466,9 @@ Both characters must have the same length of multi-byte form. */) tostr[0] = toc; } - pos = XINT (start); + pos = XFIXNUM (start); pos_byte = CHAR_TO_BYTE (pos); - stop = CHAR_TO_BYTE (XINT (end)); + stop = CHAR_TO_BYTE (XFIXNUM (end)); end_byte = stop; /* If we don't want undo, turn off putting stuff on the list. @@ -3516,7 +3516,7 @@ Both characters must have the same length of multi-byte form. */) else if (!changed) { changed = -1; - modify_text (pos, XINT (end)); + modify_text (pos, XFIXNUM (end)); if (! NILP (noundo)) { @@ -3639,7 +3639,7 @@ check_translation (ptrdiff_t pos, ptrdiff_t pos_byte, ptrdiff_t end, buf[buf_used++] = STRING_CHAR_AND_LENGTH (p, len1); pos_byte += len1; } - if (XINT (AREF (elt, i)) != buf[i]) + if (XFIXNUM (AREF (elt, i)) != buf[i]) break; } if (i == len) @@ -3691,9 +3691,9 @@ It returns the number of characters changed. */) tt = SDATA (table); } - pos = XINT (start); + pos = XFIXNUM (start); pos_byte = CHAR_TO_BYTE (pos); - end_pos = XINT (end); + end_pos = XFIXNUM (end); modify_text (pos, end_pos); cnt = 0; @@ -3742,7 +3742,7 @@ It returns the number of characters changed. */) val = CHAR_TABLE_REF (table, oc); if (CHARACTERP (val)) { - nc = XFASTINT (val); + nc = XFIXNAT (val); str_len = CHAR_STRING (nc, buf); str = buf; } @@ -3827,7 +3827,7 @@ This command deletes buffer text without modifying the kill ring. */) (Lisp_Object start, Lisp_Object end) { validate_region (&start, &end); - del_range (XINT (start), XINT (end)); + del_range (XFIXNUM (start), XFIXNUM (end)); return Qnil; } @@ -3837,9 +3837,9 @@ DEFUN ("delete-and-extract-region", Fdelete_and_extract_region, (Lisp_Object start, Lisp_Object end) { validate_region (&start, &end); - if (XINT (start) == XINT (end)) + if (XFIXNUM (start) == XFIXNUM (end)) return empty_unibyte_string; - return del_range_1 (XINT (start), XINT (end), 1, 1); + return del_range_1 (XFIXNUM (start), XFIXNUM (end), 1, 1); } DEFUN ("widen", Fwiden, Swiden, 0, 0, "", @@ -3871,24 +3871,24 @@ or markers) bounding the text that should remain visible. */) CHECK_FIXNUM_COERCE_MARKER (start); CHECK_FIXNUM_COERCE_MARKER (end); - if (XINT (start) > XINT (end)) + if (XFIXNUM (start) > XFIXNUM (end)) { Lisp_Object tem; tem = start; start = end; end = tem; } - if (!(BEG <= XINT (start) && XINT (start) <= XINT (end) && XINT (end) <= Z)) + if (!(BEG <= XFIXNUM (start) && XFIXNUM (start) <= XFIXNUM (end) && XFIXNUM (end) <= Z)) args_out_of_range (start, end); - if (BEGV != XFASTINT (start) || ZV != XFASTINT (end)) + if (BEGV != XFIXNAT (start) || ZV != XFIXNAT (end)) current_buffer->clip_changed = 1; - SET_BUF_BEGV (current_buffer, XFASTINT (start)); - SET_BUF_ZV (current_buffer, XFASTINT (end)); - if (PT < XFASTINT (start)) - SET_PT (XFASTINT (start)); - if (PT > XFASTINT (end)) - SET_PT (XFASTINT (end)); + SET_BUF_BEGV (current_buffer, XFIXNAT (start)); + SET_BUF_ZV (current_buffer, XFIXNAT (end)); + if (PT < XFIXNAT (start)) + SET_PT (XFIXNAT (start)); + if (PT > XFIXNAT (end)) + SET_PT (XFIXNAT (end)); /* Changing the buffer bounds invalidates any recorded current column. */ invalidate_current_column (); return Qnil; @@ -4475,7 +4475,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) } else if (conversion == 'c') { - if (FIXNUMP (arg) && ! ASCII_CHAR_P (XINT (arg))) + if (FIXNUMP (arg) && ! ASCII_CHAR_P (XFIXNUM (arg))) { if (!multibyte) { @@ -4717,7 +4717,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) /* Although long double may have a rounding error if DIG_BITS_LBOUND * LDBL_MANT_DIG < FIXNUM_BITS - 1, it is more accurate than plain 'double'. */ - long double x = XINT (arg); + long double x = XFIXNUM (arg); sprintf_bytes = sprintf (sprintf_buf, convspec, prec, x); } else @@ -4727,7 +4727,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) else if (conversion == 'c') { /* Don't use sprintf here, as it might mishandle prec. */ - sprintf_buf[0] = XINT (arg); + sprintf_buf[0] = XFIXNUM (arg); sprintf_bytes = prec != 0; sprintf_buf[sprintf_bytes] = '\0'; } @@ -4735,7 +4735,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) { if (FIXNUMP (arg)) { - printmax_t x = XINT (arg); + printmax_t x = XFIXNUM (arg); sprintf_bytes = sprintf (sprintf_buf, convspec, prec, x); } else @@ -4759,7 +4759,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) /* Don't sign-extend for octal or hex printing. */ uprintmax_t x; if (FIXNUMP (arg)) - x = XUINT (arg); + x = XUFIXNUM (arg); else { double d = XFLOAT_DATA (arg); @@ -5016,7 +5016,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) Lisp_Object item = XCAR (list); /* First adjust the property start position. */ - ptrdiff_t pos = XINT (XCAR (item)); + ptrdiff_t pos = XFIXNUM (XCAR (item)); /* Advance BYTEPOS, POSITION, TRANSLATED and ARGN up to this position. */ @@ -5038,7 +5038,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) XSETCAR (item, make_fixnum (translated)); /* Likewise adjust the property end position. */ - pos = XINT (XCAR (XCDR (item))); + pos = XFIXNUM (XCAR (XCDR (item))); for (; position < pos; bytepos++) { @@ -5099,13 +5099,13 @@ Case is ignored if `case-fold-search' is non-nil in the current buffer. */) CHECK_CHARACTER (c1); CHECK_CHARACTER (c2); - if (XINT (c1) == XINT (c2)) + if (XFIXNUM (c1) == XFIXNUM (c2)) return Qt; if (NILP (BVAR (current_buffer, case_fold_search))) return Qnil; - i1 = XFASTINT (c1); - i2 = XFASTINT (c2); + i1 = XFIXNAT (c1); + i2 = XFIXNAT (c2); /* FIXME: It is possible to compare multibyte characters even when the current buffer is unibyte. Unfortunately this is ambiguous @@ -5249,10 +5249,10 @@ ring. */) validate_region (&startr1, &endr1); validate_region (&startr2, &endr2); - start1 = XFASTINT (startr1); - end1 = XFASTINT (endr1); - start2 = XFASTINT (startr2); - end2 = XFASTINT (endr2); + start1 = XFIXNAT (startr1); + end1 = XFIXNAT (endr1); + start2 = XFIXNAT (startr2); + end2 = XFIXNAT (endr2); gap = GPT; /* Swap the regions if they're reversed. */ diff --git a/src/emacs-module.c b/src/emacs-module.c index 39150f6f67..e7ba17426b 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -302,7 +302,7 @@ module_make_global_ref (emacs_env *env, emacs_value ref) if (i >= 0) { Lisp_Object value = HASH_VALUE (h, i); - EMACS_INT refcount = XFASTINT (value) + 1; + EMACS_INT refcount = XFIXNAT (value) + 1; if (MOST_POSITIVE_FIXNUM < refcount) xsignal0 (Qoverflow_error); value = make_fixed_natnum (refcount); @@ -329,7 +329,7 @@ module_free_global_ref (emacs_env *env, emacs_value ref) if (i >= 0) { - EMACS_INT refcount = XFASTINT (HASH_VALUE (h, i)) - 1; + EMACS_INT refcount = XFIXNAT (HASH_VALUE (h, i)) - 1; if (refcount > 0) set_hash_value_slot (h, i, make_fixed_natnum (refcount)); else @@ -525,7 +525,7 @@ module_extract_integer (emacs_env *env, emacs_value n) xsignal1 (Qoverflow_error, l); return mpz_get_si (XBIGNUM (l)->value); } - return XINT (l); + return XFIXNUM (l); } static emacs_value diff --git a/src/emacs.c b/src/emacs.c index aef4f93d02..dc62ce8066 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -2065,9 +2065,9 @@ all of which are called before Emacs is actually killed. */ } if (FIXNUMP (arg)) - exit_code = (XINT (arg) < 0 - ? XINT (arg) | INT_MIN - : XINT (arg) & INT_MAX); + exit_code = (XFIXNUM (arg) < 0 + ? XFIXNUM (arg) | INT_MIN + : XFIXNUM (arg) & INT_MAX); else exit_code = EXIT_SUCCESS; exit (exit_code); diff --git a/src/eval.c b/src/eval.c index 800d7f2afb..f7d4d5be2a 100644 --- a/src/eval.c +++ b/src/eval.c @@ -264,8 +264,8 @@ init_eval (void) static void restore_stack_limits (Lisp_Object data) { - max_specpdl_size = XINT (XCAR (data)); - max_lisp_eval_depth = XINT (XCDR (data)); + max_specpdl_size = XFIXNUM (XCAR (data)); + max_lisp_eval_depth = XFIXNUM (XCDR (data)); } static void grow_specpdl (void); @@ -938,7 +938,7 @@ usage: (let VARLIST BODY...) */) CHECK_LIST (varlist); /* Make space to hold the values to give the bound variables. */ - EMACS_INT varlist_len = XFASTINT (Flength (varlist)); + EMACS_INT varlist_len = XFIXNAT (Flength (varlist)); SAFE_ALLOCA_LISP (temps, varlist_len); ptrdiff_t nvars = varlist_len; @@ -2246,9 +2246,9 @@ eval_sub (Lisp_Object form) check_cons_list (); - if (XINT (numargs) < XSUBR (fun)->min_args + if (XFIXNUM (numargs) < XSUBR (fun)->min_args || (XSUBR (fun)->max_args >= 0 - && XSUBR (fun)->max_args < XINT (numargs))) + && XSUBR (fun)->max_args < XFIXNUM (numargs))) xsignal2 (Qwrong_number_of_arguments, original_fun, numargs); else if (XSUBR (fun)->max_args == UNEVALLED) @@ -2260,9 +2260,9 @@ eval_sub (Lisp_Object form) ptrdiff_t argnum = 0; USE_SAFE_ALLOCA; - SAFE_ALLOCA_LISP (vals, XINT (numargs)); + SAFE_ALLOCA_LISP (vals, XFIXNUM (numargs)); - while (CONSP (args_left) && argnum < XINT (numargs)) + while (CONSP (args_left) && argnum < XFIXNUM (numargs)) { Lisp_Object arg = XCAR (args_left); args_left = XCDR (args_left); @@ -2292,7 +2292,7 @@ eval_sub (Lisp_Object form) args_left = Fcdr (args_left); } - set_backtrace_args (specpdl + count, argvals, XINT (numargs)); + set_backtrace_args (specpdl + count, argvals, XFIXNUM (numargs)); switch (i) { @@ -2405,7 +2405,7 @@ usage: (apply FUNCTION &rest ARGUMENTS) */) CHECK_LIST (spread_arg); - numargs = XINT (Flength (spread_arg)); + numargs = XFIXNUM (Flength (spread_arg)); if (numargs == 0) return Ffuncall (nargs - 1, args); @@ -2960,7 +2960,7 @@ apply_lambda (Lisp_Object fun, Lisp_Object args, ptrdiff_t count) Lisp_Object tem; USE_SAFE_ALLOCA; - numargs = XFASTINT (Flength (args)); + numargs = XFIXNAT (Flength (args)); SAFE_ALLOCA_LISP (arg_vector, numargs); args_left = args; @@ -3667,7 +3667,7 @@ get_backtrace_frame (Lisp_Object nframes, Lisp_Object base) union specbinding *pdl = get_backtrace_starting_at (base); /* Find the frame requested. */ - for (i = XFASTINT (nframes); i > 0 && backtrace_p (pdl); i--) + for (i = XFIXNAT (nframes); i > 0 && backtrace_p (pdl); i--) pdl = backtrace_next (pdl); return pdl; @@ -3868,7 +3868,7 @@ NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'. { union specbinding *frame = get_backtrace_frame (nframes, base); union specbinding *prevframe - = get_backtrace_frame (make_fixnum (XFASTINT (nframes) - 1), base); + = get_backtrace_frame (make_fixnum (XFIXNAT (nframes) - 1), base); ptrdiff_t distance = specpdl_ptr - frame; Lisp_Object result = Qnil; eassert (distance >= 0); diff --git a/src/fileio.c b/src/fileio.c index b8809853e0..14089dcf49 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -3195,7 +3195,7 @@ symbolic notation, like the `chmod' command from GNU Coreutils. */) encoded_absname = ENCODE_FILE (absname); - if (chmod (SSDATA (encoded_absname), XINT (mode) & 07777) < 0) + if (chmod (SSDATA (encoded_absname), XFIXNUM (mode) & 07777) < 0) report_file_error ("Doing chmod", absname); return Qnil; @@ -3218,7 +3218,7 @@ by having the corresponding bit in the mask reset. */) mode_t oldrealmask, oldumask, newumask; CHECK_FIXNUM (mode); oldrealmask = realmask; - newumask = ~ XINT (mode) & 0777; + newumask = ~ XFIXNUM (mode) & 0777; block_input (); realmask = newumask; @@ -3378,7 +3378,7 @@ verify (alignof (union read_non_regular) % GCALIGNMENT == 0); static Lisp_Object read_non_regular (Lisp_Object state) { - union read_non_regular *data = XINTPTR (state); + union read_non_regular *data = XFIXNUMPTR (state); int nbytes = emacs_read_quit (data->s.fd, ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE + data->s.inserted), @@ -3402,7 +3402,7 @@ static off_t file_offset (Lisp_Object val) { if (RANGED_FIXNUMP (0, val, TYPE_MAXIMUM (off_t))) - return XINT (val); + return XFIXNUM (val); if (FLOATP (val)) { @@ -3462,14 +3462,14 @@ restore_window_points (Lisp_Object window_markers, ptrdiff_t inserted, Lisp_Object marker = XCAR (car); Lisp_Object oldpos = XCDR (car); if (MARKERP (marker) && FIXNUMP (oldpos) - && XINT (oldpos) > same_at_start - && XINT (oldpos) < same_at_end) + && XFIXNUM (oldpos) > same_at_start + && XFIXNUM (oldpos) < same_at_end) { ptrdiff_t oldsize = same_at_end - same_at_start; ptrdiff_t newsize = inserted; double growth = newsize / (double)oldsize; ptrdiff_t newpos - = same_at_start + growth * (XINT (oldpos) - same_at_start); + = same_at_start + growth * (XFIXNUM (oldpos) - same_at_start); Fset_marker (marker, make_fixnum (newpos), Qnil); } } @@ -3584,7 +3584,7 @@ by calling `format-decode', which see. */) visit, beg, end, replace); if (CONSP (val) && CONSP (XCDR (val)) && RANGED_FIXNUMP (0, XCAR (XCDR (val)), ZV - PT)) - inserted = XINT (XCAR (XCDR (val))); + inserted = XFIXNUM (XCAR (XCDR (val))); goto handled; } @@ -4248,7 +4248,7 @@ by calling `format-decode', which see. */) break; } - this = XINT (nbytes); + this = XFIXNUM (nbytes); } else { @@ -4469,7 +4469,7 @@ by calling `format-decode', which see. */) { if (! RANGED_FIXNUMP (0, insval, ZV - PT)) wrong_type_argument (intern ("inserted-chars"), insval); - inserted = XFASTINT (insval); + inserted = XFIXNAT (insval); } } @@ -4492,7 +4492,7 @@ by calling `format-decode', which see. */) Qnil, make_fixnum (inserted), visit); if (! RANGED_FIXNUMP (0, insval, ZV - PT)) wrong_type_argument (intern ("inserted-chars"), insval); - inserted = XFASTINT (insval); + inserted = XFIXNAT (insval); } else { @@ -4523,7 +4523,7 @@ by calling `format-decode', which see. */) else /* format_decode modified buffer's characters => consider entire buffer changed and leave point at point-min. */ - inserted = XFASTINT (insval); + inserted = XFIXNAT (insval); } /* For consistency with format-decode call these now iff inserted > 0 @@ -4538,7 +4538,7 @@ by calling `format-decode', which see. */) { if (! RANGED_FIXNUMP (0, insval, ZV - PT)) wrong_type_argument (intern ("inserted-chars"), insval); - inserted = XFASTINT (insval); + inserted = XFIXNAT (insval); } } else @@ -4566,7 +4566,7 @@ by calling `format-decode', which see. */) /* after_insert_file_functions did modify buffer's characters => consider entire buffer changed and leave point at point-min. */ - inserted = XFASTINT (insval); + inserted = XFIXNAT (insval); } } @@ -4584,7 +4584,7 @@ by calling `format-decode', which see. */) Lisp_Object tem = XCAR (old_undo); if (CONSP (tem) && FIXNUMP (XCAR (tem)) && FIXNUMP (XCDR (tem)) - && XFASTINT (XCDR (tem)) == PT + old_inserted) + && XFIXNAT (XCDR (tem)) == PT + old_inserted) XSETCDR (tem, make_fixnum (PT + inserted)); } } @@ -4962,14 +4962,14 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, if (STRINGP (start)) ok = a_write (desc, start, 0, SCHARS (start), &annotations, &coding); - else if (XINT (start) != XINT (end)) - ok = a_write (desc, Qnil, XINT (start), XINT (end) - XINT (start), + else if (XFIXNUM (start) != XFIXNUM (end)) + ok = a_write (desc, Qnil, XFIXNUM (start), XFIXNUM (end) - XFIXNUM (start), &annotations, &coding); else { /* If file was empty, still need to write the annotations. */ coding.mode |= CODING_MODE_LAST_BLOCK; - ok = a_write (desc, Qnil, XINT (end), 0, &annotations, &coding); + ok = a_write (desc, Qnil, XFIXNUM (end), 0, &annotations, &coding); } save_errno = errno; @@ -5256,7 +5256,7 @@ a_write (int desc, Lisp_Object string, ptrdiff_t pos, tem = Fcar_safe (Fcar (*annot)); nextpos = pos - 1; if (FIXNUMP (tem)) - nextpos = XFASTINT (tem); + nextpos = XFIXNAT (tem); /* If there are no more annotations in this range, output the rest of the range all at once. */ @@ -5458,7 +5458,7 @@ An argument specifies the modification time value to use if (FIXNUMP (time_flag)) { CHECK_RANGED_INTEGER (time_flag, -1, 0); - mtime = make_timespec (0, UNKNOWN_MODTIME_NSECS - XINT (time_flag)); + mtime = make_timespec (0, UNKNOWN_MODTIME_NSECS - XFIXNUM (time_flag)); } else mtime = lisp_time_argument (time_flag); @@ -5526,7 +5526,7 @@ auto_save_1 (void) else if (modes = Ffile_modes (BVAR (current_buffer, filename)), FIXNUMP (modes)) /* Remote files don't cooperate with stat. */ - auto_save_mode_bits = (XINT (modes) | 0600) & 0777; + auto_save_mode_bits = (XFIXNUM (modes) | 0600) & 0777; } return @@ -5693,7 +5693,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b) && BUF_AUTOSAVE_MODIFF (b) < BUF_MODIFF (b) /* -1 means we've turned off autosaving for a while--see below. */ - && XINT (BVAR (b, save_length)) >= 0 + && XFIXNUM (BVAR (b, save_length)) >= 0 && (do_handled_files || NILP (Ffind_file_name_handler (BVAR (b, auto_save_file_name), Qwrite_region)))) @@ -5708,11 +5708,11 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) set_buffer_internal (b); if (NILP (Vauto_save_include_big_deletions) - && (XFASTINT (BVAR (b, save_length)) * 10 + && (XFIXNAT (BVAR (b, save_length)) * 10 > (BUF_Z (b) - BUF_BEG (b)) * 13) /* A short file is likely to change a large fraction; spare the user annoying messages. */ - && XFASTINT (BVAR (b, save_length)) > 5000 + && XFIXNAT (BVAR (b, save_length)) > 5000 /* These messages are frequent and annoying for `*mail*'. */ && !EQ (BVAR (b, filename), Qnil) && NILP (no_message)) diff --git a/src/floatfns.c b/src/floatfns.c index 563c65f827..f8463f3244 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -194,7 +194,7 @@ EXPONENT must be an integer. */) (Lisp_Object sgnfcand, Lisp_Object exponent) { CHECK_FIXNUM (exponent); - int e = min (max (INT_MIN, XINT (exponent)), INT_MAX); + int e = min (max (INT_MIN, XFIXNUM (exponent)), INT_MAX); return make_float (ldexp (extract_float (sgnfcand), e)); } @@ -215,14 +215,14 @@ DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, CHECK_FIXNUM_OR_FLOAT (arg2); if (FIXNUMP (arg1) /* common lisp spec */ && FIXNUMP (arg2) /* don't promote, if both are ints, and */ - && XINT (arg2) >= 0) /* we are sure the result is not fractional */ + && XFIXNUM (arg2) >= 0) /* we are sure the result is not fractional */ { /* this can be improved by pre-calculating */ EMACS_INT y; /* some binary powers of x then accumulating */ EMACS_UINT acc, x; /* Unsigned so that overflow is well defined. */ Lisp_Object val; - x = XINT (arg1); - y = XINT (arg2); + x = XFIXNUM (arg1); + y = XFIXNUM (arg2); acc = (y & 1 ? x : 1); while ((y >>= 1) != 0) @@ -285,7 +285,7 @@ DEFUN ("abs", Fabs, Sabs, 1, 1, 0, arg = make_number (val); mpz_clear (val); } - else if (FIXNUMP (arg) && XINT (arg) == MOST_NEGATIVE_FIXNUM) + else if (FIXNUMP (arg) && XFIXNUM (arg) == MOST_NEGATIVE_FIXNUM) { mpz_t val; mpz_init (val); @@ -295,8 +295,8 @@ DEFUN ("abs", Fabs, Sabs, 1, 1, 0, } else if (FLOATP (arg)) arg = make_float (fabs (XFLOAT_DATA (arg))); - else if (XINT (arg) < 0) - XSETINT (arg, - XINT (arg)); + else if (XFIXNUM (arg) < 0) + XSETINT (arg, - XFIXNUM (arg)); return arg; } @@ -310,7 +310,7 @@ DEFUN ("float", Ffloat, Sfloat, 1, 1, 0, if (BIGNUMP (arg)) return make_float (mpz_get_d (XBIGNUM (arg)->value)); if (FIXNUMP (arg)) - return make_float ((double) XINT (arg)); + return make_float ((double) XFIXNUM (arg)); else /* give 'em the same float back */ return arg; } @@ -351,7 +351,7 @@ This is the same as the exponent of a float. */) else { eassert (FIXNUMP (arg)); - EMACS_INT i = eabs (XINT (arg)); + EMACS_INT i = eabs (XFIXNUM (arg)); value = (i == 0 ? MOST_NEGATIVE_FIXNUM : EMACS_UINT_WIDTH - 1 - ecount_leading_zeros (i)); @@ -383,13 +383,13 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor, CHECK_FIXNUM_OR_FLOAT (divisor); if (!FLOATP (arg) && !FLOATP (divisor)) { - if (XINT (divisor) == 0) + if (XFIXNUM (divisor) == 0) xsignal0 (Qarith_error); - return make_fixnum (int_round2 (XINT (arg), XINT (divisor))); + return make_fixnum (int_round2 (XFIXNUM (arg), XFIXNUM (divisor))); } - double f1 = FLOATP (arg) ? XFLOAT_DATA (arg) : XINT (arg); - double f2 = FLOATP (divisor) ? XFLOAT_DATA (divisor) : XINT (divisor); + double f1 = FLOATP (arg) ? XFLOAT_DATA (arg) : XFIXNUM (arg); + double f2 = FLOATP (divisor) ? XFLOAT_DATA (divisor) : XFIXNUM (divisor); if (! IEEE_FLOATING_POINT && f2 == 0) xsignal0 (Qarith_error); d = f1 / f2; @@ -510,8 +510,8 @@ fmod_float (Lisp_Object x, Lisp_Object y) { double f1, f2; - f1 = FLOATP (x) ? XFLOAT_DATA (x) : XINT (x); - f2 = FLOATP (y) ? XFLOAT_DATA (y) : XINT (y); + f1 = FLOATP (x) ? XFLOAT_DATA (x) : XFIXNUM (x); + f2 = FLOATP (y) ? XFLOAT_DATA (y) : XFIXNUM (y); f1 = fmod (f1, f2); diff --git a/src/fns.c b/src/fns.c index ac93a2f6d8..92a853e175 100644 --- a/src/fns.c +++ b/src/fns.c @@ -77,14 +77,14 @@ See Info node `(elisp)Random Numbers' for more details. */) seed_random (SSDATA (limit), SBYTES (limit)); val = get_random (); - if (FIXNUMP (limit) && 0 < XINT (limit)) + if (FIXNUMP (limit) && 0 < XFIXNUM (limit)) while (true) { /* Return the remainder, except reject the rare case where get_random returns a number so close to INTMASK that the remainder isn't random. */ - EMACS_INT remainder = val % XINT (limit); - if (val - remainder <= INTMASK - XINT (limit) + 1) + EMACS_INT remainder = val % XFIXNUM (limit); + if (val - remainder <= INTMASK - XFIXNUM (limit) + 1) return make_fixnum (remainder); val = get_random (); } @@ -270,9 +270,9 @@ If string STR1 is greater, the value is a positive number N; /* For backward compatibility, silently bring too-large positive end values into range. */ - if (FIXNUMP (end1) && SCHARS (str1) < XINT (end1)) + if (FIXNUMP (end1) && SCHARS (str1) < XFIXNUM (end1)) end1 = make_fixnum (SCHARS (str1)); - if (FIXNUMP (end2) && SCHARS (str2) < XINT (end2)) + if (FIXNUMP (end2) && SCHARS (str2) < XFIXNUM (end2)) end2 = make_fixnum (SCHARS (str2)); validate_subarray (str1, start1, end1, SCHARS (str1), &from1, &to1); @@ -298,8 +298,8 @@ If string STR1 is greater, the value is a positive number N; if (! NILP (ignore_case)) { - c1 = XINT (Fupcase (make_fixnum (c1))); - c2 = XINT (Fupcase (make_fixnum (c2))); + c1 = XFIXNUM (Fupcase (make_fixnum (c1))); + c2 = XFIXNUM (Fupcase (make_fixnum (c2))); } if (c1 == c2) @@ -645,7 +645,7 @@ concat (ptrdiff_t nargs, Lisp_Object *args, { EMACS_INT len; this = args[argnum]; - len = XFASTINT (Flength (this)); + len = XFIXNAT (Flength (this)); if (target_type == Lisp_String) { /* We must count the number of bytes needed in the string @@ -660,7 +660,7 @@ concat (ptrdiff_t nargs, Lisp_Object *args, { ch = AREF (this, i); CHECK_CHARACTER (ch); - c = XFASTINT (ch); + c = XFIXNAT (ch); this_len_byte = CHAR_BYTES (c); if (STRING_BYTES_BOUND - result_len_byte < this_len_byte) string_overflow (); @@ -675,7 +675,7 @@ concat (ptrdiff_t nargs, Lisp_Object *args, { ch = XCAR (this); CHECK_CHARACTER (ch); - c = XFASTINT (ch); + c = XFIXNAT (ch); this_len_byte = CHAR_BYTES (c); if (STRING_BYTES_BOUND - result_len_byte < this_len_byte) string_overflow (); @@ -740,7 +740,7 @@ concat (ptrdiff_t nargs, Lisp_Object *args, this = args[argnum]; if (!CONSP (this)) - thislen = Flength (this), thisleni = XINT (thislen); + thislen = Flength (this), thisleni = XFIXNUM (thislen); /* Between strings of the same kind, copy fast. */ if (STRINGP (this) && STRINGP (val) @@ -827,7 +827,7 @@ concat (ptrdiff_t nargs, Lisp_Object *args, { int c; CHECK_CHARACTER (elt); - c = XFASTINT (elt); + c = XFIXNAT (elt); if (some_multibyte) toindex_byte += CHAR_STRING (c, SDATA (val) + toindex_byte); else @@ -1260,7 +1260,7 @@ validate_subarray (Lisp_Object array, Lisp_Object from, Lisp_Object to, if (FIXNUMP (from)) { - f = XINT (from); + f = XFIXNUM (from); if (f < 0) f += size; } @@ -1271,7 +1271,7 @@ validate_subarray (Lisp_Object array, Lisp_Object from, Lisp_Object to, if (FIXNUMP (to)) { - t = XINT (to); + t = XFIXNUM (to); if (t < 0) t += size; } @@ -1385,7 +1385,7 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0, { CHECK_FIXNUM (n); Lisp_Object tail = list; - for (EMACS_INT num = XINT (n); 0 < num; num--) + for (EMACS_INT num = XFIXNUM (n); 0 < num; num--) { if (! CONSP (tail)) { @@ -1645,7 +1645,7 @@ changing the value of a sequence `foo'. */) cbytes = 1; } - if (!FIXNUMP (elt) || c != XINT (elt)) + if (!FIXNUMP (elt) || c != XFIXNUM (elt)) { ++nchars; nbytes += cbytes; @@ -1675,7 +1675,7 @@ changing the value of a sequence `foo'. */) cbytes = 1; } - if (!FIXNUMP (elt) || c != XINT (elt)) + if (!FIXNUMP (elt) || c != XFIXNUM (elt)) { unsigned char *from = SDATA (seq) + ibyte; unsigned char *to = SDATA (tem) + nbytes; @@ -1846,7 +1846,7 @@ sort_list (Lisp_Object list, Lisp_Object predicate) front = list; len = Flength (list); - length = XINT (len); + length = XFIXNUM (len); if (length < 2) return list; @@ -2417,7 +2417,7 @@ ARRAY is a vector, string, char-table, or bool-vector. */) register unsigned char *p = SDATA (array); int charval; CHECK_CHARACTER (item); - charval = XFASTINT (item); + charval = XFIXNAT (item); size = SCHARS (array); if (STRING_MULTIBYTE (array)) { @@ -2569,7 +2569,7 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string. */) (Lisp_Object function, Lisp_Object sequence, Lisp_Object separator) { USE_SAFE_ALLOCA; - EMACS_INT leni = XFASTINT (Flength (sequence)); + EMACS_INT leni = XFIXNAT (Flength (sequence)); if (CHAR_TABLE_P (sequence)) wrong_type_argument (Qlistp, sequence); EMACS_INT args_alloc = 2 * leni - 1; @@ -2598,7 +2598,7 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string. */) (Lisp_Object function, Lisp_Object sequence) { USE_SAFE_ALLOCA; - EMACS_INT leni = XFASTINT (Flength (sequence)); + EMACS_INT leni = XFIXNAT (Flength (sequence)); if (CHAR_TABLE_P (sequence)) wrong_type_argument (Qlistp, sequence); Lisp_Object *args; @@ -2617,7 +2617,7 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string. */) { register EMACS_INT leni; - leni = XFASTINT (Flength (sequence)); + leni = XFIXNAT (Flength (sequence)); if (CHAR_TABLE_P (sequence)) wrong_type_argument (Qlistp, sequence); mapcar1 (leni, 0, function, sequence); @@ -2632,7 +2632,7 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string. */) (Lisp_Object function, Lisp_Object sequence) { USE_SAFE_ALLOCA; - EMACS_INT leni = XFASTINT (Flength (sequence)); + EMACS_INT leni = XFIXNAT (Flength (sequence)); if (CHAR_TABLE_P (sequence)) wrong_type_argument (Qlistp, sequence); Lisp_Object *args; @@ -3159,9 +3159,9 @@ into shorter lines. */) validate_region (&beg, &end); - ibeg = CHAR_TO_BYTE (XFASTINT (beg)); - iend = CHAR_TO_BYTE (XFASTINT (end)); - move_gap_both (XFASTINT (beg), ibeg); + ibeg = CHAR_TO_BYTE (XFIXNAT (beg)); + iend = CHAR_TO_BYTE (XFIXNAT (end)); + move_gap_both (XFIXNAT (beg), ibeg); /* We need to allocate enough room for encoding the text. We need 33 1/3% more space, plus a newline every 76 @@ -3186,17 +3186,17 @@ into shorter lines. */) /* Now we have encoded the region, so we insert the new contents and delete the old. (Insert first in order to preserve markers.) */ - SET_PT_BOTH (XFASTINT (beg), ibeg); + SET_PT_BOTH (XFIXNAT (beg), ibeg); insert (encoded, encoded_length); SAFE_FREE (); del_range_byte (ibeg + encoded_length, iend + encoded_length); /* If point was outside of the region, restore it exactly; else just move to the beginning of the region. */ - if (old_pos >= XFASTINT (end)) - old_pos += encoded_length - (XFASTINT (end) - XFASTINT (beg)); - else if (old_pos > XFASTINT (beg)) - old_pos = XFASTINT (beg); + if (old_pos >= XFIXNAT (end)) + old_pos += encoded_length - (XFIXNAT (end) - XFIXNAT (beg)); + else if (old_pos > XFIXNAT (beg)) + old_pos = XFIXNAT (beg); SET_PT (old_pos); /* We return the length of the encoded text. */ @@ -3359,8 +3359,8 @@ If the region can't be decoded, signal an error and don't modify the buffer. */ validate_region (&beg, &end); - ibeg = CHAR_TO_BYTE (XFASTINT (beg)); - iend = CHAR_TO_BYTE (XFASTINT (end)); + ibeg = CHAR_TO_BYTE (XFIXNAT (beg)); + iend = CHAR_TO_BYTE (XFIXNAT (end)); length = iend - ibeg; @@ -3370,7 +3370,7 @@ If the region can't be decoded, signal an error and don't modify the buffer. */ allength = multibyte ? length * 2 : length; decoded = SAFE_ALLOCA (allength); - move_gap_both (XFASTINT (beg), ibeg); + move_gap_both (XFIXNAT (beg), ibeg); decoded_length = base64_decode_1 ((char *) BYTE_POS_ADDR (ibeg), decoded, length, multibyte, &inserted_chars); @@ -3385,21 +3385,21 @@ If the region can't be decoded, signal an error and don't modify the buffer. */ /* Now we have decoded the region, so we insert the new contents and delete the old. (Insert first in order to preserve markers.) */ - TEMP_SET_PT_BOTH (XFASTINT (beg), ibeg); + TEMP_SET_PT_BOTH (XFIXNAT (beg), ibeg); insert_1_both (decoded, inserted_chars, decoded_length, 0, 1, 0); - signal_after_change (XFASTINT (beg), 0, inserted_chars); + signal_after_change (XFIXNAT (beg), 0, inserted_chars); SAFE_FREE (); /* Delete the original text. */ - del_range_both (PT, PT_BYTE, XFASTINT (end) + inserted_chars, + del_range_both (PT, PT_BYTE, XFIXNAT (end) + inserted_chars, iend + decoded_length, 1); /* If point was outside of the region, restore it exactly; else just move to the beginning of the region. */ - if (old_pos >= XFASTINT (end)) - old_pos += inserted_chars - (XFASTINT (end) - XFASTINT (beg)); - else if (old_pos > XFASTINT (beg)) - old_pos = XFASTINT (beg); + if (old_pos >= XFIXNAT (end)) + old_pos += inserted_chars - (XFIXNAT (end) - XFIXNAT (beg)); + else if (old_pos > XFIXNAT (beg)) + old_pos = XFIXNAT (beg); SET_PT (old_pos > ZV ? ZV : old_pos); return make_fixnum (inserted_chars); @@ -3696,7 +3696,7 @@ larger_vector (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max) static ptrdiff_t HASH_NEXT (struct Lisp_Hash_Table *h, ptrdiff_t idx) { - return XINT (AREF (h->next, idx)); + return XFIXNUM (AREF (h->next, idx)); } /* Return the index of the element in hash table H that is the start @@ -3705,7 +3705,7 @@ HASH_NEXT (struct Lisp_Hash_Table *h, ptrdiff_t idx) static ptrdiff_t HASH_INDEX (struct Lisp_Hash_Table *h, ptrdiff_t idx) { - return XINT (AREF (h->index, idx)); + return XFIXNUM (AREF (h->index, idx)); } /* Compare KEY1 which has hash code HASH1 and KEY2 with hash code @@ -4008,7 +4008,7 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) for (i = 0; i < old_size; ++i) if (!NILP (HASH_HASH (h, i))) { - EMACS_UINT hash_code = XUINT (HASH_HASH (h, i)); + EMACS_UINT hash_code = XUFIXNUM (HASH_HASH (h, i)); ptrdiff_t start_of_bucket = hash_code % ASIZE (h->index); set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket)); set_hash_index_slot (h, start_of_bucket, i); @@ -4037,7 +4037,7 @@ hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, EMACS_UINT *hash) for (i = HASH_INDEX (h, start_of_bucket); 0 <= i; i = HASH_NEXT (h, i)) if (EQ (key, HASH_KEY (h, i)) || (h->test.cmpfn - && hash_code == XUINT (HASH_HASH (h, i)) + && hash_code == XUFIXNUM (HASH_HASH (h, i)) && h->test.cmpfn (&h->test, key, HASH_KEY (h, i)))) break; @@ -4094,7 +4094,7 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key) { if (EQ (key, HASH_KEY (h, i)) || (h->test.cmpfn - && hash_code == XUINT (HASH_HASH (h, i)) + && hash_code == XUFIXNUM (HASH_HASH (h, i)) && h->test.cmpfn (&h->test, key, HASH_KEY (h, i)))) { /* Take entry out of collision chain. */ @@ -4444,7 +4444,7 @@ sxhash (Lisp_Object obj, int depth) switch (XTYPE (obj)) { case_Lisp_Int: - hash = XUINT (obj); + hash = XUFIXNUM (obj); break; case Lisp_Misc: @@ -4607,7 +4607,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) if (NILP (size_arg)) size = DEFAULT_HASH_SIZE; else if (FIXNATP (size_arg)) - size = XFASTINT (size_arg); + size = XFIXNAT (size_arg); else signal_error ("Invalid hash table size", size_arg); @@ -4616,8 +4616,8 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) i = get_key_arg (QCrehash_size, nargs, args, used); if (!i) rehash_size = DEFAULT_REHASH_SIZE; - else if (FIXNUMP (args[i]) && 0 < XINT (args[i])) - rehash_size = - XINT (args[i]); + else if (FIXNUMP (args[i]) && 0 < XFIXNUM (args[i])) + rehash_size = - XFIXNUM (args[i]); else if (FLOATP (args[i]) && 0 < (float) (XFLOAT_DATA (args[i]) - 1)) rehash_size = (float) (XFLOAT_DATA (args[i]) - 1); else @@ -4932,7 +4932,7 @@ extract_data_from_object (Lisp_Object spec, else { CHECK_FIXNUM_COERCE_MARKER (start); - b = XINT (start); + b = XFIXNUM (start); } if (NILP (end)) @@ -4940,7 +4940,7 @@ extract_data_from_object (Lisp_Object spec, else { CHECK_FIXNUM_COERCE_MARKER (end); - e = XINT (end); + e = XFIXNUM (end); } if (b > e) @@ -5033,7 +5033,7 @@ extract_data_from_object (Lisp_Object spec, error ("Without a length, `iv-auto' can't be used; see ELisp manual"); else { - EMACS_INT start_hold = XFASTINT (start); + EMACS_INT start_hold = XFIXNAT (start); object = make_uninit_string (start_hold); gnutls_rnd (GNUTLS_RND_NONCE, SSDATA (object), start_hold); diff --git a/src/font.c b/src/font.c index 382cd78a23..f31d9c21e7 100644 --- a/src/font.c +++ b/src/font.c @@ -303,7 +303,7 @@ font_pixel_size (struct frame *f, Lisp_Object spec) Lisp_Object val; if (FIXNUMP (size)) - return XINT (size); + return XFIXNUM (size); if (NILP (size)) return 0; if (FRAME_WINDOW_P (f)) @@ -312,7 +312,7 @@ font_pixel_size (struct frame *f, Lisp_Object spec) point_size = XFLOAT_DATA (size); val = AREF (spec, FONT_DPI_INDEX); if (FIXNUMP (val)) - dpi = XINT (val); + dpi = XFIXNUM (val); else dpi = FRAME_RES_Y (f); pixel_size = POINT_TO_PIXEL (point_size, dpi); @@ -354,7 +354,7 @@ font_style_to_value (enum font_property_index prop, Lisp_Object val, if (EQ (val, AREF (AREF (table, i), j))) { CHECK_FIXNUM (AREF (AREF (table, i), 0)); - return ((XINT (AREF (AREF (table, i), 0)) << 8) + return ((XFIXNUM (AREF (AREF (table, i), 0)) << 8) | (i << 4) | (j - 1)); } } @@ -367,7 +367,7 @@ font_style_to_value (enum font_property_index prop, Lisp_Object val, if (xstrcasecmp (s, SSDATA (SYMBOL_NAME (elt))) == 0) { CHECK_FIXNUM (AREF (AREF (table, i), 0)); - return ((XINT (AREF (AREF (table, i), 0)) << 8) + return ((XFIXNUM (AREF (AREF (table, i), 0)) << 8) | (i << 4) | (j - 1)); } } @@ -383,7 +383,7 @@ font_style_to_value (enum font_property_index prop, Lisp_Object val, else { int i, last_n; - EMACS_INT numeric = XINT (val); + EMACS_INT numeric = XFIXNUM (val); for (i = 0, last_n = -1; i < len; i++) { @@ -391,7 +391,7 @@ font_style_to_value (enum font_property_index prop, Lisp_Object val, CHECK_VECTOR (AREF (table, i)); CHECK_FIXNUM (AREF (AREF (table, i), 0)); - n = XINT (AREF (AREF (table, i), 0)); + n = XFIXNUM (AREF (AREF (table, i), 0)); if (numeric == n) return (n << 8) | (i << 4); if (numeric < n) @@ -421,7 +421,7 @@ font_style_symbolic (Lisp_Object font, enum font_property_index prop, return Qnil; table = AREF (font_style_table, prop - FONT_WEIGHT_INDEX); CHECK_VECTOR (table); - i = XINT (val) & 0xFF; + i = XFIXNUM (val) & 0xFF; eassert (((i >> 4) & 0xF) < ASIZE (table)); elt = AREF (table, ((i >> 4) & 0xF)); CHECK_VECTOR (elt); @@ -470,28 +470,28 @@ font_registry_charsets (Lisp_Object registry, struct charset **encoding, struct val = XCDR (val); if (NILP (val)) return -1; - encoding_id = XINT (XCAR (val)); - repertory_id = XINT (XCDR (val)); + encoding_id = XFIXNUM (XCAR (val)); + repertory_id = XFIXNUM (XCDR (val)); } else { val = find_font_encoding (SYMBOL_NAME (registry)); if (SYMBOLP (val) && CHARSETP (val)) { - encoding_id = repertory_id = XINT (CHARSET_SYMBOL_ID (val)); + encoding_id = repertory_id = XFIXNUM (CHARSET_SYMBOL_ID (val)); } else if (CONSP (val)) { if (! CHARSETP (XCAR (val))) goto invalid_entry; - encoding_id = XINT (CHARSET_SYMBOL_ID (XCAR (val))); + encoding_id = XFIXNUM (CHARSET_SYMBOL_ID (XCAR (val))); if (NILP (XCDR (val))) repertory_id = -1; else { if (! CHARSETP (XCDR (val))) goto invalid_entry; - repertory_id = XINT (CHARSET_SYMBOL_ID (XCDR (val))); + repertory_id = XFIXNUM (CHARSET_SYMBOL_ID (XCDR (val))); } } else @@ -545,7 +545,7 @@ font_prop_validate_style (Lisp_Object style, Lisp_Object val) : FONT_WIDTH_INDEX); if (FIXNUMP (val)) { - EMACS_INT n = XINT (val); + EMACS_INT n = XFIXNUM (val); CHECK_VECTOR (AREF (font_style_table, prop - FONT_WEIGHT_INDEX)); if (((n >> 4) & 0xF) >= ASIZE (AREF (font_style_table, prop - FONT_WEIGHT_INDEX))) @@ -560,7 +560,7 @@ font_prop_validate_style (Lisp_Object style, Lisp_Object val) else { CHECK_FIXNUM (AREF (elt, 0)); - if (XINT (AREF (elt, 0)) != (n >> 8)) + if (XFIXNUM (AREF (elt, 0)) != (n >> 8)) val = Qerror; } } @@ -586,7 +586,7 @@ font_prop_validate_non_neg (Lisp_Object prop, Lisp_Object val) static Lisp_Object font_prop_validate_spacing (Lisp_Object prop, Lisp_Object val) { - if (NILP (val) || (FIXNATP (val) && XINT (val) <= FONT_SPACING_CHARCELL)) + if (NILP (val) || (FIXNATP (val) && XFIXNUM (val) <= FONT_SPACING_CHARCELL)) return val; if (SYMBOLP (val) && SBYTES (SYMBOL_NAME (val)) == 1) { @@ -877,7 +877,7 @@ font_expand_wildcards (Lisp_Object *field, int n) if (FIXNUMP (val)) { - EMACS_INT numeric = XINT (val); + EMACS_INT numeric = XFIXNUM (val); if (i + 1 == n) from = to = XLFD_ENCODING_INDEX, @@ -1185,7 +1185,7 @@ font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font) ASET (font, FONT_SIZE_INDEX, prop[XLFD_PIXEL_INDEX]); else if (FIXNUMP (prop[XLFD_POINT_INDEX])) { - double point_size = XINT (prop[XLFD_POINT_INDEX]); + double point_size = XFIXNUM (prop[XLFD_POINT_INDEX]); ASET (font, FONT_SIZE_INDEX, make_float (point_size / 10)); } @@ -1289,7 +1289,7 @@ font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes) 1 + DBL_MAX_10_EXP + 1)]; if (FIXNUMP (val)) { - EMACS_INT v = XINT (val); + EMACS_INT v = XFIXNUM (val); if (v <= 0) v = pixel_size; if (v > 0) @@ -1312,7 +1312,7 @@ font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes) char dpi_index_buf[sizeof "-" + 2 * INT_STRLEN_BOUND (EMACS_INT)]; if (FIXNUMP (AREF (font, FONT_DPI_INDEX))) { - EMACS_INT v = XINT (AREF (font, FONT_DPI_INDEX)); + EMACS_INT v = XFIXNUM (AREF (font, FONT_DPI_INDEX)); f[XLFD_RESX_INDEX] = p = dpi_index_buf; sprintf (p, "%"pI"d-%"pI"d", v, v); } @@ -1321,7 +1321,7 @@ font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes) if (FIXNUMP (AREF (font, FONT_SPACING_INDEX))) { - EMACS_INT spacing = XINT (AREF (font, FONT_SPACING_INDEX)); + EMACS_INT spacing = XFIXNUM (AREF (font, FONT_SPACING_INDEX)); f[XLFD_SPACING_INDEX] = (spacing <= FONT_SPACING_PROPORTIONAL ? "p" : spacing <= FONT_SPACING_DUAL ? "d" @@ -1335,7 +1335,7 @@ font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes) if (FIXNUMP (AREF (font, FONT_AVGWIDTH_INDEX))) { f[XLFD_AVGWIDTH_INDEX] = p = avgwidth_index_buf; - sprintf (p, "%"pI"d", XINT (AREF (font, FONT_AVGWIDTH_INDEX))); + sprintf (p, "%"pI"d", XFIXNUM (AREF (font, FONT_AVGWIDTH_INDEX))); } else f[XLFD_AVGWIDTH_INDEX] = "*"; @@ -1623,8 +1623,8 @@ font_unparse_fcname (Lisp_Object font, int pixel_size, char *name, int nbytes) val = AREF (font, FONT_SIZE_INDEX); if (FIXNUMP (val)) { - if (XINT (val) != 0) - pixel_size = XINT (val); + if (XFIXNUM (val) != 0) + pixel_size = XFIXNUM (val); point_size = -1; } else @@ -1691,7 +1691,7 @@ font_unparse_fcname (Lisp_Object font, int pixel_size, char *name, int nbytes) if (FIXNUMP (AREF (font, FONT_DPI_INDEX))) { int len = snprintf (p, lim - p, ":dpi=%"pI"d", - XINT (AREF (font, FONT_DPI_INDEX))); + XFIXNUM (AREF (font, FONT_DPI_INDEX))); if (! (0 <= len && len < lim - p)) return -1; p += len; @@ -1700,7 +1700,7 @@ font_unparse_fcname (Lisp_Object font, int pixel_size, char *name, int nbytes) if (FIXNUMP (AREF (font, FONT_SPACING_INDEX))) { int len = snprintf (p, lim - p, ":spacing=%"pI"d", - XINT (AREF (font, FONT_SPACING_INDEX))); + XFIXNUM (AREF (font, FONT_SPACING_INDEX))); if (! (0 <= len && len < lim - p)) return -1; p += len; @@ -1709,7 +1709,7 @@ font_unparse_fcname (Lisp_Object font, int pixel_size, char *name, int nbytes) if (FIXNUMP (AREF (font, FONT_AVGWIDTH_INDEX))) { int len = snprintf (p, lim - p, - (XINT (AREF (font, FONT_AVGWIDTH_INDEX)) == 0 + (XFIXNUM (AREF (font, FONT_AVGWIDTH_INDEX)) == 0 ? ":scalable=true" : ":scalable=false")); if (! (0 <= len && len < lim - p)) @@ -2134,20 +2134,20 @@ font_score (Lisp_Object entity, Lisp_Object *spec_prop) for (i = FONT_WEIGHT_INDEX; i <= FONT_WIDTH_INDEX; i++) if (! NILP (spec_prop[i]) && ! EQ (AREF (entity, i), spec_prop[i])) { - EMACS_INT diff = ((XINT (AREF (entity, i)) >> 8) - - (XINT (spec_prop[i]) >> 8)); + EMACS_INT diff = ((XFIXNUM (AREF (entity, i)) >> 8) + - (XFIXNUM (spec_prop[i]) >> 8)); score |= min (eabs (diff), 127) << sort_shift_bits[i]; } /* Score the size. Maximum difference is 127. */ if (! NILP (spec_prop[FONT_SIZE_INDEX]) - && XINT (AREF (entity, FONT_SIZE_INDEX)) > 0) + && XFIXNUM (AREF (entity, FONT_SIZE_INDEX)) > 0) { /* We use the higher 6-bit for the actual size difference. The lowest bit is set if the DPI is different. */ EMACS_INT diff; - EMACS_INT pixel_size = XINT (spec_prop[FONT_SIZE_INDEX]); - EMACS_INT entity_size = XINT (AREF (entity, FONT_SIZE_INDEX)); + EMACS_INT pixel_size = XFIXNUM (spec_prop[FONT_SIZE_INDEX]); + EMACS_INT entity_size = XFIXNUM (AREF (entity, FONT_SIZE_INDEX)); if (CONSP (Vface_font_rescale_alist)) pixel_size *= font_rescale_ratio (entity); @@ -2174,7 +2174,7 @@ font_score (Lisp_Object entity, Lisp_Object *spec_prop) static Lisp_Object font_vconcat_entity_vectors (Lisp_Object list) { - EMACS_INT nargs = XFASTINT (Flength (list)); + EMACS_INT nargs = XFIXNAT (Flength (list)); Lisp_Object *args; USE_SAFE_ALLOCA; SAFE_ALLOCA_LISP (args, nargs); @@ -2492,7 +2492,7 @@ font_match_p (Lisp_Object spec, Lisp_Object font) { if (! CHARACTERP (XCAR (val2))) continue; - if (font_encode_char (font, XFASTINT (XCAR (val2))) + if (font_encode_char (font, XFIXNAT (XCAR (val2))) == FONT_INVALID_CODE) return 0; } @@ -2504,7 +2504,7 @@ font_match_p (Lisp_Object spec, Lisp_Object font) { if (! CHARACTERP (AREF (val2, i))) continue; - if (font_encode_char (font, XFASTINT (AREF (val2, i))) + if (font_encode_char (font, XFIXNAT (AREF (val2, i))) != FONT_INVALID_CODE) break; } @@ -2565,7 +2565,7 @@ font_prepare_cache (struct frame *f, struct font_driver const *driver) else { val = XCDR (XCAR (val)); - XSETCAR (val, make_fixnum (XINT (XCAR (val)) + 1)); + XSETCAR (val, make_fixnum (XFIXNUM (XCAR (val)) + 1)); } } @@ -2582,8 +2582,8 @@ font_finish_cache (struct frame *f, struct font_driver const *driver) cache = val, val = XCDR (val); eassert (! NILP (val)); tmp = XCDR (XCAR (val)); - XSETCAR (tmp, make_fixnum (XINT (XCAR (tmp)) - 1)); - if (XINT (XCAR (tmp)) == 0) + XSETCAR (tmp, make_fixnum (XFIXNUM (XCAR (tmp)) - 1)); + if (XFIXNUM (XCAR (tmp)) == 0) { font_clear_cache (f, XCAR (val), driver); XSETCDR (cache, XCDR (val)); @@ -2699,14 +2699,14 @@ font_delete_unmatched (Lisp_Object vec, Lisp_Object spec, int size) } for (prop = FONT_WEIGHT_INDEX; prop < FONT_SIZE_INDEX; prop++) if (FIXNUMP (AREF (spec, prop)) - && ((XINT (AREF (spec, prop)) >> 8) - != (XINT (AREF (entity, prop)) >> 8))) + && ((XFIXNUM (AREF (spec, prop)) >> 8) + != (XFIXNUM (AREF (entity, prop)) >> 8))) prop = FONT_SPEC_MAX; if (prop < FONT_SPEC_MAX && size - && XINT (AREF (entity, FONT_SIZE_INDEX)) > 0) + && XFIXNUM (AREF (entity, FONT_SIZE_INDEX)) > 0) { - int diff = XINT (AREF (entity, FONT_SIZE_INDEX)) - size; + int diff = XFIXNUM (AREF (entity, FONT_SIZE_INDEX)) - size; if (eabs (diff) > FONT_PIXEL_SIZE_QUANTUM) prop = FONT_SPEC_MAX; @@ -2714,13 +2714,13 @@ font_delete_unmatched (Lisp_Object vec, Lisp_Object spec, int size) if (prop < FONT_SPEC_MAX && FIXNUMP (AREF (spec, FONT_DPI_INDEX)) && FIXNUMP (AREF (entity, FONT_DPI_INDEX)) - && XINT (AREF (entity, FONT_DPI_INDEX)) != 0 + && XFIXNUM (AREF (entity, FONT_DPI_INDEX)) != 0 && ! EQ (AREF (spec, FONT_DPI_INDEX), AREF (entity, FONT_DPI_INDEX))) prop = FONT_SPEC_MAX; if (prop < FONT_SPEC_MAX && FIXNUMP (AREF (spec, FONT_AVGWIDTH_INDEX)) && FIXNUMP (AREF (entity, FONT_AVGWIDTH_INDEX)) - && XINT (AREF (entity, FONT_AVGWIDTH_INDEX)) != 0 + && XFIXNUM (AREF (entity, FONT_AVGWIDTH_INDEX)) != 0 && ! EQ (AREF (spec, FONT_AVGWIDTH_INDEX), AREF (entity, FONT_AVGWIDTH_INDEX))) prop = FONT_SPEC_MAX; @@ -2748,7 +2748,7 @@ font_list_entities (struct frame *f, Lisp_Object spec) eassert (FONT_SPEC_P (spec)); if (FIXNUMP (AREF (spec, FONT_SIZE_INDEX))) - size = XINT (AREF (spec, FONT_SIZE_INDEX)); + size = XFIXNUM (AREF (spec, FONT_SIZE_INDEX)); else if (FLOATP (AREF (spec, FONT_SIZE_INDEX))) size = font_pixel_size (f, spec); else @@ -2873,8 +2873,8 @@ font_open_entity (struct frame *f, Lisp_Object entity, int pixel_size) eassert (FONT_ENTITY_P (entity)); size = AREF (entity, FONT_SIZE_INDEX); - if (XINT (size) != 0) - pixel_size = XINT (size); + if (XFIXNUM (size) != 0) + pixel_size = XFIXNUM (size); val = AREF (entity, FONT_TYPE_INDEX); for (driver_list = f->font_driver_list; @@ -3181,7 +3181,7 @@ font_find_for_lface (struct frame *f, Lisp_Object *attrs, Lisp_Object spec, int pixel_size = font_pixel_size (f, spec); if (pixel_size == 0 && FIXNUMP (attrs[LFACE_HEIGHT_INDEX])) { - double pt = XINT (attrs[LFACE_HEIGHT_INDEX]); + double pt = XFIXNUM (attrs[LFACE_HEIGHT_INDEX]); pixel_size = POINT_TO_PIXEL (pt / 10, FRAME_RES_Y (f)); if (pixel_size < 1) @@ -3241,7 +3241,7 @@ font_find_for_lface (struct frame *f, Lisp_Object *attrs, Lisp_Object spec, int if (! NILP (alters)) { - EMACS_INT alterslen = XFASTINT (Flength (alters)); + EMACS_INT alterslen = XFIXNAT (Flength (alters)); SAFE_ALLOCA_LISP (family, alterslen + 2); for (i = 0; CONSP (alters); i++, alters = XCDR (alters)) family[i] = XCAR (alters); @@ -3299,8 +3299,8 @@ font_open_for_lface (struct frame *f, Lisp_Object entity, Lisp_Object *attrs, Li int size; if (FIXNUMP (AREF (entity, FONT_SIZE_INDEX)) - && XINT (AREF (entity, FONT_SIZE_INDEX)) > 0) - size = XINT (AREF (entity, FONT_SIZE_INDEX)); + && XFIXNUM (AREF (entity, FONT_SIZE_INDEX)) > 0) + size = XFIXNUM (AREF (entity, FONT_SIZE_INDEX)); else { if (FONT_SPEC_P (spec) && ! NILP (AREF (spec, FONT_SIZE_INDEX))) @@ -3309,13 +3309,13 @@ font_open_for_lface (struct frame *f, Lisp_Object entity, Lisp_Object *attrs, Li { double pt; if (FIXNUMP (attrs[LFACE_HEIGHT_INDEX])) - pt = XINT (attrs[LFACE_HEIGHT_INDEX]); + pt = XFIXNUM (attrs[LFACE_HEIGHT_INDEX]); else { struct face *def = FACE_FROM_ID (f, DEFAULT_FACE_ID); Lisp_Object height = def->lface[LFACE_HEIGHT_INDEX]; eassert (FIXNUMP (height)); - pt = XINT (height); + pt = XFIXNUM (height); } pt /= 10; @@ -3325,7 +3325,7 @@ font_open_for_lface (struct frame *f, Lisp_Object entity, Lisp_Object *attrs, Li { Lisp_Object ffsize = get_frame_param (f, Qfontsize); size = (FIXED_OR_FLOATP (ffsize) - ? POINT_TO_PIXEL (XINT (ffsize), FRAME_RES_Y (f)) : 0); + ? POINT_TO_PIXEL (XFIXNUM (ffsize), FRAME_RES_Y (f)) : 0); } #endif } @@ -3372,7 +3372,7 @@ font_load_for_lface (struct frame *f, Lisp_Object *attrs, Lisp_Object spec) Lisp_Object lsize = Ffont_get (spec, QCsize); if ((FLOATP (lsize) && XFLOAT_DATA (lsize) == font_size) - || (FIXNUMP (lsize) && XINT (lsize) == font_size)) + || (FIXNUMP (lsize) && XFIXNUM (lsize) == font_size)) { ASET (spec, FONT_FAMILY_INDEX, font_intern_prop (p, tail - p, 1)); @@ -3673,7 +3673,7 @@ font_filter_properties (Lisp_Object font, if (strcmp (boolean_properties[i], keystr) == 0) { - const char *str = FIXNUMP (val) ? (XINT (val) ? "true" : "false") + const char *str = FIXNUMP (val) ? (XFIXNUM (val) ? "true" : "false") : SYMBOLP (val) ? SSDATA (SYMBOL_NAME (val)) : "true"; @@ -3828,7 +3828,7 @@ font_range (ptrdiff_t pos, ptrdiff_t pos_byte, ptrdiff_t *limit, FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, pos, pos_byte); category = CHAR_TABLE_REF (Vunicode_category_table, c); if (FIXNUMP (category) - && (XINT (category) == UNICODE_CATEGORY_Cf + && (XFIXNUM (category) == UNICODE_CATEGORY_Cf || CHAR_VARIATION_SELECTOR_P (c))) continue; if (NILP (font_object)) @@ -4145,9 +4145,9 @@ are to be displayed on. If omitted, the selected frame is used. */) if (FIXNUMP (val)) { Lisp_Object font_dpi = AREF (font, FONT_DPI_INDEX); - int dpi = FIXNUMP (font_dpi) ? XINT (font_dpi) : FRAME_RES_Y (f); + int dpi = FIXNUMP (font_dpi) ? XFIXNUM (font_dpi) : FRAME_RES_Y (f); plist[n++] = QCheight; - plist[n++] = make_fixnum (PIXEL_TO_POINT (XINT (val) * 10, dpi)); + plist[n++] = make_fixnum (PIXEL_TO_POINT (XFIXNUM (val) * 10, dpi)); } else if (FLOATP (val)) { @@ -4232,7 +4232,7 @@ how close they are to PREFER. */) if (! NILP (num)) { CHECK_FIXNUM (num); - n = XINT (num); + n = XFIXNUM (num); if (n <= 0) return Qnil; } @@ -4358,7 +4358,7 @@ clear_font_cache (struct frame *f) ! EQ (XCAR (XCAR (val)), driver_list->driver->type)) val = XCDR (val); tmp = XCDR (XCAR (val)); - if (XINT (XCAR (tmp)) == 0) + if (XFIXNUM (XCAR (tmp)) == 0) { font_clear_cache (f, XCAR (val), driver_list->driver); XSETCDR (cache, XCDR (val)); @@ -4432,10 +4432,10 @@ GSTRING. */) gstring = larger_vector (gstring, LGSTRING_GLYPH_LEN (gstring), -1); } - if (i == 3 || XINT (n) == 0) + if (i == 3 || XFIXNUM (n) == 0) return Qnil; - if (XINT (n) < LGSTRING_GLYPH_LEN (gstring)) - LGSTRING_SET_GLYPH (gstring, XINT (n), Qnil); + if (XFIXNUM (n) < LGSTRING_GLYPH_LEN (gstring)) + LGSTRING_SET_GLYPH (gstring, XFIXNUM (n), Qnil); /* Check FROM_IDX and TO_IDX of each GLYPH in GSTRING to assure that GLYPHS covers all characters (except for the last few ones) in @@ -4469,7 +4469,7 @@ GSTRING. */) from = LGLYPH_FROM (glyph); to = LGLYPH_TO (glyph); } - return composition_gstring_put_cache (gstring, XINT (n)); + return composition_gstring_put_cache (gstring, XFIXNUM (n)); shaper_error: return Qnil; @@ -4495,7 +4495,7 @@ where font = XFONT_OBJECT (font_object); if (! font->driver->get_variation_glyphs) return Qnil; - n = font->driver->get_variation_glyphs (font, XINT (character), variations); + n = font->driver->get_variation_glyphs (font, XFIXNUM (character), variations); if (! n) return Qnil; val = Qnil; @@ -4556,7 +4556,7 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0, if (NILP (position)) { CHECK_CHARACTER (ch); - c = XINT (ch); + c = XFIXNUM (ch); f = XFRAME (selected_frame); face_id = lookup_basic_face (NULL, f, DEFAULT_FACE_ID); pos = -1; @@ -4567,16 +4567,16 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0, struct window *w; CHECK_FIXNUM_COERCE_MARKER (position); - if (! (BEGV <= XINT (position) && XINT (position) < ZV)) + if (! (BEGV <= XFIXNUM (position) && XFIXNUM (position) < ZV)) args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV)); - pos = XINT (position); + pos = XFIXNUM (position); pos_byte = CHAR_TO_BYTE (pos); if (NILP (ch)) c = FETCH_CHAR (pos_byte); else { CHECK_FIXNAT (ch); - c = XINT (ch); + c = XFIXNUM (ch); } window = Fget_buffer_window (Fcurrent_buffer (), Qnil); if (NILP (window)) @@ -4669,13 +4669,13 @@ glyph-string. */) CHECK_FIXNAT (to); CHECK_FIXNAT (index); - if (XINT (from) >= XINT (to) || XINT (to) > len) + if (XFIXNUM (from) >= XFIXNUM (to) || XFIXNUM (to) > len) args_out_of_range_3 (from, to, make_fixnum (len)); - if (XINT (index) >= ASIZE (gstring_out)) + if (XFIXNUM (index) >= ASIZE (gstring_out)) args_out_of_range (index, make_fixnum (ASIZE (gstring_out))); num = font->driver->otf_drive (font, otf_features, - gstring_in, XINT (from), XINT (to), - gstring_out, XINT (index), 0); + gstring_in, XFIXNUM (from), XFIXNUM (to), + gstring_out, XFIXNUM (index), 0); if (num < 0) return Qnil; return make_fixnum (num); @@ -4708,7 +4708,7 @@ corresponding character. */) gstring_in = Ffont_make_gstring (font_object, make_fixnum (1)); g = LGSTRING_GLYPH (gstring_in, 0); - LGLYPH_SET_CHAR (g, XINT (character)); + LGLYPH_SET_CHAR (g, XFIXNUM (character)); gstring_out = Ffont_make_gstring (font_object, make_fixnum (10)); while ((num = font->driver->otf_drive (font, otf_features, gstring_in, 0, 1, gstring_out, 0, 1)) < 0) @@ -4741,14 +4741,14 @@ DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0, CHECK_FONT_ENTITY (font_entity); if (NILP (size)) - isize = XINT (AREF (font_entity, FONT_SIZE_INDEX)); + isize = XFIXNUM (AREF (font_entity, FONT_SIZE_INDEX)); else { CHECK_FIXNUM_OR_FLOAT (size); if (FLOATP (size)) isize = POINT_TO_PIXEL (XFLOAT_DATA (size), FRAME_RES_Y (f)); else - isize = XINT (size); + isize = XFIXNUM (size); if (! (INT_MIN <= isize && isize <= INT_MAX)) args_out_of_range (font_entity, size); if (isize == 0) @@ -4862,11 +4862,11 @@ the corresponding element is nil. */) validate_region (&from, &to); if (EQ (from, to)) return Qnil; - len = XFASTINT (to) - XFASTINT (from); + len = XFIXNAT (to) - XFIXNAT (from); SAFE_ALLOCA_LISP (chars, len); - charpos = XFASTINT (from); + charpos = XFIXNAT (from); bytepos = CHAR_TO_BYTE (charpos); - for (i = 0; charpos < XFASTINT (to); i++) + for (i = 0; charpos < XFIXNAT (to); i++) { int c; FETCH_CHAR_ADVANCE (c, charpos, bytepos); @@ -4925,7 +4925,7 @@ the corresponding element is nil. */) for (i = 0; i < len; i++) { Lisp_Object g; - int c = XFASTINT (chars[i]); + int c = XFIXNAT (chars[i]); unsigned code; struct font_metrics metrics; @@ -4979,18 +4979,18 @@ character at index specified by POSITION. */) if (XBUFFER (w->contents) != current_buffer) error ("Specified window is not displaying the current buffer"); CHECK_FIXNUM_COERCE_MARKER (position); - if (! (BEGV <= XINT (position) && XINT (position) < ZV)) + if (! (BEGV <= XFIXNUM (position) && XFIXNUM (position) < ZV)) args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV)); } else { CHECK_FIXNUM (position); CHECK_STRING (string); - if (! (0 <= XINT (position) && XINT (position) < SCHARS (string))) + if (! (0 <= XFIXNUM (position) && XFIXNUM (position) < SCHARS (string))) args_out_of_range (string, position); } - return font_at (-1, XINT (position), NULL, w, string); + return font_at (-1, XFIXNUM (position), NULL, w, string); } #if 0 @@ -5015,7 +5015,7 @@ Type C-l to recover what previously shown. */) { Lisp_Object ch = Faref (string, make_fixnum (i)); Lisp_Object val; - int c = XINT (ch); + int c = XFIXNUM (ch); code[i] = font->driver->encode_char (font, c); if (code[i] == FONT_INVALID_CODE) diff --git a/src/font.h b/src/font.h index 62a9920e59..1741b3f396 100644 --- a/src/font.h +++ b/src/font.h @@ -186,15 +186,15 @@ enum font_property_index /* Return the numeric weight value of FONT. */ #define FONT_WEIGHT_NUMERIC(font) \ (FIXNUMP (AREF ((font), FONT_WEIGHT_INDEX)) \ - ? (XINT (AREF ((font), FONT_WEIGHT_INDEX)) >> 8) : -1) + ? (XFIXNUM (AREF ((font), FONT_WEIGHT_INDEX)) >> 8) : -1) /* Return the numeric slant value of FONT. */ #define FONT_SLANT_NUMERIC(font) \ (FIXNUMP (AREF ((font), FONT_SLANT_INDEX)) \ - ? (XINT (AREF ((font), FONT_SLANT_INDEX)) >> 8) : -1) + ? (XFIXNUM (AREF ((font), FONT_SLANT_INDEX)) >> 8) : -1) /* Return the numeric width value of FONT. */ #define FONT_WIDTH_NUMERIC(font) \ (FIXNUMP (AREF ((font), FONT_WIDTH_INDEX)) \ - ? (XINT (AREF ((font), FONT_WIDTH_INDEX)) >> 8) : -1) + ? (XFIXNUM (AREF ((font), FONT_WIDTH_INDEX)) >> 8) : -1) /* Return the symbolic weight value of FONT. */ #define FONT_WEIGHT_SYMBOLIC(font) \ font_style_symbolic (font, FONT_WEIGHT_INDEX, false) diff --git a/src/fontset.c b/src/fontset.c index d4a2e4ea5b..0dbc54efd0 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -276,7 +276,7 @@ set_fontset_fallback (Lisp_Object fontset, Lisp_Object fallback) the order of listing by font backends, the higher bits represents the order given by charset priority list. The smaller value is preferable. */ -#define RFONT_DEF_SCORE(rfont_def) XINT (AREF (rfont_def, 3)) +#define RFONT_DEF_SCORE(rfont_def) XFIXNUM (AREF (rfont_def, 3)) #define RFONT_DEF_SET_SCORE(rfont_def, score) \ ASET ((rfont_def), 3, make_fixnum (score)) #define RFONT_DEF_NEW(rfont_def, font_def) \ @@ -344,8 +344,8 @@ fontset_add (Lisp_Object fontset, Lisp_Object range, Lisp_Object elt, Lisp_Objec if (CONSP (range)) { - int from = XINT (XCAR (range)); - int to = XINT (XCDR (range)); + int from = XFIXNUM (XCAR (range)); + int to = XFIXNUM (XCDR (range)); int from1, to1; do { @@ -561,7 +561,7 @@ fontset_find_font (Lisp_Object fontset, int c, struct face *face, if (ASIZE (vec) > 1) { - if (XINT (XCAR (font_group)) != charset_ordered_list_tick) + if (XFIXNUM (XCAR (font_group)) != charset_ordered_list_tick) /* We have just created the font-group, or the charset priorities were changed. */ reorder_font_vector (font_group, face->ascii_face->font); @@ -577,7 +577,7 @@ fontset_find_font (Lisp_Object fontset, int c, struct face *face, break; repertory = FONT_DEF_REPERTORY (RFONT_DEF_FONT_DEF (rfont_def)); - if (XINT (repertory) == charset_id) + if (XFIXNUM (repertory) == charset_id) { charset_matched = i; break; @@ -634,7 +634,7 @@ fontset_find_font (Lisp_Object fontset, int c, struct face *face, return Qt; } if (FIXNUMP (RFONT_DEF_FACE (rfont_def)) - && XINT (RFONT_DEF_FACE (rfont_def)) < 0) + && XFIXNUM (RFONT_DEF_FACE (rfont_def)) < 0) /* We couldn't open this font last time. */ continue; @@ -892,7 +892,7 @@ free_face_fontset (struct frame *f, struct face *face) next_fontset_id = face->fontset; if (! NILP (FONTSET_DEFAULT (fontset))) { - int id = XINT (FONTSET_ID (FONTSET_DEFAULT (fontset))); + int id = XFIXNUM (FONTSET_ID (FONTSET_DEFAULT (fontset))); fontset = AREF (Vfontset_table, id); eassert (!NILP (fontset) && ! BASE_FONTSET_P (fontset)); @@ -981,7 +981,7 @@ face_for_char (struct frame *f, struct face *face, int c, val = assq_no_quit (charset, Vfont_encoding_charset_alist); if (CONSP (val) && CHARSETP (XCDR (val))) charset = XCDR (val); - id = XINT (CHARSET_SYMBOL_ID (charset)); + id = XFIXNUM (CHARSET_SYMBOL_ID (charset)); } else id = -1; @@ -991,7 +991,7 @@ face_for_char (struct frame *f, struct face *face, int c, if (VECTORP (rfont_def)) { if (FIXNUMP (RFONT_DEF_FACE (rfont_def))) - face_id = XINT (RFONT_DEF_FACE (rfont_def)); + face_id = XFIXNUM (RFONT_DEF_FACE (rfont_def)); else { Lisp_Object font_object; @@ -1004,7 +1004,7 @@ face_for_char (struct frame *f, struct face *face, int c, else { if (FIXNUMP (FONTSET_NOFONT_FACE (fontset))) - face_id = XINT (FONTSET_NOFONT_FACE (fontset)); + face_id = XFIXNUM (FONTSET_NOFONT_FACE (fontset)); else { face_id = face_for_font (f, Qnil, face); @@ -1048,7 +1048,7 @@ font_for_char (struct face *face, int c, ptrdiff_t pos, Lisp_Object object) val = assq_no_quit (charset, Vfont_encoding_charset_alist); if (CONSP (val) && CHARSETP (XCDR (val))) charset = XCDR (val); - id = XINT (CHARSET_SYMBOL_ID (charset)); + id = XFIXNUM (CHARSET_SYMBOL_ID (charset)); } else id = -1; @@ -1083,7 +1083,7 @@ make_fontset_for_ascii_face (struct frame *f, int base_fontset_id, struct face * base_fontset = Vdefault_fontset; fontset = make_fontset (frame, Qnil, base_fontset); - return XINT (FONTSET_ID (fontset)); + return XFIXNUM (FONTSET_ID (fontset)); } @@ -1306,7 +1306,7 @@ free_realized_fontsets (Lisp_Object base) tail = XCDR (tail)) { struct frame *f = XFRAME (FONTSET_FRAME (this)); - int face_id = XINT (XCDR (XCAR (tail))); + int face_id = XFIXNUM (XCDR (XCAR (tail))); struct face *face = FACE_FROM_ID_OR_NULL (f, face_id); /* Face THIS itself is also freed by the following call. */ @@ -1399,7 +1399,7 @@ static void set_fontset_font (Lisp_Object arg, Lisp_Object range) { Lisp_Object fontset, font_def, add, ascii, script_range_list; - int from = XINT (XCAR (range)), to = XINT (XCDR (range)); + int from = XFIXNUM (XCAR (range)), to = XFIXNUM (XCDR (range)); fontset = AREF (arg, 0); font_def = AREF (arg, 1); @@ -1415,8 +1415,8 @@ set_fontset_font (Lisp_Object arg, Lisp_Object range) range = Fcons (make_fixnum (0x80), XCDR (range)); } -#define SCRIPT_FROM XINT (XCAR (XCAR (script_range_list))) -#define SCRIPT_TO XINT (XCDR (XCAR (script_range_list))) +#define SCRIPT_FROM XFIXNUM (XCAR (XCAR (script_range_list))) +#define SCRIPT_TO XFIXNUM (XCDR (XCAR (script_range_list))) #define POP_SCRIPT_RANGE() script_range_list = XCDR (script_range_list) for (; CONSP (script_range_list) && SCRIPT_TO < from; POP_SCRIPT_RANGE ()) @@ -1544,7 +1544,7 @@ appended. By default, FONT-SPEC overrides the previous settings. */) if (CHARACTERP (target)) { - if (XFASTINT (target) < 0x80) + if (XFIXNAT (target) < 0x80) error ("Can't set a font for partial ASCII range"); range_list = list1 (Fcons (target, target)); } @@ -1556,9 +1556,9 @@ appended. By default, FONT-SPEC overrides the previous settings. */) to = Fcdr (target); CHECK_CHARACTER (from); CHECK_CHARACTER (to); - if (XFASTINT (from) < 0x80) + if (XFIXNAT (from) < 0x80) { - if (XFASTINT (from) != 0 || XFASTINT (to) < 0x7F) + if (XFIXNAT (from) != 0 || XFIXNAT (to) < 0x7F) error ("Can't set a font for partial ASCII range"); ascii_changed = 1; } @@ -1629,7 +1629,7 @@ appended. By default, FONT-SPEC overrides the previous settings. */) if (ascii_changed) { Lisp_Object tail, fr; - int fontset_id = XINT (FONTSET_ID (fontset)); + int fontset_id = XFIXNUM (FONTSET_ID (fontset)); set_fontset_ascii (fontset, fontname); name = FONTSET_NAME (fontset); @@ -1762,7 +1762,7 @@ fontset_from_font (Lisp_Object font_object) val = assoc_no_quit (font_spec, auto_fontset_alist); if (CONSP (val)) - return XINT (FONTSET_ID (XCDR (val))); + return XFIXNUM (FONTSET_ID (XCDR (val))); if (num_auto_fontsets++ == 0) alias = intern ("fontset-startup"); else @@ -1797,7 +1797,7 @@ fontset_from_font (Lisp_Object font_object) set_fontset_ascii (fontset, font_name); - return XINT (FONTSET_ID (fontset)); + return XFIXNUM (FONTSET_ID (fontset)); } @@ -1985,7 +1985,7 @@ patterns. */) fontset = check_fontset_name (name, &frame); CHECK_CHARACTER (ch); - c = XINT (ch); + c = XFIXNUM (ch); list = Qnil; while (1) { @@ -2002,7 +2002,7 @@ patterns. */) repertory = AREF (val, 1); if (FIXNUMP (repertory)) { - struct charset *charset = CHARSET_FROM_ID (XINT (repertory)); + struct charset *charset = CHARSET_FROM_ID (XFIXNUM (repertory)); if (! CHAR_CHARSET_P (c, charset)) continue; diff --git a/src/frame.c b/src/frame.c index e13b392eca..c2e3d4b619 100644 --- a/src/frame.c +++ b/src/frame.c @@ -159,9 +159,9 @@ frame_size_history_add (struct frame *f, Lisp_Object fun_symbol, XSETFRAME (frame, f); if (CONSP (frame_size_history) && FIXNUMP (XCAR (frame_size_history)) - && 0 < XINT (XCAR (frame_size_history))) + && 0 < XFIXNUM (XCAR (frame_size_history))) frame_size_history = - Fcons (make_fixnum (XINT (XCAR (frame_size_history)) - 1), + Fcons (make_fixnum (XFIXNUM (XCAR (frame_size_history)) - 1), Fcons (list4 (frame, fun_symbol, ((width > 0) @@ -220,7 +220,7 @@ set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) return; if (TYPE_RANGED_FIXNUMP (int, value)) - nlines = XINT (value); + nlines = XFIXNUM (value); else nlines = 0; @@ -359,7 +359,7 @@ frame_windows_min_size (Lisp_Object frame, Lisp_Object horizontal, || (NILP (horizontal) && FIXED_OR_FLOATP (par_size = get_frame_param (f, Qmin_height)))) { - int min_size = XINT (par_size); + int min_size = XFIXNUM (par_size); /* Don't allow phantom frames. */ if (min_size < 1) @@ -372,7 +372,7 @@ frame_windows_min_size (Lisp_Object frame, Lisp_Object horizontal, : FRAME_COLUMN_WIDTH (f))); } else - retval = XINT (call4 (Qframe_windows_min_size, frame, horizontal, + retval = XFIXNUM (call4 (Qframe_windows_min_size, frame, horizontal, ignore, pixelwise)); /* Don't allow too small height of text-mode frames, or else cm.c might abort in cmcheckmagic. */ @@ -1598,7 +1598,7 @@ candidate_frame (Lisp_Object candidate, Lisp_Object frame, Lisp_Object minibuf) FRAME_FOCUS_FRAME (c))) return candidate; } - else if (FIXNUMP (minibuf) && XINT (minibuf) == 0) + else if (FIXNUMP (minibuf) && XFIXNUM (minibuf) == 0) { if (FRAME_VISIBLE_P (c) || FRAME_ICONIFIED_P (c)) return candidate; @@ -2320,8 +2320,8 @@ and returns whatever that function returns. */) if (! NILP (x)) { - int col = XINT (x); - int row = XINT (y); + int col = XFIXNUM (x); + int row = XFIXNUM (y); pixel_to_glyph_coords (f, col, row, &col, &row, NULL, 1); XSETINT (x, col); XSETINT (y, row); @@ -2430,19 +2430,19 @@ before calling this function on it, like this. #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (XFRAME (frame))) /* Warping the mouse will cause enternotify and focus events. */ - frame_set_mouse_position (XFRAME (frame), XINT (x), XINT (y)); + frame_set_mouse_position (XFRAME (frame), XFIXNUM (x), XFIXNUM (y)); #else #if defined (MSDOS) if (FRAME_MSDOS_P (XFRAME (frame))) { Fselect_frame (frame, Qnil); - mouse_moveto (XINT (x), XINT (y)); + mouse_moveto (XFIXNUM (x), XFIXNUM (y)); } #else #ifdef HAVE_GPM { Fselect_frame (frame, Qnil); - term_mouse_moveto (XINT (x), XINT (y)); + term_mouse_moveto (XFIXNUM (x), XFIXNUM (y)); } #endif #endif @@ -2471,19 +2471,19 @@ before calling this function on it, like this. #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (XFRAME (frame))) /* Warping the mouse will cause enternotify and focus events. */ - frame_set_mouse_pixel_position (XFRAME (frame), XINT (x), XINT (y)); + frame_set_mouse_pixel_position (XFRAME (frame), XFIXNUM (x), XFIXNUM (y)); #else #if defined (MSDOS) if (FRAME_MSDOS_P (XFRAME (frame))) { Fselect_frame (frame, Qnil); - mouse_moveto (XINT (x), XINT (y)); + mouse_moveto (XFIXNUM (x), XFIXNUM (y)); } #else #ifdef HAVE_GPM { Fselect_frame (frame, Qnil); - term_mouse_moveto (XINT (x), XINT (y)); + term_mouse_moveto (XFIXNUM (x), XFIXNUM (y)); } #endif #endif @@ -3193,7 +3193,7 @@ list, but are otherwise ignored. */) #endif { - EMACS_INT length = XFASTINT (Flength (alist)); + EMACS_INT length = XFIXNAT (Flength (alist)); ptrdiff_t i; Lisp_Object *parms; Lisp_Object *values; @@ -3428,8 +3428,8 @@ multiple of the default frame font height. */) CHECK_TYPE_RANGED_INTEGER (int, height); pixel_height = (!NILP (pixelwise) - ? XINT (height) - : XINT (height) * FRAME_LINE_HEIGHT (f)); + ? XFIXNUM (height) + : XFIXNUM (height) * FRAME_LINE_HEIGHT (f)); adjust_frame_size (f, -1, pixel_height, 1, !NILP (pretend), Qheight); return Qnil; @@ -3453,8 +3453,8 @@ multiple of the default frame font width. */) CHECK_TYPE_RANGED_INTEGER (int, width); pixel_width = (!NILP (pixelwise) - ? XINT (width) - : XINT (width) * FRAME_COLUMN_WIDTH (f)); + ? XFIXNUM (width) + : XFIXNUM (width) * FRAME_COLUMN_WIDTH (f)); adjust_frame_size (f, pixel_width, -1, 1, !NILP (pretend), Qwidth); return Qnil; @@ -3476,11 +3476,11 @@ font height. */) CHECK_TYPE_RANGED_INTEGER (int, height); pixel_width = (!NILP (pixelwise) - ? XINT (width) - : XINT (width) * FRAME_COLUMN_WIDTH (f)); + ? XFIXNUM (width) + : XFIXNUM (width) * FRAME_COLUMN_WIDTH (f)); pixel_height = (!NILP (pixelwise) - ? XINT (height) - : XINT (height) * FRAME_LINE_HEIGHT (f)); + ? XFIXNUM (height) + : XFIXNUM (height) * FRAME_LINE_HEIGHT (f)); adjust_frame_size (f, pixel_width, pixel_height, 1, 0, Qsize); return Qnil; @@ -3520,7 +3520,7 @@ bottom edge of FRAME's display. */) if (FRAME_WINDOW_P (f)) { #ifdef HAVE_WINDOW_SYSTEM - x_set_offset (f, XINT (x), XINT (y), 1); + x_set_offset (f, XFIXNUM (x), XFIXNUM (y), 1); #endif } @@ -3689,10 +3689,10 @@ frame_float (struct frame *f, Lisp_Object val, enum frame_float_type what, } /* Workarea available. */ - parent_left = XINT (Fnth (make_fixnum (0), workarea)); - parent_top = XINT (Fnth (make_fixnum (1), workarea)); - parent_width = XINT (Fnth (make_fixnum (2), workarea)); - parent_height = XINT (Fnth (make_fixnum (3), workarea)); + parent_left = XFIXNUM (Fnth (make_fixnum (0), workarea)); + parent_top = XFIXNUM (Fnth (make_fixnum (1), workarea)); + parent_width = XFIXNUM (Fnth (make_fixnum (2), workarea)); + parent_height = XFIXNUM (Fnth (make_fixnum (3), workarea)); *parent_done = 1; } } @@ -3720,12 +3720,12 @@ frame_float (struct frame *f, Lisp_Object val, enum frame_float_type what, if (!NILP (outer_edges)) { outer_minus_text_width - = (XINT (Fnth (make_fixnum (2), outer_edges)) - - XINT (Fnth (make_fixnum (0), outer_edges)) + = (XFIXNUM (Fnth (make_fixnum (2), outer_edges)) + - XFIXNUM (Fnth (make_fixnum (0), outer_edges)) - FRAME_TEXT_WIDTH (f)); outer_minus_text_height - = (XINT (Fnth (make_fixnum (3), outer_edges)) - - XINT (Fnth (make_fixnum (1), outer_edges)) + = (XFIXNUM (Fnth (make_fixnum (3), outer_edges)) + - XFIXNUM (Fnth (make_fixnum (1), outer_edges)) - FRAME_TEXT_HEIGHT (f)); } else @@ -3875,10 +3875,10 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist) if (EQ (prop, Qwidth)) { if (RANGED_FIXNUMP (0, val, INT_MAX)) - width = XFASTINT (val) * FRAME_COLUMN_WIDTH (f) ; + width = XFIXNAT (val) * FRAME_COLUMN_WIDTH (f) ; else if (CONSP (val) && EQ (XCAR (val), Qtext_pixels) && RANGED_FIXNUMP (0, XCDR (val), INT_MAX)) - width = XFASTINT (XCDR (val)); + width = XFIXNAT (XCDR (val)); else if (FLOATP (val)) width = frame_float (f, val, FRAME_FLOAT_WIDTH, &parent_done, &outer_done, -1); @@ -3886,10 +3886,10 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist) else if (EQ (prop, Qheight)) { if (RANGED_FIXNUMP (0, val, INT_MAX)) - height = XFASTINT (val) * FRAME_LINE_HEIGHT (f); + height = XFIXNAT (val) * FRAME_LINE_HEIGHT (f); else if (CONSP (val) && EQ (XCAR (val), Qtext_pixels) && RANGED_FIXNUMP (0, XCDR (val), INT_MAX)) - height = XFASTINT (XCDR (val)); + height = XFIXNAT (XCDR (val)); else if (FLOATP (val)) height = frame_float (f, val, FRAME_FLOAT_HEIGHT, &parent_done, &outer_done, -1); @@ -3917,9 +3917,9 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist) param_index = Fget (prop, Qx_frame_parameter); if (FIXNATP (param_index) - && XFASTINT (param_index) < ARRAYELTS (frame_parms) - && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)]) - (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value); + && XFIXNAT (param_index) < ARRAYELTS (frame_parms) + && FRAME_RIF (f)->frame_parm_handlers[XFIXNUM (param_index)]) + (*(FRAME_RIF (f)->frame_parm_handlers[XFIXNUM (param_index)])) (f, val, old_value); } } @@ -3981,8 +3981,8 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist) if ((!NILP (left) || !NILP (top)) && ! (left_no_change && top_no_change) - && ! (FIXED_OR_FLOATP (left) && XINT (left) == f->left_pos - && FIXED_OR_FLOATP (top) && XINT (top) == f->top_pos)) + && ! (FIXED_OR_FLOATP (left) && XFIXNUM (left) == f->left_pos + && FIXED_OR_FLOATP (top) && XFIXNUM (top) == f->top_pos)) { int leftpos = 0; int toppos = 0; @@ -3993,7 +3993,7 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist) f->size_hint_flags |= XNegative; else if (TYPE_RANGED_FIXNUMP (int, left)) { - leftpos = XINT (left); + leftpos = XFIXNUM (left); if (leftpos < 0) f->size_hint_flags |= XNegative; } @@ -4001,13 +4001,13 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist) && CONSP (XCDR (left)) && RANGED_FIXNUMP (-INT_MAX, XCAR (XCDR (left)), INT_MAX)) { - leftpos = - XINT (XCAR (XCDR (left))); + leftpos = - XFIXNUM (XCAR (XCDR (left))); f->size_hint_flags |= XNegative; } else if (CONSP (left) && EQ (XCAR (left), Qplus) && CONSP (XCDR (left)) && TYPE_RANGED_FIXNUMP (int, XCAR (XCDR (left)))) - leftpos = XINT (XCAR (XCDR (left))); + leftpos = XFIXNUM (XCAR (XCDR (left))); else if (FLOATP (left)) leftpos = frame_float (f, left, FRAME_FLOAT_LEFT, &parent_done, &outer_done, 0); @@ -4016,7 +4016,7 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist) f->size_hint_flags |= YNegative; else if (TYPE_RANGED_FIXNUMP (int, top)) { - toppos = XINT (top); + toppos = XFIXNUM (top); if (toppos < 0) f->size_hint_flags |= YNegative; } @@ -4024,13 +4024,13 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist) && CONSP (XCDR (top)) && RANGED_FIXNUMP (-INT_MAX, XCAR (XCDR (top)), INT_MAX)) { - toppos = - XINT (XCAR (XCDR (top))); + toppos = - XFIXNUM (XCAR (XCDR (top))); f->size_hint_flags |= YNegative; } else if (CONSP (top) && EQ (XCAR (top), Qplus) && CONSP (XCDR (top)) && TYPE_RANGED_FIXNUMP (int, XCAR (XCDR (top)))) - toppos = XINT (XCAR (XCDR (top))); + toppos = XFIXNUM (XCAR (XCDR (top))); else if (FLOATP (top)) toppos = frame_float (f, top, FRAME_FLOAT_TOP, &parent_done, &outer_done, 0); @@ -4061,7 +4061,7 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist) #ifdef HAVE_X_WINDOWS if ((!NILP (icon_left) || !NILP (icon_top)) && ! (icon_left_no_change && icon_top_no_change)) - x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top)); + x_wm_set_icon_position (f, XFIXNUM (icon_left), XFIXNUM (icon_top)); #endif /* HAVE_X_WINDOWS */ SAFE_FREE (); @@ -4188,7 +4188,7 @@ x_set_line_spacing (struct frame *f, Lisp_Object new_value, Lisp_Object old_valu if (NILP (new_value)) f->extra_line_spacing = 0; else if (RANGED_FIXNUMP (0, new_value, INT_MAX)) - f->extra_line_spacing = XFASTINT (new_value); + f->extra_line_spacing = XFIXNAT (new_value); else if (FLOATP (new_value)) { int new_spacing = XFLOAT_DATA (new_value) * FRAME_LINE_HEIGHT (f) + 0.5; @@ -4227,9 +4227,9 @@ x_set_screen_gamma (struct frame *f, Lisp_Object new_value, Lisp_Object old_valu { Lisp_Object parm_index = Fget (Qbackground_color, Qx_frame_parameter); if (FIXNATP (parm_index) - && XFASTINT (parm_index) < ARRAYELTS (frame_parms) - && FRAME_RIF (f)->frame_parm_handlers[XFASTINT (parm_index)]) - (*FRAME_RIF (f)->frame_parm_handlers[XFASTINT (parm_index)]) + && XFIXNAT (parm_index) < ARRAYELTS (frame_parms) + && FRAME_RIF (f)->frame_parm_handlers[XFIXNAT (parm_index)]) + (*FRAME_RIF (f)->frame_parm_handlers[XFIXNAT (parm_index)]) (f, bgcolor, Qnil); } @@ -4415,7 +4415,7 @@ x_set_left_fringe (struct frame *f, Lisp_Object new_value, Lisp_Object old_value int new_width; new_width = (RANGED_FIXNUMP (-INT_MAX, new_value, INT_MAX) - ? eabs (XINT (new_value)) : 8); + ? eabs (XFIXNUM (new_value)) : 8); if (new_width != old_width) { @@ -4439,7 +4439,7 @@ x_set_right_fringe (struct frame *f, Lisp_Object new_value, Lisp_Object old_valu int new_width; new_width = (RANGED_FIXNUMP (-INT_MAX, new_value, INT_MAX) - ? eabs (XINT (new_value)) : 8); + ? eabs (XFIXNUM (new_value)) : 8); if (new_width != old_width) { @@ -4460,13 +4460,13 @@ x_set_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { CHECK_TYPE_RANGED_INTEGER (int, arg); - if (XINT (arg) == f->border_width) + if (XFIXNUM (arg) == f->border_width) return; if (FRAME_X_WINDOW (f) != 0) error ("Cannot change the border width of a frame"); - f->border_width = XINT (arg); + f->border_width = XFIXNUM (arg); } void @@ -4474,7 +4474,7 @@ x_set_right_divider_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { int old = FRAME_RIGHT_DIVIDER_WIDTH (f); CHECK_TYPE_RANGED_INTEGER (int, arg); - int new = max (0, XINT (arg)); + int new = max (0, XFIXNUM (arg)); if (new != old) { f->right_divider_width = new; @@ -4489,7 +4489,7 @@ x_set_bottom_divider_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval { int old = FRAME_BOTTOM_DIVIDER_WIDTH (f); CHECK_TYPE_RANGED_INTEGER (int, arg); - int new = max (0, XINT (arg)); + int new = max (0, XFIXNUM (arg)); if (new != old) { f->bottom_divider_width = new; @@ -4599,10 +4599,10 @@ x_set_scroll_bar_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval) SET_FRAME_GARBAGED (f); } else if (RANGED_FIXNUMP (1, arg, INT_MAX) - && XFASTINT (arg) != FRAME_CONFIG_SCROLL_BAR_WIDTH (f)) + && XFIXNAT (arg) != FRAME_CONFIG_SCROLL_BAR_WIDTH (f)) { - FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = XFASTINT (arg); - FRAME_CONFIG_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + unit - 1) / unit; + FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = XFIXNAT (arg); + FRAME_CONFIG_SCROLL_BAR_COLS (f) = (XFIXNAT (arg) + unit - 1) / unit; if (FRAME_X_WINDOW (f)) adjust_frame_size (f, -1, -1, 3, 0, Qscroll_bar_width); @@ -4629,10 +4629,10 @@ x_set_scroll_bar_height (struct frame *f, Lisp_Object arg, Lisp_Object oldval) SET_FRAME_GARBAGED (f); } else if (RANGED_FIXNUMP (1, arg, INT_MAX) - && XFASTINT (arg) != FRAME_CONFIG_SCROLL_BAR_HEIGHT (f)) + && XFIXNAT (arg) != FRAME_CONFIG_SCROLL_BAR_HEIGHT (f)) { - FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) = XFASTINT (arg); - FRAME_CONFIG_SCROLL_BAR_LINES (f) = (XFASTINT (arg) + unit - 1) / unit; + FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) = XFIXNAT (arg); + FRAME_CONFIG_SCROLL_BAR_LINES (f) = (XFIXNAT (arg) + unit - 1) / unit; if (FRAME_X_WINDOW (f)) adjust_frame_size (f, -1, -1, 3, 0, Qscroll_bar_height); @@ -4673,7 +4673,7 @@ x_set_alpha (struct frame *f, Lisp_Object arg, Lisp_Object oldval) } else if (FIXNUMP (item)) { - EMACS_INT ialpha = XINT (item); + EMACS_INT ialpha = XFIXNUM (item); if (! (0 <= ialpha && ialpha <= 100)) args_out_of_range (make_fixnum (0), make_fixnum (100)); alpha = ialpha / 100.0; @@ -5303,10 +5303,10 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x : DEFAULT_TOOL_BAR_BUTTON_RELIEF); if (RANGED_FIXNUMP (1, Vtool_bar_button_margin, INT_MAX)) - margin = XFASTINT (Vtool_bar_button_margin); + margin = XFIXNAT (Vtool_bar_button_margin); else if (CONSP (Vtool_bar_button_margin) && RANGED_FIXNUMP (1, XCDR (Vtool_bar_button_margin), INT_MAX)) - margin = XFASTINT (XCDR (Vtool_bar_button_margin)); + margin = XFIXNAT (XCDR (Vtool_bar_button_margin)); else margin = 0; @@ -5328,12 +5328,12 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x if (CONSP (width) && EQ (XCAR (width), Qtext_pixels)) { CHECK_FIXNUM (XCDR (width)); - if ((XINT (XCDR (width)) < 0 || XINT (XCDR (width)) > INT_MAX)) + if ((XFIXNUM (XCDR (width)) < 0 || XFIXNUM (XCDR (width)) > INT_MAX)) xsignal1 (Qargs_out_of_range, XCDR (width)); - SET_FRAME_WIDTH (f, XINT (XCDR (width))); + SET_FRAME_WIDTH (f, XFIXNUM (XCDR (width))); f->inhibit_horizontal_resize = true; - *x_width = XINT (XCDR (width)); + *x_width = XFIXNUM (XCDR (width)); } else if (FLOATP (width)) { @@ -5353,10 +5353,10 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x else { CHECK_FIXNUM (width); - if ((XINT (width) < 0 || XINT (width) > INT_MAX)) + if ((XFIXNUM (width) < 0 || XFIXNUM (width) > INT_MAX)) xsignal1 (Qargs_out_of_range, width); - SET_FRAME_WIDTH (f, XINT (width) * FRAME_COLUMN_WIDTH (f)); + SET_FRAME_WIDTH (f, XFIXNUM (width) * FRAME_COLUMN_WIDTH (f)); } } @@ -5365,12 +5365,12 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x if (CONSP (height) && EQ (XCAR (height), Qtext_pixels)) { CHECK_FIXNUM (XCDR (height)); - if ((XINT (XCDR (height)) < 0 || XINT (XCDR (height)) > INT_MAX)) + if ((XFIXNUM (XCDR (height)) < 0 || XFIXNUM (XCDR (height)) > INT_MAX)) xsignal1 (Qargs_out_of_range, XCDR (height)); - SET_FRAME_HEIGHT (f, XINT (XCDR (height))); + SET_FRAME_HEIGHT (f, XFIXNUM (XCDR (height))); f->inhibit_vertical_resize = true; - *x_height = XINT (XCDR (height)); + *x_height = XFIXNUM (XCDR (height)); } else if (FLOATP (height)) { @@ -5390,10 +5390,10 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x else { CHECK_FIXNUM (height); - if ((XINT (height) < 0) || (XINT (height) > INT_MAX)) + if ((XFIXNUM (height) < 0) || (XFIXNUM (height) > INT_MAX)) xsignal1 (Qargs_out_of_range, height); - SET_FRAME_HEIGHT (f, XINT (height) * FRAME_LINE_HEIGHT (f)); + SET_FRAME_HEIGHT (f, XFIXNUM (height) * FRAME_LINE_HEIGHT (f)); } } @@ -5418,14 +5418,14 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x && CONSP (XCDR (top)) && RANGED_FIXNUMP (-INT_MAX, XCAR (XCDR (top)), INT_MAX)) { - f->top_pos = - XINT (XCAR (XCDR (top))); + f->top_pos = - XFIXNUM (XCAR (XCDR (top))); window_prompting |= YNegative; } else if (CONSP (top) && EQ (XCAR (top), Qplus) && CONSP (XCDR (top)) && TYPE_RANGED_FIXNUMP (int, XCAR (XCDR (top)))) { - f->top_pos = XINT (XCAR (XCDR (top))); + f->top_pos = XFIXNUM (XCAR (XCDR (top))); } else if (FLOATP (top)) f->top_pos = frame_float (f, top, FRAME_FLOAT_TOP, &parent_done, @@ -5435,7 +5435,7 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x else { CHECK_TYPE_RANGED_INTEGER (int, top); - f->top_pos = XINT (top); + f->top_pos = XFIXNUM (top); if (f->top_pos < 0) window_prompting |= YNegative; } @@ -5449,14 +5449,14 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x && CONSP (XCDR (left)) && RANGED_FIXNUMP (-INT_MAX, XCAR (XCDR (left)), INT_MAX)) { - f->left_pos = - XINT (XCAR (XCDR (left))); + f->left_pos = - XFIXNUM (XCAR (XCDR (left))); window_prompting |= XNegative; } else if (CONSP (left) && EQ (XCAR (left), Qplus) && CONSP (XCDR (left)) && TYPE_RANGED_FIXNUMP (int, XCAR (XCDR (left)))) { - f->left_pos = XINT (XCAR (XCDR (left))); + f->left_pos = XFIXNUM (XCAR (XCDR (left))); } else if (FLOATP (left)) f->left_pos = frame_float (f, left, FRAME_FLOAT_LEFT, &parent_done, @@ -5466,7 +5466,7 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x else { CHECK_TYPE_RANGED_INTEGER (int, left); - f->left_pos = XINT (left); + f->left_pos = XFIXNUM (left); if (f->left_pos < 0) window_prompting |= XNegative; } diff --git a/src/frame.h b/src/frame.h index 03e23027ec..87d0d5a341 100644 --- a/src/frame.h +++ b/src/frame.h @@ -1361,7 +1361,7 @@ FRAME_BOTTOM_DIVIDER_WIDTH (struct frame *f) float. Value is a C integer. */ #define FRAME_PIXEL_X_FROM_CANON_X(F, X) \ (FIXNUMP (X) \ - ? XINT (X) * FRAME_COLUMN_WIDTH (F) \ + ? XFIXNUM (X) * FRAME_COLUMN_WIDTH (F) \ : (int) (XFLOAT_DATA (X) * FRAME_COLUMN_WIDTH (F))) /* Convert canonical value Y to pixels. F is the frame whose @@ -1369,7 +1369,7 @@ FRAME_BOTTOM_DIVIDER_WIDTH (struct frame *f) or float. Value is a C integer. */ #define FRAME_PIXEL_Y_FROM_CANON_Y(F, Y) \ (FIXNUMP (Y) \ - ? XINT (Y) * FRAME_LINE_HEIGHT (F) \ + ? XFIXNUM (Y) * FRAME_LINE_HEIGHT (F) \ : (int) (XFLOAT_DATA (Y) * FRAME_LINE_HEIGHT (F))) /* Convert pixel-value X to canonical units. F is the frame whose diff --git a/src/fringe.c b/src/fringe.c index c1784c01b9..583bba4e51 100644 --- a/src/fringe.c +++ b/src/fringe.c @@ -491,7 +491,7 @@ lookup_fringe_bitmap (Lisp_Object bitmap) if (!FIXNUMP (bitmap)) return 0; - bn = XINT (bitmap); + bn = XFIXNUM (bitmap); if (bn > NO_FRINGE_BITMAP && bn < max_used_fringe_bitmap && (bn < MAX_STANDARD_FRINGE_BITMAPS @@ -743,7 +743,7 @@ get_logical_fringe_bitmap (struct window *w, Lisp_Object bitmap, int right_p, in return NO_FRINGE_BITMAP; if (CONSP (bm1)) { - ln1 = XINT (Flength (bm1)); + ln1 = XFIXNUM (Flength (bm1)); if (partial_p) { if (ln1 > ix2) @@ -778,7 +778,7 @@ get_logical_fringe_bitmap (struct window *w, Lisp_Object bitmap, int right_p, in { if (CONSP (bm2)) { - ln2 = XINT (Flength (bm2)); + ln2 = XFIXNUM (Flength (bm2)); if (partial_p) { if (ln2 > ix2) @@ -1510,7 +1510,7 @@ If BITMAP already exists, the existing definition is replaced. */) else { CHECK_FIXNUM (height); - fb.height = max (0, min (XINT (height), 255)); + fb.height = max (0, min (XFIXNUM (height), 255)); if (fb.height > h) { fill1 = (fb.height - h) / 2; @@ -1523,7 +1523,7 @@ If BITMAP already exists, the existing definition is replaced. */) else { CHECK_FIXNUM (width); - fb.width = max (0, min (XINT (width), 255)); + fb.width = max (0, min (XFIXNUM (width), 255)); } fb.period = 0; @@ -1605,7 +1605,7 @@ If BITMAP already exists, the existing definition is replaced. */) for (i = 0; i < h && j < fb.height; i++) { Lisp_Object elt = Faref (bits, make_fixnum (i)); - b[j++] = FIXED_OR_FLOATP (elt) ? XINT (elt) : 0; + b[j++] = FIXED_OR_FLOATP (elt) ? XFIXNUM (elt) : 0; } for (i = 0; i < fill2 && j < fb.height; i++) b[j++] = 0; @@ -1662,9 +1662,9 @@ Return nil if POS is not visible in WINDOW. */) if (!NILP (pos)) { CHECK_FIXNUM_COERCE_MARKER (pos); - if (! (BEGV <= XINT (pos) && XINT (pos) <= ZV)) + if (! (BEGV <= XFIXNUM (pos) && XFIXNUM (pos) <= ZV)) args_out_of_range (window, pos); - textpos = XINT (pos); + textpos = XFIXNUM (pos); } else if (w == XWINDOW (selected_window)) textpos = PT; diff --git a/src/ftcrfont.c b/src/ftcrfont.c index 425250e229..dc1a389c60 100644 --- a/src/ftcrfont.c +++ b/src/ftcrfont.c @@ -137,7 +137,7 @@ ftcrfont_open (struct frame *f, Lisp_Object entity, int pixel_size) FT_UInt size; block_input (); - size = XINT (AREF (entity, FONT_SIZE_INDEX)); + size = XFIXNUM (AREF (entity, FONT_SIZE_INDEX)); if (size == 0) size = pixel_size; font_object = font_build_object (VECSIZE (struct ftcrfont_info), diff --git a/src/ftfont.c b/src/ftfont.c index 741a592c0b..e83eff3ad0 100644 --- a/src/ftfont.c +++ b/src/ftfont.c @@ -390,7 +390,7 @@ ftfont_lookup_cache (Lisp_Object key, enum ftfont_cache_for cache_for) ? ! cache_data->ft_face : ! cache_data->fc_charset) { char *filename = SSDATA (XCAR (key)); - int idx = XINT (XCDR (key)); + int idx = XFIXNUM (XCDR (key)); if (cache_for == FTFONT_CACHE_FOR_FACE) { @@ -600,9 +600,9 @@ ftfont_get_open_type_spec (Lisp_Object otf_spec) continue; len = Flength (val); spec->features[i] = - (min (PTRDIFF_MAX, SIZE_MAX) / sizeof (int) < XINT (len) + (min (PTRDIFF_MAX, SIZE_MAX) / sizeof (int) < XFIXNUM (len) ? 0 - : malloc (XINT (len) * sizeof *spec->features[i])); + : malloc (XFIXNUM (len) * sizeof *spec->features[i])); if (! spec->features[i]) { if (i > 0 && spec->features[0]) @@ -647,9 +647,9 @@ ftfont_spec_pattern (Lisp_Object spec, char *otlayout, struct OpenTypeSpec **ots return NULL; if (FIXNUMP (AREF (spec, FONT_DPI_INDEX))) - dpi = XINT (AREF (spec, FONT_DPI_INDEX)); + dpi = XFIXNUM (AREF (spec, FONT_DPI_INDEX)); if (FIXNUMP (AREF (spec, FONT_AVGWIDTH_INDEX)) - && XINT (AREF (spec, FONT_AVGWIDTH_INDEX)) == 0) + && XFIXNUM (AREF (spec, FONT_AVGWIDTH_INDEX)) == 0) scalable = 1; registry = AREF (spec, FONT_REGISTRY_INDEX); @@ -687,7 +687,7 @@ ftfont_spec_pattern (Lisp_Object spec, char *otlayout, struct OpenTypeSpec **ots if (EQ (key, QCdpi)) { if (FIXNUMP (val)) - dpi = XINT (val); + dpi = XFIXNUM (val); } else if (EQ (key, QClang)) { @@ -735,7 +735,7 @@ ftfont_spec_pattern (Lisp_Object spec, char *otlayout, struct OpenTypeSpec **ots goto err; for (chars = XCDR (chars); CONSP (chars); chars = XCDR (chars)) if (CHARACTERP (XCAR (chars)) - && ! FcCharSetAddChar (charset, XFASTINT (XCAR (chars)))) + && ! FcCharSetAddChar (charset, XFIXNAT (XCAR (chars)))) goto err; } } @@ -833,7 +833,7 @@ ftfont_list (struct frame *f, Lisp_Object spec) val = Qnil; } if (FIXNUMP (AREF (spec, FONT_SPACING_INDEX))) - spacing = XINT (AREF (spec, FONT_SPACING_INDEX)); + spacing = XFIXNUM (AREF (spec, FONT_SPACING_INDEX)); family = AREF (spec, FONT_FAMILY_INDEX); if (! NILP (family)) { @@ -956,7 +956,7 @@ ftfont_list (struct frame *f, Lisp_Object spec) continue; for (j = 0; j < ASIZE (chars); j++) if (TYPE_RANGED_FIXNUMP (FcChar32, AREF (chars, j)) - && FcCharSetHasChar (charset, XFASTINT (AREF (chars, j)))) + && FcCharSetHasChar (charset, XFIXNAT (AREF (chars, j)))) break; if (j == ASIZE (chars)) continue; @@ -1021,7 +1021,7 @@ ftfont_match (struct frame *f, Lisp_Object spec) FcValue value; value.type = FcTypeDouble; - value.u.d = XINT (AREF (spec, FONT_SIZE_INDEX)); + value.u.d = XFIXNUM (AREF (spec, FONT_SIZE_INDEX)); FcPatternAdd (pattern, FC_PIXEL_SIZE, value, FcFalse); } if (FcConfigSubstitute (NULL, pattern, FcMatchPattern) == FcTrue) @@ -1130,7 +1130,7 @@ ftfont_open2 (struct frame *f, return Qnil; } } - size = XINT (AREF (entity, FONT_SIZE_INDEX)); + size = XFIXNUM (AREF (entity, FONT_SIZE_INDEX)); if (size == 0) size = pixel_size; if (FT_Set_Pixel_Sizes (ft_face, size, size) != 0) @@ -1148,7 +1148,7 @@ ftfont_open2 (struct frame *f, font = XFONT_OBJECT (font_object); ftfont_info = (struct ftfont_info *) font; ftfont_info->ft_size = ft_face->size; - ftfont_info->index = XINT (idx); + ftfont_info->index = XFIXNUM (idx); #ifdef HAVE_LIBOTF ftfont_info->maybe_otf = (ft_face->face_flags & FT_FACE_FLAG_SFNT) != 0; ftfont_info->otf = NULL; @@ -1161,7 +1161,7 @@ ftfont_open2 (struct frame *f, upEM = ft_face->units_per_EM; scalable = (FIXNUMP (AREF (entity, FONT_AVGWIDTH_INDEX)) - && XINT (AREF (entity, FONT_AVGWIDTH_INDEX)) == 0); + && XFIXNUM (AREF (entity, FONT_AVGWIDTH_INDEX)) == 0); if (scalable) { font->ascent = ft_face->ascender * size / upEM + 0.5; @@ -1175,7 +1175,7 @@ ftfont_open2 (struct frame *f, font->height = ft_face->size->metrics.height >> 6; } if (FIXNUMP (AREF (entity, FONT_SPACING_INDEX))) - spacing = XINT (AREF (entity, FONT_SPACING_INDEX)); + spacing = XFIXNUM (AREF (entity, FONT_SPACING_INDEX)); else spacing = FC_PROPORTIONAL; if (spacing != FC_PROPORTIONAL @@ -1233,7 +1233,7 @@ ftfont_open (struct frame *f, Lisp_Object entity, int pixel_size) { Lisp_Object font_object; FT_UInt size; - size = XINT (AREF (entity, FONT_SIZE_INDEX)); + size = XFIXNUM (AREF (entity, FONT_SIZE_INDEX)); if (size == 0) size = pixel_size; font_object = font_build_object (VECSIZE (struct ftfont_info), diff --git a/src/gfilenotify.c b/src/gfilenotify.c index 674ae069f6..7eea2cfac1 100644 --- a/src/gfilenotify.c +++ b/src/gfilenotify.c @@ -240,7 +240,7 @@ WATCH-DESCRIPTOR should be an object returned by `gfile-add-watch'. */) watch_descriptor); eassert (FIXNUMP (watch_descriptor)); - GFileMonitor *monitor = XINTPTR (watch_descriptor); + GFileMonitor *monitor = XFIXNUMPTR (watch_descriptor); if (!g_file_monitor_is_cancelled (monitor) && !g_file_monitor_cancel (monitor)) xsignal2 (Qfile_notify_error, build_string ("Could not rm watch"), @@ -271,7 +271,7 @@ invalid. */) return Qnil; else { - GFileMonitor *monitor = XINTPTR (watch_descriptor); + GFileMonitor *monitor = XFIXNUMPTR (watch_descriptor); return g_file_monitor_is_cancelled (monitor) ? Qnil : Qt; } } @@ -290,7 +290,7 @@ If WATCH-DESCRIPTOR is not valid, nil is returned. */) return Qnil; else { - GFileMonitor *monitor = XINTPTR (watch_descriptor); + GFileMonitor *monitor = XFIXNUMPTR (watch_descriptor); return intern (G_OBJECT_TYPE_NAME (monitor)); } } diff --git a/src/gnutls.c b/src/gnutls.c index 337b3d65ce..111dc61248 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -936,7 +936,7 @@ Usage: (gnutls-error-fatalp ERROR) */) if (! TYPE_RANGED_FIXNUMP (int, err)) error ("Not an error symbol or code"); - if (0 == gnutls_error_is_fatal (XINT (err))) + if (0 == gnutls_error_is_fatal (XFIXNUM (err))) return Qnil; return Qt; @@ -968,7 +968,7 @@ usage: (gnutls-error-string ERROR) */) if (! TYPE_RANGED_FIXNUMP (int, err)) return build_string ("Not an error symbol or code"); - return build_string (emacs_gnutls_strerror (XINT (err))); + return build_string (emacs_gnutls_strerror (XFIXNUM (err))); } DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0, @@ -1656,8 +1656,8 @@ one trustfile (usually a CA bundle). */) # ifdef HAVE_GNUTLS3 gnutls_global_set_audit_log_function (gnutls_audit_log_function); # endif - gnutls_global_set_log_level (XINT (loglevel)); - max_log_level = XINT (loglevel); + gnutls_global_set_log_level (XFIXNUM (loglevel)); + max_log_level = XFIXNUM (loglevel); XPROCESS (proc)->gnutls_log_level = max_log_level; } @@ -1692,7 +1692,7 @@ one trustfile (usually a CA bundle). */) verify_flags = Fplist_get (proplist, QCverify_flags); if (TYPE_RANGED_FIXNUMP (unsigned int, verify_flags)) { - gnutls_verify_flags = XFASTINT (verify_flags); + gnutls_verify_flags = XFIXNAT (verify_flags); GNUTLS_LOG (2, max_log_level, "setting verification flags"); } else if (NILP (verify_flags)) @@ -1852,7 +1852,7 @@ one trustfile (usually a CA bundle). */) GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_PRIORITY; if (FIXNUMP (prime_bits)) - gnutls_dh_set_prime_bits (state, XUINT (prime_bits)); + gnutls_dh_set_prime_bits (state, XUFIXNUM (prime_bits)); ret = EQ (type, Qgnutls_x509pki) ? gnutls_credentials_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred) @@ -2073,7 +2073,7 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher, if (SYMBOLP (cipher)) info = XCDR (Fassq (cipher, Fgnutls_ciphers ())); else if (TYPE_RANGED_FIXNUMP (gnutls_cipher_algorithm_t, cipher)) - gca = XINT (cipher); + gca = XFIXNUM (cipher); else info = cipher; @@ -2081,7 +2081,7 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher, { Lisp_Object v = Fplist_get (info, QCcipher_id); if (TYPE_RANGED_FIXNUMP (gnutls_cipher_algorithm_t, v)) - gca = XINT (v); + gca = XFIXNUM (v); } ptrdiff_t key_size = gnutls_cipher_get_key_size (gca); @@ -2344,7 +2344,7 @@ itself. */) if (SYMBOLP (hash_method)) info = XCDR (Fassq (hash_method, Fgnutls_macs ())); else if (TYPE_RANGED_FIXNUMP (gnutls_mac_algorithm_t, hash_method)) - gma = XINT (hash_method); + gma = XFIXNUM (hash_method); else info = hash_method; @@ -2352,7 +2352,7 @@ itself. */) { Lisp_Object v = Fplist_get (info, QCmac_algorithm_id); if (TYPE_RANGED_FIXNUMP (gnutls_mac_algorithm_t, v)) - gma = XINT (v); + gma = XFIXNUM (v); } ptrdiff_t digest_length = gnutls_hmac_get_len (gma); @@ -2425,7 +2425,7 @@ the number itself. */) if (SYMBOLP (digest_method)) info = XCDR (Fassq (digest_method, Fgnutls_digests ())); else if (TYPE_RANGED_FIXNUMP (gnutls_digest_algorithm_t, digest_method)) - gda = XINT (digest_method); + gda = XFIXNUM (digest_method); else info = digest_method; @@ -2433,7 +2433,7 @@ the number itself. */) { Lisp_Object v = Fplist_get (info, QCdigest_algorithm_id); if (TYPE_RANGED_FIXNUMP (gnutls_digest_algorithm_t, v)) - gda = XINT (v); + gda = XFIXNUM (v); } ptrdiff_t digest_length = gnutls_hash_get_len (gda); diff --git a/src/gtkutil.c b/src/gtkutil.c index 79b453d2a5..4250355a2f 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -4296,7 +4296,7 @@ xg_print_frames_dialog (Lisp_Object frames) gtk_print_operation_set_print_settings (print, print_settings); if (page_setup != NULL) gtk_print_operation_set_default_page_setup (print, page_setup); - gtk_print_operation_set_n_pages (print, XINT (Flength (frames))); + gtk_print_operation_set_n_pages (print, XFIXNUM (Flength (frames))); g_signal_connect (print, "draw-page", G_CALLBACK (draw_page), &frames); res = gtk_print_operation_run (print, GTK_PRINT_OPERATION_ACTION_PRINT_DIALOG, NULL, NULL); @@ -4891,16 +4891,16 @@ update_frame_tool_bar (struct frame *f) if (RANGED_FIXNUMP (1, Vtool_bar_button_margin, INT_MAX)) { - hmargin = XFASTINT (Vtool_bar_button_margin); - vmargin = XFASTINT (Vtool_bar_button_margin); + hmargin = XFIXNAT (Vtool_bar_button_margin); + vmargin = XFIXNAT (Vtool_bar_button_margin); } else if (CONSP (Vtool_bar_button_margin)) { if (RANGED_FIXNUMP (1, XCAR (Vtool_bar_button_margin), INT_MAX)) - hmargin = XFASTINT (XCAR (Vtool_bar_button_margin)); + hmargin = XFIXNAT (XCAR (Vtool_bar_button_margin)); if (RANGED_FIXNUMP (1, XCDR (Vtool_bar_button_margin), INT_MAX)) - vmargin = XFASTINT (XCDR (Vtool_bar_button_margin)); + vmargin = XFIXNAT (XCDR (Vtool_bar_button_margin)); } /* The natural size (i.e. when GTK uses 0 as margin) looks best, diff --git a/src/image.c b/src/image.c index 980911e0d1..78eaf8a759 100644 --- a/src/image.c +++ b/src/image.c @@ -785,7 +785,7 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords, /* Unlike the other integer-related cases, this one does not verify that VALUE fits in 'int'. This is because callers want EMACS_INT. */ - if (!FIXNUMP (value) || XINT (value) < 0) + if (!FIXNUMP (value) || XFIXNUM (value) < 0) return 0; break; @@ -1005,8 +1005,8 @@ check_image_size (struct frame *f, int width, int height) return 0; if (FIXNUMP (Vmax_image_size)) - return (width <= XINT (Vmax_image_size) - && height <= XINT (Vmax_image_size)); + return (width <= XFIXNUM (Vmax_image_size) + && height <= XFIXNUM (Vmax_image_size)); else if (FLOATP (Vmax_image_size)) { if (f != NULL) @@ -1547,7 +1547,7 @@ clear_image_cache (struct frame *f, Lisp_Object filter) /* If the number of cached images has grown unusually large, decrease the cache eviction delay (Bug#6230). */ - delay = XINT (Vimage_cache_eviction_delay); + delay = XFIXNUM (Vimage_cache_eviction_delay); if (nimages > 40) delay = 1600 * delay / nimages / nimages; delay = max (delay, 1); @@ -1762,10 +1762,10 @@ lookup_image (struct frame *f, Lisp_Object spec) value = image_spec_value (spec, QCwidth, NULL); img->width = (FIXNUMP (value) - ? XFASTINT (value) : DEFAULT_IMAGE_WIDTH); + ? XFIXNAT (value) : DEFAULT_IMAGE_WIDTH); value = image_spec_value (spec, QCheight, NULL); img->height = (FIXNUMP (value) - ? XFASTINT (value) : DEFAULT_IMAGE_HEIGHT); + ? XFIXNAT (value) : DEFAULT_IMAGE_HEIGHT); } else { @@ -1777,24 +1777,24 @@ lookup_image (struct frame *f, Lisp_Object spec) ascent = image_spec_value (spec, QCascent, NULL); if (FIXNUMP (ascent)) - img->ascent = XFASTINT (ascent); + img->ascent = XFIXNAT (ascent); else if (EQ (ascent, Qcenter)) img->ascent = CENTERED_IMAGE_ASCENT; margin = image_spec_value (spec, QCmargin, NULL); if (FIXNUMP (margin)) - img->vmargin = img->hmargin = XFASTINT (margin); + img->vmargin = img->hmargin = XFIXNAT (margin); else if (CONSP (margin)) { - img->hmargin = XFASTINT (XCAR (margin)); - img->vmargin = XFASTINT (XCDR (margin)); + img->hmargin = XFIXNAT (XCAR (margin)); + img->vmargin = XFIXNAT (XCDR (margin)); } relief = image_spec_value (spec, QCrelief, NULL); relief_bound = INT_MAX - max (img->hmargin, img->vmargin); if (RANGED_FIXNUMP (- relief_bound, relief, relief_bound)) { - img->relief = XINT (relief); + img->relief = XFIXNUM (relief); img->hmargin += eabs (img->relief); img->vmargin += eabs (img->relief); } @@ -2512,8 +2512,8 @@ xbm_image_p (Lisp_Object object) return 0; data = kw[XBM_DATA].value; - width = XFASTINT (kw[XBM_WIDTH].value); - height = XFASTINT (kw[XBM_HEIGHT].value); + width = XFIXNAT (kw[XBM_WIDTH].value); + height = XFIXNAT (kw[XBM_HEIGHT].value); /* Check type of data, and width and height against contents of data. */ @@ -3061,8 +3061,8 @@ xbm_load (struct frame *f, struct image *img) /* Get specified width, and height. */ if (!in_memory_file_p) { - img->width = XFASTINT (fmt[XBM_WIDTH].value); - img->height = XFASTINT (fmt[XBM_HEIGHT].value); + img->width = XFIXNAT (fmt[XBM_WIDTH].value); + img->height = XFIXNAT (fmt[XBM_HEIGHT].value); eassert (img->width > 0 && img->height > 0); if (!check_image_size (f, img->width, img->height)) { @@ -4168,7 +4168,7 @@ xpm_load_image (struct frame *f, if (!NILP (Fxw_display_color_p (frame))) best_key = XPM_COLOR_KEY_C; else if (!NILP (Fx_display_grayscale_p (frame))) - best_key = (XFASTINT (Fx_display_planes (frame)) > 2 + best_key = (XFIXNAT (Fx_display_planes (frame)) > 2 ? XPM_COLOR_KEY_G : XPM_COLOR_KEY_G4); else best_key = XPM_COLOR_KEY_M; @@ -4267,7 +4267,7 @@ xpm_load_image (struct frame *f, (*get_color_table) (color_table, str, chars_per_pixel); XPutPixel (ximg, x, y, - (FIXNUMP (color_val) ? XINT (color_val) + (FIXNUMP (color_val) ? XFIXNUM (color_val) : FRAME_FOREGROUND_PIXEL (f))); #ifndef HAVE_NS XPutPixel (mask_img, x, y, @@ -5095,7 +5095,7 @@ x_build_heuristic_mask (struct frame *f, struct image *img, Lisp_Object how) for (i = 0; i < 3 && CONSP (how) && FIXNATP (XCAR (how)); ++i) { - rgb[i] = XFASTINT (XCAR (how)) & 0xffff; + rgb[i] = XFIXNAT (XCAR (how)) & 0xffff; how = XCDR (how); } @@ -7282,7 +7282,7 @@ tiff_load (struct frame *f, struct image *img) image = image_spec_value (img->spec, QCindex, NULL); if (FIXNUMP (image)) { - EMACS_INT ino = XFASTINT (image); + EMACS_INT ino = XFIXNAT (image); if (! (TYPE_MINIMUM (tdir_t) <= ino && ino <= TYPE_MAXIMUM (tdir_t) && TIFFSetDirectory (tiff, ino))) { @@ -7746,7 +7746,7 @@ gif_load (struct frame *f, struct image *img) /* Which sub-image are we to display? */ { Lisp_Object image_number = image_spec_value (img->spec, QCindex, NULL); - idx = FIXNUMP (image_number) ? XFASTINT (image_number) : 0; + idx = FIXNUMP (image_number) ? XFIXNAT (image_number) : 0; if (idx < 0 || idx >= gif->ImageCount) { image_error ("Invalid image number `%s' in image `%s'", @@ -8107,11 +8107,11 @@ compute_image_size (size_t width, size_t height, value = image_spec_value (spec, QCmax_width, NULL); if (FIXNATP (value)) - max_width = min (XFASTINT (value), INT_MAX); + max_width = min (XFIXNAT (value), INT_MAX); value = image_spec_value (spec, QCmax_height, NULL); if (FIXNATP (value)) - max_height = min (XFASTINT (value), INT_MAX); + max_height = min (XFIXNAT (value), INT_MAX); /* If width and/or height is set in the display spec assume we want to scale to those values. If either h or w is unspecified, the @@ -8120,7 +8120,7 @@ compute_image_size (size_t width, size_t height, value = image_spec_value (spec, QCwidth, NULL); if (FIXNATP (value)) { - desired_width = min (XFASTINT (value) * scale, INT_MAX); + desired_width = min (XFIXNAT (value) * scale, INT_MAX); /* :width overrides :max-width. */ max_width = -1; } @@ -8128,7 +8128,7 @@ compute_image_size (size_t width, size_t height, value = image_spec_value (spec, QCheight, NULL); if (FIXNATP (value)) { - desired_height = min (XFASTINT (value) * scale, INT_MAX); + desired_height = min (XFIXNAT (value) * scale, INT_MAX); /* :height overrides :max-height. */ max_height = -1; } @@ -8573,7 +8573,7 @@ imagemagick_load_image (struct frame *f, struct image *img, find out things about it. */ image = image_spec_value (img->spec, QCindex, NULL); - ino = FIXNUMP (image) ? XFASTINT (image) : 0; + ino = FIXNUMP (image) ? XFIXNAT (image) : 0; image_wand = NewMagickWand (); if (filename) @@ -8585,7 +8585,7 @@ imagemagick_load_image (struct frame *f, struct image *img, if (FIXNATP (lwidth) && FIXNATP (lheight)) { - MagickSetSize (image_wand, XFASTINT (lwidth), XFASTINT (lheight)); + MagickSetSize (image_wand, XFIXNAT (lwidth), XFIXNAT (lheight)); MagickSetDepth (image_wand, 8); } filename_hint = imagemagick_filename_hint (img->spec, hint_buffer); @@ -8685,19 +8685,19 @@ imagemagick_load_image (struct frame *f, struct image *img, than the alternatives, but it still reads the entire image into memory before cropping, which is apparently difficult to avoid when using imagemagick. */ - size_t crop_width = XINT (XCAR (crop)); + size_t crop_width = XFIXNUM (XCAR (crop)); crop = XCDR (crop); if (CONSP (crop) && TYPE_RANGED_FIXNUMP (size_t, XCAR (crop))) { - size_t crop_height = XINT (XCAR (crop)); + size_t crop_height = XFIXNUM (XCAR (crop)); crop = XCDR (crop); if (CONSP (crop) && TYPE_RANGED_FIXNUMP (ssize_t, XCAR (crop))) { - ssize_t crop_x = XINT (XCAR (crop)); + ssize_t crop_x = XFIXNUM (XCAR (crop)); crop = XCDR (crop); if (CONSP (crop) && TYPE_RANGED_FIXNUMP (ssize_t, XCAR (crop))) { - ssize_t crop_y = XINT (XCAR (crop)); + ssize_t crop_y = XFIXNUM (XCAR (crop)); MagickCropImage (image_wand, crop_width, crop_height, crop_x, crop_y); } @@ -9589,10 +9589,10 @@ gs_load (struct frame *f, struct image *img) = 1/72 in, xdpi and ydpi are stored in the frame's X display info. */ pt_width = image_spec_value (img->spec, QCpt_width, NULL); - in_width = FIXNUMP (pt_width) ? XFASTINT (pt_width) / 72.0 : 0; + in_width = FIXNUMP (pt_width) ? XFIXNAT (pt_width) / 72.0 : 0; in_width *= FRAME_RES_X (f); pt_height = image_spec_value (img->spec, QCpt_height, NULL); - in_height = FIXNUMP (pt_height) ? XFASTINT (pt_height) / 72.0 : 0; + in_height = FIXNUMP (pt_height) ? XFIXNAT (pt_height) / 72.0 : 0; in_height *= FRAME_RES_Y (f); if (! (in_width <= INT_MAX && in_height <= INT_MAX diff --git a/src/indent.c b/src/indent.c index fd505bceeb..18855768d3 100644 --- a/src/indent.c +++ b/src/indent.c @@ -116,7 +116,7 @@ disptab_matches_widthtab (struct Lisp_Char_Table *disptab, struct Lisp_Vector *w for (i = 0; i < 256; i++) if (character_width (i, disptab) - != XFASTINT (widthtab->contents[i])) + != XFIXNAT (widthtab->contents[i])) return 0; return 1; @@ -235,24 +235,24 @@ skip_invisible (ptrdiff_t pos, ptrdiff_t *next_boundary_p, ptrdiff_t to, Lisp_Ob /* As for text properties, this gives a lower bound for where the invisible text property could change. */ proplimit = Fnext_property_change (position, buffer, Qt); - if (XFASTINT (overlay_limit) < XFASTINT (proplimit)) + if (XFIXNAT (overlay_limit) < XFIXNAT (proplimit)) proplimit = overlay_limit; /* PROPLIMIT is now a lower bound for the next change in invisible status. If that is plenty far away, use that lower bound. */ - if (XFASTINT (proplimit) > pos + 100 || XFASTINT (proplimit) >= to) - *next_boundary_p = XFASTINT (proplimit); + if (XFIXNAT (proplimit) > pos + 100 || XFIXNAT (proplimit) >= to) + *next_boundary_p = XFIXNAT (proplimit); /* Otherwise, scan for the next `invisible' property change. */ else { /* Don't scan terribly far. */ XSETFASTINT (proplimit, min (pos + 100, to)); /* No matter what, don't go past next overlay change. */ - if (XFASTINT (overlay_limit) < XFASTINT (proplimit)) + if (XFIXNAT (overlay_limit) < XFIXNAT (proplimit)) proplimit = overlay_limit; tmp = Fnext_single_property_change (position, Qinvisible, buffer, proplimit); - end = XFASTINT (tmp); + end = XFIXNAT (tmp); #if 0 /* Don't put the boundary in the middle of multibyte form if there is no actual property change. */ @@ -486,13 +486,13 @@ check_display_width (ptrdiff_t pos, ptrdiff_t col, ptrdiff_t *endpos) RANGED_FIXNUMP (0, prop, INT_MAX)) || (prop = Fplist_get (plist, QCrelative_width), RANGED_FIXNUMP (0, prop, INT_MAX))) - width = XINT (prop); + width = XFIXNUM (prop); else if (FLOATP (prop) && 0 <= XFLOAT_DATA (prop) && XFLOAT_DATA (prop) <= INT_MAX) width = (int)(XFLOAT_DATA (prop) + 0.5); else if ((prop = Fplist_get (plist, QCalign_to), RANGED_FIXNUMP (col, prop, align_to_max))) - width = XINT (prop) - col; + width = XFIXNUM (prop) - col; else if (FLOATP (prop) && col <= XFLOAT_DATA (prop) && (XFLOAT_DATA (prop) <= align_to_max)) width = (int)(XFLOAT_DATA (prop) + 0.5) - col; @@ -752,7 +752,7 @@ string_display_width (Lisp_Object string, Lisp_Object beg, Lisp_Object end) else { CHECK_FIXNUM (end); - e = XINT (end); + e = XFIXNUM (end); } if (NILP (beg)) @@ -760,7 +760,7 @@ string_display_width (Lisp_Object string, Lisp_Object beg, Lisp_Object end) else { CHECK_FIXNUM (beg); - b = XINT (beg); + b = XFIXNUM (beg); } /* Make a pointer for decrementing through the chars before point. */ @@ -826,8 +826,8 @@ The return value is the column where the insertion ends. */) CHECK_FIXNUM (minimum); fromcol = current_column (); - mincol = fromcol + XINT (minimum); - if (mincol < XINT (column)) mincol = XINT (column); + mincol = fromcol + XFIXNUM (minimum); + if (mincol < XFIXNUM (column)) mincol = XFIXNUM (column); if (fromcol == mincol) return make_fixnum (mincol); @@ -836,7 +836,7 @@ The return value is the column where the insertion ends. */) { Lisp_Object n; XSETFASTINT (n, mincol / tab_width - fromcol / tab_width); - if (XFASTINT (n) != 0) + if (XFIXNAT (n) != 0) { Finsert_char (make_fixnum ('\t'), n, Qt); @@ -995,7 +995,7 @@ The return value is the current column. */) EMACS_INT goal; CHECK_FIXNAT (column); - goal = XINT (column); + goal = XFIXNUM (column); col = goal; pos = ZV; @@ -1129,7 +1129,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos, struct Lisp_Char_Table *dp = window_display_table (win); EMACS_INT selective = (FIXNUMP (BVAR (current_buffer, selective_display)) - ? XINT (BVAR (current_buffer, selective_display)) + ? XFIXNUM (BVAR (current_buffer, selective_display)) : !NILP (BVAR (current_buffer, selective_display)) ? -1 : 0); ptrdiff_t selective_rlen = (selective && dp && VECTORP (DISP_INVIS_VECTOR (dp)) @@ -1340,7 +1340,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos, { if (FIXNUMP (Vtruncate_partial_width_windows)) truncate - = total_width < XFASTINT (Vtruncate_partial_width_windows); + = total_width < XFIXNAT (Vtruncate_partial_width_windows); else truncate = 1; } @@ -1533,7 +1533,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos, /* Is this character part of the current run? If so, extend the run. */ if (pos - 1 == width_run_end - && XFASTINT (width_table[c]) == width_run_width) + && XFIXNAT (width_table[c]) == width_run_width) width_run_end = pos; /* The previous run is over, since this is a character at a @@ -1548,7 +1548,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos, width_run_start, width_run_end); /* Start recording a new width run. */ - width_run_width = XFASTINT (width_table[c]); + width_run_width = XFIXNAT (width_table[c]); width_run_start = pos - 1; width_run_end = pos; } @@ -1773,29 +1773,29 @@ visible section of the buffer, and pass LINE and COL as TOPOS. */) CHECK_CONS (offsets); CHECK_FIXNUM_CAR (offsets); CHECK_FIXNUM_CDR (offsets); - if (! (0 <= XINT (XCAR (offsets)) && XINT (XCAR (offsets)) <= PTRDIFF_MAX - && 0 <= XINT (XCDR (offsets)) && XINT (XCDR (offsets)) <= INT_MAX)) + if (! (0 <= XFIXNUM (XCAR (offsets)) && XFIXNUM (XCAR (offsets)) <= PTRDIFF_MAX + && 0 <= XFIXNUM (XCDR (offsets)) && XFIXNUM (XCDR (offsets)) <= INT_MAX)) args_out_of_range (XCAR (offsets), XCDR (offsets)); - hscroll = XINT (XCAR (offsets)); - tab_offset = XINT (XCDR (offsets)); + hscroll = XFIXNUM (XCAR (offsets)); + tab_offset = XFIXNUM (XCDR (offsets)); } else hscroll = tab_offset = 0; w = decode_live_window (window); - if (XINT (from) < BEGV || XINT (from) > ZV) + if (XFIXNUM (from) < BEGV || XFIXNUM (from) > ZV) args_out_of_range_3 (from, make_fixnum (BEGV), make_fixnum (ZV)); - if (XINT (to) < BEGV || XINT (to) > ZV) + if (XFIXNUM (to) < BEGV || XFIXNUM (to) > ZV) args_out_of_range_3 (to, make_fixnum (BEGV), make_fixnum (ZV)); - pos = compute_motion (XINT (from), CHAR_TO_BYTE (XINT (from)), - XINT (XCDR (frompos)), - XINT (XCAR (frompos)), 0, - XINT (to), + pos = compute_motion (XFIXNUM (from), CHAR_TO_BYTE (XFIXNUM (from)), + XFIXNUM (XCDR (frompos)), + XFIXNUM (XCAR (frompos)), 0, + XFIXNUM (to), (NILP (topos) ? window_internal_height (w) - : XINT (XCDR (topos))), + : XFIXNUM (XCDR (topos))), (NILP (topos) ? (window_body_width (w, 0) - ( @@ -1803,8 +1803,8 @@ visible section of the buffer, and pass LINE and COL as TOPOS. */) FRAME_WINDOW_P (XFRAME (w->frame)) ? 0 : #endif 1)) - : XINT (XCAR (topos))), - (NILP (width) ? -1 : XINT (width)), + : XFIXNUM (XCAR (topos))), + (NILP (width) ? -1 : XFIXNUM (width)), hscroll, tab_offset, w); XSETFASTINT (bufpos, pos->bufpos); @@ -1832,7 +1832,7 @@ vmotion (register ptrdiff_t from, register ptrdiff_t from_byte, ptrdiff_t lmargin = hscroll > 0 ? 1 - hscroll : 0; ptrdiff_t selective = (FIXNUMP (BVAR (current_buffer, selective_display)) - ? clip_to_bounds (-1, XINT (BVAR (current_buffer, selective_display)), + ? clip_to_bounds (-1, XFIXNUM (BVAR (current_buffer, selective_display)), PTRDIFF_MAX) : !NILP (BVAR (current_buffer, selective_display)) ? -1 : 0); Lisp_Object window; @@ -2045,8 +2045,8 @@ restore_window_buffer (Lisp_Object list) wset_buffer (w, XCAR (list)); list = XCDR (list); set_marker_both (w->pointm, w->contents, - XFASTINT (XCAR (list)), - XFASTINT (XCAR (XCDR (list)))); + XFIXNAT (XCAR (list)), + XFIXNAT (XCAR (XCDR (list)))); } DEFUN ("vertical-motion", Fvertical_motion, Svertical_motion, 1, 3, 0, @@ -2118,7 +2118,7 @@ whether or not it is currently displayed in some window. */) if (noninteractive) { struct position pos; - pos = *vmotion (PT, PT_BYTE, XINT (lines), w); + pos = *vmotion (PT, PT_BYTE, XFIXNUM (lines), w); SET_PT_BOTH (pos.bufpos, pos.bytepos); it.vpos = pos.vpos; } @@ -2128,7 +2128,7 @@ whether or not it is currently displayed in some window. */) int first_x; bool overshoot_handled = 0; bool disp_string_at_start_p = 0; - ptrdiff_t nlines = XINT (lines); + ptrdiff_t nlines = XFIXNUM (lines); int vpos_init = 0; double start_col UNINIT; int start_x UNINIT; diff --git a/src/insdel.c b/src/insdel.c index a365b95fc1..70cebc0d2c 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -2287,17 +2287,17 @@ DEFUN ("combine-after-change-execute", Fcombine_after_change_execute, elt = XCAR (tail); if (! CONSP (elt)) continue; - thisbeg = XINT (XCAR (elt)); + thisbeg = XFIXNUM (XCAR (elt)); elt = XCDR (elt); if (! CONSP (elt)) continue; - thisend = XINT (XCAR (elt)); + thisend = XFIXNUM (XCAR (elt)); elt = XCDR (elt); if (! CONSP (elt)) continue; - thischange = XINT (XCAR (elt)); + thischange = XFIXNUM (XCAR (elt)); /* Merge this range into the accumulated range. */ change += thischange; diff --git a/src/intervals.c b/src/intervals.c index 90ec4bd053..af27afea0d 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -1926,8 +1926,8 @@ set_point_both (ptrdiff_t charpos, ptrdiff_t bytepos) if (! NILP (intangible_propval)) { - while (XINT (pos) > BEGV - && EQ (Fget_char_property (make_fixnum (XINT (pos) - 1), + while (XFIXNUM (pos) > BEGV + && EQ (Fget_char_property (make_fixnum (XFIXNUM (pos) - 1), Qintangible, Qnil), intangible_propval)) pos = Fprevious_char_property_change (pos, Qnil); @@ -1937,7 +1937,7 @@ set_point_both (ptrdiff_t charpos, ptrdiff_t bytepos) property is `front-sticky', perturb it to be one character earlier -- this ensures that point can never move to the beginning of an invisible/intangible/front-sticky region. */ - charpos = adjust_for_invis_intang (XINT (pos), 0, -1, 0); + charpos = adjust_for_invis_intang (XFIXNUM (pos), 0, -1, 0); } } else @@ -1959,7 +1959,7 @@ set_point_both (ptrdiff_t charpos, ptrdiff_t bytepos) if (! NILP (intangible_propval)) { - while (XINT (pos) < ZV + while (XFIXNUM (pos) < ZV && EQ (Fget_char_property (pos, Qintangible, Qnil), intangible_propval)) pos = Fnext_char_property_change (pos, Qnil); @@ -1969,7 +1969,7 @@ set_point_both (ptrdiff_t charpos, ptrdiff_t bytepos) property is `rear-sticky', perturb it to be one character later -- this ensures that point can never move to the end of an invisible/intangible/rear-sticky region. */ - charpos = adjust_for_invis_intang (XINT (pos), -1, 1, 0); + charpos = adjust_for_invis_intang (XFIXNUM (pos), -1, 1, 0); } } @@ -2055,7 +2055,7 @@ move_if_not_intangible (ptrdiff_t position) if (! NILP (Vinhibit_point_motion_hooks)) /* If intangible is inhibited, always move point to POSITION. */ ; - else if (PT < position && XINT (pos) < ZV) + else if (PT < position && XFIXNUM (pos) < ZV) { /* We want to move forward, so check the text before POSITION. */ @@ -2065,23 +2065,23 @@ move_if_not_intangible (ptrdiff_t position) /* If following char is intangible, skip back over all chars with matching intangible property. */ if (! NILP (intangible_propval)) - while (XINT (pos) > BEGV - && EQ (Fget_char_property (make_fixnum (XINT (pos) - 1), + while (XFIXNUM (pos) > BEGV + && EQ (Fget_char_property (make_fixnum (XFIXNUM (pos) - 1), Qintangible, Qnil), intangible_propval)) pos = Fprevious_char_property_change (pos, Qnil); } - else if (XINT (pos) > BEGV) + else if (XFIXNUM (pos) > BEGV) { /* We want to move backward, so check the text after POSITION. */ - intangible_propval = Fget_char_property (make_fixnum (XINT (pos) - 1), + intangible_propval = Fget_char_property (make_fixnum (XFIXNUM (pos) - 1), Qintangible, Qnil); /* If following char is intangible, skip forward over all chars with matching intangible property. */ if (! NILP (intangible_propval)) - while (XINT (pos) < ZV + while (XFIXNUM (pos) < ZV && EQ (Fget_char_property (pos, Qintangible, Qnil), intangible_propval)) pos = Fnext_char_property_change (pos, Qnil); @@ -2096,7 +2096,7 @@ move_if_not_intangible (ptrdiff_t position) try moving to POSITION (which means we actually move farther if POSITION is inside of intangible text). */ - if (XINT (pos) != PT) + if (XFIXNUM (pos) != PT) SET_PT (position); } diff --git a/src/json.c b/src/json.c index da6e34d89c..17edb4140e 100644 --- a/src/json.c +++ b/src/json.c @@ -485,7 +485,7 @@ lisp_to_json (Lisp_Object lisp, struct json_configuration *conf) else if (FIXNUMP (lisp)) { CHECK_TYPE_RANGED_INTEGER (json_int_t, lisp); - return json_check (json_integer (XINT (lisp))); + return json_check (json_integer (XFIXNUM (lisp))); } else if (FLOATP (lisp)) return json_check (json_real (XFLOAT_DATA (lisp))); diff --git a/src/keyboard.c b/src/keyboard.c index 25864b5b5f..4c8807d680 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -441,7 +441,7 @@ static bool echo_keystrokes_p (void) { return (FLOATP (Vecho_keystrokes) ? XFLOAT_DATA (Vecho_keystrokes) > 0.0 - : FIXNUMP (Vecho_keystrokes) ? XINT (Vecho_keystrokes) > 0 + : FIXNUMP (Vecho_keystrokes) ? XFIXNUM (Vecho_keystrokes) > 0 : false); } @@ -467,7 +467,7 @@ echo_add_key (Lisp_Object c) c = EVENT_HEAD (c); if (FIXNUMP (c)) - ptr = push_key_description (XINT (c), ptr); + ptr = push_key_description (XFIXNUM (c), ptr); else if (SYMBOLP (c)) { Lisp_Object name = SYMBOL_NAME (c); @@ -541,7 +541,7 @@ echo_dash (void) idx = make_fixnum (SCHARS (KVAR (current_kboard, echo_string)) - 1); last_char = Faref (KVAR (current_kboard, echo_string), idx); - if (XINT (last_char) == '-' && XINT (prev_char) != ' ') + if (XFIXNUM (last_char) == '-' && XFIXNUM (prev_char) != ' ') return; } @@ -1525,7 +1525,7 @@ command_loop_1 (void) { Lisp_Object txt = call1 (Fsymbol_value (Qregion_extract_function), Qnil); - if (XINT (Flength (txt)) > 0) + if (XFIXNUM (Flength (txt)) > 0) /* Don't set empty selections. */ call2 (Qgui_set_selection, QPRIMARY, txt); } @@ -1677,7 +1677,7 @@ adjust_point_for_property (ptrdiff_t last_pt, bool modified) || !NILP (Foverlay_get (overlay, Qbefore_string)))); tmp = Fnext_single_char_property_change (make_fixnum (end), Qinvisible, Qnil, Qnil); - end = FIXNATP (tmp) ? XFASTINT (tmp) : ZV; + end = FIXNATP (tmp) ? XFIXNAT (tmp) : ZV; } while (beg > BEGV #if 0 @@ -1695,7 +1695,7 @@ adjust_point_for_property (ptrdiff_t last_pt, bool modified) || !NILP (Foverlay_get (overlay, Qbefore_string)))); tmp = Fprevious_single_char_property_change (make_fixnum (beg), Qinvisible, Qnil, Qnil); - beg = FIXNATP (tmp) ? XFASTINT (tmp) : BEGV; + beg = FIXNATP (tmp) ? XFIXNAT (tmp) : BEGV; } /* Move away from the inside area. */ @@ -2145,7 +2145,7 @@ read_event_from_main_queue (struct timespec *end_time, } /* Terminate Emacs in batch mode if at eof. */ - if (noninteractive && FIXNUMP (c) && XINT (c) < 0) + if (noninteractive && FIXNUMP (c) && XFIXNUM (c) < 0) Fkill_emacs (make_fixnum (1)); if (FIXNUMP (c)) @@ -2154,12 +2154,12 @@ read_event_from_main_queue (struct timespec *end_time, if ((extra_keyboard_modifiers & CHAR_CTL) || ((extra_keyboard_modifiers & 0177) < ' ' && (extra_keyboard_modifiers & 0177) != 0)) - XSETINT (c, make_ctrl_char (XINT (c))); + XSETINT (c, make_ctrl_char (XFIXNUM (c))); /* Transfer any other modifier bits directly from extra_keyboard_modifiers to c. Ignore the actual character code in the low 16 bits of extra_keyboard_modifiers. */ - XSETINT (c, XINT (c) | (extra_keyboard_modifiers & ~0xff7f & ~CHAR_CTL)); + XSETINT (c, XFIXNUM (c) | (extra_keyboard_modifiers & ~0xff7f & ~CHAR_CTL)); } return c; @@ -2208,7 +2208,7 @@ read_decoded_event_from_main_queue (struct timespec *end_time, eassert (n < MAX_ENCODED_BYTES); events[n++] = nextevt; if (FIXNATP (nextevt) - && XINT (nextevt) < (meta_key == 1 ? 0x80 : 0x100)) + && XFIXNUM (nextevt) < (meta_key == 1 ? 0x80 : 0x100)) { /* An encoded byte sequence, let's try to decode it. */ struct coding_system *coding = TERMINAL_KEYBOARD_CODING (terminal); @@ -2218,7 +2218,7 @@ read_decoded_event_from_main_queue (struct timespec *end_time, int i; if (meta_key != 2) for (i = 0; i < n; i++) - events[i] = make_fixnum (XINT (events[i]) & ~0x80); + events[i] = make_fixnum (XFIXNUM (events[i]) & ~0x80); } else { @@ -2226,7 +2226,7 @@ read_decoded_event_from_main_queue (struct timespec *end_time, unsigned char dest[MAX_ENCODED_BYTES * MAX_MULTIBYTE_LENGTH]; int i; for (i = 0; i < n; i++) - src[i] = XINT (events[i]); + src[i] = XFIXNUM (events[i]); if (meta_key != 2) for (i = 0; i < n; i++) src[i] &= ~0x80; @@ -2403,7 +2403,7 @@ read_char (int commandflag, Lisp_Object map, Also, some things replace the macro with t to force an early exit. */ if (EQ (Vexecuting_kbd_macro, Qt) - || executing_kbd_macro_index >= XFASTINT (Flength (Vexecuting_kbd_macro))) + || executing_kbd_macro_index >= XFIXNAT (Flength (Vexecuting_kbd_macro))) { XSETINT (c, -1); goto exit; @@ -2411,8 +2411,8 @@ read_char (int commandflag, Lisp_Object map, c = Faref (Vexecuting_kbd_macro, make_fixnum (executing_kbd_macro_index)); if (STRINGP (Vexecuting_kbd_macro) - && (XFASTINT (c) & 0x80) && (XFASTINT (c) <= 0xff)) - XSETFASTINT (c, CHAR_META | (XFASTINT (c) & ~0x80)); + && (XFIXNAT (c) & 0x80) && (XFIXNAT (c) <= 0xff)) + XSETFASTINT (c, CHAR_META | (XFIXNAT (c) & ~0x80)); executing_kbd_macro_index++; @@ -2516,7 +2516,7 @@ read_char (int commandflag, Lisp_Object map, { c = read_char_minibuf_menu_prompt (commandflag, map); - if (FIXNUMP (c) && XINT (c) == -2) + if (FIXNUMP (c) && XFIXNUM (c) == -2) return c; /* wrong_kboard_jmpbuf */ if (! NILP (c)) @@ -2676,10 +2676,10 @@ read_char (int commandflag, Lisp_Object map, if (commandflag != 0 && commandflag != -2 && num_nonmacro_input_events > last_auto_save && FIXNUMP (Vauto_save_timeout) - && XINT (Vauto_save_timeout) > 0) + && XFIXNUM (Vauto_save_timeout) > 0) { Lisp_Object tem0; - EMACS_INT timeout = XFASTINT (Vauto_save_timeout); + EMACS_INT timeout = XFIXNAT (Vauto_save_timeout); timeout = min (timeout, MOST_POSITIVE_FIXNUM / delay_level * 4); timeout = delay_level * timeout / 4; @@ -2852,15 +2852,15 @@ read_char (int commandflag, Lisp_Object map, if (FIXNUMP (c)) { /* If kbd_buffer_get_event gave us an EOF, return that. */ - if (XINT (c) == -1) + if (XFIXNUM (c) == -1) goto exit; if ((STRINGP (KVAR (current_kboard, Vkeyboard_translate_table)) - && UNSIGNED_CMP (XFASTINT (c), <, + && UNSIGNED_CMP (XFIXNAT (c), <, SCHARS (KVAR (current_kboard, Vkeyboard_translate_table)))) || (VECTORP (KVAR (current_kboard, Vkeyboard_translate_table)) - && UNSIGNED_CMP (XFASTINT (c), <, + && UNSIGNED_CMP (XFIXNAT (c), <, ASIZE (KVAR (current_kboard, Vkeyboard_translate_table)))) || (CHAR_TABLE_P (KVAR (current_kboard, Vkeyboard_translate_table)) @@ -2910,7 +2910,7 @@ read_char (int commandflag, Lisp_Object map, save the echo area contents for it to refer to. */ if (FIXNUMP (c) && ! NILP (Vinput_method_function) - && ' ' <= XINT (c) && XINT (c) < 256 && XINT (c) != 127) + && ' ' <= XFIXNUM (c) && XFIXNUM (c) < 256 && XFIXNUM (c) != 127) { previous_echo_area_message = Fcurrent_message (); Vinput_method_previous_message = previous_echo_area_message; @@ -2940,7 +2940,7 @@ read_char (int commandflag, Lisp_Object map, /* Don't run the input method within a key sequence, after the first event of the key sequence. */ && NILP (prev_event) - && ' ' <= XINT (c) && XINT (c) < 256 && XINT (c) != 127) + && ' ' <= XFIXNUM (c) && XFIXNUM (c) < 256 && XFIXNUM (c) != 127) { Lisp_Object keys; ptrdiff_t key_count; @@ -3261,10 +3261,10 @@ record_char (Lisp_Object c) block_input (); if (FIXNUMP (c)) { - if (XUINT (c) < 0x100) - putc_unlocked (XUINT (c), dribble); + if (XUFIXNUM (c) < 0x100) + putc_unlocked (XUFIXNUM (c), dribble); else - fprintf (dribble, " 0x%"pI"x", XUINT (c)); + fprintf (dribble, " 0x%"pI"x", XUFIXNUM (c)); } else { @@ -5009,7 +5009,7 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, int xret = 0, yret = 0; /* The window or frame under frame pixel coordinates (x,y) */ Lisp_Object window_or_frame = f - ? window_from_coordinates (f, XINT (x), XINT (y), &part, 0) + ? window_from_coordinates (f, XFIXNUM (x), XFIXNUM (y), &part, 0) : Qnil; if (WINDOWP (window_or_frame)) @@ -5024,15 +5024,15 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, Lisp_Object object = Qnil; /* Pixel coordinates relative to the window corner. */ - int wx = XINT (x) - WINDOW_LEFT_EDGE_X (w); - int wy = XINT (y) - WINDOW_TOP_EDGE_Y (w); + int wx = XFIXNUM (x) - WINDOW_LEFT_EDGE_X (w); + int wy = XFIXNUM (y) - WINDOW_TOP_EDGE_Y (w); /* For text area clicks, return X, Y relative to the corner of this text area. Note that dX, dY etc are set below, by buffer_posn_from_coords. */ if (part == ON_TEXT) { - xret = XINT (x) - window_box_left (w, TEXT_AREA); + xret = XFIXNUM (x) - window_box_left (w, TEXT_AREA); yret = wy - WINDOW_HEADER_LINE_HEIGHT (w); } /* For mode line and header line clicks, return X, Y relative to @@ -5152,7 +5152,7 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, : (part == ON_RIGHT_FRINGE || part == ON_RIGHT_MARGIN || (part == ON_VERTICAL_SCROLL_BAR && WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_RIGHT (w))) - ? (XINT (x) - window_box_left (w, TEXT_AREA)) + ? (XFIXNUM (x) - window_box_left (w, TEXT_AREA)) : 0; int y2 = wy; @@ -5210,8 +5210,8 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, { /* Return mouse pixel coordinates here. */ XSETFRAME (window_or_frame, f); - xret = XINT (x); - yret = XINT (y); + xret = XFIXNUM (x); + yret = XFIXNUM (y); if (FRAME_LIVE_P (f) && FRAME_INTERNAL_BORDER_WIDTH (f) > 0 @@ -5530,7 +5530,7 @@ make_lispy_event (struct input_event *event) in a menu (non-toolkit version). */ if (!toolkit_menubar_in_use (f)) { - pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y), + pixel_to_glyph_coords (f, XFIXNUM (event->x), XFIXNUM (event->y), &column, &row, NULL, 1); /* In the non-toolkit version, clicks on the menu bar @@ -5555,8 +5555,8 @@ make_lispy_event (struct input_event *event) pos = AREF (items, i + 3); if (NILP (string)) break; - if (column >= XINT (pos) - && column < XINT (pos) + SCHARS (string)) + if (column >= XFIXNUM (pos) + && column < XFIXNUM (pos) + SCHARS (string)) { item = AREF (items, i); break; @@ -5616,18 +5616,18 @@ make_lispy_event (struct input_event *event) fuzz = double_click_fuzz / 8; is_double = (button == last_mouse_button - && (eabs (XINT (event->x) - last_mouse_x) <= fuzz) - && (eabs (XINT (event->y) - last_mouse_y) <= fuzz) + && (eabs (XFIXNUM (event->x) - last_mouse_x) <= fuzz) + && (eabs (XFIXNUM (event->y) - last_mouse_y) <= fuzz) && button_down_time != 0 && (EQ (Vdouble_click_time, Qt) || (FIXNATP (Vdouble_click_time) && (event->timestamp - button_down_time - < XFASTINT (Vdouble_click_time))))); + < XFIXNAT (Vdouble_click_time))))); } last_mouse_button = button; - last_mouse_x = XINT (event->x); - last_mouse_y = XINT (event->y); + last_mouse_x = XFIXNUM (event->x); + last_mouse_y = XFIXNUM (event->y); /* If this is a button press, squirrel away the location, so we can decide later whether it was a click or a drag. */ @@ -5674,8 +5674,8 @@ make_lispy_event (struct input_event *event) if (CONSP (down) && FIXNUMP (XCAR (down)) && FIXNUMP (XCDR (down))) { - xdiff = XINT (XCAR (new_down)) - XINT (XCAR (down)); - ydiff = XINT (XCDR (new_down)) - XINT (XCDR (down)); + xdiff = XFIXNUM (XCAR (new_down)) - XFIXNUM (XCAR (down)); + ydiff = XFIXNUM (XCDR (new_down)) - XFIXNUM (XCDR (down)); } if (ignore_mouse_drag_p) @@ -5794,13 +5794,13 @@ make_lispy_event (struct input_event *event) symbol_num += 2; is_double = (last_mouse_button == - (1 + symbol_num) - && (eabs (XINT (event->x) - last_mouse_x) <= fuzz) - && (eabs (XINT (event->y) - last_mouse_y) <= fuzz) + && (eabs (XFIXNUM (event->x) - last_mouse_x) <= fuzz) + && (eabs (XFIXNUM (event->y) - last_mouse_y) <= fuzz) && button_down_time != 0 && (EQ (Vdouble_click_time, Qt) || (FIXNATP (Vdouble_click_time) && (event->timestamp - button_down_time - < XFASTINT (Vdouble_click_time))))); + < XFIXNAT (Vdouble_click_time))))); if (is_double) { double_click_count++; @@ -5817,8 +5817,8 @@ make_lispy_event (struct input_event *event) button_down_time = event->timestamp; /* Use a negative value to distinguish wheel from mouse button. */ last_mouse_button = - (1 + symbol_num); - last_mouse_x = XINT (event->x); - last_mouse_y = XINT (event->y); + last_mouse_x = XFIXNUM (event->x); + last_mouse_y = XFIXNUM (event->y); /* Get the symbol we should use for the wheel event. */ head = modify_event_symbol (symbol_num, @@ -6260,7 +6260,7 @@ lispy_modifier_list (int modifiers) SYMBOL's Qevent_symbol_element_mask property, and maintains the Qevent_symbol_elements property. */ -#define KEY_TO_CHAR(k) (XINT (k) & ((1 << CHARACTERBITS) - 1)) +#define KEY_TO_CHAR(k) (XFIXNUM (k) & ((1 << CHARACTERBITS) - 1)) Lisp_Object parse_modifiers (Lisp_Object symbol) @@ -6268,7 +6268,7 @@ parse_modifiers (Lisp_Object symbol) Lisp_Object elements; if (FIXNUMP (symbol)) - return list2i (KEY_TO_CHAR (symbol), XINT (symbol) & CHAR_MODIFIER_MASK); + return list2i (KEY_TO_CHAR (symbol), XFIXNUM (symbol) & CHAR_MODIFIER_MASK); else if (!SYMBOLP (symbol)) return Qnil; @@ -6336,7 +6336,7 @@ apply_modifiers (int modifiers, Lisp_Object base) modifiers &= INTMASK; if (FIXNUMP (base)) - return make_fixnum (XINT (base) | modifiers); + return make_fixnum (XFIXNUM (base) | modifiers); /* The click modifier never figures into cache indices. */ cache = Fget (base, Qmodifier_cache); @@ -6404,7 +6404,7 @@ reorder_modifiers (Lisp_Object symbol) Lisp_Object parsed; parsed = parse_modifiers (symbol); - return apply_modifiers (XFASTINT (XCAR (XCDR (parsed))), + return apply_modifiers (XFIXNAT (XCAR (XCDR (parsed))), XCAR (parsed)); } @@ -6491,7 +6491,7 @@ modify_event_symbol (ptrdiff_t symbol_num, int modifiers, Lisp_Object symbol_kin USE_SAFE_ALLOCA; buf = SAFE_ALLOCA (len); esprintf (buf, "%s-%"pI"d", SDATA (name_alist_or_stem), - XINT (symbol_int) + 1); + XFIXNUM (symbol_int) + 1); value = intern (buf); SAFE_FREE (); } @@ -6578,18 +6578,18 @@ has the same base event type and all the specified modifiers. */) { /* Turn (shift a) into A. */ if ((modifiers & shift_modifier) != 0 - && (XINT (base) >= 'a' && XINT (base) <= 'z')) + && (XFIXNUM (base) >= 'a' && XFIXNUM (base) <= 'z')) { - XSETINT (base, XINT (base) - ('a' - 'A')); + XSETINT (base, XFIXNUM (base) - ('a' - 'A')); modifiers &= ~shift_modifier; } /* Turn (control a) into C-a. */ if (modifiers & ctrl_modifier) return make_fixnum ((modifiers & ~ctrl_modifier) - | make_ctrl_char (XINT (base))); + | make_ctrl_char (XFIXNUM (base))); else - return make_fixnum (modifiers | XINT (base)); + return make_fixnum (modifiers | XFIXNUM (base)); } else if (SYMBOLP (base)) return apply_modifiers (modifiers, base); @@ -8527,8 +8527,8 @@ read_char_minibuf_menu_prompt (int commandflag, upcased_event = Fupcase (event); downcased_event = Fdowncase (event); - char_matches = (XINT (upcased_event) == SREF (s, 0) - || XINT (downcased_event) == SREF (s, 0)); + char_matches = (XFIXNUM (upcased_event) == SREF (s, 0) + || XFIXNUM (downcased_event) == SREF (s, 0)); if (! char_matches) desc = Fsingle_key_description (event, Qnil); @@ -8633,10 +8633,10 @@ read_char_minibuf_menu_prompt (int commandflag, while (BUFFERP (obj)); kset_defining_kbd_macro (current_kboard, orig_defn_macro); - if (!FIXNUMP (obj) || XINT (obj) == -2 + if (!FIXNUMP (obj) || XFIXNUM (obj) == -2 || (! EQ (obj, menu_prompt_more_char) && (!FIXNUMP (menu_prompt_more_char) - || ! EQ (obj, make_fixnum (Ctl (XINT (menu_prompt_more_char))))))) + || ! EQ (obj, make_fixnum (Ctl (XFIXNUM (menu_prompt_more_char))))))) { if (!NILP (KVAR (current_kboard, defining_kbd_macro))) store_kbd_macro_char (obj); @@ -8757,7 +8757,7 @@ keyremap_step (Lisp_Object *keybuf, volatile keyremap *fkey, the binding and restart with fkey->start at the end. */ if ((VECTORP (next) || STRINGP (next)) && doit) { - int len = XFASTINT (Flength (next)); + int len = XFIXNAT (Flength (next)); int i; *diff = len - (fkey->end - fkey->start); @@ -9105,7 +9105,7 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt, current_binding, last_nonmenu_event, &used_mouse_menu, NULL); used_mouse_menu_history[t] = used_mouse_menu; - if ((FIXNUMP (key) && XINT (key) == -2) /* wrong_kboard_jmpbuf */ + if ((FIXNUMP (key) && XFIXNUM (key) == -2) /* wrong_kboard_jmpbuf */ /* When switching to a new tty (with a new keyboard), read_char returns the new buffer, rather than -2 (Bug#5095). This is because `terminal-init-xterm' @@ -9173,7 +9173,7 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt, /* read_char returns -1 at the end of a macro. Emacs 18 handles this by returning immediately with a zero, so that's what we'll do. */ - if (FIXNUMP (key) && XINT (key) == -1) + if (FIXNUMP (key) && XFIXNUM (key) == -1) { t = 0; /* The Microsoft C compiler can't handle the goto that @@ -9209,7 +9209,7 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt, quit_throw_to_read_char switched buffers, replay to get the right keymap. */ if (FIXNUMP (key) - && XINT (key) == quit_char + && XFIXNUM (key) == quit_char && current_buffer != starting_buffer) { GROW_RAW_KEYBUF; @@ -9409,7 +9409,7 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt, int modifiers; breakdown = parse_modifiers (head); - modifiers = XINT (XCAR (XCDR (breakdown))); + modifiers = XFIXNUM (XCAR (XCDR (breakdown))); /* Attempt to reduce an unbound mouse event to a simpler event that is bound: Drags reduce to clicks. @@ -9642,7 +9642,7 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt, && FIXNUMP (key)) { Lisp_Object new_key; - EMACS_INT k = XINT (key); + EMACS_INT k = XFIXNUM (key); if (k & shift_modifier) XSETINT (new_key, k & ~shift_modifier); @@ -9689,7 +9689,7 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt, { Lisp_Object breakdown = parse_modifiers (key); int modifiers - = CONSP (breakdown) ? (XINT (XCAR (XCDR (breakdown)))) : 0; + = CONSP (breakdown) ? (XFIXNUM (XCAR (XCDR (breakdown)))) : 0; if (modifiers & shift_modifier /* Treat uppercase keys as shifted. */ @@ -10655,7 +10655,7 @@ See also `current-input-mode'. */) return Qnil; tty = t->display_info.tty; - if (NILP (quit) || !FIXNUMP (quit) || XINT (quit) < 0 || XINT (quit) > 0400) + if (NILP (quit) || !FIXNUMP (quit) || XFIXNUM (quit) < 0 || XFIXNUM (quit) > 0400) error ("QUIT must be an ASCII character"); #ifndef DOS_NT @@ -10664,7 +10664,7 @@ See also `current-input-mode'. */) #endif /* Don't let this value be out of range. */ - quit_char = XINT (quit) & (tty->meta_key == 0 ? 0177 : 0377); + quit_char = XFIXNUM (quit) & (tty->meta_key == 0 ? 0177 : 0377); #ifndef DOS_NT init_sys_modes (tty); @@ -10747,7 +10747,7 @@ The `posn-' functions access elements of such lists. */) CHECK_FIXNUM (x); /* We allow X of -1, for the newline in a R2L line that overflowed into the left fringe. */ - if (XINT (x) != -1) + if (XFIXNUM (x) != -1) CHECK_FIXNAT (x); CHECK_FIXNAT (y); @@ -10758,12 +10758,12 @@ The `posn-' functions access elements of such lists. */) { struct window *w = decode_live_window (frame_or_window); - XSETINT (x, (XINT (x) + XSETINT (x, (XFIXNUM (x) + WINDOW_LEFT_EDGE_X (w) + (NILP (whole) ? window_box_left_offset (w, TEXT_AREA) : 0))); - XSETINT (y, WINDOW_TO_FRAME_PIXEL_Y (w, XINT (y))); + XSETINT (y, WINDOW_TO_FRAME_PIXEL_Y (w, XFIXNUM (y))); frame_or_window = w->frame; } @@ -10796,15 +10796,15 @@ The `posn-' functions access elements of such lists. */) Lisp_Object x = XCAR (tem); Lisp_Object y = XCAR (XCDR (tem)); Lisp_Object aux_info = XCDR (XCDR (tem)); - int y_coord = XINT (y); + int y_coord = XFIXNUM (y); /* Point invisible due to hscrolling? X can be -1 when a newline in a R2L line overflows into the left fringe. */ - if (XINT (x) < -1) + if (XFIXNUM (x) < -1) return Qnil; if (!NILP (aux_info) && y_coord < 0) { - int rtop = XINT (XCAR (aux_info)); + int rtop = XFIXNUM (XCAR (aux_info)); y = make_fixnum (y_coord + rtop); } diff --git a/src/keymap.c b/src/keymap.c index a7e0557ebd..bdd3af2cdc 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -382,17 +382,17 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx, else if (FIXNUMP (idx)) /* Clobber the high bits that can be present on a machine with more than 24 bits of integer. */ - XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1))); + XSETFASTINT (idx, XFIXNUM (idx) & (CHAR_META | (CHAR_META - 1))); /* Handle the special meta -> esc mapping. */ - if (FIXNUMP (idx) && XFASTINT (idx) & meta_modifier) + if (FIXNUMP (idx) && XFIXNAT (idx) & meta_modifier) { /* See if there is a meta-map. If there's none, there is no binding for IDX, unless a default binding exists in MAP. */ Lisp_Object event_meta_binding, event_meta_map; /* A strange value in which Meta is set would cause infinite recursion. Protect against that. */ - if (XINT (meta_prefix_char) & CHAR_META) + if (XFIXNUM (meta_prefix_char) & CHAR_META) meta_prefix_char = make_fixnum (27); event_meta_binding = access_keymap_1 (map, meta_prefix_char, t_ok, noinherit, autoload); @@ -400,7 +400,7 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx, if (CONSP (event_meta_map)) { map = event_meta_map; - idx = make_fixnum (XFASTINT (idx) & ~meta_modifier); + idx = make_fixnum (XFIXNAT (idx) & ~meta_modifier); } else if (t_ok) /* Set IDX to t, so that we only find a default binding. */ @@ -473,15 +473,15 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx, } else if (VECTORP (binding)) { - if (FIXNUMP (idx) && XFASTINT (idx) < ASIZE (binding)) - val = AREF (binding, XFASTINT (idx)); + if (FIXNUMP (idx) && XFIXNAT (idx) < ASIZE (binding)) + val = AREF (binding, XFIXNAT (idx)); } else if (CHAR_TABLE_P (binding)) { /* Character codes with modifiers are not included in a char-table. All character codes without modifiers are included. */ - if (FIXNUMP (idx) && (XFASTINT (idx) & CHAR_MODIFIER_MASK) == 0) + if (FIXNUMP (idx) && (XFIXNAT (idx) & CHAR_MODIFIER_MASK) == 0) { val = Faref (binding, idx); /* nil has a special meaning for char-tables, so @@ -567,7 +567,7 @@ map_keymap_char_table_item (Lisp_Object args, Lisp_Object key, Lisp_Object val) it in place. */ if (CONSP (key)) key = Fcons (XCAR (key), XCDR (key)); - union map_keymap *md = XINTPTR (args); + union map_keymap *md = XFIXNUMPTR (args); map_keymap_item (md->s.fun, md->s.args, key, val, md->s.data); } } @@ -785,7 +785,7 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def) else if (FIXNUMP (idx)) /* Clobber the high bits that can be present on a machine with more than 24 bits of integer. */ - XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1))); + XSETFASTINT (idx, XFIXNUM (idx) & (CHAR_META | (CHAR_META - 1))); /* Scan the keymap for a binding of idx. */ { @@ -807,22 +807,22 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def) elt = XCAR (tail); if (VECTORP (elt)) { - if (FIXNATP (idx) && XFASTINT (idx) < ASIZE (elt)) + if (FIXNATP (idx) && XFIXNAT (idx) < ASIZE (elt)) { CHECK_IMPURE (elt, XVECTOR (elt)); - ASET (elt, XFASTINT (idx), def); + ASET (elt, XFIXNAT (idx), def); return def; } else if (CONSP (idx) && CHARACTERP (XCAR (idx))) { - int from = XFASTINT (XCAR (idx)); - int to = XFASTINT (XCDR (idx)); + int from = XFIXNAT (XCAR (idx)); + int to = XFIXNAT (XCDR (idx)); if (to >= ASIZE (elt)) to = ASIZE (elt) - 1; for (; from <= to; from++) ASET (elt, from, def); - if (to == XFASTINT (XCDR (idx))) + if (to == XFIXNAT (XCDR (idx))) /* We have defined all keys in IDX. */ return def; } @@ -833,7 +833,7 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def) /* Character codes with modifiers are not included in a char-table. All character codes without modifiers are included. */ - if (FIXNATP (idx) && !(XFASTINT (idx) & CHAR_MODIFIER_MASK)) + if (FIXNATP (idx) && !(XFIXNAT (idx) & CHAR_MODIFIER_MASK)) { Faset (elt, idx, /* nil has a special meaning for char-tables, so @@ -870,11 +870,11 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def) && CHARACTERP (XCAR (idx)) && CHARACTERP (XCAR (elt))) { - int from = XFASTINT (XCAR (idx)); - int to = XFASTINT (XCDR (idx)); + int from = XFIXNAT (XCAR (idx)); + int to = XFIXNAT (XCDR (idx)); - if (from <= XFASTINT (XCAR (elt)) - && to >= XFASTINT (XCAR (elt))) + if (from <= XFIXNAT (XCAR (elt)) + && to >= XFIXNAT (XCAR (elt))) { XSETCDR (elt, def); if (from == to) @@ -1124,7 +1124,7 @@ binding KEY to DEF is added at the front of KEYMAP. */) silly_event_symbol_error (c); if (FIXNUMP (c) - && (XINT (c) & meta_bit) + && (XFIXNUM (c) & meta_bit) && !metized) { c = meta_prefix_char; @@ -1133,7 +1133,7 @@ binding KEY to DEF is added at the front of KEYMAP. */) else { if (FIXNUMP (c)) - XSETINT (c, XINT (c) & ~meta_bit); + XSETINT (c, XFIXNUM (c) & ~meta_bit); metized = 0; idx++; @@ -1246,8 +1246,8 @@ recognize the default bindings, just as `read-key-sequence' does. */) c = Fevent_convert_list (c); /* Turn the 8th bit of string chars into a meta modifier. */ - if (STRINGP (key) && XINT (c) & 0x80 && !STRING_MULTIBYTE (key)) - XSETINT (c, (XINT (c) | meta_modifier) & ~0x80); + if (STRINGP (key) && XFIXNUM (c) & 0x80 && !STRING_MULTIBYTE (key)) + XSETINT (c, (XFIXNUM (c) | meta_modifier) & ~0x80); /* Allow string since binding for `menu-bar-select-buffer' includes the buffer name in the key sequence. */ @@ -1300,7 +1300,7 @@ silly_event_symbol_error (Lisp_Object c) int modifiers; parsed = parse_modifiers (c); - modifiers = XFASTINT (XCAR (XCDR (parsed))); + modifiers = XFIXNAT (XCAR (XCDR (parsed))); base = XCAR (parsed); name = Fsymbol_name (base); /* This alist includes elements such as ("RET" . "\\r"). */ @@ -1474,7 +1474,7 @@ current_minor_maps (Lisp_Object **modeptr, Lisp_Object **mapptr) static ptrdiff_t click_position (Lisp_Object position) { - EMACS_INT pos = (FIXNUMP (position) ? XINT (position) + EMACS_INT pos = (FIXNUMP (position) ? XFIXNUM (position) : MARKERP (position) ? marker_position (position) : PT); if (! (BEGV <= pos && pos <= ZV)) @@ -1553,12 +1553,12 @@ like in the respective argument of `key-binding'. */) pos = POSN_BUFFER_POSN (position); if (FIXNUMP (pos) - && XINT (pos) >= BEG && XINT (pos) <= Z) + && XFIXNUM (pos) >= BEG && XFIXNUM (pos) <= Z) { - local_map = get_local_map (XINT (pos), + local_map = get_local_map (XFIXNUM (pos), current_buffer, Qlocal_map); - keymap = get_local_map (XINT (pos), + keymap = get_local_map (XFIXNUM (pos), current_buffer, Qkeymap); } } @@ -1576,8 +1576,8 @@ like in the respective argument of `key-binding'. */) pos = XCDR (string); string = XCAR (string); if (FIXNUMP (pos) - && XINT (pos) >= 0 - && XINT (pos) < SCHARS (string)) + && XFIXNUM (pos) >= 0 + && XFIXNUM (pos) < SCHARS (string)) { map = Fget_text_property (pos, Qlocal_map, string); if (!NILP (map)) @@ -1854,8 +1854,8 @@ accessible_keymaps_1 (Lisp_Object key, Lisp_Object cmd, Lisp_Object args, void * while (!NILP (tem = Frassq (cmd, maps))) { Lisp_Object prefix = XCAR (tem); - ptrdiff_t lim = XINT (Flength (XCAR (tem))); - if (lim <= XINT (Flength (thisseq))) + ptrdiff_t lim = XFIXNUM (Flength (XCAR (tem))); + if (lim <= XFIXNUM (Flength (thisseq))) { /* This keymap was already seen with a smaller prefix. */ ptrdiff_t i = 0; while (i < lim && EQ (Faref (prefix, make_fixnum (i)), @@ -1879,10 +1879,10 @@ accessible_keymaps_1 (Lisp_Object key, Lisp_Object cmd, Lisp_Object args, void * if (is_metized) { int meta_bit = meta_modifier; - Lisp_Object last = make_fixnum (XINT (Flength (thisseq)) - 1); + Lisp_Object last = make_fixnum (XFIXNUM (Flength (thisseq)) - 1); tem = Fcopy_sequence (thisseq); - Faset (tem, last, make_fixnum (XINT (key) | meta_bit)); + Faset (tem, last, make_fixnum (XFIXNUM (key) | meta_bit)); /* This new sequence is the same length as thisseq, so stick it in the list right @@ -1910,7 +1910,7 @@ then the value includes only maps for prefixes that start with PREFIX. */) (Lisp_Object keymap, Lisp_Object prefix) { Lisp_Object maps, tail; - EMACS_INT prefixlen = XFASTINT (Flength (prefix)); + EMACS_INT prefixlen = XFIXNAT (Flength (prefix)); if (!NILP (prefix)) { @@ -1969,11 +1969,11 @@ then the value includes only maps for prefixes that start with PREFIX. */) data.thisseq = Fcar (XCAR (tail)); data.maps = maps; data.tail = tail; - last = make_fixnum (XINT (Flength (data.thisseq)) - 1); + last = make_fixnum (XFIXNUM (Flength (data.thisseq)) - 1); /* Does the current sequence end in the meta-prefix-char? */ - data.is_metized = (XINT (last) >= 0 + data.is_metized = (XFIXNUM (last) >= 0 /* Don't metize the last char of PREFIX. */ - && XINT (last) >= prefixlen + && XFIXNUM (last) >= prefixlen && EQ (Faref (data.thisseq, last), meta_prefix_char)); /* Since we can't run lisp code, we can't scan autoloaded maps. */ @@ -1997,7 +1997,7 @@ For an approximate inverse of this, see `kbd'. */) EMACS_INT i; ptrdiff_t i_byte; Lisp_Object *args; - EMACS_INT size = XINT (Flength (keys)); + EMACS_INT size = XFIXNUM (Flength (keys)); Lisp_Object list; Lisp_Object sep = build_string (" "); Lisp_Object key; @@ -2006,7 +2006,7 @@ For an approximate inverse of this, see `kbd'. */) USE_SAFE_ALLOCA; if (!NILP (prefix)) - size += XINT (Flength (prefix)); + size += XFIXNUM (Flength (prefix)); /* This has one extra element at the end that we don't pass to Fconcat. */ EMACS_INT size4; @@ -2043,7 +2043,7 @@ For an approximate inverse of this, see `kbd'. */) else if (VECTORP (list)) size = ASIZE (list); else if (CONSP (list)) - size = XINT (Flength (list)); + size = XFIXNUM (Flength (list)); else wrong_type_argument (Qarrayp, list); @@ -2074,7 +2074,7 @@ For an approximate inverse of this, see `kbd'. */) { if (!FIXNUMP (key) || EQ (key, meta_prefix_char) - || (XINT (key) & meta_modifier)) + || (XFIXNUM (key) & meta_modifier)) { args[len++] = Fsingle_key_description (meta_prefix_char, Qnil); args[len++] = sep; @@ -2082,7 +2082,7 @@ For an approximate inverse of this, see `kbd'. */) continue; } else - XSETINT (key, XINT (key) | meta_modifier); + XSETINT (key, XFIXNUM (key) | meta_modifier); add_meta = 0; } else if (EQ (key, meta_prefix_char)) @@ -2240,7 +2240,7 @@ around function keys and event symbols. */) if (FIXNUMP (key)) /* Normal character. */ { char tem[KEY_DESCRIPTION_SIZE]; - char *p = push_key_description (XINT (key), tem); + char *p = push_key_description (XFIXNUM (key), tem); *p = 0; return make_specified_string (tem, -1, p - tem, 1); } @@ -2306,7 +2306,7 @@ See Info node `(elisp)Describing Characters' for examples. */) CHECK_CHARACTER (character); - c = XINT (character); + c = XFIXNUM (character); if (!ASCII_CHAR_P (c)) { int len = CHAR_STRING (c, (unsigned char *) str); @@ -2328,7 +2328,7 @@ static int preferred_sequence_p (Lisp_Object seq) { EMACS_INT i; - EMACS_INT len = XFASTINT (Flength (seq)); + EMACS_INT len = XFIXNAT (Flength (seq)); int result = 1; for (i = 0; i < len; i++) @@ -2342,7 +2342,7 @@ preferred_sequence_p (Lisp_Object seq) return 0; else { - int modifiers = XINT (elt) & (CHAR_MODIFIER_MASK & ~CHAR_META); + int modifiers = XFIXNUM (elt) & (CHAR_MODIFIER_MASK & ~CHAR_META); if (modifiers == where_is_preferred_modifier) result = 2; else if (modifiers) @@ -2463,12 +2463,12 @@ where_is_internal (Lisp_Object definition, Lisp_Object keymaps, this = Fcar (XCAR (maps)); map = Fcdr (XCAR (maps)); - last = make_fixnum (XINT (Flength (this)) - 1); - last_is_meta = (XINT (last) >= 0 + last = make_fixnum (XFIXNUM (Flength (this)) - 1); + last_is_meta = (XFIXNUM (last) >= 0 && EQ (Faref (this, last), meta_prefix_char)); /* if (nomenus && !preferred_sequence_p (this)) */ - if (nomenus && XINT (last) >= 0 + if (nomenus && XFIXNUM (last) >= 0 && SYMBOLP (tem = Faref (this, make_fixnum (0))) && !NILP (Fmemq (XCAR (parse_modifiers (tem)), Vmouse_events))) /* If no menu entries should be returned, skip over the @@ -2720,7 +2720,7 @@ where_is_internal_1 (Lisp_Object key, Lisp_Object binding, Lisp_Object args, voi if (FIXNUMP (key) && last_is_meta) { sequence = Fcopy_sequence (this); - Faset (sequence, last, make_fixnum (XINT (key) | meta_modifier)); + Faset (sequence, last, make_fixnum (XFIXNUM (key) | meta_modifier)); } else { @@ -3126,8 +3126,8 @@ describe_map_compare (const void *aa, const void *bb) { const struct describe_map_elt *a = aa, *b = bb; if (FIXNUMP (a->event) && FIXNUMP (b->event)) - return ((XINT (a->event) > XINT (b->event)) - - (XINT (a->event) < XINT (b->event))); + return ((XFIXNUM (a->event) > XFIXNUM (b->event)) + - (XFIXNUM (a->event) < XFIXNUM (b->event))); if (!FIXNUMP (a->event) && FIXNUMP (b->event)) return 1; if (FIXNUMP (a->event) && !FIXNUMP (b->event)) @@ -3285,7 +3285,7 @@ describe_map (Lisp_Object map, Lisp_Object prefix, if (FIXNUMP (vect[i].event)) { while (i + 1 < slots_used - && EQ (vect[i+1].event, make_fixnum (XINT (vect[i].event) + 1)) + && EQ (vect[i+1].event, make_fixnum (XFIXNUM (vect[i].event) + 1)) && !NILP (Fequal (vect[i + 1].definition, definition)) && vect[i].shadowed == vect[i + 1].shadowed) i++; @@ -3407,7 +3407,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args, if (!keymap_p) { /* Call Fkey_description first, to avoid GC bug for the other string. */ - if (!NILP (prefix) && XFASTINT (Flength (prefix)) > 0) + if (!NILP (prefix) && XFIXNAT (Flength (prefix)) > 0) { Lisp_Object tem = Fkey_description (prefix, Qnil); AUTO_STRING (space, " "); diff --git a/src/kqueue.c b/src/kqueue.c index b45c316b93..bc01ab5062 100644 --- a/src/kqueue.c +++ b/src/kqueue.c @@ -234,7 +234,7 @@ kqueue_compare_dir_list (Lisp_Object watch_object) /* Check size of that file. */ Lisp_Object size = Fnth (make_fixnum (4), entry); - if (FLOATP (size) || (XINT (size) > 0)) + if (FLOATP (size) || (XFIXNUM (size) > 0)) kqueue_generate_event (watch_object, Fcons (Qwrite, Qnil), XCAR (XCDR (entry)), Qnil); @@ -395,7 +395,7 @@ only when the upper directory of the renamed file is watched. */) maxfd = 256; /* We assume 50 file descriptors are sufficient for the rest of Emacs. */ - if ((maxfd - 50) < XINT (Flength (watch_list))) + if ((maxfd - 50) < XFIXNUM (Flength (watch_list))) xsignal2 (Qfile_notify_error, build_string ("File watching not possible, no file descriptor left"), @@ -474,7 +474,7 @@ WATCH-DESCRIPTOR should be an object returned by `kqueue-add-watch'. */) watch_descriptor); eassert (FIXNUMP (watch_descriptor)); - int fd = XINT (watch_descriptor); + int fd = XFIXNUM (watch_descriptor); if ( fd >= 0) emacs_close (fd); diff --git a/src/lcms.c b/src/lcms.c index 9df85c2c18..a3a9822306 100644 --- a/src/lcms.c +++ b/src/lcms.c @@ -254,7 +254,7 @@ parse_viewing_conditions (Lisp_Object view, const cmsCIEXYZ *wp, if (CONSP (view) && FIXNATP (XCAR (view))) \ { \ CHECK_RANGED_INTEGER (XCAR (view), 1, 4); \ - vc->field = XINT (XCAR (view)); \ + vc->field = XFIXNUM (XCAR (view)); \ view = XCDR (view); \ } \ else \ diff --git a/src/lisp.h b/src/lisp.h index b404f9d89a..9047d21724 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -382,15 +382,15 @@ typedef EMACS_INT Lisp_Word; #define lisp_h_XCDR(c) XCONS (c)->u.s.u.cdr #define lisp_h_XCONS(a) \ (eassert (CONSP (a)), XUNTAG (a, Lisp_Cons, struct Lisp_Cons)) -#define lisp_h_XHASH(a) XUINT (a) +#define lisp_h_XHASH(a) XUFIXNUM (a) #ifndef GC_CHECK_CONS_LIST # define lisp_h_check_cons_list() ((void) 0) #endif #if USE_LSB_TAG # define lisp_h_make_fixnum(n) \ XIL ((EMACS_INT) (((EMACS_UINT) (n) << INTTYPEBITS) + Lisp_Int0)) -# define lisp_h_XFASTINT(a) XINT (a) -# define lisp_h_XINT(a) (XLI (a) >> INTTYPEBITS) +# define lisp_h_XFIXNAT(a) XFIXNUM (a) +# define lisp_h_XFIXNUM(a) (XLI (a) >> INTTYPEBITS) # ifdef __CHKP__ # define lisp_h_XSYMBOL(a) \ (eassert (SYMBOLP (a)), \ @@ -448,8 +448,8 @@ typedef EMACS_INT Lisp_Word; # endif # if USE_LSB_TAG # define make_fixnum(n) lisp_h_make_fixnum (n) -# define XFASTINT(a) lisp_h_XFASTINT (a) -# define XINT(a) lisp_h_XINT (a) +# define XFIXNAT(a) lisp_h_XFIXNAT (a) +# define XFIXNUM(a) lisp_h_XFIXNUM (a) # define XSYMBOL(a) lisp_h_XSYMBOL (a) # define XTYPE(a) lisp_h_XTYPE (a) # endif @@ -486,7 +486,7 @@ enum Lisp_Type whose first member indicates the subtype. */ Lisp_Misc = 1, - /* Integer. XINT (obj) is the integer value. */ + /* Integer. XFIXNUM (obj) is the integer value. */ Lisp_Int0 = 2, Lisp_Int1 = USE_LSB_TAG ? 6 : 3, @@ -1038,15 +1038,15 @@ INLINE Lisp_Object } INLINE EMACS_INT -(XINT) (Lisp_Object a) +(XFIXNUM) (Lisp_Object a) { - return lisp_h_XINT (a); + return lisp_h_XFIXNUM (a); } INLINE EMACS_INT -(XFASTINT) (Lisp_Object a) +(XFIXNAT) (Lisp_Object a) { - EMACS_INT n = lisp_h_XFASTINT (a); + EMACS_INT n = lisp_h_XFIXNAT (a); eassume (0 <= n); return n; } @@ -1079,7 +1079,7 @@ make_fixnum (EMACS_INT n) /* Extract A's value as a signed integer. */ INLINE EMACS_INT -XINT (Lisp_Object a) +XFIXNUM (Lisp_Object a) { EMACS_INT i = XLI (a); if (! USE_LSB_TAG) @@ -1090,14 +1090,14 @@ XINT (Lisp_Object a) return i >> INTTYPEBITS; } -/* Like XINT (A), but may be faster. A must be nonnegative. +/* Like XFIXNUM (A), but may be faster. A must be nonnegative. If ! USE_LSB_TAG, this takes advantage of the fact that Lisp integers have zero-bits in their tags. */ INLINE EMACS_INT -XFASTINT (Lisp_Object a) +XFIXNAT (Lisp_Object a) { EMACS_INT int0 = Lisp_Int0; - EMACS_INT n = USE_LSB_TAG ? XINT (a) : XLI (a) - (int0 << VALBITS); + EMACS_INT n = USE_LSB_TAG ? XFIXNUM (a) : XLI (a) - (int0 << VALBITS); eassume (0 <= n); return n; } @@ -1106,14 +1106,14 @@ XFASTINT (Lisp_Object a) /* Extract A's value as an unsigned integer. */ INLINE EMACS_UINT -XUINT (Lisp_Object a) +XUFIXNUM (Lisp_Object a) { EMACS_UINT i = XLI (a); return USE_LSB_TAG ? i >> INTTYPEBITS : i & INTMASK; } -/* Return A's (Lisp-integer sized) hash. Happens to be like XUINT - right now, but XUINT should only be applied to objects we know are +/* Return A's (Lisp-integer sized) hash. Happens to be like XUFIXNUM + right now, but XUFIXNUM should only be applied to objects we know are integers. */ INLINE EMACS_INT @@ -1218,7 +1218,7 @@ INLINE bool bits set, which makes this conversion inherently unportable. */ INLINE void * -XINTPTR (Lisp_Object a) +XFIXNUMPTR (Lisp_Object a) { return XUNTAG (a, Lisp_Int0, char); } @@ -1227,7 +1227,7 @@ INLINE Lisp_Object make_pointer_integer (void *p) { Lisp_Object a = TAG_PTR (Lisp_Int0, p); - eassert (FIXNUMP (a) && XINTPTR (a) == p); + eassert (FIXNUMP (a) && XFIXNUMPTR (a) == p); return a; } @@ -2378,10 +2378,10 @@ extern Lisp_Object make_misc_ptr (void *); /* A mint_ptr object OBJ represents a C-language pointer P efficiently. Preferably (and typically), OBJ is a Lisp integer I such that - XINTPTR (I) == P, as this represents P within a single Lisp value + XFIXNUMPTR (I) == P, as this represents P within a single Lisp value without requiring any auxiliary memory. However, if P would be damaged by being tagged as an integer and then untagged via - XINTPTR, then OBJ is a Lisp_Misc_Ptr with pointer component P. + XFIXNUMPTR, then OBJ is a Lisp_Misc_Ptr with pointer component P. mint_ptr objects are efficiency hacks intended for C code. Although xmint_ptr can be given any mint_ptr generated by non-buggy @@ -2395,7 +2395,7 @@ INLINE Lisp_Object make_mint_ptr (void *a) { Lisp_Object val = TAG_PTR (Lisp_Int0, a); - return FIXNUMP (val) && XINTPTR (val) == a ? val : make_misc_ptr (a); + return FIXNUMP (val) && XFIXNUMPTR (val) == a ? val : make_misc_ptr (a); } INLINE bool @@ -2409,7 +2409,7 @@ xmint_pointer (Lisp_Object a) { eassert (mint_ptrp (a)); if (FIXNUMP (a)) - return XINTPTR (a); + return XFIXNUMPTR (a); return XUNTAG (a, Lisp_Misc, struct Lisp_Misc_Ptr)->pointer; } @@ -2766,14 +2766,14 @@ FIXED_OR_FLOATP (Lisp_Object x) INLINE bool FIXNATP (Lisp_Object x) { - return FIXNUMP (x) && 0 <= XINT (x); + return FIXNUMP (x) && 0 <= XFIXNUM (x); } INLINE bool NATNUMP (Lisp_Object x) { if (BIGNUMP (x)) return mpz_cmp_si (XBIGNUM (x)->value, 0) >= 0; - return FIXNUMP (x) && 0 <= XINT (x); + return FIXNUMP (x) && 0 <= XFIXNUM (x); } INLINE bool NUMBERP (Lisp_Object x) @@ -2784,13 +2784,13 @@ NUMBERP (Lisp_Object x) INLINE bool RANGED_FIXNUMP (intmax_t lo, Lisp_Object x, intmax_t hi) { - return FIXNUMP (x) && lo <= XINT (x) && XINT (x) <= hi; + return FIXNUMP (x) && lo <= XFIXNUM (x) && XFIXNUM (x) <= hi; } #define TYPE_RANGED_FIXNUMP(type, x) \ (FIXNUMP (x) \ - && (TYPE_SIGNED (type) ? TYPE_MINIMUM (type) <= XINT (x) : 0 <= XINT (x)) \ - && XINT (x) <= TYPE_MAXIMUM (type)) + && (TYPE_SIGNED (type) ? TYPE_MINIMUM (type) <= XFIXNUM (x) : 0 <= XFIXNUM (x)) \ + && XFIXNUM (x) <= TYPE_MAXIMUM (type)) INLINE bool AUTOLOADP (Lisp_Object x) @@ -2892,7 +2892,7 @@ CHECK_FIXNAT (Lisp_Object x) #define CHECK_RANGED_INTEGER(x, lo, hi) \ do { \ CHECK_FIXNUM (x); \ - if (! ((lo) <= XINT (x) && XINT (x) <= (hi))) \ + if (! ((lo) <= XFIXNUM (x) && XFIXNUM (x) <= (hi))) \ args_out_of_range_3 \ (x, \ make_fixnum ((lo) < 0 && (lo) < MOST_NEGATIVE_FIXNUM \ @@ -2921,7 +2921,7 @@ XFLOATINT (Lisp_Object n) { if (BIGNUMP (n)) return mpz_get_d (XBIGNUM (n)->value); - return FLOATP (n) ? XFLOAT_DATA (n) : XINT (n); + return FLOATP (n) ? XFLOAT_DATA (n) : XFIXNUM (n); } INLINE void diff --git a/src/lread.c b/src/lread.c index ff86c96c9b..bcb695c3da 100644 --- a/src/lread.c +++ b/src/lread.c @@ -331,7 +331,7 @@ readchar (Lisp_Object readcharfun, bool *multibyte) if (NILP (tem)) return -1; - return XINT (tem); + return XFIXNUM (tem); read_multibyte: if (unread_char >= 0) @@ -673,7 +673,7 @@ read_filtered_event (bool no_switch_frame, bool ascii_required, do val = read_char (0, Qnil, (input_method ? Qnil : Qt), 0, FIXED_OR_FLOATP (seconds) ? &end_time : NULL); - while (FIXNUMP (val) && XINT (val) == -2); /* wrong_kboard_jmpbuf */ + while (FIXNUMP (val) && XFIXNUM (val) == -2); /* wrong_kboard_jmpbuf */ if (BUFFERP (val)) goto retry; @@ -704,7 +704,7 @@ read_filtered_event (bool no_switch_frame, bool ascii_required, /* Merge this symbol's modifier bits with the ASCII equivalent of its basic code. */ if (!NILP (tem1)) - XSETFASTINT (val, XINT (tem1) | XINT (Fcar (Fcdr (tem)))); + XSETFASTINT (val, XFIXNUM (tem1) | XFIXNUM (Fcar (Fcdr (tem)))); } } @@ -766,7 +766,7 @@ floating-point value. */) val = read_filtered_event (1, 1, 1, ! NILP (inherit_input_method), seconds); return (NILP (val) ? Qnil - : make_fixnum (char_resolve_modifier_mask (XINT (val)))); + : make_fixnum (char_resolve_modifier_mask (XFIXNUM (val)))); } DEFUN ("read-event", Fread_event, Sread_event, 0, 3, 0, @@ -810,7 +810,7 @@ floating-point value. */) val = read_filtered_event (1, 1, 0, ! NILP (inherit_input_method), seconds); return (NILP (val) ? Qnil - : make_fixnum (char_resolve_modifier_mask (XINT (val)))); + : make_fixnum (char_resolve_modifier_mask (XFIXNUM (val)))); } DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0, @@ -1702,9 +1702,9 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, if (FIXNATP (predicate)) { fd = -1; - if (INT_MAX < XFASTINT (predicate)) + if (INT_MAX < XFIXNAT (predicate)) last_errno = EINVAL; - else if (faccessat (AT_FDCWD, pfn, XFASTINT (predicate), + else if (faccessat (AT_FDCWD, pfn, XFIXNAT (predicate), AT_EACCESS) == 0) { @@ -2348,14 +2348,14 @@ character_name_to_code (char const *name, ptrdiff_t name_len) : call2 (Qchar_from_name, make_unibyte_string (name, name_len), Qt)); if (! RANGED_FIXNUMP (0, code, MAX_UNICODE_CHAR) - || char_surrogate_p (XINT (code))) + || char_surrogate_p (XFIXNUM (code))) { AUTO_STRING (format, "\\N{%s}"); AUTO_STRING_WITH_LEN (namestr, name, name_len); xsignal1 (Qinvalid_read_syntax, CALLN (Fformat, format, namestr)); } - return XINT (code); + return XFIXNUM (code); } /* Bound on the length of a Unicode character name. As of @@ -2779,7 +2779,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) if (!EQ (head, Qhash_table)) { - ptrdiff_t size = XINT (Flength (tmp)); + ptrdiff_t size = XFIXNUM (Flength (tmp)); Lisp_Object record = Fmake_record (CAR_SAFE (tmp), make_fixnum (size - 1), Qnil); @@ -2866,7 +2866,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) /* Sub char-table can't be read as a regular vector because of a two C integer fields. */ Lisp_Object tbl, tmp = read_list (1, readcharfun); - ptrdiff_t size = XINT (Flength (tmp)); + ptrdiff_t size = XFIXNUM (Flength (tmp)); int i, depth, min_char; struct Lisp_Cons *cell; @@ -2875,7 +2875,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) if (! RANGED_FIXNUMP (1, XCAR (tmp), 3)) error ("Invalid depth in sub char-table"); - depth = XINT (XCAR (tmp)); + depth = XFIXNUM (XCAR (tmp)); if (chartab_size[depth] != size - 2) error ("Invalid size in sub char-table"); cell = XCONS (tmp), tmp = XCDR (tmp), size--; @@ -2883,7 +2883,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) if (! RANGED_FIXNUMP (0, XCAR (tmp), MAX_CHAR)) error ("Invalid minimum character in sub-char-table"); - min_char = XINT (XCAR (tmp)); + min_char = XFIXNUM (XCAR (tmp)); cell = XCONS (tmp), tmp = XCDR (tmp), size--; free_cons (cell); @@ -2908,7 +2908,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) if (c == '"') { Lisp_Object tmp, val; - EMACS_INT size_in_chars = bool_vector_bytes (XFASTINT (length)); + EMACS_INT size_in_chars = bool_vector_bytes (XFIXNAT (length)); unsigned char *data; UNREAD (c); @@ -2919,17 +2919,17 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) when the number of bits was a multiple of 8. Accept such input in case it came from an old version. */ - && ! (XFASTINT (length) + && ! (XFIXNAT (length) == (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR))) invalid_syntax ("#&..."); - val = make_uninit_bool_vector (XFASTINT (length)); + val = make_uninit_bool_vector (XFIXNAT (length)); data = bool_vector_uchar_data (val); memcpy (data, SDATA (tmp), size_in_chars); /* Clear the extraneous bits in the last byte. */ - if (XINT (length) != size_in_chars * BOOL_VECTOR_BITS_PER_CHAR) + if (XFIXNUM (length) != size_in_chars * BOOL_VECTOR_BITS_PER_CHAR) data[size_in_chars - 1] - &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1; + &= (1 << (XFIXNUM (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1; return val; } invalid_syntax ("#&..."); @@ -3832,11 +3832,11 @@ read_vector (Lisp_Object readcharfun, bool bytecodeflag) tem = read_list (1, readcharfun); len = Flength (tem); - if (bytecodeflag && XFASTINT (len) <= COMPILED_STACK_DEPTH) + if (bytecodeflag && XFIXNAT (len) <= COMPILED_STACK_DEPTH) error ("Invalid byte code"); vector = Fmake_vector (len, Qnil); - size = XFASTINT (len); + size = XFIXNAT (len); ptr = XVECTOR (vector)->contents; for (i = 0; i < size; i++) { @@ -3990,7 +3990,7 @@ read_list (bool flag, Lisp_Object readcharfun) multibyte. */ /* Position is negative for user variables. */ - EMACS_INT pos = eabs (XINT (XCDR (val))); + EMACS_INT pos = eabs (XFIXNUM (XCDR (val))); if (pos >= saved_doc_string_position && pos < (saved_doc_string_position + saved_doc_string_length)) @@ -4095,7 +4095,7 @@ intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index) SET_SYMBOL_VAL (XSYMBOL (sym), sym); } - ptr = aref_addr (obarray, XINT (index)); + ptr = aref_addr (obarray, XFIXNUM (index)); set_symbol_next (sym, SYMBOLP (*ptr) ? XSYMBOL (*ptr) : NULL); *ptr = sym; return sym; diff --git a/src/macros.c b/src/macros.c index be84106992..0677021bfd 100644 --- a/src/macros.c +++ b/src/macros.c @@ -98,8 +98,8 @@ macro before appending to it. */) { Lisp_Object c; c = Faref (KVAR (current_kboard, Vlast_kbd_macro), make_fixnum (i)); - if (cvt && FIXNATP (c) && (XFASTINT (c) & 0x80)) - XSETFASTINT (c, CHAR_META | (XFASTINT (c) & ~0x80)); + if (cvt && FIXNATP (c) && (XFIXNAT (c) & 0x80)) + XSETFASTINT (c, CHAR_META | (XFIXNAT (c) & ~0x80)); current_kboard->kbd_macro_buffer[i] = c; } @@ -162,11 +162,11 @@ each iteration of the macro. Iteration stops if LOOPFUNC returns nil. */) message1 ("Keyboard macro defined"); } - if (XFASTINT (repeat) == 0) + if (XFIXNAT (repeat) == 0) Fexecute_kbd_macro (KVAR (current_kboard, Vlast_kbd_macro), repeat, loopfunc); - else if (XINT (repeat) > 1) + else if (XFIXNUM (repeat) > 1) { - XSETINT (repeat, XINT (repeat) - 1); + XSETINT (repeat, XFIXNUM (repeat) - 1); Fexecute_kbd_macro (KVAR (current_kboard, Vlast_kbd_macro), repeat, loopfunc); } @@ -267,7 +267,7 @@ pop_kbd_macro (Lisp_Object info) Lisp_Object tem; Vexecuting_kbd_macro = XCAR (info); tem = XCDR (info); - executing_kbd_macro_index = XINT (XCAR (tem)); + executing_kbd_macro_index = XFIXNUM (XCAR (tem)); Vreal_this_command = XCDR (tem); run_hook (Qkbd_macro_termination_hook); } @@ -293,7 +293,7 @@ each iteration of the macro. Iteration stops if LOOPFUNC returns nil. */) if (!NILP (count)) { count = Fprefix_numeric_value (count); - repeat = XINT (count); + repeat = XFIXNUM (count); } final = indirect_function (macro); diff --git a/src/marker.c b/src/marker.c index ab1eb9f5bf..b9ea5c5982 100644 --- a/src/marker.c +++ b/src/marker.c @@ -525,7 +525,7 @@ set_marker_internal (Lisp_Object marker, Lisp_Object position, don't want to call buf_charpos_to_bytepos if POSITION is a marker and so we know the bytepos already. */ if (FIXNUMP (position)) - charpos = XINT (position), bytepos = -1; + charpos = XFIXNUM (position), bytepos = -1; else if (MARKERP (position)) { charpos = XMARKER (position)->charpos; @@ -752,7 +752,7 @@ DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, Sbuffer_has_markers_at, register struct Lisp_Marker *tail; register ptrdiff_t charpos; - charpos = clip_to_bounds (BEG, XINT (position), Z); + charpos = clip_to_bounds (BEG, XFIXNUM (position), Z); for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next) if (tail->charpos == charpos) diff --git a/src/menu.c b/src/menu.c index 1d0ba3c258..eac82017d3 100644 --- a/src/menu.c +++ b/src/menu.c @@ -134,11 +134,11 @@ restore_menu_items (Lisp_Object saved) menu_items_inuse = (! NILP (menu_items) ? Qt : Qnil); menu_items_allocated = (VECTORP (menu_items) ? ASIZE (menu_items) : 0); saved = XCDR (saved); - menu_items_used = XINT (XCAR (saved)); + menu_items_used = XFIXNUM (XCAR (saved)); saved = XCDR (saved); - menu_items_n_panes = XINT (XCAR (saved)); + menu_items_n_panes = XFIXNUM (XCAR (saved)); saved = XCDR (saved); - menu_items_submenu_depth = XINT (XCAR (saved)); + menu_items_submenu_depth = XFIXNUM (XCAR (saved)); } /* Push the whole state of menu_items processing onto the specpdl. @@ -532,7 +532,7 @@ parse_single_submenu (Lisp_Object item_key, Lisp_Object item_name, USE_SAFE_ALLOCA; length = Flength (maps); - len = XINT (length); + len = XFIXNUM (length); /* Convert the list MAPS into a vector MAPVEC. */ SAFE_ALLOCA_LISP (mapvec, len); @@ -1079,7 +1079,7 @@ into menu items. */) if (!FRAME_LIVE_P (f)) return Qnil; - pixel_to_glyph_coords (f, XINT (x), XINT (y), &col, &row, NULL, 1); + pixel_to_glyph_coords (f, XFIXNUM (x), XFIXNUM (y), &col, &row, NULL, 1); if (0 <= row && row < FRAME_MENU_BAR_LINES (f)) { Lisp_Object items, item; @@ -1099,10 +1099,10 @@ into menu items. */) pos = AREF (items, i + 3); if (NILP (str)) return item; - if (XINT (pos) <= col + if (XFIXNUM (pos) <= col /* We use <= so the blank between 2 items on a TTY is considered part of the previous item. */ - && col <= XINT (pos) + menu_item_width (SDATA (str))) + && col <= XFIXNUM (pos) + menu_item_width (SDATA (str))) { item = AREF (items, i); return item; @@ -1268,8 +1268,8 @@ x_popup_menu_1 (Lisp_Object position, Lisp_Object menu) ? (EMACS_INT) INT_MIN - ypos : MOST_NEGATIVE_FIXNUM), INT_MAX - ypos); - xpos += XINT (x); - ypos += XINT (y); + xpos += XFIXNUM (x); + ypos += XFIXNUM (y); XSETFRAME (Vmenu_updating_frame, f); } @@ -1309,7 +1309,7 @@ x_popup_menu_1 (Lisp_Object position, Lisp_Object menu) else if (CONSP (menu) && KEYMAPP (XCAR (menu))) { /* We were given a list of keymaps. */ - EMACS_INT nmaps = XFASTINT (Flength (menu)); + EMACS_INT nmaps = XFIXNAT (Flength (menu)); Lisp_Object *maps; ptrdiff_t i; USE_SAFE_ALLOCA; diff --git a/src/minibuf.c b/src/minibuf.c index a6d03b2cb5..751d6bda16 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -157,7 +157,7 @@ string_to_object (Lisp_Object val, Lisp_Object defalt) } expr_and_pos = Fread_from_string (val, Qnil, Qnil); - pos = XINT (Fcdr (expr_and_pos)); + pos = XFIXNUM (Fcdr (expr_and_pos)); if (pos != SCHARS (val)) { /* Ignore trailing whitespace; any other trailing junk @@ -198,7 +198,7 @@ read_minibuf_noninteractive (Lisp_Object map, Lisp_Object initial, /* Check, whether we need to suppress echoing. */ if (CHARACTERP (Vread_hide_char)) - hide_char = XFASTINT (Vread_hide_char); + hide_char = XFIXNAT (Vread_hide_char); /* Manipulate tty. */ if (hide_char) @@ -299,7 +299,7 @@ Return (point-min) if current buffer is not a minibuffer. */) end = Ffield_end (beg, Qnil, Qnil); - if (XINT (end) == ZV && NILP (Fget_char_property (beg, Qfield, Qnil))) + if (XFIXNUM (end) == ZV && NILP (Fget_char_property (beg, Qfield, Qnil))) return beg; else return end; @@ -311,7 +311,7 @@ DEFUN ("minibuffer-contents", Fminibuffer_contents, If the current buffer is not a minibuffer, return its entire contents. */) (void) { - ptrdiff_t prompt_end = XINT (Fminibuffer_prompt_end ()); + ptrdiff_t prompt_end = XFIXNUM (Fminibuffer_prompt_end ()); return make_buffer_string (prompt_end, ZV, 1); } @@ -321,7 +321,7 @@ DEFUN ("minibuffer-contents-no-properties", Fminibuffer_contents_no_properties, If the current buffer is not a minibuffer, return its entire contents. */) (void) { - ptrdiff_t prompt_end = XINT (Fminibuffer_prompt_end ()); + ptrdiff_t prompt_end = XFIXNUM (Fminibuffer_prompt_end ()); return make_buffer_string (prompt_end, ZV, 0); } @@ -395,11 +395,11 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, { CHECK_FIXNUM (backup_n); /* Convert to distance from end of input. */ - if (XINT (backup_n) < 1) + if (XFIXNUM (backup_n) < 1) /* A number too small means the beginning of the string. */ pos = - SCHARS (initial); else - pos = XINT (backup_n) - 1 - SCHARS (initial); + pos = XFIXNUM (backup_n) - 1 - SCHARS (initial); } } else @@ -788,12 +788,12 @@ read_minibuf_unwind (void) /* Restore prompt, etc, from outer minibuffer level. */ Lisp_Object key_vec = Fcar (minibuf_save_list); eassert (VECTORP (key_vec)); - this_command_key_count = XFASTINT (Flength (key_vec)); + this_command_key_count = XFIXNAT (Flength (key_vec)); this_command_keys = key_vec; minibuf_save_list = Fcdr (minibuf_save_list); minibuf_prompt = Fcar (minibuf_save_list); minibuf_save_list = Fcdr (minibuf_save_list); - minibuf_prompt_width = XFASTINT (Fcar (minibuf_save_list)); + minibuf_prompt_width = XFIXNAT (Fcar (minibuf_save_list)); minibuf_save_list = Fcdr (minibuf_save_list); Vhelp_form = Fcar (minibuf_save_list); minibuf_save_list = Fcdr (minibuf_save_list); @@ -1327,7 +1327,7 @@ is used to further constrain the set of candidates. */) eltstring, zero, make_fixnum (compare), completion_ignore_case ? Qt : Qnil); - matchsize = EQ (tem, Qt) ? compare : eabs (XINT (tem)) - 1; + matchsize = EQ (tem, Qt) ? compare : eabs (XFIXNUM (tem)) - 1; if (completion_ignore_case) { diff --git a/src/msdos.c b/src/msdos.c index 4f38b1de7d..4031c579df 100644 --- a/src/msdos.c +++ b/src/msdos.c @@ -224,7 +224,7 @@ them. This happens with wheeled mice on Windows 9X, for example. */) int n; CHECK_FIXNUM (nbuttons); - n = XINT (nbuttons); + n = XFIXNUM (nbuttons); if (n < 2 || n > 3) xsignal2 (Qargs_out_of_range, build_string ("only 2 or 3 mouse buttons are supported"), @@ -540,7 +540,7 @@ dos_set_window_size (int *rows, int *cols) *rows, *cols), Qnil)); if (FIXNUMP (video_mode) - && (video_mode_value = XINT (video_mode)) > 0) + && (video_mode_value = XFIXNUM (video_mode)) > 0) { regs.x.ax = video_mode_value; int86 (0x10, ®s, ®s); @@ -746,7 +746,7 @@ IT_set_cursor_type (struct frame *f, Lisp_Object cursor_type) { /* Feature: negative WIDTH means cursor at the top of the character cell, zero means invisible cursor. */ - width = XINT (bar_parms); + width = XFIXNUM (bar_parms); msdos_set_cursor_shape (f, width >= 0 ? DEFAULT_CURSOR_START : 0, width); } @@ -754,9 +754,9 @@ IT_set_cursor_type (struct frame *f, Lisp_Object cursor_type) && FIXNUMP (XCAR (bar_parms)) && FIXNUMP (XCDR (bar_parms))) { - int start_line = XINT (XCDR (bar_parms)); + int start_line = XFIXNUM (XCDR (bar_parms)); - width = XINT (XCAR (bar_parms)); + width = XFIXNUM (XCAR (bar_parms)); msdos_set_cursor_shape (f, start_line, width); } } @@ -1564,7 +1564,7 @@ void IT_set_frame_parameters (struct frame *f, Lisp_Object alist) { Lisp_Object tail; - int i, j, length = XINT (Flength (alist)); + int i, j, length = XFIXNUM (Flength (alist)); Lisp_Object *parms = (Lisp_Object *) alloca (length * word_size); Lisp_Object *values diff --git a/src/print.c b/src/print.c index 2b1d1fec72..998ff2dc0c 100644 --- a/src/print.c +++ b/src/print.c @@ -261,7 +261,7 @@ printchar_to_stream (unsigned int ch, FILE *stream) break; if (! (i < n)) break; - ch = XFASTINT (AREF (dv, i)); + ch = XFIXNAT (AREF (dv, i)); } } @@ -522,7 +522,7 @@ PRINTCHARFUN defaults to the value of `standard-output' (which see). */) printcharfun = Vstandard_output; CHECK_FIXNUM (character); PRINTPREPARE; - printchar (XINT (character), printcharfun); + printchar (XFIXNUM (character), printcharfun); PRINTFINISH; return character; } @@ -772,7 +772,7 @@ to make it write to the debugging output. */) (Lisp_Object character) { CHECK_FIXNUM (character); - printchar_to_stream (XINT (character), stderr); + printchar_to_stream (XFIXNUM (character), stderr); return character; } @@ -1408,8 +1408,8 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, Negative values of print-length are invalid. Treat them like a print-length of nil. */ if (FIXNATP (Vprint_length) - && XFASTINT (Vprint_length) < size_in_bytes) - size_in_bytes = XFASTINT (Vprint_length); + && XFIXNAT (Vprint_length) < size_in_bytes) + size_in_bytes = XFIXNAT (Vprint_length); for (ptrdiff_t i = 0; i < size_in_bytes; i++) { @@ -1521,8 +1521,8 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, ptrdiff_t size = real_size; /* Don't print more elements than the specified maximum. */ - if (FIXNATP (Vprint_length) && XFASTINT (Vprint_length) < size) - size = XFASTINT (Vprint_length); + if (FIXNATP (Vprint_length) && XFIXNAT (Vprint_length) < size) + size = XFIXNAT (Vprint_length); printchar ('(', printcharfun); for (ptrdiff_t i = 0; i < size; i++) @@ -1652,8 +1652,8 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, /* Don't print more elements than the specified maximum. */ ptrdiff_t n - = (FIXNATP (Vprint_length) && XFASTINT (Vprint_length) < size - ? XFASTINT (Vprint_length) : size); + = (FIXNATP (Vprint_length) && XFIXNAT (Vprint_length) < size + ? XFIXNAT (Vprint_length) : size); print_c_string ("#s(", printcharfun); for (ptrdiff_t i = 0; i < n; i ++) @@ -1714,8 +1714,8 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, /* Don't print more elements than the specified maximum. */ if (FIXNATP (Vprint_length) - && XFASTINT (Vprint_length) < size) - size = XFASTINT (Vprint_length); + && XFIXNAT (Vprint_length) < size) + size = XFIXNAT (Vprint_length); for (int i = idx; i < size; i++) { @@ -1807,7 +1807,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil); if (FIXNUMP (num)) { - EMACS_INT n = XINT (num); + EMACS_INT n = XFIXNUM (num); if (n < 0) { /* Add a prefix #n= if OBJ has not yet been printed; that is, its status field is nil. */ @@ -1832,7 +1832,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) { case_Lisp_Int: { - int len = sprintf (buf, "%"pI"d", XINT (obj)); + int len = sprintf (buf, "%"pI"d", XFIXNUM (obj)); strout (buf, len, len, printcharfun); } break; @@ -2008,7 +2008,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) case Lisp_Cons: /* If deeper than spec'd depth, print placeholder. */ if (FIXNUMP (Vprint_level) - && print_depth > XINT (Vprint_level)) + && print_depth > XFIXNUM (Vprint_level)) print_c_string ("...", printcharfun); else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj))) && EQ (XCAR (obj), Qquote)) @@ -2050,7 +2050,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) /* Negative values of print-length are invalid in CL. Treat them like nil, as CMUCL does. */ printmax_t print_length = (FIXNATP (Vprint_length) - ? XFASTINT (Vprint_length) + ? XFIXNAT (Vprint_length) : TYPE_MAXIMUM (printmax_t)); printmax_t i = 0; diff --git a/src/process.c b/src/process.c index 350cfe0f80..698a2c3ac0 100644 --- a/src/process.c +++ b/src/process.c @@ -747,7 +747,7 @@ status_message (struct Lisp_Process *p) { char const *signame; synchronize_system_messages_locale (); - signame = strsignal (XFASTINT (code)); + signame = strsignal (XFIXNAT (code)); if (signame == 0) string = build_string ("unknown"); else @@ -769,10 +769,10 @@ status_message (struct Lisp_Process *p) else if (EQ (symbol, Qexit)) { if (NETCONN1_P (p)) - return build_string (XFASTINT (code) == 0 + return build_string (XFIXNAT (code) == 0 ? "deleted\n" : "connection broken by remote peer\n"); - if (XFASTINT (code) == 0) + if (XFIXNAT (code) == 0) return build_string ("finished\n"); AUTO_STRING (prefix, "exited abnormally with code "); string = Fnumber_to_string (code); @@ -1383,7 +1383,7 @@ nil otherwise. */) if (NETCONN_P (process) || XPROCESS (process)->infd < 0 || (set_window_size (XPROCESS (process)->infd, - XINT (height), XINT (width)) + XFIXNUM (height), XFIXNUM (width)) < 0)) return Qnil; else @@ -1589,7 +1589,7 @@ Return nil if format of ADDRESS is invalid. */) if (nargs <= 5 /* IPv4 */ && i < 4 /* host, not port */ - && XINT (p->contents[i]) > 255) + && XFIXNUM (p->contents[i]) > 255) return Qnil; args[i + 1] = p->contents[i]; @@ -1789,7 +1789,7 @@ usage: (make-process &rest ARGS) */) val = Vcoding_system_for_read; if (NILP (val)) { - ptrdiff_t nargs2 = 3 + XINT (Flength (command)); + ptrdiff_t nargs2 = 3 + XFIXNUM (Flength (command)); Lisp_Object tem2; SAFE_ALLOCA_LISP (args2, nargs2); ptrdiff_t i = 0; @@ -1819,7 +1819,7 @@ usage: (make-process &rest ARGS) */) { if (EQ (coding_systems, Qt)) { - ptrdiff_t nargs2 = 3 + XINT (Flength (command)); + ptrdiff_t nargs2 = 3 + XFIXNUM (Flength (command)); Lisp_Object tem2; SAFE_ALLOCA_LISP (args2, nargs2); ptrdiff_t i = 0; @@ -2567,7 +2567,7 @@ static Lisp_Object conv_addrinfo_to_lisp (struct addrinfo *res) { Lisp_Object protocol = make_fixnum (res->ai_protocol); - eassert (XINT (protocol) == res->ai_protocol); + eassert (XFIXNUM (protocol) == res->ai_protocol); return Fcons (protocol, conv_sockaddr_to_lisp (res->ai_addr, res->ai_addrlen)); } @@ -2609,7 +2609,7 @@ get_lisp_to_sockaddr_size (Lisp_Object address, int *familyp) p = XVECTOR (XCDR (address)); if (MAX_ALLOCA - sizeof sa->sa_family < p->header.size) return 0; - *familyp = XINT (XCAR (address)); + *familyp = XFIXNUM (XCAR (address)); return p->header.size + sizeof (sa->sa_family); } return 0; @@ -2639,7 +2639,7 @@ conv_lisp_to_sockaddr (int family, Lisp_Object address, struct sockaddr *sa, int { DECLARE_POINTER_ALIAS (sin, struct sockaddr_in, sa); len = sizeof (sin->sin_addr) + 1; - hostport = XINT (p->contents[--len]); + hostport = XFIXNUM (p->contents[--len]); sin->sin_port = htons (hostport); cp = (unsigned char *)&sin->sin_addr; sa->sa_family = family; @@ -2650,12 +2650,12 @@ conv_lisp_to_sockaddr (int family, Lisp_Object address, struct sockaddr *sa, int DECLARE_POINTER_ALIAS (sin6, struct sockaddr_in6, sa); DECLARE_POINTER_ALIAS (ip6, uint16_t, &sin6->sin6_addr); len = sizeof (sin6->sin6_addr) / 2 + 1; - hostport = XINT (p->contents[--len]); + hostport = XFIXNUM (p->contents[--len]); sin6->sin6_port = htons (hostport); for (i = 0; i < len; i++) if (FIXNUMP (p->contents[i])) { - int j = XFASTINT (p->contents[i]) & 0xffff; + int j = XFIXNAT (p->contents[i]) & 0xffff; ip6[i] = ntohs (j); } sa->sa_family = family; @@ -2687,7 +2687,7 @@ conv_lisp_to_sockaddr (int family, Lisp_Object address, struct sockaddr *sa, int for (i = 0; i < len; i++) if (FIXNUMP (p->contents[i])) - *cp++ = XFASTINT (p->contents[i]) & 0xff; + *cp++ = XFIXNAT (p->contents[i]) & 0xff; } #ifdef DATAGRAM_SOCKETS @@ -2819,7 +2819,7 @@ set_socket_option (int s, Lisp_Object opt, Lisp_Object val) { int optval; if (TYPE_RANGED_FIXNUMP (int, val)) - optval = XINT (val); + optval = XFIXNUM (val); else error ("Bad option value for %s", name); ret = setsockopt (s, sopt->optlevel, sopt->optnum, @@ -2858,7 +2858,7 @@ set_socket_option (int s, Lisp_Object opt, Lisp_Object val) linger.l_onoff = 1; linger.l_linger = 0; if (TYPE_RANGED_FIXNUMP (int, val)) - linger.l_linger = XINT (val); + linger.l_linger = XFIXNUM (val); else linger.l_onoff = NILP (val) ? 0 : 1; ret = setsockopt (s, sopt->optlevel, sopt->optnum, @@ -3357,7 +3357,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, { Lisp_Object addrinfo = XCAR (addrinfos); addrinfos = XCDR (addrinfos); - int protocol = XINT (XCAR (addrinfo)); + int protocol = XFIXNUM (XCAR (addrinfo)); Lisp_Object ip_address = XCDR (addrinfo); #ifdef WINDOWSNT @@ -3941,7 +3941,7 @@ usage: (make-network-process &rest ARGS) */) else if (EQ (tem, Qipv4)) family = AF_INET; else if (TYPE_RANGED_FIXNUMP (int, tem)) - family = XINT (tem); + family = XFIXNUM (tem); else error ("Unknown address family"); @@ -4010,7 +4010,7 @@ usage: (make-network-process &rest ARGS) */) else if (FIXNUMP (service)) { portstring = portbuf; - portstringlen = sprintf (portbuf, "%"pI"d", XINT (service)); + portstringlen = sprintf (portbuf, "%"pI"d", XFIXNUM (service)); } else { @@ -4096,7 +4096,7 @@ usage: (make-network-process &rest ARGS) */) if (EQ (service, Qt)) port = 0; else if (FIXNUMP (service)) - port = XINT (service); + port = XFIXNUM (service); else { CHECK_STRING (service); @@ -4170,7 +4170,7 @@ usage: (make-network-process &rest ARGS) */) /* :server QLEN */ p->is_server = !NILP (server); if (TYPE_RANGED_FIXNUMP (int, server)) - p->backlog = XINT (server); + p->backlog = XFIXNUM (server); /* :nowait BOOL */ if (!p->is_server && socktype != SOCK_DGRAM && nowait) @@ -4627,11 +4627,11 @@ is nil, from any process) before the timeout expired. */) { /* Obsolete calling convention using integers rather than floats. */ CHECK_FIXNUM (millisec); if (NILP (seconds)) - seconds = make_float (XINT (millisec) / 1000.0); + seconds = make_float (XFIXNUM (millisec) / 1000.0); else { CHECK_FIXNUM (seconds); - seconds = make_float (XINT (millisec) / 1000.0 + XINT (seconds)); + seconds = make_float (XFIXNUM (millisec) / 1000.0 + XFIXNUM (seconds)); } } @@ -4642,9 +4642,9 @@ is nil, from any process) before the timeout expired. */) { if (FIXNUMP (seconds)) { - if (XINT (seconds) > 0) + if (XFIXNUM (seconds) > 0) { - secs = XINT (seconds); + secs = XFIXNUM (seconds); nsecs = 0; } } @@ -6196,8 +6196,8 @@ write_queue_pop (struct Lisp_Process *p, Lisp_Object *obj, *obj = XCAR (entry); offset_length = XCDR (entry); - *len = XINT (XCDR (offset_length)); - offset = XINT (XCAR (offset_length)); + *len = XFIXNUM (XCDR (offset_length)); + offset = XFIXNUM (XCAR (offset_length)); *buf = SSDATA (*obj) + offset; return 1; @@ -6451,11 +6451,11 @@ set up yet, this function will block until socket setup has completed. */) validate_region (&start, &end); - start_byte = CHAR_TO_BYTE (XINT (start)); - end_byte = CHAR_TO_BYTE (XINT (end)); + start_byte = CHAR_TO_BYTE (XFIXNUM (start)); + end_byte = CHAR_TO_BYTE (XFIXNUM (end)); - if (XINT (start) < GPT && XINT (end) > GPT) - move_gap_both (XINT (start), start_byte); + if (XFIXNUM (start) < GPT && XFIXNUM (end) > GPT) + move_gap_both (XFIXNUM (start), start_byte); if (NETCONN_P (proc)) wait_while_connecting (proc); @@ -6864,7 +6864,7 @@ SIGCODE may be an integer, or a symbol whose name is a signal name. */) if (FIXNUMP (sigcode)) { CHECK_TYPE_RANGED_INTEGER (int, sigcode); - signo = XINT (sigcode); + signo = XFIXNUM (sigcode); } else { @@ -7052,7 +7052,7 @@ handle_child_signal (int sig) { pid_t deleted_pid; if (FIXNUMP (xpid)) - deleted_pid = XINT (xpid); + deleted_pid = XFIXNUM (xpid); else deleted_pid = XFLOAT_DATA (xpid); if (child_status_changed (deleted_pid, 0, 0)) diff --git a/src/profiler.c b/src/profiler.c index 4c7812aa77..7330f8861f 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -80,12 +80,12 @@ static EMACS_INT approximate_median (log_t *log, { eassert (size > 0); if (size < 2) - return XINT (HASH_VALUE (log, start)); + return XFIXNUM (HASH_VALUE (log, start)); if (size < 3) /* Not an actual median, but better for our application than choosing either of the two numbers. */ - return ((XINT (HASH_VALUE (log, start)) - + XINT (HASH_VALUE (log, start + 1))) + return ((XFIXNUM (HASH_VALUE (log, start)) + + XFIXNUM (HASH_VALUE (log, start + 1))) / 2); else { @@ -110,7 +110,7 @@ static void evict_lower_half (log_t *log) for (i = 0; i < size; i++) /* Evict not only values smaller but also values equal to the median, so as to make sure we evict something no matter what. */ - if (XINT (HASH_VALUE (log, i)) <= median) + if (XFIXNUM (HASH_VALUE (log, i)) <= median) { Lisp_Object key = HASH_KEY (log, i); { /* FIXME: we could make this more efficient. */ @@ -156,7 +156,7 @@ record_backtrace (log_t *log, EMACS_INT count) ptrdiff_t j = hash_lookup (log, backtrace, &hash); if (j >= 0) { - EMACS_INT old_val = XINT (HASH_VALUE (log, j)); + EMACS_INT old_val = XFIXNUM (HASH_VALUE (log, j)); EMACS_INT new_val = saturated_add (old_val, count); set_hash_value_slot (log, j, make_fixnum (new_val)); } @@ -273,7 +273,7 @@ setup_cpu_timer (Lisp_Object sampling_interval) : EMACS_INT_MAX))) return -1; - current_sampling_interval = XINT (sampling_interval); + current_sampling_interval = XFIXNUM (sampling_interval); interval = make_timespec (current_sampling_interval / billion, current_sampling_interval % billion); emacs_sigaction_init (&action, deliver_profiler_signal); diff --git a/src/search.c b/src/search.c index 72374c8b9b..5385c890f9 100644 --- a/src/search.c +++ b/src/search.c @@ -402,7 +402,7 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, ptrdiff_t len = SCHARS (string); CHECK_FIXNUM (start); - pos = XINT (start); + pos = XFIXNUM (start); if (pos < 0 && -pos <= len) pos = len + pos; else if (0 > pos || pos > len) @@ -1037,7 +1037,7 @@ search_command (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, if (!NILP (count)) { CHECK_FIXNUM (count); - n *= XINT (count); + n *= XFIXNUM (count); } CHECK_STRING (string); @@ -1051,7 +1051,7 @@ search_command (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, else { CHECK_FIXNUM_COERCE_MARKER (bound); - lim = XINT (bound); + lim = XFIXNUM (bound); if (n > 0 ? lim < PT : lim > PT) error ("Invalid search bound (wrong side of point)"); if (lim > ZV) @@ -1153,7 +1153,7 @@ do \ Lisp_Object temp; \ temp = Faref (trt, make_fixnum (d)); \ if (FIXNUMP (temp)) \ - out = XINT (temp); \ + out = XFIXNUM (temp); \ else \ out = d; \ } \ @@ -2421,9 +2421,9 @@ since only regular expressions have distinguished subexpressions. */) else { CHECK_FIXNUM (subexp); - if (! (0 <= XINT (subexp) && XINT (subexp) < search_regs.num_regs)) + if (! (0 <= XFIXNUM (subexp) && XFIXNUM (subexp) < search_regs.num_regs)) args_out_of_range (subexp, make_fixnum (search_regs.num_regs)); - sub = XINT (subexp); + sub = XFIXNUM (subexp); } if (NILP (string)) @@ -2810,7 +2810,7 @@ match_limit (Lisp_Object num, bool beginningp) EMACS_INT n; CHECK_FIXNUM (num); - n = XINT (num); + n = XFIXNUM (num); if (n < 0) args_out_of_range (num, make_fixnum (0)); if (search_regs.num_regs <= 0) @@ -2989,7 +2989,7 @@ If optional arg RESEAT is non-nil, make markers on LIST point nowhere. */) /* Allocate registers if they don't already exist. */ { - EMACS_INT length = XFASTINT (Flength (list)) / 2; + EMACS_INT length = XFIXNAT (Flength (list)) / 2; if (length > search_regs.num_regs) { @@ -3055,15 +3055,15 @@ If optional arg RESEAT is non-nil, make markers on LIST point nowhere. */) XSETFASTINT (marker, 0); CHECK_FIXNUM_COERCE_MARKER (marker); - if ((XINT (from) < 0 - ? TYPE_MINIMUM (regoff_t) <= XINT (from) - : XINT (from) <= TYPE_MAXIMUM (regoff_t)) - && (XINT (marker) < 0 - ? TYPE_MINIMUM (regoff_t) <= XINT (marker) - : XINT (marker) <= TYPE_MAXIMUM (regoff_t))) + if ((XFIXNUM (from) < 0 + ? TYPE_MINIMUM (regoff_t) <= XFIXNUM (from) + : XFIXNUM (from) <= TYPE_MAXIMUM (regoff_t)) + && (XFIXNUM (marker) < 0 + ? TYPE_MINIMUM (regoff_t) <= XFIXNUM (marker) + : XFIXNUM (marker) <= TYPE_MAXIMUM (regoff_t))) { - search_regs.start[i] = XINT (from); - search_regs.end[i] = XINT (marker); + search_regs.start[i] = XFIXNUM (from); + search_regs.end[i] = XFIXNUM (marker); } else { diff --git a/src/sound.c b/src/sound.c index ea57dc43bc..6f15f5dab6 100644 --- a/src/sound.c +++ b/src/sound.c @@ -387,7 +387,7 @@ parse_sound (Lisp_Object sound, Lisp_Object *attrs) { if (FIXNUMP (attrs[SOUND_VOLUME])) { - EMACS_INT volume = XINT (attrs[SOUND_VOLUME]); + EMACS_INT volume = XFIXNUM (attrs[SOUND_VOLUME]); if (! (0 <= volume && volume <= 100)) return 0; } @@ -1401,7 +1401,7 @@ Internal use only, use `play-sound' instead. */) current_sound_device->file = attrs[SOUND_DEVICE]; if (FIXNUMP (attrs[SOUND_VOLUME])) - current_sound_device->volume = XFASTINT (attrs[SOUND_VOLUME]); + current_sound_device->volume = XFIXNAT (attrs[SOUND_VOLUME]); else if (FLOATP (attrs[SOUND_VOLUME])) current_sound_device->volume = XFLOAT_DATA (attrs[SOUND_VOLUME]) * 100; @@ -1425,7 +1425,7 @@ Internal use only, use `play-sound' instead. */) file = ENCODE_FILE (file); if (FIXNUMP (attrs[SOUND_VOLUME])) { - ui_volume_tmp = XFASTINT (attrs[SOUND_VOLUME]); + ui_volume_tmp = XFIXNAT (attrs[SOUND_VOLUME]); } else if (FLOATP (attrs[SOUND_VOLUME])) { diff --git a/src/syntax.c b/src/syntax.c index 8434f47a5f..ee83ed070a 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -615,7 +615,7 @@ find_defun_start (ptrdiff_t pos, ptrdiff_t pos_byte) Lisp_Object boc = Fnth (make_fixnum (8), ppss); if (FIXED_OR_FLOATP (boc)) { - find_start_value = XINT (boc); + find_start_value = XFIXNUM (boc); find_start_value_byte = CHAR_TO_BYTE (find_start_value); } else @@ -952,7 +952,7 @@ back_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop, { adjusted = true; find_start_value - = CONSP (state.levelstarts) ? XINT (XCAR (state.levelstarts)) + = CONSP (state.levelstarts) ? XFIXNUM (XCAR (state.levelstarts)) : state.thislevelstart >= 0 ? state.thislevelstart : find_start_value; find_start_value_byte = CHAR_TO_BYTE (find_start_value); @@ -1118,7 +1118,7 @@ this is probably the wrong function to use, because it can't take { int char_int; CHECK_CHARACTER (character); - char_int = XINT (character); + char_int = XFIXNUM (character); SETUP_BUFFER_SYNTAX_TABLE (); return make_fixnum (syntax_code_spec[SYNTAX (char_int)]); } @@ -1130,7 +1130,7 @@ DEFUN ("matching-paren", Fmatching_paren, Smatching_paren, 1, 1, 0, int char_int; enum syntaxcode code; CHECK_CHARACTER (character); - char_int = XINT (character); + char_int = XFIXNUM (character); SETUP_BUFFER_SYNTAX_TABLE (); code = SYNTAX (char_int); if (code == Sopen || code == Sclose) @@ -1165,7 +1165,7 @@ the value of a `syntax-table' text property. */) int len; int character = STRING_CHAR_AND_LENGTH (p, len); XSETINT (match, character); - if (XFASTINT (match) == ' ') + if (XFIXNAT (match) == ' ') match = Qnil; p += len; } @@ -1277,7 +1277,7 @@ usage: (modify-syntax-entry CHAR NEWENTRY &optional SYNTAX-TABLE) */) if (CONSP (c)) SET_RAW_SYNTAX_ENTRY_RANGE (syntax_table, c, newentry); else - SET_RAW_SYNTAX_ENTRY (syntax_table, XINT (c), newentry); + SET_RAW_SYNTAX_ENTRY (syntax_table, XFIXNUM (c), newentry); /* We clear the regexp cache, since character classes can now have different values from those in the compiled regexps.*/ @@ -1325,7 +1325,7 @@ DEFUN ("internal-describe-syntax-value", Finternal_describe_syntax_value, return syntax; } - syntax_code = XINT (first) & INT_MAX; + syntax_code = XFIXNUM (first) & INT_MAX; code = syntax_code & 0377; start1 = SYNTAX_FLAGS_COMSTART_FIRST (syntax_code); start2 = SYNTAX_FLAGS_COMSTART_SECOND (syntax_code); @@ -1348,7 +1348,7 @@ DEFUN ("internal-describe-syntax-value", Finternal_describe_syntax_value, if (NILP (match_lisp)) insert (" ", 1); else - insert_char (XINT (match_lisp)); + insert_char (XFIXNUM (match_lisp)); if (start1) insert ("1", 1); @@ -1413,7 +1413,7 @@ DEFUN ("internal-describe-syntax-value", Finternal_describe_syntax_value, if (!NILP (match_lisp)) { insert_string (", matches "); - insert_char (XINT (match_lisp)); + insert_char (XFIXNUM (match_lisp)); } if (start1) @@ -1481,9 +1481,9 @@ scan_words (ptrdiff_t from, EMACS_INT count) if (! NILP (Ffboundp (func))) { pos = call2 (func, make_fixnum (from - 1), make_fixnum (end)); - if (FIXNUMP (pos) && from < XINT (pos) && XINT (pos) <= ZV) + if (FIXNUMP (pos) && from < XFIXNUM (pos) && XFIXNUM (pos) <= ZV) { - from = XINT (pos); + from = XFIXNUM (pos); from_byte = CHAR_TO_BYTE (from); } } @@ -1530,9 +1530,9 @@ scan_words (ptrdiff_t from, EMACS_INT count) if (! NILP (Ffboundp (func))) { pos = call2 (func, make_fixnum (from), make_fixnum (beg)); - if (FIXNUMP (pos) && BEGV <= XINT (pos) && XINT (pos) < from) + if (FIXNUMP (pos) && BEGV <= XFIXNUM (pos) && XFIXNUM (pos) < from) { - from = XINT (pos); + from = XFIXNUM (pos); from_byte = CHAR_TO_BYTE (from); } } @@ -1588,14 +1588,14 @@ instead. See Info node `(elisp) Word Motion' for details. */) else CHECK_FIXNUM (arg); - val = orig_val = scan_words (PT, XINT (arg)); + val = orig_val = scan_words (PT, XFIXNUM (arg)); if (! orig_val) - val = XINT (arg) > 0 ? ZV : BEGV; + val = XFIXNUM (arg) > 0 ? ZV : BEGV; /* Avoid jumping out of an input field. */ tmp = Fconstrain_to_field (make_fixnum (val), make_fixnum (PT), Qnil, Qnil, Qnil); - val = XFASTINT (tmp); + val = XFIXNAT (tmp); SET_PT (val); return val == orig_val ? Qt : Qnil; @@ -1679,13 +1679,13 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, CHECK_FIXNUM_COERCE_MARKER (lim); /* In any case, don't allow scan outside bounds of buffer. */ - if (XINT (lim) > ZV) + if (XFIXNUM (lim) > ZV) XSETFASTINT (lim, ZV); - if (XINT (lim) < BEGV) + if (XFIXNUM (lim) < BEGV) XSETFASTINT (lim, BEGV); multibyte = (!NILP (BVAR (current_buffer, enable_multibyte_characters)) - && (XINT (lim) - PT != CHAR_TO_BYTE (XINT (lim)) - PT_BYTE)); + && (XFIXNUM (lim) - PT != CHAR_TO_BYTE (XFIXNUM (lim)) - PT_BYTE)); string_multibyte = SBYTES (string) > SCHARS (string); memset (fastmap, 0, sizeof fastmap); @@ -1936,13 +1936,13 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, if (forwardp) { - endp = (XINT (lim) == GPT) ? GPT_ADDR : CHAR_POS_ADDR (XINT (lim)); - stop = (pos < GPT && GPT < XINT (lim)) ? GPT_ADDR : endp; + endp = (XFIXNUM (lim) == GPT) ? GPT_ADDR : CHAR_POS_ADDR (XFIXNUM (lim)); + stop = (pos < GPT && GPT < XFIXNUM (lim)) ? GPT_ADDR : endp; } else { - endp = CHAR_POS_ADDR (XINT (lim)); - stop = (pos >= GPT && GPT > XINT (lim)) ? GAP_END_ADDR : endp; + endp = CHAR_POS_ADDR (XFIXNUM (lim)); + stop = (pos >= GPT && GPT > XFIXNUM (lim)) ? GAP_END_ADDR : endp; } /* This code may look up syntax tables using functions that rely on the @@ -2118,16 +2118,16 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim) CHECK_FIXNUM_COERCE_MARKER (lim); /* In any case, don't allow scan outside bounds of buffer. */ - if (XINT (lim) > ZV) + if (XFIXNUM (lim) > ZV) XSETFASTINT (lim, ZV); - if (XINT (lim) < BEGV) + if (XFIXNUM (lim) < BEGV) XSETFASTINT (lim, BEGV); - if (forwardp ? (PT >= XFASTINT (lim)) : (PT <= XFASTINT (lim))) + if (forwardp ? (PT >= XFIXNAT (lim)) : (PT <= XFIXNAT (lim))) return make_fixnum (0); multibyte = (!NILP (BVAR (current_buffer, enable_multibyte_characters)) - && (XINT (lim) - PT != CHAR_TO_BYTE (XINT (lim)) - PT_BYTE)); + && (XFIXNUM (lim) - PT != CHAR_TO_BYTE (XFIXNUM (lim)) - PT_BYTE)); memset (fastmap, 0, sizeof fastmap); @@ -2172,8 +2172,8 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim) while (true) { p = BYTE_POS_ADDR (pos_byte); - endp = XINT (lim) == GPT ? GPT_ADDR : CHAR_POS_ADDR (XINT (lim)); - stop = pos < GPT && GPT < XINT (lim) ? GPT_ADDR : endp; + endp = XFIXNUM (lim) == GPT ? GPT_ADDR : CHAR_POS_ADDR (XFIXNUM (lim)); + stop = pos < GPT && GPT < XFIXNUM (lim) ? GPT_ADDR : endp; do { @@ -2205,8 +2205,8 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim) else { p = BYTE_POS_ADDR (pos_byte); - endp = CHAR_POS_ADDR (XINT (lim)); - stop = pos >= GPT && GPT > XINT (lim) ? GAP_END_ADDR : endp; + endp = CHAR_POS_ADDR (XFIXNUM (lim)); + stop = pos >= GPT && GPT > XFIXNUM (lim) ? GAP_END_ADDR : endp; if (multibyte) { @@ -2275,7 +2275,7 @@ in_classes (int c, Lisp_Object iso_classes) elt = XCAR (iso_classes); iso_classes = XCDR (iso_classes); - if (re_iswctype (c, XFASTINT (elt))) + if (re_iswctype (c, XFIXNAT (elt))) fits_class = 1; } @@ -2443,7 +2443,7 @@ between them, return t; otherwise return nil. */) unsigned short int quit_count = 0; CHECK_FIXNUM (count); - count1 = XINT (count); + count1 = XFIXNUM (count); stop = count1 > 0 ? ZV : BEGV; from = PT; @@ -3057,7 +3057,7 @@ that point is zero, and signal an error if the depth is nonzero. */) CHECK_FIXNUM (count); CHECK_FIXNUM (depth); - return scan_lists (XINT (from), XINT (count), XINT (depth), 0); + return scan_lists (XFIXNUM (from), XFIXNUM (count), XFIXNUM (depth), 0); } DEFUN ("scan-sexps", Fscan_sexps, Sscan_sexps, 2, 2, 0, @@ -3076,7 +3076,7 @@ but before count is used up, nil is returned. */) CHECK_FIXNUM (from); CHECK_FIXNUM (count); - return scan_lists (XINT (from), XINT (count), 0, 1); + return scan_lists (XFIXNUM (from), XFIXNUM (count), 0, 1); } DEFUN ("backward-prefix-chars", Fbackward_prefix_chars, Sbackward_prefix_chars, @@ -3217,7 +3217,7 @@ do { prev_from = from; \ { Lisp_Object temhd = Fcar (tem); if (RANGED_FIXNUMP (PTRDIFF_MIN, temhd, PTRDIFF_MAX)) - curlevel->last = XINT (temhd); + curlevel->last = XFIXNUM (temhd); if (++curlevel == endlevel) curlevel--; /* error ("Nesting too deep for parser"); */ curlevel->prev = -1; @@ -3490,7 +3490,7 @@ internalize_parse_state (Lisp_Object external, struct lisp_parse_state *state) { tem = Fcar (external); if (!NILP (tem)) - state->depth = XINT (tem); + state->depth = XFIXNUM (tem); else state->depth = 0; @@ -3500,13 +3500,13 @@ internalize_parse_state (Lisp_Object external, struct lisp_parse_state *state) tem = Fcar (external); /* Check whether we are inside string_fence-style string: */ state->instring = (!NILP (tem) - ? (CHARACTERP (tem) ? XFASTINT (tem) : ST_STRING_STYLE) + ? (CHARACTERP (tem) ? XFIXNAT (tem) : ST_STRING_STYLE) : -1); external = Fcdr (external); tem = Fcar (external); state->incomment = (!NILP (tem) - ? (FIXNUMP (tem) ? XINT (tem) : -1) + ? (FIXNUMP (tem) ? XFIXNUM (tem) : -1) : 0); external = Fcdr (external); @@ -3521,20 +3521,20 @@ internalize_parse_state (Lisp_Object external, struct lisp_parse_state *state) state->comstyle = (NILP (tem) ? 0 : (RANGED_FIXNUMP (0, tem, ST_COMMENT_STYLE) - ? XINT (tem) + ? XFIXNUM (tem) : ST_COMMENT_STYLE)); external = Fcdr (external); tem = Fcar (external); state->comstr_start = - RANGED_FIXNUMP (PTRDIFF_MIN, tem, PTRDIFF_MAX) ? XINT (tem) : -1; + RANGED_FIXNUMP (PTRDIFF_MIN, tem, PTRDIFF_MAX) ? XFIXNUM (tem) : -1; external = Fcdr (external); tem = Fcar (external); state->levelstarts = tem; external = Fcdr (external); tem = Fcar (external); - state->prev_syntax = NILP (tem) ? Smax : XINT (tem); + state->prev_syntax = NILP (tem) ? Smax : XFIXNUM (tem); } } @@ -3584,15 +3584,15 @@ Sixth arg COMMENTSTOP non-nil means stop after the start of a comment. if (!NILP (targetdepth)) { CHECK_FIXNUM (targetdepth); - target = XINT (targetdepth); + target = XFIXNUM (targetdepth); } else target = TYPE_MINIMUM (EMACS_INT); /* We won't reach this depth. */ validate_region (&from, &to); internalize_parse_state (oldstate, &state); - scan_sexps_forward (&state, XINT (from), CHAR_TO_BYTE (XINT (from)), - XINT (to), + scan_sexps_forward (&state, XFIXNUM (from), CHAR_TO_BYTE (XFIXNUM (from)), + XFIXNUM (to), target, !NILP (stopbefore), (NILP (commentstop) ? 0 : (EQ (commentstop, Qsyntax_table) ? -1 : 1))); diff --git a/src/syntax.h b/src/syntax.h index f02a17ce8d..d971c74753 100644 --- a/src/syntax.h +++ b/src/syntax.h @@ -118,7 +118,7 @@ INLINE int syntax_property_with_flags (int c, bool via_property) { Lisp_Object ent = syntax_property_entry (c, via_property); - return CONSP (ent) ? XINT (XCAR (ent)) : Swhitespace; + return CONSP (ent) ? XFIXNUM (XCAR (ent)) : Swhitespace; } INLINE int SYNTAX_WITH_FLAGS (int c) diff --git a/src/sysdep.c b/src/sysdep.c index 3bc7adcc89..cf2982bca1 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -2851,7 +2851,7 @@ serial_configure (struct Lisp_Process *p, else tem = Fplist_get (p->childp, QCspeed); CHECK_FIXNUM (tem); - err = cfsetspeed (&attr, XINT (tem)); + err = cfsetspeed (&attr, XFIXNUM (tem)); if (err != 0) report_file_error ("Failed cfsetspeed", tem); childp2 = Fplist_put (childp2, QCspeed, tem); @@ -2864,15 +2864,15 @@ serial_configure (struct Lisp_Process *p, if (NILP (tem)) tem = make_fixnum (8); CHECK_FIXNUM (tem); - if (XINT (tem) != 7 && XINT (tem) != 8) + if (XFIXNUM (tem) != 7 && XFIXNUM (tem) != 8) error (":bytesize must be nil (8), 7, or 8"); - summary[0] = XINT (tem) + '0'; + summary[0] = XFIXNUM (tem) + '0'; #if defined (CSIZE) && defined (CS7) && defined (CS8) attr.c_cflag &= ~CSIZE; - attr.c_cflag |= ((XINT (tem) == 7) ? CS7 : CS8); + attr.c_cflag |= ((XFIXNUM (tem) == 7) ? CS7 : CS8); #else /* Don't error on bytesize 8, which should be set by cfmakeraw. */ - if (XINT (tem) != 8) + if (XFIXNUM (tem) != 8) error ("Bytesize cannot be changed"); #endif childp2 = Fplist_put (childp2, QCbytesize, tem); @@ -2918,16 +2918,16 @@ serial_configure (struct Lisp_Process *p, if (NILP (tem)) tem = make_fixnum (1); CHECK_FIXNUM (tem); - if (XINT (tem) != 1 && XINT (tem) != 2) + if (XFIXNUM (tem) != 1 && XFIXNUM (tem) != 2) error (":stopbits must be nil (1 stopbit), 1, or 2"); - summary[2] = XINT (tem) + '0'; + summary[2] = XFIXNUM (tem) + '0'; #if defined (CSTOPB) attr.c_cflag &= ~CSTOPB; - if (XINT (tem) == 2) + if (XFIXNUM (tem) == 2) attr.c_cflag |= CSTOPB; #else /* Don't error on 1 stopbit, which should be set by cfmakeraw. */ - if (XINT (tem) != 1) + if (XFIXNUM (tem) != 1) error ("Stopbits cannot be configured"); #endif childp2 = Fplist_put (childp2, QCstopbits, tem); diff --git a/src/term.c b/src/term.c index 026ead3f9a..ce24f6915f 100644 --- a/src/term.c +++ b/src/term.c @@ -2147,7 +2147,7 @@ set_tty_color_mode (struct tty_display_info *tty, struct frame *f) else color_mode = Qnil; - mode = TYPE_RANGED_FIXNUMP (int, color_mode) ? XINT (color_mode) : 0; + mode = TYPE_RANGED_FIXNUMP (int, color_mode) ? XFIXNUM (color_mode) : 0; if (mode != tty->previous_color_mode) { @@ -2805,8 +2805,8 @@ mouse_get_xy (int *x, int *y) &time_dummy); if (!NILP (lmx)) { - *x = XINT (lmx); - *y = XINT (lmy); + *x = XFIXNUM (lmx); + *y = XFIXNUM (lmy); } } @@ -3477,7 +3477,7 @@ tty_menu_new_item_coords (struct frame *f, int which, int *x, int *y) pos = AREF (items, i + 3); if (NILP (str)) return; - ix = XINT (pos); + ix = XFIXNUM (pos); if (ix <= *x /* We use <= so the blank between 2 items on a TTY is considered part of the previous item. */ @@ -3488,14 +3488,14 @@ tty_menu_new_item_coords (struct frame *f, int which, int *x, int *y) if (which == TTYM_NEXT) { if (i < last_i) - *x = XINT (AREF (items, i + 4 + 3)); + *x = XFIXNUM (AREF (items, i + 4 + 3)); else *x = 0; /* Wrap around to the first item. */ } else if (prev_x < 0) { /* Wrap around to the last item. */ - *x = XINT (AREF (items, last_i + 3)); + *x = XFIXNUM (AREF (items, last_i + 3)); } else *x = prev_x; diff --git a/src/termhooks.h b/src/termhooks.h index d8c5edc948..160bd2f480 100644 --- a/src/termhooks.h +++ b/src/termhooks.h @@ -346,7 +346,7 @@ enum { FIXNUM_BITS, so using it to represent a modifier key means that characters thus modified have different integer equivalents depending on the architecture they're running on. Oh, and - applying XINT to a character whose 2^28 bit is set might sign-extend + applying XFIXNUM to a character whose 2^28 bit is set might sign-extend it, so you get a bunch of bits in the mask you didn't want. The CHAR_ macros are defined in lisp.h. */ diff --git a/src/textprop.c b/src/textprop.c index 3f636a125a..4bd4892b73 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -79,7 +79,7 @@ text_read_only (Lisp_Object propval) static void modify_text_properties (Lisp_Object buffer, Lisp_Object start, Lisp_Object end) { - ptrdiff_t b = XINT (start), e = XINT (end); + ptrdiff_t b = XFIXNUM (start), e = XFIXNUM (end); struct buffer *buf = XBUFFER (buffer), *old = current_buffer; set_buffer_internal (buf); @@ -145,7 +145,7 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin, if (EQ (*begin, *end) && begin != end) return NULL; - if (XINT (*begin) > XINT (*end)) + if (XFIXNUM (*begin) > XFIXNUM (*end)) { Lisp_Object n; n = *begin; @@ -157,8 +157,8 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin, { register struct buffer *b = XBUFFER (object); - if (!(BUF_BEGV (b) <= XINT (*begin) && XINT (*begin) <= XINT (*end) - && XINT (*end) <= BUF_ZV (b))) + if (!(BUF_BEGV (b) <= XFIXNUM (*begin) && XFIXNUM (*begin) <= XFIXNUM (*end) + && XFIXNUM (*end) <= BUF_ZV (b))) args_out_of_range (*begin, *end); i = buffer_intervals (b); @@ -166,24 +166,24 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin, if (BUF_BEGV (b) == BUF_ZV (b)) return NULL; - searchpos = XINT (*begin); + searchpos = XFIXNUM (*begin); } else { ptrdiff_t len = SCHARS (object); - if (! (0 <= XINT (*begin) && XINT (*begin) <= XINT (*end) - && XINT (*end) <= len)) + if (! (0 <= XFIXNUM (*begin) && XFIXNUM (*begin) <= XFIXNUM (*end) + && XFIXNUM (*end) <= len)) args_out_of_range (*begin, *end); - XSETFASTINT (*begin, XFASTINT (*begin)); + XSETFASTINT (*begin, XFIXNAT (*begin)); if (begin != end) - XSETFASTINT (*end, XFASTINT (*end)); + XSETFASTINT (*end, XFIXNAT (*end)); i = string_intervals (object); if (len == 0) return NULL; - searchpos = XINT (*begin); + searchpos = XFIXNUM (*begin); } if (!i) @@ -572,7 +572,7 @@ If POSITION is at the end of OBJECT, the value is nil. */) it means it's the end of OBJECT. There are no properties at the very end, since no character follows. */ - if (XINT (position) == LENGTH (i) + i->position) + if (XFIXNUM (position) == LENGTH (i) + i->position) return Qnil; return i->plist; @@ -621,14 +621,14 @@ get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop, Lisp_Object *overlay_vec; struct buffer *obuf = current_buffer; - if (XINT (position) < BUF_BEGV (XBUFFER (object)) - || XINT (position) > BUF_ZV (XBUFFER (object))) + if (XFIXNUM (position) < BUF_BEGV (XBUFFER (object)) + || XFIXNUM (position) > BUF_ZV (XBUFFER (object))) xsignal1 (Qargs_out_of_range, position); set_buffer_temp (XBUFFER (object)); USE_SAFE_ALLOCA; - GET_OVERLAYS_AT (XINT (position), overlay_vec, noverlays, NULL, false); + GET_OVERLAYS_AT (XFIXNUM (position), overlay_vec, noverlays, NULL, false); noverlays = sort_overlays (overlay_vec, noverlays, w); set_buffer_temp (obuf); @@ -715,7 +715,7 @@ before LIMIT. LIMIT is a no-op if it is greater than (point-max). */) if (! NILP (limit)) { CHECK_FIXNUM_COERCE_MARKER (limit); - if (XINT (limit) < XINT (temp)) + if (XFIXNUM (limit) < XFIXNUM (temp)) temp = limit; } return Fnext_property_change (position, Qnil, temp); @@ -741,7 +741,7 @@ before LIMIT. LIMIT is a no-op if it is less than (point-min). */) if (! NILP (limit)) { CHECK_FIXNUM_COERCE_MARKER (limit); - if (XINT (limit) > XINT (temp)) + if (XFIXNUM (limit) > XFIXNUM (temp)) temp = limit; } return Fprevious_property_change (position, Qnil, temp); @@ -805,17 +805,17 @@ last valid position in OBJECT. */) else CHECK_FIXNUM_COERCE_MARKER (limit); - if (XFASTINT (position) >= XFASTINT (limit)) + if (XFIXNAT (position) >= XFIXNAT (limit)) { position = limit; - if (XFASTINT (position) > ZV) + if (XFIXNAT (position) > ZV) XSETFASTINT (position, ZV); } else while (true) { position = Fnext_char_property_change (position, limit); - if (XFASTINT (position) >= XFASTINT (limit)) + if (XFIXNAT (position) >= XFIXNAT (limit)) { position = limit; break; @@ -887,23 +887,23 @@ first valid position in OBJECT. */) else CHECK_FIXNUM_COERCE_MARKER (limit); - if (XFASTINT (position) <= XFASTINT (limit)) + if (XFIXNAT (position) <= XFIXNAT (limit)) { position = limit; - if (XFASTINT (position) < BEGV) + if (XFIXNAT (position) < BEGV) XSETFASTINT (position, BEGV); } else { Lisp_Object initial_value - = Fget_char_property (make_fixnum (XFASTINT (position) - 1), + = Fget_char_property (make_fixnum (XFIXNAT (position) - 1), prop, object); while (true) { position = Fprevious_char_property_change (position, limit); - if (XFASTINT (position) <= XFASTINT (limit)) + if (XFIXNAT (position) <= XFIXNAT (limit)) { position = limit; break; @@ -911,7 +911,7 @@ first valid position in OBJECT. */) else { Lisp_Object value - = Fget_char_property (make_fixnum (XFASTINT (position) - 1), + = Fget_char_property (make_fixnum (XFIXNAT (position) - 1), prop, object); if (!EQ (value, initial_value)) @@ -976,13 +976,13 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT. */) next = next_interval (i); while (next && intervals_equal (i, next) - && (NILP (limit) || next->position < XFASTINT (limit))) + && (NILP (limit) || next->position < XFIXNAT (limit))) next = next_interval (next); if (!next || (next->position >= (FIXNUMP (limit) - ? XFASTINT (limit) + ? XFIXNAT (limit) : (STRINGP (object) ? SCHARS (object) : BUF_ZV (XBUFFER (object)))))) @@ -1025,13 +1025,13 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT. */) next = next_interval (i); while (next && EQ (here_val, textget (next->plist, prop)) - && (NILP (limit) || next->position < XFASTINT (limit))) + && (NILP (limit) || next->position < XFIXNAT (limit))) next = next_interval (next); if (!next || (next->position >= (FIXNUMP (limit) - ? XFASTINT (limit) + ? XFIXNAT (limit) : (STRINGP (object) ? SCHARS (object) : BUF_ZV (XBUFFER (object)))))) @@ -1069,19 +1069,19 @@ back past position LIMIT; return LIMIT if nothing is found until LIMIT. */) return limit; /* Start with the interval containing the char before point. */ - if (i->position == XFASTINT (position)) + if (i->position == XFIXNAT (position)) i = previous_interval (i); previous = previous_interval (i); while (previous && intervals_equal (previous, i) && (NILP (limit) - || (previous->position + LENGTH (previous) > XFASTINT (limit)))) + || (previous->position + LENGTH (previous) > XFIXNAT (limit)))) previous = previous_interval (previous); if (!previous || (previous->position + LENGTH (previous) <= (FIXNUMP (limit) - ? XFASTINT (limit) + ? XFIXNAT (limit) : (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object)))))) return limit; else @@ -1117,7 +1117,7 @@ back past position LIMIT; return LIMIT if nothing is found until LIMIT. */) i = validate_interval_range (object, &position, &position, soft); /* Start with the interval containing the char before point. */ - if (i && i->position == XFASTINT (position)) + if (i && i->position == XFIXNAT (position)) i = previous_interval (i); if (!i) @@ -1128,13 +1128,13 @@ back past position LIMIT; return LIMIT if nothing is found until LIMIT. */) while (previous && EQ (here_val, textget (previous->plist, prop)) && (NILP (limit) - || (previous->position + LENGTH (previous) > XFASTINT (limit)))) + || (previous->position + LENGTH (previous) > XFIXNAT (limit)))) previous = previous_interval (previous); if (!previous || (previous->position + LENGTH (previous) <= (FIXNUMP (limit) - ? XFASTINT (limit) + ? XFIXNAT (limit) : (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object)))))) return limit; else @@ -1164,8 +1164,8 @@ add_text_properties_1 (Lisp_Object start, Lisp_Object end, if (!i) return Qnil; - s = XINT (start); - len = XINT (end) - s; + s = XFIXNUM (start); + len = XFIXNUM (end) - s; /* If this interval already has the properties, we can skip it. */ if (interval_has_all_properties (properties, i)) @@ -1221,8 +1221,8 @@ add_text_properties_1 (Lisp_Object start, Lisp_Object end, if (interval_has_all_properties (properties, i)) { if (BUFFERP (object)) - signal_after_change (XINT (start), XINT (end) - XINT (start), - XINT (end) - XINT (start)); + signal_after_change (XFIXNUM (start), XFIXNUM (end) - XFIXNUM (start), + XFIXNUM (end) - XFIXNUM (start)); eassert (modified); return Qt; @@ -1232,8 +1232,8 @@ add_text_properties_1 (Lisp_Object start, Lisp_Object end, { add_properties (properties, i, object, set_type); if (BUFFERP (object)) - signal_after_change (XINT (start), XINT (end) - XINT (start), - XINT (end) - XINT (start)); + signal_after_change (XFIXNUM (start), XFIXNUM (end) - XFIXNUM (start), + XFIXNUM (end) - XFIXNUM (start)); return Qt; } @@ -1243,8 +1243,8 @@ add_text_properties_1 (Lisp_Object start, Lisp_Object end, copy_properties (unchanged, i); add_properties (properties, i, object, set_type); if (BUFFERP (object)) - signal_after_change (XINT (start), XINT (end) - XINT (start), - XINT (end) - XINT (start)); + signal_after_change (XFIXNUM (start), XFIXNUM (end) - XFIXNUM (start), + XFIXNUM (end) - XFIXNUM (start)); return Qt; } @@ -1362,8 +1362,8 @@ set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object properties, /* If we want no properties for a whole string, get rid of its intervals. */ if (NILP (properties) && STRINGP (object) - && XFASTINT (start) == 0 - && XFASTINT (end) == SCHARS (object)) + && XFIXNAT (start) == 0 + && XFIXNAT (end) == SCHARS (object)) { if (!string_intervals (object)) return Qnil; @@ -1397,8 +1397,8 @@ set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object properties, set_text_properties_1 (start, end, properties, object, i); if (BUFFERP (object) && !NILP (coherent_change_p)) - signal_after_change (XINT (start), XINT (end) - XINT (start), - XINT (end) - XINT (start)); + signal_after_change (XFIXNUM (start), XFIXNUM (end) - XFIXNUM (start), + XFIXNUM (end) - XFIXNUM (start)); return Qt; } @@ -1415,15 +1415,15 @@ set_text_properties_1 (Lisp_Object start, Lisp_Object end, Lisp_Object propertie register ptrdiff_t s, len; INTERVAL unchanged; - if (XINT (start) < XINT (end)) + if (XFIXNUM (start) < XFIXNUM (end)) { - s = XINT (start); - len = XINT (end) - s; + s = XFIXNUM (start); + len = XFIXNUM (end) - s; } - else if (XINT (end) < XINT (start)) + else if (XFIXNUM (end) < XFIXNUM (start)) { - s = XINT (end); - len = XINT (start) - s; + s = XFIXNUM (end); + len = XFIXNUM (start) - s; } else return; @@ -1515,8 +1515,8 @@ Use `set-text-properties' if you want to remove all text properties. */) if (!i) return Qnil; - s = XINT (start); - len = XINT (end) - s; + s = XFIXNUM (start); + len = XFIXNUM (end) - s; /* If there are no properties on this entire interval, return. */ if (! interval_has_some_properties (properties, i)) @@ -1573,8 +1573,8 @@ Use `set-text-properties' if you want to remove all text properties. */) { eassert (modified); if (BUFFERP (object)) - signal_after_change (XINT (start), XINT (end) - XINT (start), - XINT (end) - XINT (start)); + signal_after_change (XFIXNUM (start), XFIXNUM (end) - XFIXNUM (start), + XFIXNUM (end) - XFIXNUM (start)); return Qt; } @@ -1582,8 +1582,8 @@ Use `set-text-properties' if you want to remove all text properties. */) { remove_properties (properties, Qnil, i, object); if (BUFFERP (object)) - signal_after_change (XINT (start), XINT (end) - XINT (start), - XINT (end) - XINT (start)); + signal_after_change (XFIXNUM (start), XFIXNUM (end) - XFIXNUM (start), + XFIXNUM (end) - XFIXNUM (start)); return Qt; } @@ -1593,8 +1593,8 @@ Use `set-text-properties' if you want to remove all text properties. */) copy_properties (unchanged, i); remove_properties (properties, Qnil, i, object); if (BUFFERP (object)) - signal_after_change (XINT (start), XINT (end) - XINT (start), - XINT (end) - XINT (start)); + signal_after_change (XFIXNUM (start), XFIXNUM (end) - XFIXNUM (start), + XFIXNUM (end) - XFIXNUM (start)); return Qt; } @@ -1627,8 +1627,8 @@ Return t if any property was actually removed, nil otherwise. */) if (!i) return Qnil; - s = XINT (start); - len = XINT (end) - s; + s = XFIXNUM (start); + len = XFIXNUM (end) - s; /* If there are no properties on the interval, return. */ if (! interval_has_some_properties_list (properties, i)) @@ -1671,9 +1671,9 @@ Return t if any property was actually removed, nil otherwise. */) if (modified) { if (BUFFERP (object)) - signal_after_change (XINT (start), - XINT (end) - XINT (start), - XINT (end) - XINT (start)); + signal_after_change (XFIXNUM (start), + XFIXNUM (end) - XFIXNUM (start), + XFIXNUM (end) - XFIXNUM (start)); return Qt; } else @@ -1685,8 +1685,8 @@ Return t if any property was actually removed, nil otherwise. */) modify_text_properties (object, start, end); remove_properties (Qnil, properties, i, object); if (BUFFERP (object)) - signal_after_change (XINT (start), XINT (end) - XINT (start), - XINT (end) - XINT (start)); + signal_after_change (XFIXNUM (start), XFIXNUM (end) - XFIXNUM (start), + XFIXNUM (end) - XFIXNUM (start)); return Qt; } else @@ -1698,8 +1698,8 @@ Return t if any property was actually removed, nil otherwise. */) modify_text_properties (object, start, end); remove_properties (Qnil, properties, i, object); if (BUFFERP (object)) - signal_after_change (XINT (start), XINT (end) - XINT (start), - XINT (end) - XINT (start)); + signal_after_change (XFIXNUM (start), XFIXNUM (end) - XFIXNUM (start), + XFIXNUM (end) - XFIXNUM (start)); return Qt; } } @@ -1717,9 +1717,9 @@ Return t if any property was actually removed, nil otherwise. */) if (modified) { if (BUFFERP (object)) - signal_after_change (XINT (start), - XINT (end) - XINT (start), - XINT (end) - XINT (start)); + signal_after_change (XFIXNUM (start), + XFIXNUM (end) - XFIXNUM (start), + XFIXNUM (end) - XFIXNUM (start)); return Qt; } else @@ -1746,7 +1746,7 @@ markers). If OBJECT is a string, START and END are 0-based indices into it. */ i = validate_interval_range (object, &start, &end, soft); if (!i) return (!NILP (value) || EQ (start, end) ? Qnil : start); - e = XINT (end); + e = XFIXNUM (end); while (i) { @@ -1755,8 +1755,8 @@ markers). If OBJECT is a string, START and END are 0-based indices into it. */ if (EQ (textget (i->plist, property), value)) { pos = i->position; - if (pos < XINT (start)) - pos = XINT (start); + if (pos < XFIXNUM (start)) + pos = XFIXNUM (start); return make_fixnum (pos); } i = next_interval (i); @@ -1782,8 +1782,8 @@ markers). If OBJECT is a string, START and END are 0-based indices into it. */ i = validate_interval_range (object, &start, &end, soft); if (!i) return (NILP (value) || EQ (start, end)) ? Qnil : start; - s = XINT (start); - e = XINT (end); + s = XFIXNUM (start); + e = XFIXNUM (end); while (i) { @@ -1811,7 +1811,7 @@ int text_property_stickiness (Lisp_Object prop, Lisp_Object pos, Lisp_Object buffer) { bool ignore_previous_character; - Lisp_Object prev_pos = make_fixnum (XINT (pos) - 1); + Lisp_Object prev_pos = make_fixnum (XFIXNUM (pos) - 1); Lisp_Object front_sticky; bool is_rear_sticky = true, is_front_sticky = false; /* defaults */ Lisp_Object defalt = Fassq (prop, Vtext_property_default_nonsticky); @@ -1819,7 +1819,7 @@ text_property_stickiness (Lisp_Object prop, Lisp_Object pos, Lisp_Object buffer) if (NILP (buffer)) XSETBUFFER (buffer, current_buffer); - ignore_previous_character = XINT (pos) <= BUF_BEGV (XBUFFER (buffer)); + ignore_previous_character = XFIXNUM (pos) <= BUF_BEGV (XBUFFER (buffer)); if (ignore_previous_character || (CONSP (defalt) && !NILP (XCDR (defalt)))) is_rear_sticky = false; @@ -1895,7 +1895,7 @@ copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src, { Lisp_Object dest_start, dest_end; - e = XINT (pos) + (XINT (end) - XINT (start)); + e = XFIXNUM (pos) + (XFIXNUM (end) - XFIXNUM (start)); if (MOST_POSITIVE_FIXNUM < e) args_out_of_range (pos, end); dest_start = pos; @@ -1905,9 +1905,9 @@ copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src, validate_interval_range (dest, &dest_start, &dest_end, soft); } - s = XINT (start); - e = XINT (end); - p = XINT (pos); + s = XFIXNUM (start); + e = XFIXNUM (end); + p = XFIXNUM (pos); stuff = Qnil; @@ -1975,8 +1975,8 @@ text_property_list (Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp i = validate_interval_range (object, &start, &end, soft); if (i) { - ptrdiff_t s = XINT (start); - ptrdiff_t e = XINT (end); + ptrdiff_t s = XFIXNUM (start); + ptrdiff_t e = XFIXNUM (end); while (s < e) { @@ -2027,8 +2027,8 @@ add_text_properties_from_list (Lisp_Object object, Lisp_Object list, Lisp_Object Lisp_Object item, start, end, plist; item = XCAR (list); - start = make_fixnum (XINT (XCAR (item)) + XINT (delta)); - end = make_fixnum (XINT (XCAR (XCDR (item))) + XINT (delta)); + start = make_fixnum (XFIXNUM (XCAR (item)) + XFIXNUM (delta)); + end = make_fixnum (XFIXNUM (XCAR (XCDR (item))) + XFIXNUM (delta)); plist = XCAR (XCDR (XCDR (item))); Fadd_text_properties (start, end, plist, object); @@ -2046,7 +2046,7 @@ Lisp_Object extend_property_ranges (Lisp_Object list, Lisp_Object old_end, Lisp_Object new_end) { Lisp_Object prev = Qnil, head = list; - ptrdiff_t max = XINT (new_end); + ptrdiff_t max = XFIXNUM (new_end); for (; CONSP (list); prev = list, list = XCDR (list)) { @@ -2055,9 +2055,9 @@ extend_property_ranges (Lisp_Object list, Lisp_Object old_end, Lisp_Object new_e item = XCAR (list); beg = XCAR (item); - end = XINT (XCAR (XCDR (item))); + end = XFIXNUM (XCAR (XCDR (item))); - if (XINT (beg) >= max) + if (XFIXNUM (beg) >= max) { /* The start-point is past the end of the new string. Discard this property. */ @@ -2066,7 +2066,7 @@ extend_property_ranges (Lisp_Object list, Lisp_Object old_end, Lisp_Object new_e else XSETCDR (prev, XCDR (list)); } - else if ((end == XINT (old_end) && end != max) + else if ((end == XFIXNUM (old_end) && end != max) || end > max) { /* Either the end-point is past the end of the new string, diff --git a/src/undo.c b/src/undo.c index 7d2402fda3..e80ec58ab0 100644 --- a/src/undo.c +++ b/src/undo.c @@ -104,7 +104,7 @@ record_insert (ptrdiff_t beg, ptrdiff_t length) if (CONSP (elt) && FIXNUMP (XCAR (elt)) && FIXNUMP (XCDR (elt)) - && XINT (XCDR (elt)) == beg) + && XFIXNUM (XCDR (elt)) == beg) { XSETCDR (elt, make_fixnum (beg + length)); return; @@ -353,7 +353,7 @@ truncate_undo_list (struct buffer *b) /* If by the first boundary we have already passed undo_outer_limit, we're heading for memory full, so offer to clear out the list. */ if (FIXNUMP (Vundo_outer_limit) - && size_so_far > XINT (Vundo_outer_limit) + && size_so_far > XFIXNUM (Vundo_outer_limit) && !NILP (Vundo_outer_limit_function)) { Lisp_Object tem; diff --git a/src/w32.c b/src/w32.c index 6eb6b0bbee..299bba7be4 100644 --- a/src/w32.c +++ b/src/w32.c @@ -7043,7 +7043,7 @@ system_process_attributes (Lisp_Object pid) BOOL result = FALSE; CHECK_FIXNUM_OR_FLOAT (pid); - proc_id = FLOATP (pid) ? XFLOAT_DATA (pid) : XINT (pid); + proc_id = FLOATP (pid) ? XFLOAT_DATA (pid) : XFIXNUM (pid); h_snapshot = create_toolhelp32_snapshot (TH32CS_SNAPPROCESS, 0); @@ -10107,7 +10107,7 @@ serial_configure (struct Lisp_Process *p, Lisp_Object contact) else tem = Fplist_get (p->childp, QCspeed); CHECK_FIXNUM (tem); - dcb.BaudRate = XINT (tem); + dcb.BaudRate = XFIXNUM (tem); childp2 = Fplist_put (childp2, QCspeed, tem); /* Configure bytesize. */ @@ -10118,10 +10118,10 @@ serial_configure (struct Lisp_Process *p, Lisp_Object contact) if (NILP (tem)) tem = make_fixnum (8); CHECK_FIXNUM (tem); - if (XINT (tem) != 7 && XINT (tem) != 8) + if (XFIXNUM (tem) != 7 && XFIXNUM (tem) != 8) error (":bytesize must be nil (8), 7, or 8"); - dcb.ByteSize = XINT (tem); - summary[0] = XINT (tem) + '0'; + dcb.ByteSize = XFIXNUM (tem); + summary[0] = XFIXNUM (tem) + '0'; childp2 = Fplist_put (childp2, QCbytesize, tem); /* Configure parity. */ @@ -10162,12 +10162,12 @@ serial_configure (struct Lisp_Process *p, Lisp_Object contact) if (NILP (tem)) tem = make_fixnum (1); CHECK_FIXNUM (tem); - if (XINT (tem) != 1 && XINT (tem) != 2) + if (XFIXNUM (tem) != 1 && XFIXNUM (tem) != 2) error (":stopbits must be nil (1 stopbit), 1, or 2"); - summary[2] = XINT (tem) + '0'; - if (XINT (tem) == 1) + summary[2] = XFIXNUM (tem) + '0'; + if (XFIXNUM (tem) == 1) dcb.StopBits = ONESTOPBIT; - else if (XINT (tem) == 2) + else if (XFIXNUM (tem) == 2) dcb.StopBits = TWOSTOPBITS; childp2 = Fplist_put (childp2, QCstopbits, tem); diff --git a/src/w32console.c b/src/w32console.c index c322a8e699..6c3cf06bfd 100644 --- a/src/w32console.c +++ b/src/w32console.c @@ -791,7 +791,7 @@ DEFUN ("set-screen-color", Fset_screen_color, Sset_screen_color, 2, 2, 0, Arguments should be indices between 0 and 15, see w32console.el. */) (Lisp_Object foreground, Lisp_Object background) { - char_attr_normal = XFASTINT (foreground) + (XFASTINT (background) << 4); + char_attr_normal = XFIXNAT (foreground) + (XFIXNAT (background) << 4); Frecenter (Qnil, Qt); return Qt; @@ -814,7 +814,7 @@ DEFUN ("set-cursor-size", Fset_cursor_size, Sset_cursor_size, 1, 1, 0, (Lisp_Object size) { CONSOLE_CURSOR_INFO cci; - cci.dwSize = XFASTINT (size); + cci.dwSize = XFIXNAT (size); cci.bVisible = TRUE; (void) SetConsoleCursorInfo (cur_screen, &cci); diff --git a/src/w32fns.c b/src/w32fns.c index e8962b491f..8d5293c1af 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -462,7 +462,7 @@ if the entry is new. */) CHECK_FIXNUM (blue); CHECK_STRING (name); - XSETINT (rgb, RGB (XUINT (red), XUINT (green), XUINT (blue))); + XSETINT (rgb, RGB (XUFIXNUM (red), XUFIXNUM (green), XUFIXNUM (blue))); block_input (); @@ -1182,7 +1182,7 @@ w32_defined_color (struct frame *f, const char *color, XColor *color_def, if (f) { /* Apply gamma correction. */ - w32_color_ref = XUINT (tem); + w32_color_ref = XUFIXNUM (tem); gamma_correct (f, &w32_color_ref); XSETINT (tem, w32_color_ref); } @@ -1198,7 +1198,7 @@ w32_defined_color (struct frame *f, const char *color, XColor *color_def, /* check if color is already mapped */ while (entry) { - if (W32_COLOR (entry->entry) == XUINT (tem)) + if (W32_COLOR (entry->entry) == XUFIXNUM (tem)) break; prev = &entry->next; entry = entry->next; @@ -1208,7 +1208,7 @@ w32_defined_color (struct frame *f, const char *color, XColor *color_def, { /* not already mapped, so add to list */ entry = xmalloc (sizeof (struct w32_palette_entry)); - SET_W32_COLOR (entry->entry, XUINT (tem)); + SET_W32_COLOR (entry->entry, XUFIXNUM (tem)); entry->next = NULL; *prev = entry; one_w32_display_info.num_colors++; @@ -1220,7 +1220,7 @@ w32_defined_color (struct frame *f, const char *color, XColor *color_def, /* Ensure COLORREF value is snapped to nearest color in (default) palette by simulating the PALETTERGB macro. This works whether or not the display device has a palette. */ - w32_color_ref = XUINT (tem) | 0x2000000; + w32_color_ref = XUFIXNUM (tem) | 0x2000000; color_def->pixel = w32_color_ref; color_def->red = GetRValue (w32_color_ref) * 256; @@ -1344,7 +1344,7 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) if (!EQ (Qnil, Vx_pointer_shape)) { CHECK_FIXNUM (Vx_pointer_shape); - cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XINT (Vx_pointer_shape)); + cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XFIXNUM (Vx_pointer_shape)); } else cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm); @@ -1354,7 +1354,7 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { CHECK_FIXNUM (Vx_nontext_pointer_shape); nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), - XINT (Vx_nontext_pointer_shape)); + XFIXNUM (Vx_nontext_pointer_shape)); } else nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_left_ptr); @@ -1364,7 +1364,7 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { CHECK_FIXNUM (Vx_hourglass_pointer_shape); hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), - XINT (Vx_hourglass_pointer_shape)); + XFIXNUM (Vx_hourglass_pointer_shape)); } else hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_watch); @@ -1375,7 +1375,7 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { CHECK_FIXNUM (Vx_mode_pointer_shape); mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), - XINT (Vx_mode_pointer_shape)); + XFIXNUM (Vx_mode_pointer_shape)); } else mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm); @@ -1386,7 +1386,7 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) CHECK_FIXNUM (Vx_sensitive_text_pointer_shape); hand_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), - XINT (Vx_sensitive_text_pointer_shape)); + XFIXNUM (Vx_sensitive_text_pointer_shape)); } else hand_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_crosshair); @@ -1396,7 +1396,7 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) CHECK_FIXNUM (Vx_window_horizontal_drag_shape); horizontal_drag_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), - XINT (Vx_window_horizontal_drag_shape)); + XFIXNUM (Vx_window_horizontal_drag_shape)); } else horizontal_drag_cursor @@ -1407,7 +1407,7 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) CHECK_FIXNUM (Vx_window_vertical_drag_shape); vertical_drag_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), - XINT (Vx_window_vertical_drag_shape)); + XFIXNUM (Vx_window_vertical_drag_shape)); } else vertical_drag_cursor @@ -1689,7 +1689,7 @@ x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldva int border; CHECK_TYPE_RANGED_INTEGER (int, arg); - border = max (XINT (arg), 0); + border = max (XFIXNUM (arg), 0); if (border != FRAME_INTERNAL_BORDER_WIDTH (f)) { @@ -1725,7 +1725,7 @@ x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) if (!FRAME_MINIBUF_ONLY_P (f) && !FRAME_PARENT_FRAME (f)) { boolean old = FRAME_EXTERNAL_MENU_BAR (f); - boolean new = (FIXNUMP (value) && XINT (value) > 0) ? true : false; + boolean new = (FIXNUMP (value) && XFIXNUM (value) > 0) ? true : false; FRAME_MENU_BAR_LINES (f) = 0; FRAME_MENU_BAR_HEIGHT (f) = 0; @@ -1780,8 +1780,8 @@ x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) return; /* Use VALUE only if an integer >= 0. */ - if (FIXNUMP (value) && XINT (value) >= 0) - nlines = XFASTINT (value); + if (FIXNUMP (value) && XFIXNUM (value) >= 0) + nlines = XFIXNAT (value); else nlines = 0; @@ -2027,7 +2027,7 @@ x_set_undecorated (struct frame *f, Lisp_Object new_value, Lisp_Object old_value if (!NILP (new_value) && !FRAME_UNDECORATED (f)) { dwStyle = ((dwStyle & ~WS_THICKFRAME & ~WS_CAPTION) - | ((FIXED_OR_FLOATP (border_width) && (XINT (border_width) > 0)) + | ((FIXED_OR_FLOATP (border_width) && (XFIXNUM (border_width) > 0)) ? WS_BORDER : false)); SetWindowLong (hwnd, GWL_STYLE, dwStyle); SetWindowPos (hwnd, HWND_TOP, 0, 0, 0, 0, @@ -2334,7 +2334,7 @@ w32_createwindow (struct frame *f, int *coords) if (FRAME_UNDECORATED (f)) { /* If we want a thin border, specify it here. */ - if (FIXED_OR_FLOATP (border_width) && (XINT (border_width) > 0)) + if (FIXED_OR_FLOATP (border_width) && (XFIXNUM (border_width) > 0)) f->output_data.w32->dwStyle |= WS_BORDER; } else @@ -2350,7 +2350,7 @@ w32_createwindow (struct frame *f, int *coords) f->output_data.w32->dwStyle = WS_POPUP; /* If we want a thin border, specify it here. */ - if (FIXED_OR_FLOATP (border_width) && (XINT (border_width) > 0)) + if (FIXED_OR_FLOATP (border_width) && (XFIXNUM (border_width) > 0)) f->output_data.w32->dwStyle |= WS_BORDER; } else @@ -3117,9 +3117,9 @@ map_keypad_keys (unsigned int virt_key, unsigned int extended) static Lisp_Object w32_grabbed_keys; #define HOTKEY(vk, mods) make_fixnum (((vk) & 255) | ((mods) << 8)) -#define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff) -#define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255) -#define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8) +#define HOTKEY_ID(k) (XFIXNAT (k) & 0xbfff) +#define HOTKEY_VK_CODE(k) (XFIXNAT (k) & 255) +#define HOTKEY_MODIFIERS(k) (XFIXNAT (k) >> 8) #define RAW_HOTKEY_ID(k) ((k) & 0xbfff) #define RAW_HOTKEY_VK_CODE(k) ((k) & 255) @@ -4200,7 +4200,7 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) if (GetAsyncKeyState (wParam) & 1) { if (FIXED_OR_FLOATP (Vw32_phantom_key_code)) - key = XUINT (Vw32_phantom_key_code) & 255; + key = XUFIXNUM (Vw32_phantom_key_code) & 255; else key = VK_SPACE; dpyinfo->faked_key = key; @@ -4216,7 +4216,7 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) if (GetAsyncKeyState (wParam) & 1) { if (FIXED_OR_FLOATP (Vw32_phantom_key_code)) - key = XUINT (Vw32_phantom_key_code) & 255; + key = XUFIXNUM (Vw32_phantom_key_code) & 255; else key = VK_SPACE; dpyinfo->faked_key = key; @@ -5413,11 +5413,11 @@ my_create_window (struct frame * f) if (EQ (left, Qunbound)) coords[0] = CW_USEDEFAULT; else - coords[0] = XINT (left); + coords[0] = XFIXNUM (left); if (EQ (top, Qunbound)) coords[1] = CW_USEDEFAULT; else - coords[1] = XINT (top); + coords[1] = XFIXNUM (top); if (!PostThreadMessage (dwWindowsThreadId, WM_EMACS_CREATEWINDOW, (WPARAM)f, (LPARAM)coords)) @@ -5809,7 +5809,7 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, { /* Cast to UINT_PTR shuts up compiler warnings about cast to pointer from integer of different size. */ - f->output_data.w32->parent_desc = (Window) (UINT_PTR) XFASTINT (parent); + f->output_data.w32->parent_desc = (Window) (UINT_PTR) XFIXNAT (parent); f->output_data.w32->explicit_parent = true; } else @@ -7105,33 +7105,33 @@ compute_tip_xy (struct frame *f, } if (FIXNUMP (top)) - *root_y = XINT (top); + *root_y = XFIXNUM (top); else if (FIXNUMP (bottom)) - *root_y = XINT (bottom) - height; - else if (*root_y + XINT (dy) <= min_y) + *root_y = XFIXNUM (bottom) - height; + else if (*root_y + XFIXNUM (dy) <= min_y) *root_y = min_y; /* Can happen for negative dy */ - else if (*root_y + XINT (dy) + height <= max_y) + else if (*root_y + XFIXNUM (dy) + height <= max_y) /* It fits below the pointer */ - *root_y += XINT (dy); - else if (height + XINT (dy) + min_y <= *root_y) + *root_y += XFIXNUM (dy); + else if (height + XFIXNUM (dy) + min_y <= *root_y) /* It fits above the pointer. */ - *root_y -= height + XINT (dy); + *root_y -= height + XFIXNUM (dy); else /* Put it on the top. */ *root_y = min_y; if (FIXNUMP (left)) - *root_x = XINT (left); + *root_x = XFIXNUM (left); else if (FIXNUMP (right)) - *root_x = XINT (right) - width; - else if (*root_x + XINT (dx) <= min_x) + *root_x = XFIXNUM (right) - width; + else if (*root_x + XFIXNUM (dx) <= min_x) *root_x = 0; /* Can happen for negative dx */ - else if (*root_x + XINT (dx) + width <= max_x) + else if (*root_x + XFIXNUM (dx) + width <= max_x) /* It fits to the right of the pointer. */ - *root_x += XINT (dx); - else if (width + XINT (dx) + min_x <= *root_x) + *root_x += XFIXNUM (dx); + else if (width + XFIXNUM (dx) + min_x <= *root_x) /* It fits to the left of the pointer. */ - *root_x -= width + XINT (dx); + *root_x -= width + XFIXNUM (dx); else /* Put it left justified on the screen -- it ought to fit that way. */ *root_x = min_x; @@ -7389,8 +7389,8 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, && RANGED_FIXNUMP (1, XCAR (Vx_max_tooltip_size), INT_MAX) && RANGED_FIXNUMP (1, XCDR (Vx_max_tooltip_size), INT_MAX)) { - w->total_cols = XFASTINT (XCAR (Vx_max_tooltip_size)); - w->total_lines = XFASTINT (XCDR (Vx_max_tooltip_size)); + w->total_cols = XFIXNAT (XCAR (Vx_max_tooltip_size)); + w->total_lines = XFIXNAT (XCDR (Vx_max_tooltip_size)); } else { @@ -7422,8 +7422,8 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, size = Fwindow_text_pixel_size (window, Qnil, Qnil, Qnil, make_fixnum (w->pixel_height), Qnil); /* Add the frame's internal border to calculated size. */ - width = XINT (Fcar (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); - height = XINT (Fcdr (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); + width = XFIXNUM (Fcar (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); + height = XFIXNUM (Fcdr (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); /* Calculate position of tooltip frame. */ compute_tip_xy (tip_f, parms, dx, dy, width, height, &root_x, &root_y); @@ -7431,7 +7431,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, { RECT rect; int pad = (FIXED_OR_FLOATP (Vw32_tooltip_extra_pixels) - ? max (0, XINT (Vw32_tooltip_extra_pixels)) + ? max (0, XFIXNUM (Vw32_tooltip_extra_pixels)) : FRAME_COLUMN_WIDTH (tip_f)); rect.left = rect.top = 0; @@ -8036,7 +8036,7 @@ If optional parameter FRAME is not specified, use selected frame. */) CHECK_FIXNUM (command); if (FRAME_W32_P (f)) - PostMessage (FRAME_W32_WINDOW (f), WM_SYSCOMMAND, XINT (command), 0); + PostMessage (FRAME_W32_WINDOW (f), WM_SYSCOMMAND, XFIXNUM (command), 0); return Qnil; } @@ -8144,7 +8144,7 @@ a ShowWindow flag: result = (intptr_t) ShellExecuteW (NULL, ops_w, doc_w, params_w, GUI_SDATA (current_dir), (FIXNUMP (show_flag) - ? XINT (show_flag) : SW_SHOWDEFAULT)); + ? XFIXNUM (show_flag) : SW_SHOWDEFAULT)); if (result > 32) return Qt; @@ -8301,7 +8301,7 @@ a ShowWindow flag: shexinfo_w.lpParameters = params_w; shexinfo_w.lpDirectory = current_dir_w; shexinfo_w.nShow = - (FIXNUMP (show_flag) ? XINT (show_flag) : SW_SHOWDEFAULT); + (FIXNUMP (show_flag) ? XFIXNUM (show_flag) : SW_SHOWDEFAULT); success = ShellExecuteExW (&shexinfo_w); xfree (doc_w); } @@ -8336,7 +8336,7 @@ a ShowWindow flag: shexinfo_a.lpParameters = params_a; shexinfo_a.lpDirectory = current_dir_a; shexinfo_a.nShow = - (FIXNUMP (show_flag) ? XINT (show_flag) : SW_SHOWDEFAULT); + (FIXNUMP (show_flag) ? XFIXNUM (show_flag) : SW_SHOWDEFAULT); success = ShellExecuteExA (&shexinfo_a); xfree (doc_w); xfree (doc_a); @@ -8419,7 +8419,7 @@ w32_parse_and_hook_hot_key (Lisp_Object key, int hook) if (SYMBOLP (c)) { c = parse_modifiers (c); - lisp_modifiers = XINT (Fcar (Fcdr (c))); + lisp_modifiers = XFIXNUM (Fcar (Fcdr (c))); c = Fcar (c); if (!SYMBOLP (c)) emacs_abort (); @@ -8432,9 +8432,9 @@ w32_parse_and_hook_hot_key (Lisp_Object key, int hook) } else if (FIXNUMP (c)) { - lisp_modifiers = XINT (c) & ~CHARACTERBITS; + lisp_modifiers = XFIXNUM (c) & ~CHARACTERBITS; /* Many ascii characters are their own virtual key code. */ - vk_code = XINT (c) & CHARACTERBITS; + vk_code = XFIXNUM (c) & CHARACTERBITS; } if (vk_code < 0 || vk_code > 255) @@ -8534,7 +8534,7 @@ any key combinations, otherwise nil. */) /* Notify input thread about new hot-key definition, so that it takes effect without needing to switch focus. */ PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY, - (WPARAM) XINT (key), 0); + (WPARAM) XFIXNUM (key), 0); } return key; @@ -8567,7 +8567,7 @@ DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key, /* Notify input thread about hot-key definition being removed, so that it takes effect without needing focus switch. */ if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY, - (WPARAM) XINT (XCAR (item)), lparam)) + (WPARAM) XFIXNUM (XCAR (item)), lparam)) { MSG msg; GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE); @@ -8647,7 +8647,7 @@ to change the state. */) if (NILP (new_state)) lparam = -1; else - lparam = (XUINT (new_state)) & 1; + lparam = (XUFIXNUM (new_state)) & 1; if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY, (WPARAM) vk_code, lparam)) { @@ -9071,7 +9071,7 @@ The coordinates X and Y are interpreted in pixels relative to a position if (os_subtype == OS_NT && w32_major_version + w32_minor_version >= 6) ret = SystemParametersInfo (SPI_GETMOUSETRAILS, 0, &trail_num, 0); - SetCursorPos (XINT (x), XINT (y)); + SetCursorPos (XFIXNUM (x), XFIXNUM (y)); if (ret) SystemParametersInfo (SPI_SETMOUSETRAILS, trail_num, NULL, 0); unblock_input (); @@ -9432,7 +9432,7 @@ w32_console_toggle_lock_key (int vk_code, Lisp_Object new_state) if (NILP (new_state) || (FIXED_OR_FLOATP (new_state) - && ((XUINT (new_state)) & 1) != cur_state)) + && ((XUFIXNUM (new_state)) & 1) != cur_state)) { #ifdef WINDOWSNT faked_key = vk_code; @@ -10071,7 +10071,7 @@ DEFUN ("w32-notification-close", struct frame *f = SELECTED_FRAME (); if (FIXNUMP (id)) - delete_tray_notification (f, XINT (id)); + delete_tray_notification (f, XFIXNUM (id)); return Qnil; } diff --git a/src/w32font.c b/src/w32font.c index ed68656a00..c2f5dc3746 100644 --- a/src/w32font.c +++ b/src/w32font.c @@ -920,7 +920,7 @@ w32font_open_internal (struct frame *f, Lisp_Object font_entity, if (!EQ (val, Qraster)) logfont.lfOutPrecision = OUT_TT_PRECIS; - size = XINT (AREF (font_entity, FONT_SIZE_INDEX)); + size = XFIXNUM (AREF (font_entity, FONT_SIZE_INDEX)); if (!size) size = pixel_size; @@ -1231,7 +1231,7 @@ font_matches_spec (DWORD type, NEWTEXTMETRICEX *font, val = AREF (spec, FONT_SPACING_INDEX); if (FIXNUMP (val)) { - int spacing = XINT (val); + int spacing = XFIXNUM (val); int proportional = (spacing < FONT_SPACING_MONO); if ((proportional && !(font->ntmTm.tmPitchAndFamily & 0x01)) @@ -1822,8 +1822,8 @@ w32_to_x_charset (int fncharset, char *matching) /* Look for Same charset and a valid codepage (or non-int which means ignore). */ if (EQ (w32_charset, charset_type) - && (!FIXNUMP (codepage) || XINT (codepage) == CP_DEFAULT - || IsValidCodePage (XINT (codepage)))) + && (!FIXNUMP (codepage) || XFIXNUM (codepage) == CP_DEFAULT + || IsValidCodePage (XFIXNUM (codepage)))) { /* If we don't have a match already, then this is the best. */ @@ -1957,7 +1957,7 @@ fill_in_logfont (struct frame *f, LOGFONT *logfont, Lisp_Object font_spec) tmp = AREF (font_spec, FONT_DPI_INDEX); if (FIXNUMP (tmp)) { - dpi = XINT (tmp); + dpi = XFIXNUM (tmp); } else if (FLOATP (tmp)) { @@ -1967,7 +1967,7 @@ fill_in_logfont (struct frame *f, LOGFONT *logfont, Lisp_Object font_spec) /* Height */ tmp = AREF (font_spec, FONT_SIZE_INDEX); if (FIXNUMP (tmp)) - logfont->lfHeight = -1 * XINT (tmp); + logfont->lfHeight = -1 * XFIXNUM (tmp); else if (FLOATP (tmp)) logfont->lfHeight = (int) (-1.0 * dpi * XFLOAT_DATA (tmp) / 72.27 + 0.5); @@ -2038,7 +2038,7 @@ fill_in_logfont (struct frame *f, LOGFONT *logfont, Lisp_Object font_spec) tmp = AREF (font_spec, FONT_SPACING_INDEX); if (FIXNUMP (tmp)) { - int spacing = XINT (tmp); + int spacing = XFIXNUM (tmp); if (spacing < FONT_SPACING_MONO) logfont->lfPitchAndFamily = (logfont->lfPitchAndFamily & 0xF0) | VARIABLE_PITCH; diff --git a/src/w32inevt.c b/src/w32inevt.c index 6c5a1c6d47..e8494c88bc 100644 --- a/src/w32inevt.c +++ b/src/w32inevt.c @@ -182,7 +182,7 @@ key_event (KEY_EVENT_RECORD *event, struct input_event *emacs_ev, int *isdead) if ((mod_key_state & LEFT_WIN_PRESSED) == 0) { if (FIXED_OR_FLOATP (Vw32_phantom_key_code)) - faked_key = XUINT (Vw32_phantom_key_code) & 255; + faked_key = XUFIXNUM (Vw32_phantom_key_code) & 255; else faked_key = VK_SPACE; keybd_event (faked_key, (BYTE) MapVirtualKey (faked_key, 0), 0, 0); @@ -199,7 +199,7 @@ key_event (KEY_EVENT_RECORD *event, struct input_event *emacs_ev, int *isdead) if ((mod_key_state & RIGHT_WIN_PRESSED) == 0) { if (FIXED_OR_FLOATP (Vw32_phantom_key_code)) - faked_key = XUINT (Vw32_phantom_key_code) & 255; + faked_key = XUFIXNUM (Vw32_phantom_key_code) & 255; else faked_key = VK_SPACE; keybd_event (faked_key, (BYTE) MapVirtualKey (faked_key, 0), 0, 0); diff --git a/src/w32proc.c b/src/w32proc.c index 4cffdd0d9d..61ce157b55 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -1890,7 +1890,7 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp) /* Override escape char by binding w32-quote-process-args to desired character, or use t for auto-selection. */ if (FIXNUMP (Vw32_quote_process_args)) - escape_char = XINT (Vw32_quote_process_args); + escape_char = XFIXNUM (Vw32_quote_process_args); else escape_char = (is_cygnus_app || is_msys_app) ? '"' : '\\'; } @@ -3023,7 +3023,7 @@ If successful, the return value is t, otherwise nil. */) externally. This is necessary because real pids on Windows 95 are negative. */ - pid = XINT (process); + pid = XFIXNUM (process); cp = find_child_pid (pid); if (cp != NULL) pid = cp->procinfo.dwProcessId; @@ -3188,12 +3188,12 @@ If LCID (a 16-bit number) is not a valid locale, the result is nil. */) CHECK_FIXNUM (lcid); - if (!IsValidLocale (XINT (lcid), LCID_SUPPORTED)) + if (!IsValidLocale (XFIXNUM (lcid), LCID_SUPPORTED)) return Qnil; if (NILP (longform)) { - got_abbrev = GetLocaleInfo (XINT (lcid), + got_abbrev = GetLocaleInfo (XFIXNUM (lcid), LOCALE_SABBREVLANGNAME | LOCALE_USE_CP_ACP, abbrev_name, sizeof (abbrev_name)); if (got_abbrev) @@ -3201,7 +3201,7 @@ If LCID (a 16-bit number) is not a valid locale, the result is nil. */) } else if (EQ (longform, Qt)) { - got_full = GetLocaleInfo (XINT (lcid), + got_full = GetLocaleInfo (XFIXNUM (lcid), LOCALE_SLANGUAGE | LOCALE_USE_CP_ACP, full_name, sizeof (full_name)); if (got_full) @@ -3209,8 +3209,8 @@ If LCID (a 16-bit number) is not a valid locale, the result is nil. */) } else if (FIXED_OR_FLOATP (longform)) { - got_full = GetLocaleInfo (XINT (lcid), - XINT (longform), + got_full = GetLocaleInfo (XFIXNUM (lcid), + XFIXNUM (longform), full_name, sizeof (full_name)); /* GetLocaleInfo's return value includes the terminating null character, when the returned information is a string, whereas @@ -3301,16 +3301,16 @@ If successful, the new locale id is returned, otherwise nil. */) { CHECK_FIXNUM (lcid); - if (!IsValidLocale (XINT (lcid), LCID_SUPPORTED)) + if (!IsValidLocale (XFIXNUM (lcid), LCID_SUPPORTED)) return Qnil; - if (!SetThreadLocale (XINT (lcid))) + if (!SetThreadLocale (XFIXNUM (lcid))) return Qnil; /* Need to set input thread locale if present. */ if (dwWindowsThreadId) /* Reply is not needed. */ - PostThreadMessage (dwWindowsThreadId, WM_EMACS_SETLOCALE, XINT (lcid), 0); + PostThreadMessage (dwWindowsThreadId, WM_EMACS_SETLOCALE, XFIXNUM (lcid), 0); return make_fixnum (GetThreadLocale ()); } @@ -3360,10 +3360,10 @@ If successful, the new CP is returned, otherwise nil. */) { CHECK_FIXNUM (cp); - if (!IsValidCodePage (XINT (cp))) + if (!IsValidCodePage (XFIXNUM (cp))) return Qnil; - if (!SetConsoleCP (XINT (cp))) + if (!SetConsoleCP (XFIXNUM (cp))) return Qnil; return make_fixnum (GetConsoleCP ()); @@ -3388,10 +3388,10 @@ If successful, the new CP is returned, otherwise nil. */) { CHECK_FIXNUM (cp); - if (!IsValidCodePage (XINT (cp))) + if (!IsValidCodePage (XFIXNUM (cp))) return Qnil; - if (!SetConsoleOutputCP (XINT (cp))) + if (!SetConsoleOutputCP (XFIXNUM (cp))) return Qnil; return make_fixnum (GetConsoleOutputCP ()); @@ -3414,13 +3414,13 @@ yield nil. */) CHECK_FIXNUM (cp); - if (!IsValidCodePage (XINT (cp))) + if (!IsValidCodePage (XFIXNUM (cp))) return Qnil; /* Going through a temporary DWORD_PTR variable avoids compiler warning about cast to pointer from integer of different size, when building --with-wide-int or building for 64bit. */ - dwcp = XINT (cp); + dwcp = XFIXNUM (cp); if (TranslateCharsetInfo ((DWORD *) dwcp, &info, TCI_SRCCODEPAGE)) return make_fixnum (info.ciCharset); @@ -3480,8 +3480,8 @@ If successful, the new layout id is returned, otherwise nil. */) CHECK_FIXNUM_CAR (layout); CHECK_FIXNUM_CDR (layout); - kl = (HKL) (UINT_PTR) ((XINT (XCAR (layout)) & 0xffff) - | (XINT (XCDR (layout)) << 16)); + kl = (HKL) (UINT_PTR) ((XFIXNUM (XCAR (layout)) & 0xffff) + | (XFIXNUM (XCDR (layout)) << 16)); /* Synchronize layout with input thread. */ if (dwWindowsThreadId) diff --git a/src/w32select.c b/src/w32select.c index 9255bf068a..dc568d47f2 100644 --- a/src/w32select.c +++ b/src/w32select.c @@ -241,7 +241,7 @@ static Lisp_Object render (Lisp_Object oformat) { HGLOBAL htext = NULL; - UINT format = XFASTINT (oformat); + UINT format = XFIXNAT (oformat); ONTRACE (fprintf (stderr, "render\n")); diff --git a/src/w32term.c b/src/w32term.c index cf6d516d58..9d224fe9b4 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -479,7 +479,7 @@ x_set_frame_alpha (struct frame *f) if (FLOATP (Vframe_alpha_lower_limit)) alpha_min = XFLOAT_DATA (Vframe_alpha_lower_limit); else if (FIXNUMP (Vframe_alpha_lower_limit)) - alpha_min = (XINT (Vframe_alpha_lower_limit)) / 100.0; + alpha_min = (XFIXNUM (Vframe_alpha_lower_limit)) / 100.0; if (alpha < 0.0) return; @@ -1982,11 +1982,11 @@ x_draw_image_relief (struct glyph_string *s) && FIXNUMP (XCAR (Vtool_bar_button_margin)) && FIXNUMP (XCDR (Vtool_bar_button_margin))) { - extra_x = XINT (XCAR (Vtool_bar_button_margin)); - extra_y = XINT (XCDR (Vtool_bar_button_margin)); + extra_x = XFIXNUM (XCAR (Vtool_bar_button_margin)); + extra_y = XFIXNUM (XCDR (Vtool_bar_button_margin)); } else if (FIXNUMP (Vtool_bar_button_margin)) - extra_x = extra_y = XINT (Vtool_bar_button_margin); + extra_x = extra_y = XFIXNUM (Vtool_bar_button_margin); } top_p = bot_p = left_p = right_p = 0; @@ -2482,7 +2482,7 @@ x_draw_glyph_string (struct glyph_string *s) = buffer_local_value (Qunderline_minimum_offset, s->w->contents); if (FIXNUMP (val)) - minimum_offset = XFASTINT (val); + minimum_offset = XFIXNAT (val); else minimum_offset = 1; val = buffer_local_value (Qx_underline_at_descent_line, @@ -3573,8 +3573,8 @@ w32_mouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, static void w32_handle_tool_bar_click (struct frame *f, struct input_event *button_event) { - int x = XFASTINT (button_event->x); - int y = XFASTINT (button_event->y); + int x = XFIXNAT (button_event->x); + int y = XFIXNAT (button_event->y); if (button_event->modifiers & down_modifier) handle_tool_bar_click (f, x, y, 1, 0); @@ -4996,8 +4996,8 @@ w32_read_socket (struct terminal *terminal, && WINDOW_TOTAL_LINES (XWINDOW (f->tool_bar_window))) { Lisp_Object window; - int x = XFASTINT (inev.x); - int y = XFASTINT (inev.y); + int x = XFIXNAT (inev.x); + int y = XFIXNAT (inev.y); window = window_from_coordinates (f, x, y, 0, 1); @@ -6145,8 +6145,8 @@ x_calc_absolute_position (struct frame *f) monitor_left = Fnth (make_fixnum (1), geometry); monitor_top = Fnth (make_fixnum (2), geometry); - display_left = min (display_left, XINT (monitor_left)); - display_top = min (display_top, XINT (monitor_top)); + display_left = min (display_left, XFIXNUM (monitor_left)); + display_top = min (display_top, XFIXNUM (monitor_top)); } } } diff --git a/src/w32term.h b/src/w32term.h index c69bebeebd..ebdab040fb 100644 --- a/src/w32term.h +++ b/src/w32term.h @@ -478,7 +478,7 @@ struct scroll_bar { #ifdef _WIN64 /* Building a 64-bit C integer from two 32-bit lisp integers. */ -#define SCROLL_BAR_PACK(low, high) (XINT (high) << 32 | XINT (low)) +#define SCROLL_BAR_PACK(low, high) (XFIXNUM (high) << 32 | XFIXNUM (low)) /* Setting two lisp integers to the low and high words of a 64-bit C int. */ #define SCROLL_BAR_UNPACK(low, high, int64) \ @@ -486,7 +486,7 @@ struct scroll_bar { XSETINT ((high), ((DWORDLONG)(int64) >> 32) & 0xffffffff)) #else /* not _WIN64 */ /* Building a 32-bit C unsigned integer from two 16-bit lisp integers. */ -#define SCROLL_BAR_PACK(low, high) ((UINT_PTR)(XINT (high) << 16 | XINT (low))) +#define SCROLL_BAR_PACK(low, high) ((UINT_PTR)(XFIXNUM (high) << 16 | XFIXNUM (low))) /* Setting two lisp integers to the low and high words of a 32-bit C int. */ #define SCROLL_BAR_UNPACK(low, high, int32) \ diff --git a/src/w32uniscribe.c b/src/w32uniscribe.c index 149f03d6ac..11bfa5490b 100644 --- a/src/w32uniscribe.c +++ b/src/w32uniscribe.c @@ -879,7 +879,7 @@ uniscribe_check_otf (LOGFONT *font, Lisp_Object otf_spec) int i, retval = 0; /* Check the spec is in the right format. */ - if (!CONSP (otf_spec) || XINT (Flength (otf_spec)) < 3) + if (!CONSP (otf_spec) || XFIXNUM (Flength (otf_spec)) < 3) return 0; /* Break otf_spec into its components. */ diff --git a/src/window.c b/src/window.c index e3b0c3a66a..67cfdc12b5 100644 --- a/src/window.c +++ b/src/window.c @@ -1118,7 +1118,7 @@ window so that the location of point moves off-window. */) (Lisp_Object window, Lisp_Object ncol) { CHECK_FIXNUM (ncol); - return set_window_hscroll (decode_live_window (window), XINT (ncol)); + return set_window_hscroll (decode_live_window (window), XFIXNUM (ncol)); } DEFUN ("window-redisplay-end-trigger", Fwindow_redisplay_end_trigger, @@ -1764,7 +1764,7 @@ POS, ROWH is the visible height of that row, and VPOS is the row number else if (!NILP (pos)) { CHECK_FIXNUM_COERCE_MARKER (pos); - posint = XINT (pos); + posint = XFIXNUM (pos); } else if (w == XWINDOW (selected_window)) posint = PT; @@ -1870,7 +1870,7 @@ Return nil if window display is not up-to-date. In that case, use } CHECK_FIXNUM (line); - n = XINT (line); + n = XFIXNUM (line); row = MATRIX_FIRST_TEXT_ROW (w->current_matrix); end_row = MATRIX_BOTTOM_TEXT_ROW (w->current_matrix, w); @@ -1975,7 +1975,7 @@ though when run from an idle timer with a delay of zero seconds. */) else if (FIXED_OR_FLOATP (first)) { CHECK_RANGED_INTEGER (first, 0, w->current_matrix->nrows); - row = MATRIX_ROW (w->current_matrix, XINT (first)); + row = MATRIX_ROW (w->current_matrix, XFIXNUM (first)); } else error ("Invalid specification of first line"); @@ -1988,7 +1988,7 @@ though when run from an idle timer with a delay of zero seconds. */) else if (FIXED_OR_FLOATP (last)) { CHECK_RANGED_INTEGER (last, 0, w->current_matrix->nrows); - end_row = MATRIX_ROW (w->current_matrix, XINT (last)); + end_row = MATRIX_ROW (w->current_matrix, XFIXNUM (last)); } else error ("Invalid specification of last line"); @@ -2492,7 +2492,7 @@ candidate_window_p (Lisp_Object window, Lisp_Object owindow, == FRAME_TERMINAL (XFRAME (selected_frame))); } - else if (FIXNUMP (all_frames) && XINT (all_frames) == 0) + else if (FIXNUMP (all_frames) && XFIXNUM (all_frames) == 0) { candidate_p = (FRAME_VISIBLE_P (f) || FRAME_ICONIFIED_P (f) #ifdef HAVE_X_WINDOWS @@ -3495,7 +3495,7 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer, /* Update time stamps of buffer display. */ if (FIXNUMP (BVAR (b, display_count))) - bset_display_count (b, make_fixnum (XINT (BVAR (b, display_count)) + 1)); + bset_display_count (b, make_fixnum (XFIXNUM (BVAR (b, display_count)) + 1)); bset_display_time (b, Fcurrent_time ()); w->window_end_pos = 0; @@ -3820,14 +3820,14 @@ Note: This function does not operate on any child windows of WINDOW. */) (Lisp_Object window, Lisp_Object size, Lisp_Object add) { struct window *w = decode_valid_window (window); - EMACS_INT size_min = NILP (add) ? 0 : - XINT (w->new_pixel); + EMACS_INT size_min = NILP (add) ? 0 : - XFIXNUM (w->new_pixel); EMACS_INT size_max = size_min + min (INT_MAX, MOST_POSITIVE_FIXNUM); CHECK_RANGED_INTEGER (size, size_min, size_max); if (NILP (add)) wset_new_pixel (w, size); else - wset_new_pixel (w, make_fixnum (XINT (w->new_pixel) + XINT (size))); + wset_new_pixel (w, make_fixnum (XFIXNUM (w->new_pixel) + XFIXNUM (size))); return w->new_pixel; } @@ -3853,7 +3853,7 @@ Note: This function does not operate on any child windows of WINDOW. */) if (NILP (add)) wset_new_total (w, size); else - wset_new_total (w, make_fixnum (XINT (w->new_total) + XINT (size))); + wset_new_total (w, make_fixnum (XFIXNUM (w->new_total) + XFIXNUM (size))); return w->new_total; } @@ -3895,7 +3895,7 @@ window_resize_check (struct window *w, bool horflag) { while (c) { - if (XINT (c->new_pixel) != XINT (w->new_pixel) + if (XFIXNUM (c->new_pixel) != XFIXNUM (w->new_pixel) || !window_resize_check (c, horflag)) return false; @@ -3908,14 +3908,14 @@ window_resize_check (struct window *w, bool horflag) /* The sum of the heights of the child windows of W must equal W's height. */ { - int remaining_pixels = XINT (w->new_pixel); + int remaining_pixels = XFIXNUM (w->new_pixel); while (c) { if (!window_resize_check (c, horflag)) return false; - remaining_pixels -= XINT (c->new_pixel); + remaining_pixels -= XFIXNUM (c->new_pixel); if (remaining_pixels < 0) return false; c = NILP (c->next) ? 0 : XWINDOW (c->next); @@ -3932,14 +3932,14 @@ window_resize_check (struct window *w, bool horflag) /* The sum of the widths of the child windows of W must equal W's width. */ { - int remaining_pixels = XINT (w->new_pixel); + int remaining_pixels = XFIXNUM (w->new_pixel); while (c) { if (!window_resize_check (c, horflag)) return false; - remaining_pixels -= XINT (c->new_pixel); + remaining_pixels -= XFIXNUM (c->new_pixel); if (remaining_pixels < 0) return false; c = NILP (c->next) ? 0 : XWINDOW (c->next); @@ -3952,7 +3952,7 @@ window_resize_check (struct window *w, bool horflag) { while (c) { - if (XINT (c->new_pixel) != XINT (w->new_pixel) + if (XFIXNUM (c->new_pixel) != XFIXNUM (w->new_pixel) || !window_resize_check (c, horflag)) return false; @@ -3966,7 +3966,7 @@ window_resize_check (struct window *w, bool horflag) /* A leaf window. Make sure it's not too small. The following hardcodes the values of `window-safe-min-width' (2) and `window-safe-min-height' (1) which are defined in window.el. */ - return (XINT (w->new_pixel) >= (horflag + return (XFIXNUM (w->new_pixel) >= (horflag ? (2 * FRAME_COLUMN_WIDTH (f)) : FRAME_LINE_HEIGHT (f))); } @@ -3992,7 +3992,7 @@ window_resize_apply (struct window *w, bool horflag) parent window has been set *before*. */ if (horflag) { - w->pixel_width = XFASTINT (w->new_pixel); + w->pixel_width = XFIXNAT (w->new_pixel); w->total_cols = w->pixel_width / unit; if (FIXED_OR_FLOATP (w->new_normal)) wset_normal_cols (w, w->new_normal); @@ -4001,7 +4001,7 @@ window_resize_apply (struct window *w, bool horflag) } else { - w->pixel_height = XFASTINT (w->new_pixel); + w->pixel_height = XFIXNAT (w->new_pixel); w->total_lines = w->pixel_height / unit; if (FIXED_OR_FLOATP (w->new_normal)) wset_normal_lines (w, w->new_normal); @@ -4076,12 +4076,12 @@ window_resize_apply_total (struct window *w, bool horflag) parent window has been set *before*. */ if (horflag) { - w->total_cols = XFASTINT (w->new_total); + w->total_cols = XFIXNAT (w->new_total); edge = w->left_col; } else { - w->total_lines = XFASTINT (w->new_total); + w->total_lines = XFIXNAT (w->new_total); edge = w->top_line; } @@ -4149,7 +4149,7 @@ be applied on the Elisp level. */) bool horflag = !NILP (horizontal); if (!window_resize_check (r, horflag) - || (XINT (r->new_pixel) + || (XFIXNUM (r->new_pixel) != (horflag ? r->pixel_width : r->pixel_height))) return Qnil; @@ -4193,10 +4193,10 @@ values. */) if (NILP (horizontal)) { m->top_line = r->top_line + r->total_lines; - m->total_lines = XFASTINT (m->new_total); + m->total_lines = XFIXNAT (m->new_total); } else - m->total_cols = XFASTINT (m->new_total); + m->total_cols = XFIXNAT (m->new_total); } unblock_input (); @@ -4286,7 +4286,7 @@ resize_frame_windows (struct frame *f, int size, bool horflag, bool pixelwise) resize_root_window (root, delta, horflag ? Qt : Qnil, Qnil, pixelwise ? Qt : Qnil); if (window_resize_check (r, horflag) - && new_pixel_size == XINT (r->new_pixel)) + && new_pixel_size == XFIXNUM (r->new_pixel)) { window_resize_apply (r, horflag); window_pixel_to_total (r->frame, horflag ? Qt : Qnil); @@ -4297,7 +4297,7 @@ resize_frame_windows (struct frame *f, int size, bool horflag, bool pixelwise) resize_root_window (root, delta, horflag ? Qt : Qnil, Qt, pixelwise ? Qt : Qnil); if (window_resize_check (r, horflag) - && new_pixel_size == XINT (r->new_pixel)) + && new_pixel_size == XFIXNUM (r->new_pixel)) { window_resize_apply (r, horflag); window_pixel_to_total (r->frame, horflag ? Qt : Qnil); @@ -4371,7 +4371,7 @@ set correctly. See the code of `split-window' for how this is done. */) CHECK_FIXNUM (pixel_size); EMACS_INT total_size - = XINT (pixel_size) / (horflag + = XFIXNUM (pixel_size) / (horflag ? FRAME_COLUMN_WIDTH (f) : FRAME_LINE_HEIGHT (f)); @@ -4407,7 +4407,7 @@ set correctly. See the code of `split-window' for how this is done. */) /* Temporarily pretend we split the parent window. */ wset_new_pixel (p, make_fixnum ((horflag ? p->pixel_width : p->pixel_height) - - XINT (pixel_size))); + - XFIXNUM (pixel_size))); if (!window_resize_check (p, horflag)) error ("Window sizes don't fit"); else @@ -4418,7 +4418,7 @@ set correctly. See the code of `split-window' for how this is done. */) { if (!window_resize_check (o, horflag)) error ("Resizing old window failed"); - else if (XINT (pixel_size) + XINT (o->new_pixel) + else if (XFIXNUM (pixel_size) + XFIXNUM (o->new_pixel) != (horflag ? o->pixel_width : o->pixel_height)) error ("Sum of sizes of old and new window don't fit"); } @@ -4511,7 +4511,7 @@ set correctly. See the code of `split-window' for how this is done. */) while (c) { if (c != n) - sum = sum + XINT (c->new_total); + sum = sum + XFIXNUM (c->new_total); c = NILP (c->next) ? 0 : XWINDOW (c->next); } wset_new_total (n, make_fixnum ((horflag @@ -4596,7 +4596,7 @@ Signal an error when WINDOW is the only window on its frame. */) } if (window_resize_check (r, horflag) - && (XINT (r->new_pixel) + && (XFIXNUM (r->new_pixel) == (horflag ? r->pixel_width : r->pixel_height))) /* We can delete WINDOW now. */ { @@ -4735,12 +4735,12 @@ grow_mini_window (struct window *w, int delta, bool pixelwise) if (pixelwise) { - pixel_height = min (-XINT (height), INT_MAX - w->pixel_height); + pixel_height = min (-XFIXNUM (height), INT_MAX - w->pixel_height); line_height = pixel_height / FRAME_LINE_HEIGHT (f); } else { - line_height = min (-XINT (height), + line_height = min (-XFIXNUM (height), ((INT_MAX - w->pixel_height) / FRAME_LINE_HEIGHT (f))); pixel_height = line_height * FRAME_LINE_HEIGHT (f); @@ -4831,13 +4831,13 @@ DEFUN ("resize-mini-window-internal", Fresize_mini_window_internal, Sresize_mini r = XWINDOW (FRAME_ROOT_WINDOW (f)); height = r->pixel_height + w->pixel_height; if (window_resize_check (r, false) - && XINT (w->new_pixel) > 0 - && height == XINT (r->new_pixel) + XINT (w->new_pixel)) + && XFIXNUM (w->new_pixel) > 0 + && height == XFIXNUM (r->new_pixel) + XFIXNUM (w->new_pixel)) { block_input (); window_resize_apply (r, false); - w->pixel_height = XFASTINT (w->new_pixel); + w->pixel_height = XFIXNAT (w->new_pixel); w->total_lines = w->pixel_height / FRAME_LINE_HEIGHT (f); w->pixel_top = r->pixel_top + r->pixel_height; w->top_line = r->top_line + r->total_lines; @@ -5128,9 +5128,9 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) /* If there are other text lines above the current row, move window start to current row. Else to next row. */ if (rbot > 0) - spos = XINT (Fline_beginning_position (Qnil)); + spos = XFIXNUM (Fline_beginning_position (Qnil)); else - spos = min (XINT (Fline_end_position (Qnil)) + 1, ZV); + spos = min (XFIXNUM (Fline_end_position (Qnil)) + 1, ZV); set_marker_restricted (w->start, make_fixnum (spos), w->contents); w->start_at_line_beg = true; @@ -5589,7 +5589,7 @@ window_scroll_line_based (Lisp_Object window, int n, bool whole, bool noerror) SET_PT_BOTH (pos, pos_byte); tem = Fvertical_motion (make_fixnum (ht - this_scroll_margin), window, Qnil); - if (XFASTINT (tem) == ht - this_scroll_margin) + if (XFIXNAT (tem) == ht - this_scroll_margin) bottom_margin = PT; else bottom_margin = PT + 1; @@ -5680,7 +5680,7 @@ scroll_command (Lisp_Object window, Lisp_Object n, int direction) else { n = Fprefix_numeric_value (n); - window_scroll (window, XINT (n) * direction, false, false); + window_scroll (window, XFIXNUM (n) * direction, false, false); } if (other_window) @@ -5804,7 +5804,7 @@ by this function. This happens in an interactive call. */) struct window *w = XWINDOW (selected_window); EMACS_INT requested_arg = (NILP (arg) ? window_body_width (w, 0) - 2 - : XINT (Fprefix_numeric_value (arg))); + : XFIXNUM (Fprefix_numeric_value (arg))); Lisp_Object result = set_window_hscroll (w, w->hscroll + requested_arg); if (!NILP (set_minimum)) @@ -5829,7 +5829,7 @@ by this function. This happens in an interactive call. */) struct window *w = XWINDOW (selected_window); EMACS_INT requested_arg = (NILP (arg) ? window_body_width (w, 0) - 2 - : XINT (Fprefix_numeric_value (arg))); + : XFIXNUM (Fprefix_numeric_value (arg))); Lisp_Object result = set_window_hscroll (w, w->hscroll - requested_arg); if (!NILP (set_minimum)) @@ -5962,7 +5962,7 @@ and redisplay normally--don't erase and redraw the frame. */) { arg = Fprefix_numeric_value (arg); CHECK_FIXNUM (arg); - iarg = XINT (arg); + iarg = XFIXNUM (arg); } /* Do this after making BUF current @@ -6210,7 +6210,7 @@ from the top of the window. */) XSETFASTINT (arg, lines / 2); else { - EMACS_INT iarg = XINT (Fprefix_numeric_value (arg)); + EMACS_INT iarg = XFIXNUM (Fprefix_numeric_value (arg)); if (iarg < 0) iarg = iarg + lines; @@ -6233,7 +6233,7 @@ from the top of the window. */) /* Skip past a partially visible first line. */ if (w->vscroll) - XSETINT (arg, XINT (arg) + 1); + XSETINT (arg, XFIXNUM (arg) + 1); return Fvertical_motion (arg, window, Qnil); } @@ -6471,14 +6471,14 @@ the return value is nil. Otherwise the value is t. */) if (!NILP (p->parent)) wset_parent - (w, SAVED_WINDOW_N (saved_windows, XFASTINT (p->parent))->window); + (w, SAVED_WINDOW_N (saved_windows, XFIXNAT (p->parent))->window); else wset_parent (w, Qnil); if (!NILP (p->prev)) { wset_prev - (w, SAVED_WINDOW_N (saved_windows, XFASTINT (p->prev))->window); + (w, SAVED_WINDOW_N (saved_windows, XFIXNAT (p->prev))->window); wset_next (XWINDOW (w->prev), p->window); } else @@ -6486,7 +6486,7 @@ the return value is nil. Otherwise the value is t. */) wset_prev (w, Qnil); if (!NILP (w->parent)) wset_combination (XWINDOW (w->parent), - (XINT (p->total_cols) + (XFIXNUM (p->total_cols) != XWINDOW (w->parent)->total_cols), p->window); } @@ -6494,32 +6494,32 @@ the return value is nil. Otherwise the value is t. */) /* If we squirreled away the buffer, restore it now. */ if (BUFFERP (w->combination_limit)) wset_buffer (w, w->combination_limit); - w->pixel_left = XFASTINT (p->pixel_left); - w->pixel_top = XFASTINT (p->pixel_top); - w->pixel_width = XFASTINT (p->pixel_width); - w->pixel_height = XFASTINT (p->pixel_height); + w->pixel_left = XFIXNAT (p->pixel_left); + w->pixel_top = XFIXNAT (p->pixel_top); + w->pixel_width = XFIXNAT (p->pixel_width); + w->pixel_height = XFIXNAT (p->pixel_height); w->pixel_width_before_size_change - = XFASTINT (p->pixel_width_before_size_change); + = XFIXNAT (p->pixel_width_before_size_change); w->pixel_height_before_size_change - = XFASTINT (p->pixel_height_before_size_change); - w->left_col = XFASTINT (p->left_col); - w->top_line = XFASTINT (p->top_line); - w->total_cols = XFASTINT (p->total_cols); - w->total_lines = XFASTINT (p->total_lines); + = XFIXNAT (p->pixel_height_before_size_change); + w->left_col = XFIXNAT (p->left_col); + w->top_line = XFIXNAT (p->top_line); + w->total_cols = XFIXNAT (p->total_cols); + w->total_lines = XFIXNAT (p->total_lines); wset_normal_cols (w, p->normal_cols); wset_normal_lines (w, p->normal_lines); - w->hscroll = XFASTINT (p->hscroll); + w->hscroll = XFIXNAT (p->hscroll); w->suspend_auto_hscroll = !NILP (p->suspend_auto_hscroll); - w->min_hscroll = XFASTINT (p->min_hscroll); - w->hscroll_whole = XFASTINT (p->hscroll_whole); + w->min_hscroll = XFIXNAT (p->min_hscroll); + w->hscroll_whole = XFIXNAT (p->hscroll_whole); wset_display_table (w, p->display_table); - w->left_margin_cols = XINT (p->left_margin_cols); - w->right_margin_cols = XINT (p->right_margin_cols); - w->left_fringe_width = XINT (p->left_fringe_width); - w->right_fringe_width = XINT (p->right_fringe_width); + w->left_margin_cols = XFIXNUM (p->left_margin_cols); + w->right_margin_cols = XFIXNUM (p->right_margin_cols); + w->left_fringe_width = XFIXNUM (p->left_fringe_width); + w->right_fringe_width = XFIXNUM (p->right_fringe_width); w->fringes_outside_margins = !NILP (p->fringes_outside_margins); - w->scroll_bar_width = XINT (p->scroll_bar_width); - w->scroll_bar_height = XINT (p->scroll_bar_height); + w->scroll_bar_width = XFIXNUM (p->scroll_bar_width); + w->scroll_bar_height = XFIXNUM (p->scroll_bar_height); wset_vertical_scroll_bar_type (w, p->vertical_scroll_bar_type); wset_horizontal_scroll_bar_type (w, p->horizontal_scroll_bar_type); wset_dedicated (w, p->dedicated); @@ -7042,7 +7042,7 @@ extract_dimension (Lisp_Object dimension) if (NILP (dimension)) return -1; CHECK_RANGED_INTEGER (dimension, 0, INT_MAX); - return XINT (dimension); + return XFIXNUM (dimension); } static struct window * diff --git a/src/xdisp.c b/src/xdisp.c index 4af0a6d2e3..e30f800b7e 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -1251,7 +1251,7 @@ default_line_pixel_height (struct window *w) if (!NILP (val)) { if (RANGED_FIXNUMP (0, val, INT_MAX)) - height += XFASTINT (val); + height += XFIXNAT (val); else if (FLOATP (val)) { int addon = XFLOAT_DATA (val) * height + 0.5; @@ -1550,8 +1550,8 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y, startpos = Fprevious_single_char_property_change (endpos, Qdisplay, Qnil, Qnil); - start = XFASTINT (startpos); - end = XFASTINT (endpos); + start = XFIXNAT (startpos); + end = XFIXNAT (endpos); /* Move to the last buffer position before the display property. */ start_display (&it3, w, top); @@ -2843,7 +2843,7 @@ init_iterator (struct it *it, struct window *w, && FRAME_WINDOW_P (it->f)) { if (FIXNATP (BVAR (current_buffer, extra_line_spacing))) - it->extra_line_spacing = XFASTINT (BVAR (current_buffer, extra_line_spacing)); + it->extra_line_spacing = XFIXNAT (BVAR (current_buffer, extra_line_spacing)); else if (FLOATP (BVAR (current_buffer, extra_line_spacing))) it->extra_line_spacing = (XFLOAT_DATA (BVAR (current_buffer, extra_line_spacing)) * FRAME_LINE_HEIGHT (it->f)); @@ -2870,7 +2870,7 @@ init_iterator (struct it *it, struct window *w, invisible. */ it->selective = (FIXNUMP (BVAR (current_buffer, selective_display)) ? (clip_to_bounds - (-1, XINT (BVAR (current_buffer, selective_display)), + (-1, XFIXNUM (BVAR (current_buffer, selective_display)), PTRDIFF_MAX)) : (!NILP (BVAR (current_buffer, selective_display)) ? -1 : 0)); @@ -2891,7 +2891,7 @@ init_iterator (struct it *it, struct window *w, = marker_position (w->redisplay_end_trigger); else if (FIXNUMP (w->redisplay_end_trigger)) it->redisplay_end_trigger_charpos - = clip_to_bounds (PTRDIFF_MIN, XINT (w->redisplay_end_trigger), + = clip_to_bounds (PTRDIFF_MIN, XFIXNUM (w->redisplay_end_trigger), PTRDIFF_MAX); it->tab_width = SANE_TAB_WIDTH (current_buffer); @@ -2905,7 +2905,7 @@ init_iterator (struct it *it, struct window *w, || NILP (Vtruncate_partial_width_windows) || (FIXNUMP (Vtruncate_partial_width_windows) /* PXW: Shall we do something about this? */ - && (XINT (Vtruncate_partial_width_windows) + && (XFIXNUM (Vtruncate_partial_width_windows) <= WINDOW_TOTAL_COLS (it->w)))) && NILP (BVAR (current_buffer, truncate_lines))) it->line_wrap = NILP (BVAR (current_buffer, word_wrap)) @@ -3599,7 +3599,7 @@ compute_stop_pos (struct it *it) for (next_iv = next_interval (iv); (next_iv && (NILP (limit) - || XFASTINT (limit) > next_iv->position)); + || XFIXNAT (limit) > next_iv->position)); next_iv = next_interval (next_iv)) { for (p = it_props; p->handler; ++p) @@ -3617,9 +3617,9 @@ compute_stop_pos (struct it *it) if (next_iv) { if (FIXNUMP (limit) - && next_iv->position >= XFASTINT (limit)) + && next_iv->position >= XFIXNAT (limit)) /* No text property change up to limit. */ - it->stop_charpos = min (XFASTINT (limit), it->stop_charpos); + it->stop_charpos = min (XFIXNAT (limit), it->stop_charpos); else /* Text properties change in next_iv. */ it->stop_charpos = min (it->stop_charpos, next_iv->position); @@ -3758,7 +3758,7 @@ compute_display_string_pos (struct text_pos *position, limpos = make_fixnum (lim); do { pos = Fnext_single_char_property_change (pos, Qdisplay, object1, limpos); - CHARPOS (tpos) = XFASTINT (pos); + CHARPOS (tpos) = XFIXNAT (pos); if (CHARPOS (tpos) >= lim) { *disp_prop = 0; @@ -3819,7 +3819,7 @@ compute_display_string_end (ptrdiff_t charpos, struct bidi_string_data *string) changes. */ pos = Fnext_single_char_property_change (pos, Qdisplay, object, Qnil); - return XFASTINT (pos); + return XFIXNAT (pos); } @@ -4376,7 +4376,7 @@ handle_invisible_prop (struct it *it) eassert (FIXNUMP (end_charpos)); if (FIXNUMP (end_charpos)) { - endpos = XFASTINT (end_charpos); + endpos = XFIXNAT (end_charpos); prop = Fget_text_property (end_charpos, Qinvisible, it->string); invis = TEXT_PROP_MEANS_INVISIBLE (prop); if (invis == 2) @@ -4863,11 +4863,11 @@ display_prop_end (struct it *it, Lisp_Object object, struct text_pos start_pos) end = Fnext_single_char_property_change (make_fixnum (CHARPOS (start_pos)), Qdisplay, object, Qnil); - CHARPOS (end_pos) = XFASTINT (end); + CHARPOS (end_pos) = XFIXNAT (end); if (STRINGP (object)) compute_string_pos (&end_pos, start_pos, it->string); else - BYTEPOS (end_pos) = CHAR_TO_BYTE (XFASTINT (end)); + BYTEPOS (end_pos) = CHAR_TO_BYTE (XFIXNAT (end)); return end_pos; } @@ -4965,7 +4965,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, && RANGED_FIXNUMP (0, XCAR (XCDR (it->font_height)), INT_MAX)) { /* `(+ N)' or `(- N)' where N is an integer. */ - int steps = XINT (XCAR (XCDR (it->font_height))); + int steps = XFIXNUM (XCAR (XCDR (it->font_height))); if (EQ (XCAR (it->font_height), Qplus)) steps = - steps; it->face_id = smaller_face (it->f, it->face_id, steps); @@ -4989,7 +4989,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, f = FACE_FROM_ID (it->f, lookup_basic_face (it->w, it->f, DEFAULT_FACE_ID)); new_height = (XFLOATINT (it->font_height) - * XINT (f->lface[LFACE_HEIGHT_INDEX])); + * XFIXNUM (f->lface[LFACE_HEIGHT_INDEX])); } else if (enable_eval_p) { @@ -5517,7 +5517,7 @@ string_buffer_position_lim (Lisp_Object string, } } - return found ? XINT (pos) : 0; + return found ? XFIXNUM (pos) : 0; } /* Determine which buffer position in current buffer STRING comes from. @@ -5852,7 +5852,7 @@ load_overlay_strings (struct it *it, ptrdiff_t charpos) entries[n].string = (STRING); \ entries[n].overlay = (OVERLAY); \ priority = Foverlay_get ((OVERLAY), Qpriority); \ - entries[n].priority = FIXNUMP (priority) ? XINT (priority) : 0; \ + entries[n].priority = FIXNUMP (priority) ? XFIXNUM (priority) : 0; \ entries[n].after_string_p = (AFTER_P); \ ++n; \ } \ @@ -10144,7 +10144,7 @@ include the height of both, if present, in the return value. */) else { CHECK_FIXNUM_COERCE_MARKER (from); - start = min (max (XINT (from), BEGV), ZV); + start = min (max (XFIXNUM (from), BEGV), ZV); } if (NILP (to)) @@ -10161,16 +10161,16 @@ include the height of both, if present, in the return value. */) else { CHECK_FIXNUM_COERCE_MARKER (to); - end = max (start, min (XINT (to), ZV)); + end = max (start, min (XFIXNUM (to), ZV)); } if (!NILP (x_limit) && RANGED_FIXNUMP (0, x_limit, INT_MAX)) - max_x = XINT (x_limit); + max_x = XFIXNUM (x_limit); if (NILP (y_limit)) max_y = INT_MAX; else if (RANGED_FIXNUMP (0, y_limit, INT_MAX)) - max_y = XINT (y_limit); + max_y = XFIXNUM (y_limit); itdata = bidi_shelve_cache (); SET_TEXT_POS (startp, start, CHAR_TO_BYTE (start)); @@ -10460,7 +10460,7 @@ message_dolog (const char *m, ptrdiff_t nbytes, bool nlflag, bool multibyte) if (FIXNATP (Vmessage_log_max)) { scan_newline (Z, Z_BYTE, BEG, BEG_BYTE, - -XFASTINT (Vmessage_log_max) - 1, false); + -XFIXNAT (Vmessage_log_max) - 1, false); del_range_both (BEG, BEG_BYTE, PT, PT_BYTE, false); } } @@ -11000,7 +11000,7 @@ unwind_with_echo_area_buffer (Lisp_Object vector) { set_buffer_internal_1 (XBUFFER (AREF (vector, 0))); Vdeactivate_mark = AREF (vector, 1); - windows_or_buffers_changed = XFASTINT (AREF (vector, 2)); + windows_or_buffers_changed = XFIXNAT (AREF (vector, 2)); if (WINDOWP (AREF (vector, 3))) { @@ -11012,14 +11012,14 @@ unwind_with_echo_area_buffer (Lisp_Object vector) wset_buffer (w, buffer); set_marker_both (w->pointm, buffer, - XFASTINT (AREF (vector, 5)), - XFASTINT (AREF (vector, 6))); + XFIXNAT (AREF (vector, 5)), + XFIXNAT (AREF (vector, 6))); set_marker_both (w->old_pointm, buffer, - XFASTINT (AREF (vector, 7)), - XFASTINT (AREF (vector, 8))); + XFIXNAT (AREF (vector, 7)), + XFIXNAT (AREF (vector, 8))); set_marker_both (w->start, buffer, - XFASTINT (AREF (vector, 9)), - XFASTINT (AREF (vector, 10))); + XFIXNAT (AREF (vector, 9)), + XFIXNAT (AREF (vector, 10))); } Vwith_echo_area_save_vector = vector; @@ -11280,7 +11280,7 @@ resize_mini_window (struct window *w, bool exact_p) if (FLOATP (Vmax_mini_window_height)) max_height = XFLOAT_DATA (Vmax_mini_window_height) * total_height; else if (FIXNUMP (Vmax_mini_window_height)) - max_height = XINT (Vmax_mini_window_height) * unit; + max_height = XFIXNUM (Vmax_mini_window_height) * unit; else max_height = total_height / 4; @@ -11871,8 +11871,8 @@ unwind_format_mode_line (Lisp_Object vector) Lisp_Object target_frame_window = AREF (vector, 8); Lisp_Object old_top_frame = AREF (vector, 9); - mode_line_target = XINT (AREF (vector, 0)); - mode_line_noprop_ptr = mode_line_noprop_buf + XINT (AREF (vector, 1)); + mode_line_target = XFIXNUM (AREF (vector, 0)); + mode_line_noprop_ptr = mode_line_noprop_buf + XFIXNUM (AREF (vector, 1)); mode_line_string_list = AREF (vector, 2); if (! EQ (AREF (vector, 3), Qt)) mode_line_proptrans_alist = AREF (vector, 3); @@ -12488,18 +12488,18 @@ build_desired_tool_bar_string (struct frame *f) if (RANGED_FIXNUMP (1, Vtool_bar_button_margin, INT_MAX - max (hmargin, vmargin))) { - hmargin += XFASTINT (Vtool_bar_button_margin); - vmargin += XFASTINT (Vtool_bar_button_margin); + hmargin += XFIXNAT (Vtool_bar_button_margin); + vmargin += XFIXNAT (Vtool_bar_button_margin); } else if (CONSP (Vtool_bar_button_margin)) { if (RANGED_FIXNUMP (1, XCAR (Vtool_bar_button_margin), INT_MAX - hmargin)) - hmargin += XFASTINT (XCAR (Vtool_bar_button_margin)); + hmargin += XFIXNAT (XCAR (Vtool_bar_button_margin)); if (RANGED_FIXNUMP (1, XCDR (Vtool_bar_button_margin), INT_MAX - vmargin)) - vmargin += XFASTINT (XCDR (Vtool_bar_button_margin)); + vmargin += XFIXNAT (XCDR (Vtool_bar_button_margin)); } if (auto_raise_tool_bar_buttons_p) @@ -12836,7 +12836,7 @@ redisplay_tool_bar (struct frame *f) int border, rows, height, extra; if (TYPE_RANGED_FIXNUMP (int, Vtool_bar_border)) - border = XINT (Vtool_bar_border); + border = XFIXNUM (Vtool_bar_border); else if (EQ (Vtool_bar_border, Qinternal_border_width)) border = FRAME_INTERNAL_BORDER_WIDTH (f); else if (EQ (Vtool_bar_border, Qborder_width)) @@ -12958,7 +12958,7 @@ tool_bar_item_info (struct frame *f, struct glyph *glyph, int *prop_idx) Qmenu_item, f->current_tool_bar_string); if (! FIXNUMP (prop)) return false; - *prop_idx = XINT (prop); + *prop_idx = XFIXNUM (prop); return true; } @@ -13205,7 +13205,7 @@ hscroll_window_tree (Lisp_Object window) } else if (TYPE_RANGED_FIXNUMP (int, Vhscroll_step)) { - hscroll_step_abs = XINT (Vhscroll_step); + hscroll_step_abs = XFIXNUM (Vhscroll_step); if (hscroll_step_abs < 0) hscroll_step_abs = 0; } @@ -13562,7 +13562,7 @@ text_outside_line_unchanged_p (struct window *w, beginning of the line. */ if (unchanged_p && FIXNUMP (BVAR (current_buffer, selective_display)) - && XINT (BVAR (current_buffer, selective_display)) > 0 + && XFIXNUM (BVAR (current_buffer, selective_display)) > 0 && (BEG_UNCHANGED < start || GPT <= start)) unchanged_p = false; @@ -14144,7 +14144,7 @@ redisplay_internal (void) { \ Lisp_Object entry = Fgethash (make_fixnum (i), a, make_fixnum (0)); \ if (FIXNUMP (entry)) \ - Fputhash (make_fixnum (i), make_fixnum (1 + XINT (entry)), a); \ + Fputhash (make_fixnum (i), make_fixnum (1 + XFIXNUM (entry)), a); \ } AINC (Vredisplay__all_windows_cause, windows_or_buffers_changed); @@ -15136,7 +15136,7 @@ set_cursor_from_row (struct window *w, struct glyph_row *row, } if (FIXNUMP (chprop)) { - bpos_covered = bpos_max + XINT (chprop); + bpos_covered = bpos_max + XFIXNUM (chprop); /* If the `cursor' property covers buffer positions up to and including point, we should display cursor on this glyph. Note that, if a `cursor' property on one @@ -15210,7 +15210,7 @@ set_cursor_from_row (struct window *w, struct glyph_row *row, } if (FIXNUMP (chprop)) { - bpos_covered = bpos_max + XINT (chprop); + bpos_covered = bpos_max + XFIXNUM (chprop); /* If the `cursor' property covers buffer positions up to and including point, we should display cursor on this glyph. */ @@ -16943,7 +16943,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) Qnil, Qnil); if (FIXNATP (invprop_end)) - alt_pt = XFASTINT (invprop_end); + alt_pt = XFIXNAT (invprop_end); else alt_pt = ZV; r = row_containing_pos (w, alt_pt, w->desired_matrix->rows, @@ -17475,7 +17475,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) Qnil, Qnil); if (FIXNATP (invis_end)) - alt_pos = XFASTINT (invis_end); + alt_pos = XFIXNAT (invis_end); else alt_pos = ZV; row = row_containing_pos (w, alt_pos, matrix->rows, NULL, 0); @@ -19584,7 +19584,7 @@ with numeric argument, its value is passed as the GLYPHS flag. */) w->cursor.x, w->cursor.y, w->cursor.hpos, w->cursor.vpos); fprintf (stderr, "=============================================\n"); dump_glyph_matrix (w->current_matrix, - TYPE_RANGED_FIXNUMP (int, glyphs) ? XINT (glyphs) : 0); + TYPE_RANGED_FIXNUMP (int, glyphs) ? XFIXNUM (glyphs) : 0); return Qnil; } @@ -19629,13 +19629,13 @@ GLYPHS > 1 or omitted means dump glyphs in long form. */) else { CHECK_FIXNUM (row); - vpos = XINT (row); + vpos = XFIXNUM (row); } matrix = XWINDOW (selected_window)->current_matrix; if (vpos >= 0 && vpos < matrix->nrows) dump_glyph_row (MATRIX_ROW (matrix, vpos), vpos, - TYPE_RANGED_FIXNUMP (int, glyphs) ? XINT (glyphs) : 2); + TYPE_RANGED_FIXNUMP (int, glyphs) ? XFIXNUM (glyphs) : 2); return Qnil; } @@ -19661,11 +19661,11 @@ do nothing. */) else { CHECK_FIXNUM (row); - vpos = XINT (row); + vpos = XFIXNUM (row); } if (vpos >= 0 && vpos < m->nrows) dump_glyph_row (MATRIX_ROW (m, vpos), vpos, - TYPE_RANGED_FIXNUMP (int, glyphs) ? XINT (glyphs) : 2); + TYPE_RANGED_FIXNUMP (int, glyphs) ? XFIXNUM (glyphs) : 2); #endif return Qnil; } @@ -19681,7 +19681,7 @@ With ARG, turn tracing on if and only if ARG is positive. */) else { arg = Fprefix_numeric_value (arg); - trace_redisplay_p = XINT (arg) > 0; + trace_redisplay_p = XFIXNUM (arg) > 0; } return Qnil; @@ -20147,8 +20147,8 @@ append_space_for_newline (struct it *it, bool default_face_p) it->phys_ascent = it->ascent; it->phys_descent = it->descent; if (!NILP (height) - && XINT (height) > it->ascent + it->descent) - it->ascent = XINT (height) - it->descent; + && XFIXNUM (height) > it->ascent + it->descent) + it->ascent = XFIXNUM (height) - it->descent; if (!NILP (total_height)) spacing = calc_line_height_property (it, total_height, font, @@ -20161,7 +20161,7 @@ append_space_for_newline (struct it *it, bool default_face_p) } if (FIXNUMP (spacing)) { - extra_line_spacing = XINT (spacing); + extra_line_spacing = XFIXNUM (spacing); if (!NILP (total_height)) extra_line_spacing -= (it->phys_ascent + it->phys_descent); } @@ -21129,7 +21129,7 @@ maybe_produce_line_number (struct it *it) if (!it->lnum_width) { if (FIXNATP (Vdisplay_line_numbers_width)) - it->lnum_width = XFASTINT (Vdisplay_line_numbers_width); + it->lnum_width = XFIXNAT (Vdisplay_line_numbers_width); /* Max line number to be displayed cannot be more than the one corresponding to the last row of the desired matrix. */ @@ -22186,7 +22186,7 @@ display_line (struct it *it, int cursor_vpos) else { eassert (FIXNUMP (overlay_arrow_string)); - row->overlay_arrow_bitmap = XINT (overlay_arrow_string); + row->overlay_arrow_bitmap = XFIXNUM (overlay_arrow_string); } overlay_arrow_seen = true; } @@ -22449,8 +22449,8 @@ the `bidi-class' property of a character. */) set_buffer_temp (buf); validate_region (&from, &to); - from_pos = XINT (from); - to_pos = XINT (to); + from_pos = XFIXNUM (from); + to_pos = XFIXNUM (to); if (from_pos >= ZV) return Qnil; @@ -22519,7 +22519,7 @@ Value is the new character position of point. */) && !(GLYPH)->avoid_cursor_p) CHECK_FIXNUM (direction); - dir = XINT (direction); + dir = XFIXNUM (direction); if (dir > 0) dir = 1; else @@ -22990,7 +22990,7 @@ Emacs UBA implementation, in particular with the test suite. */) else { CHECK_FIXNUM_COERCE_MARKER (vpos); - nrow = XINT (vpos); + nrow = XFIXNUM (vpos); } /* We require up-to-date glyph matrix for this window. */ @@ -23912,7 +23912,7 @@ display_mode_element (struct it *it, int depth, int field_width, int precision, } else if (FIXNUMP (car)) { - register int lim = XINT (car); + register int lim = XFIXNUM (car); elt = XCDR (elt); if (lim < 0) { @@ -24032,7 +24032,7 @@ store_mode_line_string (const char *string, Lisp_Object lisp_string, } else { - len = XFASTINT (Flength (lisp_string)); + len = XFIXNAT (Flength (lisp_string)); if (precision > 0 && len > precision) { len = precision; @@ -24362,7 +24362,7 @@ decode_mode_spec_coding (Lisp_Object coding_system, char *buf, bool eol_flag) eolvalue = AREF (val, 2); *buf++ = multibyte - ? XFASTINT (CODING_ATTR_MNEMONIC (attrs)) + ? XFIXNAT (CODING_ATTR_MNEMONIC (attrs)) : ' '; if (eol_flag) @@ -24391,7 +24391,7 @@ decode_mode_spec_coding (Lisp_Object coding_system, char *buf, bool eol_flag) } else if (CHARACTERP (eoltype)) { - int c = XFASTINT (eoltype); + int c = XFIXNAT (eoltype); return buf + CHAR_STRING (c, (unsigned char *) buf); } else @@ -24598,7 +24598,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, /* If the buffer is very big, don't waste time. */ if (FIXNUMP (Vline_number_display_limit) - && BUF_ZV (b) - BUF_BEGV (b) > XINT (Vline_number_display_limit)) + && BUF_ZV (b) - BUF_BEGV (b) > XFIXNUM (Vline_number_display_limit)) { w->base_line_pos = 0; w->base_line_number = 0; @@ -27191,22 +27191,22 @@ produce_image_glyph (struct it *it) slice.height = img->height; if (FIXNUMP (it->slice.x)) - slice.x = XINT (it->slice.x); + slice.x = XFIXNUM (it->slice.x); else if (FLOATP (it->slice.x)) slice.x = XFLOAT_DATA (it->slice.x) * img->width; if (FIXNUMP (it->slice.y)) - slice.y = XINT (it->slice.y); + slice.y = XFIXNUM (it->slice.y); else if (FLOATP (it->slice.y)) slice.y = XFLOAT_DATA (it->slice.y) * img->height; if (FIXNUMP (it->slice.width)) - slice.width = XINT (it->slice.width); + slice.width = XFIXNUM (it->slice.width); else if (FLOATP (it->slice.width)) slice.width = XFLOAT_DATA (it->slice.width) * img->width; if (FIXNUMP (it->slice.height)) - slice.height = XINT (it->slice.height); + slice.height = XFIXNUM (it->slice.height); else if (FLOATP (it->slice.height)) slice.height = XFLOAT_DATA (it->slice.height) * img->height; @@ -27886,7 +27886,7 @@ calc_line_height_property (struct it *it, Lisp_Object val, struct font *font, if (FLOATP (val)) height = (int)(XFLOAT_DATA (val) * height); else if (FIXNUMP (val)) - height *= XINT (val); + height *= XFIXNUM (val); return make_fixnum (height); } @@ -28376,8 +28376,8 @@ x_produce_glyphs (struct it *it) it->descent += face->box_line_width; } if (!NILP (height) - && XINT (height) > it->ascent + it->descent) - it->ascent = XINT (height) - it->descent; + && XFIXNUM (height) > it->ascent + it->descent) + it->ascent = XFIXNUM (height) - it->descent; if (!NILP (total_height)) spacing = calc_line_height_property (it, total_height, font, @@ -28390,7 +28390,7 @@ x_produce_glyphs (struct it *it) } if (FIXNUMP (spacing)) { - extra_line_spacing = XINT (spacing); + extra_line_spacing = XFIXNUM (spacing); if (!NILP (total_height)) extra_line_spacing -= (it->phys_ascent + it->phys_descent); } @@ -29096,7 +29096,7 @@ get_specified_cursor_type (Lisp_Object arg, int *width) && EQ (XCAR (arg), Qbar) && RANGED_FIXNUMP (0, XCDR (arg), INT_MAX)) { - *width = XINT (XCDR (arg)); + *width = XFIXNUM (XCDR (arg)); return BAR_CURSOR; } @@ -29110,7 +29110,7 @@ get_specified_cursor_type (Lisp_Object arg, int *width) && EQ (XCAR (arg), Qhbar) && RANGED_FIXNUMP (0, XCDR (arg), INT_MAX)) { - *width = XINT (XCDR (arg)); + *width = XFIXNUM (XCDR (arg)); return HBAR_CURSOR; } @@ -30733,13 +30733,13 @@ on_hot_spot_p (Lisp_Object hot_spot, int x, int y) return false; if (!CONSP (XCDR (rect))) return false; - if (!(tem = XCAR (XCAR (rect)), FIXNUMP (tem) && x >= XINT (tem))) + if (!(tem = XCAR (XCAR (rect)), FIXNUMP (tem) && x >= XFIXNUM (tem))) return false; - if (!(tem = XCDR (XCAR (rect)), FIXNUMP (tem) && y >= XINT (tem))) + if (!(tem = XCDR (XCAR (rect)), FIXNUMP (tem) && y >= XFIXNUM (tem))) return false; - if (!(tem = XCAR (XCDR (rect)), FIXNUMP (tem) && x <= XINT (tem))) + if (!(tem = XCAR (XCDR (rect)), FIXNUMP (tem) && x <= XFIXNUM (tem))) return false; - if (!(tem = XCDR (XCDR (rect)), FIXNUMP (tem) && y <= XINT (tem))) + if (!(tem = XCDR (XCDR (rect)), FIXNUMP (tem) && y <= XFIXNUM (tem))) return false; return true; } @@ -30755,8 +30755,8 @@ on_hot_spot_p (Lisp_Object hot_spot, int x, int y) && (ly0 = XCDR (XCAR (circ)), FIXNUMP (ly0))) { double r = XFLOATINT (lr); - double dx = XINT (lx0) - x; - double dy = XINT (ly0) - y; + double dx = XFIXNUM (lx0) - x; + double dy = XFIXNUM (ly0) - y; return (dx * dx + dy * dy <= r * r); } } @@ -30784,14 +30784,14 @@ on_hot_spot_p (Lisp_Object hot_spot, int x, int y) if ((lx = poly[n-2], !FIXNUMP (lx)) || (ly = poly[n-1], !FIXNUMP (lx))) return false; - x0 = XINT (lx), y0 = XINT (ly); + x0 = XFIXNUM (lx), y0 = XFIXNUM (ly); for (i = 0; i < n; i += 2) { int x1 = x0, y1 = y0; if ((lx = poly[i], !FIXNUMP (lx)) || (ly = poly[i+1], !FIXNUMP (ly))) return false; - x0 = XINT (lx), y0 = XINT (ly); + x0 = XFIXNUM (lx), y0 = XFIXNUM (ly); /* Does this segment cross the X line? */ if (x0 >= x) @@ -30847,8 +30847,8 @@ Returns the alist element for the first matching AREA in MAP. */) CHECK_FIXNUM (y); return find_hot_spot (map, - clip_to_bounds (INT_MIN, XINT (x), INT_MAX), - clip_to_bounds (INT_MIN, XINT (y), INT_MAX)); + clip_to_bounds (INT_MIN, XFIXNUM (x), INT_MAX), + clip_to_bounds (INT_MIN, XFIXNUM (y), INT_MAX)); } #endif /* HAVE_WINDOW_SYSTEM */ @@ -31090,13 +31090,13 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y, if (NILP (b)) begpos = 0; else - begpos = XINT (b); + begpos = XFIXNUM (b); e = Fnext_single_property_change (pos, Qmouse_face, string, Qnil); if (NILP (e)) endpos = SCHARS (string); else - endpos = XINT (e); + endpos = XFIXNUM (e); /* Calculate the glyph position GPOS of GLYPH in the displayed string, relative to the beginning of the @@ -31573,7 +31573,7 @@ note_mouse_highlight (struct frame *f, int x, int y) if (NILP (e)) e = make_fixnum (SCHARS (object)); mouse_face_from_string_pos (w, hlinfo, object, - XINT (s), XINT (e)); + XFIXNUM (s), XFIXNUM (e)); hlinfo->mouse_face_past_end = false; hlinfo->mouse_face_window = window; hlinfo->mouse_face_face_id @@ -31658,10 +31658,10 @@ note_mouse_highlight (struct frame *f, int x, int y) mouse_face_from_buffer_pos (window, hlinfo, pos, NILP (before) ? 1 - : XFASTINT (before), + : XFIXNAT (before), NILP (after) ? BUF_Z (XBUFFER (buffer)) - : XFASTINT (after), + : XFIXNAT (after), before_string, after_string, disp_string); cursor = No_Cursor; @@ -33316,8 +33316,8 @@ start_hourglass (void) cancel_hourglass (); if (FIXNUMP (Vhourglass_delay) - && XINT (Vhourglass_delay) > 0) - delay = make_timespec (min (XINT (Vhourglass_delay), + && XFIXNUM (Vhourglass_delay) > 0) + delay = make_timespec (min (XFIXNUM (Vhourglass_delay), TYPE_MAXIMUM (time_t)), 0); else if (FLOATP (Vhourglass_delay) diff --git a/src/xfaces.c b/src/xfaces.c index f87eb66b3a..29168e2320 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -739,8 +739,8 @@ the pixmap. Bits are stored row by row, each row occupies && RANGED_FIXNUMP (1, width, INT_MAX) && RANGED_FIXNUMP (1, height, INT_MAX)) { - int bytes_per_row = (XINT (width) + CHAR_BIT - 1) / CHAR_BIT; - if (XINT (height) <= SBYTES (data) / bytes_per_row) + int bytes_per_row = (XFIXNUM (width) + CHAR_BIT - 1) / CHAR_BIT; + if (XFIXNUM (height) <= SBYTES (data) / bytes_per_row) pixmap_p = true; } } @@ -773,8 +773,8 @@ load_pixmap (struct frame *f, Lisp_Object name) int h, w; Lisp_Object bits; - w = XINT (Fcar (name)); - h = XINT (Fcar (Fcdr (name))); + w = XFIXNUM (Fcar (name)); + h = XFIXNUM (Fcar (Fcdr (name))); bits = Fcar (Fcdr (Fcdr (name))); bitmap_id = x_create_bitmap_from_data (f, SSDATA (bits), @@ -820,7 +820,7 @@ parse_rgb_list (Lisp_Object rgb_list, XColor *color) #define PARSE_RGB_LIST_FIELD(field) \ if (CONSP (rgb_list) && FIXNUMP (XCAR (rgb_list))) \ { \ - color->field = XINT (XCAR (rgb_list)); \ + color->field = XFIXNUM (XCAR (rgb_list)); \ rgb_list = XCDR (rgb_list); \ } \ else \ @@ -858,7 +858,7 @@ tty_lookup_color (struct frame *f, Lisp_Object color, XColor *tty_color, if (! FIXNUMP (XCAR (XCDR (color_desc)))) return false; - tty_color->pixel = XINT (XCAR (XCDR (color_desc))); + tty_color->pixel = XFIXNUM (XCAR (XCDR (color_desc))); rgb = XCDR (XCDR (color_desc)); if (! parse_rgb_list (rgb, tty_color)) @@ -1391,8 +1391,8 @@ compare_fonts_by_sort_order (const void *v1, const void *v2) else { if (FIXNUMP (val1)) - result = (FIXNUMP (val2) && XINT (val1) >= XINT (val2) - ? XINT (val1) > XINT (val2) + result = (FIXNUMP (val2) && XFIXNUM (val1) >= XFIXNUM (val2) + ? XFIXNUM (val1) > XFIXNUM (val2) : -1); else result = FIXNUMP (val2) ? 1 : 0; @@ -1457,7 +1457,7 @@ the face font sort order. */) font_props_for_sorting[i++] = FONT_ADSTYLE_INDEX; font_props_for_sorting[i++] = FONT_REGISTRY_INDEX; - ndrivers = XINT (Flength (list)); + ndrivers = XFIXNUM (Flength (list)); SAFE_ALLOCA_LISP (drivers, ndrivers); for (i = 0; i < ndrivers; i++, list = XCDR (list)) drivers[i] = XCAR (list); @@ -1477,7 +1477,7 @@ the face font sort order. */) ASET (v, 0, AREF (font, FONT_FAMILY_INDEX)); ASET (v, 1, FONT_WIDTH_SYMBOLIC (font)); - point = PIXEL_TO_POINT (XINT (AREF (font, FONT_SIZE_INDEX)) * 10, + point = PIXEL_TO_POINT (XFIXNUM (AREF (font, FONT_SIZE_INDEX)) * 10, FRAME_RES_Y (f)); ASET (v, 2, make_fixnum (point)); ASET (v, 3, FONT_WEIGHT_SYMBOLIC (font)); @@ -1566,7 +1566,7 @@ the WIDTH times as wide as FACE on FRAME. */) avgwidth = FRAME_FONT (f)->average_width; } if (!NILP (width)) - avgwidth *= XINT (width); + avgwidth *= XFIXNUM (width); } Lisp_Object font_spec = font_spec_from_name (pattern); @@ -1585,7 +1585,7 @@ the WIDTH times as wide as FACE on FRAME. */) font_entity = XCAR (tail); if ((NILP (AREF (font_entity, FONT_SIZE_INDEX)) - || XINT (AREF (font_entity, FONT_SIZE_INDEX)) == 0) + || XFIXNUM (AREF (font_entity, FONT_SIZE_INDEX)) == 0) && ! NILP (AREF (font_spec, FONT_SIZE_INDEX))) { /* This is a scalable font. For backward compatibility, @@ -2051,7 +2051,7 @@ merge_face_heights (Lisp_Object from, Lisp_Object to, Lisp_Object invalid) { if (FIXNUMP (to)) /* relative X absolute => absolute */ - result = make_fixnum (XFLOAT_DATA (from) * XINT (to)); + result = make_fixnum (XFLOAT_DATA (from) * XFIXNUM (to)); else if (FLOATP (to)) /* relative X relative => relative */ result = make_float (XFLOAT_DATA (from) * XFLOAT_DATA (to)); @@ -2792,7 +2792,7 @@ FRAME 0 means change the face on all frames, and change the default /* If FRAME is 0, change face on all frames, and change the default for new frames. */ - if (FIXNUMP (frame) && XINT (frame) == 0) + if (FIXNUMP (frame) && XFIXNUM (frame) == 0) { Lisp_Object tail; Finternal_set_lisp_face_attribute (face, attr, value, Qt); @@ -2862,7 +2862,7 @@ FRAME 0 means change the face on all frames, and change the default if (EQ (face, Qdefault)) { /* The default face must have an absolute size. */ - if (!FIXNUMP (value) || XINT (value) <= 0) + if (!FIXNUMP (value) || XFIXNUM (value) <= 0) signal_error ("Default face height not absolute and positive", value); } @@ -2873,7 +2873,7 @@ FRAME 0 means change the face on all frames, and change the default Lisp_Object test = merge_face_heights (value, make_fixnum (10), Qnil); - if (!FIXNUMP (test) || XINT (test) <= 0) + if (!FIXNUMP (test) || XFIXNUM (test) <= 0) signal_error ("Face height does not produce a positive integer", value); } @@ -3008,7 +3008,7 @@ FRAME 0 means change the face on all frames, and change the default else if (NILP (value)) valid_p = true; else if (FIXNUMP (value)) - valid_p = XINT (value) != 0; + valid_p = XFIXNUM (value) != 0; else if (STRINGP (value)) valid_p = SCHARS (value) > 0; else if (CONSP (value)) @@ -3029,7 +3029,7 @@ FRAME 0 means change the face on all frames, and change the default if (EQ (k, QCline_width)) { - if (!FIXNUMP (v) || XINT (v) == 0) + if (!FIXNUMP (v) || XFIXNUM (v) == 0) break; } else if (EQ (k, QCcolor)) @@ -3538,7 +3538,7 @@ DEFUN ("internal-set-lisp-face-attribute-from-resource", else if (EQ (attr, QCheight)) { value = Fstring_to_number (value, Qnil); - if (!FIXNUMP (value) || XINT (value) <= 0) + if (!FIXNUMP (value) || XFIXNUM (value) <= 0) signal_error ("Invalid face height from X resource", value); } else if (EQ (attr, QCbold) || EQ (attr, QCitalic)) @@ -3928,7 +3928,7 @@ return the font name used for CHARACTER. */) if (FRAME_WINDOW_P (f) && !NILP (character)) { CHECK_CHARACTER (character); - face_id = FACE_FOR_CHAR (f, fface, XINT (character), -1, Qnil); + face_id = FACE_FOR_CHAR (f, fface, XFIXNUM (character), -1, Qnil); fface = FACE_FROM_ID_OR_NULL (f, face_id); } return ((fface && fface->font) @@ -4685,7 +4685,7 @@ smaller_face (struct frame *f, int face_id, int steps) face = FACE_FROM_ID (f, face_id); memcpy (attrs, face->lface, sizeof attrs); - pt = last_pt = XFASTINT (attrs[LFACE_HEIGHT_INDEX]); + pt = last_pt = XFIXNAT (attrs[LFACE_HEIGHT_INDEX]); new_face_id = face_id; last_height = FONT_HEIGHT (face->font); @@ -5679,9 +5679,9 @@ realize_x_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE]) { /* Simple box of specified line width in foreground color of the face. */ - eassert (XINT (box) != 0); + eassert (XFIXNUM (box) != 0); face->box = FACE_SIMPLE_BOX; - face->box_line_width = XINT (box); + face->box_line_width = XFIXNUM (box); face->box_color = face->foreground; face->box_color_defaulted_p = true; } @@ -5708,8 +5708,8 @@ realize_x_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE]) if (EQ (keyword, QCline_width)) { - if (FIXNUMP (value) && XINT (value) != 0) - face->box_line_width = XINT (value); + if (FIXNUMP (value) && XFIXNUM (value) != 0) + face->box_line_width = XFIXNUM (value); } else if (EQ (keyword, QCcolor)) { @@ -5875,7 +5875,7 @@ map_tty_color (struct frame *f, struct face *face, { /* Associations in tty-defined-color-alist are of the form (NAME INDEX R G B). We need the INDEX part. */ - pixel = XINT (XCAR (XCDR (def))); + pixel = XFIXNUM (XCAR (XCDR (def))); } if (pixel == default_pixel && STRINGP (color)) @@ -6075,7 +6075,7 @@ face_at_buffer_position (struct window *w, ptrdiff_t pos, XSETFASTINT (limit1, (limit < endpos ? limit : endpos)); end = Fnext_single_property_change (position, propname, w->contents, limit1); if (FIXNUMP (end)) - endpos = XINT (end); + endpos = XFIXNUM (end); /* Look at properties from overlays. */ USE_SAFE_ALLOCA; @@ -6204,7 +6204,7 @@ face_for_overlay_string (struct window *w, ptrdiff_t pos, XSETFASTINT (limit1, (limit < endpos ? limit : endpos)); end = Fnext_single_property_change (position, propname, w->contents, limit1); if (FIXNUMP (end)) - endpos = XINT (end); + endpos = XFIXNUM (end); *endptr = endpos; @@ -6277,7 +6277,7 @@ face_at_string_position (struct window *w, Lisp_Object string, XSETFASTINT (limit, SCHARS (string)); end = Fnext_single_property_change (position, prop_name, string, limit); if (FIXNUMP (end)) - *endptr = XFASTINT (end); + *endptr = XFIXNAT (end); else *endptr = -1; @@ -6477,7 +6477,7 @@ DEFUN ("dump-face", Fdump_face, Sdump_face, 0, 1, 0, doc: /* */) { struct face *face; CHECK_FIXNUM (n); - face = FACE_FROM_ID_OR_NULL (SELECTED_FRAME (), XINT (n)); + face = FACE_FROM_ID_OR_NULL (SELECTED_FRAME (), XFIXNUM (n)); if (face == NULL) error ("Not a valid face"); dump_realized_face (face); diff --git a/src/xfns.c b/src/xfns.c index 224e090ebc..d9df03e7ef 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -1233,7 +1233,7 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) if (!NILP (shape_var)) { CHECK_TYPE_RANGED_INTEGER (unsigned, shape_var); - cursor_data.cursor_num[i] = XINT (shape_var); + cursor_data.cursor_num[i] = XFIXNUM (shape_var); } else cursor_data.cursor_num[i] = mouse_cursor_types[i].default_shape; @@ -1532,7 +1532,7 @@ x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) return; if (TYPE_RANGED_FIXNUMP (int, value)) - nlines = XINT (value); + nlines = XFIXNUM (value); else nlines = 0; @@ -1619,7 +1619,7 @@ x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) /* Use VALUE only if an int >= 0. */ if (RANGED_FIXNUMP (0, value, INT_MAX)) - nlines = XFASTINT (value); + nlines = XFIXNAT (value); else nlines = 0; @@ -1716,7 +1716,7 @@ x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldva int border; CHECK_TYPE_RANGED_INTEGER (int, arg); - border = max (XINT (arg), 0); + border = max (XFIXNUM (arg), 0); if (border != FRAME_INTERNAL_BORDER_WIDTH (f)) { @@ -3292,7 +3292,7 @@ x_icon (struct frame *f, Lisp_Object parms) block_input (); if (! EQ (icon_x, Qunbound)) - x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y)); + x_wm_set_icon_position (f, XFIXNUM (icon_x), XFIXNUM (icon_y)); #if false /* x_get_arg removes the visibility parameter as a side effect, but x_create_frame still needs it. */ @@ -3725,7 +3725,7 @@ This function is an internal primitive--use `make-frame' instead. */) /* Specify the parent under which to make this X window. */ if (!NILP (parent)) { - f->output_data.x->parent_desc = (Window) XFASTINT (parent); + f->output_data.x->parent_desc = (Window) XFIXNAT (parent); f->output_data.x->explicit_parent = true; } else @@ -5099,8 +5099,8 @@ frame_geometry (Lisp_Object frame, Lisp_Object attribute) edges = Fx_frame_edges (parent, Qnative_edges); if (!NILP (edges)) { - x_native += XINT (Fnth (make_fixnum (0), edges)); - y_native += XINT (Fnth (make_fixnum (1), edges)); + x_native += XFIXNUM (Fnth (make_fixnum (0), edges)); + y_native += XFIXNUM (Fnth (make_fixnum (1), edges)); } outer_left = x_native; @@ -5476,7 +5476,7 @@ The coordinates X and Y are interpreted in pixels relative to a position block_input (); XWarpPointer (FRAME_X_DISPLAY (f), None, DefaultRootWindow (FRAME_X_DISPLAY (f)), - 0, 0, 0, 0, XINT (x), XINT (y)); + 0, 0, 0, 0, XFIXNUM (x), XFIXNUM (y)); unblock_input (); return Qnil; @@ -5776,10 +5776,10 @@ FRAME. Default is to change on the edit X window. */) { CHECK_FIXNUM (format); - if (XINT (format) != 8 && XINT (format) != 16 - && XINT (format) != 32) + if (XFIXNUM (format) != 8 && XFIXNUM (format) != 16 + && XFIXNUM (format) != 32) error ("FORMAT must be one of 8, 16 or 32"); - element_format = XINT (format); + element_format = XFIXNUM (format); } if (CONSP (value)) @@ -6484,10 +6484,10 @@ compute_tip_xy (struct frame *f, geometry = Fassq (Qgeometry, monitor); if (CONSP (geometry)) { - min_x = XINT (Fnth (make_fixnum (1), geometry)); - min_y = XINT (Fnth (make_fixnum (2), geometry)); - max_x = min_x + XINT (Fnth (make_fixnum (3), geometry)); - max_y = min_y + XINT (Fnth (make_fixnum (4), geometry)); + min_x = XFIXNUM (Fnth (make_fixnum (1), geometry)); + min_y = XFIXNUM (Fnth (make_fixnum (2), geometry)); + max_x = min_x + XFIXNUM (Fnth (make_fixnum (3), geometry)); + max_y = min_y + XFIXNUM (Fnth (make_fixnum (4), geometry)); if (min_x <= *root_x && *root_x < max_x && min_y <= *root_y && *root_y < max_y) { @@ -6511,33 +6511,33 @@ compute_tip_xy (struct frame *f, } if (FIXNUMP (top)) - *root_y = XINT (top); + *root_y = XFIXNUM (top); else if (FIXNUMP (bottom)) - *root_y = XINT (bottom) - height; - else if (*root_y + XINT (dy) <= min_y) + *root_y = XFIXNUM (bottom) - height; + else if (*root_y + XFIXNUM (dy) <= min_y) *root_y = min_y; /* Can happen for negative dy */ - else if (*root_y + XINT (dy) + height <= max_y) + else if (*root_y + XFIXNUM (dy) + height <= max_y) /* It fits below the pointer */ - *root_y += XINT (dy); - else if (height + XINT (dy) + min_y <= *root_y) + *root_y += XFIXNUM (dy); + else if (height + XFIXNUM (dy) + min_y <= *root_y) /* It fits above the pointer. */ - *root_y -= height + XINT (dy); + *root_y -= height + XFIXNUM (dy); else /* Put it on the top. */ *root_y = min_y; if (FIXNUMP (left)) - *root_x = XINT (left); + *root_x = XFIXNUM (left); else if (FIXNUMP (right)) - *root_x = XINT (right) - width; - else if (*root_x + XINT (dx) <= min_x) + *root_x = XFIXNUM (right) - width; + else if (*root_x + XFIXNUM (dx) <= min_x) *root_x = 0; /* Can happen for negative dx */ - else if (*root_x + XINT (dx) + width <= max_x) + else if (*root_x + XFIXNUM (dx) + width <= max_x) /* It fits to the right of the pointer. */ - *root_x += XINT (dx); - else if (width + XINT (dx) + min_x <= *root_x) + *root_x += XFIXNUM (dx); + else if (width + XFIXNUM (dx) + min_x <= *root_x) /* It fits to the left of the pointer. */ - *root_x -= width + XINT (dx); + *root_x -= width + XFIXNUM (dx); else /* Put it left justified on the screen -- it ought to fit that way. */ *root_x = min_x; @@ -6925,8 +6925,8 @@ Text larger than the specified size is clipped. */) && RANGED_FIXNUMP (1, XCAR (Vx_max_tooltip_size), INT_MAX) && RANGED_FIXNUMP (1, XCDR (Vx_max_tooltip_size), INT_MAX)) { - w->total_cols = XFASTINT (XCAR (Vx_max_tooltip_size)); - w->total_lines = XFASTINT (XCDR (Vx_max_tooltip_size)); + w->total_cols = XFIXNAT (XCAR (Vx_max_tooltip_size)); + w->total_lines = XFIXNAT (XCDR (Vx_max_tooltip_size)); } else { @@ -6958,8 +6958,8 @@ Text larger than the specified size is clipped. */) size = Fwindow_text_pixel_size (window, Qnil, Qnil, Qnil, make_fixnum (w->pixel_height), Qnil); /* Add the frame's internal border to calculated size. */ - width = XINT (Fcar (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); - height = XINT (Fcdr (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); + width = XFIXNUM (Fcar (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); + height = XFIXNUM (Fcdr (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); /* Calculate position of tooltip frame. */ compute_tip_xy (tip_f, parms, dx, dy, width, height, &root_x, &root_y); diff --git a/src/xfont.c b/src/xfont.c index 53f7070a64..73caa70589 100644 --- a/src/xfont.c +++ b/src/xfont.c @@ -190,7 +190,7 @@ xfont_chars_supported (Lisp_Object chars, XFontStruct *xfont, { for (; CONSP (chars); chars = XCDR (chars)) { - int c = XINT (XCAR (chars)); + int c = XFIXNUM (XCAR (chars)); unsigned code = ENCODE_CHAR (charset, c); XChar2b char2b; @@ -213,7 +213,7 @@ xfont_chars_supported (Lisp_Object chars, XFontStruct *xfont, for (i = ASIZE (chars) - 1; i >= 0; i--) { - int c = XINT (AREF (chars, i)); + int c = XFIXNUM (AREF (chars, i)); unsigned code = ENCODE_CHAR (charset, c); XChar2b char2b; @@ -378,8 +378,8 @@ xfont_list_pattern (Display *display, const char *pattern, /* Avoid auto-scaled fonts. */ if (FIXNUMP (AREF (entity, FONT_DPI_INDEX)) && FIXNUMP (AREF (entity, FONT_AVGWIDTH_INDEX)) - && XINT (AREF (entity, FONT_DPI_INDEX)) != 0 - && XINT (AREF (entity, FONT_AVGWIDTH_INDEX)) == 0) + && XFIXNUM (AREF (entity, FONT_DPI_INDEX)) != 0 + && XFIXNUM (AREF (entity, FONT_AVGWIDTH_INDEX)) == 0) continue; /* Avoid not-allowed scalable fonts. */ if (NILP (Vscalable_fonts_allowed)) @@ -387,7 +387,7 @@ xfont_list_pattern (Display *display, const char *pattern, int size = 0; if (FIXNUMP (AREF (entity, FONT_SIZE_INDEX))) - size = XINT (AREF (entity, FONT_SIZE_INDEX)); + size = XFIXNUM (AREF (entity, FONT_SIZE_INDEX)); else if (FLOATP (AREF (entity, FONT_SIZE_INDEX))) size = XFLOAT_DATA (AREF (entity, FONT_SIZE_INDEX)); if (size == 0 && i_pass == 0) @@ -672,8 +672,8 @@ xfont_open (struct frame *f, Lisp_Object entity, int pixel_size) return Qnil; } - if (XINT (AREF (entity, FONT_SIZE_INDEX)) != 0) - pixel_size = XINT (AREF (entity, FONT_SIZE_INDEX)); + if (XFIXNUM (AREF (entity, FONT_SIZE_INDEX)) != 0) + pixel_size = XFIXNUM (AREF (entity, FONT_SIZE_INDEX)); else if (pixel_size == 0) { if (FRAME_FONT (f)) @@ -812,7 +812,7 @@ xfont_open (struct frame *f, Lisp_Object entity, int pixel_size) val = Ffont_get (font_object, QCavgwidth); if (FIXNUMP (val)) - font->average_width = XINT (val) / 10; + font->average_width = XFIXNUM (val) / 10; if (font->average_width < 0) font->average_width = - font->average_width; else diff --git a/src/xftfont.c b/src/xftfont.c index b5749add66..85df0d857a 100644 --- a/src/xftfont.c +++ b/src/xftfont.c @@ -220,7 +220,7 @@ xftfont_add_rendering_parameters (FcPattern *pat, Lisp_Object entity) else if (EQ (key, QChintstyle)) { if (FIXNUMP (val)) - FcPatternAddInteger (pat, FC_HINT_STYLE, XINT (val)); + FcPatternAddInteger (pat, FC_HINT_STYLE, XFIXNUM (val)); else if (SYMBOLP (val) && FcNameConstant (SDATA (SYMBOL_NAME (val)), &ival)) FcPatternAddInteger (pat, FC_HINT_STYLE, ival); @@ -228,7 +228,7 @@ xftfont_add_rendering_parameters (FcPattern *pat, Lisp_Object entity) else if (EQ (key, QCrgba)) { if (FIXNUMP (val)) - FcPatternAddInteger (pat, FC_RGBA, XINT (val)); + FcPatternAddInteger (pat, FC_RGBA, XFIXNUM (val)); else if (SYMBOLP (val) && FcNameConstant (SDATA (SYMBOL_NAME (val)), &ival)) FcPatternAddInteger (pat, FC_RGBA, ival); @@ -236,7 +236,7 @@ xftfont_add_rendering_parameters (FcPattern *pat, Lisp_Object entity) else if (EQ (key, QClcdfilter)) { if (FIXNUMP (val)) - FcPatternAddInteger (pat, FC_LCD_FILTER, ival = XINT (val)); + FcPatternAddInteger (pat, FC_LCD_FILTER, ival = XFIXNUM (val)); else if (SYMBOLP (val) && FcNameConstant (SDATA (SYMBOL_NAME (val)), &ival)) FcPatternAddInteger (pat, FC_LCD_FILTER, ival); @@ -271,7 +271,7 @@ xftfont_open (struct frame *f, Lisp_Object entity, int pixel_size) val = XCDR (val); filename = XCAR (val); idx = XCDR (val); - size = XINT (AREF (entity, FONT_SIZE_INDEX)); + size = XFIXNUM (AREF (entity, FONT_SIZE_INDEX)); if (size == 0) size = pixel_size; pat = FcPatternCreate (); @@ -289,16 +289,16 @@ xftfont_open (struct frame *f, Lisp_Object entity, int pixel_size) FcPatternAddString (pat, FC_FOUNDRY, (FcChar8 *) SDATA (SYMBOL_NAME (val))); val = AREF (entity, FONT_SPACING_INDEX); if (! NILP (val)) - FcPatternAddInteger (pat, FC_SPACING, XINT (val)); + FcPatternAddInteger (pat, FC_SPACING, XFIXNUM (val)); val = AREF (entity, FONT_DPI_INDEX); if (! NILP (val)) { - double dbl = XINT (val); + double dbl = XFIXNUM (val); FcPatternAddDouble (pat, FC_DPI, dbl); } val = AREF (entity, FONT_AVGWIDTH_INDEX); - if (FIXNUMP (val) && XINT (val) == 0) + if (FIXNUMP (val) && XFIXNUM (val) == 0) FcPatternAddBool (pat, FC_SCALABLE, FcTrue); /* This is necessary to identify the exact font (e.g. 10x20.pcf.gz over 10x20-ISO8859-1.pcf.gz). */ @@ -307,7 +307,7 @@ xftfont_open (struct frame *f, Lisp_Object entity, int pixel_size) xftfont_add_rendering_parameters (pat, entity); FcPatternAddString (pat, FC_FILE, (FcChar8 *) SDATA (filename)); - FcPatternAddInteger (pat, FC_INDEX, XINT (idx)); + FcPatternAddInteger (pat, FC_INDEX, XFIXNUM (idx)); block_input (); @@ -353,7 +353,7 @@ xftfont_open (struct frame *f, Lisp_Object entity, int pixel_size) xftfont_info->matrix.yx = 0x10000L * matrix->yx; } if (FIXNUMP (AREF (entity, FONT_SPACING_INDEX))) - spacing = XINT (AREF (entity, FONT_SPACING_INDEX)); + spacing = XFIXNUM (AREF (entity, FONT_SPACING_INDEX)); else spacing = FC_PROPORTIONAL; if (! ascii_printable[0]) @@ -412,7 +412,7 @@ xftfont_open (struct frame *f, Lisp_Object entity, int pixel_size) } font->height = font->ascent + font->descent; - if (XINT (AREF (entity, FONT_SIZE_INDEX)) == 0) + if (XFIXNUM (AREF (entity, FONT_SIZE_INDEX)) == 0) { int upEM = ft_face->units_per_EM; diff --git a/src/xmenu.c b/src/xmenu.c index f51e46fb27..e6740af7ca 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -1180,10 +1180,10 @@ menu_position_func (GtkMenu *menu, gint *x, gint *y, gboolean *push_in, gpointer { int min_x, min_y; - min_x = XINT (XCAR (workarea)); - min_y = XINT (Fnth (make_fixnum (1), workarea)); - max_x = min_x + XINT (Fnth (make_fixnum (2), workarea)); - max_y = min_y + XINT (Fnth (make_fixnum (3), workarea)); + min_x = XFIXNUM (XCAR (workarea)); + min_y = XFIXNUM (Fnth (make_fixnum (1), workarea)); + max_x = min_x + XFIXNUM (Fnth (make_fixnum (2), workarea)); + max_y = min_y + XFIXNUM (Fnth (make_fixnum (3), workarea)); } if (max_x < 0 || max_y < 0) diff --git a/src/xml.c b/src/xml.c index 3674e320ef..5f3ccc85c8 100644 --- a/src/xml.c +++ b/src/xml.c @@ -187,8 +187,8 @@ parse_region (Lisp_Object start, Lisp_Object end, Lisp_Object base_url, validate_region (&start, &end); - istart = XINT (start); - iend = XINT (end); + istart = XFIXNUM (start); + iend = XFIXNUM (end); istart_byte = CHAR_TO_BYTE (istart); iend_byte = CHAR_TO_BYTE (iend); diff --git a/src/xrdb.c b/src/xrdb.c index ce0e1cce07..4abf1ad84e 100644 --- a/src/xrdb.c +++ b/src/xrdb.c @@ -474,13 +474,13 @@ x_load_resources (Display *display, const char *xrm_string, /* Set double click time of list boxes in the file selection dialog from `double-click-time'. */ - if (FIXNUMP (Vdouble_click_time) && XINT (Vdouble_click_time) > 0) + if (FIXNUMP (Vdouble_click_time) && XFIXNUM (Vdouble_click_time) > 0) { sprintf (line, "%s*fsb*DirList.doubleClickInterval: %"pI"d", - myclass, XFASTINT (Vdouble_click_time)); + myclass, XFIXNAT (Vdouble_click_time)); XrmPutLineResource (&rdb, line); sprintf (line, "%s*fsb*ItemsList.doubleClickInterval: %"pI"d", - myclass, XFASTINT (Vdouble_click_time)); + myclass, XFIXNAT (Vdouble_click_time)); XrmPutLineResource (&rdb, line); } diff --git a/src/xselect.c b/src/xselect.c index d24a493294..984d95d748 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -1693,7 +1693,7 @@ static unsigned long cons_to_x_long (Lisp_Object obj) { if (X_ULONG_MAX <= INTMAX_MAX - || XINT (FIXNUMP (obj) ? obj : XCAR (obj)) < 0) + || XFIXNUM (FIXNUMP (obj) ? obj : XCAR (obj)) < 0) return cons_to_signed (obj, X_LONG_MIN, min (X_ULONG_MAX, INTMAX_MAX)); else return cons_to_unsigned (obj, X_ULONG_MAX); @@ -1756,7 +1756,7 @@ lisp_data_to_selection_data (struct x_display_info *dpyinfo, cs->format = 16; cs->size = 1; cs->data[sizeof (short)] = 0; - *short_ptr = XINT (obj); + *short_ptr = XFIXNUM (obj); if (NILP (type)) type = QINTEGER; } else if (FIXNUMP (obj) @@ -1832,7 +1832,7 @@ lisp_data_to_selection_data (struct x_display_info *dpyinfo, if (format == 32) x_atoms[i] = cons_to_x_long (AREF (obj, i)); else - shorts[i] = XINT (AREF (obj, i)); + shorts[i] = XFIXNUM (AREF (obj, i)); } } } @@ -1856,10 +1856,10 @@ clean_local_selection_data (Lisp_Object obj) && FIXNUMP (XCAR (obj)) && FIXNUMP (XCDR (obj))) { - if (XINT (XCAR (obj)) == 0) + if (XFIXNUM (XCAR (obj)) == 0) return XCDR (obj); - if (XINT (XCAR (obj)) == -1) - return make_fixnum (- XINT (XCDR (obj))); + if (XFIXNUM (XCAR (obj)) == -1) + return make_fixnum (- XFIXNUM (XCDR (obj))); } if (VECTORP (obj)) { @@ -2313,8 +2313,8 @@ x_fill_property_data (Display *dpy, Lisp_Object data, void *ret, int format) For XDnd, v2 might be y of a window, and can be negative. The XDnd spec. is not explicit about negative values, but let's assume negative v2 is sent modulo 2**16. */ - unsigned long v1 = XINT (XCAR (o)) & 0xffff; - unsigned long v2 = XINT (XCDR (o)) & 0xffff; + unsigned long v1 = XFIXNUM (XCAR (o)) & 0xffff; + unsigned long v2 = XFIXNUM (XCDR (o)) & 0xffff; val = (v1 << 16) | v2; } else @@ -2560,11 +2560,11 @@ x_send_client_event (Lisp_Object display, Lisp_Object dest, Lisp_Object from, if (x_check_property_data (values) == -1) error ("Bad data in VALUES, must be number, cons or string"); - if (XINT (format) != 8 && XINT (format) != 16 && XINT (format) != 32) + if (XFIXNUM (format) != 8 && XFIXNUM (format) != 16 && XFIXNUM (format) != 32) error ("FORMAT must be one of 8, 16 or 32"); event.xclient.type = ClientMessage; - event.xclient.format = XINT (format); + event.xclient.format = XFIXNUM (format); if (FRAMEP (dest) || NILP (dest)) { diff --git a/src/xsettings.c b/src/xsettings.c index 81c8f9b291..0b67db3074 100644 --- a/src/xsettings.c +++ b/src/xsettings.c @@ -393,7 +393,7 @@ parse_settings (unsigned char *prop, struct xsettings *settings) { Lisp_Object byteorder = Fbyteorder (); - int my_bo = XFASTINT (byteorder) == 'B' ? MSBFirst : LSBFirst; + int my_bo = XFIXNAT (byteorder) == 'B' ? MSBFirst : LSBFirst; int that_bo = prop[0]; CARD32 n_settings; int bytes_parsed = 0; diff --git a/src/xterm.c b/src/xterm.c index f83f054802..be8e3da372 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -918,7 +918,7 @@ x_set_frame_alpha (struct frame *f) if (FLOATP (Vframe_alpha_lower_limit)) alpha_min = XFLOAT_DATA (Vframe_alpha_lower_limit); else if (FIXNUMP (Vframe_alpha_lower_limit)) - alpha_min = (XINT (Vframe_alpha_lower_limit)) / 100.0; + alpha_min = (XFIXNUM (Vframe_alpha_lower_limit)) / 100.0; if (alpha < 0.0) return; @@ -3109,11 +3109,11 @@ x_draw_image_relief (struct glyph_string *s) && FIXNUMP (XCAR (Vtool_bar_button_margin)) && FIXNUMP (XCDR (Vtool_bar_button_margin))) { - extra_x = XINT (XCAR (Vtool_bar_button_margin)); - extra_y = XINT (XCDR (Vtool_bar_button_margin)); + extra_x = XFIXNUM (XCAR (Vtool_bar_button_margin)); + extra_y = XFIXNUM (XCDR (Vtool_bar_button_margin)); } else if (FIXNUMP (Vtool_bar_button_margin)) - extra_x = extra_y = XINT (Vtool_bar_button_margin); + extra_x = extra_y = XFIXNUM (Vtool_bar_button_margin); } top_p = bot_p = left_p = right_p = false; @@ -3705,7 +3705,7 @@ x_draw_glyph_string (struct glyph_string *s) = buffer_local_value (Qunderline_minimum_offset, s->w->contents); if (FIXNUMP (val)) - minimum_offset = XFASTINT (val); + minimum_offset = XFIXNAT (val); else minimum_offset = 1; val = buffer_local_value (Qx_underline_at_descent_line, @@ -4824,15 +4824,15 @@ x_x_to_emacs_modifiers (struct x_display_info *dpyinfo, int state) Lisp_Object tem; tem = Fget (Vx_ctrl_keysym, Qmodifier_value); - if (FIXNUMP (tem)) mod_ctrl = XINT (tem) & INT_MAX; + if (FIXNUMP (tem)) mod_ctrl = XFIXNUM (tem) & INT_MAX; tem = Fget (Vx_alt_keysym, Qmodifier_value); - if (FIXNUMP (tem)) mod_alt = XINT (tem) & INT_MAX; + if (FIXNUMP (tem)) mod_alt = XFIXNUM (tem) & INT_MAX; tem = Fget (Vx_meta_keysym, Qmodifier_value); - if (FIXNUMP (tem)) mod_meta = XINT (tem) & INT_MAX; + if (FIXNUMP (tem)) mod_meta = XFIXNUM (tem) & INT_MAX; tem = Fget (Vx_hyper_keysym, Qmodifier_value); - if (FIXNUMP (tem)) mod_hyper = XINT (tem) & INT_MAX; + if (FIXNUMP (tem)) mod_hyper = XFIXNUM (tem) & INT_MAX; tem = Fget (Vx_super_keysym, Qmodifier_value); - if (FIXNUMP (tem)) mod_super = XINT (tem) & INT_MAX; + if (FIXNUMP (tem)) mod_super = XFIXNUM (tem) & INT_MAX; return ( ((state & (ShiftMask | dpyinfo->shift_lock_mask)) ? shift_modifier : 0) | ((state & ControlMask) ? mod_ctrl : 0) @@ -4854,15 +4854,15 @@ x_emacs_to_x_modifiers (struct x_display_info *dpyinfo, EMACS_INT state) Lisp_Object tem; tem = Fget (Vx_ctrl_keysym, Qmodifier_value); - if (FIXNUMP (tem)) mod_ctrl = XINT (tem); + if (FIXNUMP (tem)) mod_ctrl = XFIXNUM (tem); tem = Fget (Vx_alt_keysym, Qmodifier_value); - if (FIXNUMP (tem)) mod_alt = XINT (tem); + if (FIXNUMP (tem)) mod_alt = XFIXNUM (tem); tem = Fget (Vx_meta_keysym, Qmodifier_value); - if (FIXNUMP (tem)) mod_meta = XINT (tem); + if (FIXNUMP (tem)) mod_meta = XFIXNUM (tem); tem = Fget (Vx_hyper_keysym, Qmodifier_value); - if (FIXNUMP (tem)) mod_hyper = XINT (tem); + if (FIXNUMP (tem)) mod_hyper = XFIXNUM (tem); tem = Fget (Vx_super_keysym, Qmodifier_value); - if (FIXNUMP (tem)) mod_super = XINT (tem); + if (FIXNUMP (tem)) mod_super = XFIXNUM (tem); return ( ((state & mod_alt) ? dpyinfo->alt_mod_mask : 0) @@ -8363,10 +8363,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, Qnil), FIXNATP (c))) { - inev.ie.kind = (SINGLE_BYTE_CHAR_P (XFASTINT (c)) + inev.ie.kind = (SINGLE_BYTE_CHAR_P (XFIXNAT (c)) ? ASCII_KEYSTROKE_EVENT : MULTIBYTE_CHAR_KEYSTROKE_EVENT); - inev.ie.code = XFASTINT (c); + inev.ie.code = XFIXNAT (c); goto done_keysym; } @@ -10254,8 +10254,8 @@ x_calc_absolute_position (struct frame *f) XSETFRAME (frame, f); edges = Fx_frame_edges (frame, Qouter_edges); if (!NILP (edges)) - width = (XINT (Fnth (make_fixnum (2), edges)) - - XINT (Fnth (make_fixnum (0), edges))); + width = (XFIXNUM (Fnth (make_fixnum (2), edges)) + - XFIXNUM (Fnth (make_fixnum (0), edges))); } if (p) @@ -10296,8 +10296,8 @@ x_calc_absolute_position (struct frame *f) if (NILP (edges)) edges = Fx_frame_edges (frame, Qouter_edges); if (!NILP (edges)) - height = (XINT (Fnth (make_fixnum (3), edges)) - - XINT (Fnth (make_fixnum (1), edges))); + height = (XFIXNUM (Fnth (make_fixnum (3), edges)) + - XFIXNUM (Fnth (make_fixnum (1), edges))); } if (p) diff --git a/src/xwidget.c b/src/xwidget.c index dc1b888280..d6b39fe410 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -87,8 +87,8 @@ Returns the newly constructed xwidget, or nil if construction fails. */) xw->type = type; xw->title = title; xw->buffer = NILP (buffer) ? Fcurrent_buffer () : Fget_buffer_create (buffer); - xw->height = XFASTINT (height); - xw->width = XFASTINT (width); + xw->height = XFIXNAT (height); + xw->width = XFIXNAT (width); xw->kill_without_query = false; XSETXWIDGET (val, xw); Vxwidget_list = Fcons (val, Vxwidget_list); @@ -767,8 +767,8 @@ DEFUN ("xwidget-resize", Fxwidget_resize, Sxwidget_resize, 3, 3, 0, CHECK_RANGED_INTEGER (new_width, 0, INT_MAX); CHECK_RANGED_INTEGER (new_height, 0, INT_MAX); struct xwidget *xw = XXWIDGET (xwidget); - int w = XFASTINT (new_width); - int h = XFASTINT (new_height); + int w = XFIXNAT (new_width); + int h = XFIXNAT (new_height); xw->width = w; xw->height = h; commit cd9032532d119b35685dc078b8156023122f6dcd Author: Eli Zaretskii Date: Tue Aug 7 19:15:41 2018 +0300 Improve documentation of M-? * doc/emacs/maintaining.texi (Identifier Search): * lisp/progmodes/xref.el (xref-find-references): Improve documentation of xref-find-references and xref-prompt-for-identifier. (Bug#32389) diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 9421691ba7..d7d7eddf62 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -1966,9 +1966,14 @@ Restart one of the last 2 commands above, from the current location of point. @kindex M-? @findex xref-find-references - @kbd{M-?} finds all the references for the identifier at point. If -there's no identifier at point, or when invoked with a prefix -argument, the command prompts for the identifier, with completion. It + @kbd{M-?} finds all the references for the identifier at point, +prompting for the identifier as needed, with completion. Depending on +the current backend (@pxref{Xref}), the command may prompt even if it +finds a valid identifier at point. When invoked with a prefix +argument, it always prompts for the identifier. (If you want it to +prompt always, customize the value of the variable +@code{xref-prompt-for-identifier} to @code{t}; or set it to @code{nil} +to prompt only if there's no usable identifier at point.) The command then presents the @file{*xref*} buffer with all the references to the identifier, showing the file name and the line where the identifier is referenced. The XREF mode commands are available in this buffer, see diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index b0bdd62ae9..e563951793 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -866,7 +866,11 @@ buffer where the user can select from the list." ;;;###autoload (defun xref-find-references (identifier) "Find references to the identifier at point. -With prefix argument, prompt for the identifier." +This command might prompt for the identifier as needed, perhaps +offering the symbol at point as the default. +With prefix argument, or if `xref-prompt-for-identifier' is t, +always prompt for the identifier. If `xref-prompt-for-identifier' +is nil, prompt only if there's no usable symbol at point." (interactive (list (xref--read-identifier "Find references of: "))) (xref--find-xrefs identifier 'references identifier nil)) commit 155a885158c3ea7c2802d2a6c679cdee766a3b28 Author: Ivan Shmakov Date: Sun Aug 5 21:45:46 2018 +0000 Reinterpret Esperanto characters in iso-transl as iso-8859-3. * lisp/international/iso-transl.el (iso-transl-language-alist): Reinterpret Esperanto characters as iso-8859-3 (were: iso-8859-1). (Bug#32371) diff --git a/lisp/international/iso-transl.el b/lisp/international/iso-transl.el index 1af5c64a48..0856b4f6fb 100644 --- a/lisp/international/iso-transl.el +++ b/lisp/international/iso-transl.el @@ -234,18 +234,18 @@ sequence VECTOR. (VECTOR is normally one character long.)") ;; Language-specific translation lists. (defvar iso-transl-language-alist '(("Esperanto" - ("C" . [?Æ]) - ("G" . [?Ă]) - ("H" . [?¦]) - ("J" . [?¬]) - ("S" . [?Ăž]) - ("U" . [?Ăť]) - ("c" . [?æ]) - ("g" . [?ø]) - ("h" . [?¶]) - ("j" . [?ÂĽ]) - ("s" . [?Ăľ]) - ("u" . [?Ă˝])) + ("C" . [?Ä]) + ("G" . [?Äś]) + ("H" . [?Ĥ]) + ("J" . [?Ä´]) + ("S" . [?Ĺś]) + ("U" . [?Ŭ]) + ("c" . [?ĉ]) + ("g" . [?Äť]) + ("h" . [?ÄĄ]) + ("j" . [?ĵ]) + ("s" . [?Ĺť]) + ("u" . [?Ĺ­])) ("French" ("C" . [?Ç]) ("c" . [?ç])) commit a0ef73388615e13467e1bd112a94b73ab85ead62 Author: Eli Zaretskii Date: Tue Aug 7 18:35:12 2018 +0300 Fix Flyspell mode when several languages are mixed in a buffer * lisp/textmodes/flyspell.el (flyspell-external-point-words): Handle "misspelled" words that actually belong to a language unsupported by the current dictionary. (Bug#32280) Fix the test for Ispell the program. diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index 5726bd82cb..4d7a18969e 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -1420,10 +1420,20 @@ determined by `flyspell-large-region'." The list of incorrect words should be in `flyspell-external-ispell-buffer'. \(We finish by killing that buffer and setting the variable to nil.) The buffer to mark them in is `flyspell-large-region-buffer'." - (let (words-not-found - (ispell-otherchars (ispell-get-otherchars)) - (buffer-scan-pos flyspell-large-region-beg) - case-fold-search) + (let* (words-not-found + (flyspell-casechars (flyspell-get-casechars)) + (ispell-otherchars (ispell-get-otherchars)) + (ispell-many-otherchars-p (ispell-get-many-otherchars-p)) + (word-chars (concat flyspell-casechars + "+\\(" + (if (not (string= "" ispell-otherchars)) + (concat ispell-otherchars "?")) + flyspell-casechars + "+\\)" + (if ispell-many-otherchars-p + "*" "?"))) + (buffer-scan-pos flyspell-large-region-beg) + case-fold-search) (with-current-buffer flyspell-external-ispell-buffer (goto-char (point-min)) ;; Loop over incorrect words, in the order they were reported, @@ -1453,11 +1463,18 @@ The buffer to mark them in is `flyspell-large-region-buffer'." ;; Move back into the match ;; so flyspell-get-word will find it. (forward-char -1) - (flyspell-get-word))) + ;; Is this a word that matches the + ;; current dictionary? + (if (looking-at word-chars) + (flyspell-get-word)))) (found (car found-list)) (found-length (length found)) (misspell-length (length word))) (when (or + ;; Misspelled word is not from the + ;; language supported by the current + ;; dictionary. + (null found) ;; Size matches, we really found it. (= found-length misspell-length) ;; Matches as part of a boundary-char separated @@ -1479,13 +1496,21 @@ The buffer to mark them in is `flyspell-large-region-buffer'." ;; backslash) and none of the previous ;; conditions match. (and (not ispell-really-aspell) + (not ispell-really-hunspell) + (not ispell-really-enchant) (save-excursion (goto-char (- (nth 1 found-list) 1)) (if (looking-at "[\\]" ) t nil)))) (setq keep nil) - (flyspell-word nil t) + ;; Don't try spell-checking words whose + ;; characters don't match CASECHARS, because + ;; flyspell-word will then consider as + ;; misspelling the preceding word that matches + ;; CASECHARS. + (or (null found) + (flyspell-word nil t)) ;; Search for next misspelled word will begin from ;; end of last validated match. (setq buffer-scan-pos (point)))) commit 3eac378c966cd5c7fa9c62f2abcb8a9744dea69b Author: Eli Zaretskii Date: Tue Aug 7 17:28:35 2018 +0300 Avoid segfaults in jason-serialize on MS-Windows * src/json.c (Fjson_serialize): Free the string with 'json_free', not 'free', since it was allocated with 'json_malloc'. (Bug#32381) diff --git a/src/json.c b/src/json.c index afdd9a2548..540aa630c5 100644 --- a/src/json.c +++ b/src/json.c @@ -159,7 +159,12 @@ init_json_functions (void) than PTRDIFF_MAX. Such objects wouldn't play well with the rest of Emacs's codebase, which generally uses ptrdiff_t for sizes and indices. The other functions in this file also generally assume - that size_t values never exceed PTRDIFF_MAX. */ + that size_t values never exceed PTRDIFF_MAX. + + In addition, we need to use a custom allocator because on + MS-Windows we replace malloc/free with our own functions, see + w32heap.c, so we must force the library to use our allocator, or + else we won't be able to free storage allocated by the library. */ static void * json_malloc (size_t size) @@ -605,7 +610,7 @@ usage: (json-serialize OBJECT &rest ARGS) */) char *string = json_dumps (json, JSON_COMPACT); if (string == NULL) json_out_of_memory (); - record_unwind_protect_ptr (free, string); + record_unwind_protect_ptr (json_free, string); return unbind_to (count, json_build_string (string)); } commit 5f32ba5015b5c17dbbe0453e8fe3efc343fe8489 Author: Stephen Berman Date: Mon Aug 6 23:52:47 2018 +0200 Fix todo-mode bug involving active region (bug#32379) * lisp/calendar/todo-mode.el (todo-forward-category) (todo-jump-to-category, todo-toggle-view-done-items) (todo-toggle-view-done-only, todo-edit-quit, todo-search) (todo-go-to-source-item, todo-diary-goto-entry): Deactivate the mark when the region is active. diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index a375313b33..c1c292129e 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -863,6 +863,7 @@ category is the first)." (not (zerop (todo-get-count 'archived)))) (setq todo-category-number (funcall setcatnum)))) (todo-category-select) + (if transient-mark-mode (deactivate-mark)) (goto-char (point-min)))) (defun todo-backward-category () @@ -928,6 +929,7 @@ Categories mode." (when goto-archive (todo-archive-mode)) (set-window-buffer (selected-window) (set-buffer (find-buffer-visiting file0))) + (if transient-mark-mode (deactivate-mark)) (unless todo-global-current-todo-file (setq todo-global-current-todo-file todo-current-todo-file)) (todo-category-number category) @@ -1019,15 +1021,17 @@ empty line above the done items separator." (setq shown (progn (goto-char (point-min)) (re-search-forward todo-done-string-start nil t))) - (if (not (pos-visible-in-window-p shown)) - (recenter) - (goto-char opoint))))))) + (if (pos-visible-in-window-p shown) + (goto-char opoint) + (recenter) + (if transient-mark-mode (deactivate-mark)))))))) (defun todo-toggle-view-done-only () "Switch between displaying only done or only todo items." (interactive) (setq todo-show-done-only (not todo-show-done-only)) - (todo-category-select)) + (todo-category-select) + (if transient-mark-mode (deactivate-mark))) (defun todo-toggle-item-highlighting () "Highlight or unhighlight the todo item the cursor is on." @@ -2230,7 +2234,8 @@ made in the number or names of categories." (insert item)) (kill-buffer) (unless (eq (current-buffer) buf) - (set-window-buffer (selected-window) (set-buffer buf)))) + (set-window-buffer (selected-window) (set-buffer buf))) + (if transient-mark-mode (deactivate-mark))) ;; We got here via `F e'. (when (todo-check-format) ;; FIXME: separate out sexp check? @@ -3839,6 +3844,7 @@ face." (goto-char (point-min)) (while (not (eobp)) (setq match (re-search-forward regex nil t)) + (if (and match transient-mark-mode) (deactivate-mark)) (goto-char (line-beginning-position)) (unless (or (equal (point) 1) (looking-at (concat "^" (regexp-quote todo-category-beg)))) @@ -4081,6 +4087,7 @@ regexp items." t todo-show-with-done))) (todo-category-select)) + (if transient-mark-mode (deactivate-mark)) (goto-char (car found)))))) (defvar todo-multiple-filter-files nil @@ -5314,6 +5321,7 @@ Overrides `diary-goto-entry'." nil t) (todo-category-number (match-string 1)) (todo-category-select) + (if transient-mark-mode (deactivate-mark)) (goto-char opoint)))))) (add-function :override diary-goto-entry-function #'todo-diary-goto-entry) commit 518c5b64d537c77050a49d15af25bc919e60f1a2 Author: Stephen Berman Date: Mon Aug 6 19:59:25 2018 +0200 Correct and improve part of previous todo-mode.el fix * lisp/calendar/todo-mode.el (todo-jump-to-category): Improve code by using bound-and-true-p. This leaves a byte-compiler warning unsilenced, but ideally, there shouldn't be a warning here (see https://lists.gnu.org/archive/html/emacs-devel/2018-08/msg00131.html). (todo--fifiles-history): New variable. (todo-find-filtered-items-file): Use it to fix the filtered items files history list for completing-read. diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index 6ff4d2a0a5..a375313b33 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -933,7 +933,7 @@ Categories mode." (todo-category-number category) (todo-category-select) (goto-char (point-min)) - (if (and (boundp 'hl-line-mode) hl-line-mode) (hl-line-highlight)) + (if (bound-and-true-p hl-line-mode) (hl-line-highlight)) (when add-item (todo-insert-item--basic)))))) (defun todo-next-item (&optional count) @@ -4037,20 +4037,22 @@ regexp items." (interactive "P") (todo-filter-items 'regexp arg t)) +(defvar todo--fifiles-history nil + "List of short file names used by todo-find-filtered-items-file.") + (defun todo-find-filtered-items-file () "Choose a filtered items file and visit it." (interactive) (let ((files (directory-files todo-directory t "\\.tod[rty]$" t)) - falist sfnlist file) + falist file) (dolist (f files) (let ((sf-name (todo-short-file-name f)) (type (cond ((equal (file-name-extension f) "todr") "regexp") ((equal (file-name-extension f) "todt") "top") ((equal (file-name-extension f) "tody") "diary")))) (push (cons (concat sf-name " (" type ")") f) falist))) - (setq sfnlist (mapcar #'car falist)) - (setq file (completing-read "Choose a filtered items file: " - falist nil t nil 'sfnlist (caar falist))) + (setq file (completing-read "Choose a filtered items file: " falist nil t nil + 'todo--fifiles-history (caar falist))) (setq file (cdr (assoc-string file falist))) (find-file file) (unless (derived-mode-p 'todo-filtered-items-mode) commit bedf905dd37ef8ad45d5912dd230bfe63a1721b3 Author: Eli Zaretskii Date: Mon Aug 6 17:50:55 2018 +0300 Fix the MS-Windows build as followup to Gnulib regex import * lib-src/ntlib.c (nl_langinfo): New function. (Bug#32194) diff --git a/lib-src/ntlib.c b/lib-src/ntlib.c index 9551285483..4ca521d277 100644 --- a/lib-src/ntlib.c +++ b/lib-src/ntlib.c @@ -31,6 +31,10 @@ along with GNU Emacs. If not, see . */ #include #include #include +#include + +#include +#include #include "ntlib.h" @@ -423,3 +427,66 @@ sys_open (const char * path, int oflag, int mode) { return _open (path, oflag, mode); } + +/* Emulation of nl_langinfo that supports only CODESET. + Used in Gnulib regex.c. */ +char * +nl_langinfo (nl_item item) +{ + switch (item) + { + case CODESET: + { + /* Shamelessly stolen from Gnulib's nl_langinfo.c, modulo + CPP directives. */ + static char buf[2 + 10 + 1]; + char const *locale = setlocale (LC_CTYPE, NULL); + char *codeset = buf; + size_t codesetlen; + codeset[0] = '\0'; + + if (locale && locale[0]) + { + /* If the locale name contains an encoding after the + dot, return it. */ + char *dot = strchr (locale, '.'); + + if (dot) + { + /* Look for the possible @... trailer and remove it, + if any. */ + char *codeset_start = dot + 1; + char const *modifier = strchr (codeset_start, '@'); + + if (! modifier) + codeset = codeset_start; + else + { + codesetlen = modifier - codeset_start; + if (codesetlen < sizeof buf) + { + codeset = memcpy (buf, codeset_start, codesetlen); + codeset[codesetlen] = '\0'; + } + } + } + } + /* If setlocale is successful, it returns the number of the + codepage, as a string. Otherwise, fall back on Windows + API GetACP, which returns the locale's codepage as a + number (although this doesn't change according to what + the 'setlocale' call specified). Either way, prepend + "CP" to make it a valid codeset name. */ + codesetlen = strlen (codeset); + if (0 < codesetlen && codesetlen < sizeof buf - 2) + memmove (buf + 2, codeset, codesetlen + 1); + else + sprintf (buf + 2, "%u", GetACP ()); + codeset = memcpy (buf, "CP", 2); + + return codeset; + } + default: + return (char *) ""; + } +} commit 9c022a488bd462b85895ef84313fe84c5bc2bb4d Author: Paul Eggert Date: Sun Aug 5 18:41:21 2018 -0700 Spruce up some regex-emacs comments * src/regex-emacs.c, src/regex-emacs.h: Update comments. diff --git a/src/regex-emacs.c b/src/regex-emacs.c index b944fe0c5a..d19838a876 100644 --- a/src/regex-emacs.c +++ b/src/regex-emacs.c @@ -1,6 +1,4 @@ -/* Extended regular expression matching and search library, version - 0.12. (Implements POSIX draft P1003.2/D11.2, except for some of the - internationalization features.) +/* Emacs regular expression matching and search Copyright (C) 1993-2018 Free Software Foundation, Inc. @@ -19,7 +17,6 @@ /* TODO: - structure the opcode space into opcode+flag. - - merge with glibc's regex.[ch]. - replace (succeed_n + jump_n + set_number_at) with something that doesn't need to modify the compiled regexp so that re_search can be reentrant. - get rid of on_failure_jump_smart by doing the optimization in re_comp @@ -28,34 +25,30 @@ #include -/* Get the interface, including the syntax bits. */ #include "regex-emacs.h" #include #include "character.h" #include "buffer.h" - #include "syntax.h" #include "category.h" /* Maximum number of duplicates an interval can allow. Some systems - define this in other header files, but we want our - value, so remove any previous define. */ + define this in other header files, but we want our value, so remove + any previous define. Repeat counts are stored in opcodes as 2-byte + unsigned integers. */ #ifdef RE_DUP_MAX # undef RE_DUP_MAX #endif -/* Repeat counts are stored in opcodes as 2 byte integers. This was - previously limited to 7fff because the parsing code uses signed - ints. But Emacs only runs on 32 bit platforms anyway. */ #define RE_DUP_MAX (0xffff) /* Make syntax table lookup grant data in gl_state. */ #define SYNTAX(c) syntax_property (c, 1) -/* Converts the pointer to the char to BEG-based offset from the start. */ +/* Convert the pointer to the char to BEG-based offset from the start. */ #define PTR_TO_OFFSET(d) POS_AS_IN_BUFFER (POINTER_TO_OFFSET (d)) -/* Strings are 0-indexed, buffers are 1-indexed; we pun on the boolean +/* Strings are 0-indexed, buffers are 1-indexed; pun on the boolean result to get the right base index. */ #define POS_AS_IN_BUFFER(p) \ ((p) + (NILP (gl_state.object) || BUFFERP (gl_state.object))) @@ -63,9 +56,9 @@ #define RE_MULTIBYTE_P(bufp) ((bufp)->multibyte) #define RE_TARGET_MULTIBYTE_P(bufp) ((bufp)->target_multibyte) #define RE_STRING_CHAR(p, multibyte) \ - (multibyte ? (STRING_CHAR (p)) : (*(p))) + (multibyte ? STRING_CHAR (p) : *(p)) #define RE_STRING_CHAR_AND_LENGTH(p, len, multibyte) \ - (multibyte ? (STRING_CHAR_AND_LENGTH (p, len)) : ((len) = 1, *(p))) + (multibyte ? STRING_CHAR_AND_LENGTH (p, len) : ((len) = 1, *(p))) #define RE_CHAR_TO_MULTIBYTE(c) UNIBYTE_TO_CHAR (c) @@ -79,8 +72,9 @@ if (target_multibyte) \ { \ re_char *dtemp = (p) == (str2) ? (end1) : (p); \ - re_char *dlimit = ((p) > (str2) && (p) <= (end2)) ? (str2) : (str1); \ - while (dtemp-- > dlimit && !CHAR_HEAD_P (*dtemp)); \ + re_char *dlimit = (p) > (str2) && (p) <= (end2) ? (str2) : (str1); \ + while (dtemp-- > dlimit && !CHAR_HEAD_P (*dtemp)) \ + continue; \ c = STRING_CHAR (dtemp); \ } \ else \ @@ -88,7 +82,7 @@ (c = ((p) == (str2) ? (end1) : (p))[-1]); \ (c) = RE_CHAR_TO_MULTIBYTE (c); \ } \ - } while (0) + } while (false) /* Set C a (possibly converted to multibyte) character at P, and set LEN to the byte length of that character. */ @@ -102,11 +96,8 @@ len = 1; \ (c) = RE_CHAR_TO_MULTIBYTE (c); \ } \ - } while (0) + } while (false) -/* isalpha etc. are used for the character classes. */ -#include - /* 1 if C is an ASCII character. */ #define IS_REAL_ASCII(c) ((c) < 0200) @@ -165,13 +156,13 @@ /* Use alloca instead of malloc. This is because using malloc in re_search* or re_match* could cause memory leaks when C-g is used in Emacs (note that SAFE_ALLOCA could also call malloc, but does so - via `record_xmalloc' which uses `unwind_protect' to ensure the + via 'record_xmalloc' which uses 'unwind_protect' to ensure the memory is freed even in case of non-local exits); also, malloc is slower and causes storage fragmentation. On the other hand, malloc is more portable, and easier to debug. Because we sometimes use alloca, some routines have to be macros, - not functions -- `alloca'-allocated space disappears at the end of the + not functions -- 'alloca'-allocated space disappears at the end of the function it is called in. */ /* This may be adjusted in main(), if the stack is successfully grown. */ @@ -180,13 +171,13 @@ ptrdiff_t emacs_re_safe_alloca = MAX_ALLOCA; #define REGEX_USE_SAFE_ALLOCA \ USE_SAFE_ALLOCA; sa_avail = emacs_re_safe_alloca -/* Assumes a `char *destination' variable. */ +/* Assumes a 'char *destination' variable. */ #define REGEX_REALLOCATE(source, osize, nsize) \ (destination = SAFE_ALLOCA (nsize), \ memcpy (destination, source, osize)) -/* True if `size1' is non-NULL and PTR is pointing anywhere inside - `string1' or just past its end. This works if PTR is NULL, which is +/* True if 'size1' is non-NULL and PTR is pointing anywhere inside + 'string1' or just past its end. This works if PTR is NULL, which is a good thing. */ #define FIRST_STRING_P(ptr) \ (size1 && string1 <= (ptr) && (ptr) <= string1 + size1) @@ -254,7 +245,7 @@ typedef enum /* Stop remembering the text that is matched and store it in a memory register. Followed by one byte with the register - number, in the range 0 to one less than `re_nsub' in the + number, in the range 0 to one less than 're_nsub' in the pattern buffer. */ stop_memory, @@ -285,23 +276,23 @@ typedef enum current string position when executed. */ on_failure_keep_string_jump, - /* Just like `on_failure_jump', except that it checks that we + /* Just like 'on_failure_jump', except that it checks that we don't get stuck in an infinite loop (matching an empty string indefinitely). */ on_failure_jump_loop, - /* Just like `on_failure_jump_loop', except that it checks for + /* Just like 'on_failure_jump_loop', except that it checks for a different kind of loop (the kind that shows up with non-greedy operators). This operation has to be immediately preceded - by a `no_op'. */ + by a 'no_op'. */ on_failure_jump_nastyloop, - /* A smart `on_failure_jump' used for greedy * and + operators. + /* A smart 'on_failure_jump' used for greedy * and + operators. It analyzes the loop before which it is put and if the loop does not require backtracking, it changes itself to - `on_failure_keep_string_jump' and short-circuits the loop, - else it just defaults to changing itself into `on_failure_jump'. - It assumes that it is pointing to just past a `jump'. */ + 'on_failure_keep_string_jump' and short-circuits the loop, + else it just defaults to changing itself into 'on_failure_jump'. + It assumes that it is pointing to just past a 'jump'. */ on_failure_jump_smart, /* Followed by two-byte relative address and two-byte number n. @@ -356,7 +347,7 @@ typedef enum do { \ (destination)[0] = (number) & 0377; \ (destination)[1] = (number) >> 8; \ - } while (0) + } while (false) /* Same as STORE_NUMBER, except increment DESTINATION to the byte after where the number is stored. Therefore, DESTINATION @@ -366,7 +357,7 @@ typedef enum do { \ STORE_NUMBER (destination, number); \ (destination) += 2; \ - } while (0) + } while (false) /* Put into DESTINATION a number stored in two contiguous bytes starting at SOURCE. */ @@ -405,7 +396,7 @@ extract_number_and_incr (re_char **source) (destination)[1] = ((character) >> 8) & 0377; \ (destination)[2] = (character) >> 16; \ (destination) += 3; \ - } while (0) + } while (false) /* Put into DESTINATION a character stored in three contiguous bytes starting at SOURCE. */ @@ -415,7 +406,7 @@ extract_number_and_incr (re_char **source) (destination) = ((source)[0] \ | ((source)[1] << 8) \ | ((source)[2] << 16)); \ - } while (0) + } while (false) /* Macros for charset. */ @@ -429,7 +420,7 @@ extract_number_and_incr (re_char **source) /* Return the address of range table of charset P. But not the start of table itself, but the before where the number of ranges is - stored. `2 +' means to skip re_opcode_t and size of bitmap, + stored. '2 +' means to skip re_opcode_t and size of bitmap, and the 2 bytes of flags at the start of the range table. */ #define CHARSET_RANGE_TABLE(p) (&(p)[4 + CHARSET_BITMAP_SIZE (p)]) @@ -439,8 +430,8 @@ extract_number_and_incr (re_char **source) + (p)[3 + CHARSET_BITMAP_SIZE (p)] * 0x100) /* Return the address of end of RANGE_TABLE. COUNT is number of - ranges (which is a pair of (start, end)) in the RANGE_TABLE. `* 2' - is start of range and end of range. `* 3' is size of each start + ranges (which is a pair of (start, end)) in the RANGE_TABLE. '* 2' + is start of range and end of range. '* 3' is size of each start and end. */ #define CHARSET_RANGE_TABLE_END(range_table, count) \ ((range_table) + (count) * 2 * 3) @@ -450,7 +441,7 @@ extract_number_and_incr (re_char **source) #ifdef REGEX_EMACS_DEBUG -/* We use standard I/O for debugging. */ +/* Use standard I/O for debugging. */ # include static int regex_emacs_debug = -100000; @@ -859,7 +850,7 @@ enum { REGS_UNALLOCATED, REGS_REALLOCATE, REGS_FIXED }; /* If 'regs_allocated' is REGS_UNALLOCATED in the pattern buffer, 're_match_2' returns information about at least this many registers - the first time a `regs' structure is passed. */ + the first time a 'regs' structure is passed. */ enum { RE_NREGS = 30 }; /* The searching and matching functions allocate memory for the @@ -878,7 +869,7 @@ enum { RE_NREGS = 30 }; #define INIT_FAILURE_ALLOC 20 /* Roughly the maximum number of failure points on the stack. Would be - exactly that if always used TYPICAL_FAILURE_SIZE items each time we failed. + exactly that if failure always used TYPICAL_FAILURE_SIZE items. This is a variable only so users of regex can assign to it; we never change it ourselves. We always multiply it by TYPICAL_FAILURE_SIZE before using it, so it should probably be a byte-count instead. */ @@ -891,7 +882,7 @@ size_t emacs_re_max_failures = 40000; union fail_stack_elt { re_char *pointer; - /* This should be the biggest `int' that's no bigger than a pointer. */ + /* This should be the biggest 'int' that's no bigger than a pointer. */ long integer; }; @@ -918,19 +909,18 @@ typedef struct fail_stack.size = INIT_FAILURE_ALLOC; \ fail_stack.avail = 0; \ fail_stack.frame = 0; \ - } while (0) + } while (false) /* Double the size of FAIL_STACK, up to a limit - which allows approximately `emacs_re_max_failures' items. + which allows approximately 'emacs_re_max_failures' items. Return 1 if succeeds, and 0 if either ran out of memory allocating space for it or it was already too large. - REGEX_REALLOCATE requires `destination' be declared. */ + REGEX_REALLOCATE requires 'destination' be declared. */ -/* Factor to increase the failure stack size by - when we increase it. +/* Factor to increase the failure stack size by. This used to be 2, but 2 was too wasteful because the old discarded stacks added up to as much space were as ultimate, maximum-size stack. */ @@ -952,19 +942,19 @@ typedef struct /* Push a pointer value onto the failure stack. - Assumes the variable `fail_stack'. Probably should only - be called from within `PUSH_FAILURE_POINT'. */ + Assumes the variable 'fail_stack'. Probably should only + be called from within 'PUSH_FAILURE_POINT'. */ #define PUSH_FAILURE_POINTER(item) \ fail_stack.stack[fail_stack.avail++].pointer = (item) /* This pushes an integer-valued item onto the failure stack. - Assumes the variable `fail_stack'. Probably should only - be called from within `PUSH_FAILURE_POINT'. */ + Assumes the variable 'fail_stack'. Probably should only + be called from within 'PUSH_FAILURE_POINT'. */ #define PUSH_FAILURE_INT(item) \ fail_stack.stack[fail_stack.avail++].integer = (item) /* These POP... operations complement the PUSH... operations. - All assume that `fail_stack' is nonempty. */ + All assume that 'fail_stack' is nonempty. */ #define POP_FAILURE_POINTER() fail_stack.stack[--fail_stack.avail].pointer #define POP_FAILURE_INT() fail_stack.stack[--fail_stack.avail].integer @@ -997,7 +987,7 @@ do { \ PUSH_FAILURE_POINTER (regstart[n]); \ PUSH_FAILURE_POINTER (regend[n]); \ PUSH_FAILURE_INT (n); \ -} while (0) +} while (false) /* Change the counter's value to VAL, but make sure that it will be reset when backtracking. */ @@ -1012,7 +1002,7 @@ do { \ PUSH_FAILURE_POINTER (ptr); \ PUSH_FAILURE_INT (-1); \ STORE_NUMBER (ptr, val); \ -} while (0) +} while (false) /* Pop a saved register off the stack. */ #define POP_FAILURE_REG_OR_COUNT() \ @@ -1034,7 +1024,7 @@ do { \ DEBUG_PRINT (" Pop reg %ld (spanning %p -> %p)\n", \ pfreg, regstart[pfreg], regend[pfreg]); \ } \ -} while (0) +} while (false) /* Check that we are not stuck in an infinite loop. */ #define CHECK_INFINITE_LOOP(pat_cur, string_place) \ @@ -1056,23 +1046,20 @@ do { \ failure = NEXT_FAILURE_HANDLE(failure); \ } \ DEBUG_PRINT (" Other string: %p\n", FAILURE_STR (failure)); \ -} while (0) +} while (false) /* Push the information about the state we will need if we ever fail back to it. Requires variables fail_stack, regstart, regend and - num_regs be declared. GROW_FAIL_STACK requires `destination' be + num_regs be declared. GROW_FAIL_STACK requires 'destination' be declared. - Does `return FAILURE_CODE' if runs out of memory. */ + Does 'return FAILURE_CODE' if runs out of memory. */ #define PUSH_FAILURE_POINT(pattern, string_place) \ do { \ char *destination; \ - /* Must be int, so when we don't save any registers, the arithmetic \ - of 0 + -1 isn't done as unsigned. */ \ - \ DEBUG_STATEMENT (nfailure_points_pushed++); \ DEBUG_PRINT ("\nPUSH_FAILURE_POINT:\n"); \ DEBUG_PRINT (" Before push, next avail: %zu\n", (fail_stack).avail); \ @@ -1096,7 +1083,7 @@ do { \ \ /* Close the frame by moving the frame pointer past it. */ \ fail_stack.frame = fail_stack.avail; \ -} while (0) +} while (false) /* Estimate the size of data pushed by a typical failure stack entry. An estimate is all we need, because all we use this for @@ -1108,15 +1095,15 @@ do { \ #define REMAINING_AVAIL_SLOTS ((fail_stack).size - (fail_stack).avail) -/* Pops what PUSH_FAIL_STACK pushes. +/* Pop what PUSH_FAIL_STACK pushes. - We restore into the parameters, all of which should be lvalues: + Restore into the parameters, all of which should be lvalues: STR -- the saved data position. PAT -- the saved pattern position. REGSTART, REGEND -- arrays of string positions. - Also assumes the variables `fail_stack' and (if debugging), `bufp', - `pend', `string1', `size1', `string2', and `size2'. */ + Also assume the variables FAIL_STACK and (if debugging) BUFP, PEND, + STRING1, SIZE1, STRING2, and SIZE2. */ #define POP_FAILURE_POINT(str, pat) \ do { \ @@ -1150,7 +1137,7 @@ do { \ eassert (fail_stack.frame <= fail_stack.avail); \ \ DEBUG_STATEMENT (nfailure_points_popped++); \ -} while (0) /* POP_FAILURE_POINT */ +} while (false) /* POP_FAILURE_POINT */ @@ -1183,28 +1170,28 @@ static int analyze_first (re_char *p, re_char *pend, if (p == pend) return REG_EEND; \ c = RE_STRING_CHAR_AND_LENGTH (p, len, multibyte); \ p += len; \ - } while (0) + } while (false) #define RE_TRANSLATE(TBL, C) char_table_translate (TBL, C) #define TRANSLATE(d) (!NILP (translate) ? RE_TRANSLATE (translate, d) : (d)) -/* Macros for outputting the compiled pattern into `buffer'. */ +/* Macros for outputting the compiled pattern into 'buffer'. */ /* If the buffer isn't allocated when it comes in, use this. */ #define INIT_BUF_SIZE 32 -/* Make sure we have at least N more bytes of space in buffer. */ +/* Ensure at least N more bytes of space in buffer. */ #define GET_BUFFER_SPACE(n) \ while ((size_t) (b - bufp->buffer + (n)) > bufp->allocated) \ EXTEND_BUFFER () -/* Make sure we have one more byte of buffer space and then add C to it. */ +/* Ensure one more byte of buffer space and then add C to it. */ #define BUF_PUSH(c) \ do { \ GET_BUFFER_SPACE (1); \ *b++ = (unsigned char) (c); \ - } while (0) + } while (false) /* Ensure we have two more bytes of buffer space and then append C1 and C2. */ @@ -1213,10 +1200,10 @@ static int analyze_first (re_char *p, re_char *pend, GET_BUFFER_SPACE (2); \ *b++ = (unsigned char) (c1); \ *b++ = (unsigned char) (c2); \ - } while (0) + } while (false) -/* Store a jump with opcode OP at LOC to location TO. We store a +/* Store a jump with opcode OP at LOC to location TO. Store a relative address offset by the three bytes the jump itself occupies. */ #define STORE_JUMP(op, loc, to) \ store_op1 (op, loc, (to) - (loc) - 3) @@ -1225,11 +1212,11 @@ static int analyze_first (re_char *p, re_char *pend, #define STORE_JUMP2(op, loc, to, arg) \ store_op2 (op, loc, (to) - (loc) - 3, arg) -/* Like `STORE_JUMP', but for inserting. Assume `b' is the buffer end. */ +/* Like 'STORE_JUMP', but for inserting. Assume B is the buffer end. */ #define INSERT_JUMP(op, loc, to) \ insert_op1 (op, loc, (to) - (loc) - 3, b) -/* Like `STORE_JUMP2', but for inserting. Assume `b' is the buffer end. */ +/* Like 'STORE_JUMP2', but for inserting. Assume B is the buffer end. */ #define INSERT_JUMP2(op, loc, to, arg) \ insert_op2 (op, loc, (to) - (loc) - 3, arg, b) @@ -1237,7 +1224,7 @@ static int analyze_first (re_char *p, re_char *pend, /* This is not an arbitrary limit: the arguments which represent offsets into the pattern are two bytes long. So if 2^15 bytes turns out to be too small, many things would have to change. */ -# define MAX_BUF_SIZE (1L << 15) +# define MAX_BUF_SIZE (1 << 15) /* Extend the buffer by twice its current size via realloc and reset the pointers that pointed into the old block to point to the @@ -1267,7 +1254,7 @@ static int analyze_first (re_char *p, re_char *pend, if (fixup_alt_jump_set) fixup_alt_jump = new_buffer + fixup_alt_jump_off; \ if (laststart_set) laststart = new_buffer + laststart_off; \ if (pending_exact_set) pending_exact = new_buffer + pending_exact_off; \ - } while (0) + } while (false) /* Since we have one byte reserved for the register number argument to @@ -1275,7 +1262,7 @@ static int analyze_first (re_char *p, re_char *pend, things about is what fits in that byte. */ #define MAX_REGNUM 255 -/* But patterns can have more than `MAX_REGNUM' registers. We just +/* But patterns can have more than 'MAX_REGNUM' registers. Just ignore the excess. */ typedef int regnum_t; @@ -1284,7 +1271,6 @@ typedef int regnum_t; /* Since offsets can go either forwards or backwards, this type needs to be able to hold values from -(MAX_BUF_SIZE - 1) to MAX_BUF_SIZE - 1. */ -/* int may be not enough when sizeof(int) == 2. */ typedef long pattern_offset_t; typedef struct @@ -1334,7 +1320,7 @@ struct range_table_work_area if ((work_area).table == 0) \ return (REG_ESPACE); \ } \ - } while (0) + } while (false) #define SET_RANGE_TABLE_WORK_AREA_BIT(work_area, bit) \ (work_area).bits |= (bit) @@ -1345,16 +1331,17 @@ struct range_table_work_area EXTEND_RANGE_TABLE ((work_area), 2); \ (work_area).table[(work_area).used++] = (range_start); \ (work_area).table[(work_area).used++] = (range_end); \ - } while (0) + } while (false) /* Free allocated memory for WORK_AREA. */ #define FREE_RANGE_TABLE_WORK_AREA(work_area) \ do { \ if ((work_area).table) \ xfree ((work_area).table); \ - } while (0) + } while (false) -#define CLEAR_RANGE_TABLE_WORK_USED(work_area) ((work_area).used = 0, (work_area).bits = 0) +#define CLEAR_RANGE_TABLE_WORK_USED(work_area) \ + ((work_area).used = 0, (work_area).bits = 0) #define RANGE_TABLE_WORK_USED(work_area) ((work_area).used) #define RANGE_TABLE_WORK_BITS(work_area) ((work_area).bits) #define RANGE_TABLE_WORK_ELT(work_area, i) ((work_area).table[i]) @@ -1405,7 +1392,7 @@ struct range_table_work_area } \ SET_LIST_BIT (C1); \ } \ - } while (0) + } while (false) /* Both FROM and TO are unibyte characters (0x80..0xFF). */ @@ -1445,7 +1432,7 @@ struct range_table_work_area SET_RANGE_TABLE_WORK_AREA ((work_area), C2, C2); \ } \ } \ - } while (0) + } while (false) /* Both FROM and TO are multibyte characters. */ @@ -1480,7 +1467,7 @@ struct range_table_work_area if (I < USED) \ SET_RANGE_TABLE_WORK_AREA ((work_area), C1, C1); \ } \ - } while (0) + } while (false) /* Get the next unsigned number in the uncompiled pattern. */ #define GET_INTERVAL_COUNT(num) \ @@ -1502,7 +1489,7 @@ struct range_table_work_area PATFETCH (c); \ } \ } \ - } while (0) + } while (false) /* Parse a character class, i.e. string such as "[:name:]". *strp points to the string to be parsed and limit is length, in bytes, of @@ -1662,34 +1649,17 @@ extend_range_table_work_area (struct range_table_work_area *work_area) work_area->table = xrealloc (work_area->table, work_area->allocated); } -static bool group_in_compile_stack (compile_stack_type, regnum_t); - -/* `regex_compile' compiles PATTERN (of length SIZE) according to SYNTAX. - Returns one of error codes defined in `regex-emacs.h', or zero for success. - - If WHITESPACE_REGEXP is given, it is used instead of a space - character in PATTERN. - - Assumes the `allocated' (and perhaps `buffer') and `translate' - fields are set in BUFP on entry. - - If it succeeds, results are put in BUFP (if it returns an error, the - contents of BUFP are undefined): - `buffer' is the compiled pattern; - `syntax' is set to SYNTAX; - `used' is set to the length of the compiled pattern; - `fastmap_accurate' is zero; - `re_nsub' is the number of subexpressions in PATTERN; +/* regex_compile and helpers. */ - The `fastmap' field is neither examined nor set. */ +static bool group_in_compile_stack (compile_stack_type, regnum_t); -/* Insert the `jump' from the end of last alternative to "here". +/* Insert the 'jump' from the end of last alternative to "here". The space for the jump has already been allocated. */ #define FIXUP_ALT_JUMP() \ do { \ if (fixup_alt_jump) \ STORE_JUMP (jump, fixup_alt_jump, b); \ -} while (0) +} while (false) /* Return, freeing storage we allocated. */ @@ -1698,7 +1668,26 @@ do { \ FREE_RANGE_TABLE_WORK_AREA (range_table_work); \ xfree (compile_stack.stack); \ return value; \ - } while (0) + } while (false) + +/* Compile PATTERN (of length SIZE) according to SYNTAX. + Return a nonzero error code on failure, or zero for success. + + If WHITESPACE_REGEXP is given, use it instead of a space + character in PATTERN. + + Assume the 'allocated' (and perhaps 'buffer') and 'translate' + fields are set in BUFP on entry. + + If successful, put results in *BUFP (otherwise the + contents of *BUFP are undefined): + 'buffer' is the compiled pattern; + 'syntax' is set to SYNTAX; + 'used' is set to the length of the compiled pattern; + 'fastmap_accurate' is zero; + 're_nsub' is the number of subexpressions in PATTERN; + + The 'fastmap' field is neither examined nor set. */ static reg_errcode_t regex_compile (re_char *pattern, size_t size, @@ -1706,7 +1695,7 @@ regex_compile (re_char *pattern, size_t size, const char *whitespace_regexp, struct re_pattern_buffer *bufp) { - /* We fetch characters from PATTERN here. */ + /* Fetch characters from PATTERN here. */ int c, c1; /* Points to the end of the buffer, where we should append. */ @@ -1722,10 +1711,10 @@ regex_compile (re_char *pattern, size_t size, /* How to translate the characters in the pattern. */ Lisp_Object translate = bufp->translate; - /* Address of the count-byte of the most recently inserted `exactn' + /* Address of the count-byte of the most recently inserted 'exactn' command. This makes it possible to tell if a new exact-match character can be added to that command or if the character requires - a new `exactn' command. */ + a new 'exactn' command. */ unsigned char *pending_exact = 0; /* Address of start of the most recently finished expression. @@ -1741,7 +1730,7 @@ regex_compile (re_char *pattern, size_t size, re_char *beg_interval; /* Address of the place where a forward jump should go to the end of - the containing expression. Each alternative of an `or' -- except the + the containing expression. Each alternative of an 'or' -- except the last -- ends with a forward jump of this sort. */ unsigned char *fixup_alt_jump = 0; @@ -1785,7 +1774,7 @@ regex_compile (re_char *pattern, size_t size, bufp->fastmap_accurate = 0; bufp->used_syntax = 0; - /* Set `used' to zero, so that if we return an error, the pattern + /* Set 'used' to zero, so that if we return an error, the pattern printer (for debugging) will think there's no pattern. We reset it at the end. */ bufp->used = 0; @@ -1892,8 +1881,8 @@ regex_compile (re_char *pattern, size_t size, /* If there is a sequence of repetition chars, collapse it down to just one (the right one). We can't combine - interval operators with these because of, e.g., `a{2}*', - which should only match an even number of `a's. */ + interval operators with these because of, e.g., 'a{2}*', + which should only match an even number of 'a's. */ for (;;) { @@ -2025,8 +2014,8 @@ regex_compile (re_char *pattern, size_t size, laststart = b; - /* We test `*p == '^' twice, instead of using an if - statement, so we only need one BUF_PUSH. */ + /* Test '*p == '^' twice, instead of using an if + statement, so we need only one BUF_PUSH. */ BUF_PUSH (*p == '^' ? charset_not : charset); if (*p == '^') p++; @@ -2104,7 +2093,7 @@ regex_compile (re_char *pattern, size_t size, PATFETCH (c); /* Could be the end of the bracket expression. If it's - not (i.e., when the bracket expression is `[]' so + not (i.e., when the bracket expression is '[]' so far), the ']' character bit gets set way below. */ if (c == ']' && p2 != p1) break; @@ -2112,7 +2101,7 @@ regex_compile (re_char *pattern, size_t size, if (p < pend && p[0] == '-' && p[1] != ']') { - /* Discard the `-'. */ + /* Discard the '-'. */ PATFETCH (c1); /* Fetch the character which ends the range. */ @@ -2294,12 +2283,12 @@ regex_compile (re_char *pattern, size_t size, FREE_STACK_RETURN (REG_ERPAREN); /* Since we just checked for an empty stack above, this - ``can't happen''. */ + "can't happen". */ eassert (compile_stack.avail != 0); { - /* We don't just want to restore into `regnum', because + /* We don't just want to restore into 'regnum', because later groups should continue to be numbered higher, - as in `(ab)c(de)' -- the second group is #2. */ + as in '(ab)c(de)' -- the second group is #2. */ regnum_t regnum; compile_stack.avail--; @@ -2323,7 +2312,7 @@ regex_compile (re_char *pattern, size_t size, break; - case '|': /* `\|'. */ + case '|': /* '\|'. */ /* Insert before the previous alternative a jump which jumps to this alternative if the former fails. */ GET_BUFFER_SPACE (3); @@ -2340,12 +2329,12 @@ regex_compile (re_char *pattern, size_t size, _____ _____ | | | | | v | v - a | b | c + A | B | C - If we are at `b', then fixup_alt_jump right now points to a - three-byte space after `a'. We'll put in the jump, set - fixup_alt_jump to right after `b', and leave behind three - bytes which we'll fill in when we get to after `c'. */ + If we are at B, then fixup_alt_jump right now points to a + three-byte space after A. We'll put in the jump, set + fixup_alt_jump to right after B, and leave behind three + bytes which we'll fill in when we get to after C. */ FIXUP_ALT_JUMP (); @@ -2373,7 +2362,7 @@ regex_compile (re_char *pattern, size_t size, if (c == ',') GET_INTERVAL_COUNT (upper_bound); else - /* Interval such as `{1}' => match exactly once. */ + /* Interval such as '{1}' => match exactly once. */ upper_bound = lower_bound; if (lower_bound < 0 @@ -2406,8 +2395,8 @@ regex_compile (re_char *pattern, size_t size, succeed_n jump_n - (The upper bound and `jump_n' are omitted if - `upper_bound' is 1, though.) */ + (The upper bound and 'jump_n' are omitted if + 'upper_bound' is 1, though.) */ else { /* If the upper bound is > 1, we need to insert more at the end of the loop. */ @@ -2427,21 +2416,22 @@ regex_compile (re_char *pattern, size_t size, } else { - /* Initialize lower bound of the `succeed_n', even + /* Initialize lower bound of the 'succeed_n', even though it will be set during matching by its - attendant `set_number_at' (inserted next), - because `re_compile_fastmap' needs to know. - Jump to the `jump_n' we might insert below. */ + attendant 'set_number_at' (inserted next), + because 're_compile_fastmap' needs to know. + Jump to the 'jump_n' we might insert below. */ INSERT_JUMP2 (succeed_n, laststart, b + 5 + nbytes, lower_bound); b += 5; /* Code to initialize the lower bound. Insert - before the `succeed_n'. The `5' is the last two - bytes of this `set_number_at', plus 3 bytes of - the following `succeed_n'. */ - insert_op2 (set_number_at, laststart, 5, lower_bound, b); + before the 'succeed_n'. The '5' is the last two + bytes of this 'set_number_at', plus 3 bytes of + the following 'succeed_n'. */ + insert_op2 (set_number_at, laststart, 5, + lower_bound, b); b += 5; startoffset += 5; } @@ -2455,28 +2445,28 @@ regex_compile (re_char *pattern, size_t size, } else if (upper_bound > 1) { /* More than one repetition is allowed, so - append a backward jump to the `succeed_n' + append a backward jump to the 'succeed_n' that starts this interval. When we've reached this during matching, we'll have matched the interval once, so - jump back only `upper_bound - 1' times. */ + jump back only 'upper_bound - 1' times. */ STORE_JUMP2 (jump_n, b, laststart + startoffset, upper_bound - 1); b += 5; /* The location we want to set is the second - parameter of the `jump_n'; that is `b-2' as - an absolute address. `laststart' will be - the `set_number_at' we're about to insert; - `laststart+3' the number to set, the source + parameter of the 'jump_n'; that is 'b-2' as + an absolute address. 'laststart' will be + the 'set_number_at' we're about to insert; + 'laststart+3' the number to set, the source for the relative address. But we are inserting into the middle of the pattern -- so everything is getting moved up by 5. Conclusion: (b - 2) - (laststart + 3) + 5, i.e., b - laststart. - We insert this at the beginning of the loop + Insert this at the beginning of the loop so that if we fail during matching, we'll reinitialize the bounds. */ insert_op2 (set_number_at, laststart, b - laststart, @@ -2601,7 +2591,7 @@ regex_compile (re_char *pattern, size_t size, default: - /* Expects the character in `c'. */ + /* Expects the character in C. */ normal_char: /* If no exactn currently being built. */ if (!pending_exact @@ -2609,7 +2599,7 @@ regex_compile (re_char *pattern, size_t size, /* If last exactn not at current position. */ || pending_exact + *pending_exact + 1 != b - /* We have only one byte following the exactn for the count. */ + /* Only one byte follows the exactn for the count. */ || *pending_exact >= (1 << BYTEWIDTH) - MAX_MULTIBYTE_LENGTH /* If followed by a repetition operator. */ @@ -2668,7 +2658,7 @@ regex_compile (re_char *pattern, size_t size, if (!posix_backtracking) BUF_PUSH (succeed); - /* We have succeeded; set the length of the buffer. */ + /* Success; set the length of the buffer. */ bufp->used = b - bufp->buffer; #ifdef REGEX_EMACS_DEBUG @@ -2685,7 +2675,7 @@ regex_compile (re_char *pattern, size_t size, } /* regex_compile */ -/* Subroutines for `regex_compile'. */ +/* Subroutines for 'regex_compile'. */ /* Store OP at LOC followed by two-byte integer parameter ARG. */ @@ -2697,7 +2687,7 @@ store_op1 (re_opcode_t op, unsigned char *loc, int arg) } -/* Like `store_op1', but for two two-byte parameters ARG1 and ARG2. */ +/* Like 'store_op1', but for two two-byte parameters ARG1 and ARG2. */ static void store_op2 (re_opcode_t op, unsigned char *loc, int arg1, int arg2) @@ -2724,10 +2714,11 @@ insert_op1 (re_opcode_t op, unsigned char *loc, int arg, unsigned char *end) } -/* Like `insert_op1', but for two two-byte parameters ARG1 and ARG2. */ +/* Like 'insert_op1', but for two two-byte parameters ARG1 and ARG2. */ static void -insert_op2 (re_opcode_t op, unsigned char *loc, int arg1, int arg2, unsigned char *end) +insert_op2 (re_opcode_t op, unsigned char *loc, int arg1, int arg2, + unsigned char *end) { register unsigned char *pfrom = end; register unsigned char *pto = end + 5; @@ -2740,7 +2731,7 @@ insert_op2 (re_opcode_t op, unsigned char *loc, int arg1, int arg2, unsigned cha /* P points to just after a ^ in PATTERN. Return true if that ^ comes - after an alternative or a begin-subexpression. We assume there is at + after an alternative or a begin-subexpression. Assume there is at least one character before the ^. */ static bool @@ -2776,8 +2767,8 @@ at_begline_loc_p (re_char *pattern, re_char *p) } -/* The dual of at_begline_loc_p. This one is for $. We assume there is - at least one character after the $, i.e., `P < PEND'. */ +/* The dual of at_begline_loc_p. This one is for $. Assume there is + at least one character after the $, i.e., 'P < PEND'. */ static bool at_endline_loc_p (re_char *p, re_char *pend) @@ -2832,22 +2823,22 @@ analyze_first (re_char *p, re_char *pend, char *fastmap, starts by only containing a pointer to the first operation. - If the opcode we're looking at is a match against some set of chars, then we add those chars to the fastmap and go on to the - next work element from the worklist (done via `break'). + next work element from the worklist (done via 'break'). - If the opcode is a control operator on the other hand, we either - ignore it (if it's meaningless at this point, such as `start_memory') + ignore it (if it's meaningless at this point, such as 'start_memory') or execute it (if it's a jump). If the jump has several destinations - (i.e. `on_failure_jump'), then we push the other destination onto the + (i.e. 'on_failure_jump'), then we push the other destination onto the worklist. We guarantee termination by ignoring backward jumps (more or less), - so that `p' is monotonically increasing. More to the point, we - never set `p' (or push) anything `<= p1'. */ + so that P is monotonically increasing. More to the point, we + never set P (or push) anything '<= p1'. */ while (p < pend) { - /* `p1' is used as a marker of how far back a `on_failure_jump' - can go without being ignored. It is normally equal to `p' - (which prevents any backward `on_failure_jump') except right - after a plain `jump', to allow patterns such as: + /* P1 is used as a marker of how far back a 'on_failure_jump' + can go without being ignored. It is normally equal to P + (which prevents any backward 'on_failure_jump') except right + after a plain 'jump', to allow patterns such as: 0: jump 10 3..9: 10: on_failure_jump 3 @@ -2869,7 +2860,7 @@ analyze_first (re_char *p, re_char *pend, char *fastmap, /* Following are the cases which match a character. These end - with `break'. */ + with 'break'. */ case exactn: if (fastmap) @@ -2943,7 +2934,7 @@ analyze_first (re_char *p, re_char *pend, char *fastmap, int c, count; unsigned char lc1, lc2; - /* Make P points the range table. `+ 2' is to skip flag + /* Make P points the range table. '+ 2' is to skip flag bits for a character class. */ p += CHARSET_BITMAP_SIZE (&p[-2]) + 2; @@ -2991,7 +2982,7 @@ analyze_first (re_char *p, re_char *pend, char *fastmap, break; /* All cases after this match the empty string. These end with - `continue'. */ + 'continue'. */ case at_dot: case no_op: @@ -3012,7 +3003,7 @@ analyze_first (re_char *p, re_char *pend, char *fastmap, EXTRACT_NUMBER_AND_INCR (j, p); if (j < 0) /* Backward jumps can only go back to code that we've already - visited. `re_compile' should make sure this is true. */ + visited. 're_compile' should make sure this is true. */ break; p += j; switch (*p) @@ -3027,7 +3018,7 @@ analyze_first (re_char *p, re_char *pend, char *fastmap, default: continue; }; - /* Keep `p1' to allow the `on_failure_jump' we are jumping to + /* Keep P1 to allow the 'on_failure_jump' we are jumping to to jump back to "just after here". */ FALLTHROUGH; case on_failure_jump: @@ -3094,8 +3085,8 @@ analyze_first (re_char *p, re_char *pend, char *fastmap, } /* analyze_first */ -/* re_compile_fastmap computes a ``fastmap'' for the compiled pattern in - BUFP. A fastmap records which of the (1 << BYTEWIDTH) possible +/* Compute a fastmap for the compiled pattern in BUFP. + A fastmap records which of the (1 << BYTEWIDTH) possible characters can start a string that matches the pattern. This fastmap is used by re_search to skip quickly over impossible starting points. @@ -3106,10 +3097,8 @@ analyze_first (re_char *p, re_char *pend, char *fastmap, The caller must supply the address of a (1 << BYTEWIDTH)-byte data area as BUFP->fastmap. - We set the `fastmap', `fastmap_accurate', and `can_be_null' fields in - the pattern buffer. - - Returns 0 if we succeed, -2 if an internal error. */ + Set the 'fastmap', 'fastmap_accurate', and 'can_be_null' fields in + the pattern buffer. */ static void re_compile_fastmap (struct re_pattern_buffer *bufp) @@ -3197,13 +3186,14 @@ re_search (struct re_pattern_buffer *bufp, const char *string, size_t size, Do not consider matching one past the index STOP in the virtual concatenation of STRING1 and STRING2. - We return either the position in the strings at which the match was + Return either the position in the strings at which the match was found, -1 if no match, or -2 if error (such as failure stack overflow). */ ptrdiff_t re_search_2 (struct re_pattern_buffer *bufp, const char *str1, size_t size1, - const char *str2, size_t size2, ptrdiff_t startpos, ptrdiff_t range, + const char *str2, size_t size2, + ptrdiff_t startpos, ptrdiff_t range, struct re_registers *regs, ptrdiff_t stop) { ptrdiff_t val; @@ -3267,7 +3257,7 @@ re_search_2 (struct re_pattern_buffer *bufp, const char *str1, size_t size1, { /* If the pattern is anchored, skip quickly past places we cannot match. - We don't bother to treat startpos == 0 specially + Don't bother to treat startpos == 0 specially because that case doesn't repeat. */ if (anchored_start && startpos > 0) { @@ -3295,7 +3285,7 @@ re_search_2 (struct re_pattern_buffer *bufp, const char *str1, size_t size1, if (startpos < size1 && startpos + range >= size1) lim = range - (size1 - startpos); - /* Written out as an if-else to avoid testing `translate' + /* Written out as an if-else to avoid testing 'translate' inside the loop. */ if (!NILP (translate)) { @@ -3440,8 +3430,8 @@ static int bcmp_translate (re_char *s1, re_char *s2, Lisp_Object translate, const int multibyte); -/* This converts PTR, a pointer into one of the search strings `string1' - and `string2' into an offset from the beginning of that string. */ +/* This converts PTR, a pointer into one of the search strings 'string1' + and 'string2' into an offset from the beginning of that string. */ #define POINTER_TO_OFFSET(ptr) \ (FIRST_STRING_P (ptr) \ ? (ptr) - string1 \ @@ -3465,7 +3455,7 @@ static int bcmp_translate (re_char *s1, re_char *s2, /* Call before fetching a char with *d if you already checked other limits. This is meant for use in lookahead operations like wordend, etc.. where we might need to look at parts of the string that might be - outside of the LIMITs (i.e past `stop'). */ + outside of the LIMITs (i.e past 'stop'). */ #define PREFETCH_NOLIMIT() \ if (d == end1) \ { \ @@ -3474,7 +3464,7 @@ static int bcmp_translate (re_char *s1, re_char *s2, } \ /* Test if at very beginning or at very end of the virtual concatenation - of `string1' and `string2'. If only one string, it's `string2'. */ + of STRING1 and STRING2. If only one string, it's STRING2. */ #define AT_STRINGS_BEG(d) ((d) == (size1 ? string1 : string2) || !size2) #define AT_STRINGS_END(d) ((d) == end2) @@ -3599,7 +3589,7 @@ execute_charset (re_char **pp, unsigned c, unsigned corig, bool unibyte) if (unibyte && c < (1 << BYTEWIDTH)) { /* Lookup bitmap. */ - /* Cast to `unsigned' instead of `unsigned char' in + /* Cast to 'unsigned' instead of 'unsigned char' in case the bit list is a full 32 bytes long. */ if (c < (unsigned) (CHARSET_BITMAP_SIZE (p) * BYTEWIDTH) && p[2 + c / BYTEWIDTH] & (1 << (c % BYTEWIDTH))) @@ -3700,7 +3690,7 @@ mutually_exclusive_p (struct re_pattern_buffer *bufp, re_char *p1, else if ((re_opcode_t) *p1 == charset || (re_opcode_t) *p1 == charset_not) { - if (!execute_charset (&p1, c, c, !multibyte || IS_REAL_ASCII (c))) + if (!execute_charset (&p1, c, c, !multibyte || ASCII_CHAR_P (c))) { DEBUG_PRINT (" No match => fast loop.\n"); return 1; @@ -3727,10 +3717,10 @@ mutually_exclusive_p (struct re_pattern_buffer *bufp, re_char *p1, else if (!multibyte || !CHARSET_RANGE_TABLE_EXISTS_P (p2)) { /* Now, we are sure that P2 has no range table. - So, for the size of bitmap in P2, `p2[1]' is + So, for the size of bitmap in P2, 'p2[1]' is enough. But P1 may have range table, so the size of bitmap table of P1 is extracted by - using macro `CHARSET_BITMAP_SIZE'. + using macro 'CHARSET_BITMAP_SIZE'. In a multibyte case, we know that all the character listed in P2 is ASCII. In a unibyte case, P1 has only a @@ -3934,11 +3924,11 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, unsigned best_regs_set = false; re_char **best_regstart UNINIT, **best_regend UNINIT; - /* Logically, this is `best_regend[0]'. But we don't want to have to + /* Logically, this is 'best_regend[0]'. But we don't want to have to allocate space for that if we're not allocating space for anything else (see below). Also, we never need info about register 0 for any of the other register vectors, and it seems rather a kludge to - treat `best_regend' differently than the rest. So we keep track of + treat 'best_regend' differently than the rest. So we keep track of the end of the best match so far in a separate variable. We initialize this to NULL so that when we backtrack the first time and need to test it, it's not garbage. */ @@ -3981,8 +3971,8 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, for (reg = 1; reg < num_regs; reg++) regstart[reg] = regend[reg] = NULL; - /* We move `string1' into `string2' if the latter's empty -- but not if - `string1' is null. */ + /* We move 'string1' into 'string2' if the latter's empty -- but not if + 'string1' is null. */ if (size2 == 0 && string1 != NULL) { string2 = string1; @@ -3993,12 +3983,12 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, end1 = string1 + size1; end2 = string2 + size2; - /* `p' scans through the pattern as `d' scans through the data. - `dend' is the end of the input string that `d' points within. `d' - is advanced into the following input string whenever necessary, but + /* P scans through the pattern as D scans through the data. + DEND is the end of the input string that D points within. + Advance D into the following input string whenever necessary, but this happens before fetching; therefore, at the beginning of the - loop, `d' can be pointing at the end of a string, but it cannot - equal `string2'. */ + loop, D can be pointing at the end of a string, but it cannot + equal STRING2. */ if (pos >= size1) { /* Only match within string2. */ @@ -4015,7 +4005,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, /* BEWARE! When we reach end_match_1, PREFETCH normally switches to string2. But in the present case, this means that just doing a PREFETCH - makes us jump from `stop' to `gap' within the string. + makes us jump from 'stop' to 'gap' within the string. What we really want here is for the search to stop as soon as we hit end_match_1. That's why we set end_match_2 to end_match_1 (since PREFETCH fails as soon as we hit @@ -4023,8 +4013,8 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, end_match_2 = end_match_1; } else - { /* It's important to use this code when stop == size so that - moving `d' from end1 to string2 will not prevent the d == dend + { /* It's important to use this code when STOP == SIZE so that + moving D from end1 to string2 will not prevent the D == DEND check from catching the end of string. */ end_match_1 = end1; end_match_2 = string2 + stop - size1; @@ -4100,10 +4090,10 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, else if (best_regs_set && !best_match_p) { restore_best_regs: - /* Restore best match. It may happen that `dend == + /* Restore best match. It may happen that 'dend == end_match_1' while the restored d is in string2. - For example, the pattern `x.*y.*z' against the - strings `x-' and `y-z-', if the two strings are + For example, the pattern 'x.*y.*z' against the + strings 'x-' and 'y-z-', if the two strings are not consecutive in memory. */ DEBUG_PRINT ("Restoring best registers.\n"); @@ -4128,7 +4118,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, /* Have the register data arrays been allocated? */ if (bufp->regs_allocated == REGS_UNALLOCATED) { /* No. So allocate them with malloc. We need one - extra element beyond `num_regs' for the `-1' marker + extra element beyond 'num_regs' for the '-1' marker GNU code uses. */ regs->num_regs = max (RE_NREGS, num_regs + 1); regs->start = TALLOC (regs->num_regs, ptrdiff_t); @@ -4149,7 +4139,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, else eassert (bufp->regs_allocated == REGS_FIXED); - /* Convert the pointer data in `regstart' and `regend' to + /* Convert the pointer data in 'regstart' and 'regend' to indices. Register zero has to be set differently, since we haven't kept track of any info for it. */ if (regs->num_regs > 0) @@ -4158,7 +4148,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, regs->end[0] = POINTER_TO_OFFSET (d); } - /* Go through the first `min (num_regs, regs->num_regs)' + /* Go through the first 'min (num_regs, regs->num_regs)' registers, since that is all we initialized. */ for (reg = 1; reg < min (num_regs, regs->num_regs); reg++) { @@ -4216,7 +4206,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, /* Remember the start point to rollback upon failure. */ dfail = d; - /* The cost of testing `translate' is comparatively small. */ + /* The cost of testing 'translate' is comparatively small. */ if (target_multibyte) do { @@ -4405,7 +4395,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, break; - /* \ has been turned into a `duplicate' command which is + /* \ has been turned into a 'duplicate' command which is followed by the numeric value of as the register number. */ case duplicate: { @@ -4520,21 +4510,21 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, goto fail; - /* on_failure_keep_string_jump is used to optimize `.*\n'. It + /* on_failure_keep_string_jump is used to optimize '.*\n'. It pushes NULL as the value for the string on the stack. Then - `POP_FAILURE_POINT' will keep the current value for the + 'POP_FAILURE_POINT' will keep the current value for the string, instead of restoring it. To see why, consider - matching `foo\nbar' against `.*\n'. The .* matches the foo; + matching 'foo\nbar' against '.*\n'. The .* matches the foo; then the . fails against the \n. But the next thing we want to do is match the \n against the \n; if we restored the string value, we would be back at the foo. Because this is used only in specific cases, we don't need to - check all the things that `on_failure_jump' does, to make + check all the things that 'on_failure_jump' does, to make sure the right things get saved on the stack. Hence we don't share its code. The only reason to push anything on the stack at all is that otherwise we would have to change - `anychar's code to do something besides goto fail in this + 'anychar's code to do something besides goto fail in this case; that seems worse than this. */ case on_failure_keep_string_jump: EXTRACT_NUMBER_AND_INCR (mcnt, p); @@ -4588,7 +4578,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, CHECK_INFINITE_LOOP (p - 3, d); if (cycle) /* If there's a cycle, get out of the loop, as if the matching - had failed. We used to just `goto fail' here, but that was + had failed. We used to just 'goto fail' here, but that was aborting the search a bit too early: we want to keep the empty-loop-match and keep matching after the loop. We want (x?)*y\1z to match both xxyz and xxyxz. */ @@ -4623,7 +4613,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, Compare the beginning of the repeat with what in the pattern follows its end. If we can establish that there is nothing that they would both match, i.e., that we - would have to backtrack because of (as in, e.g., `a*a') + would have to backtrack because of (as in, e.g., 'a*a') then we can use a non-backtracking loop based on on_failure_keep_string_jump instead of on_failure_jump. */ case on_failure_jump_smart: @@ -4648,14 +4638,14 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, DEBUG_STATEMENT (regex_emacs_debug += 2); if (mutually_exclusive_p (bufp, p1, p2)) { - /* Use a fast `on_failure_keep_string_jump' loop. */ + /* Use a fast 'on_failure_keep_string_jump' loop. */ DEBUG_PRINT (" smart exclusive => fast loop.\n"); *p3 = (unsigned char) on_failure_keep_string_jump; STORE_NUMBER (p2 - 2, mcnt + 3); } else { - /* Default to a safe `on_failure_jump' loop. */ + /* Default to a safe 'on_failure_jump' loop. */ DEBUG_PRINT (" smart default => slow loop.\n"); *p3 = (unsigned char) on_failure_jump; } @@ -4675,7 +4665,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, /* Have to succeed matching what follows at least n times. - After that, handle like `on_failure_jump'. */ + After that, handle like 'on_failure_jump'. */ case succeed_n: /* Signedness doesn't matter since we only compare MCNT to 0. */ EXTRACT_NUMBER (mcnt, p + 2); @@ -5054,7 +5044,7 @@ bcmp_translate (re_char *s1, re_char *s2, ptrdiff_t len, re_char *p2_end = s2 + len; /* FIXME: Checking both p1 and p2 presumes that the two strings might have - different lengths, but relying on a single `len' would break this. -sm */ + different lengths, but relying on a single LEN would break this. -sm */ while (p1 < p1_end && p2 < p2_end) { int p1_charlen, p2_charlen; @@ -5082,7 +5072,7 @@ bcmp_translate (re_char *s1, re_char *s2, ptrdiff_t len, compiles PATTERN (of length SIZE) and puts the result in BUFP. Returns 0 if the pattern was valid, otherwise an error string. - Assumes the `allocated' (and perhaps `buffer') and `translate' fields + Assumes the 'allocated' (and perhaps 'buffer') and 'translate' fields are set in BUFP on entry. We call regex_compile to do the actual compilation. */ diff --git a/src/regex-emacs.h b/src/regex-emacs.h index b6dd26b2f4..a849cbea05 100644 --- a/src/regex-emacs.h +++ b/src/regex-emacs.h @@ -1,5 +1,4 @@ -/* Definitions for data structures and routines for the regular - expression library, version 0.12. +/* Emacs regular expression API Copyright (C) 1985, 1989-1993, 1995, 2000-2018 Free Software Foundation, Inc. @@ -22,8 +21,7 @@ #include -/* This is the structure we store register match data in. See - regex.texinfo for a full description of what registers match. +/* This is the structure we store register match data in. Declare this before including lisp.h, since lisp.h (via thread.h) uses struct re_registers. */ struct re_registers @@ -35,12 +33,12 @@ struct re_registers #include "lisp.h" -/* In Emacs, this is the string or buffer in which we are matching. +/* The string or buffer being matched. It is used for looking up syntax properties. - If the value is a Lisp string object, we are matching text in that - string; if it's nil, we are matching text in the current buffer; if - it's t, we are matching text in a C string. + If the value is a Lisp string object, match text in that string; if + it's nil, match text in the current buffer; if it's t, match text + in a C string. This value is effectively another parameter to re_search_2 and re_match_2. No calls into Lisp or thread switches are allowed @@ -58,25 +56,25 @@ extern size_t emacs_re_max_failures; extern ptrdiff_t emacs_re_safe_alloca; /* This data structure represents a compiled pattern. Before calling - the pattern compiler, the fields `buffer', `allocated', `fastmap', - and `translate' can be set. After the pattern has been - compiled, the `re_nsub' field is available. All other fields are + the pattern compiler, the fields 'buffer', 'allocated', 'fastmap', + and 'translate' can be set. After the pattern has been + compiled, the 're_nsub' field is available. All other fields are private to the regex routines. */ struct re_pattern_buffer { /* Space that holds the compiled pattern. It is declared as - `unsigned char *' because its elements are + 'unsigned char *' because its elements are sometimes used as array indexes. */ unsigned char *buffer; - /* Number of bytes to which `buffer' points. */ + /* Number of bytes to which 'buffer' points. */ size_t allocated; - /* Number of bytes actually used in `buffer'. */ + /* Number of bytes actually used in 'buffer'. */ size_t used; - /* Charset of unibyte characters at compiling time. */ + /* Charset of unibyte characters at compiling time. */ int charset_unibyte; /* Pointer to a fastmap, if any, otherwise zero. re_search uses @@ -86,31 +84,31 @@ struct re_pattern_buffer /* Either a translate table to apply to all characters before comparing them, or zero for no translation. The translation - is applied to a pattern when it is compiled and to a string + applies to a pattern when it is compiled and to a string when it is matched. */ Lisp_Object translate; /* Number of subexpressions found by the compiler. */ size_t re_nsub; - /* Zero if this pattern cannot match the empty string, one else. - Well, in truth it's used only in `re_search_2', to see + /* True if and only if this pattern can match the empty string. + Well, in truth it's used only in 're_search_2', to see whether or not we should use the fastmap, so we don't set - this absolutely perfectly; see `re_compile_fastmap'. */ + this absolutely perfectly; see 're_compile_fastmap'. */ unsigned can_be_null : 1; - /* If REGS_UNALLOCATED, allocate space in the `regs' structure - for `max (RE_NREGS, re_nsub + 1)' groups. + /* If REGS_UNALLOCATED, allocate space in the 'regs' structure + for 'max (RE_NREGS, re_nsub + 1)' groups. If REGS_REALLOCATE, reallocate space if necessary. If REGS_FIXED, use what's there. */ unsigned regs_allocated : 2; - /* Set to zero when `regex_compile' compiles a pattern; set to one - by `re_compile_fastmap' if it updates the fastmap. */ + /* Set to false when 'regex_compile' compiles a pattern; set to true + by 're_compile_fastmap' if it updates the fastmap. */ unsigned fastmap_accurate : 1; /* If true, the compilation of the pattern had to look up the syntax table, - so the compiled pattern is only valid for the current syntax table. */ + so the compiled pattern is valid for the current syntax table only. */ unsigned used_syntax : 1; /* If true, multi-byte form in the regexp pattern should be @@ -125,7 +123,7 @@ struct re_pattern_buffer /* Declarations for routines. */ /* Compile the regular expression PATTERN, with length LENGTH - and syntax given by the global `re_syntax_options', into the buffer + and syntax given by the global 're_syntax_options', into the buffer BUFFER. Return NULL if successful, and an error string if not. */ extern const char *re_compile_pattern (const char *pattern, size_t length, bool posix_backtracking, @@ -137,14 +135,14 @@ extern const char *re_compile_pattern (const char *pattern, size_t length, compiled into BUFFER. Start searching at position START, for RANGE characters. Return the starting position of the match, -1 for no match, or -2 for an internal error. Also return register - information in REGS (if REGS is nonzero). */ + information in REGS (if REGS is non-null). */ extern ptrdiff_t re_search (struct re_pattern_buffer *buffer, const char *string, size_t length, ptrdiff_t start, ptrdiff_t range, struct re_registers *regs); -/* Like `re_search', but search in the concatenation of STRING1 and +/* Like 're_search', but search in the concatenation of STRING1 and STRING2. Also, stop searching at index START + STOP. */ extern ptrdiff_t re_search_2 (struct re_pattern_buffer *buffer, const char *string1, size_t length1, @@ -166,7 +164,7 @@ extern ptrdiff_t re_match_2 (struct re_pattern_buffer *buffer, /* Set REGS to hold NUM_REGS registers, storing them in STARTS and ENDS. Subsequent matches using BUFFER and REGS will use this memory for recording register information. STARTS and ENDS must be - allocated with malloc, and must each be at least `NUM_REGS * sizeof + allocated with malloc, and must each be at least 'NUM_REGS * sizeof (ptrdiff_t)' bytes long. If NUM_REGS == 0, then subsequent matches should allocate their own @@ -196,4 +194,4 @@ extern bool re_iswctype (int ch, re_wctype_t cc); extern re_wctype_t re_wctype_parse (const unsigned char **strp, unsigned limit); -#endif /* regex-emacs.h */ +#endif /* EMACS_REGEX_H */ commit e097826f8972c78577d1d5a14389ec8e888be1b7 Author: Paul Eggert Date: Sun Aug 5 18:41:21 2018 -0700 Remove always-0 struct re_pattern_buffer members * src/regex-emacs.h (struct re_pattern_buffer): Remove no_sub, not_bol, not_eol. They are always zero. All uses removed, and code simplified. diff --git a/src/regex-emacs.c b/src/regex-emacs.c index 1ceb67ad29..b944fe0c5a 100644 --- a/src/regex-emacs.c +++ b/src/regex-emacs.c @@ -762,9 +762,6 @@ print_compiled_pattern (struct re_pattern_buffer *bufp) printf ("re_nsub: %zu\t", bufp->re_nsub); printf ("regs_alloc: %d\t", bufp->regs_allocated); printf ("can_be_null: %d\t", bufp->can_be_null); - printf ("no_sub: %d\t", bufp->no_sub); - printf ("not_bol: %d\t", bufp->not_bol); - printf ("not_eol: %d\t", bufp->not_eol); #ifndef emacs printf ("syntax: %lx\n", bufp->syntax); #endif @@ -1683,7 +1680,6 @@ static bool group_in_compile_stack (compile_stack_type, regnum_t); `used' is set to the length of the compiled pattern; `fastmap_accurate' is zero; `re_nsub' is the number of subexpressions in PATTERN; - `not_bol' and `not_eol' are zero; The `fastmap' field is neither examined nor set. */ @@ -1787,7 +1783,6 @@ regex_compile (re_char *pattern, size_t size, /* Initialize the pattern buffer. */ bufp->fastmap_accurate = 0; - bufp->not_bol = bufp->not_eol = 0; bufp->used_syntax = 0; /* Set `used' to zero, so that if we return an error, the pattern @@ -1795,7 +1790,6 @@ regex_compile (re_char *pattern, size_t size, at the end. */ bufp->used = 0; - /* Always count groups, whether or not bufp->no_sub is set. */ bufp->re_nsub = 0; if (bufp->allocated == 0) @@ -3841,9 +3835,8 @@ mutually_exclusive_p (struct re_pattern_buffer *bufp, re_char *p1, and SIZE2, respectively). We start matching at POS, and stop matching at STOP. - If REGS is non-null and the `no_sub' field of BUFP is nonzero, we - store offsets for the substring each group matched in REGS. See the - documentation for exactly how many groups we fill. + If REGS is non-null, store offsets for the substring each group + matched in REGS. We return -1 if no match, -2 if an internal error (such as the failure stack overflowing). Otherwise, we return the length of the @@ -4130,7 +4123,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, DEBUG_PRINT ("Accepting match.\n"); /* If caller wants register contents data back, do it. */ - if (regs && !bufp->no_sub) + if (regs) { /* Have the register data arrays been allocated? */ if (bufp->regs_allocated == REGS_UNALLOCATED) @@ -4185,7 +4178,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, -1 at the end. */ for (reg = num_regs; reg < regs->num_regs; reg++) regs->start[reg] = regs->end[reg] = -1; - } /* regs && !bufp->no_sub */ + } DEBUG_PRINT ("%u failure points pushed, %u popped (%u remain).\n", nfailure_points_pushed, nfailure_points_popped, @@ -4482,15 +4475,13 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, break; - /* begline matches the empty string at the beginning of the string - (unless `not_bol' is set in `bufp'), and after newlines. */ + /* begline matches the empty string at the beginning of the string, + and after newlines. */ case begline: DEBUG_PRINT ("EXECUTING begline.\n"); if (AT_STRINGS_BEG (d)) - { - if (!bufp->not_bol) break; - } + break; else { unsigned c; @@ -4498,7 +4489,6 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, if (c == '\n') break; } - /* In all other cases, we fail. */ goto fail; @@ -4507,15 +4497,10 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, DEBUG_PRINT ("EXECUTING endline.\n"); if (AT_STRINGS_END (d)) - { - if (!bufp->not_eol) break; - } - else - { - PREFETCH_NOLIMIT (); - if (*d == '\n') - break; - } + break; + PREFETCH_NOLIMIT (); + if (*d == '\n') + break; goto fail; @@ -5113,11 +5098,6 @@ re_compile_pattern (const char *pattern, size_t length, (and at least one extra will be -1). */ bufp->regs_allocated = REGS_UNALLOCATED; - /* And GNU code determines whether or not to get register information - by passing null for the REGS argument to re_search, etc., not by - setting no_sub. */ - bufp->no_sub = 0; - ret = regex_compile ((re_char *) pattern, length, posix_backtracking, whitespace_regexp, diff --git a/src/regex-emacs.h b/src/regex-emacs.h index 159c7dcb9b..b6dd26b2f4 100644 --- a/src/regex-emacs.h +++ b/src/regex-emacs.h @@ -59,7 +59,7 @@ extern ptrdiff_t emacs_re_safe_alloca; /* This data structure represents a compiled pattern. Before calling the pattern compiler, the fields `buffer', `allocated', `fastmap', - `translate', and `no_sub' can be set. After the pattern has been + and `translate' can be set. After the pattern has been compiled, the `re_nsub' field is available. All other fields are private to the regex routines. */ @@ -109,17 +109,6 @@ struct re_pattern_buffer by `re_compile_fastmap' if it updates the fastmap. */ unsigned fastmap_accurate : 1; - /* If set, `re_match_2' does not return information about - subexpressions. */ - unsigned no_sub : 1; - - /* If set, a beginning-of-line anchor doesn't match at the - beginning of the string. */ - unsigned not_bol : 1; - - /* Similarly for an end-of-line anchor. */ - unsigned not_eol : 1; - /* If true, the compilation of the pattern had to look up the syntax table, so the compiled pattern is only valid for the current syntax table. */ unsigned used_syntax : 1; @@ -148,7 +137,7 @@ extern const char *re_compile_pattern (const char *pattern, size_t length, compiled into BUFFER. Start searching at position START, for RANGE characters. Return the starting position of the match, -1 for no match, or -2 for an internal error. Also return register - information in REGS (if REGS and BUFFER->no_sub are nonzero). */ + information in REGS (if REGS is nonzero). */ extern ptrdiff_t re_search (struct re_pattern_buffer *buffer, const char *string, size_t length, ptrdiff_t start, ptrdiff_t range, commit 03dfb6061bfd78d74564d678213ef95728a5f9eb Author: Paul Eggert Date: Sun Aug 5 18:41:20 2018 -0700 Simplify regex-emacs by assuming Emacs syntax * src/regex-emacs.c (reg_syntax_t) (RE_BACKSLASH_ESCAPE_IN_LISTS, RE_BK_PLUS_QM) (RE_CHAR_CLASSES, RE_CONTEXT_INDEP_ANCHORS) (RE_CONTEXT_INDEP_OPS, RE_CONTEXT_INVALID_OPS) (RE_DOT_NEWLINE, RE_DOT_NOT_NULL, RE_HAT_LISTS_NOT_NEWLINE) (RE_INTERVALS, RE_LIMITED_OPS, RE_NEWLINE_ALT) (RE_NO_BK_BRACES, RE_NO_BK_PARENS, RE_NO_BK_REFS) (RE_NO_BK_VBAR, RE_NO_EMPTY_RANGES) (RE_UNMATCHED_RIGHT_PAREN_ORD, RE_NO_POSIX_BACKTRACKING) (RE_NO_GNU_OPS, RE_FRUGAL, RE_SHY_GROUPS) (RE_NO_NEWLINE_ANCHOR, RE_SYNTAX_EMACS, RE_TRANSLATE_P): Remove. All uses removed and resulting code simplified. (TRANSLATE): Treat nil as an absent translation table, not zero. All uses changed. diff --git a/src/regex-emacs.c b/src/regex-emacs.c index eb5970ffcf..1ceb67ad29 100644 --- a/src/regex-emacs.c +++ b/src/regex-emacs.c @@ -50,133 +50,6 @@ ints. But Emacs only runs on 32 bit platforms anyway. */ #define RE_DUP_MAX (0xffff) -/* The following bits are used to determine the regexp syntax we - recognize. The set/not-set meanings where historically chosen so - that Emacs syntax had the value 0. - The bits are given in alphabetical order, and - the definitions shifted by one from the previous bit; thus, when we - add or remove a bit, only one other definition need change. */ -typedef unsigned long reg_syntax_t; - -/* If this bit is not set, then \ inside a bracket expression is literal. - If set, then such a \ quotes the following character. */ -#define RE_BACKSLASH_ESCAPE_IN_LISTS ((unsigned long int) 1) - -/* If this bit is not set, then + and ? are operators, and \+ and \? are - literals. - If set, then \+ and \? are operators and + and ? are literals. */ -#define RE_BK_PLUS_QM (RE_BACKSLASH_ESCAPE_IN_LISTS << 1) - -/* If this bit is set, then character classes are supported. They are: - [:alpha:], [:upper:], [:lower:], [:digit:], [:alnum:], [:xdigit:], - [:space:], [:print:], [:punct:], [:graph:], and [:cntrl:]. - If not set, then character classes are not supported. */ -#define RE_CHAR_CLASSES (RE_BK_PLUS_QM << 1) - -/* If this bit is set, then ^ and $ are always anchors (outside bracket - expressions, of course). - If this bit is not set, then it depends: - ^ is an anchor if it is at the beginning of a regular - expression or after an open-group or an alternation operator; - $ is an anchor if it is at the end of a regular expression, or - before a close-group or an alternation operator. - - This bit could be (re)combined with RE_CONTEXT_INDEP_OPS, because - POSIX draft 11.2 says that * etc. in leading positions is undefined. - We already implemented a previous draft which made those constructs - invalid, though, so we haven't changed the code back. */ -#define RE_CONTEXT_INDEP_ANCHORS (RE_CHAR_CLASSES << 1) - -/* If this bit is set, then special characters are always special - regardless of where they are in the pattern. - If this bit is not set, then special characters are special only in - some contexts; otherwise they are ordinary. Specifically, - * + ? and intervals are only special when not after the beginning, - open-group, or alternation operator. */ -#define RE_CONTEXT_INDEP_OPS (RE_CONTEXT_INDEP_ANCHORS << 1) - -/* If this bit is set, then *, +, ?, and { cannot be first in an re or - immediately after an alternation or begin-group operator. */ -#define RE_CONTEXT_INVALID_OPS (RE_CONTEXT_INDEP_OPS << 1) - -/* If this bit is set, then . matches newline. - If not set, then it doesn't. */ -#define RE_DOT_NEWLINE (RE_CONTEXT_INVALID_OPS << 1) - -/* If this bit is set, then . doesn't match NUL. - If not set, then it does. */ -#define RE_DOT_NOT_NULL (RE_DOT_NEWLINE << 1) - -/* If this bit is set, nonmatching lists [^...] do not match newline. - If not set, they do. */ -#define RE_HAT_LISTS_NOT_NEWLINE (RE_DOT_NOT_NULL << 1) - -/* If this bit is set, either \{...\} or {...} defines an - interval, depending on RE_NO_BK_BRACES. - If not set, \{, \}, {, and } are literals. */ -#define RE_INTERVALS (RE_HAT_LISTS_NOT_NEWLINE << 1) - -/* If this bit is set, +, ? and | aren't recognized as operators. - If not set, they are. */ -#define RE_LIMITED_OPS (RE_INTERVALS << 1) - -/* If this bit is set, newline is an alternation operator. - If not set, newline is literal. */ -#define RE_NEWLINE_ALT (RE_LIMITED_OPS << 1) - -/* If this bit is set, then `{...}' defines an interval, and \{ and \} - are literals. - If not set, then `\{...\}' defines an interval. */ -#define RE_NO_BK_BRACES (RE_NEWLINE_ALT << 1) - -/* If this bit is set, (...) defines a group, and \( and \) are literals. - If not set, \(...\) defines a group, and ( and ) are literals. */ -#define RE_NO_BK_PARENS (RE_NO_BK_BRACES << 1) - -/* If this bit is set, then \ matches . - If not set, then \ is a back-reference. */ -#define RE_NO_BK_REFS (RE_NO_BK_PARENS << 1) - -/* If this bit is set, then | is an alternation operator, and \| is literal. - If not set, then \| is an alternation operator, and | is literal. */ -#define RE_NO_BK_VBAR (RE_NO_BK_REFS << 1) - -/* If this bit is set, then an ending range point collating higher - than the starting range point, as in [z-a], is invalid. - If not set, then when ending range point collates higher than the - starting range point, the range is ignored. */ -#define RE_NO_EMPTY_RANGES (RE_NO_BK_VBAR << 1) - -/* If this bit is set, then an unmatched ) is ordinary. - If not set, then an unmatched ) is invalid. */ -#define RE_UNMATCHED_RIGHT_PAREN_ORD (RE_NO_EMPTY_RANGES << 1) - -/* If this bit is set, succeed as soon as we match the whole pattern, - without further backtracking. */ -#define RE_NO_POSIX_BACKTRACKING (RE_UNMATCHED_RIGHT_PAREN_ORD << 1) - -/* If this bit is set, do not process the GNU regex operators. - If not set, then the GNU regex operators are recognized. */ -#define RE_NO_GNU_OPS (RE_NO_POSIX_BACKTRACKING << 1) - -/* If this bit is set, then *?, +? and ?? match non greedily. */ -#define RE_FRUGAL (RE_NO_GNU_OPS << 1) - -/* If this bit is set, then (?:...) is treated as a shy group. */ -#define RE_SHY_GROUPS (RE_FRUGAL << 1) - -/* If this bit is set, ^ and $ only match at beg/end of buffer. */ -#define RE_NO_NEWLINE_ANCHOR (RE_SHY_GROUPS << 1) - -/* This global variable defines the particular regexp syntax to use (for - some interfaces). When a regexp is compiled, the syntax used is - stored in the pattern buffer, so changing this does not affect - already-compiled regexps. */ -/* extern reg_syntax_t re_syntax_options; */ -/* Define combinations of the above bits for the standard possibilities. */ -#define RE_SYNTAX_EMACS \ - (RE_CHAR_CLASSES | RE_INTERVALS | RE_SHY_GROUPS | RE_FRUGAL) - /* Make syntax table lookup grant data in gl_state. */ #define SYNTAX(c) syntax_property (c, 1) @@ -1299,10 +1172,8 @@ static void insert_op1 (re_opcode_t op, unsigned char *loc, int arg, unsigned char *end); static void insert_op2 (re_opcode_t op, unsigned char *loc, int arg1, int arg2, unsigned char *end); -static bool at_begline_loc_p (re_char *pattern, re_char *p, - reg_syntax_t syntax); -static bool at_endline_loc_p (re_char *p, re_char *pend, - reg_syntax_t syntax); +static bool at_begline_loc_p (re_char *pattern, re_char *p); +static bool at_endline_loc_p (re_char *p, re_char *pend); static re_char *skip_one_char (re_char *p); static int analyze_first (re_char *p, re_char *pend, char *fastmap, const int multibyte); @@ -1319,15 +1190,7 @@ static int analyze_first (re_char *p, re_char *pend, #define RE_TRANSLATE(TBL, C) char_table_translate (TBL, C) -#define RE_TRANSLATE_P(TBL) (!EQ (TBL, make_number (0))) - -/* If `translate' is non-zero, return translate[D], else just D. We - cast the subscript to translate because some data is declared as - `char *', to avoid warnings when a string constant is passed. But - when we use a character as a subscript we must make it unsigned. */ -#define TRANSLATE(d) \ - (RE_TRANSLATE_P (translate) ? RE_TRANSLATE (translate, (d)) : (d)) - +#define TRANSLATE(d) (!NILP (translate) ? RE_TRANSLATE (translate, d) : (d)) /* Macros for outputting the compiled pattern into `buffer'. */ @@ -1847,8 +1710,6 @@ regex_compile (re_char *pattern, size_t size, const char *whitespace_regexp, struct re_pattern_buffer *bufp) { - reg_syntax_t syntax = RE_SYNTAX_EMACS; - /* We fetch characters from PATTERN here. */ int c, c1; @@ -2011,51 +1872,24 @@ regex_compile (re_char *pattern, size_t size, } case '^': - { - if ( /* If at start of pattern, it's an operator. */ - p == pattern + 1 - /* If context independent, it's an operator. */ - || syntax & RE_CONTEXT_INDEP_ANCHORS - /* Otherwise, depends on what's come before. */ - || at_begline_loc_p (pattern, p, syntax)) - BUF_PUSH ((syntax & RE_NO_NEWLINE_ANCHOR) ? begbuf : begline); - else - goto normal_char; - } + if (! (p == pattern + 1 || at_begline_loc_p (pattern, p))) + goto normal_char; + BUF_PUSH (begline); break; - case '$': - { - if ( /* If at end of pattern, it's an operator. */ - p == pend - /* If context independent, it's an operator. */ - || syntax & RE_CONTEXT_INDEP_ANCHORS - /* Otherwise, depends on what's next. */ - || at_endline_loc_p (p, pend, syntax)) - BUF_PUSH ((syntax & RE_NO_NEWLINE_ANCHOR) ? endbuf : endline); - else - goto normal_char; - } - break; + if (! (p == pend || at_endline_loc_p (p, pend))) + goto normal_char; + BUF_PUSH (endline); + break; case '+': case '?': - if ((syntax & RE_BK_PLUS_QM) - || (syntax & RE_LIMITED_OPS)) - goto normal_char; - FALLTHROUGH; case '*': - handle_plus: /* If there is no previous pattern... */ if (!laststart) - { - if (syntax & RE_CONTEXT_INVALID_OPS) - FREE_STACK_RETURN (REG_BADRPT); - else if (!(syntax & RE_CONTEXT_INDEP_OPS)) - goto normal_char; - } + goto normal_char; { /* 1 means zero (many) matches is allowed. */ @@ -2069,8 +1903,7 @@ regex_compile (re_char *pattern, size_t size, for (;;) { - if ((syntax & RE_FRUGAL) - && c == '?' && (zero_times_ok || many_times_ok)) + if (c == '?' && (zero_times_ok || many_times_ok)) greedy = false; else { @@ -2078,25 +1911,10 @@ regex_compile (re_char *pattern, size_t size, many_times_ok |= c != '?'; } - if (p == pend) - break; - else if (*p == '*' - || (!(syntax & RE_BK_PLUS_QM) - && (*p == '+' || *p == '?'))) - ; - else if (syntax & RE_BK_PLUS_QM && *p == '\\') - { - if (p+1 == pend) - FREE_STACK_RETURN (REG_EESCAPE); - if (p[1] == '+' || p[1] == '?') - PATFETCH (c); /* Gobble up the backslash. */ - else - break; - } - else + if (! (p < pend && (*p == '*' || *p == '+' || *p == '?'))) break; /* If we get here, we found another repeat character. */ - PATFETCH (c); + c = *p++; } /* Star, etc. applied to an empty pattern is equivalent @@ -2228,24 +2046,18 @@ regex_compile (re_char *pattern, size_t size, /* Clear the whole map. */ memset (b, 0, (1 << BYTEWIDTH) / BYTEWIDTH); - /* charset_not matches newline according to a syntax bit. */ - if ((re_opcode_t) b[-2] == charset_not - && (syntax & RE_HAT_LISTS_NOT_NEWLINE)) - SET_LIST_BIT ('\n'); - /* Read in characters and ranges, setting map bits. */ for (;;) { const unsigned char *p2 = p; - re_wctype_t cc; int ch; if (p == pend) FREE_STACK_RETURN (REG_EBRACK); /* See if we're at the beginning of a possible character class. */ - if (syntax & RE_CHAR_CLASSES && - (cc = re_wctype_parse(&p, pend - p)) != -1) + re_wctype_t cc = re_wctype_parse (&p, pend - p); + if (cc != -1) { if (cc == 0) FREE_STACK_RETURN (REG_ECTYPE); @@ -2297,21 +2109,11 @@ regex_compile (re_char *pattern, size_t size, (let ((case-fold-search t)) (string-match "[A-_]" "A")) */ PATFETCH (c); - /* \ might escape characters inside [...] and [^...]. */ - if ((syntax & RE_BACKSLASH_ESCAPE_IN_LISTS) && c == '\\') - { - if (p == pend) FREE_STACK_RETURN (REG_EESCAPE); - - PATFETCH (c); - } - else - { - /* Could be the end of the bracket expression. If it's - not (i.e., when the bracket expression is `[]' so - far), the ']' character bit gets set way below. */ - if (c == ']' && p2 != p1) - break; - } + /* Could be the end of the bracket expression. If it's + not (i.e., when the bracket expression is `[]' so + far), the ']' character bit gets set way below. */ + if (c == ']' && p2 != p1) + break; if (p < pend && p[0] == '-' && p[1] != ']') { @@ -2332,13 +2134,7 @@ regex_compile (re_char *pattern, size_t size, /* Range from C to C. */ c1 = c; - if (c > c1) - { - if (syntax & RE_NO_EMPTY_RANGES) - FREE_STACK_RETURN (REG_ERANGEX); - /* Else, repeat the loop. */ - } - else + if (c <= c1) { if (c < 128) { @@ -2348,24 +2144,17 @@ regex_compile (re_char *pattern, size_t size, if (CHAR_BYTE8_P (c1)) c = BYTE8_TO_CHAR (128); } - if (c <= c1) + if (CHAR_BYTE8_P (c)) { - if (CHAR_BYTE8_P (c)) - { - c = CHAR_TO_BYTE8 (c); - c1 = CHAR_TO_BYTE8 (c1); - for (; c <= c1; c++) - SET_LIST_BIT (c); - } - else if (multibyte) - { - SETUP_MULTIBYTE_RANGE (range_table_work, c, c1); - } - else - { - SETUP_UNIBYTE_RANGE (range_table_work, c, c1); - } + c = CHAR_TO_BYTE8 (c); + c1 = CHAR_TO_BYTE8 (c1); + for (; c <= c1; c++) + SET_LIST_BIT (c); } + else if (multibyte) + SETUP_MULTIBYTE_RANGE (range_table_work, c, c1); + else + SETUP_UNIBYTE_RANGE (range_table_work, c, c1); } } @@ -2403,41 +2192,6 @@ regex_compile (re_char *pattern, size_t size, break; - case '(': - if (syntax & RE_NO_BK_PARENS) - goto handle_open; - else - goto normal_char; - - - case ')': - if (syntax & RE_NO_BK_PARENS) - goto handle_close; - else - goto normal_char; - - - case '\n': - if (syntax & RE_NEWLINE_ALT) - goto handle_alt; - else - goto normal_char; - - - case '|': - if (syntax & RE_NO_BK_VBAR) - goto handle_alt; - else - goto normal_char; - - - case '{': - if (syntax & RE_INTERVALS && syntax & RE_NO_BK_BRACES) - goto handle_interval; - else - goto normal_char; - - case '\\': if (p == pend) FREE_STACK_RETURN (REG_EESCAPE); @@ -2449,17 +2203,13 @@ regex_compile (re_char *pattern, size_t size, switch (c) { case '(': - if (syntax & RE_NO_BK_PARENS) - goto normal_backslash; - - handle_open: { int shy = 0; regnum_t regnum = 0; if (p+1 < pend) { /* Look for a special (?...) construct */ - if ((syntax & RE_SHY_GROUPS) && *p == '?') + if (*p == '?') { PATFETCH (c); /* Gobble up the '?'. */ while (!shy) @@ -2540,27 +2290,14 @@ regex_compile (re_char *pattern, size_t size, } case ')': - if (syntax & RE_NO_BK_PARENS) goto normal_backslash; - if (COMPILE_STACK_EMPTY) - { - if (syntax & RE_UNMATCHED_RIGHT_PAREN_ORD) - goto normal_backslash; - else - FREE_STACK_RETURN (REG_ERPAREN); - } + FREE_STACK_RETURN (REG_ERPAREN); - handle_close: FIXUP_ALT_JUMP (); /* See similar code for backslashed left paren above. */ if (COMPILE_STACK_EMPTY) - { - if (syntax & RE_UNMATCHED_RIGHT_PAREN_ORD) - goto normal_char; - else - FREE_STACK_RETURN (REG_ERPAREN); - } + FREE_STACK_RETURN (REG_ERPAREN); /* Since we just checked for an empty stack above, this ``can't happen''. */ @@ -2593,12 +2330,6 @@ regex_compile (re_char *pattern, size_t size, case '|': /* `\|'. */ - if (syntax & RE_LIMITED_OPS || syntax & RE_NO_BK_VBAR) - goto normal_backslash; - handle_alt: - if (syntax & RE_LIMITED_OPS) - goto normal_char; - /* Insert before the previous alternative a jump which jumps to this alternative if the former fails. */ GET_BUFFER_SPACE (3); @@ -2637,17 +2368,7 @@ regex_compile (re_char *pattern, size_t size, case '{': - /* If \{ is a literal. */ - if (!(syntax & RE_INTERVALS) - /* If we're at `\{' and it's not the open-interval - operator. */ - || (syntax & RE_NO_BK_BRACES)) - goto normal_backslash; - - handle_interval: { - /* If got here, then the syntax allows intervals. */ - /* At least (most) this many matches must be made. */ int lower_bound = 0, upper_bound = -1; @@ -2662,33 +2383,19 @@ regex_compile (re_char *pattern, size_t size, upper_bound = lower_bound; if (lower_bound < 0 - || (0 <= upper_bound && upper_bound < lower_bound)) + || (0 <= upper_bound && upper_bound < lower_bound) + || c != '\\') FREE_STACK_RETURN (REG_BADBR); - - if (!(syntax & RE_NO_BK_BRACES)) - { - if (c != '\\') - FREE_STACK_RETURN (REG_BADBR); - if (p == pend) - FREE_STACK_RETURN (REG_EESCAPE); - PATFETCH (c); - } - - if (c != '}') + if (p == pend) + FREE_STACK_RETURN (REG_EESCAPE); + if (*p++ != '}') FREE_STACK_RETURN (REG_BADBR); /* We just parsed a valid interval. */ /* If it's invalid to have no preceding re. */ if (!laststart) - { - if (syntax & RE_CONTEXT_INVALID_OPS) - FREE_STACK_RETURN (REG_BADRPT); - else if (syntax & RE_CONTEXT_INDEP_OPS) - laststart = b; - else - goto unfetch_interval; - } + goto unfetch_interval; if (upper_bound == 0) /* If the upper bound is zero, just drop the sub pattern @@ -2793,17 +2500,9 @@ regex_compile (re_char *pattern, size_t size, eassert (beg_interval); p = beg_interval; beg_interval = NULL; - - /* normal_char and normal_backslash need `c'. */ + eassert (p > pattern && p[-1] == '\\'); c = '{'; - - if (!(syntax & RE_NO_BK_BRACES)) - { - eassert (p > pattern && p[-1] == '\\'); - goto normal_backslash; - } - else - goto normal_char; + goto normal_char; case '=': laststart = b; @@ -2835,38 +2534,28 @@ regex_compile (re_char *pattern, size_t size, break; case 'w': - if (syntax & RE_NO_GNU_OPS) - goto normal_char; laststart = b; BUF_PUSH_2 (syntaxspec, Sword); break; case 'W': - if (syntax & RE_NO_GNU_OPS) - goto normal_char; laststart = b; BUF_PUSH_2 (notsyntaxspec, Sword); break; case '<': - if (syntax & RE_NO_GNU_OPS) - goto normal_char; laststart = b; BUF_PUSH (wordbeg); break; case '>': - if (syntax & RE_NO_GNU_OPS) - goto normal_char; laststart = b; BUF_PUSH (wordend); break; case '_': - if (syntax & RE_NO_GNU_OPS) - goto normal_char; laststart = b; PATFETCH (c); if (c == '<') @@ -2878,38 +2567,25 @@ regex_compile (re_char *pattern, size_t size, break; case 'b': - if (syntax & RE_NO_GNU_OPS) - goto normal_char; BUF_PUSH (wordbound); break; case 'B': - if (syntax & RE_NO_GNU_OPS) - goto normal_char; BUF_PUSH (notwordbound); break; case '`': - if (syntax & RE_NO_GNU_OPS) - goto normal_char; BUF_PUSH (begbuf); break; case '\'': - if (syntax & RE_NO_GNU_OPS) - goto normal_char; BUF_PUSH (endbuf); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': { - regnum_t reg; - - if (syntax & RE_NO_BK_REFS) - goto normal_backslash; - - reg = c - '0'; + regnum_t reg = c - '0'; if (reg > bufp->re_nsub || reg < 1 /* Can't back reference to a subexp before its end. */ @@ -2921,16 +2597,7 @@ regex_compile (re_char *pattern, size_t size, } break; - - case '+': - case '?': - if (syntax & RE_BK_PLUS_QM) - goto handle_plus; - else - goto normal_backslash; - default: - normal_backslash: /* You might think it would be useful for \ to mean not to translate; but if we don't translate it it will never match anything. */ @@ -2952,14 +2619,9 @@ regex_compile (re_char *pattern, size_t size, || *pending_exact >= (1 << BYTEWIDTH) - MAX_MULTIBYTE_LENGTH /* If followed by a repetition operator. */ - || (p != pend && (*p == '*' || *p == '^')) - || ((syntax & RE_BK_PLUS_QM) - ? p + 1 < pend && *p == '\\' && (p[1] == '+' || p[1] == '?') - : p != pend && (*p == '+' || *p == '?')) - || ((syntax & RE_INTERVALS) - && ((syntax & RE_NO_BK_BRACES) - ? p != pend && *p == '{' - : p + 1 < pend && p[0] == '\\' && p[1] == '{'))) + || (p != pend + && (*p == '*' || *p == '+' || *p == '?' || *p == '^')) + || (p + 1 < pend && p[0] == '\\' && p[1] == '{')) { /* Start building a new exactn. */ @@ -3088,40 +2750,35 @@ insert_op2 (re_opcode_t op, unsigned char *loc, int arg1, int arg2, unsigned cha least one character before the ^. */ static bool -at_begline_loc_p (re_char *pattern, re_char *p, reg_syntax_t syntax) +at_begline_loc_p (re_char *pattern, re_char *p) { re_char *prev = p - 2; - bool odd_backslashes; - - /* After a subexpression? */ - if (*prev == '(') - odd_backslashes = (syntax & RE_NO_BK_PARENS) == 0; - /* After an alternative? */ - else if (*prev == '|') - odd_backslashes = (syntax & RE_NO_BK_VBAR) == 0; - - /* After a shy subexpression? */ - else if (*prev == ':' && (syntax & RE_SHY_GROUPS)) + switch (*prev) { + case '(': /* After a subexpression. */ + case '|': /* After an alternative. */ + break; + + case ':': /* After a shy subexpression. */ /* Skip over optional regnum. */ - while (prev - 1 >= pattern && prev[-1] >= '0' && prev[-1] <= '9') + while (prev > pattern && '0' <= prev[-1] && prev[-1] <= '9') --prev; - if (!(prev - 2 >= pattern - && prev[-1] == '?' && prev[-2] == '(')) + if (! (prev > pattern + 1 && prev[-1] == '?' && prev[-2] == '(')) return false; prev -= 2; - odd_backslashes = (syntax & RE_NO_BK_PARENS) == 0; + break; + + default: + return false; } - else - return false; /* Count the number of preceding backslashes. */ p = prev; - while (prev - 1 >= pattern && prev[-1] == '\\') + while (prev > pattern && prev[-1] == '\\') --prev; - return (p - prev) & odd_backslashes; + return (p - prev) & 1; } @@ -3129,19 +2786,10 @@ at_begline_loc_p (re_char *pattern, re_char *p, reg_syntax_t syntax) at least one character after the $, i.e., `P < PEND'. */ static bool -at_endline_loc_p (re_char *p, re_char *pend, reg_syntax_t syntax) +at_endline_loc_p (re_char *p, re_char *pend) { - re_char *next = p; - bool next_backslash = *next == '\\'; - re_char *next_next = p + 1 < pend ? p + 1 : 0; - - return - /* Before a subexpression? */ - (syntax & RE_NO_BK_PARENS ? *next == ')' - : next_backslash && next_next && *next_next == ')') - /* Before an alternative? */ - || (syntax & RE_NO_BK_VBAR ? *next == '|' - : next_backslash && next_next && *next_next == '|'); + /* Before a subexpression or an alternative? */ + return *p == '\\' && p + 1 < pend && (p[1] == ')' || p[1] == '|'); } @@ -3655,7 +3303,7 @@ re_search_2 (struct re_pattern_buffer *bufp, const char *str1, size_t size1, /* Written out as an if-else to avoid testing `translate' inside the loop. */ - if (RE_TRANSLATE_P (translate)) + if (!NILP (translate)) { if (multibyte) while (range > lim) @@ -4643,12 +4291,11 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, break; - /* Match any character except possibly a newline or a null. */ + /* Match any character except newline. */ case anychar: { int buf_charlen; int buf_ch; - reg_syntax_t syntax; DEBUG_PRINT ("EXECUTING anychar.\n"); @@ -4656,11 +4303,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, buf_ch = RE_STRING_CHAR_AND_LENGTH (d, buf_charlen, target_multibyte); buf_ch = TRANSLATE (buf_ch); - - syntax = RE_SYNTAX_EMACS; - - if ((!(syntax & RE_DOT_NEWLINE) && buf_ch == '\n') - || ((syntax & RE_DOT_NOT_NULL) && buf_ch == '\000')) + if (buf_ch == '\n') goto fail; DEBUG_PRINT (" Matched \"%d\".\n", *d); @@ -4826,7 +4469,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, /* Compare that many; failure if mismatch, else move past them. */ - if (RE_TRANSLATE_P (translate) + if (!NILP (translate) ? bcmp_translate (d, d2, dcnt, translate, target_multibyte) : memcmp (d, d2, dcnt)) { diff --git a/src/search.c b/src/search.c index f758bb9304..4e5a253011 100644 --- a/src/search.c +++ b/src/search.c @@ -132,7 +132,7 @@ compile_pattern_1 (struct regexp_cache *cp, Lisp_Object pattern, eassert (!cp->busy); cp->regexp = Qnil; - cp->buf.translate = (! NILP (translate) ? translate : make_number (0)); + cp->buf.translate = translate; cp->posix = posix; cp->buf.multibyte = STRING_MULTIBYTE (pattern); cp->buf.charset_unibyte = charset_unibyte; @@ -238,7 +238,7 @@ compile_pattern (Lisp_Object pattern, struct re_registers *regp, && !cp->busy && STRING_MULTIBYTE (cp->regexp) == STRING_MULTIBYTE (pattern) && !NILP (Fstring_equal (cp->regexp, pattern)) - && EQ (cp->buf.translate, (! NILP (translate) ? translate : make_number (0))) + && EQ (cp->buf.translate, translate) && cp->posix == posix && (EQ (cp->syntax_table, Qt) || EQ (cp->syntax_table, BVAR (current_buffer, syntax_table))) commit 3a6abe65c1324361bf0efcb65df61d22a39cfaaf Author: Paul Eggert Date: Sun Aug 5 18:41:20 2018 -0700 Simplify regex-emacs code by assuming Emacs * src/regex-emacs.c: Omit no-longer-needed AIX code. Don’t ignore GCC warnings. Include regex-emacs.h immediately after config.h, to test that it’s independent. Omit the "#ifndef emacs" and "#ifdef REGEX_MALLOC" and "#if WIDE_CHAR_SUPPORT" or "#ifdef _REGEX_RE_COMP", code, as we are no longer interested in compiling outside Emacs (with or without debugging or native wide char support) or in avoiding alloca. (REGEX_EMACS_DEBUG, regex_emacs_debug): Rename from DEBUG and debug, to avoid collision with other DEBUGS. All uses changed. In debugging output, change %ld and %zd to %zu when appropriate. No need to include stddef.h, stdlib.h, sys/types.h, wchar.h, wctype.h, locale/localeinfo.h, locale/elem-hash.h, langinfo.h, libintl.h, unistd.h, stdbool.h, string.h, stdio.h, assert.h. All uses of assert changed to eassert. (RE_DUP_MAX, reg_syntax_t, RE_BACKSLASH_ESCAPE_IN_LISTS) (RE_BK_PLUS_QM, RE_CHAR_CLASSES, RE_CONTEXT_INDEP_ANCHORS) (RE_CONTEXT_INDEP_OPS, RE_CONTEXT_INVALID_OPS, RE_DOT_NEWLINE) (RE_DOT_NOT_NULL, RE_HAT_LISTS_NOT_NEWLINE, RE_INTERVALS) (RE_LIMITED_OPS, RE_NEWLINE_ALT, RE_NO_BK_BRACES) (RE_NO_BK_PARENS, RE_NO_BK_REFS, RE_NO_BK_VBAR) (RE_NO_EMPTY_RANGES, RE_UNMATCHED_RIGHT_PAREN_ORD) (RE_NO_POSIX_BACKTRACKING, RE_NO_GNU_OPS, RE_FRUGAL) (RE_SHY_GROUPS, RE_NO_NEWLINE_ANCHOR, RE_SYNTAX_EMACS) (REG_NOERROR, REG_NOMATCH, REG_BADPAT, REG_ECOLLATE) (REG_ECTYPE, REG_EESCAPE, REG_ESUBREG, REG_EBRACK, REG_EPAREN) (REG_EBRACE, REG_BADBR, REG_ERANGE, REG_ESPACE, REG_BADRPT) (REG_EEND, REG_ESIZE, REG_ERPAREN, REG_ERANGEX, REG_ESIZEBR) (reg_errcode_t, REGS_UNALLOCATED, REGS_REALLOCATE, REGS_FIXED) (RE_NREGS, RE_TRANSLATE, RE_TRANSLATE_P): Move here from regex-emacs.h. (RE_NREGS): Define unconditionally. (boolean): Remove. All uses replaced by bool. (WIDE_CHAR_SUPPORT, regfree, regexec, regcomp, regerror): (re_set_syntax, re_syntax_options, WEAK_ALIAS, gettext, gettext_noop): Remove. All uses removed. (malloc, realloc, free): Do not redefine. Adjust all callers to use xmalloc, xrealloc, xfree instead. (re_error_msgid): Use C99 to avoid need to keep in same order as reg_error_t. (REGEX_USE_SAFE_ALLOCA): Simplify by using USE_SAFE_ALLOCA. (REGEX_ALLOCATE, REGEX_REALLOCATE, REGEX_FREE, REGEX_ALLOCATE_STACK) (REGEX_REALLOCATE_STACK, REGEX_FREE_STACK): Remove. All callers changed to use the non-REGEX_MALLOC version. (REGEX_TALLOC): Remove. All callers changed to use SAFE_ALLOCA. (re_set_syntax): Remove; unused. (MATCH_MAY_ALLOCATE): Remove; now always true. All uses simplified. (INIT_FAILURE_ALLOC): Define unconditionally. (re_compile_fastmap): Now static. (re_compile_pattern): Avoid unnecessary cast. * src/regex-emacs.h (EMACS_REGEX_H): Renamed from _REGEX_H to avoid possible collision with glibc. Don’t include sys/types.h. All uses of ssize_t changed to ptrdiff_t. Don’t worry about C++ or VMS. Assume emacs is defined and that _REGEX_RE_COMP and WIDE_CHAR_SUPPORT are not. Define struct re_registers before including lisp.h. (REG_ENOSYS, RE_TRANSLATE_TYPE): Remove; all uses replaced by Lisp_Object. (regoff_t): Remove. All uses replaced with ptrdiff_t. (re_match, regcomp, regexec, regerror, regfree): Remove decl of nonexistent functions. (RE_DEBUG, RE_SYNTAX_AWK, RE_SYNTAX_GNU_AWK) (RE_SYNTAX_POSIX_AWK, RE_SYNTAX_GREP, RE_SYNTAX_EGREP) (RE_SYNTAX_POSIX_EGREP, RE_SYNTAX_ED, RE_SYNTAX_SED) (_RE_SYNTAX_POSIX_COMMON, RE_SYNTAX_POSIX_BASIC) (RE_SYNTAX_POSIX_MINIMAL_BASIC, RE_SYNTAX_POSIX_EXTENDED) (RE_SYNTAX_POSIX_MINIMAL_EXTENDED, REG_EXTENDED, REG_ICASE) (REG_NEWLINE, REG_NOSUB, REG_NOTBOL, REG_NOTEOL, regmatch_t): Remove; unused. * src/search.c (Fset_match_data): Simplify range test now that we know it’s ptrdiff_t. diff --git a/src/regex-emacs.c b/src/regex-emacs.c index 08fc8c67f1..eb5970ffcf 100644 --- a/src/regex-emacs.c +++ b/src/regex-emacs.c @@ -21,159 +21,187 @@ - structure the opcode space into opcode+flag. - merge with glibc's regex.[ch]. - replace (succeed_n + jump_n + set_number_at) with something that doesn't - need to modify the compiled regexp so that re_match can be reentrant. + need to modify the compiled regexp so that re_search can be reentrant. - get rid of on_failure_jump_smart by doing the optimization in re_comp - rather than at run-time, so that re_match can be reentrant. + rather than at run-time, so that re_search can be reentrant. */ -/* AIX requires this to be the first thing in the file. */ -#if defined _AIX && !defined REGEX_MALLOC - #pragma alloca -#endif - -/* Ignore some GCC warnings for now. This section should go away - once the Emacs and Gnulib regex code is merged. */ -#if 4 < __GNUC__ + (5 <= __GNUC_MINOR__) || defined __clang__ -# pragma GCC diagnostic ignored "-Wstrict-overflow" -# ifndef emacs -# pragma GCC diagnostic ignored "-Wunused-function" -# pragma GCC diagnostic ignored "-Wunused-macros" -# pragma GCC diagnostic ignored "-Wunused-result" -# pragma GCC diagnostic ignored "-Wunused-variable" -# endif -#endif - -#if 4 < __GNUC__ + (6 <= __GNUC_MINOR__) && ! defined __clang__ -# pragma GCC diagnostic ignored "-Wunused-but-set-variable" -#endif - #include -#include -#include - -#ifdef emacs -/* We need this for `regex-emacs.h', and perhaps for the Emacs include - files. */ -# include -#endif - -/* Whether to use ISO C Amendment 1 wide char functions. - Those should not be used for Emacs since it uses its own. */ -#if defined _LIBC -#define WIDE_CHAR_SUPPORT 1 -#else -#define WIDE_CHAR_SUPPORT \ - (HAVE_WCTYPE_H && HAVE_WCHAR_H && HAVE_BTOWC && !emacs) -#endif +/* Get the interface, including the syntax bits. */ +#include "regex-emacs.h" -/* For platform which support the ISO C amendment 1 functionality we - support user defined character classes. */ -#if WIDE_CHAR_SUPPORT -/* Solaris 2.5 has a bug: must be included before . */ -# include -# include -#endif +#include -#ifdef _LIBC -/* We have to keep the namespace clean. */ -# define regfree(preg) __regfree (preg) -# define regexec(pr, st, nm, pm, ef) __regexec (pr, st, nm, pm, ef) -# define regcomp(preg, pattern, cflags) __regcomp (preg, pattern, cflags) -# define regerror(err_code, preg, errbuf, errbuf_size) \ - __regerror (err_code, preg, errbuf, errbuf_size) -# define re_set_registers(bu, re, nu, st, en) \ - __re_set_registers (bu, re, nu, st, en) -# define re_match_2(bufp, string1, size1, string2, size2, pos, regs, stop) \ - __re_match_2 (bufp, string1, size1, string2, size2, pos, regs, stop) -# define re_match(bufp, string, size, pos, regs) \ - __re_match (bufp, string, size, pos, regs) -# define re_search(bufp, string, size, startpos, range, regs) \ - __re_search (bufp, string, size, startpos, range, regs) -# define re_compile_pattern(pattern, length, bufp) \ - __re_compile_pattern (pattern, length, bufp) -# define re_set_syntax(syntax) __re_set_syntax (syntax) -# define re_search_2(bufp, st1, s1, st2, s2, startpos, range, regs, stop) \ - __re_search_2 (bufp, st1, s1, st2, s2, startpos, range, regs, stop) -# define re_compile_fastmap(bufp) __re_compile_fastmap (bufp) - -/* Make sure we call libc's function even if the user overrides them. */ -# define btowc __btowc -# define iswctype __iswctype -# define wctype __wctype - -# define WEAK_ALIAS(a,b) weak_alias (a, b) - -/* We are also using some library internals. */ -# include -# include -# include -#else -# define WEAK_ALIAS(a,b) -#endif +#include "character.h" +#include "buffer.h" -/* This is for other GNU distributions with internationalized messages. */ -#if HAVE_LIBINTL_H || defined _LIBC -# include -#else -# define gettext(msgid) (msgid) -#endif +#include "syntax.h" +#include "category.h" -#ifndef gettext_noop -/* This define is so xgettext can find the internationalizable - strings. */ -# define gettext_noop(String) String +/* Maximum number of duplicates an interval can allow. Some systems + define this in other header files, but we want our + value, so remove any previous define. */ +#ifdef RE_DUP_MAX +# undef RE_DUP_MAX #endif - -/* The `emacs' switch turns on certain matching commands - that make sense only in Emacs. */ -#ifdef emacs - -# include "lisp.h" -# include "character.h" -# include "buffer.h" - -# include "syntax.h" -# include "category.h" +/* Repeat counts are stored in opcodes as 2 byte integers. This was + previously limited to 7fff because the parsing code uses signed + ints. But Emacs only runs on 32 bit platforms anyway. */ +#define RE_DUP_MAX (0xffff) + +/* The following bits are used to determine the regexp syntax we + recognize. The set/not-set meanings where historically chosen so + that Emacs syntax had the value 0. + The bits are given in alphabetical order, and + the definitions shifted by one from the previous bit; thus, when we + add or remove a bit, only one other definition need change. */ +typedef unsigned long reg_syntax_t; + +/* If this bit is not set, then \ inside a bracket expression is literal. + If set, then such a \ quotes the following character. */ +#define RE_BACKSLASH_ESCAPE_IN_LISTS ((unsigned long int) 1) + +/* If this bit is not set, then + and ? are operators, and \+ and \? are + literals. + If set, then \+ and \? are operators and + and ? are literals. */ +#define RE_BK_PLUS_QM (RE_BACKSLASH_ESCAPE_IN_LISTS << 1) + +/* If this bit is set, then character classes are supported. They are: + [:alpha:], [:upper:], [:lower:], [:digit:], [:alnum:], [:xdigit:], + [:space:], [:print:], [:punct:], [:graph:], and [:cntrl:]. + If not set, then character classes are not supported. */ +#define RE_CHAR_CLASSES (RE_BK_PLUS_QM << 1) + +/* If this bit is set, then ^ and $ are always anchors (outside bracket + expressions, of course). + If this bit is not set, then it depends: + ^ is an anchor if it is at the beginning of a regular + expression or after an open-group or an alternation operator; + $ is an anchor if it is at the end of a regular expression, or + before a close-group or an alternation operator. + + This bit could be (re)combined with RE_CONTEXT_INDEP_OPS, because + POSIX draft 11.2 says that * etc. in leading positions is undefined. + We already implemented a previous draft which made those constructs + invalid, though, so we haven't changed the code back. */ +#define RE_CONTEXT_INDEP_ANCHORS (RE_CHAR_CLASSES << 1) + +/* If this bit is set, then special characters are always special + regardless of where they are in the pattern. + If this bit is not set, then special characters are special only in + some contexts; otherwise they are ordinary. Specifically, + * + ? and intervals are only special when not after the beginning, + open-group, or alternation operator. */ +#define RE_CONTEXT_INDEP_OPS (RE_CONTEXT_INDEP_ANCHORS << 1) + +/* If this bit is set, then *, +, ?, and { cannot be first in an re or + immediately after an alternation or begin-group operator. */ +#define RE_CONTEXT_INVALID_OPS (RE_CONTEXT_INDEP_OPS << 1) + +/* If this bit is set, then . matches newline. + If not set, then it doesn't. */ +#define RE_DOT_NEWLINE (RE_CONTEXT_INVALID_OPS << 1) + +/* If this bit is set, then . doesn't match NUL. + If not set, then it does. */ +#define RE_DOT_NOT_NULL (RE_DOT_NEWLINE << 1) + +/* If this bit is set, nonmatching lists [^...] do not match newline. + If not set, they do. */ +#define RE_HAT_LISTS_NOT_NEWLINE (RE_DOT_NOT_NULL << 1) + +/* If this bit is set, either \{...\} or {...} defines an + interval, depending on RE_NO_BK_BRACES. + If not set, \{, \}, {, and } are literals. */ +#define RE_INTERVALS (RE_HAT_LISTS_NOT_NEWLINE << 1) + +/* If this bit is set, +, ? and | aren't recognized as operators. + If not set, they are. */ +#define RE_LIMITED_OPS (RE_INTERVALS << 1) + +/* If this bit is set, newline is an alternation operator. + If not set, newline is literal. */ +#define RE_NEWLINE_ALT (RE_LIMITED_OPS << 1) + +/* If this bit is set, then `{...}' defines an interval, and \{ and \} + are literals. + If not set, then `\{...\}' defines an interval. */ +#define RE_NO_BK_BRACES (RE_NEWLINE_ALT << 1) + +/* If this bit is set, (...) defines a group, and \( and \) are literals. + If not set, \(...\) defines a group, and ( and ) are literals. */ +#define RE_NO_BK_PARENS (RE_NO_BK_BRACES << 1) + +/* If this bit is set, then \ matches . + If not set, then \ is a back-reference. */ +#define RE_NO_BK_REFS (RE_NO_BK_PARENS << 1) + +/* If this bit is set, then | is an alternation operator, and \| is literal. + If not set, then \| is an alternation operator, and | is literal. */ +#define RE_NO_BK_VBAR (RE_NO_BK_REFS << 1) + +/* If this bit is set, then an ending range point collating higher + than the starting range point, as in [z-a], is invalid. + If not set, then when ending range point collates higher than the + starting range point, the range is ignored. */ +#define RE_NO_EMPTY_RANGES (RE_NO_BK_VBAR << 1) + +/* If this bit is set, then an unmatched ) is ordinary. + If not set, then an unmatched ) is invalid. */ +#define RE_UNMATCHED_RIGHT_PAREN_ORD (RE_NO_EMPTY_RANGES << 1) + +/* If this bit is set, succeed as soon as we match the whole pattern, + without further backtracking. */ +#define RE_NO_POSIX_BACKTRACKING (RE_UNMATCHED_RIGHT_PAREN_ORD << 1) + +/* If this bit is set, do not process the GNU regex operators. + If not set, then the GNU regex operators are recognized. */ +#define RE_NO_GNU_OPS (RE_NO_POSIX_BACKTRACKING << 1) + +/* If this bit is set, then *?, +? and ?? match non greedily. */ +#define RE_FRUGAL (RE_NO_GNU_OPS << 1) + +/* If this bit is set, then (?:...) is treated as a shy group. */ +#define RE_SHY_GROUPS (RE_FRUGAL << 1) + +/* If this bit is set, ^ and $ only match at beg/end of buffer. */ +#define RE_NO_NEWLINE_ANCHOR (RE_SHY_GROUPS << 1) + +/* This global variable defines the particular regexp syntax to use (for + some interfaces). When a regexp is compiled, the syntax used is + stored in the pattern buffer, so changing this does not affect + already-compiled regexps. */ +/* extern reg_syntax_t re_syntax_options; */ +/* Define combinations of the above bits for the standard possibilities. */ +#define RE_SYNTAX_EMACS \ + (RE_CHAR_CLASSES | RE_INTERVALS | RE_SHY_GROUPS | RE_FRUGAL) /* Make syntax table lookup grant data in gl_state. */ -# define SYNTAX(c) syntax_property (c, 1) - -# ifdef malloc -# undef malloc -# endif -# define malloc xmalloc -# ifdef realloc -# undef realloc -# endif -# define realloc xrealloc -# ifdef free -# undef free -# endif -# define free xfree +#define SYNTAX(c) syntax_property (c, 1) /* Converts the pointer to the char to BEG-based offset from the start. */ -# define PTR_TO_OFFSET(d) POS_AS_IN_BUFFER (POINTER_TO_OFFSET (d)) +#define PTR_TO_OFFSET(d) POS_AS_IN_BUFFER (POINTER_TO_OFFSET (d)) /* Strings are 0-indexed, buffers are 1-indexed; we pun on the boolean result to get the right base index. */ -# define POS_AS_IN_BUFFER(p) \ +#define POS_AS_IN_BUFFER(p) \ ((p) + (NILP (gl_state.object) || BUFFERP (gl_state.object))) -# define RE_MULTIBYTE_P(bufp) ((bufp)->multibyte) -# define RE_TARGET_MULTIBYTE_P(bufp) ((bufp)->target_multibyte) -# define RE_STRING_CHAR(p, multibyte) \ +#define RE_MULTIBYTE_P(bufp) ((bufp)->multibyte) +#define RE_TARGET_MULTIBYTE_P(bufp) ((bufp)->target_multibyte) +#define RE_STRING_CHAR(p, multibyte) \ (multibyte ? (STRING_CHAR (p)) : (*(p))) -# define RE_STRING_CHAR_AND_LENGTH(p, len, multibyte) \ +#define RE_STRING_CHAR_AND_LENGTH(p, len, multibyte) \ (multibyte ? (STRING_CHAR_AND_LENGTH (p, len)) : ((len) = 1, *(p))) -# define RE_CHAR_TO_MULTIBYTE(c) UNIBYTE_TO_CHAR (c) +#define RE_CHAR_TO_MULTIBYTE(c) UNIBYTE_TO_CHAR (c) -# define RE_CHAR_TO_UNIBYTE(c) CHAR_TO_BYTE_SAFE (c) +#define RE_CHAR_TO_UNIBYTE(c) CHAR_TO_BYTE_SAFE (c) /* Set C a (possibly converted to multibyte) character before P. P points into a string which is the virtual concatenation of STR1 (which ends at END1) or STR2 (which ends at END2). */ -# define GET_CHAR_BEFORE_2(c, p, str1, end1, str2, end2) \ +#define GET_CHAR_BEFORE_2(c, p, str1, end1, str2, end2) \ do { \ if (target_multibyte) \ { \ @@ -191,7 +219,7 @@ /* Set C a (possibly converted to multibyte) character at P, and set LEN to the byte length of that character. */ -# define GET_CHAR_AFTER(c, p, len) \ +#define GET_CHAR_AFTER(c, p, len) \ do { \ if (target_multibyte) \ (c) = STRING_CHAR_AND_LENGTH (p, len); \ @@ -202,235 +230,66 @@ (c) = RE_CHAR_TO_MULTIBYTE (c); \ } \ } while (0) - -#else /* not emacs */ - -/* If we are not linking with Emacs proper, - we can't use the relocating allocator - even if config.h says that we can. */ -# undef REL_ALLOC - -# include - -/* When used in Emacs's lib-src, we need xmalloc and xrealloc. */ - -static ATTRIBUTE_MALLOC void * -xmalloc (size_t size) -{ - void *val = malloc (size); - if (!val && size) - { - write (STDERR_FILENO, "virtual memory exhausted\n", 25); - exit (1); - } - return val; -} - -static void * -xrealloc (void *block, size_t size) -{ - void *val; - /* We must call malloc explicitly when BLOCK is 0, since some - reallocs don't do this. */ - if (! block) - val = malloc (size); - else - val = realloc (block, size); - if (!val && size) - { - write (STDERR_FILENO, "virtual memory exhausted\n", 25); - exit (1); - } - return val; -} - -# ifdef malloc -# undef malloc -# endif -# define malloc xmalloc -# ifdef realloc -# undef realloc -# endif -# define realloc xrealloc - -# include -# include - -/* Define the syntax stuff for \<, \>, etc. */ - -/* Sword must be nonzero for the wordchar pattern commands in re_match_2. */ -enum syntaxcode { Swhitespace = 0, Sword = 1, Ssymbol = 2 }; - -/* Dummy macros for non-Emacs environments. */ -# define MAX_MULTIBYTE_LENGTH 1 -# define RE_MULTIBYTE_P(x) 0 -# define RE_TARGET_MULTIBYTE_P(x) 0 -# define WORD_BOUNDARY_P(c1, c2) (0) -# define BYTES_BY_CHAR_HEAD(p) (1) -# define PREV_CHAR_BOUNDARY(p, limit) ((p)--) -# define STRING_CHAR(p) (*(p)) -# define RE_STRING_CHAR(p, multibyte) STRING_CHAR (p) -# define CHAR_STRING(c, s) (*(s) = (c), 1) -# define STRING_CHAR_AND_LENGTH(p, actual_len) ((actual_len) = 1, *(p)) -# define RE_STRING_CHAR_AND_LENGTH(p, len, multibyte) STRING_CHAR_AND_LENGTH (p, len) -# define RE_CHAR_TO_MULTIBYTE(c) (c) -# define RE_CHAR_TO_UNIBYTE(c) (c) -# define GET_CHAR_BEFORE_2(c, p, str1, end1, str2, end2) \ - (c = ((p) == (str2) ? *((end1) - 1) : *((p) - 1))) -# define GET_CHAR_AFTER(c, p, len) \ - (c = *p, len = 1) -# define CHAR_BYTE8_P(c) (0) -# define CHAR_LEADING_CODE(c) (c) - -#endif /* not emacs */ - -#ifndef RE_TRANSLATE -# define RE_TRANSLATE(TBL, C) ((unsigned char)(TBL)[C]) -# define RE_TRANSLATE_P(TBL) (TBL) -#endif -/* Get the interface, including the syntax bits. */ -#include "regex-emacs.h" - /* isalpha etc. are used for the character classes. */ #include -#ifdef emacs - /* 1 if C is an ASCII character. */ -# define IS_REAL_ASCII(c) ((c) < 0200) +#define IS_REAL_ASCII(c) ((c) < 0200) /* 1 if C is a unibyte character. */ -# define ISUNIBYTE(c) (SINGLE_BYTE_CHAR_P ((c))) +#define ISUNIBYTE(c) (SINGLE_BYTE_CHAR_P ((c))) /* The Emacs definitions should not be directly affected by locales. */ /* In Emacs, these are only used for single-byte characters. */ -# define ISDIGIT(c) ((c) >= '0' && (c) <= '9') -# define ISCNTRL(c) ((c) < ' ') -# define ISXDIGIT(c) (0 <= char_hexdigit (c)) +#define ISDIGIT(c) ((c) >= '0' && (c) <= '9') +#define ISCNTRL(c) ((c) < ' ') +#define ISXDIGIT(c) (0 <= char_hexdigit (c)) /* The rest must handle multibyte characters. */ -# define ISBLANK(c) (IS_REAL_ASCII (c) \ +#define ISBLANK(c) (IS_REAL_ASCII (c) \ ? ((c) == ' ' || (c) == '\t') \ : blankp (c)) -# define ISGRAPH(c) (SINGLE_BYTE_CHAR_P (c) \ +#define ISGRAPH(c) (SINGLE_BYTE_CHAR_P (c) \ ? (c) > ' ' && !((c) >= 0177 && (c) <= 0240) \ : graphicp (c)) -# define ISPRINT(c) (SINGLE_BYTE_CHAR_P (c) \ +#define ISPRINT(c) (SINGLE_BYTE_CHAR_P (c) \ ? (c) >= ' ' && !((c) >= 0177 && (c) <= 0237) \ : printablep (c)) -# define ISALNUM(c) (IS_REAL_ASCII (c) \ +#define ISALNUM(c) (IS_REAL_ASCII (c) \ ? (((c) >= 'a' && (c) <= 'z') \ || ((c) >= 'A' && (c) <= 'Z') \ || ((c) >= '0' && (c) <= '9')) \ : alphanumericp (c)) -# define ISALPHA(c) (IS_REAL_ASCII (c) \ +#define ISALPHA(c) (IS_REAL_ASCII (c) \ ? (((c) >= 'a' && (c) <= 'z') \ || ((c) >= 'A' && (c) <= 'Z')) \ : alphabeticp (c)) -# define ISLOWER(c) lowercasep (c) +#define ISLOWER(c) lowercasep (c) -# define ISPUNCT(c) (IS_REAL_ASCII (c) \ +#define ISPUNCT(c) (IS_REAL_ASCII (c) \ ? ((c) > ' ' && (c) < 0177 \ && !(((c) >= 'a' && (c) <= 'z') \ || ((c) >= 'A' && (c) <= 'Z') \ || ((c) >= '0' && (c) <= '9'))) \ : SYNTAX (c) != Sword) -# define ISSPACE(c) (SYNTAX (c) == Swhitespace) +#define ISSPACE(c) (SYNTAX (c) == Swhitespace) -# define ISUPPER(c) uppercasep (c) - -# define ISWORD(c) (SYNTAX (c) == Sword) - -#else /* not emacs */ - -/* 1 if C is an ASCII character. */ -# define IS_REAL_ASCII(c) ((c) < 0200) - -/* This distinction is not meaningful, except in Emacs. */ -# define ISUNIBYTE(c) 1 - -# ifdef isblank -# define ISBLANK(c) isblank (c) -# else -# define ISBLANK(c) ((c) == ' ' || (c) == '\t') -# endif -# ifdef isgraph -# define ISGRAPH(c) isgraph (c) -# else -# define ISGRAPH(c) (isprint (c) && !isspace (c)) -# endif - -/* Solaris defines ISPRINT so we must undefine it first. */ -# undef ISPRINT -# define ISPRINT(c) isprint (c) -# define ISDIGIT(c) isdigit (c) -# define ISALNUM(c) isalnum (c) -# define ISALPHA(c) isalpha (c) -# define ISCNTRL(c) iscntrl (c) -# define ISLOWER(c) islower (c) -# define ISPUNCT(c) ispunct (c) -# define ISSPACE(c) isspace (c) -# define ISUPPER(c) isupper (c) -# define ISXDIGIT(c) isxdigit (c) - -# define ISWORD(c) ISALPHA (c) - -# ifdef _tolower -# define TOLOWER(c) _tolower (c) -# else -# define TOLOWER(c) tolower (c) -# endif - -/* How many characters in the character set. */ -# define CHAR_SET_SIZE 256 - -# ifdef SYNTAX_TABLE - -extern char *re_syntax_table; - -# else /* not SYNTAX_TABLE */ - -static char re_syntax_table[CHAR_SET_SIZE]; - -static void -init_syntax_once (void) -{ - register int c; - static int done = 0; - - if (done) - return; - - memset (re_syntax_table, 0, sizeof re_syntax_table); - - for (c = 0; c < CHAR_SET_SIZE; ++c) - if (ISALNUM (c)) - re_syntax_table[c] = Sword; - - re_syntax_table['_'] = Ssymbol; - - done = 1; -} +#define ISUPPER(c) uppercasep (c) -# endif /* not SYNTAX_TABLE */ - -# define SYNTAX(c) re_syntax_table[(c)] - -#endif /* not emacs */ +#define ISWORD(c) (SYNTAX (c) == Sword) #define SIGN_EXTEND_CHAR(c) ((signed char) (c)) -/* Should we use malloc or alloca? If REGEX_MALLOC is not defined, we - use `alloca' instead of `malloc'. This is because using malloc in +/* Use alloca instead of malloc. This is because using malloc in re_search* or re_match* could cause memory leaks when C-g is used in Emacs (note that SAFE_ALLOCA could also call malloc, but does so via `record_xmalloc' which uses `unwind_protect' to ensure the @@ -442,64 +301,17 @@ init_syntax_once (void) not functions -- `alloca'-allocated space disappears at the end of the function it is called in. */ -#ifdef REGEX_MALLOC - -# define REGEX_ALLOCATE malloc -# define REGEX_REALLOCATE(source, osize, nsize) realloc (source, nsize) -# define REGEX_FREE free - -#else /* not REGEX_MALLOC */ - -# ifdef emacs /* This may be adjusted in main(), if the stack is successfully grown. */ ptrdiff_t emacs_re_safe_alloca = MAX_ALLOCA; /* Like USE_SAFE_ALLOCA, but use emacs_re_safe_alloca. */ -# define REGEX_USE_SAFE_ALLOCA \ - ptrdiff_t sa_avail = emacs_re_safe_alloca; \ - ptrdiff_t sa_count = SPECPDL_INDEX () - -# define REGEX_SAFE_FREE() SAFE_FREE () -# define REGEX_ALLOCATE SAFE_ALLOCA -# else -# include -# define REGEX_ALLOCATE alloca -# endif +#define REGEX_USE_SAFE_ALLOCA \ + USE_SAFE_ALLOCA; sa_avail = emacs_re_safe_alloca /* Assumes a `char *destination' variable. */ -# define REGEX_REALLOCATE(source, osize, nsize) \ - (destination = REGEX_ALLOCATE (nsize), \ +#define REGEX_REALLOCATE(source, osize, nsize) \ + (destination = SAFE_ALLOCA (nsize), \ memcpy (destination, source, osize)) -/* No need to do anything to free, after alloca. */ -# define REGEX_FREE(arg) ((void)0) /* Do nothing! But inhibit gcc warning. */ - -#endif /* not REGEX_MALLOC */ - -#ifndef REGEX_USE_SAFE_ALLOCA -# define REGEX_USE_SAFE_ALLOCA ((void) 0) -# define REGEX_SAFE_FREE() ((void) 0) -#endif - -/* Define how to allocate the failure stack. */ - -#if defined REL_ALLOC && defined REGEX_MALLOC - -# define REGEX_ALLOCATE_STACK(size) \ - r_alloc (&failure_stack_ptr, (size)) -# define REGEX_REALLOCATE_STACK(source, osize, nsize) \ - r_re_alloc (&failure_stack_ptr, (nsize)) -# define REGEX_FREE_STACK(ptr) \ - r_alloc_free (&failure_stack_ptr) - -#else /* not using relocating allocator */ - -# define REGEX_ALLOCATE_STACK(size) REGEX_ALLOCATE (size) -# define REGEX_REALLOCATE_STACK(source, o, n) REGEX_REALLOCATE (source, o, n) -# define REGEX_FREE_STACK(ptr) REGEX_FREE (ptr) - -#endif /* not using relocating allocator */ - - /* True if `size1' is non-NULL and PTR is pointing anywhere inside `string1' or just past its end. This works if PTR is NULL, which is a good thing. */ @@ -507,30 +319,21 @@ ptrdiff_t emacs_re_safe_alloca = MAX_ALLOCA; (size1 && string1 <= (ptr) && (ptr) <= string1 + size1) /* (Re)Allocate N items of type T using malloc, or fail. */ -#define TALLOC(n, t) ((t *) malloc ((n) * sizeof (t))) -#define RETALLOC(addr, n, t) ((addr) = (t *) realloc (addr, (n) * sizeof (t))) -#define REGEX_TALLOC(n, t) ((t *) REGEX_ALLOCATE ((n) * sizeof (t))) +#define TALLOC(n, t) ((t *) xmalloc ((n) * sizeof (t))) +#define RETALLOC(addr, n, t) ((addr) = (t *) xrealloc (addr, (n) * sizeof (t))) #define BYTEWIDTH 8 /* In bits. */ -#ifndef emacs -# undef max -# undef min -# define max(a, b) ((a) > (b) ? (a) : (b)) -# define min(a, b) ((a) < (b) ? (a) : (b)) -#endif - /* Type of source-pattern and string chars. */ typedef const unsigned char re_char; -typedef char boolean; - -static regoff_t re_match_2_internal (struct re_pattern_buffer *bufp, +static void re_compile_fastmap (struct re_pattern_buffer *); +static ptrdiff_t re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, size_t size1, re_char *string2, size_t size2, - ssize_t pos, + ptrdiff_t pos, struct re_registers *regs, - ssize_t stop); + ptrdiff_t stop); /* These are the command codes that appear in compiled regular expressions. Some opcodes are followed by argument bytes. A @@ -592,8 +395,7 @@ typedef enum /* Fail unless at end of line. */ endline, - /* Succeeds if at beginning of buffer (if emacs) or at beginning - of string to be matched (if not). */ + /* Succeeds if at beginning of buffer. */ begbuf, /* Analogously, for end of buffer/string. */ @@ -658,10 +460,9 @@ typedef enum syntaxspec, /* Matches any character whose syntax is not that specified. */ - notsyntaxspec + notsyntaxspec, -#ifdef emacs - , at_dot, /* Succeeds if at point. */ + at_dot, /* Succeeds if at point. */ /* Matches any character whose category-set contains the specified category. The operator is followed by a byte which contains a @@ -672,7 +473,6 @@ typedef enum specified category. The operator is followed by a byte which contains the category code (mnemonic ASCII character). */ notcategoryspec -#endif /* emacs */ } re_opcode_t; /* Common operations on the compiled pattern. */ @@ -760,12 +560,10 @@ extract_number_and_incr (re_char **source) and the 2 bytes of flags at the start of the range table. */ #define CHARSET_RANGE_TABLE(p) (&(p)[4 + CHARSET_BITMAP_SIZE (p)]) -#ifdef emacs /* Extract the bit flags that start a range table. */ #define CHARSET_RANGE_TABLE_BITS(p) \ ((p)[2 + CHARSET_BITMAP_SIZE (p)] \ + (p)[3 + CHARSET_BITMAP_SIZE (p)] * 0x100) -#endif /* Return the address of end of RANGE_TABLE. COUNT is number of ranges (which is a pair of (start, end)) in the RANGE_TABLE. `* 2' @@ -774,29 +572,23 @@ extract_number_and_incr (re_char **source) #define CHARSET_RANGE_TABLE_END(range_table, count) \ ((range_table) + (count) * 2 * 3) -/* If DEBUG is defined, Regex prints many voluminous messages about what - it is doing (if the variable `debug' is nonzero). If linked with the - main program in `iregex.c', you can enter patterns and strings - interactively. And if linked with the main program in `main.c' and - the other test files, you can run the already-written tests. */ +/* If REGEX_EMACS_DEBUG is defined, print many voluminous messages + (if the variable regex_emacs_debug is positive). */ -#ifdef DEBUG +#ifdef REGEX_EMACS_DEBUG /* We use standard I/O for debugging. */ # include -/* It is useful to test things that ``must'' be true when debugging. */ -# include - -static int debug = -100000; +static int regex_emacs_debug = -100000; # define DEBUG_STATEMENT(e) e -# define DEBUG_PRINT(...) if (debug > 0) printf (__VA_ARGS__) +# define DEBUG_PRINT(...) if (regex_emacs_debug > 0) printf (__VA_ARGS__) # define DEBUG_COMPILES_ARGUMENTS # define DEBUG_PRINT_COMPILED_PATTERN(p, s, e) \ - if (debug > 0) print_partial_compiled_pattern (s, e) + if (regex_emacs_debug > 0) print_partial_compiled_pattern (s, e) # define DEBUG_PRINT_DOUBLE_STRING(w, s1, sz1, s2, sz2) \ - if (debug > 0) print_double_string (w, s1, sz1, s2, sz2) + if (regex_emacs_debug > 0) print_double_string (w, s1, sz1, s2, sz2) /* Print the fastmap in human-readable form. */ @@ -1085,7 +877,7 @@ print_compiled_pattern (struct re_pattern_buffer *bufp) re_char *buffer = bufp->buffer; print_partial_compiled_pattern (buffer, buffer + bufp->used); - printf ("%ld bytes used/%ld bytes allocated.\n", + printf ("%zu bytes used/%zu bytes allocated.\n", bufp->used, bufp->allocated); if (bufp->fastmap_accurate && bufp->fastmap) @@ -1131,146 +923,100 @@ print_double_string (re_char *where, re_char *string1, ssize_t size1, } } -#else /* not DEBUG */ - -# undef assert -# define assert(e) +#else /* not REGEX_EMACS_DEBUG */ # define DEBUG_STATEMENT(e) # define DEBUG_PRINT(...) # define DEBUG_PRINT_COMPILED_PATTERN(p, s, e) # define DEBUG_PRINT_DOUBLE_STRING(w, s1, sz1, s2, sz2) -#endif /* not DEBUG */ +#endif /* not REGEX_EMACS_DEBUG */ -#ifndef emacs - -/* Set by `re_set_syntax' to the current regexp syntax to recognize. Can - also be assigned to arbitrarily: each pattern buffer stores its own - syntax, so it can be changed between regex compilations. */ -/* This has no initializer because initialized variables in Emacs - become read-only after dumping. */ -reg_syntax_t re_syntax_options; - - -/* Specify the precise syntax of regexps for compilation. This provides - for compatibility for various utilities which historically have - different, incompatible syntaxes. - - The argument SYNTAX is a bit mask comprised of the various bits - defined in regex-emacs.h. We return the old syntax. */ - -reg_syntax_t -re_set_syntax (reg_syntax_t syntax) +typedef enum { - reg_syntax_t ret = re_syntax_options; - - re_syntax_options = syntax; - return ret; -} -WEAK_ALIAS (__re_set_syntax, re_set_syntax) - -#endif - -/* This table gives an error message for each of the error codes listed - in regex-emacs.h. Obviously the order here has to be same as there. - POSIX doesn't require that we do anything for REG_NOERROR, - but why not be nice? */ + REG_NOERROR = 0, /* Success. */ + REG_NOMATCH, /* Didn't find a match (for regexec). */ + + /* POSIX regcomp return error codes. (In the order listed in the + standard.) An older version of this code supported the POSIX + API; this version continues to use these names internally. */ + REG_BADPAT, /* Invalid pattern. */ + REG_ECOLLATE, /* Not implemented. */ + REG_ECTYPE, /* Invalid character class name. */ + REG_EESCAPE, /* Trailing backslash. */ + REG_ESUBREG, /* Invalid back reference. */ + REG_EBRACK, /* Unmatched left bracket. */ + REG_EPAREN, /* Parenthesis imbalance. */ + REG_EBRACE, /* Unmatched \{. */ + REG_BADBR, /* Invalid contents of \{\}. */ + REG_ERANGE, /* Invalid range end. */ + REG_ESPACE, /* Ran out of memory. */ + REG_BADRPT, /* No preceding re for repetition op. */ + + /* Error codes we've added. */ + REG_EEND, /* Premature end. */ + REG_ESIZE, /* Compiled pattern bigger than 2^16 bytes. */ + REG_ERPAREN, /* Unmatched ) or \); not returned from regcomp. */ + REG_ERANGEX, /* Range striding over charsets. */ + REG_ESIZEBR /* n or m too big in \{n,m\} */ +} reg_errcode_t; static const char *re_error_msgid[] = { - gettext_noop ("Success"), /* REG_NOERROR */ - gettext_noop ("No match"), /* REG_NOMATCH */ - gettext_noop ("Invalid regular expression"), /* REG_BADPAT */ - gettext_noop ("Invalid collation character"), /* REG_ECOLLATE */ - gettext_noop ("Invalid character class name"), /* REG_ECTYPE */ - gettext_noop ("Trailing backslash"), /* REG_EESCAPE */ - gettext_noop ("Invalid back reference"), /* REG_ESUBREG */ - gettext_noop ("Unmatched [ or [^"), /* REG_EBRACK */ - gettext_noop ("Unmatched ( or \\("), /* REG_EPAREN */ - gettext_noop ("Unmatched \\{"), /* REG_EBRACE */ - gettext_noop ("Invalid content of \\{\\}"), /* REG_BADBR */ - gettext_noop ("Invalid range end"), /* REG_ERANGE */ - gettext_noop ("Memory exhausted"), /* REG_ESPACE */ - gettext_noop ("Invalid preceding regular expression"), /* REG_BADRPT */ - gettext_noop ("Premature end of regular expression"), /* REG_EEND */ - gettext_noop ("Regular expression too big"), /* REG_ESIZE */ - gettext_noop ("Unmatched ) or \\)"), /* REG_ERPAREN */ - gettext_noop ("Range striding over charsets"), /* REG_ERANGEX */ - gettext_noop ("Invalid content of \\{\\}, repetitions too big") /* REG_ESIZEBR */ + [REG_NOERROR] = "Success", + [REG_NOMATCH] = "No match", + [REG_BADPAT] = "Invalid regular expression", + [REG_ECOLLATE] = "Invalid collation character", + [REG_ECTYPE] = "Invalid character class name", + [REG_EESCAPE] = "Trailing backslash", + [REG_ESUBREG] = "Invalid back reference", + [REG_EBRACK] = "Unmatched [ or [^", + [REG_EPAREN] = "Unmatched ( or \\(", + [REG_EBRACE] = "Unmatched \\{", + [REG_BADBR] = "Invalid content of \\{\\}", + [REG_ERANGE] = "Invalid range end", + [REG_ESPACE] = "Memory exhausted", + [REG_BADRPT] = "Invalid preceding regular expression", + [REG_EEND] = "Premature end of regular expression", + [REG_ESIZE] = "Regular expression too big", + [REG_ERPAREN] = "Unmatched ) or \\)", + [REG_ERANGEX ] = "Range striding over charsets", + [REG_ESIZEBR ] = "Invalid content of \\{\\}", }; - -/* Whether to allocate memory during matching. */ - -/* Define MATCH_MAY_ALLOCATE to allow the searching and matching - functions allocate memory for the failure stack and registers. - Normally should be defined, because otherwise searching and - matching routines will have much smaller memory resources at their - disposal, and therefore might fail to handle complex regexps. - Therefore undefine MATCH_MAY_ALLOCATE only in the following - exceptional situations: - - . When running on a system where memory is at premium. - . When alloca cannot be used at all, perhaps due to bugs in - its implementation, or its being unavailable, or due to a - very small stack size. This requires to define REGEX_MALLOC - to use malloc instead, which in turn could lead to memory - leaks if search is interrupted by a signal. (For these - reasons, defining REGEX_MALLOC when building Emacs - automatically undefines MATCH_MAY_ALLOCATE, but outside - Emacs you may not care about memory leaks.) If you want to - prevent the memory leaks, undefine MATCH_MAY_ALLOCATE. - . When code that calls the searching and matching functions - cannot allow memory allocation, for whatever reasons. */ - -/* Normally, this is fine. */ -#define MATCH_MAY_ALLOCATE - -/* The match routines may not allocate if (1) they would do it with malloc - and (2) it's not safe for them to use malloc. - Note that if REL_ALLOC is defined, matching would not use malloc for the - failure stack, but we would still use it for the register vectors; - so REL_ALLOC should not affect this. */ -#if defined REGEX_MALLOC && defined emacs -# undef MATCH_MAY_ALLOCATE -#endif -/* While regex matching of a single compiled pattern isn't reentrant - (because we compile regexes to bytecode programs, and the bytecode - programs are self-modifying), the regex machinery must nevertheless - be reentrant with respect to _different_ patterns, and we do that - by avoiding global variables and using MATCH_MAY_ALLOCATE. */ -#if !defined MATCH_MAY_ALLOCATE && defined emacs -# error "Emacs requires MATCH_MAY_ALLOCATE" -#endif +/* For 'regs_allocated'. */ +enum { REGS_UNALLOCATED, REGS_REALLOCATE, REGS_FIXED }; +/* If 'regs_allocated' is REGS_UNALLOCATED in the pattern buffer, + 're_match_2' returns information about at least this many registers + the first time a `regs' structure is passed. */ +enum { RE_NREGS = 30 }; +/* The searching and matching functions allocate memory for the + failure stack and registers. Otherwise searching and matching + routines would have much smaller memory resources at their + disposal, and therefore might fail to handle complex regexps. */ + /* Failure stack declarations and macros; both re_compile_fastmap and re_match_2 use a failure stack. These have to be macros because of - REGEX_ALLOCATE_STACK. */ + SAFE_ALLOCA. */ /* Approximate number of failure points for which to initially allocate space when matching. If this number is exceeded, we allocate more space, so it is not a hard limit. */ -#ifndef INIT_FAILURE_ALLOC -# define INIT_FAILURE_ALLOC 20 -#endif +#define INIT_FAILURE_ALLOC 20 /* Roughly the maximum number of failure points on the stack. Would be exactly that if always used TYPICAL_FAILURE_SIZE items each time we failed. This is a variable only so users of regex can assign to it; we never change it ourselves. We always multiply it by TYPICAL_FAILURE_SIZE before using it, so it should probably be a byte-count instead. */ -# if defined MATCH_MAY_ALLOCATE /* Note that 4400 was enough to cause a crash on Alpha OSF/1, whose default stack limit is 2mb. In order for a larger value to work reliably, you have to try to make it accord with the process stack limit. */ size_t emacs_re_max_failures = 40000; -# else -size_t emacs_re_max_failures = 4000; -# endif union fail_stack_elt { @@ -1292,33 +1038,17 @@ typedef struct #define FAIL_STACK_EMPTY() (fail_stack.frame == 0) -/* Define macros to initialize and free the failure stack. - Do `return -2' if the alloc fails. */ +/* Define macros to initialize and free the failure stack. */ -#ifdef MATCH_MAY_ALLOCATE -# define INIT_FAIL_STACK() \ +#define INIT_FAIL_STACK() \ do { \ fail_stack.stack = \ - REGEX_ALLOCATE_STACK (INIT_FAILURE_ALLOC * TYPICAL_FAILURE_SIZE \ - * sizeof (fail_stack_elt_t)); \ - \ - if (fail_stack.stack == NULL) \ - return -2; \ - \ + SAFE_ALLOCA (INIT_FAILURE_ALLOC * TYPICAL_FAILURE_SIZE \ + * sizeof (fail_stack_elt_t)); \ fail_stack.size = INIT_FAILURE_ALLOC; \ fail_stack.avail = 0; \ fail_stack.frame = 0; \ } while (0) -#else -# define INIT_FAIL_STACK() \ - do { \ - fail_stack.avail = 0; \ - fail_stack.frame = 0; \ - } while (0) - -# define RETALLOC_IF(addr, n, t) \ - if (addr) RETALLOC((addr), (n), t); else (addr) = TALLOC ((n), t) -#endif /* Double the size of FAIL_STACK, up to a limit @@ -1327,7 +1057,7 @@ typedef struct Return 1 if succeeds, and 0 if either ran out of memory allocating space for it or it was already too large. - REGEX_REALLOCATE_STACK requires `destination' be declared. */ + REGEX_REALLOCATE requires `destination' be declared. */ /* Factor to increase the failure stack size by when we increase it. @@ -1340,18 +1070,15 @@ typedef struct (((fail_stack).size >= emacs_re_max_failures * TYPICAL_FAILURE_SIZE) \ ? 0 \ : ((fail_stack).stack \ - = REGEX_REALLOCATE_STACK ((fail_stack).stack, \ + = REGEX_REALLOCATE ((fail_stack).stack, \ (fail_stack).size * sizeof (fail_stack_elt_t), \ min (emacs_re_max_failures * TYPICAL_FAILURE_SIZE, \ ((fail_stack).size * FAIL_STACK_GROWTH_FACTOR)) \ * sizeof (fail_stack_elt_t)), \ - \ - (fail_stack).stack == NULL \ - ? 0 \ - : ((fail_stack).size \ - = (min (emacs_re_max_failures * TYPICAL_FAILURE_SIZE, \ - ((fail_stack).size * FAIL_STACK_GROWTH_FACTOR))), \ - 1))) + ((fail_stack).size \ + = (min (emacs_re_max_failures * TYPICAL_FAILURE_SIZE, \ + ((fail_stack).size * FAIL_STACK_GROWTH_FACTOR)))), \ + 1)) /* Push a pointer value onto the failure stack. @@ -1385,8 +1112,8 @@ typedef struct while (REMAINING_AVAIL_SLOTS <= space) { \ if (!GROW_FAIL_STACK (fail_stack)) \ return -2; \ - DEBUG_PRINT ("\n Doubled stack; size now: %zd\n", (fail_stack).size);\ - DEBUG_PRINT (" slots available: %zd\n", REMAINING_AVAIL_SLOTS);\ + DEBUG_PRINT ("\n Doubled stack; size now: %zu\n", (fail_stack).size);\ + DEBUG_PRINT (" slots available: %zu\n", REMAINING_AVAIL_SLOTS);\ } /* Push register NUM onto the stack. */ @@ -1424,7 +1151,7 @@ do { \ if (pfreg == -1) \ { \ /* It's a counter. */ \ - /* Here, we discard `const', making re_match non-reentrant. */ \ + /* Discard 'const', making re_search non-reentrant. */ \ unsigned char *ptr = (unsigned char *) POP_FAILURE_POINTER (); \ pfreg = POP_FAILURE_INT (); \ STORE_NUMBER (ptr, pfreg); \ @@ -1442,14 +1169,14 @@ do { \ /* Check that we are not stuck in an infinite loop. */ #define CHECK_INFINITE_LOOP(pat_cur, string_place) \ do { \ - ssize_t failure = TOP_FAILURE_HANDLE (); \ + ptrdiff_t failure = TOP_FAILURE_HANDLE (); \ /* Check for infinite matching loops */ \ while (failure > 0 \ && (FAILURE_STR (failure) == string_place \ || FAILURE_STR (failure) == NULL)) \ { \ - assert (FAILURE_PAT (failure) >= bufp->buffer \ - && FAILURE_PAT (failure) <= bufp->buffer + bufp->used); \ + eassert (FAILURE_PAT (failure) >= bufp->buffer \ + && FAILURE_PAT (failure) <= bufp->buffer + bufp->used); \ if (FAILURE_PAT (failure) == pat_cur) \ { \ cycle = 1; \ @@ -1478,14 +1205,14 @@ do { \ \ DEBUG_STATEMENT (nfailure_points_pushed++); \ DEBUG_PRINT ("\nPUSH_FAILURE_POINT:\n"); \ - DEBUG_PRINT (" Before push, next avail: %zd\n", (fail_stack).avail); \ - DEBUG_PRINT (" size: %zd\n", (fail_stack).size);\ + DEBUG_PRINT (" Before push, next avail: %zu\n", (fail_stack).avail); \ + DEBUG_PRINT (" size: %zu\n", (fail_stack).size);\ \ ENSURE_FAIL_STACK (NUM_NONREG_ITEMS); \ \ DEBUG_PRINT ("\n"); \ \ - DEBUG_PRINT (" Push frame index: %zd\n", fail_stack.frame); \ + DEBUG_PRINT (" Push frame index: %zu\n", fail_stack.frame); \ PUSH_FAILURE_INT (fail_stack.frame); \ \ DEBUG_PRINT (" Push string %p: \"", string_place); \ @@ -1523,12 +1250,12 @@ do { \ #define POP_FAILURE_POINT(str, pat) \ do { \ - assert (!FAIL_STACK_EMPTY ()); \ + eassert (!FAIL_STACK_EMPTY ()); \ \ /* Remove failure points and point to how many regs pushed. */ \ DEBUG_PRINT ("POP_FAILURE_POINT:\n"); \ - DEBUG_PRINT (" Before pop, next avail: %zd\n", fail_stack.avail); \ - DEBUG_PRINT (" size: %zd\n", fail_stack.size); \ + DEBUG_PRINT (" Before pop, next avail: %zu\n", fail_stack.avail); \ + DEBUG_PRINT (" size: %zu\n", fail_stack.size); \ \ /* Pop the saved registers. */ \ while (fail_stack.frame < fail_stack.avail) \ @@ -1547,10 +1274,10 @@ do { \ DEBUG_PRINT ("\"\n"); \ \ fail_stack.frame = POP_FAILURE_INT (); \ - DEBUG_PRINT (" Popping frame index: %zd\n", fail_stack.frame); \ + DEBUG_PRINT (" Popping frame index: %zu\n", fail_stack.frame); \ \ - assert (fail_stack.avail >= 0); \ - assert (fail_stack.frame <= fail_stack.avail); \ + eassert (fail_stack.avail >= 0); \ + eassert (fail_stack.frame <= fail_stack.avail); \ \ DEBUG_STATEMENT (nfailure_points_popped++); \ } while (0) /* POP_FAILURE_POINT */ @@ -1563,12 +1290,8 @@ do { \ /* Subroutine declarations and macros for regex_compile. */ static reg_errcode_t regex_compile (re_char *pattern, size_t size, -#ifdef emacs bool posix_backtracking, const char *whitespace_regexp, -#else - reg_syntax_t syntax, -#endif struct re_pattern_buffer *bufp); static void store_op1 (re_opcode_t op, unsigned char *loc, int arg); static void store_op2 (re_opcode_t op, unsigned char *loc, int arg1, int arg2); @@ -1576,10 +1299,10 @@ static void insert_op1 (re_opcode_t op, unsigned char *loc, int arg, unsigned char *end); static void insert_op2 (re_opcode_t op, unsigned char *loc, int arg1, int arg2, unsigned char *end); -static boolean at_begline_loc_p (re_char *pattern, re_char *p, - reg_syntax_t syntax); -static boolean at_endline_loc_p (re_char *p, re_char *pend, - reg_syntax_t syntax); +static bool at_begline_loc_p (re_char *pattern, re_char *p, + reg_syntax_t syntax); +static bool at_endline_loc_p (re_char *p, re_char *pend, + reg_syntax_t syntax); static re_char *skip_one_char (re_char *p); static int analyze_first (re_char *p, re_char *pend, char *fastmap, const int multibyte); @@ -1595,14 +1318,15 @@ static int analyze_first (re_char *p, re_char *pend, } while (0) -/* If `translate' is non-null, return translate[D], else just D. We +#define RE_TRANSLATE(TBL, C) char_table_translate (TBL, C) +#define RE_TRANSLATE_P(TBL) (!EQ (TBL, make_number (0))) + +/* If `translate' is non-zero, return translate[D], else just D. We cast the subscript to translate because some data is declared as `char *', to avoid warnings when a string constant is passed. But when we use a character as a subscript we must make it unsigned. */ -#ifndef TRANSLATE -# define TRANSLATE(d) \ +#define TRANSLATE(d) \ (RE_TRANSLATE_P (translate) ? RE_TRANSLATE (translate, (d)) : (d)) -#endif /* Macros for outputting the compiled pattern into `buffer'. */ @@ -1677,8 +1401,6 @@ static int analyze_first (re_char *p, re_char *pend, if (laststart_set) laststart_off = laststart - old_buffer; \ if (pending_exact_set) pending_exact_off = pending_exact - old_buffer; \ RETALLOC (bufp->buffer, bufp->allocated, unsigned char); \ - if (bufp->buffer == NULL) \ - return REG_ESPACE; \ unsigned char *new_buffer = bufp->buffer; \ b = new_buffer + b_off; \ begalt = new_buffer + begalt_off; \ @@ -1729,12 +1451,6 @@ typedef struct /* The next available element. */ #define COMPILE_STACK_TOP (compile_stack.stack[compile_stack.avail]) - -/* Explicit quit checking is needed for Emacs, which uses polling to - process input events. */ -#ifndef emacs -static void maybe_quit (void) {} -#endif /* Structure to manage work area for range table. */ struct range_table_work_area @@ -1745,8 +1461,6 @@ struct range_table_work_area int bits; /* flag to record character classes */ }; -#ifdef emacs - /* Make sure that WORK_AREA can hold more N multibyte characters. This is used only in set_image_of_range and set_image_of_range_1. It expects WORK_AREA to be a pointer. @@ -1773,13 +1487,11 @@ struct range_table_work_area (work_area).table[(work_area).used++] = (range_end); \ } while (0) -#endif /* emacs */ - /* Free allocated memory for WORK_AREA. */ #define FREE_RANGE_TABLE_WORK_AREA(work_area) \ do { \ if ((work_area).table) \ - free ((work_area).table); \ + xfree ((work_area).table); \ } while (0) #define CLEAR_RANGE_TABLE_WORK_USED(work_area) ((work_area).used = 0, (work_area).bits = 0) @@ -1807,8 +1519,6 @@ struct range_table_work_area #define SET_LIST_BIT(c) (b[((c)) / BYTEWIDTH] |= 1 << ((c) % BYTEWIDTH)) -#ifdef emacs - /* Store characters in the range FROM to TO in the bitmap at B (for ASCII and unibyte characters) and WORK_AREA (for multibyte characters) while translating them and paying attention to the @@ -1912,8 +1622,6 @@ struct range_table_work_area } \ } while (0) -#endif /* emacs */ - /* Get the next unsigned number in the uncompiled pattern. */ #define GET_INTERVAL_COUNT(num) \ do { \ @@ -1936,8 +1644,6 @@ struct range_table_work_area } \ } while (0) -#if ! WIDE_CHAR_SUPPORT - /* Parse a character class, i.e. string such as "[:name:]". *strp points to the string to be parsed and limit is length, in bytes, of that string. @@ -2031,7 +1737,7 @@ re_wctype_parse (const unsigned char **strp, unsigned limit) } /* True if CH is in the char class CC. */ -boolean +bool re_iswctype (int ch, re_wctype_t cc) { switch (cc) @@ -2084,7 +1790,6 @@ re_wctype_to_bit (re_wctype_t cc) abort (); } } -#endif /* Filling in the work area of a range. */ @@ -2094,288 +1799,16 @@ static void extend_range_table_work_area (struct range_table_work_area *work_area) { work_area->allocated += 16 * sizeof (int); - work_area->table = realloc (work_area->table, work_area->allocated); + work_area->table = xrealloc (work_area->table, work_area->allocated); } - -#if 0 -#ifdef emacs - -/* Carefully find the ranges of codes that are equivalent - under case conversion to the range start..end when passed through - TRANSLATE. Handle the case where non-letters can come in between - two upper-case letters (which happens in Latin-1). - Also handle the case of groups of more than 2 case-equivalent chars. - - The basic method is to look at consecutive characters and see - if they can form a run that can be handled as one. - - Returns -1 if successful, REG_ESPACE if ran out of space. */ - -static int -set_image_of_range_1 (struct range_table_work_area *work_area, - re_wchar_t start, re_wchar_t end, - RE_TRANSLATE_TYPE translate) -{ - /* `one_case' indicates a character, or a run of characters, - each of which is an isolate (no case-equivalents). - This includes all ASCII non-letters. - - `two_case' indicates a character, or a run of characters, - each of which has two case-equivalent forms. - This includes all ASCII letters. - - `strange' indicates a character that has more than one - case-equivalent. */ - - enum case_type {one_case, two_case, strange}; - - /* Describe the run that is in progress, - which the next character can try to extend. - If run_type is strange, that means there really is no run. - If run_type is one_case, then run_start...run_end is the run. - If run_type is two_case, then the run is run_start...run_end, - and the case-equivalents end at run_eqv_end. */ - - enum case_type run_type = strange; - int run_start, run_end, run_eqv_end; - - Lisp_Object eqv_table; - - if (!RE_TRANSLATE_P (translate)) - { - EXTEND_RANGE_TABLE (work_area, 2); - work_area->table[work_area->used++] = (start); - work_area->table[work_area->used++] = (end); - return -1; - } - - eqv_table = XCHAR_TABLE (translate)->extras[2]; - - for (; start <= end; start++) - { - enum case_type this_type; - int eqv = RE_TRANSLATE (eqv_table, start); - int minchar, maxchar; - - /* Classify this character */ - if (eqv == start) - this_type = one_case; - else if (RE_TRANSLATE (eqv_table, eqv) == start) - this_type = two_case; - else - this_type = strange; - - if (start < eqv) - minchar = start, maxchar = eqv; - else - minchar = eqv, maxchar = start; - - /* Can this character extend the run in progress? */ - if (this_type == strange || this_type != run_type - || !(minchar == run_end + 1 - && (run_type == two_case - ? maxchar == run_eqv_end + 1 : 1))) - { - /* No, end the run. - Record each of its equivalent ranges. */ - if (run_type == one_case) - { - EXTEND_RANGE_TABLE (work_area, 2); - work_area->table[work_area->used++] = run_start; - work_area->table[work_area->used++] = run_end; - } - else if (run_type == two_case) - { - EXTEND_RANGE_TABLE (work_area, 4); - work_area->table[work_area->used++] = run_start; - work_area->table[work_area->used++] = run_end; - work_area->table[work_area->used++] - = RE_TRANSLATE (eqv_table, run_start); - work_area->table[work_area->used++] - = RE_TRANSLATE (eqv_table, run_end); - } - run_type = strange; - } - - if (this_type == strange) - { - /* For a strange character, add each of its equivalents, one - by one. Don't start a range. */ - do - { - EXTEND_RANGE_TABLE (work_area, 2); - work_area->table[work_area->used++] = eqv; - work_area->table[work_area->used++] = eqv; - eqv = RE_TRANSLATE (eqv_table, eqv); - } - while (eqv != start); - } - - /* Add this char to the run, or start a new run. */ - else if (run_type == strange) - { - /* Initialize a new range. */ - run_type = this_type; - run_start = start; - run_end = start; - run_eqv_end = RE_TRANSLATE (eqv_table, run_end); - } - else - { - /* Extend a running range. */ - run_end = minchar; - run_eqv_end = RE_TRANSLATE (eqv_table, run_end); - } - } - - /* If a run is still in progress at the end, finish it now - by recording its equivalent ranges. */ - if (run_type == one_case) - { - EXTEND_RANGE_TABLE (work_area, 2); - work_area->table[work_area->used++] = run_start; - work_area->table[work_area->used++] = run_end; - } - else if (run_type == two_case) - { - EXTEND_RANGE_TABLE (work_area, 4); - work_area->table[work_area->used++] = run_start; - work_area->table[work_area->used++] = run_end; - work_area->table[work_area->used++] - = RE_TRANSLATE (eqv_table, run_start); - work_area->table[work_area->used++] - = RE_TRANSLATE (eqv_table, run_end); - } - - return -1; -} - -#endif /* emacs */ - -/* Record the image of the range start..end when passed through - TRANSLATE. This is not necessarily TRANSLATE(start)..TRANSLATE(end) - and is not even necessarily contiguous. - Normally we approximate it with the smallest contiguous range that contains - all the chars we need. However, for Latin-1 we go to extra effort - to do a better job. - - This function is not called for ASCII ranges. - - Returns -1 if successful, REG_ESPACE if ran out of space. */ - -static int -set_image_of_range (struct range_table_work_area *work_area, - re_wchar_t start, re_wchar_t end, - RE_TRANSLATE_TYPE translate) -{ - re_wchar_t cmin, cmax; - -#ifdef emacs - /* For Latin-1 ranges, use set_image_of_range_1 - to get proper handling of ranges that include letters and nonletters. - For a range that includes the whole of Latin-1, this is not necessary. - For other character sets, we don't bother to get this right. */ - if (RE_TRANSLATE_P (translate) && start < 04400 - && !(start < 04200 && end >= 04377)) - { - int newend; - int tem; - newend = end; - if (newend > 04377) - newend = 04377; - tem = set_image_of_range_1 (work_area, start, newend, translate); - if (tem > 0) - return tem; - - start = 04400; - if (end < 04400) - return -1; - } -#endif - - EXTEND_RANGE_TABLE (work_area, 2); - work_area->table[work_area->used++] = (start); - work_area->table[work_area->used++] = (end); - - cmin = -1, cmax = -1; - - if (RE_TRANSLATE_P (translate)) - { - int ch; - - for (ch = start; ch <= end; ch++) - { - re_wchar_t c = TRANSLATE (ch); - if (! (start <= c && c <= end)) - { - if (cmin == -1) - cmin = c, cmax = c; - else - { - cmin = min (cmin, c); - cmax = max (cmax, c); - } - } - } - - if (cmin != -1) - { - EXTEND_RANGE_TABLE (work_area, 2); - work_area->table[work_area->used++] = (cmin); - work_area->table[work_area->used++] = (cmax); - } - } - - return -1; -} -#endif /* 0 */ - -#ifndef MATCH_MAY_ALLOCATE - -/* If we cannot allocate large objects within re_match_2_internal, - we make the fail stack and register vectors global. - The fail stack, we grow to the maximum size when a regexp - is compiled. - The register vectors, we adjust in size each time we - compile a regexp, according to the number of registers it needs. */ - -static fail_stack_type fail_stack; - -/* Size with which the following vectors are currently allocated. - That is so we can make them bigger as needed, - but never make them smaller. */ -static int regs_allocated_size; - -static re_char ** regstart, ** regend; -static re_char **best_regstart, **best_regend; - -/* Make the register vectors big enough for NUM_REGS registers, - but don't make them smaller. */ - -static -regex_grow_registers (int num_regs) -{ - if (num_regs > regs_allocated_size) - { - RETALLOC_IF (regstart, num_regs, re_char *); - RETALLOC_IF (regend, num_regs, re_char *); - RETALLOC_IF (best_regstart, num_regs, re_char *); - RETALLOC_IF (best_regend, num_regs, re_char *); - - regs_allocated_size = num_regs; - } -} - -#endif /* not MATCH_MAY_ALLOCATE */ -static boolean group_in_compile_stack (compile_stack_type compile_stack, - regnum_t regnum); +static bool group_in_compile_stack (compile_stack_type, regnum_t); /* `regex_compile' compiles PATTERN (of length SIZE) according to SYNTAX. Returns one of error codes defined in `regex-emacs.h', or zero for success. - If WHITESPACE_REGEXP is given (only #ifdef emacs), it is used instead of - a space character in PATTERN. + If WHITESPACE_REGEXP is given, it is used instead of a space + character in PATTERN. Assumes the `allocated' (and perhaps `buffer') and `translate' fields are set in BUFP on entry. @@ -2404,42 +1837,33 @@ do { \ #define FREE_STACK_RETURN(value) \ do { \ FREE_RANGE_TABLE_WORK_AREA (range_table_work); \ - free (compile_stack.stack); \ + xfree (compile_stack.stack); \ return value; \ } while (0) static reg_errcode_t regex_compile (re_char *pattern, size_t size, -#ifdef emacs -# define syntax RE_SYNTAX_EMACS bool posix_backtracking, const char *whitespace_regexp, -#else - reg_syntax_t syntax, -# define posix_backtracking (!(syntax & RE_NO_POSIX_BACKTRACKING)) -#endif struct re_pattern_buffer *bufp) { + reg_syntax_t syntax = RE_SYNTAX_EMACS; + /* We fetch characters from PATTERN here. */ - register re_wchar_t c, c1; + int c, c1; /* Points to the end of the buffer, where we should append. */ - register unsigned char *b; + unsigned char *b; /* Keeps track of unclosed groups. */ compile_stack_type compile_stack; /* Points to the current (ending) position in the pattern. */ -#ifdef AIX - /* `const' makes AIX compiler fail. */ - unsigned char *p = pattern; -#else re_char *p = pattern; -#endif re_char *pend = pattern + size; /* How to translate the characters in the pattern. */ - RE_TRANSLATE_TYPE translate = bufp->translate; + Lisp_Object translate = bufp->translate; /* Address of the count-byte of the most recently inserted `exactn' command. This makes it possible to tell if a new exact-match @@ -2468,9 +1892,8 @@ regex_compile (re_char *pattern, size_t size, struct range_table_work_area range_table_work; /* If the object matched can contain multibyte characters. */ - const boolean multibyte = RE_MULTIBYTE_P (bufp); + bool multibyte = RE_MULTIBYTE_P (bufp); -#ifdef emacs /* Nonzero if we have pushed down into a subpattern. */ int in_subpattern = 0; @@ -2479,26 +1902,22 @@ regex_compile (re_char *pattern, size_t size, re_char *main_p; re_char *main_pattern; re_char *main_pend; -#endif -#ifdef DEBUG - debug++; +#ifdef REGEX_EMACS_DEBUG + regex_emacs_debug++; DEBUG_PRINT ("\nCompiling pattern: "); - if (debug > 0) + if (regex_emacs_debug > 0) { - unsigned debug_count; + size_t debug_count; for (debug_count = 0; debug_count < size; debug_count++) putchar (pattern[debug_count]); putchar ('\n'); } -#endif /* DEBUG */ +#endif /* Initialize the compile stack. */ compile_stack.stack = TALLOC (INIT_COMPILE_STACK_SIZE, compile_stack_elt_t); - if (compile_stack.stack == NULL) - return REG_ESPACE; - compile_stack.size = INIT_COMPILE_STACK_SIZE; compile_stack.avail = 0; @@ -2506,9 +1925,6 @@ regex_compile (re_char *pattern, size_t size, range_table_work.allocated = 0; /* Initialize the pattern buffer. */ -#ifndef emacs - bufp->syntax = syntax; -#endif bufp->fastmap_accurate = 0; bufp->not_bol = bufp->not_eol = 0; bufp->used_syntax = 0; @@ -2521,11 +1937,6 @@ regex_compile (re_char *pattern, size_t size, /* Always count groups, whether or not bufp->no_sub is set. */ bufp->re_nsub = 0; -#if !defined emacs && !defined SYNTAX_TABLE - /* Initialize the syntax table. */ - init_syntax_once (); -#endif - if (bufp->allocated == 0) { if (bufp->buffer) @@ -2538,8 +1949,6 @@ regex_compile (re_char *pattern, size_t size, { /* Caller did not allocate a buffer. Do it for them. */ bufp->buffer = TALLOC (INIT_BUF_SIZE, unsigned char); } - if (!bufp->buffer) FREE_STACK_RETURN (REG_ESPACE); - bufp->allocated = INIT_BUF_SIZE; } @@ -2550,7 +1959,6 @@ regex_compile (re_char *pattern, size_t size, { if (p == pend) { -#ifdef emacs /* If this is the end of an included regexp, pop back to the main regexp and try again. */ if (in_subpattern) @@ -2561,7 +1969,6 @@ regex_compile (re_char *pattern, size_t size, pend = main_pend; continue; } -#endif /* If this is the end of the main regexp, we are done. */ break; } @@ -2570,7 +1977,6 @@ regex_compile (re_char *pattern, size_t size, switch (c) { -#ifdef emacs case ' ': { re_char *p1 = p; @@ -2603,7 +2009,6 @@ regex_compile (re_char *pattern, size_t size, pend = p + strlen (whitespace_regexp); break; } -#endif case '^': { @@ -2654,8 +2059,8 @@ regex_compile (re_char *pattern, size_t size, { /* 1 means zero (many) matches is allowed. */ - boolean zero_times_ok = 0, many_times_ok = 0; - boolean greedy = 1; + bool zero_times_ok = false, many_times_ok = false; + bool greedy = true; /* If there is a sequence of repetition chars, collapse it down to just one (the right one). We can't combine @@ -2666,7 +2071,7 @@ regex_compile (re_char *pattern, size_t size, { if ((syntax & RE_FRUGAL) && c == '?' && (zero_times_ok || many_times_ok)) - greedy = 0; + greedy = false; else { zero_times_ok |= c != '+'; @@ -2705,13 +2110,13 @@ regex_compile (re_char *pattern, size_t size, { if (many_times_ok) { - boolean simple = skip_one_char (laststart) == b; + bool simple = skip_one_char (laststart) == b; size_t startoffset = 0; re_opcode_t ofj = /* Check if the loop can match the empty string. */ (simple || !analyze_first (laststart, b, NULL, 0)) ? on_failure_jump : on_failure_jump_loop; - assert (skip_one_char (laststart) <= b); + eassert (skip_one_char (laststart) <= b); if (!zero_times_ok && simple) { /* Since simple * loops can be made faster by using @@ -2744,7 +2149,7 @@ regex_compile (re_char *pattern, size_t size, else { /* A simple ? pattern. */ - assert (zero_times_ok); + eassert (zero_times_ok); GET_BUFFER_SPACE (3); INSERT_JUMP (on_failure_jump, laststart, b + 3); b += 3; @@ -2756,7 +2161,7 @@ regex_compile (re_char *pattern, size_t size, GET_BUFFER_SPACE (7); /* We might use less. */ if (many_times_ok) { - boolean emptyp = analyze_first (laststart, b, NULL, 0); + bool emptyp = analyze_first (laststart, b, NULL, 0); /* The non-greedy multiple match looks like a repeat..until: we only need a conditional jump @@ -2831,10 +2236,9 @@ regex_compile (re_char *pattern, size_t size, /* Read in characters and ranges, setting map bits. */ for (;;) { - boolean escaped_char = false; const unsigned char *p2 = p; re_wctype_t cc; - re_wchar_t ch; + int ch; if (p == pend) FREE_STACK_RETURN (REG_EBRACK); @@ -2849,15 +2253,6 @@ regex_compile (re_char *pattern, size_t size, if (p == pend) FREE_STACK_RETURN (REG_EBRACK); -#ifndef emacs - for (ch = 0; ch < (1 << BYTEWIDTH); ++ch) - if (re_iswctype (btowc (ch), cc)) - { - c = TRANSLATE (ch); - if (c < (1 << BYTEWIDTH)) - SET_LIST_BIT (c); - } -#else /* emacs */ /* Most character classes in a multibyte match just set a flag. Exceptions are is_blank, is_digit, is_cntrl, and is_xdigit, since they can only match ASCII characters. @@ -2884,7 +2279,7 @@ regex_compile (re_char *pattern, size_t size, } SET_RANGE_TABLE_WORK_AREA_BIT (range_table_work, re_wctype_to_bit (cc)); -#endif /* emacs */ + /* In most cases the matching rule for char classes only uses the syntax table for multibyte chars, so that the content of the syntax-table is not hardcoded in the @@ -2908,7 +2303,6 @@ regex_compile (re_char *pattern, size_t size, if (p == pend) FREE_STACK_RETURN (REG_EESCAPE); PATFETCH (c); - escaped_char = true; } else { @@ -2927,13 +2321,12 @@ regex_compile (re_char *pattern, size_t size, /* Fetch the character which ends the range. */ PATFETCH (c1); -#ifdef emacs + if (CHAR_BYTE8_P (c1) && ! ASCII_CHAR_P (c) && ! CHAR_BYTE8_P (c)) /* Treat the range from a multibyte character to raw-byte character as empty. */ c = c1 + 1; -#endif /* emacs */ } else /* Range from C to C. */ @@ -2947,15 +2340,6 @@ regex_compile (re_char *pattern, size_t size, } else { -#ifndef emacs - /* Set the range into bitmap */ - for (; c <= c1; c++) - { - ch = TRANSLATE (c); - if (ch < (1 << BYTEWIDTH)) - SET_LIST_BIT (ch); - } -#else /* emacs */ if (c < 128) { ch = min (127, c1); @@ -2982,7 +2366,6 @@ regex_compile (re_char *pattern, size_t size, SETUP_UNIBYTE_RANGE (range_table_work, c, c1); } } -#endif /* emacs */ } } @@ -3007,8 +2390,7 @@ regex_compile (re_char *pattern, size_t size, /* Indicate the existence of range table. */ laststart[1] |= 0x80; - /* Store the character class flag bits into the range table. - If not in emacs, these flag bits are always 0. */ + /* Store the character class flag bits into the range table. */ *b++ = RANGE_TABLE_WORK_BITS (range_table_work) & 0xff; *b++ = RANGE_TABLE_WORK_BITS (range_table_work) >> 8; @@ -3127,8 +2509,6 @@ regex_compile (re_char *pattern, size_t size, { RETALLOC (compile_stack.stack, compile_stack.size << 1, compile_stack_elt_t); - if (compile_stack.stack == NULL) return REG_ESPACE; - compile_stack.size <<= 1; } @@ -3184,7 +2564,7 @@ regex_compile (re_char *pattern, size_t size, /* Since we just checked for an empty stack above, this ``can't happen''. */ - assert (compile_stack.avail != 0); + eassert (compile_stack.avail != 0); { /* We don't just want to restore into `regnum', because later groups should continue to be numbered higher, @@ -3410,7 +2790,7 @@ regex_compile (re_char *pattern, size_t size, unfetch_interval: /* If an invalid interval, match the characters as literals. */ - assert (beg_interval); + eassert (beg_interval); p = beg_interval; beg_interval = NULL; @@ -3419,13 +2799,12 @@ regex_compile (re_char *pattern, size_t size, if (!(syntax & RE_NO_BK_BRACES)) { - assert (p > pattern && p[-1] == '\\'); + eassert (p > pattern && p[-1] == '\\'); goto normal_backslash; } else goto normal_char; -#ifdef emacs case '=': laststart = b; BUF_PUSH (at_dot); @@ -3454,8 +2833,6 @@ regex_compile (re_char *pattern, size_t size, PATFETCH (c); BUF_PUSH_2 (notcategoryspec, c); break; -#endif /* emacs */ - case 'w': if (syntax & RE_NO_GNU_OPS) @@ -3607,7 +2984,7 @@ regex_compile (re_char *pattern, size_t size, c1 = RE_CHAR_TO_MULTIBYTE (c); if (! CHAR_BYTE8_P (c1)) { - re_wchar_t c2 = TRANSLATE (c1); + int c2 = TRANSLATE (c1); if (c1 != c2 && (c1 = RE_CHAR_TO_UNIBYTE (c2)) >= 0) c = c1; @@ -3638,41 +3015,18 @@ regex_compile (re_char *pattern, size_t size, /* We have succeeded; set the length of the buffer. */ bufp->used = b - bufp->buffer; -#ifdef DEBUG - if (debug > 0) +#ifdef REGEX_EMACS_DEBUG + if (regex_emacs_debug > 0) { re_compile_fastmap (bufp); DEBUG_PRINT ("\nCompiled pattern: \n"); print_compiled_pattern (bufp); } - debug--; -#endif /* DEBUG */ - -#ifndef MATCH_MAY_ALLOCATE - /* Initialize the failure stack to the largest possible stack. This - isn't necessary unless we're trying to avoid calling alloca in - the search and match routines. */ - { - int num_regs = bufp->re_nsub + 1; - - if (fail_stack.size < emacs_re_max_failures * TYPICAL_FAILURE_SIZE) - { - fail_stack.size = emacs_re_max_failures * TYPICAL_FAILURE_SIZE; - falk_stack.stack = realloc (fail_stack.stack, - fail_stack.size * sizeof *falk_stack.stack); - } - - regex_grow_registers (num_regs); - } -#endif /* not MATCH_MAY_ALLOCATE */ + regex_emacs_debug--; +#endif FREE_STACK_RETURN (REG_NOERROR); -#ifdef emacs -# undef syntax -#else -# undef posix_backtracking -#endif } /* regex_compile */ /* Subroutines for `regex_compile'. */ @@ -3733,11 +3087,11 @@ insert_op2 (re_opcode_t op, unsigned char *loc, int arg1, int arg2, unsigned cha after an alternative or a begin-subexpression. We assume there is at least one character before the ^. */ -static boolean +static bool at_begline_loc_p (re_char *pattern, re_char *p, reg_syntax_t syntax) { re_char *prev = p - 2; - boolean odd_backslashes; + bool odd_backslashes; /* After a subexpression? */ if (*prev == '(') @@ -3774,11 +3128,11 @@ at_begline_loc_p (re_char *pattern, re_char *p, reg_syntax_t syntax) /* The dual of at_begline_loc_p. This one is for $. We assume there is at least one character after the $, i.e., `P < PEND'. */ -static boolean +static bool at_endline_loc_p (re_char *p, re_char *pend, reg_syntax_t syntax) { re_char *next = p; - boolean next_backslash = *next == '\\'; + bool next_backslash = *next == '\\'; re_char *next_next = p + 1 < pend ? p + 1 : 0; return @@ -3794,10 +3148,10 @@ at_endline_loc_p (re_char *p, re_char *pend, reg_syntax_t syntax) /* Returns true if REGNUM is in one of COMPILE_STACK's elements and false if it's not. */ -static boolean +static bool group_in_compile_stack (compile_stack_type compile_stack, regnum_t regnum) { - ssize_t this_element; + ptrdiff_t this_element; for (this_element = compile_stack.avail - 1; this_element >= 0; @@ -3823,13 +3177,13 @@ analyze_first (re_char *p, re_char *pend, char *fastmap, const int multibyte) { int j, k; - boolean not; + bool not; /* If all elements for base leading-codes in fastmap is set, this flag is set true. */ - boolean match_any_multibyte_characters = false; + bool match_any_multibyte_characters = false; - assert (p); + eassert (p); /* The loop below works as follows: - It has a working-list kept in the PATTERN_STACK and which basically @@ -3920,7 +3274,6 @@ analyze_first (re_char *p, re_char *pend, char *fastmap, if (!!(p[j / BYTEWIDTH] & (1 << (j % BYTEWIDTH))) ^ not) fastmap[j] = 1; -#ifdef emacs if (/* Any leading code can possibly start a character which doesn't match the specified set of characters. */ not @@ -3966,20 +3319,11 @@ analyze_first (re_char *p, re_char *pend, char *fastmap, fastmap[j] = 1; } } -#endif break; case syntaxspec: case notsyntaxspec: if (!fastmap) break; -#ifndef emacs - not = (re_opcode_t)p[-1] == notsyntaxspec; - k = *p++; - for (j = 0; j < (1 << BYTEWIDTH); j++) - if ((SYNTAX (j) == (enum syntaxcode) k) ^ not) - fastmap[j] = 1; - break; -#else /* emacs */ /* This match depends on text properties. These end with aborting optimizations. */ return -1; @@ -4008,7 +3352,6 @@ analyze_first (re_char *p, re_char *pend, char *fastmap, `continue'. */ case at_dot: -#endif /* !emacs */ case no_op: case begline: case endline: @@ -4066,7 +3409,7 @@ analyze_first (re_char *p, re_char *pend, char *fastmap, case jump_n: /* This code simply does not properly handle forward jump_n. */ - DEBUG_STATEMENT (EXTRACT_NUMBER (j, p); assert (j < 0)); + DEBUG_STATEMENT (EXTRACT_NUMBER (j, p); eassert (j < 0)); p += 4; /* jump_n can either jump or fall through. The (backward) jump case has already been handled, so we only need to look at the @@ -4075,7 +3418,7 @@ analyze_first (re_char *p, re_char *pend, char *fastmap, case succeed_n: /* If N == 0, it should be an on_failure_jump_loop instead. */ - DEBUG_STATEMENT (EXTRACT_NUMBER (j, p + 2); assert (j > 0)); + DEBUG_STATEMENT (EXTRACT_NUMBER (j, p + 2); eassert (j > 0)); p += 4; /* We only care about one iteration of the loop, so we don't need to consider the case where this behaves like an @@ -4126,13 +3469,13 @@ analyze_first (re_char *p, re_char *pend, char *fastmap, Returns 0 if we succeed, -2 if an internal error. */ -int +static void re_compile_fastmap (struct re_pattern_buffer *bufp) { char *fastmap = bufp->fastmap; int analysis; - assert (fastmap && bufp->buffer); + eassert (fastmap && bufp->buffer); memset (fastmap, 0, 1 << BYTEWIDTH); /* Assume nothing's valid. */ bufp->fastmap_accurate = 1; /* It will be when we're done. */ @@ -4140,14 +3483,13 @@ re_compile_fastmap (struct re_pattern_buffer *bufp) analysis = analyze_first (bufp->buffer, bufp->buffer + bufp->used, fastmap, RE_MULTIBYTE_P (bufp)); bufp->can_be_null = (analysis != 0); - return 0; } /* re_compile_fastmap */ /* Set REGS to hold NUM_REGS registers, storing them in STARTS and ENDS. Subsequent matches using PATTERN_BUFFER and REGS will use this memory for recording register information. STARTS and ENDS must be allocated using the malloc library routine, and must each - be at least NUM_REGS * sizeof (regoff_t) bytes long. + be at least NUM_REGS * sizeof (ptrdiff_t) bytes long. If NUM_REGS == 0, then subsequent matches should allocate their own register data. @@ -4157,7 +3499,8 @@ re_compile_fastmap (struct re_pattern_buffer *bufp) freeing the old data. */ void -re_set_registers (struct re_pattern_buffer *bufp, struct re_registers *regs, unsigned int num_regs, regoff_t *starts, regoff_t *ends) +re_set_registers (struct re_pattern_buffer *bufp, struct re_registers *regs, + unsigned int num_regs, ptrdiff_t *starts, ptrdiff_t *ends) { if (num_regs) { @@ -4173,21 +3516,19 @@ re_set_registers (struct re_pattern_buffer *bufp, struct re_registers *regs, uns regs->start = regs->end = 0; } } -WEAK_ALIAS (__re_set_registers, re_set_registers) /* Searching routines. */ /* Like re_search_2, below, but only one string is specified, and doesn't let you say where to stop matching. */ -regoff_t +ptrdiff_t re_search (struct re_pattern_buffer *bufp, const char *string, size_t size, - ssize_t startpos, ssize_t range, struct re_registers *regs) + ptrdiff_t startpos, ptrdiff_t range, struct re_registers *regs) { return re_search_2 (bufp, NULL, 0, string, size, startpos, range, regs, size); } -WEAK_ALIAS (__re_search, re_search) /* Head address of virtual concatenation of string. */ #define HEAD_ADDR_VSTRING(P) \ @@ -4218,21 +3559,21 @@ WEAK_ALIAS (__re_search, re_search) found, -1 if no match, or -2 if error (such as failure stack overflow). */ -regoff_t +ptrdiff_t re_search_2 (struct re_pattern_buffer *bufp, const char *str1, size_t size1, - const char *str2, size_t size2, ssize_t startpos, ssize_t range, - struct re_registers *regs, ssize_t stop) + const char *str2, size_t size2, ptrdiff_t startpos, ptrdiff_t range, + struct re_registers *regs, ptrdiff_t stop) { - regoff_t val; + ptrdiff_t val; re_char *string1 = (re_char *) str1; re_char *string2 = (re_char *) str2; - register char *fastmap = bufp->fastmap; - register RE_TRANSLATE_TYPE translate = bufp->translate; + char *fastmap = bufp->fastmap; + Lisp_Object translate = bufp->translate; size_t total_size = size1 + size2; - ssize_t endpos = startpos + range; - boolean anchored_start; + ptrdiff_t endpos = startpos + range; + bool anchored_start; /* Nonzero if we are searching multibyte string. */ - const boolean multibyte = RE_TARGET_MULTIBYTE_P (bufp); + bool multibyte = RE_TARGET_MULTIBYTE_P (bufp); /* Check for out-of-range STARTPOS. */ if (startpos < 0 || startpos > total_size) @@ -4256,7 +3597,6 @@ re_search_2 (struct re_pattern_buffer *bufp, const char *str1, size_t size1, range = 0; } -#ifdef emacs /* In a forward search for something that starts with \=. don't keep searching past point. */ if (bufp->used > 0 && (re_opcode_t) bufp->buffer[0] == at_dot && range > 0) @@ -4265,7 +3605,6 @@ re_search_2 (struct re_pattern_buffer *bufp, const char *str1, size_t size1, if (range < 0) return -1; } -#endif /* emacs */ /* Update the fastmap now if not correct already. */ if (fastmap && !bufp->fastmap_accurate) @@ -4274,14 +3613,12 @@ re_search_2 (struct re_pattern_buffer *bufp, const char *str1, size_t size1, /* See whether the pattern is anchored. */ anchored_start = (bufp->buffer[0] == begline); -#ifdef emacs gl_state.object = re_match_object; /* Used by SYNTAX_TABLE_BYTE_TO_CHAR. */ { - ssize_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (POS_AS_IN_BUFFER (startpos)); + ptrdiff_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (POS_AS_IN_BUFFER (startpos)); SETUP_SYNTAX_TABLE_FOR_OBJECT (re_match_object, charpos, 1); } -#endif /* Loop through the string, looking for a place to start matching. */ for (;;) @@ -4304,14 +3641,14 @@ re_search_2 (struct re_pattern_buffer *bufp, const char *str1, size_t size1, the first null string. */ if (fastmap && startpos < total_size && !bufp->can_be_null) { - register re_char *d; - register re_wchar_t buf_ch; + re_char *d; + int buf_ch; d = POS_ADDR_VSTRING (startpos); if (range > 0) /* Searching forwards. */ { - ssize_t irange = range, lim = 0; + ptrdiff_t irange = range, lim = 0; if (startpos < size1 && startpos + range >= size1) lim = range - (size1 - startpos); @@ -4336,11 +3673,9 @@ re_search_2 (struct re_pattern_buffer *bufp, const char *str1, size_t size1, else while (range > lim) { - register re_wchar_t ch, translated; - buf_ch = *d; - ch = RE_CHAR_TO_MULTIBYTE (buf_ch); - translated = RE_TRANSLATE (translate, ch); + int ch = RE_CHAR_TO_MULTIBYTE (buf_ch); + int translated = RE_TRANSLATE (translate, ch); if (translated != ch && (ch = RE_CHAR_TO_UNIBYTE (translated)) >= 0) buf_ch = ch; @@ -4383,11 +3718,9 @@ re_search_2 (struct re_pattern_buffer *bufp, const char *str1, size_t size1, } else { - register re_wchar_t ch, translated; - buf_ch = *d; - ch = RE_CHAR_TO_MULTIBYTE (buf_ch); - translated = TRANSLATE (ch); + int ch = RE_CHAR_TO_MULTIBYTE (buf_ch); + int translated = TRANSLATE (ch); if (translated != ch && (ch = RE_CHAR_TO_UNIBYTE (translated)) >= 0) buf_ch = ch; @@ -4457,13 +3790,12 @@ re_search_2 (struct re_pattern_buffer *bufp, const char *str1, size_t size1, } return -1; } /* re_search_2 */ -WEAK_ALIAS (__re_search_2, re_search_2) /* Declarations and macros for re_match_2. */ static int bcmp_translate (re_char *s1, re_char *s2, - register ssize_t len, - RE_TRANSLATE_TYPE translate, + ptrdiff_t len, + Lisp_Object translate, const int multibyte); /* This converts PTR, a pointer into one of the search strings `string1' @@ -4531,29 +3863,6 @@ static int bcmp_translate (re_char *s1, re_char *s2, || WORDCHAR_P (d - 1) != WORDCHAR_P (d)) #endif -/* Free everything we malloc. */ -#ifdef MATCH_MAY_ALLOCATE -# define FREE_VAR(var) \ - do { \ - if (var) \ - { \ - REGEX_FREE (var); \ - var = NULL; \ - } \ - } while (0) -# define FREE_VARIABLES() \ - do { \ - REGEX_FREE_STACK (fail_stack.stack); \ - FREE_VAR (regstart); \ - FREE_VAR (regend); \ - FREE_VAR (best_regstart); \ - FREE_VAR (best_regend); \ - REGEX_SAFE_FREE (); \ - } while (0) -#else -# define FREE_VARIABLES() ((void)0) /* Do nothing! But inhibit gcc warning. */ -#endif /* not MATCH_MAY_ALLOCATE */ - /* Optimization routines. */ @@ -4586,10 +3895,8 @@ skip_one_char (re_char *p) case syntaxspec: case notsyntaxspec: -#ifdef emacs case categoryspec: case notcategoryspec: -#endif /* emacs */ p++; break; @@ -4623,7 +3930,7 @@ skip_noops (re_char *p, re_char *pend) return p; } } - assert (p == pend); + eassert (p == pend); return p; } @@ -4656,11 +3963,10 @@ execute_charset (re_char **pp, unsigned c, unsigned corig, bool unibyte) && p[2 + c / BYTEWIDTH] & (1 << (c % BYTEWIDTH))) return !not; } -#ifdef emacs else if (rtp) { int class_bits = CHARSET_RANGE_TABLE_BITS (p); - re_wchar_t range_start, range_end; + int range_start, range_end; /* Sort tests by the most commonly used classes with some adjustment to which tests are easiest to perform. Take a look at comment in re_wctype_parse @@ -4691,7 +3997,7 @@ execute_charset (re_char **pp, unsigned c, unsigned corig, bool unibyte) return !not; } } -#endif /* emacs */ + return not; } @@ -4701,11 +4007,11 @@ mutually_exclusive_p (struct re_pattern_buffer *bufp, re_char *p1, re_char *p2) { re_opcode_t op2; - const boolean multibyte = RE_MULTIBYTE_P (bufp); + bool multibyte = RE_MULTIBYTE_P (bufp); unsigned char *pend = bufp->buffer + bufp->used; - assert (p1 >= bufp->buffer && p1 < pend - && p2 >= bufp->buffer && p2 <= pend); + eassert (p1 >= bufp->buffer && p1 < pend + && p2 >= bufp->buffer && p2 <= pend); /* Skip over open/close-group commands. If what follows this loop is a ...+ construct, @@ -4716,8 +4022,8 @@ mutually_exclusive_p (struct re_pattern_buffer *bufp, re_char *p1, is only used in the case where p1 is a simple match operator. */ /* p1 = skip_noops (p1, pend); */ - assert (p1 >= bufp->buffer && p1 < pend - && p2 >= bufp->buffer && p2 <= pend); + eassert (p1 >= bufp->buffer && p1 < pend + && p2 >= bufp->buffer && p2 <= pend); op2 = p2 == pend ? succeed : *p2; @@ -4736,7 +4042,7 @@ mutually_exclusive_p (struct re_pattern_buffer *bufp, re_char *p1, case endline: case exactn: { - register re_wchar_t c + int c = (re_opcode_t) *p2 == endline ? '\n' : RE_STRING_CHAR (p2 + 2, multibyte); @@ -4866,12 +4172,10 @@ mutually_exclusive_p (struct re_pattern_buffer *bufp, re_char *p1, || (re_opcode_t) *p1 == syntaxspec) && p1[1] == Sword); -#ifdef emacs case categoryspec: return ((re_opcode_t) *p1 == notcategoryspec && p1[1] == p2[1]); case notcategoryspec: return ((re_opcode_t) *p1 == categoryspec && p1[1] == p2[1]); -#endif /* emacs */ default: ; @@ -4884,20 +4188,6 @@ mutually_exclusive_p (struct re_pattern_buffer *bufp, re_char *p1, /* Matching routines. */ -#ifndef emacs /* Emacs never uses this. */ -/* re_match is like re_match_2 except it takes only a single string. */ - -regoff_t -re_match (struct re_pattern_buffer *bufp, const char *string, - size_t size, ssize_t pos, struct re_registers *regs) -{ - regoff_t result = re_match_2_internal (bufp, NULL, 0, (re_char *) string, - size, pos, regs, size); - return result; -} -WEAK_ALIAS (__re_match, re_match) -#endif /* not emacs */ - /* re_match_2 matches the compiled pattern in BUFP against the the (virtual) concatenation of STRING1 and STRING2 (of length SIZE1 and SIZE2, respectively). We start matching at POS, and stop @@ -4911,34 +4201,31 @@ WEAK_ALIAS (__re_match, re_match) failure stack overflowing). Otherwise, we return the length of the matched substring. */ -regoff_t +ptrdiff_t re_match_2 (struct re_pattern_buffer *bufp, const char *string1, - size_t size1, const char *string2, size_t size2, ssize_t pos, - struct re_registers *regs, ssize_t stop) + size_t size1, const char *string2, size_t size2, ptrdiff_t pos, + struct re_registers *regs, ptrdiff_t stop) { - regoff_t result; + ptrdiff_t result; -#ifdef emacs - ssize_t charpos; + ptrdiff_t charpos; gl_state.object = re_match_object; /* Used by SYNTAX_TABLE_BYTE_TO_CHAR. */ charpos = SYNTAX_TABLE_BYTE_TO_CHAR (POS_AS_IN_BUFFER (pos)); SETUP_SYNTAX_TABLE_FOR_OBJECT (re_match_object, charpos, 1); -#endif result = re_match_2_internal (bufp, (re_char *) string1, size1, (re_char *) string2, size2, pos, regs, stop); return result; } -WEAK_ALIAS (__re_match_2, re_match_2) /* This is a separate function so that we can force an alloca cleanup afterwards. */ -static regoff_t +static ptrdiff_t re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, size_t size1, re_char *string2, size_t size2, - ssize_t pos, struct re_registers *regs, ssize_t stop) + ptrdiff_t pos, struct re_registers *regs, ptrdiff_t stop) { /* General temporaries. */ int mcnt; @@ -4965,13 +4252,13 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, re_char *pend = p + bufp->used; /* We use this to map every character in the string. */ - RE_TRANSLATE_TYPE translate = bufp->translate; + Lisp_Object translate = bufp->translate; - /* Nonzero if BUFP is setup from a multibyte regex. */ - const boolean multibyte = RE_MULTIBYTE_P (bufp); + /* True if BUFP is setup from a multibyte regex. */ + bool multibyte = RE_MULTIBYTE_P (bufp); - /* Nonzero if STRING1/STRING2 are multibyte. */ - const boolean target_multibyte = RE_TARGET_MULTIBYTE_P (bufp); + /* True if STRING1/STRING2 are multibyte. */ + bool target_multibyte = RE_TARGET_MULTIBYTE_P (bufp); /* Failure point stack. Each place that can handle a failure further down the line pushes a failure point on this stack. It consists of @@ -4980,19 +4267,11 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, registers, and, finally, two char *'s. The first char * is where to resume scanning the pattern; the second one is where to resume scanning the strings. */ -#ifdef MATCH_MAY_ALLOCATE /* otherwise, this is global. */ fail_stack_type fail_stack; -#endif #ifdef DEBUG_COMPILES_ARGUMENTS unsigned nfailure_points_pushed = 0, nfailure_points_popped = 0; #endif -#if defined REL_ALLOC && defined REGEX_MALLOC - /* This holds the pointer to the failure stack, when - it is allocated relocatably. */ - fail_stack_elt_t *failure_stack_ptr; -#endif - /* We fill all the registers internally, independent of what we return, for use in backreferences. The number here includes an element for register zero. */ @@ -5005,18 +4284,14 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, matching and the regnum-th regend points to right after where we stopped matching the regnum-th subexpression. (The zeroth register keeps track of what the whole pattern matches.) */ -#ifdef MATCH_MAY_ALLOCATE /* otherwise, these are global. */ - re_char **regstart, **regend; -#endif + re_char **regstart UNINIT, **regend UNINIT; /* The following record the register info as found in the above variables when we find a match better than any we've seen before. This happens as we backtrack through the failure points, which in turn happens only if we have not yet matched the entire string. */ unsigned best_regs_set = false; -#ifdef MATCH_MAY_ALLOCATE /* otherwise, these are global. */ - re_char **best_regstart, **best_regend; -#endif + re_char **best_regstart UNINIT, **best_regend UNINIT; /* Logically, this is `best_regend[0]'. But we don't want to have to allocate space for that if we're not allocating space for anything @@ -5039,7 +4314,6 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, INIT_FAIL_STACK (); -#ifdef MATCH_MAY_ALLOCATE /* Do not bother to initialize all the register variables if there are no groups in the pattern, as it takes a fair amount of time. If there are groups, we include space for register 0 (the whole @@ -5047,29 +4321,16 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, array indexing. We should fix this. */ if (bufp->re_nsub) { - regstart = REGEX_TALLOC (num_regs, re_char *); - regend = REGEX_TALLOC (num_regs, re_char *); - best_regstart = REGEX_TALLOC (num_regs, re_char *); - best_regend = REGEX_TALLOC (num_regs, re_char *); - - if (!(regstart && regend && best_regstart && best_regend)) - { - FREE_VARIABLES (); - return -2; - } + regstart = SAFE_ALLOCA (num_regs * 4 * sizeof *regstart); + regend = regstart + num_regs; + best_regstart = regend + num_regs; + best_regend = best_regstart + num_regs; } - else - { - /* We must initialize all our variables to NULL, so that - `FREE_VARIABLES' doesn't try to free them. */ - regstart = regend = best_regstart = best_regend = NULL; - } -#endif /* MATCH_MAY_ALLOCATE */ /* The starting position is bogus. */ if (pos < 0 || pos > size1 + size2) { - FREE_VARIABLES (); + SAFE_FREE (); return -1; } @@ -5229,13 +4490,8 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, extra element beyond `num_regs' for the `-1' marker GNU code uses. */ regs->num_regs = max (RE_NREGS, num_regs + 1); - regs->start = TALLOC (regs->num_regs, regoff_t); - regs->end = TALLOC (regs->num_regs, regoff_t); - if (regs->start == NULL || regs->end == NULL) - { - FREE_VARIABLES (); - return -2; - } + regs->start = TALLOC (regs->num_regs, ptrdiff_t); + regs->end = TALLOC (regs->num_regs, ptrdiff_t); bufp->regs_allocated = REGS_REALLOCATE; } else if (bufp->regs_allocated == REGS_REALLOCATE) @@ -5245,21 +4501,12 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, if (regs->num_regs < num_regs + 1) { regs->num_regs = num_regs + 1; - RETALLOC (regs->start, regs->num_regs, regoff_t); - RETALLOC (regs->end, regs->num_regs, regoff_t); - if (regs->start == NULL || regs->end == NULL) - { - FREE_VARIABLES (); - return -2; - } + RETALLOC (regs->start, regs->num_regs, ptrdiff_t); + RETALLOC (regs->end, regs->num_regs, ptrdiff_t); } } else - { - /* These braces fend off a "empty body in an else-statement" - warning under GCC when assert expands to nothing. */ - assert (bufp->regs_allocated == REGS_FIXED); - } + eassert (bufp->regs_allocated == REGS_FIXED); /* Convert the pointer data in `regstart' and `regend' to indices. Register zero has to be set differently, @@ -5301,7 +4548,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, DEBUG_PRINT ("Returning %td from re_match_2.\n", dcnt); - FREE_VARIABLES (); + SAFE_FREE (); return dcnt; } @@ -5328,33 +4575,6 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, /* Remember the start point to rollback upon failure. */ dfail = d; -#ifndef emacs - /* This is written out as an if-else so we don't waste time - testing `translate' inside the loop. */ - if (RE_TRANSLATE_P (translate)) - do - { - PREFETCH (); - if (RE_TRANSLATE (translate, *d) != *p++) - { - d = dfail; - goto fail; - } - d++; - } - while (--mcnt); - else - do - { - PREFETCH (); - if (*d++ != *p++) - { - d = dfail; - goto fail; - } - } - while (--mcnt); -#else /* emacs */ /* The cost of testing `translate' is comparatively small. */ if (target_multibyte) do @@ -5419,7 +4639,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, d++; } while (--mcnt); -#endif + break; @@ -5427,7 +4647,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, case anychar: { int buf_charlen; - re_wchar_t buf_ch; + int buf_ch; reg_syntax_t syntax; DEBUG_PRINT ("EXECUTING anychar.\n"); @@ -5437,11 +4657,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, target_multibyte); buf_ch = TRANSLATE (buf_ch); -#ifdef emacs syntax = RE_SYNTAX_EMACS; -#else - syntax = bufp->syntax; -#endif if ((!(syntax & RE_DOT_NEWLINE) && buf_ch == '\n') || ((syntax & RE_DOT_NOT_NULL) && buf_ch == '\000')) @@ -5460,7 +4676,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, int len; /* Whether matching against a unibyte character. */ - boolean unibyte_char = false; + bool unibyte_char = false; DEBUG_PRINT ("EXECUTING charset%s.\n", (re_opcode_t) *(p - 1) == charset_not ? "_not" : ""); @@ -5530,10 +4746,10 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, case stop_memory: DEBUG_PRINT ("EXECUTING stop_memory %d:\n", *p); - assert (!REG_UNSET (regstart[*p])); + eassert (!REG_UNSET (regstart[*p])); /* Strictly speaking, there should be code such as: - assert (REG_UNSET (regend[*p])); + eassert (REG_UNSET (regend[*p])); PUSH_FAILURE_REGSTOP ((unsigned int)*p); But the only info to be pushed is regend[*p] and it is known to @@ -5557,7 +4773,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, followed by the numeric value of as the register number. */ case duplicate: { - register re_char *d2, *dend2; + re_char *d2, *dend2; int regno = *p++; /* Get which register to match against. */ DEBUG_PRINT ("EXECUTING duplicate %d.\n", regno); @@ -5719,7 +4935,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, DEBUG_PRINT ("EXECUTING on_failure_jump_nastyloop %d (to %p):\n", mcnt, p + mcnt); - assert ((re_opcode_t)p[-4] == no_op); + eassert ((re_opcode_t)p[-4] == no_op); { int cycle = 0; CHECK_INFINITE_LOOP (p - 4, d); @@ -5788,7 +5004,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, mcnt, p + mcnt); { re_char *p1 = p; /* Next operation. */ - /* Here, we discard `const', making re_match non-reentrant. */ + /* Discard 'const', making re_search non-reentrant. */ unsigned char *p2 = (unsigned char *) p + mcnt; /* Jump dest. */ unsigned char *p3 = (unsigned char *) p - 3; /* opcode location. */ @@ -5799,9 +5015,9 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, /* Ensure this is indeed the trivial kind of loop we are expecting. */ - assert (skip_one_char (p1) == p2 - 3); - assert ((re_opcode_t) p2[-3] == jump && p2 + mcnt == p); - DEBUG_STATEMENT (debug += 2); + eassert (skip_one_char (p1) == p2 - 3); + eassert ((re_opcode_t) p2[-3] == jump && p2 + mcnt == p); + DEBUG_STATEMENT (regex_emacs_debug += 2); if (mutually_exclusive_p (bufp, p1, p2)) { /* Use a fast `on_failure_keep_string_jump' loop. */ @@ -5815,7 +5031,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, DEBUG_PRINT (" smart default => slow loop.\n"); *p3 = (unsigned char) on_failure_jump; } - DEBUG_STATEMENT (debug -= 2); + DEBUG_STATEMENT (regex_emacs_debug -= 2); } break; @@ -5840,7 +5056,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, /* Originally, mcnt is how many times we HAVE to succeed. */ if (mcnt != 0) { - /* Here, we discard `const', making re_match non-reentrant. */ + /* Discard 'const', making re_search non-reentrant. */ unsigned char *p2 = (unsigned char *) p + 2; /* counter loc. */ mcnt--; p += 4; @@ -5859,7 +5075,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, /* Originally, this is how many times we CAN jump. */ if (mcnt != 0) { - /* Here, we discard `const', making re_match non-reentrant. */ + /* Discard 'const', making re_search non-reentrant. */ unsigned char *p2 = (unsigned char *) p + 2; /* counter loc. */ mcnt--; PUSH_NUMBER (p2, mcnt); @@ -5876,7 +5092,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, DEBUG_PRINT ("EXECUTING set_number_at.\n"); EXTRACT_NUMBER_AND_INCR (mcnt, p); - /* Here, we discard `const', making re_match non-reentrant. */ + /* Discard 'const', making re_search non-reentrant. */ p2 = (unsigned char *) p + mcnt; /* Signedness doesn't matter since we only copy MCNT's bits. */ EXTRACT_NUMBER_AND_INCR (mcnt, p); @@ -5888,7 +5104,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, case wordbound: case notwordbound: { - boolean not = (re_opcode_t) *(p - 1) == notwordbound; + bool not = (re_opcode_t) *(p - 1) == notwordbound; DEBUG_PRINT ("EXECUTING %swordbound.\n", not ? "not" : ""); /* We SUCCEED (or FAIL) in one of the following cases: */ @@ -5900,19 +5116,15 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, { /* C1 is the character before D, S1 is the syntax of C1, C2 is the character at D, and S2 is the syntax of C2. */ - re_wchar_t c1, c2; + int c1, c2; int s1, s2; int dummy; -#ifdef emacs - ssize_t offset = PTR_TO_OFFSET (d - 1); - ssize_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset); + ptrdiff_t offset = PTR_TO_OFFSET (d - 1); + ptrdiff_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset); UPDATE_SYNTAX_TABLE (charpos); -#endif GET_CHAR_BEFORE_2 (c1, d, string1, end1, string2, end2); s1 = SYNTAX (c1); -#ifdef emacs UPDATE_SYNTAX_TABLE_FORWARD (charpos + 1); -#endif PREFETCH_NOLIMIT (); GET_CHAR_AFTER (c2, d, dummy); s2 = SYNTAX (c2); @@ -5942,14 +5154,12 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, { /* C1 is the character before D, S1 is the syntax of C1, C2 is the character at D, and S2 is the syntax of C2. */ - re_wchar_t c1, c2; + int c1, c2; int s1, s2; int dummy; -#ifdef emacs - ssize_t offset = PTR_TO_OFFSET (d); - ssize_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset); + ptrdiff_t offset = PTR_TO_OFFSET (d); + ptrdiff_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset); UPDATE_SYNTAX_TABLE (charpos); -#endif PREFETCH (); GET_CHAR_AFTER (c2, d, dummy); s2 = SYNTAX (c2); @@ -5962,9 +5172,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, if (!AT_STRINGS_BEG (d)) { GET_CHAR_BEFORE_2 (c1, d, string1, end1, string2, end2); -#ifdef emacs UPDATE_SYNTAX_TABLE_BACKWARD (charpos - 1); -#endif s1 = SYNTAX (c1); /* ... and S1 is Sword, and WORD_BOUNDARY_P (C1, C2) @@ -5987,14 +5195,12 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, { /* C1 is the character before D, S1 is the syntax of C1, C2 is the character at D, and S2 is the syntax of C2. */ - re_wchar_t c1, c2; + int c1, c2; int s1, s2; int dummy; -#ifdef emacs - ssize_t offset = PTR_TO_OFFSET (d) - 1; - ssize_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset); + ptrdiff_t offset = PTR_TO_OFFSET (d) - 1; + ptrdiff_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset); UPDATE_SYNTAX_TABLE (charpos); -#endif GET_CHAR_BEFORE_2 (c1, d, string1, end1, string2, end2); s1 = SYNTAX (c1); @@ -6007,9 +5213,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, { PREFETCH_NOLIMIT (); GET_CHAR_AFTER (c2, d, dummy); -#ifdef emacs UPDATE_SYNTAX_TABLE_FORWARD (charpos); -#endif s2 = SYNTAX (c2); /* ... and S2 is Sword, and WORD_BOUNDARY_P (C1, C2) @@ -6032,13 +5236,11 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, { /* C1 is the character before D, S1 is the syntax of C1, C2 is the character at D, and S2 is the syntax of C2. */ - re_wchar_t c1, c2; + int c1, c2; int s1, s2; -#ifdef emacs - ssize_t offset = PTR_TO_OFFSET (d); - ssize_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset); + ptrdiff_t offset = PTR_TO_OFFSET (d); + ptrdiff_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset); UPDATE_SYNTAX_TABLE (charpos); -#endif PREFETCH (); c2 = RE_STRING_CHAR (d, target_multibyte); s2 = SYNTAX (c2); @@ -6051,9 +5253,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, if (!AT_STRINGS_BEG (d)) { GET_CHAR_BEFORE_2 (c1, d, string1, end1, string2, end2); -#ifdef emacs UPDATE_SYNTAX_TABLE_BACKWARD (charpos - 1); -#endif s1 = SYNTAX (c1); /* ... and S1 is Sword or Ssymbol. */ @@ -6075,13 +5275,11 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, { /* C1 is the character before D, S1 is the syntax of C1, C2 is the character at D, and S2 is the syntax of C2. */ - re_wchar_t c1, c2; + int c1, c2; int s1, s2; -#ifdef emacs - ssize_t offset = PTR_TO_OFFSET (d) - 1; - ssize_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset); + ptrdiff_t offset = PTR_TO_OFFSET (d) - 1; + ptrdiff_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset); UPDATE_SYNTAX_TABLE (charpos); -#endif GET_CHAR_BEFORE_2 (c1, d, string1, end1, string2, end2); s1 = SYNTAX (c1); @@ -6094,9 +5292,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, { PREFETCH_NOLIMIT (); c2 = RE_STRING_CHAR (d, target_multibyte); -#ifdef emacs UPDATE_SYNTAX_TABLE_FORWARD (charpos + 1); -#endif s2 = SYNTAX (c2); /* ... and S2 is Sword or Ssymbol. */ @@ -6109,21 +5305,19 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, case syntaxspec: case notsyntaxspec: { - boolean not = (re_opcode_t) *(p - 1) == notsyntaxspec; + bool not = (re_opcode_t) *(p - 1) == notsyntaxspec; mcnt = *p++; DEBUG_PRINT ("EXECUTING %ssyntaxspec %d.\n", not ? "not" : "", mcnt); PREFETCH (); -#ifdef emacs { - ssize_t offset = PTR_TO_OFFSET (d); - ssize_t pos1 = SYNTAX_TABLE_BYTE_TO_CHAR (offset); + ptrdiff_t offset = PTR_TO_OFFSET (d); + ptrdiff_t pos1 = SYNTAX_TABLE_BYTE_TO_CHAR (offset); UPDATE_SYNTAX_TABLE (pos1); } -#endif { int len; - re_wchar_t c; + int c; GET_CHAR_AFTER (c, d, len); if ((SYNTAX (c) != (enum syntaxcode) mcnt) ^ not) @@ -6133,7 +5327,6 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, } break; -#ifdef emacs case at_dot: DEBUG_PRINT ("EXECUTING at_dot.\n"); if (PTR_BYTE_POS (d) != PT_BYTE) @@ -6143,7 +5336,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, case categoryspec: case notcategoryspec: { - boolean not = (re_opcode_t) *(p - 1) == notcategoryspec; + bool not = (re_opcode_t) *(p - 1) == notcategoryspec; mcnt = *p++; DEBUG_PRINT ("EXECUTING %scategoryspec %d.\n", not ? "not" : "", mcnt); @@ -6151,7 +5344,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, { int len; - re_wchar_t c; + int c; GET_CHAR_AFTER (c, d, len); if ((!CHAR_HAS_CATEGORY (c, mcnt)) ^ not) goto fail; @@ -6160,8 +5353,6 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, } break; -#endif /* emacs */ - default: abort (); } @@ -6180,11 +5371,11 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, switch (*pat++) { case on_failure_keep_string_jump: - assert (str == NULL); + eassert (str == NULL); goto continue_failure_jump; case on_failure_jump_nastyloop: - assert ((re_opcode_t)pat[-2] == no_op); + eassert ((re_opcode_t)pat[-2] == no_op); PUSH_FAILURE_POINT (pat - 2, str); FALLTHROUGH; case on_failure_jump_loop: @@ -6204,7 +5395,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, abort (); } - assert (p >= bufp->buffer && p <= pend); + eassert (p >= bufp->buffer && p <= pend); if (d >= string1 && d <= end1) dend = end_match_1; @@ -6216,7 +5407,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, if (best_regs_set) goto restore_best_regs; - FREE_VARIABLES (); + SAFE_FREE (); return -1; /* Failure to match. */ } @@ -6227,8 +5418,8 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, bytes; nonzero otherwise. */ static int -bcmp_translate (re_char *s1, re_char *s2, ssize_t len, - RE_TRANSLATE_TYPE translate, const int target_multibyte) +bcmp_translate (re_char *s1, re_char *s2, ptrdiff_t len, + Lisp_Object translate, int target_multibyte) { re_char *p1 = s1, *p2 = s2; re_char *p1_end = s1 + len; @@ -6239,7 +5430,7 @@ bcmp_translate (re_char *s1, re_char *s2, ssize_t len, while (p1 < p1_end && p2 < p2_end) { int p1_charlen, p2_charlen; - re_wchar_t p1_ch, p2_ch; + int p1_ch, p2_ch; GET_CHAR_AFTER (p1_ch, p1, p1_charlen); GET_CHAR_AFTER (p2_ch, p2, p2_charlen); @@ -6270,9 +5461,7 @@ bcmp_translate (re_char *s1, re_char *s2, ssize_t len, const char * re_compile_pattern (const char *pattern, size_t length, -#ifdef emacs bool posix_backtracking, const char *whitespace_regexp, -#endif struct re_pattern_buffer *bufp) { reg_errcode_t ret; @@ -6282,334 +5471,16 @@ re_compile_pattern (const char *pattern, size_t length, bufp->regs_allocated = REGS_UNALLOCATED; /* And GNU code determines whether or not to get register information - by passing null for the REGS argument to re_match, etc., not by + by passing null for the REGS argument to re_search, etc., not by setting no_sub. */ bufp->no_sub = 0; ret = regex_compile ((re_char *) pattern, length, -#ifdef emacs posix_backtracking, whitespace_regexp, -#else - re_syntax_options, -#endif bufp); if (!ret) return NULL; - return gettext (re_error_msgid[(int) ret]); -} -WEAK_ALIAS (__re_compile_pattern, re_compile_pattern) - -/* Entry points compatible with 4.2 BSD regex library. We don't define - them unless specifically requested. */ - -#if defined _REGEX_RE_COMP || defined _LIBC - -/* BSD has one and only one pattern buffer. */ -static struct re_pattern_buffer re_comp_buf; - -char * -# ifdef _LIBC -/* Make these definitions weak in libc, so POSIX programs can redefine - these names if they don't use our functions, and still use - regcomp/regexec below without link errors. */ -weak_function -# endif -re_comp (const char *s) -{ - reg_errcode_t ret; - - if (!s) - { - if (!re_comp_buf.buffer) - /* Yes, we're discarding `const' here if !HAVE_LIBINTL. */ - return (char *) gettext ("No previous regular expression"); - return 0; - } - - if (!re_comp_buf.buffer) - { - re_comp_buf.buffer = malloc (200); - if (re_comp_buf.buffer == NULL) - /* Yes, we're discarding `const' here if !HAVE_LIBINTL. */ - return (char *) gettext (re_error_msgid[(int) REG_ESPACE]); - re_comp_buf.allocated = 200; - - re_comp_buf.fastmap = malloc (1 << BYTEWIDTH); - if (re_comp_buf.fastmap == NULL) - /* Yes, we're discarding `const' here if !HAVE_LIBINTL. */ - return (char *) gettext (re_error_msgid[(int) REG_ESPACE]); - } - - /* Since `re_exec' always passes NULL for the `regs' argument, we - don't need to initialize the pattern buffer fields which affect it. */ - - ret = regex_compile (s, strlen (s), re_syntax_options, &re_comp_buf); - - if (!ret) - return NULL; - - /* Yes, we're discarding `const' here if !HAVE_LIBINTL. */ - return (char *) gettext (re_error_msgid[(int) ret]); -} - - -int -# ifdef _LIBC -weak_function -# endif -re_exec (const char *s) -{ - const size_t len = strlen (s); - return re_search (&re_comp_buf, s, len, 0, len, 0) >= 0; + return re_error_msgid[ret]; } -#endif /* _REGEX_RE_COMP */ - -/* POSIX.2 functions. Don't define these for Emacs. */ - -#ifndef emacs - -/* regcomp takes a regular expression as a string and compiles it. - - PREG is a regex_t *. We do not expect any fields to be initialized, - since POSIX says we shouldn't. Thus, we set - - `buffer' to the compiled pattern; - `used' to the length of the compiled pattern; - `syntax' to RE_SYNTAX_POSIX_EXTENDED if the - REG_EXTENDED bit in CFLAGS is set; otherwise, to - RE_SYNTAX_POSIX_BASIC; - `fastmap' to an allocated space for the fastmap; - `fastmap_accurate' to zero; - `re_nsub' to the number of subexpressions in PATTERN. - - PATTERN is the address of the pattern string. - - CFLAGS is a series of bits which affect compilation. - - If REG_EXTENDED is set, we use POSIX extended syntax; otherwise, we - use POSIX basic syntax. - - If REG_NEWLINE is set, then . and [^...] don't match newline. - Also, regexec will try a match beginning after every newline. - - If REG_ICASE is set, then we considers upper- and lowercase - versions of letters to be equivalent when matching. - - If REG_NOSUB is set, then when PREG is passed to regexec, that - routine will report only success or failure, and nothing about the - registers. - - It returns 0 if it succeeds, nonzero if it doesn't. (See regex-emacs.h for - the return codes and their meanings.) */ - -reg_errcode_t -regcomp (regex_t *_Restrict_ preg, const char *_Restrict_ pattern, - int cflags) -{ - reg_errcode_t ret; - reg_syntax_t syntax - = (cflags & REG_EXTENDED) ? - RE_SYNTAX_POSIX_EXTENDED : RE_SYNTAX_POSIX_BASIC; - - /* regex_compile will allocate the space for the compiled pattern. */ - preg->buffer = 0; - preg->allocated = 0; - preg->used = 0; - - /* Try to allocate space for the fastmap. */ - preg->fastmap = malloc (1 << BYTEWIDTH); - - if (cflags & REG_ICASE) - { - unsigned i; - - preg->translate = malloc (CHAR_SET_SIZE * sizeof *preg->translate); - if (preg->translate == NULL) - return (int) REG_ESPACE; - - /* Map uppercase characters to corresponding lowercase ones. */ - for (i = 0; i < CHAR_SET_SIZE; i++) - preg->translate[i] = ISUPPER (i) ? TOLOWER (i) : i; - } - else - preg->translate = NULL; - - /* If REG_NEWLINE is set, newlines are treated differently. */ - if (cflags & REG_NEWLINE) - { /* REG_NEWLINE implies neither . nor [^...] match newline. */ - syntax &= ~RE_DOT_NEWLINE; - syntax |= RE_HAT_LISTS_NOT_NEWLINE; - } - else - syntax |= RE_NO_NEWLINE_ANCHOR; - - preg->no_sub = !!(cflags & REG_NOSUB); - - /* POSIX says a null character in the pattern terminates it, so we - can use strlen here in compiling the pattern. */ - ret = regex_compile ((re_char *) pattern, strlen (pattern), syntax, preg); - - /* POSIX doesn't distinguish between an unmatched open-group and an - unmatched close-group: both are REG_EPAREN. */ - if (ret == REG_ERPAREN) - ret = REG_EPAREN; - - if (ret == REG_NOERROR && preg->fastmap) - { /* Compute the fastmap now, since regexec cannot modify the pattern - buffer. */ - re_compile_fastmap (preg); - if (preg->can_be_null) - { /* The fastmap can't be used anyway. */ - free (preg->fastmap); - preg->fastmap = NULL; - } - } - return ret; -} -WEAK_ALIAS (__regcomp, regcomp) - - -/* regexec searches for a given pattern, specified by PREG, in the - string STRING. - - If NMATCH is zero or REG_NOSUB was set in the cflags argument to - `regcomp', we ignore PMATCH. Otherwise, we assume PMATCH has at - least NMATCH elements, and we set them to the offsets of the - corresponding matched substrings. - - EFLAGS specifies `execution flags' which affect matching: if - REG_NOTBOL is set, then ^ does not match at the beginning of the - string; if REG_NOTEOL is set, then $ does not match at the end. - - We return 0 if we find a match and REG_NOMATCH if not. */ - -reg_errcode_t -regexec (const regex_t *_Restrict_ preg, const char *_Restrict_ string, - size_t nmatch, regmatch_t pmatch[_Restrict_arr_], int eflags) -{ - regoff_t ret; - struct re_registers regs; - regex_t private_preg; - size_t len = strlen (string); - boolean want_reg_info = !preg->no_sub && nmatch > 0 && pmatch; - - private_preg = *preg; - - private_preg.not_bol = !!(eflags & REG_NOTBOL); - private_preg.not_eol = !!(eflags & REG_NOTEOL); - - /* The user has told us exactly how many registers to return - information about, via `nmatch'. We have to pass that on to the - matching routines. */ - private_preg.regs_allocated = REGS_FIXED; - - if (want_reg_info) - { - regs.num_regs = nmatch; - regs.start = TALLOC (nmatch * 2, regoff_t); - if (regs.start == NULL) - return REG_NOMATCH; - regs.end = regs.start + nmatch; - } - - /* Instead of using not_eol to implement REG_NOTEOL, we could simply - pass (&private_preg, string, len + 1, 0, len, ...) pretending the string - was a little bit longer but still only matching the real part. - This works because the `endline' will check for a '\n' and will find a - '\0', correctly deciding that this is not the end of a line. - But it doesn't work out so nicely for REG_NOTBOL, since we don't have - a convenient '\0' there. For all we know, the string could be preceded - by '\n' which would throw things off. */ - - /* Perform the searching operation. */ - ret = re_search (&private_preg, string, len, - /* start: */ 0, /* range: */ len, - want_reg_info ? ®s : 0); - - /* Copy the register information to the POSIX structure. */ - if (want_reg_info) - { - if (ret >= 0) - { - unsigned r; - - for (r = 0; r < nmatch; r++) - { - pmatch[r].rm_so = regs.start[r]; - pmatch[r].rm_eo = regs.end[r]; - } - } - - /* If we needed the temporary register info, free the space now. */ - free (regs.start); - } - - /* We want zero return to mean success, unlike `re_search'. */ - return ret >= 0 ? REG_NOERROR : REG_NOMATCH; -} -WEAK_ALIAS (__regexec, regexec) - - -/* Returns a message corresponding to an error code, ERR_CODE, returned - from either regcomp or regexec. We don't use PREG here. - - ERR_CODE was previously called ERRCODE, but that name causes an - error with msvc8 compiler. */ - -size_t -regerror (int err_code, const regex_t *preg, char *errbuf, size_t errbuf_size) -{ - const char *msg; - size_t msg_size; - - if (err_code < 0 - || err_code >= (sizeof (re_error_msgid) / sizeof (re_error_msgid[0]))) - /* Only error codes returned by the rest of the code should be passed - to this routine. If we are given anything else, or if other regex - code generates an invalid error code, then the program has a bug. - Dump core so we can fix it. */ - abort (); - - msg = gettext (re_error_msgid[err_code]); - - msg_size = strlen (msg) + 1; /* Includes the null. */ - - if (errbuf_size != 0) - { - if (msg_size > errbuf_size) - { - memcpy (errbuf, msg, errbuf_size - 1); - errbuf[errbuf_size - 1] = 0; - } - else - strcpy (errbuf, msg); - } - - return msg_size; -} -WEAK_ALIAS (__regerror, regerror) - - -/* Free dynamically allocated space used by PREG. */ - -void -regfree (regex_t *preg) -{ - free (preg->buffer); - preg->buffer = NULL; - - preg->allocated = 0; - preg->used = 0; - - free (preg->fastmap); - preg->fastmap = NULL; - preg->fastmap_accurate = 0; - - free (preg->translate); - preg->translate = NULL; -} -WEAK_ALIAS (__regfree, regfree) - -#endif /* not emacs */ diff --git a/src/regex-emacs.h b/src/regex-emacs.h index 9a6214af98..159c7dcb9b 100644 --- a/src/regex-emacs.h +++ b/src/regex-emacs.h @@ -17,163 +17,24 @@ You should have received a copy of the GNU General Public License along with this program. If not, see . */ -#ifndef _REGEX_H -#define _REGEX_H 1 - -#if defined emacs && (defined _REGEX_RE_COMP || defined _LIBC) -/* We're not defining re_set_syntax and using a different prototype of - re_compile_pattern when building Emacs so fail compilation early with - a (somewhat helpful) error message when conflict is detected. */ -# error "_REGEX_RE_COMP nor _LIBC can be defined if emacs is defined." -#endif - -#include - -/* Allow the use in C++ code. */ -#ifdef __cplusplus -extern "C" { -#endif - -#if !defined _POSIX_C_SOURCE && !defined _POSIX_SOURCE && defined VMS -/* VMS doesn't have `size_t' in , even though POSIX says it - should be there. */ -# include -#endif - -/* The following bits are used to determine the regexp syntax we - recognize. The set/not-set meanings where historically chosen so - that Emacs syntax had the value 0. - The bits are given in alphabetical order, and - the definitions shifted by one from the previous bit; thus, when we - add or remove a bit, only one other definition need change. */ -typedef unsigned long reg_syntax_t; - -/* If this bit is not set, then \ inside a bracket expression is literal. - If set, then such a \ quotes the following character. */ -#define RE_BACKSLASH_ESCAPE_IN_LISTS ((unsigned long int) 1) - -/* If this bit is not set, then + and ? are operators, and \+ and \? are - literals. - If set, then \+ and \? are operators and + and ? are literals. */ -#define RE_BK_PLUS_QM (RE_BACKSLASH_ESCAPE_IN_LISTS << 1) - -/* If this bit is set, then character classes are supported. They are: - [:alpha:], [:upper:], [:lower:], [:digit:], [:alnum:], [:xdigit:], - [:space:], [:print:], [:punct:], [:graph:], and [:cntrl:]. - If not set, then character classes are not supported. */ -#define RE_CHAR_CLASSES (RE_BK_PLUS_QM << 1) - -/* If this bit is set, then ^ and $ are always anchors (outside bracket - expressions, of course). - If this bit is not set, then it depends: - ^ is an anchor if it is at the beginning of a regular - expression or after an open-group or an alternation operator; - $ is an anchor if it is at the end of a regular expression, or - before a close-group or an alternation operator. - - This bit could be (re)combined with RE_CONTEXT_INDEP_OPS, because - POSIX draft 11.2 says that * etc. in leading positions is undefined. - We already implemented a previous draft which made those constructs - invalid, though, so we haven't changed the code back. */ -#define RE_CONTEXT_INDEP_ANCHORS (RE_CHAR_CLASSES << 1) - -/* If this bit is set, then special characters are always special - regardless of where they are in the pattern. - If this bit is not set, then special characters are special only in - some contexts; otherwise they are ordinary. Specifically, - * + ? and intervals are only special when not after the beginning, - open-group, or alternation operator. */ -#define RE_CONTEXT_INDEP_OPS (RE_CONTEXT_INDEP_ANCHORS << 1) - -/* If this bit is set, then *, +, ?, and { cannot be first in an re or - immediately after an alternation or begin-group operator. */ -#define RE_CONTEXT_INVALID_OPS (RE_CONTEXT_INDEP_OPS << 1) - -/* If this bit is set, then . matches newline. - If not set, then it doesn't. */ -#define RE_DOT_NEWLINE (RE_CONTEXT_INVALID_OPS << 1) - -/* If this bit is set, then . doesn't match NUL. - If not set, then it does. */ -#define RE_DOT_NOT_NULL (RE_DOT_NEWLINE << 1) - -/* If this bit is set, nonmatching lists [^...] do not match newline. - If not set, they do. */ -#define RE_HAT_LISTS_NOT_NEWLINE (RE_DOT_NOT_NULL << 1) - -/* If this bit is set, either \{...\} or {...} defines an - interval, depending on RE_NO_BK_BRACES. - If not set, \{, \}, {, and } are literals. */ -#define RE_INTERVALS (RE_HAT_LISTS_NOT_NEWLINE << 1) - -/* If this bit is set, +, ? and | aren't recognized as operators. - If not set, they are. */ -#define RE_LIMITED_OPS (RE_INTERVALS << 1) - -/* If this bit is set, newline is an alternation operator. - If not set, newline is literal. */ -#define RE_NEWLINE_ALT (RE_LIMITED_OPS << 1) - -/* If this bit is set, then `{...}' defines an interval, and \{ and \} - are literals. - If not set, then `\{...\}' defines an interval. */ -#define RE_NO_BK_BRACES (RE_NEWLINE_ALT << 1) - -/* If this bit is set, (...) defines a group, and \( and \) are literals. - If not set, \(...\) defines a group, and ( and ) are literals. */ -#define RE_NO_BK_PARENS (RE_NO_BK_BRACES << 1) - -/* If this bit is set, then \ matches . - If not set, then \ is a back-reference. */ -#define RE_NO_BK_REFS (RE_NO_BK_PARENS << 1) - -/* If this bit is set, then | is an alternation operator, and \| is literal. - If not set, then \| is an alternation operator, and | is literal. */ -#define RE_NO_BK_VBAR (RE_NO_BK_REFS << 1) - -/* If this bit is set, then an ending range point collating higher - than the starting range point, as in [z-a], is invalid. - If not set, then when ending range point collates higher than the - starting range point, the range is ignored. */ -#define RE_NO_EMPTY_RANGES (RE_NO_BK_VBAR << 1) - -/* If this bit is set, then an unmatched ) is ordinary. - If not set, then an unmatched ) is invalid. */ -#define RE_UNMATCHED_RIGHT_PAREN_ORD (RE_NO_EMPTY_RANGES << 1) - -/* If this bit is set, succeed as soon as we match the whole pattern, - without further backtracking. */ -#define RE_NO_POSIX_BACKTRACKING (RE_UNMATCHED_RIGHT_PAREN_ORD << 1) - -/* If this bit is set, do not process the GNU regex operators. - If not set, then the GNU regex operators are recognized. */ -#define RE_NO_GNU_OPS (RE_NO_POSIX_BACKTRACKING << 1) - -/* If this bit is set, then *?, +? and ?? match non greedily. */ -#define RE_FRUGAL (RE_NO_GNU_OPS << 1) - -/* If this bit is set, then (?:...) is treated as a shy group. */ -#define RE_SHY_GROUPS (RE_FRUGAL << 1) - -/* If this bit is set, ^ and $ only match at beg/end of buffer. */ -#define RE_NO_NEWLINE_ANCHOR (RE_SHY_GROUPS << 1) - -/* If this bit is set, turn on internal regex debugging. - If not set, and debugging was on, turn it off. - This only works if regex-emacs.c is compiled -DDEBUG. - We define this bit always, so that all that's needed to turn on - debugging is to recompile regex-emacs.c; the calling code can always have - this bit set, and it won't affect anything in the normal case. */ -#define RE_DEBUG (RE_NO_NEWLINE_ANCHOR << 1) - -/* This global variable defines the particular regexp syntax to use (for - some interfaces). When a regexp is compiled, the syntax used is - stored in the pattern buffer, so changing this does not affect - already-compiled regexps. */ -/* extern reg_syntax_t re_syntax_options; */ - -#ifdef emacs -# include "lisp.h" +#ifndef EMACS_REGEX_H +#define EMACS_REGEX_H 1 + +#include + +/* This is the structure we store register match data in. See + regex.texinfo for a full description of what registers match. + Declare this before including lisp.h, since lisp.h (via thread.h) + uses struct re_registers. */ +struct re_registers +{ + unsigned num_regs; + ptrdiff_t *start; + ptrdiff_t *end; +}; + +#include "lisp.h" + /* In Emacs, this is the string or buffer in which we are matching. It is used for looking up syntax properties. @@ -187,187 +48,23 @@ typedef unsigned long reg_syntax_t; and match functions. These functions capture the current value of re_match_object into gl_state on entry. - TODO: once we get rid of the !emacs case in this code, turn into an - actual function parameter. */ + TODO: turn into an actual function parameter. */ extern Lisp_Object re_match_object; -#endif /* Roughly the maximum number of failure points on the stack. */ extern size_t emacs_re_max_failures; -#ifdef emacs /* Amount of memory that we can safely stack allocate. */ extern ptrdiff_t emacs_re_safe_alloca; -#endif - - -/* Define combinations of the above bits for the standard possibilities. - (The [[[ comments delimit what gets put into the Texinfo file, so - don't delete them!) */ -/* [[[begin syntaxes]]] */ -#define RE_SYNTAX_EMACS \ - (RE_CHAR_CLASSES | RE_INTERVALS | RE_SHY_GROUPS | RE_FRUGAL) - -#define RE_SYNTAX_AWK \ - (RE_BACKSLASH_ESCAPE_IN_LISTS | RE_DOT_NOT_NULL \ - | RE_NO_BK_PARENS | RE_NO_BK_REFS \ - | RE_NO_BK_VBAR | RE_NO_EMPTY_RANGES \ - | RE_DOT_NEWLINE | RE_CONTEXT_INDEP_ANCHORS \ - | RE_UNMATCHED_RIGHT_PAREN_ORD | RE_NO_GNU_OPS) - -#define RE_SYNTAX_GNU_AWK \ - ((RE_SYNTAX_POSIX_EXTENDED | RE_BACKSLASH_ESCAPE_IN_LISTS | RE_DEBUG) \ - & ~(RE_DOT_NOT_NULL | RE_INTERVALS | RE_CONTEXT_INDEP_OPS)) - -#define RE_SYNTAX_POSIX_AWK \ - (RE_SYNTAX_POSIX_EXTENDED | RE_BACKSLASH_ESCAPE_IN_LISTS \ - | RE_INTERVALS | RE_NO_GNU_OPS) - -#define RE_SYNTAX_GREP \ - (RE_BK_PLUS_QM | RE_CHAR_CLASSES \ - | RE_HAT_LISTS_NOT_NEWLINE | RE_INTERVALS \ - | RE_NEWLINE_ALT) - -#define RE_SYNTAX_EGREP \ - (RE_CHAR_CLASSES | RE_CONTEXT_INDEP_ANCHORS \ - | RE_CONTEXT_INDEP_OPS | RE_HAT_LISTS_NOT_NEWLINE \ - | RE_NEWLINE_ALT | RE_NO_BK_PARENS \ - | RE_NO_BK_VBAR) - -#define RE_SYNTAX_POSIX_EGREP \ - (RE_SYNTAX_EGREP | RE_INTERVALS | RE_NO_BK_BRACES) - -/* P1003.2/D11.2, section 4.20.7.1, lines 5078ff. */ -#define RE_SYNTAX_ED RE_SYNTAX_POSIX_BASIC - -#define RE_SYNTAX_SED RE_SYNTAX_POSIX_BASIC - -/* Syntax bits common to both basic and extended POSIX regex syntax. */ -#define _RE_SYNTAX_POSIX_COMMON \ - (RE_CHAR_CLASSES | RE_DOT_NEWLINE | RE_DOT_NOT_NULL \ - | RE_INTERVALS | RE_NO_EMPTY_RANGES) - -#define RE_SYNTAX_POSIX_BASIC \ - (_RE_SYNTAX_POSIX_COMMON | RE_BK_PLUS_QM) - -/* Differs from ..._POSIX_BASIC only in that RE_BK_PLUS_QM becomes - RE_LIMITED_OPS, i.e., \? \+ \| are not recognized. Actually, this - isn't minimal, since other operators, such as \`, aren't disabled. */ -#define RE_SYNTAX_POSIX_MINIMAL_BASIC \ - (_RE_SYNTAX_POSIX_COMMON | RE_LIMITED_OPS) - -#define RE_SYNTAX_POSIX_EXTENDED \ - (_RE_SYNTAX_POSIX_COMMON | RE_CONTEXT_INDEP_ANCHORS \ - | RE_CONTEXT_INDEP_OPS | RE_NO_BK_BRACES \ - | RE_NO_BK_PARENS | RE_NO_BK_VBAR \ - | RE_CONTEXT_INVALID_OPS | RE_UNMATCHED_RIGHT_PAREN_ORD) - -/* Differs from ..._POSIX_EXTENDED in that RE_CONTEXT_INDEP_OPS is - removed and RE_NO_BK_REFS is added. */ -#define RE_SYNTAX_POSIX_MINIMAL_EXTENDED \ - (_RE_SYNTAX_POSIX_COMMON | RE_CONTEXT_INDEP_ANCHORS \ - | RE_CONTEXT_INVALID_OPS | RE_NO_BK_BRACES \ - | RE_NO_BK_PARENS | RE_NO_BK_REFS \ - | RE_NO_BK_VBAR | RE_UNMATCHED_RIGHT_PAREN_ORD) -/* [[[end syntaxes]]] */ -/* Maximum number of duplicates an interval can allow. Some systems - (erroneously) define this in other header files, but we want our - value, so remove any previous define. */ -#ifdef RE_DUP_MAX -# undef RE_DUP_MAX -#endif -/* Repeat counts are stored in opcodes as 2 byte integers. This was - previously limited to 7fff because the parsing code uses signed - ints. But Emacs only runs on 32 bit platforms anyway. */ -#define RE_DUP_MAX (0xffff) - - -/* POSIX `cflags' bits (i.e., information for `regcomp'). */ - -/* If this bit is set, then use extended regular expression syntax. - If not set, then use basic regular expression syntax. */ -#define REG_EXTENDED 1 - -/* If this bit is set, then ignore case when matching. - If not set, then case is significant. */ -#define REG_ICASE (REG_EXTENDED << 1) - -/* If this bit is set, then anchors do not match at newline - characters in the string. - If not set, then anchors do match at newlines. */ -#define REG_NEWLINE (REG_ICASE << 1) - -/* If this bit is set, then report only success or fail in regexec. - If not set, then returns differ between not matching and errors. */ -#define REG_NOSUB (REG_NEWLINE << 1) - - -/* POSIX `eflags' bits (i.e., information for regexec). */ - -/* If this bit is set, then the beginning-of-line operator doesn't match - the beginning of the string (presumably because it's not the - beginning of a line). - If not set, then the beginning-of-line operator does match the - beginning of the string. */ -#define REG_NOTBOL 1 - -/* Like REG_NOTBOL, except for the end-of-line. */ -#define REG_NOTEOL (1 << 1) - - -/* If any error codes are removed, changed, or added, update the - `re_error_msg' table in regex-emacs.c. */ -typedef enum -{ -#ifdef _XOPEN_SOURCE - REG_ENOSYS = -1, /* This will never happen for this implementation. */ -#endif - - REG_NOERROR = 0, /* Success. */ - REG_NOMATCH, /* Didn't find a match (for regexec). */ - - /* POSIX regcomp return error codes. (In the order listed in the - standard.) */ - REG_BADPAT, /* Invalid pattern. */ - REG_ECOLLATE, /* Not implemented. */ - REG_ECTYPE, /* Invalid character class name. */ - REG_EESCAPE, /* Trailing backslash. */ - REG_ESUBREG, /* Invalid back reference. */ - REG_EBRACK, /* Unmatched left bracket. */ - REG_EPAREN, /* Parenthesis imbalance. */ - REG_EBRACE, /* Unmatched \{. */ - REG_BADBR, /* Invalid contents of \{\}. */ - REG_ERANGE, /* Invalid range end. */ - REG_ESPACE, /* Ran out of memory. */ - REG_BADRPT, /* No preceding re for repetition op. */ - - /* Error codes we've added. */ - REG_EEND, /* Premature end. */ - REG_ESIZE, /* Compiled pattern bigger than 2^16 bytes. */ - REG_ERPAREN, /* Unmatched ) or \); not returned from regcomp. */ - REG_ERANGEX, /* Range striding over charsets. */ - REG_ESIZEBR /* n or m too big in \{n,m\} */ -} reg_errcode_t; - -/* Use a type compatible with Emacs. */ -#define RE_TRANSLATE_TYPE Lisp_Object -#define RE_TRANSLATE(TBL, C) char_table_translate (TBL, C) -#define RE_TRANSLATE_P(TBL) (!EQ (TBL, make_number (0))) - /* This data structure represents a compiled pattern. Before calling the pattern compiler, the fields `buffer', `allocated', `fastmap', `translate', and `no_sub' can be set. After the pattern has been compiled, the `re_nsub' field is available. All other fields are private to the regex routines. */ -#ifndef RE_TRANSLATE_TYPE -# define RE_TRANSLATE_TYPE char * -#endif - struct re_pattern_buffer { -/* [[[begin pattern_buffer]]] */ /* Space that holds the compiled pattern. It is declared as `unsigned char *' because its elements are sometimes used as array indexes. */ @@ -379,13 +76,9 @@ struct re_pattern_buffer /* Number of bytes actually used in `buffer'. */ size_t used; -#ifdef emacs /* Charset of unibyte characters at compiling time. */ int charset_unibyte; -#else - /* Syntax setting with which the pattern was compiled. */ - reg_syntax_t syntax; -#endif + /* Pointer to a fastmap, if any, otherwise zero. re_search uses the fastmap, if there is one, to skip over impossible starting points for matches. */ @@ -395,7 +88,7 @@ struct re_pattern_buffer comparing them, or zero for no translation. The translation is applied to a pattern when it is compiled and to a string when it is matched. */ - RE_TRANSLATE_TYPE translate; + Lisp_Object translate; /* Number of subexpressions found by the compiler. */ size_t re_nsub; @@ -410,9 +103,6 @@ struct re_pattern_buffer for `max (RE_NREGS, re_nsub + 1)' groups. If REGS_REALLOCATE, reallocate space if necessary. If REGS_FIXED, use what's there. */ -#define REGS_UNALLOCATED 0 -#define REGS_REALLOCATE 1 -#define REGS_FIXED 2 unsigned regs_allocated : 2; /* Set to zero when `regex_compile' compiles a pattern; set to one @@ -434,7 +124,6 @@ struct re_pattern_buffer so the compiled pattern is only valid for the current syntax table. */ unsigned used_syntax : 1; -#ifdef emacs /* If true, multi-byte form in the regexp pattern should be recognized as a multibyte character. */ unsigned multibyte : 1; @@ -442,72 +131,17 @@ struct re_pattern_buffer /* If true, multi-byte form in the target of match should be recognized as a multibyte character. */ unsigned target_multibyte : 1; -#endif - -/* [[[end pattern_buffer]]] */ }; - -typedef struct re_pattern_buffer regex_t; - -/* POSIX 1003.1-2008 requires that regoff_t be at least as wide as - ptrdiff_t and ssize_t. We don't know of any hosts where ptrdiff_t - is wider than ssize_t, so ssize_t is safe. ptrdiff_t is not - necessarily visible here, so use ssize_t. */ -typedef ssize_t regoff_t; - - -/* This is the structure we store register match data in. See - regex.texinfo for a full description of what registers match. */ -struct re_registers -{ - unsigned num_regs; - regoff_t *start; - regoff_t *end; -}; - - -/* If `regs_allocated' is REGS_UNALLOCATED in the pattern buffer, - `re_match_2' returns information about at least this many registers - the first time a `regs' structure is passed. */ -#ifndef RE_NREGS -# define RE_NREGS 30 -#endif - - -/* POSIX specification for registers. Aside from the different names than - `re_registers', POSIX uses an array of structures, instead of a - structure of arrays. */ -typedef struct -{ - regoff_t rm_so; /* Byte offset from string's start to substring's start. */ - regoff_t rm_eo; /* Byte offset from string's start to substring's end. */ -} regmatch_t; /* Declarations for routines. */ -#ifndef emacs - -/* Sets the current default syntax to SYNTAX, and return the old syntax. - You can also simply assign to the `re_syntax_options' variable. */ -extern reg_syntax_t re_set_syntax (reg_syntax_t __syntax); - -#endif - /* Compile the regular expression PATTERN, with length LENGTH and syntax given by the global `re_syntax_options', into the buffer BUFFER. Return NULL if successful, and an error string if not. */ -extern const char *re_compile_pattern (const char *__pattern, size_t __length, -#ifdef emacs +extern const char *re_compile_pattern (const char *pattern, size_t length, bool posix_backtracking, const char *whitespace_regexp, -#endif - struct re_pattern_buffer *__buffer); - - -/* Compile a fastmap for the compiled pattern in BUFFER; used to - accelerate searches. Return 0 if successful and -2 if was an - internal error. */ -extern int re_compile_fastmap (struct re_pattern_buffer *__buffer); + struct re_pattern_buffer *buffer); /* Search in the string STRING (with length LENGTH) for the pattern @@ -515,42 +149,36 @@ extern int re_compile_fastmap (struct re_pattern_buffer *__buffer); characters. Return the starting position of the match, -1 for no match, or -2 for an internal error. Also return register information in REGS (if REGS and BUFFER->no_sub are nonzero). */ -extern regoff_t re_search (struct re_pattern_buffer *__buffer, - const char *__string, size_t __length, - ssize_t __start, ssize_t __range, - struct re_registers *__regs); +extern ptrdiff_t re_search (struct re_pattern_buffer *buffer, + const char *string, size_t length, + ptrdiff_t start, ptrdiff_t range, + struct re_registers *regs); /* Like `re_search', but search in the concatenation of STRING1 and STRING2. Also, stop searching at index START + STOP. */ -extern regoff_t re_search_2 (struct re_pattern_buffer *__buffer, - const char *__string1, size_t __length1, - const char *__string2, size_t __length2, - ssize_t __start, ssize_t __range, - struct re_registers *__regs, - ssize_t __stop); +extern ptrdiff_t re_search_2 (struct re_pattern_buffer *buffer, + const char *string1, size_t length1, + const char *string2, size_t length2, + ptrdiff_t start, ptrdiff_t range, + struct re_registers *regs, + ptrdiff_t stop); -/* Like `re_search', but return how many characters in STRING the regexp +/* Like 're_search_2', but return how many characters in STRING the regexp in BUFFER matched, starting at position START. */ -extern regoff_t re_match (struct re_pattern_buffer *__buffer, - const char *__string, size_t __length, - ssize_t __start, struct re_registers *__regs); - - -/* Relates to `re_match' as `re_search_2' relates to `re_search'. */ -extern regoff_t re_match_2 (struct re_pattern_buffer *__buffer, - const char *__string1, size_t __length1, - const char *__string2, size_t __length2, - ssize_t __start, struct re_registers *__regs, - ssize_t __stop); +extern ptrdiff_t re_match_2 (struct re_pattern_buffer *buffer, + const char *string1, size_t length1, + const char *string2, size_t length2, + ptrdiff_t start, struct re_registers *regs, + ptrdiff_t stop); /* Set REGS to hold NUM_REGS registers, storing them in STARTS and ENDS. Subsequent matches using BUFFER and REGS will use this memory for recording register information. STARTS and ENDS must be allocated with malloc, and must each be at least `NUM_REGS * sizeof - (regoff_t)' bytes long. + (ptrdiff_t)' bytes long. If NUM_REGS == 0, then subsequent matches should allocate their own register data. @@ -558,83 +186,10 @@ extern regoff_t re_match_2 (struct re_pattern_buffer *__buffer, Unless this function is called, the first search or match using PATTERN_BUFFER will allocate its own register data, without freeing the old data. */ -extern void re_set_registers (struct re_pattern_buffer *__buffer, - struct re_registers *__regs, - unsigned __num_regs, - regoff_t *__starts, regoff_t *__ends); - -#if defined _REGEX_RE_COMP || defined _LIBC -# ifndef _CRAY -/* 4.2 bsd compatibility. */ -extern char *re_comp (const char *); -extern int re_exec (const char *); -# endif -#endif - -/* GCC 2.95 and later have "__restrict"; C99 compilers have - "restrict", and "configure" may have defined "restrict". - Other compilers use __restrict, __restrict__, and _Restrict, and - 'configure' might #define 'restrict' to those words, so pick a - different name. */ -#ifndef _Restrict_ -# if 199901L <= __STDC_VERSION__ -# define _Restrict_ restrict -# elif 2 < __GNUC__ || (2 == __GNUC__ && 95 <= __GNUC_MINOR__) -# define _Restrict_ __restrict -# else -# define _Restrict_ -# endif -#endif -/* gcc 3.1 and up support the [restrict] syntax. Don't trust - sys/cdefs.h's definition of __restrict_arr, though, as it - mishandles gcc -ansi -pedantic. */ -#ifndef _Restrict_arr_ -# if ((199901L <= __STDC_VERSION__ \ - || ((3 < __GNUC__ || (3 == __GNUC__ && 1 <= __GNUC_MINOR__)) \ - && !defined __STRICT_ANSI__)) \ - && !defined __GNUG__) -# define _Restrict_arr_ _Restrict_ -# else -# define _Restrict_arr_ -# endif -#endif - -/* POSIX compatibility. */ -extern reg_errcode_t regcomp (regex_t *_Restrict_ __preg, - const char *_Restrict_ __pattern, - int __cflags); - -extern reg_errcode_t regexec (const regex_t *_Restrict_ __preg, - const char *_Restrict_ __string, size_t __nmatch, - regmatch_t __pmatch[_Restrict_arr_], - int __eflags); - -extern size_t regerror (int __errcode, const regex_t * __preg, - char *__errbuf, size_t __errbuf_size); - -extern void regfree (regex_t *__preg); - - -#ifdef __cplusplus -} -#endif /* C++ */ - -/* For platform which support the ISO C amendment 1 functionality we - support user defined character classes. */ -#if WIDE_CHAR_SUPPORT -/* Solaris 2.5 has a bug: must be included before . */ -# include -# include - -typedef wctype_t re_wctype_t; -typedef wchar_t re_wchar_t; -# define re_wctype wctype -# define re_iswctype iswctype -# define re_wctype_to_bit(cc) 0 -#else -# ifndef emacs -# define btowc(c) c -# endif +extern void re_set_registers (struct re_pattern_buffer *buffer, + struct re_registers *regs, + unsigned num_regs, + ptrdiff_t *starts, ptrdiff_t *ends); /* Character classes. */ typedef enum { RECC_ERROR = 0, @@ -648,12 +203,8 @@ typedef enum { RECC_ERROR = 0, RECC_ASCII, RECC_UNIBYTE } re_wctype_t; -extern char re_iswctype (int ch, re_wctype_t cc); -extern re_wctype_t re_wctype_parse (const unsigned char **strp, unsigned limit); - -typedef int re_wchar_t; - -#endif /* not WIDE_CHAR_SUPPORT */ +extern bool re_iswctype (int ch, re_wctype_t cc); +extern re_wctype_t re_wctype_parse (const unsigned char **strp, + unsigned limit); #endif /* regex-emacs.h */ - diff --git a/src/search.c b/src/search.c index d4b0322041..f758bb9304 100644 --- a/src/search.c +++ b/src/search.c @@ -59,8 +59,8 @@ static struct regexp_cache searchbufs[REGEXP_CACHE_SIZE]; static struct regexp_cache *searchbuf_head; -/* Every call to re_match, etc., must pass &search_regs as the regs - argument unless you can show it is unnecessary (i.e., if re_match +/* Every call to re_search, etc., must pass &search_regs as the regs + argument unless you can show it is unnecessary (i.e., if re_search is certainly going to be called again before region-around-match can be called). @@ -2189,8 +2189,8 @@ set_search_regs (ptrdiff_t beg_byte, ptrdiff_t nbytes) the match position. */ if (search_regs.num_regs == 0) { - search_regs.start = xmalloc (2 * sizeof (regoff_t)); - search_regs.end = xmalloc (2 * sizeof (regoff_t)); + search_regs.start = xmalloc (2 * sizeof *search_regs.start); + search_regs.end = xmalloc (2 * sizeof *search_regs.end); search_regs.num_regs = 2; } @@ -3001,9 +3001,9 @@ If optional arg RESEAT is non-nil, make markers on LIST point nowhere. */) memory_full (SIZE_MAX); search_regs.start = xpalloc (search_regs.start, &num_regs, length - num_regs, - min (PTRDIFF_MAX, UINT_MAX), sizeof (regoff_t)); + min (PTRDIFF_MAX, UINT_MAX), sizeof *search_regs.start); search_regs.end = - xrealloc (search_regs.end, num_regs * sizeof (regoff_t)); + xrealloc (search_regs.end, num_regs * sizeof *search_regs.end); for (i = search_regs.num_regs; i < num_regs; i++) search_regs.start[i] = -1; @@ -3058,12 +3058,9 @@ If optional arg RESEAT is non-nil, make markers on LIST point nowhere. */) XSETFASTINT (marker, 0); CHECK_NUMBER_COERCE_MARKER (marker); - if ((XINT (from) < 0 - ? TYPE_MINIMUM (regoff_t) <= XINT (from) - : XINT (from) <= TYPE_MAXIMUM (regoff_t)) - && (XINT (marker) < 0 - ? TYPE_MINIMUM (regoff_t) <= XINT (marker) - : XINT (marker) <= TYPE_MAXIMUM (regoff_t))) + if (PTRDIFF_MIN <= XINT (from) && XINT (from) <= PTRDIFF_MAX + && PTRDIFF_MIN <= XINT (marker) + && XINT (marker) <= PTRDIFF_MAX) { search_regs.start[i] = XINT (from); search_regs.end[i] = XINT (marker); diff --git a/src/thread.h b/src/thread.h index e1eb40921b..8ecb00824d 100644 --- a/src/thread.h +++ b/src/thread.h @@ -112,8 +112,8 @@ struct thread_state struct buffer *m_current_buffer; #define current_buffer (current_thread->m_current_buffer) - /* Every call to re_match, etc., must pass &search_regs as the regs - argument unless you can show it is unnecessary (i.e., if re_match + /* Every call to re_match_2, etc., must pass &search_regs as the regs + argument unless you can show it is unnecessary (i.e., if re_match_2 is certainly going to be called again before region-around-match can be called). commit d904cc83f3036db96107a3976cee1a0112547de6 Author: Paul Eggert Date: Sun Aug 5 18:41:20 2018 -0700 Use Gnulib regex for lib-src Emacs regular expressions forked from everyone else long ago. This makes it official and should allow simplification later. etags.c now uses the glibc regex API, falling back on a Gnulib-supplied substitute lib/regex.c if necessary. Emacs proper now uses its own regular expression module. Although this patch may look dauntingly large, most of it was generated automatically by admin/merge-gnulib and contains an exact copy of the glibc regex source, and the by-hand changes do not grow the Emacs source code. * admin/merge-gnulib (GNULIB_MODULES): Add regex. (AVOIDED_MODULES): Add btowc, langinfo, lock, mbrtowc, mbsinit, nl_langinfo, wchar, wcrtomb, wctype-h. * lib-src/Makefile.in (regex-emacs.o): Remove; Gnulib does it now. (etags_deps, etags_libs): Remove regex-emacs.o. * lib-src/etags.c: Go back to including regex.h. (add_regex): Use unsigned char translation array, since glibc regex requires that. * lib/Makefile.in (not_emacs_OBJECTS, for_emacs_OBJECTS): New macros. (libegnu_a_OBJECTS): Use them, to avoid building e-regex.o. * lib/gnulib.mk.in, m4/gnulib-comp.m4: Regenerate. * lib/regcomp.c, lib/regex.c, lib/regex.h, lib/regex_internal.c: * lib/regex_internal.h, lib/regexec.c, m4/builtin-expect.m4: * m4/eealloc.m4, m4/glibc21.m4, m4/mbstate_t.m4, m4/regex.m4: New files, copied from Gnulib. * src/regex-emacs.h, src/conf_post.h: (RE_TRANSLATE_TYPE, RE_TRANSLATE, RE_TRANSLATE_P): Move from src/conf_post.h to src/regex-emacs.h, so that they don’t interfere with compiling lib/regex.c. diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 1397ecfb9f..abb192911d 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -37,7 +37,7 @@ GNULIB_MODULES=' getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog ieee754-h ignore-value intprops largefile lstat manywarnings memrchr minmax mkostemp mktime nstrftime - pipe2 pselect pthread_sigmask putenv qcopy-acl readlink readlinkat + pipe2 pselect pthread_sigmask putenv qcopy-acl readlink readlinkat regex sig2str socklen stat-time std-gnu11 stdalign stddef stdio stpcpy strtoimax symlink sys_stat sys_time tempname time time_r time_rz timegm timer-time timespec-add timespec-sub @@ -46,11 +46,12 @@ GNULIB_MODULES=' ' AVOIDED_MODULES=' - close dup fchdir fstat - malloc-posix msvc-inval msvc-nothrow + btowc close dup fchdir fstat langinfo lock + malloc-posix mbrtowc mbsinit msvc-inval msvc-nothrow nl_langinfo openat-die opendir raise save-cwd select setenv sigprocmask stat stdarg stdbool threadlib tzset unsetenv utime utime-h + wchar wcrtomb wctype-h ' GNULIB_TOOL_FLAGS=' diff --git a/etc/NEWS b/etc/NEWS index fa8a7afd52..21887f5bfd 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -31,6 +31,13 @@ functions 'json-serialize', 'json-insert', 'json-parse-string', and 'json-parse-buffer' are typically much faster than their Lisp counterparts from json.el. +** The etags program now uses the C library's regular expression matcher +when possible, and a compatible regex substitute otherwise. This will +let developers maintain Emacs's own regex code without having to also +support other programs. The new configure option '--without-included-regex' +forces etags to use the C library's regex matcher even if the regex +substitute ordinarily would be used to work around compatibility problems. + ** Emacs has been ported to the -fcheck-pointer-bounds option of GCC. This causes Emacs to check bounds of some arrays addressed by its internal pointers, which can be helpful when debugging the Emacs diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in index e70b23c4b3..b2b901788a 100644 --- a/lib-src/Makefile.in +++ b/lib-src/Makefile.in @@ -361,13 +361,9 @@ TAGS: etags${EXEEXT} ${tagsfiles} ../lib/libgnu.a: $(config_h) $(MAKE) -C ../lib all -regex-emacs.o: $(srcdir)/../src/regex-emacs.c $(srcdir)/../src/regex-emacs.h $(config_h) - $(AM_V_CC)$(CC) -c $(CPP_CFLAGS) $< - - -etags_deps = ${srcdir}/etags.c regex-emacs.o $(NTLIB) $(config_h) +etags_deps = ${srcdir}/etags.c $(NTLIB) $(config_h) etags_cflags = -DEMACS_NAME="\"GNU Emacs\"" -DVERSION="\"${version}\"" -o $@ -etags_libs = regex-emacs.o $(NTLIB) $(LOADLIBES) +etags_libs = $(NTLIB) $(LOADLIBES) etags${EXEEXT}: ${etags_deps} $(AM_V_CCLD)$(CC) ${ALL_CFLAGS} $(etags_cflags) $< $(etags_libs) diff --git a/lib-src/etags.c b/lib-src/etags.c index 47d13116db..ee50670343 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -135,7 +135,7 @@ char pot_etags_version[] = "@(#) pot revision number is 17.38.1.4"; #endif #include -#include +#include /* Define CTAGS to make the program "ctags" compatible with the usual one. Leave it undefined to make the program "etags", which makes emacs-style @@ -6401,7 +6401,7 @@ add_regex (char *regexp_pattern, language *lang) *patbuf = zeropattern; if (ignore_case) { - static char lc_trans[UCHAR_MAX + 1]; + static unsigned char lc_trans[UCHAR_MAX + 1]; int i; for (i = 0; i < UCHAR_MAX + 1; i++) lc_trans[i] = c_tolower (i); diff --git a/lib/Makefile.in b/lib/Makefile.in index 201f4b5383..b26db27423 100644 --- a/lib/Makefile.in +++ b/lib/Makefile.in @@ -79,9 +79,15 @@ endif Makefile: ../config.status $(srcdir)/Makefile.in $(MAKE) -C .. src/$@ +# Object modules that need not be built for Emacs. +# Emacs does not need e-regex.o (it has its own regex-emacs.c), +# and building it would just waste time. +not_emacs_OBJECTS = regex.o + libgnu_a_OBJECTS = $(gl_LIBOBJS) \ $(patsubst %.c,%.o,$(filter %.c,$(libgnu_a_SOURCES))) -libegnu_a_OBJECTS = $(patsubst %.o,e-%.o,$(libgnu_a_OBJECTS)) +for_emacs_OBJECTS = $(filter-out $(not_emacs_OBJECTS),$(libgnu_a_OBJECTS)) +libegnu_a_OBJECTS = $(patsubst %.o,e-%.o,$(for_emacs_OBJECTS)) $(libegnu_a_OBJECTS) $(libgnu_a_OBJECTS): $(BUILT_SOURCES) diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 7d28dcc62b..7ad390875b 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -34,13 +34,19 @@ # --no-libtool \ # --macro-prefix=gl \ # --no-vc-files \ +# --avoid=btowc \ # --avoid=close \ # --avoid=dup \ # --avoid=fchdir \ # --avoid=fstat \ +# --avoid=langinfo \ +# --avoid=lock \ # --avoid=malloc-posix \ +# --avoid=mbrtowc \ +# --avoid=mbsinit \ # --avoid=msvc-inval \ # --avoid=msvc-nothrow \ +# --avoid=nl_langinfo \ # --avoid=openat-die \ # --avoid=opendir \ # --avoid=raise \ @@ -56,6 +62,9 @@ # --avoid=unsetenv \ # --avoid=utime \ # --avoid=utime-h \ +# --avoid=wchar \ +# --avoid=wcrtomb \ +# --avoid=wctype-h \ # alloca-opt \ # binary-io \ # byteswap \ @@ -113,6 +122,7 @@ # qcopy-acl \ # readlink \ # readlinkat \ +# regex \ # sig2str \ # socklen \ # stat-time \ @@ -216,6 +226,7 @@ GETOPT_CDEFS_H = @GETOPT_CDEFS_H@ GETOPT_H = @GETOPT_H@ GFILENOTIFY_CFLAGS = @GFILENOTIFY_CFLAGS@ GFILENOTIFY_LIBS = @GFILENOTIFY_LIBS@ +GLIBC21 = @GLIBC21@ GL_COND_LIBTOOL = @GL_COND_LIBTOOL@ GL_GENERATE_ALLOCA_H = @GL_GENERATE_ALLOCA_H@ GL_GENERATE_BYTESWAP_H = @GL_GENERATE_BYTESWAP_H@ @@ -1024,6 +1035,7 @@ gameuser = @gameuser@ gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7 = @gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7@ gl_GNULIB_ENABLED_2049e887c7e5308faad27b3f894bb8c9 = @gl_GNULIB_ENABLED_2049e887c7e5308faad27b3f894bb8c9@ gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b = @gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b@ +gl_GNULIB_ENABLED_37f71b604aa9c54446783d80f42fe547 = @gl_GNULIB_ENABLED_37f71b604aa9c54446783d80f42fe547@ gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31 = @gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31@ gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c = @gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c@ gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec = @gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec@ @@ -2095,6 +2107,17 @@ EXTRA_libgnu_a_SOURCES += at-func.c readlinkat.c endif ## end gnulib module readlinkat +## begin gnulib module regex +ifeq (,$(OMIT_GNULIB_MODULE_regex)) + + +EXTRA_DIST += regcomp.c regex.c regex.h regex_internal.c regex_internal.h regexec.c + +EXTRA_libgnu_a_SOURCES += regcomp.c regex.c regex_internal.c regexec.c + +endif +## end gnulib module regex + ## begin gnulib module root-uid ifeq (,$(OMIT_GNULIB_MODULE_root-uid)) diff --git a/lib/regcomp.c b/lib/regcomp.c new file mode 100644 index 0000000000..53eb226374 --- /dev/null +++ b/lib/regcomp.c @@ -0,0 +1,3944 @@ +/* Extended regular expression matching and search library. + Copyright (C) 2002-2018 Free Software Foundation, Inc. + This file is part of the GNU C Library. + Contributed by Isamu Hasegawa . + + The GNU C Library 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. + + The GNU C Library 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 the GNU C Library; if not, see + . */ + +#ifdef _LIBC +# include +#endif + +static reg_errcode_t re_compile_internal (regex_t *preg, const char * pattern, + size_t length, reg_syntax_t syntax); +static void re_compile_fastmap_iter (regex_t *bufp, + const re_dfastate_t *init_state, + char *fastmap); +static reg_errcode_t init_dfa (re_dfa_t *dfa, size_t pat_len); +#ifdef RE_ENABLE_I18N +static void free_charset (re_charset_t *cset); +#endif /* RE_ENABLE_I18N */ +static void free_workarea_compile (regex_t *preg); +static reg_errcode_t create_initial_state (re_dfa_t *dfa); +#ifdef RE_ENABLE_I18N +static void optimize_utf8 (re_dfa_t *dfa); +#endif +static reg_errcode_t analyze (regex_t *preg); +static reg_errcode_t preorder (bin_tree_t *root, + reg_errcode_t (fn (void *, bin_tree_t *)), + void *extra); +static reg_errcode_t postorder (bin_tree_t *root, + reg_errcode_t (fn (void *, bin_tree_t *)), + void *extra); +static reg_errcode_t optimize_subexps (void *extra, bin_tree_t *node); +static reg_errcode_t lower_subexps (void *extra, bin_tree_t *node); +static bin_tree_t *lower_subexp (reg_errcode_t *err, regex_t *preg, + bin_tree_t *node); +static reg_errcode_t calc_first (void *extra, bin_tree_t *node); +static reg_errcode_t calc_next (void *extra, bin_tree_t *node); +static reg_errcode_t link_nfa_nodes (void *extra, bin_tree_t *node); +static Idx duplicate_node (re_dfa_t *dfa, Idx org_idx, unsigned int constraint); +static Idx search_duplicated_node (const re_dfa_t *dfa, Idx org_node, + unsigned int constraint); +static reg_errcode_t calc_eclosure (re_dfa_t *dfa); +static reg_errcode_t calc_eclosure_iter (re_node_set *new_set, re_dfa_t *dfa, + Idx node, bool root); +static reg_errcode_t calc_inveclosure (re_dfa_t *dfa); +static Idx fetch_number (re_string_t *input, re_token_t *token, + reg_syntax_t syntax); +static int peek_token (re_token_t *token, re_string_t *input, + reg_syntax_t syntax); +static bin_tree_t *parse (re_string_t *regexp, regex_t *preg, + reg_syntax_t syntax, reg_errcode_t *err); +static bin_tree_t *parse_reg_exp (re_string_t *regexp, regex_t *preg, + re_token_t *token, reg_syntax_t syntax, + Idx nest, reg_errcode_t *err); +static bin_tree_t *parse_branch (re_string_t *regexp, regex_t *preg, + re_token_t *token, reg_syntax_t syntax, + Idx nest, reg_errcode_t *err); +static bin_tree_t *parse_expression (re_string_t *regexp, regex_t *preg, + re_token_t *token, reg_syntax_t syntax, + Idx nest, reg_errcode_t *err); +static bin_tree_t *parse_sub_exp (re_string_t *regexp, regex_t *preg, + re_token_t *token, reg_syntax_t syntax, + Idx nest, reg_errcode_t *err); +static bin_tree_t *parse_dup_op (bin_tree_t *dup_elem, re_string_t *regexp, + re_dfa_t *dfa, re_token_t *token, + reg_syntax_t syntax, reg_errcode_t *err); +static bin_tree_t *parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa, + re_token_t *token, reg_syntax_t syntax, + reg_errcode_t *err); +static reg_errcode_t parse_bracket_element (bracket_elem_t *elem, + re_string_t *regexp, + re_token_t *token, int token_len, + re_dfa_t *dfa, + reg_syntax_t syntax, + bool accept_hyphen); +static reg_errcode_t parse_bracket_symbol (bracket_elem_t *elem, + re_string_t *regexp, + re_token_t *token); +#ifdef RE_ENABLE_I18N +static reg_errcode_t build_equiv_class (bitset_t sbcset, + re_charset_t *mbcset, + Idx *equiv_class_alloc, + const unsigned char *name); +static reg_errcode_t build_charclass (RE_TRANSLATE_TYPE trans, + bitset_t sbcset, + re_charset_t *mbcset, + Idx *char_class_alloc, + const char *class_name, + reg_syntax_t syntax); +#else /* not RE_ENABLE_I18N */ +static reg_errcode_t build_equiv_class (bitset_t sbcset, + const unsigned char *name); +static reg_errcode_t build_charclass (RE_TRANSLATE_TYPE trans, + bitset_t sbcset, + const char *class_name, + reg_syntax_t syntax); +#endif /* not RE_ENABLE_I18N */ +static bin_tree_t *build_charclass_op (re_dfa_t *dfa, + RE_TRANSLATE_TYPE trans, + const char *class_name, + const char *extra, + bool non_match, reg_errcode_t *err); +static bin_tree_t *create_tree (re_dfa_t *dfa, + bin_tree_t *left, bin_tree_t *right, + re_token_type_t type); +static bin_tree_t *create_token_tree (re_dfa_t *dfa, + bin_tree_t *left, bin_tree_t *right, + const re_token_t *token); +static bin_tree_t *duplicate_tree (const bin_tree_t *src, re_dfa_t *dfa); +static void free_token (re_token_t *node); +static reg_errcode_t free_tree (void *extra, bin_tree_t *node); +static reg_errcode_t mark_opt_subexp (void *extra, bin_tree_t *node); + +/* This table gives an error message for each of the error codes listed + in regex.h. Obviously the order here has to be same as there. + POSIX doesn't require that we do anything for REG_NOERROR, + but why not be nice? */ + +static const char __re_error_msgid[] = + { +#define REG_NOERROR_IDX 0 + gettext_noop ("Success") /* REG_NOERROR */ + "\0" +#define REG_NOMATCH_IDX (REG_NOERROR_IDX + sizeof "Success") + gettext_noop ("No match") /* REG_NOMATCH */ + "\0" +#define REG_BADPAT_IDX (REG_NOMATCH_IDX + sizeof "No match") + gettext_noop ("Invalid regular expression") /* REG_BADPAT */ + "\0" +#define REG_ECOLLATE_IDX (REG_BADPAT_IDX + sizeof "Invalid regular expression") + gettext_noop ("Invalid collation character") /* REG_ECOLLATE */ + "\0" +#define REG_ECTYPE_IDX (REG_ECOLLATE_IDX + sizeof "Invalid collation character") + gettext_noop ("Invalid character class name") /* REG_ECTYPE */ + "\0" +#define REG_EESCAPE_IDX (REG_ECTYPE_IDX + sizeof "Invalid character class name") + gettext_noop ("Trailing backslash") /* REG_EESCAPE */ + "\0" +#define REG_ESUBREG_IDX (REG_EESCAPE_IDX + sizeof "Trailing backslash") + gettext_noop ("Invalid back reference") /* REG_ESUBREG */ + "\0" +#define REG_EBRACK_IDX (REG_ESUBREG_IDX + sizeof "Invalid back reference") + gettext_noop ("Unmatched [, [^, [:, [., or [=") /* REG_EBRACK */ + "\0" +#define REG_EPAREN_IDX (REG_EBRACK_IDX + sizeof "Unmatched [, [^, [:, [., or [=") + gettext_noop ("Unmatched ( or \\(") /* REG_EPAREN */ + "\0" +#define REG_EBRACE_IDX (REG_EPAREN_IDX + sizeof "Unmatched ( or \\(") + gettext_noop ("Unmatched \\{") /* REG_EBRACE */ + "\0" +#define REG_BADBR_IDX (REG_EBRACE_IDX + sizeof "Unmatched \\{") + gettext_noop ("Invalid content of \\{\\}") /* REG_BADBR */ + "\0" +#define REG_ERANGE_IDX (REG_BADBR_IDX + sizeof "Invalid content of \\{\\}") + gettext_noop ("Invalid range end") /* REG_ERANGE */ + "\0" +#define REG_ESPACE_IDX (REG_ERANGE_IDX + sizeof "Invalid range end") + gettext_noop ("Memory exhausted") /* REG_ESPACE */ + "\0" +#define REG_BADRPT_IDX (REG_ESPACE_IDX + sizeof "Memory exhausted") + gettext_noop ("Invalid preceding regular expression") /* REG_BADRPT */ + "\0" +#define REG_EEND_IDX (REG_BADRPT_IDX + sizeof "Invalid preceding regular expression") + gettext_noop ("Premature end of regular expression") /* REG_EEND */ + "\0" +#define REG_ESIZE_IDX (REG_EEND_IDX + sizeof "Premature end of regular expression") + gettext_noop ("Regular expression too big") /* REG_ESIZE */ + "\0" +#define REG_ERPAREN_IDX (REG_ESIZE_IDX + sizeof "Regular expression too big") + gettext_noop ("Unmatched ) or \\)") /* REG_ERPAREN */ + }; + +static const size_t __re_error_msgid_idx[] = + { + REG_NOERROR_IDX, + REG_NOMATCH_IDX, + REG_BADPAT_IDX, + REG_ECOLLATE_IDX, + REG_ECTYPE_IDX, + REG_EESCAPE_IDX, + REG_ESUBREG_IDX, + REG_EBRACK_IDX, + REG_EPAREN_IDX, + REG_EBRACE_IDX, + REG_BADBR_IDX, + REG_ERANGE_IDX, + REG_ESPACE_IDX, + REG_BADRPT_IDX, + REG_EEND_IDX, + REG_ESIZE_IDX, + REG_ERPAREN_IDX + }; + +/* Entry points for GNU code. */ + +/* re_compile_pattern is the GNU regular expression compiler: it + compiles PATTERN (of length LENGTH) and puts the result in BUFP. + Returns 0 if the pattern was valid, otherwise an error string. + + Assumes the 'allocated' (and perhaps 'buffer') and 'translate' fields + are set in BUFP on entry. */ + +const char * +re_compile_pattern (const char *pattern, size_t length, + struct re_pattern_buffer *bufp) +{ + reg_errcode_t ret; + + /* And GNU code determines whether or not to get register information + by passing null for the REGS argument to re_match, etc., not by + setting no_sub, unless RE_NO_SUB is set. */ + bufp->no_sub = !!(re_syntax_options & RE_NO_SUB); + + /* Match anchors at newline. */ + bufp->newline_anchor = 1; + + ret = re_compile_internal (bufp, pattern, length, re_syntax_options); + + if (!ret) + return NULL; + return gettext (__re_error_msgid + __re_error_msgid_idx[(int) ret]); +} +#ifdef _LIBC +weak_alias (__re_compile_pattern, re_compile_pattern) +#endif + +/* Set by 're_set_syntax' to the current regexp syntax to recognize. Can + also be assigned to arbitrarily: each pattern buffer stores its own + syntax, so it can be changed between regex compilations. */ +/* This has no initializer because initialized variables in Emacs + become read-only after dumping. */ +reg_syntax_t re_syntax_options; + + +/* Specify the precise syntax of regexps for compilation. This provides + for compatibility for various utilities which historically have + different, incompatible syntaxes. + + The argument SYNTAX is a bit mask comprised of the various bits + defined in regex.h. We return the old syntax. */ + +reg_syntax_t +re_set_syntax (reg_syntax_t syntax) +{ + reg_syntax_t ret = re_syntax_options; + + re_syntax_options = syntax; + return ret; +} +#ifdef _LIBC +weak_alias (__re_set_syntax, re_set_syntax) +#endif + +int +re_compile_fastmap (struct re_pattern_buffer *bufp) +{ + re_dfa_t *dfa = bufp->buffer; + char *fastmap = bufp->fastmap; + + memset (fastmap, '\0', sizeof (char) * SBC_MAX); + re_compile_fastmap_iter (bufp, dfa->init_state, fastmap); + if (dfa->init_state != dfa->init_state_word) + re_compile_fastmap_iter (bufp, dfa->init_state_word, fastmap); + if (dfa->init_state != dfa->init_state_nl) + re_compile_fastmap_iter (bufp, dfa->init_state_nl, fastmap); + if (dfa->init_state != dfa->init_state_begbuf) + re_compile_fastmap_iter (bufp, dfa->init_state_begbuf, fastmap); + bufp->fastmap_accurate = 1; + return 0; +} +#ifdef _LIBC +weak_alias (__re_compile_fastmap, re_compile_fastmap) +#endif + +static inline void +__attribute__ ((always_inline)) +re_set_fastmap (char *fastmap, bool icase, int ch) +{ + fastmap[ch] = 1; + if (icase) + fastmap[tolower (ch)] = 1; +} + +/* Helper function for re_compile_fastmap. + Compile fastmap for the initial_state INIT_STATE. */ + +static void +re_compile_fastmap_iter (regex_t *bufp, const re_dfastate_t *init_state, + char *fastmap) +{ + re_dfa_t *dfa = bufp->buffer; + Idx node_cnt; + bool icase = (dfa->mb_cur_max == 1 && (bufp->syntax & RE_ICASE)); + for (node_cnt = 0; node_cnt < init_state->nodes.nelem; ++node_cnt) + { + Idx node = init_state->nodes.elems[node_cnt]; + re_token_type_t type = dfa->nodes[node].type; + + if (type == CHARACTER) + { + re_set_fastmap (fastmap, icase, dfa->nodes[node].opr.c); +#ifdef RE_ENABLE_I18N + if ((bufp->syntax & RE_ICASE) && dfa->mb_cur_max > 1) + { + unsigned char buf[MB_LEN_MAX]; + unsigned char *p; + wchar_t wc; + mbstate_t state; + + p = buf; + *p++ = dfa->nodes[node].opr.c; + while (++node < dfa->nodes_len + && dfa->nodes[node].type == CHARACTER + && dfa->nodes[node].mb_partial) + *p++ = dfa->nodes[node].opr.c; + memset (&state, '\0', sizeof (state)); + if (__mbrtowc (&wc, (const char *) buf, p - buf, + &state) == p - buf + && (__wcrtomb ((char *) buf, __towlower (wc), &state) + != (size_t) -1)) + re_set_fastmap (fastmap, false, buf[0]); + } +#endif + } + else if (type == SIMPLE_BRACKET) + { + int i, ch; + for (i = 0, ch = 0; i < BITSET_WORDS; ++i) + { + int j; + bitset_word_t w = dfa->nodes[node].opr.sbcset[i]; + for (j = 0; j < BITSET_WORD_BITS; ++j, ++ch) + if (w & ((bitset_word_t) 1 << j)) + re_set_fastmap (fastmap, icase, ch); + } + } +#ifdef RE_ENABLE_I18N + else if (type == COMPLEX_BRACKET) + { + re_charset_t *cset = dfa->nodes[node].opr.mbcset; + Idx i; + +# ifdef _LIBC + /* See if we have to try all bytes which start multiple collation + elements. + e.g. In da_DK, we want to catch 'a' since "aa" is a valid + collation element, and don't catch 'b' since 'b' is + the only collation element which starts from 'b' (and + it is caught by SIMPLE_BRACKET). */ + if (_NL_CURRENT_WORD (LC_COLLATE, _NL_COLLATE_NRULES) != 0 + && (cset->ncoll_syms || cset->nranges)) + { + const int32_t *table = (const int32_t *) + _NL_CURRENT (LC_COLLATE, _NL_COLLATE_TABLEMB); + for (i = 0; i < SBC_MAX; ++i) + if (table[i] < 0) + re_set_fastmap (fastmap, icase, i); + } +# endif /* _LIBC */ + + /* See if we have to start the match at all multibyte characters, + i.e. where we would not find an invalid sequence. This only + applies to multibyte character sets; for single byte character + sets, the SIMPLE_BRACKET again suffices. */ + if (dfa->mb_cur_max > 1 + && (cset->nchar_classes || cset->non_match || cset->nranges +# ifdef _LIBC + || cset->nequiv_classes +# endif /* _LIBC */ + )) + { + unsigned char c = 0; + do + { + mbstate_t mbs; + memset (&mbs, 0, sizeof (mbs)); + if (__mbrtowc (NULL, (char *) &c, 1, &mbs) == (size_t) -2) + re_set_fastmap (fastmap, false, (int) c); + } + while (++c != 0); + } + + else + { + /* ... Else catch all bytes which can start the mbchars. */ + for (i = 0; i < cset->nmbchars; ++i) + { + char buf[256]; + mbstate_t state; + memset (&state, '\0', sizeof (state)); + if (__wcrtomb (buf, cset->mbchars[i], &state) != (size_t) -1) + re_set_fastmap (fastmap, icase, *(unsigned char *) buf); + if ((bufp->syntax & RE_ICASE) && dfa->mb_cur_max > 1) + { + if (__wcrtomb (buf, __towlower (cset->mbchars[i]), &state) + != (size_t) -1) + re_set_fastmap (fastmap, false, *(unsigned char *) buf); + } + } + } + } +#endif /* RE_ENABLE_I18N */ + else if (type == OP_PERIOD +#ifdef RE_ENABLE_I18N + || type == OP_UTF8_PERIOD +#endif /* RE_ENABLE_I18N */ + || type == END_OF_RE) + { + memset (fastmap, '\1', sizeof (char) * SBC_MAX); + if (type == END_OF_RE) + bufp->can_be_null = 1; + return; + } + } +} + +/* Entry point for POSIX code. */ +/* regcomp takes a regular expression as a string and compiles it. + + PREG is a regex_t *. We do not expect any fields to be initialized, + since POSIX says we shouldn't. Thus, we set + + 'buffer' to the compiled pattern; + 'used' to the length of the compiled pattern; + 'syntax' to RE_SYNTAX_POSIX_EXTENDED if the + REG_EXTENDED bit in CFLAGS is set; otherwise, to + RE_SYNTAX_POSIX_BASIC; + 'newline_anchor' to REG_NEWLINE being set in CFLAGS; + 'fastmap' to an allocated space for the fastmap; + 'fastmap_accurate' to zero; + 're_nsub' to the number of subexpressions in PATTERN. + + PATTERN is the address of the pattern string. + + CFLAGS is a series of bits which affect compilation. + + If REG_EXTENDED is set, we use POSIX extended syntax; otherwise, we + use POSIX basic syntax. + + If REG_NEWLINE is set, then . and [^...] don't match newline. + Also, regexec will try a match beginning after every newline. + + If REG_ICASE is set, then we considers upper- and lowercase + versions of letters to be equivalent when matching. + + If REG_NOSUB is set, then when PREG is passed to regexec, that + routine will report only success or failure, and nothing about the + registers. + + It returns 0 if it succeeds, nonzero if it doesn't. (See regex.h for + the return codes and their meanings.) */ + +int +regcomp (regex_t *_Restrict_ preg, const char *_Restrict_ pattern, int cflags) +{ + reg_errcode_t ret; + reg_syntax_t syntax = ((cflags & REG_EXTENDED) ? RE_SYNTAX_POSIX_EXTENDED + : RE_SYNTAX_POSIX_BASIC); + + preg->buffer = NULL; + preg->allocated = 0; + preg->used = 0; + + /* Try to allocate space for the fastmap. */ + preg->fastmap = re_malloc (char, SBC_MAX); + if (BE (preg->fastmap == NULL, 0)) + return REG_ESPACE; + + syntax |= (cflags & REG_ICASE) ? RE_ICASE : 0; + + /* If REG_NEWLINE is set, newlines are treated differently. */ + if (cflags & REG_NEWLINE) + { /* REG_NEWLINE implies neither . nor [^...] match newline. */ + syntax &= ~RE_DOT_NEWLINE; + syntax |= RE_HAT_LISTS_NOT_NEWLINE; + /* It also changes the matching behavior. */ + preg->newline_anchor = 1; + } + else + preg->newline_anchor = 0; + preg->no_sub = !!(cflags & REG_NOSUB); + preg->translate = NULL; + + ret = re_compile_internal (preg, pattern, strlen (pattern), syntax); + + /* POSIX doesn't distinguish between an unmatched open-group and an + unmatched close-group: both are REG_EPAREN. */ + if (ret == REG_ERPAREN) + ret = REG_EPAREN; + + /* We have already checked preg->fastmap != NULL. */ + if (BE (ret == REG_NOERROR, 1)) + /* Compute the fastmap now, since regexec cannot modify the pattern + buffer. This function never fails in this implementation. */ + (void) re_compile_fastmap (preg); + else + { + /* Some error occurred while compiling the expression. */ + re_free (preg->fastmap); + preg->fastmap = NULL; + } + + return (int) ret; +} +#ifdef _LIBC +libc_hidden_def (__regcomp) +weak_alias (__regcomp, regcomp) +#endif + +/* Returns a message corresponding to an error code, ERRCODE, returned + from either regcomp or regexec. We don't use PREG here. */ + +size_t +regerror (int errcode, const regex_t *_Restrict_ preg, char *_Restrict_ errbuf, + size_t errbuf_size) +{ + const char *msg; + size_t msg_size; + + if (BE (errcode < 0 + || errcode >= (int) (sizeof (__re_error_msgid_idx) + / sizeof (__re_error_msgid_idx[0])), 0)) + /* Only error codes returned by the rest of the code should be passed + to this routine. If we are given anything else, or if other regex + code generates an invalid error code, then the program has a bug. + Dump core so we can fix it. */ + abort (); + + msg = gettext (__re_error_msgid + __re_error_msgid_idx[errcode]); + + msg_size = strlen (msg) + 1; /* Includes the null. */ + + if (BE (errbuf_size != 0, 1)) + { + size_t cpy_size = msg_size; + if (BE (msg_size > errbuf_size, 0)) + { + cpy_size = errbuf_size - 1; + errbuf[cpy_size] = '\0'; + } + memcpy (errbuf, msg, cpy_size); + } + + return msg_size; +} +#ifdef _LIBC +weak_alias (__regerror, regerror) +#endif + + +#ifdef RE_ENABLE_I18N +/* This static array is used for the map to single-byte characters when + UTF-8 is used. Otherwise we would allocate memory just to initialize + it the same all the time. UTF-8 is the preferred encoding so this is + a worthwhile optimization. */ +static const bitset_t utf8_sb_map = +{ + /* Set the first 128 bits. */ +# if defined __GNUC__ && !defined __STRICT_ANSI__ + [0 ... 0x80 / BITSET_WORD_BITS - 1] = BITSET_WORD_MAX +# else +# if 4 * BITSET_WORD_BITS < ASCII_CHARS +# error "bitset_word_t is narrower than 32 bits" +# elif 3 * BITSET_WORD_BITS < ASCII_CHARS + BITSET_WORD_MAX, BITSET_WORD_MAX, BITSET_WORD_MAX, +# elif 2 * BITSET_WORD_BITS < ASCII_CHARS + BITSET_WORD_MAX, BITSET_WORD_MAX, +# elif 1 * BITSET_WORD_BITS < ASCII_CHARS + BITSET_WORD_MAX, +# endif + (BITSET_WORD_MAX + >> (SBC_MAX % BITSET_WORD_BITS == 0 + ? 0 + : BITSET_WORD_BITS - SBC_MAX % BITSET_WORD_BITS)) +# endif +}; +#endif + + +static void +free_dfa_content (re_dfa_t *dfa) +{ + Idx i, j; + + if (dfa->nodes) + for (i = 0; i < dfa->nodes_len; ++i) + free_token (dfa->nodes + i); + re_free (dfa->nexts); + for (i = 0; i < dfa->nodes_len; ++i) + { + if (dfa->eclosures != NULL) + re_node_set_free (dfa->eclosures + i); + if (dfa->inveclosures != NULL) + re_node_set_free (dfa->inveclosures + i); + if (dfa->edests != NULL) + re_node_set_free (dfa->edests + i); + } + re_free (dfa->edests); + re_free (dfa->eclosures); + re_free (dfa->inveclosures); + re_free (dfa->nodes); + + if (dfa->state_table) + for (i = 0; i <= dfa->state_hash_mask; ++i) + { + struct re_state_table_entry *entry = dfa->state_table + i; + for (j = 0; j < entry->num; ++j) + { + re_dfastate_t *state = entry->array[j]; + free_state (state); + } + re_free (entry->array); + } + re_free (dfa->state_table); +#ifdef RE_ENABLE_I18N + if (dfa->sb_char != utf8_sb_map) + re_free (dfa->sb_char); +#endif + re_free (dfa->subexp_map); +#ifdef DEBUG + re_free (dfa->re_str); +#endif + + re_free (dfa); +} + + +/* Free dynamically allocated space used by PREG. */ + +void +regfree (regex_t *preg) +{ + re_dfa_t *dfa = preg->buffer; + if (BE (dfa != NULL, 1)) + { + lock_fini (dfa->lock); + free_dfa_content (dfa); + } + preg->buffer = NULL; + preg->allocated = 0; + + re_free (preg->fastmap); + preg->fastmap = NULL; + + re_free (preg->translate); + preg->translate = NULL; +} +#ifdef _LIBC +libc_hidden_def (__regfree) +weak_alias (__regfree, regfree) +#endif + +/* Entry points compatible with 4.2 BSD regex library. We don't define + them unless specifically requested. */ + +#if defined _REGEX_RE_COMP || defined _LIBC + +/* BSD has one and only one pattern buffer. */ +static struct re_pattern_buffer re_comp_buf; + +char * +# ifdef _LIBC +/* Make these definitions weak in libc, so POSIX programs can redefine + these names if they don't use our functions, and still use + regcomp/regexec above without link errors. */ +weak_function +# endif +re_comp (const char *s) +{ + reg_errcode_t ret; + char *fastmap; + + if (!s) + { + if (!re_comp_buf.buffer) + return gettext ("No previous regular expression"); + return 0; + } + + if (re_comp_buf.buffer) + { + fastmap = re_comp_buf.fastmap; + re_comp_buf.fastmap = NULL; + __regfree (&re_comp_buf); + memset (&re_comp_buf, '\0', sizeof (re_comp_buf)); + re_comp_buf.fastmap = fastmap; + } + + if (re_comp_buf.fastmap == NULL) + { + re_comp_buf.fastmap = re_malloc (char, SBC_MAX); + if (re_comp_buf.fastmap == NULL) + return (char *) gettext (__re_error_msgid + + __re_error_msgid_idx[(int) REG_ESPACE]); + } + + /* Since 're_exec' always passes NULL for the 'regs' argument, we + don't need to initialize the pattern buffer fields which affect it. */ + + /* Match anchors at newlines. */ + re_comp_buf.newline_anchor = 1; + + ret = re_compile_internal (&re_comp_buf, s, strlen (s), re_syntax_options); + + if (!ret) + return NULL; + + /* Yes, we're discarding 'const' here if !HAVE_LIBINTL. */ + return (char *) gettext (__re_error_msgid + __re_error_msgid_idx[(int) ret]); +} + +#ifdef _LIBC +libc_freeres_fn (free_mem) +{ + __regfree (&re_comp_buf); +} +#endif + +#endif /* _REGEX_RE_COMP */ + +/* Internal entry point. + Compile the regular expression PATTERN, whose length is LENGTH. + SYNTAX indicate regular expression's syntax. */ + +static reg_errcode_t +re_compile_internal (regex_t *preg, const char * pattern, size_t length, + reg_syntax_t syntax) +{ + reg_errcode_t err = REG_NOERROR; + re_dfa_t *dfa; + re_string_t regexp; + + /* Initialize the pattern buffer. */ + preg->fastmap_accurate = 0; + preg->syntax = syntax; + preg->not_bol = preg->not_eol = 0; + preg->used = 0; + preg->re_nsub = 0; + preg->can_be_null = 0; + preg->regs_allocated = REGS_UNALLOCATED; + + /* Initialize the dfa. */ + dfa = preg->buffer; + if (BE (preg->allocated < sizeof (re_dfa_t), 0)) + { + /* If zero allocated, but buffer is non-null, try to realloc + enough space. This loses if buffer's address is bogus, but + that is the user's responsibility. If ->buffer is NULL this + is a simple allocation. */ + dfa = re_realloc (preg->buffer, re_dfa_t, 1); + if (dfa == NULL) + return REG_ESPACE; + preg->allocated = sizeof (re_dfa_t); + preg->buffer = dfa; + } + preg->used = sizeof (re_dfa_t); + + err = init_dfa (dfa, length); + if (BE (err == REG_NOERROR && lock_init (dfa->lock) != 0, 0)) + err = REG_ESPACE; + if (BE (err != REG_NOERROR, 0)) + { + free_dfa_content (dfa); + preg->buffer = NULL; + preg->allocated = 0; + return err; + } +#ifdef DEBUG + /* Note: length+1 will not overflow since it is checked in init_dfa. */ + dfa->re_str = re_malloc (char, length + 1); + strncpy (dfa->re_str, pattern, length + 1); +#endif + + err = re_string_construct (®exp, pattern, length, preg->translate, + (syntax & RE_ICASE) != 0, dfa); + if (BE (err != REG_NOERROR, 0)) + { + re_compile_internal_free_return: + free_workarea_compile (preg); + re_string_destruct (®exp); + lock_fini (dfa->lock); + free_dfa_content (dfa); + preg->buffer = NULL; + preg->allocated = 0; + return err; + } + + /* Parse the regular expression, and build a structure tree. */ + preg->re_nsub = 0; + dfa->str_tree = parse (®exp, preg, syntax, &err); + if (BE (dfa->str_tree == NULL, 0)) + goto re_compile_internal_free_return; + + /* Analyze the tree and create the nfa. */ + err = analyze (preg); + if (BE (err != REG_NOERROR, 0)) + goto re_compile_internal_free_return; + +#ifdef RE_ENABLE_I18N + /* If possible, do searching in single byte encoding to speed things up. */ + if (dfa->is_utf8 && !(syntax & RE_ICASE) && preg->translate == NULL) + optimize_utf8 (dfa); +#endif + + /* Then create the initial state of the dfa. */ + err = create_initial_state (dfa); + + /* Release work areas. */ + free_workarea_compile (preg); + re_string_destruct (®exp); + + if (BE (err != REG_NOERROR, 0)) + { + lock_fini (dfa->lock); + free_dfa_content (dfa); + preg->buffer = NULL; + preg->allocated = 0; + } + + return err; +} + +/* Initialize DFA. We use the length of the regular expression PAT_LEN + as the initial length of some arrays. */ + +static reg_errcode_t +init_dfa (re_dfa_t *dfa, size_t pat_len) +{ + __re_size_t table_size; +#ifndef _LIBC + const char *codeset_name; +#endif +#ifdef RE_ENABLE_I18N + size_t max_i18n_object_size = MAX (sizeof (wchar_t), sizeof (wctype_t)); +#else + size_t max_i18n_object_size = 0; +#endif + size_t max_object_size = + MAX (sizeof (struct re_state_table_entry), + MAX (sizeof (re_token_t), + MAX (sizeof (re_node_set), + MAX (sizeof (regmatch_t), + max_i18n_object_size)))); + + memset (dfa, '\0', sizeof (re_dfa_t)); + + /* Force allocation of str_tree_storage the first time. */ + dfa->str_tree_storage_idx = BIN_TREE_STORAGE_SIZE; + + /* Avoid overflows. The extra "/ 2" is for the table_size doubling + calculation below, and for similar doubling calculations + elsewhere. And it's <= rather than <, because some of the + doubling calculations add 1 afterwards. */ + if (BE (MIN (IDX_MAX, SIZE_MAX / max_object_size) / 2 <= pat_len, 0)) + return REG_ESPACE; + + dfa->nodes_alloc = pat_len + 1; + dfa->nodes = re_malloc (re_token_t, dfa->nodes_alloc); + + /* table_size = 2 ^ ceil(log pat_len) */ + for (table_size = 1; ; table_size <<= 1) + if (table_size > pat_len) + break; + + dfa->state_table = calloc (sizeof (struct re_state_table_entry), table_size); + dfa->state_hash_mask = table_size - 1; + + dfa->mb_cur_max = MB_CUR_MAX; +#ifdef _LIBC + if (dfa->mb_cur_max == 6 + && strcmp (_NL_CURRENT (LC_CTYPE, _NL_CTYPE_CODESET_NAME), "UTF-8") == 0) + dfa->is_utf8 = 1; + dfa->map_notascii = (_NL_CURRENT_WORD (LC_CTYPE, _NL_CTYPE_MAP_TO_NONASCII) + != 0); +#else + codeset_name = nl_langinfo (CODESET); + if ((codeset_name[0] == 'U' || codeset_name[0] == 'u') + && (codeset_name[1] == 'T' || codeset_name[1] == 't') + && (codeset_name[2] == 'F' || codeset_name[2] == 'f') + && strcmp (codeset_name + 3 + (codeset_name[3] == '-'), "8") == 0) + dfa->is_utf8 = 1; + + /* We check exhaustively in the loop below if this charset is a + superset of ASCII. */ + dfa->map_notascii = 0; +#endif + +#ifdef RE_ENABLE_I18N + if (dfa->mb_cur_max > 1) + { + if (dfa->is_utf8) + dfa->sb_char = (re_bitset_ptr_t) utf8_sb_map; + else + { + int i, j, ch; + + dfa->sb_char = (re_bitset_ptr_t) calloc (sizeof (bitset_t), 1); + if (BE (dfa->sb_char == NULL, 0)) + return REG_ESPACE; + + /* Set the bits corresponding to single byte chars. */ + for (i = 0, ch = 0; i < BITSET_WORDS; ++i) + for (j = 0; j < BITSET_WORD_BITS; ++j, ++ch) + { + wint_t wch = __btowc (ch); + if (wch != WEOF) + dfa->sb_char[i] |= (bitset_word_t) 1 << j; +# ifndef _LIBC + if (isascii (ch) && wch != ch) + dfa->map_notascii = 1; +# endif + } + } + } +#endif + + if (BE (dfa->nodes == NULL || dfa->state_table == NULL, 0)) + return REG_ESPACE; + return REG_NOERROR; +} + +/* Initialize WORD_CHAR table, which indicate which character is + "word". In this case "word" means that it is the word construction + character used by some operators like "\<", "\>", etc. */ + +static void +init_word_char (re_dfa_t *dfa) +{ + int i = 0; + int j; + int ch = 0; + dfa->word_ops_used = 1; + if (BE (dfa->map_notascii == 0, 1)) + { + /* Avoid uint32_t and uint64_t as some non-GCC platforms lack + them, an issue when this code is used in Gnulib. */ + bitset_word_t bits0 = 0x00000000; + bitset_word_t bits1 = 0x03ff0000; + bitset_word_t bits2 = 0x87fffffe; + bitset_word_t bits3 = 0x07fffffe; + if (BITSET_WORD_BITS == 64) + { + /* Pacify gcc -Woverflow on 32-bit platformns. */ + dfa->word_char[0] = bits1 << 31 << 1 | bits0; + dfa->word_char[1] = bits3 << 31 << 1 | bits2; + i = 2; + } + else if (BITSET_WORD_BITS == 32) + { + dfa->word_char[0] = bits0; + dfa->word_char[1] = bits1; + dfa->word_char[2] = bits2; + dfa->word_char[3] = bits3; + i = 4; + } + else + goto general_case; + ch = 128; + + if (BE (dfa->is_utf8, 1)) + { + memset (&dfa->word_char[i], '\0', (SBC_MAX - ch) / 8); + return; + } + } + + general_case: + for (; i < BITSET_WORDS; ++i) + for (j = 0; j < BITSET_WORD_BITS; ++j, ++ch) + if (isalnum (ch) || ch == '_') + dfa->word_char[i] |= (bitset_word_t) 1 << j; +} + +/* Free the work area which are only used while compiling. */ + +static void +free_workarea_compile (regex_t *preg) +{ + re_dfa_t *dfa = preg->buffer; + bin_tree_storage_t *storage, *next; + for (storage = dfa->str_tree_storage; storage; storage = next) + { + next = storage->next; + re_free (storage); + } + dfa->str_tree_storage = NULL; + dfa->str_tree_storage_idx = BIN_TREE_STORAGE_SIZE; + dfa->str_tree = NULL; + re_free (dfa->org_indices); + dfa->org_indices = NULL; +} + +/* Create initial states for all contexts. */ + +static reg_errcode_t +create_initial_state (re_dfa_t *dfa) +{ + Idx first, i; + reg_errcode_t err; + re_node_set init_nodes; + + /* Initial states have the epsilon closure of the node which is + the first node of the regular expression. */ + first = dfa->str_tree->first->node_idx; + dfa->init_node = first; + err = re_node_set_init_copy (&init_nodes, dfa->eclosures + first); + if (BE (err != REG_NOERROR, 0)) + return err; + + /* The back-references which are in initial states can epsilon transit, + since in this case all of the subexpressions can be null. + Then we add epsilon closures of the nodes which are the next nodes of + the back-references. */ + if (dfa->nbackref > 0) + for (i = 0; i < init_nodes.nelem; ++i) + { + Idx node_idx = init_nodes.elems[i]; + re_token_type_t type = dfa->nodes[node_idx].type; + + Idx clexp_idx; + if (type != OP_BACK_REF) + continue; + for (clexp_idx = 0; clexp_idx < init_nodes.nelem; ++clexp_idx) + { + re_token_t *clexp_node; + clexp_node = dfa->nodes + init_nodes.elems[clexp_idx]; + if (clexp_node->type == OP_CLOSE_SUBEXP + && clexp_node->opr.idx == dfa->nodes[node_idx].opr.idx) + break; + } + if (clexp_idx == init_nodes.nelem) + continue; + + if (type == OP_BACK_REF) + { + Idx dest_idx = dfa->edests[node_idx].elems[0]; + if (!re_node_set_contains (&init_nodes, dest_idx)) + { + reg_errcode_t merge_err + = re_node_set_merge (&init_nodes, dfa->eclosures + dest_idx); + if (merge_err != REG_NOERROR) + return merge_err; + i = 0; + } + } + } + + /* It must be the first time to invoke acquire_state. */ + dfa->init_state = re_acquire_state_context (&err, dfa, &init_nodes, 0); + /* We don't check ERR here, since the initial state must not be NULL. */ + if (BE (dfa->init_state == NULL, 0)) + return err; + if (dfa->init_state->has_constraint) + { + dfa->init_state_word = re_acquire_state_context (&err, dfa, &init_nodes, + CONTEXT_WORD); + dfa->init_state_nl = re_acquire_state_context (&err, dfa, &init_nodes, + CONTEXT_NEWLINE); + dfa->init_state_begbuf = re_acquire_state_context (&err, dfa, + &init_nodes, + CONTEXT_NEWLINE + | CONTEXT_BEGBUF); + if (BE (dfa->init_state_word == NULL || dfa->init_state_nl == NULL + || dfa->init_state_begbuf == NULL, 0)) + return err; + } + else + dfa->init_state_word = dfa->init_state_nl + = dfa->init_state_begbuf = dfa->init_state; + + re_node_set_free (&init_nodes); + return REG_NOERROR; +} + +#ifdef RE_ENABLE_I18N +/* If it is possible to do searching in single byte encoding instead of UTF-8 + to speed things up, set dfa->mb_cur_max to 1, clear is_utf8 and change + DFA nodes where needed. */ + +static void +optimize_utf8 (re_dfa_t *dfa) +{ + Idx node; + int i; + bool mb_chars = false; + bool has_period = false; + + for (node = 0; node < dfa->nodes_len; ++node) + switch (dfa->nodes[node].type) + { + case CHARACTER: + if (dfa->nodes[node].opr.c >= ASCII_CHARS) + mb_chars = true; + break; + case ANCHOR: + switch (dfa->nodes[node].opr.ctx_type) + { + case LINE_FIRST: + case LINE_LAST: + case BUF_FIRST: + case BUF_LAST: + break; + default: + /* Word anchors etc. cannot be handled. It's okay to test + opr.ctx_type since constraints (for all DFA nodes) are + created by ORing one or more opr.ctx_type values. */ + return; + } + break; + case OP_PERIOD: + has_period = true; + break; + case OP_BACK_REF: + case OP_ALT: + case END_OF_RE: + case OP_DUP_ASTERISK: + case OP_OPEN_SUBEXP: + case OP_CLOSE_SUBEXP: + break; + case COMPLEX_BRACKET: + return; + case SIMPLE_BRACKET: + /* Just double check. */ + { + int rshift = (ASCII_CHARS % BITSET_WORD_BITS == 0 + ? 0 + : BITSET_WORD_BITS - ASCII_CHARS % BITSET_WORD_BITS); + for (i = ASCII_CHARS / BITSET_WORD_BITS; i < BITSET_WORDS; ++i) + { + if (dfa->nodes[node].opr.sbcset[i] >> rshift != 0) + return; + rshift = 0; + } + } + break; + default: + abort (); + } + + if (mb_chars || has_period) + for (node = 0; node < dfa->nodes_len; ++node) + { + if (dfa->nodes[node].type == CHARACTER + && dfa->nodes[node].opr.c >= ASCII_CHARS) + dfa->nodes[node].mb_partial = 0; + else if (dfa->nodes[node].type == OP_PERIOD) + dfa->nodes[node].type = OP_UTF8_PERIOD; + } + + /* The search can be in single byte locale. */ + dfa->mb_cur_max = 1; + dfa->is_utf8 = 0; + dfa->has_mb_node = dfa->nbackref > 0 || has_period; +} +#endif + +/* Analyze the structure tree, and calculate "first", "next", "edest", + "eclosure", and "inveclosure". */ + +static reg_errcode_t +analyze (regex_t *preg) +{ + re_dfa_t *dfa = preg->buffer; + reg_errcode_t ret; + + /* Allocate arrays. */ + dfa->nexts = re_malloc (Idx, dfa->nodes_alloc); + dfa->org_indices = re_malloc (Idx, dfa->nodes_alloc); + dfa->edests = re_malloc (re_node_set, dfa->nodes_alloc); + dfa->eclosures = re_malloc (re_node_set, dfa->nodes_alloc); + if (BE (dfa->nexts == NULL || dfa->org_indices == NULL || dfa->edests == NULL + || dfa->eclosures == NULL, 0)) + return REG_ESPACE; + + dfa->subexp_map = re_malloc (Idx, preg->re_nsub); + if (dfa->subexp_map != NULL) + { + Idx i; + for (i = 0; i < preg->re_nsub; i++) + dfa->subexp_map[i] = i; + preorder (dfa->str_tree, optimize_subexps, dfa); + for (i = 0; i < preg->re_nsub; i++) + if (dfa->subexp_map[i] != i) + break; + if (i == preg->re_nsub) + { + re_free (dfa->subexp_map); + dfa->subexp_map = NULL; + } + } + + ret = postorder (dfa->str_tree, lower_subexps, preg); + if (BE (ret != REG_NOERROR, 0)) + return ret; + ret = postorder (dfa->str_tree, calc_first, dfa); + if (BE (ret != REG_NOERROR, 0)) + return ret; + preorder (dfa->str_tree, calc_next, dfa); + ret = preorder (dfa->str_tree, link_nfa_nodes, dfa); + if (BE (ret != REG_NOERROR, 0)) + return ret; + ret = calc_eclosure (dfa); + if (BE (ret != REG_NOERROR, 0)) + return ret; + + /* We only need this during the prune_impossible_nodes pass in regexec.c; + skip it if p_i_n will not run, as calc_inveclosure can be quadratic. */ + if ((!preg->no_sub && preg->re_nsub > 0 && dfa->has_plural_match) + || dfa->nbackref) + { + dfa->inveclosures = re_malloc (re_node_set, dfa->nodes_len); + if (BE (dfa->inveclosures == NULL, 0)) + return REG_ESPACE; + ret = calc_inveclosure (dfa); + } + + return ret; +} + +/* Our parse trees are very unbalanced, so we cannot use a stack to + implement parse tree visits. Instead, we use parent pointers and + some hairy code in these two functions. */ +static reg_errcode_t +postorder (bin_tree_t *root, reg_errcode_t (fn (void *, bin_tree_t *)), + void *extra) +{ + bin_tree_t *node, *prev; + + for (node = root; ; ) + { + /* Descend down the tree, preferably to the left (or to the right + if that's the only child). */ + while (node->left || node->right) + if (node->left) + node = node->left; + else + node = node->right; + + do + { + reg_errcode_t err = fn (extra, node); + if (BE (err != REG_NOERROR, 0)) + return err; + if (node->parent == NULL) + return REG_NOERROR; + prev = node; + node = node->parent; + } + /* Go up while we have a node that is reached from the right. */ + while (node->right == prev || node->right == NULL); + node = node->right; + } +} + +static reg_errcode_t +preorder (bin_tree_t *root, reg_errcode_t (fn (void *, bin_tree_t *)), + void *extra) +{ + bin_tree_t *node; + + for (node = root; ; ) + { + reg_errcode_t err = fn (extra, node); + if (BE (err != REG_NOERROR, 0)) + return err; + + /* Go to the left node, or up and to the right. */ + if (node->left) + node = node->left; + else + { + bin_tree_t *prev = NULL; + while (node->right == prev || node->right == NULL) + { + prev = node; + node = node->parent; + if (!node) + return REG_NOERROR; + } + node = node->right; + } + } +} + +/* Optimization pass: if a SUBEXP is entirely contained, strip it and tell + re_search_internal to map the inner one's opr.idx to this one's. Adjust + backreferences as well. Requires a preorder visit. */ +static reg_errcode_t +optimize_subexps (void *extra, bin_tree_t *node) +{ + re_dfa_t *dfa = (re_dfa_t *) extra; + + if (node->token.type == OP_BACK_REF && dfa->subexp_map) + { + int idx = node->token.opr.idx; + node->token.opr.idx = dfa->subexp_map[idx]; + dfa->used_bkref_map |= 1 << node->token.opr.idx; + } + + else if (node->token.type == SUBEXP + && node->left && node->left->token.type == SUBEXP) + { + Idx other_idx = node->left->token.opr.idx; + + node->left = node->left->left; + if (node->left) + node->left->parent = node; + + dfa->subexp_map[other_idx] = dfa->subexp_map[node->token.opr.idx]; + if (other_idx < BITSET_WORD_BITS) + dfa->used_bkref_map &= ~((bitset_word_t) 1 << other_idx); + } + + return REG_NOERROR; +} + +/* Lowering pass: Turn each SUBEXP node into the appropriate concatenation + of OP_OPEN_SUBEXP, the body of the SUBEXP (if any) and OP_CLOSE_SUBEXP. */ +static reg_errcode_t +lower_subexps (void *extra, bin_tree_t *node) +{ + regex_t *preg = (regex_t *) extra; + reg_errcode_t err = REG_NOERROR; + + if (node->left && node->left->token.type == SUBEXP) + { + node->left = lower_subexp (&err, preg, node->left); + if (node->left) + node->left->parent = node; + } + if (node->right && node->right->token.type == SUBEXP) + { + node->right = lower_subexp (&err, preg, node->right); + if (node->right) + node->right->parent = node; + } + + return err; +} + +static bin_tree_t * +lower_subexp (reg_errcode_t *err, regex_t *preg, bin_tree_t *node) +{ + re_dfa_t *dfa = preg->buffer; + bin_tree_t *body = node->left; + bin_tree_t *op, *cls, *tree1, *tree; + + if (preg->no_sub + /* We do not optimize empty subexpressions, because otherwise we may + have bad CONCAT nodes with NULL children. This is obviously not + very common, so we do not lose much. An example that triggers + this case is the sed "script" /\(\)/x. */ + && node->left != NULL + && (node->token.opr.idx >= BITSET_WORD_BITS + || !(dfa->used_bkref_map + & ((bitset_word_t) 1 << node->token.opr.idx)))) + return node->left; + + /* Convert the SUBEXP node to the concatenation of an + OP_OPEN_SUBEXP, the contents, and an OP_CLOSE_SUBEXP. */ + op = create_tree (dfa, NULL, NULL, OP_OPEN_SUBEXP); + cls = create_tree (dfa, NULL, NULL, OP_CLOSE_SUBEXP); + tree1 = body ? create_tree (dfa, body, cls, CONCAT) : cls; + tree = create_tree (dfa, op, tree1, CONCAT); + if (BE (tree == NULL || tree1 == NULL || op == NULL || cls == NULL, 0)) + { + *err = REG_ESPACE; + return NULL; + } + + op->token.opr.idx = cls->token.opr.idx = node->token.opr.idx; + op->token.opt_subexp = cls->token.opt_subexp = node->token.opt_subexp; + return tree; +} + +/* Pass 1 in building the NFA: compute FIRST and create unlinked automaton + nodes. Requires a postorder visit. */ +static reg_errcode_t +calc_first (void *extra, bin_tree_t *node) +{ + re_dfa_t *dfa = (re_dfa_t *) extra; + if (node->token.type == CONCAT) + { + node->first = node->left->first; + node->node_idx = node->left->node_idx; + } + else + { + node->first = node; + node->node_idx = re_dfa_add_node (dfa, node->token); + if (BE (node->node_idx == -1, 0)) + return REG_ESPACE; + if (node->token.type == ANCHOR) + dfa->nodes[node->node_idx].constraint = node->token.opr.ctx_type; + } + return REG_NOERROR; +} + +/* Pass 2: compute NEXT on the tree. Preorder visit. */ +static reg_errcode_t +calc_next (void *extra, bin_tree_t *node) +{ + switch (node->token.type) + { + case OP_DUP_ASTERISK: + node->left->next = node; + break; + case CONCAT: + node->left->next = node->right->first; + node->right->next = node->next; + break; + default: + if (node->left) + node->left->next = node->next; + if (node->right) + node->right->next = node->next; + break; + } + return REG_NOERROR; +} + +/* Pass 3: link all DFA nodes to their NEXT node (any order will do). */ +static reg_errcode_t +link_nfa_nodes (void *extra, bin_tree_t *node) +{ + re_dfa_t *dfa = (re_dfa_t *) extra; + Idx idx = node->node_idx; + reg_errcode_t err = REG_NOERROR; + + switch (node->token.type) + { + case CONCAT: + break; + + case END_OF_RE: + assert (node->next == NULL); + break; + + case OP_DUP_ASTERISK: + case OP_ALT: + { + Idx left, right; + dfa->has_plural_match = 1; + if (node->left != NULL) + left = node->left->first->node_idx; + else + left = node->next->node_idx; + if (node->right != NULL) + right = node->right->first->node_idx; + else + right = node->next->node_idx; + assert (left > -1); + assert (right > -1); + err = re_node_set_init_2 (dfa->edests + idx, left, right); + } + break; + + case ANCHOR: + case OP_OPEN_SUBEXP: + case OP_CLOSE_SUBEXP: + err = re_node_set_init_1 (dfa->edests + idx, node->next->node_idx); + break; + + case OP_BACK_REF: + dfa->nexts[idx] = node->next->node_idx; + if (node->token.type == OP_BACK_REF) + err = re_node_set_init_1 (dfa->edests + idx, dfa->nexts[idx]); + break; + + default: + assert (!IS_EPSILON_NODE (node->token.type)); + dfa->nexts[idx] = node->next->node_idx; + break; + } + + return err; +} + +/* Duplicate the epsilon closure of the node ROOT_NODE. + Note that duplicated nodes have constraint INIT_CONSTRAINT in addition + to their own constraint. */ + +static reg_errcode_t +duplicate_node_closure (re_dfa_t *dfa, Idx top_org_node, Idx top_clone_node, + Idx root_node, unsigned int init_constraint) +{ + Idx org_node, clone_node; + bool ok; + unsigned int constraint = init_constraint; + for (org_node = top_org_node, clone_node = top_clone_node;;) + { + Idx org_dest, clone_dest; + if (dfa->nodes[org_node].type == OP_BACK_REF) + { + /* If the back reference epsilon-transit, its destination must + also have the constraint. Then duplicate the epsilon closure + of the destination of the back reference, and store it in + edests of the back reference. */ + org_dest = dfa->nexts[org_node]; + re_node_set_empty (dfa->edests + clone_node); + clone_dest = duplicate_node (dfa, org_dest, constraint); + if (BE (clone_dest == -1, 0)) + return REG_ESPACE; + dfa->nexts[clone_node] = dfa->nexts[org_node]; + ok = re_node_set_insert (dfa->edests + clone_node, clone_dest); + if (BE (! ok, 0)) + return REG_ESPACE; + } + else if (dfa->edests[org_node].nelem == 0) + { + /* In case of the node can't epsilon-transit, don't duplicate the + destination and store the original destination as the + destination of the node. */ + dfa->nexts[clone_node] = dfa->nexts[org_node]; + break; + } + else if (dfa->edests[org_node].nelem == 1) + { + /* In case of the node can epsilon-transit, and it has only one + destination. */ + org_dest = dfa->edests[org_node].elems[0]; + re_node_set_empty (dfa->edests + clone_node); + /* If the node is root_node itself, it means the epsilon closure + has a loop. Then tie it to the destination of the root_node. */ + if (org_node == root_node && clone_node != org_node) + { + ok = re_node_set_insert (dfa->edests + clone_node, org_dest); + if (BE (! ok, 0)) + return REG_ESPACE; + break; + } + /* In case the node has another constraint, append it. */ + constraint |= dfa->nodes[org_node].constraint; + clone_dest = duplicate_node (dfa, org_dest, constraint); + if (BE (clone_dest == -1, 0)) + return REG_ESPACE; + ok = re_node_set_insert (dfa->edests + clone_node, clone_dest); + if (BE (! ok, 0)) + return REG_ESPACE; + } + else /* dfa->edests[org_node].nelem == 2 */ + { + /* In case of the node can epsilon-transit, and it has two + destinations. In the bin_tree_t and DFA, that's '|' and '*'. */ + org_dest = dfa->edests[org_node].elems[0]; + re_node_set_empty (dfa->edests + clone_node); + /* Search for a duplicated node which satisfies the constraint. */ + clone_dest = search_duplicated_node (dfa, org_dest, constraint); + if (clone_dest == -1) + { + /* There is no such duplicated node, create a new one. */ + reg_errcode_t err; + clone_dest = duplicate_node (dfa, org_dest, constraint); + if (BE (clone_dest == -1, 0)) + return REG_ESPACE; + ok = re_node_set_insert (dfa->edests + clone_node, clone_dest); + if (BE (! ok, 0)) + return REG_ESPACE; + err = duplicate_node_closure (dfa, org_dest, clone_dest, + root_node, constraint); + if (BE (err != REG_NOERROR, 0)) + return err; + } + else + { + /* There is a duplicated node which satisfies the constraint, + use it to avoid infinite loop. */ + ok = re_node_set_insert (dfa->edests + clone_node, clone_dest); + if (BE (! ok, 0)) + return REG_ESPACE; + } + + org_dest = dfa->edests[org_node].elems[1]; + clone_dest = duplicate_node (dfa, org_dest, constraint); + if (BE (clone_dest == -1, 0)) + return REG_ESPACE; + ok = re_node_set_insert (dfa->edests + clone_node, clone_dest); + if (BE (! ok, 0)) + return REG_ESPACE; + } + org_node = org_dest; + clone_node = clone_dest; + } + return REG_NOERROR; +} + +/* Search for a node which is duplicated from the node ORG_NODE, and + satisfies the constraint CONSTRAINT. */ + +static Idx +search_duplicated_node (const re_dfa_t *dfa, Idx org_node, + unsigned int constraint) +{ + Idx idx; + for (idx = dfa->nodes_len - 1; dfa->nodes[idx].duplicated && idx > 0; --idx) + { + if (org_node == dfa->org_indices[idx] + && constraint == dfa->nodes[idx].constraint) + return idx; /* Found. */ + } + return -1; /* Not found. */ +} + +/* Duplicate the node whose index is ORG_IDX and set the constraint CONSTRAINT. + Return the index of the new node, or -1 if insufficient storage is + available. */ + +static Idx +duplicate_node (re_dfa_t *dfa, Idx org_idx, unsigned int constraint) +{ + Idx dup_idx = re_dfa_add_node (dfa, dfa->nodes[org_idx]); + if (BE (dup_idx != -1, 1)) + { + dfa->nodes[dup_idx].constraint = constraint; + dfa->nodes[dup_idx].constraint |= dfa->nodes[org_idx].constraint; + dfa->nodes[dup_idx].duplicated = 1; + + /* Store the index of the original node. */ + dfa->org_indices[dup_idx] = org_idx; + } + return dup_idx; +} + +static reg_errcode_t +calc_inveclosure (re_dfa_t *dfa) +{ + Idx src, idx; + bool ok; + for (idx = 0; idx < dfa->nodes_len; ++idx) + re_node_set_init_empty (dfa->inveclosures + idx); + + for (src = 0; src < dfa->nodes_len; ++src) + { + Idx *elems = dfa->eclosures[src].elems; + for (idx = 0; idx < dfa->eclosures[src].nelem; ++idx) + { + ok = re_node_set_insert_last (dfa->inveclosures + elems[idx], src); + if (BE (! ok, 0)) + return REG_ESPACE; + } + } + + return REG_NOERROR; +} + +/* Calculate "eclosure" for all the node in DFA. */ + +static reg_errcode_t +calc_eclosure (re_dfa_t *dfa) +{ + Idx node_idx; + bool incomplete; +#ifdef DEBUG + assert (dfa->nodes_len > 0); +#endif + incomplete = false; + /* For each nodes, calculate epsilon closure. */ + for (node_idx = 0; ; ++node_idx) + { + reg_errcode_t err; + re_node_set eclosure_elem; + if (node_idx == dfa->nodes_len) + { + if (!incomplete) + break; + incomplete = false; + node_idx = 0; + } + +#ifdef DEBUG + assert (dfa->eclosures[node_idx].nelem != -1); +#endif + + /* If we have already calculated, skip it. */ + if (dfa->eclosures[node_idx].nelem != 0) + continue; + /* Calculate epsilon closure of 'node_idx'. */ + err = calc_eclosure_iter (&eclosure_elem, dfa, node_idx, true); + if (BE (err != REG_NOERROR, 0)) + return err; + + if (dfa->eclosures[node_idx].nelem == 0) + { + incomplete = true; + re_node_set_free (&eclosure_elem); + } + } + return REG_NOERROR; +} + +/* Calculate epsilon closure of NODE. */ + +static reg_errcode_t +calc_eclosure_iter (re_node_set *new_set, re_dfa_t *dfa, Idx node, bool root) +{ + reg_errcode_t err; + Idx i; + re_node_set eclosure; + bool ok; + bool incomplete = false; + err = re_node_set_alloc (&eclosure, dfa->edests[node].nelem + 1); + if (BE (err != REG_NOERROR, 0)) + return err; + + /* This indicates that we are calculating this node now. + We reference this value to avoid infinite loop. */ + dfa->eclosures[node].nelem = -1; + + /* If the current node has constraints, duplicate all nodes + since they must inherit the constraints. */ + if (dfa->nodes[node].constraint + && dfa->edests[node].nelem + && !dfa->nodes[dfa->edests[node].elems[0]].duplicated) + { + err = duplicate_node_closure (dfa, node, node, node, + dfa->nodes[node].constraint); + if (BE (err != REG_NOERROR, 0)) + return err; + } + + /* Expand each epsilon destination nodes. */ + if (IS_EPSILON_NODE(dfa->nodes[node].type)) + for (i = 0; i < dfa->edests[node].nelem; ++i) + { + re_node_set eclosure_elem; + Idx edest = dfa->edests[node].elems[i]; + /* If calculating the epsilon closure of 'edest' is in progress, + return intermediate result. */ + if (dfa->eclosures[edest].nelem == -1) + { + incomplete = true; + continue; + } + /* If we haven't calculated the epsilon closure of 'edest' yet, + calculate now. Otherwise use calculated epsilon closure. */ + if (dfa->eclosures[edest].nelem == 0) + { + err = calc_eclosure_iter (&eclosure_elem, dfa, edest, false); + if (BE (err != REG_NOERROR, 0)) + return err; + } + else + eclosure_elem = dfa->eclosures[edest]; + /* Merge the epsilon closure of 'edest'. */ + err = re_node_set_merge (&eclosure, &eclosure_elem); + if (BE (err != REG_NOERROR, 0)) + return err; + /* If the epsilon closure of 'edest' is incomplete, + the epsilon closure of this node is also incomplete. */ + if (dfa->eclosures[edest].nelem == 0) + { + incomplete = true; + re_node_set_free (&eclosure_elem); + } + } + + /* An epsilon closure includes itself. */ + ok = re_node_set_insert (&eclosure, node); + if (BE (! ok, 0)) + return REG_ESPACE; + if (incomplete && !root) + dfa->eclosures[node].nelem = 0; + else + dfa->eclosures[node] = eclosure; + *new_set = eclosure; + return REG_NOERROR; +} + +/* Functions for token which are used in the parser. */ + +/* Fetch a token from INPUT. + We must not use this function inside bracket expressions. */ + +static void +fetch_token (re_token_t *result, re_string_t *input, reg_syntax_t syntax) +{ + re_string_skip_bytes (input, peek_token (result, input, syntax)); +} + +/* Peek a token from INPUT, and return the length of the token. + We must not use this function inside bracket expressions. */ + +static int +peek_token (re_token_t *token, re_string_t *input, reg_syntax_t syntax) +{ + unsigned char c; + + if (re_string_eoi (input)) + { + token->type = END_OF_RE; + return 0; + } + + c = re_string_peek_byte (input, 0); + token->opr.c = c; + + token->word_char = 0; +#ifdef RE_ENABLE_I18N + token->mb_partial = 0; + if (input->mb_cur_max > 1 && + !re_string_first_byte (input, re_string_cur_idx (input))) + { + token->type = CHARACTER; + token->mb_partial = 1; + return 1; + } +#endif + if (c == '\\') + { + unsigned char c2; + if (re_string_cur_idx (input) + 1 >= re_string_length (input)) + { + token->type = BACK_SLASH; + return 1; + } + + c2 = re_string_peek_byte_case (input, 1); + token->opr.c = c2; + token->type = CHARACTER; +#ifdef RE_ENABLE_I18N + if (input->mb_cur_max > 1) + { + wint_t wc = re_string_wchar_at (input, + re_string_cur_idx (input) + 1); + token->word_char = IS_WIDE_WORD_CHAR (wc) != 0; + } + else +#endif + token->word_char = IS_WORD_CHAR (c2) != 0; + + switch (c2) + { + case '|': + if (!(syntax & RE_LIMITED_OPS) && !(syntax & RE_NO_BK_VBAR)) + token->type = OP_ALT; + break; + case '1': case '2': case '3': case '4': case '5': + case '6': case '7': case '8': case '9': + if (!(syntax & RE_NO_BK_REFS)) + { + token->type = OP_BACK_REF; + token->opr.idx = c2 - '1'; + } + break; + case '<': + if (!(syntax & RE_NO_GNU_OPS)) + { + token->type = ANCHOR; + token->opr.ctx_type = WORD_FIRST; + } + break; + case '>': + if (!(syntax & RE_NO_GNU_OPS)) + { + token->type = ANCHOR; + token->opr.ctx_type = WORD_LAST; + } + break; + case 'b': + if (!(syntax & RE_NO_GNU_OPS)) + { + token->type = ANCHOR; + token->opr.ctx_type = WORD_DELIM; + } + break; + case 'B': + if (!(syntax & RE_NO_GNU_OPS)) + { + token->type = ANCHOR; + token->opr.ctx_type = NOT_WORD_DELIM; + } + break; + case 'w': + if (!(syntax & RE_NO_GNU_OPS)) + token->type = OP_WORD; + break; + case 'W': + if (!(syntax & RE_NO_GNU_OPS)) + token->type = OP_NOTWORD; + break; + case 's': + if (!(syntax & RE_NO_GNU_OPS)) + token->type = OP_SPACE; + break; + case 'S': + if (!(syntax & RE_NO_GNU_OPS)) + token->type = OP_NOTSPACE; + break; + case '`': + if (!(syntax & RE_NO_GNU_OPS)) + { + token->type = ANCHOR; + token->opr.ctx_type = BUF_FIRST; + } + break; + case '\'': + if (!(syntax & RE_NO_GNU_OPS)) + { + token->type = ANCHOR; + token->opr.ctx_type = BUF_LAST; + } + break; + case '(': + if (!(syntax & RE_NO_BK_PARENS)) + token->type = OP_OPEN_SUBEXP; + break; + case ')': + if (!(syntax & RE_NO_BK_PARENS)) + token->type = OP_CLOSE_SUBEXP; + break; + case '+': + if (!(syntax & RE_LIMITED_OPS) && (syntax & RE_BK_PLUS_QM)) + token->type = OP_DUP_PLUS; + break; + case '?': + if (!(syntax & RE_LIMITED_OPS) && (syntax & RE_BK_PLUS_QM)) + token->type = OP_DUP_QUESTION; + break; + case '{': + if ((syntax & RE_INTERVALS) && (!(syntax & RE_NO_BK_BRACES))) + token->type = OP_OPEN_DUP_NUM; + break; + case '}': + if ((syntax & RE_INTERVALS) && (!(syntax & RE_NO_BK_BRACES))) + token->type = OP_CLOSE_DUP_NUM; + break; + default: + break; + } + return 2; + } + + token->type = CHARACTER; +#ifdef RE_ENABLE_I18N + if (input->mb_cur_max > 1) + { + wint_t wc = re_string_wchar_at (input, re_string_cur_idx (input)); + token->word_char = IS_WIDE_WORD_CHAR (wc) != 0; + } + else +#endif + token->word_char = IS_WORD_CHAR (token->opr.c); + + switch (c) + { + case '\n': + if (syntax & RE_NEWLINE_ALT) + token->type = OP_ALT; + break; + case '|': + if (!(syntax & RE_LIMITED_OPS) && (syntax & RE_NO_BK_VBAR)) + token->type = OP_ALT; + break; + case '*': + token->type = OP_DUP_ASTERISK; + break; + case '+': + if (!(syntax & RE_LIMITED_OPS) && !(syntax & RE_BK_PLUS_QM)) + token->type = OP_DUP_PLUS; + break; + case '?': + if (!(syntax & RE_LIMITED_OPS) && !(syntax & RE_BK_PLUS_QM)) + token->type = OP_DUP_QUESTION; + break; + case '{': + if ((syntax & RE_INTERVALS) && (syntax & RE_NO_BK_BRACES)) + token->type = OP_OPEN_DUP_NUM; + break; + case '}': + if ((syntax & RE_INTERVALS) && (syntax & RE_NO_BK_BRACES)) + token->type = OP_CLOSE_DUP_NUM; + break; + case '(': + if (syntax & RE_NO_BK_PARENS) + token->type = OP_OPEN_SUBEXP; + break; + case ')': + if (syntax & RE_NO_BK_PARENS) + token->type = OP_CLOSE_SUBEXP; + break; + case '[': + token->type = OP_OPEN_BRACKET; + break; + case '.': + token->type = OP_PERIOD; + break; + case '^': + if (!(syntax & (RE_CONTEXT_INDEP_ANCHORS | RE_CARET_ANCHORS_HERE)) && + re_string_cur_idx (input) != 0) + { + char prev = re_string_peek_byte (input, -1); + if (!(syntax & RE_NEWLINE_ALT) || prev != '\n') + break; + } + token->type = ANCHOR; + token->opr.ctx_type = LINE_FIRST; + break; + case '$': + if (!(syntax & RE_CONTEXT_INDEP_ANCHORS) && + re_string_cur_idx (input) + 1 != re_string_length (input)) + { + re_token_t next; + re_string_skip_bytes (input, 1); + peek_token (&next, input, syntax); + re_string_skip_bytes (input, -1); + if (next.type != OP_ALT && next.type != OP_CLOSE_SUBEXP) + break; + } + token->type = ANCHOR; + token->opr.ctx_type = LINE_LAST; + break; + default: + break; + } + return 1; +} + +/* Peek a token from INPUT, and return the length of the token. + We must not use this function out of bracket expressions. */ + +static int +peek_token_bracket (re_token_t *token, re_string_t *input, reg_syntax_t syntax) +{ + unsigned char c; + if (re_string_eoi (input)) + { + token->type = END_OF_RE; + return 0; + } + c = re_string_peek_byte (input, 0); + token->opr.c = c; + +#ifdef RE_ENABLE_I18N + if (input->mb_cur_max > 1 && + !re_string_first_byte (input, re_string_cur_idx (input))) + { + token->type = CHARACTER; + return 1; + } +#endif /* RE_ENABLE_I18N */ + + if (c == '\\' && (syntax & RE_BACKSLASH_ESCAPE_IN_LISTS) + && re_string_cur_idx (input) + 1 < re_string_length (input)) + { + /* In this case, '\' escape a character. */ + unsigned char c2; + re_string_skip_bytes (input, 1); + c2 = re_string_peek_byte (input, 0); + token->opr.c = c2; + token->type = CHARACTER; + return 1; + } + if (c == '[') /* '[' is a special char in a bracket exps. */ + { + unsigned char c2; + int token_len; + if (re_string_cur_idx (input) + 1 < re_string_length (input)) + c2 = re_string_peek_byte (input, 1); + else + c2 = 0; + token->opr.c = c2; + token_len = 2; + switch (c2) + { + case '.': + token->type = OP_OPEN_COLL_ELEM; + break; + + case '=': + token->type = OP_OPEN_EQUIV_CLASS; + break; + + case ':': + if (syntax & RE_CHAR_CLASSES) + { + token->type = OP_OPEN_CHAR_CLASS; + break; + } + FALLTHROUGH; + default: + token->type = CHARACTER; + token->opr.c = c; + token_len = 1; + break; + } + return token_len; + } + switch (c) + { + case '-': + token->type = OP_CHARSET_RANGE; + break; + case ']': + token->type = OP_CLOSE_BRACKET; + break; + case '^': + token->type = OP_NON_MATCH_LIST; + break; + default: + token->type = CHARACTER; + } + return 1; +} + +/* Functions for parser. */ + +/* Entry point of the parser. + Parse the regular expression REGEXP and return the structure tree. + If an error occurs, ERR is set by error code, and return NULL. + This function build the following tree, from regular expression : + CAT + / \ + / \ + EOR + + CAT means concatenation. + EOR means end of regular expression. */ + +static bin_tree_t * +parse (re_string_t *regexp, regex_t *preg, reg_syntax_t syntax, + reg_errcode_t *err) +{ + re_dfa_t *dfa = preg->buffer; + bin_tree_t *tree, *eor, *root; + re_token_t current_token; + dfa->syntax = syntax; + fetch_token (¤t_token, regexp, syntax | RE_CARET_ANCHORS_HERE); + tree = parse_reg_exp (regexp, preg, ¤t_token, syntax, 0, err); + if (BE (*err != REG_NOERROR && tree == NULL, 0)) + return NULL; + eor = create_tree (dfa, NULL, NULL, END_OF_RE); + if (tree != NULL) + root = create_tree (dfa, tree, eor, CONCAT); + else + root = eor; + if (BE (eor == NULL || root == NULL, 0)) + { + *err = REG_ESPACE; + return NULL; + } + return root; +} + +/* This function build the following tree, from regular expression + |: + ALT + / \ + / \ + + + ALT means alternative, which represents the operator '|'. */ + +static bin_tree_t * +parse_reg_exp (re_string_t *regexp, regex_t *preg, re_token_t *token, + reg_syntax_t syntax, Idx nest, reg_errcode_t *err) +{ + re_dfa_t *dfa = preg->buffer; + bin_tree_t *tree, *branch = NULL; + bitset_word_t initial_bkref_map = dfa->completed_bkref_map; + tree = parse_branch (regexp, preg, token, syntax, nest, err); + if (BE (*err != REG_NOERROR && tree == NULL, 0)) + return NULL; + + while (token->type == OP_ALT) + { + fetch_token (token, regexp, syntax | RE_CARET_ANCHORS_HERE); + if (token->type != OP_ALT && token->type != END_OF_RE + && (nest == 0 || token->type != OP_CLOSE_SUBEXP)) + { + bitset_word_t accumulated_bkref_map = dfa->completed_bkref_map; + dfa->completed_bkref_map = initial_bkref_map; + branch = parse_branch (regexp, preg, token, syntax, nest, err); + if (BE (*err != REG_NOERROR && branch == NULL, 0)) + { + if (tree != NULL) + postorder (tree, free_tree, NULL); + return NULL; + } + dfa->completed_bkref_map |= accumulated_bkref_map; + } + else + branch = NULL; + tree = create_tree (dfa, tree, branch, OP_ALT); + if (BE (tree == NULL, 0)) + { + *err = REG_ESPACE; + return NULL; + } + } + return tree; +} + +/* This function build the following tree, from regular expression + : + CAT + / \ + / \ + + + CAT means concatenation. */ + +static bin_tree_t * +parse_branch (re_string_t *regexp, regex_t *preg, re_token_t *token, + reg_syntax_t syntax, Idx nest, reg_errcode_t *err) +{ + bin_tree_t *tree, *expr; + re_dfa_t *dfa = preg->buffer; + tree = parse_expression (regexp, preg, token, syntax, nest, err); + if (BE (*err != REG_NOERROR && tree == NULL, 0)) + return NULL; + + while (token->type != OP_ALT && token->type != END_OF_RE + && (nest == 0 || token->type != OP_CLOSE_SUBEXP)) + { + expr = parse_expression (regexp, preg, token, syntax, nest, err); + if (BE (*err != REG_NOERROR && expr == NULL, 0)) + { + if (tree != NULL) + postorder (tree, free_tree, NULL); + return NULL; + } + if (tree != NULL && expr != NULL) + { + bin_tree_t *newtree = create_tree (dfa, tree, expr, CONCAT); + if (newtree == NULL) + { + postorder (expr, free_tree, NULL); + postorder (tree, free_tree, NULL); + *err = REG_ESPACE; + return NULL; + } + tree = newtree; + } + else if (tree == NULL) + tree = expr; + /* Otherwise expr == NULL, we don't need to create new tree. */ + } + return tree; +} + +/* This function build the following tree, from regular expression a*: + * + | + a +*/ + +static bin_tree_t * +parse_expression (re_string_t *regexp, regex_t *preg, re_token_t *token, + reg_syntax_t syntax, Idx nest, reg_errcode_t *err) +{ + re_dfa_t *dfa = preg->buffer; + bin_tree_t *tree; + switch (token->type) + { + case CHARACTER: + tree = create_token_tree (dfa, NULL, NULL, token); + if (BE (tree == NULL, 0)) + { + *err = REG_ESPACE; + return NULL; + } +#ifdef RE_ENABLE_I18N + if (dfa->mb_cur_max > 1) + { + while (!re_string_eoi (regexp) + && !re_string_first_byte (regexp, re_string_cur_idx (regexp))) + { + bin_tree_t *mbc_remain; + fetch_token (token, regexp, syntax); + mbc_remain = create_token_tree (dfa, NULL, NULL, token); + tree = create_tree (dfa, tree, mbc_remain, CONCAT); + if (BE (mbc_remain == NULL || tree == NULL, 0)) + { + *err = REG_ESPACE; + return NULL; + } + } + } +#endif + break; + + case OP_OPEN_SUBEXP: + tree = parse_sub_exp (regexp, preg, token, syntax, nest + 1, err); + if (BE (*err != REG_NOERROR && tree == NULL, 0)) + return NULL; + break; + + case OP_OPEN_BRACKET: + tree = parse_bracket_exp (regexp, dfa, token, syntax, err); + if (BE (*err != REG_NOERROR && tree == NULL, 0)) + return NULL; + break; + + case OP_BACK_REF: + if (!BE (dfa->completed_bkref_map & (1 << token->opr.idx), 1)) + { + *err = REG_ESUBREG; + return NULL; + } + dfa->used_bkref_map |= 1 << token->opr.idx; + tree = create_token_tree (dfa, NULL, NULL, token); + if (BE (tree == NULL, 0)) + { + *err = REG_ESPACE; + return NULL; + } + ++dfa->nbackref; + dfa->has_mb_node = 1; + break; + + case OP_OPEN_DUP_NUM: + if (syntax & RE_CONTEXT_INVALID_DUP) + { + *err = REG_BADRPT; + return NULL; + } + FALLTHROUGH; + case OP_DUP_ASTERISK: + case OP_DUP_PLUS: + case OP_DUP_QUESTION: + if (syntax & RE_CONTEXT_INVALID_OPS) + { + *err = REG_BADRPT; + return NULL; + } + else if (syntax & RE_CONTEXT_INDEP_OPS) + { + fetch_token (token, regexp, syntax); + return parse_expression (regexp, preg, token, syntax, nest, err); + } + FALLTHROUGH; + case OP_CLOSE_SUBEXP: + if ((token->type == OP_CLOSE_SUBEXP) && + !(syntax & RE_UNMATCHED_RIGHT_PAREN_ORD)) + { + *err = REG_ERPAREN; + return NULL; + } + FALLTHROUGH; + case OP_CLOSE_DUP_NUM: + /* We treat it as a normal character. */ + + /* Then we can these characters as normal characters. */ + token->type = CHARACTER; + /* mb_partial and word_char bits should be initialized already + by peek_token. */ + tree = create_token_tree (dfa, NULL, NULL, token); + if (BE (tree == NULL, 0)) + { + *err = REG_ESPACE; + return NULL; + } + break; + + case ANCHOR: + if ((token->opr.ctx_type + & (WORD_DELIM | NOT_WORD_DELIM | WORD_FIRST | WORD_LAST)) + && dfa->word_ops_used == 0) + init_word_char (dfa); + if (token->opr.ctx_type == WORD_DELIM + || token->opr.ctx_type == NOT_WORD_DELIM) + { + bin_tree_t *tree_first, *tree_last; + if (token->opr.ctx_type == WORD_DELIM) + { + token->opr.ctx_type = WORD_FIRST; + tree_first = create_token_tree (dfa, NULL, NULL, token); + token->opr.ctx_type = WORD_LAST; + } + else + { + token->opr.ctx_type = INSIDE_WORD; + tree_first = create_token_tree (dfa, NULL, NULL, token); + token->opr.ctx_type = INSIDE_NOTWORD; + } + tree_last = create_token_tree (dfa, NULL, NULL, token); + tree = create_tree (dfa, tree_first, tree_last, OP_ALT); + if (BE (tree_first == NULL || tree_last == NULL || tree == NULL, 0)) + { + *err = REG_ESPACE; + return NULL; + } + } + else + { + tree = create_token_tree (dfa, NULL, NULL, token); + if (BE (tree == NULL, 0)) + { + *err = REG_ESPACE; + return NULL; + } + } + /* We must return here, since ANCHORs can't be followed + by repetition operators. + eg. RE"^*" is invalid or "", + it must not be "". */ + fetch_token (token, regexp, syntax); + return tree; + + case OP_PERIOD: + tree = create_token_tree (dfa, NULL, NULL, token); + if (BE (tree == NULL, 0)) + { + *err = REG_ESPACE; + return NULL; + } + if (dfa->mb_cur_max > 1) + dfa->has_mb_node = 1; + break; + + case OP_WORD: + case OP_NOTWORD: + tree = build_charclass_op (dfa, regexp->trans, + "alnum", + "_", + token->type == OP_NOTWORD, err); + if (BE (*err != REG_NOERROR && tree == NULL, 0)) + return NULL; + break; + + case OP_SPACE: + case OP_NOTSPACE: + tree = build_charclass_op (dfa, regexp->trans, + "space", + "", + token->type == OP_NOTSPACE, err); + if (BE (*err != REG_NOERROR && tree == NULL, 0)) + return NULL; + break; + + case OP_ALT: + case END_OF_RE: + return NULL; + + case BACK_SLASH: + *err = REG_EESCAPE; + return NULL; + + default: + /* Must not happen? */ +#ifdef DEBUG + assert (0); +#endif + return NULL; + } + fetch_token (token, regexp, syntax); + + while (token->type == OP_DUP_ASTERISK || token->type == OP_DUP_PLUS + || token->type == OP_DUP_QUESTION || token->type == OP_OPEN_DUP_NUM) + { + bin_tree_t *dup_tree = parse_dup_op (tree, regexp, dfa, token, + syntax, err); + if (BE (*err != REG_NOERROR && dup_tree == NULL, 0)) + { + if (tree != NULL) + postorder (tree, free_tree, NULL); + return NULL; + } + tree = dup_tree; + /* In BRE consecutive duplications are not allowed. */ + if ((syntax & RE_CONTEXT_INVALID_DUP) + && (token->type == OP_DUP_ASTERISK + || token->type == OP_OPEN_DUP_NUM)) + { + if (tree != NULL) + postorder (tree, free_tree, NULL); + *err = REG_BADRPT; + return NULL; + } + } + + return tree; +} + +/* This function build the following tree, from regular expression + (): + SUBEXP + | + +*/ + +static bin_tree_t * +parse_sub_exp (re_string_t *regexp, regex_t *preg, re_token_t *token, + reg_syntax_t syntax, Idx nest, reg_errcode_t *err) +{ + re_dfa_t *dfa = preg->buffer; + bin_tree_t *tree; + size_t cur_nsub; + cur_nsub = preg->re_nsub++; + + fetch_token (token, regexp, syntax | RE_CARET_ANCHORS_HERE); + + /* The subexpression may be a null string. */ + if (token->type == OP_CLOSE_SUBEXP) + tree = NULL; + else + { + tree = parse_reg_exp (regexp, preg, token, syntax, nest, err); + if (BE (*err == REG_NOERROR && token->type != OP_CLOSE_SUBEXP, 0)) + { + if (tree != NULL) + postorder (tree, free_tree, NULL); + *err = REG_EPAREN; + } + if (BE (*err != REG_NOERROR, 0)) + return NULL; + } + + if (cur_nsub <= '9' - '1') + dfa->completed_bkref_map |= 1 << cur_nsub; + + tree = create_tree (dfa, tree, NULL, SUBEXP); + if (BE (tree == NULL, 0)) + { + *err = REG_ESPACE; + return NULL; + } + tree->token.opr.idx = cur_nsub; + return tree; +} + +/* This function parse repetition operators like "*", "+", "{1,3}" etc. */ + +static bin_tree_t * +parse_dup_op (bin_tree_t *elem, re_string_t *regexp, re_dfa_t *dfa, + re_token_t *token, reg_syntax_t syntax, reg_errcode_t *err) +{ + bin_tree_t *tree = NULL, *old_tree = NULL; + Idx i, start, end, start_idx = re_string_cur_idx (regexp); + re_token_t start_token = *token; + + if (token->type == OP_OPEN_DUP_NUM) + { + end = 0; + start = fetch_number (regexp, token, syntax); + if (start == -1) + { + if (token->type == CHARACTER && token->opr.c == ',') + start = 0; /* We treat "{,m}" as "{0,m}". */ + else + { + *err = REG_BADBR; /* {} is invalid. */ + return NULL; + } + } + if (BE (start != -2, 1)) + { + /* We treat "{n}" as "{n,n}". */ + end = ((token->type == OP_CLOSE_DUP_NUM) ? start + : ((token->type == CHARACTER && token->opr.c == ',') + ? fetch_number (regexp, token, syntax) : -2)); + } + if (BE (start == -2 || end == -2, 0)) + { + /* Invalid sequence. */ + if (BE (!(syntax & RE_INVALID_INTERVAL_ORD), 0)) + { + if (token->type == END_OF_RE) + *err = REG_EBRACE; + else + *err = REG_BADBR; + + return NULL; + } + + /* If the syntax bit is set, rollback. */ + re_string_set_index (regexp, start_idx); + *token = start_token; + token->type = CHARACTER; + /* mb_partial and word_char bits should be already initialized by + peek_token. */ + return elem; + } + + if (BE ((end != -1 && start > end) + || token->type != OP_CLOSE_DUP_NUM, 0)) + { + /* First number greater than second. */ + *err = REG_BADBR; + return NULL; + } + + if (BE (RE_DUP_MAX < (end == -1 ? start : end), 0)) + { + *err = REG_ESIZE; + return NULL; + } + } + else + { + start = (token->type == OP_DUP_PLUS) ? 1 : 0; + end = (token->type == OP_DUP_QUESTION) ? 1 : -1; + } + + fetch_token (token, regexp, syntax); + + if (BE (elem == NULL, 0)) + return NULL; + if (BE (start == 0 && end == 0, 0)) + { + postorder (elem, free_tree, NULL); + return NULL; + } + + /* Extract "{n,m}" to "...{0,}". */ + if (BE (start > 0, 0)) + { + tree = elem; + for (i = 2; i <= start; ++i) + { + elem = duplicate_tree (elem, dfa); + tree = create_tree (dfa, tree, elem, CONCAT); + if (BE (elem == NULL || tree == NULL, 0)) + goto parse_dup_op_espace; + } + + if (start == end) + return tree; + + /* Duplicate ELEM before it is marked optional. */ + elem = duplicate_tree (elem, dfa); + if (BE (elem == NULL, 0)) + goto parse_dup_op_espace; + old_tree = tree; + } + else + old_tree = NULL; + + if (elem->token.type == SUBEXP) + { + uintptr_t subidx = elem->token.opr.idx; + postorder (elem, mark_opt_subexp, (void *) subidx); + } + + tree = create_tree (dfa, elem, NULL, + (end == -1 ? OP_DUP_ASTERISK : OP_ALT)); + if (BE (tree == NULL, 0)) + goto parse_dup_op_espace; + + /* This loop is actually executed only when end != -1, + to rewrite {0,n} as ((...?)?)?... We have + already created the start+1-th copy. */ + if (TYPE_SIGNED (Idx) || end != -1) + for (i = start + 2; i <= end; ++i) + { + elem = duplicate_tree (elem, dfa); + tree = create_tree (dfa, tree, elem, CONCAT); + if (BE (elem == NULL || tree == NULL, 0)) + goto parse_dup_op_espace; + + tree = create_tree (dfa, tree, NULL, OP_ALT); + if (BE (tree == NULL, 0)) + goto parse_dup_op_espace; + } + + if (old_tree) + tree = create_tree (dfa, old_tree, tree, CONCAT); + + return tree; + + parse_dup_op_espace: + *err = REG_ESPACE; + return NULL; +} + +/* Size of the names for collating symbol/equivalence_class/character_class. + I'm not sure, but maybe enough. */ +#define BRACKET_NAME_BUF_SIZE 32 + +#ifndef _LIBC + +# ifdef RE_ENABLE_I18N +/* Convert the byte B to the corresponding wide character. In a + unibyte locale, treat B as itself if it is an encoding error. + In a multibyte locale, return WEOF if B is an encoding error. */ +static wint_t +parse_byte (unsigned char b, re_charset_t *mbcset) +{ + wint_t wc = __btowc (b); + return wc == WEOF && !mbcset ? b : wc; +} +#endif + + /* Local function for parse_bracket_exp only used in case of NOT _LIBC. + Build the range expression which starts from START_ELEM, and ends + at END_ELEM. The result are written to MBCSET and SBCSET. + RANGE_ALLOC is the allocated size of mbcset->range_starts, and + mbcset->range_ends, is a pointer argument since we may + update it. */ + +static reg_errcode_t +# ifdef RE_ENABLE_I18N +build_range_exp (const reg_syntax_t syntax, + bitset_t sbcset, + re_charset_t *mbcset, + Idx *range_alloc, + const bracket_elem_t *start_elem, + const bracket_elem_t *end_elem) +# else /* not RE_ENABLE_I18N */ +build_range_exp (const reg_syntax_t syntax, + bitset_t sbcset, + const bracket_elem_t *start_elem, + const bracket_elem_t *end_elem) +# endif /* not RE_ENABLE_I18N */ +{ + unsigned int start_ch, end_ch; + /* Equivalence Classes and Character Classes can't be a range start/end. */ + if (BE (start_elem->type == EQUIV_CLASS || start_elem->type == CHAR_CLASS + || end_elem->type == EQUIV_CLASS || end_elem->type == CHAR_CLASS, + 0)) + return REG_ERANGE; + + /* We can handle no multi character collating elements without libc + support. */ + if (BE ((start_elem->type == COLL_SYM + && strlen ((char *) start_elem->opr.name) > 1) + || (end_elem->type == COLL_SYM + && strlen ((char *) end_elem->opr.name) > 1), 0)) + return REG_ECOLLATE; + +# ifdef RE_ENABLE_I18N + { + wchar_t wc; + wint_t start_wc; + wint_t end_wc; + + start_ch = ((start_elem->type == SB_CHAR) ? start_elem->opr.ch + : ((start_elem->type == COLL_SYM) ? start_elem->opr.name[0] + : 0)); + end_ch = ((end_elem->type == SB_CHAR) ? end_elem->opr.ch + : ((end_elem->type == COLL_SYM) ? end_elem->opr.name[0] + : 0)); + start_wc = ((start_elem->type == SB_CHAR || start_elem->type == COLL_SYM) + ? parse_byte (start_ch, mbcset) : start_elem->opr.wch); + end_wc = ((end_elem->type == SB_CHAR || end_elem->type == COLL_SYM) + ? parse_byte (end_ch, mbcset) : end_elem->opr.wch); + if (start_wc == WEOF || end_wc == WEOF) + return REG_ECOLLATE; + else if (BE ((syntax & RE_NO_EMPTY_RANGES) && start_wc > end_wc, 0)) + return REG_ERANGE; + + /* Got valid collation sequence values, add them as a new entry. + However, for !_LIBC we have no collation elements: if the + character set is single byte, the single byte character set + that we build below suffices. parse_bracket_exp passes + no MBCSET if dfa->mb_cur_max == 1. */ + if (mbcset) + { + /* Check the space of the arrays. */ + if (BE (*range_alloc == mbcset->nranges, 0)) + { + /* There is not enough space, need realloc. */ + wchar_t *new_array_start, *new_array_end; + Idx new_nranges; + + /* +1 in case of mbcset->nranges is 0. */ + new_nranges = 2 * mbcset->nranges + 1; + /* Use realloc since mbcset->range_starts and mbcset->range_ends + are NULL if *range_alloc == 0. */ + new_array_start = re_realloc (mbcset->range_starts, wchar_t, + new_nranges); + new_array_end = re_realloc (mbcset->range_ends, wchar_t, + new_nranges); + + if (BE (new_array_start == NULL || new_array_end == NULL, 0)) + { + re_free (new_array_start); + re_free (new_array_end); + return REG_ESPACE; + } + + mbcset->range_starts = new_array_start; + mbcset->range_ends = new_array_end; + *range_alloc = new_nranges; + } + + mbcset->range_starts[mbcset->nranges] = start_wc; + mbcset->range_ends[mbcset->nranges++] = end_wc; + } + + /* Build the table for single byte characters. */ + for (wc = 0; wc < SBC_MAX; ++wc) + { + if (start_wc <= wc && wc <= end_wc) + bitset_set (sbcset, wc); + } + } +# else /* not RE_ENABLE_I18N */ + { + unsigned int ch; + start_ch = ((start_elem->type == SB_CHAR ) ? start_elem->opr.ch + : ((start_elem->type == COLL_SYM) ? start_elem->opr.name[0] + : 0)); + end_ch = ((end_elem->type == SB_CHAR ) ? end_elem->opr.ch + : ((end_elem->type == COLL_SYM) ? end_elem->opr.name[0] + : 0)); + if (start_ch > end_ch) + return REG_ERANGE; + /* Build the table for single byte characters. */ + for (ch = 0; ch < SBC_MAX; ++ch) + if (start_ch <= ch && ch <= end_ch) + bitset_set (sbcset, ch); + } +# endif /* not RE_ENABLE_I18N */ + return REG_NOERROR; +} +#endif /* not _LIBC */ + +#ifndef _LIBC +/* Helper function for parse_bracket_exp only used in case of NOT _LIBC.. + Build the collating element which is represented by NAME. + The result are written to MBCSET and SBCSET. + COLL_SYM_ALLOC is the allocated size of mbcset->coll_sym, is a + pointer argument since we may update it. */ + +static reg_errcode_t +# ifdef RE_ENABLE_I18N +build_collating_symbol (bitset_t sbcset, re_charset_t *mbcset, + Idx *coll_sym_alloc, const unsigned char *name) +# else /* not RE_ENABLE_I18N */ +build_collating_symbol (bitset_t sbcset, const unsigned char *name) +# endif /* not RE_ENABLE_I18N */ +{ + size_t name_len = strlen ((const char *) name); + if (BE (name_len != 1, 0)) + return REG_ECOLLATE; + else + { + bitset_set (sbcset, name[0]); + return REG_NOERROR; + } +} +#endif /* not _LIBC */ + +/* This function parse bracket expression like "[abc]", "[a-c]", + "[[.a-a.]]" etc. */ + +static bin_tree_t * +parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa, re_token_t *token, + reg_syntax_t syntax, reg_errcode_t *err) +{ +#ifdef _LIBC + const unsigned char *collseqmb; + const char *collseqwc; + uint32_t nrules; + int32_t table_size; + const int32_t *symb_table; + const unsigned char *extra; + + /* Local function for parse_bracket_exp used in _LIBC environment. + Seek the collating symbol entry corresponding to NAME. + Return the index of the symbol in the SYMB_TABLE, + or -1 if not found. */ + + auto inline int32_t + __attribute__ ((always_inline)) + seek_collating_symbol_entry (const unsigned char *name, size_t name_len) + { + int32_t elem; + + for (elem = 0; elem < table_size; elem++) + if (symb_table[2 * elem] != 0) + { + int32_t idx = symb_table[2 * elem + 1]; + /* Skip the name of collating element name. */ + idx += 1 + extra[idx]; + if (/* Compare the length of the name. */ + name_len == extra[idx] + /* Compare the name. */ + && memcmp (name, &extra[idx + 1], name_len) == 0) + /* Yep, this is the entry. */ + return elem; + } + return -1; + } + + /* Local function for parse_bracket_exp used in _LIBC environment. + Look up the collation sequence value of BR_ELEM. + Return the value if succeeded, UINT_MAX otherwise. */ + + auto inline unsigned int + __attribute__ ((always_inline)) + lookup_collation_sequence_value (bracket_elem_t *br_elem) + { + if (br_elem->type == SB_CHAR) + { + /* + if (MB_CUR_MAX == 1) + */ + if (nrules == 0) + return collseqmb[br_elem->opr.ch]; + else + { + wint_t wc = __btowc (br_elem->opr.ch); + return __collseq_table_lookup (collseqwc, wc); + } + } + else if (br_elem->type == MB_CHAR) + { + if (nrules != 0) + return __collseq_table_lookup (collseqwc, br_elem->opr.wch); + } + else if (br_elem->type == COLL_SYM) + { + size_t sym_name_len = strlen ((char *) br_elem->opr.name); + if (nrules != 0) + { + int32_t elem, idx; + elem = seek_collating_symbol_entry (br_elem->opr.name, + sym_name_len); + if (elem != -1) + { + /* We found the entry. */ + idx = symb_table[2 * elem + 1]; + /* Skip the name of collating element name. */ + idx += 1 + extra[idx]; + /* Skip the byte sequence of the collating element. */ + idx += 1 + extra[idx]; + /* Adjust for the alignment. */ + idx = (idx + 3) & ~3; + /* Skip the multibyte collation sequence value. */ + idx += sizeof (unsigned int); + /* Skip the wide char sequence of the collating element. */ + idx += sizeof (unsigned int) * + (1 + *(unsigned int *) (extra + idx)); + /* Return the collation sequence value. */ + return *(unsigned int *) (extra + idx); + } + else if (sym_name_len == 1) + { + /* No valid character. Match it as a single byte + character. */ + return collseqmb[br_elem->opr.name[0]]; + } + } + else if (sym_name_len == 1) + return collseqmb[br_elem->opr.name[0]]; + } + return UINT_MAX; + } + + /* Local function for parse_bracket_exp used in _LIBC environment. + Build the range expression which starts from START_ELEM, and ends + at END_ELEM. The result are written to MBCSET and SBCSET. + RANGE_ALLOC is the allocated size of mbcset->range_starts, and + mbcset->range_ends, is a pointer argument since we may + update it. */ + + auto inline reg_errcode_t + __attribute__ ((always_inline)) + build_range_exp (bitset_t sbcset, re_charset_t *mbcset, int *range_alloc, + bracket_elem_t *start_elem, bracket_elem_t *end_elem) + { + unsigned int ch; + uint32_t start_collseq; + uint32_t end_collseq; + + /* Equivalence Classes and Character Classes can't be a range + start/end. */ + if (BE (start_elem->type == EQUIV_CLASS || start_elem->type == CHAR_CLASS + || end_elem->type == EQUIV_CLASS || end_elem->type == CHAR_CLASS, + 0)) + return REG_ERANGE; + + /* FIXME: Implement rational ranges here, too. */ + start_collseq = lookup_collation_sequence_value (start_elem); + end_collseq = lookup_collation_sequence_value (end_elem); + /* Check start/end collation sequence values. */ + if (BE (start_collseq == UINT_MAX || end_collseq == UINT_MAX, 0)) + return REG_ECOLLATE; + if (BE ((syntax & RE_NO_EMPTY_RANGES) && start_collseq > end_collseq, 0)) + return REG_ERANGE; + + /* Got valid collation sequence values, add them as a new entry. + However, if we have no collation elements, and the character set + is single byte, the single byte character set that we + build below suffices. */ + if (nrules > 0 || dfa->mb_cur_max > 1) + { + /* Check the space of the arrays. */ + if (BE (*range_alloc == mbcset->nranges, 0)) + { + /* There is not enough space, need realloc. */ + uint32_t *new_array_start; + uint32_t *new_array_end; + Idx new_nranges; + + /* +1 in case of mbcset->nranges is 0. */ + new_nranges = 2 * mbcset->nranges + 1; + new_array_start = re_realloc (mbcset->range_starts, uint32_t, + new_nranges); + new_array_end = re_realloc (mbcset->range_ends, uint32_t, + new_nranges); + + if (BE (new_array_start == NULL || new_array_end == NULL, 0)) + return REG_ESPACE; + + mbcset->range_starts = new_array_start; + mbcset->range_ends = new_array_end; + *range_alloc = new_nranges; + } + + mbcset->range_starts[mbcset->nranges] = start_collseq; + mbcset->range_ends[mbcset->nranges++] = end_collseq; + } + + /* Build the table for single byte characters. */ + for (ch = 0; ch < SBC_MAX; ch++) + { + uint32_t ch_collseq; + /* + if (MB_CUR_MAX == 1) + */ + if (nrules == 0) + ch_collseq = collseqmb[ch]; + else + ch_collseq = __collseq_table_lookup (collseqwc, __btowc (ch)); + if (start_collseq <= ch_collseq && ch_collseq <= end_collseq) + bitset_set (sbcset, ch); + } + return REG_NOERROR; + } + + /* Local function for parse_bracket_exp used in _LIBC environment. + Build the collating element which is represented by NAME. + The result are written to MBCSET and SBCSET. + COLL_SYM_ALLOC is the allocated size of mbcset->coll_sym, is a + pointer argument since we may update it. */ + + auto inline reg_errcode_t + __attribute__ ((always_inline)) + build_collating_symbol (bitset_t sbcset, re_charset_t *mbcset, + Idx *coll_sym_alloc, const unsigned char *name) + { + int32_t elem, idx; + size_t name_len = strlen ((const char *) name); + if (nrules != 0) + { + elem = seek_collating_symbol_entry (name, name_len); + if (elem != -1) + { + /* We found the entry. */ + idx = symb_table[2 * elem + 1]; + /* Skip the name of collating element name. */ + idx += 1 + extra[idx]; + } + else if (name_len == 1) + { + /* No valid character, treat it as a normal + character. */ + bitset_set (sbcset, name[0]); + return REG_NOERROR; + } + else + return REG_ECOLLATE; + + /* Got valid collation sequence, add it as a new entry. */ + /* Check the space of the arrays. */ + if (BE (*coll_sym_alloc == mbcset->ncoll_syms, 0)) + { + /* Not enough, realloc it. */ + /* +1 in case of mbcset->ncoll_syms is 0. */ + Idx new_coll_sym_alloc = 2 * mbcset->ncoll_syms + 1; + /* Use realloc since mbcset->coll_syms is NULL + if *alloc == 0. */ + int32_t *new_coll_syms = re_realloc (mbcset->coll_syms, int32_t, + new_coll_sym_alloc); + if (BE (new_coll_syms == NULL, 0)) + return REG_ESPACE; + mbcset->coll_syms = new_coll_syms; + *coll_sym_alloc = new_coll_sym_alloc; + } + mbcset->coll_syms[mbcset->ncoll_syms++] = idx; + return REG_NOERROR; + } + else + { + if (BE (name_len != 1, 0)) + return REG_ECOLLATE; + else + { + bitset_set (sbcset, name[0]); + return REG_NOERROR; + } + } + } +#endif + + re_token_t br_token; + re_bitset_ptr_t sbcset; +#ifdef RE_ENABLE_I18N + re_charset_t *mbcset; + Idx coll_sym_alloc = 0, range_alloc = 0, mbchar_alloc = 0; + Idx equiv_class_alloc = 0, char_class_alloc = 0; +#endif /* not RE_ENABLE_I18N */ + bool non_match = false; + bin_tree_t *work_tree; + int token_len; + bool first_round = true; +#ifdef _LIBC + collseqmb = (const unsigned char *) + _NL_CURRENT (LC_COLLATE, _NL_COLLATE_COLLSEQMB); + nrules = _NL_CURRENT_WORD (LC_COLLATE, _NL_COLLATE_NRULES); + if (nrules) + { + /* + if (MB_CUR_MAX > 1) + */ + collseqwc = _NL_CURRENT (LC_COLLATE, _NL_COLLATE_COLLSEQWC); + table_size = _NL_CURRENT_WORD (LC_COLLATE, _NL_COLLATE_SYMB_HASH_SIZEMB); + symb_table = (const int32_t *) _NL_CURRENT (LC_COLLATE, + _NL_COLLATE_SYMB_TABLEMB); + extra = (const unsigned char *) _NL_CURRENT (LC_COLLATE, + _NL_COLLATE_SYMB_EXTRAMB); + } +#endif + sbcset = (re_bitset_ptr_t) calloc (sizeof (bitset_t), 1); +#ifdef RE_ENABLE_I18N + mbcset = (re_charset_t *) calloc (sizeof (re_charset_t), 1); +#endif /* RE_ENABLE_I18N */ +#ifdef RE_ENABLE_I18N + if (BE (sbcset == NULL || mbcset == NULL, 0)) +#else + if (BE (sbcset == NULL, 0)) +#endif /* RE_ENABLE_I18N */ + { + re_free (sbcset); +#ifdef RE_ENABLE_I18N + re_free (mbcset); +#endif + *err = REG_ESPACE; + return NULL; + } + + token_len = peek_token_bracket (token, regexp, syntax); + if (BE (token->type == END_OF_RE, 0)) + { + *err = REG_BADPAT; + goto parse_bracket_exp_free_return; + } + if (token->type == OP_NON_MATCH_LIST) + { +#ifdef RE_ENABLE_I18N + mbcset->non_match = 1; +#endif /* not RE_ENABLE_I18N */ + non_match = true; + if (syntax & RE_HAT_LISTS_NOT_NEWLINE) + bitset_set (sbcset, '\n'); + re_string_skip_bytes (regexp, token_len); /* Skip a token. */ + token_len = peek_token_bracket (token, regexp, syntax); + if (BE (token->type == END_OF_RE, 0)) + { + *err = REG_BADPAT; + goto parse_bracket_exp_free_return; + } + } + + /* We treat the first ']' as a normal character. */ + if (token->type == OP_CLOSE_BRACKET) + token->type = CHARACTER; + + while (1) + { + bracket_elem_t start_elem, end_elem; + unsigned char start_name_buf[BRACKET_NAME_BUF_SIZE]; + unsigned char end_name_buf[BRACKET_NAME_BUF_SIZE]; + reg_errcode_t ret; + int token_len2 = 0; + bool is_range_exp = false; + re_token_t token2; + + start_elem.opr.name = start_name_buf; + start_elem.type = COLL_SYM; + ret = parse_bracket_element (&start_elem, regexp, token, token_len, dfa, + syntax, first_round); + if (BE (ret != REG_NOERROR, 0)) + { + *err = ret; + goto parse_bracket_exp_free_return; + } + first_round = false; + + /* Get information about the next token. We need it in any case. */ + token_len = peek_token_bracket (token, regexp, syntax); + + /* Do not check for ranges if we know they are not allowed. */ + if (start_elem.type != CHAR_CLASS && start_elem.type != EQUIV_CLASS) + { + if (BE (token->type == END_OF_RE, 0)) + { + *err = REG_EBRACK; + goto parse_bracket_exp_free_return; + } + if (token->type == OP_CHARSET_RANGE) + { + re_string_skip_bytes (regexp, token_len); /* Skip '-'. */ + token_len2 = peek_token_bracket (&token2, regexp, syntax); + if (BE (token2.type == END_OF_RE, 0)) + { + *err = REG_EBRACK; + goto parse_bracket_exp_free_return; + } + if (token2.type == OP_CLOSE_BRACKET) + { + /* We treat the last '-' as a normal character. */ + re_string_skip_bytes (regexp, -token_len); + token->type = CHARACTER; + } + else + is_range_exp = true; + } + } + + if (is_range_exp == true) + { + end_elem.opr.name = end_name_buf; + end_elem.type = COLL_SYM; + ret = parse_bracket_element (&end_elem, regexp, &token2, token_len2, + dfa, syntax, true); + if (BE (ret != REG_NOERROR, 0)) + { + *err = ret; + goto parse_bracket_exp_free_return; + } + + token_len = peek_token_bracket (token, regexp, syntax); + +#ifdef _LIBC + *err = build_range_exp (sbcset, mbcset, &range_alloc, + &start_elem, &end_elem); +#else +# ifdef RE_ENABLE_I18N + *err = build_range_exp (syntax, sbcset, + dfa->mb_cur_max > 1 ? mbcset : NULL, + &range_alloc, &start_elem, &end_elem); +# else + *err = build_range_exp (syntax, sbcset, &start_elem, &end_elem); +# endif +#endif /* RE_ENABLE_I18N */ + if (BE (*err != REG_NOERROR, 0)) + goto parse_bracket_exp_free_return; + } + else + { + switch (start_elem.type) + { + case SB_CHAR: + bitset_set (sbcset, start_elem.opr.ch); + break; +#ifdef RE_ENABLE_I18N + case MB_CHAR: + /* Check whether the array has enough space. */ + if (BE (mbchar_alloc == mbcset->nmbchars, 0)) + { + wchar_t *new_mbchars; + /* Not enough, realloc it. */ + /* +1 in case of mbcset->nmbchars is 0. */ + mbchar_alloc = 2 * mbcset->nmbchars + 1; + /* Use realloc since array is NULL if *alloc == 0. */ + new_mbchars = re_realloc (mbcset->mbchars, wchar_t, + mbchar_alloc); + if (BE (new_mbchars == NULL, 0)) + goto parse_bracket_exp_espace; + mbcset->mbchars = new_mbchars; + } + mbcset->mbchars[mbcset->nmbchars++] = start_elem.opr.wch; + break; +#endif /* RE_ENABLE_I18N */ + case EQUIV_CLASS: + *err = build_equiv_class (sbcset, +#ifdef RE_ENABLE_I18N + mbcset, &equiv_class_alloc, +#endif /* RE_ENABLE_I18N */ + start_elem.opr.name); + if (BE (*err != REG_NOERROR, 0)) + goto parse_bracket_exp_free_return; + break; + case COLL_SYM: + *err = build_collating_symbol (sbcset, +#ifdef RE_ENABLE_I18N + mbcset, &coll_sym_alloc, +#endif /* RE_ENABLE_I18N */ + start_elem.opr.name); + if (BE (*err != REG_NOERROR, 0)) + goto parse_bracket_exp_free_return; + break; + case CHAR_CLASS: + *err = build_charclass (regexp->trans, sbcset, +#ifdef RE_ENABLE_I18N + mbcset, &char_class_alloc, +#endif /* RE_ENABLE_I18N */ + (const char *) start_elem.opr.name, + syntax); + if (BE (*err != REG_NOERROR, 0)) + goto parse_bracket_exp_free_return; + break; + default: + assert (0); + break; + } + } + if (BE (token->type == END_OF_RE, 0)) + { + *err = REG_EBRACK; + goto parse_bracket_exp_free_return; + } + if (token->type == OP_CLOSE_BRACKET) + break; + } + + re_string_skip_bytes (regexp, token_len); /* Skip a token. */ + + /* If it is non-matching list. */ + if (non_match) + bitset_not (sbcset); + +#ifdef RE_ENABLE_I18N + /* Ensure only single byte characters are set. */ + if (dfa->mb_cur_max > 1) + bitset_mask (sbcset, dfa->sb_char); + + if (mbcset->nmbchars || mbcset->ncoll_syms || mbcset->nequiv_classes + || mbcset->nranges || (dfa->mb_cur_max > 1 && (mbcset->nchar_classes + || mbcset->non_match))) + { + bin_tree_t *mbc_tree; + int sbc_idx; + /* Build a tree for complex bracket. */ + dfa->has_mb_node = 1; + br_token.type = COMPLEX_BRACKET; + br_token.opr.mbcset = mbcset; + mbc_tree = create_token_tree (dfa, NULL, NULL, &br_token); + if (BE (mbc_tree == NULL, 0)) + goto parse_bracket_exp_espace; + for (sbc_idx = 0; sbc_idx < BITSET_WORDS; ++sbc_idx) + if (sbcset[sbc_idx]) + break; + /* If there are no bits set in sbcset, there is no point + of having both SIMPLE_BRACKET and COMPLEX_BRACKET. */ + if (sbc_idx < BITSET_WORDS) + { + /* Build a tree for simple bracket. */ + br_token.type = SIMPLE_BRACKET; + br_token.opr.sbcset = sbcset; + work_tree = create_token_tree (dfa, NULL, NULL, &br_token); + if (BE (work_tree == NULL, 0)) + goto parse_bracket_exp_espace; + + /* Then join them by ALT node. */ + work_tree = create_tree (dfa, work_tree, mbc_tree, OP_ALT); + if (BE (work_tree == NULL, 0)) + goto parse_bracket_exp_espace; + } + else + { + re_free (sbcset); + work_tree = mbc_tree; + } + } + else +#endif /* not RE_ENABLE_I18N */ + { +#ifdef RE_ENABLE_I18N + free_charset (mbcset); +#endif + /* Build a tree for simple bracket. */ + br_token.type = SIMPLE_BRACKET; + br_token.opr.sbcset = sbcset; + work_tree = create_token_tree (dfa, NULL, NULL, &br_token); + if (BE (work_tree == NULL, 0)) + goto parse_bracket_exp_espace; + } + return work_tree; + + parse_bracket_exp_espace: + *err = REG_ESPACE; + parse_bracket_exp_free_return: + re_free (sbcset); +#ifdef RE_ENABLE_I18N + free_charset (mbcset); +#endif /* RE_ENABLE_I18N */ + return NULL; +} + +/* Parse an element in the bracket expression. */ + +static reg_errcode_t +parse_bracket_element (bracket_elem_t *elem, re_string_t *regexp, + re_token_t *token, int token_len, re_dfa_t *dfa, + reg_syntax_t syntax, bool accept_hyphen) +{ +#ifdef RE_ENABLE_I18N + int cur_char_size; + cur_char_size = re_string_char_size_at (regexp, re_string_cur_idx (regexp)); + if (cur_char_size > 1) + { + elem->type = MB_CHAR; + elem->opr.wch = re_string_wchar_at (regexp, re_string_cur_idx (regexp)); + re_string_skip_bytes (regexp, cur_char_size); + return REG_NOERROR; + } +#endif /* RE_ENABLE_I18N */ + re_string_skip_bytes (regexp, token_len); /* Skip a token. */ + if (token->type == OP_OPEN_COLL_ELEM || token->type == OP_OPEN_CHAR_CLASS + || token->type == OP_OPEN_EQUIV_CLASS) + return parse_bracket_symbol (elem, regexp, token); + if (BE (token->type == OP_CHARSET_RANGE, 0) && !accept_hyphen) + { + /* A '-' must only appear as anything but a range indicator before + the closing bracket. Everything else is an error. */ + re_token_t token2; + (void) peek_token_bracket (&token2, regexp, syntax); + if (token2.type != OP_CLOSE_BRACKET) + /* The actual error value is not standardized since this whole + case is undefined. But ERANGE makes good sense. */ + return REG_ERANGE; + } + elem->type = SB_CHAR; + elem->opr.ch = token->opr.c; + return REG_NOERROR; +} + +/* Parse a bracket symbol in the bracket expression. Bracket symbols are + such as [::], [..], and + [==]. */ + +static reg_errcode_t +parse_bracket_symbol (bracket_elem_t *elem, re_string_t *regexp, + re_token_t *token) +{ + unsigned char ch, delim = token->opr.c; + int i = 0; + if (re_string_eoi(regexp)) + return REG_EBRACK; + for (;; ++i) + { + if (i >= BRACKET_NAME_BUF_SIZE) + return REG_EBRACK; + if (token->type == OP_OPEN_CHAR_CLASS) + ch = re_string_fetch_byte_case (regexp); + else + ch = re_string_fetch_byte (regexp); + if (re_string_eoi(regexp)) + return REG_EBRACK; + if (ch == delim && re_string_peek_byte (regexp, 0) == ']') + break; + elem->opr.name[i] = ch; + } + re_string_skip_bytes (regexp, 1); + elem->opr.name[i] = '\0'; + switch (token->type) + { + case OP_OPEN_COLL_ELEM: + elem->type = COLL_SYM; + break; + case OP_OPEN_EQUIV_CLASS: + elem->type = EQUIV_CLASS; + break; + case OP_OPEN_CHAR_CLASS: + elem->type = CHAR_CLASS; + break; + default: + break; + } + return REG_NOERROR; +} + + /* Helper function for parse_bracket_exp. + Build the equivalence class which is represented by NAME. + The result are written to MBCSET and SBCSET. + EQUIV_CLASS_ALLOC is the allocated size of mbcset->equiv_classes, + is a pointer argument since we may update it. */ + +static reg_errcode_t +#ifdef RE_ENABLE_I18N +build_equiv_class (bitset_t sbcset, re_charset_t *mbcset, + Idx *equiv_class_alloc, const unsigned char *name) +#else /* not RE_ENABLE_I18N */ +build_equiv_class (bitset_t sbcset, const unsigned char *name) +#endif /* not RE_ENABLE_I18N */ +{ +#ifdef _LIBC + uint32_t nrules = _NL_CURRENT_WORD (LC_COLLATE, _NL_COLLATE_NRULES); + if (nrules != 0) + { + const int32_t *table, *indirect; + const unsigned char *weights, *extra, *cp; + unsigned char char_buf[2]; + int32_t idx1, idx2; + unsigned int ch; + size_t len; + /* Calculate the index for equivalence class. */ + cp = name; + table = (const int32_t *) _NL_CURRENT (LC_COLLATE, _NL_COLLATE_TABLEMB); + weights = (const unsigned char *) _NL_CURRENT (LC_COLLATE, + _NL_COLLATE_WEIGHTMB); + extra = (const unsigned char *) _NL_CURRENT (LC_COLLATE, + _NL_COLLATE_EXTRAMB); + indirect = (const int32_t *) _NL_CURRENT (LC_COLLATE, + _NL_COLLATE_INDIRECTMB); + idx1 = findidx (table, indirect, extra, &cp, -1); + if (BE (idx1 == 0 || *cp != '\0', 0)) + /* This isn't a valid character. */ + return REG_ECOLLATE; + + /* Build single byte matching table for this equivalence class. */ + len = weights[idx1 & 0xffffff]; + for (ch = 0; ch < SBC_MAX; ++ch) + { + char_buf[0] = ch; + cp = char_buf; + idx2 = findidx (table, indirect, extra, &cp, 1); +/* + idx2 = table[ch]; +*/ + if (idx2 == 0) + /* This isn't a valid character. */ + continue; + /* Compare only if the length matches and the collation rule + index is the same. */ + if (len == weights[idx2 & 0xffffff] && (idx1 >> 24) == (idx2 >> 24)) + { + int cnt = 0; + + while (cnt <= len && + weights[(idx1 & 0xffffff) + 1 + cnt] + == weights[(idx2 & 0xffffff) + 1 + cnt]) + ++cnt; + + if (cnt > len) + bitset_set (sbcset, ch); + } + } + /* Check whether the array has enough space. */ + if (BE (*equiv_class_alloc == mbcset->nequiv_classes, 0)) + { + /* Not enough, realloc it. */ + /* +1 in case of mbcset->nequiv_classes is 0. */ + Idx new_equiv_class_alloc = 2 * mbcset->nequiv_classes + 1; + /* Use realloc since the array is NULL if *alloc == 0. */ + int32_t *new_equiv_classes = re_realloc (mbcset->equiv_classes, + int32_t, + new_equiv_class_alloc); + if (BE (new_equiv_classes == NULL, 0)) + return REG_ESPACE; + mbcset->equiv_classes = new_equiv_classes; + *equiv_class_alloc = new_equiv_class_alloc; + } + mbcset->equiv_classes[mbcset->nequiv_classes++] = idx1; + } + else +#endif /* _LIBC */ + { + if (BE (strlen ((const char *) name) != 1, 0)) + return REG_ECOLLATE; + bitset_set (sbcset, *name); + } + return REG_NOERROR; +} + + /* Helper function for parse_bracket_exp. + Build the character class which is represented by NAME. + The result are written to MBCSET and SBCSET. + CHAR_CLASS_ALLOC is the allocated size of mbcset->char_classes, + is a pointer argument since we may update it. */ + +static reg_errcode_t +#ifdef RE_ENABLE_I18N +build_charclass (RE_TRANSLATE_TYPE trans, bitset_t sbcset, + re_charset_t *mbcset, Idx *char_class_alloc, + const char *class_name, reg_syntax_t syntax) +#else /* not RE_ENABLE_I18N */ +build_charclass (RE_TRANSLATE_TYPE trans, bitset_t sbcset, + const char *class_name, reg_syntax_t syntax) +#endif /* not RE_ENABLE_I18N */ +{ + int i; + const char *name = class_name; + + /* In case of REG_ICASE "upper" and "lower" match the both of + upper and lower cases. */ + if ((syntax & RE_ICASE) + && (strcmp (name, "upper") == 0 || strcmp (name, "lower") == 0)) + name = "alpha"; + +#ifdef RE_ENABLE_I18N + /* Check the space of the arrays. */ + if (BE (*char_class_alloc == mbcset->nchar_classes, 0)) + { + /* Not enough, realloc it. */ + /* +1 in case of mbcset->nchar_classes is 0. */ + Idx new_char_class_alloc = 2 * mbcset->nchar_classes + 1; + /* Use realloc since array is NULL if *alloc == 0. */ + wctype_t *new_char_classes = re_realloc (mbcset->char_classes, wctype_t, + new_char_class_alloc); + if (BE (new_char_classes == NULL, 0)) + return REG_ESPACE; + mbcset->char_classes = new_char_classes; + *char_class_alloc = new_char_class_alloc; + } + mbcset->char_classes[mbcset->nchar_classes++] = __wctype (name); +#endif /* RE_ENABLE_I18N */ + +#define BUILD_CHARCLASS_LOOP(ctype_func) \ + do { \ + if (BE (trans != NULL, 0)) \ + { \ + for (i = 0; i < SBC_MAX; ++i) \ + if (ctype_func (i)) \ + bitset_set (sbcset, trans[i]); \ + } \ + else \ + { \ + for (i = 0; i < SBC_MAX; ++i) \ + if (ctype_func (i)) \ + bitset_set (sbcset, i); \ + } \ + } while (0) + + if (strcmp (name, "alnum") == 0) + BUILD_CHARCLASS_LOOP (isalnum); + else if (strcmp (name, "cntrl") == 0) + BUILD_CHARCLASS_LOOP (iscntrl); + else if (strcmp (name, "lower") == 0) + BUILD_CHARCLASS_LOOP (islower); + else if (strcmp (name, "space") == 0) + BUILD_CHARCLASS_LOOP (isspace); + else if (strcmp (name, "alpha") == 0) + BUILD_CHARCLASS_LOOP (isalpha); + else if (strcmp (name, "digit") == 0) + BUILD_CHARCLASS_LOOP (isdigit); + else if (strcmp (name, "print") == 0) + BUILD_CHARCLASS_LOOP (isprint); + else if (strcmp (name, "upper") == 0) + BUILD_CHARCLASS_LOOP (isupper); + else if (strcmp (name, "blank") == 0) + BUILD_CHARCLASS_LOOP (isblank); + else if (strcmp (name, "graph") == 0) + BUILD_CHARCLASS_LOOP (isgraph); + else if (strcmp (name, "punct") == 0) + BUILD_CHARCLASS_LOOP (ispunct); + else if (strcmp (name, "xdigit") == 0) + BUILD_CHARCLASS_LOOP (isxdigit); + else + return REG_ECTYPE; + + return REG_NOERROR; +} + +static bin_tree_t * +build_charclass_op (re_dfa_t *dfa, RE_TRANSLATE_TYPE trans, + const char *class_name, + const char *extra, bool non_match, + reg_errcode_t *err) +{ + re_bitset_ptr_t sbcset; +#ifdef RE_ENABLE_I18N + re_charset_t *mbcset; + Idx alloc = 0; +#endif /* not RE_ENABLE_I18N */ + reg_errcode_t ret; + re_token_t br_token; + bin_tree_t *tree; + + sbcset = (re_bitset_ptr_t) calloc (sizeof (bitset_t), 1); + if (BE (sbcset == NULL, 0)) + { + *err = REG_ESPACE; + return NULL; + } +#ifdef RE_ENABLE_I18N + mbcset = (re_charset_t *) calloc (sizeof (re_charset_t), 1); + if (BE (mbcset == NULL, 0)) + { + re_free (sbcset); + *err = REG_ESPACE; + return NULL; + } + mbcset->non_match = non_match; +#endif /* RE_ENABLE_I18N */ + + /* We don't care the syntax in this case. */ + ret = build_charclass (trans, sbcset, +#ifdef RE_ENABLE_I18N + mbcset, &alloc, +#endif /* RE_ENABLE_I18N */ + class_name, 0); + + if (BE (ret != REG_NOERROR, 0)) + { + re_free (sbcset); +#ifdef RE_ENABLE_I18N + free_charset (mbcset); +#endif /* RE_ENABLE_I18N */ + *err = ret; + return NULL; + } + /* \w match '_' also. */ + for (; *extra; extra++) + bitset_set (sbcset, *extra); + + /* If it is non-matching list. */ + if (non_match) + bitset_not (sbcset); + +#ifdef RE_ENABLE_I18N + /* Ensure only single byte characters are set. */ + if (dfa->mb_cur_max > 1) + bitset_mask (sbcset, dfa->sb_char); +#endif + + /* Build a tree for simple bracket. */ +#if defined GCC_LINT || defined lint + memset (&br_token, 0, sizeof br_token); +#endif + br_token.type = SIMPLE_BRACKET; + br_token.opr.sbcset = sbcset; + tree = create_token_tree (dfa, NULL, NULL, &br_token); + if (BE (tree == NULL, 0)) + goto build_word_op_espace; + +#ifdef RE_ENABLE_I18N + if (dfa->mb_cur_max > 1) + { + bin_tree_t *mbc_tree; + /* Build a tree for complex bracket. */ + br_token.type = COMPLEX_BRACKET; + br_token.opr.mbcset = mbcset; + dfa->has_mb_node = 1; + mbc_tree = create_token_tree (dfa, NULL, NULL, &br_token); + if (BE (mbc_tree == NULL, 0)) + goto build_word_op_espace; + /* Then join them by ALT node. */ + tree = create_tree (dfa, tree, mbc_tree, OP_ALT); + if (BE (mbc_tree != NULL, 1)) + return tree; + } + else + { + free_charset (mbcset); + return tree; + } +#else /* not RE_ENABLE_I18N */ + return tree; +#endif /* not RE_ENABLE_I18N */ + + build_word_op_espace: + re_free (sbcset); +#ifdef RE_ENABLE_I18N + free_charset (mbcset); +#endif /* RE_ENABLE_I18N */ + *err = REG_ESPACE; + return NULL; +} + +/* This is intended for the expressions like "a{1,3}". + Fetch a number from 'input', and return the number. + Return -1 if the number field is empty like "{,1}". + Return RE_DUP_MAX + 1 if the number field is too large. + Return -2 if an error occurred. */ + +static Idx +fetch_number (re_string_t *input, re_token_t *token, reg_syntax_t syntax) +{ + Idx num = -1; + unsigned char c; + while (1) + { + fetch_token (token, input, syntax); + c = token->opr.c; + if (BE (token->type == END_OF_RE, 0)) + return -2; + if (token->type == OP_CLOSE_DUP_NUM || c == ',') + break; + num = ((token->type != CHARACTER || c < '0' || '9' < c || num == -2) + ? -2 + : num == -1 + ? c - '0' + : MIN (RE_DUP_MAX + 1, num * 10 + c - '0')); + } + return num; +} + +#ifdef RE_ENABLE_I18N +static void +free_charset (re_charset_t *cset) +{ + re_free (cset->mbchars); +# ifdef _LIBC + re_free (cset->coll_syms); + re_free (cset->equiv_classes); + re_free (cset->range_starts); + re_free (cset->range_ends); +# endif + re_free (cset->char_classes); + re_free (cset); +} +#endif /* RE_ENABLE_I18N */ + +/* Functions for binary tree operation. */ + +/* Create a tree node. */ + +static bin_tree_t * +create_tree (re_dfa_t *dfa, bin_tree_t *left, bin_tree_t *right, + re_token_type_t type) +{ + re_token_t t; +#if defined GCC_LINT || defined lint + memset (&t, 0, sizeof t); +#endif + t.type = type; + return create_token_tree (dfa, left, right, &t); +} + +static bin_tree_t * +create_token_tree (re_dfa_t *dfa, bin_tree_t *left, bin_tree_t *right, + const re_token_t *token) +{ + bin_tree_t *tree; + if (BE (dfa->str_tree_storage_idx == BIN_TREE_STORAGE_SIZE, 0)) + { + bin_tree_storage_t *storage = re_malloc (bin_tree_storage_t, 1); + + if (storage == NULL) + return NULL; + storage->next = dfa->str_tree_storage; + dfa->str_tree_storage = storage; + dfa->str_tree_storage_idx = 0; + } + tree = &dfa->str_tree_storage->data[dfa->str_tree_storage_idx++]; + + tree->parent = NULL; + tree->left = left; + tree->right = right; + tree->token = *token; + tree->token.duplicated = 0; + tree->token.opt_subexp = 0; + tree->first = NULL; + tree->next = NULL; + tree->node_idx = -1; + + if (left != NULL) + left->parent = tree; + if (right != NULL) + right->parent = tree; + return tree; +} + +/* Mark the tree SRC as an optional subexpression. + To be called from preorder or postorder. */ + +static reg_errcode_t +mark_opt_subexp (void *extra, bin_tree_t *node) +{ + Idx idx = (uintptr_t) extra; + if (node->token.type == SUBEXP && node->token.opr.idx == idx) + node->token.opt_subexp = 1; + + return REG_NOERROR; +} + +/* Free the allocated memory inside NODE. */ + +static void +free_token (re_token_t *node) +{ +#ifdef RE_ENABLE_I18N + if (node->type == COMPLEX_BRACKET && node->duplicated == 0) + free_charset (node->opr.mbcset); + else +#endif /* RE_ENABLE_I18N */ + if (node->type == SIMPLE_BRACKET && node->duplicated == 0) + re_free (node->opr.sbcset); +} + +/* Worker function for tree walking. Free the allocated memory inside NODE + and its children. */ + +static reg_errcode_t +free_tree (void *extra, bin_tree_t *node) +{ + free_token (&node->token); + return REG_NOERROR; +} + + +/* Duplicate the node SRC, and return new node. This is a preorder + visit similar to the one implemented by the generic visitor, but + we need more infrastructure to maintain two parallel trees --- so, + it's easier to duplicate. */ + +static bin_tree_t * +duplicate_tree (const bin_tree_t *root, re_dfa_t *dfa) +{ + const bin_tree_t *node; + bin_tree_t *dup_root; + bin_tree_t **p_new = &dup_root, *dup_node = root->parent; + + for (node = root; ; ) + { + /* Create a new tree and link it back to the current parent. */ + *p_new = create_token_tree (dfa, NULL, NULL, &node->token); + if (*p_new == NULL) + return NULL; + (*p_new)->parent = dup_node; + (*p_new)->token.duplicated = 1; + dup_node = *p_new; + + /* Go to the left node, or up and to the right. */ + if (node->left) + { + node = node->left; + p_new = &dup_node->left; + } + else + { + const bin_tree_t *prev = NULL; + while (node->right == prev || node->right == NULL) + { + prev = node; + node = node->parent; + dup_node = dup_node->parent; + if (!node) + return dup_root; + } + node = node->right; + p_new = &dup_node->right; + } + } +} diff --git a/lib/regex.c b/lib/regex.c new file mode 100644 index 0000000000..499e1f0e03 --- /dev/null +++ b/lib/regex.c @@ -0,0 +1,81 @@ +/* Extended regular expression matching and search library. + Copyright (C) 2002-2018 Free Software Foundation, Inc. + This file is part of the GNU C Library. + Contributed by Isamu Hasegawa . + + The GNU C Library 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. + + The GNU C Library 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 the GNU C Library; if not, see + . */ + +#ifndef _LIBC +# include + +# if (__GNUC__ == 4 && 6 <= __GNUC_MINOR__) || 4 < __GNUC__ +# pragma GCC diagnostic ignored "-Wsuggest-attribute=pure" +# endif +# if (__GNUC__ == 4 && 3 <= __GNUC_MINOR__) || 4 < __GNUC__ +# pragma GCC diagnostic ignored "-Wold-style-definition" +# pragma GCC diagnostic ignored "-Wtype-limits" +# endif +#endif + +/* Make sure no one compiles this code with a C++ compiler. */ +#if defined __cplusplus && defined _LIBC +# error "This is C code, use a C compiler" +#endif + +#ifdef _LIBC +/* We have to keep the namespace clean. */ +# define regfree(preg) __regfree (preg) +# define regexec(pr, st, nm, pm, ef) __regexec (pr, st, nm, pm, ef) +# define regcomp(preg, pattern, cflags) __regcomp (preg, pattern, cflags) +# define regerror(errcode, preg, errbuf, errbuf_size) \ + __regerror(errcode, preg, errbuf, errbuf_size) +# define re_set_registers(bu, re, nu, st, en) \ + __re_set_registers (bu, re, nu, st, en) +# define re_match_2(bufp, string1, size1, string2, size2, pos, regs, stop) \ + __re_match_2 (bufp, string1, size1, string2, size2, pos, regs, stop) +# define re_match(bufp, string, size, pos, regs) \ + __re_match (bufp, string, size, pos, regs) +# define re_search(bufp, string, size, startpos, range, regs) \ + __re_search (bufp, string, size, startpos, range, regs) +# define re_compile_pattern(pattern, length, bufp) \ + __re_compile_pattern (pattern, length, bufp) +# define re_set_syntax(syntax) __re_set_syntax (syntax) +# define re_search_2(bufp, st1, s1, st2, s2, startpos, range, regs, stop) \ + __re_search_2 (bufp, st1, s1, st2, s2, startpos, range, regs, stop) +# define re_compile_fastmap(bufp) __re_compile_fastmap (bufp) + +# include "../locale/localeinfo.h" +#endif + +/* On some systems, limits.h sets RE_DUP_MAX to a lower value than + GNU regex allows. Include it before , which correctly + #undefs RE_DUP_MAX and sets it to the right value. */ +#include + +#include +#include "regex_internal.h" + +#include "regex_internal.c" +#include "regcomp.c" +#include "regexec.c" + +/* Binary backward compatibility. */ +#if _LIBC +# include +# if SHLIB_COMPAT (libc, GLIBC_2_0, GLIBC_2_3) +link_warning (re_max_failures, "the 're_max_failures' variable is obsolete and will go away.") +int re_max_failures = 2000; +# endif +#endif diff --git a/lib/regex.h b/lib/regex.h new file mode 100644 index 0000000000..f2ac9507ad --- /dev/null +++ b/lib/regex.h @@ -0,0 +1,658 @@ +/* Definitions for data structures and routines for the regular + expression library. + Copyright (C) 1985, 1989-2018 Free Software Foundation, Inc. + This file is part of the GNU C Library. + + The GNU C Library 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. + + The GNU C Library 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 the GNU C Library; if not, see + . */ + +#ifndef _REGEX_H +#define _REGEX_H 1 + +#include + +/* Allow the use in C++ code. */ +#ifdef __cplusplus +extern "C" { +#endif + +/* Define __USE_GNU to declare GNU extensions that violate the + POSIX name space rules. */ +#ifdef _GNU_SOURCE +# define __USE_GNU 1 +#endif + +#ifdef _REGEX_LARGE_OFFSETS + +/* Use types and values that are wide enough to represent signed and + unsigned byte offsets in memory. This currently works only when + the regex code is used outside of the GNU C library; it is not yet + supported within glibc itself, and glibc users should not define + _REGEX_LARGE_OFFSETS. */ + +/* The type of object sizes. */ +typedef size_t __re_size_t; + +/* The type of object sizes, in places where the traditional code + uses unsigned long int. */ +typedef size_t __re_long_size_t; + +#else + +/* The traditional GNU regex implementation mishandles strings longer + than INT_MAX. */ +typedef unsigned int __re_size_t; +typedef unsigned long int __re_long_size_t; + +#endif + +/* The following two types have to be signed and unsigned integer type + wide enough to hold a value of a pointer. For most ANSI compilers + ptrdiff_t and size_t should be likely OK. Still size of these two + types is 2 for Microsoft C. Ugh... */ +typedef long int s_reg_t; +typedef unsigned long int active_reg_t; + +/* The following bits are used to determine the regexp syntax we + recognize. The set/not-set meanings are chosen so that Emacs syntax + remains the value 0. The bits are given in alphabetical order, and + the definitions shifted by one from the previous bit; thus, when we + add or remove a bit, only one other definition need change. */ +typedef unsigned long int reg_syntax_t; + +#ifdef __USE_GNU +/* If this bit is not set, then \ inside a bracket expression is literal. + If set, then such a \ quotes the following character. */ +# define RE_BACKSLASH_ESCAPE_IN_LISTS ((unsigned long int) 1) + +/* If this bit is not set, then + and ? are operators, and \+ and \? are + literals. + If set, then \+ and \? are operators and + and ? are literals. */ +# define RE_BK_PLUS_QM (RE_BACKSLASH_ESCAPE_IN_LISTS << 1) + +/* If this bit is set, then character classes are supported. They are: + [:alpha:], [:upper:], [:lower:], [:digit:], [:alnum:], [:xdigit:], + [:space:], [:print:], [:punct:], [:graph:], and [:cntrl:]. + If not set, then character classes are not supported. */ +# define RE_CHAR_CLASSES (RE_BK_PLUS_QM << 1) + +/* If this bit is set, then ^ and $ are always anchors (outside bracket + expressions, of course). + If this bit is not set, then it depends: + ^ is an anchor if it is at the beginning of a regular + expression or after an open-group or an alternation operator; + $ is an anchor if it is at the end of a regular expression, or + before a close-group or an alternation operator. + + This bit could be (re)combined with RE_CONTEXT_INDEP_OPS, because + POSIX draft 11.2 says that * etc. in leading positions is undefined. + We already implemented a previous draft which made those constructs + invalid, though, so we haven't changed the code back. */ +# define RE_CONTEXT_INDEP_ANCHORS (RE_CHAR_CLASSES << 1) + +/* If this bit is set, then special characters are always special + regardless of where they are in the pattern. + If this bit is not set, then special characters are special only in + some contexts; otherwise they are ordinary. Specifically, + * + ? and intervals are only special when not after the beginning, + open-group, or alternation operator. */ +# define RE_CONTEXT_INDEP_OPS (RE_CONTEXT_INDEP_ANCHORS << 1) + +/* If this bit is set, then *, +, ?, and { cannot be first in an re or + immediately after an alternation or begin-group operator. */ +# define RE_CONTEXT_INVALID_OPS (RE_CONTEXT_INDEP_OPS << 1) + +/* If this bit is set, then . matches newline. + If not set, then it doesn't. */ +# define RE_DOT_NEWLINE (RE_CONTEXT_INVALID_OPS << 1) + +/* If this bit is set, then . doesn't match NUL. + If not set, then it does. */ +# define RE_DOT_NOT_NULL (RE_DOT_NEWLINE << 1) + +/* If this bit is set, nonmatching lists [^...] do not match newline. + If not set, they do. */ +# define RE_HAT_LISTS_NOT_NEWLINE (RE_DOT_NOT_NULL << 1) + +/* If this bit is set, either \{...\} or {...} defines an + interval, depending on RE_NO_BK_BRACES. + If not set, \{, \}, {, and } are literals. */ +# define RE_INTERVALS (RE_HAT_LISTS_NOT_NEWLINE << 1) + +/* If this bit is set, +, ? and | aren't recognized as operators. + If not set, they are. */ +# define RE_LIMITED_OPS (RE_INTERVALS << 1) + +/* If this bit is set, newline is an alternation operator. + If not set, newline is literal. */ +# define RE_NEWLINE_ALT (RE_LIMITED_OPS << 1) + +/* If this bit is set, then '{...}' defines an interval, and \{ and \} + are literals. + If not set, then '\{...\}' defines an interval. */ +# define RE_NO_BK_BRACES (RE_NEWLINE_ALT << 1) + +/* If this bit is set, (...) defines a group, and \( and \) are literals. + If not set, \(...\) defines a group, and ( and ) are literals. */ +# define RE_NO_BK_PARENS (RE_NO_BK_BRACES << 1) + +/* If this bit is set, then \ matches . + If not set, then \ is a back-reference. */ +# define RE_NO_BK_REFS (RE_NO_BK_PARENS << 1) + +/* If this bit is set, then | is an alternation operator, and \| is literal. + If not set, then \| is an alternation operator, and | is literal. */ +# define RE_NO_BK_VBAR (RE_NO_BK_REFS << 1) + +/* If this bit is set, then an ending range point collating higher + than the starting range point, as in [z-a], is invalid. + If not set, then when ending range point collates higher than the + starting range point, the range is ignored. */ +# define RE_NO_EMPTY_RANGES (RE_NO_BK_VBAR << 1) + +/* If this bit is set, then an unmatched ) is ordinary. + If not set, then an unmatched ) is invalid. */ +# define RE_UNMATCHED_RIGHT_PAREN_ORD (RE_NO_EMPTY_RANGES << 1) + +/* If this bit is set, succeed as soon as we match the whole pattern, + without further backtracking. */ +# define RE_NO_POSIX_BACKTRACKING (RE_UNMATCHED_RIGHT_PAREN_ORD << 1) + +/* If this bit is set, do not process the GNU regex operators. + If not set, then the GNU regex operators are recognized. */ +# define RE_NO_GNU_OPS (RE_NO_POSIX_BACKTRACKING << 1) + +/* If this bit is set, turn on internal regex debugging. + If not set, and debugging was on, turn it off. + This only works if regex.c is compiled -DDEBUG. + We define this bit always, so that all that's needed to turn on + debugging is to recompile regex.c; the calling code can always have + this bit set, and it won't affect anything in the normal case. */ +# define RE_DEBUG (RE_NO_GNU_OPS << 1) + +/* If this bit is set, a syntactically invalid interval is treated as + a string of ordinary characters. For example, the ERE 'a{1' is + treated as 'a\{1'. */ +# define RE_INVALID_INTERVAL_ORD (RE_DEBUG << 1) + +/* If this bit is set, then ignore case when matching. + If not set, then case is significant. */ +# define RE_ICASE (RE_INVALID_INTERVAL_ORD << 1) + +/* This bit is used internally like RE_CONTEXT_INDEP_ANCHORS but only + for ^, because it is difficult to scan the regex backwards to find + whether ^ should be special. */ +# define RE_CARET_ANCHORS_HERE (RE_ICASE << 1) + +/* If this bit is set, then \{ cannot be first in a regex or + immediately after an alternation, open-group or \} operator. */ +# define RE_CONTEXT_INVALID_DUP (RE_CARET_ANCHORS_HERE << 1) + +/* If this bit is set, then no_sub will be set to 1 during + re_compile_pattern. */ +# define RE_NO_SUB (RE_CONTEXT_INVALID_DUP << 1) +#endif + +/* This global variable defines the particular regexp syntax to use (for + some interfaces). When a regexp is compiled, the syntax used is + stored in the pattern buffer, so changing this does not affect + already-compiled regexps. */ +extern reg_syntax_t re_syntax_options; + +#ifdef __USE_GNU +/* Define combinations of the above bits for the standard possibilities. + (The [[[ comments delimit what gets put into the Texinfo file, so + don't delete them!) */ +/* [[[begin syntaxes]]] */ +# define RE_SYNTAX_EMACS 0 + +# define RE_SYNTAX_AWK \ + (RE_BACKSLASH_ESCAPE_IN_LISTS | RE_DOT_NOT_NULL \ + | RE_NO_BK_PARENS | RE_NO_BK_REFS \ + | RE_NO_BK_VBAR | RE_NO_EMPTY_RANGES \ + | RE_DOT_NEWLINE | RE_CONTEXT_INDEP_ANCHORS \ + | RE_CHAR_CLASSES \ + | RE_UNMATCHED_RIGHT_PAREN_ORD | RE_NO_GNU_OPS) + +# define RE_SYNTAX_GNU_AWK \ + ((RE_SYNTAX_POSIX_EXTENDED | RE_BACKSLASH_ESCAPE_IN_LISTS \ + | RE_INVALID_INTERVAL_ORD) \ + & ~(RE_DOT_NOT_NULL | RE_CONTEXT_INDEP_OPS \ + | RE_CONTEXT_INVALID_OPS )) + +# define RE_SYNTAX_POSIX_AWK \ + (RE_SYNTAX_POSIX_EXTENDED | RE_BACKSLASH_ESCAPE_IN_LISTS \ + | RE_INTERVALS | RE_NO_GNU_OPS \ + | RE_INVALID_INTERVAL_ORD) + +# define RE_SYNTAX_GREP \ + ((RE_SYNTAX_POSIX_BASIC | RE_NEWLINE_ALT) \ + & ~(RE_CONTEXT_INVALID_DUP | RE_DOT_NOT_NULL)) + +# define RE_SYNTAX_EGREP \ + ((RE_SYNTAX_POSIX_EXTENDED | RE_INVALID_INTERVAL_ORD | RE_NEWLINE_ALT) \ + & ~(RE_CONTEXT_INVALID_OPS | RE_DOT_NOT_NULL)) + +/* POSIX grep -E behavior is no longer incompatible with GNU. */ +# define RE_SYNTAX_POSIX_EGREP \ + RE_SYNTAX_EGREP + +/* P1003.2/D11.2, section 4.20.7.1, lines 5078ff. */ +# define RE_SYNTAX_ED RE_SYNTAX_POSIX_BASIC + +# define RE_SYNTAX_SED RE_SYNTAX_POSIX_BASIC + +/* Syntax bits common to both basic and extended POSIX regex syntax. */ +# define _RE_SYNTAX_POSIX_COMMON \ + (RE_CHAR_CLASSES | RE_DOT_NEWLINE | RE_DOT_NOT_NULL \ + | RE_INTERVALS | RE_NO_EMPTY_RANGES) + +# define RE_SYNTAX_POSIX_BASIC \ + (_RE_SYNTAX_POSIX_COMMON | RE_BK_PLUS_QM | RE_CONTEXT_INVALID_DUP) + +/* Differs from ..._POSIX_BASIC only in that RE_BK_PLUS_QM becomes + RE_LIMITED_OPS, i.e., \? \+ \| are not recognized. Actually, this + isn't minimal, since other operators, such as \`, aren't disabled. */ +# define RE_SYNTAX_POSIX_MINIMAL_BASIC \ + (_RE_SYNTAX_POSIX_COMMON | RE_LIMITED_OPS) + +# define RE_SYNTAX_POSIX_EXTENDED \ + (_RE_SYNTAX_POSIX_COMMON | RE_CONTEXT_INDEP_ANCHORS \ + | RE_CONTEXT_INDEP_OPS | RE_NO_BK_BRACES \ + | RE_NO_BK_PARENS | RE_NO_BK_VBAR \ + | RE_CONTEXT_INVALID_OPS | RE_UNMATCHED_RIGHT_PAREN_ORD) + +/* Differs from ..._POSIX_EXTENDED in that RE_CONTEXT_INDEP_OPS is + removed and RE_NO_BK_REFS is added. */ +# define RE_SYNTAX_POSIX_MINIMAL_EXTENDED \ + (_RE_SYNTAX_POSIX_COMMON | RE_CONTEXT_INDEP_ANCHORS \ + | RE_CONTEXT_INVALID_OPS | RE_NO_BK_BRACES \ + | RE_NO_BK_PARENS | RE_NO_BK_REFS \ + | RE_NO_BK_VBAR | RE_UNMATCHED_RIGHT_PAREN_ORD) +/* [[[end syntaxes]]] */ + +/* Maximum number of duplicates an interval can allow. POSIX-conforming + systems might define this in , but we want our + value, so remove any previous define. */ +# ifdef _REGEX_INCLUDE_LIMITS_H +# include +# endif +# ifdef RE_DUP_MAX +# undef RE_DUP_MAX +# endif + +/* RE_DUP_MAX is 2**15 - 1 because an earlier implementation stored + the counter as a 2-byte signed integer. This is no longer true, so + RE_DUP_MAX could be increased to (INT_MAX / 10 - 1), or to + ((SIZE_MAX - 9) / 10) if _REGEX_LARGE_OFFSETS is defined. + However, there would be a huge performance problem if someone + actually used a pattern like a\{214748363\}, so RE_DUP_MAX retains + its historical value. */ +# define RE_DUP_MAX (0x7fff) +#endif + + +/* POSIX 'cflags' bits (i.e., information for 'regcomp'). */ + +/* If this bit is set, then use extended regular expression syntax. + If not set, then use basic regular expression syntax. */ +#define REG_EXTENDED 1 + +/* If this bit is set, then ignore case when matching. + If not set, then case is significant. */ +#define REG_ICASE (1 << 1) + +/* If this bit is set, then anchors do not match at newline + characters in the string. + If not set, then anchors do match at newlines. */ +#define REG_NEWLINE (1 << 2) + +/* If this bit is set, then report only success or fail in regexec. + If not set, then returns differ between not matching and errors. */ +#define REG_NOSUB (1 << 3) + + +/* POSIX 'eflags' bits (i.e., information for regexec). */ + +/* If this bit is set, then the beginning-of-line operator doesn't match + the beginning of the string (presumably because it's not the + beginning of a line). + If not set, then the beginning-of-line operator does match the + beginning of the string. */ +#define REG_NOTBOL 1 + +/* Like REG_NOTBOL, except for the end-of-line. */ +#define REG_NOTEOL (1 << 1) + +/* Use PMATCH[0] to delimit the start and end of the search in the + buffer. */ +#define REG_STARTEND (1 << 2) + + +/* If any error codes are removed, changed, or added, update the + '__re_error_msgid' table in regcomp.c. */ + +typedef enum +{ + _REG_ENOSYS = -1, /* This will never happen for this implementation. */ + _REG_NOERROR = 0, /* Success. */ + _REG_NOMATCH, /* Didn't find a match (for regexec). */ + + /* POSIX regcomp return error codes. (In the order listed in the + standard.) */ + _REG_BADPAT, /* Invalid pattern. */ + _REG_ECOLLATE, /* Invalid collating element. */ + _REG_ECTYPE, /* Invalid character class name. */ + _REG_EESCAPE, /* Trailing backslash. */ + _REG_ESUBREG, /* Invalid back reference. */ + _REG_EBRACK, /* Unmatched left bracket. */ + _REG_EPAREN, /* Parenthesis imbalance. */ + _REG_EBRACE, /* Unmatched \{. */ + _REG_BADBR, /* Invalid contents of \{\}. */ + _REG_ERANGE, /* Invalid range end. */ + _REG_ESPACE, /* Ran out of memory. */ + _REG_BADRPT, /* No preceding re for repetition op. */ + + /* Error codes we've added. */ + _REG_EEND, /* Premature end. */ + _REG_ESIZE, /* Too large (e.g., repeat count too large). */ + _REG_ERPAREN /* Unmatched ) or \); not returned from regcomp. */ +} reg_errcode_t; + +#if defined _XOPEN_SOURCE || defined __USE_XOPEN2K +# define REG_ENOSYS _REG_ENOSYS +#endif +#define REG_NOERROR _REG_NOERROR +#define REG_NOMATCH _REG_NOMATCH +#define REG_BADPAT _REG_BADPAT +#define REG_ECOLLATE _REG_ECOLLATE +#define REG_ECTYPE _REG_ECTYPE +#define REG_EESCAPE _REG_EESCAPE +#define REG_ESUBREG _REG_ESUBREG +#define REG_EBRACK _REG_EBRACK +#define REG_EPAREN _REG_EPAREN +#define REG_EBRACE _REG_EBRACE +#define REG_BADBR _REG_BADBR +#define REG_ERANGE _REG_ERANGE +#define REG_ESPACE _REG_ESPACE +#define REG_BADRPT _REG_BADRPT +#define REG_EEND _REG_EEND +#define REG_ESIZE _REG_ESIZE +#define REG_ERPAREN _REG_ERPAREN + +/* This data structure represents a compiled pattern. Before calling + the pattern compiler, the fields 'buffer', 'allocated', 'fastmap', + and 'translate' can be set. After the pattern has been compiled, + the fields 're_nsub', 'not_bol' and 'not_eol' are available. All + other fields are private to the regex routines. */ + +#ifndef RE_TRANSLATE_TYPE +# define __RE_TRANSLATE_TYPE unsigned char * +# ifdef __USE_GNU +# define RE_TRANSLATE_TYPE __RE_TRANSLATE_TYPE +# endif +#endif + +#ifdef __USE_GNU +# define __REPB_PREFIX(name) name +#else +# define __REPB_PREFIX(name) __##name +#endif + +struct re_pattern_buffer +{ + /* Space that holds the compiled pattern. The type + 'struct re_dfa_t' is private and is not declared here. */ + struct re_dfa_t *__REPB_PREFIX(buffer); + + /* Number of bytes to which 'buffer' points. */ + __re_long_size_t __REPB_PREFIX(allocated); + + /* Number of bytes actually used in 'buffer'. */ + __re_long_size_t __REPB_PREFIX(used); + + /* Syntax setting with which the pattern was compiled. */ + reg_syntax_t __REPB_PREFIX(syntax); + + /* Pointer to a fastmap, if any, otherwise zero. re_search uses the + fastmap, if there is one, to skip over impossible starting points + for matches. */ + char *__REPB_PREFIX(fastmap); + + /* Either a translate table to apply to all characters before + comparing them, or zero for no translation. The translation is + applied to a pattern when it is compiled and to a string when it + is matched. */ + __RE_TRANSLATE_TYPE __REPB_PREFIX(translate); + + /* Number of subexpressions found by the compiler. */ + size_t re_nsub; + + /* Zero if this pattern cannot match the empty string, one else. + Well, in truth it's used only in 're_search_2', to see whether or + not we should use the fastmap, so we don't set this absolutely + perfectly; see 're_compile_fastmap' (the "duplicate" case). */ + unsigned __REPB_PREFIX(can_be_null) : 1; + + /* If REGS_UNALLOCATED, allocate space in the 'regs' structure + for 'max (RE_NREGS, re_nsub + 1)' groups. + If REGS_REALLOCATE, reallocate space if necessary. + If REGS_FIXED, use what's there. */ +#ifdef __USE_GNU +# define REGS_UNALLOCATED 0 +# define REGS_REALLOCATE 1 +# define REGS_FIXED 2 +#endif + unsigned __REPB_PREFIX(regs_allocated) : 2; + + /* Set to zero when 're_compile_pattern' compiles a pattern; set to + one by 're_compile_fastmap' if it updates the fastmap. */ + unsigned __REPB_PREFIX(fastmap_accurate) : 1; + + /* If set, 're_match_2' does not return information about + subexpressions. */ + unsigned __REPB_PREFIX(no_sub) : 1; + + /* If set, a beginning-of-line anchor doesn't match at the beginning + of the string. */ + unsigned __REPB_PREFIX(not_bol) : 1; + + /* Similarly for an end-of-line anchor. */ + unsigned __REPB_PREFIX(not_eol) : 1; + + /* If true, an anchor at a newline matches. */ + unsigned __REPB_PREFIX(newline_anchor) : 1; +}; + +typedef struct re_pattern_buffer regex_t; + +/* Type for byte offsets within the string. POSIX mandates this. */ +#ifdef _REGEX_LARGE_OFFSETS +/* POSIX 1003.1-2008 requires that regoff_t be at least as wide as + ptrdiff_t and ssize_t. We don't know of any hosts where ptrdiff_t + is wider than ssize_t, so ssize_t is safe. ptrdiff_t is not + visible here, so use ssize_t. */ +typedef ssize_t regoff_t; +#else +/* The traditional GNU regex implementation mishandles strings longer + than INT_MAX. */ +typedef int regoff_t; +#endif + + +#ifdef __USE_GNU +/* This is the structure we store register match data in. See + regex.texinfo for a full description of what registers match. */ +struct re_registers +{ + __re_size_t num_regs; + regoff_t *start; + regoff_t *end; +}; + + +/* If 'regs_allocated' is REGS_UNALLOCATED in the pattern buffer, + 're_match_2' returns information about at least this many registers + the first time a 'regs' structure is passed. */ +# ifndef RE_NREGS +# define RE_NREGS 30 +# endif +#endif + + +/* POSIX specification for registers. Aside from the different names than + 're_registers', POSIX uses an array of structures, instead of a + structure of arrays. */ +typedef struct +{ + regoff_t rm_so; /* Byte offset from string's start to substring's start. */ + regoff_t rm_eo; /* Byte offset from string's start to substring's end. */ +} regmatch_t; + +/* Declarations for routines. */ + +#ifdef __USE_GNU +/* Sets the current default syntax to SYNTAX, and return the old syntax. + You can also simply assign to the 're_syntax_options' variable. */ +extern reg_syntax_t re_set_syntax (reg_syntax_t __syntax); + +/* Compile the regular expression PATTERN, with length LENGTH + and syntax given by the global 're_syntax_options', into the buffer + BUFFER. Return NULL if successful, and an error string if not. + + To free the allocated storage, you must call 'regfree' on BUFFER. + Note that the translate table must either have been initialized by + 'regcomp', with a malloc'ed value, or set to NULL before calling + 'regfree'. */ +extern const char *re_compile_pattern (const char *__pattern, size_t __length, + struct re_pattern_buffer *__buffer); + + +/* Compile a fastmap for the compiled pattern in BUFFER; used to + accelerate searches. Return 0 if successful and -2 if was an + internal error. */ +extern int re_compile_fastmap (struct re_pattern_buffer *__buffer); + + +/* Search in the string STRING (with length LENGTH) for the pattern + compiled into BUFFER. Start searching at position START, for RANGE + characters. Return the starting position of the match, -1 for no + match, or -2 for an internal error. Also return register + information in REGS (if REGS and BUFFER->no_sub are nonzero). */ +extern regoff_t re_search (struct re_pattern_buffer *__buffer, + const char *__String, regoff_t __length, + regoff_t __start, regoff_t __range, + struct re_registers *__regs); + + +/* Like 're_search', but search in the concatenation of STRING1 and + STRING2. Also, stop searching at index START + STOP. */ +extern regoff_t re_search_2 (struct re_pattern_buffer *__buffer, + const char *__string1, regoff_t __length1, + const char *__string2, regoff_t __length2, + regoff_t __start, regoff_t __range, + struct re_registers *__regs, + regoff_t __stop); + + +/* Like 're_search', but return how many characters in STRING the regexp + in BUFFER matched, starting at position START. */ +extern regoff_t re_match (struct re_pattern_buffer *__buffer, + const char *__String, regoff_t __length, + regoff_t __start, struct re_registers *__regs); + + +/* Relates to 're_match' as 're_search_2' relates to 're_search'. */ +extern regoff_t re_match_2 (struct re_pattern_buffer *__buffer, + const char *__string1, regoff_t __length1, + const char *__string2, regoff_t __length2, + regoff_t __start, struct re_registers *__regs, + regoff_t __stop); + + +/* Set REGS to hold NUM_REGS registers, storing them in STARTS and + ENDS. Subsequent matches using BUFFER and REGS will use this memory + for recording register information. STARTS and ENDS must be + allocated with malloc, and must each be at least 'NUM_REGS * sizeof + (regoff_t)' bytes long. + + If NUM_REGS == 0, then subsequent matches should allocate their own + register data. + + Unless this function is called, the first search or match using + BUFFER will allocate its own register data, without + freeing the old data. */ +extern void re_set_registers (struct re_pattern_buffer *__buffer, + struct re_registers *__regs, + __re_size_t __num_regs, + regoff_t *__starts, regoff_t *__ends); +#endif /* Use GNU */ + +#if defined _REGEX_RE_COMP || (defined _LIBC && defined __USE_MISC) +# ifndef _CRAY +/* 4.2 bsd compatibility. */ +extern char *re_comp (const char *); +extern int re_exec (const char *); +# endif +#endif + +/* For plain 'restrict', use glibc's __restrict if defined. + Otherwise, GCC 2.95 and later have "__restrict"; C99 compilers have + "restrict", and "configure" may have defined "restrict". + Other compilers use __restrict, __restrict__, and _Restrict, and + 'configure' might #define 'restrict' to those words, so pick a + different name. */ +#ifndef _Restrict_ +# if defined __restrict || 2 < __GNUC__ + (95 <= __GNUC_MINOR__) +# define _Restrict_ __restrict +# elif 199901L <= __STDC_VERSION__ || defined restrict +# define _Restrict_ restrict +# else +# define _Restrict_ +# endif +#endif +/* For [restrict], use glibc's __restrict_arr if available. + Otherwise, GCC 3.1 (not in C++ mode) and C99 support [restrict]. */ +#ifndef _Restrict_arr_ +# ifdef __restrict_arr +# define _Restrict_arr_ __restrict_arr +# elif ((199901L <= __STDC_VERSION__ || 3 < __GNUC__ + (1 <= __GNUC_MINOR__)) \ + && !defined __GNUG__) +# define _Restrict_arr_ _Restrict_ +# else +# define _Restrict_arr_ +# endif +#endif + +/* POSIX compatibility. */ +extern int regcomp (regex_t *_Restrict_ __preg, + const char *_Restrict_ __pattern, + int __cflags); + +extern int regexec (const regex_t *_Restrict_ __preg, + const char *_Restrict_ __String, size_t __nmatch, + regmatch_t __pmatch[_Restrict_arr_], + int __eflags); + +extern size_t regerror (int __errcode, const regex_t *_Restrict_ __preg, + char *_Restrict_ __errbuf, size_t __errbuf_size); + +extern void regfree (regex_t *__preg); + + +#ifdef __cplusplus +} +#endif /* C++ */ + +#endif /* regex.h */ diff --git a/lib/regex_internal.c b/lib/regex_internal.c new file mode 100644 index 0000000000..32373565e6 --- /dev/null +++ b/lib/regex_internal.c @@ -0,0 +1,1740 @@ +/* Extended regular expression matching and search library. + Copyright (C) 2002-2018 Free Software Foundation, Inc. + This file is part of the GNU C Library. + Contributed by Isamu Hasegawa . + + The GNU C Library 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. + + The GNU C Library 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 the GNU C Library; if not, see + . */ + +static void re_string_construct_common (const char *str, Idx len, + re_string_t *pstr, + RE_TRANSLATE_TYPE trans, bool icase, + const re_dfa_t *dfa); +static re_dfastate_t *create_ci_newstate (const re_dfa_t *dfa, + const re_node_set *nodes, + re_hashval_t hash); +static re_dfastate_t *create_cd_newstate (const re_dfa_t *dfa, + const re_node_set *nodes, + unsigned int context, + re_hashval_t hash); +static reg_errcode_t re_string_realloc_buffers (re_string_t *pstr, + Idx new_buf_len); +#ifdef RE_ENABLE_I18N +static void build_wcs_buffer (re_string_t *pstr); +static reg_errcode_t build_wcs_upper_buffer (re_string_t *pstr); +#endif /* RE_ENABLE_I18N */ +static void build_upper_buffer (re_string_t *pstr); +static void re_string_translate_buffer (re_string_t *pstr); +static unsigned int re_string_context_at (const re_string_t *input, Idx idx, + int eflags) __attribute__ ((pure)); + +/* Functions for string operation. */ + +/* This function allocate the buffers. It is necessary to call + re_string_reconstruct before using the object. */ + +static reg_errcode_t +__attribute_warn_unused_result__ +re_string_allocate (re_string_t *pstr, const char *str, Idx len, Idx init_len, + RE_TRANSLATE_TYPE trans, bool icase, const re_dfa_t *dfa) +{ + reg_errcode_t ret; + Idx init_buf_len; + + /* Ensure at least one character fits into the buffers. */ + if (init_len < dfa->mb_cur_max) + init_len = dfa->mb_cur_max; + init_buf_len = (len + 1 < init_len) ? len + 1: init_len; + re_string_construct_common (str, len, pstr, trans, icase, dfa); + + ret = re_string_realloc_buffers (pstr, init_buf_len); + if (BE (ret != REG_NOERROR, 0)) + return ret; + + pstr->word_char = dfa->word_char; + pstr->word_ops_used = dfa->word_ops_used; + pstr->mbs = pstr->mbs_allocated ? pstr->mbs : (unsigned char *) str; + pstr->valid_len = (pstr->mbs_allocated || dfa->mb_cur_max > 1) ? 0 : len; + pstr->valid_raw_len = pstr->valid_len; + return REG_NOERROR; +} + +/* This function allocate the buffers, and initialize them. */ + +static reg_errcode_t +__attribute_warn_unused_result__ +re_string_construct (re_string_t *pstr, const char *str, Idx len, + RE_TRANSLATE_TYPE trans, bool icase, const re_dfa_t *dfa) +{ + reg_errcode_t ret; + memset (pstr, '\0', sizeof (re_string_t)); + re_string_construct_common (str, len, pstr, trans, icase, dfa); + + if (len > 0) + { + ret = re_string_realloc_buffers (pstr, len + 1); + if (BE (ret != REG_NOERROR, 0)) + return ret; + } + pstr->mbs = pstr->mbs_allocated ? pstr->mbs : (unsigned char *) str; + + if (icase) + { +#ifdef RE_ENABLE_I18N + if (dfa->mb_cur_max > 1) + { + while (1) + { + ret = build_wcs_upper_buffer (pstr); + if (BE (ret != REG_NOERROR, 0)) + return ret; + if (pstr->valid_raw_len >= len) + break; + if (pstr->bufs_len > pstr->valid_len + dfa->mb_cur_max) + break; + ret = re_string_realloc_buffers (pstr, pstr->bufs_len * 2); + if (BE (ret != REG_NOERROR, 0)) + return ret; + } + } + else +#endif /* RE_ENABLE_I18N */ + build_upper_buffer (pstr); + } + else + { +#ifdef RE_ENABLE_I18N + if (dfa->mb_cur_max > 1) + build_wcs_buffer (pstr); + else +#endif /* RE_ENABLE_I18N */ + { + if (trans != NULL) + re_string_translate_buffer (pstr); + else + { + pstr->valid_len = pstr->bufs_len; + pstr->valid_raw_len = pstr->bufs_len; + } + } + } + + return REG_NOERROR; +} + +/* Helper functions for re_string_allocate, and re_string_construct. */ + +static reg_errcode_t +__attribute_warn_unused_result__ +re_string_realloc_buffers (re_string_t *pstr, Idx new_buf_len) +{ +#ifdef RE_ENABLE_I18N + if (pstr->mb_cur_max > 1) + { + wint_t *new_wcs; + + /* Avoid overflow in realloc. */ + const size_t max_object_size = MAX (sizeof (wint_t), sizeof (Idx)); + if (BE (MIN (IDX_MAX, SIZE_MAX / max_object_size) < new_buf_len, 0)) + return REG_ESPACE; + + new_wcs = re_realloc (pstr->wcs, wint_t, new_buf_len); + if (BE (new_wcs == NULL, 0)) + return REG_ESPACE; + pstr->wcs = new_wcs; + if (pstr->offsets != NULL) + { + Idx *new_offsets = re_realloc (pstr->offsets, Idx, new_buf_len); + if (BE (new_offsets == NULL, 0)) + return REG_ESPACE; + pstr->offsets = new_offsets; + } + } +#endif /* RE_ENABLE_I18N */ + if (pstr->mbs_allocated) + { + unsigned char *new_mbs = re_realloc (pstr->mbs, unsigned char, + new_buf_len); + if (BE (new_mbs == NULL, 0)) + return REG_ESPACE; + pstr->mbs = new_mbs; + } + pstr->bufs_len = new_buf_len; + return REG_NOERROR; +} + + +static void +re_string_construct_common (const char *str, Idx len, re_string_t *pstr, + RE_TRANSLATE_TYPE trans, bool icase, + const re_dfa_t *dfa) +{ + pstr->raw_mbs = (const unsigned char *) str; + pstr->len = len; + pstr->raw_len = len; + pstr->trans = trans; + pstr->icase = icase; + pstr->mbs_allocated = (trans != NULL || icase); + pstr->mb_cur_max = dfa->mb_cur_max; + pstr->is_utf8 = dfa->is_utf8; + pstr->map_notascii = dfa->map_notascii; + pstr->stop = pstr->len; + pstr->raw_stop = pstr->stop; +} + +#ifdef RE_ENABLE_I18N + +/* Build wide character buffer PSTR->WCS. + If the byte sequence of the string are: + (0), (1), (0), (1), + Then wide character buffer will be: + , WEOF , , WEOF , + We use WEOF for padding, they indicate that the position isn't + a first byte of a multibyte character. + + Note that this function assumes PSTR->VALID_LEN elements are already + built and starts from PSTR->VALID_LEN. */ + +static void +build_wcs_buffer (re_string_t *pstr) +{ +#ifdef _LIBC + unsigned char buf[MB_LEN_MAX]; + assert (MB_LEN_MAX >= pstr->mb_cur_max); +#else + unsigned char buf[64]; +#endif + mbstate_t prev_st; + Idx byte_idx, end_idx, remain_len; + size_t mbclen; + + /* Build the buffers from pstr->valid_len to either pstr->len or + pstr->bufs_len. */ + end_idx = (pstr->bufs_len > pstr->len) ? pstr->len : pstr->bufs_len; + for (byte_idx = pstr->valid_len; byte_idx < end_idx;) + { + wchar_t wc; + const char *p; + + remain_len = end_idx - byte_idx; + prev_st = pstr->cur_state; + /* Apply the translation if we need. */ + if (BE (pstr->trans != NULL, 0)) + { + int i, ch; + + for (i = 0; i < pstr->mb_cur_max && i < remain_len; ++i) + { + ch = pstr->raw_mbs [pstr->raw_mbs_idx + byte_idx + i]; + buf[i] = pstr->mbs[byte_idx + i] = pstr->trans[ch]; + } + p = (const char *) buf; + } + else + p = (const char *) pstr->raw_mbs + pstr->raw_mbs_idx + byte_idx; + mbclen = __mbrtowc (&wc, p, remain_len, &pstr->cur_state); + if (BE (mbclen == (size_t) -1 || mbclen == 0 + || (mbclen == (size_t) -2 && pstr->bufs_len >= pstr->len), 0)) + { + /* We treat these cases as a singlebyte character. */ + mbclen = 1; + wc = (wchar_t) pstr->raw_mbs[pstr->raw_mbs_idx + byte_idx]; + if (BE (pstr->trans != NULL, 0)) + wc = pstr->trans[wc]; + pstr->cur_state = prev_st; + } + else if (BE (mbclen == (size_t) -2, 0)) + { + /* The buffer doesn't have enough space, finish to build. */ + pstr->cur_state = prev_st; + break; + } + + /* Write wide character and padding. */ + pstr->wcs[byte_idx++] = wc; + /* Write paddings. */ + for (remain_len = byte_idx + mbclen - 1; byte_idx < remain_len ;) + pstr->wcs[byte_idx++] = WEOF; + } + pstr->valid_len = byte_idx; + pstr->valid_raw_len = byte_idx; +} + +/* Build wide character buffer PSTR->WCS like build_wcs_buffer, + but for REG_ICASE. */ + +static reg_errcode_t +__attribute_warn_unused_result__ +build_wcs_upper_buffer (re_string_t *pstr) +{ + mbstate_t prev_st; + Idx src_idx, byte_idx, end_idx, remain_len; + size_t mbclen; +#ifdef _LIBC + char buf[MB_LEN_MAX]; + assert (MB_LEN_MAX >= pstr->mb_cur_max); +#else + char buf[64]; +#endif + + byte_idx = pstr->valid_len; + end_idx = (pstr->bufs_len > pstr->len) ? pstr->len : pstr->bufs_len; + + /* The following optimization assumes that ASCII characters can be + mapped to wide characters with a simple cast. */ + if (! pstr->map_notascii && pstr->trans == NULL && !pstr->offsets_needed) + { + while (byte_idx < end_idx) + { + wchar_t wc; + + if (isascii (pstr->raw_mbs[pstr->raw_mbs_idx + byte_idx]) + && mbsinit (&pstr->cur_state)) + { + /* In case of a singlebyte character. */ + pstr->mbs[byte_idx] + = toupper (pstr->raw_mbs[pstr->raw_mbs_idx + byte_idx]); + /* The next step uses the assumption that wchar_t is encoded + ASCII-safe: all ASCII values can be converted like this. */ + pstr->wcs[byte_idx] = (wchar_t) pstr->mbs[byte_idx]; + ++byte_idx; + continue; + } + + remain_len = end_idx - byte_idx; + prev_st = pstr->cur_state; + mbclen = __mbrtowc (&wc, + ((const char *) pstr->raw_mbs + pstr->raw_mbs_idx + + byte_idx), remain_len, &pstr->cur_state); + if (BE (mbclen < (size_t) -2, 1)) + { + wchar_t wcu = __towupper (wc); + if (wcu != wc) + { + size_t mbcdlen; + + mbcdlen = __wcrtomb (buf, wcu, &prev_st); + if (BE (mbclen == mbcdlen, 1)) + memcpy (pstr->mbs + byte_idx, buf, mbclen); + else + { + src_idx = byte_idx; + goto offsets_needed; + } + } + else + memcpy (pstr->mbs + byte_idx, + pstr->raw_mbs + pstr->raw_mbs_idx + byte_idx, mbclen); + pstr->wcs[byte_idx++] = wcu; + /* Write paddings. */ + for (remain_len = byte_idx + mbclen - 1; byte_idx < remain_len ;) + pstr->wcs[byte_idx++] = WEOF; + } + else if (mbclen == (size_t) -1 || mbclen == 0 + || (mbclen == (size_t) -2 && pstr->bufs_len >= pstr->len)) + { + /* It is an invalid character, an incomplete character + at the end of the string, or '\0'. Just use the byte. */ + int ch = pstr->raw_mbs[pstr->raw_mbs_idx + byte_idx]; + pstr->mbs[byte_idx] = ch; + /* And also cast it to wide char. */ + pstr->wcs[byte_idx++] = (wchar_t) ch; + if (BE (mbclen == (size_t) -1, 0)) + pstr->cur_state = prev_st; + } + else + { + /* The buffer doesn't have enough space, finish to build. */ + pstr->cur_state = prev_st; + break; + } + } + pstr->valid_len = byte_idx; + pstr->valid_raw_len = byte_idx; + return REG_NOERROR; + } + else + for (src_idx = pstr->valid_raw_len; byte_idx < end_idx;) + { + wchar_t wc; + const char *p; + offsets_needed: + remain_len = end_idx - byte_idx; + prev_st = pstr->cur_state; + if (BE (pstr->trans != NULL, 0)) + { + int i, ch; + + for (i = 0; i < pstr->mb_cur_max && i < remain_len; ++i) + { + ch = pstr->raw_mbs [pstr->raw_mbs_idx + src_idx + i]; + buf[i] = pstr->trans[ch]; + } + p = (const char *) buf; + } + else + p = (const char *) pstr->raw_mbs + pstr->raw_mbs_idx + src_idx; + mbclen = __mbrtowc (&wc, p, remain_len, &pstr->cur_state); + if (BE (mbclen < (size_t) -2, 1)) + { + wchar_t wcu = __towupper (wc); + if (wcu != wc) + { + size_t mbcdlen; + + mbcdlen = __wcrtomb ((char *) buf, wcu, &prev_st); + if (BE (mbclen == mbcdlen, 1)) + memcpy (pstr->mbs + byte_idx, buf, mbclen); + else if (mbcdlen != (size_t) -1) + { + size_t i; + + if (byte_idx + mbcdlen > pstr->bufs_len) + { + pstr->cur_state = prev_st; + break; + } + + if (pstr->offsets == NULL) + { + pstr->offsets = re_malloc (Idx, pstr->bufs_len); + + if (pstr->offsets == NULL) + return REG_ESPACE; + } + if (!pstr->offsets_needed) + { + for (i = 0; i < (size_t) byte_idx; ++i) + pstr->offsets[i] = i; + pstr->offsets_needed = 1; + } + + memcpy (pstr->mbs + byte_idx, buf, mbcdlen); + pstr->wcs[byte_idx] = wcu; + pstr->offsets[byte_idx] = src_idx; + for (i = 1; i < mbcdlen; ++i) + { + pstr->offsets[byte_idx + i] + = src_idx + (i < mbclen ? i : mbclen - 1); + pstr->wcs[byte_idx + i] = WEOF; + } + pstr->len += mbcdlen - mbclen; + if (pstr->raw_stop > src_idx) + pstr->stop += mbcdlen - mbclen; + end_idx = (pstr->bufs_len > pstr->len) + ? pstr->len : pstr->bufs_len; + byte_idx += mbcdlen; + src_idx += mbclen; + continue; + } + else + memcpy (pstr->mbs + byte_idx, p, mbclen); + } + else + memcpy (pstr->mbs + byte_idx, p, mbclen); + + if (BE (pstr->offsets_needed != 0, 0)) + { + size_t i; + for (i = 0; i < mbclen; ++i) + pstr->offsets[byte_idx + i] = src_idx + i; + } + src_idx += mbclen; + + pstr->wcs[byte_idx++] = wcu; + /* Write paddings. */ + for (remain_len = byte_idx + mbclen - 1; byte_idx < remain_len ;) + pstr->wcs[byte_idx++] = WEOF; + } + else if (mbclen == (size_t) -1 || mbclen == 0 + || (mbclen == (size_t) -2 && pstr->bufs_len >= pstr->len)) + { + /* It is an invalid character or '\0'. Just use the byte. */ + int ch = pstr->raw_mbs[pstr->raw_mbs_idx + src_idx]; + + if (BE (pstr->trans != NULL, 0)) + ch = pstr->trans [ch]; + pstr->mbs[byte_idx] = ch; + + if (BE (pstr->offsets_needed != 0, 0)) + pstr->offsets[byte_idx] = src_idx; + ++src_idx; + + /* And also cast it to wide char. */ + pstr->wcs[byte_idx++] = (wchar_t) ch; + if (BE (mbclen == (size_t) -1, 0)) + pstr->cur_state = prev_st; + } + else + { + /* The buffer doesn't have enough space, finish to build. */ + pstr->cur_state = prev_st; + break; + } + } + pstr->valid_len = byte_idx; + pstr->valid_raw_len = src_idx; + return REG_NOERROR; +} + +/* Skip characters until the index becomes greater than NEW_RAW_IDX. + Return the index. */ + +static Idx +re_string_skip_chars (re_string_t *pstr, Idx new_raw_idx, wint_t *last_wc) +{ + mbstate_t prev_st; + Idx rawbuf_idx; + size_t mbclen; + wint_t wc = WEOF; + + /* Skip the characters which are not necessary to check. */ + for (rawbuf_idx = pstr->raw_mbs_idx + pstr->valid_raw_len; + rawbuf_idx < new_raw_idx;) + { + wchar_t wc2; + Idx remain_len = pstr->raw_len - rawbuf_idx; + prev_st = pstr->cur_state; + mbclen = __mbrtowc (&wc2, (const char *) pstr->raw_mbs + rawbuf_idx, + remain_len, &pstr->cur_state); + if (BE (mbclen == (size_t) -2 || mbclen == (size_t) -1 || mbclen == 0, 0)) + { + /* We treat these cases as a single byte character. */ + if (mbclen == 0 || remain_len == 0) + wc = L'\0'; + else + wc = *(unsigned char *) (pstr->raw_mbs + rawbuf_idx); + mbclen = 1; + pstr->cur_state = prev_st; + } + else + wc = wc2; + /* Then proceed the next character. */ + rawbuf_idx += mbclen; + } + *last_wc = wc; + return rawbuf_idx; +} +#endif /* RE_ENABLE_I18N */ + +/* Build the buffer PSTR->MBS, and apply the translation if we need. + This function is used in case of REG_ICASE. */ + +static void +build_upper_buffer (re_string_t *pstr) +{ + Idx char_idx, end_idx; + end_idx = (pstr->bufs_len > pstr->len) ? pstr->len : pstr->bufs_len; + + for (char_idx = pstr->valid_len; char_idx < end_idx; ++char_idx) + { + int ch = pstr->raw_mbs[pstr->raw_mbs_idx + char_idx]; + if (BE (pstr->trans != NULL, 0)) + ch = pstr->trans[ch]; + pstr->mbs[char_idx] = toupper (ch); + } + pstr->valid_len = char_idx; + pstr->valid_raw_len = char_idx; +} + +/* Apply TRANS to the buffer in PSTR. */ + +static void +re_string_translate_buffer (re_string_t *pstr) +{ + Idx buf_idx, end_idx; + end_idx = (pstr->bufs_len > pstr->len) ? pstr->len : pstr->bufs_len; + + for (buf_idx = pstr->valid_len; buf_idx < end_idx; ++buf_idx) + { + int ch = pstr->raw_mbs[pstr->raw_mbs_idx + buf_idx]; + pstr->mbs[buf_idx] = pstr->trans[ch]; + } + + pstr->valid_len = buf_idx; + pstr->valid_raw_len = buf_idx; +} + +/* This function re-construct the buffers. + Concretely, convert to wide character in case of pstr->mb_cur_max > 1, + convert to upper case in case of REG_ICASE, apply translation. */ + +static reg_errcode_t +__attribute_warn_unused_result__ +re_string_reconstruct (re_string_t *pstr, Idx idx, int eflags) +{ + Idx offset; + + if (BE (pstr->raw_mbs_idx <= idx, 0)) + offset = idx - pstr->raw_mbs_idx; + else + { + /* Reset buffer. */ +#ifdef RE_ENABLE_I18N + if (pstr->mb_cur_max > 1) + memset (&pstr->cur_state, '\0', sizeof (mbstate_t)); +#endif /* RE_ENABLE_I18N */ + pstr->len = pstr->raw_len; + pstr->stop = pstr->raw_stop; + pstr->valid_len = 0; + pstr->raw_mbs_idx = 0; + pstr->valid_raw_len = 0; + pstr->offsets_needed = 0; + pstr->tip_context = ((eflags & REG_NOTBOL) ? CONTEXT_BEGBUF + : CONTEXT_NEWLINE | CONTEXT_BEGBUF); + if (!pstr->mbs_allocated) + pstr->mbs = (unsigned char *) pstr->raw_mbs; + offset = idx; + } + + if (BE (offset != 0, 1)) + { + /* Should the already checked characters be kept? */ + if (BE (offset < pstr->valid_raw_len, 1)) + { + /* Yes, move them to the front of the buffer. */ +#ifdef RE_ENABLE_I18N + if (BE (pstr->offsets_needed, 0)) + { + Idx low = 0, high = pstr->valid_len, mid; + do + { + mid = (high + low) / 2; + if (pstr->offsets[mid] > offset) + high = mid; + else if (pstr->offsets[mid] < offset) + low = mid + 1; + else + break; + } + while (low < high); + if (pstr->offsets[mid] < offset) + ++mid; + pstr->tip_context = re_string_context_at (pstr, mid - 1, + eflags); + /* This can be quite complicated, so handle specially + only the common and easy case where the character with + different length representation of lower and upper + case is present at or after offset. */ + if (pstr->valid_len > offset + && mid == offset && pstr->offsets[mid] == offset) + { + memmove (pstr->wcs, pstr->wcs + offset, + (pstr->valid_len - offset) * sizeof (wint_t)); + memmove (pstr->mbs, pstr->mbs + offset, pstr->valid_len - offset); + pstr->valid_len -= offset; + pstr->valid_raw_len -= offset; + for (low = 0; low < pstr->valid_len; low++) + pstr->offsets[low] = pstr->offsets[low + offset] - offset; + } + else + { + /* Otherwise, just find out how long the partial multibyte + character at offset is and fill it with WEOF/255. */ + pstr->len = pstr->raw_len - idx + offset; + pstr->stop = pstr->raw_stop - idx + offset; + pstr->offsets_needed = 0; + while (mid > 0 && pstr->offsets[mid - 1] == offset) + --mid; + while (mid < pstr->valid_len) + if (pstr->wcs[mid] != WEOF) + break; + else + ++mid; + if (mid == pstr->valid_len) + pstr->valid_len = 0; + else + { + pstr->valid_len = pstr->offsets[mid] - offset; + if (pstr->valid_len) + { + for (low = 0; low < pstr->valid_len; ++low) + pstr->wcs[low] = WEOF; + memset (pstr->mbs, 255, pstr->valid_len); + } + } + pstr->valid_raw_len = pstr->valid_len; + } + } + else +#endif + { + pstr->tip_context = re_string_context_at (pstr, offset - 1, + eflags); +#ifdef RE_ENABLE_I18N + if (pstr->mb_cur_max > 1) + memmove (pstr->wcs, pstr->wcs + offset, + (pstr->valid_len - offset) * sizeof (wint_t)); +#endif /* RE_ENABLE_I18N */ + if (BE (pstr->mbs_allocated, 0)) + memmove (pstr->mbs, pstr->mbs + offset, + pstr->valid_len - offset); + pstr->valid_len -= offset; + pstr->valid_raw_len -= offset; +#if defined DEBUG && DEBUG + assert (pstr->valid_len > 0); +#endif + } + } + else + { +#ifdef RE_ENABLE_I18N + /* No, skip all characters until IDX. */ + Idx prev_valid_len = pstr->valid_len; + + if (BE (pstr->offsets_needed, 0)) + { + pstr->len = pstr->raw_len - idx + offset; + pstr->stop = pstr->raw_stop - idx + offset; + pstr->offsets_needed = 0; + } +#endif + pstr->valid_len = 0; +#ifdef RE_ENABLE_I18N + if (pstr->mb_cur_max > 1) + { + Idx wcs_idx; + wint_t wc = WEOF; + + if (pstr->is_utf8) + { + const unsigned char *raw, *p, *end; + + /* Special case UTF-8. Multi-byte chars start with any + byte other than 0x80 - 0xbf. */ + raw = pstr->raw_mbs + pstr->raw_mbs_idx; + end = raw + (offset - pstr->mb_cur_max); + if (end < pstr->raw_mbs) + end = pstr->raw_mbs; + p = raw + offset - 1; +#ifdef _LIBC + /* We know the wchar_t encoding is UCS4, so for the simple + case, ASCII characters, skip the conversion step. */ + if (isascii (*p) && BE (pstr->trans == NULL, 1)) + { + memset (&pstr->cur_state, '\0', sizeof (mbstate_t)); + /* pstr->valid_len = 0; */ + wc = (wchar_t) *p; + } + else +#endif + for (; p >= end; --p) + if ((*p & 0xc0) != 0x80) + { + mbstate_t cur_state; + wchar_t wc2; + Idx mlen = raw + pstr->len - p; + unsigned char buf[6]; + size_t mbclen; + + const unsigned char *pp = p; + if (BE (pstr->trans != NULL, 0)) + { + int i = mlen < 6 ? mlen : 6; + while (--i >= 0) + buf[i] = pstr->trans[p[i]]; + pp = buf; + } + /* XXX Don't use mbrtowc, we know which conversion + to use (UTF-8 -> UCS4). */ + memset (&cur_state, 0, sizeof (cur_state)); + mbclen = __mbrtowc (&wc2, (const char *) pp, mlen, + &cur_state); + if (raw + offset - p <= mbclen + && mbclen < (size_t) -2) + { + memset (&pstr->cur_state, '\0', + sizeof (mbstate_t)); + pstr->valid_len = mbclen - (raw + offset - p); + wc = wc2; + } + break; + } + } + + if (wc == WEOF) + pstr->valid_len = re_string_skip_chars (pstr, idx, &wc) - idx; + if (wc == WEOF) + pstr->tip_context + = re_string_context_at (pstr, prev_valid_len - 1, eflags); + else + pstr->tip_context = ((BE (pstr->word_ops_used != 0, 0) + && IS_WIDE_WORD_CHAR (wc)) + ? CONTEXT_WORD + : ((IS_WIDE_NEWLINE (wc) + && pstr->newline_anchor) + ? CONTEXT_NEWLINE : 0)); + if (BE (pstr->valid_len, 0)) + { + for (wcs_idx = 0; wcs_idx < pstr->valid_len; ++wcs_idx) + pstr->wcs[wcs_idx] = WEOF; + if (pstr->mbs_allocated) + memset (pstr->mbs, 255, pstr->valid_len); + } + pstr->valid_raw_len = pstr->valid_len; + } + else +#endif /* RE_ENABLE_I18N */ + { + int c = pstr->raw_mbs[pstr->raw_mbs_idx + offset - 1]; + pstr->valid_raw_len = 0; + if (pstr->trans) + c = pstr->trans[c]; + pstr->tip_context = (bitset_contain (pstr->word_char, c) + ? CONTEXT_WORD + : ((IS_NEWLINE (c) && pstr->newline_anchor) + ? CONTEXT_NEWLINE : 0)); + } + } + if (!BE (pstr->mbs_allocated, 0)) + pstr->mbs += offset; + } + pstr->raw_mbs_idx = idx; + pstr->len -= offset; + pstr->stop -= offset; + + /* Then build the buffers. */ +#ifdef RE_ENABLE_I18N + if (pstr->mb_cur_max > 1) + { + if (pstr->icase) + { + reg_errcode_t ret = build_wcs_upper_buffer (pstr); + if (BE (ret != REG_NOERROR, 0)) + return ret; + } + else + build_wcs_buffer (pstr); + } + else +#endif /* RE_ENABLE_I18N */ + if (BE (pstr->mbs_allocated, 0)) + { + if (pstr->icase) + build_upper_buffer (pstr); + else if (pstr->trans != NULL) + re_string_translate_buffer (pstr); + } + else + pstr->valid_len = pstr->len; + + pstr->cur_idx = 0; + return REG_NOERROR; +} + +static unsigned char +__attribute__ ((pure)) +re_string_peek_byte_case (const re_string_t *pstr, Idx idx) +{ + int ch; + Idx off; + + /* Handle the common (easiest) cases first. */ + if (BE (!pstr->mbs_allocated, 1)) + return re_string_peek_byte (pstr, idx); + +#ifdef RE_ENABLE_I18N + if (pstr->mb_cur_max > 1 + && ! re_string_is_single_byte_char (pstr, pstr->cur_idx + idx)) + return re_string_peek_byte (pstr, idx); +#endif + + off = pstr->cur_idx + idx; +#ifdef RE_ENABLE_I18N + if (pstr->offsets_needed) + off = pstr->offsets[off]; +#endif + + ch = pstr->raw_mbs[pstr->raw_mbs_idx + off]; + +#ifdef RE_ENABLE_I18N + /* Ensure that e.g. for tr_TR.UTF-8 BACKSLASH DOTLESS SMALL LETTER I + this function returns CAPITAL LETTER I instead of first byte of + DOTLESS SMALL LETTER I. The latter would confuse the parser, + since peek_byte_case doesn't advance cur_idx in any way. */ + if (pstr->offsets_needed && !isascii (ch)) + return re_string_peek_byte (pstr, idx); +#endif + + return ch; +} + +static unsigned char +re_string_fetch_byte_case (re_string_t *pstr) +{ + if (BE (!pstr->mbs_allocated, 1)) + return re_string_fetch_byte (pstr); + +#ifdef RE_ENABLE_I18N + if (pstr->offsets_needed) + { + Idx off; + int ch; + + /* For tr_TR.UTF-8 [[:islower:]] there is + [[: CAPITAL LETTER I WITH DOT lower:]] in mbs. Skip + in that case the whole multi-byte character and return + the original letter. On the other side, with + [[: DOTLESS SMALL LETTER I return [[:I, as doing + anything else would complicate things too much. */ + + if (!re_string_first_byte (pstr, pstr->cur_idx)) + return re_string_fetch_byte (pstr); + + off = pstr->offsets[pstr->cur_idx]; + ch = pstr->raw_mbs[pstr->raw_mbs_idx + off]; + + if (! isascii (ch)) + return re_string_fetch_byte (pstr); + + re_string_skip_bytes (pstr, + re_string_char_size_at (pstr, pstr->cur_idx)); + return ch; + } +#endif + + return pstr->raw_mbs[pstr->raw_mbs_idx + pstr->cur_idx++]; +} + +static void +re_string_destruct (re_string_t *pstr) +{ +#ifdef RE_ENABLE_I18N + re_free (pstr->wcs); + re_free (pstr->offsets); +#endif /* RE_ENABLE_I18N */ + if (pstr->mbs_allocated) + re_free (pstr->mbs); +} + +/* Return the context at IDX in INPUT. */ + +static unsigned int +re_string_context_at (const re_string_t *input, Idx idx, int eflags) +{ + int c; + if (BE (idx < 0, 0)) + /* In this case, we use the value stored in input->tip_context, + since we can't know the character in input->mbs[-1] here. */ + return input->tip_context; + if (BE (idx == input->len, 0)) + return ((eflags & REG_NOTEOL) ? CONTEXT_ENDBUF + : CONTEXT_NEWLINE | CONTEXT_ENDBUF); +#ifdef RE_ENABLE_I18N + if (input->mb_cur_max > 1) + { + wint_t wc; + Idx wc_idx = idx; + while(input->wcs[wc_idx] == WEOF) + { +#if defined DEBUG && DEBUG + /* It must not happen. */ + assert (wc_idx >= 0); +#endif + --wc_idx; + if (wc_idx < 0) + return input->tip_context; + } + wc = input->wcs[wc_idx]; + if (BE (input->word_ops_used != 0, 0) && IS_WIDE_WORD_CHAR (wc)) + return CONTEXT_WORD; + return (IS_WIDE_NEWLINE (wc) && input->newline_anchor + ? CONTEXT_NEWLINE : 0); + } + else +#endif + { + c = re_string_byte_at (input, idx); + if (bitset_contain (input->word_char, c)) + return CONTEXT_WORD; + return IS_NEWLINE (c) && input->newline_anchor ? CONTEXT_NEWLINE : 0; + } +} + +/* Functions for set operation. */ + +static reg_errcode_t +__attribute_warn_unused_result__ +re_node_set_alloc (re_node_set *set, Idx size) +{ + set->alloc = size; + set->nelem = 0; + set->elems = re_malloc (Idx, size); + if (BE (set->elems == NULL, 0) && (MALLOC_0_IS_NONNULL || size != 0)) + return REG_ESPACE; + return REG_NOERROR; +} + +static reg_errcode_t +__attribute_warn_unused_result__ +re_node_set_init_1 (re_node_set *set, Idx elem) +{ + set->alloc = 1; + set->nelem = 1; + set->elems = re_malloc (Idx, 1); + if (BE (set->elems == NULL, 0)) + { + set->alloc = set->nelem = 0; + return REG_ESPACE; + } + set->elems[0] = elem; + return REG_NOERROR; +} + +static reg_errcode_t +__attribute_warn_unused_result__ +re_node_set_init_2 (re_node_set *set, Idx elem1, Idx elem2) +{ + set->alloc = 2; + set->elems = re_malloc (Idx, 2); + if (BE (set->elems == NULL, 0)) + return REG_ESPACE; + if (elem1 == elem2) + { + set->nelem = 1; + set->elems[0] = elem1; + } + else + { + set->nelem = 2; + if (elem1 < elem2) + { + set->elems[0] = elem1; + set->elems[1] = elem2; + } + else + { + set->elems[0] = elem2; + set->elems[1] = elem1; + } + } + return REG_NOERROR; +} + +static reg_errcode_t +__attribute_warn_unused_result__ +re_node_set_init_copy (re_node_set *dest, const re_node_set *src) +{ + dest->nelem = src->nelem; + if (src->nelem > 0) + { + dest->alloc = dest->nelem; + dest->elems = re_malloc (Idx, dest->alloc); + if (BE (dest->elems == NULL, 0)) + { + dest->alloc = dest->nelem = 0; + return REG_ESPACE; + } + memcpy (dest->elems, src->elems, src->nelem * sizeof (Idx)); + } + else + re_node_set_init_empty (dest); + return REG_NOERROR; +} + +/* Calculate the intersection of the sets SRC1 and SRC2. And merge it to + DEST. Return value indicate the error code or REG_NOERROR if succeeded. + Note: We assume dest->elems is NULL, when dest->alloc is 0. */ + +static reg_errcode_t +__attribute_warn_unused_result__ +re_node_set_add_intersect (re_node_set *dest, const re_node_set *src1, + const re_node_set *src2) +{ + Idx i1, i2, is, id, delta, sbase; + if (src1->nelem == 0 || src2->nelem == 0) + return REG_NOERROR; + + /* We need dest->nelem + 2 * elems_in_intersection; this is a + conservative estimate. */ + if (src1->nelem + src2->nelem + dest->nelem > dest->alloc) + { + Idx new_alloc = src1->nelem + src2->nelem + dest->alloc; + Idx *new_elems = re_realloc (dest->elems, Idx, new_alloc); + if (BE (new_elems == NULL, 0)) + return REG_ESPACE; + dest->elems = new_elems; + dest->alloc = new_alloc; + } + + /* Find the items in the intersection of SRC1 and SRC2, and copy + into the top of DEST those that are not already in DEST itself. */ + sbase = dest->nelem + src1->nelem + src2->nelem; + i1 = src1->nelem - 1; + i2 = src2->nelem - 1; + id = dest->nelem - 1; + for (;;) + { + if (src1->elems[i1] == src2->elems[i2]) + { + /* Try to find the item in DEST. Maybe we could binary search? */ + while (id >= 0 && dest->elems[id] > src1->elems[i1]) + --id; + + if (id < 0 || dest->elems[id] != src1->elems[i1]) + dest->elems[--sbase] = src1->elems[i1]; + + if (--i1 < 0 || --i2 < 0) + break; + } + + /* Lower the highest of the two items. */ + else if (src1->elems[i1] < src2->elems[i2]) + { + if (--i2 < 0) + break; + } + else + { + if (--i1 < 0) + break; + } + } + + id = dest->nelem - 1; + is = dest->nelem + src1->nelem + src2->nelem - 1; + delta = is - sbase + 1; + + /* Now copy. When DELTA becomes zero, the remaining + DEST elements are already in place; this is more or + less the same loop that is in re_node_set_merge. */ + dest->nelem += delta; + if (delta > 0 && id >= 0) + for (;;) + { + if (dest->elems[is] > dest->elems[id]) + { + /* Copy from the top. */ + dest->elems[id + delta--] = dest->elems[is--]; + if (delta == 0) + break; + } + else + { + /* Slide from the bottom. */ + dest->elems[id + delta] = dest->elems[id]; + if (--id < 0) + break; + } + } + + /* Copy remaining SRC elements. */ + memcpy (dest->elems, dest->elems + sbase, delta * sizeof (Idx)); + + return REG_NOERROR; +} + +/* Calculate the union set of the sets SRC1 and SRC2. And store it to + DEST. Return value indicate the error code or REG_NOERROR if succeeded. */ + +static reg_errcode_t +__attribute_warn_unused_result__ +re_node_set_init_union (re_node_set *dest, const re_node_set *src1, + const re_node_set *src2) +{ + Idx i1, i2, id; + if (src1 != NULL && src1->nelem > 0 && src2 != NULL && src2->nelem > 0) + { + dest->alloc = src1->nelem + src2->nelem; + dest->elems = re_malloc (Idx, dest->alloc); + if (BE (dest->elems == NULL, 0)) + return REG_ESPACE; + } + else + { + if (src1 != NULL && src1->nelem > 0) + return re_node_set_init_copy (dest, src1); + else if (src2 != NULL && src2->nelem > 0) + return re_node_set_init_copy (dest, src2); + else + re_node_set_init_empty (dest); + return REG_NOERROR; + } + for (i1 = i2 = id = 0 ; i1 < src1->nelem && i2 < src2->nelem ;) + { + if (src1->elems[i1] > src2->elems[i2]) + { + dest->elems[id++] = src2->elems[i2++]; + continue; + } + if (src1->elems[i1] == src2->elems[i2]) + ++i2; + dest->elems[id++] = src1->elems[i1++]; + } + if (i1 < src1->nelem) + { + memcpy (dest->elems + id, src1->elems + i1, + (src1->nelem - i1) * sizeof (Idx)); + id += src1->nelem - i1; + } + else if (i2 < src2->nelem) + { + memcpy (dest->elems + id, src2->elems + i2, + (src2->nelem - i2) * sizeof (Idx)); + id += src2->nelem - i2; + } + dest->nelem = id; + return REG_NOERROR; +} + +/* Calculate the union set of the sets DEST and SRC. And store it to + DEST. Return value indicate the error code or REG_NOERROR if succeeded. */ + +static reg_errcode_t +__attribute_warn_unused_result__ +re_node_set_merge (re_node_set *dest, const re_node_set *src) +{ + Idx is, id, sbase, delta; + if (src == NULL || src->nelem == 0) + return REG_NOERROR; + if (dest->alloc < 2 * src->nelem + dest->nelem) + { + Idx new_alloc = 2 * (src->nelem + dest->alloc); + Idx *new_buffer = re_realloc (dest->elems, Idx, new_alloc); + if (BE (new_buffer == NULL, 0)) + return REG_ESPACE; + dest->elems = new_buffer; + dest->alloc = new_alloc; + } + + if (BE (dest->nelem == 0, 0)) + { + dest->nelem = src->nelem; + memcpy (dest->elems, src->elems, src->nelem * sizeof (Idx)); + return REG_NOERROR; + } + + /* Copy into the top of DEST the items of SRC that are not + found in DEST. Maybe we could binary search in DEST? */ + for (sbase = dest->nelem + 2 * src->nelem, + is = src->nelem - 1, id = dest->nelem - 1; is >= 0 && id >= 0; ) + { + if (dest->elems[id] == src->elems[is]) + is--, id--; + else if (dest->elems[id] < src->elems[is]) + dest->elems[--sbase] = src->elems[is--]; + else /* if (dest->elems[id] > src->elems[is]) */ + --id; + } + + if (is >= 0) + { + /* If DEST is exhausted, the remaining items of SRC must be unique. */ + sbase -= is + 1; + memcpy (dest->elems + sbase, src->elems, (is + 1) * sizeof (Idx)); + } + + id = dest->nelem - 1; + is = dest->nelem + 2 * src->nelem - 1; + delta = is - sbase + 1; + if (delta == 0) + return REG_NOERROR; + + /* Now copy. When DELTA becomes zero, the remaining + DEST elements are already in place. */ + dest->nelem += delta; + for (;;) + { + if (dest->elems[is] > dest->elems[id]) + { + /* Copy from the top. */ + dest->elems[id + delta--] = dest->elems[is--]; + if (delta == 0) + break; + } + else + { + /* Slide from the bottom. */ + dest->elems[id + delta] = dest->elems[id]; + if (--id < 0) + { + /* Copy remaining SRC elements. */ + memcpy (dest->elems, dest->elems + sbase, + delta * sizeof (Idx)); + break; + } + } + } + + return REG_NOERROR; +} + +/* Insert the new element ELEM to the re_node_set* SET. + SET should not already have ELEM. + Return true if successful. */ + +static bool +__attribute_warn_unused_result__ +re_node_set_insert (re_node_set *set, Idx elem) +{ + Idx idx; + /* In case the set is empty. */ + if (set->alloc == 0) + return BE (re_node_set_init_1 (set, elem) == REG_NOERROR, 1); + + if (BE (set->nelem, 0) == 0) + { + /* We already guaranteed above that set->alloc != 0. */ + set->elems[0] = elem; + ++set->nelem; + return true; + } + + /* Realloc if we need. */ + if (set->alloc == set->nelem) + { + Idx *new_elems; + set->alloc = set->alloc * 2; + new_elems = re_realloc (set->elems, Idx, set->alloc); + if (BE (new_elems == NULL, 0)) + return false; + set->elems = new_elems; + } + + /* Move the elements which follows the new element. Test the + first element separately to skip a check in the inner loop. */ + if (elem < set->elems[0]) + { + idx = 0; + for (idx = set->nelem; idx > 0; idx--) + set->elems[idx] = set->elems[idx - 1]; + } + else + { + for (idx = set->nelem; set->elems[idx - 1] > elem; idx--) + set->elems[idx] = set->elems[idx - 1]; + } + + /* Insert the new element. */ + set->elems[idx] = elem; + ++set->nelem; + return true; +} + +/* Insert the new element ELEM to the re_node_set* SET. + SET should not already have any element greater than or equal to ELEM. + Return true if successful. */ + +static bool +__attribute_warn_unused_result__ +re_node_set_insert_last (re_node_set *set, Idx elem) +{ + /* Realloc if we need. */ + if (set->alloc == set->nelem) + { + Idx *new_elems; + set->alloc = (set->alloc + 1) * 2; + new_elems = re_realloc (set->elems, Idx, set->alloc); + if (BE (new_elems == NULL, 0)) + return false; + set->elems = new_elems; + } + + /* Insert the new element. */ + set->elems[set->nelem++] = elem; + return true; +} + +/* Compare two node sets SET1 and SET2. + Return true if SET1 and SET2 are equivalent. */ + +static bool +__attribute__ ((pure)) +re_node_set_compare (const re_node_set *set1, const re_node_set *set2) +{ + Idx i; + if (set1 == NULL || set2 == NULL || set1->nelem != set2->nelem) + return false; + for (i = set1->nelem ; --i >= 0 ; ) + if (set1->elems[i] != set2->elems[i]) + return false; + return true; +} + +/* Return (idx + 1) if SET contains the element ELEM, return 0 otherwise. */ + +static Idx +__attribute__ ((pure)) +re_node_set_contains (const re_node_set *set, Idx elem) +{ + __re_size_t idx, right, mid; + if (set->nelem <= 0) + return 0; + + /* Binary search the element. */ + idx = 0; + right = set->nelem - 1; + while (idx < right) + { + mid = (idx + right) / 2; + if (set->elems[mid] < elem) + idx = mid + 1; + else + right = mid; + } + return set->elems[idx] == elem ? idx + 1 : 0; +} + +static void +re_node_set_remove_at (re_node_set *set, Idx idx) +{ + if (idx < 0 || idx >= set->nelem) + return; + --set->nelem; + for (; idx < set->nelem; idx++) + set->elems[idx] = set->elems[idx + 1]; +} + + +/* Add the token TOKEN to dfa->nodes, and return the index of the token. + Or return -1 if an error occurred. */ + +static Idx +re_dfa_add_node (re_dfa_t *dfa, re_token_t token) +{ + if (BE (dfa->nodes_len >= dfa->nodes_alloc, 0)) + { + size_t new_nodes_alloc = dfa->nodes_alloc * 2; + Idx *new_nexts, *new_indices; + re_node_set *new_edests, *new_eclosures; + re_token_t *new_nodes; + + /* Avoid overflows in realloc. */ + const size_t max_object_size = MAX (sizeof (re_token_t), + MAX (sizeof (re_node_set), + sizeof (Idx))); + if (BE (MIN (IDX_MAX, SIZE_MAX / max_object_size) < new_nodes_alloc, 0)) + return -1; + + new_nodes = re_realloc (dfa->nodes, re_token_t, new_nodes_alloc); + if (BE (new_nodes == NULL, 0)) + return -1; + dfa->nodes = new_nodes; + new_nexts = re_realloc (dfa->nexts, Idx, new_nodes_alloc); + new_indices = re_realloc (dfa->org_indices, Idx, new_nodes_alloc); + new_edests = re_realloc (dfa->edests, re_node_set, new_nodes_alloc); + new_eclosures = re_realloc (dfa->eclosures, re_node_set, new_nodes_alloc); + if (BE (new_nexts == NULL || new_indices == NULL + || new_edests == NULL || new_eclosures == NULL, 0)) + { + re_free (new_nexts); + re_free (new_indices); + re_free (new_edests); + re_free (new_eclosures); + return -1; + } + dfa->nexts = new_nexts; + dfa->org_indices = new_indices; + dfa->edests = new_edests; + dfa->eclosures = new_eclosures; + dfa->nodes_alloc = new_nodes_alloc; + } + dfa->nodes[dfa->nodes_len] = token; + dfa->nodes[dfa->nodes_len].constraint = 0; +#ifdef RE_ENABLE_I18N + dfa->nodes[dfa->nodes_len].accept_mb = + ((token.type == OP_PERIOD && dfa->mb_cur_max > 1) + || token.type == COMPLEX_BRACKET); +#endif + dfa->nexts[dfa->nodes_len] = -1; + re_node_set_init_empty (dfa->edests + dfa->nodes_len); + re_node_set_init_empty (dfa->eclosures + dfa->nodes_len); + return dfa->nodes_len++; +} + +static re_hashval_t +calc_state_hash (const re_node_set *nodes, unsigned int context) +{ + re_hashval_t hash = nodes->nelem + context; + Idx i; + for (i = 0 ; i < nodes->nelem ; i++) + hash += nodes->elems[i]; + return hash; +} + +/* Search for the state whose node_set is equivalent to NODES. + Return the pointer to the state, if we found it in the DFA. + Otherwise create the new one and return it. In case of an error + return NULL and set the error code in ERR. + Note: - We assume NULL as the invalid state, then it is possible that + return value is NULL and ERR is REG_NOERROR. + - We never return non-NULL value in case of any errors, it is for + optimization. */ + +static re_dfastate_t * +__attribute_warn_unused_result__ +re_acquire_state (reg_errcode_t *err, const re_dfa_t *dfa, + const re_node_set *nodes) +{ + re_hashval_t hash; + re_dfastate_t *new_state; + struct re_state_table_entry *spot; + Idx i; +#if defined GCC_LINT || defined lint + /* Suppress bogus uninitialized-variable warnings. */ + *err = REG_NOERROR; +#endif + if (BE (nodes->nelem == 0, 0)) + { + *err = REG_NOERROR; + return NULL; + } + hash = calc_state_hash (nodes, 0); + spot = dfa->state_table + (hash & dfa->state_hash_mask); + + for (i = 0 ; i < spot->num ; i++) + { + re_dfastate_t *state = spot->array[i]; + if (hash != state->hash) + continue; + if (re_node_set_compare (&state->nodes, nodes)) + return state; + } + + /* There are no appropriate state in the dfa, create the new one. */ + new_state = create_ci_newstate (dfa, nodes, hash); + if (BE (new_state == NULL, 0)) + *err = REG_ESPACE; + + return new_state; +} + +/* Search for the state whose node_set is equivalent to NODES and + whose context is equivalent to CONTEXT. + Return the pointer to the state, if we found it in the DFA. + Otherwise create the new one and return it. In case of an error + return NULL and set the error code in ERR. + Note: - We assume NULL as the invalid state, then it is possible that + return value is NULL and ERR is REG_NOERROR. + - We never return non-NULL value in case of any errors, it is for + optimization. */ + +static re_dfastate_t * +__attribute_warn_unused_result__ +re_acquire_state_context (reg_errcode_t *err, const re_dfa_t *dfa, + const re_node_set *nodes, unsigned int context) +{ + re_hashval_t hash; + re_dfastate_t *new_state; + struct re_state_table_entry *spot; + Idx i; +#if defined GCC_LINT || defined lint + /* Suppress bogus uninitialized-variable warnings. */ + *err = REG_NOERROR; +#endif + if (nodes->nelem == 0) + { + *err = REG_NOERROR; + return NULL; + } + hash = calc_state_hash (nodes, context); + spot = dfa->state_table + (hash & dfa->state_hash_mask); + + for (i = 0 ; i < spot->num ; i++) + { + re_dfastate_t *state = spot->array[i]; + if (state->hash == hash + && state->context == context + && re_node_set_compare (state->entrance_nodes, nodes)) + return state; + } + /* There are no appropriate state in 'dfa', create the new one. */ + new_state = create_cd_newstate (dfa, nodes, context, hash); + if (BE (new_state == NULL, 0)) + *err = REG_ESPACE; + + return new_state; +} + +/* Finish initialization of the new state NEWSTATE, and using its hash value + HASH put in the appropriate bucket of DFA's state table. Return value + indicates the error code if failed. */ + +static reg_errcode_t +__attribute_warn_unused_result__ +register_state (const re_dfa_t *dfa, re_dfastate_t *newstate, + re_hashval_t hash) +{ + struct re_state_table_entry *spot; + reg_errcode_t err; + Idx i; + + newstate->hash = hash; + err = re_node_set_alloc (&newstate->non_eps_nodes, newstate->nodes.nelem); + if (BE (err != REG_NOERROR, 0)) + return REG_ESPACE; + for (i = 0; i < newstate->nodes.nelem; i++) + { + Idx elem = newstate->nodes.elems[i]; + if (!IS_EPSILON_NODE (dfa->nodes[elem].type)) + if (! re_node_set_insert_last (&newstate->non_eps_nodes, elem)) + return REG_ESPACE; + } + + spot = dfa->state_table + (hash & dfa->state_hash_mask); + if (BE (spot->alloc <= spot->num, 0)) + { + Idx new_alloc = 2 * spot->num + 2; + re_dfastate_t **new_array = re_realloc (spot->array, re_dfastate_t *, + new_alloc); + if (BE (new_array == NULL, 0)) + return REG_ESPACE; + spot->array = new_array; + spot->alloc = new_alloc; + } + spot->array[spot->num++] = newstate; + return REG_NOERROR; +} + +static void +free_state (re_dfastate_t *state) +{ + re_node_set_free (&state->non_eps_nodes); + re_node_set_free (&state->inveclosure); + if (state->entrance_nodes != &state->nodes) + { + re_node_set_free (state->entrance_nodes); + re_free (state->entrance_nodes); + } + re_node_set_free (&state->nodes); + re_free (state->word_trtable); + re_free (state->trtable); + re_free (state); +} + +/* Create the new state which is independent of contexts. + Return the new state if succeeded, otherwise return NULL. */ + +static re_dfastate_t * +__attribute_warn_unused_result__ +create_ci_newstate (const re_dfa_t *dfa, const re_node_set *nodes, + re_hashval_t hash) +{ + Idx i; + reg_errcode_t err; + re_dfastate_t *newstate; + + newstate = (re_dfastate_t *) calloc (sizeof (re_dfastate_t), 1); + if (BE (newstate == NULL, 0)) + return NULL; + err = re_node_set_init_copy (&newstate->nodes, nodes); + if (BE (err != REG_NOERROR, 0)) + { + re_free (newstate); + return NULL; + } + + newstate->entrance_nodes = &newstate->nodes; + for (i = 0 ; i < nodes->nelem ; i++) + { + re_token_t *node = dfa->nodes + nodes->elems[i]; + re_token_type_t type = node->type; + if (type == CHARACTER && !node->constraint) + continue; +#ifdef RE_ENABLE_I18N + newstate->accept_mb |= node->accept_mb; +#endif /* RE_ENABLE_I18N */ + + /* If the state has the halt node, the state is a halt state. */ + if (type == END_OF_RE) + newstate->halt = 1; + else if (type == OP_BACK_REF) + newstate->has_backref = 1; + else if (type == ANCHOR || node->constraint) + newstate->has_constraint = 1; + } + err = register_state (dfa, newstate, hash); + if (BE (err != REG_NOERROR, 0)) + { + free_state (newstate); + newstate = NULL; + } + return newstate; +} + +/* Create the new state which is depend on the context CONTEXT. + Return the new state if succeeded, otherwise return NULL. */ + +static re_dfastate_t * +__attribute_warn_unused_result__ +create_cd_newstate (const re_dfa_t *dfa, const re_node_set *nodes, + unsigned int context, re_hashval_t hash) +{ + Idx i, nctx_nodes = 0; + reg_errcode_t err; + re_dfastate_t *newstate; + + newstate = (re_dfastate_t *) calloc (sizeof (re_dfastate_t), 1); + if (BE (newstate == NULL, 0)) + return NULL; + err = re_node_set_init_copy (&newstate->nodes, nodes); + if (BE (err != REG_NOERROR, 0)) + { + re_free (newstate); + return NULL; + } + + newstate->context = context; + newstate->entrance_nodes = &newstate->nodes; + + for (i = 0 ; i < nodes->nelem ; i++) + { + re_token_t *node = dfa->nodes + nodes->elems[i]; + re_token_type_t type = node->type; + unsigned int constraint = node->constraint; + + if (type == CHARACTER && !constraint) + continue; +#ifdef RE_ENABLE_I18N + newstate->accept_mb |= node->accept_mb; +#endif /* RE_ENABLE_I18N */ + + /* If the state has the halt node, the state is a halt state. */ + if (type == END_OF_RE) + newstate->halt = 1; + else if (type == OP_BACK_REF) + newstate->has_backref = 1; + + if (constraint) + { + if (newstate->entrance_nodes == &newstate->nodes) + { + newstate->entrance_nodes = re_malloc (re_node_set, 1); + if (BE (newstate->entrance_nodes == NULL, 0)) + { + free_state (newstate); + return NULL; + } + if (re_node_set_init_copy (newstate->entrance_nodes, nodes) + != REG_NOERROR) + return NULL; + nctx_nodes = 0; + newstate->has_constraint = 1; + } + + if (NOT_SATISFY_PREV_CONSTRAINT (constraint,context)) + { + re_node_set_remove_at (&newstate->nodes, i - nctx_nodes); + ++nctx_nodes; + } + } + } + err = register_state (dfa, newstate, hash); + if (BE (err != REG_NOERROR, 0)) + { + free_state (newstate); + newstate = NULL; + } + return newstate; +} diff --git a/lib/regex_internal.h b/lib/regex_internal.h new file mode 100644 index 0000000000..7bbe802bc5 --- /dev/null +++ b/lib/regex_internal.h @@ -0,0 +1,911 @@ +/* Extended regular expression matching and search library. + Copyright (C) 2002-2018 Free Software Foundation, Inc. + This file is part of the GNU C Library. + Contributed by Isamu Hasegawa . + + The GNU C Library 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. + + The GNU C Library 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 the GNU C Library; if not, see + . */ + +#ifndef _REGEX_INTERNAL_H +#define _REGEX_INTERNAL_H 1 + +#include +#include +#include +#include +#include + +#include +#include +#include +#include +#include +#include + +/* Properties of integers. Although Gnulib has intprops.h, glibc does + without for now. */ +#ifndef _LIBC +# include "intprops.h" +#else +/* True if the real type T is signed. */ +# define TYPE_SIGNED(t) (! ((t) 0 < (t) -1)) + +/* True if adding the nonnegative Idx values A and B would overflow. + If false, set *R to A + B. A, B, and R may be evaluated more than + once, or zero times. Although this is not a full implementation of + Gnulib INT_ADD_WRAPV, it is good enough for glibc regex code. + FIXME: This implementation is a fragile stopgap, and this file would + be simpler and more robust if intprops.h were migrated into glibc. */ +# define INT_ADD_WRAPV(a, b, r) \ + (IDX_MAX - (a) < (b) ? true : (*(r) = (a) + (b), false)) +#endif + +#ifdef _LIBC +# include +# define lock_define(name) __libc_lock_define (, name) +# define lock_init(lock) (__libc_lock_init (lock), 0) +# define lock_fini(lock) ((void) 0) +# define lock_lock(lock) __libc_lock_lock (lock) +# define lock_unlock(lock) __libc_lock_unlock (lock) +#elif defined GNULIB_LOCK && !defined USE_UNLOCKED_IO +# include "glthread/lock.h" + /* Use gl_lock_define if empty macro arguments are known to work. + Otherwise, fall back on less-portable substitutes. */ +# if ((defined __GNUC__ && !defined __STRICT_ANSI__) \ + || (defined __STDC_VERSION__ && 199901L <= __STDC_VERSION__)) +# define lock_define(name) gl_lock_define (, name) +# elif USE_POSIX_THREADS +# define lock_define(name) pthread_mutex_t name; +# elif USE_PTH_THREADS +# define lock_define(name) pth_mutex_t name; +# elif USE_SOLARIS_THREADS +# define lock_define(name) mutex_t name; +# elif USE_WINDOWS_THREADS +# define lock_define(name) gl_lock_t name; +# else +# define lock_define(name) +# endif +# define lock_init(lock) glthread_lock_init (&(lock)) +# define lock_fini(lock) glthread_lock_destroy (&(lock)) +# define lock_lock(lock) glthread_lock_lock (&(lock)) +# define lock_unlock(lock) glthread_lock_unlock (&(lock)) +#elif defined GNULIB_PTHREAD && !defined USE_UNLOCKED_IO +# include +# define lock_define(name) pthread_mutex_t name; +# define lock_init(lock) pthread_mutex_init (&(lock), 0) +# define lock_fini(lock) pthread_mutex_destroy (&(lock)) +# define lock_lock(lock) pthread_mutex_lock (&(lock)) +# define lock_unlock(lock) pthread_mutex_unlock (&(lock)) +#else +# define lock_define(name) +# define lock_init(lock) 0 +# define lock_fini(lock) ((void) 0) + /* The 'dfa' avoids an "unused variable 'dfa'" warning from GCC. */ +# define lock_lock(lock) ((void) dfa) +# define lock_unlock(lock) ((void) 0) +#endif + +/* In case that the system doesn't have isblank(). */ +#if !defined _LIBC && ! (defined isblank || (HAVE_ISBLANK && HAVE_DECL_ISBLANK)) +# define isblank(ch) ((ch) == ' ' || (ch) == '\t') +#endif + +#ifdef _LIBC +# ifndef _RE_DEFINE_LOCALE_FUNCTIONS +# define _RE_DEFINE_LOCALE_FUNCTIONS 1 +# include +# include +# endif +#endif + +/* This is for other GNU distributions with internationalized messages. */ +#if (HAVE_LIBINTL_H && ENABLE_NLS) || defined _LIBC +# include +# ifdef _LIBC +# undef gettext +# define gettext(msgid) \ + __dcgettext (_libc_intl_domainname, msgid, LC_MESSAGES) +# endif +#else +# undef gettext +# define gettext(msgid) (msgid) +#endif + +#ifndef gettext_noop +/* This define is so xgettext can find the internationalizable + strings. */ +# define gettext_noop(String) String +#endif + +#if (defined MB_CUR_MAX && HAVE_WCTYPE_H && HAVE_ISWCTYPE) || _LIBC +# define RE_ENABLE_I18N +#endif + +#define BE(expr, val) __builtin_expect (expr, val) + +/* Number of ASCII characters. */ +#define ASCII_CHARS 0x80 + +/* Number of single byte characters. */ +#define SBC_MAX (UCHAR_MAX + 1) + +#define COLL_ELEM_LEN_MAX 8 + +/* The character which represents newline. */ +#define NEWLINE_CHAR '\n' +#define WIDE_NEWLINE_CHAR L'\n' + +/* Rename to standard API for using out of glibc. */ +#ifndef _LIBC +# undef __wctype +# undef __iswctype +# define __wctype wctype +# define __iswalnum iswalnum +# define __iswctype iswctype +# define __towlower towlower +# define __towupper towupper +# define __btowc btowc +# define __mbrtowc mbrtowc +# define __wcrtomb wcrtomb +# define __regfree regfree +# define attribute_hidden +#endif /* not _LIBC */ + +#if __GNUC__ < 3 + (__GNUC_MINOR__ < 1) +# define __attribute__(arg) +#endif + +#ifndef SSIZE_MAX +# define SSIZE_MAX ((ssize_t) (SIZE_MAX / 2)) +#endif + +/* The type of indexes into strings. This is signed, not size_t, + since the API requires indexes to fit in regoff_t anyway, and using + signed integers makes the code a bit smaller and presumably faster. + The traditional GNU regex implementation uses int for indexes. + The POSIX-compatible implementation uses a possibly-wider type. + The name 'Idx' is three letters to minimize the hassle of + reindenting a lot of regex code that formerly used 'int'. */ +typedef regoff_t Idx; +#ifdef _REGEX_LARGE_OFFSETS +# define IDX_MAX SSIZE_MAX +#else +# define IDX_MAX INT_MAX +#endif + +/* A hash value, suitable for computing hash tables. */ +typedef __re_size_t re_hashval_t; + +/* An integer used to represent a set of bits. It must be unsigned, + and must be at least as wide as unsigned int. */ +typedef unsigned long int bitset_word_t; +/* All bits set in a bitset_word_t. */ +#define BITSET_WORD_MAX ULONG_MAX + +/* Number of bits in a bitset_word_t. For portability to hosts with + padding bits, do not use '(sizeof (bitset_word_t) * CHAR_BIT)'; + instead, deduce it directly from BITSET_WORD_MAX. Avoid + greater-than-32-bit integers and unconditional shifts by more than + 31 bits, as they're not portable. */ +#if BITSET_WORD_MAX == 0xffffffffUL +# define BITSET_WORD_BITS 32 +#elif BITSET_WORD_MAX >> 31 >> 4 == 1 +# define BITSET_WORD_BITS 36 +#elif BITSET_WORD_MAX >> 31 >> 16 == 1 +# define BITSET_WORD_BITS 48 +#elif BITSET_WORD_MAX >> 31 >> 28 == 1 +# define BITSET_WORD_BITS 60 +#elif BITSET_WORD_MAX >> 31 >> 31 >> 1 == 1 +# define BITSET_WORD_BITS 64 +#elif BITSET_WORD_MAX >> 31 >> 31 >> 9 == 1 +# define BITSET_WORD_BITS 72 +#elif BITSET_WORD_MAX >> 31 >> 31 >> 31 >> 31 >> 3 == 1 +# define BITSET_WORD_BITS 128 +#elif BITSET_WORD_MAX >> 31 >> 31 >> 31 >> 31 >> 31 >> 31 >> 31 >> 31 >> 7 == 1 +# define BITSET_WORD_BITS 256 +#elif BITSET_WORD_MAX >> 31 >> 31 >> 31 >> 31 >> 31 >> 31 >> 31 >> 31 >> 7 > 1 +# define BITSET_WORD_BITS 257 /* any value > SBC_MAX will do here */ +# if BITSET_WORD_BITS <= SBC_MAX +# error "Invalid SBC_MAX" +# endif +#else +# error "Add case for new bitset_word_t size" +#endif + +/* Number of bitset_word_t values in a bitset_t. */ +#define BITSET_WORDS ((SBC_MAX + BITSET_WORD_BITS - 1) / BITSET_WORD_BITS) + +typedef bitset_word_t bitset_t[BITSET_WORDS]; +typedef bitset_word_t *re_bitset_ptr_t; +typedef const bitset_word_t *re_const_bitset_ptr_t; + +#define PREV_WORD_CONSTRAINT 0x0001 +#define PREV_NOTWORD_CONSTRAINT 0x0002 +#define NEXT_WORD_CONSTRAINT 0x0004 +#define NEXT_NOTWORD_CONSTRAINT 0x0008 +#define PREV_NEWLINE_CONSTRAINT 0x0010 +#define NEXT_NEWLINE_CONSTRAINT 0x0020 +#define PREV_BEGBUF_CONSTRAINT 0x0040 +#define NEXT_ENDBUF_CONSTRAINT 0x0080 +#define WORD_DELIM_CONSTRAINT 0x0100 +#define NOT_WORD_DELIM_CONSTRAINT 0x0200 + +typedef enum +{ + INSIDE_WORD = PREV_WORD_CONSTRAINT | NEXT_WORD_CONSTRAINT, + WORD_FIRST = PREV_NOTWORD_CONSTRAINT | NEXT_WORD_CONSTRAINT, + WORD_LAST = PREV_WORD_CONSTRAINT | NEXT_NOTWORD_CONSTRAINT, + INSIDE_NOTWORD = PREV_NOTWORD_CONSTRAINT | NEXT_NOTWORD_CONSTRAINT, + LINE_FIRST = PREV_NEWLINE_CONSTRAINT, + LINE_LAST = NEXT_NEWLINE_CONSTRAINT, + BUF_FIRST = PREV_BEGBUF_CONSTRAINT, + BUF_LAST = NEXT_ENDBUF_CONSTRAINT, + WORD_DELIM = WORD_DELIM_CONSTRAINT, + NOT_WORD_DELIM = NOT_WORD_DELIM_CONSTRAINT +} re_context_type; + +typedef struct +{ + Idx alloc; + Idx nelem; + Idx *elems; +} re_node_set; + +typedef enum +{ + NON_TYPE = 0, + + /* Node type, These are used by token, node, tree. */ + CHARACTER = 1, + END_OF_RE = 2, + SIMPLE_BRACKET = 3, + OP_BACK_REF = 4, + OP_PERIOD = 5, +#ifdef RE_ENABLE_I18N + COMPLEX_BRACKET = 6, + OP_UTF8_PERIOD = 7, +#endif /* RE_ENABLE_I18N */ + + /* We define EPSILON_BIT as a macro so that OP_OPEN_SUBEXP is used + when the debugger shows values of this enum type. */ +#define EPSILON_BIT 8 + OP_OPEN_SUBEXP = EPSILON_BIT | 0, + OP_CLOSE_SUBEXP = EPSILON_BIT | 1, + OP_ALT = EPSILON_BIT | 2, + OP_DUP_ASTERISK = EPSILON_BIT | 3, + ANCHOR = EPSILON_BIT | 4, + + /* Tree type, these are used only by tree. */ + CONCAT = 16, + SUBEXP = 17, + + /* Token type, these are used only by token. */ + OP_DUP_PLUS = 18, + OP_DUP_QUESTION, + OP_OPEN_BRACKET, + OP_CLOSE_BRACKET, + OP_CHARSET_RANGE, + OP_OPEN_DUP_NUM, + OP_CLOSE_DUP_NUM, + OP_NON_MATCH_LIST, + OP_OPEN_COLL_ELEM, + OP_CLOSE_COLL_ELEM, + OP_OPEN_EQUIV_CLASS, + OP_CLOSE_EQUIV_CLASS, + OP_OPEN_CHAR_CLASS, + OP_CLOSE_CHAR_CLASS, + OP_WORD, + OP_NOTWORD, + OP_SPACE, + OP_NOTSPACE, + BACK_SLASH + +} re_token_type_t; + +#ifdef RE_ENABLE_I18N +typedef struct +{ + /* Multibyte characters. */ + wchar_t *mbchars; + + /* Collating symbols. */ +# ifdef _LIBC + int32_t *coll_syms; +# endif + + /* Equivalence classes. */ +# ifdef _LIBC + int32_t *equiv_classes; +# endif + + /* Range expressions. */ +# ifdef _LIBC + uint32_t *range_starts; + uint32_t *range_ends; +# else /* not _LIBC */ + wchar_t *range_starts; + wchar_t *range_ends; +# endif /* not _LIBC */ + + /* Character classes. */ + wctype_t *char_classes; + + /* If this character set is the non-matching list. */ + unsigned int non_match : 1; + + /* # of multibyte characters. */ + Idx nmbchars; + + /* # of collating symbols. */ + Idx ncoll_syms; + + /* # of equivalence classes. */ + Idx nequiv_classes; + + /* # of range expressions. */ + Idx nranges; + + /* # of character classes. */ + Idx nchar_classes; +} re_charset_t; +#endif /* RE_ENABLE_I18N */ + +typedef struct +{ + union + { + unsigned char c; /* for CHARACTER */ + re_bitset_ptr_t sbcset; /* for SIMPLE_BRACKET */ +#ifdef RE_ENABLE_I18N + re_charset_t *mbcset; /* for COMPLEX_BRACKET */ +#endif /* RE_ENABLE_I18N */ + Idx idx; /* for BACK_REF */ + re_context_type ctx_type; /* for ANCHOR */ + } opr; +#if __GNUC__ >= 2 && !defined __STRICT_ANSI__ + re_token_type_t type : 8; +#else + re_token_type_t type; +#endif + unsigned int constraint : 10; /* context constraint */ + unsigned int duplicated : 1; + unsigned int opt_subexp : 1; +#ifdef RE_ENABLE_I18N + unsigned int accept_mb : 1; + /* These 2 bits can be moved into the union if needed (e.g. if running out + of bits; move opr.c to opr.c.c and move the flags to opr.c.flags). */ + unsigned int mb_partial : 1; +#endif + unsigned int word_char : 1; +} re_token_t; + +#define IS_EPSILON_NODE(type) ((type) & EPSILON_BIT) + +struct re_string_t +{ + /* Indicate the raw buffer which is the original string passed as an + argument of regexec(), re_search(), etc.. */ + const unsigned char *raw_mbs; + /* Store the multibyte string. In case of "case insensitive mode" like + REG_ICASE, upper cases of the string are stored, otherwise MBS points + the same address that RAW_MBS points. */ + unsigned char *mbs; +#ifdef RE_ENABLE_I18N + /* Store the wide character string which is corresponding to MBS. */ + wint_t *wcs; + Idx *offsets; + mbstate_t cur_state; +#endif + /* Index in RAW_MBS. Each character mbs[i] corresponds to + raw_mbs[raw_mbs_idx + i]. */ + Idx raw_mbs_idx; + /* The length of the valid characters in the buffers. */ + Idx valid_len; + /* The corresponding number of bytes in raw_mbs array. */ + Idx valid_raw_len; + /* The length of the buffers MBS and WCS. */ + Idx bufs_len; + /* The index in MBS, which is updated by re_string_fetch_byte. */ + Idx cur_idx; + /* length of RAW_MBS array. */ + Idx raw_len; + /* This is RAW_LEN - RAW_MBS_IDX + VALID_LEN - VALID_RAW_LEN. */ + Idx len; + /* End of the buffer may be shorter than its length in the cases such + as re_match_2, re_search_2. Then, we use STOP for end of the buffer + instead of LEN. */ + Idx raw_stop; + /* This is RAW_STOP - RAW_MBS_IDX adjusted through OFFSETS. */ + Idx stop; + + /* The context of mbs[0]. We store the context independently, since + the context of mbs[0] may be different from raw_mbs[0], which is + the beginning of the input string. */ + unsigned int tip_context; + /* The translation passed as a part of an argument of re_compile_pattern. */ + RE_TRANSLATE_TYPE trans; + /* Copy of re_dfa_t's word_char. */ + re_const_bitset_ptr_t word_char; + /* true if REG_ICASE. */ + unsigned char icase; + unsigned char is_utf8; + unsigned char map_notascii; + unsigned char mbs_allocated; + unsigned char offsets_needed; + unsigned char newline_anchor; + unsigned char word_ops_used; + int mb_cur_max; +}; +typedef struct re_string_t re_string_t; + + +struct re_dfa_t; +typedef struct re_dfa_t re_dfa_t; + +#ifndef _LIBC +# define IS_IN(libc) false +#endif + +#define re_string_peek_byte(pstr, offset) \ + ((pstr)->mbs[(pstr)->cur_idx + offset]) +#define re_string_fetch_byte(pstr) \ + ((pstr)->mbs[(pstr)->cur_idx++]) +#define re_string_first_byte(pstr, idx) \ + ((idx) == (pstr)->valid_len || (pstr)->wcs[idx] != WEOF) +#define re_string_is_single_byte_char(pstr, idx) \ + ((pstr)->wcs[idx] != WEOF && ((pstr)->valid_len == (idx) + 1 \ + || (pstr)->wcs[(idx) + 1] != WEOF)) +#define re_string_eoi(pstr) ((pstr)->stop <= (pstr)->cur_idx) +#define re_string_cur_idx(pstr) ((pstr)->cur_idx) +#define re_string_get_buffer(pstr) ((pstr)->mbs) +#define re_string_length(pstr) ((pstr)->len) +#define re_string_byte_at(pstr,idx) ((pstr)->mbs[idx]) +#define re_string_skip_bytes(pstr,idx) ((pstr)->cur_idx += (idx)) +#define re_string_set_index(pstr,idx) ((pstr)->cur_idx = (idx)) + +#if defined _LIBC || HAVE_ALLOCA +# include +#endif + +#ifndef _LIBC +# if HAVE_ALLOCA +/* The OS usually guarantees only one guard page at the bottom of the stack, + and a page size can be as small as 4096 bytes. So we cannot safely + allocate anything larger than 4096 bytes. Also care for the possibility + of a few compiler-allocated temporary stack slots. */ +# define __libc_use_alloca(n) ((n) < 4032) +# else +/* alloca is implemented with malloc, so just use malloc. */ +# define __libc_use_alloca(n) 0 +# undef alloca +# define alloca(n) malloc (n) +# endif +#endif + +#ifdef _LIBC +# define MALLOC_0_IS_NONNULL 1 +#elif !defined MALLOC_0_IS_NONNULL +# define MALLOC_0_IS_NONNULL 0 +#endif + +#ifndef MAX +# define MAX(a,b) ((a) < (b) ? (b) : (a)) +#endif +#ifndef MIN +# define MIN(a,b) ((a) < (b) ? (a) : (b)) +#endif + +#define re_malloc(t,n) ((t *) malloc ((n) * sizeof (t))) +#define re_realloc(p,t,n) ((t *) realloc (p, (n) * sizeof (t))) +#define re_free(p) free (p) + +struct bin_tree_t +{ + struct bin_tree_t *parent; + struct bin_tree_t *left; + struct bin_tree_t *right; + struct bin_tree_t *first; + struct bin_tree_t *next; + + re_token_t token; + + /* 'node_idx' is the index in dfa->nodes, if 'type' == 0. + Otherwise 'type' indicate the type of this node. */ + Idx node_idx; +}; +typedef struct bin_tree_t bin_tree_t; + +#define BIN_TREE_STORAGE_SIZE \ + ((1024 - sizeof (void *)) / sizeof (bin_tree_t)) + +struct bin_tree_storage_t +{ + struct bin_tree_storage_t *next; + bin_tree_t data[BIN_TREE_STORAGE_SIZE]; +}; +typedef struct bin_tree_storage_t bin_tree_storage_t; + +#define CONTEXT_WORD 1 +#define CONTEXT_NEWLINE (CONTEXT_WORD << 1) +#define CONTEXT_BEGBUF (CONTEXT_NEWLINE << 1) +#define CONTEXT_ENDBUF (CONTEXT_BEGBUF << 1) + +#define IS_WORD_CONTEXT(c) ((c) & CONTEXT_WORD) +#define IS_NEWLINE_CONTEXT(c) ((c) & CONTEXT_NEWLINE) +#define IS_BEGBUF_CONTEXT(c) ((c) & CONTEXT_BEGBUF) +#define IS_ENDBUF_CONTEXT(c) ((c) & CONTEXT_ENDBUF) +#define IS_ORDINARY_CONTEXT(c) ((c) == 0) + +#define IS_WORD_CHAR(ch) (isalnum (ch) || (ch) == '_') +#define IS_NEWLINE(ch) ((ch) == NEWLINE_CHAR) +#define IS_WIDE_WORD_CHAR(ch) (__iswalnum (ch) || (ch) == L'_') +#define IS_WIDE_NEWLINE(ch) ((ch) == WIDE_NEWLINE_CHAR) + +#define NOT_SATISFY_PREV_CONSTRAINT(constraint,context) \ + ((((constraint) & PREV_WORD_CONSTRAINT) && !IS_WORD_CONTEXT (context)) \ + || ((constraint & PREV_NOTWORD_CONSTRAINT) && IS_WORD_CONTEXT (context)) \ + || ((constraint & PREV_NEWLINE_CONSTRAINT) && !IS_NEWLINE_CONTEXT (context))\ + || ((constraint & PREV_BEGBUF_CONSTRAINT) && !IS_BEGBUF_CONTEXT (context))) + +#define NOT_SATISFY_NEXT_CONSTRAINT(constraint,context) \ + ((((constraint) & NEXT_WORD_CONSTRAINT) && !IS_WORD_CONTEXT (context)) \ + || (((constraint) & NEXT_NOTWORD_CONSTRAINT) && IS_WORD_CONTEXT (context)) \ + || (((constraint) & NEXT_NEWLINE_CONSTRAINT) && !IS_NEWLINE_CONTEXT (context)) \ + || (((constraint) & NEXT_ENDBUF_CONSTRAINT) && !IS_ENDBUF_CONTEXT (context))) + +struct re_dfastate_t +{ + re_hashval_t hash; + re_node_set nodes; + re_node_set non_eps_nodes; + re_node_set inveclosure; + re_node_set *entrance_nodes; + struct re_dfastate_t **trtable, **word_trtable; + unsigned int context : 4; + unsigned int halt : 1; + /* If this state can accept "multi byte". + Note that we refer to multibyte characters, and multi character + collating elements as "multi byte". */ + unsigned int accept_mb : 1; + /* If this state has backreference node(s). */ + unsigned int has_backref : 1; + unsigned int has_constraint : 1; +}; +typedef struct re_dfastate_t re_dfastate_t; + +struct re_state_table_entry +{ + Idx num; + Idx alloc; + re_dfastate_t **array; +}; + +/* Array type used in re_sub_match_last_t and re_sub_match_top_t. */ + +typedef struct +{ + Idx next_idx; + Idx alloc; + re_dfastate_t **array; +} state_array_t; + +/* Store information about the node NODE whose type is OP_CLOSE_SUBEXP. */ + +typedef struct +{ + Idx node; + Idx str_idx; /* The position NODE match at. */ + state_array_t path; +} re_sub_match_last_t; + +/* Store information about the node NODE whose type is OP_OPEN_SUBEXP. + And information about the node, whose type is OP_CLOSE_SUBEXP, + corresponding to NODE is stored in LASTS. */ + +typedef struct +{ + Idx str_idx; + Idx node; + state_array_t *path; + Idx alasts; /* Allocation size of LASTS. */ + Idx nlasts; /* The number of LASTS. */ + re_sub_match_last_t **lasts; +} re_sub_match_top_t; + +struct re_backref_cache_entry +{ + Idx node; + Idx str_idx; + Idx subexp_from; + Idx subexp_to; + char more; + char unused; + unsigned short int eps_reachable_subexps_map; +}; + +typedef struct +{ + /* The string object corresponding to the input string. */ + re_string_t input; +#if defined _LIBC || (defined __STDC_VERSION__ && __STDC_VERSION__ >= 199901L) + const re_dfa_t *const dfa; +#else + const re_dfa_t *dfa; +#endif + /* EFLAGS of the argument of regexec. */ + int eflags; + /* Where the matching ends. */ + Idx match_last; + Idx last_node; + /* The state log used by the matcher. */ + re_dfastate_t **state_log; + Idx state_log_top; + /* Back reference cache. */ + Idx nbkref_ents; + Idx abkref_ents; + struct re_backref_cache_entry *bkref_ents; + int max_mb_elem_len; + Idx nsub_tops; + Idx asub_tops; + re_sub_match_top_t **sub_tops; +} re_match_context_t; + +typedef struct +{ + re_dfastate_t **sifted_states; + re_dfastate_t **limited_states; + Idx last_node; + Idx last_str_idx; + re_node_set limits; +} re_sift_context_t; + +struct re_fail_stack_ent_t +{ + Idx idx; + Idx node; + regmatch_t *regs; + re_node_set eps_via_nodes; +}; + +struct re_fail_stack_t +{ + Idx num; + Idx alloc; + struct re_fail_stack_ent_t *stack; +}; + +struct re_dfa_t +{ + re_token_t *nodes; + size_t nodes_alloc; + size_t nodes_len; + Idx *nexts; + Idx *org_indices; + re_node_set *edests; + re_node_set *eclosures; + re_node_set *inveclosures; + struct re_state_table_entry *state_table; + re_dfastate_t *init_state; + re_dfastate_t *init_state_word; + re_dfastate_t *init_state_nl; + re_dfastate_t *init_state_begbuf; + bin_tree_t *str_tree; + bin_tree_storage_t *str_tree_storage; + re_bitset_ptr_t sb_char; + int str_tree_storage_idx; + + /* number of subexpressions 're_nsub' is in regex_t. */ + re_hashval_t state_hash_mask; + Idx init_node; + Idx nbackref; /* The number of backreference in this dfa. */ + + /* Bitmap expressing which backreference is used. */ + bitset_word_t used_bkref_map; + bitset_word_t completed_bkref_map; + + unsigned int has_plural_match : 1; + /* If this dfa has "multibyte node", which is a backreference or + a node which can accept multibyte character or multi character + collating element. */ + unsigned int has_mb_node : 1; + unsigned int is_utf8 : 1; + unsigned int map_notascii : 1; + unsigned int word_ops_used : 1; + int mb_cur_max; + bitset_t word_char; + reg_syntax_t syntax; + Idx *subexp_map; +#ifdef DEBUG + char* re_str; +#endif + lock_define (lock) +}; + +#define re_node_set_init_empty(set) memset (set, '\0', sizeof (re_node_set)) +#define re_node_set_remove(set,id) \ + (re_node_set_remove_at (set, re_node_set_contains (set, id) - 1)) +#define re_node_set_empty(p) ((p)->nelem = 0) +#define re_node_set_free(set) re_free ((set)->elems) + + +typedef enum +{ + SB_CHAR, + MB_CHAR, + EQUIV_CLASS, + COLL_SYM, + CHAR_CLASS +} bracket_elem_type; + +typedef struct +{ + bracket_elem_type type; + union + { + unsigned char ch; + unsigned char *name; + wchar_t wch; + } opr; +} bracket_elem_t; + + +/* Functions for bitset_t operation. */ + +static inline void +bitset_set (bitset_t set, Idx i) +{ + set[i / BITSET_WORD_BITS] |= (bitset_word_t) 1 << i % BITSET_WORD_BITS; +} + +static inline void +bitset_clear (bitset_t set, Idx i) +{ + set[i / BITSET_WORD_BITS] &= ~ ((bitset_word_t) 1 << i % BITSET_WORD_BITS); +} + +static inline bool +bitset_contain (const bitset_t set, Idx i) +{ + return (set[i / BITSET_WORD_BITS] >> i % BITSET_WORD_BITS) & 1; +} + +static inline void +bitset_empty (bitset_t set) +{ + memset (set, '\0', sizeof (bitset_t)); +} + +static inline void +bitset_set_all (bitset_t set) +{ + memset (set, -1, sizeof (bitset_word_t) * (SBC_MAX / BITSET_WORD_BITS)); + if (SBC_MAX % BITSET_WORD_BITS != 0) + set[BITSET_WORDS - 1] = + ((bitset_word_t) 1 << SBC_MAX % BITSET_WORD_BITS) - 1; +} + +static inline void +bitset_copy (bitset_t dest, const bitset_t src) +{ + memcpy (dest, src, sizeof (bitset_t)); +} + +static inline void +bitset_not (bitset_t set) +{ + int bitset_i; + for (bitset_i = 0; bitset_i < SBC_MAX / BITSET_WORD_BITS; ++bitset_i) + set[bitset_i] = ~set[bitset_i]; + if (SBC_MAX % BITSET_WORD_BITS != 0) + set[BITSET_WORDS - 1] = + ((((bitset_word_t) 1 << SBC_MAX % BITSET_WORD_BITS) - 1) + & ~set[BITSET_WORDS - 1]); +} + +static inline void +bitset_merge (bitset_t dest, const bitset_t src) +{ + int bitset_i; + for (bitset_i = 0; bitset_i < BITSET_WORDS; ++bitset_i) + dest[bitset_i] |= src[bitset_i]; +} + +static inline void +bitset_mask (bitset_t dest, const bitset_t src) +{ + int bitset_i; + for (bitset_i = 0; bitset_i < BITSET_WORDS; ++bitset_i) + dest[bitset_i] &= src[bitset_i]; +} + +#ifdef RE_ENABLE_I18N +/* Functions for re_string. */ +static int +__attribute__ ((pure, unused)) +re_string_char_size_at (const re_string_t *pstr, Idx idx) +{ + int byte_idx; + if (pstr->mb_cur_max == 1) + return 1; + for (byte_idx = 1; idx + byte_idx < pstr->valid_len; ++byte_idx) + if (pstr->wcs[idx + byte_idx] != WEOF) + break; + return byte_idx; +} + +static wint_t +__attribute__ ((pure, unused)) +re_string_wchar_at (const re_string_t *pstr, Idx idx) +{ + if (pstr->mb_cur_max == 1) + return (wint_t) pstr->mbs[idx]; + return (wint_t) pstr->wcs[idx]; +} + +# ifdef _LIBC +# include +# endif + +static int +__attribute__ ((pure, unused)) +re_string_elem_size_at (const re_string_t *pstr, Idx idx) +{ +# ifdef _LIBC + const unsigned char *p, *extra; + const int32_t *table, *indirect; + uint_fast32_t nrules = _NL_CURRENT_WORD (LC_COLLATE, _NL_COLLATE_NRULES); + + if (nrules != 0) + { + table = (const int32_t *) _NL_CURRENT (LC_COLLATE, _NL_COLLATE_TABLEMB); + extra = (const unsigned char *) + _NL_CURRENT (LC_COLLATE, _NL_COLLATE_EXTRAMB); + indirect = (const int32_t *) _NL_CURRENT (LC_COLLATE, + _NL_COLLATE_INDIRECTMB); + p = pstr->mbs + idx; + findidx (table, indirect, extra, &p, pstr->len - idx); + return p - pstr->mbs - idx; + } + else +# endif /* _LIBC */ + return 1; +} +#endif /* RE_ENABLE_I18N */ + +#ifndef __GNUC_PREREQ +# if defined __GNUC__ && defined __GNUC_MINOR__ +# define __GNUC_PREREQ(maj, min) \ + ((__GNUC__ << 16) + __GNUC_MINOR__ >= ((maj) << 16) + (min)) +# else +# define __GNUC_PREREQ(maj, min) 0 +# endif +#endif + +#if __GNUC_PREREQ (3,4) +# undef __attribute_warn_unused_result__ +# define __attribute_warn_unused_result__ \ + __attribute__ ((__warn_unused_result__)) +#else +# define __attribute_warn_unused_result__ /* empty */ +#endif + +#ifndef FALLTHROUGH +# if __GNUC__ < 7 +# define FALLTHROUGH ((void) 0) +# else +# define FALLTHROUGH __attribute__ ((__fallthrough__)) +# endif +#endif + +#endif /* _REGEX_INTERNAL_H */ diff --git a/lib/regexec.c b/lib/regexec.c new file mode 100644 index 0000000000..6591311164 --- /dev/null +++ b/lib/regexec.c @@ -0,0 +1,4324 @@ +/* Extended regular expression matching and search library. + Copyright (C) 2002-2018 Free Software Foundation, Inc. + This file is part of the GNU C Library. + Contributed by Isamu Hasegawa . + + The GNU C Library 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. + + The GNU C Library 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 the GNU C Library; if not, see + . */ + +static reg_errcode_t match_ctx_init (re_match_context_t *cache, int eflags, + Idx n); +static void match_ctx_clean (re_match_context_t *mctx); +static void match_ctx_free (re_match_context_t *cache); +static reg_errcode_t match_ctx_add_entry (re_match_context_t *cache, Idx node, + Idx str_idx, Idx from, Idx to); +static Idx search_cur_bkref_entry (const re_match_context_t *mctx, Idx str_idx); +static reg_errcode_t match_ctx_add_subtop (re_match_context_t *mctx, Idx node, + Idx str_idx); +static re_sub_match_last_t * match_ctx_add_sublast (re_sub_match_top_t *subtop, + Idx node, Idx str_idx); +static void sift_ctx_init (re_sift_context_t *sctx, re_dfastate_t **sifted_sts, + re_dfastate_t **limited_sts, Idx last_node, + Idx last_str_idx); +static reg_errcode_t re_search_internal (const regex_t *preg, + const char *string, Idx length, + Idx start, Idx last_start, Idx stop, + size_t nmatch, regmatch_t pmatch[], + int eflags); +static regoff_t re_search_2_stub (struct re_pattern_buffer *bufp, + const char *string1, Idx length1, + const char *string2, Idx length2, + Idx start, regoff_t range, + struct re_registers *regs, + Idx stop, bool ret_len); +static regoff_t re_search_stub (struct re_pattern_buffer *bufp, + const char *string, Idx length, Idx start, + regoff_t range, Idx stop, + struct re_registers *regs, + bool ret_len); +static unsigned re_copy_regs (struct re_registers *regs, regmatch_t *pmatch, + Idx nregs, int regs_allocated); +static reg_errcode_t prune_impossible_nodes (re_match_context_t *mctx); +static Idx check_matching (re_match_context_t *mctx, bool fl_longest_match, + Idx *p_match_first); +static Idx check_halt_state_context (const re_match_context_t *mctx, + const re_dfastate_t *state, Idx idx); +static void update_regs (const re_dfa_t *dfa, regmatch_t *pmatch, + regmatch_t *prev_idx_match, Idx cur_node, + Idx cur_idx, Idx nmatch); +static reg_errcode_t push_fail_stack (struct re_fail_stack_t *fs, + Idx str_idx, Idx dest_node, Idx nregs, + regmatch_t *regs, + re_node_set *eps_via_nodes); +static reg_errcode_t set_regs (const regex_t *preg, + const re_match_context_t *mctx, + size_t nmatch, regmatch_t *pmatch, + bool fl_backtrack); +static reg_errcode_t free_fail_stack_return (struct re_fail_stack_t *fs); + +#ifdef RE_ENABLE_I18N +static int sift_states_iter_mb (const re_match_context_t *mctx, + re_sift_context_t *sctx, + Idx node_idx, Idx str_idx, Idx max_str_idx); +#endif /* RE_ENABLE_I18N */ +static reg_errcode_t sift_states_backward (const re_match_context_t *mctx, + re_sift_context_t *sctx); +static reg_errcode_t build_sifted_states (const re_match_context_t *mctx, + re_sift_context_t *sctx, Idx str_idx, + re_node_set *cur_dest); +static reg_errcode_t update_cur_sifted_state (const re_match_context_t *mctx, + re_sift_context_t *sctx, + Idx str_idx, + re_node_set *dest_nodes); +static reg_errcode_t add_epsilon_src_nodes (const re_dfa_t *dfa, + re_node_set *dest_nodes, + const re_node_set *candidates); +static bool check_dst_limits (const re_match_context_t *mctx, + const re_node_set *limits, + Idx dst_node, Idx dst_idx, Idx src_node, + Idx src_idx); +static int check_dst_limits_calc_pos_1 (const re_match_context_t *mctx, + int boundaries, Idx subexp_idx, + Idx from_node, Idx bkref_idx); +static int check_dst_limits_calc_pos (const re_match_context_t *mctx, + Idx limit, Idx subexp_idx, + Idx node, Idx str_idx, + Idx bkref_idx); +static reg_errcode_t check_subexp_limits (const re_dfa_t *dfa, + re_node_set *dest_nodes, + const re_node_set *candidates, + re_node_set *limits, + struct re_backref_cache_entry *bkref_ents, + Idx str_idx); +static reg_errcode_t sift_states_bkref (const re_match_context_t *mctx, + re_sift_context_t *sctx, + Idx str_idx, const re_node_set *candidates); +static reg_errcode_t merge_state_array (const re_dfa_t *dfa, + re_dfastate_t **dst, + re_dfastate_t **src, Idx num); +static re_dfastate_t *find_recover_state (reg_errcode_t *err, + re_match_context_t *mctx); +static re_dfastate_t *transit_state (reg_errcode_t *err, + re_match_context_t *mctx, + re_dfastate_t *state); +static re_dfastate_t *merge_state_with_log (reg_errcode_t *err, + re_match_context_t *mctx, + re_dfastate_t *next_state); +static reg_errcode_t check_subexp_matching_top (re_match_context_t *mctx, + re_node_set *cur_nodes, + Idx str_idx); +#if 0 +static re_dfastate_t *transit_state_sb (reg_errcode_t *err, + re_match_context_t *mctx, + re_dfastate_t *pstate); +#endif +#ifdef RE_ENABLE_I18N +static reg_errcode_t transit_state_mb (re_match_context_t *mctx, + re_dfastate_t *pstate); +#endif /* RE_ENABLE_I18N */ +static reg_errcode_t transit_state_bkref (re_match_context_t *mctx, + const re_node_set *nodes); +static reg_errcode_t get_subexp (re_match_context_t *mctx, + Idx bkref_node, Idx bkref_str_idx); +static reg_errcode_t get_subexp_sub (re_match_context_t *mctx, + const re_sub_match_top_t *sub_top, + re_sub_match_last_t *sub_last, + Idx bkref_node, Idx bkref_str); +static Idx find_subexp_node (const re_dfa_t *dfa, const re_node_set *nodes, + Idx subexp_idx, int type); +static reg_errcode_t check_arrival (re_match_context_t *mctx, + state_array_t *path, Idx top_node, + Idx top_str, Idx last_node, Idx last_str, + int type); +static reg_errcode_t check_arrival_add_next_nodes (re_match_context_t *mctx, + Idx str_idx, + re_node_set *cur_nodes, + re_node_set *next_nodes); +static reg_errcode_t check_arrival_expand_ecl (const re_dfa_t *dfa, + re_node_set *cur_nodes, + Idx ex_subexp, int type); +static reg_errcode_t check_arrival_expand_ecl_sub (const re_dfa_t *dfa, + re_node_set *dst_nodes, + Idx target, Idx ex_subexp, + int type); +static reg_errcode_t expand_bkref_cache (re_match_context_t *mctx, + re_node_set *cur_nodes, Idx cur_str, + Idx subexp_num, int type); +static bool build_trtable (const re_dfa_t *dfa, re_dfastate_t *state); +#ifdef RE_ENABLE_I18N +static int check_node_accept_bytes (const re_dfa_t *dfa, Idx node_idx, + const re_string_t *input, Idx idx); +# ifdef _LIBC +static unsigned int find_collation_sequence_value (const unsigned char *mbs, + size_t name_len); +# endif /* _LIBC */ +#endif /* RE_ENABLE_I18N */ +static Idx group_nodes_into_DFAstates (const re_dfa_t *dfa, + const re_dfastate_t *state, + re_node_set *states_node, + bitset_t *states_ch); +static bool check_node_accept (const re_match_context_t *mctx, + const re_token_t *node, Idx idx); +static reg_errcode_t extend_buffers (re_match_context_t *mctx, int min_len); + +/* Entry point for POSIX code. */ + +/* regexec searches for a given pattern, specified by PREG, in the + string STRING. + + If NMATCH is zero or REG_NOSUB was set in the cflags argument to + 'regcomp', we ignore PMATCH. Otherwise, we assume PMATCH has at + least NMATCH elements, and we set them to the offsets of the + corresponding matched substrings. + + EFLAGS specifies "execution flags" which affect matching: if + REG_NOTBOL is set, then ^ does not match at the beginning of the + string; if REG_NOTEOL is set, then $ does not match at the end. + + We return 0 if we find a match and REG_NOMATCH if not. */ + +int +regexec (const regex_t *_Restrict_ preg, const char *_Restrict_ string, + size_t nmatch, regmatch_t pmatch[], int eflags) +{ + reg_errcode_t err; + Idx start, length; + re_dfa_t *dfa = preg->buffer; + + if (eflags & ~(REG_NOTBOL | REG_NOTEOL | REG_STARTEND)) + return REG_BADPAT; + + if (eflags & REG_STARTEND) + { + start = pmatch[0].rm_so; + length = pmatch[0].rm_eo; + } + else + { + start = 0; + length = strlen (string); + } + + lock_lock (dfa->lock); + if (preg->no_sub) + err = re_search_internal (preg, string, length, start, length, + length, 0, NULL, eflags); + else + err = re_search_internal (preg, string, length, start, length, + length, nmatch, pmatch, eflags); + lock_unlock (dfa->lock); + return err != REG_NOERROR; +} + +#ifdef _LIBC +libc_hidden_def (__regexec) + +# include +versioned_symbol (libc, __regexec, regexec, GLIBC_2_3_4); + +# if SHLIB_COMPAT (libc, GLIBC_2_0, GLIBC_2_3_4) +__typeof__ (__regexec) __compat_regexec; + +int +attribute_compat_text_section +__compat_regexec (const regex_t *_Restrict_ preg, + const char *_Restrict_ string, size_t nmatch, + regmatch_t pmatch[], int eflags) +{ + return regexec (preg, string, nmatch, pmatch, + eflags & (REG_NOTBOL | REG_NOTEOL)); +} +compat_symbol (libc, __compat_regexec, regexec, GLIBC_2_0); +# endif +#endif + +/* Entry points for GNU code. */ + +/* re_match, re_search, re_match_2, re_search_2 + + The former two functions operate on STRING with length LENGTH, + while the later two operate on concatenation of STRING1 and STRING2 + with lengths LENGTH1 and LENGTH2, respectively. + + re_match() matches the compiled pattern in BUFP against the string, + starting at index START. + + re_search() first tries matching at index START, then it tries to match + starting from index START + 1, and so on. The last start position tried + is START + RANGE. (Thus RANGE = 0 forces re_search to operate the same + way as re_match().) + + The parameter STOP of re_{match,search}_2 specifies that no match exceeding + the first STOP characters of the concatenation of the strings should be + concerned. + + If REGS is not NULL, and BUFP->no_sub is not set, the offsets of the match + and all groups is stored in REGS. (For the "_2" variants, the offsets are + computed relative to the concatenation, not relative to the individual + strings.) + + On success, re_match* functions return the length of the match, re_search* + return the position of the start of the match. Return value -1 means no + match was found and -2 indicates an internal error. */ + +regoff_t +re_match (struct re_pattern_buffer *bufp, const char *string, Idx length, + Idx start, struct re_registers *regs) +{ + return re_search_stub (bufp, string, length, start, 0, length, regs, true); +} +#ifdef _LIBC +weak_alias (__re_match, re_match) +#endif + +regoff_t +re_search (struct re_pattern_buffer *bufp, const char *string, Idx length, + Idx start, regoff_t range, struct re_registers *regs) +{ + return re_search_stub (bufp, string, length, start, range, length, regs, + false); +} +#ifdef _LIBC +weak_alias (__re_search, re_search) +#endif + +regoff_t +re_match_2 (struct re_pattern_buffer *bufp, const char *string1, Idx length1, + const char *string2, Idx length2, Idx start, + struct re_registers *regs, Idx stop) +{ + return re_search_2_stub (bufp, string1, length1, string2, length2, + start, 0, regs, stop, true); +} +#ifdef _LIBC +weak_alias (__re_match_2, re_match_2) +#endif + +regoff_t +re_search_2 (struct re_pattern_buffer *bufp, const char *string1, Idx length1, + const char *string2, Idx length2, Idx start, regoff_t range, + struct re_registers *regs, Idx stop) +{ + return re_search_2_stub (bufp, string1, length1, string2, length2, + start, range, regs, stop, false); +} +#ifdef _LIBC +weak_alias (__re_search_2, re_search_2) +#endif + +static regoff_t +re_search_2_stub (struct re_pattern_buffer *bufp, const char *string1, + Idx length1, const char *string2, Idx length2, Idx start, + regoff_t range, struct re_registers *regs, + Idx stop, bool ret_len) +{ + const char *str; + regoff_t rval; + Idx len; + char *s = NULL; + + if (BE ((length1 < 0 || length2 < 0 || stop < 0 + || INT_ADD_WRAPV (length1, length2, &len)), + 0)) + return -2; + + /* Concatenate the strings. */ + if (length2 > 0) + if (length1 > 0) + { + s = re_malloc (char, len); + + if (BE (s == NULL, 0)) + return -2; +#ifdef _LIBC + memcpy (__mempcpy (s, string1, length1), string2, length2); +#else + memcpy (s, string1, length1); + memcpy (s + length1, string2, length2); +#endif + str = s; + } + else + str = string2; + else + str = string1; + + rval = re_search_stub (bufp, str, len, start, range, stop, regs, + ret_len); + re_free (s); + return rval; +} + +/* The parameters have the same meaning as those of re_search. + Additional parameters: + If RET_LEN is true the length of the match is returned (re_match style); + otherwise the position of the match is returned. */ + +static regoff_t +re_search_stub (struct re_pattern_buffer *bufp, const char *string, Idx length, + Idx start, regoff_t range, Idx stop, struct re_registers *regs, + bool ret_len) +{ + reg_errcode_t result; + regmatch_t *pmatch; + Idx nregs; + regoff_t rval; + int eflags = 0; + re_dfa_t *dfa = bufp->buffer; + Idx last_start = start + range; + + /* Check for out-of-range. */ + if (BE (start < 0 || start > length, 0)) + return -1; + if (BE (length < last_start || (0 <= range && last_start < start), 0)) + last_start = length; + else if (BE (last_start < 0 || (range < 0 && start <= last_start), 0)) + last_start = 0; + + lock_lock (dfa->lock); + + eflags |= (bufp->not_bol) ? REG_NOTBOL : 0; + eflags |= (bufp->not_eol) ? REG_NOTEOL : 0; + + /* Compile fastmap if we haven't yet. */ + if (start < last_start && bufp->fastmap != NULL && !bufp->fastmap_accurate) + re_compile_fastmap (bufp); + + if (BE (bufp->no_sub, 0)) + regs = NULL; + + /* We need at least 1 register. */ + if (regs == NULL) + nregs = 1; + else if (BE (bufp->regs_allocated == REGS_FIXED + && regs->num_regs <= bufp->re_nsub, 0)) + { + nregs = regs->num_regs; + if (BE (nregs < 1, 0)) + { + /* Nothing can be copied to regs. */ + regs = NULL; + nregs = 1; + } + } + else + nregs = bufp->re_nsub + 1; + pmatch = re_malloc (regmatch_t, nregs); + if (BE (pmatch == NULL, 0)) + { + rval = -2; + goto out; + } + + result = re_search_internal (bufp, string, length, start, last_start, stop, + nregs, pmatch, eflags); + + rval = 0; + + /* I hope we needn't fill their regs with -1's when no match was found. */ + if (result != REG_NOERROR) + rval = result == REG_NOMATCH ? -1 : -2; + else if (regs != NULL) + { + /* If caller wants register contents data back, copy them. */ + bufp->regs_allocated = re_copy_regs (regs, pmatch, nregs, + bufp->regs_allocated); + if (BE (bufp->regs_allocated == REGS_UNALLOCATED, 0)) + rval = -2; + } + + if (BE (rval == 0, 1)) + { + if (ret_len) + { + assert (pmatch[0].rm_so == start); + rval = pmatch[0].rm_eo - start; + } + else + rval = pmatch[0].rm_so; + } + re_free (pmatch); + out: + lock_unlock (dfa->lock); + return rval; +} + +static unsigned +re_copy_regs (struct re_registers *regs, regmatch_t *pmatch, Idx nregs, + int regs_allocated) +{ + int rval = REGS_REALLOCATE; + Idx i; + Idx need_regs = nregs + 1; + /* We need one extra element beyond 'num_regs' for the '-1' marker GNU code + uses. */ + + /* Have the register data arrays been allocated? */ + if (regs_allocated == REGS_UNALLOCATED) + { /* No. So allocate them with malloc. */ + regs->start = re_malloc (regoff_t, need_regs); + if (BE (regs->start == NULL, 0)) + return REGS_UNALLOCATED; + regs->end = re_malloc (regoff_t, need_regs); + if (BE (regs->end == NULL, 0)) + { + re_free (regs->start); + return REGS_UNALLOCATED; + } + regs->num_regs = need_regs; + } + else if (regs_allocated == REGS_REALLOCATE) + { /* Yes. If we need more elements than were already + allocated, reallocate them. If we need fewer, just + leave it alone. */ + if (BE (need_regs > regs->num_regs, 0)) + { + regoff_t *new_start = re_realloc (regs->start, regoff_t, need_regs); + regoff_t *new_end; + if (BE (new_start == NULL, 0)) + return REGS_UNALLOCATED; + new_end = re_realloc (regs->end, regoff_t, need_regs); + if (BE (new_end == NULL, 0)) + { + re_free (new_start); + return REGS_UNALLOCATED; + } + regs->start = new_start; + regs->end = new_end; + regs->num_regs = need_regs; + } + } + else + { + assert (regs_allocated == REGS_FIXED); + /* This function may not be called with REGS_FIXED and nregs too big. */ + assert (regs->num_regs >= nregs); + rval = REGS_FIXED; + } + + /* Copy the regs. */ + for (i = 0; i < nregs; ++i) + { + regs->start[i] = pmatch[i].rm_so; + regs->end[i] = pmatch[i].rm_eo; + } + for ( ; i < regs->num_regs; ++i) + regs->start[i] = regs->end[i] = -1; + + return rval; +} + +/* Set REGS to hold NUM_REGS registers, storing them in STARTS and + ENDS. Subsequent matches using PATTERN_BUFFER and REGS will use + this memory for recording register information. STARTS and ENDS + must be allocated using the malloc library routine, and must each + be at least NUM_REGS * sizeof (regoff_t) bytes long. + + If NUM_REGS == 0, then subsequent matches should allocate their own + register data. + + Unless this function is called, the first search or match using + PATTERN_BUFFER will allocate its own register data, without + freeing the old data. */ + +void +re_set_registers (struct re_pattern_buffer *bufp, struct re_registers *regs, + __re_size_t num_regs, regoff_t *starts, regoff_t *ends) +{ + if (num_regs) + { + bufp->regs_allocated = REGS_REALLOCATE; + regs->num_regs = num_regs; + regs->start = starts; + regs->end = ends; + } + else + { + bufp->regs_allocated = REGS_UNALLOCATED; + regs->num_regs = 0; + regs->start = regs->end = NULL; + } +} +#ifdef _LIBC +weak_alias (__re_set_registers, re_set_registers) +#endif + +/* Entry points compatible with 4.2 BSD regex library. We don't define + them unless specifically requested. */ + +#if defined _REGEX_RE_COMP || defined _LIBC +int +# ifdef _LIBC +weak_function +# endif +re_exec (const char *s) +{ + return 0 == regexec (&re_comp_buf, s, 0, NULL, 0); +} +#endif /* _REGEX_RE_COMP */ + +/* Internal entry point. */ + +/* Searches for a compiled pattern PREG in the string STRING, whose + length is LENGTH. NMATCH, PMATCH, and EFLAGS have the same + meaning as with regexec. LAST_START is START + RANGE, where + START and RANGE have the same meaning as with re_search. + Return REG_NOERROR if we find a match, and REG_NOMATCH if not, + otherwise return the error code. + Note: We assume front end functions already check ranges. + (0 <= LAST_START && LAST_START <= LENGTH) */ + +static reg_errcode_t +__attribute_warn_unused_result__ +re_search_internal (const regex_t *preg, const char *string, Idx length, + Idx start, Idx last_start, Idx stop, size_t nmatch, + regmatch_t pmatch[], int eflags) +{ + reg_errcode_t err; + const re_dfa_t *dfa = preg->buffer; + Idx left_lim, right_lim; + int incr; + bool fl_longest_match; + int match_kind; + Idx match_first; + Idx match_last = -1; + Idx extra_nmatch; + bool sb; + int ch; +#if defined _LIBC || (defined __STDC_VERSION__ && __STDC_VERSION__ >= 199901L) + re_match_context_t mctx = { .dfa = dfa }; +#else + re_match_context_t mctx; +#endif + char *fastmap = ((preg->fastmap != NULL && preg->fastmap_accurate + && start != last_start && !preg->can_be_null) + ? preg->fastmap : NULL); + RE_TRANSLATE_TYPE t = preg->translate; + +#if !(defined _LIBC || (defined __STDC_VERSION__ && __STDC_VERSION__ >= 199901L)) + memset (&mctx, '\0', sizeof (re_match_context_t)); + mctx.dfa = dfa; +#endif + + extra_nmatch = (nmatch > preg->re_nsub) ? nmatch - (preg->re_nsub + 1) : 0; + nmatch -= extra_nmatch; + + /* Check if the DFA haven't been compiled. */ + if (BE (preg->used == 0 || dfa->init_state == NULL + || dfa->init_state_word == NULL || dfa->init_state_nl == NULL + || dfa->init_state_begbuf == NULL, 0)) + return REG_NOMATCH; + +#ifdef DEBUG + /* We assume front-end functions already check them. */ + assert (0 <= last_start && last_start <= length); +#endif + + /* If initial states with non-begbuf contexts have no elements, + the regex must be anchored. If preg->newline_anchor is set, + we'll never use init_state_nl, so do not check it. */ + if (dfa->init_state->nodes.nelem == 0 + && dfa->init_state_word->nodes.nelem == 0 + && (dfa->init_state_nl->nodes.nelem == 0 + || !preg->newline_anchor)) + { + if (start != 0 && last_start != 0) + return REG_NOMATCH; + start = last_start = 0; + } + + /* We must check the longest matching, if nmatch > 0. */ + fl_longest_match = (nmatch != 0 || dfa->nbackref); + + err = re_string_allocate (&mctx.input, string, length, dfa->nodes_len + 1, + preg->translate, (preg->syntax & RE_ICASE) != 0, + dfa); + if (BE (err != REG_NOERROR, 0)) + goto free_return; + mctx.input.stop = stop; + mctx.input.raw_stop = stop; + mctx.input.newline_anchor = preg->newline_anchor; + + err = match_ctx_init (&mctx, eflags, dfa->nbackref * 2); + if (BE (err != REG_NOERROR, 0)) + goto free_return; + + /* We will log all the DFA states through which the dfa pass, + if nmatch > 1, or this dfa has "multibyte node", which is a + back-reference or a node which can accept multibyte character or + multi character collating element. */ + if (nmatch > 1 || dfa->has_mb_node) + { + /* Avoid overflow. */ + if (BE ((MIN (IDX_MAX, SIZE_MAX / sizeof (re_dfastate_t *)) + <= mctx.input.bufs_len), 0)) + { + err = REG_ESPACE; + goto free_return; + } + + mctx.state_log = re_malloc (re_dfastate_t *, mctx.input.bufs_len + 1); + if (BE (mctx.state_log == NULL, 0)) + { + err = REG_ESPACE; + goto free_return; + } + } + else + mctx.state_log = NULL; + + match_first = start; + mctx.input.tip_context = (eflags & REG_NOTBOL) ? CONTEXT_BEGBUF + : CONTEXT_NEWLINE | CONTEXT_BEGBUF; + + /* Check incrementally whether the input string matches. */ + incr = (last_start < start) ? -1 : 1; + left_lim = (last_start < start) ? last_start : start; + right_lim = (last_start < start) ? start : last_start; + sb = dfa->mb_cur_max == 1; + match_kind = + (fastmap + ? ((sb || !(preg->syntax & RE_ICASE || t) ? 4 : 0) + | (start <= last_start ? 2 : 0) + | (t != NULL ? 1 : 0)) + : 8); + + for (;; match_first += incr) + { + err = REG_NOMATCH; + if (match_first < left_lim || right_lim < match_first) + goto free_return; + + /* Advance as rapidly as possible through the string, until we + find a plausible place to start matching. This may be done + with varying efficiency, so there are various possibilities: + only the most common of them are specialized, in order to + save on code size. We use a switch statement for speed. */ + switch (match_kind) + { + case 8: + /* No fastmap. */ + break; + + case 7: + /* Fastmap with single-byte translation, match forward. */ + while (BE (match_first < right_lim, 1) + && !fastmap[t[(unsigned char) string[match_first]]]) + ++match_first; + goto forward_match_found_start_or_reached_end; + + case 6: + /* Fastmap without translation, match forward. */ + while (BE (match_first < right_lim, 1) + && !fastmap[(unsigned char) string[match_first]]) + ++match_first; + + forward_match_found_start_or_reached_end: + if (BE (match_first == right_lim, 0)) + { + ch = match_first >= length + ? 0 : (unsigned char) string[match_first]; + if (!fastmap[t ? t[ch] : ch]) + goto free_return; + } + break; + + case 4: + case 5: + /* Fastmap without multi-byte translation, match backwards. */ + while (match_first >= left_lim) + { + ch = match_first >= length + ? 0 : (unsigned char) string[match_first]; + if (fastmap[t ? t[ch] : ch]) + break; + --match_first; + } + if (match_first < left_lim) + goto free_return; + break; + + default: + /* In this case, we can't determine easily the current byte, + since it might be a component byte of a multibyte + character. Then we use the constructed buffer instead. */ + for (;;) + { + /* If MATCH_FIRST is out of the valid range, reconstruct the + buffers. */ + __re_size_t offset = match_first - mctx.input.raw_mbs_idx; + if (BE (offset >= (__re_size_t) mctx.input.valid_raw_len, 0)) + { + err = re_string_reconstruct (&mctx.input, match_first, + eflags); + if (BE (err != REG_NOERROR, 0)) + goto free_return; + + offset = match_first - mctx.input.raw_mbs_idx; + } + /* If MATCH_FIRST is out of the buffer, leave it as '\0'. + Note that MATCH_FIRST must not be smaller than 0. */ + ch = (match_first >= length + ? 0 : re_string_byte_at (&mctx.input, offset)); + if (fastmap[ch]) + break; + match_first += incr; + if (match_first < left_lim || match_first > right_lim) + { + err = REG_NOMATCH; + goto free_return; + } + } + break; + } + + /* Reconstruct the buffers so that the matcher can assume that + the matching starts from the beginning of the buffer. */ + err = re_string_reconstruct (&mctx.input, match_first, eflags); + if (BE (err != REG_NOERROR, 0)) + goto free_return; + +#ifdef RE_ENABLE_I18N + /* Don't consider this char as a possible match start if it part, + yet isn't the head, of a multibyte character. */ + if (!sb && !re_string_first_byte (&mctx.input, 0)) + continue; +#endif + + /* It seems to be appropriate one, then use the matcher. */ + /* We assume that the matching starts from 0. */ + mctx.state_log_top = mctx.nbkref_ents = mctx.max_mb_elem_len = 0; + match_last = check_matching (&mctx, fl_longest_match, + start <= last_start ? &match_first : NULL); + if (match_last != -1) + { + if (BE (match_last == -2, 0)) + { + err = REG_ESPACE; + goto free_return; + } + else + { + mctx.match_last = match_last; + if ((!preg->no_sub && nmatch > 1) || dfa->nbackref) + { + re_dfastate_t *pstate = mctx.state_log[match_last]; + mctx.last_node = check_halt_state_context (&mctx, pstate, + match_last); + } + if ((!preg->no_sub && nmatch > 1 && dfa->has_plural_match) + || dfa->nbackref) + { + err = prune_impossible_nodes (&mctx); + if (err == REG_NOERROR) + break; + if (BE (err != REG_NOMATCH, 0)) + goto free_return; + match_last = -1; + } + else + break; /* We found a match. */ + } + } + + match_ctx_clean (&mctx); + } + +#ifdef DEBUG + assert (match_last != -1); + assert (err == REG_NOERROR); +#endif + + /* Set pmatch[] if we need. */ + if (nmatch > 0) + { + Idx reg_idx; + + /* Initialize registers. */ + for (reg_idx = 1; reg_idx < nmatch; ++reg_idx) + pmatch[reg_idx].rm_so = pmatch[reg_idx].rm_eo = -1; + + /* Set the points where matching start/end. */ + pmatch[0].rm_so = 0; + pmatch[0].rm_eo = mctx.match_last; + /* FIXME: This function should fail if mctx.match_last exceeds + the maximum possible regoff_t value. We need a new error + code REG_OVERFLOW. */ + + if (!preg->no_sub && nmatch > 1) + { + err = set_regs (preg, &mctx, nmatch, pmatch, + dfa->has_plural_match && dfa->nbackref > 0); + if (BE (err != REG_NOERROR, 0)) + goto free_return; + } + + /* At last, add the offset to each register, since we slid + the buffers so that we could assume that the matching starts + from 0. */ + for (reg_idx = 0; reg_idx < nmatch; ++reg_idx) + if (pmatch[reg_idx].rm_so != -1) + { +#ifdef RE_ENABLE_I18N + if (BE (mctx.input.offsets_needed != 0, 0)) + { + pmatch[reg_idx].rm_so = + (pmatch[reg_idx].rm_so == mctx.input.valid_len + ? mctx.input.valid_raw_len + : mctx.input.offsets[pmatch[reg_idx].rm_so]); + pmatch[reg_idx].rm_eo = + (pmatch[reg_idx].rm_eo == mctx.input.valid_len + ? mctx.input.valid_raw_len + : mctx.input.offsets[pmatch[reg_idx].rm_eo]); + } +#else + assert (mctx.input.offsets_needed == 0); +#endif + pmatch[reg_idx].rm_so += match_first; + pmatch[reg_idx].rm_eo += match_first; + } + for (reg_idx = 0; reg_idx < extra_nmatch; ++reg_idx) + { + pmatch[nmatch + reg_idx].rm_so = -1; + pmatch[nmatch + reg_idx].rm_eo = -1; + } + + if (dfa->subexp_map) + for (reg_idx = 0; reg_idx + 1 < nmatch; reg_idx++) + if (dfa->subexp_map[reg_idx] != reg_idx) + { + pmatch[reg_idx + 1].rm_so + = pmatch[dfa->subexp_map[reg_idx] + 1].rm_so; + pmatch[reg_idx + 1].rm_eo + = pmatch[dfa->subexp_map[reg_idx] + 1].rm_eo; + } + } + + free_return: + re_free (mctx.state_log); + if (dfa->nbackref) + match_ctx_free (&mctx); + re_string_destruct (&mctx.input); + return err; +} + +static reg_errcode_t +__attribute_warn_unused_result__ +prune_impossible_nodes (re_match_context_t *mctx) +{ + const re_dfa_t *const dfa = mctx->dfa; + Idx halt_node, match_last; + reg_errcode_t ret; + re_dfastate_t **sifted_states; + re_dfastate_t **lim_states = NULL; + re_sift_context_t sctx; +#ifdef DEBUG + assert (mctx->state_log != NULL); +#endif + match_last = mctx->match_last; + halt_node = mctx->last_node; + + /* Avoid overflow. */ + if (BE (MIN (IDX_MAX, SIZE_MAX / sizeof (re_dfastate_t *)) <= match_last, 0)) + return REG_ESPACE; + + sifted_states = re_malloc (re_dfastate_t *, match_last + 1); + if (BE (sifted_states == NULL, 0)) + { + ret = REG_ESPACE; + goto free_return; + } + if (dfa->nbackref) + { + lim_states = re_malloc (re_dfastate_t *, match_last + 1); + if (BE (lim_states == NULL, 0)) + { + ret = REG_ESPACE; + goto free_return; + } + while (1) + { + memset (lim_states, '\0', + sizeof (re_dfastate_t *) * (match_last + 1)); + sift_ctx_init (&sctx, sifted_states, lim_states, halt_node, + match_last); + ret = sift_states_backward (mctx, &sctx); + re_node_set_free (&sctx.limits); + if (BE (ret != REG_NOERROR, 0)) + goto free_return; + if (sifted_states[0] != NULL || lim_states[0] != NULL) + break; + do + { + --match_last; + if (match_last < 0) + { + ret = REG_NOMATCH; + goto free_return; + } + } while (mctx->state_log[match_last] == NULL + || !mctx->state_log[match_last]->halt); + halt_node = check_halt_state_context (mctx, + mctx->state_log[match_last], + match_last); + } + ret = merge_state_array (dfa, sifted_states, lim_states, + match_last + 1); + re_free (lim_states); + lim_states = NULL; + if (BE (ret != REG_NOERROR, 0)) + goto free_return; + } + else + { + sift_ctx_init (&sctx, sifted_states, lim_states, halt_node, match_last); + ret = sift_states_backward (mctx, &sctx); + re_node_set_free (&sctx.limits); + if (BE (ret != REG_NOERROR, 0)) + goto free_return; + if (sifted_states[0] == NULL) + { + ret = REG_NOMATCH; + goto free_return; + } + } + re_free (mctx->state_log); + mctx->state_log = sifted_states; + sifted_states = NULL; + mctx->last_node = halt_node; + mctx->match_last = match_last; + ret = REG_NOERROR; + free_return: + re_free (sifted_states); + re_free (lim_states); + return ret; +} + +/* Acquire an initial state and return it. + We must select appropriate initial state depending on the context, + since initial states may have constraints like "\<", "^", etc.. */ + +static inline re_dfastate_t * +__attribute__ ((always_inline)) +acquire_init_state_context (reg_errcode_t *err, const re_match_context_t *mctx, + Idx idx) +{ + const re_dfa_t *const dfa = mctx->dfa; + if (dfa->init_state->has_constraint) + { + unsigned int context; + context = re_string_context_at (&mctx->input, idx - 1, mctx->eflags); + if (IS_WORD_CONTEXT (context)) + return dfa->init_state_word; + else if (IS_ORDINARY_CONTEXT (context)) + return dfa->init_state; + else if (IS_BEGBUF_CONTEXT (context) && IS_NEWLINE_CONTEXT (context)) + return dfa->init_state_begbuf; + else if (IS_NEWLINE_CONTEXT (context)) + return dfa->init_state_nl; + else if (IS_BEGBUF_CONTEXT (context)) + { + /* It is relatively rare case, then calculate on demand. */ + return re_acquire_state_context (err, dfa, + dfa->init_state->entrance_nodes, + context); + } + else + /* Must not happen? */ + return dfa->init_state; + } + else + return dfa->init_state; +} + +/* Check whether the regular expression match input string INPUT or not, + and return the index where the matching end. Return -1 if + there is no match, and return -2 in case of an error. + FL_LONGEST_MATCH means we want the POSIX longest matching. + If P_MATCH_FIRST is not NULL, and the match fails, it is set to the + next place where we may want to try matching. + Note that the matcher assumes that the matching starts from the current + index of the buffer. */ + +static Idx +__attribute_warn_unused_result__ +check_matching (re_match_context_t *mctx, bool fl_longest_match, + Idx *p_match_first) +{ + const re_dfa_t *const dfa = mctx->dfa; + reg_errcode_t err; + Idx match = 0; + Idx match_last = -1; + Idx cur_str_idx = re_string_cur_idx (&mctx->input); + re_dfastate_t *cur_state; + bool at_init_state = p_match_first != NULL; + Idx next_start_idx = cur_str_idx; + + err = REG_NOERROR; + cur_state = acquire_init_state_context (&err, mctx, cur_str_idx); + /* An initial state must not be NULL (invalid). */ + if (BE (cur_state == NULL, 0)) + { + assert (err == REG_ESPACE); + return -2; + } + + if (mctx->state_log != NULL) + { + mctx->state_log[cur_str_idx] = cur_state; + + /* Check OP_OPEN_SUBEXP in the initial state in case that we use them + later. E.g. Processing back references. */ + if (BE (dfa->nbackref, 0)) + { + at_init_state = false; + err = check_subexp_matching_top (mctx, &cur_state->nodes, 0); + if (BE (err != REG_NOERROR, 0)) + return err; + + if (cur_state->has_backref) + { + err = transit_state_bkref (mctx, &cur_state->nodes); + if (BE (err != REG_NOERROR, 0)) + return err; + } + } + } + + /* If the RE accepts NULL string. */ + if (BE (cur_state->halt, 0)) + { + if (!cur_state->has_constraint + || check_halt_state_context (mctx, cur_state, cur_str_idx)) + { + if (!fl_longest_match) + return cur_str_idx; + else + { + match_last = cur_str_idx; + match = 1; + } + } + } + + while (!re_string_eoi (&mctx->input)) + { + re_dfastate_t *old_state = cur_state; + Idx next_char_idx = re_string_cur_idx (&mctx->input) + 1; + + if ((BE (next_char_idx >= mctx->input.bufs_len, 0) + && mctx->input.bufs_len < mctx->input.len) + || (BE (next_char_idx >= mctx->input.valid_len, 0) + && mctx->input.valid_len < mctx->input.len)) + { + err = extend_buffers (mctx, next_char_idx + 1); + if (BE (err != REG_NOERROR, 0)) + { + assert (err == REG_ESPACE); + return -2; + } + } + + cur_state = transit_state (&err, mctx, cur_state); + if (mctx->state_log != NULL) + cur_state = merge_state_with_log (&err, mctx, cur_state); + + if (cur_state == NULL) + { + /* Reached the invalid state or an error. Try to recover a valid + state using the state log, if available and if we have not + already found a valid (even if not the longest) match. */ + if (BE (err != REG_NOERROR, 0)) + return -2; + + if (mctx->state_log == NULL + || (match && !fl_longest_match) + || (cur_state = find_recover_state (&err, mctx)) == NULL) + break; + } + + if (BE (at_init_state, 0)) + { + if (old_state == cur_state) + next_start_idx = next_char_idx; + else + at_init_state = false; + } + + if (cur_state->halt) + { + /* Reached a halt state. + Check the halt state can satisfy the current context. */ + if (!cur_state->has_constraint + || check_halt_state_context (mctx, cur_state, + re_string_cur_idx (&mctx->input))) + { + /* We found an appropriate halt state. */ + match_last = re_string_cur_idx (&mctx->input); + match = 1; + + /* We found a match, do not modify match_first below. */ + p_match_first = NULL; + if (!fl_longest_match) + break; + } + } + } + + if (p_match_first) + *p_match_first += next_start_idx; + + return match_last; +} + +/* Check NODE match the current context. */ + +static bool +check_halt_node_context (const re_dfa_t *dfa, Idx node, unsigned int context) +{ + re_token_type_t type = dfa->nodes[node].type; + unsigned int constraint = dfa->nodes[node].constraint; + if (type != END_OF_RE) + return false; + if (!constraint) + return true; + if (NOT_SATISFY_NEXT_CONSTRAINT (constraint, context)) + return false; + return true; +} + +/* Check the halt state STATE match the current context. + Return 0 if not match, if the node, STATE has, is a halt node and + match the context, return the node. */ + +static Idx +check_halt_state_context (const re_match_context_t *mctx, + const re_dfastate_t *state, Idx idx) +{ + Idx i; + unsigned int context; +#ifdef DEBUG + assert (state->halt); +#endif + context = re_string_context_at (&mctx->input, idx, mctx->eflags); + for (i = 0; i < state->nodes.nelem; ++i) + if (check_halt_node_context (mctx->dfa, state->nodes.elems[i], context)) + return state->nodes.elems[i]; + return 0; +} + +/* Compute the next node to which "NFA" transit from NODE("NFA" is a NFA + corresponding to the DFA). + Return the destination node, and update EPS_VIA_NODES; + return -1 in case of errors. */ + +static Idx +proceed_next_node (const re_match_context_t *mctx, Idx nregs, regmatch_t *regs, + Idx *pidx, Idx node, re_node_set *eps_via_nodes, + struct re_fail_stack_t *fs) +{ + const re_dfa_t *const dfa = mctx->dfa; + Idx i; + bool ok; + if (IS_EPSILON_NODE (dfa->nodes[node].type)) + { + re_node_set *cur_nodes = &mctx->state_log[*pidx]->nodes; + re_node_set *edests = &dfa->edests[node]; + Idx dest_node; + ok = re_node_set_insert (eps_via_nodes, node); + if (BE (! ok, 0)) + return -2; + /* Pick up a valid destination, or return -1 if none + is found. */ + for (dest_node = -1, i = 0; i < edests->nelem; ++i) + { + Idx candidate = edests->elems[i]; + if (!re_node_set_contains (cur_nodes, candidate)) + continue; + if (dest_node == -1) + dest_node = candidate; + + else + { + /* In order to avoid infinite loop like "(a*)*", return the second + epsilon-transition if the first was already considered. */ + if (re_node_set_contains (eps_via_nodes, dest_node)) + return candidate; + + /* Otherwise, push the second epsilon-transition on the fail stack. */ + else if (fs != NULL + && push_fail_stack (fs, *pidx, candidate, nregs, regs, + eps_via_nodes)) + return -2; + + /* We know we are going to exit. */ + break; + } + } + return dest_node; + } + else + { + Idx naccepted = 0; + re_token_type_t type = dfa->nodes[node].type; + +#ifdef RE_ENABLE_I18N + if (dfa->nodes[node].accept_mb) + naccepted = check_node_accept_bytes (dfa, node, &mctx->input, *pidx); + else +#endif /* RE_ENABLE_I18N */ + if (type == OP_BACK_REF) + { + Idx subexp_idx = dfa->nodes[node].opr.idx + 1; + naccepted = regs[subexp_idx].rm_eo - regs[subexp_idx].rm_so; + if (fs != NULL) + { + if (regs[subexp_idx].rm_so == -1 || regs[subexp_idx].rm_eo == -1) + return -1; + else if (naccepted) + { + char *buf = (char *) re_string_get_buffer (&mctx->input); + if (memcmp (buf + regs[subexp_idx].rm_so, buf + *pidx, + naccepted) != 0) + return -1; + } + } + + if (naccepted == 0) + { + Idx dest_node; + ok = re_node_set_insert (eps_via_nodes, node); + if (BE (! ok, 0)) + return -2; + dest_node = dfa->edests[node].elems[0]; + if (re_node_set_contains (&mctx->state_log[*pidx]->nodes, + dest_node)) + return dest_node; + } + } + + if (naccepted != 0 + || check_node_accept (mctx, dfa->nodes + node, *pidx)) + { + Idx dest_node = dfa->nexts[node]; + *pidx = (naccepted == 0) ? *pidx + 1 : *pidx + naccepted; + if (fs && (*pidx > mctx->match_last || mctx->state_log[*pidx] == NULL + || !re_node_set_contains (&mctx->state_log[*pidx]->nodes, + dest_node))) + return -1; + re_node_set_empty (eps_via_nodes); + return dest_node; + } + } + return -1; +} + +static reg_errcode_t +__attribute_warn_unused_result__ +push_fail_stack (struct re_fail_stack_t *fs, Idx str_idx, Idx dest_node, + Idx nregs, regmatch_t *regs, re_node_set *eps_via_nodes) +{ + reg_errcode_t err; + Idx num = fs->num++; + if (fs->num == fs->alloc) + { + struct re_fail_stack_ent_t *new_array; + new_array = re_realloc (fs->stack, struct re_fail_stack_ent_t, + fs->alloc * 2); + if (new_array == NULL) + return REG_ESPACE; + fs->alloc *= 2; + fs->stack = new_array; + } + fs->stack[num].idx = str_idx; + fs->stack[num].node = dest_node; + fs->stack[num].regs = re_malloc (regmatch_t, nregs); + if (fs->stack[num].regs == NULL) + return REG_ESPACE; + memcpy (fs->stack[num].regs, regs, sizeof (regmatch_t) * nregs); + err = re_node_set_init_copy (&fs->stack[num].eps_via_nodes, eps_via_nodes); + return err; +} + +static Idx +pop_fail_stack (struct re_fail_stack_t *fs, Idx *pidx, Idx nregs, + regmatch_t *regs, re_node_set *eps_via_nodes) +{ + Idx num = --fs->num; + assert (num >= 0); + *pidx = fs->stack[num].idx; + memcpy (regs, fs->stack[num].regs, sizeof (regmatch_t) * nregs); + re_node_set_free (eps_via_nodes); + re_free (fs->stack[num].regs); + *eps_via_nodes = fs->stack[num].eps_via_nodes; + return fs->stack[num].node; +} + +/* Set the positions where the subexpressions are starts/ends to registers + PMATCH. + Note: We assume that pmatch[0] is already set, and + pmatch[i].rm_so == pmatch[i].rm_eo == -1 for 0 < i < nmatch. */ + +static reg_errcode_t +__attribute_warn_unused_result__ +set_regs (const regex_t *preg, const re_match_context_t *mctx, size_t nmatch, + regmatch_t *pmatch, bool fl_backtrack) +{ + const re_dfa_t *dfa = preg->buffer; + Idx idx, cur_node; + re_node_set eps_via_nodes; + struct re_fail_stack_t *fs; + struct re_fail_stack_t fs_body = { 0, 2, NULL }; + regmatch_t *prev_idx_match; + bool prev_idx_match_malloced = false; + +#ifdef DEBUG + assert (nmatch > 1); + assert (mctx->state_log != NULL); +#endif + if (fl_backtrack) + { + fs = &fs_body; + fs->stack = re_malloc (struct re_fail_stack_ent_t, fs->alloc); + if (fs->stack == NULL) + return REG_ESPACE; + } + else + fs = NULL; + + cur_node = dfa->init_node; + re_node_set_init_empty (&eps_via_nodes); + + if (__libc_use_alloca (nmatch * sizeof (regmatch_t))) + prev_idx_match = (regmatch_t *) alloca (nmatch * sizeof (regmatch_t)); + else + { + prev_idx_match = re_malloc (regmatch_t, nmatch); + if (prev_idx_match == NULL) + { + free_fail_stack_return (fs); + return REG_ESPACE; + } + prev_idx_match_malloced = true; + } + memcpy (prev_idx_match, pmatch, sizeof (regmatch_t) * nmatch); + + for (idx = pmatch[0].rm_so; idx <= pmatch[0].rm_eo ;) + { + update_regs (dfa, pmatch, prev_idx_match, cur_node, idx, nmatch); + + if (idx == pmatch[0].rm_eo && cur_node == mctx->last_node) + { + Idx reg_idx; + if (fs) + { + for (reg_idx = 0; reg_idx < nmatch; ++reg_idx) + if (pmatch[reg_idx].rm_so > -1 && pmatch[reg_idx].rm_eo == -1) + break; + if (reg_idx == nmatch) + { + re_node_set_free (&eps_via_nodes); + if (prev_idx_match_malloced) + re_free (prev_idx_match); + return free_fail_stack_return (fs); + } + cur_node = pop_fail_stack (fs, &idx, nmatch, pmatch, + &eps_via_nodes); + } + else + { + re_node_set_free (&eps_via_nodes); + if (prev_idx_match_malloced) + re_free (prev_idx_match); + return REG_NOERROR; + } + } + + /* Proceed to next node. */ + cur_node = proceed_next_node (mctx, nmatch, pmatch, &idx, cur_node, + &eps_via_nodes, fs); + + if (BE (cur_node < 0, 0)) + { + if (BE (cur_node == -2, 0)) + { + re_node_set_free (&eps_via_nodes); + if (prev_idx_match_malloced) + re_free (prev_idx_match); + free_fail_stack_return (fs); + return REG_ESPACE; + } + if (fs) + cur_node = pop_fail_stack (fs, &idx, nmatch, pmatch, + &eps_via_nodes); + else + { + re_node_set_free (&eps_via_nodes); + if (prev_idx_match_malloced) + re_free (prev_idx_match); + return REG_NOMATCH; + } + } + } + re_node_set_free (&eps_via_nodes); + if (prev_idx_match_malloced) + re_free (prev_idx_match); + return free_fail_stack_return (fs); +} + +static reg_errcode_t +free_fail_stack_return (struct re_fail_stack_t *fs) +{ + if (fs) + { + Idx fs_idx; + for (fs_idx = 0; fs_idx < fs->num; ++fs_idx) + { + re_node_set_free (&fs->stack[fs_idx].eps_via_nodes); + re_free (fs->stack[fs_idx].regs); + } + re_free (fs->stack); + } + return REG_NOERROR; +} + +static void +update_regs (const re_dfa_t *dfa, regmatch_t *pmatch, + regmatch_t *prev_idx_match, Idx cur_node, Idx cur_idx, Idx nmatch) +{ + int type = dfa->nodes[cur_node].type; + if (type == OP_OPEN_SUBEXP) + { + Idx reg_num = dfa->nodes[cur_node].opr.idx + 1; + + /* We are at the first node of this sub expression. */ + if (reg_num < nmatch) + { + pmatch[reg_num].rm_so = cur_idx; + pmatch[reg_num].rm_eo = -1; + } + } + else if (type == OP_CLOSE_SUBEXP) + { + Idx reg_num = dfa->nodes[cur_node].opr.idx + 1; + if (reg_num < nmatch) + { + /* We are at the last node of this sub expression. */ + if (pmatch[reg_num].rm_so < cur_idx) + { + pmatch[reg_num].rm_eo = cur_idx; + /* This is a non-empty match or we are not inside an optional + subexpression. Accept this right away. */ + memcpy (prev_idx_match, pmatch, sizeof (regmatch_t) * nmatch); + } + else + { + if (dfa->nodes[cur_node].opt_subexp + && prev_idx_match[reg_num].rm_so != -1) + /* We transited through an empty match for an optional + subexpression, like (a?)*, and this is not the subexp's + first match. Copy back the old content of the registers + so that matches of an inner subexpression are undone as + well, like in ((a?))*. */ + memcpy (pmatch, prev_idx_match, sizeof (regmatch_t) * nmatch); + else + /* We completed a subexpression, but it may be part of + an optional one, so do not update PREV_IDX_MATCH. */ + pmatch[reg_num].rm_eo = cur_idx; + } + } + } +} + +/* This function checks the STATE_LOG from the SCTX->last_str_idx to 0 + and sift the nodes in each states according to the following rules. + Updated state_log will be wrote to STATE_LOG. + + Rules: We throw away the Node 'a' in the STATE_LOG[STR_IDX] if... + 1. When STR_IDX == MATCH_LAST(the last index in the state_log): + If 'a' isn't the LAST_NODE and 'a' can't epsilon transit to + the LAST_NODE, we throw away the node 'a'. + 2. When 0 <= STR_IDX < MATCH_LAST and 'a' accepts + string 's' and transit to 'b': + i. If 'b' isn't in the STATE_LOG[STR_IDX+strlen('s')], we throw + away the node 'a'. + ii. If 'b' is in the STATE_LOG[STR_IDX+strlen('s')] but 'b' is + thrown away, we throw away the node 'a'. + 3. When 0 <= STR_IDX < MATCH_LAST and 'a' epsilon transit to 'b': + i. If 'b' isn't in the STATE_LOG[STR_IDX], we throw away the + node 'a'. + ii. If 'b' is in the STATE_LOG[STR_IDX] but 'b' is thrown away, + we throw away the node 'a'. */ + +#define STATE_NODE_CONTAINS(state,node) \ + ((state) != NULL && re_node_set_contains (&(state)->nodes, node)) + +static reg_errcode_t +sift_states_backward (const re_match_context_t *mctx, re_sift_context_t *sctx) +{ + reg_errcode_t err; + int null_cnt = 0; + Idx str_idx = sctx->last_str_idx; + re_node_set cur_dest; + +#ifdef DEBUG + assert (mctx->state_log != NULL && mctx->state_log[str_idx] != NULL); +#endif + + /* Build sifted state_log[str_idx]. It has the nodes which can epsilon + transit to the last_node and the last_node itself. */ + err = re_node_set_init_1 (&cur_dest, sctx->last_node); + if (BE (err != REG_NOERROR, 0)) + return err; + err = update_cur_sifted_state (mctx, sctx, str_idx, &cur_dest); + if (BE (err != REG_NOERROR, 0)) + goto free_return; + + /* Then check each states in the state_log. */ + while (str_idx > 0) + { + /* Update counters. */ + null_cnt = (sctx->sifted_states[str_idx] == NULL) ? null_cnt + 1 : 0; + if (null_cnt > mctx->max_mb_elem_len) + { + memset (sctx->sifted_states, '\0', + sizeof (re_dfastate_t *) * str_idx); + re_node_set_free (&cur_dest); + return REG_NOERROR; + } + re_node_set_empty (&cur_dest); + --str_idx; + + if (mctx->state_log[str_idx]) + { + err = build_sifted_states (mctx, sctx, str_idx, &cur_dest); + if (BE (err != REG_NOERROR, 0)) + goto free_return; + } + + /* Add all the nodes which satisfy the following conditions: + - It can epsilon transit to a node in CUR_DEST. + - It is in CUR_SRC. + And update state_log. */ + err = update_cur_sifted_state (mctx, sctx, str_idx, &cur_dest); + if (BE (err != REG_NOERROR, 0)) + goto free_return; + } + err = REG_NOERROR; + free_return: + re_node_set_free (&cur_dest); + return err; +} + +static reg_errcode_t +__attribute_warn_unused_result__ +build_sifted_states (const re_match_context_t *mctx, re_sift_context_t *sctx, + Idx str_idx, re_node_set *cur_dest) +{ + const re_dfa_t *const dfa = mctx->dfa; + const re_node_set *cur_src = &mctx->state_log[str_idx]->non_eps_nodes; + Idx i; + + /* Then build the next sifted state. + We build the next sifted state on 'cur_dest', and update + 'sifted_states[str_idx]' with 'cur_dest'. + Note: + 'cur_dest' is the sifted state from 'state_log[str_idx + 1]'. + 'cur_src' points the node_set of the old 'state_log[str_idx]' + (with the epsilon nodes pre-filtered out). */ + for (i = 0; i < cur_src->nelem; i++) + { + Idx prev_node = cur_src->elems[i]; + int naccepted = 0; + bool ok; + +#ifdef DEBUG + re_token_type_t type = dfa->nodes[prev_node].type; + assert (!IS_EPSILON_NODE (type)); +#endif +#ifdef RE_ENABLE_I18N + /* If the node may accept "multi byte". */ + if (dfa->nodes[prev_node].accept_mb) + naccepted = sift_states_iter_mb (mctx, sctx, prev_node, + str_idx, sctx->last_str_idx); +#endif /* RE_ENABLE_I18N */ + + /* We don't check backreferences here. + See update_cur_sifted_state(). */ + if (!naccepted + && check_node_accept (mctx, dfa->nodes + prev_node, str_idx) + && STATE_NODE_CONTAINS (sctx->sifted_states[str_idx + 1], + dfa->nexts[prev_node])) + naccepted = 1; + + if (naccepted == 0) + continue; + + if (sctx->limits.nelem) + { + Idx to_idx = str_idx + naccepted; + if (check_dst_limits (mctx, &sctx->limits, + dfa->nexts[prev_node], to_idx, + prev_node, str_idx)) + continue; + } + ok = re_node_set_insert (cur_dest, prev_node); + if (BE (! ok, 0)) + return REG_ESPACE; + } + + return REG_NOERROR; +} + +/* Helper functions. */ + +static reg_errcode_t +clean_state_log_if_needed (re_match_context_t *mctx, Idx next_state_log_idx) +{ + Idx top = mctx->state_log_top; + + if ((next_state_log_idx >= mctx->input.bufs_len + && mctx->input.bufs_len < mctx->input.len) + || (next_state_log_idx >= mctx->input.valid_len + && mctx->input.valid_len < mctx->input.len)) + { + reg_errcode_t err; + err = extend_buffers (mctx, next_state_log_idx + 1); + if (BE (err != REG_NOERROR, 0)) + return err; + } + + if (top < next_state_log_idx) + { + memset (mctx->state_log + top + 1, '\0', + sizeof (re_dfastate_t *) * (next_state_log_idx - top)); + mctx->state_log_top = next_state_log_idx; + } + return REG_NOERROR; +} + +static reg_errcode_t +merge_state_array (const re_dfa_t *dfa, re_dfastate_t **dst, + re_dfastate_t **src, Idx num) +{ + Idx st_idx; + reg_errcode_t err; + for (st_idx = 0; st_idx < num; ++st_idx) + { + if (dst[st_idx] == NULL) + dst[st_idx] = src[st_idx]; + else if (src[st_idx] != NULL) + { + re_node_set merged_set; + err = re_node_set_init_union (&merged_set, &dst[st_idx]->nodes, + &src[st_idx]->nodes); + if (BE (err != REG_NOERROR, 0)) + return err; + dst[st_idx] = re_acquire_state (&err, dfa, &merged_set); + re_node_set_free (&merged_set); + if (BE (err != REG_NOERROR, 0)) + return err; + } + } + return REG_NOERROR; +} + +static reg_errcode_t +update_cur_sifted_state (const re_match_context_t *mctx, + re_sift_context_t *sctx, Idx str_idx, + re_node_set *dest_nodes) +{ + const re_dfa_t *const dfa = mctx->dfa; + reg_errcode_t err = REG_NOERROR; + const re_node_set *candidates; + candidates = ((mctx->state_log[str_idx] == NULL) ? NULL + : &mctx->state_log[str_idx]->nodes); + + if (dest_nodes->nelem == 0) + sctx->sifted_states[str_idx] = NULL; + else + { + if (candidates) + { + /* At first, add the nodes which can epsilon transit to a node in + DEST_NODE. */ + err = add_epsilon_src_nodes (dfa, dest_nodes, candidates); + if (BE (err != REG_NOERROR, 0)) + return err; + + /* Then, check the limitations in the current sift_context. */ + if (sctx->limits.nelem) + { + err = check_subexp_limits (dfa, dest_nodes, candidates, &sctx->limits, + mctx->bkref_ents, str_idx); + if (BE (err != REG_NOERROR, 0)) + return err; + } + } + + sctx->sifted_states[str_idx] = re_acquire_state (&err, dfa, dest_nodes); + if (BE (err != REG_NOERROR, 0)) + return err; + } + + if (candidates && mctx->state_log[str_idx]->has_backref) + { + err = sift_states_bkref (mctx, sctx, str_idx, candidates); + if (BE (err != REG_NOERROR, 0)) + return err; + } + return REG_NOERROR; +} + +static reg_errcode_t +__attribute_warn_unused_result__ +add_epsilon_src_nodes (const re_dfa_t *dfa, re_node_set *dest_nodes, + const re_node_set *candidates) +{ + reg_errcode_t err = REG_NOERROR; + Idx i; + + re_dfastate_t *state = re_acquire_state (&err, dfa, dest_nodes); + if (BE (err != REG_NOERROR, 0)) + return err; + + if (!state->inveclosure.alloc) + { + err = re_node_set_alloc (&state->inveclosure, dest_nodes->nelem); + if (BE (err != REG_NOERROR, 0)) + return REG_ESPACE; + for (i = 0; i < dest_nodes->nelem; i++) + { + err = re_node_set_merge (&state->inveclosure, + dfa->inveclosures + dest_nodes->elems[i]); + if (BE (err != REG_NOERROR, 0)) + return REG_ESPACE; + } + } + return re_node_set_add_intersect (dest_nodes, candidates, + &state->inveclosure); +} + +static reg_errcode_t +sub_epsilon_src_nodes (const re_dfa_t *dfa, Idx node, re_node_set *dest_nodes, + const re_node_set *candidates) +{ + Idx ecl_idx; + reg_errcode_t err; + re_node_set *inv_eclosure = dfa->inveclosures + node; + re_node_set except_nodes; + re_node_set_init_empty (&except_nodes); + for (ecl_idx = 0; ecl_idx < inv_eclosure->nelem; ++ecl_idx) + { + Idx cur_node = inv_eclosure->elems[ecl_idx]; + if (cur_node == node) + continue; + if (IS_EPSILON_NODE (dfa->nodes[cur_node].type)) + { + Idx edst1 = dfa->edests[cur_node].elems[0]; + Idx edst2 = ((dfa->edests[cur_node].nelem > 1) + ? dfa->edests[cur_node].elems[1] : -1); + if ((!re_node_set_contains (inv_eclosure, edst1) + && re_node_set_contains (dest_nodes, edst1)) + || (edst2 > 0 + && !re_node_set_contains (inv_eclosure, edst2) + && re_node_set_contains (dest_nodes, edst2))) + { + err = re_node_set_add_intersect (&except_nodes, candidates, + dfa->inveclosures + cur_node); + if (BE (err != REG_NOERROR, 0)) + { + re_node_set_free (&except_nodes); + return err; + } + } + } + } + for (ecl_idx = 0; ecl_idx < inv_eclosure->nelem; ++ecl_idx) + { + Idx cur_node = inv_eclosure->elems[ecl_idx]; + if (!re_node_set_contains (&except_nodes, cur_node)) + { + Idx idx = re_node_set_contains (dest_nodes, cur_node) - 1; + re_node_set_remove_at (dest_nodes, idx); + } + } + re_node_set_free (&except_nodes); + return REG_NOERROR; +} + +static bool +check_dst_limits (const re_match_context_t *mctx, const re_node_set *limits, + Idx dst_node, Idx dst_idx, Idx src_node, Idx src_idx) +{ + const re_dfa_t *const dfa = mctx->dfa; + Idx lim_idx, src_pos, dst_pos; + + Idx dst_bkref_idx = search_cur_bkref_entry (mctx, dst_idx); + Idx src_bkref_idx = search_cur_bkref_entry (mctx, src_idx); + for (lim_idx = 0; lim_idx < limits->nelem; ++lim_idx) + { + Idx subexp_idx; + struct re_backref_cache_entry *ent; + ent = mctx->bkref_ents + limits->elems[lim_idx]; + subexp_idx = dfa->nodes[ent->node].opr.idx; + + dst_pos = check_dst_limits_calc_pos (mctx, limits->elems[lim_idx], + subexp_idx, dst_node, dst_idx, + dst_bkref_idx); + src_pos = check_dst_limits_calc_pos (mctx, limits->elems[lim_idx], + subexp_idx, src_node, src_idx, + src_bkref_idx); + + /* In case of: + ( ) + ( ) + ( ) */ + if (src_pos == dst_pos) + continue; /* This is unrelated limitation. */ + else + return true; + } + return false; +} + +static int +check_dst_limits_calc_pos_1 (const re_match_context_t *mctx, int boundaries, + Idx subexp_idx, Idx from_node, Idx bkref_idx) +{ + const re_dfa_t *const dfa = mctx->dfa; + const re_node_set *eclosures = dfa->eclosures + from_node; + Idx node_idx; + + /* Else, we are on the boundary: examine the nodes on the epsilon + closure. */ + for (node_idx = 0; node_idx < eclosures->nelem; ++node_idx) + { + Idx node = eclosures->elems[node_idx]; + switch (dfa->nodes[node].type) + { + case OP_BACK_REF: + if (bkref_idx != -1) + { + struct re_backref_cache_entry *ent = mctx->bkref_ents + bkref_idx; + do + { + Idx dst; + int cpos; + + if (ent->node != node) + continue; + + if (subexp_idx < BITSET_WORD_BITS + && !(ent->eps_reachable_subexps_map + & ((bitset_word_t) 1 << subexp_idx))) + continue; + + /* Recurse trying to reach the OP_OPEN_SUBEXP and + OP_CLOSE_SUBEXP cases below. But, if the + destination node is the same node as the source + node, don't recurse because it would cause an + infinite loop: a regex that exhibits this behavior + is ()\1*\1* */ + dst = dfa->edests[node].elems[0]; + if (dst == from_node) + { + if (boundaries & 1) + return -1; + else /* if (boundaries & 2) */ + return 0; + } + + cpos = + check_dst_limits_calc_pos_1 (mctx, boundaries, subexp_idx, + dst, bkref_idx); + if (cpos == -1 /* && (boundaries & 1) */) + return -1; + if (cpos == 0 && (boundaries & 2)) + return 0; + + if (subexp_idx < BITSET_WORD_BITS) + ent->eps_reachable_subexps_map + &= ~((bitset_word_t) 1 << subexp_idx); + } + while (ent++->more); + } + break; + + case OP_OPEN_SUBEXP: + if ((boundaries & 1) && subexp_idx == dfa->nodes[node].opr.idx) + return -1; + break; + + case OP_CLOSE_SUBEXP: + if ((boundaries & 2) && subexp_idx == dfa->nodes[node].opr.idx) + return 0; + break; + + default: + break; + } + } + + return (boundaries & 2) ? 1 : 0; +} + +static int +check_dst_limits_calc_pos (const re_match_context_t *mctx, Idx limit, + Idx subexp_idx, Idx from_node, Idx str_idx, + Idx bkref_idx) +{ + struct re_backref_cache_entry *lim = mctx->bkref_ents + limit; + int boundaries; + + /* If we are outside the range of the subexpression, return -1 or 1. */ + if (str_idx < lim->subexp_from) + return -1; + + if (lim->subexp_to < str_idx) + return 1; + + /* If we are within the subexpression, return 0. */ + boundaries = (str_idx == lim->subexp_from); + boundaries |= (str_idx == lim->subexp_to) << 1; + if (boundaries == 0) + return 0; + + /* Else, examine epsilon closure. */ + return check_dst_limits_calc_pos_1 (mctx, boundaries, subexp_idx, + from_node, bkref_idx); +} + +/* Check the limitations of sub expressions LIMITS, and remove the nodes + which are against limitations from DEST_NODES. */ + +static reg_errcode_t +check_subexp_limits (const re_dfa_t *dfa, re_node_set *dest_nodes, + const re_node_set *candidates, re_node_set *limits, + struct re_backref_cache_entry *bkref_ents, Idx str_idx) +{ + reg_errcode_t err; + Idx node_idx, lim_idx; + + for (lim_idx = 0; lim_idx < limits->nelem; ++lim_idx) + { + Idx subexp_idx; + struct re_backref_cache_entry *ent; + ent = bkref_ents + limits->elems[lim_idx]; + + if (str_idx <= ent->subexp_from || ent->str_idx < str_idx) + continue; /* This is unrelated limitation. */ + + subexp_idx = dfa->nodes[ent->node].opr.idx; + if (ent->subexp_to == str_idx) + { + Idx ops_node = -1; + Idx cls_node = -1; + for (node_idx = 0; node_idx < dest_nodes->nelem; ++node_idx) + { + Idx node = dest_nodes->elems[node_idx]; + re_token_type_t type = dfa->nodes[node].type; + if (type == OP_OPEN_SUBEXP + && subexp_idx == dfa->nodes[node].opr.idx) + ops_node = node; + else if (type == OP_CLOSE_SUBEXP + && subexp_idx == dfa->nodes[node].opr.idx) + cls_node = node; + } + + /* Check the limitation of the open subexpression. */ + /* Note that (ent->subexp_to = str_idx != ent->subexp_from). */ + if (ops_node >= 0) + { + err = sub_epsilon_src_nodes (dfa, ops_node, dest_nodes, + candidates); + if (BE (err != REG_NOERROR, 0)) + return err; + } + + /* Check the limitation of the close subexpression. */ + if (cls_node >= 0) + for (node_idx = 0; node_idx < dest_nodes->nelem; ++node_idx) + { + Idx node = dest_nodes->elems[node_idx]; + if (!re_node_set_contains (dfa->inveclosures + node, + cls_node) + && !re_node_set_contains (dfa->eclosures + node, + cls_node)) + { + /* It is against this limitation. + Remove it form the current sifted state. */ + err = sub_epsilon_src_nodes (dfa, node, dest_nodes, + candidates); + if (BE (err != REG_NOERROR, 0)) + return err; + --node_idx; + } + } + } + else /* (ent->subexp_to != str_idx) */ + { + for (node_idx = 0; node_idx < dest_nodes->nelem; ++node_idx) + { + Idx node = dest_nodes->elems[node_idx]; + re_token_type_t type = dfa->nodes[node].type; + if (type == OP_CLOSE_SUBEXP || type == OP_OPEN_SUBEXP) + { + if (subexp_idx != dfa->nodes[node].opr.idx) + continue; + /* It is against this limitation. + Remove it form the current sifted state. */ + err = sub_epsilon_src_nodes (dfa, node, dest_nodes, + candidates); + if (BE (err != REG_NOERROR, 0)) + return err; + } + } + } + } + return REG_NOERROR; +} + +static reg_errcode_t +__attribute_warn_unused_result__ +sift_states_bkref (const re_match_context_t *mctx, re_sift_context_t *sctx, + Idx str_idx, const re_node_set *candidates) +{ + const re_dfa_t *const dfa = mctx->dfa; + reg_errcode_t err; + Idx node_idx, node; + re_sift_context_t local_sctx; + Idx first_idx = search_cur_bkref_entry (mctx, str_idx); + + if (first_idx == -1) + return REG_NOERROR; + + local_sctx.sifted_states = NULL; /* Mark that it hasn't been initialized. */ + + for (node_idx = 0; node_idx < candidates->nelem; ++node_idx) + { + Idx enabled_idx; + re_token_type_t type; + struct re_backref_cache_entry *entry; + node = candidates->elems[node_idx]; + type = dfa->nodes[node].type; + /* Avoid infinite loop for the REs like "()\1+". */ + if (node == sctx->last_node && str_idx == sctx->last_str_idx) + continue; + if (type != OP_BACK_REF) + continue; + + entry = mctx->bkref_ents + first_idx; + enabled_idx = first_idx; + do + { + Idx subexp_len; + Idx to_idx; + Idx dst_node; + bool ok; + re_dfastate_t *cur_state; + + if (entry->node != node) + continue; + subexp_len = entry->subexp_to - entry->subexp_from; + to_idx = str_idx + subexp_len; + dst_node = (subexp_len ? dfa->nexts[node] + : dfa->edests[node].elems[0]); + + if (to_idx > sctx->last_str_idx + || sctx->sifted_states[to_idx] == NULL + || !STATE_NODE_CONTAINS (sctx->sifted_states[to_idx], dst_node) + || check_dst_limits (mctx, &sctx->limits, node, + str_idx, dst_node, to_idx)) + continue; + + if (local_sctx.sifted_states == NULL) + { + local_sctx = *sctx; + err = re_node_set_init_copy (&local_sctx.limits, &sctx->limits); + if (BE (err != REG_NOERROR, 0)) + goto free_return; + } + local_sctx.last_node = node; + local_sctx.last_str_idx = str_idx; + ok = re_node_set_insert (&local_sctx.limits, enabled_idx); + if (BE (! ok, 0)) + { + err = REG_ESPACE; + goto free_return; + } + cur_state = local_sctx.sifted_states[str_idx]; + err = sift_states_backward (mctx, &local_sctx); + if (BE (err != REG_NOERROR, 0)) + goto free_return; + if (sctx->limited_states != NULL) + { + err = merge_state_array (dfa, sctx->limited_states, + local_sctx.sifted_states, + str_idx + 1); + if (BE (err != REG_NOERROR, 0)) + goto free_return; + } + local_sctx.sifted_states[str_idx] = cur_state; + re_node_set_remove (&local_sctx.limits, enabled_idx); + + /* mctx->bkref_ents may have changed, reload the pointer. */ + entry = mctx->bkref_ents + enabled_idx; + } + while (enabled_idx++, entry++->more); + } + err = REG_NOERROR; + free_return: + if (local_sctx.sifted_states != NULL) + { + re_node_set_free (&local_sctx.limits); + } + + return err; +} + + +#ifdef RE_ENABLE_I18N +static int +sift_states_iter_mb (const re_match_context_t *mctx, re_sift_context_t *sctx, + Idx node_idx, Idx str_idx, Idx max_str_idx) +{ + const re_dfa_t *const dfa = mctx->dfa; + int naccepted; + /* Check the node can accept "multi byte". */ + naccepted = check_node_accept_bytes (dfa, node_idx, &mctx->input, str_idx); + if (naccepted > 0 && str_idx + naccepted <= max_str_idx && + !STATE_NODE_CONTAINS (sctx->sifted_states[str_idx + naccepted], + dfa->nexts[node_idx])) + /* The node can't accept the "multi byte", or the + destination was already thrown away, then the node + could't accept the current input "multi byte". */ + naccepted = 0; + /* Otherwise, it is sure that the node could accept + 'naccepted' bytes input. */ + return naccepted; +} +#endif /* RE_ENABLE_I18N */ + + +/* Functions for state transition. */ + +/* Return the next state to which the current state STATE will transit by + accepting the current input byte, and update STATE_LOG if necessary. + If STATE can accept a multibyte char/collating element/back reference + update the destination of STATE_LOG. */ + +static re_dfastate_t * +__attribute_warn_unused_result__ +transit_state (reg_errcode_t *err, re_match_context_t *mctx, + re_dfastate_t *state) +{ + re_dfastate_t **trtable; + unsigned char ch; + +#ifdef RE_ENABLE_I18N + /* If the current state can accept multibyte. */ + if (BE (state->accept_mb, 0)) + { + *err = transit_state_mb (mctx, state); + if (BE (*err != REG_NOERROR, 0)) + return NULL; + } +#endif /* RE_ENABLE_I18N */ + + /* Then decide the next state with the single byte. */ +#if 0 + if (0) + /* don't use transition table */ + return transit_state_sb (err, mctx, state); +#endif + + /* Use transition table */ + ch = re_string_fetch_byte (&mctx->input); + for (;;) + { + trtable = state->trtable; + if (BE (trtable != NULL, 1)) + return trtable[ch]; + + trtable = state->word_trtable; + if (BE (trtable != NULL, 1)) + { + unsigned int context; + context + = re_string_context_at (&mctx->input, + re_string_cur_idx (&mctx->input) - 1, + mctx->eflags); + if (IS_WORD_CONTEXT (context)) + return trtable[ch + SBC_MAX]; + else + return trtable[ch]; + } + + if (!build_trtable (mctx->dfa, state)) + { + *err = REG_ESPACE; + return NULL; + } + + /* Retry, we now have a transition table. */ + } +} + +/* Update the state_log if we need */ +static re_dfastate_t * +merge_state_with_log (reg_errcode_t *err, re_match_context_t *mctx, + re_dfastate_t *next_state) +{ + const re_dfa_t *const dfa = mctx->dfa; + Idx cur_idx = re_string_cur_idx (&mctx->input); + + if (cur_idx > mctx->state_log_top) + { + mctx->state_log[cur_idx] = next_state; + mctx->state_log_top = cur_idx; + } + else if (mctx->state_log[cur_idx] == 0) + { + mctx->state_log[cur_idx] = next_state; + } + else + { + re_dfastate_t *pstate; + unsigned int context; + re_node_set next_nodes, *log_nodes, *table_nodes = NULL; + /* If (state_log[cur_idx] != 0), it implies that cur_idx is + the destination of a multibyte char/collating element/ + back reference. Then the next state is the union set of + these destinations and the results of the transition table. */ + pstate = mctx->state_log[cur_idx]; + log_nodes = pstate->entrance_nodes; + if (next_state != NULL) + { + table_nodes = next_state->entrance_nodes; + *err = re_node_set_init_union (&next_nodes, table_nodes, + log_nodes); + if (BE (*err != REG_NOERROR, 0)) + return NULL; + } + else + next_nodes = *log_nodes; + /* Note: We already add the nodes of the initial state, + then we don't need to add them here. */ + + context = re_string_context_at (&mctx->input, + re_string_cur_idx (&mctx->input) - 1, + mctx->eflags); + next_state = mctx->state_log[cur_idx] + = re_acquire_state_context (err, dfa, &next_nodes, context); + /* We don't need to check errors here, since the return value of + this function is next_state and ERR is already set. */ + + if (table_nodes != NULL) + re_node_set_free (&next_nodes); + } + + if (BE (dfa->nbackref, 0) && next_state != NULL) + { + /* Check OP_OPEN_SUBEXP in the current state in case that we use them + later. We must check them here, since the back references in the + next state might use them. */ + *err = check_subexp_matching_top (mctx, &next_state->nodes, + cur_idx); + if (BE (*err != REG_NOERROR, 0)) + return NULL; + + /* If the next state has back references. */ + if (next_state->has_backref) + { + *err = transit_state_bkref (mctx, &next_state->nodes); + if (BE (*err != REG_NOERROR, 0)) + return NULL; + next_state = mctx->state_log[cur_idx]; + } + } + + return next_state; +} + +/* Skip bytes in the input that correspond to part of a + multi-byte match, then look in the log for a state + from which to restart matching. */ +static re_dfastate_t * +find_recover_state (reg_errcode_t *err, re_match_context_t *mctx) +{ + re_dfastate_t *cur_state; + do + { + Idx max = mctx->state_log_top; + Idx cur_str_idx = re_string_cur_idx (&mctx->input); + + do + { + if (++cur_str_idx > max) + return NULL; + re_string_skip_bytes (&mctx->input, 1); + } + while (mctx->state_log[cur_str_idx] == NULL); + + cur_state = merge_state_with_log (err, mctx, NULL); + } + while (*err == REG_NOERROR && cur_state == NULL); + return cur_state; +} + +/* Helper functions for transit_state. */ + +/* From the node set CUR_NODES, pick up the nodes whose types are + OP_OPEN_SUBEXP and which have corresponding back references in the regular + expression. And register them to use them later for evaluating the + corresponding back references. */ + +static reg_errcode_t +check_subexp_matching_top (re_match_context_t *mctx, re_node_set *cur_nodes, + Idx str_idx) +{ + const re_dfa_t *const dfa = mctx->dfa; + Idx node_idx; + reg_errcode_t err; + + /* TODO: This isn't efficient. + Because there might be more than one nodes whose types are + OP_OPEN_SUBEXP and whose index is SUBEXP_IDX, we must check all + nodes. + E.g. RE: (a){2} */ + for (node_idx = 0; node_idx < cur_nodes->nelem; ++node_idx) + { + Idx node = cur_nodes->elems[node_idx]; + if (dfa->nodes[node].type == OP_OPEN_SUBEXP + && dfa->nodes[node].opr.idx < BITSET_WORD_BITS + && (dfa->used_bkref_map + & ((bitset_word_t) 1 << dfa->nodes[node].opr.idx))) + { + err = match_ctx_add_subtop (mctx, node, str_idx); + if (BE (err != REG_NOERROR, 0)) + return err; + } + } + return REG_NOERROR; +} + +#if 0 +/* Return the next state to which the current state STATE will transit by + accepting the current input byte. */ + +static re_dfastate_t * +transit_state_sb (reg_errcode_t *err, re_match_context_t *mctx, + re_dfastate_t *state) +{ + const re_dfa_t *const dfa = mctx->dfa; + re_node_set next_nodes; + re_dfastate_t *next_state; + Idx node_cnt, cur_str_idx = re_string_cur_idx (&mctx->input); + unsigned int context; + + *err = re_node_set_alloc (&next_nodes, state->nodes.nelem + 1); + if (BE (*err != REG_NOERROR, 0)) + return NULL; + for (node_cnt = 0; node_cnt < state->nodes.nelem; ++node_cnt) + { + Idx cur_node = state->nodes.elems[node_cnt]; + if (check_node_accept (mctx, dfa->nodes + cur_node, cur_str_idx)) + { + *err = re_node_set_merge (&next_nodes, + dfa->eclosures + dfa->nexts[cur_node]); + if (BE (*err != REG_NOERROR, 0)) + { + re_node_set_free (&next_nodes); + return NULL; + } + } + } + context = re_string_context_at (&mctx->input, cur_str_idx, mctx->eflags); + next_state = re_acquire_state_context (err, dfa, &next_nodes, context); + /* We don't need to check errors here, since the return value of + this function is next_state and ERR is already set. */ + + re_node_set_free (&next_nodes); + re_string_skip_bytes (&mctx->input, 1); + return next_state; +} +#endif + +#ifdef RE_ENABLE_I18N +static reg_errcode_t +transit_state_mb (re_match_context_t *mctx, re_dfastate_t *pstate) +{ + const re_dfa_t *const dfa = mctx->dfa; + reg_errcode_t err; + Idx i; + + for (i = 0; i < pstate->nodes.nelem; ++i) + { + re_node_set dest_nodes, *new_nodes; + Idx cur_node_idx = pstate->nodes.elems[i]; + int naccepted; + Idx dest_idx; + unsigned int context; + re_dfastate_t *dest_state; + + if (!dfa->nodes[cur_node_idx].accept_mb) + continue; + + if (dfa->nodes[cur_node_idx].constraint) + { + context = re_string_context_at (&mctx->input, + re_string_cur_idx (&mctx->input), + mctx->eflags); + if (NOT_SATISFY_NEXT_CONSTRAINT (dfa->nodes[cur_node_idx].constraint, + context)) + continue; + } + + /* How many bytes the node can accept? */ + naccepted = check_node_accept_bytes (dfa, cur_node_idx, &mctx->input, + re_string_cur_idx (&mctx->input)); + if (naccepted == 0) + continue; + + /* The node can accepts 'naccepted' bytes. */ + dest_idx = re_string_cur_idx (&mctx->input) + naccepted; + mctx->max_mb_elem_len = ((mctx->max_mb_elem_len < naccepted) ? naccepted + : mctx->max_mb_elem_len); + err = clean_state_log_if_needed (mctx, dest_idx); + if (BE (err != REG_NOERROR, 0)) + return err; +#ifdef DEBUG + assert (dfa->nexts[cur_node_idx] != -1); +#endif + new_nodes = dfa->eclosures + dfa->nexts[cur_node_idx]; + + dest_state = mctx->state_log[dest_idx]; + if (dest_state == NULL) + dest_nodes = *new_nodes; + else + { + err = re_node_set_init_union (&dest_nodes, + dest_state->entrance_nodes, new_nodes); + if (BE (err != REG_NOERROR, 0)) + return err; + } + context = re_string_context_at (&mctx->input, dest_idx - 1, + mctx->eflags); + mctx->state_log[dest_idx] + = re_acquire_state_context (&err, dfa, &dest_nodes, context); + if (dest_state != NULL) + re_node_set_free (&dest_nodes); + if (BE (mctx->state_log[dest_idx] == NULL && err != REG_NOERROR, 0)) + return err; + } + return REG_NOERROR; +} +#endif /* RE_ENABLE_I18N */ + +static reg_errcode_t +transit_state_bkref (re_match_context_t *mctx, const re_node_set *nodes) +{ + const re_dfa_t *const dfa = mctx->dfa; + reg_errcode_t err; + Idx i; + Idx cur_str_idx = re_string_cur_idx (&mctx->input); + + for (i = 0; i < nodes->nelem; ++i) + { + Idx dest_str_idx, prev_nelem, bkc_idx; + Idx node_idx = nodes->elems[i]; + unsigned int context; + const re_token_t *node = dfa->nodes + node_idx; + re_node_set *new_dest_nodes; + + /* Check whether 'node' is a backreference or not. */ + if (node->type != OP_BACK_REF) + continue; + + if (node->constraint) + { + context = re_string_context_at (&mctx->input, cur_str_idx, + mctx->eflags); + if (NOT_SATISFY_NEXT_CONSTRAINT (node->constraint, context)) + continue; + } + + /* 'node' is a backreference. + Check the substring which the substring matched. */ + bkc_idx = mctx->nbkref_ents; + err = get_subexp (mctx, node_idx, cur_str_idx); + if (BE (err != REG_NOERROR, 0)) + goto free_return; + + /* And add the epsilon closures (which is 'new_dest_nodes') of + the backreference to appropriate state_log. */ +#ifdef DEBUG + assert (dfa->nexts[node_idx] != -1); +#endif + for (; bkc_idx < mctx->nbkref_ents; ++bkc_idx) + { + Idx subexp_len; + re_dfastate_t *dest_state; + struct re_backref_cache_entry *bkref_ent; + bkref_ent = mctx->bkref_ents + bkc_idx; + if (bkref_ent->node != node_idx || bkref_ent->str_idx != cur_str_idx) + continue; + subexp_len = bkref_ent->subexp_to - bkref_ent->subexp_from; + new_dest_nodes = (subexp_len == 0 + ? dfa->eclosures + dfa->edests[node_idx].elems[0] + : dfa->eclosures + dfa->nexts[node_idx]); + dest_str_idx = (cur_str_idx + bkref_ent->subexp_to + - bkref_ent->subexp_from); + context = re_string_context_at (&mctx->input, dest_str_idx - 1, + mctx->eflags); + dest_state = mctx->state_log[dest_str_idx]; + prev_nelem = ((mctx->state_log[cur_str_idx] == NULL) ? 0 + : mctx->state_log[cur_str_idx]->nodes.nelem); + /* Add 'new_dest_node' to state_log. */ + if (dest_state == NULL) + { + mctx->state_log[dest_str_idx] + = re_acquire_state_context (&err, dfa, new_dest_nodes, + context); + if (BE (mctx->state_log[dest_str_idx] == NULL + && err != REG_NOERROR, 0)) + goto free_return; + } + else + { + re_node_set dest_nodes; + err = re_node_set_init_union (&dest_nodes, + dest_state->entrance_nodes, + new_dest_nodes); + if (BE (err != REG_NOERROR, 0)) + { + re_node_set_free (&dest_nodes); + goto free_return; + } + mctx->state_log[dest_str_idx] + = re_acquire_state_context (&err, dfa, &dest_nodes, context); + re_node_set_free (&dest_nodes); + if (BE (mctx->state_log[dest_str_idx] == NULL + && err != REG_NOERROR, 0)) + goto free_return; + } + /* We need to check recursively if the backreference can epsilon + transit. */ + if (subexp_len == 0 + && mctx->state_log[cur_str_idx]->nodes.nelem > prev_nelem) + { + err = check_subexp_matching_top (mctx, new_dest_nodes, + cur_str_idx); + if (BE (err != REG_NOERROR, 0)) + goto free_return; + err = transit_state_bkref (mctx, new_dest_nodes); + if (BE (err != REG_NOERROR, 0)) + goto free_return; + } + } + } + err = REG_NOERROR; + free_return: + return err; +} + +/* Enumerate all the candidates which the backreference BKREF_NODE can match + at BKREF_STR_IDX, and register them by match_ctx_add_entry(). + Note that we might collect inappropriate candidates here. + However, the cost of checking them strictly here is too high, then we + delay these checking for prune_impossible_nodes(). */ + +static reg_errcode_t +__attribute_warn_unused_result__ +get_subexp (re_match_context_t *mctx, Idx bkref_node, Idx bkref_str_idx) +{ + const re_dfa_t *const dfa = mctx->dfa; + Idx subexp_num, sub_top_idx; + const char *buf = (const char *) re_string_get_buffer (&mctx->input); + /* Return if we have already checked BKREF_NODE at BKREF_STR_IDX. */ + Idx cache_idx = search_cur_bkref_entry (mctx, bkref_str_idx); + if (cache_idx != -1) + { + const struct re_backref_cache_entry *entry + = mctx->bkref_ents + cache_idx; + do + if (entry->node == bkref_node) + return REG_NOERROR; /* We already checked it. */ + while (entry++->more); + } + + subexp_num = dfa->nodes[bkref_node].opr.idx; + + /* For each sub expression */ + for (sub_top_idx = 0; sub_top_idx < mctx->nsub_tops; ++sub_top_idx) + { + reg_errcode_t err; + re_sub_match_top_t *sub_top = mctx->sub_tops[sub_top_idx]; + re_sub_match_last_t *sub_last; + Idx sub_last_idx, sl_str, bkref_str_off; + + if (dfa->nodes[sub_top->node].opr.idx != subexp_num) + continue; /* It isn't related. */ + + sl_str = sub_top->str_idx; + bkref_str_off = bkref_str_idx; + /* At first, check the last node of sub expressions we already + evaluated. */ + for (sub_last_idx = 0; sub_last_idx < sub_top->nlasts; ++sub_last_idx) + { + regoff_t sl_str_diff; + sub_last = sub_top->lasts[sub_last_idx]; + sl_str_diff = sub_last->str_idx - sl_str; + /* The matched string by the sub expression match with the substring + at the back reference? */ + if (sl_str_diff > 0) + { + if (BE (bkref_str_off + sl_str_diff > mctx->input.valid_len, 0)) + { + /* Not enough chars for a successful match. */ + if (bkref_str_off + sl_str_diff > mctx->input.len) + break; + + err = clean_state_log_if_needed (mctx, + bkref_str_off + + sl_str_diff); + if (BE (err != REG_NOERROR, 0)) + return err; + buf = (const char *) re_string_get_buffer (&mctx->input); + } + if (memcmp (buf + bkref_str_off, buf + sl_str, sl_str_diff) != 0) + /* We don't need to search this sub expression any more. */ + break; + } + bkref_str_off += sl_str_diff; + sl_str += sl_str_diff; + err = get_subexp_sub (mctx, sub_top, sub_last, bkref_node, + bkref_str_idx); + + /* Reload buf, since the preceding call might have reallocated + the buffer. */ + buf = (const char *) re_string_get_buffer (&mctx->input); + + if (err == REG_NOMATCH) + continue; + if (BE (err != REG_NOERROR, 0)) + return err; + } + + if (sub_last_idx < sub_top->nlasts) + continue; + if (sub_last_idx > 0) + ++sl_str; + /* Then, search for the other last nodes of the sub expression. */ + for (; sl_str <= bkref_str_idx; ++sl_str) + { + Idx cls_node; + regoff_t sl_str_off; + const re_node_set *nodes; + sl_str_off = sl_str - sub_top->str_idx; + /* The matched string by the sub expression match with the substring + at the back reference? */ + if (sl_str_off > 0) + { + if (BE (bkref_str_off >= mctx->input.valid_len, 0)) + { + /* If we are at the end of the input, we cannot match. */ + if (bkref_str_off >= mctx->input.len) + break; + + err = extend_buffers (mctx, bkref_str_off + 1); + if (BE (err != REG_NOERROR, 0)) + return err; + + buf = (const char *) re_string_get_buffer (&mctx->input); + } + if (buf [bkref_str_off++] != buf[sl_str - 1]) + break; /* We don't need to search this sub expression + any more. */ + } + if (mctx->state_log[sl_str] == NULL) + continue; + /* Does this state have a ')' of the sub expression? */ + nodes = &mctx->state_log[sl_str]->nodes; + cls_node = find_subexp_node (dfa, nodes, subexp_num, + OP_CLOSE_SUBEXP); + if (cls_node == -1) + continue; /* No. */ + if (sub_top->path == NULL) + { + sub_top->path = calloc (sizeof (state_array_t), + sl_str - sub_top->str_idx + 1); + if (sub_top->path == NULL) + return REG_ESPACE; + } + /* Can the OP_OPEN_SUBEXP node arrive the OP_CLOSE_SUBEXP node + in the current context? */ + err = check_arrival (mctx, sub_top->path, sub_top->node, + sub_top->str_idx, cls_node, sl_str, + OP_CLOSE_SUBEXP); + if (err == REG_NOMATCH) + continue; + if (BE (err != REG_NOERROR, 0)) + return err; + sub_last = match_ctx_add_sublast (sub_top, cls_node, sl_str); + if (BE (sub_last == NULL, 0)) + return REG_ESPACE; + err = get_subexp_sub (mctx, sub_top, sub_last, bkref_node, + bkref_str_idx); + if (err == REG_NOMATCH) + continue; + } + } + return REG_NOERROR; +} + +/* Helper functions for get_subexp(). */ + +/* Check SUB_LAST can arrive to the back reference BKREF_NODE at BKREF_STR. + If it can arrive, register the sub expression expressed with SUB_TOP + and SUB_LAST. */ + +static reg_errcode_t +get_subexp_sub (re_match_context_t *mctx, const re_sub_match_top_t *sub_top, + re_sub_match_last_t *sub_last, Idx bkref_node, Idx bkref_str) +{ + reg_errcode_t err; + Idx to_idx; + /* Can the subexpression arrive the back reference? */ + err = check_arrival (mctx, &sub_last->path, sub_last->node, + sub_last->str_idx, bkref_node, bkref_str, + OP_OPEN_SUBEXP); + if (err != REG_NOERROR) + return err; + err = match_ctx_add_entry (mctx, bkref_node, bkref_str, sub_top->str_idx, + sub_last->str_idx); + if (BE (err != REG_NOERROR, 0)) + return err; + to_idx = bkref_str + sub_last->str_idx - sub_top->str_idx; + return clean_state_log_if_needed (mctx, to_idx); +} + +/* Find the first node which is '(' or ')' and whose index is SUBEXP_IDX. + Search '(' if FL_OPEN, or search ')' otherwise. + TODO: This function isn't efficient... + Because there might be more than one nodes whose types are + OP_OPEN_SUBEXP and whose index is SUBEXP_IDX, we must check all + nodes. + E.g. RE: (a){2} */ + +static Idx +find_subexp_node (const re_dfa_t *dfa, const re_node_set *nodes, + Idx subexp_idx, int type) +{ + Idx cls_idx; + for (cls_idx = 0; cls_idx < nodes->nelem; ++cls_idx) + { + Idx cls_node = nodes->elems[cls_idx]; + const re_token_t *node = dfa->nodes + cls_node; + if (node->type == type + && node->opr.idx == subexp_idx) + return cls_node; + } + return -1; +} + +/* Check whether the node TOP_NODE at TOP_STR can arrive to the node + LAST_NODE at LAST_STR. We record the path onto PATH since it will be + heavily reused. + Return REG_NOERROR if it can arrive, or REG_NOMATCH otherwise. */ + +static reg_errcode_t +__attribute_warn_unused_result__ +check_arrival (re_match_context_t *mctx, state_array_t *path, Idx top_node, + Idx top_str, Idx last_node, Idx last_str, int type) +{ + const re_dfa_t *const dfa = mctx->dfa; + reg_errcode_t err = REG_NOERROR; + Idx subexp_num, backup_cur_idx, str_idx, null_cnt; + re_dfastate_t *cur_state = NULL; + re_node_set *cur_nodes, next_nodes; + re_dfastate_t **backup_state_log; + unsigned int context; + + subexp_num = dfa->nodes[top_node].opr.idx; + /* Extend the buffer if we need. */ + if (BE (path->alloc < last_str + mctx->max_mb_elem_len + 1, 0)) + { + re_dfastate_t **new_array; + Idx old_alloc = path->alloc; + Idx incr_alloc = last_str + mctx->max_mb_elem_len + 1; + Idx new_alloc; + if (BE (IDX_MAX - old_alloc < incr_alloc, 0)) + return REG_ESPACE; + new_alloc = old_alloc + incr_alloc; + if (BE (SIZE_MAX / sizeof (re_dfastate_t *) < new_alloc, 0)) + return REG_ESPACE; + new_array = re_realloc (path->array, re_dfastate_t *, new_alloc); + if (BE (new_array == NULL, 0)) + return REG_ESPACE; + path->array = new_array; + path->alloc = new_alloc; + memset (new_array + old_alloc, '\0', + sizeof (re_dfastate_t *) * (path->alloc - old_alloc)); + } + + str_idx = path->next_idx ? path->next_idx : top_str; + + /* Temporary modify MCTX. */ + backup_state_log = mctx->state_log; + backup_cur_idx = mctx->input.cur_idx; + mctx->state_log = path->array; + mctx->input.cur_idx = str_idx; + + /* Setup initial node set. */ + context = re_string_context_at (&mctx->input, str_idx - 1, mctx->eflags); + if (str_idx == top_str) + { + err = re_node_set_init_1 (&next_nodes, top_node); + if (BE (err != REG_NOERROR, 0)) + return err; + err = check_arrival_expand_ecl (dfa, &next_nodes, subexp_num, type); + if (BE (err != REG_NOERROR, 0)) + { + re_node_set_free (&next_nodes); + return err; + } + } + else + { + cur_state = mctx->state_log[str_idx]; + if (cur_state && cur_state->has_backref) + { + err = re_node_set_init_copy (&next_nodes, &cur_state->nodes); + if (BE (err != REG_NOERROR, 0)) + return err; + } + else + re_node_set_init_empty (&next_nodes); + } + if (str_idx == top_str || (cur_state && cur_state->has_backref)) + { + if (next_nodes.nelem) + { + err = expand_bkref_cache (mctx, &next_nodes, str_idx, + subexp_num, type); + if (BE (err != REG_NOERROR, 0)) + { + re_node_set_free (&next_nodes); + return err; + } + } + cur_state = re_acquire_state_context (&err, dfa, &next_nodes, context); + if (BE (cur_state == NULL && err != REG_NOERROR, 0)) + { + re_node_set_free (&next_nodes); + return err; + } + mctx->state_log[str_idx] = cur_state; + } + + for (null_cnt = 0; str_idx < last_str && null_cnt <= mctx->max_mb_elem_len;) + { + re_node_set_empty (&next_nodes); + if (mctx->state_log[str_idx + 1]) + { + err = re_node_set_merge (&next_nodes, + &mctx->state_log[str_idx + 1]->nodes); + if (BE (err != REG_NOERROR, 0)) + { + re_node_set_free (&next_nodes); + return err; + } + } + if (cur_state) + { + err = check_arrival_add_next_nodes (mctx, str_idx, + &cur_state->non_eps_nodes, + &next_nodes); + if (BE (err != REG_NOERROR, 0)) + { + re_node_set_free (&next_nodes); + return err; + } + } + ++str_idx; + if (next_nodes.nelem) + { + err = check_arrival_expand_ecl (dfa, &next_nodes, subexp_num, type); + if (BE (err != REG_NOERROR, 0)) + { + re_node_set_free (&next_nodes); + return err; + } + err = expand_bkref_cache (mctx, &next_nodes, str_idx, + subexp_num, type); + if (BE (err != REG_NOERROR, 0)) + { + re_node_set_free (&next_nodes); + return err; + } + } + context = re_string_context_at (&mctx->input, str_idx - 1, mctx->eflags); + cur_state = re_acquire_state_context (&err, dfa, &next_nodes, context); + if (BE (cur_state == NULL && err != REG_NOERROR, 0)) + { + re_node_set_free (&next_nodes); + return err; + } + mctx->state_log[str_idx] = cur_state; + null_cnt = cur_state == NULL ? null_cnt + 1 : 0; + } + re_node_set_free (&next_nodes); + cur_nodes = (mctx->state_log[last_str] == NULL ? NULL + : &mctx->state_log[last_str]->nodes); + path->next_idx = str_idx; + + /* Fix MCTX. */ + mctx->state_log = backup_state_log; + mctx->input.cur_idx = backup_cur_idx; + + /* Then check the current node set has the node LAST_NODE. */ + if (cur_nodes != NULL && re_node_set_contains (cur_nodes, last_node)) + return REG_NOERROR; + + return REG_NOMATCH; +} + +/* Helper functions for check_arrival. */ + +/* Calculate the destination nodes of CUR_NODES at STR_IDX, and append them + to NEXT_NODES. + TODO: This function is similar to the functions transit_state*(), + however this function has many additional works. + Can't we unify them? */ + +static reg_errcode_t +__attribute_warn_unused_result__ +check_arrival_add_next_nodes (re_match_context_t *mctx, Idx str_idx, + re_node_set *cur_nodes, re_node_set *next_nodes) +{ + const re_dfa_t *const dfa = mctx->dfa; + bool ok; + Idx cur_idx; +#ifdef RE_ENABLE_I18N + reg_errcode_t err = REG_NOERROR; +#endif + re_node_set union_set; + re_node_set_init_empty (&union_set); + for (cur_idx = 0; cur_idx < cur_nodes->nelem; ++cur_idx) + { + int naccepted = 0; + Idx cur_node = cur_nodes->elems[cur_idx]; +#ifdef DEBUG + re_token_type_t type = dfa->nodes[cur_node].type; + assert (!IS_EPSILON_NODE (type)); +#endif +#ifdef RE_ENABLE_I18N + /* If the node may accept "multi byte". */ + if (dfa->nodes[cur_node].accept_mb) + { + naccepted = check_node_accept_bytes (dfa, cur_node, &mctx->input, + str_idx); + if (naccepted > 1) + { + re_dfastate_t *dest_state; + Idx next_node = dfa->nexts[cur_node]; + Idx next_idx = str_idx + naccepted; + dest_state = mctx->state_log[next_idx]; + re_node_set_empty (&union_set); + if (dest_state) + { + err = re_node_set_merge (&union_set, &dest_state->nodes); + if (BE (err != REG_NOERROR, 0)) + { + re_node_set_free (&union_set); + return err; + } + } + ok = re_node_set_insert (&union_set, next_node); + if (BE (! ok, 0)) + { + re_node_set_free (&union_set); + return REG_ESPACE; + } + mctx->state_log[next_idx] = re_acquire_state (&err, dfa, + &union_set); + if (BE (mctx->state_log[next_idx] == NULL + && err != REG_NOERROR, 0)) + { + re_node_set_free (&union_set); + return err; + } + } + } +#endif /* RE_ENABLE_I18N */ + if (naccepted + || check_node_accept (mctx, dfa->nodes + cur_node, str_idx)) + { + ok = re_node_set_insert (next_nodes, dfa->nexts[cur_node]); + if (BE (! ok, 0)) + { + re_node_set_free (&union_set); + return REG_ESPACE; + } + } + } + re_node_set_free (&union_set); + return REG_NOERROR; +} + +/* For all the nodes in CUR_NODES, add the epsilon closures of them to + CUR_NODES, however exclude the nodes which are: + - inside the sub expression whose number is EX_SUBEXP, if FL_OPEN. + - out of the sub expression whose number is EX_SUBEXP, if !FL_OPEN. +*/ + +static reg_errcode_t +check_arrival_expand_ecl (const re_dfa_t *dfa, re_node_set *cur_nodes, + Idx ex_subexp, int type) +{ + reg_errcode_t err; + Idx idx, outside_node; + re_node_set new_nodes; +#ifdef DEBUG + assert (cur_nodes->nelem); +#endif + err = re_node_set_alloc (&new_nodes, cur_nodes->nelem); + if (BE (err != REG_NOERROR, 0)) + return err; + /* Create a new node set NEW_NODES with the nodes which are epsilon + closures of the node in CUR_NODES. */ + + for (idx = 0; idx < cur_nodes->nelem; ++idx) + { + Idx cur_node = cur_nodes->elems[idx]; + const re_node_set *eclosure = dfa->eclosures + cur_node; + outside_node = find_subexp_node (dfa, eclosure, ex_subexp, type); + if (outside_node == -1) + { + /* There are no problematic nodes, just merge them. */ + err = re_node_set_merge (&new_nodes, eclosure); + if (BE (err != REG_NOERROR, 0)) + { + re_node_set_free (&new_nodes); + return err; + } + } + else + { + /* There are problematic nodes, re-calculate incrementally. */ + err = check_arrival_expand_ecl_sub (dfa, &new_nodes, cur_node, + ex_subexp, type); + if (BE (err != REG_NOERROR, 0)) + { + re_node_set_free (&new_nodes); + return err; + } + } + } + re_node_set_free (cur_nodes); + *cur_nodes = new_nodes; + return REG_NOERROR; +} + +/* Helper function for check_arrival_expand_ecl. + Check incrementally the epsilon closure of TARGET, and if it isn't + problematic append it to DST_NODES. */ + +static reg_errcode_t +__attribute_warn_unused_result__ +check_arrival_expand_ecl_sub (const re_dfa_t *dfa, re_node_set *dst_nodes, + Idx target, Idx ex_subexp, int type) +{ + Idx cur_node; + for (cur_node = target; !re_node_set_contains (dst_nodes, cur_node);) + { + bool ok; + + if (dfa->nodes[cur_node].type == type + && dfa->nodes[cur_node].opr.idx == ex_subexp) + { + if (type == OP_CLOSE_SUBEXP) + { + ok = re_node_set_insert (dst_nodes, cur_node); + if (BE (! ok, 0)) + return REG_ESPACE; + } + break; + } + ok = re_node_set_insert (dst_nodes, cur_node); + if (BE (! ok, 0)) + return REG_ESPACE; + if (dfa->edests[cur_node].nelem == 0) + break; + if (dfa->edests[cur_node].nelem == 2) + { + reg_errcode_t err; + err = check_arrival_expand_ecl_sub (dfa, dst_nodes, + dfa->edests[cur_node].elems[1], + ex_subexp, type); + if (BE (err != REG_NOERROR, 0)) + return err; + } + cur_node = dfa->edests[cur_node].elems[0]; + } + return REG_NOERROR; +} + + +/* For all the back references in the current state, calculate the + destination of the back references by the appropriate entry + in MCTX->BKREF_ENTS. */ + +static reg_errcode_t +__attribute_warn_unused_result__ +expand_bkref_cache (re_match_context_t *mctx, re_node_set *cur_nodes, + Idx cur_str, Idx subexp_num, int type) +{ + const re_dfa_t *const dfa = mctx->dfa; + reg_errcode_t err; + Idx cache_idx_start = search_cur_bkref_entry (mctx, cur_str); + struct re_backref_cache_entry *ent; + + if (cache_idx_start == -1) + return REG_NOERROR; + + restart: + ent = mctx->bkref_ents + cache_idx_start; + do + { + Idx to_idx, next_node; + + /* Is this entry ENT is appropriate? */ + if (!re_node_set_contains (cur_nodes, ent->node)) + continue; /* No. */ + + to_idx = cur_str + ent->subexp_to - ent->subexp_from; + /* Calculate the destination of the back reference, and append it + to MCTX->STATE_LOG. */ + if (to_idx == cur_str) + { + /* The backreference did epsilon transit, we must re-check all the + node in the current state. */ + re_node_set new_dests; + reg_errcode_t err2, err3; + next_node = dfa->edests[ent->node].elems[0]; + if (re_node_set_contains (cur_nodes, next_node)) + continue; + err = re_node_set_init_1 (&new_dests, next_node); + err2 = check_arrival_expand_ecl (dfa, &new_dests, subexp_num, type); + err3 = re_node_set_merge (cur_nodes, &new_dests); + re_node_set_free (&new_dests); + if (BE (err != REG_NOERROR || err2 != REG_NOERROR + || err3 != REG_NOERROR, 0)) + { + err = (err != REG_NOERROR ? err + : (err2 != REG_NOERROR ? err2 : err3)); + return err; + } + /* TODO: It is still inefficient... */ + goto restart; + } + else + { + re_node_set union_set; + next_node = dfa->nexts[ent->node]; + if (mctx->state_log[to_idx]) + { + bool ok; + if (re_node_set_contains (&mctx->state_log[to_idx]->nodes, + next_node)) + continue; + err = re_node_set_init_copy (&union_set, + &mctx->state_log[to_idx]->nodes); + ok = re_node_set_insert (&union_set, next_node); + if (BE (err != REG_NOERROR || ! ok, 0)) + { + re_node_set_free (&union_set); + err = err != REG_NOERROR ? err : REG_ESPACE; + return err; + } + } + else + { + err = re_node_set_init_1 (&union_set, next_node); + if (BE (err != REG_NOERROR, 0)) + return err; + } + mctx->state_log[to_idx] = re_acquire_state (&err, dfa, &union_set); + re_node_set_free (&union_set); + if (BE (mctx->state_log[to_idx] == NULL + && err != REG_NOERROR, 0)) + return err; + } + } + while (ent++->more); + return REG_NOERROR; +} + +/* Build transition table for the state. + Return true if successful. */ + +static bool +build_trtable (const re_dfa_t *dfa, re_dfastate_t *state) +{ + reg_errcode_t err; + Idx i, j; + int ch; + bool need_word_trtable = false; + bitset_word_t elem, mask; + bool dests_node_malloced = false; + bool dest_states_malloced = false; + Idx ndests; /* Number of the destination states from 'state'. */ + re_dfastate_t **trtable; + re_dfastate_t **dest_states = NULL, **dest_states_word, **dest_states_nl; + re_node_set follows, *dests_node; + bitset_t *dests_ch; + bitset_t acceptable; + + struct dests_alloc + { + re_node_set dests_node[SBC_MAX]; + bitset_t dests_ch[SBC_MAX]; + } *dests_alloc; + + /* We build DFA states which corresponds to the destination nodes + from 'state'. 'dests_node[i]' represents the nodes which i-th + destination state contains, and 'dests_ch[i]' represents the + characters which i-th destination state accepts. */ + if (__libc_use_alloca (sizeof (struct dests_alloc))) + dests_alloc = (struct dests_alloc *) alloca (sizeof (struct dests_alloc)); + else + { + dests_alloc = re_malloc (struct dests_alloc, 1); + if (BE (dests_alloc == NULL, 0)) + return false; + dests_node_malloced = true; + } + dests_node = dests_alloc->dests_node; + dests_ch = dests_alloc->dests_ch; + + /* Initialize transition table. */ + state->word_trtable = state->trtable = NULL; + + /* At first, group all nodes belonging to 'state' into several + destinations. */ + ndests = group_nodes_into_DFAstates (dfa, state, dests_node, dests_ch); + if (BE (ndests <= 0, 0)) + { + if (dests_node_malloced) + re_free (dests_alloc); + /* Return false in case of an error, true otherwise. */ + if (ndests == 0) + { + state->trtable = (re_dfastate_t **) + calloc (sizeof (re_dfastate_t *), SBC_MAX); + if (BE (state->trtable == NULL, 0)) + return false; + return true; + } + return false; + } + + err = re_node_set_alloc (&follows, ndests + 1); + if (BE (err != REG_NOERROR, 0)) + goto out_free; + + /* Avoid arithmetic overflow in size calculation. */ + if (BE ((((SIZE_MAX - (sizeof (re_node_set) + sizeof (bitset_t)) * SBC_MAX) + / (3 * sizeof (re_dfastate_t *))) + < ndests), + 0)) + goto out_free; + + if (__libc_use_alloca ((sizeof (re_node_set) + sizeof (bitset_t)) * SBC_MAX + + ndests * 3 * sizeof (re_dfastate_t *))) + dest_states = (re_dfastate_t **) + alloca (ndests * 3 * sizeof (re_dfastate_t *)); + else + { + dest_states = re_malloc (re_dfastate_t *, ndests * 3); + if (BE (dest_states == NULL, 0)) + { +out_free: + if (dest_states_malloced) + re_free (dest_states); + re_node_set_free (&follows); + for (i = 0; i < ndests; ++i) + re_node_set_free (dests_node + i); + if (dests_node_malloced) + re_free (dests_alloc); + return false; + } + dest_states_malloced = true; + } + dest_states_word = dest_states + ndests; + dest_states_nl = dest_states_word + ndests; + bitset_empty (acceptable); + + /* Then build the states for all destinations. */ + for (i = 0; i < ndests; ++i) + { + Idx next_node; + re_node_set_empty (&follows); + /* Merge the follows of this destination states. */ + for (j = 0; j < dests_node[i].nelem; ++j) + { + next_node = dfa->nexts[dests_node[i].elems[j]]; + if (next_node != -1) + { + err = re_node_set_merge (&follows, dfa->eclosures + next_node); + if (BE (err != REG_NOERROR, 0)) + goto out_free; + } + } + dest_states[i] = re_acquire_state_context (&err, dfa, &follows, 0); + if (BE (dest_states[i] == NULL && err != REG_NOERROR, 0)) + goto out_free; + /* If the new state has context constraint, + build appropriate states for these contexts. */ + if (dest_states[i]->has_constraint) + { + dest_states_word[i] = re_acquire_state_context (&err, dfa, &follows, + CONTEXT_WORD); + if (BE (dest_states_word[i] == NULL && err != REG_NOERROR, 0)) + goto out_free; + + if (dest_states[i] != dest_states_word[i] && dfa->mb_cur_max > 1) + need_word_trtable = true; + + dest_states_nl[i] = re_acquire_state_context (&err, dfa, &follows, + CONTEXT_NEWLINE); + if (BE (dest_states_nl[i] == NULL && err != REG_NOERROR, 0)) + goto out_free; + } + else + { + dest_states_word[i] = dest_states[i]; + dest_states_nl[i] = dest_states[i]; + } + bitset_merge (acceptable, dests_ch[i]); + } + + if (!BE (need_word_trtable, 0)) + { + /* We don't care about whether the following character is a word + character, or we are in a single-byte character set so we can + discern by looking at the character code: allocate a + 256-entry transition table. */ + trtable = state->trtable = + (re_dfastate_t **) calloc (sizeof (re_dfastate_t *), SBC_MAX); + if (BE (trtable == NULL, 0)) + goto out_free; + + /* For all characters ch...: */ + for (i = 0; i < BITSET_WORDS; ++i) + for (ch = i * BITSET_WORD_BITS, elem = acceptable[i], mask = 1; + elem; + mask <<= 1, elem >>= 1, ++ch) + if (BE (elem & 1, 0)) + { + /* There must be exactly one destination which accepts + character ch. See group_nodes_into_DFAstates. */ + for (j = 0; (dests_ch[j][i] & mask) == 0; ++j) + ; + + /* j-th destination accepts the word character ch. */ + if (dfa->word_char[i] & mask) + trtable[ch] = dest_states_word[j]; + else + trtable[ch] = dest_states[j]; + } + } + else + { + /* We care about whether the following character is a word + character, and we are in a multi-byte character set: discern + by looking at the character code: build two 256-entry + transition tables, one starting at trtable[0] and one + starting at trtable[SBC_MAX]. */ + trtable = state->word_trtable = + (re_dfastate_t **) calloc (sizeof (re_dfastate_t *), 2 * SBC_MAX); + if (BE (trtable == NULL, 0)) + goto out_free; + + /* For all characters ch...: */ + for (i = 0; i < BITSET_WORDS; ++i) + for (ch = i * BITSET_WORD_BITS, elem = acceptable[i], mask = 1; + elem; + mask <<= 1, elem >>= 1, ++ch) + if (BE (elem & 1, 0)) + { + /* There must be exactly one destination which accepts + character ch. See group_nodes_into_DFAstates. */ + for (j = 0; (dests_ch[j][i] & mask) == 0; ++j) + ; + + /* j-th destination accepts the word character ch. */ + trtable[ch] = dest_states[j]; + trtable[ch + SBC_MAX] = dest_states_word[j]; + } + } + + /* new line */ + if (bitset_contain (acceptable, NEWLINE_CHAR)) + { + /* The current state accepts newline character. */ + for (j = 0; j < ndests; ++j) + if (bitset_contain (dests_ch[j], NEWLINE_CHAR)) + { + /* k-th destination accepts newline character. */ + trtable[NEWLINE_CHAR] = dest_states_nl[j]; + if (need_word_trtable) + trtable[NEWLINE_CHAR + SBC_MAX] = dest_states_nl[j]; + /* There must be only one destination which accepts + newline. See group_nodes_into_DFAstates. */ + break; + } + } + + if (dest_states_malloced) + re_free (dest_states); + + re_node_set_free (&follows); + for (i = 0; i < ndests; ++i) + re_node_set_free (dests_node + i); + + if (dests_node_malloced) + re_free (dests_alloc); + + return true; +} + +/* Group all nodes belonging to STATE into several destinations. + Then for all destinations, set the nodes belonging to the destination + to DESTS_NODE[i] and set the characters accepted by the destination + to DEST_CH[i]. This function return the number of destinations. */ + +static Idx +group_nodes_into_DFAstates (const re_dfa_t *dfa, const re_dfastate_t *state, + re_node_set *dests_node, bitset_t *dests_ch) +{ + reg_errcode_t err; + bool ok; + Idx i, j, k; + Idx ndests; /* Number of the destinations from 'state'. */ + bitset_t accepts; /* Characters a node can accept. */ + const re_node_set *cur_nodes = &state->nodes; + bitset_empty (accepts); + ndests = 0; + + /* For all the nodes belonging to 'state', */ + for (i = 0; i < cur_nodes->nelem; ++i) + { + re_token_t *node = &dfa->nodes[cur_nodes->elems[i]]; + re_token_type_t type = node->type; + unsigned int constraint = node->constraint; + + /* Enumerate all single byte character this node can accept. */ + if (type == CHARACTER) + bitset_set (accepts, node->opr.c); + else if (type == SIMPLE_BRACKET) + { + bitset_merge (accepts, node->opr.sbcset); + } + else if (type == OP_PERIOD) + { +#ifdef RE_ENABLE_I18N + if (dfa->mb_cur_max > 1) + bitset_merge (accepts, dfa->sb_char); + else +#endif + bitset_set_all (accepts); + if (!(dfa->syntax & RE_DOT_NEWLINE)) + bitset_clear (accepts, '\n'); + if (dfa->syntax & RE_DOT_NOT_NULL) + bitset_clear (accepts, '\0'); + } +#ifdef RE_ENABLE_I18N + else if (type == OP_UTF8_PERIOD) + { + if (ASCII_CHARS % BITSET_WORD_BITS == 0) + memset (accepts, -1, ASCII_CHARS / CHAR_BIT); + else + bitset_merge (accepts, utf8_sb_map); + if (!(dfa->syntax & RE_DOT_NEWLINE)) + bitset_clear (accepts, '\n'); + if (dfa->syntax & RE_DOT_NOT_NULL) + bitset_clear (accepts, '\0'); + } +#endif + else + continue; + + /* Check the 'accepts' and sift the characters which are not + match it the context. */ + if (constraint) + { + if (constraint & NEXT_NEWLINE_CONSTRAINT) + { + bool accepts_newline = bitset_contain (accepts, NEWLINE_CHAR); + bitset_empty (accepts); + if (accepts_newline) + bitset_set (accepts, NEWLINE_CHAR); + else + continue; + } + if (constraint & NEXT_ENDBUF_CONSTRAINT) + { + bitset_empty (accepts); + continue; + } + + if (constraint & NEXT_WORD_CONSTRAINT) + { + bitset_word_t any_set = 0; + if (type == CHARACTER && !node->word_char) + { + bitset_empty (accepts); + continue; + } +#ifdef RE_ENABLE_I18N + if (dfa->mb_cur_max > 1) + for (j = 0; j < BITSET_WORDS; ++j) + any_set |= (accepts[j] &= (dfa->word_char[j] | ~dfa->sb_char[j])); + else +#endif + for (j = 0; j < BITSET_WORDS; ++j) + any_set |= (accepts[j] &= dfa->word_char[j]); + if (!any_set) + continue; + } + if (constraint & NEXT_NOTWORD_CONSTRAINT) + { + bitset_word_t any_set = 0; + if (type == CHARACTER && node->word_char) + { + bitset_empty (accepts); + continue; + } +#ifdef RE_ENABLE_I18N + if (dfa->mb_cur_max > 1) + for (j = 0; j < BITSET_WORDS; ++j) + any_set |= (accepts[j] &= ~(dfa->word_char[j] & dfa->sb_char[j])); + else +#endif + for (j = 0; j < BITSET_WORDS; ++j) + any_set |= (accepts[j] &= ~dfa->word_char[j]); + if (!any_set) + continue; + } + } + + /* Then divide 'accepts' into DFA states, or create a new + state. Above, we make sure that accepts is not empty. */ + for (j = 0; j < ndests; ++j) + { + bitset_t intersec; /* Intersection sets, see below. */ + bitset_t remains; + /* Flags, see below. */ + bitset_word_t has_intersec, not_subset, not_consumed; + + /* Optimization, skip if this state doesn't accept the character. */ + if (type == CHARACTER && !bitset_contain (dests_ch[j], node->opr.c)) + continue; + + /* Enumerate the intersection set of this state and 'accepts'. */ + has_intersec = 0; + for (k = 0; k < BITSET_WORDS; ++k) + has_intersec |= intersec[k] = accepts[k] & dests_ch[j][k]; + /* And skip if the intersection set is empty. */ + if (!has_intersec) + continue; + + /* Then check if this state is a subset of 'accepts'. */ + not_subset = not_consumed = 0; + for (k = 0; k < BITSET_WORDS; ++k) + { + not_subset |= remains[k] = ~accepts[k] & dests_ch[j][k]; + not_consumed |= accepts[k] = accepts[k] & ~dests_ch[j][k]; + } + + /* If this state isn't a subset of 'accepts', create a + new group state, which has the 'remains'. */ + if (not_subset) + { + bitset_copy (dests_ch[ndests], remains); + bitset_copy (dests_ch[j], intersec); + err = re_node_set_init_copy (dests_node + ndests, &dests_node[j]); + if (BE (err != REG_NOERROR, 0)) + goto error_return; + ++ndests; + } + + /* Put the position in the current group. */ + ok = re_node_set_insert (&dests_node[j], cur_nodes->elems[i]); + if (BE (! ok, 0)) + goto error_return; + + /* If all characters are consumed, go to next node. */ + if (!not_consumed) + break; + } + /* Some characters remain, create a new group. */ + if (j == ndests) + { + bitset_copy (dests_ch[ndests], accepts); + err = re_node_set_init_1 (dests_node + ndests, cur_nodes->elems[i]); + if (BE (err != REG_NOERROR, 0)) + goto error_return; + ++ndests; + bitset_empty (accepts); + } + } + return ndests; + error_return: + for (j = 0; j < ndests; ++j) + re_node_set_free (dests_node + j); + return -1; +} + +#ifdef RE_ENABLE_I18N +/* Check how many bytes the node 'dfa->nodes[node_idx]' accepts. + Return the number of the bytes the node accepts. + STR_IDX is the current index of the input string. + + This function handles the nodes which can accept one character, or + one collating element like '.', '[a-z]', opposite to the other nodes + can only accept one byte. */ + +# ifdef _LIBC +# include +# endif + +static int +check_node_accept_bytes (const re_dfa_t *dfa, Idx node_idx, + const re_string_t *input, Idx str_idx) +{ + const re_token_t *node = dfa->nodes + node_idx; + int char_len, elem_len; + Idx i; + + if (BE (node->type == OP_UTF8_PERIOD, 0)) + { + unsigned char c = re_string_byte_at (input, str_idx), d; + if (BE (c < 0xc2, 1)) + return 0; + + if (str_idx + 2 > input->len) + return 0; + + d = re_string_byte_at (input, str_idx + 1); + if (c < 0xe0) + return (d < 0x80 || d > 0xbf) ? 0 : 2; + else if (c < 0xf0) + { + char_len = 3; + if (c == 0xe0 && d < 0xa0) + return 0; + } + else if (c < 0xf8) + { + char_len = 4; + if (c == 0xf0 && d < 0x90) + return 0; + } + else if (c < 0xfc) + { + char_len = 5; + if (c == 0xf8 && d < 0x88) + return 0; + } + else if (c < 0xfe) + { + char_len = 6; + if (c == 0xfc && d < 0x84) + return 0; + } + else + return 0; + + if (str_idx + char_len > input->len) + return 0; + + for (i = 1; i < char_len; ++i) + { + d = re_string_byte_at (input, str_idx + i); + if (d < 0x80 || d > 0xbf) + return 0; + } + return char_len; + } + + char_len = re_string_char_size_at (input, str_idx); + if (node->type == OP_PERIOD) + { + if (char_len <= 1) + return 0; + /* FIXME: I don't think this if is needed, as both '\n' + and '\0' are char_len == 1. */ + /* '.' accepts any one character except the following two cases. */ + if ((!(dfa->syntax & RE_DOT_NEWLINE) && + re_string_byte_at (input, str_idx) == '\n') || + ((dfa->syntax & RE_DOT_NOT_NULL) && + re_string_byte_at (input, str_idx) == '\0')) + return 0; + return char_len; + } + + elem_len = re_string_elem_size_at (input, str_idx); + if ((elem_len <= 1 && char_len <= 1) || char_len == 0) + return 0; + + if (node->type == COMPLEX_BRACKET) + { + const re_charset_t *cset = node->opr.mbcset; +# ifdef _LIBC + const unsigned char *pin + = ((const unsigned char *) re_string_get_buffer (input) + str_idx); + Idx j; + uint32_t nrules; +# endif /* _LIBC */ + int match_len = 0; + wchar_t wc = ((cset->nranges || cset->nchar_classes || cset->nmbchars) + ? re_string_wchar_at (input, str_idx) : 0); + + /* match with multibyte character? */ + for (i = 0; i < cset->nmbchars; ++i) + if (wc == cset->mbchars[i]) + { + match_len = char_len; + goto check_node_accept_bytes_match; + } + /* match with character_class? */ + for (i = 0; i < cset->nchar_classes; ++i) + { + wctype_t wt = cset->char_classes[i]; + if (__iswctype (wc, wt)) + { + match_len = char_len; + goto check_node_accept_bytes_match; + } + } + +# ifdef _LIBC + nrules = _NL_CURRENT_WORD (LC_COLLATE, _NL_COLLATE_NRULES); + if (nrules != 0) + { + unsigned int in_collseq = 0; + const int32_t *table, *indirect; + const unsigned char *weights, *extra; + const char *collseqwc; + + /* match with collating_symbol? */ + if (cset->ncoll_syms) + extra = (const unsigned char *) + _NL_CURRENT (LC_COLLATE, _NL_COLLATE_SYMB_EXTRAMB); + for (i = 0; i < cset->ncoll_syms; ++i) + { + const unsigned char *coll_sym = extra + cset->coll_syms[i]; + /* Compare the length of input collating element and + the length of current collating element. */ + if (*coll_sym != elem_len) + continue; + /* Compare each bytes. */ + for (j = 0; j < *coll_sym; j++) + if (pin[j] != coll_sym[1 + j]) + break; + if (j == *coll_sym) + { + /* Match if every bytes is equal. */ + match_len = j; + goto check_node_accept_bytes_match; + } + } + + if (cset->nranges) + { + if (elem_len <= char_len) + { + collseqwc = _NL_CURRENT (LC_COLLATE, _NL_COLLATE_COLLSEQWC); + in_collseq = __collseq_table_lookup (collseqwc, wc); + } + else + in_collseq = find_collation_sequence_value (pin, elem_len); + } + /* match with range expression? */ + /* FIXME: Implement rational ranges here, too. */ + for (i = 0; i < cset->nranges; ++i) + if (cset->range_starts[i] <= in_collseq + && in_collseq <= cset->range_ends[i]) + { + match_len = elem_len; + goto check_node_accept_bytes_match; + } + + /* match with equivalence_class? */ + if (cset->nequiv_classes) + { + const unsigned char *cp = pin; + table = (const int32_t *) + _NL_CURRENT (LC_COLLATE, _NL_COLLATE_TABLEMB); + weights = (const unsigned char *) + _NL_CURRENT (LC_COLLATE, _NL_COLLATE_WEIGHTMB); + extra = (const unsigned char *) + _NL_CURRENT (LC_COLLATE, _NL_COLLATE_EXTRAMB); + indirect = (const int32_t *) + _NL_CURRENT (LC_COLLATE, _NL_COLLATE_INDIRECTMB); + int32_t idx = findidx (table, indirect, extra, &cp, elem_len); + int32_t rule = idx >> 24; + idx &= 0xffffff; + if (idx > 0) + { + size_t weight_len = weights[idx]; + for (i = 0; i < cset->nequiv_classes; ++i) + { + int32_t equiv_class_idx = cset->equiv_classes[i]; + int32_t equiv_class_rule = equiv_class_idx >> 24; + equiv_class_idx &= 0xffffff; + if (weights[equiv_class_idx] == weight_len + && equiv_class_rule == rule + && memcmp (weights + idx + 1, + weights + equiv_class_idx + 1, + weight_len) == 0) + { + match_len = elem_len; + goto check_node_accept_bytes_match; + } + } + } + } + } + else +# endif /* _LIBC */ + { + /* match with range expression? */ + for (i = 0; i < cset->nranges; ++i) + { + if (cset->range_starts[i] <= wc && wc <= cset->range_ends[i]) + { + match_len = char_len; + goto check_node_accept_bytes_match; + } + } + } + check_node_accept_bytes_match: + if (!cset->non_match) + return match_len; + else + { + if (match_len > 0) + return 0; + else + return (elem_len > char_len) ? elem_len : char_len; + } + } + return 0; +} + +# ifdef _LIBC +static unsigned int +find_collation_sequence_value (const unsigned char *mbs, size_t mbs_len) +{ + uint32_t nrules = _NL_CURRENT_WORD (LC_COLLATE, _NL_COLLATE_NRULES); + if (nrules == 0) + { + if (mbs_len == 1) + { + /* No valid character. Match it as a single byte character. */ + const unsigned char *collseq = (const unsigned char *) + _NL_CURRENT (LC_COLLATE, _NL_COLLATE_COLLSEQMB); + return collseq[mbs[0]]; + } + return UINT_MAX; + } + else + { + int32_t idx; + const unsigned char *extra = (const unsigned char *) + _NL_CURRENT (LC_COLLATE, _NL_COLLATE_SYMB_EXTRAMB); + int32_t extrasize = (const unsigned char *) + _NL_CURRENT (LC_COLLATE, _NL_COLLATE_SYMB_EXTRAMB + 1) - extra; + + for (idx = 0; idx < extrasize;) + { + int mbs_cnt; + bool found = false; + int32_t elem_mbs_len; + /* Skip the name of collating element name. */ + idx = idx + extra[idx] + 1; + elem_mbs_len = extra[idx++]; + if (mbs_len == elem_mbs_len) + { + for (mbs_cnt = 0; mbs_cnt < elem_mbs_len; ++mbs_cnt) + if (extra[idx + mbs_cnt] != mbs[mbs_cnt]) + break; + if (mbs_cnt == elem_mbs_len) + /* Found the entry. */ + found = true; + } + /* Skip the byte sequence of the collating element. */ + idx += elem_mbs_len; + /* Adjust for the alignment. */ + idx = (idx + 3) & ~3; + /* Skip the collation sequence value. */ + idx += sizeof (uint32_t); + /* Skip the wide char sequence of the collating element. */ + idx = idx + sizeof (uint32_t) * (*(int32_t *) (extra + idx) + 1); + /* If we found the entry, return the sequence value. */ + if (found) + return *(uint32_t *) (extra + idx); + /* Skip the collation sequence value. */ + idx += sizeof (uint32_t); + } + return UINT_MAX; + } +} +# endif /* _LIBC */ +#endif /* RE_ENABLE_I18N */ + +/* Check whether the node accepts the byte which is IDX-th + byte of the INPUT. */ + +static bool +check_node_accept (const re_match_context_t *mctx, const re_token_t *node, + Idx idx) +{ + unsigned char ch; + ch = re_string_byte_at (&mctx->input, idx); + switch (node->type) + { + case CHARACTER: + if (node->opr.c != ch) + return false; + break; + + case SIMPLE_BRACKET: + if (!bitset_contain (node->opr.sbcset, ch)) + return false; + break; + +#ifdef RE_ENABLE_I18N + case OP_UTF8_PERIOD: + if (ch >= ASCII_CHARS) + return false; + FALLTHROUGH; +#endif + case OP_PERIOD: + if ((ch == '\n' && !(mctx->dfa->syntax & RE_DOT_NEWLINE)) + || (ch == '\0' && (mctx->dfa->syntax & RE_DOT_NOT_NULL))) + return false; + break; + + default: + return false; + } + + if (node->constraint) + { + /* The node has constraints. Check whether the current context + satisfies the constraints. */ + unsigned int context = re_string_context_at (&mctx->input, idx, + mctx->eflags); + if (NOT_SATISFY_NEXT_CONSTRAINT (node->constraint, context)) + return false; + } + + return true; +} + +/* Extend the buffers, if the buffers have run out. */ + +static reg_errcode_t +__attribute_warn_unused_result__ +extend_buffers (re_match_context_t *mctx, int min_len) +{ + reg_errcode_t ret; + re_string_t *pstr = &mctx->input; + + /* Avoid overflow. */ + if (BE (MIN (IDX_MAX, SIZE_MAX / sizeof (re_dfastate_t *)) / 2 + <= pstr->bufs_len, 0)) + return REG_ESPACE; + + /* Double the lengths of the buffers, but allocate at least MIN_LEN. */ + ret = re_string_realloc_buffers (pstr, + MAX (min_len, + MIN (pstr->len, pstr->bufs_len * 2))); + if (BE (ret != REG_NOERROR, 0)) + return ret; + + if (mctx->state_log != NULL) + { + /* And double the length of state_log. */ + /* XXX We have no indication of the size of this buffer. If this + allocation fail we have no indication that the state_log array + does not have the right size. */ + re_dfastate_t **new_array = re_realloc (mctx->state_log, re_dfastate_t *, + pstr->bufs_len + 1); + if (BE (new_array == NULL, 0)) + return REG_ESPACE; + mctx->state_log = new_array; + } + + /* Then reconstruct the buffers. */ + if (pstr->icase) + { +#ifdef RE_ENABLE_I18N + if (pstr->mb_cur_max > 1) + { + ret = build_wcs_upper_buffer (pstr); + if (BE (ret != REG_NOERROR, 0)) + return ret; + } + else +#endif /* RE_ENABLE_I18N */ + build_upper_buffer (pstr); + } + else + { +#ifdef RE_ENABLE_I18N + if (pstr->mb_cur_max > 1) + build_wcs_buffer (pstr); + else +#endif /* RE_ENABLE_I18N */ + { + if (pstr->trans != NULL) + re_string_translate_buffer (pstr); + } + } + return REG_NOERROR; +} + + +/* Functions for matching context. */ + +/* Initialize MCTX. */ + +static reg_errcode_t +__attribute_warn_unused_result__ +match_ctx_init (re_match_context_t *mctx, int eflags, Idx n) +{ + mctx->eflags = eflags; + mctx->match_last = -1; + if (n > 0) + { + /* Avoid overflow. */ + size_t max_object_size = + MAX (sizeof (struct re_backref_cache_entry), + sizeof (re_sub_match_top_t *)); + if (BE (MIN (IDX_MAX, SIZE_MAX / max_object_size) < n, 0)) + return REG_ESPACE; + + mctx->bkref_ents = re_malloc (struct re_backref_cache_entry, n); + mctx->sub_tops = re_malloc (re_sub_match_top_t *, n); + if (BE (mctx->bkref_ents == NULL || mctx->sub_tops == NULL, 0)) + return REG_ESPACE; + } + /* Already zero-ed by the caller. + else + mctx->bkref_ents = NULL; + mctx->nbkref_ents = 0; + mctx->nsub_tops = 0; */ + mctx->abkref_ents = n; + mctx->max_mb_elem_len = 1; + mctx->asub_tops = n; + return REG_NOERROR; +} + +/* Clean the entries which depend on the current input in MCTX. + This function must be invoked when the matcher changes the start index + of the input, or changes the input string. */ + +static void +match_ctx_clean (re_match_context_t *mctx) +{ + Idx st_idx; + for (st_idx = 0; st_idx < mctx->nsub_tops; ++st_idx) + { + Idx sl_idx; + re_sub_match_top_t *top = mctx->sub_tops[st_idx]; + for (sl_idx = 0; sl_idx < top->nlasts; ++sl_idx) + { + re_sub_match_last_t *last = top->lasts[sl_idx]; + re_free (last->path.array); + re_free (last); + } + re_free (top->lasts); + if (top->path) + { + re_free (top->path->array); + re_free (top->path); + } + re_free (top); + } + + mctx->nsub_tops = 0; + mctx->nbkref_ents = 0; +} + +/* Free all the memory associated with MCTX. */ + +static void +match_ctx_free (re_match_context_t *mctx) +{ + /* First, free all the memory associated with MCTX->SUB_TOPS. */ + match_ctx_clean (mctx); + re_free (mctx->sub_tops); + re_free (mctx->bkref_ents); +} + +/* Add a new backreference entry to MCTX. + Note that we assume that caller never call this function with duplicate + entry, and call with STR_IDX which isn't smaller than any existing entry. +*/ + +static reg_errcode_t +__attribute_warn_unused_result__ +match_ctx_add_entry (re_match_context_t *mctx, Idx node, Idx str_idx, Idx from, + Idx to) +{ + if (mctx->nbkref_ents >= mctx->abkref_ents) + { + struct re_backref_cache_entry* new_entry; + new_entry = re_realloc (mctx->bkref_ents, struct re_backref_cache_entry, + mctx->abkref_ents * 2); + if (BE (new_entry == NULL, 0)) + { + re_free (mctx->bkref_ents); + return REG_ESPACE; + } + mctx->bkref_ents = new_entry; + memset (mctx->bkref_ents + mctx->nbkref_ents, '\0', + sizeof (struct re_backref_cache_entry) * mctx->abkref_ents); + mctx->abkref_ents *= 2; + } + if (mctx->nbkref_ents > 0 + && mctx->bkref_ents[mctx->nbkref_ents - 1].str_idx == str_idx) + mctx->bkref_ents[mctx->nbkref_ents - 1].more = 1; + + mctx->bkref_ents[mctx->nbkref_ents].node = node; + mctx->bkref_ents[mctx->nbkref_ents].str_idx = str_idx; + mctx->bkref_ents[mctx->nbkref_ents].subexp_from = from; + mctx->bkref_ents[mctx->nbkref_ents].subexp_to = to; + + /* This is a cache that saves negative results of check_dst_limits_calc_pos. + If bit N is clear, means that this entry won't epsilon-transition to + an OP_OPEN_SUBEXP or OP_CLOSE_SUBEXP for the N+1-th subexpression. If + it is set, check_dst_limits_calc_pos_1 will recurse and try to find one + such node. + + A backreference does not epsilon-transition unless it is empty, so set + to all zeros if FROM != TO. */ + mctx->bkref_ents[mctx->nbkref_ents].eps_reachable_subexps_map + = (from == to ? -1 : 0); + + mctx->bkref_ents[mctx->nbkref_ents++].more = 0; + if (mctx->max_mb_elem_len < to - from) + mctx->max_mb_elem_len = to - from; + return REG_NOERROR; +} + +/* Return the first entry with the same str_idx, or -1 if none is + found. Note that MCTX->BKREF_ENTS is already sorted by MCTX->STR_IDX. */ + +static Idx +search_cur_bkref_entry (const re_match_context_t *mctx, Idx str_idx) +{ + Idx left, right, mid, last; + last = right = mctx->nbkref_ents; + for (left = 0; left < right;) + { + mid = (left + right) / 2; + if (mctx->bkref_ents[mid].str_idx < str_idx) + left = mid + 1; + else + right = mid; + } + if (left < last && mctx->bkref_ents[left].str_idx == str_idx) + return left; + else + return -1; +} + +/* Register the node NODE, whose type is OP_OPEN_SUBEXP, and which matches + at STR_IDX. */ + +static reg_errcode_t +__attribute_warn_unused_result__ +match_ctx_add_subtop (re_match_context_t *mctx, Idx node, Idx str_idx) +{ +#ifdef DEBUG + assert (mctx->sub_tops != NULL); + assert (mctx->asub_tops > 0); +#endif + if (BE (mctx->nsub_tops == mctx->asub_tops, 0)) + { + Idx new_asub_tops = mctx->asub_tops * 2; + re_sub_match_top_t **new_array = re_realloc (mctx->sub_tops, + re_sub_match_top_t *, + new_asub_tops); + if (BE (new_array == NULL, 0)) + return REG_ESPACE; + mctx->sub_tops = new_array; + mctx->asub_tops = new_asub_tops; + } + mctx->sub_tops[mctx->nsub_tops] = calloc (1, sizeof (re_sub_match_top_t)); + if (BE (mctx->sub_tops[mctx->nsub_tops] == NULL, 0)) + return REG_ESPACE; + mctx->sub_tops[mctx->nsub_tops]->node = node; + mctx->sub_tops[mctx->nsub_tops++]->str_idx = str_idx; + return REG_NOERROR; +} + +/* Register the node NODE, whose type is OP_CLOSE_SUBEXP, and which matches + at STR_IDX, whose corresponding OP_OPEN_SUBEXP is SUB_TOP. */ + +static re_sub_match_last_t * +match_ctx_add_sublast (re_sub_match_top_t *subtop, Idx node, Idx str_idx) +{ + re_sub_match_last_t *new_entry; + if (BE (subtop->nlasts == subtop->alasts, 0)) + { + Idx new_alasts = 2 * subtop->alasts + 1; + re_sub_match_last_t **new_array = re_realloc (subtop->lasts, + re_sub_match_last_t *, + new_alasts); + if (BE (new_array == NULL, 0)) + return NULL; + subtop->lasts = new_array; + subtop->alasts = new_alasts; + } + new_entry = calloc (1, sizeof (re_sub_match_last_t)); + if (BE (new_entry != NULL, 1)) + { + subtop->lasts[subtop->nlasts] = new_entry; + new_entry->node = node; + new_entry->str_idx = str_idx; + ++subtop->nlasts; + } + return new_entry; +} + +static void +sift_ctx_init (re_sift_context_t *sctx, re_dfastate_t **sifted_sts, + re_dfastate_t **limited_sts, Idx last_node, Idx last_str_idx) +{ + sctx->sifted_states = sifted_sts; + sctx->limited_states = limited_sts; + sctx->last_node = last_node; + sctx->last_str_idx = last_str_idx; + re_node_set_init_empty (&sctx->limits); +} diff --git a/m4/builtin-expect.m4 b/m4/builtin-expect.m4 new file mode 100644 index 0000000000..a1eaf965b4 --- /dev/null +++ b/m4/builtin-expect.m4 @@ -0,0 +1,49 @@ +dnl Check for __builtin_expect. + +dnl Copyright 2016-2018 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +dnl Written by Paul Eggert. + +AC_DEFUN([gl___BUILTIN_EXPECT], +[ + AC_CACHE_CHECK([for __builtin_expect], + [gl_cv___builtin_expect], + [AC_LINK_IFELSE( + [AC_LANG_SOURCE([[ + int + main (int argc, char **argv) + { + argc = __builtin_expect (argc, 100); + return argv[argc != 100][0]; + }]])], + [gl_cv___builtin_expect=yes], + [AC_LINK_IFELSE( + [AC_LANG_SOURCE([[ + #include + int + main (int argc, char **argv) + { + argc = __builtin_expect (argc, 100); + return argv[argc != 100][0]; + }]])], + [gl_cv___builtin_expect="in "], + [gl_cv___builtin_expect=no])])]) + if test "$gl_cv___builtin_expect" = yes; then + AC_DEFINE([HAVE___BUILTIN_EXPECT], [1]) + elif test "$gl_cv___builtin_expect" = "in "; then + AC_DEFINE([HAVE___BUILTIN_EXPECT], [2]) + fi + AH_VERBATIM([HAVE___BUILTIN_EXPECT], + [/* Define to 1 if the compiler supports __builtin_expect, + and to 2 if does. */ +#undef HAVE___BUILTIN_EXPECT +#ifndef HAVE___BUILTIN_EXPECT +# define __builtin_expect(e, c) (e) +#elif HAVE___BUILTIN_EXPECT == 2 +# include +#endif + ]) +]) diff --git a/m4/eealloc.m4 b/m4/eealloc.m4 new file mode 100644 index 0000000000..a5a4e267d8 --- /dev/null +++ b/m4/eealloc.m4 @@ -0,0 +1,31 @@ +# eealloc.m4 serial 3 +dnl Copyright (C) 2003, 2009-2018 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +AC_DEFUN([gl_EEALLOC], +[ + AC_REQUIRE([gl_EEMALLOC]) + AC_REQUIRE([gl_EEREALLOC]) +]) + +AC_DEFUN([gl_EEMALLOC], +[ + _AC_FUNC_MALLOC_IF( + [gl_cv_func_malloc_0_nonnull=1], + [gl_cv_func_malloc_0_nonnull=0]) + AC_DEFINE_UNQUOTED([MALLOC_0_IS_NONNULL], [$gl_cv_func_malloc_0_nonnull], + [If malloc(0) is != NULL, define this to 1. Otherwise define this + to 0.]) +]) + +AC_DEFUN([gl_EEREALLOC], +[ + _AC_FUNC_REALLOC_IF( + [gl_cv_func_realloc_0_nonnull=1], + [gl_cv_func_realloc_0_nonnull=0]) + AC_DEFINE_UNQUOTED([REALLOC_0_IS_NONNULL], [$gl_cv_func_realloc_0_nonnull], + [If realloc(NULL,0) is != NULL, define this to 1. Otherwise define this + to 0.]) +]) diff --git a/m4/glibc21.m4 b/m4/glibc21.m4 new file mode 100644 index 0000000000..126aa1a959 --- /dev/null +++ b/m4/glibc21.m4 @@ -0,0 +1,34 @@ +# glibc21.m4 serial 5 +dnl Copyright (C) 2000-2002, 2004, 2008, 2010-2018 Free Software Foundation, +dnl Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +# Test for the GNU C Library, version 2.1 or newer, or uClibc. +# From Bruno Haible. + +AC_DEFUN([gl_GLIBC21], + [ + AC_CACHE_CHECK([whether we are using the GNU C Library >= 2.1 or uClibc], + [ac_cv_gnu_library_2_1], + [AC_EGREP_CPP([Lucky], + [ +#include +#ifdef __GNU_LIBRARY__ + #if (__GLIBC__ == 2 && __GLIBC_MINOR__ >= 1) || (__GLIBC__ > 2) + Lucky GNU user + #endif +#endif +#ifdef __UCLIBC__ + Lucky user +#endif + ], + [ac_cv_gnu_library_2_1=yes], + [ac_cv_gnu_library_2_1=no]) + ] + ) + AC_SUBST([GLIBC21]) + GLIBC21="$ac_cv_gnu_library_2_1" + ] +) diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 494c77c7c4..61aabaa342 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -48,6 +48,7 @@ AC_DEFUN([gl_EARLY], # Code from module allocator: # Code from module at-internal: # Code from module binary-io: + # Code from module builtin-expect: # Code from module byteswap: # Code from module c-ctype: # Code from module c-strcase: @@ -129,6 +130,7 @@ AC_DEFUN([gl_EARLY], # Code from module qcopy-acl: # Code from module readlink: # Code from module readlinkat: + # Code from module regex: # Code from module root-uid: # Code from module sig2str: # Code from module signal-h: @@ -358,6 +360,11 @@ AC_DEFUN([gl_INIT], AC_LIBOBJ([readlinkat]) fi gl_UNISTD_MODULE_INDICATOR([readlinkat]) + gl_REGEX + if test $ac_use_included_regex = yes; then + AC_LIBOBJ([regex]) + gl_PREREQ_REGEX + fi gl_FUNC_SIG2STR if test $ac_cv_func_sig2str = no; then AC_LIBOBJ([sig2str]) @@ -425,6 +432,7 @@ AC_DEFUN([gl_INIT], gl_UTIMENS AC_C_VARARRAYS gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b=false + gl_gnulib_enabled_37f71b604aa9c54446783d80f42fe547=false gl_gnulib_enabled_cloexec=false gl_gnulib_enabled_dirfd=false gl_gnulib_enabled_dosname=false @@ -448,6 +456,13 @@ AC_DEFUN([gl_INIT], func_gl_gnulib_m4code_open fi } + func_gl_gnulib_m4code_37f71b604aa9c54446783d80f42fe547 () + { + if ! $gl_gnulib_enabled_37f71b604aa9c54446783d80f42fe547; then + gl___BUILTIN_EXPECT + gl_gnulib_enabled_37f71b604aa9c54446783d80f42fe547=true + fi + } func_gl_gnulib_m4code_cloexec () { if ! $gl_gnulib_enabled_cloexec; then @@ -651,6 +666,9 @@ AC_DEFUN([gl_INIT], if test $HAVE_READLINKAT = 0; then func_gl_gnulib_m4code_03e0aaad4cb89ca757653bd367a6ccb7 fi + if test $ac_use_included_regex = yes; then + func_gl_gnulib_m4code_37f71b604aa9c54446783d80f42fe547 + fi if { test $HAVE_DECL_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; } && test $ac_cv_type_long_long_int = yes; then func_gl_gnulib_m4code_strtoll fi @@ -659,6 +677,7 @@ AC_DEFUN([gl_INIT], fi m4_pattern_allow([^gl_GNULIB_ENABLED_]) AM_CONDITIONAL([gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b], [$gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b]) + AM_CONDITIONAL([gl_GNULIB_ENABLED_37f71b604aa9c54446783d80f42fe547], [$gl_gnulib_enabled_37f71b604aa9c54446783d80f42fe547]) AM_CONDITIONAL([gl_GNULIB_ENABLED_cloexec], [$gl_gnulib_enabled_cloexec]) AM_CONDITIONAL([gl_GNULIB_ENABLED_dirfd], [$gl_gnulib_enabled_dirfd]) AM_CONDITIONAL([gl_GNULIB_ENABLED_dosname], [$gl_gnulib_enabled_dosname]) @@ -924,6 +943,12 @@ AC_DEFUN([gl_FILE_LIST], [ lib/qcopy-acl.c lib/readlink.c lib/readlinkat.c + lib/regcomp.c + lib/regex.c + lib/regex.h + lib/regex_internal.c + lib/regex_internal.h + lib/regexec.c lib/root-uid.h lib/set-permissions.c lib/sha1.c @@ -980,6 +1005,7 @@ AC_DEFUN([gl_FILE_LIST], [ m4/absolute-header.m4 m4/acl.m4 m4/alloca.m4 + m4/builtin-expect.m4 m4/byteswap.m4 m4/c-strtod.m4 m4/clock_time.m4 @@ -991,6 +1017,7 @@ AC_DEFUN([gl_FILE_LIST], [ m4/dirent_h.m4 m4/dirfd.m4 m4/dup2.m4 + m4/eealloc.m4 m4/environ.m4 m4/errno_h.m4 m4/euidaccess.m4 @@ -1018,6 +1045,7 @@ AC_DEFUN([gl_FILE_LIST], [ m4/gettime.m4 m4/gettimeofday.m4 m4/gl-openssl.m4 + m4/glibc21.m4 m4/gnulib-common.m4 m4/group-member.m4 m4/ieee754-h.m4 @@ -1030,6 +1058,7 @@ AC_DEFUN([gl_FILE_LIST], [ m4/lstat.m4 m4/manywarnings-c++.m4 m4/manywarnings.m4 + m4/mbstate_t.m4 m4/md5.m4 m4/memrchr.m4 m4/minmax.m4 @@ -1048,6 +1077,7 @@ AC_DEFUN([gl_FILE_LIST], [ m4/putenv.m4 m4/readlink.m4 m4/readlinkat.m4 + m4/regex.m4 m4/sha1.m4 m4/sha256.m4 m4/sha512.m4 diff --git a/m4/mbstate_t.m4 b/m4/mbstate_t.m4 new file mode 100644 index 0000000000..004aa0d17c --- /dev/null +++ b/m4/mbstate_t.m4 @@ -0,0 +1,41 @@ +# mbstate_t.m4 serial 13 +dnl Copyright (C) 2000-2002, 2008-2018 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +# From Paul Eggert. + +# BeOS 5 has but does not define mbstate_t, +# so you can't declare an object of that type. +# Check for this incompatibility with Standard C. + +# AC_TYPE_MBSTATE_T +# ----------------- +AC_DEFUN([AC_TYPE_MBSTATE_T], +[ + AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS]) dnl for HP-UX 11.11 + + AC_CACHE_CHECK([for mbstate_t], [ac_cv_type_mbstate_t], + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [AC_INCLUDES_DEFAULT[ +/* Tru64 with Desktop Toolkit C has a bug: must be included before + . + BSD/OS 4.0.1 has a bug: , and must be + included before . */ +#include +#include +#include +#include ]], + [[mbstate_t x; return sizeof x;]])], + [ac_cv_type_mbstate_t=yes], + [ac_cv_type_mbstate_t=no])]) + if test $ac_cv_type_mbstate_t = yes; then + AC_DEFINE([HAVE_MBSTATE_T], [1], + [Define to 1 if declares mbstate_t.]) + else + AC_DEFINE([mbstate_t], [int], + [Define to a type if does not define.]) + fi +]) diff --git a/m4/regex.m4 b/m4/regex.m4 new file mode 100644 index 0000000000..055d71b5aa --- /dev/null +++ b/m4/regex.m4 @@ -0,0 +1,300 @@ +# serial 67 + +# Copyright (C) 1996-2001, 2003-2018 Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +dnl Initially derived from code in GNU grep. +dnl Mostly written by Jim Meyering. + +AC_PREREQ([2.50]) + +AC_DEFUN([gl_REGEX], +[ + AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles + AC_ARG_WITH([included-regex], + [AS_HELP_STRING([--without-included-regex], + [don't compile regex; this is the default on systems + with recent-enough versions of the GNU C Library + (use with caution on other systems).])]) + + case $with_included_regex in #( + yes|no) ac_use_included_regex=$with_included_regex + ;; + '') + # If the system regex support is good enough that it passes the + # following run test, then default to *not* using the included regex.c. + # If cross compiling, assume the test would fail and use the included + # regex.c. + AC_CHECK_DECLS_ONCE([alarm]) + AC_CHECK_HEADERS_ONCE([malloc.h]) + AC_CACHE_CHECK([for working re_compile_pattern], + [gl_cv_func_re_compile_pattern_working], + [AC_RUN_IFELSE( + [AC_LANG_PROGRAM( + [[#include + + #include + #include + #include + + #if defined M_CHECK_ACTION || HAVE_DECL_ALARM + # include + # include + #endif + + #if HAVE_MALLOC_H + # include + #endif + + #ifdef M_CHECK_ACTION + /* Exit with distinguishable exit code. */ + static void sigabrt_no_core (int sig) { raise (SIGTERM); } + #endif + ]], + [[int result = 0; + static struct re_pattern_buffer regex; + unsigned char folded_chars[UCHAR_MAX + 1]; + int i; + const char *s; + struct re_registers regs; + + /* Some builds of glibc go into an infinite loop on this + test. Use alarm to force death, and mallopt to avoid + malloc recursion in diagnosing the corrupted heap. */ +#if HAVE_DECL_ALARM + signal (SIGALRM, SIG_DFL); + alarm (2); +#endif +#ifdef M_CHECK_ACTION + signal (SIGABRT, sigabrt_no_core); + mallopt (M_CHECK_ACTION, 2); +#endif + + if (setlocale (LC_ALL, "en_US.UTF-8")) + { + { + /* https://sourceware.org/ml/libc-hacker/2006-09/msg00008.html + This test needs valgrind to catch the bug on Debian + GNU/Linux 3.1 x86, but it might catch the bug better + on other platforms and it shouldn't hurt to try the + test here. */ + static char const pat[] = "insert into"; + static char const data[] = + "\xFF\0\x12\xA2\xAA\xC4\xB1,K\x12\xC4\xB1*\xACK"; + re_set_syntax (RE_SYNTAX_GREP | RE_HAT_LISTS_NOT_NEWLINE + | RE_ICASE); + memset (®ex, 0, sizeof regex); + s = re_compile_pattern (pat, sizeof pat - 1, ®ex); + if (s) + result |= 1; + else if (re_search (®ex, data, sizeof data - 1, + 0, sizeof data - 1, ®s) + != -1) + result |= 1; + regfree (®ex); + } + + { + /* This test is from glibc bug 15078. + The test case is from Andreas Schwab in + . + */ + static char const pat[] = "[^x]x"; + static char const data[] = + /* */ + "\xe1\x80\x80" + "\xe1\x80\xbb" + "\xe1\x80\xbd" + "\xe1\x80\x94" + "\xe1\x80\xba" + "\xe1\x80\xaf" + "\xe1\x80\x95" + "\xe1\x80\xba" + "x"; + re_set_syntax (0); + memset (®ex, 0, sizeof regex); + s = re_compile_pattern (pat, sizeof pat - 1, ®ex); + if (s) + result |= 1; + else + { + i = re_search (®ex, data, sizeof data - 1, + 0, sizeof data - 1, 0); + if (i != 0 && i != 21) + result |= 1; + } + regfree (®ex); + } + + if (! setlocale (LC_ALL, "C")) + return 1; + } + + /* This test is from glibc bug 3957, reported by Andrew Mackey. */ + re_set_syntax (RE_SYNTAX_EGREP | RE_HAT_LISTS_NOT_NEWLINE); + memset (®ex, 0, sizeof regex); + s = re_compile_pattern ("a[^x]b", 6, ®ex); + if (s) + result |= 2; + /* This should fail, but succeeds for glibc-2.5. */ + else if (re_search (®ex, "a\nb", 3, 0, 3, ®s) != -1) + result |= 2; + + /* This regular expression is from Spencer ere test number 75 + in grep-2.3. */ + re_set_syntax (RE_SYNTAX_POSIX_EGREP); + memset (®ex, 0, sizeof regex); + for (i = 0; i <= UCHAR_MAX; i++) + folded_chars[i] = i; + regex.translate = folded_chars; + s = re_compile_pattern ("a[[:@:>@:]]b\n", 11, ®ex); + /* This should fail with _Invalid character class name_ error. */ + if (!s) + result |= 4; + + /* Ensure that [b-a] is diagnosed as invalid, when + using RE_NO_EMPTY_RANGES. */ + re_set_syntax (RE_SYNTAX_POSIX_EGREP | RE_NO_EMPTY_RANGES); + memset (®ex, 0, sizeof regex); + s = re_compile_pattern ("a[b-a]", 6, ®ex); + if (s == 0) + result |= 8; + + /* This should succeed, but does not for glibc-2.1.3. */ + memset (®ex, 0, sizeof regex); + s = re_compile_pattern ("{1", 2, ®ex); + if (s) + result |= 8; + + /* The following example is derived from a problem report + against gawk from Jorge Stolfi . */ + memset (®ex, 0, sizeof regex); + s = re_compile_pattern ("[an\371]*n", 7, ®ex); + if (s) + result |= 8; + /* This should match, but does not for glibc-2.2.1. */ + else if (re_match (®ex, "an", 2, 0, ®s) != 2) + result |= 8; + + memset (®ex, 0, sizeof regex); + s = re_compile_pattern ("x", 1, ®ex); + if (s) + result |= 8; + /* glibc-2.2.93 does not work with a negative RANGE argument. */ + else if (re_search (®ex, "wxy", 3, 2, -2, ®s) != 1) + result |= 8; + + /* The version of regex.c in older versions of gnulib + ignored RE_ICASE. Detect that problem too. */ + re_set_syntax (RE_SYNTAX_EMACS | RE_ICASE); + memset (®ex, 0, sizeof regex); + s = re_compile_pattern ("x", 1, ®ex); + if (s) + result |= 16; + else if (re_search (®ex, "WXY", 3, 0, 3, ®s) < 0) + result |= 16; + + /* Catch a bug reported by Vin Shelton in + https://lists.gnu.org/r/bug-coreutils/2007-06/msg00089.html + */ + re_set_syntax (RE_SYNTAX_POSIX_BASIC + & ~RE_CONTEXT_INVALID_DUP + & ~RE_NO_EMPTY_RANGES); + memset (®ex, 0, sizeof regex); + s = re_compile_pattern ("[[:alnum:]_-]\\\\+$", 16, ®ex); + if (s) + result |= 32; + + /* REG_STARTEND was added to glibc on 2004-01-15. + Reject older versions. */ + if (! REG_STARTEND) + result |= 64; + +#if 0 + /* It would be nice to reject hosts whose regoff_t values are too + narrow (including glibc on hosts with 64-bit ptrdiff_t and + 32-bit int), but we should wait until glibc implements this + feature. Otherwise, support for equivalence classes and + multibyte collation symbols would always be broken except + when compiling --without-included-regex. */ + if (sizeof (regoff_t) < sizeof (ptrdiff_t) + || sizeof (regoff_t) < sizeof (ssize_t)) + result |= 64; +#endif + + return result; + ]])], + [gl_cv_func_re_compile_pattern_working=yes], + [gl_cv_func_re_compile_pattern_working=no], + [case "$host_os" in + # Guess no on native Windows. + mingw*) gl_cv_func_re_compile_pattern_working="guessing no" ;; + # Otherwise, assume it is not working. + *) gl_cv_func_re_compile_pattern_working="guessing no" ;; + esac + ]) + ]) + case "$gl_cv_func_re_compile_pattern_working" in #( + *yes) ac_use_included_regex=no;; #( + *no) ac_use_included_regex=yes;; + esac + ;; + *) AC_MSG_ERROR([Invalid value for --with-included-regex: $with_included_regex]) + ;; + esac + + if test $ac_use_included_regex = yes; then + AC_DEFINE([_REGEX_INCLUDE_LIMITS_H], [1], + [Define if you want to include , so that it + consistently overrides 's RE_DUP_MAX.]) + AC_DEFINE([_REGEX_LARGE_OFFSETS], [1], + [Define if you want regoff_t to be at least as wide POSIX requires.]) + AC_DEFINE([re_syntax_options], [rpl_re_syntax_options], + [Define to rpl_re_syntax_options if the replacement should be used.]) + AC_DEFINE([re_set_syntax], [rpl_re_set_syntax], + [Define to rpl_re_set_syntax if the replacement should be used.]) + AC_DEFINE([re_compile_pattern], [rpl_re_compile_pattern], + [Define to rpl_re_compile_pattern if the replacement should be used.]) + AC_DEFINE([re_compile_fastmap], [rpl_re_compile_fastmap], + [Define to rpl_re_compile_fastmap if the replacement should be used.]) + AC_DEFINE([re_search], [rpl_re_search], + [Define to rpl_re_search if the replacement should be used.]) + AC_DEFINE([re_search_2], [rpl_re_search_2], + [Define to rpl_re_search_2 if the replacement should be used.]) + AC_DEFINE([re_match], [rpl_re_match], + [Define to rpl_re_match if the replacement should be used.]) + AC_DEFINE([re_match_2], [rpl_re_match_2], + [Define to rpl_re_match_2 if the replacement should be used.]) + AC_DEFINE([re_set_registers], [rpl_re_set_registers], + [Define to rpl_re_set_registers if the replacement should be used.]) + AC_DEFINE([re_comp], [rpl_re_comp], + [Define to rpl_re_comp if the replacement should be used.]) + AC_DEFINE([re_exec], [rpl_re_exec], + [Define to rpl_re_exec if the replacement should be used.]) + AC_DEFINE([regcomp], [rpl_regcomp], + [Define to rpl_regcomp if the replacement should be used.]) + AC_DEFINE([regexec], [rpl_regexec], + [Define to rpl_regexec if the replacement should be used.]) + AC_DEFINE([regerror], [rpl_regerror], + [Define to rpl_regerror if the replacement should be used.]) + AC_DEFINE([regfree], [rpl_regfree], + [Define to rpl_regfree if the replacement should be used.]) + fi +]) + +# Prerequisites of lib/regex.c and lib/regex_internal.c. +AC_DEFUN([gl_PREREQ_REGEX], +[ + AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS]) + AC_REQUIRE([AC_C_INLINE]) + AC_REQUIRE([AC_C_RESTRICT]) + AC_REQUIRE([AC_TYPE_MBSTATE_T]) + AC_REQUIRE([gl_EEMALLOC]) + AC_REQUIRE([gl_GLIBC21]) + AC_CHECK_HEADERS([libintl.h]) + AC_CHECK_FUNCS_ONCE([isblank iswctype]) + AC_CHECK_DECLS([isblank], [], [], [[#include ]]) +]) diff --git a/src/conf_post.h b/src/conf_post.h index 8d56f0b490..9758298437 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -202,13 +202,6 @@ extern void _DebPrint (const char *fmt, ...); #endif #endif -#ifdef emacs /* Don't do this for lib-src. */ -/* Tell regex-emacs.c to use a type compatible with Emacs. */ -#define RE_TRANSLATE_TYPE Lisp_Object -#define RE_TRANSLATE(TBL, C) char_table_translate (TBL, C) -#define RE_TRANSLATE_P(TBL) (!EQ (TBL, make_number (0))) -#endif - /* Tell time_rz.c to use Emacs's getter and setter for TZ. Only Emacs uses time_rz so this is OK. */ #define getenv_TZ emacs_getenv_TZ diff --git a/src/regex-emacs.h b/src/regex-emacs.h index cb6dd76ed3..9a6214af98 100644 --- a/src/regex-emacs.h +++ b/src/regex-emacs.h @@ -219,7 +219,7 @@ extern ptrdiff_t emacs_re_safe_alloca; ((RE_SYNTAX_POSIX_EXTENDED | RE_BACKSLASH_ESCAPE_IN_LISTS | RE_DEBUG) \ & ~(RE_DOT_NOT_NULL | RE_INTERVALS | RE_CONTEXT_INDEP_OPS)) -#define RE_SYNTAX_POSIX_AWK \ +#define RE_SYNTAX_POSIX_AWK \ (RE_SYNTAX_POSIX_EXTENDED | RE_BACKSLASH_ESCAPE_IN_LISTS \ | RE_INTERVALS | RE_NO_GNU_OPS) @@ -350,6 +350,11 @@ typedef enum REG_ESIZEBR /* n or m too big in \{n,m\} */ } reg_errcode_t; +/* Use a type compatible with Emacs. */ +#define RE_TRANSLATE_TYPE Lisp_Object +#define RE_TRANSLATE(TBL, C) char_table_translate (TBL, C) +#define RE_TRANSLATE_P(TBL) (!EQ (TBL, make_number (0))) + /* This data structure represents a compiled pattern. Before calling the pattern compiler, the fields `buffer', `allocated', `fastmap', `translate', and `no_sub' can be set. After the pattern has been commit e5652268a993ad9117f7253553c143d60460eb8f Author: Paul Eggert Date: Sun Aug 5 18:41:20 2018 -0700 Rename src/regex.c to src/regex-emacs.c. This is in preparation for using Gnulib regex for etags, to avoid collisions in include directives. * src/regex-emacs.c: Rename from src/regex.c. * src/regex-emacs.h: Rename from src/regex.h. All uses changed. * test/src/regex-emacs-tests.el: Rename from test/src/regex-tests.el. diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS index 1a4157ac53..10633a8e0e 100644 --- a/admin/MAINTAINERS +++ b/admin/MAINTAINERS @@ -37,7 +37,7 @@ Kenichi Handa Mule Stefan Monnier - src/regex.c + src/regex-emacs.c src/syntax.c src/keymap.c font-lock/jit-lock/syntax diff --git a/admin/find-gc.el b/admin/find-gc.el index fb564039c7..e8cc113650 100644 --- a/admin/find-gc.el +++ b/admin/find-gc.el @@ -57,7 +57,7 @@ Each entry has the form (FUNCTION . FUNCTIONS-IT-CALLS).") "keymap.c" "sysdep.c" "buffer.c" "filelock.c" "insdel.c" "marker.c" "minibuf.c" "fileio.c" "dired.c" "cmds.c" "casefiddle.c" - "indent.c" "search.c" "regex.c" "undo.c" + "indent.c" "search.c" "regex-emacs.c" "undo.c" "alloc.c" "data.c" "doc.c" "editfns.c" "callint.c" "eval.c" "fns.c" "print.c" "lread.c" "syntax.c" "unexcoff.c" diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in index fa37d8ed85..e70b23c4b3 100644 --- a/lib-src/Makefile.in +++ b/lib-src/Makefile.in @@ -361,13 +361,13 @@ TAGS: etags${EXEEXT} ${tagsfiles} ../lib/libgnu.a: $(config_h) $(MAKE) -C ../lib all -regex.o: $(srcdir)/../src/regex.c $(srcdir)/../src/regex.h $(config_h) +regex-emacs.o: $(srcdir)/../src/regex-emacs.c $(srcdir)/../src/regex-emacs.h $(config_h) $(AM_V_CC)$(CC) -c $(CPP_CFLAGS) $< -etags_deps = ${srcdir}/etags.c regex.o $(NTLIB) $(config_h) +etags_deps = ${srcdir}/etags.c regex-emacs.o $(NTLIB) $(config_h) etags_cflags = -DEMACS_NAME="\"GNU Emacs\"" -DVERSION="\"${version}\"" -o $@ -etags_libs = regex.o $(NTLIB) $(LOADLIBES) +etags_libs = regex-emacs.o $(NTLIB) $(LOADLIBES) etags${EXEEXT}: ${etags_deps} $(AM_V_CCLD)$(CC) ${ALL_CFLAGS} $(etags_cflags) $< $(etags_libs) diff --git a/lib-src/etags.c b/lib-src/etags.c index b3b4575e0a..47d13116db 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -135,7 +135,7 @@ char pot_etags_version[] = "@(#) pot revision number is 17.38.1.4"; #endif #include -#include +#include /* Define CTAGS to make the program "ctags" compatible with the usual one. Leave it undefined to make the program "etags", which makes emacs-style diff --git a/lisp/char-fold.el b/lisp/char-fold.el index 9c05e364df..86bd6038e3 100644 --- a/lisp/char-fold.el +++ b/lisp/char-fold.el @@ -214,7 +214,7 @@ from which to start." (when (> spaces 0) (push (char-fold--make-space-string spaces) out)) (let ((regexp (apply #'concat (nreverse out)))) - ;; Limited by `MAX_BUF_SIZE' in `regex.c'. + ;; Limited by `MAX_BUF_SIZE' in `regex-emacs.c'. (if (> (length regexp) 5000) (regexp-quote string) regexp)))) diff --git a/src/Makefile.in b/src/Makefile.in index c3bcc50349..1aae27b2f9 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -391,7 +391,7 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \ emacs.o keyboard.o macros.o keymap.o sysdep.o \ buffer.o filelock.o insdel.o marker.o \ minibuf.o fileio.o dired.o \ - cmds.o casetab.o casefiddle.o indent.o search.o regex.o undo.o \ + cmds.o casetab.o casefiddle.o indent.o search.o regex-emacs.o undo.o \ alloc.o data.o doc.o editfns.o callint.o \ eval.o floatfns.o fns.o font.o print.o lread.o $(MODULES_OBJ) \ syntax.o $(UNEXEC_OBJ) bytecode.o \ diff --git a/src/casetab.c b/src/casetab.c index 8f806a0647..36f94f43db 100644 --- a/src/casetab.c +++ b/src/casetab.c @@ -144,7 +144,8 @@ set_case_table (Lisp_Object table, bool standard) set_char_table_extras (table, 2, eqv); } - /* This is so set_image_of_range_1 in regex.c can find the EQV table. */ + /* This is so set_image_of_range_1 in regex-emacs.c can find the EQV + table. */ set_char_table_extras (canon, 2, eqv); if (standard) diff --git a/src/conf_post.h b/src/conf_post.h index 080d7b7e68..8d56f0b490 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -203,7 +203,7 @@ extern void _DebPrint (const char *fmt, ...); #endif #ifdef emacs /* Don't do this for lib-src. */ -/* Tell regex.c to use a type compatible with Emacs. */ +/* Tell regex-emacs.c to use a type compatible with Emacs. */ #define RE_TRANSLATE_TYPE Lisp_Object #define RE_TRANSLATE(TBL, C) char_table_translate (TBL, C) #define RE_TRANSLATE_P(TBL) (!EQ (TBL, make_number (0))) diff --git a/src/deps.mk b/src/deps.mk index 7b6ae9cd8e..f202d0e104 100644 --- a/src/deps.mk +++ b/src/deps.mk @@ -71,7 +71,7 @@ cmds.o: cmds.c syntax.h buffer.h character.h commands.h window.h lisp.h \ pre-crt0.o: pre-crt0.c dbusbind.o: dbusbind.c termhooks.h frame.h keyboard.h lisp.h $(config_h) dired.o: dired.c commands.h buffer.h lisp.h $(config_h) character.h charset.h \ - coding.h regex.h systime.h blockinput.h atimer.h composite.h \ + coding.h regex-emacs.h systime.h blockinput.h atimer.h composite.h \ ../lib/filemode.h ../lib/unistd.h globals.h dispnew.o: dispnew.c systime.h commands.h process.h frame.h coding.h \ window.h buffer.h termchar.h termopts.h termhooks.h cm.h \ @@ -169,20 +169,21 @@ process.o: process.c process.h buffer.h window.h termhooks.h termopts.h \ blockinput.h atimer.h coding.h msdos.h nsterm.h composite.h \ keyboard.h lisp.h globals.h $(config_h) character.h xgselect.h sysselect.h \ ../lib/unistd.h gnutls.h -regex.o: regex.c syntax.h buffer.h lisp.h globals.h $(config_h) regex.h \ +regex-emacs.o: regex-emacs.c syntax.h buffer.h lisp.h globals.h \ + $(config_h) regex-emacs.h \ category.h character.h region-cache.o: region-cache.c buffer.h region-cache.h \ lisp.h globals.h $(config_h) scroll.o: scroll.c termchar.h dispextern.h frame.h msdos.h keyboard.h \ termhooks.h lisp.h globals.h $(config_h) systime.h coding.h composite.h \ window.h -search.o: search.c regex.h commands.h buffer.h region-cache.h syntax.h \ +search.o: search.c regex-emacs.h commands.h buffer.h region-cache.h syntax.h \ blockinput.h atimer.h systime.h category.h character.h charset.h \ $(INTERVALS_H) lisp.h globals.h $(config_h) sound.o: sound.c dispextern.h syssignal.h lisp.h globals.h $(config_h) \ atimer.h systime.h ../lib/unistd.h msdos.h syntax.o: syntax.c syntax.h buffer.h commands.h category.h character.h \ - keymap.h regex.h $(INTERVALS_H) lisp.h globals.h $(config_h) + keymap.h regex-emacs.h $(INTERVALS_H) lisp.h globals.h $(config_h) sysdep.o: sysdep.c syssignal.h systty.h systime.h syswait.h blockinput.h \ process.h dispextern.h termhooks.h termchar.h termopts.h coding.h \ frame.h atimer.h window.h msdos.h dosfns.h keyboard.h cm.h lisp.h \ diff --git a/src/emacs.c b/src/emacs.c index 130a9f8fc8..7304bc406e 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -84,7 +84,7 @@ along with GNU Emacs. If not, see . */ #include "composite.h" #include "dispextern.h" #include "ptr-bounds.h" -#include "regex.h" +#include "regex-emacs.h" #include "sheap.h" #include "syntax.h" #include "sysselect.h" @@ -846,9 +846,9 @@ main (int argc, char **argv) { rlim_t lim = rlim.rlim_cur; - /* Approximate the amount regex.c needs per unit of + /* Approximate the amount regex-emacs.c needs per unit of emacs_re_max_failures, then add 33% to cover the size of the - smaller stacks that regex.c successively allocates and + smaller stacks that regex-emacs.c successively allocates and discards on its way to the maximum. */ int min_ratio = 20 * sizeof (char *); int ratio = min_ratio + min_ratio / 3; @@ -887,7 +887,7 @@ main (int argc, char **argv) lim = newlim; } } - /* If the stack is big enough, let regex.c more of it before + /* If the stack is big enough, let regex-emacs.c more of it before falling back to heap allocation. */ emacs_re_safe_alloca = max (min (lim - extra, SIZE_MAX) * (min_ratio / ratio), diff --git a/src/regex.c b/src/regex-emacs.c similarity index 99% rename from src/regex.c rename to src/regex-emacs.c index 6ee13c4c99..08fc8c67f1 100644 --- a/src/regex.c +++ b/src/regex-emacs.c @@ -53,7 +53,8 @@ #include #ifdef emacs -/* We need this for `regex.h', and perhaps for the Emacs include files. */ +/* We need this for `regex-emacs.h', and perhaps for the Emacs include + files. */ # include #endif @@ -289,7 +290,7 @@ enum syntaxcode { Swhitespace = 0, Sword = 1, Ssymbol = 2 }; #endif /* Get the interface, including the syntax bits. */ -#include "regex.h" +#include "regex-emacs.h" /* isalpha etc. are used for the character classes. */ #include @@ -1157,7 +1158,7 @@ reg_syntax_t re_syntax_options; different, incompatible syntaxes. The argument SYNTAX is a bit mask comprised of the various bits - defined in regex.h. We return the old syntax. */ + defined in regex-emacs.h. We return the old syntax. */ reg_syntax_t re_set_syntax (reg_syntax_t syntax) @@ -1172,7 +1173,7 @@ WEAK_ALIAS (__re_set_syntax, re_set_syntax) #endif /* This table gives an error message for each of the error codes listed - in regex.h. Obviously the order here has to be same as there. + in regex-emacs.h. Obviously the order here has to be same as there. POSIX doesn't require that we do anything for REG_NOERROR, but why not be nice? */ @@ -1474,28 +1475,28 @@ do { \ char *destination; \ /* Must be int, so when we don't save any registers, the arithmetic \ of 0 + -1 isn't done as unsigned. */ \ - \ + \ DEBUG_STATEMENT (nfailure_points_pushed++); \ DEBUG_PRINT ("\nPUSH_FAILURE_POINT:\n"); \ DEBUG_PRINT (" Before push, next avail: %zd\n", (fail_stack).avail); \ DEBUG_PRINT (" size: %zd\n", (fail_stack).size);\ - \ + \ ENSURE_FAIL_STACK (NUM_NONREG_ITEMS); \ - \ + \ DEBUG_PRINT ("\n"); \ - \ + \ DEBUG_PRINT (" Push frame index: %zd\n", fail_stack.frame); \ PUSH_FAILURE_INT (fail_stack.frame); \ - \ + \ DEBUG_PRINT (" Push string %p: \"", string_place); \ DEBUG_PRINT_DOUBLE_STRING (string_place, string1, size1, string2, size2);\ DEBUG_PRINT ("\"\n"); \ PUSH_FAILURE_POINTER (string_place); \ - \ + \ DEBUG_PRINT (" Push pattern %p: ", pattern); \ DEBUG_PRINT_COMPILED_PATTERN (bufp, pattern, pend); \ PUSH_FAILURE_POINTER (pattern); \ - \ + \ /* Close the frame by moving the frame pointer past it. */ \ fail_stack.frame = fail_stack.avail; \ } while (0) @@ -1822,7 +1823,7 @@ struct range_table_work_area #define SETUP_ASCII_RANGE(work_area, FROM, TO) \ do { \ int C0, C1; \ - \ + \ for (C0 = (FROM); C0 <= (TO); C0++) \ { \ C1 = TRANSLATE (C0); \ @@ -1843,7 +1844,7 @@ struct range_table_work_area do { \ int C0, C1, C2, I; \ int USED = RANGE_TABLE_WORK_USED (work_area); \ - \ + \ for (C0 = (FROM); C0 <= (TO); C0++) \ { \ C1 = RE_CHAR_TO_MULTIBYTE (C0); \ @@ -1882,7 +1883,7 @@ struct range_table_work_area #define SETUP_MULTIBYTE_RANGE(work_area, FROM, TO) \ do { \ int C0, C1, C2, I, USED = RANGE_TABLE_WORK_USED (work_area); \ - \ + \ SET_RANGE_TABLE_WORK_AREA ((work_area), (FROM), (TO)); \ for (C0 = (FROM); C0 <= (TO); C0++) \ { \ @@ -1896,7 +1897,7 @@ struct range_table_work_area { \ int from = RANGE_TABLE_WORK_ELT (work_area, I); \ int to = RANGE_TABLE_WORK_ELT (work_area, I + 1); \ - \ + \ if (C1 >= from - 1 && C1 <= to + 1) \ { \ if (C1 == from - 1) \ @@ -2371,7 +2372,7 @@ static boolean group_in_compile_stack (compile_stack_type compile_stack, regnum_t regnum); /* `regex_compile' compiles PATTERN (of length SIZE) according to SYNTAX. - Returns one of error codes defined in `regex.h', or zero for success. + Returns one of error codes defined in `regex-emacs.h', or zero for success. If WHITESPACE_REGEXP is given (only #ifdef emacs), it is used instead of a space character in PATTERN. @@ -2714,15 +2715,15 @@ regex_compile (re_char *pattern, size_t size, if (!zero_times_ok && simple) { /* Since simple * loops can be made faster by using - on_failure_keep_string_jump, we turn simple P+ - into PP* if P is simple. */ - unsigned char *p1, *p2; - startoffset = b - laststart; - GET_BUFFER_SPACE (startoffset); - p1 = b; p2 = laststart; - while (p2 < p1) - *b++ = *p2++; - zero_times_ok = 1; + on_failure_keep_string_jump, we turn simple P+ + into PP* if P is simple. */ + unsigned char *p1, *p2; + startoffset = b - laststart; + GET_BUFFER_SPACE (startoffset); + p1 = b; p2 = laststart; + while (p2 < p1) + *b++ = *p2++; + zero_times_ok = 1; } GET_BUFFER_SPACE (6); @@ -6217,7 +6218,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, FREE_VARIABLES (); - return -1; /* Failure to match. */ + return -1; /* Failure to match. */ } /* Subroutine definitions for re_match_2. */ @@ -6400,7 +6401,7 @@ re_exec (const char *s) routine will report only success or failure, and nothing about the registers. - It returns 0 if it succeeds, nonzero if it doesn't. (See regex.h for + It returns 0 if it succeeds, nonzero if it doesn't. (See regex-emacs.h for the return codes and their meanings.) */ reg_errcode_t diff --git a/src/regex.h b/src/regex-emacs.h similarity index 99% rename from src/regex.h rename to src/regex-emacs.h index 3a2d74d86a..cb6dd76ed3 100644 --- a/src/regex.h +++ b/src/regex-emacs.h @@ -160,9 +160,9 @@ typedef unsigned long reg_syntax_t; /* If this bit is set, turn on internal regex debugging. If not set, and debugging was on, turn it off. - This only works if regex.c is compiled -DDEBUG. + This only works if regex-emacs.c is compiled -DDEBUG. We define this bit always, so that all that's needed to turn on - debugging is to recompile regex.c; the calling code can always have + debugging is to recompile regex-emacs.c; the calling code can always have this bit set, and it won't affect anything in the normal case. */ #define RE_DEBUG (RE_NO_NEWLINE_ANCHOR << 1) @@ -317,7 +317,7 @@ extern ptrdiff_t emacs_re_safe_alloca; /* If any error codes are removed, changed, or added, update the - `re_error_msg' table in regex.c. */ + `re_error_msg' table in regex-emacs.c. */ typedef enum { #ifdef _XOPEN_SOURCE @@ -650,5 +650,5 @@ typedef int re_wchar_t; #endif /* not WIDE_CHAR_SUPPORT */ -#endif /* regex.h */ +#endif /* regex-emacs.h */ diff --git a/src/search.c b/src/search.c index ccdb659776..d4b0322041 100644 --- a/src/search.c +++ b/src/search.c @@ -30,7 +30,7 @@ along with GNU Emacs. If not, see . */ #include "blockinput.h" #include "intervals.h" -#include "regex.h" +#include "regex-emacs.h" #define REGEXP_CACHE_SIZE 20 @@ -290,7 +290,8 @@ looking_at_1 (Lisp_Object string, bool posix) if (running_asynch_code) save_search_regs (); - /* This is so set_image_of_range_1 in regex.c can find the EQV table. */ + /* This is so set_image_of_range_1 in regex-emacs.c can find the EQV + table. */ set_char_table_extras (BVAR (current_buffer, case_canon_table), 2, BVAR (current_buffer, case_eqv_table)); @@ -410,7 +411,8 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, pos_byte = string_char_to_byte (string, pos); } - /* This is so set_image_of_range_1 in regex.c can find the EQV table. */ + /* This is so set_image_of_range_1 in regex-emacs.c can find the EQV + table. */ set_char_table_extras (BVAR (current_buffer, case_canon_table), 2, BVAR (current_buffer, case_eqv_table)); @@ -1062,7 +1064,8 @@ search_command (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, lim_byte = CHAR_TO_BYTE (lim); } - /* This is so set_image_of_range_1 in regex.c can find the EQV table. */ + /* This is so set_image_of_range_1 in regex-emacs.c can find the EQV + table. */ set_char_table_extras (BVAR (current_buffer, case_canon_table), 2, BVAR (current_buffer, case_eqv_table)); diff --git a/src/syntax.c b/src/syntax.c index c5a4b03955..2f9fd05ddf 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -23,7 +23,7 @@ along with GNU Emacs. If not, see . */ #include "lisp.h" #include "character.h" #include "buffer.h" -#include "regex.h" +#include "regex-emacs.h" #include "syntax.h" #include "intervals.h" #include "category.h" @@ -267,9 +267,10 @@ SETUP_SYNTAX_TABLE (ptrdiff_t from, ptrdiff_t count) If it is t (which is only used in fast_c_string_match_ignore_case), ignore properties altogether. - This is meant for regex.c to use. For buffers, regex.c passes arguments - to the UPDATE_SYNTAX_TABLE functions which are relative to BEGV. - So if it is a buffer, we set the offset field to BEGV. */ + This is meant for regex-emacs.c to use. For buffers, regex-emacs.c + passes arguments to the UPDATE_SYNTAX_TABLE functions which are + relative to BEGV. So if it is a buffer, we set the offset field to + BEGV. */ void SETUP_SYNTAX_TABLE_FOR_OBJECT (Lisp_Object object, @@ -3729,7 +3730,7 @@ syms_of_syntax (void) staticpro (&gl_state.current_syntax_table); staticpro (&gl_state.old_prop); - /* Defined in regex.c. */ + /* Defined in regex-emacs.c. */ staticpro (&re_match_object); DEFSYM (Qscan_error, "scan-error"); diff --git a/src/thread.h b/src/thread.h index 922eea6217..e1eb40921b 100644 --- a/src/thread.h +++ b/src/thread.h @@ -19,7 +19,7 @@ along with GNU Emacs. If not, see . */ #ifndef THREAD_H #define THREAD_H -#include "regex.h" +#include "regex-emacs.h" #ifdef WINDOWSNT #include diff --git a/test/src/regex-tests.el b/test/src/regex-emacs-tests.el similarity index 99% rename from test/src/regex-tests.el rename to test/src/regex-emacs-tests.el index 083ed5c4c8..7a075908a6 100644 --- a/test/src/regex-tests.el +++ b/test/src/regex-emacs-tests.el @@ -1,4 +1,4 @@ -;;; regex-tests.el --- tests for regex.c functions -*- lexical-binding: t -*- +;;; regex-emacs-tests.el --- tests for regex-emacs.c -*- lexical-binding: t -*- ;; Copyright (C) 2015-2018 Free Software Foundation, Inc. @@ -24,7 +24,7 @@ (defvar regex-tests--resources-dir (concat (concat (file-name-directory (or load-file-name buffer-file-name)) "/regex-resources/")) - "Path to regex-resources directory next to the \"regex-tests.el\" file.") + "Path to regex-resources directory next to the \"regex-emacs-tests.el\" file.") (ert-deftest regex-word-cc-fallback-test () "Test that \"[[:cc:]]*x\" matches \"x\" (bug#24020). @@ -683,4 +683,4 @@ This evaluates the TESTS test cases from glibc." (should-not (string-match "\\`x\\{65535\\}" (make-string 65534 ?x))) (should-error (string-match "\\`x\\{65536\\}" "X") :type 'invalid-regexp)) -;;; regex-tests.el ends here +;;; regex-emacs-tests.el ends here commit ba8eb994f86206f69cbf9743a67b9d86ef9b1d8f Author: Paul Eggert Date: Sun Aug 5 17:40:22 2018 -0700 Update from gnulib This incorporates: 2018-08-05 Fix link error regarding 'rpl_environ' * build-aux/config.guess, lib/unistd.in.h, lib/warn-on-use.h: * m4/extern-inline.m4: Copy from Gnulib. diff --git a/build-aux/config.guess b/build-aux/config.guess index ba6af63cc4..d4fb3213ec 100755 --- a/build-aux/config.guess +++ b/build-aux/config.guess @@ -2,7 +2,7 @@ # Attempt to guess a canonical system name. # Copyright 1992-2018 Free Software Foundation, Inc. -timestamp='2018-07-18' +timestamp='2018-08-02' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -126,7 +126,7 @@ set_cc_for_build() { # This is needed to find uname on a Pyramid OSx when run in the BSD universe. # (ghazi@noc.rutgers.edu 1994-08-24) -if (test -f /.attbin/uname) >/dev/null 2>&1 ; then +if test -f /.attbin/uname ; then PATH=$PATH:/.attbin ; export PATH fi diff --git a/lib/unistd.in.h b/lib/unistd.in.h index b6a348f529..55bbb6ca3b 100644 --- a/lib/unistd.in.h +++ b/lib/unistd.in.h @@ -432,12 +432,12 @@ extern char **environ; #elif defined GNULIB_POSIXCHECK # if HAVE_RAW_DECL_ENVIRON _GL_UNISTD_INLINE char *** +_GL_WARN_ON_USE_ATTRIBUTE ("environ is unportable - " + "use gnulib module environ for portability") rpl_environ (void) { return &environ; } -_GL_WARN_ON_USE (rpl_environ, "environ is unportable - " - "use gnulib module environ for portability"); # undef environ # define environ (*rpl_environ ()) # endif diff --git a/lib/warn-on-use.h b/lib/warn-on-use.h index e76c38427d..72d67cc234 100644 --- a/lib/warn-on-use.h +++ b/lib/warn-on-use.h @@ -20,23 +20,32 @@ supported by the compiler. If the compiler does not support this feature, the macro expands to an unused extern declaration. - This macro is useful for marking a function as a potential + _GL_WARN_ON_USE_ATTRIBUTE ("literal string") expands to the + attribute used in _GL_WARN_ON_USE. If the compiler does not support + this feature, it expands to empty. + + These macros are useful for marking a function as a potential portability trap, with the intent that "literal string" include instructions on the replacement function that should be used - instead. However, one of the reasons that a function is a - portability trap is if it has the wrong signature. Declaring - FUNCTION with a different signature in C is a compilation error, so - this macro must use the same type as any existing declaration so - that programs that avoid the problematic FUNCTION do not fail to - compile merely because they included a header that poisoned the - function. But this implies that _GL_WARN_ON_USE is only safe to - use if FUNCTION is known to already have a declaration. Use of - this macro implies that there must not be any other macro hiding - the declaration of FUNCTION; but undefining FUNCTION first is part - of the poisoning process anyway (although for symbols that are - provided only via a macro, the result is a compilation error rather - than a warning containing "literal string"). Also note that in - C++, it is only safe to use if FUNCTION has no overloads. + instead. + _GL_WARN_ON_USE is for functions with 'extern' linkage. + _GL_WARN_ON_USE_ATTRIBUTE is for functions with 'static' or 'inline' + linkage. + + However, one of the reasons that a function is a portability trap is + if it has the wrong signature. Declaring FUNCTION with a different + signature in C is a compilation error, so this macro must use the + same type as any existing declaration so that programs that avoid + the problematic FUNCTION do not fail to compile merely because they + included a header that poisoned the function. But this implies that + _GL_WARN_ON_USE is only safe to use if FUNCTION is known to already + have a declaration. Use of this macro implies that there must not + be any other macro hiding the declaration of FUNCTION; but + undefining FUNCTION first is part of the poisoning process anyway + (although for symbols that are provided only via a macro, the result + is a compilation error rather than a warning containing + "literal string"). Also note that in C++, it is only safe to use if + FUNCTION has no overloads. For an example, it is possible to poison 'getline' by: - adding a call to gl_WARN_ON_USE_PREPARE([[#include ]], @@ -54,12 +63,21 @@ (less common usage, like &environ, will cause a compilation error rather than issue the nice warning, but the end result of informing the developer about their portability problem is still achieved): - #if HAVE_RAW_DECL_ENVIRON - static char ***rpl_environ (void) { return &environ; } - _GL_WARN_ON_USE (rpl_environ, "environ is not always properly declared"); - # undef environ - # define environ (*rpl_environ ()) - #endif + #if HAVE_RAW_DECL_ENVIRON + static char *** + rpl_environ (void) { return &environ; } + _GL_WARN_ON_USE (rpl_environ, "environ is not always properly declared"); + # undef environ + # define environ (*rpl_environ ()) + #endif + or better (avoiding contradictory use of 'static' and 'extern'): + #if HAVE_RAW_DECL_ENVIRON + static char *** + _GL_WARN_ON_USE_ATTRIBUTE ("environ is not always properly declared") + rpl_environ (void) { return &environ; } + # undef environ + # define environ (*rpl_environ ()) + #endif */ #ifndef _GL_WARN_ON_USE @@ -67,13 +85,17 @@ /* A compiler attribute is available in gcc versions 4.3.0 and later. */ # define _GL_WARN_ON_USE(function, message) \ extern __typeof__ (function) function __attribute__ ((__warning__ (message))) +# define _GL_WARN_ON_USE_ATTRIBUTE(message) \ + __attribute__ ((__warning__ (message))) # elif __GNUC__ >= 3 && GNULIB_STRICT_CHECKING /* Verify the existence of the function. */ # define _GL_WARN_ON_USE(function, message) \ extern __typeof__ (function) function +# define _GL_WARN_ON_USE_ATTRIBUTE(message) # else /* Unsupported. */ # define _GL_WARN_ON_USE(function, message) \ _GL_WARN_EXTERN_C int _gl_warn_on_use +# define _GL_WARN_ON_USE_ATTRIBUTE(message) # endif #endif diff --git a/m4/extern-inline.m4 b/m4/extern-inline.m4 index da8a2cc01c..3661cbda5e 100644 --- a/m4/extern-inline.m4 +++ b/m4/extern-inline.m4 @@ -25,7 +25,8 @@ AC_DEFUN([gl_EXTERN_INLINE], if isdigit is mistakenly implemented via a static inline function, a program containing an extern inline function that calls isdigit may not work since the C standard prohibits extern inline functions - from calling static functions. This bug is known to occur on: + from calling static functions (ISO C 99 section 6.7.4.(3). + This bug is known to occur on: OS X 10.8 and earlier; see: https://lists.gnu.org/r/bug-gnulib/2012-12/msg00023.html @@ -38,7 +39,18 @@ AC_DEFUN([gl_EXTERN_INLINE], OS X 10.9 has a macro __header_inline indicating the bug is fixed for C and for clang but remains for g++; see . - Assume DragonFly and FreeBSD will be similar. */ + Assume DragonFly and FreeBSD will be similar. + + GCC 4.3 and above with -std=c99 or -std=gnu99 implements ISO C99 + inline semantics, unless -fgnu89-inline is used. It defines a macro + __GNUC_STDC_INLINE__ to indicate this situation or a macro + __GNUC_GNU_INLINE__ to indicate the opposite situation. + GCC 4.2 with -std=c99 or -std=gnu99 implements the GNU C inline + semantics but warns, unless -fgnu89-inline is used: + warning: C99 inline functions are not supported; using GNU89 + warning: to disable this warning use -fgnu89-inline or the gnu_inline function attribute + It defines a macro __GNUC_GNU_INLINE__ to indicate this situation. + */ #if (((defined __APPLE__ && defined __MACH__) \ || defined __DragonFly__ || defined __FreeBSD__) \ && (defined __header_inline \ commit 68ebff23f7057090da260830500cb278f7b886a5 Author: Andy Moreton Date: Sun Aug 5 12:56:33 2018 -0600 Fix test and comment in CCL change * lisp/international/ccl.el (ccl-fixnum): Update comment. * test/lisp/international/ccl-tests.el (prog-midi-dump): Add trailing space to expected result. diff --git a/lisp/international/ccl.el b/lisp/international/ccl.el index d1b82ceb9c..58083f05d9 100644 --- a/lisp/international/ccl.el +++ b/lisp/international/ccl.el @@ -184,8 +184,10 @@ (defvar ccl-current-ic 0 "The current index for `ccl-program-vector'.") -;; This is needed because CCL assumes the pre-bigint (wrapping) -;; semantics of integer overflow. +;; The CCL compiled codewords are 28bits, but the CCL implementation +;; assumes that the codewords are sign-extended, so that data constants in +;; the upper part of the codeword are signed. This function truncates a +;; codeword to 28bits, and then sign extends the result to a fixnum. (defun ccl-fixnum (code) "Convert a CCL code word to a fixnum value." (- (logxor (logand code #x0fffffff) #x08000000) #x08000000)) diff --git a/test/lisp/international/ccl-tests.el b/test/lisp/international/ccl-tests.el index d0c254ce91..ba6d2040e8 100644 --- a/test/lisp/international/ccl-tests.el +++ b/test/lisp/international/ccl-tests.el @@ -162,7 +162,7 @@ At EOF: Main-body: 2:[read-jump-cond-expr-const] read r0, if !(r0 < 128), jump to 22(+20) 5:[branch] jump to array[r3] of length 4 - 11 12 15 18 22 + 11 12 15 18 22 11:[jump] jump to 2(-9) 12:[set-register] r1 = r0 13:[set-register] r0 = r4 commit 56683b139b8480198b167ef61cf1b32c528d1070 Author: Charles A. Roelli Date: Sun Aug 5 17:39:38 2018 +0200 ; * src/xdisp.c: Fix typo. diff --git a/src/xdisp.c b/src/xdisp.c index 2719ade6f9..8f89ec559a 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -265,7 +265,7 @@ along with GNU Emacs. If not, see . */ character to be delivered is a composed character, the iteration calls composition_reseat_it and next_element_from_composition. If they succeed to compose the character with one or more of the - following characters, the whole sequence of characters that where + following characters, the whole sequence of characters that were composed is recorded in the `struct composition_it' object that is part of the buffer iterator. The composed sequence could produce one or more font glyphs (called "grapheme clusters") on the screen. commit e1646e1e2864d6eaf567f4fe77cc11d3e17dde51 Author: Mike Kupfer Date: Sat Aug 4 18:06:37 2018 -0700 Fix mh-redistribute to work with nmh 1.5 and identities (SF#268) Co-authored-by: Jeffrey C Honig * lisp/mh-e/mh-comp.el (mh-redistribute): Add a non-optional identity parameter. Use mh-bare-components to generate a draft, then apply identity-specific settings. Add more details to the "Resent" annotation line. (mh-dist-formfile): New. (mh-bare-components): Add a formfile argument. (mh-edit-again, mh-send-sub): Track the change to mh-bare-components. * lisp/mh-e/mh-identity.el (mh-select-identity) (mh-identity-field): New. diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el index 2b49fae2a6..5c474b4b90 100644 --- a/lisp/mh-e/mh-comp.el +++ b/lisp/mh-e/mh-comp.el @@ -77,6 +77,14 @@ Default is \"components\". If not an absolute file name, the file is searched for first in the user's MH directory, then in the system MH lib directory.") +(defvar mh-dist-formfile "distcomps" + "Name of file to be used as a skeleton for redistributing messages. + +Default is \"distcomps\". + +If not an absolute file name, the file is searched for first in the +user's MH directory, then in the system MH lib directory.") + (defvar mh-repl-formfile "replcomps" "Name of file to be used as a skeleton for replying to messages. @@ -413,7 +421,7 @@ See also `mh-send'." (interactive (list (mh-get-msg-num t))) (let* ((from-folder mh-current-folder) (config (current-window-configuration)) - (components-file (mh-bare-components)) + (components-file (mh-bare-components mh-comp-formfile)) (draft (cond ((and mh-draft-folder (equal from-folder mh-draft-folder)) (pop-to-buffer (find-file-noselect (mh-msg-filename message)) @@ -649,15 +657,16 @@ Original message has headers FROM and SUBJECT." (format mh-forward-subject-format from subject)) ;;;###mh-autoload -(defun mh-redistribute (to cc &optional message) +(defun mh-redistribute (to cc identity &optional message) "Redistribute a message. This command is similar in function to forwarding mail, but it does not allow you to edit the message, nor does it add your name to the \"From\" header field. It appears to the recipient as if the message had come from the original sender. When you run this -command, you are prompted for the TO and CC recipients. The -default MESSAGE is the current message. +command, you are prompted for the TO and CC recipients. You are +also prompted for the sending IDENTITY to use. The default +MESSAGE is the current message. Also investigate the command \\[mh-edit-again] for another way to redistribute messages. @@ -668,6 +677,9 @@ The hook `mh-annotate-msg-hook' is run after annotating the message and scan line." (interactive (list (mh-read-address "Redist-To: ") (mh-read-address "Redist-Cc: ") + (if mh-identity-list + (mh-select-identity mh-identity-default) + nil) (mh-get-msg-num t))) (or message (setq message (mh-get-msg-num t))) @@ -677,14 +689,51 @@ message and scan line." (if mh-redist-full-contents-flag (mh-msg-filename message) nil) - nil))) - (mh-goto-header-end 0) - (insert "Resent-To: " to "\n") - (if (not (equal cc "")) (insert "Resent-cc: " cc "\n")) - (mh-clean-msg-header - (point-min) - "^Message-Id:\\|^Received:\\|^Return-Path:\\|^Sender:\\|^Date:\\|^From:" - nil) + nil)) + (from (mh-identity-field identity "From")) + (fcc (mh-identity-field identity "Fcc")) + (bcc (mh-identity-field identity "Bcc")) + comp-fcc comp-to comp-cc comp-bcc) + (if mh-redist-full-contents-flag + (mh-clean-msg-header + (point-min) + "^Message-Id:\\|^Received:\\|^Return-Path:\\|^Date:\\|^Resent-.*:" + nil)) + ;; Read fields from the distcomps file and put them in our + ;; draft. For "To", "Cc", "Bcc", and "Fcc", multiple headers are + ;; combined into a single header with comma-separated entries. + ;; For "From", the first value wins, with the identity's "From" + ;; trumping anything in the distcomps file. + (let ((components-file (mh-bare-components mh-dist-formfile))) + (mh-mapc + (function + (lambda (header-field) + (let ((field (car header-field)) + (value (cdr header-field)) + (case-fold-search t)) + (cond + ((string-match field "^Resent-Fcc$") + (setq comp-fcc value)) + ((string-match field "^Resent-From$") + (or from + (setq from value))) + ((string-match field "^Resent-To$") + (setq comp-to value)) + ((string-match field "^Resent-Cc$") + (setq comp-cc value)) + ((string-match field "^Resent-Bcc$") + (setq comp-bcc value)) + ((string-match field "^Resent-.*$") + (mh-insert-fields field value)))))) + (mh-components-to-list components-file)) + (delete-file components-file)) + (mh-insert-fields "Resent-To:" (mapconcat 'identity (list to comp-to) ", ") + "Resent-Cc:" (mapconcat 'identity (list cc comp-cc) ", ") + "Resent-Fcc:" (mapconcat 'identity (list fcc + comp-fcc) ", ") + "Resent-Bcc:" (mapconcat 'identity (list bcc + comp-bcc) ", ") + "Resent-From:" from) (save-buffer) (message "Redistributing...") (let ((env "mhdist=1")) @@ -702,7 +751,8 @@ message and scan line." ;; Annotate... (mh-annotate-msg message folder mh-note-dist "-component" "Resent:" - "-text" (format "\"%s %s\"" to cc))) + "-text" (format "\"To: %s Cc: %s From: %s\"" + to cc from))) (kill-buffer draft) (message "Redistributing...done")))) @@ -898,7 +948,7 @@ CONFIG is the window configuration before sending mail." (message "Composing a message...") (let ((draft (mh-read-draft "message" - (mh-bare-components) + (mh-bare-components mh-comp-formfile) t))) (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc) (goto-char (point-max)) @@ -908,23 +958,25 @@ CONFIG is the window configuration before sending mail." (mh-letter-mode-message) (mh-letter-adjust-point)))) -(defun mh-bare-components () - "Generate a temporary, clean components file and return its path." - ;; Let comp(1) create the skeleton for us. This is particularly +(defun mh-bare-components (formfile) + "Generate a temporary, clean components file from FORMFILE. +Return the path to the temporary file." + ;; Let comp(1) create the skeleton for us. This is particularly ;; important with nmh-1.5, because its default "components" needs - ;; some processing before it can be used. Unfortunately, comp(1) - ;; doesn't have a -build option. So, to avoid the possibility of - ;; clobbering an existing draft, create a temporary directory and - ;; use it as the drafts folder. Then copy the skeleton to a regular - ;; temp file, and return the regular temp file. + ;; some processing before it can be used. Unfortunately, comp(1) + ;; didn't have a -build option until later versions of nmh. So, to + ;; avoid the possibility of clobbering an existing draft, create + ;; a temporary directory and use it as the drafts folder. Then + ;; copy the skeleton to a regular temp file, and return the + ;; regular temp file. (let (new (temp-folder (make-temp-file (concat mh-user-path "draftfolder.") t))) (mh-exec-cmd "comp" "-nowhatnowproc" "-draftfolder" (format "+%s" (file-name-nondirectory temp-folder)) - (if (stringp mh-comp-formfile) - (list "-form" mh-comp-formfile))) + (if (stringp formfile) + (list "-form" formfile))) (setq new (make-temp-file "comp.")) (rename-file (concat temp-folder "/" "1") new t) ;; The temp folder could contain various metadata files. Rather diff --git a/lisp/mh-e/mh-identity.el b/lisp/mh-e/mh-identity.el index fd7c2b83fe..a1eb22ff18 100644 --- a/lisp/mh-e/mh-identity.el +++ b/lisp/mh-e/mh-identity.el @@ -131,6 +131,33 @@ valid header field." (cdr (assoc ":default" mh-identity-handlers)) 'mh-identity-handler-default)) +;;;###mh-autoload +(defun mh-select-identity (default) + "Prompt for and return an identity. +If DEFAULT is non-nil, it will be used if the user doesn't enter a +different identity. + +See `mh-identity-list'." + (let (identity) + (setq identity + (completing-read + "Identity: " + (cons '("None") + (mapcar 'list (mapcar 'car mh-identity-list))) + nil t default nil default)) + (if (eq identity "None") + nil + identity))) + +;;;###mh-autoload +(defun mh-identity-field (identity field) + "Return the specified FIELD of the given IDENTITY. + +See `mh-identity-list'." + (let* ((pers-list (cadr (assoc identity mh-identity-list))) + (value (cdr (assoc field pers-list)))) + value)) + ;;;###mh-autoload (defun mh-insert-identity (identity &optional maybe-insert) "Insert fields specified by given IDENTITY. commit 1303f8a4806fb170c14375c53b0f79d03e288eb3 Author: Tom Tromey Date: Sat Aug 4 11:08:31 2018 -0600 Fix hash functions for bignums * src/fns.c (cmpfn_eql, hashfn_eql): Handle bignums. (sxhash_bignum): New function. (sxhash): Use it. * test/src/fns-tests.el (test-bignum-hash): New test. diff --git a/src/fns.c b/src/fns.c index b14481d010..ac93a2f6d8 100644 --- a/src/fns.c +++ b/src/fns.c @@ -3717,9 +3717,13 @@ cmpfn_eql (struct hash_table_test *ht, Lisp_Object key1, Lisp_Object key2) { - return (FLOATP (key1) - && FLOATP (key2) - && XFLOAT_DATA (key1) == XFLOAT_DATA (key2)); + if (FLOATP (key1) + && FLOATP (key2) + && XFLOAT_DATA (key1) == XFLOAT_DATA (key2)) + return true; + return (BIGNUMP (key1) + && BIGNUMP (key2) + && mpz_cmp (XBIGNUM (key1)->value, XBIGNUM (key2)->value) == 0); } @@ -3775,7 +3779,9 @@ hashfn_equal (struct hash_table_test *ht, Lisp_Object key) static EMACS_UINT hashfn_eql (struct hash_table_test *ht, Lisp_Object key) { - return FLOATP (key) ? hashfn_equal (ht, key) : hashfn_eq (ht, key); + return ((FLOATP (key) || BIGNUMP (key)) + ? hashfn_equal (ht, key) + : hashfn_eq (ht, key)); } /* Value is a hash code for KEY for use in hash table H which uses as @@ -4409,6 +4415,20 @@ sxhash_bool_vector (Lisp_Object vec) return SXHASH_REDUCE (hash); } +/* Return a hash for a bignum. */ + +static EMACS_UINT +sxhash_bignum (struct Lisp_Bignum *bignum) +{ + size_t i, nlimbs = mpz_size (bignum->value); + EMACS_UINT hash = 0; + + for (i = 0; i < nlimbs; ++i) + hash = sxhash_combine (hash, mpz_getlimbn (bignum->value, i)); + + return SXHASH_REDUCE (hash); +} + /* Return a hash code for OBJ. DEPTH is the current depth in the Lisp structure. Value is an unsigned integer clipped to INTMASK. */ @@ -4428,6 +4448,12 @@ sxhash (Lisp_Object obj, int depth) break; case Lisp_Misc: + if (XMISCTYPE (obj) == Lisp_Misc_Bignum) + { + hash = sxhash_bignum (XBIGNUM (obj)); + break; + } + FALLTHROUGH; case Lisp_Symbol: hash = XHASH (obj); break; diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index d440cfabda..d560f0bb0d 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -602,4 +602,15 @@ (should (equal x y)) (should-not (eql x 0.0e+NaN)))) +(ert-deftest test-bignum-hash () + "Test that hash tables work for bignums." + ;; Make two bignums that are eql but not eq. + (let ((b1 (1+ most-positive-fixnum)) + (b2 (1+ most-positive-fixnum))) + (dolist (test '(eq eql equal)) + (let ((hash (make-hash-table :test test))) + (puthash b1 t hash) + (should (eq (gethash b2 hash) + (funcall test b1 b2))))))) + (provide 'fns-tests) commit 91d505d8e2cd8a5736f4ed76bb5aabfbc4410e89 Author: Tom Tromey Date: Sat Aug 4 10:50:35 2018 -0600 Fix bignum comparisons with NaN * src/data.c (isnan): Move earlier. (bignumcompare): Explicitly handle NaN. * test/src/data-tests.el (data-tests-min): Add NaN tests for bignum. (data-check-sign): Fix for previous patch. * test/src/fns-tests.el (test-bignum-eql): Add NaN test. diff --git a/src/data.c b/src/data.c index 3d55d9d17d..4388a2b0ff 100644 --- a/src/data.c +++ b/src/data.c @@ -2397,6 +2397,10 @@ bool-vector. IDX starts at 0. */) /* Arithmetic functions */ +#ifndef isnan +# define isnan(x) ((x) != (x)) +#endif + static Lisp_Object bignumcompare (Lisp_Object num1, Lisp_Object num2, enum Arith_Comparison comparison) @@ -2407,7 +2411,13 @@ bignumcompare (Lisp_Object num1, Lisp_Object num2, if (BIGNUMP (num1)) { if (FLOATP (num2)) - cmp = mpz_cmp_d (XBIGNUM (num1)->value, XFLOAT_DATA (num2)); + { + /* Note that GMP doesn't define comparisons against NaN, so + we need to handle them specially. */ + if (isnan (XFLOAT_DATA (num2))) + return Qnil; + cmp = mpz_cmp_d (XBIGNUM (num1)->value, XFLOAT_DATA (num2)); + } else if (FIXNUMP (num2)) { if (sizeof (EMACS_INT) > sizeof (long) && XINT (num2) > LONG_MAX) @@ -2431,7 +2441,13 @@ bignumcompare (Lisp_Object num1, Lisp_Object num2, { eassume (BIGNUMP (num2)); if (FLOATP (num1)) - cmp = - mpz_cmp_d (XBIGNUM (num2)->value, XFLOAT_DATA (num1)); + { + /* Note that GMP doesn't define comparisons against NaN, so + we need to handle them specially. */ + if (isnan (XFLOAT_DATA (num1))) + return Qnil; + cmp = - mpz_cmp_d (XBIGNUM (num2)->value, XFLOAT_DATA (num1)); + } else { eassume (FIXNUMP (num1)); @@ -3021,10 +3037,6 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) return unbind_to (count, make_number (accum)); } -#ifndef isnan -# define isnan(x) ((x) != (x)) -#endif - static Lisp_Object float_arith_driver (double accum, ptrdiff_t argnum, enum arithop code, ptrdiff_t nargs, Lisp_Object *args) diff --git a/test/src/data-tests.el b/test/src/data-tests.el index 07159df48c..ee6a3eb922 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -105,7 +105,9 @@ (should (isnan (min 0.0e+NaN))) (should (isnan (min 0.0e+NaN 1 2))) (should (isnan (min 1.0 0.0e+NaN))) - (should (isnan (min 1.0 0.0e+NaN 1.1)))) + (should (isnan (min 1.0 0.0e+NaN 1.1))) + (should (isnan (min 1.0 0.0e+NaN 1.1 (1+ most-positive-fixnum)))) + (should (isnan (max 1.0 0.0e+NaN 1.1 (1+ most-positive-fixnum))))) (defun data-tests-popcnt (byte) "Calculate the Hamming weight of BYTE." @@ -618,6 +620,6 @@ comparing the subr with a much slower lisp implementation." (should (= (ash most-negative-fixnum 1) (* most-negative-fixnum 2))) (should (= (lsh most-negative-fixnum 1) - (* (abs most-negative-fixnum) 2)))) + (* most-negative-fixnum 2)))) ;;; data-tests.el ends here diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index f5f3b89244..d440cfabda 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -599,6 +599,7 @@ (y (+ most-positive-fixnum 1))) (should (eq x x)) (should (eql x y)) - (should (equal x y)))) + (should (equal x y)) + (should-not (eql x 0.0e+NaN)))) (provide 'fns-tests) commit bc8ff54efee05f4a2769be32046866ed1e152b41 Author: Andy Moreton Date: Sat Aug 4 10:28:13 2018 -0600 Make bignums work better when EMACS_INT is larger than long * lisp/international/ccl.el (ccl-fixnum): New function. (ccl-embed-data, ccl-embed-current-address, ccl-dump): Use it. * src/alloc.c (make_number): Handle case where EMACS_INT is larger than long. * src/data.c (bignumcompare): Handle case where EMACS_INT is larger than long. (arith_driver): Likewise. Coerce markers. (float_arith_driver): Coerce markers. (Flogcount): Use mpz_sgn. (ash_lsh_impl): Fix bugs. (Fsub1): Fix underflow check. * src/lisp.h (NUMBERP): Don't check BIGNUMP. (CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER): Fix indentation. * test/lisp/international/ccl-tests.el: New file. diff --git a/lisp/international/ccl.el b/lisp/international/ccl.el index d2f490d59c..d1b82ceb9c 100644 --- a/lisp/international/ccl.el +++ b/lisp/international/ccl.el @@ -184,11 +184,17 @@ (defvar ccl-current-ic 0 "The current index for `ccl-program-vector'.") +;; This is needed because CCL assumes the pre-bigint (wrapping) +;; semantics of integer overflow. +(defun ccl-fixnum (code) + "Convert a CCL code word to a fixnum value." + (- (logxor (logand code #x0fffffff) #x08000000) #x08000000)) + (defun ccl-embed-data (data &optional ic) "Embed integer DATA in `ccl-program-vector' at `ccl-current-ic' and increment it. If IC is specified, embed DATA at IC." (if ic - (aset ccl-program-vector ic data) + (aset ccl-program-vector ic (ccl-fixnum data)) (let ((len (length ccl-program-vector))) (if (>= ccl-current-ic len) (let ((new (make-vector (* len 2) nil))) @@ -196,7 +202,7 @@ increment it. If IC is specified, embed DATA at IC." (setq len (1- len)) (aset new len (aref ccl-program-vector len))) (setq ccl-program-vector new)))) - (aset ccl-program-vector ccl-current-ic data) + (aset ccl-program-vector ccl-current-ic (ccl-fixnum data)) (setq ccl-current-ic (1+ ccl-current-ic)))) (defun ccl-embed-symbol (symbol prop) @@ -230,7 +236,8 @@ proper index number for SYMBOL. PROP should be `ccl-program-vector' at IC without altering the other bit field." (let ((relative (- ccl-current-ic (1+ ic)))) (aset ccl-program-vector ic - (logior (aref ccl-program-vector ic) (ash relative 8))))) + (logior (aref ccl-program-vector ic) + (ccl-fixnum (ash relative 8)))))) (defun ccl-embed-code (op reg data &optional reg2) "Embed CCL code for the operation OP and arguments REG and DATA in @@ -986,7 +993,8 @@ is a list of CCL-BLOCKs." (defun ccl-get-next-code () "Return a CCL code in `ccl-code' at `ccl-current-ic'." (prog1 - (aref ccl-code ccl-current-ic) + (let ((code (aref ccl-code ccl-current-ic))) + (if (numberp code) (ccl-fixnum code) code)) (setq ccl-current-ic (1+ ccl-current-ic)))) (defun ccl-dump-1 () diff --git a/src/alloc.c b/src/alloc.c index 1dc1bbb031..367bb73fc1 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3815,6 +3815,34 @@ make_number (mpz_t value) } } + /* Check if fixnum can be larger than long. */ + if (sizeof (EMACS_INT) > sizeof (long)) + { + size_t bits = mpz_sizeinbase (value, 2); + int sign = mpz_sgn (value); + + if (bits < FIXNUM_BITS + (sign < 0)) + { + EMACS_INT v = 0; + size_t limbs = mpz_size (value); + mp_size_t i; + + for (i = 0; i < limbs; i++) + { + mp_limb_t limb = mpz_getlimbn (value, i); + v |= (EMACS_INT) ((EMACS_UINT) limb << (i * GMP_NUMB_BITS)); + } + if (sign < 0) + v = -v; + + if (!FIXNUM_OVERFLOW_P (v)) + { + XSETINT (obj, v); + return obj; + } + } + } + obj = allocate_misc (Lisp_Misc_Bignum); b = XBIGNUM (obj); /* We could mpz_init + mpz_swap here, to avoid a copy, but the diff --git a/src/data.c b/src/data.c index 0deebdca1a..3d55d9d17d 100644 --- a/src/data.c +++ b/src/data.c @@ -2409,7 +2409,18 @@ bignumcompare (Lisp_Object num1, Lisp_Object num2, if (FLOATP (num2)) cmp = mpz_cmp_d (XBIGNUM (num1)->value, XFLOAT_DATA (num2)); else if (FIXNUMP (num2)) - cmp = mpz_cmp_si (XBIGNUM (num1)->value, XINT (num2)); + { + if (sizeof (EMACS_INT) > sizeof (long) && XINT (num2) > LONG_MAX) + { + mpz_t tem; + mpz_init (tem); + mpz_set_intmax (tem, XINT (num2)); + cmp = mpz_cmp (XBIGNUM (num1)->value, tem); + mpz_clear (tem); + } + else + cmp = mpz_cmp_si (XBIGNUM (num1)->value, XINT (num2)); + } else { eassume (BIGNUMP (num2)); @@ -2422,10 +2433,19 @@ bignumcompare (Lisp_Object num1, Lisp_Object num2, if (FLOATP (num1)) cmp = - mpz_cmp_d (XBIGNUM (num2)->value, XFLOAT_DATA (num1)); else - { + { eassume (FIXNUMP (num1)); - cmp = - mpz_cmp_si (XBIGNUM (num2)->value, XINT (num1)); - } + if (sizeof (EMACS_INT) > sizeof (long) && XINT (num1) > LONG_MAX) + { + mpz_t tem; + mpz_init (tem); + mpz_set_intmax (tem, XINT (num1)); + cmp = - mpz_cmp (XBIGNUM (num2)->value, tem); + mpz_clear (tem); + } + else + cmp = - mpz_cmp_si (XBIGNUM (num2)->value, XINT (num1)); + } } switch (comparison) @@ -2860,7 +2880,7 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) { /* Using args[argnum] as argument to CHECK_NUMBER... */ val = args[argnum]; - CHECK_NUMBER (val); + CHECK_NUMBER_COERCE_MARKER (val); if (FLOATP (val)) return unbind_to (count, @@ -2871,7 +2891,15 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) case Aadd: if (BIGNUMP (val)) mpz_add (accum, accum, XBIGNUM (val)->value); - else if (XINT (val) < 0) + else if (sizeof (EMACS_INT) > sizeof (long)) + { + mpz_t tem; + mpz_init (tem); + mpz_set_intmax (tem, XINT (val)); + mpz_add (accum, accum, tem); + mpz_clear (tem); + } + else if (XINT (val) < 0) mpz_sub_ui (accum, accum, - XINT (val)); else mpz_add_ui (accum, accum, XINT (val)); @@ -2888,6 +2916,14 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) } else if (BIGNUMP (val)) mpz_sub (accum, accum, XBIGNUM (val)->value); + else if (sizeof (EMACS_INT) > sizeof (long)) + { + mpz_t tem; + mpz_init (tem); + mpz_set_intmax (tem, XINT (val)); + mpz_sub (accum, accum, tem); + mpz_clear (tem); + } else if (XINT (val) < 0) mpz_add_ui (accum, accum, - XINT (val)); else @@ -2896,6 +2932,14 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) case Amult: if (BIGNUMP (val)) mpz_mul (accum, accum, XBIGNUM (val)->value); + else if (sizeof (EMACS_INT) > sizeof (long)) + { + mpz_t tem; + mpz_init (tem); + mpz_set_intmax (tem, XINT (val)); + mpz_mul (accum, accum, tem); + mpz_clear (tem); + } else mpz_mul_si (accum, accum, XINT (val)); break; @@ -2915,6 +2959,14 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) xsignal0 (Qarith_error); if (BIGNUMP (val)) mpz_tdiv_q (accum, accum, XBIGNUM (val)->value); + else if (sizeof (EMACS_INT) > sizeof (long)) + { + mpz_t tem; + mpz_init (tem); + mpz_set_intmax (tem, XINT (val)); + mpz_tdiv_q (accum, accum, tem); + mpz_clear (tem); + } else { EMACS_INT value = XINT (val); @@ -2982,8 +3034,9 @@ float_arith_driver (double accum, ptrdiff_t argnum, enum arithop code, for (; argnum < nargs; argnum++) { - val = args[argnum]; /* using args[argnum] as argument to CHECK_FIXNUM_... */ - CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (val); + /* using args[argnum] as argument to CHECK_NUMBER_... */ + val = args[argnum]; + CHECK_NUMBER_COERCE_MARKER (val); if (FLOATP (val)) { @@ -3277,7 +3330,7 @@ representation. */) if (BIGNUMP (value)) { - if (mpz_cmp_si (XBIGNUM (value)->value, 0) >= 0) + if (mpz_sgn (XBIGNUM (value)->value) >= 0) return make_fixnum (mpz_popcount (XBIGNUM (value)->value)); mpz_t tem; mpz_init (tem); @@ -3314,8 +3367,10 @@ ash_lsh_impl (Lisp_Object value, Lisp_Object count, bool lsh) mpz_init (result); if (XINT (count) >= 0) mpz_mul_2exp (result, XBIGNUM (value)->value, XINT (count)); - else + else if (lsh) mpz_tdiv_q_2exp (result, XBIGNUM (value)->value, - XINT (count)); + else + mpz_fdiv_q_2exp (result, XBIGNUM (value)->value, - XINT (count)); val = make_number (result); mpz_clear (result); } @@ -3325,14 +3380,21 @@ ash_lsh_impl (Lisp_Object value, Lisp_Object count, bool lsh) mpz_t result; eassume (FIXNUMP (value)); mpz_init (result); - if (lsh) - mpz_set_uintmax (result, XUINT (value)); - else - mpz_set_intmax (result, XINT (value)); + + mpz_set_intmax (result, XINT (value)); + if (XINT (count) >= 0) mpz_mul_2exp (result, result, XINT (count)); - else - mpz_tdiv_q_2exp (result, result, - XINT (count)); + else if (lsh) + { + if (mpz_sgn (result) > 0) + mpz_fdiv_q_2exp (result, result, - XINT (count)); + else + mpz_fdiv_q_2exp (result, result, - XINT (count)); + } + else /* ash */ + mpz_fdiv_q_2exp (result, result, - XINT (count)); + val = make_number (result); mpz_clear (result); } @@ -3414,7 +3476,7 @@ Markers are converted to integers. */) else { eassume (FIXNUMP (number)); - if (XINT (number) > MOST_POSITIVE_FIXNUM) + if (XINT (number) > MOST_NEGATIVE_FIXNUM) XSETINT (number, XINT (number) - 1); else { diff --git a/src/lisp.h b/src/lisp.h index 4208634fa9..b404f9d89a 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2778,7 +2778,7 @@ NATNUMP (Lisp_Object x) INLINE bool NUMBERP (Lisp_Object x) { - return INTEGERP (x) || FLOATP (x) || BIGNUMP (x); + return INTEGERP (x) || FLOATP (x); } INLINE bool @@ -2947,7 +2947,7 @@ CHECK_INTEGER (Lisp_Object x) if (MARKERP (x)) \ XSETFASTINT (x, marker_position (x)); \ else \ - CHECK_TYPE (FIXED_OR_FLOATP (x), Qnumber_or_marker_p, x); \ + CHECK_TYPE (FIXED_OR_FLOATP (x), Qnumber_or_marker_p, x); \ } while (false) #define CHECK_NUMBER_COERCE_MARKER(x) \ diff --git a/test/lisp/international/ccl-tests.el b/test/lisp/international/ccl-tests.el new file mode 100644 index 0000000000..d0c254ce91 --- /dev/null +++ b/test/lisp/international/ccl-tests.el @@ -0,0 +1,219 @@ +(require 'ert) +(require 'ccl) +(require 'seq) + + +(ert-deftest shift () + ;; shift left +ve 5628 #x00000000000015fc + (should (= (ash 5628 8) 1440768)) ; #x000000000015fc00 + (should (= (lsh 5628 8) 1440768)) ; #x000000000015fc00 + + ;; shift left -ve -5628 #x3fffffffffffea04 + (should (= (ash -5628 8) -1440768)) ; #x3fffffffffea0400 + (should (= (lsh -5628 8) -1440768)) ; #x3fffffffffea0400 + + ;; shift right +ve 5628 #x00000000000015fc + (should (= (ash 5628 -8) 21)) ; #x0000000000000015 + (should (= (lsh 5628 -8) 21)) ; #x0000000000000015 + + ;; shift right -ve -5628 #x3fffffffffffea04 + (should (= (ash -5628 -8) -22)) ; #x3fffffffffffffea + + ;; shift right -5628 #x3fffffffffffea04 + (cond + ((fboundp 'bignump) + (should (= (lsh -5628 -8) -22))) ; #x3fffffffffffffea bignum + ((= (logb most-negative-fixnum) 61) + (should (= (lsh -5628 -8) + (string-to-number + "18014398509481962")))) ; #x003fffffffffffea master (64bit) + ((= (logb most-negative-fixnum) 29) + (should (= (lsh -5628 -8) 4194282))) ; #x003fffea master (32bit) + )) + +;; CCl program from `pgg-parse-crc24' in lisp/obsolete/pgg-parse.el +(defconst prog-pgg-source + '(1 + ((loop + (read r0) (r1 ^= r0) (r2 ^= 0) + (r5 = 0) + (loop + (r1 <<= 1) + (r1 += ((r2 >> 15) & 1)) + (r2 <<= 1) + (if (r1 & 256) + ((r1 ^= 390) (r2 ^= 19707))) + (if (r5 < 7) + ((r5 += 1) + (repeat)))) + (repeat))))) + +(defconst prog-pgg-code + [1 30 14 114744 114775 0 161 131127 1 148217 15 82167 + 1 1848 131159 1 1595 5 256 114743 390 114775 19707 + 1467 16 7 183 1 -5628 -7164 22]) + +(defconst prog-pgg-dump +"Out-buffer must be as large as in-buffer. +Main-body: + 2:[read-register] read r0 (0 remaining) + 3:[set-assign-expr-register] r1 ^= r0 + 4:[set-assign-expr-const] r2 ^= 0 + 6:[set-short-const] r5 = 0 + 7:[set-assign-expr-const] r1 <<= 1 + 9:[set-expr-const] r7 = r2 >> 15 + 11:[set-assign-expr-const] r7 &= 1 + 13:[set-assign-expr-register] r1 += r7 + 14:[set-assign-expr-const] r2 <<= 1 + 16:[jump-cond-expr-const] if !(r1 & 256), jump to 23(+7) + 19:[set-assign-expr-const] r1 ^= 390 + 21:[set-assign-expr-const] r2 ^= 19707 + 23:[jump-cond-expr-const] if !(r5 < 7), jump to 29(+6) + 26:[set-assign-expr-const] r5 += 1 + 28:[jump] jump to 7(-21) + 29:[jump] jump to 2(-27) +At EOF: + 30:[end] end +") + +(ert-deftest ccl-compile-pgg () + (should (equal (ccl-compile prog-pgg-source) prog-pgg-code))) + +(ert-deftest ccl-dump-pgg () + (with-temp-buffer + (ccl-dump prog-pgg-code) + (should (equal (buffer-string) prog-pgg-dump)))) + +(ert-deftest pgg-parse-crc24 () + ;; Compiler + (require 'pgg) + (should (equal pgg-parse-crc24 prog-pgg-code)) + ;; Interpreter + (should (equal (pgg-parse-crc24-string "foo") (concat [#x4f #xc2 #x55]))) + (should (equal (pgg-parse-crc24-string "bar") (concat [#x51 #xd9 #x53]))) + (should (equal (pgg-parse-crc24-string "baz") (concat [#xf0 #x58 #x6a])))) + +(ert-deftest pgg-parse-crc24-dump () + ;; Disassembler + (require 'pgg) + (with-temp-buffer + (ccl-dump pgg-parse-crc24) + (should (equal (buffer-string) prog-pgg-dump)))) + +;;---------------------------------------------------------------------------- +;; Program from 'midikbd-decoder in midi-kbd-0.2.el GNU ELPA package +(defconst prog-midi-source + '(2 + (loop + (loop + ;; central message receiver loop here. + ;; When it exits, the command to deal with is in r0 + ;; Any arguments are in r1 and r2 + ;; r3 contains: 0 if no arguments are accepted + ;; 1 if 1 argument can be accepted + ;; 2 if 2 arguments can be accepted + ;; 3 if the first of two arguments has been accepted + ;; Arguments are read into r1 and r2. + ;; r4 contains the current running status byte if any. + (read-if (r0 < #x80) + (branch r3 + (repeat) + ((r1 = r0) (r0 = r4) (break)) + ((r1 = r0) (r3 = 3) (repeat)) + ((r2 = r0) (r3 = 2) (r0 = r4) (break)))) + (if (r0 >= #xf8) ; real time message + (break)) + (if (r0 < #xf0) ; channel command + ((r4 = r0) + (if ((r0 & #xe0) == #xc0) + ;; program change and channel pressure take only 1 argument + (r3 = 1) + (r3 = 2)) + (repeat))) + ;; system common message, we swallow those for now + (r3 = 0) + (repeat)) + (if ((r0 & #xf0) == #x90) + (if (r2 == 0) ; Some Midi devices use velocity 0 + ; for switching notes off, + ; so translate into note-off + ; and fall through + (r0 -= #x10) + ((r0 &= #xf) + (write 0) + (write r0 r1 r2) + (repeat)))) + (if ((r0 & #xf0) == #x80) + ((r0 &= #xf) + (write 1) + (write r0 r1 r2) + (repeat))) + (repeat)))) + +(defconst prog-midi-code + [2 72 4893 16 128 1133 5 6 9 12 16 -2556 32 1024 6660 32 865 + -4092 64 609 1024 4868 795 20 248 3844 3099 16 240 128 82169 + 224 1275 18 192 353 260 609 -9468 97 -9980 82169 240 4091 + 18 144 1371 18 0 16407 16 1796 81943 15 20 529 305 81 -14588 + 82169 240 2555 18 128 81943 15 276 529 305 81 -17660 -17916 22]) + +(defconst prog-midi-dump +"Out-buffer must be 2 times bigger than in-buffer. +Main-body: + 2:[read-jump-cond-expr-const] read r0, if !(r0 < 128), jump to 22(+20) + 5:[branch] jump to array[r3] of length 4 + 11 12 15 18 22 + 11:[jump] jump to 2(-9) + 12:[set-register] r1 = r0 + 13:[set-register] r0 = r4 + 14:[jump] jump to 41(+27) + 15:[set-register] r1 = r0 + 16:[set-short-const] r3 = 3 + 17:[jump] jump to 2(-15) + 18:[set-register] r2 = r0 + 19:[set-short-const] r3 = 2 + 20:[set-register] r0 = r4 + 21:[jump] jump to 41(+20) + 22:[jump-cond-expr-const] if !(r0 >= 248), jump to 26(+4) + 25:[jump] jump to 41(+16) + 26:[jump-cond-expr-const] if !(r0 < 240), jump to 39(+13) + 29:[set-register] r4 = r0 + 30:[set-expr-const] r7 = r0 & 224 + 32:[jump-cond-expr-const] if !(r7 == 192), jump to 37(+5) + 35:[set-short-const] r3 = 1 + 36:[jump] jump to 38(+2) + 37:[set-short-const] r3 = 2 + 38:[jump] jump to 2(-36) + 39:[set-short-const] r3 = 0 + 40:[jump] jump to 2(-38) + 41:[set-expr-const] r7 = r0 & 240 + 43:[jump-cond-expr-const] if !(r7 == 144), jump to 59(+16) + 46:[jump-cond-expr-const] if !(r2 == 0), jump to 52(+6) + 49:[set-assign-expr-const] r0 -= 16 + 51:[jump] jump to 59(+8) + 52:[set-assign-expr-const] r0 &= 15 + 54:[write-const-string] write char \"\x00\" + 55:[write-register] write r0 (2 remaining) + 56:[write-register] write r1 (1 remaining) + 57:[write-register] write r2 (0 remaining) + 58:[jump] jump to 2(-56) + 59:[set-expr-const] r7 = r0 & 240 + 61:[jump-cond-expr-const] if !(r7 == 128), jump to 71(+10) + 64:[set-assign-expr-const] r0 &= 15 + 66:[write-const-string] write char \"\x01\" + 67:[write-register] write r0 (2 remaining) + 68:[write-register] write r1 (1 remaining) + 69:[write-register] write r2 (0 remaining) + 70:[jump] jump to 2(-68) + 71:[jump] jump to 2(-69) +At EOF: + 72:[end] end +") + +(ert-deftest ccl-compile-midi () + (should (equal (ccl-compile prog-midi-source) prog-midi-code))) + +(ert-deftest ccl-dump-midi () + (with-temp-buffer + (ccl-dump prog-midi-code) + (should (equal (buffer-string) prog-midi-dump)))) commit f7d65a5e972ce8563e7b7861f6f7f3508f275f12 Author: Stephen Berman Date: Sat Aug 4 18:06:18 2018 +0200 Fix assorted todo-mode bugs (bug#32366) * lisp/calendar/todo-mode.el (todo-forward-category): Fix calculation for skipping backward over archived categories. (todo-jump-to-category): When hl-line-mode is enabled, force highlighting to compensate for apparent failure of post-command-hook to run. (todo-insert-item--basic): Prevent inserting a new todo item in an archive category. (todo-delete-item): Ensure done items separator disappears when the last done item is deleted. (todo-edit-item--header): Fix calculation for choosing a month prior to the current one. (todo-find-filtered-items-file): Fix use of completing-read, correcting typo in default value passed to it and confining history to filtered items files. (todo-go-to-source-item): Make a noop when point is not on an item. (todo-save-filtered-items-buffer): Make buffer read-only after saving and improve buffer name. (todo-key-bindings-t+a+f): Remove three mistakenly included bindings. (todo-key-bindings-t+a): Add two mistakenly omitted bindings. diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index 80bea25acd..6ff4d2a0a5 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -853,17 +853,17 @@ category. With non-nil argument BACK, visit the numerically previous category (the highest numbered one, if the current category is the first)." (interactive) - (setq todo-category-number - (1+ (mod (- todo-category-number (if back 2 0)) - (length todo-categories)))) - (when todo-skip-archived-categories - (while (and (zerop (todo-get-count 'todo)) - (zerop (todo-get-count 'done)) - (not (zerop (todo-get-count 'archived)))) - (setq todo-category-number - (funcall (if back #'1- #'1+) todo-category-number)))) - (todo-category-select) - (goto-char (point-min))) + (let ((setcatnum (lambda () (1+ (mod (- todo-category-number + (if back 2 0)) + (length todo-categories)))))) + (setq todo-category-number (funcall setcatnum)) + (when todo-skip-archived-categories + (while (and (zerop (todo-get-count 'todo)) + (zerop (todo-get-count 'done)) + (not (zerop (todo-get-count 'archived)))) + (setq todo-category-number (funcall setcatnum)))) + (todo-category-select) + (goto-char (point-min)))) (defun todo-backward-category () "Visit the numerically previous category in this todo file. @@ -933,6 +933,7 @@ Categories mode." (todo-category-number category) (todo-category-select) (goto-char (point-min)) + (if (and (boundp 'hl-line-mode) hl-line-mode) (hl-line-highlight)) (when add-item (todo-insert-item--basic)))))) (defun todo-next-item (&optional count) @@ -1896,7 +1897,10 @@ their associated keys and their effects." (new-item (cond (copy (todo-item-string)) (region (buffer-substring-no-properties (region-beginning) (region-end))) - (t (read-from-minibuffer "Todo item: ")))) + (t (if (eq major-mode 'todo-archive-mode) + (user-error (concat "Cannot insert a new Todo" + " item in an archive")) + (read-from-minibuffer "Todo item: "))))) (date-string (cond ((eq date-type 'date) (todo-read-date)) @@ -2083,7 +2087,14 @@ the item at point." (setq todo-categories-with-marks (assq-delete-all cat todo-categories-with-marks))) (todo-update-categories-sexp) - (todo-prefix-overlays))) + (todo-prefix-overlays) + (when (and (zerop (todo-get-count 'diary)) + (save-excursion + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote todo-category-done)) + nil t))) + (let (todo-show-with-done) (todo-category-select))))) (if ov (delete-overlay ov))))) (defvar todo-edit-item--param-key-alist) @@ -2326,7 +2337,7 @@ made in the number or names of categories." ((or (string= omonth "*") (= mm 13)) (user-error "Cannot increment *")) (t - (let ((mminc (+ mm inc))) + (let ((mminc (+ mm inc (if (< inc 0) 12 0)))) ;; Increment or decrement month by INC ;; modulo 12. (setq mm (% mminc 12)) @@ -4030,15 +4041,16 @@ regexp items." "Choose a filtered items file and visit it." (interactive) (let ((files (directory-files todo-directory t "\\.tod[rty]$" t)) - falist file) + falist sfnlist file) (dolist (f files) - (let ((type (cond ((equal (file-name-extension f) "todr") "regexp") + (let ((sf-name (todo-short-file-name f)) + (type (cond ((equal (file-name-extension f) "todr") "regexp") ((equal (file-name-extension f) "todt") "top") ((equal (file-name-extension f) "tody") "diary")))) - (push (cons (concat (todo-short-file-name f) " (" type ")") f) - falist))) + (push (cons (concat sf-name " (" type ")") f) falist))) + (setq sfnlist (mapcar #'car falist)) (setq file (completing-read "Choose a filtered items file: " - falist nil t nil nil (car falist))) + falist nil t nil 'sfnlist (caar falist))) (setq file (cdr (assoc-string file falist))) (find-file file) (unless (derived-mode-p 'todo-filtered-items-mode) @@ -4048,25 +4060,26 @@ regexp items." (defun todo-go-to-source-item () "Display the file and category of the filtered item at point." (interactive) - (let* ((str (todo-item-string)) - (buf (current-buffer)) - (res (todo-find-item str)) - (found (nth 0 res)) - (file (nth 1 res)) - (cat (nth 2 res))) - (if (not found) - (message "Category %s does not contain this item." cat) - (kill-buffer buf) - (set-window-buffer (selected-window) - (set-buffer (find-buffer-visiting file))) - (setq todo-current-todo-file file) - (setq todo-category-number (todo-category-number cat)) - (let ((todo-show-with-done (if (or todo-filter-done-items - (eq (cdr found) 'done)) - t - todo-show-with-done))) - (todo-category-select)) - (goto-char (car found))))) + (unless (looking-at "^$") ; Empty line at EOB. + (let* ((str (todo-item-string)) + (buf (current-buffer)) + (res (todo-find-item str)) + (found (nth 0 res)) + (file (nth 1 res)) + (cat (nth 2 res))) + (if (not found) + (message "Category %s does not contain this item." cat) + (kill-buffer buf) + (set-window-buffer (selected-window) + (set-buffer (find-buffer-visiting file))) + (setq todo-current-todo-file file) + (setq todo-category-number (todo-category-number cat)) + (let ((todo-show-with-done (if (or todo-filter-done-items + (eq (cdr found) 'done)) + t + todo-show-with-done))) + (todo-category-select)) + (goto-char (car found)))))) (defvar todo-multiple-filter-files nil "List of files selected from `todo-multiple-filter-files' widget.") @@ -4518,8 +4531,11 @@ its priority has changed, and `same' otherwise." (defun todo-save-filtered-items-buffer () "Save current Filtered Items buffer to a file. If the file already exists, overwrite it only on confirmation." - (let ((filename (or (buffer-file-name) (todo-filter-items-filename)))) - (write-file filename t))) + (let ((filename (or (buffer-file-name) (todo-filter-items-filename))) + (bufname (buffer-name))) + (write-file filename t) + (setq buffer-read-only t) + (rename-buffer bufname))) ;; ----------------------------------------------------------------------------- ;;; Printing Todo mode buffers @@ -6422,9 +6438,6 @@ Filtered Items mode following todo (not done) items." ("N" todo-toggle-prefix-numbers) ("PB" todo-print-buffer) ("PF" todo-print-buffer-to-file) - ("b" todo-backward-category) - ("d" todo-item-done) - ("f" todo-forward-category) ("j" todo-jump-to-category) ("n" todo-next-item) ("p" todo-previous-item) @@ -6439,6 +6452,8 @@ Filtered Items mode following todo (not done) items." ("Fc" todo-show-categories-table) ("S" todo-search) ("X" todo-clear-matches) + ("b" todo-backward-category) + ("f" todo-forward-category) ("*" todo-toggle-mark-item) ) "List of key bindings for Todo and Todo Archive modes.") commit 111916596fc8518cffcd0c32cf0f99e638f6ec24 Author: Noam Postavsky Date: Sat Aug 4 12:00:43 2018 -0400 ; (read-answer-short): Fix :version setting for backport diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el index 87c4079a95..a61c0adc8f 100644 --- a/lisp/emacs-lisp/map-ynp.el +++ b/lisp/emacs-lisp/map-ynp.el @@ -265,7 +265,7 @@ the function cell of `yes-or-no-p' is set to `y-or-on-p'." :type '(choice (const :tag "Accept short answers" t) (const :tag "Require long answer" nil) (const :tag "Guess preference" auto)) - :version "27.1" + :version "26.2" :group 'minibuffer) (defconst read-answer-map--memoize (make-hash-table :weakness 'key :test 'equal)) commit 84ecc48d1f9a98626977151aca332cfd4d7361b9 Author: Noam Postavsky Date: Mon Jul 30 21:02:07 2018 -0400 ; etc/NEWS: Remove read-answer, it was backported to v26 diff --git a/etc/NEWS b/etc/NEWS index 2d5032f32a..fa8a7afd52 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -969,10 +969,6 @@ higher-level functions. some years back. It now respects 'imagemagick-types-inhibit' as a way to disable that. -+++ -** The new function 'read-answer' accepts either long or short answers -depending on the new customizable variable 'read-answer-short'. - ** The function 'load' now behaves correctly when loading modules. Specifically, it puts the module name into 'load-history', prints loading messages if requested, and protects against recursive loads. commit 95050a5841c01bbcb6e8a82838881eee7879b7b9 Author: Noam Postavsky Date: Wed Jul 4 22:51:45 2018 -0400 Respect non-saved value of `read-short-answer' (Bug#31782) * lisp/emacs-lisp/map-ynp.el (read-answer-short): Add an `auto' setting. (read-answer): Check the function cell of `yes-or-no-p' when `read-answer-short' is `auto' rather than calling `custom-reevaluate-setting' which would reset the option to its saved value. diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el index 61c04ff7b3..87c4079a95 100644 --- a/lisp/emacs-lisp/map-ynp.el +++ b/lisp/emacs-lisp/map-ynp.el @@ -257,9 +257,14 @@ C-g to quit (cancel the whole command); ;; either long or short answers. ;; For backward compatibility check if short y/n answers are preferred. -(defcustom read-answer-short (eq (symbol-function 'yes-or-no-p) 'y-or-n-p) - "If non-nil, accept short answers to the question." - :type 'boolean +(defcustom read-answer-short 'auto + "If non-nil, `read-answer' accepts single-character answers. +If t, accept short (single key-press) answers to the question. +If nil, require long answers. If `auto', accept short answers if +the function cell of `yes-or-no-p' is set to `y-or-on-p'." + :type '(choice (const :tag "Accept short answers" t) + (const :tag "Require long answer" nil) + (const :tag "Guess preference" auto)) :version "27.1" :group 'minibuffer) @@ -290,8 +295,9 @@ When `read-answer-short' is non-nil, accept short answers. Return a long answer even in case of accepting short ones. When `use-dialog-box' is t, pop up a dialog window to get user input." - (custom-reevaluate-setting 'read-answer-short) - (let* ((short read-answer-short) + (let* ((short (if (eq read-answer-short 'auto) + (eq (symbol-function 'yes-or-no-p) 'y-or-n-p) + read-answer-short)) (answers-with-help (if (assoc "help" answers) answers commit d228de8a26fdda28f5414200f32be6e7adfdacf7 Merge: 529ec8df93 cc233365a9 Author: Noam Postavsky Date: Sat Aug 4 11:55:04 2018 -0400 ; Merge from emacs-26 The following commit was skipped: cc233365a9 New function read-answer (Bug#31782) commit 529ec8df9355116b165b4ec588693934137c88ca Merge: b6dd037445 f0b8e64fb7 Author: Noam Postavsky Date: Sat Aug 4 11:55:04 2018 -0400 Merge from emacs-26 f0b8e64fb7 Avoid assertion violations in maybe_produce_line_number 7669bf7880 Avoid assertion violations in set_text_properties_1 commit b6dd0374452177b2040044bce48d830692bf48f2 Merge: 6328d2ff6f 15458a8301 Author: Noam Postavsky Date: Sat Aug 4 11:55:03 2018 -0400 ; Merge from emacs-26 The following commit was skipped: 15458a8301 ; Auto-commit of loaddefs files. commit 6328d2ff6f4c6c845b610e8011a36d489d9445a2 Merge: c27bd469f1 951c5a127f Author: Noam Postavsky Date: Sat Aug 4 11:55:03 2018 -0400 Merge from emacs-26 951c5a127f Fix wdired test failure when byte compiled (bug#32318) 0252f7311f * test/lisp/wdired-tests.el (wdired-test-symlink-name): Ne... dd51434714 Fix url's thing-at-point beginning-op (Bug#32028) commit cc233365a925dcf9fa7270630819f2e6e75280da Author: Juri Linkov Date: Sun Jan 21 23:45:43 2018 +0200 New function read-answer (Bug#31782) * lisp/emacs-lisp/map-ynp.el (read-answer-short): New defcustom. (read-answer): New function. * lisp/subr.el (assoc-delete-all): New function. * etc/NEWS: Announce them. * lisp/dired.el (dired-delete-file): Use read-answer. (dired--yes-no-all-quit-help): Remove function. (dired-delete-help): Remove defconst. (backported from master, "New function read-answer (bug#30073)" and "Respect non-saved value of `read-short-answer' (Bug#31782)") diff --git a/etc/NEWS b/etc/NEWS index a27d1b89ec..a1c12a6766 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -110,6 +110,12 @@ be removed prior using the changed 'shadow-*' commands. * Lisp Changes in Emacs 26.2 +** The new function 'read-answer' accepts either long or short answers +depending on the new customizable variable 'read-answer-short'. + +** New function 'assoc-delete-all'. +Like 'assq-delete-all', but uses 'equal' for comparison. + * Changes in Emacs 26.2 on Non-Free Operating Systems diff --git a/lisp/dired.el b/lisp/dired.el index c421e51ffd..2520ed2a10 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -2995,37 +2995,6 @@ Any other value means to ask for each directory." ;; Match anything but `.' and `..'. (defvar dired-re-no-dot "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*") -(defconst dired-delete-help - "Type: -`yes' to delete recursively the current directory, -`no' to skip to next, -`all' to delete all remaining directories with no more questions, -`quit' to exit, -`help' to show this help message.") - -(defun dired--yes-no-all-quit-help (prompt &optional help-msg) - "Ask a question with valid answers: yes, no, all, quit, help. -PROMPT must end with '? ', for instance, 'Delete it? '. -If optional arg HELP-MSG is non-nil, then is a message to show when -the user answers 'help'. Otherwise, default to `dired-delete-help'." - (let ((valid-answers (list "yes" "no" "all" "quit")) - (answer "") - (input-fn (lambda () - (read-string - (format "%s [yes, no, all, quit, help] " prompt))))) - (setq answer (funcall input-fn)) - (when (string= answer "help") - (with-help-window "*Help*" - (with-current-buffer "*Help*" - (insert (or help-msg dired-delete-help))))) - (while (not (member answer valid-answers)) - (unless (string= answer "help") - (beep) - (message "Please answer `yes' or `no' or `all' or `quit'") - (sleep-for 2)) - (setq answer (funcall input-fn))) - answer)) - ;; Delete file, possibly delete a directory and all its files. ;; This function is useful outside of dired. One could change its name ;; to e.g. recursive-delete-file and put it somewhere else. @@ -3055,11 +3024,17 @@ TRASH non-nil means to trash the file instead of deleting, provided "trash" "delete") (dired-make-relative file)))) - (pcase (dired--yes-no-all-quit-help prompt) ; Prompt user. + (pcase (read-answer + prompt + '(("yes" ?y "delete recursively the current directory") + ("no" ?n "skip to next") + ("all" ?! "delete all remaining directories with no more questions") + ("quit" ?q "exit"))) ('"all" (setq recursive 'always dired-recursive-deletes recursive)) ('"yes" (if (eq recursive 'top) (setq recursive 'always))) ('"no" (setq recursive nil)) - ('"quit" (keyboard-quit))))) + ('"quit" (keyboard-quit)) + (_ (keyboard-quit))))) ; catch all unknown answers (setq recursive nil)) ; Empty dir or recursive is nil. (delete-directory file recursive trash)))) diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el index 2a7eddedad..8260af5727 100644 --- a/lisp/emacs-lisp/map-ynp.el +++ b/lisp/emacs-lisp/map-ynp.el @@ -256,4 +256,132 @@ the current %s and exit." ;; Return the number of actions that were taken. actions)) + +;; read-answer is a general-purpose question-asker that supports +;; either long or short answers. + +;; For backward compatibility check if short y/n answers are preferred. +(defcustom read-answer-short 'auto + "If non-nil, `read-answer' accepts single-character answers. +If t, accept short (single key-press) answers to the question. +If nil, require long answers. If `auto', accept short answers if +the function cell of `yes-or-no-p' is set to `y-or-on-p'." + :type '(choice (const :tag "Accept short answers" t) + (const :tag "Require long answer" nil) + (const :tag "Guess preference" auto)) + :version "26.2" + :group 'minibuffer) + +(defconst read-answer-map--memoize (make-hash-table :weakness 'key :test 'equal)) + +(defun read-answer (question answers) + "Read an answer either as a complete word or its character abbreviation. +Ask user a question and accept an answer from the list of possible answers. + +QUESTION should end in a space; this function adds a list of answers to it. + +ANSWERS is an alist with elements in the following format: + (LONG-ANSWER SHORT-ANSWER HELP-MESSAGE) +where + LONG-ANSWER is a complete answer, + SHORT-ANSWER is an abbreviated one-character answer, + HELP-MESSAGE is a string describing the meaning of the answer. + +Example: + \\='((\"yes\" ?y \"perform the action\") + (\"no\" ?n \"skip to the next\") + (\"all\" ?! \"accept all remaining without more questions\") + (\"help\" ?h \"show help\") + (\"quit\" ?q \"exit\")) + +When `read-answer-short' is non-nil, accept short answers. + +Return a long answer even in case of accepting short ones. + +When `use-dialog-box' is t, pop up a dialog window to get user input." + (let* ((short (if (eq read-answer-short 'auto) + (eq (symbol-function 'yes-or-no-p) 'y-or-n-p) + read-answer-short)) + (answers-with-help + (if (assoc "help" answers) + answers + (append answers '(("help" ?? "show this help message"))))) + (answers-without-help + (assoc-delete-all "help" (copy-alist answers-with-help))) + (prompt + (format "%s(%s) " question + (mapconcat (lambda (a) + (if short + (format "%c" (nth 1 a)) + (nth 0 a))) + answers-with-help ", "))) + (message + (format "Please answer %s." + (mapconcat (lambda (a) + (format "`%s'" (if short + (string (nth 1 a)) + (nth 0 a)))) + answers-with-help " or "))) + (short-answer-map + (when short + (or (gethash answers read-answer-map--memoize) + (puthash answers + (let ((map (make-sparse-keymap))) + (set-keymap-parent map minibuffer-local-map) + (dolist (a answers-with-help) + (define-key map (vector (nth 1 a)) + (lambda () + (interactive) + (delete-minibuffer-contents) + (insert (nth 0 a)) + (exit-minibuffer)))) + (define-key map [remap self-insert-command] + (lambda () + (interactive) + (delete-minibuffer-contents) + (beep) + (message message) + (sleep-for 2))) + map) + read-answer-map--memoize)))) + answer) + (while (not (assoc (setq answer (downcase + (cond + ((and (display-popup-menus-p) + last-input-event ; not during startup + (listp last-nonmenu-event) + use-dialog-box) + (x-popup-dialog + t + (cons question + (mapcar (lambda (a) + (cons (capitalize (nth 0 a)) + (nth 0 a))) + answers-with-help)))) + (short + (read-from-minibuffer + prompt nil short-answer-map nil + 'yes-or-no-p-history)) + (t + (read-from-minibuffer + prompt nil nil nil + 'yes-or-no-p-history))))) + answers-without-help)) + (if (string= answer "help") + (with-help-window "*Help*" + (with-current-buffer "*Help*" + (insert "Type:\n" + (mapconcat + (lambda (a) + (format "`%s'%s to %s" + (if short (string (nth 1 a)) (nth 0 a)) + (if short (format " (%s)" (nth 0 a)) "") + (nth 2 a))) + answers-with-help ",\n") + ".\n"))) + (beep) + (message message) + (sleep-for 2))) + answer)) + ;;; map-ynp.el ends here diff --git a/lisp/subr.el b/lisp/subr.el index f8ac70edef..7582b6cdb8 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -705,6 +705,21 @@ Non-strings in LIST are ignored." (setq list (cdr list))) list) +(defun assoc-delete-all (key alist) + "Delete from ALIST all elements whose car is `equal' to KEY. +Return the modified alist. +Elements of ALIST that are not conses are ignored." + (while (and (consp (car alist)) + (equal (car (car alist)) key)) + (setq alist (cdr alist))) + (let ((tail alist) tail-cdr) + (while (setq tail-cdr (cdr tail)) + (if (and (consp (car tail-cdr)) + (equal (car (car tail-cdr)) key)) + (setcdr tail (cdr tail-cdr)) + (setq tail tail-cdr)))) + alist) + (defun assq-delete-all (key alist) "Delete from ALIST all elements whose car is `eq' to KEY. Return the modified alist. diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index c0242137b3..bb0e1bc388 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -384,9 +384,9 @@ (dired-test-with-temp-dirs 'just-empty-dirs (let (asked) - (advice-add 'dired--yes-no-all-quit-help + (advice-add 'read-answer :override - (lambda (_) (setq asked t) "") + (lambda (_q _a) (setq asked t) "") '((name . dired-test-bug27940-advice))) (dired default-directory) (dired-toggle-marks) @@ -395,44 +395,44 @@ (progn (should-not asked) (should-not (dired-get-marked-files))) ; All dirs deleted. - (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice)))) + (advice-remove 'read-answer 'dired-test-bug27940-advice)))) ;; Answer yes (dired-test-with-temp-dirs nil - (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "yes") + (advice-add 'read-answer :override (lambda (_q _a) "yes") '((name . dired-test-bug27940-advice))) (dired default-directory) (dired-toggle-marks) (dired-do-delete nil) (unwind-protect (should-not (dired-get-marked-files)) ; All dirs deleted. - (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice))) + (advice-remove 'read-answer 'dired-test-bug27940-advice))) ;; Answer no (dired-test-with-temp-dirs nil - (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "no") + (advice-add 'read-answer :override (lambda (_q _a) "no") '((name . dired-test-bug27940-advice))) (dired default-directory) (dired-toggle-marks) (dired-do-delete nil) (unwind-protect (should (= 5 (length (dired-get-marked-files)))) ; Just the empty dirs deleted. - (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice))) + (advice-remove 'read-answer 'dired-test-bug27940-advice))) ;; Answer all (dired-test-with-temp-dirs nil - (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "all") + (advice-add 'read-answer :override (lambda (_q _a) "all") '((name . dired-test-bug27940-advice))) (dired default-directory) (dired-toggle-marks) (dired-do-delete nil) (unwind-protect (should-not (dired-get-marked-files)) ; All dirs deleted. - (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice))) + (advice-remove 'read-answer 'dired-test-bug27940-advice))) ;; Answer quit (dired-test-with-temp-dirs nil - (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "quit") + (advice-add 'read-answer :override (lambda (_q _a) "quit") '((name . dired-test-bug27940-advice))) (dired default-directory) (dired-toggle-marks) @@ -440,7 +440,7 @@ (dired-do-delete nil)) (unwind-protect (should (= 6 (length (dired-get-marked-files)))) ; All empty dirs but zeta-empty-dir deleted. - (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice)))) + (advice-remove 'read-answer 'dired-test-bug27940-advice)))) (provide 'dired-tests) commit c27bd469f1a6f962798caaa584c36ccbe5e42936 Author: Michael Albinus Date: Sat Aug 4 17:26:55 2018 +0200 * lisp/international/mule-cmds.el (universal-coding-system-argument): Use `current-input-mode' for determining quit char. diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index cf6a8c78d0..2bde83f4ea 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -300,8 +300,7 @@ wrong, use this command again to toggle back to the right mode." (cmd (key-binding keyseq)) prefix) ;; read-key-sequence ignores quit, so make an explicit check. - ;; Like many places, this assumes quit == C-g, but it need not be. - (if (equal last-input-event ?\C-g) + (if (equal last-input-event (nth 3 (current-input-mode))) (keyboard-quit)) (when (memq cmd '(universal-argument digit-argument)) (call-interactively cmd) @@ -314,16 +313,16 @@ wrong, use this command again to toggle back to the right mode." (let ((current-prefix-arg prefix-arg) ;; Have to bind `last-command-event' here so that ;; `digit-argument', for instance, can compute the - ;; prefix arg. + ;; `prefix-arg'. (last-command-event (aref keyseq 0))) (call-interactively cmd))) ;; This is the final call to `universal-argument-other-key', which - ;; set's the final `prefix-arg. + ;; sets the final `prefix-arg'. (let ((current-prefix-arg prefix-arg)) (call-interactively cmd)) - ;; Read the command to execute with the given prefix arg. + ;; Read the command to execute with the given `prefix-arg'. (setq prefix prefix-arg keyseq (read-key-sequence nil t) cmd (key-binding keyseq))) commit b9e2a91ec5b005c624eaca32064dc60b5f3131f9 Author: Michael Albinus Date: Sat Aug 4 12:05:28 2018 +0200 Rename Tramp method "owncloud" to "nextcloud" In the spirit of freedom, "nextcloud" is preferred over "owncloud". * doc/misc/tramp.texi (Quick Start Guide, GVFS based methods): * etc/NEWS: Rename "owncloud" method to "nextcloud". * lisp/net/tramp-gvfs.el (tramp-gvfs-methods, tramp-goa-methods) (tramp-gvfs-url-file-name, tramp-gvfs-handler-mounted-unmounted) (tramp-gvfs-connection-mounted-p, tramp-gvfs-mount-spec) (tramp-get-goa-accounts): Use "nextcloud" instead of "owncloud". (tramp-gvfs-nextcloud-default-prefix) (tramp-gvfs-nextcloud-default-prefix-regexp): Rename them. Adapt all callees. * test/lisp/net/tramp-tests.el (tramp--test-nextcloud-p): Rename from `tramp--test-owncloud-p'. (tramp-test11-copy-file, tramp-test12-rename-file): Use it. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 463f10e7d7..55c21b7efc 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -544,9 +544,9 @@ file system), @file{@trampfn{dav,user@@host,/path/to/file}} and @cindex method @option{gdrive} @cindex @option{gdrive} method @cindex google drive -@cindex method @option{owncloud} -@cindex @option{owncloud} method -@cindex nextcloud +@cindex method @option{nextcloud} +@cindex @option{nextcloud} method +@cindex owncloud GVFS-based methods include also @acronym{GNOME} Online Accounts, which support the @option{Files} service. These are the Google Drive file @@ -554,7 +554,7 @@ system, and the OwnCloud/NextCloud file system. The file name syntax is here always @file{@trampfn{gdrive,john.doe@@gmail.com,/path/to/file}} (@samp{john.doe@@gmail.com} stands here for your Google Drive -account), or @file{@trampfn{owncloud,user@@host#8081,/path/to/file}} +account), or @file{@trampfn{nextcloud,user@@host#8081,/path/to/file}} (@samp{8081} stands for the port number) for OwnCloud/NextCloud files. @@ -1096,7 +1096,7 @@ but with SSL encryption. Both methods support the port numbers. Paths being part of the WebDAV volume to be mounted by GVFS, as it is common for OwnCloud or NextCloud file names, are not supported by -these methods. See method @option{owncloud} for handling them. +these methods. See method @option{nextcloud} for handling them. @item @option{gdrive} @cindex method @option{gdrive} @@ -1114,13 +1114,13 @@ Since Google Drive uses cryptic blob file names internally, could produce unexpected behavior in case two files in the same directory have the same @code{display-name}, such a situation must be avoided. -@item @option{owncloud} +@item @option{nextcloud} @cindex @acronym{GNOME} Online Accounts -@cindex method @option{owncloud} -@cindex @option{owncloud} method -@cindex nextcloud +@cindex method @option{nextcloud} +@cindex @option{nextcloud} method +@cindex owncloud -As the name indicates, the method @option{owncloud} allows you to +As the name indicates, the method @option{nextcloud} allows you to access OwnCloud or NextCloud hosted files and directories. Like the @option{gdrive} method, your credentials must be populated in your @command{Online Accounts} application outside Emacs. The method @@ -1139,7 +1139,7 @@ that for security reasons refuse @command{ssh} connections. @defopt tramp-gvfs-methods This user option is a list of external methods for GVFS@. By default, this list includes @option{afp}, @option{dav}, @option{davs}, -@option{gdrive}, @option{owncloud} and @option{sftp}. Other methods +@option{gdrive}, @option{nextcloud} and @option{sftp}. Other methods to include are @option{ftp}, @option{http}, @option{https} and @option{smb}. These methods are not intended to be used directly as GVFS based method. Instead, they are added here for the benefit of diff --git a/etc/NEWS b/etc/NEWS index 9c78bd5a05..2d5032f32a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -598,7 +598,7 @@ process. It now accepts signals specified either by name or by its number. ** Tramp +++ -*** New connection method "owncloud", which allows to access OwnCloud +*** New connection method "nextcloud", which allows to access OwnCloud or NextCloud hosted files and directories. +++ diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 1f40339c27..84af410de0 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -49,9 +49,9 @@ ;; The user option `tramp-gvfs-methods' contains the list of supported ;; connection methods. Per default, these are "afp", "dav", "davs", -;; "gdrive", "owncloud" and "sftp". +;; "gdrive", "nextcloud" and "sftp". -;; "gdrive" and "owncloud" connection methods require a respective +;; "gdrive" and "nextcloud" connection methods require a respective ;; account in GNOME Online Accounts, with enabled "Files" service. ;; Other possible connection methods are "ftp", "http", "https" and @@ -121,7 +121,7 @@ ;;;###tramp-autoload (defcustom tramp-gvfs-methods - '("afp" "dav" "davs" "gdrive" "owncloud" "sftp") + '("afp" "dav" "davs" "gdrive" "nextcloud" "sftp") "List of methods for remote files, accessed with GVFS." :group 'tramp :version "27.1" @@ -132,11 +132,11 @@ (const "gdrive") (const "http") (const "https") - (const "owncloud") + (const "nextcloud") (const "sftp") (const "smb")))) -(defconst tramp-goa-methods '("gdrive" "owncloud") +(defconst tramp-goa-methods '("gdrive" "nextcloud") "List of methods which require registration at GNOME Online Accounts.") ;; Remove GNOME Online Accounts methods if not supported. @@ -511,11 +511,11 @@ It has been changed in GVFS 1.14.") ":[[:blank:]]+\\(.*\\)$") "Regexp to parse GVFS file system attributes with `gvfs-info'.") -(defconst tramp-gvfs-owncloud-default-prefix "/remote.php/webdav" +(defconst tramp-gvfs-nextcloud-default-prefix "/remote.php/webdav" "Default prefix for owncloud / nextcloud methods.") -(defconst tramp-gvfs-owncloud-default-prefix-regexp - (concat (regexp-quote tramp-gvfs-owncloud-default-prefix) "$") +(defconst tramp-gvfs-nextcloud-default-prefix-regexp + (concat (regexp-quote tramp-gvfs-nextcloud-default-prefix) "$") "Regexp of default prefix for owncloud / nextcloud methods.") @@ -1380,7 +1380,7 @@ file-notify events." (with-parsed-tramp-file-name filename nil (when (string-equal "gdrive" method) (setq method "google-drive")) - (when (string-equal "owncloud" method) + (when (string-equal "nextcloud" method) (setq method "davs" localname (concat (tramp-gvfs-get-remote-prefix v) localname))) @@ -1543,8 +1543,8 @@ file-notify events." (setq method "davs")) (when (and (string-equal "davs" method) (string-match - tramp-gvfs-owncloud-default-prefix-regexp prefix)) - (setq method "owncloud")) + tramp-gvfs-nextcloud-default-prefix-regexp prefix)) + (setq method "nextcloud")) (when (string-equal "google-drive" method) (setq method "gdrive")) (when (and (string-equal "http" method) (stringp uri)) @@ -1633,8 +1633,8 @@ file-notify events." (setq method "davs")) (when (and (string-equal "davs" method) (string-match - tramp-gvfs-owncloud-default-prefix-regexp prefix)) - (setq method "owncloud")) + tramp-gvfs-nextcloud-default-prefix-regexp prefix)) + (setq method "nextcloud")) (when (string-equal "google-drive" method) (setq method "gdrive")) (when (and (string-equal "http" method) (stringp uri)) @@ -1688,7 +1688,7 @@ It was \"a(say)\", but has changed to \"a{sv})\"." (localname (tramp-file-name-unquote-localname vec)) (share (when (string-match "^/?\\([^/]+\\)" localname) (match-string 1 localname))) - (ssl (if (string-match "^davs\\|^owncloud" method) "true" "false")) + (ssl (if (string-match "^davs\\|^nextcloud" method) "true" "false")) (mount-spec `(:array ,@(cond @@ -1696,7 +1696,7 @@ It was \"a(say)\", but has changed to \"a{sv})\"." (list (tramp-gvfs-mount-spec-entry "type" "smb-share") (tramp-gvfs-mount-spec-entry "server" host) (tramp-gvfs-mount-spec-entry "share" share))) - ((string-match "^dav\\|^owncloud" method) + ((string-match "^dav\\|^nextcloud" method) (list (tramp-gvfs-mount-spec-entry "type" "dav") (tramp-gvfs-mount-spec-entry "host" host) (tramp-gvfs-mount-spec-entry "ssl" ssl))) @@ -1707,6 +1707,9 @@ It was \"a(say)\", but has changed to \"a{sv})\"." ((string-equal "gdrive" method) (list (tramp-gvfs-mount-spec-entry "type" "google-drive") (tramp-gvfs-mount-spec-entry "host" host))) + ((string-equal "nextcloud" method) + (list (tramp-gvfs-mount-spec-entry "type" "owncloud") + (tramp-gvfs-mount-spec-entry "host" host))) ((string-match "^http" method) (list (tramp-gvfs-mount-spec-entry "type" "http") (tramp-gvfs-mount-spec-entry @@ -1980,6 +1983,8 @@ VEC is used only for traces." :port (match-string 3 identity))) (when (string-equal (tramp-goa-name-method key) "google") (setf (tramp-goa-name-method key) "gdrive")) + (when (string-equal (tramp-goa-name-method key) "owncloud") + (setf (tramp-goa-name-method key) "nextcloud")) ;; Cache all properties. (dolist (prop (nconc account-properties files-properties)) (tramp-set-connection-property key (car prop) (cdr prop))) @@ -2086,7 +2091,7 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi." ;; * (Customizable) unmount when exiting Emacs. See tramp-archive.el. ;; * Host name completion for existing mount points (afp-server, -;; smb-server, google-drive, owncloud) or via smb-network or network. +;; smb-server, google-drive, nextcloud) or via smb-network or network. ;; ;; * Check, how two shares of the same SMB server can be mounted in ;; parallel. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 5c5eff8798..c0298bb709 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2182,7 +2182,7 @@ This checks also `file-name-as-directory', `file-name-directory', (unwind-protect ;; FIXME: This fails on my QNAP server, see ;; /share/Web/owncloud/data/owncloud.log - (unless (tramp--test-owncloud-p) + (unless (tramp--test-nextcloud-p) (write-region "foo" nil source) (should (file-exists-p source)) (make-directory target) @@ -2205,7 +2205,7 @@ This checks also `file-name-as-directory', `file-name-directory', (unwind-protect ;; FIXME: This fails on my QNAP server, see ;; /share/Web/owncloud/data/owncloud.log - (unless (and (tramp--test-owncloud-p) + (unless (and (tramp--test-nextcloud-p) (or (not (file-remote-p source)) (not (file-remote-p target)))) (make-directory source) @@ -2231,7 +2231,7 @@ This checks also `file-name-as-directory', `file-name-directory', ;; FIXME: This fails on my QNAP server, see ;; /share/Web/owncloud/data/owncloud.log (unless - (and (tramp--test-owncloud-p) (not (file-remote-p source))) + (and (tramp--test-nextcloud-p) (not (file-remote-p source))) (make-directory source) (should (file-directory-p source)) (write-region "foo" nil (expand-file-name "foo" source)) @@ -2320,7 +2320,7 @@ This checks also `file-name-as-directory', `file-name-directory', (unwind-protect ;; FIXME: This fails on my QNAP server, see ;; /share/Web/owncloud/data/owncloud.log - (unless (tramp--test-owncloud-p) + (unless (tramp--test-nextcloud-p) (make-directory source) (should (file-directory-p source)) (write-region "foo" nil (expand-file-name "foo" source)) @@ -2344,7 +2344,7 @@ This checks also `file-name-as-directory', `file-name-directory', (unwind-protect ;; FIXME: This fails on my QNAP server, see ;; /share/Web/owncloud/data/owncloud.log - (unless (tramp--test-owncloud-p) + (unless (tramp--test-nextcloud-p) (make-directory source) (should (file-directory-p source)) (write-region "foo" nil (expand-file-name "foo" source)) @@ -4427,10 +4427,10 @@ This does not support external Emacs calls." (string-equal "mock" (file-remote-p tramp-test-temporary-file-directory 'method))) -(defun tramp--test-owncloud-p () - "Check, whether the owncloud method is used." +(defun tramp--test-nextcloud-p () + "Check, whether the nextcloud method is used." (string-equal - "owncloud" (file-remote-p tramp-test-temporary-file-directory 'method))) + "nextcloud" (file-remote-p tramp-test-temporary-file-directory 'method))) (defun tramp--test-rsync-p () "Check, whether the rsync method is used. commit 5dc3d0a9b0594fee80a03e78fee109ebd0934dcf Author: Ken Brown Date: Fri Aug 3 10:37:04 2018 -0400 Fix a filenotify test failure on Cygwin * test/lisp/filenotify-tests.el (file-notify-test04-autorevert): Increase a sleep-for time from 2 to 3 on Cygwin. This avoids sporadic failures of the test. (Bug#32363) diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el index 56403f4309..612ea8cd7f 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el @@ -891,9 +891,9 @@ delivered." ;; Modify file. We wait for two seconds, in order to ;; have another timestamp. One second seems to be too - ;; short. + ;; short. And Cygwin sporadically requires more than two. (ert-with-message-capture captured-messages - (sleep-for 2) + (sleep-for (if (eq system-type 'cygwin) 3 2)) (write-region "foo bla" nil file-notify--test-tmpfile nil 'no-message) commit da0054c30729e58259c1e7251cb03c8ef13ff943 Merge: e65ec81fc3 95b2ab3dcc Author: Gemini Lasswell Date: Fri Aug 3 10:28:28 2018 -0700 Merge branch 'scratch/backtrace-mode' commit 95b2ab3dccdc756614b4c8f45a7b206d61753705 Author: Gemini Lasswell Date: Wed Aug 1 07:47:12 2018 -0700 Fix some documentation formatting nits * doc/misc/ert.texi (Running Tests Interactively): Correct Elisp manual titile in xref. * doc/lispref/edebug.texi (Edebug Misc): Use single argument form of xref. * doc/lispref/debugging.texi (Backtraces): Add comma and period after xref braces. (Backtraces): Correct Emacs manual title. (Internals of Debugger): Add a space before period. diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi index 841b16eaf9..9b3ba6cf7e 100644 --- a/doc/lispref/debugging.texi +++ b/doc/lispref/debugging.texi @@ -402,8 +402,8 @@ assumptions are false if the debugger is running interpreted. @cindex backtrace buffer Debugger mode is derived from Backtrace mode, which is also used to -show backtraces by Edebug and ERT. (@pxref{Edebug} and @ref{Top,the -ERT manual,, ert, ERT: Emacs Lisp Regression Testing}) +show backtraces by Edebug and ERT. (@pxref{Edebug}, and @ref{Top,the +ERT manual,, ert, ERT: Emacs Lisp Regression Testing}.) @cindex stack frame The backtrace buffer shows you the functions that are executing and @@ -423,9 +423,9 @@ source code is located. You can click with the mouse on that name, or move to it and type @key{RET}, to visit the source code. You can also type @key{RET} while point is on any name of a function or variable which is not underlined, to see help information for that symbol in a -help buffer, if any exists. The @code{xref-find-definitions} command, +help buffer, if any exists. The @code{xref-find-definitions} command, bound to @key{M-.}, can also be used on any identifier in a backtrace -(@pxref{Looking Up Identifiers,,,emacs,Emacs manual}). +(@pxref{Looking Up Identifiers,,,emacs, The GNU Emacs Manual}). In backtraces, the tails of long lists and the ends of long strings, vectors or structures, as well as objects which are deeply nested, @@ -690,7 +690,7 @@ Each line of the backtrace represents one function call. The line shows the function followed by a list of the values of the function's arguments if they are all known; if they are still being computed, the line consists of a list containing the function and its unevaluated -arguments. Long lists or deeply nested structures may be elided. +arguments. Long lists or deeply nested structures may be elided. @smallexample @group diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index 59c9a68c54..54200b9990 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -442,7 +442,7 @@ Redisplay the most recently known expression result in the echo area Display a backtrace, excluding Edebug's own functions for clarity (@code{edebug-backtrace}). -@xref{Debugging,, Backtraces, elisp}, for a description of backtraces +@xref{Backtraces}, for a description of backtraces and the commands which work on them. If you would like to see Edebug's functions in the backtrace, diff --git a/doc/misc/ert.texi b/doc/misc/ert.texi index e2aeeb1353..6a34f5c572 100644 --- a/doc/misc/ert.texi +++ b/doc/misc/ert.texi @@ -276,7 +276,7 @@ Pressing @kbd{r} re-runs the test near point on its own. Pressing definition of the test near point (@kbd{@key{RET}} has the same effect if point is on the name of the test). On a failed test, @kbd{b} shows the backtrace of the failure. @xref{Debugging,, Backtraces, elisp, -the Emacs Lisp Reference Manual}, for more information about +GNU Emacs Lisp Reference Manual}, for more information about backtraces. @kindex l@r{, in ert results buffer} diff --git a/etc/NEWS b/etc/NEWS index 53b7765627..9c78bd5a05 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -471,7 +471,7 @@ and case-sensitivity together with search strings in the search ring. +++ *** The Lisp Debugger is now based on 'backtrace-mode'. Backtrace mode adds fontification and commands for changing the -appearance of backtrace frames. See the node "Backtraces" in the Elisp +appearance of backtrace frames. See the node "Backtraces" in the Elisp manual for documentation of the new mode and its commands. ** Edebug @@ -484,9 +484,9 @@ using the new variables 'edebug-behavior-alist', globally or for individual definitions. +++ -*** Edebug's backtrace buffer now uses 'backtrace-mode'. Backtrace -mode adds fontification, links and commands for changing the -appearance of backtrace frames. See the node "Backtraces" in the Elisp +*** Edebug's backtrace buffer now uses 'backtrace-mode'. +Backtrace mode adds fontification, links and commands for changing the +appearance of backtrace frames. See the node "Backtraces" in the Elisp manual for documentation of the new mode and its commands. The binding of 'd' in Edebug's keymap is now 'edebug-pop-to-backtrace' @@ -523,7 +523,7 @@ less verbose by removing non-essential information. +++ *** ERT's backtrace buffer now uses 'backtrace-mode'. Backtrace mode adds fontification and commands for changing the -appearance of backtrace frames. See the node "Backtraces" in the Elisp +appearance of backtrace frames. See the node "Backtraces" in the Elisp manual for documentation of the new mode and its commands. ** Gamegrid @@ -702,7 +702,7 @@ used by the Language Server Protocol (LSP), is readily available. ** Backtrace mode improves viewing of Elisp backtraces. Backtrace mode adds pretty printing, fontification and ellipsis expansion to backtrace buffers produced by the Lisp debugger, Edebug -and ERT. See the node "Backtraces" in the Elisp manual for +and ERT. See the node "Backtraces" in the Elisp manual for documentation of the new mode and its commands. commit 58be6cb6bbb2cc7b1c35c0fc30b6f4f9b111eb77 Author: Gemini Lasswell Date: Fri Jul 27 12:37:10 2018 -0700 Fix typo in edebug-backtrace-hide-instrumentation's docstring. * lisp/emacs-lisp/edebug.el (edebug-backtrace-hide-instrumentation): Fix docstring copypasta. diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index fc295485fd..fa418c6828 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -4108,7 +4108,7 @@ Save DEF-NAME, BEFORE-INDEX and AFTER-INDEX in FRAME." (revert-buffer))) (defun edebug-backtrace-hide-instrumentation () - "Show Edebug's instrumentation in an Edebug Backtrace buffer." + "Hide Edebug's instrumentation in an Edebug Backtrace buffer." (interactive) (unless (eq backtrace-frames edebug-backtrace-frames) (setq backtrace-frames edebug-backtrace-frames) commit 3cd6a6846b5f8f67216eba61b761a0e1daff7895 Author: Gemini Lasswell Date: Sat Jul 21 12:27:32 2018 -0700 Give two backtrace-mode commands better names * lisp/emacs-lisp/backtrace.el (backtrace-mode-map): Update bindings and menu items with new function names. (backtrace-collapse, backtrace-pretty-print) (backtrace--collapse, backtrace--pretty-print): Remove functions. (backtrace-single-line, backtrace-multi-line) (backtrace--single-line, backtrace--multi-line): New functions. (backtrace--reformat-sexp): Remove 'error-message' argument. * test/lisp/emacs-lisp/backtrace-tests.el (backtrace-tests--pretty-print-and-collapse): Remove. (backtrace-tests--single-and-multi-line): New test. (backtrace-tests--verify-pp-and-collapse): Remove. (backtrace-tests--verify-single-and-multi-line): New function. diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el index d162983c01..f13b43b465 100644 --- a/lisp/emacs-lisp/backtrace.el +++ b/lisp/emacs-lisp/backtrace.el @@ -206,8 +206,8 @@ frames where the source code location is known.") (define-key map "#" 'backtrace-toggle-print-circle) (define-key map "s" 'backtrace-goto-source) (define-key map "\C-m" 'backtrace-help-follow-symbol) - (define-key map "+" 'backtrace-pretty-print) - (define-key map "-" 'backtrace-collapse) + (define-key map "+" 'backtrace-multi-line) + (define-key map "-" 'backtrace-single-line) (define-key map "." 'backtrace-expand-ellipses) (define-key map [follow-link] 'mouse-face) (define-key map [mouse-2] 'mouse-select-window) @@ -225,9 +225,9 @@ frames where the source code location is known.") :help "Show or hide the local variables for the frame at point"] ["Expand \"...\"s" backtrace-expand-ellipses :help "Expand all the abbreviated forms in the current frame"] - ["Show on Multiple Lines" backtrace-pretty-print + ["Show on Multiple Lines" backtrace-multi-line :help "Use line breaks and indentation to make a form more readable"] - ["Collapse to Single Line" backtrace-collapse] + ["Show on Single Line" backtrace-single-line] "--" ["Go to Source" backtrace-goto-source :active (and (backtrace-get-index) @@ -524,37 +524,36 @@ initial state of the Backtrace buffer." (push-button (point))) (goto-char next)))))) -(defun backtrace-pretty-print () - "Pretty-print the top level s-expression at point." +(defun backtrace-multi-line () + "Show the top level s-expression at point on multiple lines with indentation." (interactive) - (backtrace--reformat-sexp #'backtrace--pretty-print - "No form here to pretty-print")) + (backtrace--reformat-sexp #'backtrace--multi-line)) -(defun backtrace--pretty-print () +(defun backtrace--multi-line () "Pretty print the current buffer, then remove the trailing newline." (set-syntax-table emacs-lisp-mode-syntax-table) (pp-buffer) (goto-char (1- (point-max))) (delete-char 1)) -(defun backtrace-collapse () - "Collapse the top level s-expression at point onto one line." +(defun backtrace-single-line () + "Show the top level s-expression at point on one line." (interactive) - (backtrace--reformat-sexp #'backtrace--collapse "No form here to collapse")) + (backtrace--reformat-sexp #'backtrace--single-line)) -(defun backtrace--collapse () +(defun backtrace--single-line () "Replace line breaks and following indentation with spaces. Works on the current buffer." (goto-char (point-min)) (while (re-search-forward "\n[[:blank:]]*" nil t) (replace-match " "))) -(defun backtrace--reformat-sexp (format-function error-message) +(defun backtrace--reformat-sexp (format-function) "Reformat the top level sexp at point. Locate the top level sexp at or following point on the same line, and reformat it with FORMAT-FUNCTION, preserving the location of point within the sexp. If no sexp is found before the end of -the line or buffer, show ERROR-MESSAGE instead. +the line or buffer, signal an error. FORMAT-FUNCTION will be called without arguments, with the current buffer set to a temporary buffer containing only the @@ -567,7 +566,7 @@ content of the sexp." nil (point-min)))) (unless tag (when (or (= end (point-max)) (> end (point-at-eol))) - (user-error error-message)) + (user-error "No form here to reformat")) (goto-char end) (setq pos end end (next-single-property-change pos 'backtrace-form) @@ -752,10 +751,9 @@ Format it according to VIEW." (insert (backtrace--print-to-string args (max (truncate (/ backtrace-line-length 5)) (- backtrace-line-length (- (point) beg))))) - ;; The backtrace-form property is so that - ;; backtrace-pretty-print will find it. - ;; backtrace-pretty-print doesn't do anything useful with it, - ;; just being consistent. + ;; The backtrace-form property is so that backtrace-multi-line + ;; will find it. backtrace-multi-line doesn't do anything + ;; useful with it, just being consistent. (let ((start (point))) (insert "()") (put-text-property start (point) 'backtrace-form t)))) diff --git a/test/lisp/emacs-lisp/backtrace-tests.el b/test/lisp/emacs-lisp/backtrace-tests.el index ff26112ab9..edd45c770c 100644 --- a/test/lisp/emacs-lisp/backtrace-tests.el +++ b/test/lisp/emacs-lisp/backtrace-tests.el @@ -222,9 +222,9 @@ (goto-char (point-max)) (should-error (backtrace-forward-frame))))) -(ert-deftest backtrace-tests--pretty-print-and-collapse () - "Forms in backtrace frames can be pretty-printed and collapsed." - (ert-with-test-buffer (:name "pp-and-collapse") +(ert-deftest backtrace-tests--single-and-multi-line () + "Forms in backtrace frames can be on a single line or on multiple lines." + (ert-with-test-buffer (:name "single-multi-line") (let* ((arg '(lambda (x) ; Quote this so it isn't made into a closure. (let ((number (1+ x))) (+ x number)))) @@ -249,25 +249,25 @@ results)) ;; Check pp and collapse for the form in the header. (goto-char (point-min)) - (backtrace-tests--verify-pp-and-collapse header) + (backtrace-tests--verify-single-and-multi-line header) ;; Check pp and collapse for the last frame. (goto-char (point-max)) (backtrace-backward-frame) - (backtrace-tests--verify-pp-and-collapse last-line) + (backtrace-tests--verify-single-and-multi-line last-line) ;; Check pp and collapse for local variables in the last line. (goto-char (point-max)) (backtrace-backward-frame) (backtrace-toggle-locals) (forward-line) - (backtrace-tests--verify-pp-and-collapse last-line-locals)))) + (backtrace-tests--verify-single-and-multi-line last-line-locals)))) -(defun backtrace-tests--verify-pp-and-collapse (line) - "Verify that `backtrace-pretty-print' and `backtrace-collapse' work at point. +(defun backtrace-tests--verify-single-and-multi-line (line) + "Verify that `backtrace-single-line' and `backtrace-multi-line' work at point. Point should be at the beginning of a line, and LINE should be a string containing the text of the line at point. Assume that the line contains the strings \"lambda\" and \"number\"." (let ((pos (point))) - (backtrace-pretty-print) + (backtrace-multi-line) ;; Verify point is still at the start of the line. (should (= pos (point)))) @@ -276,7 +276,7 @@ line contains the strings \"lambda\" and \"number\"." (search-forward "number") (should-not (= pos (point-at-bol)))) ;; Collapse the form. - (backtrace-collapse) + (backtrace-single-line) ;; Verify that the form is now back on one line, ;; and that point is at the same place. (should (string= (backtrace-tests--get-substring commit 83af893fc0e7cc87c0fb0626fb48ef96e00b3f8b Author: Gemini Lasswell Date: Wed Jul 18 08:30:45 2018 -0700 Move 'backtrace' from subr.el to backtrace.el * lisp/subr.el (backtrace, backtrace--print-frame): Remove functions. * lisp/emacs-lisp/backtrace.el (backtrace-backtrace): Remove function. (backtrace): New function. (backtrace-to-string): Make argument optional. * doc/lispref/debugging.texi (Internals of Debugger): Update description of 'backtrace' function. diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi index 87429a67ba..841b16eaf9 100644 --- a/doc/lispref/debugging.texi +++ b/doc/lispref/debugging.texi @@ -678,20 +678,19 @@ of @code{debug} (@pxref{Invoking the Debugger}). @cindex run time stack @cindex call stack This function prints a trace of Lisp function calls currently active. -This is the function used by @code{debug} to fill up the -@file{*Backtrace*} buffer. It is written in C, since it must have access -to the stack to determine which function calls are active. The return -value is always @code{nil}. +The trace is identical to the one that @code{debug} would show in the +@file{*Backtrace*} buffer. The return value is always nil. In the following example, a Lisp expression calls @code{backtrace} explicitly. This prints the backtrace to the stream @code{standard-output}, which, in this case, is the buffer @samp{backtrace-output}. -Each line of the backtrace represents one function call. The line shows -the values of the function's arguments if they are all known; if they -are still being computed, the line says so. The arguments of special -forms are elided. +Each line of the backtrace represents one function call. The line +shows the function followed by a list of the values of the function's +arguments if they are all known; if they are still being computed, the +line consists of a list containing the function and its unevaluated +arguments. Long lists or deeply nested structures may be elided. @smallexample @group @@ -708,7 +707,7 @@ forms are elided. @group ----------- Buffer: backtrace-output ------------ backtrace() - (list ...computing arguments...) + (list 'testing (backtrace)) @end group (progn ...) eval((progn (1+ var) (list 'testing (backtrace)))) @@ -739,7 +738,7 @@ example would look as follows: @group ----------- Buffer: backtrace-output ------------ (backtrace) - (list ...computing arguments...) + (list 'testing (backtrace)) @end group (progn ...) (eval (progn (1+ var) (list 'testing (backtrace)))) diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el index 5169c30503..d162983c01 100644 --- a/lisp/emacs-lisp/backtrace.el +++ b/lisp/emacs-lisp/backtrace.el @@ -891,14 +891,18 @@ followed by `backtrace-print-frame', once for each stack frame." ;;; Backtrace printing -(defun backtrace-backtrace () +;;;###autoload +(defun backtrace () "Print a trace of Lisp function calls currently active. Output stream used is value of `standard-output'." - (princ (backtrace-to-string (backtrace-get-frames 'backtrace-backtrace)))) + (princ (backtrace-to-string (backtrace-get-frames 'backtrace))) + nil) -(defun backtrace-to-string(frames) +(defun backtrace-to-string(&optional frames) "Format FRAMES, a list of `backtrace-frame' objects, for output. -Return the result as a string." +Return the result as a string. If FRAMES is nil, use all +function calls currently active." + (unless frames (setq frames (backtrace-get-frames 'backtrace-to-string))) (let ((backtrace-fontify nil)) (with-temp-buffer (backtrace-mode) diff --git a/lisp/subr.el b/lisp/subr.el index f8c19efc37..fbb3e49a35 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -4687,25 +4687,6 @@ The properties used on SYMBOL are `composefunc', `sendfunc', (put symbol 'hookvar (or hookvar 'mail-send-hook))) -(defun backtrace--print-frame (evald func args flags) - "Print a trace of a single stack frame to `standard-output'. -EVALD, FUNC, ARGS, FLAGS are as in `mapbacktrace'." - (princ (if (plist-get flags :debug-on-exit) "* " " ")) - (cond - ((and evald (not debugger-stack-frame-as-list)) - (cl-prin1 func) - (if args (cl-prin1 args) (princ "()"))) - (t - (cl-prin1 (cons func args)))) - (princ "\n")) - -(defun backtrace () - "Print a trace of Lisp function calls currently active. -Output stream used is value of `standard-output'." - (let ((print-level (or print-level 8)) - (print-escape-control-characters t)) - (mapbacktrace #'backtrace--print-frame 'backtrace))) - (defun backtrace-frames (&optional base) "Collect all frames of current backtrace into a list. If non-nil, BASE should be a function, and frames before its commit ca98377280005344fb07c816997b9bc2a737056a Author: Gemini Lasswell Date: Tue Jul 17 11:47:43 2018 -0700 Add new commands to Edebug backtraces Add commands to go to source if available, and to show and hide Edebug's instrumentation. Make Edebug pop to backtraces instead of displaying them, which makes Edebug consistant with the behavior of ERT and the Lisp Debugger. * doc/lispref/edebug.texi (Edebug Misc): Document when and how you can jump to source code from an Edebug backtrace. Document 'edebug-backtrace-show-instrumentation' and 'edebug-backtrace-hide-instrumentation'. * lisp/emacs-lisp/backtrace.el (backtrace-frame): Add comments to describe the fields. (backtrace-goto-source-functions): New abnormal hook. (backtrace-mode-map): Add keybinding and menu item for backtrace-goto-source. (backtrace--flags-width): New constant. (backtrace-update-flags): Use it. (backtrace-goto-source): New command. (backtrace--print-flags): Print the :source-available flag. * lisp/emacs-lisp/edebug.el (edebug-backtrace-frames) (edebug-instrumented-backtrace-frames): New variables. (edebug-backtrace, edebug--backtrace-frames): Remove functions. (edebug-pop-to-backtrace, edebug--backtrace-goto-source) (edebug--add-source-info): New functions. (edebug-mode-map, edebug-mode-menus): Replace 'edebug-backtrace' with 'edebug-pop-to-backtrace'. (edebug--strip-instrumentation): New function. (edebug--unwrap-and-add-info): Remove. (edebug-unwrap-frame, edebug-add-source-info): New functions. (edebug-backtrace-show-instrumentation) (edebug-backtrace-hide-instrumentation): New commands. * test/lisp/emacs-lisp/edebug-tests.el (edebug-tests-check-keymap): Verify keybindings in backtrace-mode-map used by new test. Update with binding for 'edebug-pop-to-backtrace'. (edebug-tests-backtrace-goto-source): New test. * test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el (edebug-test-code-range): Add a new stop point. diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index 0e0a2e8a64..59c9a68c54 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -442,8 +442,16 @@ Redisplay the most recently known expression result in the echo area Display a backtrace, excluding Edebug's own functions for clarity (@code{edebug-backtrace}). -@xref{Debugging,, Backtraces, elisp}, for the commands which work -in a backtrace buffer. +@xref{Debugging,, Backtraces, elisp}, for a description of backtraces +and the commands which work on them. + +If you would like to see Edebug's functions in the backtrace, +use @kbd{M-x edebug-backtrace-show-instrumentation}. To hide them +again use @kbd{M-x edebug-backtrace-hide-instrumentation}. + +If a backtrace frame starts with @samp{>} that means that Edebug knows +where the source code for the frame is located. Use @kbd{s} to jump +to the source code for the current frame. The backtrace buffer is killed automatically when you continue execution. diff --git a/etc/NEWS b/etc/NEWS index 486e0d4384..53b7765627 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -484,11 +484,20 @@ using the new variables 'edebug-behavior-alist', globally or for individual definitions. +++ -*** Edebug's backtrace buffer now uses 'backtrace-mode'. -Backtrace mode adds fontification, links and commands for changing the +*** Edebug's backtrace buffer now uses 'backtrace-mode'. Backtrace +mode adds fontification, links and commands for changing the appearance of backtrace frames. See the node "Backtraces" in the Elisp manual for documentation of the new mode and its commands. +The binding of 'd' in Edebug's keymap is now 'edebug-pop-to-backtrace' +which replaces 'edebug-backtrace'. Consequently Edebug's backtrace +windows now behave like those of the Lisp Debugger and of ERT, in that +when they appear they will be the selected window. + +The new 'backtrace-goto-source' command, bound to 's', works in +Edebug's backtraces on backtrace frames whose source code has +been instrumented by Edebug. + ** Enhanced xterm support *** New variable 'xterm-set-window-title' controls whether Emacs sets diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el index b6ca289076..5169c30503 100644 --- a/lisp/emacs-lisp/backtrace.el +++ b/lisp/emacs-lisp/backtrace.el @@ -66,7 +66,14 @@ abbreviate the forms it prints." (cl-defstruct (backtrace-frame (:constructor backtrace-make-frame)) - evald fun args flags locals buffer pos) + evald ; Non-nil if argument evaluation is complete. + fun ; The function called/to call in this frame. + args ; Either evaluated or unevaluated arguments to the function. + flags ; A plist, possible properties are :debug-on-exit and :source-available. + locals ; An alist containing variable names and values. + buffer ; If non-nil, the buffer in use by eval-buffer or eval-region. + pos ; The position in the buffer. + ) (cl-defun backtrace-get-frames (&optional base &key (constructor #'backtrace-make-frame)) @@ -181,6 +188,15 @@ This is commonly used to recompute `backtrace-frames'.") (defvar-local backtrace-print-function #'cl-prin1 "Function used to print values in the current Backtrace buffer.") +(defvar-local backtrace-goto-source-functions nil + "Abnormal hook used to jump to the source code for the current frame. +Each hook function is called with no argument, and should return +non-nil if it is able to switch to the buffer containing the +source code. Execution of the hook will stop if one of the +functions returns non-nil. When adding a function to this hook, +you should also set the :source-available flag for the backtrace +frames where the source code location is known.") + (defvar backtrace-mode-map (let ((map (copy-keymap special-mode-map))) (set-keymap-parent map button-buffer-map) @@ -188,6 +204,7 @@ This is commonly used to recompute `backtrace-frames'.") (define-key map "p" 'backtrace-backward-frame) (define-key map "v" 'backtrace-toggle-locals) (define-key map "#" 'backtrace-toggle-print-circle) + (define-key map "s" 'backtrace-goto-source) (define-key map "\C-m" 'backtrace-help-follow-symbol) (define-key map "+" 'backtrace-pretty-print) (define-key map "-" 'backtrace-collapse) @@ -212,6 +229,12 @@ This is commonly used to recompute `backtrace-frames'.") :help "Use line breaks and indentation to make a form more readable"] ["Collapse to Single Line" backtrace-collapse] "--" + ["Go to Source" backtrace-goto-source + :active (and (backtrace-get-index) + (plist-get (backtrace-frame-flags + (nth (backtrace-get-index) backtrace-frames)) + :source-available)) + :help "Show the source code for the current frame"] ["Help for Symbol" backtrace-help-follow-symbol :help "Show help for symbol at point"] ["Describe Backtrace Mode" describe-mode @@ -219,6 +242,9 @@ This is commonly used to recompute `backtrace-frames'.") map) "Local keymap for `backtrace-mode' buffers.") +(defconst backtrace--flags-width 2 + "Width in characters of the flags for a backtrace frame.") + ;;; Navigation and Text Properties ;; This mode uses the following text properties: @@ -580,6 +606,20 @@ content of the sexp." '(backtrace-section backtrace-index backtrace-view backtrace-form)))) +(defun backtrace-goto-source () + "If its location is known, jump to the source code for the frame at point." + (interactive) + (let* ((index (or (backtrace-get-index) (user-error "Not in a stack frame"))) + (frame (nth index backtrace-frames)) + (source-available (plist-get (backtrace-frame-flags frame) + :source-available))) + (unless (and source-available + (catch 'done + (dolist (func backtrace-goto-source-functions) + (when (funcall func) + (throw 'done t))))) + (user-error "Source code location not known")))) + (defun backtrace-help-follow-symbol (&optional pos) "Follow cross-reference at POS, defaulting to point. For the cross-reference format, see `help-make-xrefs'." @@ -681,8 +721,12 @@ property for use by navigation." (defun backtrace--print-flags (frame view) "Print the flags of a backtrace FRAME if enabled in VIEW." (let ((beg (point)) - (flag (plist-get (backtrace-frame-flags frame) :debug-on-exit))) - (insert (if (and (plist-get view :show-flags) flag) "* " " ")) + (flag (plist-get (backtrace-frame-flags frame) :debug-on-exit)) + (source (plist-get (backtrace-frame-flags frame) :source-available))) + (when (plist-get view :show-flags) + (when source (insert ">")) + (when flag (insert "*"))) + (insert (make-string (- backtrace--flags-width (- (point) beg)) ?\s)) (put-text-property beg (point) 'backtrace-section 'func))) (defun backtrace--print-func-and-args (frame _view) @@ -770,7 +814,7 @@ Fall back to `prin1' if there is an error." (let ((props (backtrace-get-text-properties begin)) (inhibit-read-only t) (standard-output (current-buffer))) - (delete-char 2) + (delete-char backtrace--flags-width) (backtrace--print-flags (nth (backtrace-get-index) backtrace-frames) view) (add-text-properties begin (point) props)))))) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 3bf9cb9a48..fc295485fd 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -3692,7 +3692,7 @@ be installed in `emacs-lisp-mode-map'.") ;; misc (define-key map "?" 'edebug-help) - (define-key map "d" 'edebug-backtrace) + (define-key map "d" 'edebug-pop-to-backtrace) (define-key map "-" 'negative-argument) @@ -3985,6 +3985,13 @@ Otherwise call `debug' normally." ;;; Backtrace buffer +(defvar-local edebug-backtrace-frames nil + "Stack frames of the current Edebug Backtrace buffer without instrumentation. +This should be a list of `edebug---frame' objects.") +(defvar-local edebug-instrumented-backtrace-frames nil + "Stack frames of the current Edebug Backtrace buffer with instrumentation. +This should be a list of `edebug---frame' objects.") + ;; Data structure for backtrace frames with information ;; from Edebug instrumentation found in the backtrace. (cl-defstruct @@ -3993,7 +4000,7 @@ Otherwise call `debug' normally." (:include backtrace-frame)) def-name before-index after-index) -(defun edebug-backtrace () +(defun edebug-pop-to-backtrace () "Display the current backtrace in a `backtrace-mode' window." (interactive) (if (or (not edebug-backtrace-buffer) @@ -4002,31 +4009,33 @@ Otherwise call `debug' normally." (generate-new-buffer "*Edebug Backtrace*")) ;; Else, could just display edebug-backtrace-buffer. ) - (with-output-to-temp-buffer (buffer-name edebug-backtrace-buffer) - (setq edebug-backtrace-buffer standard-output) - (with-current-buffer edebug-backtrace-buffer - (unless (derived-mode-p 'backtrace-mode) - (backtrace-mode)) - (setq backtrace-frames (edebug--backtrace-frames)) - (backtrace-print) - (goto-char (point-min))))) - -(defun edebug--backtrace-frames () - "Return backtrace frames with instrumentation removed. + (pop-to-buffer edebug-backtrace-buffer) + (unless (derived-mode-p 'backtrace-mode) + (backtrace-mode) + (add-hook 'backtrace-goto-source-functions 'edebug--backtrace-goto-source)) + (setq edebug-instrumented-backtrace-frames + (backtrace-get-frames 'edebug-debugger + :constructor #'edebug--make-frame) + edebug-backtrace-frames (edebug--strip-instrumentation + edebug-instrumented-backtrace-frames) + backtrace-frames edebug-backtrace-frames) + (backtrace-print) + (goto-char (point-min))) + +(defun edebug--strip-instrumentation (frames) + "Return a new list of backtrace frames with instrumentation removed. Remove frames for Edebug's functions and the lambdas in -`edebug-enter' wrappers." - (let* ((frames (backtrace-get-frames 'edebug-debugger - :constructor #'edebug--make-frame)) - skip-next-lambda def-name before-index after-index - results - (index (length frames))) +`edebug-enter' wrappers. Fill in the def-name, before-index +and after-index fields in both FRAMES and the returned list +of deinstrumented frames, for those frames where the source +code location is known." + (let (skip-next-lambda def-name before-index after-index results + (index (length frames))) (dolist (frame (reverse frames)) - (let ((fun (edebug--frame-fun frame)) + (let ((new-frame (copy-edebug--frame frame)) + (fun (edebug--frame-fun frame)) (args (edebug--frame-args frame))) (cl-decf index) - (when (edebug--frame-evald frame) - (setq before-index nil - after-index nil)) (pcase fun ('edebug-enter (setq skip-next-lambda t @@ -4037,17 +4046,18 @@ Remove frames for Edebug's functions and the lambdas in (nth 0 args)) after-index (nth 1 args))) ((pred edebug--symbol-not-prefixed-p) - (edebug--unwrap-and-add-info frame def-name before-index after-index) - (setf (edebug--frame-def-name frame) (and before-index def-name)) - (setf (edebug--frame-before-index frame) before-index) - (setf (edebug--frame-after-index frame) after-index) - (push frame results) + (edebug--unwrap-frame new-frame) + (edebug--add-source-info new-frame def-name before-index after-index) + (edebug--add-source-info frame def-name before-index after-index) + (push new-frame results) (setq before-index nil after-index nil)) (`(,(or 'lambda 'closure) . ,_) (unless skip-next-lambda - (edebug--unwrap-and-add-info frame def-name before-index after-index) - (push frame results)) + (edebug--unwrap-frame new-frame) + (edebug--add-source-info frame def-name before-index after-index) + (edebug--add-source-info new-frame def-name before-index after-index) + (push new-frame results)) (setq before-index nil after-index nil skip-next-lambda nil))))) @@ -4058,14 +4068,9 @@ Remove frames for Edebug's functions and the lambdas in (and (symbolp sym) (not (string-prefix-p "edebug-" (symbol-name sym))))) -(defun edebug--unwrap-and-add-info (frame def-name before-index after-index) - "Update FRAME with the additional info needed by an edebug--frame. -Save DEF-NAME, BEFORE-INDEX and AFTER-INDEX in FRAME. Also -remove Edebug's instrumentation from the function and any -unevaluated arguments in FRAME." - (setf (edebug--frame-def-name frame) (and before-index def-name)) - (setf (edebug--frame-before-index frame) before-index) - (setf (edebug--frame-after-index frame) after-index) +(defun edebug--unwrap-frame (frame) + "Remove Edebug's instrumentation from FRAME. +Strip it from the function and any unevaluated arguments." (setf (edebug--frame-fun frame) (edebug-unwrap* (edebug--frame-fun frame))) (unless (edebug--frame-evald frame) (let (results) @@ -4073,6 +4078,41 @@ unevaluated arguments in FRAME." (push (edebug-unwrap* arg) results)) (setf (edebug--frame-args frame) (nreverse results))))) +(defun edebug--add-source-info (frame def-name before-index after-index) + "Update FRAME with the additional info needed by an edebug--frame. +Save DEF-NAME, BEFORE-INDEX and AFTER-INDEX in FRAME." + (when (and before-index def-name) + (setf (edebug--frame-flags frame) + (plist-put (copy-sequence (edebug--frame-flags frame)) + :source-available t))) + (setf (edebug--frame-def-name frame) (and before-index def-name)) + (setf (edebug--frame-before-index frame) before-index) + (setf (edebug--frame-after-index frame) after-index)) + +(defun edebug--backtrace-goto-source () + (let* ((index (backtrace-get-index)) + (frame (nth index backtrace-frames))) + (when (edebug--frame-def-name frame) + (let* ((data (get (edebug--frame-def-name frame) 'edebug)) + (marker (nth 0 data)) + (offsets (nth 2 data))) + (pop-to-buffer (marker-buffer marker)) + (goto-char (+ (marker-position marker) + (aref offsets (edebug--frame-before-index frame)))))))) + +(defun edebug-backtrace-show-instrumentation () + "Show Edebug's instrumentation in an Edebug Backtrace buffer." + (interactive) + (unless (eq backtrace-frames edebug-instrumented-backtrace-frames) + (setq backtrace-frames edebug-instrumented-backtrace-frames) + (revert-buffer))) + +(defun edebug-backtrace-hide-instrumentation () + "Show Edebug's instrumentation in an Edebug Backtrace buffer." + (interactive) + (unless (eq backtrace-frames edebug-backtrace-frames) + (setq backtrace-frames edebug-backtrace-frames) + (revert-buffer))) ;;; Trace display @@ -4246,7 +4286,7 @@ It is removed when you hit any char." ["Bounce to Current Point" edebug-bounce-point t] ["View Outside Windows" edebug-view-outside t] ["Previous Result" edebug-previous-result t] - ["Show Backtrace" edebug-backtrace t] + ["Show Backtrace" edebug-pop-to-backtrace t] ["Display Freq Count" edebug-display-freq-count t]) ("Eval" diff --git a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el index f3fc78d4e1..97dead057a 100644 --- a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el +++ b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el @@ -41,7 +41,7 @@ (defun edebug-test-code-range (num) !start!(let ((index 0) (result nil)) - (while (< index num)!test! + (while !lt!(< index num)!test! (push index result)!loop! (cl-incf index))!end-loop! (nreverse result))) diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index 7d780edf28..7880aaf95b 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -432,9 +432,11 @@ test and possibly others should be updated." (verify-keybinding "P" 'edebug-view-outside) ;; same as v (verify-keybinding "W" 'edebug-toggle-save-windows) (verify-keybinding "?" 'edebug-help) - (verify-keybinding "d" 'edebug-backtrace) + (verify-keybinding "d" 'edebug-pop-to-backtrace) (verify-keybinding "-" 'negative-argument) - (verify-keybinding "=" 'edebug-temp-display-freq-count))) + (verify-keybinding "=" 'edebug-temp-display-freq-count) + (should (eq (lookup-key backtrace-mode-map "n") 'backtrace-forward-frame)) + (should (eq (lookup-key backtrace-mode-map "s") 'backtrace-goto-source)))) (ert-deftest edebug-tests-stop-point-at-start-of-first-instrumented-function () "Edebug stops at the beginning of an instrumented function." @@ -924,5 +926,17 @@ test and possibly others should be updated." "g" (should (equal edebug-tests-@-result "The result of applying + to (1 x) is 11"))))) +(ert-deftest edebug-tests-backtrace-goto-source () + "Edebug can jump to instrumented source from its *Edebug-Backtrace* buffer." + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "range" '(2) t) + (edebug-tests-run-kbd-macro + "@ SPC SPC" + (edebug-tests-should-be-at "range" "lt") + "dns" ; Pop to backtrace, next frame, goto source. + (edebug-tests-should-be-at "range" "start") + "g" + (should (equal edebug-tests-@-result '(0 1)))))) + (provide 'edebug-tests) ;;; edebug-tests.el ends here commit 1459ad2c670e7633f426d7a5a7f05fab23195b32 Author: Gemini Lasswell Date: Sun Jul 15 15:45:43 2018 -0700 Add a menu for backtrace-mode * lisp/emacs-lisp/backtrace.el (backtrace-mode-map): Add a menu. * lisp/emacs-lisp/debug.el (debugger-mode-map): Change menu text for 'backtrace-help-follow-symbol' to better describe what it does. diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el index da5a777177..b6ca289076 100644 --- a/lisp/emacs-lisp/backtrace.el +++ b/lisp/emacs-lisp/backtrace.el @@ -194,6 +194,28 @@ This is commonly used to recompute `backtrace-frames'.") (define-key map "." 'backtrace-expand-ellipses) (define-key map [follow-link] 'mouse-face) (define-key map [mouse-2] 'mouse-select-window) + (easy-menu-define nil map "" + '("Backtrace" + ["Next Frame" backtrace-forward-frame + :help "Move cursor forwards to the start of a backtrace frame"] + ["Previous Frame" backtrace-backward-frame + :help "Move cursor backwards to the start of a backtrace frame"] + "--" + ["Show Variables" backtrace-toggle-locals + :style toggle + :active (backtrace-get-index) + :selected (plist-get (backtrace-get-view) :show-locals) + :help "Show or hide the local variables for the frame at point"] + ["Expand \"...\"s" backtrace-expand-ellipses + :help "Expand all the abbreviated forms in the current frame"] + ["Show on Multiple Lines" backtrace-pretty-print + :help "Use line breaks and indentation to make a form more readable"] + ["Collapse to Single Line" backtrace-collapse] + "--" + ["Help for Symbol" backtrace-help-follow-symbol + :help "Show help for symbol at point"] + ["Describe Backtrace Mode" describe-mode + :help "Display documentation for backtrace-mode"])) map) "Local keymap for `backtrace-mode' buffers.") diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index c6057b0bdb..7fc2b41c70 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -567,8 +567,8 @@ The environment used is the one when entering the activation frame at point." "--" ["Next Line" next-line :help "Move cursor down"] - ["Help Follow" backtrace-help-follow-symbol - :help "Follow cross-reference"] + ["Help for Symbol" backtrace-help-follow-symbol + :help "Show help for symbol at point"] ["Describe Debugger Mode" describe-mode :help "Display documentation for debugger-mode"] "--" commit 98791518902f5e7ccaf8661f43e222c28cac22c7 Author: Gemini Lasswell Date: Sun Jul 15 15:41:56 2018 -0700 * lisp/emacs-lisp/debug.el (debugger-mode-map): Use easy-menu-define. diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 48ca32ddd8..c6057b0bdb 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -530,8 +530,7 @@ The environment used is the one when entering the activation frame at point." (defvar debugger-mode-map - (let ((map (make-keymap)) - (menu-map (make-sparse-keymap))) + (let ((map (make-keymap))) (set-keymap-parent map backtrace-mode-map) (define-key map "b" 'debugger-frame) (define-key map "c" 'debugger-continue) @@ -544,49 +543,37 @@ The environment used is the one when entering the activation frame at point." (define-key map "e" 'debugger-eval-expression) (define-key map "R" 'debugger-record-expression) (define-key map [mouse-2] 'push-button) - (define-key map [menu-bar debugger] (cons "Debugger" menu-map)) - (define-key menu-map [deb-top] - '(menu-item "Quit" debugger-quit - :help "Quit debugging and return to top level")) - (define-key menu-map [deb-s0] '("--")) - (define-key menu-map [deb-descr] - '(menu-item "Describe Debugger Mode" describe-mode - :help "Display documentation for debugger-mode")) - (define-key menu-map [deb-hfol] - '(menu-item "Help Follow" backtrace-help-follow-symbol - :help "Follow cross-reference")) - (define-key menu-map [deb-nxt] - '(menu-item "Next Line" next-line - :help "Move cursor down")) - (define-key menu-map [deb-s1] '("--")) - (define-key menu-map [deb-lfunc] - '(menu-item "List debug on entry functions" debugger-list-functions - :help "Display a list of all the functions now set to debug on entry")) - (define-key menu-map [deb-fclear] - '(menu-item "Cancel debug frame" debugger-frame-clear - :help "Do not enter debugger when this frame exits")) - (define-key menu-map [deb-frame] - '(menu-item "Debug frame" debugger-frame - :help "Request entry to debugger when this frame exits")) - (define-key menu-map [deb-s2] '("--")) - (define-key menu-map [deb-ret] - '(menu-item "Return value..." debugger-return-value - :help "Continue, specifying value to return.")) - (define-key menu-map [deb-rec] - '(menu-item "Display and Record Expression" debugger-record-expression - :help "Display a variable's value and record it in `*Backtrace-record*' buffer")) - (define-key menu-map [deb-eval] - '(menu-item "Eval Expression..." debugger-eval-expression - :help "Eval an expression, in an environment like that outside the debugger")) - (define-key menu-map [deb-jump] - '(menu-item "Jump" debugger-jump - :help "Continue to exit from this frame, with all debug-on-entry suspended")) - (define-key menu-map [deb-cont] - '(menu-item "Continue" debugger-continue - :help "Continue, evaluating this expression without stopping")) - (define-key menu-map [deb-step] - '(menu-item "Step through" debugger-step-through - :help "Proceed, stepping through subexpressions of this expression")) + (easy-menu-define nil map "" + '("Debugger" + ["Step through" debugger-step-through + :help "Proceed, stepping through subexpressions of this expression"] + ["Continue" debugger-continue + :help "Continue, evaluating this expression without stopping"] + ["Jump" debugger-jump + :help "Continue to exit from this frame, with all debug-on-entry suspended"] + ["Eval Expression..." debugger-eval-expression + :help "Eval an expression, in an environment like that outside the debugger"] + ["Display and Record Expression" debugger-record-expression + :help "Display a variable's value and record it in `*Backtrace-record*' buffer"] + ["Return value..." debugger-return-value + :help "Continue, specifying value to return."] + "--" + ["Debug frame" debugger-frame + :help "Request entry to debugger when this frame exits"] + ["Cancel debug frame" debugger-frame-clear + :help "Do not enter debugger when this frame exits"] + ["List debug on entry functions" debugger-list-functions + :help "Display a list of all the functions now set to debug on entry"] + "--" + ["Next Line" next-line + :help "Move cursor down"] + ["Help Follow" backtrace-help-follow-symbol + :help "Follow cross-reference"] + ["Describe Debugger Mode" describe-mode + :help "Display documentation for debugger-mode"] + "--" + ["Quit" debugger-quit + :help "Quit debugging and return to top level"])) map)) (put 'debugger-mode 'mode-class 'special) commit a3ba34aeac1b41ca5d12bfe5644d3fdfa894ddda Author: Gemini Lasswell Date: Sat Jul 14 08:05:51 2018 -0700 Add new command to expand all "..."s in a backtrace frame * doc/lispref/debugging.texi (Backtraces): Document new keybinding. * lisp/emacs-lisp/backtrace.el (backtrace-line-length): Add the option of unlimited line length. (backtrace--match-ellipsis-in-string): Add a comment to explain why this function is necessary. (backtrace-mode-map): Add keybinding for 'backtrace-expand-ellipses'. (backtrace-expand-ellipsis): Use 'cl-print-to-string-with-limit'. (backtrace-expand-ellipses): New command. (backtrace-print-to-string): Use 'cl-print-to-string-with-limit'. Tag the printed forms with a gensym instead of the values of print-length and print-level. (backtrace--print): Add 'stream' argument. * test/lisp/emacs-lisp/backtrace-tests.el (backtrace-tests--expand-ellipsis): Make the test less dependent on the implementation. (backtrace-tests--expand-ellipses): New test. Move the fitting of a printed representation into a limited number of characters using appropriate values of print-level and print-length from 'backtrace-print-to-string' to cl-print.el for future use by other parts of Emacs. * lisp/emacs-lisp/cl-print.el (cl-print-to-string-with-limit): New function. * test/lisp/emacs-lisp/cl-print-tests.el (cl-print-tests-print-to-string-with-limit): New test. diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi index 5230854cc7..87429a67ba 100644 --- a/doc/lispref/debugging.texi +++ b/doc/lispref/debugging.texi @@ -457,6 +457,9 @@ Collapse the top-level Lisp form at point back to a single line. @item # Toggle @code{print-circle} for the frame at point. +@item . +Expand all the forms abbreviated with ``...'' in the frame at point. + @end table @node Debugger Commands diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el index 779feb4307..da5a777177 100644 --- a/lisp/emacs-lisp/backtrace.el +++ b/lisp/emacs-lisp/backtrace.el @@ -55,7 +55,8 @@ order to debug the code that does fontification." "Target length for lines in Backtrace buffers. Backtrace mode will attempt to abbreviate printing of backtrace frames to make them shorter than this, but success is not -guaranteed." +guaranteed. If set to nil or zero, Backtrace mode will not +abbreviate the forms it prints." :type 'integer :group 'backtrace :version "27.1") @@ -146,6 +147,9 @@ fontifies.") (defun backtrace--match-ellipsis-in-string (bound) ;; Fontify ellipses within strings as buttons. + ;; This is necessary because ellipses are text property buttons + ;; instead of overlay buttons, which is done because there could + ;; be a large number of them. (when (re-search-forward "\\(\\.\\.\\.\\)\"" bound t) (and (get-text-property (- (point) 2) 'cl-print-ellipsis) (get-text-property (- (point) 3) 'cl-print-ellipsis) @@ -187,6 +191,7 @@ This is commonly used to recompute `backtrace-frames'.") (define-key map "\C-m" 'backtrace-help-follow-symbol) (define-key map "+" 'backtrace-pretty-print) (define-key map "-" 'backtrace-collapse) + (define-key map "." 'backtrace-expand-ellipses) (define-key map [follow-link] 'mouse-face) (define-key map [mouse-2] 'mouse-select-window) map) @@ -207,9 +212,7 @@ This is commonly used to recompute `backtrace-frames'.") ;; backtrace-form: A value applied to each printed representation of a ;; top-level s-expression, which needs to be different for sexps ;; printed adjacent to each other, so the limits can be quickly -;; found for pretty-printing. The value chosen is a list contining -;; the values of print-level and print-length used to print the -;; sexp, and those values are used when expanding ellipses. +;; found for pretty-printing. (defsubst backtrace-get-index (&optional pos) "Return the index of the backtrace frame at POS. @@ -423,9 +426,6 @@ Reprint the frame with the new view plist." (defun backtrace-expand-ellipsis (button) "Expand display of the elided form at BUTTON." - ;; TODO a command to expand all ... in form at point - ;; with argument, don't bind print-level, length?? - ;; Enable undo so there's a way to go back? (interactive) (goto-char (button-start button)) (unless (get-text-property (point) 'cl-print-ellipsis) @@ -437,25 +437,44 @@ Reprint the frame with the new view plist." (begin (previous-single-property-change end 'cl-print-ellipsis)) (value (get-text-property begin 'cl-print-ellipsis)) (props (backtrace-get-text-properties begin)) - (tag (backtrace-get-form begin)) - (length (nth 0 tag)) ; TODO should this work with a target char count - (level (nth 1 tag)) ; like backtrace-print-to-string? (inhibit-read-only t)) (backtrace--with-output-variables (backtrace-get-view) - (let ((print-level level) - (print-length length)) - (delete-region begin end) - (cl-print-expand-ellipsis value (current-buffer)) - (setq end (point)) - (goto-char begin) - (while (< (point) end) - (let ((next (next-single-property-change (point) 'cl-print-ellipsis - nil end))) - (when (get-text-property (point) 'cl-print-ellipsis) - (make-text-button (point) next :type 'backtrace-ellipsis)) - (goto-char next))) - (goto-char begin) - (add-text-properties begin end props))))) + (delete-region begin end) + (insert (cl-print-to-string-with-limit #'cl-print-expand-ellipsis value + backtrace-line-length)) + (setq end (point)) + (goto-char begin) + (while (< (point) end) + (let ((next (next-single-property-change (point) 'cl-print-ellipsis + nil end))) + (when (get-text-property (point) 'cl-print-ellipsis) + (make-text-button (point) next :type 'backtrace-ellipsis)) + (goto-char next))) + (goto-char begin) + (add-text-properties begin end props)))) + +(defun backtrace-expand-ellipses (&optional no-limit) + "Expand display of all \"...\"s in the backtrace frame at point. +\\ +Each ellipsis will be limited to `backtrace-line-length' +characters in its expansion. With optional prefix argument +NO-LIMIT, do not limit the number of characters. Note that with +or without the argument, using this command can result in very +long lines and very poor display performance. If this happens +and is a problem, use `\\[revert-buffer]' to return to the +initial state of the Backtrace buffer." + (interactive "P") + (save-excursion + (let ((start (backtrace-get-frame-start)) + (end (backtrace-get-frame-end)) + (backtrace-line-length (unless no-limit backtrace-line-length))) + (goto-char end) + (while (> (point) start) + (let ((next (previous-single-property-change (point) 'cl-print-ellipsis + nil start))) + (when (get-text-property (point) 'cl-print-ellipsis) + (push-button (point))) + (goto-char next)))))) (defun backtrace-pretty-print () "Pretty-print the top level s-expression at point." @@ -605,8 +624,7 @@ line and recenter window line accordingly." "Return a printed representation of OBJ formatted for backtraces. Attempt to get the length of the returned string under LIMIT charcters with appropriate settings of `print-level' and -`print-length.' Attach the settings used with the text property -`backtrace-form'. LIMIT defaults to `backtrace-line-length'." +`print-length.' LIMIT defaults to `backtrace-line-length'." (backtrace--with-output-variables backtrace-view (backtrace--print-to-string obj limit))) @@ -614,36 +632,20 @@ charcters with appropriate settings of `print-level' and ;; This is for use by callers who wrap the call with ;; backtrace--with-output-variables. (setq limit (or limit backtrace-line-length)) - (let* ((length 50) ; (/ backtrace-line-length 100) ?? - (level (truncate (log limit))) - (delta (truncate (/ length level)))) - (with-temp-buffer - (catch 'done - (while t - (erase-buffer) - (let ((standard-output (current-buffer)) - (print-length length) - (print-level level)) - (backtrace--print sexp)) - ;; Stop when either the level is too low or the sexp is - ;; successfully printed in the space allowed. - (when (or (< (- (point-max) (point-min)) limit) (= level 2)) - (throw 'done nil)) - (cl-decf level) - (cl-decf length delta))) - (put-text-property (point-min) (point) - 'backtrace-form (list length level)) - ;; Make buttons from all the "..."s. - ;; TODO should this be under control of :do-ellipses in the view - ;; plist? - (goto-char (point-min)) - (while (< (point) (point-max)) - (let ((end (next-single-property-change (point) 'cl-print-ellipsis - nil (point-max)))) - (when (get-text-property (point) 'cl-print-ellipsis) - (make-text-button (point) end :type 'backtrace-ellipsis)) - (goto-char end))) - (buffer-string)))) + (with-temp-buffer + (insert (cl-print-to-string-with-limit #'backtrace--print sexp limit)) + ;; Add a unique backtrace-form property. + (put-text-property (point-min) (point) 'backtrace-form (gensym)) + ;; Make buttons from all the "..."s. Since there might be many of + ;; them, use text property buttons. + (goto-char (point-min)) + (while (< (point) (point-max)) + (let ((end (next-single-property-change (point) 'cl-print-ellipsis + nil (point-max)))) + (when (get-text-property (point) 'cl-print-ellipsis) + (make-text-button (point) end :type 'backtrace-ellipsis)) + (goto-char end))) + (buffer-string))) (defun backtrace-print-frame (frame view) "Insert a backtrace FRAME at point formatted according to VIEW. @@ -727,14 +729,14 @@ Print them only if :show-locals is non-nil in the VIEW plist." (insert "\n"))) (put-text-property beg (point) 'backtrace-section 'locals)))) -(defun backtrace--print (obj) - "Attempt to print OBJ using `backtrace-print-function'. +(defun backtrace--print (obj &optional stream) + "Attempt to print OBJ to STREAM using `backtrace-print-function'. Fall back to `prin1' if there is an error." (condition-case err - (funcall backtrace-print-function obj) + (funcall backtrace-print-function obj stream) (error (message "Error in backtrace printer: %S" err) - (prin1 obj)))) + (prin1 obj stream)))) (defun backtrace-update-flags () "Update the display of the flags in the backtrace frame at point." @@ -805,8 +807,6 @@ followed by `backtrace-print-frame', once for each stack frame." backtrace-font-lock-keywords-1 backtrace-font-lock-keywords-2) nil nil nil nil - ;; TODO This one doesn't look necessary: - ;; (font-lock-mark-block-function . mark-defun) (font-lock-syntactic-face-function . lisp-font-lock-syntactic-face-function)))) (setq truncate-lines t) diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index 337efa465a..c63f5ac005 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -524,5 +524,45 @@ node `(elisp)Output Variables'." (cl-prin1 object (current-buffer)) (buffer-string))) +;;;###autoload +(defun cl-print-to-string-with-limit (print-function value limit) + "Return a string containing a printed representation of VALUE. +Attempt to get the length of the returned string under LIMIT +characters with appropriate settings of `print-level' and +`print-length.' Use PRINT-FUNCTION to print, which should take +the arguments VALUE and STREAM and which should respect +`print-length' and `print-level'. LIMIT may be nil or zero in +which case PRINT-FUNCTION will be called with `print-level' and +`print-length' bound to nil. + +Use this function with `cl-prin1' to print an object, +abbreviating it with ellipses to fit within a size limit. Use +this function with `cl-prin1-expand-ellipsis' to expand an +ellipsis, abbreviating the expansion to stay within a size +limit." + (setq limit (and (natnump limit) + (not (zerop limit)) + limit)) + ;; Since this is used by the debugger when stack space may be + ;; limited, if you increase print-level here, add more depth in + ;; call_debugger (bug#31919). + (let* ((print-length (when limit (min limit 50))) + (print-level (when limit (min 8 (truncate (log limit))))) + (delta (when limit + (max 1 (truncate (/ print-length print-level)))))) + (with-temp-buffer + (catch 'done + (while t + (erase-buffer) + (funcall print-function value (current-buffer)) + ;; Stop when either print-level is too low or the value is + ;; successfully printed in the space allowed. + (when (or (not limit) + (< (- (point-max) (point-min)) limit) + (= print-level 2)) + (throw 'done (buffer-string))) + (cl-decf print-level) + (cl-decf print-length delta)))))) + (provide 'cl-print) ;;; cl-print.el ends here diff --git a/test/lisp/emacs-lisp/backtrace-tests.el b/test/lisp/emacs-lisp/backtrace-tests.el index ba2d33a9d5..ff26112ab9 100644 --- a/test/lisp/emacs-lisp/backtrace-tests.el +++ b/test/lisp/emacs-lisp/backtrace-tests.el @@ -349,32 +349,74 @@ digit and replace with #[0-9]." (buffer-string))) (ert-deftest backtrace-tests--expand-ellipsis () - "Backtrace buffers ellipsify large forms and can expand the ellipses." + "Backtrace buffers ellipsify large forms as buttons which expand the ellipses." ;; make a backtrace with an ellipsis ;; expand the ellipsis (ert-with-test-buffer (:name "variables") (let* ((print-level nil) (print-length nil) - (arg (let ((long (make-list 100 'a)) - (deep '(0 (1 (2 (3 (4 (5 (6 (7 (8 (9)))))))))))) - (setf (nth 1 long) deep) - long)) + (backtrace-line-length 300) + (arg (make-list 40 (make-string 10 ?a))) (results (backtrace-tests--result arg))) (backtrace-tests--make-backtrace arg) (backtrace-print) - ;; There should be two ellipses. Find and expand them. + ;; There should be an ellipsis. Find and expand it. (goto-char (point-min)) (search-forward "...") (backward-char) (push-button) - (search-forward "...") - (backward-char) - (push-button) (should (string= (backtrace-tests--get-substring (point-min) (point-max)) results))))) +(ert-deftest backtrace-tests--expand-ellipses () + "Backtrace buffers ellipsify large forms and can expand the ellipses." + (ert-with-test-buffer (:name "variables") + (let* ((print-level nil) + (print-length nil) + (backtrace-line-length 300) + (arg (let ((outer (make-list 40 (make-string 10 ?a))) + (nested (make-list 40 (make-string 10 ?b)))) + (setf (nth 39 nested) (make-list 40 (make-string 10 ?c))) + (setf (nth 39 outer) nested) + outer)) + (results (backtrace-tests--result-with-locals arg))) + + ;; Make a backtrace with local variables visible. + (backtrace-tests--make-backtrace arg) + (backtrace-print) + (backtrace-toggle-locals '(4)) + + ;; There should be two ellipses. + (goto-char (point-min)) + (should (search-forward "...")) + (should (search-forward "...")) + (should-error (search-forward "...")) + + ;; Expanding the last frame without argument should expand both + ;; ellipses, but the expansions will contain one ellipsis each. + (let ((buffer-len (- (point-max) (point-min)))) + (goto-char (point-max)) + (backtrace-backward-frame) + (backtrace-expand-ellipses) + (should (> (- (point-max) (point-min)) buffer-len)) + (goto-char (point-min)) + (should (search-forward "...")) + (should (search-forward "...")) + (should-error (search-forward "..."))) + + ;; Expanding with argument should remove all ellipses. + (goto-char (point-max)) + (backtrace-backward-frame) + (backtrace-expand-ellipses '(4)) + (goto-char (point-min)) + + (should-error (search-forward "...")) + (should (string= (backtrace-tests--get-substring (point-min) (point-max)) + results))))) + + (ert-deftest backtrace-tests--to-string () "Backtraces can be produced as strings." (let ((frames (ert-with-test-buffer (:name nil) diff --git a/test/lisp/emacs-lisp/cl-print-tests.el b/test/lisp/emacs-lisp/cl-print-tests.el index 7594d2466b..a469b5526c 100644 --- a/test/lisp/emacs-lisp/cl-print-tests.el +++ b/test/lisp/emacs-lisp/cl-print-tests.el @@ -233,5 +233,41 @@ (let ((print-circle t)) (should (equal "(0 . #1=(0 . #1#))" (cl-prin1-to-string x)))))) +(ert-deftest cl-print-tests-print-to-string-with-limit () + (let* ((thing10 (make-list 10 'a)) + (thing100 (make-list 100 'a)) + (thing10x10 (make-list 10 thing10)) + (nested-thing (let ((val 'a)) + (dotimes (_i 20) + (setq val (list val))) + val)) + ;; Make a consistent environment for this test. + (print-circle nil) + (print-level nil) + (print-length nil)) + + ;; Print something that fits in the space given. + (should (string= (cl-prin1-to-string thing10) + (cl-print-to-string-with-limit #'cl-prin1 thing10 100))) + + ;; Print something which needs to be abbreviated and which can be. + (should (< (length (cl-print-to-string-with-limit #'cl-prin1 thing100 100)) + 100 + (length (cl-prin1-to-string thing100)))) + + ;; Print something resistant to easy abbreviation. + (should (string= (cl-prin1-to-string thing10x10) + (cl-print-to-string-with-limit #'cl-prin1 thing10x10 100))) + + ;; Print something which should be abbreviated even if the limit is large. + (should (< (length (cl-print-to-string-with-limit #'cl-prin1 nested-thing 1000)) + (length (cl-prin1-to-string nested-thing)))) + + ;; Print with no limits. + (dolist (thing (list thing10 thing100 thing10x10 nested-thing)) + (let ((rep (cl-prin1-to-string thing))) + (should (string= rep (cl-print-to-string-with-limit #'cl-prin1 thing 0))) + (should (string= rep (cl-print-to-string-with-limit #'cl-prin1 thing nil))))))) + ;;; cl-print-tests.el ends here. commit 2ede75c49b62439e15be3ab8be2c14594f846da6 Author: Gemini Lasswell Date: Sat Jul 14 07:23:15 2018 -0700 Change keybinding for backtrace-collapse from '=' to '-' '+' and '-' make a more intuitive pair of keybindings for backtrace-pretty-print and backtrace-collapse than '+' and '='. * lisp/emacs-lisp/backtrace.el (backtrace-mode-map): * doc/lispref/debugging.texi (Backtraces): Change keybinding for backtrace-collapse. diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi index b5a73a255a..5230854cc7 100644 --- a/doc/lispref/debugging.texi +++ b/doc/lispref/debugging.texi @@ -451,7 +451,7 @@ Move to the beginning of the next frame. Add line breaks and indentation to the top-level Lisp form at point to make it more readable. -@item = +@item - Collapse the top-level Lisp form at point back to a single line. @item # diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el index aac43fec8e..779feb4307 100644 --- a/lisp/emacs-lisp/backtrace.el +++ b/lisp/emacs-lisp/backtrace.el @@ -186,7 +186,7 @@ This is commonly used to recompute `backtrace-frames'.") (define-key map "#" 'backtrace-toggle-print-circle) (define-key map "\C-m" 'backtrace-help-follow-symbol) (define-key map "+" 'backtrace-pretty-print) - (define-key map "=" 'backtrace-collapse) + (define-key map "-" 'backtrace-collapse) (define-key map [follow-link] 'mouse-face) (define-key map [mouse-2] 'mouse-select-window) map) commit 04cc0b615847e4b3ee15c7bd86499ee044abe3fa Author: Gemini Lasswell Date: Sat Jun 30 08:45:53 2018 -0700 Add more tests for backtrace-mode * test/lisp/emacs-lisp/backtrace-tests.el (backtrace-tests--variables) (backtrace-tests--backward-frame, backtrace-tests--forward-frame) (backtrace-tests--pretty-print-and-collapse) (backtrace-tests--verify-pp-and-collapse) (backtrace-tests--print-circle, backtrace-tests--make-regexp) (backtrace-tests--expand-ellipsis): New tests. (backtrace-tests--to-string): Use backtrace-tests--make-backtrace. (backtrace-tests--get-substring): New function. Change the method of generating sample backtraces in backtrace tests to work whether or not the tests are byte-compiled. * test/lisp/emacs-lisp/backtrace-tests.el (backtrace-tests--func1) (backtrace-tests--func2, backtrace-tests--func3) (backtrace-tests--create-backtrace-frames): Remove. (backtrace-tests--uncompiled-functions): New constant. (backtrace-tests--make-backtrace, backtrace-tests--setup-buffer): New functions. (backtrace-tests--backtrace-lines) (backtrace-tests--backtrace-lines-with-locals): New functions. (backtrace-tests--line-count): New constant. (backtrace-tests--result, backtrace-tests--result-with-locals): New functions. (backtrace-tests--header): New constant. (backtrace-tests--insert-header): Use backtrace-tests--header. (backtrace-tests--with-buffer): Remove. diff --git a/test/lisp/emacs-lisp/backtrace-tests.el b/test/lisp/emacs-lisp/backtrace-tests.el index 75da468494..ba2d33a9d5 100644 --- a/test/lisp/emacs-lisp/backtrace-tests.el +++ b/test/lisp/emacs-lisp/backtrace-tests.el @@ -1,4 +1,4 @@ -;;; backtrace-tests.el --- Tests for emacs-lisp/backtrace.el -*- lexical-binding: t; -*- +;;; backtrace-tests.el --- Tests for backtraces -*- lexical-binding: t; -*- ;; Copyright (C) 2018 Free Software Foundation, Inc. @@ -23,67 +23,372 @@ (require 'backtrace) (require 'ert) +(require 'ert-x) (require 'seq) -;; Create a backtrace frames list with several frames. -;; TODO load this from an el file in backtrace-resources/ so the tests -;; can be byte-compiled. -(defvar backtrace-tests--frames nil) +;; Delay evaluation of the backtrace-creating functions until +;; load so that the backtraces are the same whether this file +;; is compiled or not. -(defun backtrace-tests--func1 (arg1 arg2) - (setq backtrace-tests--frames (backtrace-get-frames nil)) - (list arg1 arg2)) +(eval-and-compile + (defconst backtrace-tests--uncompiled-functions + '(progn + (defun backtrace-tests--make-backtrace (arg) + (backtrace-tests--setup-buffer)) -(defun backtrace-tests--func2 (arg) - (list arg)) + (defun backtrace-tests--setup-buffer () + "Set up the current buffer in backtrace mode." + (backtrace-mode) + (setq backtrace-frames (backtrace-get-frames)) + (let ((this-index)) + ;; Discard all past `backtrace-tests-make-backtrace'. + (dotimes (index (length backtrace-frames)) + (when (eq (backtrace-frame-fun (nth index backtrace-frames)) + 'backtrace-tests--make-backtrace) + (setq this-index index))) + (setq backtrace-frames (seq-subseq backtrace-frames 0 (1+ this-index)))) + (backtrace-print)))) -(defun backtrace-tests--func3 (arg) - (let ((foo (list 'a arg 'b))) - (list foo (backtrace-tests--func2 arg) (backtrace-tests--func1 arg 0)))) + (eval backtrace-tests--uncompiled-functions)) -(defun backtrace-tests--create-backtrace-frames () - (backtrace-tests--func3 "string") - ;; Discard frames before this one. - (let (this-index) - (dotimes (index (length backtrace-tests--frames)) - (when (eq (backtrace-frame-fun (nth index backtrace-tests--frames)) - 'backtrace-tests--create-backtrace-frames) - (setq this-index index))) - (setq backtrace-tests--frames (seq-subseq backtrace-tests--frames - 0 (1+ this-index))))) +(defun backtrace-tests--backtrace-lines () + (if debugger-stack-frame-as-list + '(" (backtrace-get-frames)\n" + " (setq backtrace-frames (backtrace-get-frames))\n" + " (backtrace-tests--setup-buffer)\n" + " (backtrace-tests--make-backtrace %s)\n") + '(" backtrace-get-frames()\n" + " (setq backtrace-frames (backtrace-get-frames))\n" + " backtrace-tests--setup-buffer()\n" + " backtrace-tests--make-backtrace(%s)\n"))) -(backtrace-tests--create-backtrace-frames) +(defconst backtrace-tests--line-count (length (backtrace-tests--backtrace-lines))) + +(defun backtrace-tests--backtrace-lines-with-locals () + (let ((lines (backtrace-tests--backtrace-lines)) + (locals '(" [no locals]\n" + " [no locals]\n" + " [no locals]\n" + " arg = %s\n"))) + (apply #'append (cl-mapcar #'list lines locals)))) + +(defun backtrace-tests--result (value) + (format (apply #'concat (backtrace-tests--backtrace-lines)) + (cl-prin1-to-string value))) + +(defun backtrace-tests--result-with-locals (value) + (let ((str (cl-prin1-to-string value))) + (format (apply #'concat (backtrace-tests--backtrace-lines-with-locals)) + str str))) ;; TODO check that debugger-batch-max-lines still works +(defconst backtrace-tests--header "Test header\n") (defun backtrace-tests--insert-header () - (insert "Test header\n")) - -(defmacro backtrace-tests--with-buffer (&rest body) - `(with-temp-buffer - (backtrace-mode) - (setq backtrace-frames backtrace-tests--frames) - (setq backtrace-insert-header-function #'backtrace-tests--insert-header) - (backtrace-print) - ,@body)) + (insert backtrace-tests--header)) ;;; Tests + +(ert-deftest backtrace-tests--variables () + "Backtrace buffers can show and hide local variables." + (ert-with-test-buffer (:name "variables") + (let ((results (concat backtrace-tests--header + (backtrace-tests--result 'value))) + (last-frame (format (nth (1- backtrace-tests--line-count) + (backtrace-tests--backtrace-lines)) 'value)) + (last-frame-with-locals + (format (apply #'concat (nthcdr (* 2 (1- backtrace-tests--line-count)) + (backtrace-tests--backtrace-lines-with-locals))) + 'value 'value))) + (backtrace-tests--make-backtrace 'value) + (setq backtrace-insert-header-function #'backtrace-tests--insert-header) + (backtrace-print) + (should (string= (backtrace-tests--get-substring (point-min) (point-max)) + results)) + ;; Go to the last frame. + (goto-char (point-max)) + (forward-line -1) + ;; Turn on locals for that frame. + (backtrace-toggle-locals) + (should (string= (backtrace-tests--get-substring (point) (point-max)) + last-frame-with-locals)) + (should (string= (backtrace-tests--get-substring (point-min) (point-max)) + (concat results + (format (car (last (backtrace-tests--backtrace-lines-with-locals))) + 'value)))) + ;; Turn off locals for that frame. + (backtrace-toggle-locals) + (should (string= (backtrace-tests--get-substring (point) (point-max)) + last-frame)) + (should (string= (backtrace-tests--get-substring (point-min) (point-max)) + results)) + ;; Turn all locals on. + (backtrace-toggle-locals '(4)) + (should (string= (backtrace-tests--get-substring (point) (point-max)) + last-frame-with-locals)) + (should (string= (backtrace-tests--get-substring (point-min) (point-max)) + (concat backtrace-tests--header + (backtrace-tests--result-with-locals 'value)))) + ;; Turn all locals off. + (backtrace-toggle-locals '(4)) + (should (string= (backtrace-tests--get-substring + (point) (+ (point) (length last-frame))) + last-frame)) + (should (string= (backtrace-tests--get-substring (point-min) (point-max)) + results))))) + +(ert-deftest backtrace-tests--backward-frame () + "`backtrace-backward-frame' moves backward to the start of a frame." + (ert-with-test-buffer (:name "backward") + (let ((results (concat backtrace-tests--header + (backtrace-tests--result nil)))) + (backtrace-tests--make-backtrace nil) + (setq backtrace-insert-header-function #'backtrace-tests--insert-header) + (backtrace-print) + (should (string= (backtrace-tests--get-substring (point-min) (point-max)) + results)) + + ;; Try to move backward from header. + (goto-char (+ (point-min) (/ (length backtrace-tests--header) 2))) + (let ((pos (point))) + (should-error (backtrace-backward-frame)) + (should (= pos (point)))) + + ;; Try to move backward from start of first line. + (forward-line) + (let ((pos (point))) + (should-error (backtrace-backward-frame)) + (should (= pos (point)))) + + ;; Move backward from middle of line. + (let ((start (point))) + (forward-char (/ (length (nth 0 (backtrace-tests--backtrace-lines))) 2)) + (backtrace-backward-frame) + (should (= start (point)))) + + ;; Move backward from end of buffer. + (goto-char (point-max)) + (backtrace-backward-frame) + (let* ((last (format (car (last (backtrace-tests--backtrace-lines))) nil)) + (len (length last))) + (should (string= (buffer-substring-no-properties (point) (+ (point) len)) + last))) + + ;; Move backward from start of line. + (backtrace-backward-frame) + (let* ((line (car (last (backtrace-tests--backtrace-lines) 2))) + (len (length line))) + (should (string= (buffer-substring-no-properties (point) (+ (point) len)) + line)))))) + +(ert-deftest backtrace-tests--forward-frame () + "`backtrace-forward-frame' moves forward to the start of a frame." + (ert-with-test-buffer (:name "forward") + (let* ((arg '(1 2 3)) + (results (concat backtrace-tests--header + (backtrace-tests--result arg))) + (first-line (nth 0 (backtrace-tests--backtrace-lines)))) + (backtrace-tests--make-backtrace arg) + (setq backtrace-insert-header-function #'backtrace-tests--insert-header) + (backtrace-print) + (should (string= (backtrace-tests--get-substring (point-min) (point-max)) + results)) + ;; Move forward from header. + (goto-char (+ (point-min) (/ (length backtrace-tests--header) 2))) + (backtrace-forward-frame) + (should (string= (backtrace-tests--get-substring + (point) (+ (point) (length first-line))) + first-line)) + + (let ((start (point)) + (offset (/ (length first-line) 2)) + (second-line (nth 1 (backtrace-tests--backtrace-lines)))) + ;; Move forward from start of first frame. + (backtrace-forward-frame) + (should (string= (backtrace-tests--get-substring + (point) (+ (point) (length second-line))) + second-line)) + ;; Move forward from middle of first frame. + (goto-char (+ start offset)) + (backtrace-forward-frame) + (should (string= (backtrace-tests--get-substring + (point) (+ (point) (length second-line))) + second-line))) + ;; Try to move forward from middle of last frame. + (goto-char (- (point-max) + (/ 2 (length (car (last (backtrace-tests--backtrace-lines))))))) + (should-error (backtrace-forward-frame)) + ;; Try to move forward from end of buffer. + (goto-char (point-max)) + (should-error (backtrace-forward-frame))))) + +(ert-deftest backtrace-tests--pretty-print-and-collapse () + "Forms in backtrace frames can be pretty-printed and collapsed." + (ert-with-test-buffer (:name "pp-and-collapse") + (let* ((arg '(lambda (x) ; Quote this so it isn't made into a closure. + (let ((number (1+ x))) + (+ x number)))) + (header-string "Test header: ") + (header (format "%s%s\n" header-string arg)) + (insert-header-function (lambda () + (insert header-string) + (insert (backtrace-print-to-string arg)) + (insert "\n"))) + (results (concat header (backtrace-tests--result arg))) + (last-line (format (nth (1- backtrace-tests--line-count) + (backtrace-tests--backtrace-lines)) + arg)) + (last-line-locals (format (nth (1- (* 2 backtrace-tests--line-count)) + (backtrace-tests--backtrace-lines-with-locals)) + arg))) + + (backtrace-tests--make-backtrace arg) + (setq backtrace-insert-header-function insert-header-function) + (backtrace-print) + (should (string= (backtrace-tests--get-substring (point-min) (point-max)) + results)) + ;; Check pp and collapse for the form in the header. + (goto-char (point-min)) + (backtrace-tests--verify-pp-and-collapse header) + ;; Check pp and collapse for the last frame. + (goto-char (point-max)) + (backtrace-backward-frame) + (backtrace-tests--verify-pp-and-collapse last-line) + ;; Check pp and collapse for local variables in the last line. + (goto-char (point-max)) + (backtrace-backward-frame) + (backtrace-toggle-locals) + (forward-line) + (backtrace-tests--verify-pp-and-collapse last-line-locals)))) + +(defun backtrace-tests--verify-pp-and-collapse (line) + "Verify that `backtrace-pretty-print' and `backtrace-collapse' work at point. +Point should be at the beginning of a line, and LINE should be a +string containing the text of the line at point. Assume that the +line contains the strings \"lambda\" and \"number\"." + (let ((pos (point))) + (backtrace-pretty-print) + ;; Verify point is still at the start of the line. + (should (= pos (point)))) + + ;; Verify the form now spans multiple lines. + (let ((pos (point))) + (search-forward "number") + (should-not (= pos (point-at-bol)))) + ;; Collapse the form. + (backtrace-collapse) + ;; Verify that the form is now back on one line, + ;; and that point is at the same place. + (should (string= (backtrace-tests--get-substring + (- (point) 6) (point)) "number")) + (should-not (= (point) (point-at-bol))) + (should (string= (backtrace-tests--get-substring + (point-at-bol) (1+ (point-at-eol))) + line))) + +(ert-deftest backtrace-tests--print-circle () + "Backtrace buffers can toggle `print-circle' syntax." + (ert-with-test-buffer (:name "print-circle") + (let* ((print-circle nil) + (arg (let ((val (make-list 5 'a))) (nconc val val) val)) + (results (backtrace-tests--make-regexp + (backtrace-tests--result arg))) + (results-circle (regexp-quote (let ((print-circle t)) + (backtrace-tests--result arg)))) + (last-frame (backtrace-tests--make-regexp + (format (nth (1- backtrace-tests--line-count) + (backtrace-tests--backtrace-lines)) + arg))) + (last-frame-circle (regexp-quote + (let ((print-circle t)) + (format (nth (1- backtrace-tests--line-count) + (backtrace-tests--backtrace-lines)) + arg))))) + (backtrace-tests--make-backtrace arg) + (backtrace-print) + (should (string-match-p results + (backtrace-tests--get-substring (point-min) (point-max)))) + ;; Go to the last frame. + (goto-char (point-max)) + (forward-line -1) + ;; Turn on print-circle for that frame. + (backtrace-toggle-print-circle) + (should (string-match-p last-frame-circle + (backtrace-tests--get-substring (point) (point-max)))) + ;; Turn off print-circle for the frame. + (backtrace-toggle-print-circle) + (should (string-match-p last-frame + (backtrace-tests--get-substring (point) (point-max)))) + (should (string-match-p results + (backtrace-tests--get-substring (point-min) (point-max)))) + ;; Turn print-circle on for the buffer. + (backtrace-toggle-print-circle '(4)) + (should (string-match-p last-frame-circle + (backtrace-tests--get-substring (point) (point-max)))) + (should (string-match-p results-circle + (backtrace-tests--get-substring (point-min) (point-max)))) + ;; Turn print-circle off. + (backtrace-toggle-print-circle '(4)) + (should (string-match-p last-frame + (backtrace-tests--get-substring + (point) (+ (point) (length last-frame))))) + (should (string-match-p results + (backtrace-tests--get-substring (point-min) (point-max))))))) + +(defun backtrace-tests--make-regexp (str) + "Make regexp from STR for `backtrace-tests--print-circle'. +Used for results of printing circular objects without +`print-circle' on. Look for #n in string STR where n is any +digit and replace with #[0-9]." + (let ((regexp (regexp-quote str))) + (with-temp-buffer + (insert regexp) + (goto-char (point-min)) + (while (re-search-forward "#[0-9]" nil t) + (replace-match "#[0-9]"))) + (buffer-string))) + +(ert-deftest backtrace-tests--expand-ellipsis () + "Backtrace buffers ellipsify large forms and can expand the ellipses." + ;; make a backtrace with an ellipsis + ;; expand the ellipsis + (ert-with-test-buffer (:name "variables") + (let* ((print-level nil) + (print-length nil) + (arg (let ((long (make-list 100 'a)) + (deep '(0 (1 (2 (3 (4 (5 (6 (7 (8 (9)))))))))))) + (setf (nth 1 long) deep) + long)) + (results (backtrace-tests--result arg))) + (backtrace-tests--make-backtrace arg) + (backtrace-print) + + ;; There should be two ellipses. Find and expand them. + (goto-char (point-min)) + (search-forward "...") + (backward-char) + (push-button) + (search-forward "...") + (backward-char) + (push-button) + + (should (string= (backtrace-tests--get-substring (point-min) (point-max)) + results))))) + (ert-deftest backtrace-tests--to-string () - (should (string= (backtrace-to-string backtrace-tests--frames) - " backtrace-get-frames(nil) - (setq backtrace-tests--frames (backtrace-get-frames nil)) - backtrace-tests--func1(\"string\" 0) - (list foo (backtrace-tests--func2 arg) (backtrace-tests--func1 arg 0)) - (let ((foo (list 'a arg 'b))) (list foo (backtrace-tests--func2 arg) (backtrace-tests--func1 arg 0))) - backtrace-tests--func3(\"string\") - backtrace-tests--create-backtrace-frames() -"))) + "Backtraces can be produced as strings." + (let ((frames (ert-with-test-buffer (:name nil) + (backtrace-tests--make-backtrace "string") + backtrace-frames))) + (should (string= (backtrace-to-string frames) + (backtrace-tests--result "string"))))) -(provide 'backtrace-tests) +(defun backtrace-tests--get-substring (beg end) + "Return the visible text between BEG and END. +Strip the string properties because it makes failed test results +easier to read." + (substring-no-properties (filter-buffer-substring beg end))) -;; These tests expect to see non-byte compiled stack frames. -;; Local Variables: -;; no-byte-compile: t -;; End: +(provide 'backtrace-tests) ;;; backtrace-tests.el ends here commit af5f3771fd49bba579d3a2047bab1b278317eb5f Author: Gemini Lasswell Date: Sat Jul 7 12:48:18 2018 -0700 Add link in backtraces to position in buffer being evaluated (bug#14081) * lisp/emacs-lisp/backtrace.el (backtrace-frame): Add buffer field. (backtrace-get-frames): Set buffer field of frame. (backtrace-buffer-pos): New button type. (backtrace--pop-to-buffer-pos): New function. (backtrace--print-func-and-args): Create a button for the buffer position if it is set. diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el index bec57f2924..aac43fec8e 100644 --- a/lisp/emacs-lisp/backtrace.el +++ b/lisp/emacs-lisp/backtrace.el @@ -65,7 +65,7 @@ guaranteed." (cl-defstruct (backtrace-frame (:constructor backtrace-make-frame)) - evald fun args flags locals pos) + evald fun args flags locals buffer pos) (cl-defun backtrace-get-frames (&optional base &key (constructor #'backtrace-make-frame)) @@ -102,9 +102,26 @@ frames before its nearest activation frame are discarded." ;; eval-region calls for the same buffer. That's not a very ;; useful case. (with-current-buffer (pop eval-buffers) + (setf (backtrace-frame-buffer frame) (current-buffer)) (setf (backtrace-frame-pos frame) (point)))))) frames)) +;; Button definition for jumping to a buffer position. + +(define-button-type 'backtrace-buffer-pos + 'action #'backtrace--pop-to-buffer-pos + 'help-echo "mouse-2, RET: Show reading position") + +(defun backtrace--pop-to-buffer-pos (button) + "Pop to the buffer and position for the BUTTON at point." + (let* ((buffer (button-get button 'backtrace-buffer)) + (pos (button-get button 'backtrace-pos))) + (if (buffer-live-p buffer) + (progn + (pop-to-buffer buffer) + (goto-char (max (point-min) (min (point-max) pos)))) + (message "Buffer has been killed")))) + ;; Font Locking support (defconst backtrace--font-lock-keywords @@ -685,8 +702,12 @@ Format it according to VIEW." ;; After any frame that uses eval-buffer, insert a comment that ;; states the buffer position it's reading at. (when (backtrace-frame-pos frame) - (insert (format " ; Reading at buffer position %d" - (backtrace-frame-pos frame)))) + (insert " ; Reading at ") + (let ((pos (point))) + (insert (format "buffer position %d" (backtrace-frame-pos frame))) + (make-button pos (point) :type 'backtrace-buffer-pos + 'backtrace-buffer (backtrace-frame-buffer frame) + 'backtrace-pos (backtrace-frame-pos frame)))) (insert "\n") (put-text-property beg (point) 'backtrace-section 'func))) commit 9aa9d79e4420f367242312aedd61594fd173dec6 Author: Gemini Lasswell Date: Mon Jun 25 13:23:03 2018 -0700 Add links in backtraces to functions written in C (bug#25393) * lisp/emacs-lisp/backtrace.el (backtrace--print-func-and-args): Look up file names for built-in functions with evaluated arguments. diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el index d6c04bb4c6..bec57f2924 100644 --- a/lisp/emacs-lisp/backtrace.el +++ b/lisp/emacs-lisp/backtrace.el @@ -651,7 +651,11 @@ Format it according to VIEW." (evald (backtrace-frame-evald frame)) (fun (backtrace-frame-fun frame)) (args (backtrace-frame-args frame)) - (fun-file (symbol-file fun 'defun)) + (def (and (symbolp fun) (fboundp fun) (symbol-function fun))) + (fun-file (or (symbol-file fun 'defun) + (and (subrp def) + (not (eq 'unevalled (cdr (subr-arity def)))) + (find-lisp-object-file-name fun def)))) (fun-pt (point))) (cond ((and evald (not debugger-stack-frame-as-list)) commit bb9de872e86372c8a2475503e6be6b6bd64e06d6 Author: Gemini Lasswell Date: Sat Jun 23 10:25:29 2018 -0700 Add prefix argument to backtrace-toggle-print-circle With prefix argument, toggle print-circle for the whole buffer. * lisp/emacs-lisp/backtrace.el (backtrace-toggle-print-circle): Add universal prefix argument. (backtrace--toggle-feature): Add new argument 'all' to toggle all frames. (backtrace--set-feature): New function. (backtrace-mode): Use indent functions from Lisp modes. diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el index b896904134..d6c04bb4c6 100644 --- a/lisp/emacs-lisp/backtrace.el +++ b/lisp/emacs-lisp/backtrace.el @@ -349,39 +349,60 @@ Set it to VALUE unless the button is a `backtrace-ellipsis' button." (button-put beg 'skip value)) (setq beg (next-button beg))))) -(defun backtrace-toggle-print-circle () - "Toggle `print-circle' for the backtrace frame at point." - ;; TODO with argument, toggle the whole buffer. - (interactive) - (backtrace--toggle-feature :print-circle)) - -(defun backtrace--toggle-feature (feature) - "Toggle FEATURE for the backtrace frame at point. -FEATURE should be one of the options in `backtrace-view'. -After toggling the feature, reprint the frame and position -point at the start of the section of the frame it was in -before." - (let ((index (backtrace-get-index)) - (view (copy-sequence (backtrace-get-view)))) - (unless index - (user-error "Not in a stack frame")) - (setq view (plist-put view feature (not (plist-get view feature)))) - (let ((inhibit-read-only t) - (index (backtrace-get-index)) - (section (backtrace-get-section)) - (min (backtrace-get-frame-start)) - (max (backtrace-get-frame-end))) - (delete-region min max) - (goto-char min) - (backtrace-print-frame (nth index backtrace-frames) view) - (add-text-properties min (point) - `(backtrace-index ,index backtrace-view ,view)) - (goto-char min) - (when (not (eq section (backtrace-get-section))) - (if-let ((pos (text-property-any (backtrace-get-frame-start) - (backtrace-get-frame-end) - 'backtrace-section section))) - (goto-char pos)))))) +(defun backtrace-toggle-print-circle (&optional all) + "Toggle `print-circle' for the backtrace frame at point. +With prefix argument ALL, toggle the value of :print-circle in +`backtrace-view', which affects all of the backtrace frames in +the buffer." + (interactive "P") + (backtrace--toggle-feature :print-circle all)) + +(defun backtrace--toggle-feature (feature all) + "Toggle FEATURE for the current backtrace frame or for the buffer. +FEATURE should be one of the options in `backtrace-view'. If ALL +is non-nil, toggle FEATURE for all frames in the buffer. After +toggling the feature, reprint the affected frame(s). Afterwards +position point at the start of the frame it was in before." + (if all + (let ((index (backtrace-get-index)) + (pos (point)) + (at-end (= (point) (point-max))) + (value (not (plist-get backtrace-view feature)))) + (setq backtrace-view (plist-put backtrace-view feature value)) + (goto-char (point-min)) + ;; Skip the header. + (unless (backtrace-get-index) + (goto-char (backtrace-get-frame-end))) + (while (< (point) (point-max)) + (backtrace--set-feature feature value) + (goto-char (backtrace-get-frame-end))) + (if (not index) + (goto-char (if at-end (point-max) pos)) + (goto-char (point-min)) + (while (and (not (eql index (backtrace-get-index))) + (< (point) (point-max))) + (goto-char (backtrace-get-frame-end))))) + (let ((index (backtrace-get-index))) + (unless index + (user-error "Not in a stack frame")) + (backtrace--set-feature feature + (not (plist-get (backtrace-get-view) feature)))))) + +(defun backtrace--set-feature (feature value) + "Set FEATURE in the view plist of the frame at point to VALUE. +Reprint the frame with the new view plist." + (let ((inhibit-read-only t) + (view (copy-sequence (backtrace-get-view))) + (index (backtrace-get-index)) + (min (backtrace-get-frame-start)) + (max (backtrace-get-frame-end))) + (setq view (plist-put view feature value)) + (delete-region min max) + (goto-char min) + (backtrace-print-frame (nth index backtrace-frames) view) + (add-text-properties min (point) + `(backtrace-index ,index backtrace-view ,view)) + (goto-char min))) (defun backtrace-expand-ellipsis (button) "Expand display of the elided form at BUTTON." @@ -771,6 +792,8 @@ followed by `backtrace-print-frame', once for each stack frame." ;; (set-buffer-multibyte t) (setq-local revert-buffer-function #'backtrace-revert) (setq-local filter-buffer-substring-function #'backtrace--filter-visible) + (setq-local indent-line-function 'lisp-indent-line) + (setq-local indent-region-function 'lisp-indent-region) (add-hook 'xref-backend-functions #'backtrace--xref-backend nil t)) (put 'backtrace-mode 'mode-class 'special) commit d6b364edfe582be24cb54693c5aaf52c0add22d5 Author: Gemini Lasswell Date: Fri Jun 22 12:53:37 2018 -0700 Lazily print backtrace frame local variables Instead of printing the local variables for all frames when the backtrace buffer is created, print them when they are first made visible. Add a prefix argument to backtrace-toggle-locals to toggle local variables display for the entire buffer. * lisp/emacs-lisp/backtrace.el (backtrace-view): Mention :show-locals in docstring. (backtrace-get-section-end): Remove function. (backtrace-toggle-locals): Add prefix argument. (backtrace--with-output-variables): Move before first use. (backtrace--set-frame-locals-visible): New function. (backtrace--set-locals-visible-overlay): New function. (backtrace--set-locals-visible): Remove function. (backtrace-toggle-feature): Remove TODO comment. (backtrace--print-locals): Skip printing the locals if they are not visible. diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el index bcff14705c..b896904134 100644 --- a/lisp/emacs-lisp/backtrace.el +++ b/lisp/emacs-lisp/backtrace.el @@ -146,7 +146,7 @@ This should be a list of `backtrace-frame' objects.") (defvar-local backtrace-view nil "A plist describing how to render backtrace frames. -Possible entries are :show-flags and :print-circle.") +Possible entries are :show-flags, :show-locals and :print-circle.") (defvar-local backtrace-insert-header-function nil "Function for inserting a header for the current Backtrace buffer. @@ -231,14 +231,6 @@ POS, if omitted or nil, defaults to point." (next-single-property-change (or pos (point)) 'backtrace-index nil (point-max))) -(defun backtrace-get-section-end (&optional pos) - "Return the position of the end of the frame section at POS. -POS, if omitted or nil, defaults to point." - (let* ((frame-end (backtrace-get-frame-end pos)) - (section-end (next-single-property-change - (or pos (point)) 'backtrace-section nil frame-end))) - (min frame-end section-end))) - (defun backtrace-forward-frame () "Move forward to the beginning of the next frame." (interactive) @@ -272,24 +264,74 @@ It runs `backtrace-revert-hook', then calls `backtrace-print'." (run-hooks 'backtrace-revert-hook) (backtrace-print t)) -(defun backtrace-toggle-locals () - "Toggle the display of local variables for the backtrace frame at point. -TODO with argument, toggle all frames." - (interactive) - (let ((index (backtrace-get-index))) - (unless index - (user-error "Not in a stack frame")) - (let ((pos (point))) - (goto-char (backtrace-get-frame-start)) - (while (and (eq index (backtrace-get-index)) - (not (eq (backtrace-get-section) 'locals))) - (goto-char (next-single-property-change (point) 'backtrace-section))) - (let ((end (backtrace-get-section-end))) - (backtrace--set-locals-visible (point) end (invisible-p (point))) - - (goto-char (if (invisible-p pos) end pos)))))) +(defmacro backtrace--with-output-variables (view &rest body) + "Bind output variables according to VIEW and execute BODY." + (declare (indent 1)) + `(let ((print-escape-control-characters t) + (print-escape-newlines t) + (print-circle (plist-get ,view :print-circle)) + (standard-output (current-buffer))) + ,@body)) -(defun backtrace--set-locals-visible (beg end visible) +(defun backtrace-toggle-locals (&optional all) + "Toggle the display of local variables for the backtrace frame at point. +With prefix argument ALL, toggle the value of :show-locals in +`backtrace-view', which affects all of the backtrace frames in +the buffer." + (interactive "P") + (if all + (let ((pos (make-marker)) + (visible (not (plist-get backtrace-view :show-locals)))) + (setq backtrace-view (plist-put backtrace-view :show-locals visible)) + (set-marker-insertion-type pos t) + (set-marker pos (point)) + (goto-char (point-min)) + ;; Skip the header. + (unless (backtrace-get-index) + (goto-char (backtrace-get-frame-end))) + (while (< (point) (point-max)) + (backtrace--set-frame-locals-visible visible) + (goto-char (backtrace-get-frame-end))) + (goto-char pos) + (when (invisible-p pos) + (goto-char (backtrace-get-frame-start)))) + (let ((index (backtrace-get-index))) + (unless index + (user-error "Not in a stack frame")) + (backtrace--set-frame-locals-visible + (not (plist-get (backtrace-get-view) :show-locals)))))) + +(defun backtrace--set-frame-locals-visible (visible) + "Set the visibility of the local vars for the frame at point to VISIBLE." + (let ((pos (point)) + (index (backtrace-get-index)) + (start (backtrace-get-frame-start)) + (end (backtrace-get-frame-end)) + (view (copy-sequence (backtrace-get-view))) + (inhibit-read-only t)) + (setq view (plist-put view :show-locals visible)) + (goto-char (backtrace-get-frame-start)) + (while (not (or (= (point) end) + (eq (backtrace-get-section) 'locals))) + (goto-char (next-single-property-change (point) + 'backtrace-section nil end))) + (cond + ((and (= (point) end) visible) + ;; The locals section doesn't exist so create it. + (let ((standard-output (current-buffer))) + (backtrace--with-output-variables view + (backtrace--print-locals + (nth index backtrace-frames) view)) + (add-text-properties end (point) `(backtrace-index ,index)) + (goto-char pos))) + ((/= (point) end) + ;; The locals section does exist, so add or remove the overlay. + (backtrace--set-locals-visible-overlay (point) end visible) + (goto-char (if (invisible-p pos) start pos)))) + (add-text-properties start (backtrace-get-frame-end) + `(backtrace-view ,view)))) + +(defun backtrace--set-locals-visible-overlay (beg end visible) (backtrace--change-button-skip beg end (not visible)) (if visible (remove-overlays beg end 'invisible t) @@ -319,7 +361,6 @@ FEATURE should be one of the options in `backtrace-view'. After toggling the feature, reprint the frame and position point at the start of the section of the frame it was in before." - ;; TODO preserve (in)visibility of locals (let ((index (backtrace-get-index)) (view (copy-sequence (backtrace-get-view)))) (unless index @@ -342,15 +383,6 @@ before." 'backtrace-section section))) (goto-char pos)))))) -(defmacro backtrace--with-output-variables (view &rest body) - "Bind output variables according to VIEW and execute BODY." - (declare (indent 1)) - `(let ((print-escape-control-characters t) - (print-escape-newlines t) - (print-circle (plist-get ,view :print-circle)) - (standard-output (current-buffer))) - ,@body)) - (defun backtrace-expand-ellipsis (button) "Expand display of the elided form at BUTTON." ;; TODO a command to expand all ... in form at point @@ -633,21 +665,21 @@ Format it according to VIEW." (insert "\n") (put-text-property beg (point) 'backtrace-section 'func))) -(defun backtrace--print-locals (frame _view) - "Print a backtrace FRAME's local variables. -Make them invisible initially." - (let* ((beg (point)) - (locals (backtrace-frame-locals frame))) - (if (null locals) - (insert " [no locals]\n") - (pcase-dolist (`(,symbol . ,value) locals) - (insert " ") - (backtrace--print symbol) - (insert " = ") - (insert (backtrace--print-to-string value)) - (insert "\n"))) - (put-text-property beg (point) 'backtrace-section 'locals) - (backtrace--set-locals-visible beg (point) nil))) +(defun backtrace--print-locals (frame view) + "Print a backtrace FRAME's local variables according to VIEW. +Print them only if :show-locals is non-nil in the VIEW plist." + (when (plist-get view :show-locals) + (let* ((beg (point)) + (locals (backtrace-frame-locals frame))) + (if (null locals) + (insert " [no locals]\n") + (pcase-dolist (`(,symbol . ,value) locals) + (insert " ") + (backtrace--print symbol) + (insert " = ") + (insert (backtrace--print-to-string value)) + (insert "\n"))) + (put-text-property beg (point) 'backtrace-section 'locals)))) (defun backtrace--print (obj) "Attempt to print OBJ using `backtrace-print-function'. commit 5b50fa5a9d4f7c032a845bc0152c11b70ee1bf53 Author: Gemini Lasswell Date: Sun Jun 24 07:17:47 2018 -0700 Always make buttons from function names in backtraces * lisp/emacs-lisp/backtrace.el (backtrace-view) (backtrace--print-func-and-args, backtrace-mode): Always make buttons. Remove all uses of ':do-xrefs'. * lisp/emacs-lisp/debug.el (debugger-setup-buffer): Modify backtrace-view instead of setting it. * lisp/emacs-lisp/edebug.el (edebug-backtrace): * lisp/emacs-lisp/ert.el (ert-results-pop-to-backtrace-for-test-at-point): Remove initialization of backtrace-view. diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el index d16edb6a6c..bcff14705c 100644 --- a/lisp/emacs-lisp/backtrace.el +++ b/lisp/emacs-lisp/backtrace.el @@ -146,7 +146,7 @@ This should be a list of `backtrace-frame' objects.") (defvar-local backtrace-view nil "A plist describing how to render backtrace frames. -Possible entries are :show-flags, :do-xrefs and :print-circle.") +Possible entries are :show-flags and :print-circle.") (defvar-local backtrace-insert-header-function nil "Function for inserting a header for the current Backtrace buffer. @@ -591,14 +591,14 @@ property for use by navigation." (insert (if (and (plist-get view :show-flags) flag) "* " " ")) (put-text-property beg (point) 'backtrace-section 'func))) -(defun backtrace--print-func-and-args (frame view) +(defun backtrace--print-func-and-args (frame _view) "Print the function, arguments and buffer position of a backtrace FRAME. Format it according to VIEW." (let* ((beg (point)) (evald (backtrace-frame-evald frame)) (fun (backtrace-frame-fun frame)) (args (backtrace-frame-args frame)) - (fun-file (and (plist-get view :do-xrefs) (symbol-file fun 'defun))) + (fun-file (symbol-file fun 'defun)) (fun-pt (point))) (cond ((and evald (not debugger-stack-frame-as-list)) @@ -707,15 +707,16 @@ creates a backtrace-mode buffer, should usually do the following: - Maybe set `backtrace-insert-header-function' to a function to create header text for the buffer. - Set `backtrace-frames' (see below). - - Set `backtrace-view' if desired (see below). + - Maybe modify `backtrace-view' (see below). - Maybe set `backtrace-print-function'. A command which creates or switches to a Backtrace mode buffer, such as `ert-results-pop-to-backtrace-for-test-at-point', should initialize `backtrace-frames' to a list of `backtrace-frame' objects (`backtrace-get-frames' is provided for that purpose, if -desired), and `backtrace-view' to a plist describing how it wants -the backtrace to appear. Finally, it should call `backtrace-print'. +desired), and may optionally modify `backtrace-view', which is a +plist describing the appearance of the backtrace. Finally, it +should call `backtrace-print'. `backtrace-print' calls `backtrace-insert-header-function' followed by `backtrace-print-frame', once for each stack frame." diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 707e0cfa18..48ca32ddd8 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -335,7 +335,7 @@ That buffer should be current already and in debugger-mode." :debug-on-exit) nil)) - (setq backtrace-view '(:do-xrefs t :show-flags t) + (setq backtrace-view (plist-put backtrace-view :show-flags t) backtrace-insert-header-function (lambda () (debugger--insert-header args)) backtrace-print-function debugger-print-function) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index b22c8952da..3bf9cb9a48 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -4007,8 +4007,7 @@ Otherwise call `debug' normally." (with-current-buffer edebug-backtrace-buffer (unless (derived-mode-p 'backtrace-mode) (backtrace-mode)) - (setq backtrace-frames (edebug--backtrace-frames) - backtrace-view '(:do-xrefs t)) + (setq backtrace-frames (edebug--backtrace-frames)) (backtrace-print) (goto-char (point-min))))) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 7178493ebe..eb9695d0c1 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -2449,8 +2449,7 @@ To be used in the ERT results buffer." (backtrace-mode)) (setq backtrace-insert-header-function (lambda () (ert--insert-backtrace-header (ert-test-name test))) - backtrace-frames (ert-test-result-with-condition-backtrace result) - backtrace-view '(:do-xrefs t)) + backtrace-frames (ert-test-result-with-condition-backtrace result)) (backtrace-print) (goto-char (point-min))))))) commit e09120d68694272ea5efbe13b16936b4382389d8 Author: Gemini Lasswell Date: Tue Jun 19 07:27:41 2018 -0700 Add backtrace-mode and use it in the debugger, ERT and Edebug * doc/lispref/debugging.texi (Using Debugger): Remove explanation of backtrace buffer. Refer to new node. (Backtraces): New node. (Debugger Commands): Refer to new node. Remove 'v'. * doc/lispref/edebug.texi (Edebug Misc): Refer to new node. * doc/misc/ert.texi (Running Tests Interactively): Refer to new node. * lisp/emacs-lisp-backtrace.el: New file. * test/lisp/emacs-lisp/backtrace-tests.el: New file. * lisp/emacs-lisp/debug.el: (debugger-buffer-state): New cl-defstruct. (debugger--restore-buffer-state): New function. (debug): Use a debugger-buffer-state object to save and restore buffer state. Fix bug#15749 by leaving an unused buffer in debugger-mode, empty, instead of in fundamental-mode, and then when reusing a buffer, not calling debugger-mode if the buffer is already in debugger-mode. (debugger-insert-backtrace): Remove. (debugger-setup-buffer): Use backtrace-mode. (debugger--insert-header): New function. (debugger-continue, debugger-return-value): Change check for flags to use backtrace-frames. (debugger-frame-number): Determine backtrace frame number from backtrace-frames. (debugger--locals-visible-p, debugger--insert-locals) (debugger--show-locals, debugger--hide-locals) (debugger-toggle-locals): Remove. (debugger-mode-map): Make a child of backtrace-mode-map. Move navigation commands to backtrace-mode-map. Bind 'q' to debugger-quit instead of top-level. Make Help Follow menu item call backtrace-help-follow-symbol. (debugger-mode): Derive from backtrace-mode. (debug-help-follow): Remove. Move body of this function to 'backtrace-help-follow-symbol' in backtrace.el. (debugger-quit): New function. * lisp/emacs-lisp/edebug.el (edebug-unwrap-results): Remove warning in docstring about circular results. (edebug-unwrap): Use pcase. (edebug-unwrap1): New function to unwrap circular objects. (edebug-unwrap*): Use it. (edebug--frame): New cl-defstruct. (edebug-backtrace): Call the buffer *Edebug Backtrace* and use backtrace-mode. Get the frames from edebug--backtrace-frames. (edebug--backtrace-frames, edebug--unwrap-and-add-info) (edebug--symbol-not-prefixed-p): New functions. * lisp/emacs-lisp/lisp-mode.el (lisp-el-font-lock-keywords-for-backtraces) (lisp-el-font-lock-keywords-for-backtraces-1) (lisp-el-font-lock-keywords-for-backtraces-2): New constants. * lisp/emacs-lisp/ert.el (ert--print-backtrace): Remove. (ert--run-test-debugger): Use backtrace-get-frames. (ert-run-tests-batch): Use backtrace-to-string. (ert-results-pop-to-backtrace-for-test-at-point): Use backtrace-mode. (ert--insert-backtrace-header): New function. * tests/lisp/emacs-lisp/ert-tests.el (ert-test--which-file): Use backtrace-frame slot accessor. diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi index 1b1f87465d..b5a73a255a 100644 --- a/doc/lispref/debugging.texi +++ b/doc/lispref/debugging.texi @@ -81,7 +81,8 @@ debugger recursively. @xref{Recursive Editing}. * Function Debugging:: Entering it when a certain function is called. * Variable Debugging:: Entering it when a variable is modified. * Explicit Debug:: Entering it at a certain point in the program. -* Using Debugger:: What the debugger does; what you see while in it. +* Using Debugger:: What the debugger does. +* Backtraces:: What you see while in the debugger. * Debugger Commands:: Commands used while in the debugger. * Invoking the Debugger:: How to call the function @code{debug}. * Internals of Debugger:: Subroutines of the debugger, and global variables. @@ -392,32 +393,79 @@ this is not what you want, you can either set @code{eval-expression-debug-on-error} to @code{nil}, or set @code{debug-on-error} to @code{nil} in @code{debugger-mode-hook}. + The debugger itself must be run byte-compiled, since it makes +assumptions about the state of the Lisp interpreter. These +assumptions are false if the debugger is running interpreted. + +@node Backtraces +@subsection Backtraces +@cindex backtrace buffer + +Debugger mode is derived from Backtrace mode, which is also used to +show backtraces by Edebug and ERT. (@pxref{Edebug} and @ref{Top,the +ERT manual,, ert, ERT: Emacs Lisp Regression Testing}) + +@cindex stack frame +The backtrace buffer shows you the functions that are executing and +their argument values. When a backtrace buffer is created, it shows +each stack frame on one, possibly very long, line. (A stack frame is +the place where the Lisp interpreter records information about a +particular invocation of a function.) The most recently called +function will be at the top. + @cindex current stack frame - The backtrace buffer shows you the functions that are executing and -their argument values. It also allows you to specify a stack frame by -moving point to the line describing that frame. (A stack frame is the -place where the Lisp interpreter records information about a particular -invocation of a function.) The frame whose line point is on is -considered the @dfn{current frame}. Some of the debugger commands -operate on the current frame. If a line starts with a star, that means -that exiting that frame will call the debugger again. This is useful -for examining the return value of a function. - - If a function name is underlined, that means the debugger knows -where its source code is located. You can click with the mouse on -that name, or move to it and type @key{RET}, to visit the source code. +In a backtrace you can specify a stack frame by moving point to a line +describing that frame. The frame whose line point is on is considered +the @dfn{current frame}. + +If a function name is underlined, that means Emacs knows where its +source code is located. You can click with the mouse on that name, or +move to it and type @key{RET}, to visit the source code. You can also +type @key{RET} while point is on any name of a function or variable +which is not underlined, to see help information for that symbol in a +help buffer, if any exists. The @code{xref-find-definitions} command, +bound to @key{M-.}, can also be used on any identifier in a backtrace +(@pxref{Looking Up Identifiers,,,emacs,Emacs manual}). + +In backtraces, the tails of long lists and the ends of long strings, +vectors or structures, as well as objects which are deeply nested, +will be printed as underlined ``...''. You can click with the mouse +on a ``...'', or type @key{RET} while point is on it, to show the part +of the object that was hidden. To control how much abbreviation is +done, customize @code{backtrace-line-length}. + +Here is a list of commands for navigating and viewing backtraces: - The debugger itself must be run byte-compiled, since it makes -assumptions about how many stack frames are used for the debugger -itself. These assumptions are false if the debugger is running -interpreted. +@table @kbd +@item v +Toggle the display of local variables of the current stack frame. + +@item p +Move to the beginning of the frame, or to the beginning +of the previous frame. + +@item n +Move to the beginning of the next frame. + +@item + +Add line breaks and indentation to the top-level Lisp form at point to +make it more readable. + +@item = +Collapse the top-level Lisp form at point back to a single line. + +@item # +Toggle @code{print-circle} for the frame at point. + +@end table @node Debugger Commands @subsection Debugger Commands @cindex debugger command list The debugger buffer (in Debugger mode) provides special commands in -addition to the usual Emacs commands. The most important use of +addition to the usual Emacs commands and to the Backtrace mode commands +described in the previous section. The most important use of debugger commands is for stepping through code, so that you can see how control flows. The debugger can step through the control structures of an interpreted function, but cannot do so in a @@ -427,6 +475,11 @@ the same function. (To do this, visit the source for the function and type @kbd{C-M-x} on its definition.) You cannot use the Lisp debugger to step through a primitive function. +Some of the debugger commands operate on the current frame. If a +frame starts with a star, that means that exiting that frame will call the +debugger again. This is useful for examining the return value of a +function. + @c FIXME: Add @findex for the following commands? --xfq Here is a list of Debugger mode commands: @@ -502,8 +555,6 @@ Display a list of functions that will invoke the debugger when called. This is a list of functions that are set to break on entry by means of @code{debug-on-entry}. -@item v -Toggle the display of local variables of the current stack frame. @end table @node Invoking the Debugger diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index b9cc1d5afc..0e0a2e8a64 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -442,8 +442,8 @@ Redisplay the most recently known expression result in the echo area Display a backtrace, excluding Edebug's own functions for clarity (@code{edebug-backtrace}). -You cannot use debugger commands in the backtrace buffer in Edebug as -you would in the standard debugger. +@xref{Debugging,, Backtraces, elisp}, for the commands which work +in a backtrace buffer. The backtrace buffer is killed automatically when you continue execution. diff --git a/doc/misc/ert.texi b/doc/misc/ert.texi index 82e0e27ed1..e2aeeb1353 100644 --- a/doc/misc/ert.texi +++ b/doc/misc/ert.texi @@ -273,9 +273,11 @@ moving point to it and typing @kbd{@key{RET}} jumps to its definition. @cindex backtrace of a failed test Pressing @kbd{r} re-runs the test near point on its own. Pressing @kbd{d} re-runs it with the debugger enabled. @kbd{.} jumps to the -definition of the test near point (@kbd{@key{RET}} has the same effect if -point is on the name of the test). On a failed test, @kbd{b} shows -the backtrace of the failure. +definition of the test near point (@kbd{@key{RET}} has the same effect +if point is on the name of the test). On a failed test, @kbd{b} shows +the backtrace of the failure. @xref{Debugging,, Backtraces, elisp, +the Emacs Lisp Reference Manual}, for more information about +backtraces. @kindex l@r{, in ert results buffer} @kbd{l} shows the list of @code{should} forms executed in the test. diff --git a/etc/NEWS b/etc/NEWS index 6ccf6fc089..486e0d4384 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -466,6 +466,14 @@ the shift key. *** Isearch now remembers the regexp-based search mode for words/symbols and case-sensitivity together with search strings in the search ring. +** Debugger + ++++ +*** The Lisp Debugger is now based on 'backtrace-mode'. +Backtrace mode adds fontification and commands for changing the +appearance of backtrace frames. See the node "Backtraces" in the Elisp +manual for documentation of the new mode and its commands. + ** Edebug +++ @@ -475,14 +483,18 @@ using the new variables 'edebug-behavior-alist', 'edebug-new-definition-function'. Edebug's behavior can be changed globally or for individual definitions. ++++ +*** Edebug's backtrace buffer now uses 'backtrace-mode'. +Backtrace mode adds fontification, links and commands for changing the +appearance of backtrace frames. See the node "Backtraces" in the Elisp +manual for documentation of the new mode and its commands. + ** Enhanced xterm support *** New variable 'xterm-set-window-title' controls whether Emacs sets the XTerm window title. This feature is experimental and is disabled by default. -** Gamegrid - ** grep +++ @@ -499,6 +511,14 @@ The abbreviation can be disabled by the new option *** New variable 'ert-quiet' allows to make ERT output in batch mode less verbose by removing non-essential information. ++++ +*** ERT's backtrace buffer now uses 'backtrace-mode'. +Backtrace mode adds fontification and commands for changing the +appearance of backtrace frames. See the node "Backtraces" in the Elisp +manual for documentation of the new mode and its commands. + +** Gamegrid + --- *** Gamegrid now determines its default glyph size based on display dimensions, instead of always using 16 pixels. As a result, Tetris, @@ -669,6 +689,13 @@ transport strategies as well as a separate API to use them. A transport implementation for process-based communication, such as is used by the Language Server Protocol (LSP), is readily available. ++++ +** Backtrace mode improves viewing of Elisp backtraces. +Backtrace mode adds pretty printing, fontification and ellipsis +expansion to backtrace buffers produced by the Lisp debugger, Edebug +and ERT. See the node "Backtraces" in the Elisp manual for +documentation of the new mode and its commands. + * Incompatible Lisp Changes in Emacs 27.1 diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el new file mode 100644 index 0000000000..d16edb6a6c --- /dev/null +++ b/lisp/emacs-lisp/backtrace.el @@ -0,0 +1,767 @@ +;;; backtrace.el --- generic major mode for Elisp backtraces -*- lexical-binding: t -*- + +;; Copyright (C) 2018 Free Software Foundation, Inc. + +;; Author: Gemini Lasswell +;; Keywords: lisp, tools, maint +;; Version: 1.0 + +;; 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 . + +;;; Commentary: + +;; This file defines Backtrace mode, a generic major mode for displaying +;; Elisp stack backtraces, which can be used as is or inherited from +;; by another mode. + +;; For usage information, see the documentation of `backtrace-mode'. + +;;; Code: + +(eval-when-compile (require 'cl-lib)) +(eval-when-compile (require 'pcase)) +(eval-when-compile (require 'subr-x)) ; if-let +(require 'help-mode) ; Define `help-function-def' button type. +(require 'lisp-mode) + +;;; Options + +(defgroup backtrace nil + "Viewing of Elisp backtraces." + :group 'lisp) + +(defcustom backtrace-fontify t + "If non-nil, fontify Backtrace buffers. +Set to nil to disable fontification, which may be necessary in +order to debug the code that does fontification." + :type 'boolean + :group 'backtrace + :version "27.1") + +(defcustom backtrace-line-length 5000 + "Target length for lines in Backtrace buffers. +Backtrace mode will attempt to abbreviate printing of backtrace +frames to make them shorter than this, but success is not +guaranteed." + :type 'integer + :group 'backtrace + :version "27.1") + +;;; Backtrace frame data structure + +(cl-defstruct + (backtrace-frame + (:constructor backtrace-make-frame)) + evald fun args flags locals pos) + +(cl-defun backtrace-get-frames + (&optional base &key (constructor #'backtrace-make-frame)) + "Collect all frames of current backtrace into a list. +The list will contain objects made by CONSTRUCTOR, which +defaults to `backtrace-make-frame' and which, if provided, should +be the constructor of a structure which includes +`backtrace-frame'. If non-nil, BASE should be a function, and +frames before its nearest activation frame are discarded." + (let ((frames nil) + (eval-buffers eval-buffer-list)) + (mapbacktrace (lambda (evald fun args flags) + (push (funcall constructor + :evald evald :fun fun + :args args :flags flags) + frames)) + (or base 'backtrace-get-frames)) + (setq frames (nreverse frames)) + ;; Add local variables to each frame, and the buffer position + ;; to frames containing eval-buffer or eval-region. + (dotimes (idx (length frames)) + (let ((frame (nth idx frames))) + ;; `backtrace--locals' gives an error when idx is 0. But the + ;; locals for frame 0 are not needed, because when we get here + ;; from debug-on-entry, the locals aren't bound yet, and when + ;; coming from Edebug or ERT there is an Edebug or ERT + ;; function at frame 0. + (when (> idx 0) + (setf (backtrace-frame-locals frame) + (backtrace--locals idx (or base 'backtrace-get-frames)))) + (when (and eval-buffers (memq (backtrace-frame-fun frame) + '(eval-buffer eval-region))) + ;; This will get the wrong result if there are two nested + ;; eval-region calls for the same buffer. That's not a very + ;; useful case. + (with-current-buffer (pop eval-buffers) + (setf (backtrace-frame-pos frame) (point)))))) + frames)) + +;; Font Locking support + +(defconst backtrace--font-lock-keywords + '((backtrace--match-ellipsis-in-string + (1 'button prepend))) + "Expressions to fontify in Backtrace mode. +Fontify these in addition to the expressions Emacs Lisp mode +fontifies.") + +(defconst backtrace-font-lock-keywords + (append lisp-el-font-lock-keywords-for-backtraces + backtrace--font-lock-keywords) + "Default expressions to highlight in Backtrace mode.") +(defconst backtrace-font-lock-keywords-1 + (append lisp-el-font-lock-keywords-for-backtraces-1 + backtrace--font-lock-keywords) + "Subdued level highlighting for Backtrace mode.") +(defconst backtrace-font-lock-keywords-2 + (append lisp-el-font-lock-keywords-for-backtraces-2 + backtrace--font-lock-keywords) + "Gaudy level highlighting for Backtrace mode.") + +(defun backtrace--match-ellipsis-in-string (bound) + ;; Fontify ellipses within strings as buttons. + (when (re-search-forward "\\(\\.\\.\\.\\)\"" bound t) + (and (get-text-property (- (point) 2) 'cl-print-ellipsis) + (get-text-property (- (point) 3) 'cl-print-ellipsis) + (get-text-property (- (point) 4) 'cl-print-ellipsis)))) + +;;; Xref support + +(defun backtrace--xref-backend () 'elisp) + +;;; Backtrace mode variables + +(defvar-local backtrace-frames nil + "Stack frames displayed in the current Backtrace buffer. +This should be a list of `backtrace-frame' objects.") + +(defvar-local backtrace-view nil + "A plist describing how to render backtrace frames. +Possible entries are :show-flags, :do-xrefs and :print-circle.") + +(defvar-local backtrace-insert-header-function nil + "Function for inserting a header for the current Backtrace buffer. +If nil, no header will be created. Note that Backtrace buffers +are fontified as in Emacs Lisp Mode, the header text included.") + +(defvar backtrace-revert-hook nil + "Hook run before reverting a Backtrace buffer. +This is commonly used to recompute `backtrace-frames'.") + +(defvar-local backtrace-print-function #'cl-prin1 + "Function used to print values in the current Backtrace buffer.") + +(defvar backtrace-mode-map + (let ((map (copy-keymap special-mode-map))) + (set-keymap-parent map button-buffer-map) + (define-key map "n" 'backtrace-forward-frame) + (define-key map "p" 'backtrace-backward-frame) + (define-key map "v" 'backtrace-toggle-locals) + (define-key map "#" 'backtrace-toggle-print-circle) + (define-key map "\C-m" 'backtrace-help-follow-symbol) + (define-key map "+" 'backtrace-pretty-print) + (define-key map "=" 'backtrace-collapse) + (define-key map [follow-link] 'mouse-face) + (define-key map [mouse-2] 'mouse-select-window) + map) + "Local keymap for `backtrace-mode' buffers.") + +;;; Navigation and Text Properties + +;; This mode uses the following text properties: +;; backtrace-index: The index into the buffer-local variable +;; `backtrace-frames' for the frame at point, or nil if outside of a +;; frame (in the buffer header). +;; backtrace-view: A plist describing how the frame is printed. See +;; the docstring for the buffer-local variable `backtrace-view. +;; backtrace-section: The part of a frame which point is in. Either +;; `func' or `locals'. At the moment just used to show and hide the +;; local variables. Derived modes which do additional printing +;; could define their own frame sections. +;; backtrace-form: A value applied to each printed representation of a +;; top-level s-expression, which needs to be different for sexps +;; printed adjacent to each other, so the limits can be quickly +;; found for pretty-printing. The value chosen is a list contining +;; the values of print-level and print-length used to print the +;; sexp, and those values are used when expanding ellipses. + +(defsubst backtrace-get-index (&optional pos) + "Return the index of the backtrace frame at POS. +The value is an index into `backtrace-frames', or nil. +POS, if omitted or nil, defaults to point." + (get-text-property (or pos (point)) 'backtrace-index)) + +(defsubst backtrace-get-section (&optional pos) + "Return the section of a backtrace frame at POS. +POS, if omitted or nil, defaults to point." + (get-text-property (or pos (point)) 'backtrace-section)) + +(defsubst backtrace-get-view (&optional pos) + "Return the view plist of the backtrace frame at POS. +POS, if omitted or nil, defaults to point." + (get-text-property (or pos (point)) 'backtrace-view)) + +(defsubst backtrace-get-form (&optional pos) + "Return the backtrace form data for the form printed at POS. +POS, if omitted or nil, defaults to point." + (get-text-property (or pos (point)) 'backtrace-form)) + +(defun backtrace-get-frame-start (&optional pos) + "Return the beginning position of the frame at POS in the buffer. +POS, if omitted or nil, defaults to point." + (let ((posn (or pos (point)))) + (if (or (= (point-min) posn) + (not (eq (backtrace-get-index posn) + (backtrace-get-index (1- posn))))) + posn + (previous-single-property-change posn 'backtrace-index nil (point-min))))) + +(defun backtrace-get-frame-end (&optional pos) + "Return the position of the end of the frame at POS in the buffer. +POS, if omitted or nil, defaults to point." + (next-single-property-change (or pos (point)) + 'backtrace-index nil (point-max))) + +(defun backtrace-get-section-end (&optional pos) + "Return the position of the end of the frame section at POS. +POS, if omitted or nil, defaults to point." + (let* ((frame-end (backtrace-get-frame-end pos)) + (section-end (next-single-property-change + (or pos (point)) 'backtrace-section nil frame-end))) + (min frame-end section-end))) + +(defun backtrace-forward-frame () + "Move forward to the beginning of the next frame." + (interactive) + (let ((max (backtrace-get-frame-end))) + (when (= max (point-max)) + (user-error "No next stack frame")) + (goto-char max))) + +(defun backtrace-backward-frame () + "Move backward to the start of a stack frame." + (interactive) + (let ((current-index (backtrace-get-index)) + (min (backtrace-get-frame-start))) + (if (or (and (/= (point) (point-max)) (null current-index)) + (= min (point-min)) + (and (= min (point)) + (null (backtrace-get-index (1- min))))) + (user-error "No previous stack frame")) + (if (= min (point)) + (goto-char (backtrace-get-frame-start (1- min))) + (goto-char min)))) + +;; Other Backtrace mode commands + +(defun backtrace-revert (&rest _ignored) + "The `revert-buffer-function' for `backtrace-mode'. +It runs `backtrace-revert-hook', then calls `backtrace-print'." + (interactive) + (unless (derived-mode-p 'backtrace-mode) + (error "The current buffer is not in Backtrace mode")) + (run-hooks 'backtrace-revert-hook) + (backtrace-print t)) + +(defun backtrace-toggle-locals () + "Toggle the display of local variables for the backtrace frame at point. +TODO with argument, toggle all frames." + (interactive) + (let ((index (backtrace-get-index))) + (unless index + (user-error "Not in a stack frame")) + (let ((pos (point))) + (goto-char (backtrace-get-frame-start)) + (while (and (eq index (backtrace-get-index)) + (not (eq (backtrace-get-section) 'locals))) + (goto-char (next-single-property-change (point) 'backtrace-section))) + (let ((end (backtrace-get-section-end))) + (backtrace--set-locals-visible (point) end (invisible-p (point))) + + (goto-char (if (invisible-p pos) end pos)))))) + +(defun backtrace--set-locals-visible (beg end visible) + (backtrace--change-button-skip beg end (not visible)) + (if visible + (remove-overlays beg end 'invisible t) + (let ((o (make-overlay beg end))) + (overlay-put o 'invisible t) + (overlay-put o 'evaporate t)))) + +(defun backtrace--change-button-skip (beg end value) + "Change the skip property on all buttons between BEG and END. +Set it to VALUE unless the button is a `backtrace-ellipsis' button." + (let ((inhibit-read-only t)) + (setq beg (next-button beg)) + (while (and beg (< beg end)) + (unless (eq (button-type beg) 'backtrace-ellipsis) + (button-put beg 'skip value)) + (setq beg (next-button beg))))) + +(defun backtrace-toggle-print-circle () + "Toggle `print-circle' for the backtrace frame at point." + ;; TODO with argument, toggle the whole buffer. + (interactive) + (backtrace--toggle-feature :print-circle)) + +(defun backtrace--toggle-feature (feature) + "Toggle FEATURE for the backtrace frame at point. +FEATURE should be one of the options in `backtrace-view'. +After toggling the feature, reprint the frame and position +point at the start of the section of the frame it was in +before." + ;; TODO preserve (in)visibility of locals + (let ((index (backtrace-get-index)) + (view (copy-sequence (backtrace-get-view)))) + (unless index + (user-error "Not in a stack frame")) + (setq view (plist-put view feature (not (plist-get view feature)))) + (let ((inhibit-read-only t) + (index (backtrace-get-index)) + (section (backtrace-get-section)) + (min (backtrace-get-frame-start)) + (max (backtrace-get-frame-end))) + (delete-region min max) + (goto-char min) + (backtrace-print-frame (nth index backtrace-frames) view) + (add-text-properties min (point) + `(backtrace-index ,index backtrace-view ,view)) + (goto-char min) + (when (not (eq section (backtrace-get-section))) + (if-let ((pos (text-property-any (backtrace-get-frame-start) + (backtrace-get-frame-end) + 'backtrace-section section))) + (goto-char pos)))))) + +(defmacro backtrace--with-output-variables (view &rest body) + "Bind output variables according to VIEW and execute BODY." + (declare (indent 1)) + `(let ((print-escape-control-characters t) + (print-escape-newlines t) + (print-circle (plist-get ,view :print-circle)) + (standard-output (current-buffer))) + ,@body)) + +(defun backtrace-expand-ellipsis (button) + "Expand display of the elided form at BUTTON." + ;; TODO a command to expand all ... in form at point + ;; with argument, don't bind print-level, length?? + ;; Enable undo so there's a way to go back? + (interactive) + (goto-char (button-start button)) + (unless (get-text-property (point) 'cl-print-ellipsis) + (if (and (> (point) (point-min)) + (get-text-property (1- (point)) 'cl-print-ellipsis)) + (backward-char) + (user-error "No ellipsis to expand here"))) + (let* ((end (next-single-property-change (point) 'cl-print-ellipsis)) + (begin (previous-single-property-change end 'cl-print-ellipsis)) + (value (get-text-property begin 'cl-print-ellipsis)) + (props (backtrace-get-text-properties begin)) + (tag (backtrace-get-form begin)) + (length (nth 0 tag)) ; TODO should this work with a target char count + (level (nth 1 tag)) ; like backtrace-print-to-string? + (inhibit-read-only t)) + (backtrace--with-output-variables (backtrace-get-view) + (let ((print-level level) + (print-length length)) + (delete-region begin end) + (cl-print-expand-ellipsis value (current-buffer)) + (setq end (point)) + (goto-char begin) + (while (< (point) end) + (let ((next (next-single-property-change (point) 'cl-print-ellipsis + nil end))) + (when (get-text-property (point) 'cl-print-ellipsis) + (make-text-button (point) next :type 'backtrace-ellipsis)) + (goto-char next))) + (goto-char begin) + (add-text-properties begin end props))))) + +(defun backtrace-pretty-print () + "Pretty-print the top level s-expression at point." + (interactive) + (backtrace--reformat-sexp #'backtrace--pretty-print + "No form here to pretty-print")) + +(defun backtrace--pretty-print () + "Pretty print the current buffer, then remove the trailing newline." + (set-syntax-table emacs-lisp-mode-syntax-table) + (pp-buffer) + (goto-char (1- (point-max))) + (delete-char 1)) + +(defun backtrace-collapse () + "Collapse the top level s-expression at point onto one line." + (interactive) + (backtrace--reformat-sexp #'backtrace--collapse "No form here to collapse")) + +(defun backtrace--collapse () + "Replace line breaks and following indentation with spaces. +Works on the current buffer." + (goto-char (point-min)) + (while (re-search-forward "\n[[:blank:]]*" nil t) + (replace-match " "))) + +(defun backtrace--reformat-sexp (format-function error-message) + "Reformat the top level sexp at point. +Locate the top level sexp at or following point on the same line, +and reformat it with FORMAT-FUNCTION, preserving the location of +point within the sexp. If no sexp is found before the end of +the line or buffer, show ERROR-MESSAGE instead. + +FORMAT-FUNCTION will be called without arguments, with the +current buffer set to a temporary buffer containing only the +content of the sexp." + (let* ((orig-pos (point)) + (pos (point)) + (tag (backtrace-get-form pos)) + (end (next-single-property-change pos 'backtrace-form)) + (begin (previous-single-property-change end 'backtrace-form + nil (point-min)))) + (unless tag + (when (or (= end (point-max)) (> end (point-at-eol))) + (user-error error-message)) + (goto-char end) + (setq pos end + end (next-single-property-change pos 'backtrace-form) + begin (previous-single-property-change end 'backtrace-form + nil (point-min)))) + (let* ((offset (when (>= orig-pos begin) (- orig-pos begin))) + (offset-marker (when offset (make-marker))) + (content (buffer-substring begin end)) + (props (backtrace-get-text-properties begin)) + (inhibit-read-only t)) + (delete-region begin end) + (insert (with-temp-buffer + (insert content) + (when offset + (set-marker-insertion-type offset-marker t) + (set-marker offset-marker (+ (point-min) offset))) + (funcall format-function) + (when offset + (setq offset (- (marker-position offset-marker) (point-min)))) + (buffer-string))) + (when offset + (set-marker offset-marker (+ begin offset))) + (save-excursion + (goto-char begin) + (indent-sexp)) + (add-text-properties begin (point) props) + (if offset + (goto-char (marker-position offset-marker)) + (goto-char orig-pos))))) + +(defun backtrace-get-text-properties (pos) + "Return a plist of backtrace-mode's text properties at POS." + (apply #'append + (mapcar (lambda (prop) + (list prop (get-text-property pos prop))) + '(backtrace-section backtrace-index backtrace-view + backtrace-form)))) + +(defun backtrace-help-follow-symbol (&optional pos) + "Follow cross-reference at POS, defaulting to point. +For the cross-reference format, see `help-make-xrefs'." + (interactive "d") + (unless pos + (setq pos (point))) + (unless (push-button pos) + ;; Check if the symbol under point is a function or variable. + (let ((sym + (intern + (save-excursion + (goto-char pos) (skip-syntax-backward "w_") + (buffer-substring (point) + (progn (skip-syntax-forward "w_") + (point))))))) + (when (or (boundp sym) (fboundp sym) (facep sym)) + (describe-symbol sym))))) + +;; Print backtrace frames + +(defun backtrace-print (&optional remember-pos) + "Populate the current Backtrace mode buffer. +This erases the buffer and inserts printed representations of the +frames. Optional argument REMEMBER-POS, if non-nil, means to +move point to the entry with the same ID element as the current +line and recenter window line accordingly." + (let ((inhibit-read-only t) + entry-index saved-pt window-line) + (and remember-pos + (setq entry-index (backtrace-get-index)) + (when (eq (window-buffer) (current-buffer)) + (setq window-line + (count-screen-lines (window-start) (point))))) + (erase-buffer) + (when backtrace-insert-header-function + (funcall backtrace-insert-header-function)) + (dotimes (idx (length backtrace-frames)) + (let ((beg (point)) + (elt (nth idx backtrace-frames))) + (and entry-index + (equal entry-index idx) + (setq entry-index nil + saved-pt (point))) + (backtrace-print-frame elt backtrace-view) + (add-text-properties + beg (point) + `(backtrace-index ,idx backtrace-view ,backtrace-view)))) + (set-buffer-modified-p nil) + ;; If REMEMBER-POS was specified, move to the "old" location. + (if saved-pt + (progn (goto-char saved-pt) + (when window-line + (recenter window-line))) + (goto-char (point-min))))) + +;; Define button type used for ...'s. +;; Set skip property so you don't have to TAB through 100 of them to +;; get to the next function name. +(define-button-type 'backtrace-ellipsis + 'skip t 'action #'backtrace-expand-ellipsis + 'help-echo "mouse-2, RET: expand this ellipsis") + +(defun backtrace-print-to-string (obj &optional limit) + "Return a printed representation of OBJ formatted for backtraces. +Attempt to get the length of the returned string under LIMIT +charcters with appropriate settings of `print-level' and +`print-length.' Attach the settings used with the text property +`backtrace-form'. LIMIT defaults to `backtrace-line-length'." + (backtrace--with-output-variables backtrace-view + (backtrace--print-to-string obj limit))) + +(defun backtrace--print-to-string (sexp &optional limit) + ;; This is for use by callers who wrap the call with + ;; backtrace--with-output-variables. + (setq limit (or limit backtrace-line-length)) + (let* ((length 50) ; (/ backtrace-line-length 100) ?? + (level (truncate (log limit))) + (delta (truncate (/ length level)))) + (with-temp-buffer + (catch 'done + (while t + (erase-buffer) + (let ((standard-output (current-buffer)) + (print-length length) + (print-level level)) + (backtrace--print sexp)) + ;; Stop when either the level is too low or the sexp is + ;; successfully printed in the space allowed. + (when (or (< (- (point-max) (point-min)) limit) (= level 2)) + (throw 'done nil)) + (cl-decf level) + (cl-decf length delta))) + (put-text-property (point-min) (point) + 'backtrace-form (list length level)) + ;; Make buttons from all the "..."s. + ;; TODO should this be under control of :do-ellipses in the view + ;; plist? + (goto-char (point-min)) + (while (< (point) (point-max)) + (let ((end (next-single-property-change (point) 'cl-print-ellipsis + nil (point-max)))) + (when (get-text-property (point) 'cl-print-ellipsis) + (make-text-button (point) end :type 'backtrace-ellipsis)) + (goto-char end))) + (buffer-string)))) + +(defun backtrace-print-frame (frame view) + "Insert a backtrace FRAME at point formatted according to VIEW. +Tag the sections of the frame with the `backtrace-section' text +property for use by navigation." + (backtrace--with-output-variables view + (backtrace--print-flags frame view) + (backtrace--print-func-and-args frame view) + (backtrace--print-locals frame view))) + +(defun backtrace--print-flags (frame view) + "Print the flags of a backtrace FRAME if enabled in VIEW." + (let ((beg (point)) + (flag (plist-get (backtrace-frame-flags frame) :debug-on-exit))) + (insert (if (and (plist-get view :show-flags) flag) "* " " ")) + (put-text-property beg (point) 'backtrace-section 'func))) + +(defun backtrace--print-func-and-args (frame view) + "Print the function, arguments and buffer position of a backtrace FRAME. +Format it according to VIEW." + (let* ((beg (point)) + (evald (backtrace-frame-evald frame)) + (fun (backtrace-frame-fun frame)) + (args (backtrace-frame-args frame)) + (fun-file (and (plist-get view :do-xrefs) (symbol-file fun 'defun))) + (fun-pt (point))) + (cond + ((and evald (not debugger-stack-frame-as-list)) + (if (atom fun) + (funcall backtrace-print-function fun) + (insert + (backtrace--print-to-string fun (when args (/ backtrace-line-length 2))))) + (if args + (insert (backtrace--print-to-string + args (max (truncate (/ backtrace-line-length 5)) + (- backtrace-line-length (- (point) beg))))) + ;; The backtrace-form property is so that + ;; backtrace-pretty-print will find it. + ;; backtrace-pretty-print doesn't do anything useful with it, + ;; just being consistent. + (let ((start (point))) + (insert "()") + (put-text-property start (point) 'backtrace-form t)))) + (t + (let ((fun-and-args (cons fun args))) + (insert (backtrace--print-to-string fun-and-args))) + (cl-incf fun-pt))) + (when fun-file + (make-text-button fun-pt (+ fun-pt (length (symbol-name fun))) + :type 'help-function-def + 'help-args (list fun fun-file))) + ;; After any frame that uses eval-buffer, insert a comment that + ;; states the buffer position it's reading at. + (when (backtrace-frame-pos frame) + (insert (format " ; Reading at buffer position %d" + (backtrace-frame-pos frame)))) + (insert "\n") + (put-text-property beg (point) 'backtrace-section 'func))) + +(defun backtrace--print-locals (frame _view) + "Print a backtrace FRAME's local variables. +Make them invisible initially." + (let* ((beg (point)) + (locals (backtrace-frame-locals frame))) + (if (null locals) + (insert " [no locals]\n") + (pcase-dolist (`(,symbol . ,value) locals) + (insert " ") + (backtrace--print symbol) + (insert " = ") + (insert (backtrace--print-to-string value)) + (insert "\n"))) + (put-text-property beg (point) 'backtrace-section 'locals) + (backtrace--set-locals-visible beg (point) nil))) + +(defun backtrace--print (obj) + "Attempt to print OBJ using `backtrace-print-function'. +Fall back to `prin1' if there is an error." + (condition-case err + (funcall backtrace-print-function obj) + (error + (message "Error in backtrace printer: %S" err) + (prin1 obj)))) + +(defun backtrace-update-flags () + "Update the display of the flags in the backtrace frame at point." + (let ((view (backtrace-get-view)) + (begin (backtrace-get-frame-start))) + (when (plist-get view :show-flags) + (save-excursion + (goto-char begin) + (let ((props (backtrace-get-text-properties begin)) + (inhibit-read-only t) + (standard-output (current-buffer))) + (delete-char 2) + (backtrace--print-flags (nth (backtrace-get-index) backtrace-frames) + view) + (add-text-properties begin (point) props)))))) + +(defun backtrace--filter-visible (beg end &optional _delete) + "Return the visible text between BEG and END." + (let ((result "")) + (while (< beg end) + (let ((next (next-single-char-property-change beg 'invisible))) + (unless (get-char-property beg 'invisible) + (setq result (concat result (buffer-substring beg (min end next))))) + (setq beg next))) + result)) + +;;; The mode definition + +(define-derived-mode backtrace-mode special-mode "Backtrace" + "Generic major mode for examining an Elisp stack backtrace. +This mode can be used directly, or other major modes can be +derived from it, using `define-derived-mode'. + +In this major mode, the buffer contains some optional lines of +header text followed by backtrace frames, each consisting of one +or more whole lines. + +Letters in this mode do not insert themselves; instead they are +commands. +\\ +\\{backtrace-mode-map} + +A mode which inherits from Backtrace mode, or a command which +creates a backtrace-mode buffer, should usually do the following: + + - Set `backtrace-revert-hook', if the buffer contents need + to be specially recomputed prior to `revert-buffer'. + - Maybe set `backtrace-insert-header-function' to a function to create + header text for the buffer. + - Set `backtrace-frames' (see below). + - Set `backtrace-view' if desired (see below). + - Maybe set `backtrace-print-function'. + +A command which creates or switches to a Backtrace mode buffer, +such as `ert-results-pop-to-backtrace-for-test-at-point', should +initialize `backtrace-frames' to a list of `backtrace-frame' +objects (`backtrace-get-frames' is provided for that purpose, if +desired), and `backtrace-view' to a plist describing how it wants +the backtrace to appear. Finally, it should call `backtrace-print'. + +`backtrace-print' calls `backtrace-insert-header-function' +followed by `backtrace-print-frame', once for each stack frame." + :syntax-table emacs-lisp-mode-syntax-table + (when backtrace-fontify + (setq font-lock-defaults + '((backtrace-font-lock-keywords + backtrace-font-lock-keywords-1 + backtrace-font-lock-keywords-2) + nil nil nil nil + ;; TODO This one doesn't look necessary: + ;; (font-lock-mark-block-function . mark-defun) + (font-lock-syntactic-face-function + . lisp-font-lock-syntactic-face-function)))) + (setq truncate-lines t) + (buffer-disable-undo) + ;; In debug.el, from 1998 to 2009 this was set to nil, reason stated + ;; was because of bytecode. Since 2009 it's been set to t, but the + ;; default is t so I think this isn't necessary. + ;; (set-buffer-multibyte t) + (setq-local revert-buffer-function #'backtrace-revert) + (setq-local filter-buffer-substring-function #'backtrace--filter-visible) + (add-hook 'xref-backend-functions #'backtrace--xref-backend nil t)) + +(put 'backtrace-mode 'mode-class 'special) + +;;; Backtrace printing + +(defun backtrace-backtrace () + "Print a trace of Lisp function calls currently active. +Output stream used is value of `standard-output'." + (princ (backtrace-to-string (backtrace-get-frames 'backtrace-backtrace)))) + +(defun backtrace-to-string(frames) + "Format FRAMES, a list of `backtrace-frame' objects, for output. +Return the result as a string." + (let ((backtrace-fontify nil)) + (with-temp-buffer + (backtrace-mode) + (setq backtrace-view '(:show-flags t) + backtrace-frames frames + backtrace-print-function #'cl-prin1) + (backtrace-print) + (substring-no-properties (filter-buffer-substring (point-min) + (point-max)))))) + +(provide 'backtrace) + +;;; backtrace.el ends here diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 0efaa63712..707e0cfa18 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -28,6 +28,7 @@ ;;; Code: (require 'cl-lib) +(require 'backtrace) (require 'button) (defgroup debugger nil @@ -133,6 +134,25 @@ where CAUSE can be: - exit: called because of exit of a flagged function. - error: called because of `debug-on-error'.") +(cl-defstruct (debugger--buffer-state + (:constructor debugger--save-buffer-state + (&aux (mode major-mode) + (header backtrace-insert-header-function) + (frames backtrace-frames) + (content (buffer-string)) + (pos (point))))) + mode header frames content pos) + +(defun debugger--restore-buffer-state (state) + (unless (derived-mode-p (debugger--buffer-state-mode state)) + (funcall (debugger--buffer-state-mode state))) + (setq backtrace-insert-header-function (debugger--buffer-state-header state) + backtrace-frames (debugger--buffer-state-frames state)) + (let ((inhibit-read-only t)) + (erase-buffer) + (insert (debugger--buffer-state-content state))) + (goto-char (debugger--buffer-state-pos state))) + ;;;###autoload (setq debugger 'debug) ;;;###autoload @@ -174,7 +194,7 @@ first will be printed into the backtrace buffer." (debugger-previous-state (if (get-buffer "*Backtrace*") (with-current-buffer (get-buffer "*Backtrace*") - (list major-mode (buffer-string))))) + (debugger--save-buffer-state)))) (debugger-args args) (debugger-buffer (get-buffer-create "*Backtrace*")) (debugger-old-buffer (current-buffer)) @@ -236,7 +256,8 @@ first will be printed into the backtrace buffer." (window-total-height debugger-window))) (error nil))) (setq debugger-previous-window debugger-window)) - (debugger-mode) + (unless (derived-mode-p 'debugger-mode) + (debugger-mode)) (debugger-setup-buffer debugger-args) (when noninteractive ;; If the backtrace is long, save the beginning @@ -280,15 +301,14 @@ first will be printed into the backtrace buffer." (setq debugger-previous-window nil)) ;; Restore previous state of debugger-buffer in case we were ;; in a recursive invocation of the debugger, otherwise just - ;; erase the buffer and put it into fundamental mode. + ;; erase the buffer. (when (buffer-live-p debugger-buffer) (with-current-buffer debugger-buffer - (let ((inhibit-read-only t)) - (erase-buffer) - (if (null debugger-previous-state) - (fundamental-mode) - (insert (nth 1 debugger-previous-state)) - (funcall (nth 0 debugger-previous-state)))))) + (if debugger-previous-state + (debugger--restore-buffer-state debugger-previous-state) + (setq backtrace-insert-header-function nil) + (setq backtrace-frames nil) + (backtrace-print)))) (with-timeout-unsuspend debugger-with-timeout-suspend) (set-match-data debugger-outer-match-data))) (setq debug-on-next-call debugger-step-after-exit) @@ -301,112 +321,80 @@ first will be printed into the backtrace buffer." (message "Error in debug printer: %S" err) (prin1 obj stream)))) -(defun debugger-insert-backtrace (frames do-xrefs) - "Format and insert the backtrace FRAMES at point. -Make functions into cross-reference buttons if DO-XREFS is non-nil." - (let ((standard-output (current-buffer)) - (eval-buffers eval-buffer-list)) - (require 'help-mode) ; Define `help-function-def' button type. - (pcase-dolist (`(,evald ,fun ,args ,flags) frames) - (insert (if (plist-get flags :debug-on-exit) - "* " " ")) - (let ((fun-file (and do-xrefs (symbol-file fun 'defun))) - (fun-pt (point))) - (cond - ((and evald (not debugger-stack-frame-as-list)) - (debugger--print fun) - (if args (debugger--print args) (princ "()"))) - (t - (debugger--print (cons fun args)) - (cl-incf fun-pt))) - (when fun-file - (make-text-button fun-pt (+ fun-pt (length (symbol-name fun))) - :type 'help-function-def - 'help-args (list fun fun-file)))) - ;; After any frame that uses eval-buffer, insert a line that - ;; states the buffer position it's reading at. - (when (and eval-buffers (memq fun '(eval-buffer eval-region))) - (insert (format " ; Reading at buffer position %d" - ;; This will get the wrong result if there are - ;; two nested eval-region calls for the same - ;; buffer. That's not a very useful case. - (with-current-buffer (pop eval-buffers) - (point))))) - (insert "\n")))) - (defun debugger-setup-buffer (args) "Initialize the `*Backtrace*' buffer for entry to the debugger. -That buffer should be current already." - (setq buffer-read-only nil) - (erase-buffer) - (set-buffer-multibyte t) ;Why was it nil ? -stef - (setq buffer-undo-list t) +That buffer should be current already and in debugger-mode." + (setq backtrace-frames (nthcdr + ;; Remove debug--implement-debug-on-entry and the + ;; advice's `apply' frame. + (if (eq (car args) 'debug) 3 1) + (backtrace-get-frames 'debug))) + (when (eq (car-safe args) 'exit) + (setq debugger-value (nth 1 args)) + (setf (cl-getf (backtrace-frame-flags (car backtrace-frames)) + :debug-on-exit) + nil)) + + (setq backtrace-view '(:do-xrefs t :show-flags t) + backtrace-insert-header-function (lambda () + (debugger--insert-header args)) + backtrace-print-function debugger-print-function) + (backtrace-print) + ;; Place point on "stack frame 0" (bug#15101). + (goto-char (point-min)) + (search-forward ":" (line-end-position) t) + (when (and (< (point) (line-end-position)) + (= (char-after) ?\s)) + (forward-char))) + +(defun debugger--insert-header (args) + "Insert the header for the debugger's Backtrace buffer. +Include the reason for debugger entry from ARGS." (insert "Debugger entered") - (let ((frames (nthcdr - ;; Remove debug--implement-debug-on-entry and the - ;; advice's `apply' frame. - (if (eq (car args) 'debug) 3 1) - (backtrace-frames 'debug))) - (print-escape-newlines t) - (print-escape-control-characters t) - ;; If you increase print-level, add more depth in call_debugger. - (print-level 8) - (print-length 50) - (pos (point))) - (pcase (car args) - ;; lambda is for debug-on-call when a function call is next. - ;; debug is for debug-on-entry function called. - ((or `lambda `debug) - (insert "--entering a function:\n") - (setq pos (1- (point)))) - ;; Exiting a function. - (`exit - (insert "--returning value: ") - (setq pos (point)) - (setq debugger-value (nth 1 args)) - (debugger--print debugger-value (current-buffer)) - (setf (cl-getf (nth 3 (car frames)) :debug-on-exit) nil) - (insert ?\n)) - ;; Watchpoint triggered. - ((and `watchpoint (let `(,symbol ,newval . ,details) (cdr args))) - (insert - "--" - (pcase details - (`(makunbound nil) (format "making %s void" symbol)) - (`(makunbound ,buffer) (format "killing local value of %s in buffer %s" - symbol buffer)) - (`(defvaralias ,_) (format "aliasing %s to %s" symbol newval)) - (`(let ,_) (format "let-binding %s to %S" symbol newval)) - (`(unlet ,_) (format "ending let-binding of %s" symbol)) - (`(set nil) (format "setting %s to %S" symbol newval)) - (`(set ,buffer) (format "setting %s in buffer %s to %S" - symbol buffer newval)) - (_ (error "unrecognized watchpoint triggered %S" (cdr args)))) - ": ") - (setq pos (point)) - (insert ?\n)) - ;; Debugger entered for an error. - (`error - (insert "--Lisp error: ") - (setq pos (point)) - (debugger--print (nth 1 args) (current-buffer)) - (insert ?\n)) - ;; debug-on-call, when the next thing is an eval. - (`t - (insert "--beginning evaluation of function call form:\n") - (setq pos (1- (point)))) - ;; User calls debug directly. - (_ - (insert ": ") - (setq pos (point)) - (debugger--print - (if (eq (car args) 'nil) - (cdr args) args) - (current-buffer)) - (insert ?\n))) - (debugger-insert-backtrace frames t) - ;; Place point on "stack frame 0" (bug#15101). - (goto-char pos))) + (pcase (car args) + ;; lambda is for debug-on-call when a function call is next. + ;; debug is for debug-on-entry function called. + ((or `lambda `debug) + (insert "--entering a function:\n")) + ;; Exiting a function. + (`exit + (insert "--returning value: ") + (insert (backtrace-print-to-string debugger-value)) + (insert ?\n)) + ;; Watchpoint triggered. + ((and `watchpoint (let `(,symbol ,newval . ,details) (cdr args))) + (insert + "--" + (pcase details + (`(makunbound nil) (format "making %s void" symbol)) + (`(makunbound ,buffer) (format "killing local value of %s in buffer %s" + symbol buffer)) + (`(defvaralias ,_) (format "aliasing %s to %s" symbol newval)) + (`(let ,_) (format "let-binding %s to %s" symbol + (backtrace-print-to-string newval))) + (`(unlet ,_) (format "ending let-binding of %s" symbol)) + (`(set nil) (format "setting %s to %s" symbol + (backtrace-print-to-string newval))) + (`(set ,buffer) (format "setting %s in buffer %s to %s" + symbol buffer + (backtrace-print-to-string newval))) + (_ (error "unrecognized watchpoint triggered %S" (cdr args)))) + ": ") + (insert ?\n)) + ;; Debugger entered for an error. + (`error + (insert "--Lisp error: ") + (insert (backtrace-print-to-string (nth 1 args))) + (insert ?\n)) + ;; debug-on-call, when the next thing is an eval. + (`t + (insert "--beginning evaluation of function call form:\n")) + ;; User calls debug directly. + (_ + (insert ": ") + (insert (backtrace-print-to-string (if (eq (car args) 'nil) + (cdr args) args))) + (insert ?\n)))) (defun debugger-step-through () @@ -426,12 +414,12 @@ Enter another debugger on next entry to eval, apply or funcall." (unless debugger-may-continue (error "Cannot continue")) (message "Continuing.") - (save-excursion - ;; Check to see if we've flagged some frame for debug-on-exit, in which - ;; case we'll probably come back to the debugger soon. - (goto-char (point-min)) - (if (re-search-forward "^\\* " nil t) - (setq debugger-will-be-back t))) + + ;; Check to see if we've flagged some frame for debug-on-exit, in which + ;; case we'll probably come back to the debugger soon. + (dolist (frame backtrace-frames) + (when (plist-get (backtrace-frame-flags frame) :debug-on-exit) + (setq debugger-will-be-back t))) (exit-recursive-edit)) (defun debugger-return-value (val) @@ -446,12 +434,11 @@ will be used, such as in a debug on exit from a frame." (setq debugger-value val) (princ "Returning " t) (debugger--print debugger-value) - (save-excursion ;; Check to see if we've flagged some frame for debug-on-exit, in which ;; case we'll probably come back to the debugger soon. - (goto-char (point-min)) - (if (re-search-forward "^\\* " nil t) - (setq debugger-will-be-back t))) + (dolist (frame backtrace-frames) + (when (plist-get (backtrace-frame-flags frame) :debug-on-exit) + (setq debugger-will-be-back t))) (exit-recursive-edit)) (defun debugger-jump () @@ -473,63 +460,40 @@ removes itself from that hook." (defun debugger-frame-number (&optional skip-base) "Return number of frames in backtrace before the one point points at." - (save-excursion - (beginning-of-line) - (if (looking-at " *;;;\\|[a-z]") - (error "This line is not a function call")) - (let ((opoint (point)) - (count 0)) - (unless skip-base + (let ((index (backtrace-get-index)) + (count 0)) + (unless index + (error "This line is not a function call")) + (unless skip-base (while (not (eq (cadr (backtrace-frame count)) 'debug)) (setq count (1+ count))) ;; Skip debug--implement-debug-on-entry frame. (when (eq 'debug--implement-debug-on-entry (cadr (backtrace-frame (1+ count)))) (setq count (+ 2 count)))) - (goto-char (point-min)) - (when (looking-at "Debugger entered--\\(Lisp error\\|returning value\\):") - (goto-char (match-end 0)) - (forward-sexp 1)) - (forward-line 1) - (while (progn - (forward-char 2) - (cond ((debugger--locals-visible-p) - (goto-char (next-single-char-property-change - (point) 'locals-visible))) - ((= (following-char) ?\() - (forward-sexp 1)) - (t - (forward-sexp 2))) - (forward-line 1) - (<= (point) opoint)) - (if (looking-at " *;;;") - (forward-line 1)) - (setq count (1+ count))) - count))) + (+ count index))) (defun debugger-frame () "Request entry to debugger when this frame exits. Applies to the frame whose line point is on in the backtrace." (interactive) (backtrace-debug (debugger-frame-number) t) - (beginning-of-line) - (if (= (following-char) ? ) - (let ((inhibit-read-only t)) - (delete-char 1) - (insert ?*))) - (beginning-of-line)) + (setf + (cl-getf (backtrace-frame-flags (nth (backtrace-get-index) backtrace-frames)) + :debug-on-exit) + t) + (backtrace-update-flags)) (defun debugger-frame-clear () "Do not enter debugger when this frame exits. Applies to the frame whose line point is on in the backtrace." (interactive) (backtrace-debug (debugger-frame-number) nil) - (beginning-of-line) - (if (= (following-char) ?*) - (let ((inhibit-read-only t)) - (delete-char 1) - (insert ? ))) - (beginning-of-line)) + (setf + (cl-getf (backtrace-frame-flags (nth (backtrace-get-index) backtrace-frames)) + :debug-on-exit) + nil) + (backtrace-update-flags)) (defmacro debugger-env-macro (&rest body) "Run BODY in original environment." @@ -564,69 +528,11 @@ The environment used is the one when entering the activation frame at point." (let ((str (eval-expression-print-format val))) (if str (princ str t)))))))) -(defun debugger--locals-visible-p () - "Are the local variables of the current stack frame visible?" - (save-excursion - (move-to-column 2) - (get-text-property (point) 'locals-visible))) - -(defun debugger--insert-locals (locals) - "Insert the local variables LOCALS at point." - (cond ((null locals) - (insert "\n [no locals]")) - (t - (let ((print-escape-newlines t)) - (dolist (s+v locals) - (let ((symbol (car s+v)) - (value (cdr s+v))) - (insert "\n ") - (prin1 symbol (current-buffer)) - (insert " = ") - (debugger--print value (current-buffer)))))))) - -(defun debugger--show-locals () - "For the frame at point, insert locals and add text properties." - (let* ((nframe (1+ (debugger-frame-number 'skip-base))) - (base (debugger--backtrace-base)) - (locals (backtrace--locals nframe base)) - (inhibit-read-only t)) - (save-excursion - (let ((start (progn - (move-to-column 2) - (point)))) - (end-of-line) - (debugger--insert-locals locals) - (add-text-properties start (point) '(locals-visible t)))))) - -(defun debugger--hide-locals () - "Delete local variables and remove the text property." - (let* ((col (current-column)) - (end (progn - (move-to-column 2) - (next-single-char-property-change (point) 'locals-visible))) - (start (previous-single-char-property-change end 'locals-visible)) - (inhibit-read-only t)) - (remove-text-properties start end '(locals-visible)) - (goto-char start) - (end-of-line) - (delete-region (point) end) - (move-to-column col))) - -(defun debugger-toggle-locals () - "Show or hide local variables of the current stack frame." - (interactive) - (cond ((debugger--locals-visible-p) - (debugger--hide-locals)) - (t - (debugger--show-locals)))) - (defvar debugger-mode-map (let ((map (make-keymap)) (menu-map (make-sparse-keymap))) - (set-keymap-parent map button-buffer-map) - (suppress-keymap map) - (define-key map "-" 'negative-argument) + (set-keymap-parent map backtrace-mode-map) (define-key map "b" 'debugger-frame) (define-key map "c" 'debugger-continue) (define-key map "j" 'debugger-jump) @@ -634,24 +540,20 @@ The environment used is the one when entering the activation frame at point." (define-key map "u" 'debugger-frame-clear) (define-key map "d" 'debugger-step-through) (define-key map "l" 'debugger-list-functions) - (define-key map "h" 'describe-mode) - (define-key map "q" 'top-level) + (define-key map "q" 'debugger-quit) (define-key map "e" 'debugger-eval-expression) - (define-key map "v" 'debugger-toggle-locals) ; "v" is for "variables". - (define-key map " " 'next-line) (define-key map "R" 'debugger-record-expression) - (define-key map "\C-m" 'debug-help-follow) (define-key map [mouse-2] 'push-button) (define-key map [menu-bar debugger] (cons "Debugger" menu-map)) (define-key menu-map [deb-top] - '(menu-item "Quit" top-level + '(menu-item "Quit" debugger-quit :help "Quit debugging and return to top level")) (define-key menu-map [deb-s0] '("--")) (define-key menu-map [deb-descr] '(menu-item "Describe Debugger Mode" describe-mode :help "Display documentation for debugger-mode")) (define-key menu-map [deb-hfol] - '(menu-item "Help Follow" debug-help-follow + '(menu-item "Help Follow" backtrace-help-follow-symbol :help "Follow cross-reference")) (define-key menu-map [deb-nxt] '(menu-item "Next Line" next-line @@ -689,8 +591,8 @@ The environment used is the one when entering the activation frame at point." (put 'debugger-mode 'mode-class 'special) -(define-derived-mode debugger-mode fundamental-mode "Debugger" - "Mode for backtrace buffers, selected in debugger. +(define-derived-mode debugger-mode backtrace-mode "Debugger" + "Mode for debugging Emacs Lisp using a backtrace. \\ A line starts with `*' if exiting that frame will call the debugger. Type \\[debugger-frame] or \\[debugger-frame-clear] to set or remove the `*'. @@ -704,8 +606,6 @@ which functions will enter the debugger when called. Complete list of commands: \\{debugger-mode-map}" - (setq truncate-lines t) - (set-syntax-table emacs-lisp-mode-syntax-table) (add-hook 'kill-buffer-hook (lambda () (if (> (recursion-depth) 0) (top-level))) nil t) @@ -732,27 +632,6 @@ Complete list of commands: (buffer-substring (line-beginning-position 0) (line-end-position 0))))) -(defun debug-help-follow (&optional pos) - "Follow cross-reference at POS, defaulting to point. - -For the cross-reference format, see `help-make-xrefs'." - (interactive "d") - ;; Ideally we'd just do (call-interactively 'help-follow) except that this - ;; assumes we're already in a *Help* buffer and reuses it, so it ends up - ;; incorrectly "reusing" the *Backtrace* buffer to show the help info. - (unless pos - (setq pos (point))) - (unless (push-button pos) - ;; check if the symbol under point is a function or variable - (let ((sym - (intern - (save-excursion - (goto-char pos) (skip-syntax-backward "w_") - (buffer-substring (point) - (progn (skip-syntax-forward "w_") - (point))))))) - (when (or (boundp sym) (fboundp sym) (facep sym)) - (describe-symbol sym))))) ;; When you change this, you may also need to change the number of ;; frames that the debugger skips. @@ -853,6 +732,13 @@ To specify a nil argument interactively, exit with an empty minibuffer." ;;(princ "be set to debug on entry, even if it is in the list.") ))))) +(defun debugger-quit () + "Quit debugging and return to the top level." + (interactive) + (if (= (recursion-depth) 0) + (quit-window) + (top-level))) + (defun debug--implement-debug-watch (symbol newval op where) "Conditionally call the debugger. This function is called when SYMBOL's value is modified." diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index f0c0db182e..b22c8952da 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -52,6 +52,7 @@ ;;; Code: +(require 'backtrace) (require 'macroexp) (require 'cl-lib) (eval-when-compile (require 'pcase)) @@ -206,8 +207,7 @@ Use this with caution since it is not debugged." "Non-nil if Edebug should unwrap results of expressions. That is, Edebug will try to remove its own instrumentation from the result. This is useful when debugging macros where the results of expressions -are instrumented expressions. But don't do this when results might be -circular or an infinite loop will result." +are instrumented expressions." :type 'boolean :group 'edebug) @@ -1265,25 +1265,59 @@ purpose by adding an entry to this alist, and setting (defun edebug-unwrap (sexp) "Return the unwrapped SEXP or return it as is if it is not wrapped. The SEXP might be the result of wrapping a body, which is a list of -expressions; a `progn' form will be returned enclosing these forms." - (if (consp sexp) - (cond - ((eq 'edebug-after (car sexp)) - (nth 3 sexp)) - ((eq 'edebug-enter (car sexp)) - (macroexp-progn (nthcdr 2 (nth 1 (nth 3 sexp))))) - (t sexp);; otherwise it is not wrapped, so just return it. - ) - sexp)) +expressions; a `progn' form will be returned enclosing these forms. +Does not unwrap inside vectors, records, structures, or hash tables." + (pcase sexp + (`(edebug-after ,_before-form ,_after-index ,form) + form) + (`(lambda ,args (edebug-enter ',_sym ,_arglist + (function (lambda nil . ,body)))) + `(lambda ,args ,@body)) + (`(closure ,env ,args (edebug-enter ',_sym ,_arglist + (function (lambda nil . ,body)))) + `(closure ,env ,args ,@body)) + (`(edebug-enter ',_sym ,_args (function (lambda nil . ,body))) + (macroexp-progn body)) + (_ sexp))) (defun edebug-unwrap* (sexp) "Return the SEXP recursively unwrapped." + (let ((ht (make-hash-table :test 'eq))) + (edebug--unwrap1 sexp ht))) + +(defun edebug--unwrap1 (sexp hash-table) + "Unwrap SEXP using HASH-TABLE of things already unwrapped. +HASH-TABLE contains the results of unwrapping cons cells within +SEXP, which are reused to avoid infinite loops when SEXP is or +contains a circular object." (let ((new-sexp (edebug-unwrap sexp))) (while (not (eq sexp new-sexp)) (setq sexp new-sexp new-sexp (edebug-unwrap sexp))) (if (consp new-sexp) - (mapcar #'edebug-unwrap* new-sexp) + (let ((result (gethash new-sexp hash-table nil))) + (unless result + (let ((remainder new-sexp) + current) + (setq result (cons nil nil) + current result) + (while + (progn + (puthash remainder current hash-table) + (setf (car current) + (edebug--unwrap1 (car remainder) hash-table)) + (setq remainder (cdr remainder)) + (cond + ((atom remainder) + (setf (cdr current) + (edebug--unwrap1 remainder hash-table)) + nil) + ((gethash remainder hash-table nil) + (setf (cdr current) (gethash remainder hash-table nil)) + nil) + (t (setq current + (setf (cdr current) (cons nil nil))))))))) + result) new-sexp))) @@ -3916,8 +3950,10 @@ Global commands prefixed by `global-edebug-prefix': ;; (setq debugger 'debug) ; use the standard debugger ;; Note that debug and its utilities must be byte-compiled to work, -;; since they depend on the backtrace looking a certain way. But -;; edebug is not dependent on this, yet. +;; since they depend on the backtrace looking a certain way. Edebug +;; will work if not byte-compiled, but it will not be able correctly +;; remove its instrumentation from backtraces unless it is +;; byte-compiled. (defun edebug (&optional arg-mode &rest args) "Replacement for `debug'. @@ -3947,48 +3983,96 @@ Otherwise call `debug' normally." (apply #'debug arg-mode args) )) +;;; Backtrace buffer + +;; Data structure for backtrace frames with information +;; from Edebug instrumentation found in the backtrace. +(cl-defstruct + (edebug--frame + (:constructor edebug--make-frame) + (:include backtrace-frame)) + def-name before-index after-index) (defun edebug-backtrace () - "Display a non-working backtrace. Better than nothing..." + "Display the current backtrace in a `backtrace-mode' window." (interactive) (if (or (not edebug-backtrace-buffer) (null (buffer-name edebug-backtrace-buffer))) (setq edebug-backtrace-buffer - (generate-new-buffer "*Backtrace*")) + (generate-new-buffer "*Edebug Backtrace*")) ;; Else, could just display edebug-backtrace-buffer. ) (with-output-to-temp-buffer (buffer-name edebug-backtrace-buffer) (setq edebug-backtrace-buffer standard-output) - (let ((print-escape-newlines t) - (print-length 50) ; FIXME cf edebug-safe-prin1-to-string - last-ok-point) - (backtrace) - - ;; Clean up the backtrace. - ;; Not quite right for current edebug scheme. - (set-buffer edebug-backtrace-buffer) - (setq truncate-lines t) - (goto-char (point-min)) - (setq last-ok-point (point)) - (if t (progn - - ;; Delete interspersed edebug internals. - (while (re-search-forward "^ (?edebug" nil t) - (beginning-of-line) - (cond - ((looking-at "^ (edebug-after") - ;; Previous lines may contain code, so just delete this line. - (setq last-ok-point (point)) - (forward-line 1) - (delete-region last-ok-point (point))) - - ((looking-at (if debugger-stack-frame-as-list - "^ (edebug" - "^ edebug")) - (forward-line 1) - (delete-region last-ok-point (point)) - ))) - ))))) + (with-current-buffer edebug-backtrace-buffer + (unless (derived-mode-p 'backtrace-mode) + (backtrace-mode)) + (setq backtrace-frames (edebug--backtrace-frames) + backtrace-view '(:do-xrefs t)) + (backtrace-print) + (goto-char (point-min))))) + +(defun edebug--backtrace-frames () + "Return backtrace frames with instrumentation removed. +Remove frames for Edebug's functions and the lambdas in +`edebug-enter' wrappers." + (let* ((frames (backtrace-get-frames 'edebug-debugger + :constructor #'edebug--make-frame)) + skip-next-lambda def-name before-index after-index + results + (index (length frames))) + (dolist (frame (reverse frames)) + (let ((fun (edebug--frame-fun frame)) + (args (edebug--frame-args frame))) + (cl-decf index) + (when (edebug--frame-evald frame) + (setq before-index nil + after-index nil)) + (pcase fun + ('edebug-enter + (setq skip-next-lambda t + def-name (nth 0 args))) + ('edebug-after + (setq before-index (if (consp (nth 0 args)) + (nth 1 (nth 0 args)) + (nth 0 args)) + after-index (nth 1 args))) + ((pred edebug--symbol-not-prefixed-p) + (edebug--unwrap-and-add-info frame def-name before-index after-index) + (setf (edebug--frame-def-name frame) (and before-index def-name)) + (setf (edebug--frame-before-index frame) before-index) + (setf (edebug--frame-after-index frame) after-index) + (push frame results) + (setq before-index nil + after-index nil)) + (`(,(or 'lambda 'closure) . ,_) + (unless skip-next-lambda + (edebug--unwrap-and-add-info frame def-name before-index after-index) + (push frame results)) + (setq before-index nil + after-index nil + skip-next-lambda nil))))) + results)) + +(defun edebug--symbol-not-prefixed-p (sym) + "Return non-nil if SYM is a symbol not prefixed by \"edebug-\"." + (and (symbolp sym) + (not (string-prefix-p "edebug-" (symbol-name sym))))) + +(defun edebug--unwrap-and-add-info (frame def-name before-index after-index) + "Update FRAME with the additional info needed by an edebug--frame. +Save DEF-NAME, BEFORE-INDEX and AFTER-INDEX in FRAME. Also +remove Edebug's instrumentation from the function and any +unevaluated arguments in FRAME." + (setf (edebug--frame-def-name frame) (and before-index def-name)) + (setf (edebug--frame-before-index frame) before-index) + (setf (edebug--frame-after-index frame) after-index) + (setf (edebug--frame-fun frame) (edebug-unwrap* (edebug--frame-fun frame))) + (unless (edebug--frame-evald frame) + (let (results) + (dolist (arg (edebug--frame-args frame)) + (push (edebug-unwrap* arg) results)) + (setf (edebug--frame-args frame) (nreverse results))))) ;;; Trace display diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index cad21044f1..7178493ebe 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -60,6 +60,7 @@ (require 'cl-lib) (require 'button) (require 'debug) +(require 'backtrace) (require 'easymenu) (require 'ewoc) (require 'find-func) @@ -677,13 +678,6 @@ and is displayed in front of the value of MESSAGE-FORM." (cl-defstruct (ert-test-aborted-with-non-local-exit (:include ert-test-result))) -(defun ert--print-backtrace (backtrace do-xrefs) - "Format the backtrace BACKTRACE to the current buffer." - (let ((print-escape-newlines t) - (print-level 8) - (print-length 50)) - (debugger-insert-backtrace backtrace do-xrefs))) - ;; A container for the state of the execution of a single test and ;; environment data needed during its execution. (cl-defstruct ert--test-execution-info @@ -732,7 +726,7 @@ run. ARGS are the arguments to `debugger'." ;; use. ;; ;; Grab the frames above the debugger. - (backtrace (cdr (backtrace-frames debugger))) + (backtrace (cdr (backtrace-get-frames debugger))) (infos (reverse ert--infos))) (setf (ert--test-execution-info-result info) (cl-ecase type @@ -1406,9 +1400,8 @@ Returns the stats object." (ert-test-result-with-condition (message "Test %S backtrace:" (ert-test-name test)) (with-temp-buffer - (ert--print-backtrace - (ert-test-result-with-condition-backtrace result) - nil) + (insert (backtrace-to-string + (ert-test-result-with-condition-backtrace result))) (if (not ert-batch-backtrace-right-margin) (message "%s" (buffer-substring-no-properties (point-min) @@ -2450,20 +2443,21 @@ To be used in the ERT results buffer." (cl-etypecase result (ert-test-passed (error "Test passed, no backtrace available")) (ert-test-result-with-condition - (let ((backtrace (ert-test-result-with-condition-backtrace result)) - (buffer (get-buffer-create "*ERT Backtrace*"))) + (let ((buffer (get-buffer-create "*ERT Backtrace*"))) (pop-to-buffer buffer) - (let ((inhibit-read-only t)) - (buffer-disable-undo) - (erase-buffer) - (ert-simple-view-mode) - (set-buffer-multibyte t) ; mimic debugger-setup-buffer - (setq truncate-lines t) - (ert--print-backtrace backtrace t) - (goto-char (point-min)) - (insert (substitute-command-keys "Backtrace for test `")) - (ert-insert-test-name-button (ert-test-name test)) - (insert (substitute-command-keys "':\n")))))))) + (unless (derived-mode-p 'backtrace-mode) + (backtrace-mode)) + (setq backtrace-insert-header-function + (lambda () (ert--insert-backtrace-header (ert-test-name test))) + backtrace-frames (ert-test-result-with-condition-backtrace result) + backtrace-view '(:do-xrefs t)) + (backtrace-print) + (goto-char (point-min))))))) + +(defun ert--insert-backtrace-header (name) + (insert (substitute-command-keys "Backtrace for test `")) + (ert-insert-test-name-button name) + (insert (substitute-command-keys "':\n"))) (defun ert-results-pop-to-messages-for-test-at-point () "Display the part of the *Messages* buffer generated during the test at point. diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 6313c63ecf..afb7cbd1dd 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -517,6 +517,16 @@ This will generate compile-time constants from BINDINGS." (defvar lisp-cl-font-lock-keywords lisp-cl-font-lock-keywords-1 "Default expressions to highlight in Lisp modes.") +;; Support backtrace mode. +(defconst lisp-el-font-lock-keywords-for-backtraces lisp-el-font-lock-keywords + "Default highlighting from Emacs Lisp mod used in Backtrace mode.") +(defconst lisp-el-font-lock-keywords-for-backtraces-1 lisp-el-font-lock-keywords-1 + "Subdued highlighting from Emacs Lisp mode used in Backtrace mode.") +(defconst lisp-el-font-lock-keywords-for-backtraces-2 + (remove (assoc 'lisp--match-hidden-arg lisp-el-font-lock-keywords-2) + lisp-el-font-lock-keywords-2) + "Gaudy highlighting from Emacs Lisp mode used in Backtrace mode.") + (defun lisp-string-in-doc-position-p (listbeg startpos) "Return true if a doc string may occur at STARTPOS inside a list. LISTBEG is the position of the start of the innermost list diff --git a/test/lisp/emacs-lisp/backtrace-tests.el b/test/lisp/emacs-lisp/backtrace-tests.el new file mode 100644 index 0000000000..75da468494 --- /dev/null +++ b/test/lisp/emacs-lisp/backtrace-tests.el @@ -0,0 +1,89 @@ +;;; backtrace-tests.el --- Tests for emacs-lisp/backtrace.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2018 Free Software Foundation, Inc. + +;; Author: Gemini Lasswell + +;; 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 . + +;;; Code: + +(require 'backtrace) +(require 'ert) +(require 'seq) + +;; Create a backtrace frames list with several frames. +;; TODO load this from an el file in backtrace-resources/ so the tests +;; can be byte-compiled. +(defvar backtrace-tests--frames nil) + +(defun backtrace-tests--func1 (arg1 arg2) + (setq backtrace-tests--frames (backtrace-get-frames nil)) + (list arg1 arg2)) + +(defun backtrace-tests--func2 (arg) + (list arg)) + +(defun backtrace-tests--func3 (arg) + (let ((foo (list 'a arg 'b))) + (list foo (backtrace-tests--func2 arg) (backtrace-tests--func1 arg 0)))) + +(defun backtrace-tests--create-backtrace-frames () + (backtrace-tests--func3 "string") + ;; Discard frames before this one. + (let (this-index) + (dotimes (index (length backtrace-tests--frames)) + (when (eq (backtrace-frame-fun (nth index backtrace-tests--frames)) + 'backtrace-tests--create-backtrace-frames) + (setq this-index index))) + (setq backtrace-tests--frames (seq-subseq backtrace-tests--frames + 0 (1+ this-index))))) + +(backtrace-tests--create-backtrace-frames) + +;; TODO check that debugger-batch-max-lines still works + +(defun backtrace-tests--insert-header () + (insert "Test header\n")) + +(defmacro backtrace-tests--with-buffer (&rest body) + `(with-temp-buffer + (backtrace-mode) + (setq backtrace-frames backtrace-tests--frames) + (setq backtrace-insert-header-function #'backtrace-tests--insert-header) + (backtrace-print) + ,@body)) + +;;; Tests +(ert-deftest backtrace-tests--to-string () + (should (string= (backtrace-to-string backtrace-tests--frames) + " backtrace-get-frames(nil) + (setq backtrace-tests--frames (backtrace-get-frames nil)) + backtrace-tests--func1(\"string\" 0) + (list foo (backtrace-tests--func2 arg) (backtrace-tests--func1 arg 0)) + (let ((foo (list 'a arg 'b))) (list foo (backtrace-tests--func2 arg) (backtrace-tests--func1 arg 0))) + backtrace-tests--func3(\"string\") + backtrace-tests--create-backtrace-frames() +"))) + +(provide 'backtrace-tests) + +;; These tests expect to see non-byte compiled stack frames. +;; Local Variables: +;; no-byte-compile: t +;; End: + +;;; backtrace-tests.el ends here diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index cb957bd9fd..1fe5b79ef3 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -376,7 +376,7 @@ This macro is used to test if macroexpansion in `should' works." (test (make-ert-test :body test-body)) (result (ert-run-test test))) (should (ert-test-failed-p result)) - (should (eq (nth 1 (car (ert-test-failed-backtrace result))) + (should (eq (backtrace-frame-fun (car (ert-test-failed-backtrace result))) 'signal)))) (ert-deftest ert-test-messages () commit 8a7620955b4d859caecd9a5dc9f2a986baf994fd Author: Gemini Lasswell Date: Fri Jun 15 10:26:13 2018 -0700 Add methods for strings to cl-print * lisp/emacs-lisp/cl-print.el (cl-print-object) : New method. (cl-print-object-contents) : New method. (cl-print--find-sharing): Look in string property lists. * test/lisp/emacs-lisp/cl-print-tests.el (cl-print-tests-3): Test printing of long strings. (cl-print-tests-4): Test printing of strings nested in other objects. (cl-print-tests-strings, cl-print-tests-ellipsis-string): New tests. diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index e638e58275..337efa465a 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -285,6 +285,95 @@ into a button whose action shows the function's disassembly.") (princ " " stream) (cl-print-insert-ellipsis object limit stream)))) +(cl-defmethod cl-print-object ((object string) stream) + (unless stream (setq stream standard-output)) + (let* ((has-properties (or (text-properties-at 0 object) + (next-property-change 0 object))) + (len (length object)) + (limit (if (natnump print-length) (min print-length len) len))) + (if (and has-properties + cl-print--depth + (natnump print-level) + (> cl-print--depth print-level)) + (cl-print-insert-ellipsis object 0 stream) + ;; Print all or part of the string + (when has-properties + (princ "#(" stream)) + (if (= limit len) + (prin1 (if has-properties (substring-no-properties object) object) + stream) + (let ((part (concat (substring-no-properties object 0 limit) "..."))) + (prin1 part stream) + (when (bufferp stream) + (with-current-buffer stream + (cl-print-propertize-ellipsis object limit + (- (point) 4) + (- (point) 1) stream))))) + ;; Print the property list. + (when has-properties + (let* ((interval-limit (and (natnump print-length) + (max 1 (/ print-length 3)))) + (interval-count 0) + (start-pos (if (text-properties-at 0 object) + 0 (next-property-change 0 object))) + (end-pos (next-property-change start-pos object len))) + (while (and (or (null interval-limit) + (< interval-count interval-limit)) + (< start-pos len)) + (let ((props (text-properties-at start-pos object))) + (when props + (princ " " stream) (princ start-pos stream) + (princ " " stream) (princ end-pos stream) + (princ " " stream) (cl-print-object props stream) + (cl-incf interval-count)) + (setq start-pos end-pos + end-pos (next-property-change start-pos object len)))) + (when (< start-pos len) + (princ " " stream) + (cl-print-insert-ellipsis object (list start-pos) stream))) + (princ ")" stream))))) + +(cl-defmethod cl-print-object-contents ((object string) start stream) + ;; If START is an integer, it is an index into the string, and the + ;; ellipsis that needs to be expanded is part of the string. If + ;; START is a cons, its car is an index into the string, and the + ;; ellipsis that needs to be expanded is in the property list. + (let* ((len (length object))) + (if (atom start) + ;; Print part of the string. + (let* ((limit (if (natnump print-length) + (min (+ start print-length) len) len)) + (substr (substring-no-properties object start limit)) + (printed (prin1-to-string substr)) + (trimmed (substring printed 1 (1- (length printed))))) + (princ trimmed) + (when (< limit len) + (cl-print-insert-ellipsis object limit stream))) + + ;; Print part of the property list. + (let* ((first t) + (interval-limit (and (natnump print-length) + (max 1 (/ print-length 3)))) + (interval-count 0) + (start-pos (car start)) + (end-pos (next-property-change start-pos object len))) + (while (and (or (null interval-limit) + (< interval-count interval-limit)) + (< start-pos len)) + (let ((props (text-properties-at start-pos object))) + (when props + (if first + (setq first nil) + (princ " " stream)) + (princ start-pos stream) + (princ " " stream) (princ end-pos stream) + (princ " " stream) (cl-print-object props stream) + (cl-incf interval-count)) + (setq start-pos end-pos + end-pos (next-property-change start-pos object len)))) + (when (< start-pos len) + (princ " " stream) + (cl-print-insert-ellipsis object (list start-pos) stream)))))) ;;; Circularity and sharing. @@ -346,8 +435,17 @@ into a button whose action shows the function's disassembly.") (push cdr stack) (push car stack)) ((pred stringp) - ;; We presumably won't print its text-properties. - nil) + (let* ((len (length object)) + (start (if (text-properties-at 0 object) + 0 (next-property-change 0 object))) + (end (and start + (next-property-change start object len)))) + (while (and start (< start len)) + (let ((props (text-properties-at start object))) + (when props + (push props stack)) + (setq start end + end (next-property-change start object len)))))) ((or (pred arrayp) (pred byte-code-function-p)) ;; FIXME: Inefficient for char-tables! (dotimes (i (length object)) diff --git a/test/lisp/emacs-lisp/cl-print-tests.el b/test/lisp/emacs-lisp/cl-print-tests.el index 2b5eb3402b..7594d2466b 100644 --- a/test/lisp/emacs-lisp/cl-print-tests.el +++ b/test/lisp/emacs-lisp/cl-print-tests.el @@ -56,11 +56,13 @@ (let ((long-list (make-list 5 'a)) (long-vec (make-vector 5 'b)) (long-struct (cl-print-tests-con)) + (long-string (make-string 5 ?a)) (print-length 4)) (should (equal "(a a a a ...)" (cl-prin1-to-string long-list))) (should (equal "[b b b b ...]" (cl-prin1-to-string long-vec))) (should (equal "#s(cl-print-tests-struct :a nil :b nil :c nil :d nil ...)" - (cl-prin1-to-string long-struct))))) + (cl-prin1-to-string long-struct))) + (should (equal "\"aaaa...\"" (cl-prin1-to-string long-string))))) (ert-deftest cl-print-tests-4 () "CL printing observes `print-level'." @@ -68,11 +70,16 @@ (buried-vector '(a (b (c (d [e]))))) (deep-struct (cl-print-tests-con)) (buried-struct `(a (b (c (d ,deep-struct))))) + (buried-string '(a (b (c (d #("hello" 0 5 (cl-print-test t))))))) + (buried-simple-string '(a (b (c (d "hello"))))) (print-level 4)) (setf (cl-print-tests-struct-a deep-struct) deep-list) (should (equal "(a (b (c (d ...))))" (cl-prin1-to-string deep-list))) (should (equal "(a (b (c (d ...))))" (cl-prin1-to-string buried-vector))) (should (equal "(a (b (c (d ...))))" (cl-prin1-to-string buried-struct))) + (should (equal "(a (b (c (d ...))))" (cl-prin1-to-string buried-string))) + (should (equal "(a (b (c (d \"hello\"))))" + (cl-prin1-to-string buried-simple-string))) (should (equal "#s(cl-print-tests-struct :a (a (b (c ...))) :b nil :c nil :d nil :e nil)" (cl-prin1-to-string deep-struct))))) @@ -86,6 +93,35 @@ (should (equal "((quote a) (function b) (\\` ((\\, c) (\\,@ d))))" (cl-prin1-to-string quoted-stuff)))))) +(ert-deftest cl-print-tests-strings () + "CL printing prints strings and propertized strings." + (let* ((str1 "abcdefghij") + (str2 #("abcdefghij" 3 6 (bold t) 7 9 (italic t))) + (str3 #("abcdefghij" 0 10 (test t))) + (obj '(a b)) + ;; Since the byte compiler reuses string literals, + ;; and the put-text-property call is destructive, use + ;; copy-sequence to make a new string. + (str4 (copy-sequence "abcdefghij"))) + (put-text-property 0 5 'test obj str4) + (put-text-property 7 10 'test obj str4) + + (should (equal "\"abcdefghij\"" (cl-prin1-to-string str1))) + (should (equal "#(\"abcdefghij\" 3 6 (bold t) 7 9 (italic t))" + (cl-prin1-to-string str2))) + (should (equal "#(\"abcdefghij\" 0 10 (test t))" + (cl-prin1-to-string str3))) + (let ((print-circle nil)) + (should + (equal + "#(\"abcdefghij\" 0 5 (test (a b)) 7 10 (test (a b)))" + (cl-prin1-to-string str4)))) + (let ((print-circle t)) + (should + (equal + "#(\"abcdefghij\" 0 5 (test #1=(a b)) 7 10 (test #1#))" + (cl-prin1-to-string str4)))))) + (ert-deftest cl-print-tests-ellipsis-cons () "Ellipsis expansion works in conses." (let ((print-length 4) @@ -113,6 +149,21 @@ (cl-print-tests-check-ellipsis-expansion [a [b [c [d [e]]]]] "[a [b [c ...]]]" "[d [e]]"))) +(ert-deftest cl-print-tests-ellipsis-string () + "Ellipsis expansion works in strings." + (let ((print-length 4) + (print-level 3)) + (cl-print-tests-check-ellipsis-expansion + "abcdefg" "\"abcd...\"" "efg") + (cl-print-tests-check-ellipsis-expansion + "abcdefghijk" "\"abcd...\"" "efgh...") + (cl-print-tests-check-ellipsis-expansion + '(1 (2 (3 #("abcde" 0 5 (test t))))) + "(1 (2 (3 ...)))" "#(\"abcd...\" 0 5 (test t))") + (cl-print-tests-check-ellipsis-expansion + #("abcd" 0 1 (bold t) 1 2 (invisible t) 3 4 (italic t)) + "#(\"abcd\" 0 1 (bold t) ...)" "1 2 (invisible t) ..."))) + (ert-deftest cl-print-tests-ellipsis-struct () "Ellipsis expansion works in structures." (let ((print-length 4) commit eba16e5e5829c244d313101a769d4988946387d9 Author: Gemini Lasswell Date: Fri Jun 15 10:23:58 2018 -0700 Support ellipsis expansion in cl-print * lisp/emacs-lisp/cl-print.el (cl-print-object-contents): New generic method. (cl-print-object-contents) : New methods. (cl-print-object) : Use cl-print-insert-ellipsis. (cl-print-object) : Elide whole object if print-level exceeded. Use cl-print-insert-ellipsis. (cl-print-insert-ellipsis, cl-print-propertize-ellipsis) (cl-print-expand-ellipsis): New functions. * test/lisp/emacs-lisp/cl-print-tests.el (cl-print-tests-4): Test printing of objects nested in other objects. (cl-print-tests-strings, cl-print-tests-ellipsis-cons) (cl-print-tests-ellipsis-vector, cl-print-tests-ellipsis-struct) (cl-print-tests-ellipsis-circular): New tests. (cl-print-tests-check-ellipsis-expansion) (cl-print-tests-check-ellipsis-expansion-rx): New functions. diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index bf5b1e878d..e638e58275 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -55,10 +55,19 @@ call other entry points instead, such as `cl-prin1'." ;; we should only use it for objects which don't have nesting. (prin1 object stream)) +(cl-defgeneric cl-print-object-contents (_object _start _stream) + "Dispatcher to print the contents of OBJECT on STREAM. +Print the contents starting with the item at START, without +delimiters." + ;; Every cl-print-object method which can print an ellipsis should + ;; have a matching cl-print-object-contents method to expand an + ;; ellipsis. + (error "Missing cl-print-object-contents method")) + (cl-defmethod cl-print-object ((object cons) stream) (if (and cl-print--depth (natnump print-level) (> cl-print--depth print-level)) - (princ "..." stream) + (cl-print-insert-ellipsis object 0 stream) (let ((car (pop object)) (count 1)) (if (and print-quoted @@ -84,23 +93,60 @@ call other entry points instead, such as `cl-prin1'." (princ " " stream) (if (or (not (natnump print-length)) (> print-length count)) (cl-print-object (pop object) stream) - (princ "..." stream) + (cl-print-insert-ellipsis object print-length stream) (setq object nil)) (cl-incf count)) (when object (princ " . " stream) (cl-print-object object stream)) (princ ")" stream))))) +(cl-defmethod cl-print-object-contents ((object cons) _start stream) + (let ((count 0)) + (while (and (consp object) + (not (cond + (cl-print--number-table + (numberp (gethash object cl-print--number-table))) + ((memq object cl-print--currently-printing)) + (t (push object cl-print--currently-printing) + nil)))) + (unless (zerop count) + (princ " " stream)) + (if (or (not (natnump print-length)) (> print-length count)) + (cl-print-object (pop object) stream) + (cl-print-insert-ellipsis object print-length stream) + (setq object nil)) + (cl-incf count)) + (when object + (princ " . " stream) (cl-print-object object stream)))) + (cl-defmethod cl-print-object ((object vector) stream) - (princ "[" stream) - (let ((count (length object))) - (dotimes (i (if (natnump print-length) - (min print-length count) count)) - (unless (zerop i) (princ " " stream)) - (cl-print-object (aref object i) stream)) - (when (and (natnump print-length) (< print-length count)) - (princ " ..." stream))) - (princ "]" stream)) + (if (and cl-print--depth (natnump print-level) + (> cl-print--depth print-level)) + (cl-print-insert-ellipsis object 0 stream) + (princ "[" stream) + (let* ((len (length object)) + (limit (if (natnump print-length) + (min print-length len) len))) + (dotimes (i limit) + (unless (zerop i) (princ " " stream)) + (cl-print-object (aref object i) stream)) + (when (< limit len) + (princ " " stream) + (cl-print-insert-ellipsis object limit stream))) + (princ "]" stream))) + +(cl-defmethod cl-print-object-contents ((object vector) start stream) + (let* ((len (length object)) + (limit (if (natnump print-length) + (min (+ start print-length) len) len)) + (i start)) + (while (< i limit) + (unless (= i start) (princ " " stream)) + (cl-print-object (aref object i) stream) + (cl-incf i)) + (when (< limit len) + (princ " " stream) + (cl-print-insert-ellipsis object limit stream)))) (cl-defmethod cl-print-object ((object hash-table) stream) (princ "# cl-print--depth print-level)) + (cl-print-insert-ellipsis object 0 stream) + (princ "#s(" stream) + (let* ((class (cl-find-class (type-of object))) + (slots (cl--struct-class-slots class)) + (len (length slots)) + (limit (if (natnump print-length) + (min print-length len) len))) + (princ (cl--struct-class-name class) stream) + (dotimes (i limit) + (let ((slot (aref slots i))) + (princ " :" stream) + (princ (cl--slot-descriptor-name slot) stream) + (princ " " stream) + (cl-print-object (aref object (1+ i)) stream))) + (when (< limit len) + (princ " " stream) + (cl-print-insert-ellipsis object limit stream))) + (princ ")" stream))) + +(cl-defmethod cl-print-object-contents ((object cl-structure-object) start stream) (let* ((class (cl-find-class (type-of object))) (slots (cl--struct-class-slots class)) - (count (length slots))) - (princ (cl--struct-class-name class) stream) - (dotimes (i (if (natnump print-length) - (min print-length count) count)) + (len (length slots)) + (limit (if (natnump print-length) + (min (+ start print-length) len) len)) + (i start)) + (while (< i limit) (let ((slot (aref slots i))) - (princ " :" stream) + (unless (= i start) (princ " " stream)) + (princ ":" stream) (princ (cl--slot-descriptor-name slot) stream) (princ " " stream) - (cl-print-object (aref object (1+ i)) stream))) - (when (and (natnump print-length) (< print-length count)) - (princ " ..." stream))) - (princ ")" stream)) + (cl-print-object (aref object (1+ i)) stream)) + (cl-incf i)) + (when (< limit len) + (princ " " stream) + (cl-print-insert-ellipsis object limit stream)))) + ;;; Circularity and sharing. @@ -291,6 +362,48 @@ into a button whose action shows the function's disassembly.") (cl-print--find-sharing object print-number-table))) print-number-table)) +(defun cl-print-insert-ellipsis (object start stream) + "Print \"...\" to STREAM with the `cl-print-ellipsis' text property. +Save state in the text property in order to print the elided part +of OBJECT later. START should be 0 if the whole OBJECT is being +elided, otherwise it should be an index or other pointer into the +internals of OBJECT which can be passed to +`cl-print-object-contents' at a future time." + (unless stream (setq stream standard-output)) + (let ((ellipsis-start (and (bufferp stream) + (with-current-buffer stream (point))))) + (princ "..." stream) + (when ellipsis-start + (with-current-buffer stream + (cl-print-propertize-ellipsis object start ellipsis-start (point) + stream))))) + +(defun cl-print-propertize-ellipsis (object start beg end stream) + "Add the `cl-print-ellipsis' property between BEG and END. +STREAM should be a buffer. OBJECT and START are as described in +`cl-print-insert-ellipsis'." + (let ((value (list object start cl-print--number-table + cl-print--currently-printing))) + (with-current-buffer stream + (put-text-property beg end 'cl-print-ellipsis value stream)))) + +;;;###autoload +(defun cl-print-expand-ellipsis (value stream) + "Print the expansion of an ellipsis to STREAM. +VALUE should be the value of the `cl-print-ellipsis' text property +which was attached to the ellipsis by `cl-prin1'." + (let ((cl-print--depth 1) + (object (nth 0 value)) + (start (nth 1 value)) + (cl-print--number-table (nth 2 value)) + (print-number-table (nth 2 value)) + (cl-print--currently-printing (nth 3 value))) + (when (eq object (car cl-print--currently-printing)) + (pop cl-print--currently-printing)) + (if (equal start 0) + (cl-print-object object stream) + (cl-print-object-contents object start stream)))) + ;;;###autoload (defun cl-prin1 (object &optional stream) "Print OBJECT on STREAM according to its type. diff --git a/test/lisp/emacs-lisp/cl-print-tests.el b/test/lisp/emacs-lisp/cl-print-tests.el index 404d323d0c..2b5eb3402b 100644 --- a/test/lisp/emacs-lisp/cl-print-tests.el +++ b/test/lisp/emacs-lisp/cl-print-tests.el @@ -64,11 +64,15 @@ (ert-deftest cl-print-tests-4 () "CL printing observes `print-level'." - (let ((deep-list '(a (b (c (d (e)))))) - (deep-struct (cl-print-tests-con)) - (print-level 4)) + (let* ((deep-list '(a (b (c (d (e)))))) + (buried-vector '(a (b (c (d [e]))))) + (deep-struct (cl-print-tests-con)) + (buried-struct `(a (b (c (d ,deep-struct))))) + (print-level 4)) (setf (cl-print-tests-struct-a deep-struct) deep-list) (should (equal "(a (b (c (d ...))))" (cl-prin1-to-string deep-list))) + (should (equal "(a (b (c (d ...))))" (cl-prin1-to-string buried-vector))) + (should (equal "(a (b (c (d ...))))" (cl-prin1-to-string buried-struct))) (should (equal "#s(cl-print-tests-struct :a (a (b (c ...))) :b nil :c nil :d nil :e nil)" (cl-prin1-to-string deep-struct))))) @@ -82,6 +86,85 @@ (should (equal "((quote a) (function b) (\\` ((\\, c) (\\,@ d))))" (cl-prin1-to-string quoted-stuff)))))) +(ert-deftest cl-print-tests-ellipsis-cons () + "Ellipsis expansion works in conses." + (let ((print-length 4) + (print-level 3)) + (cl-print-tests-check-ellipsis-expansion + '(0 1 2 3 4 5) "(0 1 2 3 ...)" "4 5") + (cl-print-tests-check-ellipsis-expansion + '(0 1 2 3 4 5 6 7 8 9) "(0 1 2 3 ...)" "4 5 6 7 ...") + (cl-print-tests-check-ellipsis-expansion + '(a (b (c (d (e))))) "(a (b (c ...)))" "(d (e))") + (cl-print-tests-check-ellipsis-expansion + (let ((x (make-list 6 'b))) + (setf (nthcdr 6 x) 'c) + x) + "(b b b b ...)" "b b . c"))) + +(ert-deftest cl-print-tests-ellipsis-vector () + "Ellipsis expansion works in vectors." + (let ((print-length 4) + (print-level 3)) + (cl-print-tests-check-ellipsis-expansion + [0 1 2 3 4 5] "[0 1 2 3 ...]" "4 5") + (cl-print-tests-check-ellipsis-expansion + [0 1 2 3 4 5 6 7 8 9] "[0 1 2 3 ...]" "4 5 6 7 ...") + (cl-print-tests-check-ellipsis-expansion + [a [b [c [d [e]]]]] "[a [b [c ...]]]" "[d [e]]"))) + +(ert-deftest cl-print-tests-ellipsis-struct () + "Ellipsis expansion works in structures." + (let ((print-length 4) + (print-level 3) + (struct (cl-print-tests-con))) + (cl-print-tests-check-ellipsis-expansion + struct "#s(cl-print-tests-struct :a nil :b nil :c nil :d nil ...)" ":e nil") + (let ((print-length 2)) + (cl-print-tests-check-ellipsis-expansion + struct "#s(cl-print-tests-struct :a nil :b nil ...)" ":c nil :d nil ...")) + (cl-print-tests-check-ellipsis-expansion + `(a (b (c ,struct))) + "(a (b (c ...)))" + "#s(cl-print-tests-struct :a nil :b nil :c nil :d nil ...)"))) + +(ert-deftest cl-print-tests-ellipsis-circular () + "Ellipsis expansion works with circular objects." + (let ((wide-obj (list 0 1 2 3 4)) + (deep-obj `(0 (1 (2 (3 (4)))))) + (print-length 4) + (print-level 3)) + (setf (nth 4 wide-obj) wide-obj) + (setf (car (cadadr (cadadr deep-obj))) deep-obj) + (let ((print-circle nil)) + (cl-print-tests-check-ellipsis-expansion-rx + wide-obj (regexp-quote "(0 1 2 3 ...)") "\\`#[0-9]\\'") + (cl-print-tests-check-ellipsis-expansion-rx + deep-obj (regexp-quote "(0 (1 (2 ...)))") "\\`(3 (#[0-9]))\\'")) + (let ((print-circle t)) + (cl-print-tests-check-ellipsis-expansion + wide-obj "#1=(0 1 2 3 ...)" "#1#") + (cl-print-tests-check-ellipsis-expansion + deep-obj "#1=(0 (1 (2 ...)))" "(3 (#1#))")))) + +(defun cl-print-tests-check-ellipsis-expansion (obj expected expanded) + (let* ((result (cl-prin1-to-string obj)) + (pos (next-single-property-change 0 'cl-print-ellipsis result)) + value) + (should pos) + (setq value (get-text-property pos 'cl-print-ellipsis result)) + (should (equal expected result)) + (should (equal expanded (with-output-to-string (cl-print-expand-ellipsis + value nil)))))) + +(defun cl-print-tests-check-ellipsis-expansion-rx (obj expected expanded) + (let* ((result (cl-prin1-to-string obj)) + (pos (next-single-property-change 0 'cl-print-ellipsis result)) + (value (get-text-property pos 'cl-print-ellipsis result))) + (should (string-match expected result)) + (should (string-match expanded (with-output-to-string + (cl-print-expand-ellipsis value nil)))))) + (ert-deftest cl-print-circle () (let ((x '(#1=(a . #1#) #1#))) (let ((print-circle nil)) commit f0b8e64fb7720a9376bde80cc59fe37b0df83b9d Author: Eli Zaretskii Date: Thu Aug 2 16:58:44 2018 +0300 Avoid assertion violations in maybe_produce_line_number * src/xdisp.c (redisplay_window): Make sure desired_matrix is cleared before calling try_window. This is important when display-line-numbers is non-nil, because line-number display code assumes each glyph row is completely cleared when it is called to produce a line number. (Bug#32358) diff --git a/src/xdisp.c b/src/xdisp.c index 9247d5bc3e..9a82953952 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -16897,6 +16897,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) /* We used to issue a CHECK_MARGINS argument to try_window here, but this causes scrolling to fail when point begins inside the scroll margin (bug#148) -- cyd */ + clear_glyph_matrix (w->desired_matrix); if (!try_window (window, startp, 0)) { w->force_start = true; commit 7669bf7880e54aae7036a1b62db3693c2f627649 Author: Eli Zaretskii Date: Thu Aug 2 16:29:54 2018 +0300 Avoid assertion violations in set_text_properties_1 * src/textprop.c (set_text_properties): If the call to modify_text_properties modifies the interval tree as side effect, recalculate the correct interval for START and END. (Bug#32265) diff --git a/src/textprop.c b/src/textprop.c index 984f2e6640..904e2265bd 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -1350,6 +1350,7 @@ set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object properties, { register INTERVAL i; Lisp_Object ostart, oend; + bool first_time = true; ostart = start; oend = end; @@ -1372,6 +1373,7 @@ set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object properties, return Qt; } + retry: i = validate_interval_range (object, &start, &end, soft); if (!i) @@ -1391,8 +1393,22 @@ set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object properties, return Qnil; } - if (BUFFERP (object) && !NILP (coherent_change_p)) - modify_text_properties (object, start, end); + if (BUFFERP (object) && !NILP (coherent_change_p) && first_time) + { + ptrdiff_t prev_length = LENGTH (i); + ptrdiff_t prev_pos = i->position; + + modify_text_properties (object, start, end); + /* If someone called us recursively as a side effect of + modify_text_properties, and changed the intervals behind our + back, we cannot continue with I, because its data changed. + So we restart the interval analysis anew. */ + if (LENGTH (i) != prev_length || i->position != prev_pos) + { + first_time = false; + goto retry; + } + } set_text_properties_1 (start, end, properties, object, i); commit e65ec81fc3e556719fae8d8b4b42f571c7e9f4fc Author: Tino Calancha Date: Thu Aug 2 13:20:46 2018 +0900 New commands to create an empty file Similarly as `create-directory', `dired-create-directory', the new commands create the parent dirs as needed (Bug#24150). * lisp/files.el (make-empty-file): New command. * lisp/dired-aux.el (dired-create-empty-file): New command. (dired--find-topmost-parent-dir): New function extracted from `dired-create-directory'. (dired-create-directory, dired-create-empty-file): Use it. * lisp/dired.el (dired-mode-map): Add menu entry for `dired-create-empty-file'. * doc/emacs/dired.texi (Misc Dired Features) * doc/lispref/files.texi (Create/Delete Dirs): Update manual. ; * etc/NEWS: Announce the changes. diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index 007a943714..1b03a3967a 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -1468,6 +1468,11 @@ rotation is lossless, and uses an external utility called directory's name, and creates that directory. It signals an error if the directory already exists. +@findex dired-create-empty-file + The command (@code{dired-create-empty-file}) reads a +file name, and creates that file. It signals an error if +the file already exists. + @cindex searching multiple files via Dired @kindex M-s a C-s @r{(Dired)} @kindex M-s a M-C-s @r{(Dired)} diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 068cf05443..25fabe1ea5 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -3005,10 +3005,16 @@ This command creates a directory named @var{dirname}. If @var{parents} is non-@code{nil}, as is always the case in an interactive call, that means to create the parent directories first, if they don't already exist. - @code{mkdir} is an alias for this. @end deffn +@deffn Command make-empty-file filename &optional parents +This command creates an empty file named @var{filename}. +As @code{make-directory}, this command creates parent directories +if @var{parents} is non-@code{nil}. +If @var{filename} already exists, this command signals an error. +@end deffn + @deffn Command copy-directory dirname newname &optional keep-time parents copy-contents This command copies the directory named @var{dirname} to @var{newname}. If @var{newname} is a directory name, diff --git a/etc/NEWS b/etc/NEWS index 6c79a46f24..6ccf6fc089 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -185,6 +185,9 @@ This triggers to search the program on the remote host as indicated by * Editing Changes in Emacs 27.1 ++++ +** New command 'make-empty-file'. + --- ** New variable 'x-wait-for-event-timeout'. This controls how long Emacs will wait for updates to the graphical @@ -222,6 +225,11 @@ navigation and editing of large files. * Changes in Specialized Modes and Packages in Emacs 27.1 ++++ +** Dired + +*** New command 'dired-create-empty-file'. + ** Change Logs and VC *** Recording ChangeLog entries doesn't require an actual file. diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 925a7d50d6..21ee50ce5c 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1989,6 +1989,19 @@ Optional arg HOW-TO determines how to treat the target. dired-dirs))) + +;; We use this function in `dired-create-directory' and +;; `dired-create-empty-file'; the return value is the new entry +;; in the updated Dired buffer. +(defun dired--find-topmost-parent-dir (filename) + "Return the topmost nonexistent parent dir of FILENAME. +FILENAME is a full file name." + (let ((try filename) new) + (while (and try (not (file-exists-p try)) (not (equal new try))) + (setq new try + try (directory-file-name (file-name-directory try)))) + new)) + ;;;###autoload (defun dired-create-directory (directory) "Create a directory called DIRECTORY. @@ -1997,18 +2010,32 @@ If DIRECTORY already exists, signal an error." (interactive (list (read-file-name "Create directory: " (dired-current-directory)))) (let* ((expanded (directory-file-name (expand-file-name directory))) - (try expanded) new) + new) (if (file-exists-p expanded) (error "Cannot create directory %s: file exists" expanded)) - ;; Find the topmost nonexistent parent dir (variable `new') - (while (and try (not (file-exists-p try)) (not (equal new try))) - (setq new try - try (directory-file-name (file-name-directory try)))) + (setq new (dired--find-topmost-parent-dir expanded)) (make-directory expanded t) (when new (dired-add-file new) (dired-move-to-filename)))) +;;;###autoload +(defun dired-create-empty-file (file) + "Create an empty file called FILE. + Add a new entry for the new file in the Dired buffer. + Parent directories of FILE are created as needed. + If FILE already exists, signal an error." + (interactive (list (read-file-name "Create empty file: "))) + (let* ((expanded (expand-file-name file)) + new) + (if (file-exists-p expanded) + (error "Cannot create file %s: file exists" expanded)) + (setq new (dired--find-topmost-parent-dir expanded)) + (make-empty-file file 'parents) + (when new + (dired-add-file new) + (dired-move-to-filename)))) + (defun dired-into-dir-with-symlinks (target) (and (file-directory-p target) (not (file-symlink-p target)))) diff --git a/lisp/dired.el b/lisp/dired.el index 1348df6934..26a7449e03 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1802,6 +1802,9 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." (define-key map [menu-bar immediate create-directory] '(menu-item "Create Directory..." dired-create-directory :help "Create a directory")) + (define-key map [menu-bar immediate create-empty-file] + '(menu-item "Create Empty file..." dired-create-empty-file + :help "Create an empty file")) (define-key map [menu-bar immediate wdired-mode] '(menu-item "Edit File Names" wdired-change-to-wdired-mode :help "Put a Dired buffer in a mode in which filenames are editable" diff --git a/lisp/files.el b/lisp/files.el index 6e4f6ca51b..8057def525 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5519,6 +5519,21 @@ raised." (dolist (dir create-list) (files--ensure-directory dir))))))) +(defun make-empty-file (filename &optional parents) + "Create an empty file FILENAME. +Optional arg PARENTS, if non-nil then creates parent dirs as needed. + +If called interactively, then PARENTS is non-nil." + (interactive + (let ((filename (read-file-name "Create empty file: "))) + (list filename t))) + (when (and (file-exists-p filename) (null parents)) + (signal 'file-already-exists `("File exists" ,filename))) + (let ((paren-dir (file-name-directory filename))) + (when (and paren-dir (not (file-exists-p paren-dir))) + (make-directory paren-dir parents))) + (write-region "" nil filename nil 0)) + (defconst directory-files-no-dot-files-regexp "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*" "Regexp matching any file name except \".\" and \"..\".") commit d216d7d248199aa6c99cd642116717c5b301ae6d Author: Paul Eggert Date: Wed Aug 1 18:53:31 2018 -0700 Substitute a on hosts lacking it * .gitignore: Add lib/ieee754.h. * admin/merge-gnulib (GNULIB_MODULES): Add ieee754-h. * configure.ac: Remove ieee754.h check, as Gnulib now does that. * etc/NEWS: Mention this. * lib/gnulib.mk.in, m4/gnulib-comp.m4: Regenerate. * lib/ieee754.in.h, m4/ieee754-h.m4: New files, from Gnulib. * src/lisp.h (IEEE_FLOATING_POINT): Now a macro so that it can be used in #if. * src/lread.c, src/print.c: Include if IEEE_FLOATING_POINT, not if HAVE_IEEE754_H. * src/lread.c (string_to_number): * src/print.c (float_to_string): Process NaNs only on IEEE hosts, and assume in that case. diff --git a/.gitignore b/.gitignore index d3712b0d6c..26fe4bb34e 100644 --- a/.gitignore +++ b/.gitignore @@ -57,6 +57,7 @@ lib/execinfo.h lib/fcntl.h lib/getopt.h lib/getopt-cdefs.h +lib/ieee754.h lib/inttypes.h lib/libgnu.a lib/limits.h diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 39dfaee8f4..1397ecfb9f 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -35,7 +35,7 @@ GNULIB_MODULES=' fcntl fcntl-h fdatasync fdopendir filemode filevercmp flexmember fpieee fstatat fsusage fsync getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog - ignore-value intprops largefile lstat + ieee754-h ignore-value intprops largefile lstat manywarnings memrchr minmax mkostemp mktime nstrftime pipe2 pselect pthread_sigmask putenv qcopy-acl readlink readlinkat sig2str socklen stat-time std-gnu11 stdalign stddef stdio diff --git a/configure.ac b/configure.ac index dbdcce7c8d..b6918671e4 100644 --- a/configure.ac +++ b/configure.ac @@ -1668,7 +1668,6 @@ fi dnl checks for header files AC_CHECK_HEADERS_ONCE( - ieee754.h linux/fs.h malloc.h sys/systeminfo.h diff --git a/etc/NEWS b/etc/NEWS index 9e7a765dc6..6c79a46f24 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -880,9 +880,9 @@ Formerly, some of these functions ignored signs and significands of NaNs. Now, all these functions treat NaN signs and significands as significant. For example, (eql 0.0e+NaN -0.0e+NaN) now returns nil because the two NaNs have different signs; formerly it returned t. -Also, on platforms that have Emacs now reads and prints -NaN significands; e.g., if X is a NaN, (format "%s" X) now returns -"0.0e+NaN", "1.0e+NaN", etc., depending on X's significand. +Also, Emacs now reads and prints NaN significands; e.g., if X is a +NaN, (format "%s" X) now returns "0.0e+NaN", "1.0e+NaN", etc., +depending on X's significand. +++ ** The function 'make-string' accepts an additional optional argument. diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index e623921091..7d28dcc62b 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -95,6 +95,7 @@ # gettime \ # gettimeofday \ # gitlog-to-changelog \ +# ieee754-h \ # ignore-value \ # intprops \ # largefile \ @@ -220,6 +221,7 @@ GL_GENERATE_ALLOCA_H = @GL_GENERATE_ALLOCA_H@ GL_GENERATE_BYTESWAP_H = @GL_GENERATE_BYTESWAP_H@ GL_GENERATE_ERRNO_H = @GL_GENERATE_ERRNO_H@ GL_GENERATE_EXECINFO_H = @GL_GENERATE_EXECINFO_H@ +GL_GENERATE_IEEE754_H = @GL_GENERATE_IEEE754_H@ GL_GENERATE_LIMITS_H = @GL_GENERATE_LIMITS_H@ GL_GENERATE_STDALIGN_H = @GL_GENERATE_STDALIGN_H@ GL_GENERATE_STDDEF_H = @GL_GENERATE_STDDEF_H@ @@ -646,6 +648,7 @@ HAVE_WINSOCK2_H = @HAVE_WINSOCK2_H@ HAVE_XSERVER = @HAVE_XSERVER@ HAVE__EXIT = @HAVE__EXIT@ HYBRID_MALLOC = @HYBRID_MALLOC@ +IEEE754_H = @IEEE754_H@ IMAGEMAGICK_CFLAGS = @IMAGEMAGICK_CFLAGS@ IMAGEMAGICK_LIBS = @IMAGEMAGICK_LIBS@ INCLUDE_NEXT = @INCLUDE_NEXT@ @@ -1787,6 +1790,32 @@ EXTRA_libgnu_a_SOURCES += group-member.c endif ## end gnulib module group-member +## begin gnulib module ieee754-h +ifeq (,$(OMIT_GNULIB_MODULE_ieee754-h)) + +BUILT_SOURCES += $(IEEE754_H) + +# We need the following in order to create when the system +# doesn't have one that works with the given compiler. +ifneq (,$(GL_GENERATE_IEEE754_H)) +ieee754.h: ieee754.in.h $(top_builddir)/config.status + $(AM_V_GEN)rm -f $@-t && \ + { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ + sed -e 's/ifndef _GL_GNULIB_HEADER/if 0/g' \ + $(srcdir)/ieee754.in.h; \ + } > $@-t && \ + mv -f $@-t $@ +else +ieee754.h: $(top_builddir)/config.status + rm -f $@ +endif +MOSTLYCLEANFILES += ieee754.h ieee754.h-t + +EXTRA_DIST += ieee754.in.h + +endif +## end gnulib module ieee754-h + ## begin gnulib module ignore-value ifeq (,$(OMIT_GNULIB_MODULE_ignore-value)) diff --git a/lib/ieee754.in.h b/lib/ieee754.in.h new file mode 100644 index 0000000000..316ac039af --- /dev/null +++ b/lib/ieee754.in.h @@ -0,0 +1,222 @@ +/* Copyright (C) 1992-2018 Free Software Foundation, Inc. + This file is part of the GNU C Library. + + The GNU C Library 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. + + The GNU C Library 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 the GNU C Library; if not, see + . */ + +#ifndef _IEEE754_H + +#define _IEEE754_H 1 + +#ifndef _GL_GNULIB_HEADER +/* Ordinary glibc usage. */ +# include +# include +#else +/* Gnulib usage. */ +# ifndef __BEGIN_DECLS +# ifdef __cplusplus +# define __BEGIN_DECLS extern "C" { +# define __END_DECLS } +# else +# define __BEGIN_DECLS +# define __END_DECLS +# endif +# endif +# ifndef __FLOAT_WORD_ORDER +# define __LITTLE_ENDIAN 1234 +# define __BIG_ENDIAN 4321 +# ifdef WORDS_BIGENDIAN +# define __BYTE_ORDER __BIG_ENDIAN +# else +# define __BYTE_ORDER __LITTLE_ENDIAN +# endif +# define __FLOAT_WORD_ORDER __BYTE_ORDER +# endif +#endif + +__BEGIN_DECLS + +union ieee754_float + { + float f; + + /* This is the IEEE 754 single-precision format. */ + struct + { +#if __BYTE_ORDER == __BIG_ENDIAN + unsigned int negative:1; + unsigned int exponent:8; + unsigned int mantissa:23; +#endif /* Big endian. */ +#if __BYTE_ORDER == __LITTLE_ENDIAN + unsigned int mantissa:23; + unsigned int exponent:8; + unsigned int negative:1; +#endif /* Little endian. */ + } ieee; + + /* This format makes it easier to see if a NaN is a signalling NaN. */ + struct + { +#if __BYTE_ORDER == __BIG_ENDIAN + unsigned int negative:1; + unsigned int exponent:8; + unsigned int quiet_nan:1; + unsigned int mantissa:22; +#endif /* Big endian. */ +#if __BYTE_ORDER == __LITTLE_ENDIAN + unsigned int mantissa:22; + unsigned int quiet_nan:1; + unsigned int exponent:8; + unsigned int negative:1; +#endif /* Little endian. */ + } ieee_nan; + }; + +#define IEEE754_FLOAT_BIAS 0x7f /* Added to exponent. */ + + +union ieee754_double + { + double d; + + /* This is the IEEE 754 double-precision format. */ + struct + { +#if __BYTE_ORDER == __BIG_ENDIAN + unsigned int negative:1; + unsigned int exponent:11; + /* Together these comprise the mantissa. */ + unsigned int mantissa0:20; + unsigned int mantissa1:32; +#endif /* Big endian. */ +#if __BYTE_ORDER == __LITTLE_ENDIAN +# if __FLOAT_WORD_ORDER == __BIG_ENDIAN + unsigned int mantissa0:20; + unsigned int exponent:11; + unsigned int negative:1; + unsigned int mantissa1:32; +# else + /* Together these comprise the mantissa. */ + unsigned int mantissa1:32; + unsigned int mantissa0:20; + unsigned int exponent:11; + unsigned int negative:1; +# endif +#endif /* Little endian. */ + } ieee; + + /* This format makes it easier to see if a NaN is a signalling NaN. */ + struct + { +#if __BYTE_ORDER == __BIG_ENDIAN + unsigned int negative:1; + unsigned int exponent:11; + unsigned int quiet_nan:1; + /* Together these comprise the mantissa. */ + unsigned int mantissa0:19; + unsigned int mantissa1:32; +#else +# if __FLOAT_WORD_ORDER == __BIG_ENDIAN + unsigned int mantissa0:19; + unsigned int quiet_nan:1; + unsigned int exponent:11; + unsigned int negative:1; + unsigned int mantissa1:32; +# else + /* Together these comprise the mantissa. */ + unsigned int mantissa1:32; + unsigned int mantissa0:19; + unsigned int quiet_nan:1; + unsigned int exponent:11; + unsigned int negative:1; +# endif +#endif + } ieee_nan; + }; + +#define IEEE754_DOUBLE_BIAS 0x3ff /* Added to exponent. */ + + +union ieee854_long_double + { + long double d; + + /* This is the IEEE 854 double-extended-precision format. */ + struct + { +#if __BYTE_ORDER == __BIG_ENDIAN + unsigned int negative:1; + unsigned int exponent:15; + unsigned int empty:16; + unsigned int mantissa0:32; + unsigned int mantissa1:32; +#endif +#if __BYTE_ORDER == __LITTLE_ENDIAN +# if __FLOAT_WORD_ORDER == __BIG_ENDIAN + unsigned int exponent:15; + unsigned int negative:1; + unsigned int empty:16; + unsigned int mantissa0:32; + unsigned int mantissa1:32; +# else + unsigned int mantissa1:32; + unsigned int mantissa0:32; + unsigned int exponent:15; + unsigned int negative:1; + unsigned int empty:16; +# endif +#endif + } ieee; + + /* This is for NaNs in the IEEE 854 double-extended-precision format. */ + struct + { +#if __BYTE_ORDER == __BIG_ENDIAN + unsigned int negative:1; + unsigned int exponent:15; + unsigned int empty:16; + unsigned int one:1; + unsigned int quiet_nan:1; + unsigned int mantissa0:30; + unsigned int mantissa1:32; +#endif +#if __BYTE_ORDER == __LITTLE_ENDIAN +# if __FLOAT_WORD_ORDER == __BIG_ENDIAN + unsigned int exponent:15; + unsigned int negative:1; + unsigned int empty:16; + unsigned int mantissa0:30; + unsigned int quiet_nan:1; + unsigned int one:1; + unsigned int mantissa1:32; +# else + unsigned int mantissa1:32; + unsigned int mantissa0:30; + unsigned int quiet_nan:1; + unsigned int one:1; + unsigned int exponent:15; + unsigned int negative:1; + unsigned int empty:16; +# endif +#endif + } ieee_nan; + }; + +#define IEEE854_LONG_DOUBLE_BIAS 0x3fff + +__END_DECLS + +#endif /* ieee754.h */ diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index a6e3be3815..494c77c7c4 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -101,6 +101,7 @@ AC_DEFUN([gl_EARLY], # Code from module gettimeofday: # Code from module gitlog-to-changelog: # Code from module group-member: + # Code from module ieee754-h: # Code from module ignore-value: # Code from module include_next: # Code from module intprops: @@ -295,6 +296,7 @@ AC_DEFUN([gl_INIT], gl_PREREQ_GETTIMEOFDAY fi gl_SYS_TIME_MODULE_INDICATOR([gettimeofday]) + gl_IEEE754_H gl_INTTYPES_INCOMPLETE AC_REQUIRE([gl_LARGEFILE]) gl_LIMITS_H @@ -895,6 +897,7 @@ AC_DEFUN([gl_FILE_LIST], [ lib/gettimeofday.c lib/gl_openssl.h lib/group-member.c + lib/ieee754.in.h lib/ignore-value.h lib/intprops.h lib/inttypes.in.h @@ -1017,6 +1020,7 @@ AC_DEFUN([gl_FILE_LIST], [ m4/gl-openssl.m4 m4/gnulib-common.m4 m4/group-member.m4 + m4/ieee754-h.m4 m4/include_next.m4 m4/inttypes.m4 m4/largefile.m4 diff --git a/m4/ieee754-h.m4 b/m4/ieee754-h.m4 new file mode 100644 index 0000000000..bf7c332e48 --- /dev/null +++ b/m4/ieee754-h.m4 @@ -0,0 +1,21 @@ +# Configure ieee754-h module + +dnl Copyright 2018 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +AC_DEFUN([gl_IEEE754_H], +[ + AC_REQUIRE([AC_C_BIGENDIAN]) + AC_CHECK_HEADERS_ONCE([ieee754.h]) + if test $ac_cv_header_ieee754_h = yes; then + IEEE754_H= + else + IEEE754_H=ieee754.h + AC_DEFINE([_GL_REPLACE_IEEE754_H], 1, + [Define to 1 if is missing.]) + fi + AC_SUBST([IEEE754_H]) + AM_CONDITIONAL([GL_GENERATE_IEEE754_H], [test -n "$IEEE754_H"]) +]) diff --git a/src/lisp.h b/src/lisp.h index 96de60e467..bdece817bd 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2670,17 +2670,14 @@ XFLOAT_DATA (Lisp_Object f) /* Most hosts nowadays use IEEE floating point, so they use IEC 60559 representations, have infinities and NaNs, and do not trap on - exceptions. Define IEEE_FLOATING_POINT if this host is one of the + exceptions. Define IEEE_FLOATING_POINT to 1 if this host is one of the typical ones. The C11 macro __STDC_IEC_559__ is close to what is wanted here, but is not quite right because Emacs does not require all the features of C11 Annex F (and does not require C11 at all, for that matter). */ -enum - { - IEEE_FLOATING_POINT - = (FLT_RADIX == 2 && FLT_MANT_DIG == 24 - && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128) - }; + +#define IEEE_FLOATING_POINT (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \ + && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128) /* A character, declared with the following typedef, is a member of some character set associated with the current buffer. */ diff --git a/src/lread.c b/src/lread.c index 290b0f6bbe..9a025d8664 100644 --- a/src/lread.c +++ b/src/lread.c @@ -72,7 +72,7 @@ along with GNU Emacs. If not, see . */ #define file_tell ftell #endif -#if HAVE_IEEE754_H +#if IEEE_FLOATING_POINT # include #endif @@ -3756,21 +3756,18 @@ string_to_number (char const *string, int base, int flags) cp += 3; value = INFINITY; } +#if IEEE_FLOATING_POINT else if (cp[-1] == '+' && cp[0] == 'N' && cp[1] == 'a' && cp[2] == 'N') { state |= E_EXP; cp += 3; -#if HAVE_IEEE754_H union ieee754_double u = { .ieee_nan = { .exponent = -1, .quiet_nan = 1, .mantissa0 = n >> 31 >> 1, .mantissa1 = n }}; value = u.d; -#else - /* NAN is a "positive" NaN on all known Emacs hosts. */ - value = NAN; -#endif } +#endif else cp = ecp; } diff --git a/src/print.c b/src/print.c index add21609cc..34c7fa12b6 100644 --- a/src/print.c +++ b/src/print.c @@ -40,7 +40,7 @@ along with GNU Emacs. If not, see . */ #include #include -#if HAVE_IEEE754_H +#if IEEE_FLOATING_POINT # include #endif @@ -1013,34 +1013,15 @@ float_to_string (char *buf, double data) strcpy (buf, minus_infinity_string + positive); return sizeof minus_infinity_string - 1 - positive; } +#if IEEE_FLOATING_POINT if (isnan (data)) { -#if HAVE_IEEE754_H union ieee754_double u = { .d = data }; uprintmax_t hi = u.ieee_nan.mantissa0; return sprintf (buf, &"-%"pMu".0e+NaN"[!u.ieee_nan.negative], (hi << 31 << 1) + u.ieee_nan.mantissa1); -#else - /* Prepend "-" if the NaN's sign bit is negative. - The sign bit of a double is the bit that is 1 in -0.0. */ - static char const NaN_string[] = "0.0e+NaN"; - int i; - union { double d; char c[sizeof (double)]; } u_data, u_minus_zero; - bool negative = 0; - u_data.d = data; - u_minus_zero.d = - 0.0; - for (i = 0; i < sizeof (double); i++) - if (u_data.c[i] & u_minus_zero.c[i]) - { - *buf = '-'; - negative = 1; - break; - } - - strcpy (buf + negative, NaN_string); - return negative + sizeof NaN_string - 1; -#endif } +#endif if (NILP (Vfloat_output_format) || !STRINGP (Vfloat_output_format)) commit 2f37ecaefcc61b0bf389f1c1eb3ac1b15105f056 Author: Michael Albinus Date: Wed Aug 1 23:09:31 2018 +0200 Fix Bug#32325 * lisp/net/tramp-sh.el (tramp-sh-handle-make-directory): In case of PARENTS flush also upper directories caches. (Bug#32325) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 2d253506dd..86e82d4092 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2547,7 +2547,11 @@ The method used must be an out-of-band method." "Like `make-directory' for Tramp files." (setq dir (expand-file-name dir)) (with-parsed-tramp-file-name dir nil - (tramp-flush-directory-properties v (file-name-directory localname)) + ;; When PARENTS is non-nil, DIR could be a chain of non-existent + ;; directories a/b/c/... Instead of checking, we simply flush the + ;; whole cache. + (tramp-flush-directory-properties + v (if parents "/" (file-name-directory localname))) (save-excursion (tramp-barf-unless-okay v (format "%s %s" commit df7371b84e9cfbb6e62c3196c2bc588eb934b835 Author: Gemini Lasswell Date: Fri Jul 20 21:54:00 2018 -0700 Fix Edebug spec for cl-macrolet (bug#29919) Add an Edebug matching function for cl-macrolet which keeps track of its bindings and treats them as macros without Edebug specs when found in the body of the expression. * lisp/emacs-lisp/edebug.el (edebug--cl-macrolet-defs): New variable. (edebug-list-form-args): Use it. (edebug--current-cl-macrolet-defs): New variable. (edebug-match-cl-macrolet-expr, edebug-match-cl-macrolet-name) (edebug-match-cl-macrolet-body): New functions. * lisp/emacs-lisp/cl-macs.el (cl-macrolet): Use cl-macrolet-expr for Edebug spec. * test/lisp/emacs-lisp/edebug-tests.el (edebug-tests-cl-macrolet): New test. * test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el (edebug-test-code-use-cl-macrolet): New function. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 011965acb5..d0d1c3b156 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2083,10 +2083,7 @@ This is like `cl-flet', but for macros instead of functions. \(fn ((NAME ARGLIST BODY...) ...) FORM...)" (declare (indent 1) - (debug - ((&rest (&define name (&rest arg) cl-declarations-or-string - def-body)) - cl-declarations body))) + (debug (cl-macrolet-expr))) (if (cdr bindings) `(cl-macrolet (,(car bindings)) (cl-macrolet ,(cdr bindings) ,@body)) (if (null bindings) (macroexp-progn body) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index e759c5b5b2..f0c0db182e 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -1198,6 +1198,8 @@ purpose by adding an entry to this alist, and setting (defvar edebug-inside-func) ;; whether code is inside function context. ;; Currently def-form sets this to nil; def-body sets it to t. +(defvar edebug--cl-macrolet-defs) ;; Fully defined below. + (defun edebug-interactive-p-name () ;; Return a unique symbol for the variable used to store the ;; status of interactive-p for this function. @@ -1463,6 +1465,11 @@ expressions; a `progn' form will be returned enclosing these forms." ;; Helper for edebug-list-form (let ((spec (get-edebug-spec head))) (cond + ;; Treat cl-macrolet bindings like macros with no spec. + ((member head edebug--cl-macrolet-defs) + (if edebug-eval-macro-args + (edebug-forms cursor) + (edebug-sexps cursor))) (spec (cond ((consp spec) @@ -1651,6 +1658,9 @@ expressions; a `progn' form will be returned enclosing these forms." ;; (function . edebug-match-function) (lambda-expr . edebug-match-lambda-expr) (cl-generic-method-args . edebug-match-cl-generic-method-args) + (cl-macrolet-expr . edebug-match-cl-macrolet-expr) + (cl-macrolet-name . edebug-match-cl-macrolet-name) + (cl-macrolet-body . edebug-match-cl-macrolet-body) (¬ . edebug-match-¬) (&key . edebug-match-&key) (place . edebug-match-place) @@ -1954,6 +1964,43 @@ expressions; a `progn' form will be returned enclosing these forms." (edebug-move-cursor cursor) (list args))) +(defvar edebug--cl-macrolet-defs nil + "List of symbols found within the bindings of enclosing `cl-macrolet' forms.") +(defvar edebug--current-cl-macrolet-defs nil + "List of symbols found within the bindings of the current `cl-macrolet' form.") + +(defun edebug-match-cl-macrolet-expr (cursor) + "Match a `cl-macrolet' form at CURSOR." + (let (edebug--current-cl-macrolet-defs) + (edebug-match cursor + '((&rest (&define cl-macrolet-name cl-macro-list + cl-declarations-or-string + def-body)) + cl-declarations cl-macrolet-body)))) + +(defun edebug-match-cl-macrolet-name (cursor) + "Match the name in a `cl-macrolet' binding at CURSOR. +Collect the names in `edebug--cl-macrolet-defs' where they +will be checked by `edebug-list-form-args' and treated as +macros without a spec." + (let ((name (edebug-top-element-required cursor "Expected name"))) + (when (not (symbolp name)) + (edebug-no-match cursor "Bad name:" name)) + ;; Change edebug-def-name to avoid conflicts with + ;; names at global scope. + (setq edebug-def-name (gensym "edebug-anon")) + (edebug-move-cursor cursor) + (push name edebug--current-cl-macrolet-defs) + (list name))) + +(defun edebug-match-cl-macrolet-body (cursor) + "Match the body of a `cl-macrolet' expression at CURSOR. +Put the definitions collected in `edebug--current-cl-macrolet-defs' +into `edebug--cl-macrolet-defs' which is checked in `edebug-list-form-args'." + (let ((edebug--cl-macrolet-defs (nconc edebug--current-cl-macrolet-defs + edebug--cl-macrolet-defs))) + (edebug-match-body cursor))) + (defun edebug-match-arg (cursor) ;; set the def-args bound in edebug-defining-form (let ((edebug-arg (edebug-top-element-required cursor "Expected arg"))) diff --git a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el index e86c2f1c1e..f3fc78d4e1 100644 --- a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el +++ b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el @@ -130,5 +130,12 @@ (let ((two 2) (three 3)) (cl-destructuring-bind (x . y) (cons two three) (+ x!x! y!y!)))) +(defun edebug-test-code-use-cl-macrolet (x) + (cl-macrolet ((wrap (func &rest args) + `(format "The result of applying %s to %s is %S" + ',func!func! ',args + ,(cons func args)))) + (wrap + 1 x))) + (provide 'edebug-test-code) ;;; edebug-test-code.el ends here diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index 85f6bd47db..7d780edf28 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -913,5 +913,16 @@ test and possibly others should be updated." "g" (should (equal edebug-tests-@-result 5))))) +(ert-deftest edebug-tests-cl-macrolet () + "Edebug can instrument `cl-macrolet' expressions. (Bug#29919)" + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "use-cl-macrolet" '(10) t) + (edebug-tests-run-kbd-macro + "@ SPC SPC" + (edebug-tests-should-be-at "use-cl-macrolet" "func") + (edebug-tests-should-match-result-in-messages "+") + "g" + (should (equal edebug-tests-@-result "The result of applying + to (1 x) is 11"))))) + (provide 'edebug-tests) ;;; edebug-tests.el ends here commit 22d463ed5ca262e1d8893b115c3f1237485fc7e0 Author: Stephen Berman Date: Wed Aug 1 14:42:57 2018 +0200 Fix todo-mode commands called on done items separator The done items separator is not reachable by todo-mode navigation commands, but it is e.g. by C-n and C-p. Ensure that invoking todo-mode commands with point on the separator does not result in unexpected results, errors or file corruption (bug#32343). * lisp/calendar/todo-mode.el (todo-insert-item--basic): Make copying item and inserting item "here" noops when invoked on done items separator. Consolidate error handling of these cases. Also restrict "here" insertion to valid positions in the current category, since this is simpler than the previous behavior of inserting as the first item, which was moreover undocumented, counterintuitive and superfluous. (todo-set-item-priority, todo-move-item, todo-item-done) (todo-item-start, todo-item-end): Make noops when invoked on done items separator. * test/lisp/calendar/todo-mode-tests.el: Require ert-x. (todo-test--insert-item): Add formal parameters of todo-insert-item--basic. (todo-test--done-items-separator): New function. (todo-test-done-items-separator01-bol) (todo-test-done-items-separator01-eol) (todo-test-done-items-separator02-bol) (todo-test-done-items-separator02-eol) (todo-test-done-items-separator03-bol) (todo-test-done-items-separator03-eol) (todo-test-done-items-separator04-bol) (todo-test-done-items-separator04-eol) (todo-test-done-items-separator05-bol) (todo-test-done-items-separator05-eol) (todo-test-done-items-separator06-bol) (todo-test-done-items-separator06-eol) (todo-test-done-items-separator07): New tests. diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index 5161ae8d66..80bea25acd 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -1860,15 +1860,18 @@ their associated keys and their effects." (region (eq where 'region)) (here (eq where 'here)) diary-item) - (when copy - (cond - ((not (eq major-mode 'todo-mode)) - (user-error "You must be in Todo mode to copy a todo item")) - ((todo-done-item-p) - (user-error "You cannot copy a done item as a new todo item")) - ((looking-at "^$") - (user-error "Point must be on a todo item to copy it"))) - (setq diary-item (todo-diary-item-p))) + (when (and arg here) + (user-error "Here insertion only valid in current category")) + (when (and (or copy here) + (or (not (eq major-mode 'todo-mode)) (todo-done-item-p) + (when copy (looking-at "^$")) + (save-excursion + (beginning-of-line) + ;; Point is on done items separator. + (looking-at todo-category-done)))) + (user-error (concat "Item " (if copy "copying" "insertion") + " is not valid here"))) + (when copy (setq diary-item (todo-diary-item-p))) (when region (let (use-empty-active-region) (unless (and todo-use-only-highlighted-region (use-region-p)) @@ -1876,7 +1879,6 @@ their associated keys and their effects." (let* ((obuf (current-buffer)) (ocat (todo-current-category)) (opoint (point)) - (todo-mm (eq major-mode 'todo-mode)) (cat+file (cond ((equal arg '(4)) (todo-read-category "Insert in category: ")) ((equal arg '(16)) @@ -1931,7 +1933,6 @@ their associated keys and their effects." (unless todo-global-current-todo-file (setq todo-global-current-todo-file todo-current-todo-file)) (let ((buffer-read-only nil) - (called-from-outside (not (and todo-mm (equal cat ocat)))) done-only item-added) (unless copy (setq new-item @@ -1955,14 +1956,8 @@ their associated keys and their effects." "\n\t" new-item nil nil 1))) (unwind-protect (progn - ;; Make sure the correct category is selected. There - ;; are two cases: (i) we just visited the file, so no - ;; category is selected yet, or (ii) we invoked - ;; insertion "here" from outside the category we want - ;; to insert in (with priority insertion, category - ;; selection is done by todo-set-item-priority). - (when (or (= (- (point-max) (point-min)) (buffer-size)) - (and here called-from-outside)) + ;; If we just visited the file, no category is selected yet. + (when (= (- (point-max) (point-min)) (buffer-size)) (todo-category-number cat) (todo-category-select)) ;; If only done items are displayed in category, @@ -1973,16 +1968,7 @@ their associated keys and their effects." (setq done-only t) (todo-toggle-view-done-only)) (if here - (progn - ;; If command was invoked with point in done - ;; items section or outside of the current - ;; category, can't insert "here", so to be - ;; useful give new item top priority. - (when (or (todo-done-item-section-p) - called-from-outside - done-only) - (goto-char (point-min))) - (todo-insert-with-overlays new-item)) + (todo-insert-with-overlays new-item) (todo-set-item-priority new-item cat t)) (setq item-added t)) ;; If user cancels before setting priority, restore @@ -2549,7 +2535,11 @@ whose value can be either of the symbols `raise' or `lower', meaning to raise or lower the item's priority by one." (interactive) (unless (and (or (called-interactively-p 'any) (memq arg '(raise lower))) - (or (todo-done-item-p) (looking-at "^$"))) + ;; Noop if point is not on a todo (i.e. not done) item. + (or (todo-done-item-p) (looking-at "^$") + ;; On done items separator. + (save-excursion (beginning-of-line) + (looking-at todo-category-done)))) (let* ((item (or item (todo-item-string))) (marked (todo-marked-item-p)) (cat (or cat (cond ((eq major-mode 'todo-mode) @@ -2697,9 +2687,13 @@ section in the category moved to." (interactive "P") (let* ((cat1 (todo-current-category)) (marked (assoc cat1 todo-categories-with-marks))) - ;; Noop if point is not on an item and there are no marked items. - (unless (and (looking-at "^$") - (not marked)) + (unless + ;; Noop if point is not on an item and there are no marked items. + (and (or (looking-at "^$") + ;; On done items separator. + (save-excursion (beginning-of-line) + (looking-at todo-category-done))) + (not marked)) (let* ((buffer-read-only) (file1 todo-current-todo-file) (item (todo-item-string)) @@ -2856,10 +2850,14 @@ visible." (let* ((cat (todo-current-category)) (marked (assoc cat todo-categories-with-marks))) (when marked (todo--user-error-if-marked-done-item)) - (unless (and (not marked) - (or (todo-done-item-p) - ;; Point is between todo and done items. - (looking-at "^$"))) + (unless + ;; Noop if point is not on a todo (i.e. not done) item and + ;; there are no marked items. + (and (or (todo-done-item-p) (looking-at "^$") + ;; On done items separator. + (save-excursion (beginning-of-line) + (looking-at todo-category-done))) + (not marked)) (let* ((date-string (calendar-date-string (calendar-current-date) t t)) (time-string (if todo-always-add-time-string (concat " " (substring (current-time-string) @@ -5132,6 +5130,8 @@ but the categories sexp differs from the current value of (forward-line) (looking-at (concat "^" (regexp-quote todo-category-done)))))) + ;; Point is on done items separator. + (save-excursion (beginning-of-line) (looking-at todo-category-done)) ;; Buffer is widened. (looking-at (regexp-quote todo-category-beg))) (goto-char (line-beginning-position)) @@ -5141,8 +5141,11 @@ but the categories sexp differs from the current value of (defun todo-item-end () "Move to end of current todo item and return its position." - ;; Items cannot end with a blank line. - (unless (looking-at "^$") + (unless (or + ;; Items cannot end with a blank line. + (looking-at "^$") + ;; Point is on done items separator. + (save-excursion (beginning-of-line) (looking-at todo-category-done))) (let* ((done (todo-done-item-p)) (to-lim nil) ;; For todo items, end is before the done items section, for done diff --git a/test/lisp/calendar/todo-mode-tests.el b/test/lisp/calendar/todo-mode-tests.el index 159294f816..325faeff51 100644 --- a/test/lisp/calendar/todo-mode-tests.el +++ b/test/lisp/calendar/todo-mode-tests.el @@ -25,6 +25,7 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'todo-mode) (defvar todo-test-data-dir @@ -561,11 +562,12 @@ source file is different." ;; Headers in the todo file are still hidden. (should (equal (overlay-get (todo-get-overlay 'header) 'display) ""))))) -(defun todo-test--insert-item (item &optional priority) +(defun todo-test--insert-item (item &optional priority + _arg diary-type date-type time where) "Insert string ITEM into current category with priority PRIORITY. -Use defaults for all other item insertion parameters. This -provides a noninteractive API for todo-insert-item for use in -automatic testing." +The remaining arguments (except _ARG, which is ignored) specify +item insertion parameters. This provides a noninteractive API +for todo-insert-item for use in automatic testing." (cl-letf (((symbol-function 'read-from-minibuffer) (lambda (_prompt) item)) ((symbol-function 'read-number) ; For todo-set-item-priority @@ -581,6 +583,186 @@ automatic testing." (todo-test--insert-item item 1) (should (equal (overlay-get (todo-get-overlay 'header) 'display) ""))))) +(defun todo-test--done-items-separator (&optional eol) + "Set up test of command interaction with done items separator. +With non-nil argument EOL, return the position at the end of the +separator, otherwise, return the position at the beginning." + (todo-test--show 1) + (goto-char (point-max)) + ;; See comment about recentering in todo-test-raise-lower-priority. + (set-window-buffer nil (current-buffer)) + (todo-toggle-view-done-items) + ;; FIXME: Point should now be on the first done item, and in batch + ;; testing it is, so we have to move back one line to the done items + ;; separator; but for some reason, in the graphical test + ;; environment, it stays on the last empty line of the todo items + ;; section, so there we have to advance one character to the done + ;; items separator. + (if (display-graphic-p) + (forward-char) + (forward-line -1)) + (if eol (forward-char))) + +(ert-deftest todo-test-done-items-separator01-bol () + "Test item copying and here insertion at BOL of separator. +Both should be user errors." + (with-todo-test + (todo-test--done-items-separator) + (let* ((copy-err "Item copying is not valid here") + (here-err "Item insertion is not valid here") + (insert-item-test (lambda (where) + (should-error (todo-insert-item--basic + nil nil nil nil where))))) + (should (string= copy-err (cadr (funcall insert-item-test 'copy)))) + (should (string= here-err (cadr (funcall insert-item-test 'here))))))) + +(ert-deftest todo-test-done-items-separator01-eol () + "Test item copying and here insertion at EOL of separator. +Both should be user errors." + (with-todo-test + (todo-test--done-items-separator 'eol) + (let* ((copy-err "Item copying is not valid here") + (here-err "Item insertion is not valid here") + (insert-item-test (lambda (where) + (should-error (todo-insert-item--basic + nil nil nil nil where))))) + (should (string= copy-err (cadr (funcall insert-item-test 'copy)))) + (should (string= here-err (cadr (funcall insert-item-test 'here))))))) + +(ert-deftest todo-test-done-items-separator02-bol () + "Test item editing commands at BOL of done items separator. +They should all be noops." + (with-todo-test + (todo-test--done-items-separator) + (should-not (todo-item-done)) + (should-not (todo-raise-item-priority)) + (should-not (todo-lower-item-priority)) + (should-not (called-interactively-p #'todo-set-item-priority)) + (should-not (called-interactively-p #'todo-move-item)) + (should-not (called-interactively-p #'todo-delete-item)) + (should-not (called-interactively-p #'todo-edit-item)))) + +(ert-deftest todo-test-done-items-separator02-eol () + "Test item editing command at EOL of done items separator. +They should all be noops." + (with-todo-test + (todo-test--done-items-separator 'eol) + (should-not (todo-item-done)) + (should-not (todo-raise-item-priority)) + (should-not (todo-lower-item-priority)) + (should-not (called-interactively-p #'todo-set-item-priority)) + (should-not (called-interactively-p #'todo-move-item)) + (should-not (called-interactively-p #'todo-delete-item)) + (should-not (called-interactively-p #'todo-edit-item)))) + +(ert-deftest todo-test-done-items-separator03-bol () + "Test item marking at BOL of done items separator. +This should be a noop, adding no marks to the category." + (with-todo-test + (todo-test--done-items-separator) + (call-interactively #'todo-toggle-mark-item) + (should-not (assoc (todo-current-category) todo-categories-with-marks)))) + +(ert-deftest todo-test-done-items-separator03-eol () + "Test item marking at EOL of done items separator. +This should be a noop, adding no marks to the category." + (with-todo-test + (todo-test--done-items-separator 'eol) + (call-interactively #'todo-toggle-mark-item) + (should-not (assoc (todo-current-category) todo-categories-with-marks)))) + +(ert-deftest todo-test-done-items-separator04-bol () + "Test moving to previous item from BOL of done items separator. +This should move point to the last not done todo item." + (with-todo-test + (todo-test--done-items-separator) + (let ((last-item (save-excursion + ;; Move to empty line after last todo item. + (forward-line -1) + (todo-previous-item) + (todo-item-string)))) + (should (string= last-item (save-excursion + (todo-previous-item) + (todo-item-string))))))) + +(ert-deftest todo-test-done-items-separator04-eol () + "Test moving to previous item from EOL of done items separator. +This should move point to the last not done todo item." + (with-todo-test + (todo-test--done-items-separator 'eol) + (let ((last-item (save-excursion + ;; Move to empty line after last todo item. + (forward-line -1) + (todo-previous-item) + (todo-item-string)))) + (should (string= last-item (save-excursion + (todo-previous-item) + (todo-item-string))))))) + +(ert-deftest todo-test-done-items-separator05-bol () + "Test moving to next item from BOL of done items separator. +This should move point to the first done todo item." + (with-todo-test + (todo-test--done-items-separator) + (let ((first-done (save-excursion + ;; Move to empty line after last todo item. + (forward-line -1) + (todo-next-item) + (todo-item-string)))) + (should (string= first-done (save-excursion + (todo-next-item) + (todo-item-string))))))) + +(ert-deftest todo-test-done-items-separator05-eol () + "Test moving to next item from EOL of done items separator. +This should move point to the first done todo item." + (with-todo-test + (todo-test--done-items-separator 'eol) + (let ((first-done (save-excursion + ;; Move to empty line after last todo item. + (forward-line -1) + (todo-next-item) + (todo-item-string)))) + (should (string= first-done (save-excursion + (todo-next-item) + (todo-item-string))))))) + +;; Item highlighting uses hl-line-mode, which enables highlighting in +;; post-command-hook. For some reason, in the test environment, the +;; hook function is not automatically run, so after enabling item +;; highlighting, use ert-simulate-command around the next command, +;; which explicitly runs the hook function. +(ert-deftest todo-test-done-items-separator06-bol () + "Test enabling item highlighting at BOL of done items separator. +Subsequently moving to an item should show it highlighted." + (with-todo-test + (todo-test--done-items-separator) + (call-interactively #'todo-toggle-item-highlighting) + (ert-simulate-command '(todo-previous-item)) + (should (eq 'hl-line (get-char-property (point) 'face))))) + +(ert-deftest todo-test-done-items-separator06-eol () + "Test enabling item highlighting at EOL of done items separator. +Subsequently moving to an item should show it highlighted." + (with-todo-test + (todo-test--done-items-separator 'eol) + (todo-toggle-item-highlighting) + (forward-line -1) + (ert-simulate-command '(todo-previous-item)) + (should (eq 'hl-line (get-char-property (point) 'face))))) + +(ert-deftest todo-test-done-items-separator07 () + "Test item highlighting when crossing done items separator. +The highlighting should remain enabled." + (with-todo-test + (todo-test--done-items-separator) + (todo-previous-item) + (todo-toggle-item-highlighting) + (todo-next-item) ; Now on empty line above separator. + (forward-line) ; Now on separator. + (ert-simulate-command '(forward-line)) ; Now on first done item. + (should (eq 'hl-line (get-char-property (point) 'face))))) + (provide 'todo-mode-tests) ;;; todo-mode-tests.el ends here commit cabe9e5126bfed05643d595589031cce8a404255 Author: Glenn Morris Date: Wed Aug 1 07:33:38 2018 -0400 ; Auto-commit of loaddefs files. diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 5f26eba695..3bd775f515 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -176,12 +176,18 @@ Optional arg BUFFER-FILE overrides `buffer-file-name'. \(fn &optional FILE-NAME BUFFER-FILE)" nil nil) (autoload 'add-change-log-entry "add-log" "\ -Find change log file, and add an entry for today and an item for this file. -Optional arg WHOAMI (interactive prefix) non-nil means prompt for user -name and email (stored in `add-log-full-name' and `add-log-mailing-address'). - -Second arg FILE-NAME is file name of the change log. -If nil, use the value of `change-log-default-name'. +Find ChangeLog buffer, add an entry for today and an item for this file. +Optional arg WHOAMI (interactive prefix) non-nil means prompt for +user name and email (stored in `add-log-full-name' +and `add-log-mailing-address'). + +Second arg CHANGELOG-FILE-NAME is the file name of the change log. +If nil, use the value of `change-log-default-name'. If the file +thus named exists, it is used for the new entry. If it doesn't +exist, it is created, unless `add-log-dont-create-changelog-file' is t, +in which case a suitably named buffer that doesn't visit any file +is used for keeping entries pertaining to CHANGELOG-FILE-NAME's +directory. Third arg OTHER-WINDOW non-nil means visit in other window. @@ -204,7 +210,7 @@ notices. Today's date is calculated according to `add-log-time-zone-rule' if non-nil, otherwise in local time. -\(fn &optional WHOAMI FILE-NAME OTHER-WINDOW NEW-ENTRY PUT-NEW-ENTRY-ON-NEW-LINE)" t nil) +\(fn &optional WHOAMI CHANGELOG-FILE-NAME OTHER-WINDOW NEW-ENTRY PUT-NEW-ENTRY-ON-NEW-LINE)" t nil) (autoload 'add-change-log-entry-other-window "add-log" "\ Find change log file in other window and add entry and item. @@ -577,9 +583,11 @@ Return t if `allout-mode' is active in current buffer. (autoload 'allout-mode "allout" "\ Toggle Allout outline mode. -With a prefix argument ARG, enable Allout outline mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Allout mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. \\ Allout outline mode is a minor mode that provides extensive @@ -890,9 +898,11 @@ See `allout-widgets-mode' for allout widgets mode features.") (autoload 'allout-widgets-mode "allout-widgets" "\ Toggle Allout Widgets mode. -With a prefix argument ARG, enable Allout Widgets mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Allout-Widgets mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. Allout Widgets mode is an extension of Allout mode that provides graphical decoration of outline structure. It is meant to @@ -1300,7 +1310,12 @@ Entering array mode calls the function `array-mode-hook'. (autoload 'artist-mode "artist" "\ Toggle Artist mode. -With argument ARG, turn Artist mode on if ARG is positive. + +If called interactively, enable Artist mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. + Artist lets you draw lines, squares, rectangles and poly-lines, ellipses and circles with your mouse and/or keyboard. @@ -1571,9 +1586,6 @@ for a description of this minor mode.") (autoload 'autoarg-mode "autoarg" "\ Toggle Autoarg mode, a global minor mode. -With a prefix argument ARG, enable Autoarg mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. \\ In Autoarg mode, digits are bound to `digit-argument', i.e. they @@ -1607,9 +1619,11 @@ or call the function `autoarg-kp-mode'.") (autoload 'autoarg-kp-mode "autoarg" "\ Toggle Autoarg-KP mode, a global minor mode. -With a prefix argument ARG, enable Autoarg-KP mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Autoarg-Kp mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. \\ This is similar to `autoarg-mode' but rebinds the keypad keys @@ -1663,9 +1677,11 @@ or call the function `auto-insert-mode'.") (autoload 'auto-insert-mode "autoinsert" "\ Toggle Auto-insert mode, a global minor mode. -With a prefix argument ARG, enable Auto-insert mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Auto-Insert mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. When Auto-insert mode is enabled, when new files are created you can insert a template for the file depending on the mode of the buffer. @@ -1735,9 +1751,11 @@ should be non-nil). (autoload 'auto-revert-mode "autorevert" "\ Toggle reverting buffer when the file changes (Auto-Revert Mode). -With a prefix argument ARG, enable Auto-Revert Mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Auto-Revert mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. Auto-Revert Mode is a minor mode that affects only the current buffer. When enabled, it reverts the buffer when the file on @@ -1762,9 +1780,11 @@ This function is designed to be added to hooks, for example: (autoload 'auto-revert-tail-mode "autorevert" "\ Toggle reverting tail of buffer when the file grows. -With a prefix argument ARG, enable Auto-Revert Tail Mode if ARG -is positive, and disable it otherwise. If called from Lisp, -enable the mode if ARG is omitted or nil. + +If called interactively, enable Auto-Revert-Tail mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. When Auto-Revert Tail Mode is enabled, the tail of the file is constantly followed, as with the shell command `tail -f'. This @@ -1803,9 +1823,11 @@ or call the function `global-auto-revert-mode'.") (autoload 'global-auto-revert-mode "autorevert" "\ Toggle Global Auto-Revert Mode. -With a prefix argument ARG, enable Global Auto-Revert Mode if ARG -is positive, and disable it otherwise. If called from Lisp, -enable the mode if ARG is omitted or nil. + +If called interactively, enable Global Auto-Revert mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. Global Auto-Revert Mode is a global minor mode that reverts any buffer associated with a file when the file changes on disk. Use @@ -1921,9 +1943,11 @@ or call the function `display-battery-mode'.") (autoload 'display-battery-mode "battery" "\ Toggle battery status display in mode line (Display Battery mode). -With a prefix argument ARG, enable Display Battery mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Display-Battery mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. The text displayed in the mode line is controlled by `battery-mode-line-format' and `battery-status-function'. @@ -2331,7 +2355,7 @@ BOOKMARK is usually a bookmark name (a string). It can also be a bookmark record, but this is usually only done by programmatic callers. If DISPLAY-FUNC is non-nil, it is a function to invoke to display the -bookmark. It defaults to `switch-to-buffer'. A typical value for +bookmark. It defaults to `pop-to-buffer-same-window'. A typical value for DISPLAY-FUNC would be `switch-to-buffer-other-window'. \(fn BOOKMARK &optional DISPLAY-FUNC)" t nil) @@ -2897,15 +2921,22 @@ columns on its right towards the left. (autoload 'bug-reference-mode "bug-reference" "\ Toggle hyperlinking bug references in the buffer (Bug Reference mode). -With a prefix argument ARG, enable Bug Reference mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Bug-Reference mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. \(fn &optional ARG)" t nil) (autoload 'bug-reference-prog-mode "bug-reference" "\ Like `bug-reference-mode', but only buttonize in comments and strings. +If called interactively, enable Bug-Reference-Prog mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. + \(fn &optional ARG)" t nil) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bug-reference" '("bug-reference-"))) @@ -4691,9 +4722,11 @@ Prefix argument is the same as for `checkdoc-defun' (autoload 'checkdoc-minor-mode "checkdoc" "\ Toggle automatic docstring checking (Checkdoc minor mode). -With a prefix argument ARG, enable Checkdoc minor mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Checkdoc minor mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. In Checkdoc minor mode, the usual bindings for `eval-defun' which is bound to \\\\[checkdoc-eval-defun] and `checkdoc-eval-current-buffer' are overridden to include @@ -4933,6 +4966,11 @@ This can be needed when using code byte-compiled using the old macro-expansion of `cl-defstruct' that used vectors objects instead of record objects. +If called interactively, enable Cl-Old-Struct-Compat mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. + \(fn &optional ARG)" t nil) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cl-lib" '("cl-"))) @@ -5150,7 +5188,7 @@ REGEXP-GROUP is the regular expression group in REGEXP to use. \(fn PROCESS COMMAND REGEXP REGEXP-GROUP)" nil nil) -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "comint" '("comint-" "send-invisible" "shell-strip-ctrl-m"))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "comint" '("comint-"))) ;;;*** @@ -5346,9 +5384,11 @@ Runs `compilation-mode-hook' with `run-mode-hooks' (which see). (autoload 'compilation-shell-minor-mode "compile" "\ Toggle Compilation Shell minor mode. -With a prefix argument ARG, enable Compilation Shell minor mode -if ARG is positive, and disable it otherwise. If called from -Lisp, enable the mode if ARG is omitted or nil. + +If called interactively, enable Compilation-Shell minor mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. When Compilation Shell minor mode is enabled, all the error-parsing commands of the Compilation major mode are @@ -5359,9 +5399,11 @@ See `compilation-mode'. (autoload 'compilation-minor-mode "compile" "\ Toggle Compilation minor mode. -With a prefix argument ARG, enable Compilation minor mode if ARG -is positive, and disable it otherwise. If called from Lisp, -enable the mode if ARG is omitted or nil. + +If called interactively, enable Compilation minor mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. When Compilation minor mode is enabled, all the error-parsing commands of Compilation major mode are available. See @@ -5394,9 +5436,11 @@ or call the function `dynamic-completion-mode'.") (autoload 'dynamic-completion-mode "completion" "\ Toggle dynamic word-completion on or off. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. + +If called interactively, enable Dynamic-Completion mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. \(fn &optional ARG)" t nil) @@ -5959,9 +6003,11 @@ or call the function `cua-mode'.") (autoload 'cua-mode "cua-base" "\ Toggle Common User Access style editing (CUA mode). -With a prefix argument ARG, enable CUA mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. + +If called interactively, enable Cua mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. CUA mode is a global minor mode. When enabled, typed text replaces the active selection, and you can use C-z, C-x, C-c, and @@ -6006,6 +6052,11 @@ Enable CUA selection mode without the C-z/C-x/C-c/C-v bindings. Toggle the region as rectangular. Activates the region if needed. Only lasts until the region is deactivated. +If called interactively, enable Cua-Rectangle-Mark mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. + \(fn &optional ARG)" t nil) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cua-rect" '("cua-"))) @@ -6021,6 +6072,11 @@ Activates the region if needed. Only lasts until the region is deactivated. (autoload 'cursor-intangible-mode "cursor-sensor" "\ Keep cursor outside of any `cursor-intangible' text property. +If called interactively, enable Cursor-Intangible mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. + \(fn &optional ARG)" t nil) (autoload 'cursor-sensor-mode "cursor-sensor" "\ @@ -6031,6 +6087,11 @@ where WINDOW is the affected window, OLDPOS is the last known position of the cursor and DIR can be `entered' or `left' depending on whether the cursor is entering the area covered by the text-property property or leaving it. +If called interactively, enable Cursor-Sensor mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. + \(fn &optional ARG)" t nil) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cursor-sensor" '("cursor-sensor-"))) @@ -6421,16 +6482,17 @@ Mode used for cvs status output. (autoload 'cwarn-mode "cwarn" "\ Minor mode that highlights suspicious C and C++ constructions. +If called interactively, enable Cwarn mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. + Suspicious constructs are highlighted using `font-lock-warning-face'. Note, in addition to enabling this minor mode, the major mode must be included in the variable `cwarn-configuration'. By default C and C++ modes are included. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. - \(fn &optional ARG)" t nil) (define-obsolete-function-alias 'turn-on-cwarn-mode 'cwarn-mode "24.1") @@ -6849,12 +6911,11 @@ or call the function `delete-selection-mode'.") (autoload 'delete-selection-mode "delsel" "\ Toggle Delete Selection mode. -Interactively, with a prefix argument, enable -Delete Selection mode if the prefix argument is positive, -and disable it otherwise. If called from Lisp, toggle -the mode if ARG is `toggle', disable the mode if ARG is -a non-positive integer, and enable the mode otherwise -\(including if ARG is omitted or nil or a positive integer). + +If called interactively, enable Delete-Selection mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. When Delete Selection mode is enabled, typed text replaces the selection if the selection is active. Otherwise, typed text is just inserted at @@ -7006,9 +7067,11 @@ or call the function `desktop-save-mode'.") (autoload 'desktop-save-mode "desktop" "\ Toggle desktop saving (Desktop Save mode). -With a prefix argument ARG, enable Desktop Save mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode if ARG -is omitted or nil. + +If called interactively, enable Desktop-Save mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. When Desktop Save mode is enabled, the state of Emacs is saved from one session to another. In particular, Emacs will save the desktop when @@ -7371,9 +7434,11 @@ a diff with \\[diff-reverse-direction]. (autoload 'diff-minor-mode "diff-mode" "\ Toggle Diff minor mode. -With a prefix argument ARG, enable Diff minor mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Diff minor mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. \\{diff-minor-mode-map} @@ -7549,9 +7614,11 @@ Keybindings: (autoload 'dirtrack-mode "dirtrack" "\ Toggle directory tracking in shell buffers (Dirtrack mode). -With a prefix argument ARG, enable Dirtrack mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Dirtrack mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. This method requires that your shell prompt contain the current working directory at all times, and that you set the variable @@ -7723,6 +7790,11 @@ in `.emacs'. Toggle display of line numbers in the buffer. This uses `display-line-numbers' internally. +If called interactively, enable Display-Line-Numbers mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. + To change the type of line numbers displayed by default, customize `display-line-numbers-type'. To change the type while the mode is on, set `display-line-numbers' directly. @@ -7856,9 +7928,11 @@ to the next best mode. (autoload 'doc-view-minor-mode "doc-view" "\ Toggle displaying buffer via Doc View (Doc View minor mode). -With a prefix argument ARG, enable Doc View minor mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Doc-View minor mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. See the command `doc-view-mode' for more information on this mode. @@ -7918,9 +7992,11 @@ Switch to *doctor* buffer and start giving psychotherapy. (autoload 'double-mode "double" "\ Toggle special insertion on double keypresses (Double mode). -With a prefix argument ARG, enable Double mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Double mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. When Double mode is enabled, some keys will insert different strings when pressed twice. See `double-map' for details. @@ -7975,7 +8051,9 @@ non-positive integer, and enables the mode otherwise (including if the argument is omitted or nil or a positive integer). If DOC is nil, give the mode command a basic doc-string -documenting what its argument does. +documenting what its argument does. If the word \"ARG\" does not +appear in DOC, a paragraph is added to DOC explaining +usage of the mode argument. Optional INIT-VALUE is the initial value of the mode's variable. Optional LIGHTER is displayed in the mode line when the mode is on. @@ -8785,9 +8863,11 @@ or call the function `global-ede-mode'.") (autoload 'global-ede-mode "ede" "\ Toggle global EDE (Emacs Development Environment) mode. -With a prefix argument ARG, enable global EDE mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Global Ede mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. This global minor mode enables `ede-minor-mode' in all buffers in an EDE controlled project. @@ -9797,9 +9877,11 @@ or call the function `electric-pair-mode'.") (autoload 'electric-pair-mode "elec-pair" "\ Toggle automatic parens pairing (Electric Pair mode). -With a prefix argument ARG, enable Electric Pair mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Electric-Pair mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. Electric Pair mode is a global minor mode. When enabled, typing an open parenthesis automatically inserts the corresponding @@ -9814,6 +9896,11 @@ To toggle the mode in a single buffer, use `electric-pair-local-mode'. (autoload 'electric-pair-local-mode "elec-pair" "\ Toggle `electric-pair-mode' only in this buffer. +If called interactively, enable Electric-Pair-Local mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. + \(fn &optional ARG)" t nil) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "elec-pair" '("electric-pair-"))) @@ -10053,9 +10140,7 @@ displayed. (autoload 'emacs-lock-mode "emacs-lock" "\ Toggle Emacs Lock mode in the current buffer. If called with a plain prefix argument, ask for the locking mode -to be used. With any other prefix ARG, turn mode on if ARG is -positive, off otherwise. If called from Lisp, enable the mode if -ARG is omitted or nil. +to be used. Initially, if the user does not pass an explicit locking mode, it defaults to `emacs-lock-default-locking-mode' (which see); @@ -10070,6 +10155,9 @@ When called from Elisp code, ARG can be any locking mode: Other values are interpreted as usual. +See also `emacs-lock-unlockable-modes', which exempts buffers under +some major modes from being locked under some circumstances. + \(fn &optional ARG)" t nil) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "emacs-lock" '("emacs-lock-" "toggle-emacs-lock"))) @@ -10161,9 +10249,10 @@ Minor mode for editing text/enriched files. These are files with embedded formatting information in the MIME standard text/enriched format. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. +If called interactively, enable Enriched mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. Turning the mode on or off runs `enriched-mode-hook'. @@ -10432,9 +10521,11 @@ Encrypt marked files. (autoload 'epa-mail-mode "epa-mail" "\ A minor-mode for composing encrypted/clearsigned mails. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. + +If called interactively, enable epa-mail mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. \(fn &optional ARG)" t nil) @@ -10497,9 +10588,11 @@ or call the function `epa-global-mail-mode'.") (autoload 'epa-global-mail-mode "epa-mail" "\ Minor mode to hook EasyPG into Mail mode. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. + +If called interactively, enable Epa-Global-Mail mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. \(fn &optional ARG)" t nil) @@ -10545,8 +10638,13 @@ Return a list of internal configuration parameters of `epg-gpg-program'. (autoload 'epg-check-configuration "epg-config" "\ Verify that a sufficient version of GnuPG is installed. +CONFIG should be a `epg-configuration' object (a plist). +REQ-VERSIONS should be a list with elements of the form (MIN +. MAX) where MIN and MAX are version strings indicating a +semi-open range of acceptable versions. REQ-VERSIONS may also be +a single minimum version string. -\(fn CONFIG &optional MINIMUM-VERSION)" nil nil) +\(fn CONFIG &optional REQ-VERSIONS)" nil nil) (autoload 'epg-expand-group "epg-config" "\ Look at CONFIG and try to expand GROUP. @@ -12087,10 +12185,14 @@ a top-level keymap, `text-scale-increase' or (autoload 'buffer-face-mode "face-remap" "\ Minor mode for a buffer-specific default face. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. When enabled, the face specified by the -variable `buffer-face-mode-face' is used to display the buffer text. + +If called interactively, enable Buffer-Face mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. + +When enabled, the face specified by the variable +`buffer-face-mode-face' is used to display the buffer text. \(fn &optional ARG)" t nil) @@ -12972,9 +13074,11 @@ region is invalid. (autoload 'flymake-mode "flymake" "\ Toggle Flymake mode on or off. -With a prefix argument ARG, enable Flymake mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. + +If called interactively, enable Flymake mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. Flymake is an Emacs minor mode for on-the-fly syntax checking. Flymake collects diagnostic information from multiple sources, @@ -13060,9 +13164,11 @@ Turn on `flyspell-mode' for comments and strings. (autoload 'flyspell-mode "flyspell" "\ Toggle on-the-fly spell checking (Flyspell mode). -With a prefix argument ARG, enable Flyspell mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Flyspell mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. Flyspell mode is a buffer-local minor mode. When enabled, it spawns a single Ispell process and checks each word. The default @@ -13110,6 +13216,9 @@ Turn Flyspell mode off. (autoload 'flyspell-region "flyspell" "\ Flyspell text between BEG and END. +Make sure `flyspell-mode' is turned on if you want the highlight +of a misspelled word removed when you've corrected it. + \(fn BEG END)" t nil) (autoload 'flyspell-buffer "flyspell" "\ @@ -13144,9 +13253,11 @@ Turn off Follow mode. Please see the function `follow-mode'. (autoload 'follow-mode "follow" "\ Toggle Follow mode. -With a prefix argument ARG, enable Follow mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Follow mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. Follow mode is a minor mode that combines windows into one tall virtual window. This is accomplished by two main techniques: @@ -13267,9 +13378,11 @@ selected if the original window is the first one in the frame. (autoload 'footnote-mode "footnote" "\ Toggle Footnote mode. -With a prefix argument ARG, enable Footnote mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Footnote mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. Footnote mode is a buffer-local minor mode. If enabled, it provides footnote support for `message-mode'. To get started, @@ -13691,6 +13804,11 @@ being transferred. This list may grow up to a size of `gdb-debug-log-max' after which the oldest element (at the end of the list) is deleted every time a new one is added (at the front). +If called interactively, enable Gdb-Enable-Debug mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. + \(fn &optional ARG)" t nil) (autoload 'gdb "gdb-mi" "\ @@ -13859,10 +13977,14 @@ regular expression that can be used as an element of (autoload 'glasses-mode "glasses" "\ Minor mode for making identifiers likeThis readable. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. When this mode is active, it tries to -add virtual separators (like underscores) at places they belong to. + +If called interactively, enable Glasses mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. + +When this mode is active, it tries to add virtual +separators (like underscores) at places they belong to. \(fn &optional ARG)" t nil) @@ -14469,6 +14591,11 @@ If FORCE is non-nil, replace the old ones. (autoload 'gnus-mailing-list-mode "gnus-ml" "\ Minor mode for providing mailing-list commands. +If called interactively, enable Gnus-Mailing-List mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. + \\{gnus-mailing-list-mode-map} \(fn &optional ARG)" t nil) @@ -14889,7 +15016,14 @@ number with fewer than this number of bits, the handshake is rejected. (The smaller the prime number, the less secure the key exchange is against man-in-the-middle attacks.) -A value of nil says to use the default GnuTLS value.") +A value of nil says to use the default GnuTLS value. + +The default value of this variable is such that virtually any +connection can be established, whether this connection can be +considered cryptographically \"safe\" or not. However, Emacs +network security is handled at a higher level via +`open-network-stream' and the Network Security Manager. See Info +node `(emacs) Network Security'.") (custom-autoload 'gnutls-min-prime-bits "gnutls" t) @@ -14951,15 +15085,22 @@ Also fontifies the buffer appropriately (see `goto-address-fontify-p' and (autoload 'goto-address-mode "goto-addr" "\ Minor mode to buttonize URLs and e-mail addresses in the current buffer. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. + +If called interactively, enable Goto-Address mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. \(fn &optional ARG)" t nil) (autoload 'goto-address-prog-mode "goto-addr" "\ Like `goto-address-mode', but only for comments and strings. +If called interactively, enable Goto-Address-Prog mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. + \(fn &optional ARG)" t nil) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "goto-addr" '("goto-address-"))) @@ -15017,7 +15158,7 @@ List of hook functions run by `grep-process-setup' (see `run-hooks').") (custom-autoload 'grep-setup-hook "grep" t) -(defconst grep-regexp-alist `((,(concat "^\\(?:" "\\(?1:[^\0\n]+\\)\\(?3:\0\\)\\(?2:[0-9]+\\):" "\\|" "\\(?1:[^\n:]+?[^\n/:]\\):[\11 ]*\\(?2:[1-9][0-9]*\\)[\11 ]*:" "\\)") 1 2 (,(lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face 'grep-match-face))) (when mbeg (- mbeg beg))))) \, (lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face 'grep-match-face)) (mend (and mbeg (next-single-property-change mbeg 'font-lock-face nil end)))) (when mend (- mend beg)))))) nil nil (3 '(face nil display ":"))) ("^Binary file \\(.+\\) matches$" 1 nil nil 0 1)) "\ +(defconst grep-regexp-alist `((,(concat "^\\(?:" "\\(?1:[^\0\n]+\\)\\(?3:\0\\)\\(?2:[0-9]+\\):" "\\|" "\\(?1:" "\\(?:[a-zA-Z]:\\)?" "[^\n:]+?[^\n/:]\\):[\11 ]*\\(?2:[1-9][0-9]*\\)[\11 ]*:" "\\)") 1 2 (,(lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face 'grep-match-face))) (when mbeg (- mbeg beg))))) \, (lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face 'grep-match-face)) (mend (and mbeg (next-single-property-change mbeg 'font-lock-face nil end)))) (when mend (- mend beg)))))) nil nil (3 '(face nil display ":"))) ("^Binary file \\(.+\\) matches$" 1 nil nil 0 1)) "\ Regexp used to match grep hits. See `compilation-error-regexp-alist' for format details.") @@ -15259,9 +15400,11 @@ or call the function `gud-tooltip-mode'.") (autoload 'gud-tooltip-mode "gud" "\ Toggle the display of GUD tooltips. -With a prefix argument ARG, enable the feature if ARG is -positive, and disable it otherwise. If called from Lisp, enable -it if ARG is omitted or nil. + +If called interactively, enable Gud-Tooltip mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. \(fn &optional ARG)" t nil) @@ -15944,9 +16087,11 @@ This discards the buffer's undo information. (autoload 'hi-lock-mode "hi-lock" "\ Toggle selective highlighting of patterns (Hi Lock mode). -With a prefix argument ARG, enable Hi Lock mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Hi-Lock mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. Hi Lock mode is automatically enabled when you invoke any of the highlighting commands listed below, such as \\[highlight-regexp]. @@ -16114,9 +16259,11 @@ be found in variable `hi-lock-interactive-patterns'. (autoload 'hide-ifdef-mode "hideif" "\ Toggle features to hide/show #ifdef blocks (Hide-Ifdef mode). -With a prefix argument ARG, enable Hide-Ifdef mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Hide-Ifdef mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. Hide-Ifdef mode is a buffer-local minor mode for use with C and C-like major modes. When enabled, code within #ifdef constructs @@ -16191,9 +16338,11 @@ whitespace. Case does not matter.") (autoload 'hs-minor-mode "hideshow" "\ Minor mode to selectively hide/show code and comment blocks. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. + +If called interactively, enable Hs minor mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. When hideshow minor mode is on, the menu bar is augmented with hideshow commands and the hideshow commands are enabled. @@ -16227,9 +16376,11 @@ Unconditionally turn off `hs-minor-mode'. (autoload 'highlight-changes-mode "hilit-chg" "\ Toggle highlighting changes in this buffer (Highlight Changes mode). -With a prefix argument ARG, enable Highlight Changes mode if ARG -is positive, and disable it otherwise. If called from Lisp, -enable the mode if ARG is omitted or nil. + +If called interactively, enable Highlight-Changes mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. When Highlight Changes is enabled, changes are marked with a text property. Normally they are displayed in a distinctive face, but @@ -16250,9 +16401,11 @@ buffer with the contents of a file (autoload 'highlight-changes-visible-mode "hilit-chg" "\ Toggle visibility of highlighting due to Highlight Changes mode. -With a prefix argument ARG, enable Highlight Changes Visible mode -if ARG is positive, and disable it otherwise. If called from -Lisp, enable the mode if ARG is omitted or nil. + +If called interactively, enable Highlight-Changes-Visible mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. Highlight Changes Visible mode only has an effect when Highlight Changes mode is on. When enabled, the changed text is displayed @@ -16395,9 +16548,11 @@ argument VERBOSE non-nil makes the function verbose. (autoload 'hl-line-mode "hl-line" "\ Toggle highlighting of the current line (Hl-Line mode). -With a prefix argument ARG, enable Hl-Line mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Hl-Line mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. Hl-Line mode is a buffer-local minor mode. If `hl-line-sticky-flag' is non-nil, Hl-Line mode highlights the @@ -16425,9 +16580,11 @@ or call the function `global-hl-line-mode'.") (autoload 'global-hl-line-mode "hl-line" "\ Toggle line highlighting in all buffers (Global Hl-Line mode). -With a prefix argument ARG, enable Global Hl-Line mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Global Hl-Line mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. If `global-hl-line-sticky-flag' is non-nil, Global Hl-Line mode highlights the line about the current buffer's point in all live @@ -16841,9 +16998,11 @@ or call the function `icomplete-mode'.") (autoload 'icomplete-mode "icomplete" "\ Toggle incremental minibuffer completion (Icomplete mode). -With a prefix argument ARG, enable Icomplete mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Icomplete mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. When this global minor mode is enabled, typing in the minibuffer continuously displays a list of possible completions that match @@ -17392,10 +17551,11 @@ DEF, if non-nil, is the default value. (autoload 'ielm "ielm" "\ Interactively evaluate Emacs Lisp expressions. -Switches to the buffer `*ielm*', or creates it if it does not exist. +Switches to the buffer named BUF-NAME if provided (`*ielm*' by default), +or creates it if it does not exist. See `inferior-emacs-lisp-mode' for details. -\(fn)" t nil) +\(fn &optional BUF-NAME)" t nil) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ielm" '("ielm-" "inferior-emacs-lisp-mode"))) @@ -17415,9 +17575,12 @@ See `inferior-emacs-lisp-mode' for details. (autoload 'iimage-mode "iimage" "\ Toggle Iimage mode on or off. -With a prefix argument ARG, enable Iimage mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. + +If called interactively, enable Iimage mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. + \\{iimage-mode-map} \(fn &optional ARG)" t nil) @@ -17710,6 +17873,11 @@ Setup easy-to-use keybindings for the commands to be used in dired mode. Note that n, p and and will be hijacked and bound to `image-dired-dired-x-line'. +If called interactively, enable Image-Dired minor mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. + \(fn &optional ARG)" t nil) (define-obsolete-function-alias 'image-dired-setup-dired-keybindings 'image-dired-minor-mode "26.1") @@ -17813,9 +17981,11 @@ or call the function `auto-image-file-mode'.") (autoload 'auto-image-file-mode "image-file" "\ Toggle visiting of image files as images (Auto Image File mode). -With a prefix argument ARG, enable Auto Image File mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Auto-Image-File mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. An image file is one whose name has an extension in `image-file-name-extensions', or matches a regexp in @@ -17842,9 +18012,11 @@ Key bindings: (autoload 'image-minor-mode "image-mode" "\ Toggle Image minor mode in this buffer. -With a prefix argument ARG, enable Image minor mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Image minor mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. Image minor mode provides the key \\\\[image-toggle-display], to switch back to `image-mode' and display an image file as the @@ -17907,9 +18079,9 @@ string (which specifies the title of a submenu into which the matches are put). REGEXP is a regular expression matching a definition construct which is to be displayed in the menu. REGEXP may also be a -function, called without arguments. It is expected to search -backwards. It must return true and set `match-data' if it finds -another element. +function of no arguments. If REGEXP is a function, it is +expected to search backwards, return non-nil if it finds a +definition construct, and set `match-data' for that construct. INDEX is an integer specifying which subexpression of REGEXP matches the definition's name; this subexpression is displayed as the menu item. @@ -18824,9 +18996,11 @@ available on the net. (autoload 'ispell-minor-mode "ispell" "\ Toggle last-word spell checking (Ispell minor mode). -With a prefix argument ARG, enable Ispell minor mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable ISpell minor mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. Ispell minor mode is a buffer-local minor mode. When enabled, typing SPC or RET warns you if the previous word is incorrectly @@ -19510,9 +19684,11 @@ generations (this defaults to 1). (autoload 'linum-mode "linum" "\ Toggle display of line numbers in the left margin (Linum mode). -With a prefix argument ARG, enable Linum mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. + +If called interactively, enable Linum mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. Linum mode is a buffer-local minor mode. @@ -20085,9 +20261,11 @@ or call the function `mail-abbrevs-mode'.") (autoload 'mail-abbrevs-mode "mailabbrev" "\ Toggle abbrev expansion of mail aliases (Mail Abbrevs mode). -With a prefix argument ARG, enable Mail Abbrevs mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Mail-Abbrevs mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. Mail Abbrevs mode is a global minor mode. When enabled, abbrev-like expansion is performed when editing certain mail @@ -20431,9 +20609,11 @@ Default bookmark handler for Man buffers. (autoload 'master-mode "master" "\ Toggle Master mode. -With a prefix argument ARG, enable Master mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Master mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. When Master mode is enabled, you can scroll the slave buffer using the following commands: @@ -20465,9 +20645,11 @@ or call the function `minibuffer-depth-indicate-mode'.") (autoload 'minibuffer-depth-indicate-mode "mb-depth" "\ Toggle Minibuffer Depth Indication mode. -With a prefix argument ARG, enable Minibuffer Depth Indication -mode if ARG is positive, and disable it otherwise. If called -from Lisp, enable the mode if ARG is omitted or nil. + +If called interactively, enable Minibuffer-Depth-Indicate mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. Minibuffer Depth Indication mode is a global minor mode. When enabled, any recursive use of the minibuffer will show the @@ -21095,6 +21277,11 @@ or call the function `midnight-mode'.") (autoload 'midnight-mode "midnight" "\ Non-nil means run `midnight-hook' at midnight. +If called interactively, enable Midnight mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. + \(fn &optional ARG)" t nil) (autoload 'clean-buffer-list "midnight" "\ @@ -21137,9 +21324,11 @@ or call the function `minibuffer-electric-default-mode'.") (autoload 'minibuffer-electric-default-mode "minibuf-eldef" "\ Toggle Minibuffer Electric Default mode. -With a prefix argument ARG, enable Minibuffer Electric Default -mode if ARG is positive, and disable it otherwise. If called -from Lisp, enable the mode if ARG is omitted or nil. + +If called interactively, enable Minibuffer-Electric-Default mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. Minibuffer Electric Default mode is a global minor mode. When enabled, minibuffer prompts that show a default value only show @@ -21722,9 +21911,11 @@ or call the function `msb-mode'.") (autoload 'msb-mode "msb" "\ Toggle Msb mode. -With a prefix argument ARG, enable Msb mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. + +If called interactively, enable Msb mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. This mode overrides the binding(s) of `mouse-buffer-menu' to provide a different buffer menu using the function `msb'. @@ -23390,6 +23581,11 @@ modes. The following keys behave as if Org mode were active, if the cursor is on a headline, or on a plain list item (both as defined by Org mode). +If called interactively, enable OrgStruct mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. + \(fn &optional ARG)" t nil) (autoload 'turn-on-orgstruct "org" "\ @@ -24302,9 +24498,11 @@ Turning on outline mode calls the value of `text-mode-hook' and then of (autoload 'outline-minor-mode "outline" "\ Toggle Outline minor mode. -With a prefix argument ARG, enable Outline minor mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Outline minor mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. See the command `outline-mode' for more information on this mode. @@ -24579,9 +24777,11 @@ or call the function `show-paren-mode'.") (autoload 'show-paren-mode "paren" "\ Toggle visualization of matching parens (Show Paren mode). -With a prefix argument ARG, enable Show Paren mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Show-Paren mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. Show Paren mode is a global minor mode. When enabled, any matching parenthesis is highlighted in `show-paren-style' after @@ -25300,9 +25500,11 @@ or call the function `pixel-scroll-mode'.") (autoload 'pixel-scroll-mode "pixel-scroll" "\ A minor mode to scroll text pixel-by-pixel. -With a prefix argument ARG, enable Pixel Scroll mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable Pixel Scroll mode -if ARG is omitted or nil. + +If called interactively, enable Pixel-Scroll mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. \(fn &optional ARG)" t nil) @@ -26959,9 +27161,11 @@ or call the function `rcirc-track-minor-mode'.") (autoload 'rcirc-track-minor-mode "rcirc" "\ Global minor mode for tracking activity in rcirc buffers. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. + +If called interactively, enable Rcirc-Track minor mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. \(fn &optional ARG)" t nil) @@ -27005,9 +27209,11 @@ or call the function `recentf-mode'.") (autoload 'recentf-mode "recentf" "\ Toggle \"Open Recent\" menu (Recentf mode). -With a prefix argument ARG, enable Recentf mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -Recentf mode if ARG is omitted or nil. + +If called interactively, enable Recentf mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. When Recentf mode is enabled, a \"Open Recent\" submenu is displayed in the \"File\" menu, containing a list of files that @@ -27157,6 +27363,12 @@ with a prefix argument, prompt for START-AT and FORMAT. (autoload 'rectangle-mark-mode "rect" "\ Toggle the region as rectangular. + +If called interactively, enable Rectangle-Mark mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. + Activates the region if needed. Only lasts until the region is deactivated. \(fn &optional ARG)" t nil) @@ -27184,9 +27396,11 @@ Activates the region if needed. Only lasts until the region is deactivated. (autoload 'refill-mode "refill" "\ Toggle automatic refilling (Refill mode). -With a prefix argument ARG, enable Refill mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Refill mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. Refill mode is a buffer-local minor mode. When enabled, the current paragraph is refilled as you edit. Self-inserting @@ -27216,6 +27430,11 @@ Turn on RefTeX mode. (autoload 'reftex-mode "reftex" "\ Minor mode with distinct support for \\label, \\ref and \\cite in LaTeX. +If called interactively, enable Reftex mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. + \\A Table of Contents of the entire (multifile) document with browsing capabilities is available with `\\[reftex-toc]'. @@ -27560,9 +27779,11 @@ first comment line visible (if point is in a comment). (autoload 'reveal-mode "reveal" "\ Toggle uncloaking of invisible text near point (Reveal mode). -With a prefix argument ARG, enable Reveal mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -Reveal mode if ARG is omitted or nil. + +If called interactively, enable Reveal mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. Reveal mode is a buffer-local minor mode. When enabled, it reveals invisible text around point. @@ -27583,9 +27804,10 @@ or call the function `global-reveal-mode'.") Toggle Reveal mode in all buffers (Global Reveal mode). Reveal mode renders invisible text around point visible again. -With a prefix argument ARG, enable Global Reveal mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. +If called interactively, enable Global Reveal mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. \(fn &optional ARG)" t nil) @@ -28303,9 +28525,11 @@ highlighting. (autoload 'rst-minor-mode "rst" "\ Toggle ReST minor mode. -With a prefix argument ARG, enable ReST minor mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Rst minor mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. When ReST minor mode is enabled, the ReST mode keybindings are installed on top of the major mode bindings. Use this @@ -28352,9 +28576,11 @@ Use the command `ruler-mode' to change this variable.") (autoload 'ruler-mode "ruler-mode" "\ Toggle display of ruler in header line (Ruler mode). -With a prefix argument ARG, enable Ruler mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. + +If called interactively, enable Ruler mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. \(fn &optional ARG)" t nil) @@ -28738,9 +28964,11 @@ or call the function `savehist-mode'.") (autoload 'savehist-mode "savehist" "\ Toggle saving of minibuffer history (Savehist mode). -With a prefix argument ARG, enable Savehist mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Savehist mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. When Savehist mode is enabled, minibuffer history is saved periodically and when exiting Emacs. When Savehist mode is @@ -28775,6 +29003,11 @@ Non-nil means automatically save place in each file. This means when you visit a file, point goes to the last place where it was when you previously visited the same file. +If called interactively, enable Save-Place mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. + \(fn &optional ARG)" t nil) (autoload 'save-place-local-mode "saveplace" "\ @@ -28783,8 +29016,10 @@ If this mode is enabled, point is recorded when you kill the buffer or exit Emacs. Visiting this file again will go to that position, even in a later Emacs session. -If called with a prefix arg, the mode is enabled if and only if -the argument is positive. +If called interactively, enable Save-Place-Local mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. To save places automatically in all files, put this in your init file: @@ -28875,9 +29110,11 @@ or call the function `scroll-all-mode'.") (autoload 'scroll-all-mode "scroll-all" "\ Toggle shared scrolling in same-frame windows (Scroll-All mode). -With a prefix argument ARG, enable Scroll-All mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Scroll-All mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. When Scroll-All mode is enabled, scrolling commands invoked in one window apply to all visible windows in the same frame. @@ -28900,12 +29137,16 @@ one window apply to all visible windows in the same frame. (autoload 'scroll-lock-mode "scroll-lock" "\ Buffer-local minor mode for pager-like scrolling. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. When enabled, keys that normally move -point by line or paragraph will scroll the buffer by the -respective amount of lines instead and point will be kept -vertically fixed relative to window boundaries during scrolling. + +If called interactively, enable Scroll-Lock mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. + +When enabled, keys that normally move point by line or paragraph +will scroll the buffer by the respective amount of lines instead +and point will be kept vertically fixed relative to window +boundaries during scrolling. \(fn &optional ARG)" t nil) @@ -28964,9 +29205,11 @@ or call the function `semantic-mode'.") (autoload 'semantic-mode "semantic" "\ Toggle parser features (Semantic mode). -With a prefix argument ARG, enable Semantic mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -Semantic mode if ARG is omitted or nil. + +If called interactively, enable Semantic mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. In Semantic mode, Emacs parses the buffers you visit for their semantic content. This information is used by a variety of @@ -29925,9 +30168,11 @@ or call the function `server-mode'.") (autoload 'server-mode "server" "\ Toggle Server mode. -With a prefix argument ARG, enable Server mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -Server mode if ARG is omitted or nil. + +If called interactively, enable Server mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. Server mode runs a process that accepts commands from the `emacsclient' program. See Info node `Emacs server' and @@ -30550,9 +30795,12 @@ buffer names. (autoload 'smerge-mode "smerge-mode" "\ Minor mode to simplify editing output from the diff3 program. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. + +If called interactively, enable Smerge mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. + \\{smerge-mode-map} \(fn &optional ARG)" t nil) @@ -31865,9 +32113,11 @@ or call the function `strokes-mode'.") (autoload 'strokes-mode "strokes" "\ Toggle Strokes mode, a global minor mode. -With a prefix argument ARG, enable Strokes mode if ARG is -positive, and disable it otherwise. If called from Lisp, -enable the mode if ARG is omitted or nil. + +If called interactively, enable Strokes mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. \\ Strokes are pictographic mouse gestures which invoke commands. @@ -31934,9 +32184,11 @@ Studlify-case the current buffer. (autoload 'subword-mode "subword" "\ Toggle subword movement and editing (Subword mode). -With a prefix argument ARG, enable Subword mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Subword mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. Subword mode is a buffer-local minor mode. Enabling it changes the definition of a word so that word-based commands stop inside @@ -31956,8 +32208,6 @@ called a `subword'. Here are some examples: This mode changes the definition of a word so that word commands treat nomenclature boundaries as word boundaries. -\\{subword-mode-map} - \(fn &optional ARG)" t nil) (defvar global-subword-mode nil "\ @@ -31984,9 +32234,11 @@ See `subword-mode' for more information on Subword mode. (autoload 'superword-mode "subword" "\ Toggle superword movement and editing (Superword mode). -With a prefix argument ARG, enable Superword mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Superword mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. Superword mode is a buffer-local minor mode. Enabling it changes the definition of words such that symbols characters are treated @@ -32081,9 +32333,11 @@ or call the function `gpm-mouse-mode'.") (autoload 'gpm-mouse-mode "t-mouse" "\ Toggle mouse support in GNU/Linux consoles (GPM Mouse mode). -With a prefix argument ARG, enable GPM Mouse mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Gpm-Mouse mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. This allows the use of the mouse when operating on a GNU/Linux console, in the same way as you can use the mouse under X11. @@ -32481,6 +32735,11 @@ location is indicated by `table-word-continuation-char'. This variable's value can be toggled by \\[table-fixed-width-mode] at run-time. +If called interactively, enable Table-Fixed-Width mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. + \(fn &optional ARG)" t nil) (autoload 'table-query-dimension "table" "\ @@ -33667,6 +33926,11 @@ This function is meant to be used as a `post-self-insert-hook'. (autoload 'tildify-mode "tildify" "\ Adds electric behavior to space character. +If called interactively, enable Tildify mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. + When space is inserted into a buffer in a position where hard space is required instead (determined by `tildify-space-pattern' and `tildify-space-predicates'), that space character is replaced by a hard space specified by @@ -33712,9 +33976,11 @@ or call the function `display-time-mode'.") (autoload 'display-time-mode "time" "\ Toggle display of time, load level, and mail flag in mode lines. -With a prefix argument ARG, enable Display Time mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -it if ARG is omitted or nil. + +If called interactively, enable Display-Time mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. When Display Time mode is enabled, it updates every minute (you can control the number of seconds between updates by customizing @@ -34571,6 +34837,11 @@ or call the function `type-break-mode'.") Enable or disable typing-break mode. This is a minor mode, but it is global to all buffers by default. +If called interactively, enable Type-Break mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. + When this mode is enabled, the user is encouraged to take typing breaks at appropriate intervals; either after a specified amount of time or when the user has exceeded a keystroke threshold. When the time arrives, the user @@ -34579,9 +34850,6 @@ again in a short period of time. The idea is to give the user enough time to find a good breaking point in his or her work, but be sufficiently annoying to discourage putting typing breaks off indefinitely. -A negative prefix argument disables this mode. -No argument or any non-negative argument enables it. - The user may enable or disable this mode by setting the variable of the same name, though setting it in that way doesn't reschedule a break or reset the keystroke counter. @@ -35105,9 +35373,11 @@ or call the function `url-handler-mode'.") (autoload 'url-handler-mode "url-handlers" "\ Toggle using `url' library for URL filenames (URL Handler mode). -With a prefix argument ARG, enable URL Handler mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Url-Handler mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. \(fn &optional ARG)" t nil) @@ -37252,9 +37522,11 @@ own View-like bindings. (autoload 'view-mode "view" "\ Toggle View mode, a minor mode for viewing text but not editing it. -With a prefix argument ARG, enable View mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable View mode -if ARG is omitted or nil. + +If called interactively, enable View mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. When View mode is enabled, commands that do not change the buffer contents are available as usual. Kill commands insert text in @@ -37628,9 +37900,11 @@ or call the function `which-function-mode'.") (autoload 'which-function-mode "which-func" "\ Toggle mode line display of current function (Which Function mode). -With a prefix argument ARG, enable Which Function mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Which-Function mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. Which Function mode is a global minor mode. When enabled, the current function name is continuously displayed in the mode line, @@ -37648,11 +37922,11 @@ in certain major modes. (autoload 'whitespace-mode "whitespace" "\ Toggle whitespace visualization (Whitespace mode). -With a prefix argument ARG, enable Whitespace mode if ARG is -positive, and disable it otherwise. -If called from Lisp, also enables the mode if ARG is omitted or nil, -and toggles it if ARG is `toggle'. +If called interactively, enable Whitespace mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. See also `whitespace-style', `whitespace-newline' and `whitespace-display-mappings'. @@ -37661,11 +37935,11 @@ See also `whitespace-style', `whitespace-newline' and (autoload 'whitespace-newline-mode "whitespace" "\ Toggle newline visualization (Whitespace Newline mode). -With a prefix argument ARG, enable Whitespace Newline mode if ARG -is positive, and disable it otherwise. -If called from Lisp, also enables the mode if ARG is omitted or nil, -and toggles it if ARG is `toggle'. +If called interactively, enable Whitespace-Newline mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. Use `whitespace-newline-mode' only for NEWLINE visualization exclusively. For other visualizations, including NEWLINE @@ -37688,11 +37962,11 @@ or call the function `global-whitespace-mode'.") (autoload 'global-whitespace-mode "whitespace" "\ Toggle whitespace visualization globally (Global Whitespace mode). -With a prefix argument ARG, enable Global Whitespace mode if ARG -is positive, and disable it otherwise. -If called from Lisp, also enables the mode if ARG is omitted or nil, -and toggles it if ARG is `toggle'. +If called interactively, enable Global Whitespace mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. See also `whitespace-style', `whitespace-newline' and `whitespace-display-mappings'. @@ -37711,11 +37985,11 @@ or call the function `global-whitespace-newline-mode'.") (autoload 'global-whitespace-newline-mode "whitespace" "\ Toggle global newline visualization (Global Whitespace Newline mode). -With a prefix argument ARG, enable Global Whitespace Newline mode -if ARG is positive, and disable it otherwise. -If called from Lisp, also enables the mode if ARG is omitted or nil, -and toggles it if ARG is `toggle'. +If called interactively, enable Global Whitespace-Newline mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. Use `global-whitespace-newline-mode' only for NEWLINE visualization exclusively. For other visualizations, including @@ -38037,9 +38311,11 @@ Show widget browser for WIDGET in other window. (autoload 'widget-minor-mode "wid-browse" "\ Minor mode for traversing widgets. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. + +If called interactively, enable Widget minor mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. \(fn &optional ARG)" t nil) @@ -38161,9 +38437,11 @@ or call the function `winner-mode'.") (autoload 'winner-mode "winner" "\ Toggle Winner mode on or off. -With a prefix argument ARG, enable Winner mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. + +If called interactively, enable Winner mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. Winner mode is a global minor mode that records the changes in the window configuration (i.e. how the frames are partitioned @@ -38373,6 +38651,12 @@ With prefix argument, prompt for the identifier. \(fn IDENTIFIER)" t nil) +(autoload 'xref-find-definitions-at-mouse "xref" "\ +Find the definition of identifier at or around mouse click. +This command is intended to be bound to a mouse event. + +\(fn EVENT)" t nil) + (autoload 'xref-find-apropos "xref" "\ Find all meaningful symbols that match PATTERN. The argument has the same meaning as in `apropos'. @@ -38425,9 +38709,11 @@ or call the function `xterm-mouse-mode'.") (autoload 'xterm-mouse-mode "xt-mouse" "\ Toggle XTerm mouse mode. -With a prefix argument ARG, enable XTerm mouse mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + +If called interactively, enable Xterm-Mouse mode if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise. Turn it on to use Emacs mouse commands, and off to use xterm mouse commands. This works in terminal emulators compatible with xterm. It only commit 15458a8301c41214609348a7476a6c0c639a89b6 Author: Glenn Morris Date: Wed Aug 1 06:28:34 2018 -0400 ; Auto-commit of loaddefs files. diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 5740cdea86..93b321a5dc 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -2335,7 +2335,7 @@ BOOKMARK is usually a bookmark name (a string). It can also be a bookmark record, but this is usually only done by programmatic callers. If DISPLAY-FUNC is non-nil, it is a function to invoke to display the -bookmark. It defaults to `switch-to-buffer'. A typical value for +bookmark. It defaults to `pop-to-buffer-same-window'. A typical value for DISPLAY-FUNC would be `switch-to-buffer-other-window'. \(fn BOOKMARK &optional DISPLAY-FUNC)" t nil) @@ -10081,6 +10081,9 @@ When called from Elisp code, ARG can be any locking mode: Other values are interpreted as usual. +See also `emacs-lock-unlockable-modes', which exempts buffers under +some major modes from being locked under some circumstances. + \(fn &optional ARG)" t nil) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "emacs-lock" '("toggle-emacs-lock" "emacs-lock-"))) @@ -13306,6 +13309,9 @@ Turn Flyspell mode off. (autoload 'flyspell-region "flyspell" "\ Flyspell text between BEG and END. +Make sure `flyspell-mode' is turned on if you want the highlight +of a misspelled word removed when you've corrected it. + \(fn BEG END)" t nil) (autoload 'flyspell-buffer "flyspell" "\ @@ -15085,7 +15091,14 @@ number with fewer than this number of bits, the handshake is rejected. (The smaller the prime number, the less secure the key exchange is against man-in-the-middle attacks.) -A value of nil says to use the default GnuTLS value.") +A value of nil says to use the default GnuTLS value. + +The default value of this variable is such that virtually any +connection can be established, whether this connection can be +considered cryptographically \"safe\" or not. However, Emacs +network security is handled at a higher level via +`open-network-stream' and the Network Security Manager. See Info +node `(emacs) Network Security'.") (custom-autoload 'gnutls-min-prime-bits "gnutls" t) @@ -15215,7 +15228,7 @@ List of hook functions run by `grep-process-setup' (see `run-hooks').") (custom-autoload 'grep-setup-hook "grep" t) -(defconst grep-regexp-alist `((,(concat "^\\(?:" "\\(?1:[^\n]+\\)\\(?3:\\)\\(?2:[0-9]+\\):" "\\|" "\\(?1:[^\n:]+?[^\n/:]\\):[ ]*\\(?2:[1-9][0-9]*\\)[ ]*:" "\\)") 1 2 (,(lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face 'grep-match-face))) (when mbeg (- mbeg beg))))) \, (lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face 'grep-match-face)) (mend (and mbeg (next-single-property-change mbeg 'font-lock-face nil end)))) (when mend (- mend beg)))))) nil nil (3 '(face nil display ":"))) ("^Binary file \\(.+\\) matches$" 1 nil nil 0 1)) "\ +(defconst grep-regexp-alist `((,(concat "^\\(?:" "\\(?1:[^\n]+\\)\\(?3:\\)\\(?2:[0-9]+\\):" "\\|" "\\(?1:" "\\(?:[a-zA-Z]:\\)?" "[^\n:]+?[^\n/:]\\):[ ]*\\(?2:[1-9][0-9]*\\)[ ]*:" "\\)") 1 2 (,(lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face 'grep-match-face))) (when mbeg (- mbeg beg))))) \, (lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face 'grep-match-face)) (mend (and mbeg (next-single-property-change mbeg 'font-lock-face nil end)))) (when mend (- mend beg)))))) nil nil (3 '(face nil display ":"))) ("^Binary file \\(.+\\) matches$" 1 nil nil 0 1)) "\ Regexp used to match grep hits. See `compilation-error-regexp-alist' for format details.") @@ -18103,9 +18116,9 @@ string (which specifies the title of a submenu into which the matches are put). REGEXP is a regular expression matching a definition construct which is to be displayed in the menu. REGEXP may also be a -function, called without arguments. It is expected to search -backwards. It must return true and set `match-data' if it finds -another element. +function of no arguments. If REGEXP is a function, it is +expected to search backwards, return non-nil if it finds a +definition construct, and set `match-data' for that construct. INDEX is an integer specifying which subexpression of REGEXP matches the definition's name; this subexpression is displayed as the menu item. @@ -32130,8 +32143,6 @@ called a `subword'. Here are some examples: This mode changes the definition of a word so that word commands treat nomenclature boundaries as word boundaries. -\\{subword-mode-map} - \(fn &optional ARG)" t nil) (defvar global-subword-mode nil "\ @@ -34594,7 +34605,7 @@ Reenable Ange-FTP, when Tramp is unloaded. ;;;### (autoloads nil "trampver" "net/trampver.el" (0 0 0 0)) ;;; Generated autoloads from net/trampver.el -(push (purecopy '(tramp 2 3 4)) package--builtin-versions) +(push (purecopy '(tramp 2 3 4 26 2)) package--builtin-versions) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "trampver" '("tramp-"))) commit 6e37d2fd05bea373c472af1c6e80238ace5e1c94 Author: Paul Eggert Date: Wed Aug 1 00:49:39 2018 -0700 Read and print NaN significand if * configure.ac: Check for ieee754.h. * doc/lispref/numbers.texi (Float Basics): Document that NaN string representation digits are machine-dependent. * etc/NEWS: Mention the change. * src/lread.c, src/print.c [HAVE_IEEE754_H]: Include ieee754.h. * src/lread.c (string_to_number) [HAVE_IEEE754_H]: * src/print.c (float_to_string) [HAVE_IEEE754_H]: Read and print NaN significand. diff --git a/configure.ac b/configure.ac index b6918671e4..dbdcce7c8d 100644 --- a/configure.ac +++ b/configure.ac @@ -1668,6 +1668,7 @@ fi dnl checks for header files AC_CHECK_HEADERS_ONCE( + ieee754.h linux/fs.h malloc.h sys/systeminfo.h diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi index 14d5059ffb..a3317c9a26 100644 --- a/doc/lispref/numbers.texi +++ b/doc/lispref/numbers.texi @@ -241,7 +241,7 @@ A NaN is never numerically equal to any value, not even to itself. NaNs carry a sign and a significand, and non-numeric functions treat two NaNs as equal when their signs and significands agree. Significands of NaNs are -machine-dependent and are not directly visible to Emacs Lisp. +machine-dependent, as are the digits in their string representation. When NaNs and signed zeros are involved, non-numeric functions like @code{eql}, @code{equal}, @code{sxhash-eql}, @code{sxhash-equal} and diff --git a/etc/NEWS b/etc/NEWS index f1ea835679..9e7a765dc6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -880,6 +880,9 @@ Formerly, some of these functions ignored signs and significands of NaNs. Now, all these functions treat NaN signs and significands as significant. For example, (eql 0.0e+NaN -0.0e+NaN) now returns nil because the two NaNs have different signs; formerly it returned t. +Also, on platforms that have Emacs now reads and prints +NaN significands; e.g., if X is a NaN, (format "%s" X) now returns +"0.0e+NaN", "1.0e+NaN", etc., depending on X's significand. +++ ** The function 'make-string' accepts an additional optional argument. diff --git a/src/lread.c b/src/lread.c index 50fc6ef8f3..290b0f6bbe 100644 --- a/src/lread.c +++ b/src/lread.c @@ -72,6 +72,10 @@ along with GNU Emacs. If not, see . */ #define file_tell ftell #endif +#if HAVE_IEEE754_H +# include +#endif + /* The objects or placeholders read with the #n=object form. A hash table maps a number to either a placeholder (while the @@ -3757,8 +3761,15 @@ string_to_number (char const *string, int base, int flags) { state |= E_EXP; cp += 3; +#if HAVE_IEEE754_H + union ieee754_double u + = { .ieee_nan = { .exponent = -1, .quiet_nan = 1, + .mantissa0 = n >> 31 >> 1, .mantissa1 = n }}; + value = u.d; +#else /* NAN is a "positive" NaN on all known Emacs hosts. */ value = NAN; +#endif } else cp = ecp; diff --git a/src/print.c b/src/print.c index da6ec1aaed..add21609cc 100644 --- a/src/print.c +++ b/src/print.c @@ -40,6 +40,10 @@ along with GNU Emacs. If not, see . */ #include #include +#if HAVE_IEEE754_H +# include +#endif + #ifdef WINDOWSNT # include /* for F_DUPFD_CLOEXEC */ #endif @@ -1011,6 +1015,12 @@ float_to_string (char *buf, double data) } if (isnan (data)) { +#if HAVE_IEEE754_H + union ieee754_double u = { .d = data }; + uprintmax_t hi = u.ieee_nan.mantissa0; + return sprintf (buf, &"-%"pMu".0e+NaN"[!u.ieee_nan.negative], + (hi << 31 << 1) + u.ieee_nan.mantissa1); +#else /* Prepend "-" if the NaN's sign bit is negative. The sign bit of a double is the bit that is 1 in -0.0. */ static char const NaN_string[] = "0.0e+NaN"; @@ -1029,6 +1039,7 @@ float_to_string (char *buf, double data) strcpy (buf + negative, NaN_string); return negative + sizeof NaN_string - 1; +#endif } if (NILP (Vfloat_output_format) commit e28a37438d4ba71cd8a053e956686ab29ff97b6a Author: Paul Eggert Date: Tue Jul 31 23:46:57 2018 -0700 Simplify by assuming C99 math.h isnan etc. These should be portable nowadays. * src/data.c (isnan): Remove. * src/floatfns.c (isfinite, isnan): Remove. * src/print.c: Include math.h, for isinf and isnan. (float_to_string): Simplify by using them. diff --git a/src/data.c b/src/data.c index c8beeda720..aaccb67518 100644 --- a/src/data.c +++ b/src/data.c @@ -2812,10 +2812,6 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) return val; } -#ifndef isnan -# define isnan(x) ((x) != (x)) -#endif - static Lisp_Object float_arith_driver (double accum, ptrdiff_t argnum, enum arithop code, ptrdiff_t nargs, Lisp_Object *args) diff --git a/src/floatfns.c b/src/floatfns.c index e7d404a84e..45e786f966 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -47,13 +47,6 @@ along with GNU Emacs. If not, see . */ #include -#ifndef isfinite -# define isfinite(x) ((x) - (x) == 0) -#endif -#ifndef isnan -# define isnan(x) ((x) != (x)) -#endif - /* Check that X is a floating point number. */ static void diff --git a/src/print.c b/src/print.c index 71591952a2..da6ec1aaed 100644 --- a/src/print.c +++ b/src/print.c @@ -38,6 +38,7 @@ along with GNU Emacs. If not, see . */ #include #include #include +#include #ifdef WINDOWSNT # include /* for F_DUPFD_CLOEXEC */ @@ -1001,23 +1002,14 @@ float_to_string (char *buf, double data) int width; int len; - /* Check for plus infinity in a way that won't lose - if there is no plus infinity. */ - if (data == data / 2 && data > 1.0) - { - static char const infinity_string[] = "1.0e+INF"; - strcpy (buf, infinity_string); - return sizeof infinity_string - 1; - } - /* Likewise for minus infinity. */ - if (data == data / 2 && data < -1.0) + if (isinf (data)) { static char const minus_infinity_string[] = "-1.0e+INF"; - strcpy (buf, minus_infinity_string); - return sizeof minus_infinity_string - 1; + bool positive = 0 < data; + strcpy (buf, minus_infinity_string + positive); + return sizeof minus_infinity_string - 1 - positive; } - /* Check for NaN in a way that won't fail if there are no NaNs. */ - if (! (data * 0.0 >= 0.0)) + if (isnan (data)) { /* Prepend "-" if the NaN's sign bit is negative. The sign bit of a double is the bit that is 1 in -0.0. */ commit 1804fece02691798394c9e9bd519cd4a53776018 Merge: 17205d3617 82d6416a28 Author: Stephen Gildea Date: Tue Jul 31 22:34:35 2018 -0700 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit 17205d361795eaaa8e09ae62875c7439bb57a078 Author: Stephen Gildea Date: Tue Jul 31 22:29:47 2018 -0700 Reset mh-blacklist and mh-whitelist on folder undo * mh-funcs.el (mh-undo-folder): Set mh-blacklist and mh-whitelist to nil, as is done with the other lists of pending operations. diff --git a/lisp/mh-e/mh-funcs.el b/lisp/mh-e/mh-funcs.el index 661d0ec756..3574f8c801 100644 --- a/lisp/mh-e/mh-funcs.el +++ b/lisp/mh-e/mh-funcs.el @@ -357,6 +357,8 @@ Arguments are IGNORED (for `revert-buffer')." (yes-or-no-p "Undo all commands in folder? ")) (setq mh-delete-list nil mh-refile-list nil + mh-blacklist nil + mh-whitelist nil mh-seq-list nil mh-next-direction 'forward) (with-mh-folder-updating (nil) commit 82d6416a28dc5b4ab65b8081f035679bec4e3604 Author: Michael Albinus Date: Tue Jul 31 06:50:30 2018 +0200 Fix Bug#32304 * lisp/net/tramp.el (tramp-handle-substitute-in-file-name): Handle special cas on Cygwin and MS-Windows. (Bug#32304) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index d56b09a604..1af2defd58 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3567,16 +3567,20 @@ support symbolic links." ;; First, we must replace environment variables. (setq filename (tramp-replace-environment-variables filename)) (with-parsed-tramp-file-name filename nil - ;; We do not want to replace environment variables, again. + ;; We do not want to replace environment variables, again. "//" + ;; has a special meaning at the beginning of a file name on + ;; Cygwin and MS-Windows, we must remove it. (let (process-environment) ;; Ignore in LOCALNAME everything before "//" or "/~". (when (stringp localname) (if (string-match "//\\(/\\|~\\)" localname) - (setq filename (substitute-in-file-name localname)) + (setq filename + (replace-regexp-in-string + "\\`/+" "/" (substitute-in-file-name localname))) (setq filename (concat (file-remote-p filename) - (tramp-run-real-handler - 'substitute-in-file-name (list localname))))))) + (replace-regexp-in-string + "\\`/+" "/" (substitute-in-file-name localname))))))) ;; "/m:h:~" does not work for completion. We use "/m:h:~/". (if (and (stringp localname) (string-equal "~" localname)) (concat filename "/") commit 951c5a127fb6f8b34c23fced0943101a41af74ad Author: Stephen Berman Date: Tue Jul 31 00:42:52 2018 +0200 Fix wdired test failure when byte compiled (bug#32318) * test/lisp/wdired-tests.el: Require wdired. Defvar dired-query to silence byte-compiler. diff --git a/test/lisp/wdired-tests.el b/test/lisp/wdired-tests.el index bf09d43ed7..b4ef4ab248 100644 --- a/test/lisp/wdired-tests.el +++ b/test/lisp/wdired-tests.el @@ -21,6 +21,9 @@ (require 'ert) (require 'dired) +(require 'wdired) + +(defvar dired-query) ; Pacify byte compiler. (ert-deftest wdired-test-bug32173-01 () "Test using non-nil wdired-use-interactive-rename. commit 0252f7311f6ea968ea45933e275ae8cedbfaa1ef Author: Stephen Berman Date: Mon Jul 30 14:12:50 2018 +0200 * test/lisp/wdired-tests.el (wdired-test-symlink-name): New test. diff --git a/test/lisp/wdired-tests.el b/test/lisp/wdired-tests.el index 7199470ea9..bf09d43ed7 100644 --- a/test/lisp/wdired-tests.el +++ b/test/lisp/wdired-tests.el @@ -74,6 +74,27 @@ Aborting an edit should leaving original file name unchanged." (if buf (kill-buffer buf)) (delete-directory test-dir t))))) +(ert-deftest wdired-test-symlink-name () + "Test the file name of a symbolic link. +The Dired and WDired functions returning the name should include +only the name before the link arrow." + (let* ((test-dir (make-temp-file "test-dir-" t)) + (link-name "foo")) + (let ((buf (find-file-noselect test-dir))) + (unwind-protect + (with-current-buffer buf + (make-symbolic-link "./bar/baz" link-name) + (revert-buffer) + (let* ((file-name (dired-get-filename)) + (dir-part (file-name-directory file-name)) + (lf-name (concat dir-part link-name))) + (should (equal file-name lf-name)) + (dired-toggle-read-only) + (should (equal (wdired-get-filename) lf-name)) + (dired-toggle-read-only))) + (if buf (kill-buffer buf)) + (delete-directory test-dir t))))) + (ert-deftest wdired-test-unfinished-edit-01 () "Test editing a file name without saving the change. Finding the new name should be possible while still in commit 63ef79329935b790b9c8107125bce66e1f272c2e Author: Michael Albinus Date: Mon Jul 30 11:11:32 2018 +0200 ; Instrumentation for shadowfile.el diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el index 1e680770ec..86280c38ad 100644 --- a/lisp/shadowfile.el +++ b/lisp/shadowfile.el @@ -646,7 +646,8 @@ Consider them as regular expressions if third arg REGEXP is true." "Use \\[shadow-copy-files] to update shadows.")) (sit-for 1)) (message "shadow-add-to-todo 8") - (shadow-write-todo-file))) + (shadow-write-todo-file) + (message "shadow-add-to-todo 9"))) nil) ; Return nil for write-file-functions (defun shadow-remove-from-todo (pair) @@ -723,8 +724,9 @@ With non-nil argument also saves the buffer." (delete-region (point-min) (point-max)) (message "shadow-write-todo-file 4 %s" shadow-todo-buffer) (shadow-insert-var 'shadow-files-to-copy) - (message "shadow-write-todo-file 5 %s" shadow-todo-buffer) - (if save (shadow-save-todo-file)))) + (message "shadow-write-todo-file 5 %s" save) + (if save (shadow-save-todo-file)) + (message "shadow-write-todo-file 6 %s" save))) (defun shadow-save-todo-file () (message "shadow-save-todo-file 1 %s" shadow-todo-buffer) commit bd36ab560d5efcc5853e455c2312cf1a104e78ea Author: Noam Postavsky Date: Sun Jul 29 21:10:31 2018 -0400 * lisp/term.el (term-read-noecho): Mark obsolete. diff --git a/etc/NEWS b/etc/NEWS index 31ccb44736..f1ea835679 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -269,6 +269,11 @@ better emulate 'M-.' in both Bash and zsh, since the former counts from the beginning of the arguments, while the latter counts from the end. +** Term + +--- +*** 'term-read-noecho' is now obsolete, use 'read-passwd' instead. + ** Flymake +++ diff --git a/lisp/term.el b/lisp/term.el index e90ff457ac..9f8f1f703a 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -2216,6 +2216,7 @@ filter and C-g is pressed, this function returns nil rather than a string). Note that the keystrokes comprising the text can still be recovered \(temporarily) with \\[view-lossage]. This may be a security bug for some applications." + (declare (obsolete read-passwd "27.1")) (let ((ans "") (c 0) (echo-keystrokes 0) commit 7a5be79256c85ed634623bf0bdccdc2104784a3b Author: Philipp Stephani Date: Mon Jul 30 00:18:27 2018 +0200 ; * src/json.c: Fix typo in license statement diff --git a/src/json.c b/src/json.c index ea941d7bb5..afdd9a2548 100644 --- a/src/json.c +++ b/src/json.c @@ -7,7 +7,7 @@ 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 -nyour option) any later version. +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 commit c71eeb8d4dd443232e2416f4e4dde19ed0b6da4d Author: Michael Albinus Date: Sun Jul 29 23:10:21 2018 +0200 ; Instrumentation for shadowfile.el diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el index dc7c1b8c1a..1e680770ec 100644 --- a/lisp/shadowfile.el +++ b/lisp/shadowfile.el @@ -713,18 +713,25 @@ defined, the old hashtable info is invalid." "Write out information to `shadow-todo-file'. With non-nil argument also saves the buffer." (save-excursion + (message "shadow-write-todo-file 1 %s" shadow-todo-buffer) (if (not shadow-todo-buffer) (setq shadow-todo-buffer (find-file-noselect shadow-todo-file))) + (message "shadow-write-todo-file 2 %s" shadow-todo-buffer) (set-buffer shadow-todo-buffer) + (message "shadow-write-todo-file 3 %s" shadow-todo-buffer) (setq buffer-read-only nil) (delete-region (point-min) (point-max)) + (message "shadow-write-todo-file 4 %s" shadow-todo-buffer) (shadow-insert-var 'shadow-files-to-copy) + (message "shadow-write-todo-file 5 %s" shadow-todo-buffer) (if save (shadow-save-todo-file)))) (defun shadow-save-todo-file () + (message "shadow-save-todo-file 1 %s" shadow-todo-buffer) (if (and shadow-todo-buffer (buffer-modified-p shadow-todo-buffer)) (with-current-buffer shadow-todo-buffer - (condition-case nil ; have to continue even in case of + (message "shadow-save-todo-file 2 %s" shadow-todo-buffer) + (condition-case nil ; have to continue even in case of (basic-save-buffer) ; error, otherwise kill-emacs might (error ; not work! (message "WARNING: Can't save shadow todo file; it is locked!") commit 414a4969b98fabd1598933d48aea4c5f19db7a7f Author: Eli Zaretskii Date: Sun Jul 29 20:07:09 2018 +0300 Avoid gettimeofday deprecation warnings with MinGW * nt/inc/ms-w32.h (__POSIX_2008_DEPRECATED) [__MINGW32_VERSION >= 5001000L]: Define to nothing, to avoid deprecation warnings about gettimeofday with mingw.org's MinGW runtime 5.1 and later. diff --git a/nt/inc/ms-w32.h b/nt/inc/ms-w32.h index d15b6da1a7..e4dec04fb8 100644 --- a/nt/inc/ms-w32.h +++ b/nt/inc/ms-w32.h @@ -34,6 +34,11 @@ along with GNU Emacs. If not, see . */ # ifdef __MINGW64_VERSION_MAJOR # define MINGW_W64 # endif +# if defined __MINGW32_VERSION && __MINGW32_VERSION >= 5001000L +/* Avoid warnings about gettimeofday being deprecated. */ +# undef __POSIX_2008_DEPRECATED +# define __POSIX_2008_DEPRECATED +# endif #endif /* #undef const */ commit d7052cf393ffd1ab57fd7f7d92abdd00a5b5df8c Merge: 4e47050df4 39d3e8b6bc Author: Paul Eggert Date: Sun Jul 29 09:47:10 2018 -0700 Merge from origin/emacs-26 39d3e8b Fix last change in 'char_width' 67679f0 Add initial tests for wdired.el commit 4e47050df4a61654646bc58cfed79a709c117d2f Merge: c92fd4e0e0 831a3cb301 Author: Paul Eggert Date: Sun Jul 29 09:47:10 2018 -0700 ; Merge from origin/emacs-26 The following commit was skipped: 831a3cb Fix use of non-nil wdired-use-interactive-rename commit c92fd4e0e0ef3d132b8beeb5f4ecaf3a6451616e Author: Michael Albinus Date: Sun Jul 29 18:35:43 2018 +0200 ; Instrumentation for shadowfile.el diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el index 609086772a..dc7c1b8c1a 100644 --- a/lisp/shadowfile.el +++ b/lisp/shadowfile.el @@ -636,12 +636,16 @@ Consider them as regular expressions if third arg REGEXP is true." (shadow-expand-file-name (buffer-file-name (current-buffer)))))) (when shadows + (message "shadow-add-to-todo 5 %s" shadows) + (message "shadow-add-to-todo 6 %s" shadow-files-to-copy) + (message "shadow-add-to-todo 7 %s" (shadow-union shadows shadow-files-to-copy)) (setq shadow-files-to-copy (shadow-union shadows shadow-files-to-copy)) (when (not shadow-inhibit-message) (message "%s" (substitute-command-keys "Use \\[shadow-copy-files] to update shadows.")) (sit-for 1)) + (message "shadow-add-to-todo 8") (shadow-write-todo-file))) nil) ; Return nil for write-file-functions commit dd514347140087112cdc632ac766a76fb4fe27f0 Author: Raimon Grau Date: Sun Jul 1 21:31:08 2018 +0100 Fix url's thing-at-point beginning-op (Bug#32028) * lisp/thingatpt.el (url): Fix beginning-op making. diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index 7fe99b0714..6a978fe96e 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -474,7 +474,7 @@ looks like an email address, \"ftp://\" if it starts with (put 'url 'end-op (lambda () (end-of-thing 'url))) -(put 'url 'beginning-op (lambda () (end-of-thing 'url))) +(put 'url 'beginning-op (lambda () (beginning-of-thing 'url))) ;; The normal thingatpt mechanism doesn't work for complex regexps. ;; This should work for almost any regexp wherever we are in the commit 39d3e8b6bc465df7a9400165a4d813af8af37237 Author: Eli Zaretskii Date: Sun Jul 29 17:42:11 2018 +0300 Fix last change in 'char_width' * src/character.c (char_width): Make sure variable C is always initialized. (Bug#32276) diff --git a/src/character.c b/src/character.c index 48268e0494..b96161ebfc 100644 --- a/src/character.c +++ b/src/character.c @@ -289,15 +289,18 @@ char_width (int c, struct Lisp_Char_Table *dp) if (VECTORP (disp)) for (i = 0, width = 0; i < ASIZE (disp); i++) { - int c; + int c = -1; ch = AREF (disp, i); if (GLYPH_CODE_P (ch)) c = GLYPH_CODE_CHAR (ch); else if (CHARACTERP (ch)) c = XFASTINT (ch); - int w = CHARACTER_WIDTH (c); - if (INT_ADD_WRAPV (width, w, &width)) - string_overflow (); + if (c >= 0) + { + int w = CHARACTER_WIDTH (c); + if (INT_ADD_WRAPV (width, w, &width)) + string_overflow (); + } } } return width; commit b3f7e73fb76a366dc644ee2e6b9f4897c17d201d Author: Tino Calancha Date: Sun Jul 29 21:21:40 2018 +0900 Prefer ?* to hide passwords It might be argued that a hidden string is more legible when using ?* as the hidden character instead of ?. For example, the following strings have the same length: "......" "******" It's slighly easier to visually count the number of characters in the second string (Bug#32220). * lisp/subr.el (read-passwd): Prefer ?* as default char instead of ?. * doc/lispref/minibuf.texi (Reading a Password): Update manual. ; * etc/NEWS (Changes in Emacs 27.1): Announce the change. diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 889b64af8a..d091787a68 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -2199,7 +2199,7 @@ function @code{read-passwd}. @defun read-passwd prompt &optional confirm default This function reads a password, prompting with @var{prompt}. It does not echo the password as the user types it; instead, it echoes -@samp{.} for each character in the password. If you want to apply +@samp{*} for each character in the password. If you want to apply another character to hide the password, let-bind the variable @code{read-hide-char} with that character. diff --git a/etc/NEWS b/etc/NEWS index 089fc4053b..31ccb44736 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -92,6 +92,9 @@ the new version of the file again.) * Changes in Emacs 27.1 ++++ +** The function 'read-passwd' uses '*' as default character to hide passwords. + --- ** New variable 'xft-ignore-color-fonts'. Default t means don't try to load color fonts when using Xft, as they diff --git a/lisp/subr.el b/lisp/subr.el index 6b30371a86..f8c19efc37 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2299,7 +2299,7 @@ some sort of escape sequence, the ambiguity is resolved via `read-key-delay'." If optional CONFIRM is non-nil, read the password twice to make sure. Optional DEFAULT is a default password to use instead of empty input. -This function echoes `.' for each character that the user types. +This function echoes `*' for each character that the user types. You could let-bind `read-hide-char' to another hiding character, though. Once the caller uses the password, it can erase the password @@ -2325,7 +2325,7 @@ by doing (clear-string STRING)." beg))) (dotimes (i (- end beg)) (put-text-property (+ i beg) (+ 1 i beg) - 'display (string (or read-hide-char ?.)))))) + 'display (string (or read-hide-char ?*)))))) minibuf) (minibuffer-with-setup-hook (lambda () @@ -2340,7 +2340,7 @@ by doing (clear-string STRING)." (add-hook 'after-change-functions hide-chars-fun nil 'local)) (unwind-protect (let ((enable-recursive-minibuffers t) - (read-hide-char (or read-hide-char ?.))) + (read-hide-char (or read-hide-char ?*))) (read-string prompt nil t default)) ; t = "no history" (when (buffer-live-p minibuf) (with-current-buffer minibuf commit ea1cf0960a86bc373cfd4900f46d9fe5e847941e Author: Stephen Berman Date: Sun Jul 29 13:16:48 2018 +0200 Handle symlinks in wdired.el when restoring filename property * lisp/wdired.el (wdired--restore-dired-filename-prop): If the file name is a symbolic link, only propertize the link name. This prevents wdired-create-parentdirs from turning the link into a directory. diff --git a/lisp/wdired.el b/lisp/wdired.el index 1d0106775d..be0bde290a 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -611,7 +611,10 @@ Optional arguments are ignored." (when (re-search-forward directory-listing-before-filename-regexp (line-end-position) t) (setq beg (point) - end (line-end-position)) + end (if (and (file-symlink-p (dired-get-filename)) + (search-forward " -> " (line-end-position) t)) + (goto-char (match-beginning 0)) + (line-end-position))) (put-text-property beg end 'dired-filename t))))) (defun wdired-next-line (arg) commit 8a563d9762670e9eec9420ba2dc12075c1dd0a8c Author: Stephen Berman Date: Sun Jul 29 01:14:41 2018 +0200 Fix bugs in wdired.el involving dired-filename property After every change in wdired-mode, put the dired-filename text property on the file name. This ensures that changing some but not all characters in the name succeeds with non-nil wdired-use-interactive-rename (bug#32173) and it also ensures that changed names can be found (e.g. by dired-isearch-filenames) while still in wdired-mode. * lisp/wdired.el (wdired--restore-dired-filename-prop): New function. (wdired-change-to-wdired-mode): Add it to after-change-functions. (wdired-change-to-dired-mode): Remove it from after-change-functions. (wdired-finish-edit): Move invocation of wdired-change-to-dired-mode below invocation of wdired-do-renames, so that the latter runs wdired--restore-dired-filename-prop, but above the invocation of revert-buffer to avoid using wdired-revert, which changes back to wdired-mode. (wdired-search-and-rename): Wrap renaming in unwind-protect and if user types C-g when prompted to change the file name, make sure we return to dired-mode. diff --git a/lisp/wdired.el b/lisp/wdired.el index bb60e77776..1d0106775d 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -255,6 +255,7 @@ See `wdired-mode'." (setq buffer-read-only nil) (dired-unadvertise default-directory) (add-hook 'kill-buffer-hook 'wdired-check-kill-buffer nil t) + (add-hook 'after-change-functions 'wdired--restore-dired-filename-prop nil t) (setq major-mode 'wdired-mode) (setq mode-name "Editable Dired") (setq revert-buffer-function 'wdired-revert) @@ -363,6 +364,7 @@ non-nil means return old filename." (setq mode-name "Dired") (dired-advertise) (remove-hook 'kill-buffer-hook 'wdired-check-kill-buffer t) + (remove-hook 'after-change-functions 'wdired--restore-dired-filename-prop t) (set (make-local-variable 'revert-buffer-function) 'dired-revert)) @@ -381,7 +383,6 @@ non-nil means return old filename." (defun wdired-finish-edit () "Actually rename files based on your editing in the Dired buffer." (interactive) - (wdired-change-to-dired-mode) (let ((changes nil) (errors 0) files-deleted @@ -423,6 +424,11 @@ non-nil means return old filename." (forward-line -1))) (when files-renamed (setq errors (+ errors (wdired-do-renames files-renamed)))) + ;; We have to be in wdired-mode when wdired-do-renames is executed + ;; so that wdired--restore-dired-filename-prop runs, but we have + ;; to change back to dired-mode before reverting the buffer to + ;; avoid using wdired-revert, which changes back to wdired-mode. + (wdired-change-to-dired-mode) (if changes (progn ;; If we are displaying a single file (rather than the @@ -543,19 +549,25 @@ and proceed depending on the answer." (goto-char (point-max)) (forward-line -1) (let ((done nil) + (failed t) curr-filename) (while (and (not done) (not (bobp))) (setq curr-filename (wdired-get-filename nil t)) (if (equal curr-filename filename-ori) - (progn - (setq done t) - (let ((inhibit-read-only t)) - (dired-move-to-filename) - (search-forward (wdired-get-filename t) nil t) - (replace-match (file-name-nondirectory filename-ori) t t)) - (dired-do-create-files-regexp - (function dired-rename-file) - "Move" 1 ".*" filename-new nil t)) + (unwind-protect + (progn + (setq done t) + (let ((inhibit-read-only t)) + (dired-move-to-filename) + (search-forward (wdired-get-filename t) nil t) + (replace-match (file-name-nondirectory filename-ori) t t)) + (dired-do-create-files-regexp + (function dired-rename-file) + "Move" 1 ".*" filename-new nil t) + (setq failed nil)) + ;; If user types C-g when prompted to change the file + ;; name, make sure we return to dired-mode. + (when failed (wdired-change-to-dired-mode))) (forward-line -1)))))) ;; marks a list of files for deletion @@ -586,6 +598,22 @@ Optional arguments are ignored." (not (y-or-n-p "Buffer changed. Discard changes and kill buffer? "))) (error "Error"))) +;; Added to after-change-functions in wdired-change-to-wdired-mode to +;; ensure that, on editing a file name, new characters get the +;; dired-filename text property, which allows functions that look for +;; this property (e.g. dired-isearch-filenames) to work in wdired-mode +;; and also avoids an error with non-nil wdired-use-interactive-rename +;; (bug#32173). +(defun wdired--restore-dired-filename-prop (beg end _len) + (save-match-data + (save-excursion + (beginning-of-line) + (when (re-search-forward directory-listing-before-filename-regexp + (line-end-position) t) + (setq beg (point) + end (line-end-position)) + (put-text-property beg end 'dired-filename t))))) + (defun wdired-next-line (arg) "Move down lines then position at filename or the current column. See `wdired-use-dired-vertical-movement'. Optional prefix ARG commit 67679f0c08755d972e8a85b63f8384e94aa18fc5 Author: Stephen Berman Date: Sun Jul 29 00:22:02 2018 +0200 Add initial tests for wdired.el * test/lisp/wdired-tests.el: New file. diff --git a/test/lisp/wdired-tests.el b/test/lisp/wdired-tests.el new file mode 100644 index 0000000000..7199470ea9 --- /dev/null +++ b/test/lisp/wdired-tests.el @@ -0,0 +1,105 @@ +;;; wdired-tests.el --- tests for wdired.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2018 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; This program 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. + +;; This program 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 this program. If not, see . + +;;; Code: + +(require 'ert) +(require 'dired) + +(ert-deftest wdired-test-bug32173-01 () + "Test using non-nil wdired-use-interactive-rename. +Partially modifying a file name should succeed." + (let* ((test-dir (make-temp-file "test-dir-" t)) + (test-file (concat (file-name-as-directory test-dir) "foo.c")) + (replace "bar") + (new-file (replace-regexp-in-string "foo" replace test-file)) + (wdired-use-interactive-rename t)) + (write-region "" nil test-file nil 'silent) + (advice-add 'dired-query ; Don't ask confirmation to overwrite a file. + :override + (lambda (_sym _prompt &rest _args) (setq dired-query t)) + '((name . "advice-dired-query"))) + (let ((buf (find-file-noselect test-dir))) + (unwind-protect + (with-current-buffer buf + (should (equal (dired-file-name-at-point) test-file)) + (dired-toggle-read-only) + (kill-region (point) (progn (search-forward ".") + (forward-char -1) (point))) + (insert replace) + (wdired-finish-edit) + (should (equal (dired-file-name-at-point) new-file))) + (if buf (kill-buffer buf)) + (delete-directory test-dir t))))) + +(ert-deftest wdired-test-bug32173-02 () + "Test using non-nil wdired-use-interactive-rename. +Aborting an edit should leaving original file name unchanged." + (let* ((test-dir (make-temp-file "test-dir-" t)) + (test-file (concat (file-name-as-directory test-dir) "foo.c")) + (wdired-use-interactive-rename t)) + (write-region "" nil test-file nil 'silent) + ;; Make dired-do-create-files-regexp a noop to mimic typing C-g + ;; at its prompt before wdired-finish-edit returns. + (advice-add 'dired-do-create-files-regexp + :override + (lambda (&rest _) (ignore)) + '((name . "advice-dired-do-create-files-regexp"))) + (let ((buf (find-file-noselect test-dir))) + (unwind-protect + (with-current-buffer buf + (should (equal (dired-file-name-at-point) test-file)) + (dired-toggle-read-only) + (kill-region (point) (progn (search-forward ".") + (forward-char -1) (point))) + (insert "bar") + (wdired-finish-edit) + (should (equal (dired-get-filename) test-file))) + (if buf (kill-buffer buf)) + (delete-directory test-dir t))))) + +(ert-deftest wdired-test-unfinished-edit-01 () + "Test editing a file name without saving the change. +Finding the new name should be possible while still in +wdired-mode." + :expected-result (if (< emacs-major-version 27) :failed :passed) + (let* ((test-dir (make-temp-file "test-dir-" t)) + (test-file (concat (file-name-as-directory test-dir) "foo.c")) + (replace "bar") + (new-file (replace-regexp-in-string "foo" replace test-file))) + (write-region "" nil test-file nil 'silent) + (let ((buf (find-file-noselect test-dir))) + (unwind-protect + (with-current-buffer buf + (should (equal (dired-file-name-at-point) test-file)) + (dired-toggle-read-only) + (kill-region (point) (progn (search-forward ".") + (forward-char -1) (point))) + (insert replace) + (should (equal (dired-get-filename) new-file)))) + (when buf + (with-current-buffer buf + ;; Prevent kill-buffer-query-functions from chiming in. + (set-buffer-modified-p nil) + (kill-buffer buf))) + (delete-directory test-dir t)))) + + +(provide 'wdired-tests) +;;; wdired-tests.el ends here commit 831a3cb301be8390a6556244e19965285300ce91 Author: Stephen Berman Date: Sat Jul 28 23:58:15 2018 +0200 Fix use of non-nil wdired-use-interactive-rename This is a fairly minimal fix for the release branch; a more comprehensive fix is on master, so do not merge this to master. * lisp/wdired.el (wdired-search-and-rename): Remove dired-filename text property in order to find new filename when it only partially replaces old filename (bug#32173). If user quits before renaming succeeds, restore the dired-filename text property. diff --git a/lisp/wdired.el b/lisp/wdired.el index bb60e77776..99465212bc 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -543,19 +543,39 @@ and proceed depending on the answer." (goto-char (point-max)) (forward-line -1) (let ((done nil) + (failed t) curr-filename) (while (and (not done) (not (bobp))) (setq curr-filename (wdired-get-filename nil t)) (if (equal curr-filename filename-ori) - (progn - (setq done t) - (let ((inhibit-read-only t)) - (dired-move-to-filename) - (search-forward (wdired-get-filename t) nil t) - (replace-match (file-name-nondirectory filename-ori) t t)) - (dired-do-create-files-regexp - (function dired-rename-file) - "Move" 1 ".*" filename-new nil t)) + (unwind-protect + (progn + (setq done t) + (let ((inhibit-read-only t)) + ;; Remove dired-filename text property in order to + ;; find filename-new when it only partially + ;; replaces filename-ori (bug#32173); the text + ;; property is added again when renaming succeeds. + (remove-text-properties + (line-beginning-position) (line-end-position) + '(dired-filename nil)) + (dired-move-to-filename) + (search-forward (wdired-get-filename t) nil t) + (replace-match (file-name-nondirectory filename-ori) t t)) + (dired-do-create-files-regexp + (function dired-rename-file) + "Move" 1 ".*" filename-new nil t) + (setq failed nil)) + ;; If user quits before renaming succeeds, restore the + ;; dired-filename text property. + (when failed + (beginning-of-line) + (let ((beg (re-search-forward + directory-listing-before-filename-regexp + (line-end-position) t)) + (end (dired-move-to-end-of-filename)) + (inhibit-read-only t)) + (add-text-properties beg end '(dired-filename t))))) (forward-line -1)))))) ;; marks a list of files for deletion commit db80851a1f10d73f0b2c12299c3d77716bb8425a Author: Michael Albinus Date: Sat Jul 28 20:06:24 2018 +0200 ; Instrumentation for shadowfile.el diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el index 180d5026b6..609086772a 100644 --- a/lisp/shadowfile.el +++ b/lisp/shadowfile.el @@ -628,6 +628,10 @@ Consider them as regular expressions if third arg REGEXP is true." (defun shadow-add-to-todo () "If current buffer has shadows, add them to the list needing to be copied." + (message "shadow-add-to-todo 1 %s" (current-buffer)) + (message "shadow-add-to-todo 2 %s" (buffer-file-name)) + (message "shadow-add-to-todo 3 %s" (shadow-expand-file-name (buffer-file-name (current-buffer)))) + (message "shadow-add-to-todo 4 %s" (shadow-shadows-of (shadow-expand-file-name (buffer-file-name (current-buffer))))) (let ((shadows (shadow-shadows-of (shadow-expand-file-name (buffer-file-name (current-buffer)))))) commit 3f0709b328346d3729b2eab710fb5211a122e74f Author: Eli Zaretskii Date: Sat Jul 28 20:34:57 2018 +0300 Make 'tis620-2533' character set be an alias for 'thai-iso8859-11' * lisp/simple.el (what-cursor-position): Revert ad-hoc change to work around tis620-2533 charset. * lisp/w32-fns.el: Use thai-iso8859-11 instead of tis620-2533. * lisp/international/mule-conf.el (tis620-2533): Now an alias for thai-iso8859-11, not a separate character set. * lisp/international/fontset.el (charset-script-alist): Add thai-iso8859-11; fix entries for greek and hebrew. (font-encoding-alist, font-encoding-charset-alist): Use thai-iso8859-11 instead of tis620-2533. * lisp/descr-text.el (describe-char): Remove the ad-hoc code that assigns eight-bit-control characters to the eight-bit charset. diff --git a/lisp/descr-text.el b/lisp/descr-text.el index 466e44aeee..d8f8188eb1 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el @@ -404,12 +404,6 @@ relevant to POS." (charset (if eight-bit-p 'eight-bit (or (get-text-property pos 'charset) (char-charset char)))) - ;; TIS620.2533 overlaps eight-bit-control, but we want to - ;; show eight-bit for raw bytes, not some obscure character - ;; set no one heard of. - (charset (if (eq charset 'tis620-2533) - 'eight-bit - charset)) (composition (find-composition pos nil nil t)) (component-chars nil) (display-table (or (window-display-table) diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index a023d4fbc8..d4ade3cc4c 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -79,7 +79,7 @@ ("cns11643.92p7-0" . chinese-cns11643-7) ("big5" . big5) ("viscii" . viscii) - ("tis620" . tis620-2533) + ("tis620" . thai-iso8859-11) ("microsoft-cp1251" . windows-1251) ("koi8-r" . koi8-r) ("jisx0213.2000-1" . japanese-jisx0213-1) @@ -139,7 +139,7 @@ (cyrillic-iso8859-5 . iso-8859-5) (greek-iso8859-7 . iso-8859-7) (arabic-iso8859-6 . iso-8859-6) - (thai-tis620 . tis620-2533) + (thai-tis620 . thai-iso8859-11) (latin-jisx0201 . jisx0201) (katakana-jisx0201 . jisx0201) (chinese-big5-1 . big5) @@ -1233,11 +1233,12 @@ Done when `mouse-set-font' is called." (latin-iso8859-15 . latin) (latin-iso8859-16 . latin) (latin-jisx0201 . latin) + (thai-iso8859-11 . thai) (thai-tis620 . thai) (cyrillic-iso8859-5 . cyrillic) (arabic-iso8859-6 . arabic) - (greek-iso8859-7 . latin) - (hebrew-iso8859-8 . latin) + (greek-iso8859-7 . greek) + (hebrew-iso8859-8 . hebrew) (katakana-jisx0201 . kana) (chinese-gb2312 . han) (chinese-gbk . han) diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el index dc095707a2..a635c67770 100644 --- a/lisp/international/mule-conf.el +++ b/lisp/international/mule-conf.el @@ -201,6 +201,7 @@ ;; plus nbsp (define-iso-single-byte-charset 'iso-8859-11 'thai-iso8859-11 "ISO/IEC 8859/11" "Latin/Thai" 166 ?T nil "8859-11") +(define-charset-alias 'tis620-2533 'thai-iso8859-11) ;; 8859-12 doesn't (yet?) exist. @@ -229,14 +230,6 @@ :code-space [32 127] :code-offset #x0E00) -;; Fixme: doc for this, c.f. above -(define-charset 'tis620-2533 - "TIS620.2533" - :short-name "TIS620.2533" - :ascii-compatible-p t - :code-space [0 255] - :superset '(ascii eight-bit-control (thai-tis620 . 128))) - (define-charset 'jisx0201 "JISX0201" :short-name "JISX0201" diff --git a/lisp/language/thai.el b/lisp/language/thai.el index a896fe59fd..c655845e95 100644 --- a/lisp/language/thai.el +++ b/lisp/language/thai.el @@ -36,7 +36,7 @@ "8-bit encoding for ASCII (MSB=0) and Thai TIS620 (MSB=1)." :coding-type 'charset :mnemonic ?T - :charset-list '(tis620-2533)) + :charset-list '(thai-iso8859-11)) (define-coding-system-alias 'th-tis620 'thai-tis620) (define-coding-system-alias 'tis620 'thai-tis620) @@ -47,7 +47,7 @@ (charset thai-tis620) (coding-system thai-tis620 iso-8859-11 cp874) (coding-priority thai-tis620) - (nonascii-translation . tis620-2533) + (nonascii-translation . iso-8859-11) (input-method . "thai-kesmanee") (unibyte-display . thai-tis620) (features thai-util) diff --git a/lisp/simple.el b/lisp/simple.el index a45e259716..8d770478aa 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1410,7 +1410,7 @@ in *Help* buffer. See also the command `describe-char'." (if (or (not coding) (eq (coding-system-type coding) t)) (setq coding (default-value 'buffer-file-coding-system))) - (if (and (>= char #x3fff80) (<= char #x3fffff)) + (if (eq (char-charset char) 'eight-bit) (setq encoding-msg (format "(%d, #o%o, #x%x, raw-byte)" char char char)) ;; Check if the character is displayed with some `display' diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el index 825420c426..bdba32c806 100644 --- a/lisp/w32-fns.el +++ b/lisp/w32-fns.el @@ -280,7 +280,7 @@ bit output with no translation." (w32-add-charset-info "iso8859-13" 'w32-charset-baltic 1257) (w32-add-charset-info "koi8-r" 'w32-charset-russian 20866) (w32-add-charset-info "iso8859-5" 'w32-charset-russian 28595) - (w32-add-charset-info "tis620-2533" 'w32-charset-thai 874) + (w32-add-charset-info "iso8859-11" 'w32-charset-thai 874) (w32-add-charset-info "windows-1258" 'w32-charset-vietnamese 1258) (w32-add-charset-info "ksc5601.1992" 'w32-charset-johab 1361) (w32-add-charset-info "mac-roman" 'w32-charset-mac 10000) commit 4713f5d7423f0a8f2a2dd147cec70982145562d6 Merge: 1bcf5d02da bd52f37cae Author: Glenn Morris Date: Sat Jul 28 07:50:36 2018 -0700 Merge from origin/emacs-26 bd52f37 (origin/emacs-26) ; Fix last change: only MinGW runtime 5.0.2... 024d20f Fix compilation with mingw.org's MinGW 5.x headers 38b6748 Update the list of special forms in the ELisp manual 8579105 Don't fail to indent-sexp before a full sexp (Bug#31984) d24c5f2 Fix calls to modifications hooks in replace-buffer-contents 71a9151 * src/character.c (char_width): Support glyphs with faces. (... 0feb673 Display raw bytes as belonging to 'eight-bit' charset 2e2f00f ; * doc/emacs/mule.texi (International Chars): Fix last change. 00561b5 Fix inaccurate text in the user manual 5cfb7a3 Copyedits in tramp.texi, improved example with bash's readline 6f8f358 Minor Tramp doc update 2585fcb File Shadowing is not available on MS Windows 39da592 ; Minor markup change in indent.texi 2f00ffe ; bookmark-jump: Add comment about last change. commit bd52f37cae3fbc25e576f9b0a1ba42596790965f Author: Eli Zaretskii Date: Sat Jul 28 17:21:53 2018 +0300 ; Fix last change: only MinGW runtime 5.0.2 and later needs that. diff --git a/lib-src/pop.c b/lib-src/pop.c index 0b9204576b..731f951fd1 100644 --- a/lib-src/pop.c +++ b/lib-src/pop.c @@ -30,7 +30,7 @@ along with GNU Emacs. If not, see . */ #include "ntlib.h" #undef _WIN32_WINNT #define _WIN32_WINNT 0x0501 /* for getaddrinfo stuff */ -#if defined __MINGW32_VERSION && __MINGW32_VERSION >= 5000000L +#if defined __MINGW32_VERSION && __MINGW32_VERSION >= 5000002L # include #else # include diff --git a/nt/inc/ms-w32.h b/nt/inc/ms-w32.h index 0ab46e9832..d15b6da1a7 100644 --- a/nt/inc/ms-w32.h +++ b/nt/inc/ms-w32.h @@ -455,7 +455,7 @@ extern char *get_emacs_configuration_options (void); windows.h. For this to have proper effect, config.h must always be included before windows.h. */ #define _WINSOCKAPI_ 1 -#if defined __MINGW32_VERSION && __MINGW32_VERSION < 5000000L +#if !(defined __MINGW32_VERSION && __MINGW32_VERSION >= 5000002L) /* mingw.org's MinGW 5.x changed how it includes winsock.h and time.h, and now defining _WINSOCK_H skips the definition of struct timeval, which we don't want. */ diff --git a/nt/inc/sys/socket.h b/nt/inc/sys/socket.h index 3ea9542b05..de282c467e 100644 --- a/nt/inc/sys/socket.h +++ b/nt/inc/sys/socket.h @@ -49,7 +49,7 @@ along with GNU Emacs. If not, see . */ #define timeval ws_timeval #endif -#if defined __MINGW32_VERSION && __MINGW32_VERSION >= 5000000L +#if defined __MINGW32_VERSION && __MINGW32_VERSION >= 5000002L /* Need winerror.h before winsock2.h with mingw.org's MinGW 5.x, otherwise some error codes are not defined. */ # include commit 024d20f81e643fe1739d28d16501a8c4f7a860c6 Author: Eli Zaretskii Date: Sat Jul 28 15:34:00 2018 +0300 Fix compilation with mingw.org's MinGW 5.x headers diff --git a/lib-src/pop.c b/lib-src/pop.c index 10aac957d4..0b9204576b 100644 --- a/lib-src/pop.c +++ b/lib-src/pop.c @@ -30,8 +30,12 @@ along with GNU Emacs. If not, see . */ #include "ntlib.h" #undef _WIN32_WINNT #define _WIN32_WINNT 0x0501 /* for getaddrinfo stuff */ -#include -#include +#if defined __MINGW32_VERSION && __MINGW32_VERSION >= 5000000L +# include +#else +# include +#endif +# include #undef getaddrinfo #define getaddrinfo sys_getaddrinfo #undef freeaddrinfo diff --git a/nt/inc/ms-w32.h b/nt/inc/ms-w32.h index ff4317817e..0ab46e9832 100644 --- a/nt/inc/ms-w32.h +++ b/nt/inc/ms-w32.h @@ -455,7 +455,12 @@ extern char *get_emacs_configuration_options (void); windows.h. For this to have proper effect, config.h must always be included before windows.h. */ #define _WINSOCKAPI_ 1 -#define _WINSOCK_H +#if defined __MINGW32_VERSION && __MINGW32_VERSION < 5000000L +/* mingw.org's MinGW 5.x changed how it includes winsock.h and time.h, + and now defining _WINSOCK_H skips the definition of struct timeval, + which we don't want. */ +# define _WINSOCK_H +#endif /* Defines size_t and alloca (). */ #include diff --git a/nt/inc/sys/socket.h b/nt/inc/sys/socket.h index 2582cbdaef..3ea9542b05 100644 --- a/nt/inc/sys/socket.h +++ b/nt/inc/sys/socket.h @@ -49,6 +49,11 @@ along with GNU Emacs. If not, see . */ #define timeval ws_timeval #endif +#if defined __MINGW32_VERSION && __MINGW32_VERSION >= 5000000L +/* Need winerror.h before winsock2.h with mingw.org's MinGW 5.x, + otherwise some error codes are not defined. */ +# include +#endif #include #include /* process.c uses uint16_t (from C99) for IPv6, but commit 1bcf5d02da96784a04034b4c0aba8fdfa1413c4e Author: Phil Sainty Date: Wed Jul 18 19:32:11 2018 +1200 * lisp/vc/diff.el (diff-buffer-with-file): Support indirect buffers. (Bug#32195) diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el index b850350cd8..ac94586cac 100644 --- a/lisp/vc/diff.el +++ b/lisp/vc/diff.el @@ -226,8 +226,9 @@ With prefix arg, prompt for diff switches." "View the differences between BUFFER and its associated file. This requires the external program `diff' to be in your `exec-path'." (interactive "bBuffer: ") - (with-current-buffer (get-buffer (or buffer (current-buffer))) - (diff buffer-file-name (current-buffer) nil 'noasync))) + (let ((buf (get-buffer (or buffer (current-buffer))))) + (with-current-buffer (or (buffer-base-buffer buf) buf) + (diff buffer-file-name (current-buffer) nil 'noasync)))) (provide 'diff) commit 177deaf9a1d75043c14f0d7ef8385ece93adb07d Author: JoĂŁo Távora Date: Sat Jul 28 08:40:57 2018 +0100 Fix @include directive in Flymake doc again Problem was reintroduced by commit titled: "Mention use of C-h . (display-local-help) in Flymake manual" * doc/misc/flymake.texi: Don't @include a relative path. diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi index bdefd40d77..bda7e1428b 100644 --- a/doc/misc/flymake.texi +++ b/doc/misc/flymake.texi @@ -4,7 +4,7 @@ @set VERSION 1.0 @set UPDATED June 2018 @settitle GNU Flymake @value{VERSION} -@include ../emacs/docstyle.texi +@include docstyle.texi @syncodeindex pg cp @syncodeindex vr cp @syncodeindex fn cp commit 38b67488566de6f7c9b405ae62664b16ab135713 Author: Eli Zaretskii Date: Sat Jul 28 10:22:04 2018 +0300 Update the list of special forms in the ELisp manual * doc/lispref/eval.texi (Special Forms): * doc/lispref/frames.texi (Mouse Tracking): 'track-mouse' is nowadays a macro. (Bug#32284) diff --git a/doc/lispref/eval.texi b/doc/lispref/eval.texi index 2590de30c7..373b12e79d 100644 --- a/doc/lispref/eval.texi +++ b/doc/lispref/eval.texi @@ -506,9 +506,6 @@ Emacs Lisp with a reference to where each is described. @item setq-default @pxref{Creating Buffer-Local} -@item track-mouse -@pxref{Mouse Tracking} - @item unwind-protect @pxref{Nonlocal Exits} diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 2f9bb39886..1e008da247 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -3310,10 +3310,10 @@ occur. That is useful, because normally you don't want to track the mouse forever---only until some other event, such as the release of a button. -@defspec track-mouse body@dots{} -This special form executes @var{body}, with generation of mouse motion -events enabled. Typically, @var{body} would use @code{read-event} to -read the motion events and modify the display accordingly. @xref{Motion +@defmac track-mouse body@dots{} +This macro executes @var{body}, with generation of mouse motion events +enabled. Typically, @var{body} would use @code{read-event} to read +the motion events and modify the display accordingly. @xref{Motion Events}, for the format of mouse motion events. The value of @code{track-mouse} is that of the last form in @var{body}. @@ -3333,7 +3333,7 @@ on (@pxref{Pointer Shape}). Therefore, Lisp programs that need the mouse pointer to retain its original shape during dragging should bind @code{track-mouse} to the value @code{dragging} at the beginning of their @var{body}. -@end defspec +@end defmac The usual purpose of tracking mouse motion is to indicate on the screen the consequences of pushing or releasing a button at the current commit c0809ff23d1c7080e00726bd55d1b5322391d63f Author: Martin Rudalics Date: Sat Jul 28 09:08:30 2018 +0200 Fix problem with 'scroll-bar-adjust-thumb-portion' nil (Bug#32002) * lisp/scroll-bar.el (scroll-bar-drag-1): Do not scroll window when its buffer is fully visible and 'scroll-bar-adjust-thumb-portion' is nil (Bug#32002). diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el index 4d1ad03fa5..7efbfc7774 100644 --- a/lisp/scroll-bar.el +++ b/lisp/scroll-bar.el @@ -254,14 +254,22 @@ EVENT should be a scroll bar click or drag event." (let* ((start-position (event-start event)) (window (nth 0 start-position)) (portion-whole (nth 2 start-position))) - (save-excursion - (with-current-buffer (window-buffer window) - ;; Calculate position relative to the accessible part of the buffer. - (goto-char (+ (point-min) - (scroll-bar-scale portion-whole - (- (point-max) (point-min))))) - (vertical-motion 0 window) - (set-window-start window (point)))))) + ;; With 'scroll-bar-adjust-thumb-portion' nil and 'portion-whole' + ;; indicating that the buffer is fully visible, do not scroll the + ;; window since that might make it impossible to scroll it back + ;; with GTK's thumb (Bug#32002). + (when (or scroll-bar-adjust-thumb-portion + (not (numberp (car portion-whole))) + (not (numberp (cdr portion-whole))) + (/= (car portion-whole) (cdr portion-whole))) + (save-excursion + (with-current-buffer (window-buffer window) + ;; Calculate position relative to the accessible part of the buffer. + (goto-char (+ (point-min) + (scroll-bar-scale portion-whole + (- (point-max) (point-min))))) + (vertical-motion 0 window) + (set-window-start window (point))))))) (defun scroll-bar-drag (event) "Scroll the window by dragging the scroll bar slider. commit 857910539313c0f2d89fe5626a41f1abe6c33ca7 Author: Noam Postavsky Date: Fri Jul 27 19:41:39 2018 -0400 Don't fail to indent-sexp before a full sexp (Bug#31984) * lisp/emacs-lisp/lisp-mode.el (indent-sexp): Only signal error if the initial forward-sexp fails. Suppress scan-error forn any of the forward-sexp calls after that. * test/lisp/emacs-lisp/lisp-mode-tests.el (indent-sexp-cant-go): New test. diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 44b27236a9..205c810b97 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -1199,14 +1199,22 @@ ENDPOS is encountered." (setq endpos (copy-marker (if endpos endpos ;; Get error now if we don't have a complete sexp - ;; after point. We actually look for a sexp which - ;; ends after the current line so that we properly - ;; indent things like #s(...). This might not be - ;; needed if Bug#15998 is fixed. - (let ((eol (line-end-position))) - (save-excursion (while (and (< (point) eol) (not (eobp))) - (forward-sexp 1)) - (point)))))) + ;; after point. + (save-excursion + (let ((eol (line-end-position))) + (forward-sexp 1) + ;; We actually look for a sexp which ends + ;; after the current line so that we properly + ;; indent things like #s(...). This might not + ;; be needed if Bug#15998 is fixed. + (condition-case () + (while (and (< (point) eol) (not (eobp))) + (forward-sexp 1)) + ;; But don't signal an error for incomplete + ;; sexps following the first complete sexp + ;; after point. + (scan-error nil))) + (point))))) (save-excursion (while (let ((indent (lisp-indent-calc-next parse-state)) (ppss (lisp-indent-state-ppss parse-state))) diff --git a/test/lisp/emacs-lisp/lisp-mode-tests.el b/test/lisp/emacs-lisp/lisp-mode-tests.el index 0b052e9fc3..30f606d381 100644 --- a/test/lisp/emacs-lisp/lisp-mode-tests.el +++ b/test/lisp/emacs-lisp/lisp-mode-tests.el @@ -125,6 +125,17 @@ noindent\" 3 #s(foo bar)\n")))) +(ert-deftest indent-sexp-cant-go () + "`indent-sexp' shouldn't error before a sexp." + ;; See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=31984#32. + (with-temp-buffer + (emacs-lisp-mode) + (insert "(())") + (goto-char (1+ (point-min))) + ;; Paredit calls `indent-sexp' from this position. + (indent-sexp) + (should (equal (buffer-string) "(())")))) + (ert-deftest lisp-indent-region () "Test basics of `lisp-indent-region'." (with-temp-buffer commit 506ed5fd5e0daf0d60be789606021f3361794322 Author: Paul Eggert Date: Fri Jul 27 14:48:04 2018 -0700 ; Merge from gnulib. diff --git a/build-aux/config.guess b/build-aux/config.guess index ced991e417..ba6af63cc4 100755 --- a/build-aux/config.guess +++ b/build-aux/config.guess @@ -2,7 +2,7 @@ # Attempt to guess a canonical system name. # Copyright 1992-2018 Free Software Foundation, Inc. -timestamp='2018-07-13' +timestamp='2018-07-18' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -392,20 +392,15 @@ case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in echo i386-pc-auroraux"$UNAME_RELEASE" exit ;; i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) - set_cc_for_build - SUN_ARCH=i386 - # If there is a compiler, see if it is configured for 64-bit objects. - # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. - # This test works for both compilers. - if [ "$CC_FOR_BUILD" != no_compiler_found ]; then - if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ - (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ - grep IS_64BIT_ARCH >/dev/null - then - SUN_ARCH=x86_64 - fi - fi - echo "$SUN_ARCH"-pc-solaris2"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`" + UNAME_REL="`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`" + case `isainfo -b` in + 32) + echo i386-pc-solaris2"$UNAME_REL" + ;; + 64) + echo x86_64-pc-solaris2"$UNAME_REL" + ;; + esac exit ;; sun4*:SunOS:6*:*) # According to config.sub, this is the proper way to canonicalize @@ -843,6 +838,17 @@ EOF *:BSD/OS:*:*) echo "$UNAME_MACHINE"-unknown-bsdi"$UNAME_RELEASE" exit ;; + arm*:FreeBSD:*:*) + UNAME_PROCESSOR=`uname -p` + set_cc_for_build + if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_PCS_VFP + then + echo "${UNAME_PROCESSOR}"-unknown-freebsd"`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`"-gnueabi + else + echo "${UNAME_PROCESSOR}"-unknown-freebsd"`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`"-gnueabihf + fi + exit ;; *:FreeBSD:*:*) UNAME_PROCESSOR=`/usr/bin/uname -p` case "$UNAME_PROCESSOR" in diff --git a/build-aux/config.sub b/build-aux/config.sub index 64f9b14b55..52eb02e29a 100755 --- a/build-aux/config.sub +++ b/build-aux/config.sub @@ -2,7 +2,7 @@ # Configuration validation subroutine script. # Copyright 1992-2018 Free Software Foundation, Inc. -timestamp='2018-07-13' +timestamp='2018-07-25' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -307,7 +307,7 @@ case $1 in os=mach ;; vsta) - basic_machine=i386-unknown + basic_machine=i386-pc os=vsta ;; isi68 | isi) @@ -371,7 +371,7 @@ case $1 in os=sysv4 ;; netbsd386) - basic_machine=i386-unknown + basic_machine=i386-pc os=netbsd ;; netwinder) commit 81d6418e6b7c3e637dccf9c856d9c4b94bd43b97 Author: Ken Brown Date: Fri Jul 27 14:24:01 2018 -0400 Fix file-name-case-insensitive-p on non-existent files * src/fileio.c (Ffile_name_case_insensitive_p): If the file doesn't exist, move up the filesystem tree until an existing directory is found. Then test that directory for case-insensitivity. (Bug#32246) diff --git a/src/fileio.c b/src/fileio.c index b92492c93a..2dcfb73b0d 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -2296,6 +2296,21 @@ The arg must be a string. */) if (!NILP (handler)) return call2 (handler, Qfile_name_case_insensitive_p, filename); + /* If the file doesn't exist, move up the filesystem tree until we + reach an existing directory or the root. */ + if (NILP (Ffile_exists_p (filename))) + { + filename = Ffile_name_directory (filename); + while (NILP (Ffile_exists_p (filename))) + { + Lisp_Object newname = expand_and_dir_to_file (filename); + /* Avoid infinite loop if the root is reported as non-existing + (impossible?). */ + if (!NILP (Fstring_equal (newname, filename))) + break; + filename = newname; + } + } filename = ENCODE_FILE (filename); return file_name_case_insensitive_p (SSDATA (filename)) ? Qt : Qnil; } commit 8c8bf7db62af2c80537b5760bea01f7da9712a0e Author: Stefan Monnier Date: Fri Jul 27 16:45:03 2018 -0400 * lisp/simple.el (event-apply-modifier): Map control+[ to C-[ diff --git a/lisp/simple.el b/lisp/simple.el index 6459531a4e..8d770478aa 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -8346,14 +8346,12 @@ LSHIFTBY is the numeric value of this modifier, in keyboard events. PREFIX is the string that represents this modifier in an event type symbol." (if (numberp event) (cond ((eq symbol 'control) - (if (and (<= (downcase event) ?z) - (>= (downcase event) ?a)) - (- (downcase event) ?a -1) - (if (and (<= (downcase event) ?Z) - (>= (downcase event) ?A)) - (- (downcase event) ?A -1) - (logior (lsh 1 lshiftby) event)))) + (if (<= 64 (upcase event) 95) + (- (upcase event) 64) + (logior (lsh 1 lshiftby) event))) ((eq symbol 'shift) + ;; FIXME: Should we also apply this "upcase" behavior of shift + ;; to non-ascii letters? (if (and (<= (downcase event) ?z) (>= (downcase event) ?a)) (upcase event) commit 22f549e3056043a6e24fdb586090b33ad0c91095 Author: Michael Albinus Date: Fri Jul 27 15:49:31 2018 +0200 ; More instrumentation for shadowfile-tests.el diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el index 910845ad40..2affe778de 100644 --- a/test/lisp/shadowfile-tests.el +++ b/test/lisp/shadowfile-tests.el @@ -687,6 +687,7 @@ guaranteed by the originator of a cluster definition." (ert-deftest shadow-test08-shadow-todo () "Check that needed shadows are added to todo." (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) + (skip-unless (file-writable-p shadow-test-remote-temporary-file-directory)) (let ((backup-inhibited t) (shadow-info-file shadow-test-info-file) @@ -742,12 +743,13 @@ guaranteed by the originator of a cluster definition." (message "Point 4") ;; Save file from "cluster2" definition. (with-temp-buffer - (message "Point 4.1") - (message "%s" file) - (message "%s" (shadow-site-primary cluster2)) - (setq buffer-file-name (concat (shadow-site-primary cluster2) file)) - (message "Point 4.2") + (message "Point 4.1") + (message "%s" file) + (message "%s" (shadow-site-primary cluster2)) + (setq buffer-file-name (concat (shadow-site-primary cluster2) file)) + (message "Point 4.2") (insert "foo") + (message "%s" buffer-file-name) (save-buffer)) (message "Point 4.3") (message "%s" (shadow-site-primary cluster2)) commit d24c5f26bf6c12bda614f90ba3345d710482005a Author: Eli Zaretskii Date: Fri Jul 27 13:04:19 2018 +0300 Fix calls to modifications hooks in replace-buffer-contents * src/editfns.c (Freplace_buffer_contents): Call the modification hooks on the entire region where replacements could have taken place. The previous attempts of being more accurate just introduced bugs. (Bug#32278) diff --git a/src/editfns.c b/src/editfns.c index a18a71e6d7..a8acff659c 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -3243,21 +3243,9 @@ differences between the two buffers. */) Instead, we announce a single modification for the entire modified region. But don't do that if the caller inhibited modification hooks, because then they don't want that. */ - ptrdiff_t from, to; if (!inhibit_modification_hooks) { - ptrdiff_t k, l; - - /* Find the first character position to be changed. */ - for (k = 0; k < size_a && !bit_is_set (ctx.deletions, k); k++) - ; - from = BEGV + k; - - /* Find the last character position to be changed. */ - for (l = size_a; l > k && !bit_is_set (ctx.deletions, l - 1); l--) - ; - to = BEGV + l; - prepare_to_modify_buffer (from, to, NULL); + prepare_to_modify_buffer (BEGV, ZV, NULL); specbind (Qinhibit_modification_hooks, Qt); modification_hooks_inhibited = true; } @@ -3310,9 +3298,8 @@ differences between the two buffers. */) if (modification_hooks_inhibited) { - ptrdiff_t updated_to = to + ZV - BEGV - size_a; - signal_after_change (from, to - from, updated_to - from); - update_compositions (from, updated_to, CHECK_INSIDE); + signal_after_change (BEGV, size_a, ZV - BEGV); + update_compositions (BEGV, ZV, CHECK_INSIDE); } return Qnil; commit 71a915153a5b4818f0a3cdebb7a1afb4fe6de374 Author: Eli Zaretskii Date: Fri Jul 27 12:33:29 2018 +0300 * src/character.c (char_width): Support glyphs with faces. (Bug#32276) diff --git a/src/character.c b/src/character.c index deac1fa22e..48268e0494 100644 --- a/src/character.c +++ b/src/character.c @@ -34,6 +34,7 @@ along with GNU Emacs. If not, see . */ #include "lisp.h" #include "character.h" #include "buffer.h" +#include "dispextern.h" #include "composite.h" #include "disptab.h" @@ -288,13 +289,15 @@ char_width (int c, struct Lisp_Char_Table *dp) if (VECTORP (disp)) for (i = 0, width = 0; i < ASIZE (disp); i++) { + int c; ch = AREF (disp, i); - if (CHARACTERP (ch)) - { - int w = CHARACTER_WIDTH (XFASTINT (ch)); - if (INT_ADD_WRAPV (width, w, &width)) - string_overflow (); - } + if (GLYPH_CODE_P (ch)) + c = GLYPH_CODE_CHAR (ch); + else if (CHARACTERP (ch)) + c = XFASTINT (ch); + int w = CHARACTER_WIDTH (c); + if (INT_ADD_WRAPV (width, w, &width)) + string_overflow (); } } return width; commit 0feb6733d4bea5f360abc3f64bfc5b9b29087c48 Author: Eli Zaretskii Date: Fri Jul 27 09:47:37 2018 +0300 Display raw bytes as belonging to 'eight-bit' charset * lisp/descr-text.el (describe-char): * lisp/simple.el (what-cursor-position): Display characters in the range #x3FFF80..#x3FFF9F as belonging to charset 'eight-bit', not 'tis620-2533'. * lisp/international/mule-diag.el (describe-character-set): Improve description of :supplementary-p. diff --git a/lisp/descr-text.el b/lisp/descr-text.el index ddd7d801d2..00b40826f4 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el @@ -404,6 +404,12 @@ relevant to POS." (charset (if eight-bit-p 'eight-bit (or (get-text-property pos 'charset) (char-charset char)))) + ;; TIS620.2533 overlaps eight-bit-control, but we want to + ;; show eight-bit for raw bytes, not some obscure character + ;; set no one heard of. + (charset (if (eq charset 'tis620-2533) + 'eight-bit + charset)) (composition (find-composition pos nil nil t)) (component-chars nil) (display-table (or (window-display-table) diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el index 7e225607a5..b5a78338f6 100644 --- a/lisp/international/mule-diag.el +++ b/lisp/international/mule-diag.el @@ -355,7 +355,8 @@ meanings of these arguments." (:iso-revision-number "ISO revision number: " number-to-string) (:supplementary-p - "Used only as a parent of some other charset." nil))) + "Used only as a parent or a subset of some other charset, +or provided just for backward compatibility." nil))) (let ((val (get-charset-property charset (car elt)))) (when val (if (cadr elt) (insert (cadr elt))) diff --git a/lisp/simple.el b/lisp/simple.el index 8b183469f8..90fea11dc1 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1353,7 +1353,7 @@ in *Help* buffer. See also the command `describe-char'." (if (or (not coding) (eq (coding-system-type coding) t)) (setq coding (default-value 'buffer-file-coding-system))) - (if (eq (char-charset char) 'eight-bit) + (if (and (>= char #x3fff80) (<= char #x3fffff)) (setq encoding-msg (format "(%d, #o%o, #x%x, raw-byte)" char char char)) ;; Check if the character is displayed with some `display' commit 2e2f00f8a55e0092a5b81e513a732f70d5fd863b Author: Eli Zaretskii Date: Fri Jul 27 08:54:44 2018 +0300 ; * doc/emacs/mule.texi (International Chars): Fix last change. diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi index 8ced575188..6c0c5b2398 100644 --- a/doc/emacs/mule.texi +++ b/doc/emacs/mule.texi @@ -164,7 +164,7 @@ octal), which Emacs cannot interpret as part of a known encoding of some non-ASCII character. Such raw bytes are treated as if they belonged to a special character set @code{eight-bit}; Emacs displays them as escaped octal codes (this can be customized; @pxref{Display -Custom}). In this case, @kbd{C-x =} shows @samp{raw byte} instead of +Custom}). In this case, @kbd{C-x =} shows @samp{raw-byte} instead of @samp{file}. In addition, @kbd{C-x =} shows the character codes of raw bytes as if they were in the range @code{#x3FFF80..#x3FFFFF}, which is where Emacs maps them to distinguish them from Unicode commit 99a93dae241b3f779bdf9484a54f1096785c6f84 Author: Alan Mackenzie Date: Thu Jul 26 19:55:47 2018 +0000 Correctly indent C++ brace lists in member init lists. * lisp/progmodes/cc-engine.el (c-guess-basic-syntax; CASE 9B, CASE 9C): Set a limit for a backward search to the ":" introducing the member init list, when there is one, rather than the enclosing "{" or nil. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 3961ea647c..d1eb3c3d06 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -12607,7 +12607,11 @@ comment at the start of cc-engine.el for more info." (= (point) containing-sexp))) (if (eq (point) (c-point 'boi)) (c-add-syntax 'brace-list-close (point)) - (setq lim (c-most-enclosing-brace state-cache (point))) + (setq lim (or (save-excursion + (and + (c-back-over-member-initializers) + (point))) + (c-most-enclosing-brace state-cache (point)))) (c-beginning-of-statement-1 lim nil nil t) (c-add-stmt-syntax 'brace-list-close nil t lim paren-state))) @@ -12636,7 +12640,11 @@ comment at the start of cc-engine.el for more info." (goto-char containing-sexp)) (if (eq (point) (c-point 'boi)) (c-add-syntax 'brace-list-intro (point)) - (setq lim (c-most-enclosing-brace state-cache (point))) + (setq lim (or (save-excursion + (and + (c-back-over-member-initializers) + (point))) + (c-most-enclosing-brace state-cache (point)))) (c-beginning-of-statement-1 lim) (c-add-stmt-syntax 'brace-list-intro nil t lim paren-state))) commit 00561b59c46106e8fb93f1ada223531cc897757a Author: Eli Zaretskii Date: Thu Jul 26 21:38:09 2018 +0300 Fix inaccurate text in the user manual * doc/emacs/mule.texi (International Chars): Correct inaccurate description of raw bytes display by "C-x =". diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi index 401c83dd49..8ced575188 100644 --- a/doc/emacs/mule.texi +++ b/doc/emacs/mule.texi @@ -156,12 +156,19 @@ system encodes the character safely and with a single byte (@pxref{Coding Systems}). If the character's encoding is longer than one byte, Emacs shows @samp{file ...}. - As a special case, if the character lies in the range 128 (0200 -octal) through 159 (0237 octal), it stands for a raw byte that -does not correspond to any specific displayable character. Such a -character lies within the @code{eight-bit-control} character set, -and is displayed as an escaped octal character code. In this case, -@kbd{C-x =} shows @samp{part of display ...} instead of @samp{file}. +@cindex eight-bit character set +@cindex raw bytes + On rare occasions, Emacs encounters @dfn{raw bytes}: single bytes +whose values are in the range 128 (0200 octal) through 255 (0377 +octal), which Emacs cannot interpret as part of a known encoding of +some non-ASCII character. Such raw bytes are treated as if they +belonged to a special character set @code{eight-bit}; Emacs displays +them as escaped octal codes (this can be customized; @pxref{Display +Custom}). In this case, @kbd{C-x =} shows @samp{raw byte} instead of +@samp{file}. In addition, @kbd{C-x =} shows the character codes of +raw bytes as if they were in the range @code{#x3FFF80..#x3FFFFF}, +which is where Emacs maps them to distinguish them from Unicode +characters in the range @code{#x0080..#x00FF}. @cindex character set of character at point @cindex font of character at point commit a8f2d97b12bf2c5cc8ef1a1e7e4eb2ed05cf3af8 Author: Michael Albinus Date: Thu Jul 26 16:12:15 2018 +0200 ; More instrumentation for shadowfile-tests.el diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el index 83e9a36af3..910845ad40 100644 --- a/test/lisp/shadowfile-tests.el +++ b/test/lisp/shadowfile-tests.el @@ -743,6 +743,8 @@ guaranteed by the originator of a cluster definition." ;; Save file from "cluster2" definition. (with-temp-buffer (message "Point 4.1") + (message "%s" file) + (message "%s" (shadow-site-primary cluster2)) (setq buffer-file-name (concat (shadow-site-primary cluster2) file)) (message "Point 4.2") (insert "foo") commit 5cfb7a39baa0a5857915dca65e5880bc3c0c6072 Author: Michael Albinus Date: Thu Jul 26 11:54:33 2018 +0200 Copyedits in tramp.texi, improved example with bash's readline * doc/misc/tramp.texi (all): Unify some wordings. (Frequently Asked Questions): Update example with bash's readline. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index f05da84745..222f6c86b9 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -1239,7 +1239,7 @@ improvement is not always true. @cindex default user @defopt tramp-default-user -@value{tramp} file name can omit the user name part since +A @value{tramp} file name can omit the user name part since @value{tramp} substitutes the currently logged-in user name. However this substitution can be overridden with @code{tramp-default-user}. For example: @@ -1452,7 +1452,7 @@ support this command. @subsection Tunneling with ssh -With ssh, you could use the @code{ProxyCommand} entry in the +With ssh, you could use the @code{ProxyCommand} entry in @file{~/.ssh/config}: @example @@ -1588,12 +1588,12 @@ A function dedicated to @file{/etc/hosts} for host names. @item @code{tramp-parse-passwd} @findex tramp-parse-passwd -A function which parses @file{/etc/passwd} files for user names. +A function which parses @file{/etc/passwd} for user names. @item @code{tramp-parse-etc-group} @findex tramp-parse-etc-group -A function which parses @file{/etc/group} files for group names. +A function which parses @file{/etc/group} for group names. @item @code{tramp-parse-netrc} @findex tramp-parse-netrc @@ -2186,7 +2186,7 @@ of the secretfile is now owned by the user logged in from When @code{backup-directory-alist} is @code{nil} (the default), such problems do not occur. -To ``turn off'' the backup feature for @value{tramp} files and stop +To ``turn off'' the backup feature for remote files and stop @value{tramp} from saving to the backup directory, use this: @lisp @@ -2248,12 +2248,11 @@ The backup file name of @vindex auto-save-file-name-transforms Just as for backup files, similar issues of file naming affect -auto-saving @value{tramp} files. Auto-saved files are saved in the -directory specified by the user option -@code{auto-save-file-name-transforms}. By default this is set to -the local temporary directory. But in some versions of Debian -GNU/Linux, this points to the source directory where the Emacs was -compiled. Reset such values to a valid directory. +auto-saving remote files. Auto-saved files are saved in the directory +specified by the user option @code{auto-save-file-name-transforms}. +By default this is set to the local temporary directory. But in some +versions of Debian GNU/Linux, this points to the source directory +where the Emacs was compiled. Reset such values to a valid directory. Set @code{auto-save-file-name-transforms} to @code{nil} to save auto-saved files to the same directory as the original file. @@ -2756,8 +2755,8 @@ hard-coded, fixed name. Note that using @code{:0} for X11 display name here will not work as expected. An alternate approach is specify @code{ForwardX11 yes} or -@code{ForwardX11Trusted yes} in the file @file{~/.ssh/config} on the -local host. +@code{ForwardX11Trusted yes} in @file{~/.ssh/config} on the local +host. @subsection Running @code{shell} on a remote host @@ -3199,12 +3198,17 @@ source "$@{HOME@}/.iterm2_shell_integration.bash" @end group @end example -And finally, bash's readline shall not use key bindings like -@samp{C-j} to commands. Disable reading the readline initialization -file: +And finally, bash's readline should not use key bindings like +@samp{C-j} to commands. Disable this in your @file{~/.inputrc}: @example -[ $TERM = "dumb" ] && INPUTRC=/dev/null +@group +$if term=dumb +# Don't bind Control-J or it messes up @value{tramp}. +$else +"\C-j": next-history +$endif +@end group @end example @item @@ -3333,13 +3337,13 @@ When testing, ensure the remote shell is the same shell How to get notified after @value{tramp} completes file transfers? Make Emacs beep after reading from or writing to the remote host with -the following code in @file{~/.emacs} file. +the following code in @file{~/.emacs}. @lisp @group (defadvice tramp-handle-write-region (after tramp-write-beep-advice activate) - "Make tramp beep after writing a file." + "Make @value{tramp} beep after writing a file." (interactive) (beep)) @end group @@ -3347,7 +3351,7 @@ the following code in @file{~/.emacs} file. @group (defadvice tramp-handle-do-copy-or-rename-file (after tramp-copy-beep-advice activate) - "Make tramp beep after copying a file." + "Make @value{tramp} beep after copying a file." (interactive) (beep)) @end group @@ -3355,7 +3359,7 @@ the following code in @file{~/.emacs} file. @group (defadvice tramp-handle-insert-file-contents (after tramp-insert-beep-advice activate) - "Make tramp beep after inserting a file." + "Make @value{tramp} beep after inserting a file." (interactive) (beep)) @end group @@ -3393,7 +3397,7 @@ then set them with a hook as follows: @item -Why is @file{~/.sh_history} file on the remote host growing? +Why is @file{~/.sh_history} on the remote host growing? @vindex tramp-histfile-override @vindex HISTFILE@r{, environment variable} @@ -3414,7 +3418,7 @@ undesired results when using @command{bash} as remote shell. Another approach is to disable @value{tramp}'s handling of the @env{HISTFILE} at all by setting @code{tramp-histfile-override} to @code{nil}. In this case, saving history could be turned off by -putting this shell code in the @file{.bashrc} or @file{.kshrc} file: +putting this shell code in @file{.bashrc} or @file{.kshrc}: @example @group @@ -3431,7 +3435,7 @@ fi @end example For @option{ssh}-based method, add the following line to your -@file{~/.ssh/environment} file: +@file{~/.ssh/environment}: @example HISTFILE=/dev/null commit e4d6ebee213e2d6f37de839c09c05ab0a5346ce3 Author: Paul Eggert Date: Thu Jul 26 01:14:31 2018 -0700 * src/editfns.c (syms_of_editfns): Fix typo in previous change. diff --git a/src/editfns.c b/src/editfns.c index df257219e8..522cb5dcef 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -5586,9 +5586,9 @@ This variable is experimental; email 32252@debbugs.gnu.org if you need it to be non-nil. */); /* For now, default to true if bignums exist, false in traditional Emacs. */ #ifdef lisp_h_FIXNUMP - binary_as_unsigned = true; -#else binary_as_unsigned = false; +#else + binary_as_unsigned = true; #endif defsubr (&Spropertize); commit 4a56ca5bbfabbb9c581828cd91648346e6b03844 Author: Paul Eggert Date: Thu Jul 26 00:34:10 2018 -0700 %o and %x can now format signed integers Optionally treat integers as signed numbers with %o and %x format specifiers, instead of treating them as a machine-dependent two’s complement representation. This option is more machine-independent, allows formats like "#x%x" to be useful for reading later, and is better-insulated for future changes involving bignums. Setting the new variable â€binary-as-unsigned’ to nil enables the new behavior (Bug#32252). This is a simplified version of the change proposed in: https://lists.gnu.org/r/emacs-devel/2018-07/msg00763.html I simplified that proposal by omitting bitwidth modifiers, as I could not find an any example uses in the Emacs source code that needed them and doing them correctly would have been quite a bit more work for apparently little benefit. * doc/lispref/strings.texi (Formatting Strings): Document that %x and %o format negative integers in a platform-dependent way. Also, document how to format numbers so that the same values can be read back in. * etc/NEWS: Document the change. * src/editfns.c (styled_format): Treat integers as signed numbers even with %o and %x, if binary-as-unsigned is nil. Support the + and space flags with %o and %x, since they’re about signs. (syms_of_editfns): New variable binary-as-unsigned. * test/src/editfns-tests.el (read-large-integer): Test that maximal integers can be read after printing with all integer formats, if binary-as-unsigned is nil. diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 2fff3c7c75..3558f17301 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -922,7 +922,8 @@ Functions}). Thus, strings are enclosed in @samp{"} characters, and @item %o @cindex integer to octal Replace the specification with the base-eight representation of an -unsigned integer. The object can also be a nonnegative floating-point +integer. Negative integers are formatted in a platform-dependent +way. The object can also be a nonnegative floating-point number that is formatted as an integer, dropping any fraction, if the integer does not exceed machine limits. @@ -935,7 +936,8 @@ formatted as an integer, dropping any fraction. @itemx %X @cindex integer to hexadecimal Replace the specification with the base-sixteen representation of an -unsigned integer. @samp{%x} uses lower case and @samp{%X} uses upper +integer. Negative integers are formatted in a platform-dependent +way. @samp{%x} uses lower case and @samp{%X} uses upper case. The object can also be a nonnegative floating-point number that is formatted as an integer, dropping any fraction, if the integer does not exceed machine limits. @@ -1108,6 +1110,17 @@ shows only the first three characters of the representation for precision is what the local library functions of the @code{printf} family produce. +@cindex formatting numbers for rereading later + If you plan to use @code{read} later on the formatted string to +retrieve a copy of the formatted value, use a specification that lets +@code{read} reconstruct the value. To format numbers in this +reversible way you can use @samp{%s} and @samp{%S}, to format just +integers you can also use @samp{%d}, and to format just nonnegative +integers you can also use @samp{#x%x} and @samp{#o%o}. Other formats +may be problematic; for example, @samp{%d} and @samp{%g} can mishandle +NaNs and can lose precision and type, and @samp{#x%x} and @samp{#o%o} +can mishandle negative integers. @xref{Input Functions}. + @node Case Conversion @section Case Conversion in Lisp @cindex upper case diff --git a/etc/NEWS b/etc/NEWS index 995ceb67b7..089fc4053b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -812,6 +812,15 @@ between two strings. ** 'print-quoted' now defaults to t, so if you want to see (quote x) instead of 'x you will have to bind it to nil where applicable. ++++ +** Numbers formatted via %o or %x may now be formatted as signed integers. +This avoids problems in calls like (read (format "#x%x" -1)), and is +more compatible with bignums, a planned feature. To get this +behavior, set the experimental variable binary-as-unsigned to nil, +and if the new behavior breaks your code please email +32252@debbugs.gnu.org. Because %o and %x can now format signed +integers, they now support the + and space flags. + ** To avoid confusion caused by "smart quotes", the reader signals an error when reading Lisp symbols which begin with one of the following quotation characters: â€â€™â€›â€śâ€ťâ€źă€žďĽ‚＇. A symbol beginning with such a diff --git a/src/editfns.c b/src/editfns.c index 1d6040da3f..df257219e8 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -4196,8 +4196,8 @@ contain either numbered or unnumbered %-sequences but not both, except that %% can be mixed with numbered %-sequences. The + flag character inserts a + before any nonnegative number, while a -space inserts a space before any nonnegative number; these flags only -affect %d, %e, %f, and %g sequences, and the + flag takes precedence. +space inserts a space before any nonnegative number; these flags +affect only numeric %-sequences, and the + flag takes precedence. The - and 0 flags affect the width specifier, as described below. The # flag means to use an alternate display form for %o, %x, %X, %e, @@ -4736,10 +4736,22 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) } else { - /* Don't sign-extend for octal or hex printing. */ uprintmax_t x; + bool negative; if (INTEGERP (arg)) - x = XUINT (arg); + { + if (binary_as_unsigned) + { + x = XUINT (arg); + negative = false; + } + else + { + EMACS_INT i = XINT (arg); + negative = i < 0; + x = negative ? -i : i; + } + } else { double d = XFLOAT_DATA (arg); @@ -4747,8 +4759,13 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) if (! (0 <= d && d < uprintmax + 1)) xsignal1 (Qoverflow_error, arg); x = d; + negative = false; } - sprintf_bytes = sprintf (sprintf_buf, convspec, prec, x); + sprintf_buf[0] = negative ? '-' : plus_flag ? '+' : ' '; + bool signedp = negative | plus_flag | space_flag; + sprintf_bytes = sprintf (sprintf_buf + signedp, + convspec, prec, x); + sprintf_bytes += signedp; } /* Now the length of the formatted item is known, except it omits @@ -5558,6 +5575,22 @@ functions if all the text being accessed has this property. */); DEFVAR_LISP ("operating-system-release", Voperating_system_release, doc: /* The release of the operating system Emacs is running on. */); + DEFVAR_BOOL ("binary-as-unsigned", + binary_as_unsigned, + doc: /* Non-nil means `format' %x and %o treat integers as unsigned. +This has machine-dependent results. Nil means to treat integers as +signed, which is portable; for example, if N is a negative integer, +(read (format "#x%x") N) returns N only when this variable is nil. + +This variable is experimental; email 32252@debbugs.gnu.org if you need +it to be non-nil. */); + /* For now, default to true if bignums exist, false in traditional Emacs. */ +#ifdef lisp_h_FIXNUMP + binary_as_unsigned = true; +#else + binary_as_unsigned = false; +#endif + defsubr (&Spropertize); defsubr (&Schar_equal); defsubr (&Sgoto_char); diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index c828000bb4..2951270dbf 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -165,10 +165,12 @@ :type 'overflow-error) (should-error (read (substring (format "%d" most-negative-fixnum) 1)) :type 'overflow-error) - (should-error (read (format "#x%x" most-negative-fixnum)) - :type 'overflow-error) - (should-error (read (format "#o%o" most-negative-fixnum)) - :type 'overflow-error) + (let ((binary-as-unsigned nil)) + (dolist (fmt '("%d" "%s" "#o%o" "#x%x")) + (dolist (val (list most-negative-fixnum (1+ most-negative-fixnum) + -1 0 1 + (1- most-positive-fixnum) most-positive-fixnum)) + (should (eq val (read (format fmt val))))))) (should-error (read (format "#32rG%x" most-positive-fixnum)) :type 'overflow-error)) commit 19f5f7b19b0dcdae87476a3fd51c41f840b2b80f Author: Lucas Werkmeister Date: Sat Jun 9 15:01:08 2018 +0200 Notify systemd in daemon-initialized and kill-emacs (Bug#31498) With --[bg-]daemon and Type=forking, systemd will only consider the daemon to have fully started up once the original process exits, and will wait until then to start units depending on the Emacs service. To get the same functionality with --fg-daemon, use Type=notify instead of Type=simple and explicitly send a readiness notification to systemd at the point where the forked process would in --bg-daemon mode notify its parent process and cause it to exit. Similarly, notify systemd at the beginning of the shutdown process as well. (Both of these calls are successful no-ops if emacs was not started by systemd.) * etc/emacs.service: Update Type. * src/emacs.c (daemon-initialized) [HAVE_LIBSYSTEMD]: * src/emacs.c (kill-emacs) [HAVE_LIBSYSTEMD]: Call sd_notify(). diff --git a/etc/NEWS b/etc/NEWS index 21b648cbb4..995ceb67b7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -81,6 +81,14 @@ work right without some adjustment: - you can use the new 'package-quickstart' so activation of packages does not need to pay attention to 'package-load-list' or 'package-user-dir' any more. +--- +** Emacs now notifies systemd when startup finishes or shutdown begins. +Units that are ordered after 'emacs.service' will only be started +after Emacs has finished initialization and is ready for use. +(If your Emacs is installed in a non-standard location and you copied the +emacs.service file to eg ~/.config/systemd/user/, you will need to copy +the new version of the file again.) + * Changes in Emacs 27.1 diff --git a/etc/emacs.service b/etc/emacs.service index b29177b120..dbcb6bc301 100644 --- a/etc/emacs.service +++ b/etc/emacs.service @@ -7,7 +7,7 @@ Description=Emacs text editor Documentation=info:emacs man:emacs(1) https://gnu.org/software/emacs/ [Service] -Type=simple +Type=notify ExecStart=emacs --fg-daemon ExecStop=emacsclient --eval "(kill-emacs)" Environment=SSH_AUTH_SOCK=%t/keyring/ssh diff --git a/src/emacs.c b/src/emacs.c index 861d70735c..130a9f8fc8 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -2019,6 +2019,10 @@ all of which are called before Emacs is actually killed. */ { int exit_code; +#ifdef HAVE_LIBSYSTEMD + sd_notify(0, "STOPPING=1"); +#endif /* HAVE_LIBSYSTEMD */ + /* Fsignal calls emacs_abort () if it sees that waiting_for_input is set. */ waiting_for_input = 0; @@ -2479,6 +2483,13 @@ from the parent process and its tty file descriptors. */) error ("This function can only be called after loading the init files"); #ifndef WINDOWSNT + if (daemon_type == 1) + { +#ifdef HAVE_LIBSYSTEMD + sd_notify(0, "READY=1"); +#endif /* HAVE_LIBSYSTEMD */ + } + if (daemon_type == 2) { int nfd; commit 244b6827257fb0ec9c14f19b9dd01a0e1bee1d75 Author: Michael Albinus Date: Wed Jul 25 22:04:34 2018 +0200 ; More instrumentation for shadowfile-tests.el diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el index a302b1cdac..83e9a36af3 100644 --- a/test/lisp/shadowfile-tests.el +++ b/test/lisp/shadowfile-tests.el @@ -731,6 +731,9 @@ guaranteed by the originator of a cluster definition." (setq buffer-file-name file) (insert "foo") (save-buffer)) + (message "%s" file) + (message "%s" (shadow-contract-file-name (concat "/cluster2:" file))) + (message "%s" shadow-files-to-copy) (should (member (cons file (shadow-contract-file-name (concat "/cluster2:" file))) @@ -739,9 +742,15 @@ guaranteed by the originator of a cluster definition." (message "Point 4") ;; Save file from "cluster2" definition. (with-temp-buffer - (setq buffer-file-name (concat (shadow-site-primary cluster2) file)) + (message "Point 4.1") + (setq buffer-file-name (concat (shadow-site-primary cluster2) file)) + (message "Point 4.2") (insert "foo") (save-buffer)) + (message "Point 4.3") + (message "%s" (shadow-site-primary cluster2)) + (message "%s" (shadow-contract-file-name (concat "/cluster1:" file))) + (message "%s" shadow-files-to-copy) (should (member (cons commit a3b32a8be1e01ba10ecae9abc27214298467c995 Author: Eric Abrahamsen Date: Wed Jul 25 12:13:36 2018 -0700 Fix docstring of gnus-dependencies-add-header * lisp/gnus/gnus-sum.el (gnus-dependencies-add-header): Code is correct, but docs had logic of `gnus-summary-ignore-duplicates' backwards: if it's t, the Message-IDs will not be renamed. diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index e562b30170..ceb9842166 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -4310,10 +4310,10 @@ If SELECT-ARTICLES, only select those articles from GROUP." If FORCE-NEW is not nil, enter HEADER into the DEPENDENCIES table even if it was already present. -If `gnus-summary-ignore-duplicates' is nil then duplicate Message-IDs -will not be entered in the DEPENDENCIES table. Otherwise duplicate -Message-IDs will be renamed to a unique Message-ID before being -entered. +If `gnus-summary-ignore-duplicates' is non-nil then duplicate +Message-IDs will not be entered in the DEPENDENCIES table. +Otherwise duplicate Message-IDs will be renamed to a unique +Message-ID before being entered. Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (let* ((id (mail-header-id header)) commit 7d96ed541c242cb0ede4ca34df6ff97f432ac5e6 Author: Michael Albinus Date: Wed Jul 25 20:48:10 2018 +0200 ; More instrumentation for shadowfile-tests.el diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el index c38d49e61f..a302b1cdac 100644 --- a/test/lisp/shadowfile-tests.el +++ b/test/lisp/shadowfile-tests.el @@ -704,6 +704,7 @@ guaranteed by the originator of a cluster definition." (when (file-exists-p shadow-todo-file) (delete-file shadow-todo-file)) + (message "Point 1") ;; Define clusters. (setq cluster1 "cluster1" primary shadow-system-name @@ -716,6 +717,7 @@ guaranteed by the originator of a cluster definition." regexp (shadow-regexp-superquote primary)) (shadow-set-cluster cluster2 primary regexp) + (message "Point 2") ;; Define a literal group. (setq file (make-temp-name @@ -723,6 +725,7 @@ guaranteed by the originator of a cluster definition." shadow-literal-groups `((,(concat "/cluster1:" file) ,(concat "/cluster2:" file)))) + (message "Point 3") ;; Save file from "cluster1" definition. (with-temp-buffer (setq buffer-file-name file) @@ -733,6 +736,7 @@ guaranteed by the originator of a cluster definition." (cons file (shadow-contract-file-name (concat "/cluster2:" file))) shadow-files-to-copy)) + (message "Point 4") ;; Save file from "cluster2" definition. (with-temp-buffer (setq buffer-file-name (concat (shadow-site-primary cluster2) file)) @@ -745,6 +749,7 @@ guaranteed by the originator of a cluster definition." (shadow-contract-file-name (concat "/cluster1:" file))) shadow-files-to-copy)) + (message "Point 5") ;; Define a regexp group. (setq shadow-files-to-copy nil shadow-regexp-groups @@ -753,6 +758,7 @@ guaranteed by the originator of a cluster definition." ,(concat (shadow-site-primary cluster2) (shadow-regexp-superquote file))))) + (message "Point 6") ;; Save file from "cluster1" definition. (with-temp-buffer (setq buffer-file-name file) @@ -763,6 +769,7 @@ guaranteed by the originator of a cluster definition." (cons file (shadow-contract-file-name (concat "/cluster2:" file))) shadow-files-to-copy)) + (message "Point 7") ;; Save file from "cluster2" definition. (with-temp-buffer (setq buffer-file-name (concat (shadow-site-primary cluster2) file)) commit 6f8f358e7327a69fbc8f7b5a3fd5b3b170af505e Author: Michael Albinus Date: Wed Jul 25 20:26:22 2018 +0200 Minor Tramp doc update * doc/misc/tramp.texi (Frequently Asked Questions): Disable bash's INPUTRC. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 0cc0b49bc4..f05da84745 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -3199,6 +3199,14 @@ source "$@{HOME@}/.iterm2_shell_integration.bash" @end group @end example +And finally, bash's readline shall not use key bindings like +@samp{C-j} to commands. Disable reading the readline initialization +file: + +@example +[ $TERM = "dumb" ] && INPUTRC=/dev/null +@end example + @item Echoed characters after login commit 2585fcb1d722c08d9e4e49b424be03bab288faa0 Author: Michael Albinus Date: Wed Jul 25 17:34:55 2018 +0200 File Shadowing is not available on MS Windows * doc/emacs/files.texi (File Shadowing): File Shadowing is not available on MS Windows. * test/lisp/shadowfile-tests.el (shadow-test00-clusters) (shadow-test01-sites, shadow-test02-files) (shadow-test03-expand-cluster-in-file-name) (shadow-test04-contract-file-name, shadow-test05-file-match) (shadow-test06-literal-groups, shadow-test07-regexp-groups) (shadow-test08-shadow-todo, shadow-test09-shadow-copy-files): Skip under MS Windows. diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index a13a2c5bb0..e950767c38 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -875,6 +875,8 @@ You can answer ``no'' to bypass copying of this file, this time. If you want to cancel the shadowing permanently for a certain file, use @w{@kbd{M-x shadow-cancel}} to eliminate or change the shadow file group. +File Shadowing is not available on MS Windows. + @node Time Stamps @subsection Updating Time Stamps Automatically @cindex time stamps diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el index 200fb4c58c..f7b14250d7 100644 --- a/test/lisp/shadowfile-tests.el +++ b/test/lisp/shadowfile-tests.el @@ -15,10 +15,22 @@ ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see `http://www.gnu.org/licenses/'. +;; along with this program. If not, see `https://www.gnu.org/licenses/'. ;;; Commentary: +;; Some of the tests require access to a remote host files. Since +;; this could be problematic, a mock-up connection method "mock" is +;; used. Emulating a remote connection, it simply calls "sh -i". +;; Tramp's file name handlers still run, so this test is sufficient +;; except for connection establishing. + +;; If you want to test a real Tramp connection, set +;; $REMOTE_TEMPORARY_FILE_DIRECTORY to a suitable value in order to +;; overwrite the default value. If you want to skip tests accessing a +;; remote host, set this environment variable to "/dev/null" or +;; whatever is appropriate on your system. + ;; A whole test run can be performed calling the command `shadowfile-test-all'. ;;; Code: @@ -64,6 +76,7 @@ Per definition, all files are identical on the different hosts of a cluster (or site). This is not tested here; it must be guaranteed by the originator of a cluster definition." + (skip-unless (not (memq system-type '(windows-nt ms-dos)))) (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) (let ((text-quoting-style 'grave) ;; We inspect the *Messages* buffer! @@ -187,6 +200,7 @@ guaranteed by the originator of a cluster definition." Per definition, all files are identical on the different hosts of a cluster (or site). This is not tested here; it must be guaranteed by the originator of a cluster definition." + (skip-unless (not (memq system-type '(windows-nt ms-dos)))) (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) (let ((shadow-info-file shadow-test-info-file) @@ -293,6 +307,7 @@ guaranteed by the originator of a cluster definition." (ert-deftest shadow-test02-files () "Check file manipulation functions." + (skip-unless (not (memq system-type '(windows-nt ms-dos)))) (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) (let ((shadow-info-file shadow-test-info-file) @@ -368,6 +383,7 @@ guaranteed by the originator of a cluster definition." (ert-deftest shadow-test03-expand-cluster-in-file-name () "Check canonical file name of a cluster or site." + (skip-unless (not (memq system-type '(windows-nt ms-dos)))) (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) (let ((shadow-info-file shadow-test-info-file) @@ -438,6 +454,7 @@ guaranteed by the originator of a cluster definition." (ert-deftest shadow-test04-contract-file-name () "Check canonical file name of a cluster or site." + (skip-unless (not (memq system-type '(windows-nt ms-dos)))) (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) (let ((shadow-info-file shadow-test-info-file) @@ -498,6 +515,7 @@ guaranteed by the originator of a cluster definition." (ert-deftest shadow-test05-file-match () "Check `shadow-same-site' and `shadow-file-match'." + (skip-unless (not (memq system-type '(windows-nt ms-dos)))) (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) (let ((shadow-info-file shadow-test-info-file) @@ -556,6 +574,7 @@ guaranteed by the originator of a cluster definition." (ert-deftest shadow-test06-literal-groups () "Check literal group definitions." + (skip-unless (not (memq system-type '(windows-nt ms-dos)))) (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) (let ((shadow-info-file shadow-test-info-file) @@ -620,6 +639,7 @@ guaranteed by the originator of a cluster definition." (ert-deftest shadow-test07-regexp-groups () "Check regexp group definitions." + (skip-unless (not (memq system-type '(windows-nt ms-dos)))) (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) (let ((shadow-info-file shadow-test-info-file) @@ -686,6 +706,7 @@ guaranteed by the originator of a cluster definition." (ert-deftest shadow-test08-shadow-todo () "Check that needed shadows are added to todo." + (skip-unless (not (memq system-type '(windows-nt ms-dos)))) (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) (let ((backup-inhibited t) @@ -786,6 +807,7 @@ guaranteed by the originator of a cluster definition." (ert-deftest shadow-test09-shadow-copy-files () "Check that needed shadow files are copied." + (skip-unless (not (memq system-type '(windows-nt ms-dos)))) (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) (let ((backup-inhibited t) commit 39da592da8f87e0dd488aa093e3e0dfff16cab19 Author: Eli Zaretskii Date: Wed Jul 25 17:22:29 2018 +0300 ; Minor markup change in indent.texi * doc/emacs/indent.texi (Indentation Commands): Use @kbd{@key{...}} for better looks. (Bug#32248) diff --git a/doc/emacs/indent.texi b/doc/emacs/indent.texi index b38e85819c..bf43909edf 100644 --- a/doc/emacs/indent.texi +++ b/doc/emacs/indent.texi @@ -60,9 +60,9 @@ repositioned to the first non-whitespace character on the line. @node Indentation Commands @section Indentation Commands -Apart from the @key{TAB} (@code{indent-for-tab-command}) command, -Emacs provides a variety of commands to perform indentation in other -ways. +Apart from the @kbd{@key{TAB}} (@code{indent-for-tab-command}) +command, Emacs provides a variety of commands to perform indentation +in other ways. @table @kbd @item C-M-o @@ -113,8 +113,8 @@ appears after the newline that is deleted. @xref{Fill Prefix}. @item C-M-\ @kindex C-M-\ @findex indent-region -Indent all the lines in the region, as though you had typed @key{TAB} -at the beginning of each line (@code{indent-region}). +Indent all the lines in the region, as though you had typed +@kbd{@key{TAB}} at the beginning of each line (@code{indent-region}). If a numeric argument is supplied, indent every line in the region to that column number. @@ -128,11 +128,12 @@ in the region, moving the affected lines as a rigid unit. If called with no argument, the command activates a transient mode for adjusting the indentation of the affected lines interactively. While -this transient mode is active, typing @key{LEFT} or @key{RIGHT} -indents leftward and rightward, respectively, by one space. You can -also type @kbd{S-@key{LEFT}} or @kbd{S-@key{RIGHT}} to indent leftward -or rightward to the next tab stop (@pxref{Tab Stops}). Typing any -other key disables the transient mode, and resumes normal editing. +this transient mode is active, typing @kbd{@key{LEFT}} or +@kbd{@key{RIGHT}} indents leftward and rightward, respectively, by one +space. You can also type @kbd{S-@key{LEFT}} or @kbd{S-@key{RIGHT}} to +indent leftward or rightward to the next tab stop (@pxref{Tab Stops}). +Typing any other key disables the transient mode, and resumes normal +editing. If called with a prefix argument @var{n}, this command indents the lines forward by @var{n} spaces (without enabling the transient mode). commit c67407e7520a97a92737200bf559c48a927db470 Author: Michael Albinus Date: Wed Jul 25 13:18:46 2018 +0200 Instrument shadowfile{-tests} for error hunting on hydra. * lisp/shadowfile.el (shadow-make-fullname): Use changed `tramp-make-tramp-file-name' from Tramp 2.4. * test/lisp/shadowfile-tests.el (shadow-test08-shadow-todo): Instrument test. Suppress errors in cleanup. (shadow-test09-shadow-copy-files): Suppress errors in cleanup. diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el index 27d934d9fc..180d5026b6 100644 --- a/lisp/shadowfile.el +++ b/lisp/shadowfile.el @@ -307,14 +307,7 @@ Replace HOST, and NAME when non-nil." (if (null (tramp-file-name-method hup)) (format "/%s:%s" (tramp-file-name-host hup) (tramp-file-name-localname hup)) - (tramp-make-tramp-file-name - (tramp-file-name-method hup) - (tramp-file-name-user hup) - (tramp-file-name-domain hup) - (tramp-file-name-host hup) - (tramp-file-name-port hup) - (tramp-file-name-localname hup) - (tramp-file-name-hop hup))))) + (tramp-make-tramp-file-name hup)))) (defun shadow-replace-name-component (fullname newname) "Return FULLNAME with the name component changed to NEWNAME." diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el index 200fb4c58c..c38d49e61f 100644 --- a/test/lisp/shadowfile-tests.el +++ b/test/lisp/shadowfile-tests.el @@ -696,6 +696,7 @@ guaranteed by the originator of a cluster definition." shadow-files-to-copy cluster1 cluster2 primary regexp file) (unwind-protect + (condition-case err (progn ;; Cleanup. (when (file-exists-p shadow-info-file) @@ -773,16 +774,19 @@ guaranteed by the originator of a cluster definition." (concat (shadow-site-primary cluster2) file) (shadow-contract-file-name (concat "/cluster1:" file))) shadow-files-to-copy))) + (error (message "Error: %s" err) (signal (car err) (cdr err)))) ;; Cleanup. (when (file-exists-p shadow-info-file) (delete-file shadow-info-file)) (when (file-exists-p shadow-todo-file) (delete-file shadow-todo-file)) - (when (file-exists-p file) - (delete-file file)) - (when (file-exists-p (concat (shadow-site-primary cluster2) file)) - (delete-file (concat (shadow-site-primary cluster2) file)))))) + (ignore-errors + (when (file-exists-p file) + (delete-file file))) + (ignore-errors + (when (file-exists-p (concat (shadow-site-primary cluster2) file)) + (delete-file (concat (shadow-site-primary cluster2) file))))))) (ert-deftest shadow-test09-shadow-copy-files () "Check that needed shadow files are copied." @@ -864,10 +868,12 @@ guaranteed by the originator of a cluster definition." (delete-file shadow-info-file)) (when (file-exists-p shadow-todo-file) (delete-file shadow-todo-file)) - (when (file-exists-p file) - (delete-file file)) - (when (file-exists-p (concat (shadow-site-primary cluster2) file)) - (delete-file (concat (shadow-site-primary cluster2) file)))))) + (ignore-errors + (when (file-exists-p file) + (delete-file file))) + (ignore-errors + (when (file-exists-p (concat (shadow-site-primary cluster2) file)) + (delete-file (concat (shadow-site-primary cluster2) file))))))) (defun shadowfile-test-all (&optional interactive) "Run all tests for \\[shadowfile]." commit 2f00ffe5f6938f851b92dee68787f34358a49426 Author: Noam Postavsky Date: Tue Jul 24 18:45:43 2018 -0400 ; bookmark-jump: Add comment about last change. diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 9299ab8850..464324cea0 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -1110,6 +1110,9 @@ DISPLAY-FUNC would be `switch-to-buffer-other-window'." (unless bookmark (error "No bookmark specified")) (bookmark-maybe-historicize-string bookmark) + ;; Don't use `switch-to-buffer' because it would let the + ;; window-point override the bookmark's point when + ;; `switch-to-buffer-preserve-window-point' is non-nil. (bookmark--jump-via bookmark (or display-func 'pop-to-buffer-same-window))) commit 200195e824befa112459c0afbac7c94aea739573 Author: Paul Eggert Date: Tue Jul 24 15:58:46 2018 -0700 Move proper-list-p to C Since C code can use it and it’s simple, we might as well use C. * lisp/subr.el (proper-list-p): Move to C code. * src/eval.c (signal_error): Simplify by using Fproper_list_p. * src/fns.c (Fproper_list_p): New function, moved here from Lisp. Simplify signal_error * src/eval.c (signal_error): Simplify by using FOR_EACH_TAIL_SAFE. diff --git a/lisp/subr.el b/lisp/subr.el index 10343e69db..6b30371a86 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -555,12 +555,6 @@ If N is omitted or nil, remove the last element." (if (> n 0) (setcdr (nthcdr (- (1- m) n) list) nil)) list)))) -(defun proper-list-p (object) - "Return OBJECT's length if it is a proper list, nil otherwise. -A proper list is neither circular nor dotted (i.e., its last cdr -is nil)." - (and (listp object) (ignore-errors (length object)))) - (defun delete-dups (list) "Destructively remove `equal' duplicates from LIST. Store the result in LIST and return it. LIST must be a proper list. diff --git a/src/eval.c b/src/eval.c index 256ca8ffdc..5964dd1867 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1732,28 +1732,12 @@ xsignal3 (Lisp_Object error_symbol, Lisp_Object arg1, Lisp_Object arg2, Lisp_Obj } /* Signal `error' with message S, and additional arg ARG. - If ARG is not a genuine list, make it a one-element list. */ + If ARG is not a proper list, make it a one-element list. */ void signal_error (const char *s, Lisp_Object arg) { - Lisp_Object tortoise, hare; - - hare = tortoise = arg; - while (CONSP (hare)) - { - hare = XCDR (hare); - if (!CONSP (hare)) - break; - - hare = XCDR (hare); - tortoise = XCDR (tortoise); - - if (EQ (hare, tortoise)) - break; - } - - if (!NILP (hare)) + if (NILP (Fproper_list_p (arg))) arg = list1 (arg); xsignal (Qerror, Fcons (build_string (s), arg)); diff --git a/src/fns.c b/src/fns.c index e7424c3471..5247140ead 100644 --- a/src/fns.c +++ b/src/fns.c @@ -144,6 +144,28 @@ which is at least the number of distinct elements. */) return make_fixnum_or_float (len); } +DEFUN ("proper-list-p", Fproper_list_p, Sproper_list_p, 1, 1, 0, + doc: /* Return OBJECT's length if it is a proper list, nil otherwise. +A proper list is neither circular nor dotted (i.e., its last cdr is nil). */ + attributes: const) + (Lisp_Object object) +{ + intptr_t len = 0; + Lisp_Object last_tail = object; + Lisp_Object tail = object; + FOR_EACH_TAIL_SAFE (tail) + { + len++; + rarely_quit (len); + last_tail = XCDR (tail); + } + if (!NILP (last_tail)) + return Qnil; + if (MOST_POSITIVE_FIXNUM < len) + xsignal0 (Qoverflow_error); + return make_number (len); +} + DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0, doc: /* Return the number of bytes in STRING. If STRING is multibyte, this may be greater than the length of STRING. */) @@ -5295,6 +5317,7 @@ this variable. */); defsubr (&Srandom); defsubr (&Slength); defsubr (&Ssafe_length); + defsubr (&Sproper_list_p); defsubr (&Sstring_bytes); defsubr (&Sstring_distance); defsubr (&Sstring_equal); diff --git a/src/lisp.h b/src/lisp.h index 8ddd363d2d..96de60e467 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4699,7 +4699,7 @@ enum #define FOR_EACH_TAIL(tail) \ FOR_EACH_TAIL_INTERNAL (tail, circular_list (tail), true) -/* Like FOR_EACH_TAIL (LIST), except do not signal or quit. +/* Like FOR_EACH_TAIL (TAIL), except do not signal or quit. If the loop exits due to a cycle, TAIL’s value is undefined. */ #define FOR_EACH_TAIL_SAFE(tail) \ commit 0ed21b7b3e71303d7858192246012f4b26438ad8 Author: Paul Eggert Date: Tue Jul 24 10:01:16 2018 -0700 * etc/NEWS: Omit bug# when not needed. diff --git a/etc/NEWS b/etc/NEWS index 83110a210f..21b648cbb4 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -685,7 +685,7 @@ as new-style, bind the new variable 'force-new-style-backquotes' to t. ** When formatting a floating-point number as an octal or hexadecimal integer, Emacs now signals an error if the number is too large for the -implementation to format (Bug#30408). +implementation to format. +++ ** The Lisp reader now signals an overflow for plain decimal integers @@ -694,7 +694,7 @@ reader silently converted them to floating-point numbers, and signaled overflow only for integers with a radix that are outside machine range. To get the old behavior, set the new, experimental variable read-integer-overflow-as-float to t and please email -30408@debbugs.gnu.org if you need that. (Bug#30408). +30408@debbugs.gnu.org if you need that. --- ** Some functions and variables obsolete since Emacs 22 have been removed: @@ -828,12 +828,12 @@ The new variable 'comment-use-syntax-ppss' can be set to nil to recover the old behavior if needed. ** The 'server-name' and 'server-socket-dir' variables are set when a -socket has been passed to Emacs (Bug#24218). +socket has been passed to Emacs. --- ** The 'file-system-info' function is now available on all platforms. instead of just Microsoft platforms. This fixes a 'get-free-disk-space' -bug on OS X 10.8 and later (Bug#28639). +bug on OS X 10.8 and later. +++ ** 'memory-limit' now returns a better estimate of memory consumption. @@ -862,7 +862,7 @@ If the optional third argument is non-nil, 'make-string' will produce a multibyte string even if its second argument is an ASCII character. ** (format "%d" X) no longer mishandles a floating-point number X that -does not fit in a machine integer (Bug#30408). +does not fit in a machine integer. ** New JSON parsing and serialization functions 'json-serialize', 'json-insert', 'json-parse-string', and 'json-parse-buffer'. These commit 64f94785c7ef76de160649054ec970f62af49472 Merge: 8c6a50230e f64c2774e9 Author: Glenn Morris Date: Tue Jul 24 06:40:58 2018 -0700 Merge from origin/emacs-26 f64c277 (origin/emacs-26) Let bookmark-jump override window-point (Bu... 1208aaa Omit keymap from subword-mode docstring (Bug#32212) 2b70b54 Prevent line-mode term from showing user passwords 5de4441 Check for special filenames in eshell (Bug#30724) 1b4b965 Fix indent-sexp of #s(...) (Bug#31984) 59e8533 Add save-match-data to abbreviate-file-name (Bug#32201) 47f75b1 Fix last change in editfns.c 671dc5a Fix calls to buffer modification hooks from replace-buffer-co... cc4ceed ; etc/NEWS: Remove unnecessary reference to a bug number. e0f33ea Fix Bug#32226 7308fa0 Improve doc strings of several variables in keyboard.c commit 8c6a50230eda7a0773dcf0e6530d064e28df357c Author: Michael Albinus Date: Tue Jul 24 10:16:22 2018 +0200 Fix typo in `find-alternate-file' * lisp/files.el (find-alternate-file): Add missing arguments to `find-file-noselect' call. diff --git a/lisp/files.el b/lisp/files.el index eabb3c0e06..468650db8a 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1830,7 +1830,7 @@ killed." ;; Don't use `find-file' because it may end up using another window ;; in some corner cases, e.g. when the selected window is ;; softly-dedicated. - (let ((newbuf (find-file-noselect filename wildcards))) + (let ((newbuf (find-file-noselect filename nil nil wildcards))) (switch-to-buffer newbuf))) (when (eq obuf (current-buffer)) ;; This executes if find-file gets an error commit f64c2774e96c755a5fddcbc49db65dcc3fcb9323 Author: Noam Postavsky Date: Mon Jul 23 21:49:00 2018 -0400 Let bookmark-jump override window-point (Bug#31751) * lisp/bookmark.el (bookmark-jump): Use pop-to-buffer-same-window instead of switch-to-buffer, the latter obeys switch-to-buffer-preserve-window-point and so loses the bookmark's point. diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 1a2ec1eb66..9299ab8850 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -1102,7 +1102,7 @@ BOOKMARK is usually a bookmark name (a string). It can also be a bookmark record, but this is usually only done by programmatic callers. If DISPLAY-FUNC is non-nil, it is a function to invoke to display the -bookmark. It defaults to `switch-to-buffer'. A typical value for +bookmark. It defaults to `pop-to-buffer-same-window'. A typical value for DISPLAY-FUNC would be `switch-to-buffer-other-window'." (interactive (list (bookmark-completing-read "Jump to bookmark" @@ -1110,7 +1110,7 @@ DISPLAY-FUNC would be `switch-to-buffer-other-window'." (unless bookmark (error "No bookmark specified")) (bookmark-maybe-historicize-string bookmark) - (bookmark--jump-via bookmark (or display-func 'switch-to-buffer))) + (bookmark--jump-via bookmark (or display-func 'pop-to-buffer-same-window))) ;;;###autoload commit 90256285e107641b064d6ec51a9c5bb03c3eee6a Author: Paul Eggert Date: Mon Jul 23 10:23:35 2018 -0700 (format "%#x" 0) yields "0", not "0x0" * doc/lispref/strings.texi (Formatting Strings): * src/editfns.c (Fformat): Document this. diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index f68199e9f9..2fff3c7c75 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -1025,7 +1025,7 @@ both flags are used, @samp{+} takes precedence. The flag @samp{#} specifies an alternate form which depends on the format in use. For @samp{%o}, it ensures that the result begins -with a @samp{0}. For @samp{%x} and @samp{%X}, it prefixes the result +with a @samp{0}. For @samp{%x} and @samp{%X}, it prefixes nonzero results with @samp{0x} or @samp{0X}. For @samp{%e} and @samp{%f}, the @samp{#} flag means include a decimal point even if the precision is zero. For @samp{%g}, it always includes a decimal point, and also diff --git a/src/editfns.c b/src/editfns.c index ccc0d27b13..09f836c3eb 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -4202,7 +4202,7 @@ The - and 0 flags affect the width specifier, as described below. The # flag means to use an alternate display form for %o, %x, %X, %e, %f, and %g sequences: for %o, it ensures that the result begins with -\"0\"; for %x and %X, it prefixes the result with \"0x\" or \"0X\"; +\"0\"; for %x and %X, it prefixes nonzero results with \"0x\" or \"0X\"; for %e and %f, it causes a decimal point to be included even if the precision is zero; for %g, it causes a decimal point to be included even if the precision is zero, and also forces trailing commit 1208aaa9893700292693a6b85ae7d1abdb0460ef Author: Noam Postavsky Date: Sun Jul 22 16:15:43 2018 -0400 Omit keymap from subword-mode docstring (Bug#32212) * lisp/progmodes/subword.el (subword-mode): Remove listing of subword-mode-map bindings, since it is empty as of 2014-03-23 "Merge capitalized-words-mode and subword-mode". diff --git a/lisp/progmodes/subword.el b/lisp/progmodes/subword.el index cbaa273a7a..c09ba37c85 100644 --- a/lisp/progmodes/subword.el +++ b/lisp/progmodes/subword.el @@ -113,9 +113,7 @@ called a `subword'. Here are some examples: NSGraphicsContext => \"NS\", \"Graphics\" and \"Context\" This mode changes the definition of a word so that word commands -treat nomenclature boundaries as word boundaries. - -\\{subword-mode-map}" +treat nomenclature boundaries as word boundaries." :lighter " ," (when subword-mode (superword-mode -1)) (subword-setup-buffer)) commit 2b70b54739a8a422aff85f0183fb69eb339c35d4 Author: Tino Calancha Date: Thu Feb 15 09:09:50 2018 +0900 Prevent line-mode term from showing user passwords For buffers whose mode derive from comint-mode, the user password is read from the minibuffer and it's hidden. A buffer in term-mode and line submode, instead shows the passwords. Make buffers in line term-mode to hide passwords too (Bug#30190). * lisp/term.el (term-send-invisible): Prefer the more robust `read-passwd' instead of `term-read-noecho'. (term-watch-for-password-prompt): New function. (term-emulate-terminal): Call it each time we receive non-escape sequence output. Co-authored-by: Noam Postavsky diff --git a/lisp/term.el b/lisp/term.el index b7f5b0e7f2..ae451e94bd 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -347,6 +347,7 @@ (eval-when-compile (require 'cl-lib)) (require 'ring) (require 'ehelp) +(require 'comint) ; Password regexp. (declare-function ring-empty-p "ring" (ring)) (declare-function ring-ref "ring" (ring index)) @@ -2283,12 +2284,10 @@ applications." (defun term-send-invisible (str &optional proc) "Read a string without echoing. Then send it to the process running in the current buffer. A new-line -is additionally sent. String is not saved on term input history list. -Security bug: your string can still be temporarily recovered with -\\[view-lossage]." +is additionally sent. String is not saved on term input history list." (interactive "P") ; Defeat snooping via C-x esc (when (not (stringp str)) - (setq str (term-read-noecho "Non-echoed text: " t))) + (setq str (read-passwd "Non-echoed text: "))) (when (not proc) (setq proc (get-buffer-process (current-buffer)))) (if (not proc) (error "Current buffer has no process") @@ -2297,6 +2296,16 @@ Security bug: your string can still be temporarily recovered with (term-send-string proc str) (term-send-string proc "\n"))) +;; TODO: Maybe combine this with `comint-watch-for-password-prompt'. +(defun term-watch-for-password-prompt (string) + "Prompt in the minibuffer for password and send without echoing. +Checks if STRING contains a password prompt as defined by +`comint-password-prompt-regexp'." + (when (term-in-line-mode) + (when (let ((case-fold-search t)) + (string-match comint-password-prompt-regexp string)) + (term-send-invisible (read-passwd string))))) + ;;; Low-level process communication @@ -3152,6 +3161,8 @@ See `term-prompt-regexp'." (term-handle-deferred-scroll)) (set-marker (process-mark proc) (point)) + (when (stringp decoded-substring) + (term-watch-for-password-prompt decoded-substring)) (when save-point (goto-char save-point) (set-marker save-point nil)) commit 57c4bc146b7e17b6f662604047cb5d10982f962c Author: Paul Eggert Date: Mon Jul 23 00:57:06 2018 -0700 0x%x → %#x in elisp formats * lisp/emacs-lisp/cl-print.el (cl-print-object): * lisp/profiler.el (profiler-format-entry): * lisp/progmodes/hideif.el (hif-evaluate-macro): Prefer %#x to 0x%x in elisp formats when formatting arbitrary integers, as it’ll produce more-readable output with negative args should we change how negative values are printed with %x. diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index 1eae8faf23..bf5b1e878d 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -109,7 +109,7 @@ call other entry points instead, such as `cl-prin1'." (princ (hash-table-count object) stream) (princ "/" stream) (princ (hash-table-size object) stream) - (princ (format " 0x%x" (sxhash object)) stream) + (princ (format " %#x" (sxhash object)) stream) (princ ">" stream)) (define-button-type 'help-byte-code @@ -166,7 +166,7 @@ into a button whose action shows the function's disassembly.") (let ((button-start (and cl-print-compiled-button (bufferp stream) (with-current-buffer stream (point))))) - (princ (format "#" (sxhash object)) stream) + (princ (format "#" (sxhash object)) stream) (when (eq cl-print-compiled 'static) (princ " " stream) (cl-print-object (aref object 2) stream)) diff --git a/lisp/profiler.el b/lisp/profiler.el index eaeb69793f..41dea68bd1 100644 --- a/lisp/profiler.el +++ b/lisp/profiler.el @@ -105,13 +105,13 @@ "Format ENTRY in human readable string. ENTRY would be a function name of a function itself." (cond ((memq (car-safe entry) '(closure lambda)) - (format "#" (sxhash entry))) + (format "#" (sxhash entry))) ((byte-code-function-p entry) - (format "#" (sxhash entry))) + (format "#" (sxhash entry))) ((or (subrp entry) (symbolp entry) (stringp entry)) (format "%s" entry)) (t - (format "#" (sxhash entry))))) + (format "#" (sxhash entry))))) (defun profiler-fixup-entry (entry) (if (symbolp entry) diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index ce7127a3d7..24ad2ff6c7 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -1625,7 +1625,7 @@ not be expanded." ((integerp result) (if (or (= 0 result) (= 1 result)) (message "%S <= `%s'" result exprstring) - (message "%S (0x%x) <= `%s'" result result exprstring))) + (message "%S (%#x) <= `%s'" result result exprstring))) ((null result) (message "%S <= `%s'" 'false exprstring)) ((eq t result) (message "%S <= `%s'" 'true exprstring)) (t (message "%S <= `%s'" result exprstring))) commit 109cb1520c690038d387aa290bb03261f7c5a1f6 Author: Paul Eggert Date: Mon Jul 23 00:05:25 2018 -0700 positive → nonnegative doc fixes * doc/lispref/numbers.texi (Bitwise Operations) (Math Functions): * doc/lispref/strings.texi (Formatting Strings): * src/editfns.c (Fformat): Correct “positive” with “nonnegative” in some documentation. diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi index 70bb103041..14d5059ffb 100644 --- a/doc/lispref/numbers.texi +++ b/doc/lispref/numbers.texi @@ -853,7 +853,7 @@ reproducing the same pattern moved over. bits in @var{integer1} to the left @var{count} places, or to the right if @var{count} is negative, bringing zeros into the vacated bits. If @var{count} is negative, @code{lsh} shifts zeros into the leftmost -(most-significant) bit, producing a positive result even if +(most-significant) bit, producing a nonnegative result even if @var{integer1} is negative. Contrast this with @code{ash}, below. Here are two examples of @code{lsh}, shifting a pattern of bits one @@ -1233,7 +1233,7 @@ returns a NaN. @defun expt x y This function returns @var{x} raised to power @var{y}. If both -arguments are integers and @var{y} is positive, the result is an +arguments are integers and @var{y} is nonnegative, the result is an integer; in this case, overflow causes truncation, so watch out. If @var{x} is a finite negative number and @var{y} is a finite non-integer, @code{expt} returns a NaN. diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 026ba749cb..f68199e9f9 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -1015,11 +1015,11 @@ numbered or unnumbered format specifications but not both, except that After the @samp{%} and any field number, you can put certain @dfn{flag characters}. - The flag @samp{+} inserts a plus sign before a positive number, so + The flag @samp{+} inserts a plus sign before a nonnegative number, so that it always has a sign. A space character as flag inserts a space -before a positive number. (Otherwise, positive numbers start with the -first digit.) These flags are useful for ensuring that positive -numbers and negative numbers use the same number of columns. They are +before a nonnegative number. (Otherwise, nonnegative numbers start with the +first digit.) These flags are useful for ensuring that nonnegative +and negative numbers use the same number of columns. They are ignored except for @samp{%d}, @samp{%e}, @samp{%f}, @samp{%g}, and if both flags are used, @samp{+} takes precedence. diff --git a/src/editfns.c b/src/editfns.c index 4dbf480572..ccc0d27b13 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -4195,8 +4195,8 @@ Nth argument is substituted instead of the next one. A format can contain either numbered or unnumbered %-sequences but not both, except that %% can be mixed with numbered %-sequences. -The + flag character inserts a + before any positive number, while a -space inserts a space before any positive number; these flags only +The + flag character inserts a + before any nonnegative number, while a +space inserts a space before any nonnegative number; these flags only affect %d, %e, %f, and %g sequences, and the + flag takes precedence. The - and 0 flags affect the width specifier, as described below. commit 216b9b2dbff4cd6843d988c1e2df81b1e02a52fd Author: Lars Ingebrigtsen Date: Mon Jul 23 09:01:24 2018 +0200 Revert "Make nnimap support IMAP namespaces" This reverts commit 7b5b3ddb2dfa98d640aff7b5b160f777e22cc794. Insufficiently tested before committing -- bugs out several places when not using namespaces. diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index cd97cff2a0..6793ed2e9f 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -14320,12 +14320,6 @@ fetch all textual parts, while leaving the rest on the server. If non-@code{nil}, record all @acronym{IMAP} commands in the @samp{"*imap log*"} buffer. -@item nnimap-use-namespaces -If non-@code{nil}, omit the IMAP namespace prefix in nnimap group -names. If your IMAP mailboxes are called something like @samp{INBOX} -and @samp{INBOX.Lists.emacs}, but you'd like the nnimap group names to -be @samp{INBOX} and @samp{Lists.emacs}, you should enable this option. - @end table diff --git a/etc/NEWS b/etc/NEWS index 57b51f61b6..fc2a5d4c03 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -46,11 +46,6 @@ option --enable-check-lisp-object-type is therefore no longer as useful and so is no longer enabled by default in developer builds, to reduce differences between developer and production builds. -** Gnus - -+++ -*** The nnimap backend now has support for IMAP namespaces. - * Startup Changes in Emacs 27.1 diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index af7899f789..3b39731927 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -55,13 +55,6 @@ If nnimap-stream is `ssl', this will default to `imaps'. If not, it will default to `imap'.") -(defvoo nnimap-use-namespaces nil - "Whether to use IMAP namespaces. -If in Gnus your folder names in all start with (e.g.) `INBOX', -you probably want to set this to t. The effects of this are -purely cosmetical, but changing this variable will affect the -names of your nnimap groups. ") - (defvoo nnimap-stream 'undecided "How nnimap talks to the IMAP server. The value should be either `undecided', `ssl' or `tls', @@ -117,8 +110,6 @@ some servers.") (defvoo nnimap-current-infos nil) -(defvoo nnimap-namespace nil) - (defun nnimap-decode-gnus-group (group) (decode-coding-string group 'utf-8)) @@ -175,18 +166,6 @@ textual parts.") (defvar nnimap-inhibit-logging nil) -(defun nnimap-group-to-imap (group) - "Convert Gnus group name to IMAP mailbox name." - (let* ((inbox (substring nnimap-namespace 0 -1))) - (utf7-encode - (cond ((or (not nnimap-namespace) - (string-equal group inbox)) - group) - ((string-prefix-p "#" group) - (substring group 1)) - (t - (concat nnimap-namespace group))) t))) - (defun nnimap-buffer () (nnimap-find-process-buffer nntp-server-buffer)) @@ -463,8 +442,7 @@ textual parts.") (props (cdr stream-list)) (greeting (plist-get props :greeting)) (capabilities (plist-get props :capabilities)) - (stream-type (plist-get props :type)) - (server (nnoo-current-server 'nnimap))) + (stream-type (plist-get props :type))) (when (and stream (not (memq (process-status stream) '(open run)))) (setq stream nil)) @@ -497,7 +475,9 @@ textual parts.") ;; the virtual server name and the address (nnimap-credentials (gnus-delete-duplicates - (list server nnimap-address)) + (list + (nnoo-current-server 'nnimap) + nnimap-address)) ports nnimap-user)))) (setq nnimap-object nil) @@ -516,17 +496,8 @@ textual parts.") (dolist (response (cddr (nnimap-command "CAPABILITY"))) (when (string= "CAPABILITY" (upcase (car response))) (setf (nnimap-capabilities nnimap-object) - (mapcar #'upcase (cdr response))))) - (when (and nnimap-use-namespaces - (nnimap-capability "NAMESPACE")) - (erase-buffer) - (nnimap-wait-for-response (nnimap-send-command "NAMESPACE")) - (let ((response (nnimap-last-response-string))) - (when (string-match - "^\\*\\W+NAMESPACE\\W+((\"\\([^\"\n]+\\)\"\\W+\"\\(.\\)\"))\\W+" - response) - (setq nnimap-namespace (match-string 1 response)))))) - ;; If the login failed, then forget the credentials + (mapcar #'upcase (cdr response)))))) + ;; If the login failed, then forget the credentials ;; that are now possibly cached. (dolist (host (list (nnoo-current-server 'nnimap) nnimap-address)) @@ -866,7 +837,7 @@ textual parts.") (with-current-buffer (nnimap-buffer) (erase-buffer) (let ((group-sequence - (nnimap-send-command "SELECT %S" (nnimap-group-to-imap group))) + (nnimap-send-command "SELECT %S" (utf7-encode group t))) (flag-sequence (nnimap-send-command "UID FETCH 1:* FLAGS"))) (setf (nnimap-group nnimap-object) group) @@ -899,13 +870,13 @@ textual parts.") (setq group (nnimap-decode-gnus-group group)) (when (nnimap-change-group nil server) (with-current-buffer (nnimap-buffer) - (car (nnimap-command "CREATE %S" (nnimap-group-to-imap group)))))) + (car (nnimap-command "CREATE %S" (utf7-encode group t)))))) (deffoo nnimap-request-delete-group (group &optional _force server) (setq group (nnimap-decode-gnus-group group)) (when (nnimap-change-group nil server) (with-current-buffer (nnimap-buffer) - (car (nnimap-command "DELETE %S" (nnimap-group-to-imap group)))))) + (car (nnimap-command "DELETE %S" (utf7-encode group t)))))) (deffoo nnimap-request-rename-group (group new-name &optional server) (setq group (nnimap-decode-gnus-group group)) @@ -913,7 +884,7 @@ textual parts.") (with-current-buffer (nnimap-buffer) (nnimap-unselect-group) (car (nnimap-command "RENAME %S %S" - (nnimap-group-to-imap group) (nnimap-group-to-imap new-name)))))) + (utf7-encode group t) (utf7-encode new-name t)))))) (defun nnimap-unselect-group () ;; Make sure we don't have this group open read/write by asking @@ -973,7 +944,7 @@ textual parts.") "UID COPY %d %S")) (result (nnimap-command command article - (nnimap-group-to-imap internal-move-group)))) + (utf7-encode internal-move-group t)))) (when (and (car result) (not can-move)) (nnimap-delete-article article)) (cons internal-move-group @@ -1040,7 +1011,7 @@ textual parts.") "UID MOVE %s %S" "UID COPY %s %S") (nnimap-article-ranges (gnus-compress-sequence articles)) - (nnimap-group-to-imap (gnus-group-real-name nnmail-expiry-target))) + (utf7-encode (gnus-group-real-name nnmail-expiry-target) t)) (set (if can-move 'deleted-articles 'articles-to-delete) articles)))) t) (t @@ -1165,7 +1136,7 @@ If LIMIT, first try to limit the search to the N last articles." (unsubscribe "UNSUBSCRIBE"))))) (when command (with-current-buffer (nnimap-buffer) - (nnimap-command "%s %S" (cadr command) (nnimap-group-to-imap group))))))) + (nnimap-command "%s %S" (cadr command) (utf7-encode group t))))))) (deffoo nnimap-request-set-mark (group actions &optional server) (setq group (nnimap-decode-gnus-group group)) @@ -1220,7 +1191,7 @@ If LIMIT, first try to limit the search to the N last articles." (nnimap-unselect-group)) (erase-buffer) (setq sequence (nnimap-send-command - "APPEND %S {%d}" (nnimap-group-to-imap group) + "APPEND %S {%d}" (utf7-encode group t) (length message))) (unless nnimap-streaming (nnimap-wait-for-connection "^[+]")) @@ -1300,11 +1271,8 @@ If LIMIT, first try to limit the search to the N last articles." (defun nnimap-get-groups () (erase-buffer) - (let* ((sequence (nnimap-send-command "LIST \"\" \"*\"")) - (prefix nnimap-namespace) - (prefix-len (length prefix)) - (inbox (substring prefix 0 -1)) - groups) + (let ((sequence (nnimap-send-command "LIST \"\" \"*\"")) + groups) (nnimap-wait-for-response sequence) (subst-char-in-region (point-min) (point-max) ?\\ ?% t) @@ -1321,15 +1289,11 @@ If LIMIT, first try to limit the search to the N last articles." (skip-chars-backward " \r\"") (point))))) (unless (member '%NoSelect flags) - (let* ((group (utf7-decode (if (stringp group) group - (format "%s" group)) t)) - (group (cond ((equal inbox group) - group) - ((string-prefix-p prefix group) - (substring group prefix-len)) - (t - (concat "#" group))))) - (push group groups))))) + (push (utf7-decode (if (stringp group) + group + (format "%s" group)) + t) + groups)))) (nreverse groups))) (defun nnimap-get-responses (sequences) @@ -1355,7 +1319,7 @@ If LIMIT, first try to limit the search to the N last articles." (dolist (group groups) (setf (nnimap-examined nnimap-object) group) (push (list (nnimap-send-command "EXAMINE %S" - (nnimap-group-to-imap group)) + (utf7-encode group t)) group) sequences)) (nnimap-wait-for-response (caar sequences)) @@ -1427,7 +1391,7 @@ If LIMIT, first try to limit the search to the N last articles." unexist) (push (list (nnimap-send-command "EXAMINE %S (%s (%s %s))" - (nnimap-group-to-imap group) + (utf7-encode group t) (nnimap-quirk "QRESYNC") uidvalidity modseq) 'qresync @@ -1449,7 +1413,7 @@ If LIMIT, first try to limit the search to the N last articles." (cl-incf (nnimap-initial-resync nnimap-object)) (setq start 1)) (push (list (nnimap-send-command "%s %S" command - (nnimap-group-to-imap group)) + (utf7-encode group t)) (nnimap-send-command "UID FETCH %d:* FLAGS" start) start group command) sequences)))) @@ -1883,7 +1847,7 @@ Return the server's response to the SELECT or EXAMINE command." (if read-only "EXAMINE" "SELECT") - (nnimap-group-to-imap group)))) + (utf7-encode group t)))) (when (car result) (setf (nnimap-group nnimap-object) group (nnimap-select-result nnimap-object) result) @@ -2141,7 +2105,7 @@ Return the server's response to the SELECT or EXAMINE command." (dolist (spec specs) (when (and (not (member (car spec) groups)) (not (eq (car spec) 'junk))) - (nnimap-command "CREATE %S" (nnimap-group-to-imap (car spec))))) + (nnimap-command "CREATE %S" (utf7-encode (car spec) t)))) ;; Then copy over all the messages. (erase-buffer) (dolist (spec specs) @@ -2157,7 +2121,7 @@ Return the server's response to the SELECT or EXAMINE command." "UID MOVE %s %S" "UID COPY %s %S") (nnimap-article-ranges ranges) - (nnimap-group-to-imap group)) + (utf7-encode group t)) ranges) sequences))))) ;; Wait for the last COPY response... commit 8f3bca3ad513549af552b321aaca81e9e635857b Author: Arash Esbati Date: Wed Jul 18 21:20:12 2018 +0200 Add \eqref to RefTeX's reference styles (Bug#32203) * lisp/textmodes/reftex-vars.el (reftex-ref-style-alist): Add entry for \eqref provided by amsmath.sty and bind it to "e" key. diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el index 11dbb8d570..e7fe8ffe66 100644 --- a/lisp/textmodes/reftex-vars.el +++ b/lisp/textmodes/reftex-vars.el @@ -1030,7 +1030,9 @@ This is used to string together whole reference sets, like ("Hyperref" "hyperref" (("\\autoref" ?a) ("\\autopageref" ?u))) ("Cleveref" "cleveref" - (("\\cref" ?c) ("\\Cref" ?C) ("\\cpageref" ?d) ("\\Cpageref" ?D)))) + (("\\cref" ?c) ("\\Cref" ?C) ("\\cpageref" ?d) ("\\Cpageref" ?D))) + ("AMSmath" "amsmath" + (("\\eqref" ?e)))) "Alist of reference styles. Each element is a list of the style name, the name of the LaTeX package associated with the style or t for any package, and an @@ -1040,7 +1042,7 @@ the macro type is being prompted for. (See also `reftex-ref-macro-prompt'.) The keys, represented as characters, have to be unique." :group 'reftex-referencing-labels - :version "24.3" + :version "27.1" :type '(alist :key-type (string :tag "Style name") :value-type (group (choice :tag "Package" (const :tag "Any package" t) commit 8217998b0d59ec491116250c6a10f46052a21ef8 Author: Noam Postavsky Date: Wed Jul 18 19:11:23 2018 -0400 Preserve nonblank whitespace when indenting (Bug#32200) * lisp/indent.el (indent-line-to): Remove only spaces and tabs, not any whitespace syntax characters. diff --git a/lisp/indent.el b/lisp/indent.el index 450632174f..73a7d0ef4e 100644 --- a/lisp/indent.el +++ b/lisp/indent.el @@ -292,7 +292,8 @@ indentation by specifying a large negative ARG." "Indent current line to COLUMN. This function removes or adds spaces and tabs at beginning of line only if necessary. It leaves point at end of indentation." - (back-to-indentation) + (beginning-of-line 1) + (skip-chars-forward " \t") (let ((cur-col (current-column))) (cond ((< cur-col column) (if (>= (- column (* (/ cur-col tab-width) tab-width)) tab-width) @@ -303,8 +304,10 @@ only if necessary. It leaves point at end of indentation." (delete-region (progn (move-to-column column t) (point)) ;; The `move-to-column' call may replace ;; tabs with spaces, so we can't reuse the - ;; previous `back-to-indentation' point. - (progn (back-to-indentation) (point))))))) + ;; previous start point. + (progn (beginning-of-line 1) + (skip-chars-forward " \t") + (point))))))) (defun current-left-margin () "Return the left margin to use for this line. commit 6e697bced0971c369c297964eac35e2ddb59feb4 Author: Lars Ingebrigtsen Date: Sun Jul 22 15:57:49 2018 +0200 Add further clarifications to gnus-blocked-images * lisp/gnus/gnus-art.el (gnus-blocked-images): Add further clarifications. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 055f02fb1a..1b0dde9455 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -1626,6 +1626,12 @@ resources when reading email groups (and therefore stops tracking), but allows loading external resources when reading from NNTP newsgroups and the like. +People controlling these external resources won't be able to tell +that any one person in particular has read the message (since +it's in a public venue, many people will end up loading that +resource), but they'll be able to tell that somebody from your IP +address has accessed the resource. + This can also be a function to be evaluated. If so, it will be called with the group name as the parameter, and should return a regexp." commit 7b5b3ddb2dfa98d640aff7b5b160f777e22cc794 Author: Nikolaus Rath Date: Sun Jul 22 15:33:38 2018 +0200 Make nnimap support IMAP namespaces * lisp/gnus/nnimap.el (nnimap-use-namespaces): Introduc new server variable. (nnimap-group-to-imap, nnimap-get-groups): Transform IMAP group names to Gnus group name by stripping / prefixing personal namespace prefix. (nnimap-open-connection-1): Ask server for namespaces and store them. * lisp/gnus/nnimap.el (nnimap-request-group-scan) (nnimap-request-create-group, nnimap-request-delete-group) (nnimap-request-rename-group, nnimap-request-move-article) (nnimap-process-expiry-targets) (nnimap-request-update-group-status) (nnimap-request-accept-article, nnimap-request-list) (nnimap-retrieve-group-data-early, nnimap-change-group) (nnimap-split-incoming-mail): Use nnimap-group-to-imap. (nnimap-group-to-imap): New function to map Gnus group names to IMAP folder names. diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 6793ed2e9f..cd97cff2a0 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -14320,6 +14320,12 @@ fetch all textual parts, while leaving the rest on the server. If non-@code{nil}, record all @acronym{IMAP} commands in the @samp{"*imap log*"} buffer. +@item nnimap-use-namespaces +If non-@code{nil}, omit the IMAP namespace prefix in nnimap group +names. If your IMAP mailboxes are called something like @samp{INBOX} +and @samp{INBOX.Lists.emacs}, but you'd like the nnimap group names to +be @samp{INBOX} and @samp{Lists.emacs}, you should enable this option. + @end table diff --git a/etc/NEWS b/etc/NEWS index fc2a5d4c03..57b51f61b6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -46,6 +46,11 @@ option --enable-check-lisp-object-type is therefore no longer as useful and so is no longer enabled by default in developer builds, to reduce differences between developer and production builds. +** Gnus + ++++ +*** The nnimap backend now has support for IMAP namespaces. + * Startup Changes in Emacs 27.1 diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 3b39731927..af7899f789 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -55,6 +55,13 @@ If nnimap-stream is `ssl', this will default to `imaps'. If not, it will default to `imap'.") +(defvoo nnimap-use-namespaces nil + "Whether to use IMAP namespaces. +If in Gnus your folder names in all start with (e.g.) `INBOX', +you probably want to set this to t. The effects of this are +purely cosmetical, but changing this variable will affect the +names of your nnimap groups. ") + (defvoo nnimap-stream 'undecided "How nnimap talks to the IMAP server. The value should be either `undecided', `ssl' or `tls', @@ -110,6 +117,8 @@ some servers.") (defvoo nnimap-current-infos nil) +(defvoo nnimap-namespace nil) + (defun nnimap-decode-gnus-group (group) (decode-coding-string group 'utf-8)) @@ -166,6 +175,18 @@ textual parts.") (defvar nnimap-inhibit-logging nil) +(defun nnimap-group-to-imap (group) + "Convert Gnus group name to IMAP mailbox name." + (let* ((inbox (substring nnimap-namespace 0 -1))) + (utf7-encode + (cond ((or (not nnimap-namespace) + (string-equal group inbox)) + group) + ((string-prefix-p "#" group) + (substring group 1)) + (t + (concat nnimap-namespace group))) t))) + (defun nnimap-buffer () (nnimap-find-process-buffer nntp-server-buffer)) @@ -442,7 +463,8 @@ textual parts.") (props (cdr stream-list)) (greeting (plist-get props :greeting)) (capabilities (plist-get props :capabilities)) - (stream-type (plist-get props :type))) + (stream-type (plist-get props :type)) + (server (nnoo-current-server 'nnimap))) (when (and stream (not (memq (process-status stream) '(open run)))) (setq stream nil)) @@ -475,9 +497,7 @@ textual parts.") ;; the virtual server name and the address (nnimap-credentials (gnus-delete-duplicates - (list - (nnoo-current-server 'nnimap) - nnimap-address)) + (list server nnimap-address)) ports nnimap-user)))) (setq nnimap-object nil) @@ -496,8 +516,17 @@ textual parts.") (dolist (response (cddr (nnimap-command "CAPABILITY"))) (when (string= "CAPABILITY" (upcase (car response))) (setf (nnimap-capabilities nnimap-object) - (mapcar #'upcase (cdr response)))))) - ;; If the login failed, then forget the credentials + (mapcar #'upcase (cdr response))))) + (when (and nnimap-use-namespaces + (nnimap-capability "NAMESPACE")) + (erase-buffer) + (nnimap-wait-for-response (nnimap-send-command "NAMESPACE")) + (let ((response (nnimap-last-response-string))) + (when (string-match + "^\\*\\W+NAMESPACE\\W+((\"\\([^\"\n]+\\)\"\\W+\"\\(.\\)\"))\\W+" + response) + (setq nnimap-namespace (match-string 1 response)))))) + ;; If the login failed, then forget the credentials ;; that are now possibly cached. (dolist (host (list (nnoo-current-server 'nnimap) nnimap-address)) @@ -837,7 +866,7 @@ textual parts.") (with-current-buffer (nnimap-buffer) (erase-buffer) (let ((group-sequence - (nnimap-send-command "SELECT %S" (utf7-encode group t))) + (nnimap-send-command "SELECT %S" (nnimap-group-to-imap group))) (flag-sequence (nnimap-send-command "UID FETCH 1:* FLAGS"))) (setf (nnimap-group nnimap-object) group) @@ -870,13 +899,13 @@ textual parts.") (setq group (nnimap-decode-gnus-group group)) (when (nnimap-change-group nil server) (with-current-buffer (nnimap-buffer) - (car (nnimap-command "CREATE %S" (utf7-encode group t)))))) + (car (nnimap-command "CREATE %S" (nnimap-group-to-imap group)))))) (deffoo nnimap-request-delete-group (group &optional _force server) (setq group (nnimap-decode-gnus-group group)) (when (nnimap-change-group nil server) (with-current-buffer (nnimap-buffer) - (car (nnimap-command "DELETE %S" (utf7-encode group t)))))) + (car (nnimap-command "DELETE %S" (nnimap-group-to-imap group)))))) (deffoo nnimap-request-rename-group (group new-name &optional server) (setq group (nnimap-decode-gnus-group group)) @@ -884,7 +913,7 @@ textual parts.") (with-current-buffer (nnimap-buffer) (nnimap-unselect-group) (car (nnimap-command "RENAME %S %S" - (utf7-encode group t) (utf7-encode new-name t)))))) + (nnimap-group-to-imap group) (nnimap-group-to-imap new-name)))))) (defun nnimap-unselect-group () ;; Make sure we don't have this group open read/write by asking @@ -944,7 +973,7 @@ textual parts.") "UID COPY %d %S")) (result (nnimap-command command article - (utf7-encode internal-move-group t)))) + (nnimap-group-to-imap internal-move-group)))) (when (and (car result) (not can-move)) (nnimap-delete-article article)) (cons internal-move-group @@ -1011,7 +1040,7 @@ textual parts.") "UID MOVE %s %S" "UID COPY %s %S") (nnimap-article-ranges (gnus-compress-sequence articles)) - (utf7-encode (gnus-group-real-name nnmail-expiry-target) t)) + (nnimap-group-to-imap (gnus-group-real-name nnmail-expiry-target))) (set (if can-move 'deleted-articles 'articles-to-delete) articles)))) t) (t @@ -1136,7 +1165,7 @@ If LIMIT, first try to limit the search to the N last articles." (unsubscribe "UNSUBSCRIBE"))))) (when command (with-current-buffer (nnimap-buffer) - (nnimap-command "%s %S" (cadr command) (utf7-encode group t))))))) + (nnimap-command "%s %S" (cadr command) (nnimap-group-to-imap group))))))) (deffoo nnimap-request-set-mark (group actions &optional server) (setq group (nnimap-decode-gnus-group group)) @@ -1191,7 +1220,7 @@ If LIMIT, first try to limit the search to the N last articles." (nnimap-unselect-group)) (erase-buffer) (setq sequence (nnimap-send-command - "APPEND %S {%d}" (utf7-encode group t) + "APPEND %S {%d}" (nnimap-group-to-imap group) (length message))) (unless nnimap-streaming (nnimap-wait-for-connection "^[+]")) @@ -1271,8 +1300,11 @@ If LIMIT, first try to limit the search to the N last articles." (defun nnimap-get-groups () (erase-buffer) - (let ((sequence (nnimap-send-command "LIST \"\" \"*\"")) - groups) + (let* ((sequence (nnimap-send-command "LIST \"\" \"*\"")) + (prefix nnimap-namespace) + (prefix-len (length prefix)) + (inbox (substring prefix 0 -1)) + groups) (nnimap-wait-for-response sequence) (subst-char-in-region (point-min) (point-max) ?\\ ?% t) @@ -1289,11 +1321,15 @@ If LIMIT, first try to limit the search to the N last articles." (skip-chars-backward " \r\"") (point))))) (unless (member '%NoSelect flags) - (push (utf7-decode (if (stringp group) - group - (format "%s" group)) - t) - groups)))) + (let* ((group (utf7-decode (if (stringp group) group + (format "%s" group)) t)) + (group (cond ((equal inbox group) + group) + ((string-prefix-p prefix group) + (substring group prefix-len)) + (t + (concat "#" group))))) + (push group groups))))) (nreverse groups))) (defun nnimap-get-responses (sequences) @@ -1319,7 +1355,7 @@ If LIMIT, first try to limit the search to the N last articles." (dolist (group groups) (setf (nnimap-examined nnimap-object) group) (push (list (nnimap-send-command "EXAMINE %S" - (utf7-encode group t)) + (nnimap-group-to-imap group)) group) sequences)) (nnimap-wait-for-response (caar sequences)) @@ -1391,7 +1427,7 @@ If LIMIT, first try to limit the search to the N last articles." unexist) (push (list (nnimap-send-command "EXAMINE %S (%s (%s %s))" - (utf7-encode group t) + (nnimap-group-to-imap group) (nnimap-quirk "QRESYNC") uidvalidity modseq) 'qresync @@ -1413,7 +1449,7 @@ If LIMIT, first try to limit the search to the N last articles." (cl-incf (nnimap-initial-resync nnimap-object)) (setq start 1)) (push (list (nnimap-send-command "%s %S" command - (utf7-encode group t)) + (nnimap-group-to-imap group)) (nnimap-send-command "UID FETCH %d:* FLAGS" start) start group command) sequences)))) @@ -1847,7 +1883,7 @@ Return the server's response to the SELECT or EXAMINE command." (if read-only "EXAMINE" "SELECT") - (utf7-encode group t)))) + (nnimap-group-to-imap group)))) (when (car result) (setf (nnimap-group nnimap-object) group (nnimap-select-result nnimap-object) result) @@ -2105,7 +2141,7 @@ Return the server's response to the SELECT or EXAMINE command." (dolist (spec specs) (when (and (not (member (car spec) groups)) (not (eq (car spec) 'junk))) - (nnimap-command "CREATE %S" (utf7-encode (car spec) t)))) + (nnimap-command "CREATE %S" (nnimap-group-to-imap (car spec))))) ;; Then copy over all the messages. (erase-buffer) (dolist (spec specs) @@ -2121,7 +2157,7 @@ Return the server's response to the SELECT or EXAMINE command." "UID MOVE %s %S" "UID COPY %s %S") (nnimap-article-ranges ranges) - (utf7-encode group t)) + (nnimap-group-to-imap group)) ranges) sequences))))) ;; Wait for the last COPY response... commit 92ba34d89ac4f5b5bbb818e1c39a3cc12a405790 Author: Lars Ingebrigtsen Date: Sun Jul 22 13:39:10 2018 +0200 Make async :family 'local failures fail correctly again * src/fileio.c (get_file_errno_data): Refactor out into its own function so that we can reuse the error handling from an async context (bug#31901). * src/process.c (connect_network_socket): When an async :family 'local client fails (with a file error, for instance), mark the process as failed. diff --git a/src/fileio.c b/src/fileio.c index 39789e55ff..b92492c93a 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -196,8 +196,8 @@ check_writable (const char *filename, int amode) list before reporting it; this saves report_file_errno's caller the trouble of preserving errno before calling list1. */ -void -report_file_errno (char const *string, Lisp_Object name, int errorno) +Lisp_Object +get_file_errno_data (char const *string, Lisp_Object name, int errorno) { Lisp_Object data = CONSP (name) || NILP (name) ? name : list1 (name); char *str = emacs_strerror (errorno); @@ -207,10 +207,18 @@ report_file_errno (char const *string, Lisp_Object name, int errorno) Lisp_Object errdata = Fcons (errstring, data); if (errorno == EEXIST) - xsignal (Qfile_already_exists, errdata); + return Fcons (Qfile_already_exists, errdata); else - xsignal (errorno == ENOENT ? Qfile_missing : Qfile_error, - Fcons (build_string (string), errdata)); + return Fcons (errorno == ENOENT ? Qfile_missing : Qfile_error, + Fcons (build_string (string), errdata)); +} + +void +report_file_errno (char const *string, Lisp_Object name, int errorno) +{ + Lisp_Object data = get_file_errno_data (string, name, errorno); + + xsignal (Fcar (data), Fcdr (data)); } /* Signal a file-access failure that set errno. STRING describes the diff --git a/src/lisp.h b/src/lisp.h index 731a45da11..8ddd363d2d 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4015,6 +4015,7 @@ extern Lisp_Object write_region (Lisp_Object, Lisp_Object, Lisp_Object, extern void close_file_unwind (int); extern void fclose_unwind (void *); extern void restore_point_unwind (Lisp_Object); +extern Lisp_Object get_file_errno_data (const char *, Lisp_Object, int); extern _Noreturn void report_file_errno (const char *, Lisp_Object, int); extern _Noreturn void report_file_error (const char *, Lisp_Object); extern _Noreturn void report_file_notify_error (const char *, Lisp_Object); diff --git a/src/process.c b/src/process.c index 0632464134..aafb46c361 100644 --- a/src/process.c +++ b/src/process.c @@ -3587,17 +3587,23 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, if (s < 0) { + const char *err = (p->is_server + ? "make server process failed" + : "make client process failed"); + /* If non-blocking got this far - and failed - assume non-blocking is not supported after all. This is probably a wrong assumption, but the normal blocking calls to open-network-stream handles this error better. */ if (p->is_non_blocking_client) - return; + { + Lisp_Object data = get_file_errno_data (err, contact, xerrno); + + pset_status (p, list2 (Fcar (data), Fcdr (data))); + return; + } - report_file_errno ((p->is_server - ? "make server process failed" - : "make client process failed"), - contact, xerrno); + report_file_errno (err, contact, xerrno); } inch = s; commit e23727978dbb07d68f730ffa60b22d59d065850e Author: Michael Albinus Date: Sun Jul 22 11:53:24 2018 +0200 thread-join returns the result of finished thread * doc/lispref/threads.texi (Basic Thread Functions): * etc/NEWS: Document return value of `thread-join'. * src/thread.c (invoke_thread_function, Fmake_thread) (init_main_thread): Set result. (Fthread_join): Propagate signals, and return result. (Vmain_thread): New defvar. * src/thread.h (struct thread_state): Add `result' field. * test/src/thread-tests.el (threads-join): Test also return value. (threads-join-error): New test. (threads-mutex-signal): Check for propagation of `quit' signal. diff --git a/doc/lispref/threads.texi b/doc/lispref/threads.texi index 4cef9c9c6e..58a3a918ef 100644 --- a/doc/lispref/threads.texi +++ b/doc/lispref/threads.texi @@ -75,8 +75,8 @@ thread, @code{nil} otherwise. @defun thread-join thread Block until @var{thread} exits, or until the current thread is -signaled. If @var{thread} has already exited, this returns -immediately. +signaled. It returns the result of the @var{thread} function. If +@var{thread} has already exited, this returns immediately. @end defun @defun thread-signal thread error-symbol data diff --git a/etc/NEWS b/etc/NEWS index c2b6b500ee..fc2a5d4c03 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -172,11 +172,6 @@ from a remote host. This triggers to search the program on the remote host as indicated by 'default-directory'. -+++ -** New variable 'main-thread' holds Emacs's main thread. -This is handy in Lisp programs that run on a non-main thread and want -to signal the main thread, e.g., when they encounter an error. - * Editing Changes in Emacs 27.1 @@ -578,7 +573,6 @@ It was obsolete since Emacs 22.1, replaced by customize. Use of built-in libgnutls based functionality (described in the Emacs GnuTLS manual) is recommended instead. - ** Message +++ @@ -624,6 +618,17 @@ If this option is non-nil, messages appended to an output file by the selects the messages to summarize with a regexp that matches the sender of the current message. +** Threads + ++++ +*** New variable 'main-thread' holds Emacs's main thread. +This is handy in Lisp programs that run on a non-main thread and want +to signal the main thread, e.g., when they encounter an error. + ++++ +*** 'thread-join' returns the result of the finished thread now. + + * New Modes and Packages in Emacs 27.1 +++ @@ -739,6 +744,7 @@ however applications should instead call 'display-buffer-in-side-window' is backwards-compatible with versions of Emacs in which the old function exists. See the node "Displaying Buffers in Side Windows" in the ELisp manual for more details. + * Lisp Changes in Emacs 27.1 diff --git a/src/thread.c b/src/thread.c index 754d286e9f..1c73d93865 100644 --- a/src/thread.c +++ b/src/thread.c @@ -681,7 +681,7 @@ invoke_thread_function (void) { ptrdiff_t count = SPECPDL_INDEX (); - Ffuncall (1, ¤t_thread->function); + current_thread->result = Ffuncall (1, ¤t_thread->function); return unbind_to (count, Qnil); } @@ -789,6 +789,7 @@ If NAME is given, it must be a string; it names the new thread. */) new_thread->m_last_thing_searched = Qnil; /* copy from parent? */ new_thread->m_saved_last_thing_searched = Qnil; new_thread->m_current_buffer = current_thread->m_current_buffer; + new_thread->result = Qnil; new_thread->error_symbol = Qnil; new_thread->error_data = Qnil; new_thread->event_object = Qnil; @@ -933,12 +934,13 @@ thread_join_callback (void *arg) DEFUN ("thread-join", Fthread_join, Sthread_join, 1, 1, 0, doc: /* Wait for THREAD to exit. -This blocks the current thread until THREAD exits or until -the current thread is signaled. -It is an error for a thread to try to join itself. */) +This blocks the current thread until THREAD exits or until the current +thread is signaled. It returns the result of the THREAD function. It +is an error for a thread to try to join itself. */) (Lisp_Object thread) { struct thread_state *tstate; + Lisp_Object error_symbol, error_data; CHECK_THREAD (thread); tstate = XTHREAD (thread); @@ -946,10 +948,16 @@ It is an error for a thread to try to join itself. */) if (tstate == current_thread) error ("Cannot join current thread"); + error_symbol = tstate->error_symbol; + error_data = tstate->error_data; + if (thread_alive_p (tstate)) flush_stack_call_func (thread_join_callback, tstate); - return Qnil; + if (!NILP (error_symbol)) + Fsignal (error_symbol, error_data); + + return tstate->result; } DEFUN ("all-threads", Fall_threads, Sall_threads, 0, 0, 0, @@ -1017,6 +1025,7 @@ init_main_thread (void) main_thread.m_saved_last_thing_searched = Qnil; main_thread.name = Qnil; main_thread.function = Qnil; + main_thread.result = Qnil; main_thread.error_symbol = Qnil; main_thread.error_data = Qnil; main_thread.event_object = Qnil; @@ -1090,8 +1099,7 @@ syms_of_threads (void) DEFSYM (Qmutexp, "mutexp"); DEFSYM (Qcondition_variable_p, "condition-variable-p"); - DEFVAR_LISP ("main-thread", - Vmain_thread, + DEFVAR_LISP ("main-thread", Vmain_thread, doc: /* The main thread of Emacs. */); #ifdef THREADS_ENABLED XSETTHREAD (Vmain_thread, &main_thread); diff --git a/src/thread.h b/src/thread.h index c10e5ecb75..922eea6217 100644 --- a/src/thread.h +++ b/src/thread.h @@ -52,6 +52,9 @@ struct thread_state /* The thread's function. */ Lisp_Object function; + /* The thread's result, if function has finished. */ + Lisp_Object result; + /* If non-nil, this thread has been signaled. */ Lisp_Object error_symbol; Lisp_Object error_data; diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el index a447fb3914..364f6d61f0 100644 --- a/test/src/thread-tests.el +++ b/test/src/thread-tests.el @@ -100,15 +100,24 @@ (progn (setq threads-test-global nil) (let ((thread (make-thread #'threads-test-thread1))) - (thread-join thread) - (and threads-test-global - (not (thread-alive-p thread))))))) + (and (= (thread-join thread) 23) + (= threads-test-global 23) + (not (thread-alive-p thread))))))) (ert-deftest threads-join-self () "Cannot `thread-join' the current thread." (skip-unless (featurep 'threads)) (should-error (thread-join (current-thread)))) +(ert-deftest threads-join-error () + "Test of error signalling from `thread-join'." + :tags '(:unstable) + (skip-unless (featurep 'threads)) + (let ((thread (make-thread #'threads-call-error))) + (while (thread-alive-p thread) + (thread-yield)) + (should-error (thread-join thread)))) + (defvar threads-test-binding nil) (defun threads-test-thread2 () @@ -197,7 +206,7 @@ (ert-deftest threads-mutex-signal () "Test signaling a blocked thread." (skip-unless (featurep 'threads)) - (should + (should-error (progn (setq threads-mutex (make-mutex)) (setq threads-mutex-key nil) @@ -206,8 +215,10 @@ (while (not threads-mutex-key) (thread-yield)) (thread-signal thr 'quit nil) - (thread-join thr)) - t))) + ;; `quit' is not catched by `should-error'. We must indicate it. + (condition-case nil + (thread-join thr) + (quit (signal 'error nil))))))) (defun threads-test-io-switch () (setq threads-test-global 23)) commit b7ca3d5d932bad6900296679ab87f7d0d64d1de9 Author: John Shahid Date: Wed Jul 18 20:18:19 2018 -0400 Avoid destroying match data in 'setenv' (Bug#32201) * lisp/env.el (setenv,setenv-internal): Replace string-match with string-match-p. diff --git a/lisp/env.el b/lisp/env.el index e47eb57836..7007ba33e5 100644 --- a/lisp/env.el +++ b/lisp/env.el @@ -113,11 +113,11 @@ Changes ENV by side-effect, and returns its new value." (not keep-empty) env (stringp (car env)) - (string-match pattern (car env))) + (string-match-p pattern (car env))) (cdr env) ;; Try to find existing entry for VARIABLE in ENV. (while (and scan (stringp (car scan))) - (when (string-match pattern (car scan)) + (when (string-match-p pattern (car scan)) (if value (setcar scan (concat variable "=" value)) (if keep-empty @@ -184,7 +184,7 @@ a side-effect." (setq variable (encode-coding-string variable locale-coding-system))) (if (and value (multibyte-string-p value)) (setq value (encode-coding-string value locale-coding-system))) - (if (string-match "=" variable) + (if (string-match-p "=" variable) (error "Environment variable name `%s' contains `='" variable)) (if (string-equal "TZ" variable) (set-time-zone-rule value)) commit 5de444112cf19c078d4a74752a50e890233ef033 Author: Jonathan Kyle Mitchell Date: Mon Jul 16 21:46:20 2018 -0500 Check for special filenames in eshell (Bug#30724) * lisp/eshell/esh-cmd.el (eshell-lisp-command): Check for "~" in lisp commands with the eshell-filename-arguments property (Bug#30724). * lisp/eshell/em-dirs.el (eshell/cd, eshell/pushd, eshell/popd): * lisp/eshell/em-ls.el (eshell/ls): * lisp/eshell/em-unix.el (eshell/rm, eshell/mkdir, eshell/rmdir) (eshell/mv, eshell/cp, eshell/ln, eshell/cat, eshell/du, eshell/diff): * lisp/eshell/esh-ext.el (eshell/addpath): Add eshell-filename-arguments to symbol plist. diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el index 37cb6b169a..ba3bdb5cd5 100644 --- a/lisp/eshell/em-dirs.el +++ b/lisp/eshell/em-dirs.el @@ -407,6 +407,7 @@ in the minibuffer: nil)))) (put 'eshell/cd 'eshell-no-numeric-conversions t) +(put 'eshell/cd 'eshell-filename-arguments t) (defun eshell-add-to-dir-ring (path) "Add PATH to the last-dir-ring, if applicable." @@ -470,6 +471,7 @@ in the minibuffer: nil) (put 'eshell/pushd 'eshell-no-numeric-conversions t) +(put 'eshell/pushd 'eshell-filename-arguments t) ;;; popd [+n] (defun eshell/popd (&rest args) @@ -500,6 +502,7 @@ in the minibuffer: nil) (put 'eshell/popd 'eshell-no-numeric-conversions t) +(put 'eshell/pop 'eshell-filename-arguments t) (defun eshell/dirs (&optional if-verbose) "Implementation of dirs in Lisp." diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el index 900b28905b..2b568a991a 100644 --- a/lisp/eshell/em-ls.el +++ b/lisp/eshell/em-ls.el @@ -334,6 +334,7 @@ instead." (apply 'eshell-do-ls args))) (put 'eshell/ls 'eshell-no-numeric-conversions t) +(put 'eshell/ls 'eshell-filename-arguments t) (declare-function eshell-glob-regexp "em-glob" (pattern)) diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index c3448de407..b00b6654cc 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -307,6 +307,7 @@ Remove (unlink) the FILE(s).") nil)) (put 'eshell/rm 'eshell-no-numeric-conversions t) +(put 'eshell/rm 'eshell-filename-arguments t) (defun eshell/mkdir (&rest args) "Implementation of mkdir in Lisp." @@ -324,6 +325,7 @@ Create the DIRECTORY(ies), if they do not already exist.") nil)) (put 'eshell/mkdir 'eshell-no-numeric-conversions t) +(put 'eshell/mkdir 'eshell-filename-arguments t) (defun eshell/rmdir (&rest args) "Implementation of rmdir in Lisp." @@ -340,6 +342,7 @@ Remove the DIRECTORY(ies), if they are empty.") nil)) (put 'eshell/rmdir 'eshell-no-numeric-conversions t) +(put 'eshell/rmdir 'eshell-filename-arguments t) (defvar no-dereference) @@ -524,6 +527,7 @@ Rename SOURCE to DEST, or move SOURCE(s) to DIRECTORY. eshell-mv-overwrite-files)))) (put 'eshell/mv 'eshell-no-numeric-conversions t) +(put 'eshell/mv 'eshell-filename-arguments t) (defun eshell/cp (&rest args) "Implementation of cp in Lisp." @@ -561,6 +565,7 @@ Copy SOURCE to DEST, or multiple SOURCE(s) to DIRECTORY.") eshell-cp-overwrite-files preserve))) (put 'eshell/cp 'eshell-no-numeric-conversions t) +(put 'eshell/cp 'eshell-filename-arguments t) (defun eshell/ln (&rest args) "Implementation of ln in Lisp." @@ -593,6 +598,7 @@ with `--symbolic'. When creating hard links, each TARGET must exist.") eshell-ln-overwrite-files)))) (put 'eshell/ln 'eshell-no-numeric-conversions t) +(put 'eshell/ln 'eshell-filename-arguments t) (defun eshell/cat (&rest args) "Implementation of cat in Lisp. @@ -645,6 +651,7 @@ Concatenate FILE(s), or standard input, to standard output.") (setq eshell-ensure-newline-p nil)))) (put 'eshell/cat 'eshell-no-numeric-conversions t) +(put 'eshell/cat 'eshell-filename-arguments t) ;; special front-end functions for compilation-mode buffers @@ -927,6 +934,8 @@ Summarize disk usage of each FILE, recursively for directories.") (eshell-print (concat (eshell-du-size-string size) "total\n")))))))) +(put 'eshell/du 'eshell-filename-arguments t) + (defvar eshell-time-start nil) (defun eshell-show-elapsed-time () @@ -1029,6 +1038,7 @@ Show wall-clock time elapsed during execution of COMMAND.") nil) (put 'eshell/diff 'eshell-no-numeric-conversions t) +(put 'eshell/diff 'eshell-filename-arguments t) (defvar locate-history-list) diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 61c0ebc71d..92cac612d4 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -1304,27 +1304,36 @@ messages, and errors." "Insert Lisp OBJECT, using ARGS if a function." (catch 'eshell-external ; deferred to an external command (let* ((eshell-ensure-newline-p (eshell-interactive-output-p)) - (result - (if (functionp object) - (progn - (setq eshell-last-arguments args - eshell-last-command-name - (concat "#")) - ;; if any of the arguments are flagged as numbers - ;; waiting for conversion, convert them now - (unless (get object 'eshell-no-numeric-conversions) - (while args - (let ((arg (car args))) - (if (and (stringp arg) - (> (length arg) 0) - (not (text-property-not-all - 0 (length arg) 'number t arg))) - (setcar args (string-to-number arg)))) - (setq args (cdr args)))) - (eshell-apply object eshell-last-arguments)) - (setq eshell-last-arguments args - eshell-last-command-name "#") - (eshell-eval object)))) + (result + (if (functionp object) + (progn + (setq eshell-last-arguments args + eshell-last-command-name + (concat "#")) + (let ((numeric (not (get object + 'eshell-no-numeric-conversions))) + (fname-args (get object 'eshell-filename-arguments))) + (when (or numeric fname-args) + (while args + (let ((arg (car args))) + (cond ((and numeric (stringp arg) (> (length arg) 0) + (text-property-any 0 (length arg) + 'number t arg)) + ;; If any of the arguments are + ;; flagged as numbers waiting for + ;; conversion, convert them now. + (setcar args (string-to-number arg))) + ((and fname-args (stringp arg) + (string-equal arg "~")) + ;; If any of the arguments match "~", + ;; prepend "./" to treat it as a + ;; regular file name. + (setcar args (concat "./" arg))))) + (setq args (cdr args))))) + (eshell-apply object eshell-last-arguments)) + (setq eshell-last-arguments args + eshell-last-command-name "#") + (eshell-eval object)))) (if (and eshell-ensure-newline-p (save-excursion (goto-char eshell-last-output-end) diff --git a/lisp/eshell/esh-ext.el b/lisp/eshell/esh-ext.el index 1bfab23c22..fdb77d3226 100644 --- a/lisp/eshell/esh-ext.el +++ b/lisp/eshell/esh-ext.el @@ -259,6 +259,7 @@ Adds the given PATH to $PATH.") (eshell-printn dir))))) (put 'eshell/addpath 'eshell-no-numeric-conversions t) +(put 'eshell/addpath 'eshell-filename-arguments t) (defun eshell-script-interpreter (file) "Extract the script to run from FILE, if it has #! in it. commit 1b4b96597c7868d9c24389d83089097a521206a5 Author: Noam Postavsky Date: Thu Jul 19 06:40:54 2018 -0400 Fix indent-sexp of #s(...) (Bug#31984) * lisp/emacs-lisp/lisp-mode.el (indent-sexp): Look for a sexp that ends after the current line. * test/lisp/emacs-lisp/lisp-mode-tests.el (indent-sexp-go): New test. diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 3a03b56313..44b27236a9 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -1199,8 +1199,14 @@ ENDPOS is encountered." (setq endpos (copy-marker (if endpos endpos ;; Get error now if we don't have a complete sexp - ;; after point. - (save-excursion (forward-sexp 1) (point))))) + ;; after point. We actually look for a sexp which + ;; ends after the current line so that we properly + ;; indent things like #s(...). This might not be + ;; needed if Bug#15998 is fixed. + (let ((eol (line-end-position))) + (save-excursion (while (and (< (point) eol) (not (eobp))) + (forward-sexp 1)) + (point)))))) (save-excursion (while (let ((indent (lisp-indent-calc-next parse-state)) (ppss (lisp-indent-state-ppss parse-state))) diff --git a/test/lisp/emacs-lisp/lisp-mode-tests.el b/test/lisp/emacs-lisp/lisp-mode-tests.el index 8598d41978..0b052e9fc3 100644 --- a/test/lisp/emacs-lisp/lisp-mode-tests.el +++ b/test/lisp/emacs-lisp/lisp-mode-tests.el @@ -113,6 +113,18 @@ noindent\" 3 ;; we're indenting ends on the previous line. (should (equal (buffer-string) original))))) +(ert-deftest indent-sexp-go () + "Make sure `indent-sexp' doesn't stop after #s." + ;; See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=31984. + (with-temp-buffer + (emacs-lisp-mode) + (insert "#s(foo\nbar)\n") + (goto-char (point-min)) + (indent-sexp) + (should (equal (buffer-string) "\ +#s(foo + bar)\n")))) + (ert-deftest lisp-indent-region () "Test basics of `lisp-indent-region'." (with-temp-buffer commit 59e8533286cc8b5abc80b0966ef4b9fb676fbdfe Author: Noam Postavsky Date: Wed Jul 18 18:45:47 2018 -0400 Add save-match-data to abbreviate-file-name (Bug#32201) * lisp/files.el (abbreviate-file-name): Save match-data around expand-file-name; it is not guaranteed to preserve match-data, and may well do so depending on what file handlers and hooks are in effect. diff --git a/lisp/files.el b/lisp/files.el index fb8c34bcae..4eb1560a20 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1929,7 +1929,7 @@ started Emacs, set `abbreviated-home-dir' to nil so it will be recalculated)." (save-match-data (string-match "^[a-zA-`]:/$" filename)))) (equal (get 'abbreviated-home-dir 'home) - (expand-file-name "~"))) + (save-match-data (expand-file-name "~")))) (setq filename (concat "~" (match-string 1 filename) commit 47f75b1ba0246b5d770fbb52e0fa3e00f9f83ffb Author: Eli Zaretskii Date: Sat Jul 21 22:27:33 2018 +0300 Fix last change in editfns.c * src/editfns.c (Freplace_buffer_contents): Fix last change: always call buffer modification hooks, even if nothing was deleted/inserted. (bug#32237) diff --git a/src/editfns.c b/src/editfns.c index cf596aec37..a18a71e6d7 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -3257,9 +3257,7 @@ differences between the two buffers. */) for (l = size_a; l > k && !bit_is_set (ctx.deletions, l - 1); l--) ; to = BEGV + l; - /* If k >= l, it means nothing needs to be deleted. */ - if (k < l) - prepare_to_modify_buffer (from, to, NULL); + prepare_to_modify_buffer (from, to, NULL); specbind (Qinhibit_modification_hooks, Qt); modification_hooks_inhibited = true; } @@ -3310,16 +3308,11 @@ differences between the two buffers. */) SAFE_FREE (); rbc_quitcounter = 0; - if (modification_hooks_inhibited && from <= to) + if (modification_hooks_inhibited) { ptrdiff_t updated_to = to + ZV - BEGV - size_a; - /* Only call after-change-functions if something was actually - inserted. */ - if (from < updated_to) - { - signal_after_change (from, to - from, updated_to - from); - update_compositions (from, updated_to, CHECK_INSIDE); - } + signal_after_change (from, to - from, updated_to - from); + update_compositions (from, updated_to, CHECK_INSIDE); } return Qnil; commit 671dc5a51edfb9aaea943e144997e7c1297f56fb Author: Eli Zaretskii Date: Sat Jul 21 21:05:52 2018 +0300 Fix calls to buffer modification hooks from replace-buffer-contents * src/editfns.c (Freplace_buffer_contents): Don't call buffer modification hooks if nothing was deleted/inserted. (Bug#32237) diff --git a/src/editfns.c b/src/editfns.c index d1a6bfbbb1..cf596aec37 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -3254,10 +3254,12 @@ differences between the two buffers. */) from = BEGV + k; /* Find the last character position to be changed. */ - for (l = size_a; l > 0 && !bit_is_set (ctx.deletions, l - 1); l--) + for (l = size_a; l > k && !bit_is_set (ctx.deletions, l - 1); l--) ; to = BEGV + l; - prepare_to_modify_buffer (from, to, NULL); + /* If k >= l, it means nothing needs to be deleted. */ + if (k < l) + prepare_to_modify_buffer (from, to, NULL); specbind (Qinhibit_modification_hooks, Qt); modification_hooks_inhibited = true; } @@ -3308,11 +3310,16 @@ differences between the two buffers. */) SAFE_FREE (); rbc_quitcounter = 0; - if (modification_hooks_inhibited) + if (modification_hooks_inhibited && from <= to) { ptrdiff_t updated_to = to + ZV - BEGV - size_a; - signal_after_change (from, to - from, updated_to - from); - update_compositions (from, updated_to, CHECK_INSIDE); + /* Only call after-change-functions if something was actually + inserted. */ + if (from < updated_to) + { + signal_after_change (from, to - from, updated_to - from); + update_compositions (from, updated_to, CHECK_INSIDE); + } } return Qnil; commit cc4ceed18d51047b390288d2d0a584e678423517 Author: Eli Zaretskii Date: Sat Jul 21 19:44:38 2018 +0300 ; etc/NEWS: Remove unnecessary reference to a bug number. diff --git a/etc/NEWS b/etc/NEWS index 1551c36c5a..a27d1b89ec 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -38,7 +38,6 @@ in its NEWS.) ** New variable 'xft-ignore-color-fonts'. Default t means don't try to load color fonts when using Xft, as they often cause crashes. Set it to nil if you really need those fonts. -(Bug#30874) * Editing Changes in Emacs 26.2 commit f3f67cf0b9a6388d423e048a7aafad2eb531b5a5 Author: Ken Brown Date: Sat Jul 21 12:15:22 2018 -0400 Pacify GCC 7 with -Wformat-overflow * src/w32term.c (x_draw_glyphless_glyph_string_foreground): Force sprintf to write at most 6 bytes, excluding the terminating null byte. diff --git a/src/w32term.c b/src/w32term.c index ff0d2bf5dd..0ae173a876 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -1476,7 +1476,7 @@ x_draw_glyphless_glyph_string_foreground (struct glyph_string *s) { sprintf ((char *) buf, "%0*X", glyph->u.glyphless.ch < 0x10000 ? 4 : 6, - (unsigned int) glyph->u.glyphless.ch); + (unsigned int) glyph->u.glyphless.ch & 0xffffff); str = buf; } commit d12215324bb201d5f8c9e2b52c9b8d2abf30b1f4 Author: Eli Zaretskii Date: Sat Jul 21 19:11:32 2018 +0300 Minor rewording of last change * lisp/vc/add-log.el (add-log-dont-create-changelog-file) (add-log--pseudo-changelog-buffer-name) (add-log--changelog-buffer-p, add-change-log-entry): Doc fixes. * etc/NEWS: Improve wording of last change. * doc/emacs/maintaining.texi (Change Log Commands): Improve wording of last change. diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index c59978ebbe..b31cacf998 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -1657,14 +1657,16 @@ ordering of entries. @vindex add-log-dont-create-changelog-file Version control systems are another way to keep track of changes in -your program and keep a change log. In these situations, you may not -want to keep a separate versioned change log file. If +your program and keep a change log. Many projects that use a VCS don't +keep a separate versioned change log file nowadays, so you may wish to +avoid having such a file in the repository. If the value of @code{add-log-dont-create-changelog-file} is non-@code{nil}, commands like @kbd{C-x 4 a} (@code{add-change-log-entry-other-window}) will record changes in a suitably named temporary buffer instead of a file, -unless such a file already exists. +if such a file does not already exist. -In either case, you can type @kbd{C-c C-a} +Whether you have a change log file or use a temporary buffer for +change logs, you can type @kbd{C-c C-a} (@code{log-edit-insert-changelog}) in the VC Log buffer to insert the relevant change log entries, if they exist. @xref{Log Buffer}. diff --git a/etc/NEWS b/etc/NEWS index 72e35f93e1..c2b6b500ee 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -219,10 +219,14 @@ navigation and editing of large files. ** Change Logs and VC -*** Recording ChangeLog entries doesn't require an actual file -An existing file will be used if it already exists. This is -controlled by the defcustom 'add-log-dont-create-changelog-file', -which defaults to t. +*** Recording ChangeLog entries doesn't require an actual file. +If a ChangeLog file doesn't exist, and if the new variable +'add-log-dont-create-changelog-file' is non-nil (which is the +default), commands such as 'C-x 4 a' will add log entries to a +suitable named temporary buffer. (An existing ChangeLog file will +still be used if it exists.) Set the variable to nil to get the +previous behavior of always creating a buffer that visits a ChangeLog +file. ** diff-mode *** Hunks are now automatically refined by default diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el index 5ed43e8c8c..d6e8540860 100644 --- a/lisp/vc/add-log.el +++ b/lisp/vc/add-log.el @@ -744,7 +744,7 @@ Optional arg BUFFER-FILE overrides `buffer-file-name'." file-name) (defun add-log-file-name (buffer-file log-file) - "Compute file-name of BUFFER-FILE as displayed in LOG-FILE." + "Compute file-name of BUFFER-FILE to be used in entries in LOG-FILE." ;; Never want to add a change log entry for the ChangeLog file itself. (unless (or (null buffer-file) (string= buffer-file log-file)) (if add-log-file-name-function @@ -770,22 +770,23 @@ Optional arg BUFFER-FILE overrides `buffer-file-name'." (defcustom add-log-dont-create-changelog-file t "If non-nil, don't create ChangeLog files for log entries. -This applies only if no pre-existing ChangeLog is found." +If a ChangeLog file does not already exist, a non-nil value +means to put log entries in a suitably named buffer." :type :boolean :version "27.1") (put 'add-log-dont-create-changelog-file 'safe-local-variable 'booleanp) (defun add-log--pseudo-changelog-buffer-name (changelog-file-name) - "Compute suitable name for a non-file ChangeLog buffer. - CHANGELOG-FILE-NAME is the file name of the actual ChangeLog file - if it were to exist." + "Compute a suitable name for a non-file visiting ChangeLog buffer. +CHANGELOG-FILE-NAME is the file name of the actual ChangeLog file +if it were to exist." (format "*changes to %s*" (abbreviate-file-name (file-name-directory changelog-file-name)))) (defun add-log--changelog-buffer-p (changelog-file-name buffer) - "Tell if BUFFER holds a ChangeLog for CHANGELOG-FILE-NAME." + "Return non-nil if BUFFER holds a change log for CHANGELOG-FILE-NAME." (with-current-buffer buffer (if buffer-file-name (equal buffer-file-name changelog-file-name) @@ -794,7 +795,7 @@ This applies only if no pre-existing ChangeLog is found." (defun add-log-find-changelog-buffer (changelog-file-name) "Find a ChangeLog buffer for CHANGELOG-FILE-NAME. - Respect `add-log-use-pseudo-changelog', which see." +Respect `add-log-use-pseudo-changelog', which see." (if (or (file-exists-p changelog-file-name) (not add-log-dont-create-changelog-file)) (find-file-noselect changelog-file-name) @@ -807,37 +808,38 @@ This applies only if no pre-existing ChangeLog is found." other-window new-entry put-new-entry-on-new-line) "Find ChangeLog buffer, add an entry for today and an item for this file. - Optional arg WHOAMI (interactive prefix) non-nil means prompt for - user name and email (stored in `add-log-full-name' and - `add-log-mailing-address'). - - Second arg CHANGELOG-FILE-NAME is file name of the change log. - If nil, use the value of `change-log-default-name'. If the file - thus named exists, it's used for the new entry. If it doesn't - exist, it is created, unless `add-log-dont-create-changelog-file' is t, - in which case a suitably named file-less buffer is used for - keeping entries pertaining to CHANGELOG-FILE-NAME's directory. - - Third arg OTHER-WINDOW non-nil means visit in other window. - - Fourth arg NEW-ENTRY non-nil means always create a new entry at the front; - never append to an existing entry. Option `add-log-keep-changes-together' - otherwise affects whether a new entry is created. - - Fifth arg PUT-NEW-ENTRY-ON-NEW-LINE non-nil means that if a new - entry is created, put it on a new line by itself, do not put it - after a comma on an existing line. - - Option `add-log-always-start-new-record' non-nil means always create a - new record, even when the last record was made on the same date and by - the same person. - - The change log file can start with a copyright notice and a copying - permission notice. The first blank line indicates the end of these - notices. - - Today's date is calculated according to `add-log-time-zone-rule' if - non-nil, otherwise in local time." +Optional arg WHOAMI (interactive prefix) non-nil means prompt for +user name and email (stored in `add-log-full-name' +and `add-log-mailing-address'). + +Second arg CHANGELOG-FILE-NAME is the file name of the change log. +If nil, use the value of `change-log-default-name'. If the file +thus named exists, it is used for the new entry. If it doesn't +exist, it is created, unless `add-log-dont-create-changelog-file' is t, +in which case a suitably named buffer that doesn't visit any file +is used for keeping entries pertaining to CHANGELOG-FILE-NAME's +directory. + +Third arg OTHER-WINDOW non-nil means visit in other window. + +Fourth arg NEW-ENTRY non-nil means always create a new entry at the front; +never append to an existing entry. Option `add-log-keep-changes-together' +otherwise affects whether a new entry is created. + +Fifth arg PUT-NEW-ENTRY-ON-NEW-LINE non-nil means that if a new +entry is created, put it on a new line by itself, do not put it +after a comma on an existing line. + +Option `add-log-always-start-new-record' non-nil means always create a +new record, even when the last record was made on the same date and by +the same person. + +The change log file can start with a copyright notice and a copying +permission notice. The first blank line indicates the end of these +notices. + +Today's date is calculated according to `add-log-time-zone-rule' if +non-nil, otherwise in local time." (interactive (list current-prefix-arg (prompt-for-change-log-name))) (let* ((defun (add-log-current-defun)) commit f96fe57fb76df8e7282f266d42a0d471780e1d75 Author: JoĂŁo Távora Date: Sat Jul 21 15:54:21 2018 +0100 New option to make 'C-x 4 a' use file-less ChangeLog buffers * doc/emacs/maintaining.texi (Change Log Commands): Document add-log-dont-create-changelog-file. * etc/NEWS (Change Logs Mode): Mention add-log-dont-create-changelog-file. * lisp/vc/add-log.el (add-log-file-name): Add comment. (add-log-dont-create-changelog-file): New variable. (add-log--pseudo-changelog-buffer-name) (add-log--changelog-buffer-p): New helpers. (add-log-find-changelog-buffer): New function. (add-log--pseudo-changelog-buffer-name): Respect add-log-dont-create-changelog-file. * lisp/vc/log-edit.el (log-edit-changelog-entries): Use add-log-find-changelog-buffer. diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 024fd9728c..c59978ebbe 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -1655,10 +1655,18 @@ not just to the next change log entry. You can also use log files into a buffer in Change Log Mode, preserving the date ordering of entries. +@vindex add-log-dont-create-changelog-file Version control systems are another way to keep track of changes in -your program and keep a change log. In the VC log buffer, typing -@kbd{C-c C-a} (@code{log-edit-insert-changelog}) inserts the relevant -change log entry, if one exists. @xref{Log Buffer}. +your program and keep a change log. In these situations, you may not +want to keep a separate versioned change log file. If +@code{add-log-dont-create-changelog-file} is non-@code{nil}, commands +like @kbd{C-x 4 a} (@code{add-change-log-entry-other-window}) will +record changes in a suitably named temporary buffer instead of a file, +unless such a file already exists. + +In either case, you can type @kbd{C-c C-a} +(@code{log-edit-insert-changelog}) in the VC Log buffer to insert the +relevant change log entries, if they exist. @xref{Log Buffer}. @node Format of ChangeLog @subsection Format of ChangeLog diff --git a/etc/NEWS b/etc/NEWS index 8275cbb72c..72e35f93e1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -217,6 +217,13 @@ navigation and editing of large files. * Changes in Specialized Modes and Packages in Emacs 27.1 +** Change Logs and VC + +*** Recording ChangeLog entries doesn't require an actual file +An existing file will be used if it already exists. This is +controlled by the defcustom 'add-log-dont-create-changelog-file', +which defaults to t. + ** diff-mode *** Hunks are now automatically refined by default To disable it, set the new defcustom 'diff-font-lock-refine' to nil. diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el index 4d69aac454..5ed43e8c8c 100644 --- a/lisp/vc/add-log.el +++ b/lisp/vc/add-log.el @@ -744,6 +744,7 @@ Optional arg BUFFER-FILE overrides `buffer-file-name'." file-name) (defun add-log-file-name (buffer-file log-file) + "Compute file-name of BUFFER-FILE as displayed in LOG-FILE." ;; Never want to add a change log entry for the ChangeLog file itself. (unless (or (null buffer-file) (string= buffer-file log-file)) (if add-log-file-name-function @@ -767,36 +768,76 @@ Optional arg BUFFER-FILE overrides `buffer-file-name'." (file-name-sans-versions buffer-file) buffer-file)))) -;;;###autoload -(defun add-change-log-entry (&optional whoami file-name other-window new-entry - put-new-entry-on-new-line) - "Find change log file, and add an entry for today and an item for this file. -Optional arg WHOAMI (interactive prefix) non-nil means prompt for user -name and email (stored in `add-log-full-name' and `add-log-mailing-address'). - -Second arg FILE-NAME is file name of the change log. -If nil, use the value of `change-log-default-name'. - -Third arg OTHER-WINDOW non-nil means visit in other window. +(defcustom add-log-dont-create-changelog-file t + "If non-nil, don't create ChangeLog files for log entries. +This applies only if no pre-existing ChangeLog is found." + :type :boolean + :version "27.1") -Fourth arg NEW-ENTRY non-nil means always create a new entry at the front; -never append to an existing entry. Option `add-log-keep-changes-together' -otherwise affects whether a new entry is created. +(put 'add-log-dont-create-changelog-file 'safe-local-variable 'booleanp) -Fifth arg PUT-NEW-ENTRY-ON-NEW-LINE non-nil means that if a new -entry is created, put it on a new line by itself, do not put it -after a comma on an existing line. +(defun add-log--pseudo-changelog-buffer-name (changelog-file-name) + "Compute suitable name for a non-file ChangeLog buffer. + CHANGELOG-FILE-NAME is the file name of the actual ChangeLog file + if it were to exist." + (format "*changes to %s*" + (abbreviate-file-name + (file-name-directory changelog-file-name)))) -Option `add-log-always-start-new-record' non-nil means always create a -new record, even when the last record was made on the same date and by -the same person. - -The change log file can start with a copyright notice and a copying -permission notice. The first blank line indicates the end of these -notices. +(defun add-log--changelog-buffer-p (changelog-file-name buffer) + "Tell if BUFFER holds a ChangeLog for CHANGELOG-FILE-NAME." + (with-current-buffer buffer + (if buffer-file-name + (equal buffer-file-name changelog-file-name) + (equal (add-log--pseudo-changelog-buffer-name changelog-file-name) + (buffer-name))))) + +(defun add-log-find-changelog-buffer (changelog-file-name) + "Find a ChangeLog buffer for CHANGELOG-FILE-NAME. + Respect `add-log-use-pseudo-changelog', which see." + (if (or (file-exists-p changelog-file-name) + (not add-log-dont-create-changelog-file)) + (find-file-noselect changelog-file-name) + (get-buffer-create + (add-log--pseudo-changelog-buffer-name changelog-file-name)))) -Today's date is calculated according to `add-log-time-zone-rule' if -non-nil, otherwise in local time." +;;;###autoload +(defun add-change-log-entry (&optional whoami + changelog-file-name + other-window new-entry + put-new-entry-on-new-line) + "Find ChangeLog buffer, add an entry for today and an item for this file. + Optional arg WHOAMI (interactive prefix) non-nil means prompt for + user name and email (stored in `add-log-full-name' and + `add-log-mailing-address'). + + Second arg CHANGELOG-FILE-NAME is file name of the change log. + If nil, use the value of `change-log-default-name'. If the file + thus named exists, it's used for the new entry. If it doesn't + exist, it is created, unless `add-log-dont-create-changelog-file' is t, + in which case a suitably named file-less buffer is used for + keeping entries pertaining to CHANGELOG-FILE-NAME's directory. + + Third arg OTHER-WINDOW non-nil means visit in other window. + + Fourth arg NEW-ENTRY non-nil means always create a new entry at the front; + never append to an existing entry. Option `add-log-keep-changes-together' + otherwise affects whether a new entry is created. + + Fifth arg PUT-NEW-ENTRY-ON-NEW-LINE non-nil means that if a new + entry is created, put it on a new line by itself, do not put it + after a comma on an existing line. + + Option `add-log-always-start-new-record' non-nil means always create a + new record, even when the last record was made on the same date and by + the same person. + + The change log file can start with a copyright notice and a copying + permission notice. The first blank line indicates the end of these + notices. + + Today's date is calculated according to `add-log-time-zone-rule' if + non-nil, otherwise in local time." (interactive (list current-prefix-arg (prompt-for-change-log-name))) (let* ((defun (add-log-current-defun)) @@ -804,20 +845,28 @@ non-nil, otherwise in local time." (change-log-version-number-search))) (buf-file-name (funcall add-log-buffer-file-name-function)) (buffer-file (if buf-file-name (expand-file-name buf-file-name))) - (file-name (expand-file-name (find-change-log file-name buffer-file))) + (changelog-file-name (expand-file-name (find-change-log + changelog-file-name + buffer-file))) ;; Set ITEM to the file name to use in the new item. - (item (add-log-file-name buffer-file file-name))) + (item (add-log-file-name buffer-file changelog-file-name))) - (unless (equal file-name buffer-file-name) + ;; don't add entries from the ChangeLog file/buffer to itself. + (unless (equal changelog-file-name buffer-file-name) (cond - ((equal file-name (buffer-file-name (window-buffer))) + ((add-log--changelog-buffer-p + changelog-file-name + (window-buffer)) ;; If the selected window already shows the desired buffer don't show ;; it again (particularly important if other-window is true). ;; This is important for diff-add-change-log-entries-other-window. (set-buffer (window-buffer))) ((or other-window (window-dedicated-p)) - (find-file-other-window file-name)) - (t (find-file file-name)))) + (switch-to-buffer-other-window + (add-log-find-changelog-buffer changelog-file-name))) + (t + (switch-to-buffer + (add-log-find-changelog-buffer changelog-file-name))))) (or (derived-mode-p 'change-log-mode) (change-log-mode)) (undo-boundary) diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index 6ff782a606..90860fbdcf 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -913,8 +913,10 @@ where LOGBUFFER is the name of the ChangeLog buffer, and each (setq change-log-default-name nil) (find-change-log))))) (when (or (find-buffer-visiting changelog-file-name) - (file-exists-p changelog-file-name)) - (with-current-buffer (find-file-noselect changelog-file-name) + (file-exists-p changelog-file-name) + add-log-dont-create-changelog-file) + (with-current-buffer + (add-log-find-changelog-buffer changelog-file-name) (unless (eq major-mode 'change-log-mode) (change-log-mode)) (goto-char (point-min)) (if (looking-at "\\s-*\n") (goto-char (match-end 0))) commit 6eac401c238b9c98550c645f3c60df9a9668dc61 Author: Bozhidar Batsov Date: Sat Jul 21 14:00:11 2018 +0300 Make ielm accept an optional buffer name param The ielm buffer name was hardcoded which made it hard for programs to interactively create ielm buffers with different names and switch to them (e.g. perhaps you want to have one ielm buffer for each of the Elisp projects you're working on). diff --git a/lisp/ielm.el b/lisp/ielm.el index b4ad69e4c7..8d1efcdc3b 100644 --- a/lisp/ielm.el +++ b/lisp/ielm.el @@ -612,17 +612,19 @@ Customized bindings may be defined in `ielm-map', which currently contains: ;;; User command ;;;###autoload -(defun ielm nil +(defun ielm (&optional buf-name) "Interactively evaluate Emacs Lisp expressions. -Switches to the buffer `*ielm*', or creates it if it does not exist. +Switches to the buffer named BUF-NAME if provided (`*ielm*' by default), +or creates it if it does not exist. See `inferior-emacs-lisp-mode' for details." (interactive) - (let (old-point) - (unless (comint-check-proc "*ielm*") - (with-current-buffer (get-buffer-create "*ielm*") + (let (old-point + (buf-name (or buf-name "*ielm*"))) + (unless (comint-check-proc buf-name) + (with-current-buffer (get-buffer-create buf-name) (unless (zerop (buffer-size)) (setq old-point (point))) (inferior-emacs-lisp-mode))) - (pop-to-buffer-same-window "*ielm*") + (pop-to-buffer-same-window buf-name) (when old-point (push-mark old-point)))) (provide 'ielm) commit e0f33ea394c636ab1aa2412b4f35b7dfc1ca768a Author: Michael Albinus Date: Sat Jul 21 12:29:06 2018 +0200 Fix Bug#32226 * lisp/shadowfile.el (shadow-site-name, shadow-name-site): Use "[-.[:word:]]+" as hostname regexp. (Bug#32226) * test/lisp/shadowfile-tests.el (shadow-test06-literal-groups) (shadow-test07-regexp-groups, shadow-test08-shadow-todo) (shadow-test09-shadow-copy-files): Skip if needed. diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el index e1a9b8e1d9..27d934d9fc 100644 --- a/lisp/shadowfile.el +++ b/lisp/shadowfile.el @@ -231,12 +231,12 @@ information defining the cluster. For interactive use, call (defun shadow-site-name (site) "Return name if SITE has the form \"/name:\", otherwise SITE." - (if (string-match "\\`/\\(\\w+\\):\\'" site) + (if (string-match "\\`/\\([-.[:word:]]+\\):\\'" site) (match-string 1 site) site)) (defun shadow-name-site (name) "Return \"/name:\" if NAME has word syntax, otherwise NAME." - (if (string-match "\\`\\w+\\'" name) + (if (string-match "\\`[-.[:word:]]+\\'" name) (format "/%s:"name) name)) (defun shadow-site-primary (site) diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el index 5ded94480e..200fb4c58c 100644 --- a/test/lisp/shadowfile-tests.el +++ b/test/lisp/shadowfile-tests.el @@ -556,6 +556,8 @@ guaranteed by the originator of a cluster definition." (ert-deftest shadow-test06-literal-groups () "Check literal group definitions." + (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) + (let ((shadow-info-file shadow-test-info-file) (shadow-todo-file shadow-test-todo-file) shadow-clusters shadow-literal-groups @@ -618,6 +620,8 @@ guaranteed by the originator of a cluster definition." (ert-deftest shadow-test07-regexp-groups () "Check regexp group definitions." + (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) + (let ((shadow-info-file shadow-test-info-file) (shadow-todo-file shadow-test-todo-file) shadow-clusters shadow-regexp-groups @@ -682,6 +686,8 @@ guaranteed by the originator of a cluster definition." (ert-deftest shadow-test08-shadow-todo () "Check that needed shadows are added to todo." + (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) + (let ((backup-inhibited t) (shadow-info-file shadow-test-info-file) (shadow-todo-file shadow-test-todo-file) @@ -780,6 +786,8 @@ guaranteed by the originator of a cluster definition." (ert-deftest shadow-test09-shadow-copy-files () "Check that needed shadow files are copied." + (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) + (let ((backup-inhibited t) (shadow-info-file shadow-test-info-file) (shadow-todo-file shadow-test-todo-file) commit 7308fa0e2b8d929a4e0f7f54ac46228f93674672 Author: Eli Zaretskii Date: Sat Jul 21 12:28:11 2018 +0300 Improve doc strings of several variables in keyboard.c * src/keyboard.c (syms_of_keyboard) : Make sure the first sentence of the doc string fits on a single line. diff --git a/src/keyboard.c b/src/keyboard.c index e62dd0ec48..1da5ac088d 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -11854,10 +11854,10 @@ if the command is in this list, the selection is not updated. */); DEFVAR_LISP ("debug-on-event", Vdebug_on_event, - doc: /* Enter debugger on this event. When Emacs -receives the special event specified by this variable, it will try to -break into the debugger as soon as possible instead of processing the -event normally through `special-event-map'. + doc: /* Enter debugger on this event. +When Emacs receives the special event specified by this variable, +it will try to break into the debugger as soon as possible instead +of processing the event normally through `special-event-map'. Currently, the only supported values for this variable are `sigusr1' and `sigusr2'. */); @@ -11865,21 +11865,23 @@ variable are `sigusr1' and `sigusr2'. */); DEFVAR_BOOL ("attempt-stack-overflow-recovery", attempt_stack_overflow_recovery, - doc: /* If non-nil, attempt to recover from C stack -overflow. This recovery is unsafe and may lead to deadlocks or data + doc: /* If non-nil, attempt to recover from C stack overflows. +This recovery is potentially unsafe and may lead to deadlocks or data corruption, but it usually works and may preserve modified buffers that would otherwise be lost. If nil, treat stack overflow like any -other kind of crash. */); +other kind of crash or fatal error. */); attempt_stack_overflow_recovery = true; DEFVAR_BOOL ("attempt-orderly-shutdown-on-fatal-signal", attempt_orderly_shutdown_on_fatal_signal, - doc: /* If non-nil, attempt to perform an orderly -shutdown when Emacs receives a fatal signal (e.g., a crash). -This cleanup is unsafe and may lead to deadlocks or data corruption, -but it usually works and may preserve modified buffers that would -otherwise be lost. If nil, crash immediately in response to fatal -signals. */); + doc: /* If non-nil, attempt orderly shutdown on fatal signals. +By default this variable is non-nil, and Emacs attempts to perform +an orderly shutdown when it catches a fatal signal (e.g., a crash). +The orderly shutdown includes an attempt to auto-save your unsaved edits +and other useful cleanups. These cleanups are potentially unsafe and may +lead to deadlocks or data corruption, but it usually works and may +preserve data in modified buffers that would otherwise be lost. +If nil, Emacs crashes immediately in response to fatal signals. */); attempt_orderly_shutdown_on_fatal_signal = true; /* Create the initial keyboard. Qt means 'unset'. */ commit 03e3440dbbfea40b449a9f6f23a3630664275d11 Author: Eli Zaretskii Date: Sat Jul 21 12:10:20 2018 +0300 Fix recording keyboard macros when input method is active * lisp/international/quail.el (quail-start-translation) (quail-start-conversion): Bind inhibit--record-char to t for the first character of a translated sequence. * src/keyboard.c (record_char): Don't record events from macros to dribble file, per documentation. (Fopen_dribble_file): Doc fix. (syms_of_keyboard) : New variable. (record_char): Don't record input event if inhibit--record-char is non-nil. (Bug#32108) diff --git a/lisp/international/quail.el b/lisp/international/quail.el index eece836354..ec15ccaaf7 100644 --- a/lisp/international/quail.el +++ b/lisp/international/quail.el @@ -1394,12 +1394,13 @@ Return the input string." (generated-events nil) ;FIXME: What is this? (input-method-function nil) (modified-p (buffer-modified-p)) - last-command-event last-command this-command) + last-command-event last-command this-command inhibit-record) (setq quail-current-key "" quail-current-str "" quail-translating t) (if key - (setq unread-command-events (cons key unread-command-events))) + (setq unread-command-events (cons key unread-command-events) + inhibit-record t)) (while quail-translating (set-buffer-modified-p modified-p) (quail-show-guidance) @@ -1408,8 +1409,13 @@ Return the input string." (or input-method-previous-message "") quail-current-str quail-guidance-str))) + ;; We inhibit record_char only for the first key, + ;; because it was already recorded before read_char + ;; called quail-input-method. + (inhibit--record-char inhibit-record) (keyseq (read-key-sequence prompt nil nil t)) (cmd (lookup-key (quail-translation-keymap) keyseq))) + (setq inhibit-record nil) (if (if key (and (commandp cmd) (not (eq cmd 'quail-other-command))) (eq cmd 'quail-self-insert-command)) @@ -1453,14 +1459,15 @@ Return the input string." (generated-events nil) ;FIXME: What is this? (input-method-function nil) (modified-p (buffer-modified-p)) - last-command-event last-command this-command) + last-command-event last-command this-command inhibit-record) (setq quail-current-key "" quail-current-str "" quail-translating t quail-converting t quail-conversion-str "") (if key - (setq unread-command-events (cons key unread-command-events))) + (setq unread-command-events (cons key unread-command-events) + inhibit-record t)) (while quail-converting (set-buffer-modified-p modified-p) (or quail-translating @@ -1476,8 +1483,13 @@ Return the input string." quail-conversion-str quail-current-str quail-guidance-str))) + ;; We inhibit record_char only for the first key, + ;; because it was already recorded before read_char + ;; called quail-input-method. + (inhibit--record-char inhibit-record) (keyseq (read-key-sequence prompt nil nil t)) (cmd (lookup-key (quail-conversion-keymap) keyseq))) + (setq inhibit-record nil) (if (if key (commandp cmd) (eq cmd 'quail-self-insert-command)) (progn (setq last-command-event (aref keyseq (1- (length keyseq))) diff --git a/src/keyboard.c b/src/keyboard.c index aa58e26843..01d7ce9d5e 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -3150,6 +3150,10 @@ help_char_p (Lisp_Object c) static void record_char (Lisp_Object c) { + /* quail.el binds this to avoid recording keys twice. */ + if (inhibit_record_char) + return; + int recorded = 0; if (CONSP (c) && (EQ (XCAR (c), Qhelp_echo) || EQ (XCAR (c), Qmouse_movement))) @@ -3256,7 +3260,7 @@ record_char (Lisp_Object c) /* Write c to the dribble file. If c is a lispy event, write the event's symbol to the dribble file, in . Bleaugh. If you, dear reader, have a better idea, you've got the source. :-) */ - if (dribble) + if (dribble && NILP (Vexecuting_kbd_macro)) { block_input (); if (INTEGERP (c)) @@ -10110,10 +10114,13 @@ DEFUN ("recursion-depth", Frecursion_depth, Srecursion_depth, 0, 0, 0, DEFUN ("open-dribble-file", Fopen_dribble_file, Sopen_dribble_file, 1, 1, "FOpen dribble file: ", - doc: /* Start writing all keyboard characters to a dribble file called FILE. + doc: /* Start writing input events to a dribble file called FILE. If FILE is nil, close any open dribble file. The file will be closed when Emacs exits. +The events written to the file include keyboard and mouse input +events, but not events from executing keyboard macros. + Be aware that this records ALL characters you type! This may include sensitive information such as passwords. */) (Lisp_Object file) @@ -11848,6 +11855,14 @@ signals. */); Vwhile_no_input_ignore_events, doc: /* Ignored events from while-no-input. */); Vwhile_no_input_ignore_events = Qnil; + + DEFVAR_BOOL ("inhibit--record-char", + inhibit_record_char, + doc: /* If non-nil, don't record input events. +This inhibits recording input events for the purposes of keyboard +macros, dribble file, and `recent-keys'. +Internal use only. */); + inhibit_record_char = false; } void commit 1780502da6b9ac8d3063dfd56f675318568283dc Author: Paul Eggert Date: Sat Jul 21 00:25:27 2018 -0700 Report base of out-of-range input fixnums * src/lread.c (string_to_number): Report the base of an out-of-range fixnum. Problem reported by Andy Moreton in: https://lists.gnu.org/r/emacs-devel/2018-07/msg00696.html diff --git a/src/lread.c b/src/lread.c index 4eba863552..50fc6ef8f3 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3798,10 +3798,11 @@ string_to_number (char const *string, int base, int flags) if (! (state & DOT_CHAR) && ! (flags & S2N_OVERFLOW_TO_FLOAT)) { - AUTO_STRING (fmt, ("%s is out of fixnum range; " + AUTO_STRING (fmt, ("%s (base %d) is out of fixnum range; " "maybe set `read-integer-overflow-as-float'?")); AUTO_STRING_WITH_LEN (arg, string, cp - string); - xsignal1 (Qoverflow_error, CALLN (Fformat_message, fmt, arg)); + xsignal1 (Qoverflow_error, + CALLN (Fformat_message, fmt, arg, make_number (base))); } } commit 2c242cb1a2956ecfa894d0110b837d4ecc43a69c Author: Paul Eggert Date: Fri Jul 20 13:55:12 2018 -0700 * src/fns.c (Feql, Fequal): Improve floating-point doc. diff --git a/src/fns.c b/src/fns.c index 7d120a90f7..e7424c3471 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2193,8 +2193,10 @@ The PLIST is modified by side effects. */) } DEFUN ("eql", Feql, Seql, 2, 2, 0, - doc: /* Return t if the two args are the same Lisp object. -Floating-point numbers of equal value are `eql', but they may not be `eq'. */) + doc: /* Return t if the two args are `eq' or are indistinguishable numbers. +Floating-point values with the same sign, exponent and fraction are `eql'. +This differs from numeric comparison: (eql 0.0 -0.0) returns nil and +\(eql 0.0e+NaN 0.0e+NaN) returns t, whereas `=' does the opposite. */) (Lisp_Object obj1, Lisp_Object obj2) { if (FLOATP (obj1)) @@ -2208,8 +2210,8 @@ DEFUN ("equal", Fequal, Sequal, 2, 2, 0, They must have the same data type. Conses are compared by comparing the cars and the cdrs. Vectors and strings are compared element by element. -Numbers are compared by value, but integers cannot equal floats. - (Use `=' if you want integers and floats to be able to be equal.) +Numbers are compared via `eql', so integers do not equal floats. +\(Use `=' if you want integers and floats to be able to be equal.) Symbols must match exactly. */) (Lisp_Object o1, Lisp_Object o2) { commit de66bfd0f22f0464d8670de9002796192bdc24e3 Merge: 6ee0032461 61de292c72 Author: Glenn Morris Date: Fri Jul 20 10:00:32 2018 -0700 ; Merge from origin/emacs-26 The following commit was skipped: 61de292 (origin/emacs-26) Fix (Bug#32218). Do not merge with master commit 6ee00324619673b402dadb3c28e791b79527868f Merge: 144bcc0132 3e722980df Author: Glenn Morris Date: Fri Jul 20 10:00:32 2018 -0700 Merge from origin/emacs-26 3e72298 Improve documentation of 'pcase-defmacro rx' ba9b9bb Fix TTY colors breakage by 'clear-face-cache' f56ad42 * admin/MAINTAINERS: Add files maintained by me (Michael Albi... 7a258fa Adapt shadowfile.el for Tramp (Bug#4526, Bug#4846) cb50077 Fix auth-source-delete (Bug#26184) a4767a6 Avoid assertion violations in gnutls.c 90110f8 Don't use a literal "C-u" in ispell.el help message text f4e7f6d Improve documentation of 'seqp' ed13639 Clarify usage and dependencies between several Flyspell features Conflicts: etc/NEWS test/lisp/auth-source-tests.el commit 144bcc0132e61cc932348312720d592764022844 Author: Paul Eggert Date: Thu Jul 19 16:12:17 2018 -0700 Simplify w32cygwinx.c and pacify GCC (Bug#32189) * src/w32cygwinx.c (format_string): New function. (Fw32_battery_status): Use it. diff --git a/src/w32cygwinx.c b/src/w32cygwinx.c index 8d3ae164cf..5d48c3a9e1 100644 --- a/src/w32cygwinx.c +++ b/src/w32cygwinx.c @@ -24,6 +24,16 @@ along with GNU Emacs. If not, see . */ #include "lisp.h" #include "w32common.h" +static Lisp_Object ATTRIBUTE_FORMAT_PRINTF (1, 2) +format_string (char const *format, ...) +{ + va_list args; + va_start (args, format); + Lisp_Object str = vformat_string (format, args); + va_end (args); + return str; +} + DEFUN ("w32-battery-status", Fw32_battery_status, Sw32_battery_status, 0, 0, 0, doc: /* Get power status information from Windows system. @@ -92,32 +102,17 @@ The following %-sequences are provided: if (system_status.BatteryLifePercent > 100) load_percentage = build_string ("N/A"); else - { - char buffer[16]; - snprintf (buffer, 16, "%d", system_status.BatteryLifePercent); - load_percentage = build_string (buffer); - } + load_percentage = format_string ("%d", system_status.BatteryLifePercent); if (seconds_left < 0) seconds = minutes = hours = remain = build_string ("N/A"); else { - long m; - double h; - char buffer[16]; - snprintf (buffer, 16, "%ld", seconds_left); - seconds = build_string (buffer); - - m = seconds_left / 60; - snprintf (buffer, 16, "%ld", m); - minutes = build_string (buffer); - - h = seconds_left / 3600.0; - snprintf (buffer, 16, "%3.1f", h); - hours = build_string (buffer); - - snprintf (buffer, 16, "%ld:%02ld", m / 60, m % 60); - remain = build_string (buffer); + long m = seconds_left / 60; + seconds = format_string ("%ld", seconds_left); + minutes = format_string ("%ld", m); + hours = format_string ("%3.1f", seconds_left / 3600.0); + remain = format_string ("%ld:%02ld", m / 60, m % 60); } status = listn (CONSTYPE_HEAP, 8, commit 249606fb539bd1a7dc95129277c1684826fc068f Author: Michael Albinus Date: Fri Jul 20 11:30:04 2018 +0200 * lisp/net/trampver.el (customize-package-emacs-version-alist): Add Tramp version integrated in Emacs 26.2. diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 0b83afcc59..9bc8768384 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -69,7 +69,7 @@ ("2.2.9-24.4" . "24.4") ("2.2.11-24.5" . "24.5") ("2.2.13.25.1" . "25.1") ("2.2.13.25.2" . "25.2") ("2.2.13.25.2" . "25.3") - ("2.3.3.26.1" . "26.1"))) + ("2.3.3.26.1" . "26.1") ("2.3.4.26.2" . "26.2"))) (add-hook 'tramp-unload-hook (lambda () commit 61de292c72382403633f753c3d632a560ccfee98 Author: Michael Albinus Date: Fri Jul 20 10:56:41 2018 +0200 Fix (Bug#32218). Do not merge with master * doc/misc/trampver.texi: * lisp/net/trampver.el: Change version to "2.3.4.26.2". (customize-package-emacs-version-alist): Add Tramp version integrated in Emacs 26.2. * lisp/net/tramp.el (tramp-handle-file-truename): * lisp/net/tramp-adb.el (tramp-adb-handle-file-truename): * lisp/net/tramp-sh.el (tramp-sh-handle-file-truename): Fix problem with trailing slash. (Bug#32218) * test/lisp/net/tramp-tests.el (tramp-test21-file-links): Remove `tramp--test-emacs27-p' check. diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index 0970e4e3b3..c6473f5b73 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -8,7 +8,7 @@ @c In the Tramp GIT, the version number is auto-frobbed from @c configure.ac, so you should edit that file and run @c "autoconf && ./configure" to change the version number. -@set trampver 2.3.4 +@set trampver 2.3.4.26.2 @c Other flags from configuration @set instprefix /usr/local diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 58f748bd71..0576cbe963 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -281,13 +281,16 @@ pass to the OPERATION." ;; code could be shared? (defun tramp-adb-handle-file-truename (filename) "Like `file-truename' for Tramp files." - (format - "%s%s" + ;; Preserve trailing "/". + (funcall + (if (string-equal (file-name-nondirectory filename) "") + 'file-name-as-directory 'identity) (with-parsed-tramp-file-name (expand-file-name filename) nil (tramp-make-tramp-file-name method user domain host port (with-tramp-file-property v localname "file-truename" - (let ((result nil)) ; result steps in reverse order + (let ((result nil) ; result steps in reverse order + (quoted (tramp-compat-file-name-quoted-p localname))) (tramp-message v 4 "Finding true name for `%s'" filename) (let* ((steps (split-string localname "/" 'omit)) (localnamedir (tramp-run-real-handler @@ -359,11 +362,19 @@ pass to the OPERATION." (not (string= (substring result -1) "/")))) (setq result (concat result "/")))) + ;; Detect cycle. + (when (and (file-symlink-p filename) + (string-equal result localname)) + (tramp-error + v 'file-error + "Apparent cycle of symbolic links for %s" filename)) + ;; If the resulting localname looks remote, we must quote it + ;; for security reasons. + (when (or quoted (file-remote-p result)) + (let (file-name-handler-alist) + (setq result (tramp-compat-file-name-quote result)))) (tramp-message v 4 "True name of `%s' is `%s'" localname result) - result)))) - - ;; Preserve trailing "/". - (if (string-equal (file-name-nondirectory filename) "") "/" ""))) + result)))))) (defun tramp-adb-handle-file-attributes (filename &optional id-format) "Like `file-attributes' for Tramp files." diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 212be4f36a..3f83697c6b 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1118,8 +1118,10 @@ component is used as the target of the symlink." (defun tramp-sh-handle-file-truename (filename) "Like `file-truename' for Tramp files." - (format - "%s%s" + ;; Preserve trailing "/". + (funcall + (if (string-equal (file-name-nondirectory filename) "") + 'file-name-as-directory 'identity) (with-parsed-tramp-file-name (expand-file-name filename) nil (tramp-make-tramp-file-name method user domain host port @@ -1223,10 +1225,7 @@ component is used as the target of the symlink." (let (file-name-handler-alist) (setq result (tramp-compat-file-name-quote result)))) (tramp-message v 4 "True name of `%s' is `%s'" localname result) - result)))) - - ;; Preserve trailing "/". - (if (string-equal (file-name-nondirectory filename) "") "/" ""))) + result)))))) ;; Basic functions. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 59f4ceaa54..1344757559 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3153,17 +3153,18 @@ User is always nil." (defun tramp-handle-file-truename (filename) "Like `file-truename' for Tramp files." - (let ((result (expand-file-name filename)) - (numchase 0) - ;; Don't make the following value larger than - ;; necessary. People expect an error message in a - ;; timely fashion when something is wrong; - ;; otherwise they might think that Emacs is hung. - ;; Of course, correctness has to come first. - (numchase-limit 20) - symlink-target) - (format - "%s%s" + ;; Preserve trailing "/". + (funcall + (if (string-equal (file-name-nondirectory filename) "") + 'file-name-as-directory 'identity) + (let ((result (expand-file-name filename)) + (numchase 0) + ;; Don't make the following value larger than necessary. + ;; People expect an error message in a timely fashion when + ;; something is wrong; otherwise they might think that Emacs + ;; is hung. Of course, correctness has to come first. + (numchase-limit 20) + symlink-target) (with-parsed-tramp-file-name result v1 (with-tramp-file-property v1 v1-localname "file-truename" (while (and (setq symlink-target (file-symlink-p result)) @@ -3188,10 +3189,7 @@ User is always nil." (tramp-error v1 'file-error "Maximum number (%d) of symlinks exceeded" numchase-limit))) - (directory-file-name result))) - - ;; Preserve trailing "/". - (if (string-equal (file-name-nondirectory filename) "") "/" "")))) + (directory-file-name result)))))) (defun tramp-handle-find-backup-file-name (filename) "Like `find-backup-file-name' for Tramp files." diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index d02e6bcc2b..6454b5b8f8 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -7,7 +7,7 @@ ;; Maintainer: Michael Albinus ;; Keywords: comm, processes ;; Package: tramp -;; Version: 2.3.4 +;; Version: 2.3.4.26.2 ;; This file is part of GNU Emacs. @@ -33,7 +33,7 @@ ;; should be changed only there. ;;;###tramp-autoload -(defconst tramp-version "2.3.4" +(defconst tramp-version "2.3.4.26.2" "This version of Tramp.") ;;;###tramp-autoload @@ -55,7 +55,7 @@ ;; Check for Emacs version. (let ((x (if (>= emacs-major-version 24) "ok" - (format "Tramp 2.3.4 is not fit for %s" + (format "Tramp 2.3.4.26.2 is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version))))))) (unless (string-match "\\`ok\\'" x) (error "%s" x))) @@ -70,7 +70,7 @@ ("2.2.9-24.4" . "24.4") ("2.2.11-24.5" . "24.5") ("2.2.13.25.1" . "25.1") ("2.2.13.25.2" . "25.2") ("2.2.13.25.2" . "25.3") - ("2.3.3.26.1" . "26.1"))) + ("2.3.3.26.1" . "26.1") ("2.3.4.26.2" . "26.2"))) (add-hook 'tramp-unload-hook (lambda () diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index e70f00eb2c..8f810818af 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2855,10 +2855,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; We must unquote it. (should (string-equal - (funcall - (if (tramp--test-emacs27-p) - 'tramp-compat-file-name-unquote 'identity) - (file-truename tmp-name1)) + (file-truename tmp-name1) (tramp-compat-file-name-unquote (file-truename tmp-name3)))))) ;; Cleanup. commit 3e722980df9d4a705394c843a2a5e051e9c682b6 Author: Eli Zaretskii Date: Fri Jul 20 11:44:36 2018 +0300 Improve documentation of 'pcase-defmacro rx' * lisp/emacs-lisp/rx.el (rx): Clarify and improve the doc string. For the details, see the discussion starting at http://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00399.html. diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index 30bb129e8f..5fa0eaf194 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -1181,24 +1181,28 @@ enclosed in `(and ...)'. (pcase-defmacro rx (&rest regexps) - "Build a `pcase' pattern matching `rx' regexps. -The REGEXPS are interpreted as by `rx'. The pattern matches if -the regular expression so constructed matches EXPVAL, as if -by `string-match'. + "Build a `pcase' pattern matching `rx' REGEXPS in sexp form. +The REGEXPS are interpreted as in `rx'. The pattern matches any +string that is a match for the regular expression so constructed, +as if by `string-match'. In addition to the usual `rx' constructs, REGEXPS can contain the following constructs: - (let VAR FORM...) creates a new explicitly numbered submatch - that matches FORM and binds the match to - VAR. - (backref VAR) creates a backreference to the submatch - introduced by a previous (let VAR ...) - construct. - -The VARs are associated with explicitly numbered submatches -starting from 1. Multiple occurrences of the same VAR refer to -the same submatch. + (let REF SEXP...) creates a new explicitly named reference to + a submatch that matches regular expressions + SEXP, and binds the match to REF. + (backref REF) creates a backreference to the submatch + introduced by a previous (let REF ...) + construct. REF can be the same symbol + in the first argument of the corresponding + (let REF ...) construct, or it can be a + submatch number. It matches the referenced + submatch. + +The REFs are associated with explicitly named submatches starting +from 1. Multiple occurrences of the same REF refer to the same +submatch. If a case matches, the match data is modified as usual so you can use it in the case body, but you still have to pass the correct commit fb24ce37d1bc258cfc3884d9828aa0602fa06e1d Author: Paul Eggert Date: Thu Jul 19 22:03:34 2018 -0700 Prefer NILP (x) to EQ (x, Qnil) This simplifies the code a bit, and also simplifies some potential future changes slightly (e.g., altering eq vs eql). * src/alloc.c (mark_object): * src/callint.c (fix_command): * src/chartab.c (Fchar_table_range, Fset_char_table_range): * src/dbusbind.c (XD_OBJECT_TO_DBUS_TYPE, xd_signature): * src/dired.c (Fsystem_users): * src/fileio.c (Fdo_auto_save): * src/fns.c (concat): * src/frame.c (get_frame_param, frame_inhibit_resize) (store_in_alist, store_frame_param, x_set_autoraise) (x_set_autolower, x_get_arg): * src/image.c (Fclear_image_cache): * src/intervals.c (intervals_equal): * src/intervals.h (DEFAULT_INTERVAL_P): * src/lread.c (substitute_object_recurse): * src/menu.c (digest_single_submenu) (find_and_call_menu_selection) (find_and_return_menu_selection): * src/nsfns.m (x_set_icon_name, Fx_create_frame): * src/nsmenu.m (ns_menu_show): * src/nsselect.m (ns_string_to_pasteboard_internal) (Fns_selection_exists_p, Fns_selection_owner_p): * src/process.c (Faccept_process_output) (wait_reading_process_output): * src/terminal.c (store_terminal_param): * src/textprop.c (verify_interval_modification): * src/xdisp.c (next_element_from_buffer): * src/xfaces.c (Finternal_set_lisp_face_attribute): * src/xfns.c (x_set_icon_type, Fx_synchronize): * src/xmenu.c (x_menu_show): * src/xselect.c (Fx_selection_owner_p) (Fx_selection_exists_p): * src/xwidget.c (xwidget_view_lookup): Prefer NILP (x) to EQ (x, Qnil). diff --git a/src/alloc.c b/src/alloc.c index 8764591336..ad716f543c 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -6585,7 +6585,7 @@ mark_object (Lisp_Object arg) CHECK_ALLOCATED_AND_LIVE (live_cons_p); CONS_MARK (ptr); /* If the cdr is nil, avoid recursion for the car. */ - if (EQ (ptr->u.s.u.cdr, Qnil)) + if (NILP (ptr->u.s.u.cdr)) { obj = ptr->u.s.car; cdr_count = 0; diff --git a/src/callint.c b/src/callint.c index c6e003ed40..807e1cca9c 100644 --- a/src/callint.c +++ b/src/callint.c @@ -200,7 +200,7 @@ fix_command (Lisp_Object input, Lisp_Object values) carelt = XCAR (elt); /* If it is (if X Y), look at Y. */ if (EQ (carelt, Qif) - && EQ (Fnthcdr (make_number (3), elt), Qnil)) + && NILP (Fnthcdr (make_number (3), elt))) elt = Fnth (make_number (2), elt); /* If it is (when ... Y), look at Y. */ else if (EQ (carelt, Qwhen)) diff --git a/src/chartab.c b/src/chartab.c index 065ae4f9f2..89983503ac 100644 --- a/src/chartab.c +++ b/src/chartab.c @@ -605,7 +605,7 @@ a cons of character codes (for characters in the range), or a character code. * Lisp_Object val; CHECK_CHAR_TABLE (char_table); - if (EQ (range, Qnil)) + if (NILP (range)) val = XCHAR_TABLE (char_table)->defalt; else if (CHARACTERP (range)) val = CHAR_TABLE_REF (char_table, XFASTINT (range)); @@ -642,7 +642,7 @@ or a character code. Return VALUE. */) for (i = 0; i < chartab_size[0]; i++) set_char_table_contents (char_table, i, value); } - else if (EQ (range, Qnil)) + else if (NILP (range)) set_char_table_defalt (char_table, value); else if (CHARACTERP (range)) char_table_set (char_table, XINT (range), value); diff --git a/src/dbusbind.c b/src/dbusbind.c index 4ebea5712a..96429810e2 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -200,7 +200,7 @@ xd_symbol_to_dbus_type (Lisp_Object object) `dbus-send-signal', into corresponding C values appended as arguments to a D-Bus message. */ #define XD_OBJECT_TO_DBUS_TYPE(object) \ - ((EQ (object, Qt) || EQ (object, Qnil)) ? DBUS_TYPE_BOOLEAN \ + ((EQ (object, Qt) || NILP (object)) ? DBUS_TYPE_BOOLEAN \ : (NATNUMP (object)) ? DBUS_TYPE_UINT32 \ : (INTEGERP (object)) ? DBUS_TYPE_INT32 \ : (FLOATP (object)) ? DBUS_TYPE_DOUBLE \ @@ -360,7 +360,7 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) break; case DBUS_TYPE_BOOLEAN: - if (!EQ (object, Qt) && !EQ (object, Qnil)) + if (!EQ (object, Qt) && !NILP (object)) wrong_type_argument (intern ("booleanp"), object); sprintf (signature, "%c", dtype); break; diff --git a/src/dired.c b/src/dired.c index 5812c569fa..472ec113d4 100644 --- a/src/dired.c +++ b/src/dired.c @@ -1058,7 +1058,7 @@ return a list with one element, taken from `user-real-login-name'. */) endpwent (); #endif - if (EQ (users, Qnil)) + if (NILP (users)) /* At least current user is always known. */ users = list1 (Vuser_real_login_name); return users; diff --git a/src/fileio.c b/src/fileio.c index 5a1c7ae10e..39789e55ff 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -5714,7 +5714,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) spare the user annoying messages. */ && XFASTINT (BVAR (b, save_length)) > 5000 /* These messages are frequent and annoying for `*mail*'. */ - && !EQ (BVAR (b, filename), Qnil) + && !NILP (BVAR (b, filename)) && NILP (no_message)) { /* It has shrunk too much; turn off auto-saving here. */ diff --git a/src/fns.c b/src/fns.c index 10997da0d4..7d120a90f7 100644 --- a/src/fns.c +++ b/src/fns.c @@ -718,7 +718,7 @@ concat (ptrdiff_t nargs, Lisp_Object *args, val = make_uninit_string (result_len); /* In `append', if all but last arg are nil, return last arg. */ - if (target_type == Lisp_Cons && EQ (val, Qnil)) + if (target_type == Lisp_Cons && NILP (val)) return last_tail; /* Copy the contents of the args into the result. */ diff --git a/src/frame.c b/src/frame.c index d477c1acc3..85ec7401d6 100644 --- a/src/frame.c +++ b/src/frame.c @@ -139,14 +139,9 @@ check_window_system (struct frame *f) /* Return the value of frame parameter PROP in frame FRAME. */ Lisp_Object -get_frame_param (register struct frame *frame, Lisp_Object prop) +get_frame_param (struct frame *frame, Lisp_Object prop) { - register Lisp_Object tem; - - tem = Fassq (prop, frame->param_alist); - if (EQ (tem, Qnil)) - return tem; - return Fcdr (tem); + return Fcdr (Fassq (prop, frame->param_alist)); } @@ -189,9 +184,9 @@ frame_inhibit_resize (struct frame *f, bool horizontal, Lisp_Object parameter) || (CONSP (frame_inhibit_implied_resize) && !NILP (Fmemq (parameter, frame_inhibit_implied_resize))) || (horizontal - && !EQ (fullscreen, Qnil) && !EQ (fullscreen, Qfullheight)) + && !NILP (fullscreen) && !EQ (fullscreen, Qfullheight)) || (!horizontal - && !EQ (fullscreen, Qnil) && !EQ (fullscreen, Qfullwidth)) + && !NILP (fullscreen) && !EQ (fullscreen, Qfullwidth)) || FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)) : ((horizontal && f->inhibit_horizontal_resize) || (!horizontal && f->inhibit_vertical_resize))); @@ -2808,10 +2803,8 @@ frames_discard_buffer (Lisp_Object buffer) void store_in_alist (Lisp_Object *alistptr, Lisp_Object prop, Lisp_Object val) { - register Lisp_Object tem; - - tem = Fassq (prop, *alistptr); - if (EQ (tem, Qnil)) + Lisp_Object tem = Fassq (prop, *alistptr); + if (NILP (tem)) *alistptr = Fcons (Fcons (prop, val), *alistptr); else Fsetcdr (tem, val); @@ -2975,7 +2968,7 @@ store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val) /* Update the frame parameter alist. */ old_alist_elt = Fassq (prop, f->param_alist); - if (EQ (old_alist_elt, Qnil)) + if (NILP (old_alist_elt)) fset_param_alist (f, Fcons (Fcons (prop, val), f->param_alist)); else Fsetcdr (old_alist_elt, val); @@ -4516,13 +4509,13 @@ x_set_visibility (struct frame *f, Lisp_Object value, Lisp_Object oldval) void x_set_autoraise (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { - f->auto_raise = !EQ (Qnil, arg); + f->auto_raise = !NILP (arg); } void x_set_autolower (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { - f->auto_lower = !EQ (Qnil, arg); + f->auto_lower = !NILP (arg); } void @@ -4973,7 +4966,7 @@ x_get_arg (Display_Info *dpyinfo, Lisp_Object alist, Lisp_Object param, /* If it wasn't specified in ALIST or the Lisp-level defaults, look in the X resources. */ - if (EQ (tem, Qnil)) + if (NILP (tem)) { if (attribute && dpyinfo) { diff --git a/src/image.c b/src/image.c index 992b225d7b..a83f0641ab 100644 --- a/src/image.c +++ b/src/image.c @@ -1610,7 +1610,7 @@ Anything else, means only clear those images which refer to FILTER, which is then usually a filename. */) (Lisp_Object filter) { - if (!(EQ (filter, Qnil) || FRAMEP (filter))) + if (! (NILP (filter) || FRAMEP (filter))) clear_image_caches (filter); else clear_image_cache (decode_window_system_frame (filter), Qt); diff --git a/src/intervals.c b/src/intervals.c index 4c624ea79c..c3e137cc38 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -197,7 +197,7 @@ intervals_equal (INTERVAL i0, INTERVAL i1) } /* i0 has something i1 doesn't. */ - if (EQ (i1_val, Qnil)) + if (NILP (i1_val)) return false; /* i0 and i1 both have sym, but it has different values in each. */ diff --git a/src/intervals.h b/src/intervals.h index 162c4efc62..f37372a42c 100644 --- a/src/intervals.h +++ b/src/intervals.h @@ -116,7 +116,7 @@ struct interval /* True if this is a default interval, which is the same as being null or having no properties. */ -#define DEFAULT_INTERVAL_P(i) (!i || EQ ((i)->plist, Qnil)) +#define DEFAULT_INTERVAL_P(i) (!i || NILP ((i)->plist)) /* Test what type of parent we have. Three possibilities: another interval, a buffer or string object, or NULL. */ diff --git a/src/lread.c b/src/lread.c index 4ce6a442c3..4eba863552 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3603,7 +3603,7 @@ substitute_object_recurse (struct subst *subst, Lisp_Object subtree) return subtree; /* If we've been to this node before, don't explore it again. */ - if (!EQ (Qnil, Fmemq (subtree, subst->seen))) + if (!NILP (Fmemq (subtree, subst->seen))) return subtree; /* If this node can be the entry point to a cycle, remember that @@ -4236,7 +4236,7 @@ usage: (unintern NAME OBARRAY) */) session if we unintern them, as well as even more ways to use `setq' or `fset' or whatnot to make the Emacs session unusable. Let's not go down this silly road. --Stef */ - /* if (EQ (tem, Qnil) || EQ (tem, Qt)) + /* if (NILP (tem) || EQ (tem, Qt)) error ("Attempt to unintern t or nil"); */ XSYMBOL (tem)->u.s.interned = SYMBOL_UNINTERNED; diff --git a/src/menu.c b/src/menu.c index e7d4d782fe..a088083df2 100644 --- a/src/menu.c +++ b/src/menu.c @@ -647,7 +647,7 @@ digest_single_submenu (int start, int end, bool top_level_items) i = start; while (i < end) { - if (EQ (AREF (menu_items, i), Qnil)) + if (NILP (AREF (menu_items, i))) { submenu_stack[submenu_depth++] = save_wv; save_wv = prev_wv; @@ -900,7 +900,7 @@ find_and_call_menu_selection (struct frame *f, int menu_bar_items_used, while (i < menu_bar_items_used) { - if (EQ (AREF (vector, i), Qnil)) + if (NILP (AREF (vector, i))) { subprefix_stack[submenu_depth++] = prefix; prefix = entry; @@ -985,7 +985,7 @@ find_and_return_menu_selection (struct frame *f, bool keymaps, void *client_data while (i < menu_items_used) { - if (EQ (AREF (menu_items, i), Qnil)) + if (NILP (AREF (menu_items, i))) { subprefix_stack[submenu_depth++] = prefix; prefix = entry; diff --git a/src/nsfns.m b/src/nsfns.m index 9ff7e88a8d..184657f3b4 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -363,7 +363,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side. if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt)) return; } - else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil)) + else if (!STRINGP (oldval) && NILP (oldval) == NILP (arg)) return; fset_icon_name (f, arg); @@ -1291,7 +1291,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side. window_prompting = x_figure_window_size (f, parms, true, &x_width, &x_height); tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN); - f->no_split = minibuffer_only || (!EQ (tem, Qunbound) && !EQ (tem, Qnil)); + f->no_split = minibuffer_only || (!EQ (tem, Qunbound) && !NILP (tem)); /* NOTE: on other terms, this is done in set_mouse_color, however this was not getting called under Nextstep. */ diff --git a/src/nsmenu.m b/src/nsmenu.m index a438952818..18c3230a74 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -828,7 +828,7 @@ - (Lisp_Object)runMenuAt: (NSPoint)p forFrame: (struct frame *)f i = 0; while (i < menu_items_used) { - if (EQ (AREF (menu_items, i), Qnil)) + if (NILP (AREF (menu_items, i))) { submenu_stack[submenu_depth++] = save_wv; save_wv = prev_wv; diff --git a/src/nsselect.m b/src/nsselect.m index c72f179ab3..e71a20ed92 100644 --- a/src/nsselect.m +++ b/src/nsselect.m @@ -164,7 +164,7 @@ Updated by Christian Limpach (chris@nice.ch) static void ns_string_to_pasteboard_internal (id pb, Lisp_Object str, NSString *gtype) { - if (EQ (str, Qnil)) + if (NILP (str)) { [pb declareTypes: [NSArray array] owner: nil]; } @@ -399,7 +399,7 @@ Updated by Christian Limpach (chris@nice.ch) return Qnil; CHECK_SYMBOL (selection); - if (EQ (selection, Qnil)) selection = QPRIMARY; + if (NILP (selection)) selection = QPRIMARY; if (EQ (selection, Qt)) selection = QSECONDARY; pb = ns_symbol_to_pb (selection); if (pb == nil) return Qnil; @@ -421,7 +421,7 @@ Updated by Christian Limpach (chris@nice.ch) { check_window_system (NULL); CHECK_SYMBOL (selection); - if (EQ (selection, Qnil)) selection = QPRIMARY; + if (NILP (selection)) selection = QPRIMARY; if (EQ (selection, Qt)) selection = QSECONDARY; return ns_get_pb_change_count (selection) == ns_get_our_change_count_for (selection) diff --git a/src/process.c b/src/process.c index 3fccd962da..0632464134 100644 --- a/src/process.c +++ b/src/process.c @@ -4608,7 +4608,7 @@ is nil, from any process) before the timeout expired. */) /* Can't wait for a process that is dedicated to a different thread. */ - if (!EQ (proc->thread, Qnil) && !EQ (proc->thread, Fcurrent_thread ())) + if (!NILP (proc->thread) && !EQ (proc->thread, Fcurrent_thread ())) { Lisp_Object proc_thread_name = XTHREAD (proc->thread)->name; @@ -5015,7 +5015,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, struct timespec now = invalid_timespec (); eassert (wait_proc == NULL - || EQ (wait_proc->thread, Qnil) + || NILP (wait_proc->thread) || XTHREAD (wait_proc->thread) == current_thread); FD_ZERO (&Available); diff --git a/src/terminal.c b/src/terminal.c index 070b8aac1f..1b3acbe07c 100644 --- a/src/terminal.c +++ b/src/terminal.c @@ -483,7 +483,7 @@ static Lisp_Object store_terminal_param (struct terminal *t, Lisp_Object parameter, Lisp_Object value) { Lisp_Object old_alist_elt = Fassq (parameter, t->param_alist); - if (EQ (old_alist_elt, Qnil)) + if (NILP (old_alist_elt)) { tset_param_alist (t, Fcons (Fcons (parameter, value), t->param_alist)); return Qnil; diff --git a/src/textprop.c b/src/textprop.c index f7e69f30ea..fe5b61e2dd 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -2269,7 +2269,7 @@ verify_interval_modification (struct buffer *buf, if (!inhibit_modification_hooks) { hooks = Fnreverse (hooks); - while (! EQ (hooks, Qnil)) + while (! NILP (hooks)) { call_mod_hooks (Fcar (hooks), make_number (start), make_number (end)); diff --git a/src/xdisp.c b/src/xdisp.c index 1199e1c1b7..316c12ee73 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -8384,7 +8384,7 @@ next_element_from_buffer (struct it *it) eassert (IT_CHARPOS (*it) >= BEGV); eassert (NILP (it->string) && !it->s); eassert (!it->bidi_p - || (EQ (it->bidi_it.string.lstring, Qnil) + || (NILP (it->bidi_it.string.lstring) && it->bidi_it.string.s == NULL)); /* With bidi reordering, the character to display might not be the diff --git a/src/xfaces.c b/src/xfaces.c index eea0672418..0f9a741dfe 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -2971,7 +2971,7 @@ FRAME 0 means change the face on all frames, and change the default if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)) if ((SYMBOLP (value) && !EQ (value, Qt) - && !EQ (value, Qnil)) + && !NILP (value)) /* Overline color. */ || (STRINGP (value) && SCHARS (value) == 0)) @@ -2985,7 +2985,7 @@ FRAME 0 means change the face on all frames, and change the default if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)) if ((SYMBOLP (value) && !EQ (value, Qt) - && !EQ (value, Qnil)) + && !NILP (value)) /* Strike-through color. */ || (STRINGP (value) && SCHARS (value) == 0)) diff --git a/src/xfns.c b/src/xfns.c index fe8170cf63..66e49df298 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -1456,7 +1456,7 @@ x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval) if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt)) return; } - else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil)) + else if (!STRINGP (oldval) && NILP (oldval) == NILP (arg)) return; block_input (); @@ -5722,7 +5722,7 @@ If TERMINAL is omitted or nil, that stands for the selected frame's display. */ { struct x_display_info *dpyinfo = check_x_display_info (terminal); - XSynchronize (dpyinfo->display, !EQ (on, Qnil)); + XSynchronize (dpyinfo->display, !NILP (on)); return Qnil; } diff --git a/src/xmenu.c b/src/xmenu.c index 58fba8c322..a99e8ab9f0 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -1487,7 +1487,7 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, i = 0; while (i < menu_items_used) { - if (EQ (AREF (menu_items, i), Qnil)) + if (NILP (AREF (menu_items, i))) { submenu_stack[submenu_depth++] = save_wv; save_wv = prev_wv; @@ -1656,7 +1656,7 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, i = 0; while (i < menu_items_used) { - if (EQ (AREF (menu_items, i), Qnil)) + if (NILP (AREF (menu_items, i))) { subprefix_stack[submenu_depth++] = prefix; prefix = entry; diff --git a/src/xselect.c b/src/xselect.c index 1f51be4c52..8448944c00 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -2094,7 +2094,7 @@ On Nextstep, TERMINAL is unused. */) struct frame *f = frame_for_x_selection (terminal); CHECK_SYMBOL (selection); - if (EQ (selection, Qnil)) selection = QPRIMARY; + if (NILP (selection)) selection = QPRIMARY; if (EQ (selection, Qt)) selection = QSECONDARY; if (f && !NILP (LOCAL_SELECTION (selection, FRAME_DISPLAY_INFO (f)))) @@ -2124,7 +2124,7 @@ On Nextstep, TERMINAL is unused. */) struct x_display_info *dpyinfo; CHECK_SYMBOL (selection); - if (EQ (selection, Qnil)) selection = QPRIMARY; + if (NILP (selection)) selection = QPRIMARY; if (EQ (selection, Qt)) selection = QSECONDARY; if (!f) diff --git a/src/xwidget.c b/src/xwidget.c index 2a53966ef4..758e640878 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -1099,7 +1099,7 @@ xwidget_view_lookup (struct xwidget *xw, struct window *w) ret = Fxwidget_view_lookup (xwidget, window); - return EQ (ret, Qnil) ? NULL : XXWIDGET_VIEW (ret); + return NILP (ret) ? NULL : XXWIDGET_VIEW (ret); } struct xwidget * commit 76715f8921dca740880cd22c644a6328cd810846 Author: Tom Tromey Date: Thu Jul 19 15:58:10 2018 -0600 Fix bignum creation when EMACS_INT is wider than long * src/alloc.c (mpz_set_intmax_slow, mpz_set_uintmax_slow): New functions. * src/data.c (arith_driver, Frem, Fmod, ash_lsh_impl, Fadd1) (Fsub1): Use mpz_set_intmax, mpz_set_uintmax. * src/emacs-module.c (module_make_integer): Use mpz_set_intmax. * src/floatfns.c (Fabs): Use mpz_set_intmax. * src/lisp.h (mpz_set_intmax, mpz_set_uintmax): New inline functions. (mpz_set_uintmax_slow, mpz_set_intmax_slow): Declare. diff --git a/src/alloc.c b/src/alloc.c index b775948fd9..1dc1bbb031 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3824,6 +3824,36 @@ make_number (mpz_t value) return obj; } +void +mpz_set_intmax_slow (mpz_t result, intmax_t v) +{ + /* If long is larger then a faster path is taken. */ + eassert (sizeof (intmax_t) > sizeof (long)); + + bool negate = false; + if (v < 0) + { + v = -v; + negate = true; + } + mpz_set_uintmax_slow (result, (uintmax_t) v); + if (negate) + mpz_neg (result, result); +} + +void +mpz_set_uintmax_slow (mpz_t result, uintmax_t v) +{ + /* If long is larger then a faster path is taken. */ + eassert (sizeof (uintmax_t) > sizeof (unsigned long)); + /* This restriction could be lifted if needed. */ + eassert (sizeof (uintmax_t) <= 2 * sizeof (unsigned long)); + + mpz_set_ui (result, v >> (CHAR_BIT * sizeof (unsigned long))); + mpz_mul_2exp (result, result, CHAR_BIT * sizeof (unsigned long)); + mpz_add_ui (result, result, v & -1ul); +} + /* Return a newly created vector or string with specified arguments as elements. If all the arguments are characters that can fit diff --git a/src/data.c b/src/data.c index 862381229d..0deebdca1a 100644 --- a/src/data.c +++ b/src/data.c @@ -2882,7 +2882,7 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) if (BIGNUMP (val)) mpz_set (accum, XBIGNUM (val)->value); else - mpz_set_si (accum, XINT (val)); + mpz_set_intmax (accum, XINT (val)); if (nargs == 1) mpz_neg (accum, accum); } @@ -2905,7 +2905,7 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) if (BIGNUMP (val)) mpz_set (accum, XBIGNUM (val)->value); else - mpz_set_si (accum, XINT (val)); + mpz_set_intmax (accum, XINT (val)); } else { @@ -2933,7 +2933,8 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) else { mpz_t tem; - mpz_init_set_ui (tem, XUINT (val)); + mpz_init (tem); + mpz_set_uintmax (tem, XUINT (val)); mpz_and (accum, accum, tem); mpz_clear (tem); } @@ -2944,7 +2945,8 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) else { mpz_t tem; - mpz_init_set_ui (tem, XUINT (val)); + mpz_init (tem); + mpz_set_uintmax (tem, XUINT (val)); mpz_ior (accum, accum, tem); mpz_clear (tem); } @@ -2955,7 +2957,8 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) else { mpz_t tem; - mpz_init_set_ui (tem, XUINT (val)); + mpz_init (tem); + mpz_set_uintmax (tem, XUINT (val)); mpz_xor (accum, accum, tem); mpz_clear (tem); } @@ -3092,7 +3095,8 @@ Both must be integers or markers. */) xmp = &XBIGNUM (x)->value; else { - mpz_init_set_si (xm, XINT (x)); + mpz_init (xm); + mpz_set_intmax (xm, XINT (x)); xmp = &xm; } @@ -3100,7 +3104,8 @@ Both must be integers or markers. */) ymp = &XBIGNUM (y)->value; else { - mpz_init_set_si (ym, XINT (y)); + mpz_init (ym); + mpz_set_intmax (ym, XINT (y)); ymp = &ym; } @@ -3163,7 +3168,8 @@ Both X and Y must be numbers or markers. */) xmp = &XBIGNUM (x)->value; else { - mpz_init_set_si (xm, XINT (x)); + mpz_init (xm); + mpz_set_intmax (xm, XINT (x)); xmp = &xm; } @@ -3171,7 +3177,8 @@ Both X and Y must be numbers or markers. */) ymp = &XBIGNUM (y)->value; else { - mpz_init_set_si (ym, XINT (y)); + mpz_init (ym); + mpz_set_intmax (ym, XINT (y)); ymp = &ym; } @@ -3317,10 +3324,11 @@ ash_lsh_impl (Lisp_Object value, Lisp_Object count, bool lsh) /* Just do the work as bignums to make the code simpler. */ mpz_t result; eassume (FIXNUMP (value)); + mpz_init (result); if (lsh) - mpz_init_set_ui (result, XUINT (value)); + mpz_set_uintmax (result, XUINT (value)); else - mpz_init_set_si (result, XINT (value)); + mpz_set_intmax (result, XINT (value)); if (XINT (count) >= 0) mpz_mul_2exp (result, result, XINT (count)); else @@ -3376,7 +3384,8 @@ Markers are converted to integers. */) else { mpz_t num; - mpz_init_set_si (num, XINT (number) + 1); + mpz_init (num); + mpz_set_intmax (num, XINT (number) + 1); number = make_number (num); mpz_clear (num); } @@ -3410,7 +3419,8 @@ Markers are converted to integers. */) else { mpz_t num; - mpz_init_set_si (num, XINT (number) - 1); + mpz_init (num); + mpz_set_intmax (num, XINT (number) - 1); number = make_number (num); mpz_clear (num); } diff --git a/src/emacs-module.c b/src/emacs-module.c index 7709eeca94..39150f6f67 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -536,7 +536,8 @@ module_make_integer (emacs_env *env, intmax_t n) if (FIXNUM_OVERFLOW_P (n)) { mpz_t val; - mpz_init_set_si (val, n); + mpz_init (val); + mpz_set_intmax (val, n); obj = make_number (val); mpz_clear (val); } diff --git a/src/floatfns.c b/src/floatfns.c index 9a5f0a3ad2..563c65f827 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -288,7 +288,8 @@ DEFUN ("abs", Fabs, Sabs, 1, 1, 0, else if (FIXNUMP (arg) && XINT (arg) == MOST_NEGATIVE_FIXNUM) { mpz_t val; - mpz_init_set_si (val, - MOST_NEGATIVE_FIXNUM); + mpz_init (val); + mpz_set_intmax (val, - MOST_NEGATIVE_FIXNUM); arg = make_number (val); mpz_clear (val); } diff --git a/src/lisp.h b/src/lisp.h index e046429c1b..4208634fa9 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3655,6 +3655,32 @@ extern Lisp_Object listn (enum constype, ptrdiff_t, Lisp_Object, ...); extern Lisp_Object make_bignum_str (const char *num, int base); extern Lisp_Object make_number (mpz_t value); +extern void mpz_set_intmax_slow (mpz_t result, intmax_t v); +extern void mpz_set_uintmax_slow (mpz_t result, uintmax_t v); + +INLINE void +mpz_set_intmax (mpz_t result, intmax_t v) +{ + /* mpz_set_si works in terms of long, but Emacs may use a wider + integer type, and so sometimes will have to construct the mpz_t + by hand. */ + if (sizeof (intmax_t) > sizeof (long) && (long) v != v) + mpz_set_intmax_slow (result, v); + else + mpz_set_si (result, v); +} + +INLINE void +mpz_set_uintmax (mpz_t result, uintmax_t v) +{ + /* mpz_set_ui works in terms of unsigned long, but Emacs may use a + wider integer type, and so sometimes will have to construct the + mpz_t by hand. */ + if (sizeof (uintmax_t) > sizeof (unsigned long) && (unsigned long) v != v) + mpz_set_uintmax_slow (result, v); + else + mpz_set_ui (result, v); +} /* Build a frequently used 2/3/4-integer lists. */ commit 678881e428073b39a906c1ffd01e1b76e271cb5d Author: Tom Tromey Date: Mon Jul 16 08:29:31 2018 -0600 Add missing @end defun * doc/lispref/numbers.texi (Bitwise Operations): Add missing @end defun. diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi index a95c31f468..d9fb43258e 100644 --- a/doc/lispref/numbers.texi +++ b/doc/lispref/numbers.texi @@ -888,6 +888,7 @@ On the other hand, shifting one place to the right looks like this: @noindent As the example illustrates, shifting one place to the right divides the value of a positive integer by two, rounding downward. +@end defun @defun ash integer1 count @cindex arithmetic shift commit 96d77f9eb882b68e994e187ed9c2156a23e3279d Author: Paul Eggert Date: Thu Jul 19 13:29:28 2018 -0700 Improve doc for floating point â€=’ vs â€eql’ * doc/lispref/numbers.texi (Float Basics, Comparison of Numbers): Improve documentation of â€=’ vs â€eq’, â€eql’ and â€equal’ when NaNs and signed zeros are involved. diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi index 6c51b849d3..70bb103041 100644 --- a/doc/lispref/numbers.texi +++ b/doc/lispref/numbers.texi @@ -223,7 +223,7 @@ least one digit after any decimal point in a floating-point number; @samp{1500.} is an integer, not a floating-point number. Emacs Lisp treats @code{-0.0} as numerically equal to ordinary zero -with respect to @code{equal} and @code{=}. This follows the +with respect to numeric comparisons like @code{=}. This follows the @acronym{IEEE} floating-point standard, which says @code{-0.0} and @code{0.0} are numerically equal even though other operations can distinguish them. @@ -232,19 +232,26 @@ distinguish them. @cindex negative infinity @cindex infinity @cindex NaN -@findex eql -@findex sxhash-eql The @acronym{IEEE} floating-point standard supports positive infinity and negative infinity as floating-point values. It also provides for a class of values called NaN, or ``not a number''; numerical functions return such values in cases where there is no correct answer. For example, @code{(/ 0.0 0.0)} returns a NaN@. A NaN is never numerically equal to any value, not even to itself. -NaNs carry a sign and a significand, and non-numeric functions like -@code{eql} and @code{sxhash-eql} treat two NaNs as equal when their +NaNs carry a sign and a significand, and non-numeric functions treat +two NaNs as equal when their signs and significands agree. Significands of NaNs are machine-dependent and are not directly visible to Emacs Lisp. + When NaNs and signed zeros are involved, non-numeric functions like +@code{eql}, @code{equal}, @code{sxhash-eql}, @code{sxhash-equal} and +@code{gethash} determine whether values are indistinguishable, not +whether they are numerically equal. For example, when @var{x} and +@var{y} are the same NaN, @code{(equal x y)} returns @code{t} whereas +@code{(= x y)} uses numeric comparison and returns @code{nil}; +conversely, @code{(equal 0.0 -0.0)} returns @code{nil} whereas +@code{(= 0.0 -0.0)} returns @code{t}. + Here are read syntaxes for these special floating-point values: @table @asis @@ -359,11 +366,15 @@ if so, @code{nil} otherwise. The argument must be a number. @cindex comparing numbers To test numbers for numerical equality, you should normally use -@code{=}, not @code{eq}. There can be many distinct floating-point -objects with the same numeric value. If you use @code{eq} to -compare them, then you test whether two values are the same -@emph{object}. By contrast, @code{=} compares only the numeric values -of the objects. +@code{=} instead of non-numeric comparison predicates like @code{eq}, +@code{eql} and @code{equal}. Distinct floating-point objects can be +numerically equal. If you use @code{eq} to compare them, you test +whether they are the same @emph{object}; if you use @code{eql} or +@code{equal}, you test whether their values are +@emph{indistinguishable}. In contrast, @code{=} uses numeric +comparison, and sometimes returns @code{t} when a non-numeric +comparison would return @code{nil} and vice versa. @xref{Float +Basics}. In Emacs Lisp, each integer is a unique Lisp object. Therefore, @code{eq} is equivalent to @code{=} where integers are commit 3a91c5e4a2684b04b86356a32b7ec57145ceba95 Author: Charles A. Roelli Date: Thu Jul 19 22:17:24 2018 +0200 ; * etc/NEWS: Fix confused documentation markers. The options.el marker was accidentally moved in 2018-07-16 "Improve description of window configs in 'register-val-describe'". diff --git a/etc/NEWS b/etc/NEWS index 28e5d39c52..8275cbb72c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -554,11 +554,12 @@ are obsoleted in GVFS. *** The user option 'tramp-ignored-file-name-regexp' allows to disable Tramp for some look-alike remote file names. ---- ** Register +--- *** The return value of method 'register-val-describe' includes the names of buffers shown by the windows of a window configuration. +--- ** The options.el library has been removed. It was obsolete since Emacs 22.1, replaced by customize. commit 36b64e087ea332505ae9a40f90af45e678db2255 Author: Charles A. Roelli Date: Thu Jul 19 22:06:07 2018 +0200 Add 'font-lock-maximum-decoration' levels for Python * etc/NEWS: New entry under Python mode. * lisp/progmodes/python.el (python-font-lock-keywords-level-1) (python-font-lock-keywords-level-2) (python-font-lock-keywords-maximum-decoration): New variables based off the incumbent 'python-font-lock-keywords'. (python-font-lock-keywords): Change it to a list of the new symbols, for use in the 'car' of 'font-lock-defaults'. (python-mode): Set the 'car' of 'font-lock-defaults' to the value of 'python-font-lock-keywords', instead of the symbol 'python-font-lock-keywords'. diff --git a/etc/NEWS b/etc/NEWS index f30ab69823..28e5d39c52 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -384,6 +384,13 @@ bound to 'C-c C-f'. when escaping text and in addition all numeric entities when unescaping text. +** Python mode + +--- +*** Python mode supports three different font lock decoration levels. +The maximum level is used by default; customize +'font-lock-maximum-decoration' to tone down the decoration. + ** Dired +++ diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index e39ff08739..c55b69e33e 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -526,9 +526,19 @@ The type returned can be `comment', `string' or `paren'." font-lock-string-face) font-lock-comment-face)) -(defvar python-font-lock-keywords - ;; Keywords - `(,(rx symbol-start +(defvar python-font-lock-keywords-level-1 + `((,(rx symbol-start "def" (1+ space) (group (1+ (or word ?_)))) + (1 font-lock-function-name-face)) + (,(rx symbol-start "class" (1+ space) (group (1+ (or word ?_)))) + (1 font-lock-type-face))) + "Font lock keywords to use in python-mode for level 1 decoration. + +This is the minimum decoration level, including function and +class declarations.") + +(defvar python-font-lock-keywords-level-2 + `(,@python-font-lock-keywords-level-1 + ,(rx symbol-start (or "and" "del" "from" "not" "while" "as" "elif" "global" "or" "with" "assert" "else" "if" "pass" "yield" "break" "except" "import" "class" @@ -548,12 +558,35 @@ The type returned can be `comment', `string' or `paren'." ;; Extra: "self") symbol-end) - ;; functions - (,(rx symbol-start "def" (1+ space) (group (1+ (or word ?_)))) - (1 font-lock-function-name-face)) - ;; classes - (,(rx symbol-start "class" (1+ space) (group (1+ (or word ?_)))) - (1 font-lock-type-face)) + ;; Builtins + (,(rx symbol-start + (or + "abs" "all" "any" "bin" "bool" "callable" "chr" "classmethod" + "compile" "complex" "delattr" "dict" "dir" "divmod" "enumerate" + "eval" "filter" "float" "format" "frozenset" "getattr" "globals" + "hasattr" "hash" "help" "hex" "id" "input" "int" "isinstance" + "issubclass" "iter" "len" "list" "locals" "map" "max" "memoryview" + "min" "next" "object" "oct" "open" "ord" "pow" "print" "property" + "range" "repr" "reversed" "round" "set" "setattr" "slice" "sorted" + "staticmethod" "str" "sum" "super" "tuple" "type" "vars" "zip" + "__import__" + ;; Python 2: + "basestring" "cmp" "execfile" "file" "long" "raw_input" "reduce" + "reload" "unichr" "unicode" "xrange" "apply" "buffer" "coerce" + "intern" + ;; Python 3: + "ascii" "bytearray" "bytes" "exec" + ;; Extra: + "__all__" "__doc__" "__name__" "__package__") + symbol-end) . font-lock-builtin-face)) + "Font lock keywords to use in python-mode for level 2 decoration. + +This is the medium decoration level, including everything in +`python-font-lock-keywords-level-1', as well as keywords and +builtins.") + +(defvar python-font-lock-keywords-maximum-decoration + `(,@python-font-lock-keywords-level-2 ;; Constants (,(rx symbol-start (or @@ -596,27 +629,6 @@ The type returned can be `comment', `string' or `paren'." "VMSError" "WindowsError" ) symbol-end) . font-lock-type-face) - ;; Builtins - (,(rx symbol-start - (or - "abs" "all" "any" "bin" "bool" "callable" "chr" "classmethod" - "compile" "complex" "delattr" "dict" "dir" "divmod" "enumerate" - "eval" "filter" "float" "format" "frozenset" "getattr" "globals" - "hasattr" "hash" "help" "hex" "id" "input" "int" "isinstance" - "issubclass" "iter" "len" "list" "locals" "map" "max" "memoryview" - "min" "next" "object" "oct" "open" "ord" "pow" "print" "property" - "range" "repr" "reversed" "round" "set" "setattr" "slice" "sorted" - "staticmethod" "str" "sum" "super" "tuple" "type" "vars" "zip" - "__import__" - ;; Python 2: - "basestring" "cmp" "execfile" "file" "long" "raw_input" "reduce" - "reload" "unichr" "unicode" "xrange" "apply" "buffer" "coerce" - "intern" - ;; Python 3: - "ascii" "bytearray" "bytes" "exec" - ;; Extra: - "__all__" "__doc__" "__name__" "__package__") - symbol-end) . font-lock-builtin-face) ;; assignments ;; support for a = b = c = 5 (,(lambda (limit) @@ -640,7 +652,26 @@ The type returned can be `comment', `string' or `paren'." (goto-char (match-end 1)) (python-syntax-context 'paren))) res)) - (1 font-lock-variable-name-face nil nil)))) + (1 font-lock-variable-name-face nil nil))) + "Font lock keywords to use in python-mode for maximum decoration. + +This decoration level includes everything in +`python-font-lock-keywords-level-2', as well as constants, +decorators, exceptions, and assignments.") + +(defvar python-font-lock-keywords + '(python-font-lock-keywords-level-1 ; When `font-lock-maximum-decoration' is nil. + python-font-lock-keywords-level-1 ; When `font-lock-maximum-decoration' is 1. + python-font-lock-keywords-level-2 ; When `font-lock-maximum-decoration' is 2. + python-font-lock-keywords-maximum-decoration ; When `font-lock-maximum-decoration' + ; is more than 1, or t (which it is, + ; by default). + ) + "List of font lock keyword specifications to use in python-mode. + +Which one will be chosen depends on the value of +`font-lock-maximum-decoration'.") + (defconst python-syntax-propertize-function (syntax-propertize-rules @@ -5325,7 +5356,7 @@ REPORT-FN is Flymake's callback function." 'python-nav-forward-sexp) (set (make-local-variable 'font-lock-defaults) - '(python-font-lock-keywords + `(,python-font-lock-keywords nil nil nil nil (font-lock-syntactic-face-function . python-font-lock-syntactic-face-function))) commit ba9b9bb4accda749be5a3803569ef1dc2de6919a Author: Eli Zaretskii Date: Thu Jul 19 20:44:32 2018 +0300 Fix TTY colors breakage by 'clear-face-cache' Without examining the right frame, 'tty-color-24bit' was erroneously treating a GUI frame as a 24-bit TTY frame. * lisp/term/tty-colors.el (tty-color-24bit): Accept optional argument DISPLAY and pass it to display-color-cells. Doc fix. (tty-color-define, tty-color-desc): Pass the FRAME argument to tty-color-24bit. (Bug#32072) diff --git a/lisp/term/tty-colors.el b/lisp/term/tty-colors.el index ab9149e6b4..a776c830a2 100644 --- a/lisp/term/tty-colors.el +++ b/lisp/term/tty-colors.el @@ -824,10 +824,12 @@ A canonicalized color name is all-lower case, with any blanks removed." (replace-regexp-in-string " +" "" (downcase color)) color))) -(defun tty-color-24bit (rgb) - "Return pixel value on 24-bit terminals. Return nil if RGB is -nil or not on 24-bit terminal." - (when (and rgb (= (display-color-cells) 16777216)) +(defun tty-color-24bit (rgb &optional display) + "Return 24-bit color pixel value for RGB value on DISPLAY. +DISPLAY can be a display name or a frame, and defaults to the +selected frame's display. +If DISPLAY is not on a 24-but TTY terminal, return nil." + (when (and rgb (= (display-color-cells display) 16777216)) (let ((r (lsh (car rgb) -8)) (g (lsh (cadr rgb) -8)) (b (lsh (nth 2 rgb) -8))) @@ -850,7 +852,7 @@ If FRAME is not specified or is nil, it defaults to the selected frame." (error "Invalid specification for tty color \"%s\"" name)) (tty-modify-color-alist (append (list (tty-color-canonicalize name) - (or (tty-color-24bit rgb) index)) + (or (tty-color-24bit rgb frame) index)) rgb) frame)) @@ -1026,7 +1028,7 @@ might need to be approximated if it is not supported directly." (or (assoc color (tty-color-alist frame)) (let ((rgb (tty-color-standard-values color))) (and rgb - (let ((pixel (tty-color-24bit rgb))) + (let ((pixel (tty-color-24bit rgb frame))) (or (and pixel (cons color (cons pixel rgb))) (tty-color-approximate rgb frame))))))))) commit 5934122c1f3371a07b9f041aec693d762e9d8767 Author: Paul Eggert Date: Wed Jul 18 11:27:06 2018 -0700 * etc/NEWS: Fix eql typo in previous change. diff --git a/etc/NEWS b/etc/NEWS index 861520bd14..f30ab69823 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -829,8 +829,8 @@ remote systems, which support this check. ** 'eql', 'make-hash-table', etc. now treat NaNs consistently. Formerly, some of these functions ignored signs and significands of NaNs. Now, all these functions treat NaN signs and significands as -significant. For example, (eql 0.0e+NaN -0.0e+NaN) now returns t -because the two NaNs have different signs; formerly it returned nil. +significant. For example, (eql 0.0e+NaN -0.0e+NaN) now returns nil +because the two NaNs have different signs; formerly it returned t. +++ ** The function 'make-string' accepts an additional optional argument. commit f56ad422c42aabc24e92ea13012692d581b7efbe Author: Michael Albinus Date: Wed Jul 18 16:52:12 2018 +0200 * admin/MAINTAINERS: Add files maintained by me (Michael Albinus). diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS index 753a676e81..1a4157ac53 100644 --- a/admin/MAINTAINERS +++ b/admin/MAINTAINERS @@ -61,7 +61,7 @@ Michael Albinus lisp/net/tramp*.el lisp/url/url-tramp.el doc/misc/tramp*.texi - test/lisp/net/tramp-tests.el + test/lisp/net/tramp*-tests.el test/lisp/url/url-tramp-tests.el D-Bus @@ -210,11 +210,21 @@ Paul Eggert Michael Albinus src/inotify.c lisp/autorevert.el + lisp/files.el (file-name-non-special) lisp/eshell/em-tramp.el + lisp/net/ange-ftp.el lisp/notifications.el + lisp/shadowfile.el test/lisp/autorevert-tests.el + test/lisp/files-tests.el (file-name-non-special) + test/lisp/shadowfile-tests.el test/src/inotify-test.el + Secret Service API in + lisp/auth-source.el + doc/misc/auth.texi + test/lisp/auth-source-tests.el + Nicolas Petton lisp/emacs-lisp/subr-x.el lisp/arc-mode.el commit 7a258fa0bb9f9e7600229b95ed54ee5ee0bc9a0c Author: Michael Albinus Date: Wed Jul 18 16:51:56 2018 +0200 Adapt shadowfile.el for Tramp (Bug#4526, Bug#4846) * etc/NEWS: Mention changes in shadowfile.el. * lisp/shadowfile.el (top): Require 'tramp instead of 'ange-ftp. (shadow-cluster): New defstruct. (shadow-make-cluster, shadow-cluster-name, shadow-cluster-primary) (shadow-cluster-regexp, shadow-get-user) (shadow-parse-fullname): Remove. (shadow-info-file, shadow-todo-file, shadow-system-name) (shadow-homedir, shadow-regexp-superquote, shadow-suffix) (shadow-set-cluster, shadow-get-cluster, shadow-site-name) (shadow-name-site, shadow-site-primary, shadow-site-cluster) (shadow-read-site, shadow-parse-name, shadow-make-fullname) (shadow-replace-name-component, shadow-local-file) (shadow-expand-cluster-in-file-name, shadow-contract-file-name) (shadow-same-site, shadow-file-match, shadow-define-cluster) (shadow-define-literal-group, shadow-define-regexp-group) (shadow-make-group, shadow-shadows-of-1, shadow-read-files) (shadow-write-info-file, shadow-write-todo-file) (shadow-initialize): Adapt variables and functions. * test/lisp/shadowfile-tests.el: New file. diff --git a/etc/NEWS b/etc/NEWS index 92331108e9..1551c36c5a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -94,12 +94,20 @@ it now shows the global revision number, in the form of its changeset hash value. To get back the previous behavior, customize the new option 'vc-hg-symbolic-revision-styles' to the value '("{rev}")'. +--- +** shadowfile.el has been rewritten to support Tramp file names. + * New Modes and Packages in Emacs 26.2 * Incompatible Lisp Changes in Emacs 26.2 +--- +** shadowfile config files have changed their syntax. +Existing files "~/.emacs.d/shadows" and "~/.emacs.d/shadow_todo" must +be removed prior using the changed 'shadow-*' commands. + * Lisp Changes in Emacs 26.2 diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el index 0095d6959e..e1a9b8e1d9 100644 --- a/lisp/shadowfile.el +++ b/lisp/shadowfile.el @@ -25,37 +25,38 @@ ;; This package helps you to keep identical copies of files in more than one ;; place - possibly on different machines. When you save a file, it checks ;; whether it is on the list of files with "shadows", and if so, it tries to -;; copy it when you exit Emacs (or use the shadow-copy-files command). +;; copy it when you exit Emacs (or use the `shadow-copy-files' command). ;; Installation & Use: -;; Add clusters (if necessary) and file groups with shadow-define-cluster, -;; shadow-define-literal-group, and shadow-define-regexp-group (see the +;; Add clusters (if necessary) and file groups with `shadow-define-cluster', +;; `shadow-define-literal-group', and `shadow-define-regexp-group' (see the ;; documentation for these functions for information on how and when to use ;; them). After doing this once, everything should be automatic. -;; The lists of clusters and shadows are saved in a ~/.emacs.d/shadows -;; (`shadow-info-file') file, so that they can be remembered from one -;; Emacs session to another, even (as much as possible) if the Emacs -;; session terminates abnormally. The files needing to be copied are -;; stored in `shadow-todo-file'; if a file cannot be copied for any -;; reason, it will stay on the list to be tried again next time. The -;; `shadow-info-file' file should itself have shadows on all your accounts -;; so that the information in it is consistent everywhere, but -;; `shadow-todo-file' is local information and should have no shadows. +;; The lists of clusters and shadows are saved in `shadow-info-file', +;; so that they can be remembered from one Emacs session to another, +;; even (as much as possible) if the Emacs session terminates +;; abnormally. The files needing to be copied are stored in +;; `shadow-todo-file'; if a file cannot be copied for any reason, it +;; will stay on the list to be tried again next time. The +;; `shadow-info-file' file should itself have shadows on all your +;; accounts so that the information in it is consistent everywhere, +;; but `shadow-todo-file' is local information and should have no +;; shadows. ;; If you do not want to copy a particular file, you can answer "no" and -;; be asked again next time you hit C-x 4 s or exit Emacs. If you do not -;; want to be asked again, use shadow-cancel, and you will not be asked +;; be asked again next time you hit "C-x 4 s" or exit Emacs. If you do not +;; want to be asked again, use "M-x shadow-cancel", and you will not be asked ;; until you change the file and save it again. If you do not want to ;; shadow that file ever again, you can edit it out of the shadows -;; buffer. Anytime you edit the shadows buffer, you must type M-x -;; shadow-read-files to load in the new information, or your changes will +;; buffer. Anytime you edit the shadows buffer, you must type "M-x +;; shadow-read-files" to load in the new information, or your changes will ;; be overwritten! ;; Bugs & Warnings: ;; -;; - It is bad to have two emacses both running shadowfile at the same +;; - It is bad to have two Emacsen both running shadowfile at the same ;; time. It tries to detect this condition, but is not always successful. ;; ;; - You have to be careful not to edit a file in two locations @@ -64,19 +65,16 @@ ;; ;; - It ought to check modification times of both files to make sure ;; it is doing the right thing. This will have to wait until -;; file-newer-than-file-p works between machines. +;; `file-newer-than-file-p' works between machines. ;; ;; - It will not make directories for you, it just fails to copy files ;; that belong in non-existent directories. -;; -;; Please report any bugs to me (boris@gnu.org). Also let me know -;; if you have suggestions or would like to be informed of updates. ;;; Code: (require 'cl-lib) -(require 'ange-ftp) +(require 'tramp) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Variables @@ -107,35 +105,35 @@ files that have been changed and need to be copied to other systems." :type 'boolean :group 'shadow) -;; FIXME in a sense, this changed in 24.4 (addition of locate-user-emacs-file), -;; but due to the weird way this variable is initialized to nil, it didn't -;; literally change. Same for shadow-todo-file. -(defcustom shadow-info-file nil +(defcustom shadow-info-file (locate-user-emacs-file "shadows" ".shadows") "File to keep shadow information in. The `shadow-info-file' should be shadowed to all your accounts to ensure consistency. Default: ~/.emacs.d/shadows" - :type '(choice (const nil) file) - :group 'shadow) + :type 'file + :group 'shadow + :version "26.2") -(defcustom shadow-todo-file nil +(defcustom shadow-todo-file + (locate-user-emacs-file "shadow_todo" ".shadow_todo") "File to store the list of uncopied shadows in. This means that if a remote system is down, or for any reason you cannot or decide not to copy your shadow files at the end of one Emacs session, it will remember and ask you again in your next Emacs session. This file must NOT be shadowed to any other system, it is host-specific. Default: ~/.emacs.d/shadow_todo" - :type '(choice (const nil) file) - :group 'shadow) + :type 'file + :group 'shadow + :version "26.2") ;;; The following two variables should in most cases initialize themselves ;;; correctly. They are provided as variables in case the defaults are wrong ;;; on your machine (and for efficiency). -(defvar shadow-system-name (system-name) - "The complete hostname of this machine.") +(defvar shadow-system-name (concat "/" (system-name) ":") + "The identification for local files on this machine.") -(defvar shadow-homedir nil +(defvar shadow-homedir "~" "Your home directory on this machine.") ;;; @@ -186,12 +184,12 @@ created by `shadow-define-regexp-group'.") (car list)) (defun shadow-regexp-superquote (string) - "Like `regexp-quote', but includes the ^ and $. + "Like `regexp-quote', but includes the \\` and \\'. This makes sure regexp matches nothing but STRING." - (concat "^" (regexp-quote string) "$")) + (concat "\\`" (regexp-quote string) "\\'")) (defun shadow-suffix (prefix string) - "If PREFIX begins STRING, return the rest. + "If PREFIX begins with STRING, return the rest. Return value is non-nil if PREFIX and STRING are `string=' up to the length of PREFIX." (let ((lp (length prefix)) @@ -204,70 +202,66 @@ PREFIX." ;;; Clusters and sites ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; I use the term `site' to refer to a string which may be the name of a -;;; cluster or a literal hostname. All user-level commands should accept -;;; either. - -(defun shadow-make-cluster (name primary regexp) - "Create a shadow cluster. -It is called NAME, uses the PRIMARY hostname and REGEXP matching all -hosts in the cluster. The variable `shadow-clusters' associates the -names of clusters to these structures. This function is for program -use: to create clusters interactively, use `shadow-define-cluster' -instead." - (list name primary regexp)) - -(defmacro shadow-cluster-name (cluster) - "Return the name of the CLUSTER." - (list 'elt cluster 0)) +;;; I use the term `site' to refer to a string which may be the +;;; cluster identification "/name:", a remote identification +;;; "/method:user@host:", or "/system-name:' (the value of +;;; `shadow-system-name') for the location of local files. All +;;; user-level commands should accept either. -(defmacro shadow-cluster-primary (cluster) - "Return the primary hostname of a CLUSTER." - (list 'elt cluster 1)) - -(defmacro shadow-cluster-regexp (cluster) - "Return the regexp matching hosts in a CLUSTER." - (list 'elt cluster 2)) +(cl-defstruct (shadow-cluster (:type list) :named) name primary regexp) (defun shadow-set-cluster (name primary regexp) "Put cluster NAME on the list of clusters. Replace old definition, if any. PRIMARY and REGEXP are the information defining the cluster. For interactive use, call `shadow-define-cluster' instead." - (let ((rest (cl-remove-if (lambda (x) (equal name (car x))) + (let ((rest (cl-remove-if (lambda (x) (equal name (shadow-cluster-name x))) shadow-clusters))) (setq shadow-clusters - (cons (shadow-make-cluster name primary regexp) + (cons (make-shadow-cluster :name name :primary primary :regexp regexp) rest)))) -(defmacro shadow-get-cluster (name) +(defun shadow-get-cluster (name) "Return cluster named NAME, or nil." - (list 'assoc name 'shadow-clusters)) + (shadow-find + (lambda (x) (string-equal (shadow-cluster-name x) name)) + shadow-clusters)) + +;;; SITES + +(defun shadow-site-name (site) + "Return name if SITE has the form \"/name:\", otherwise SITE." + (if (string-match "\\`/\\(\\w+\\):\\'" site) + (match-string 1 site) site)) + +(defun shadow-name-site (name) + "Return \"/name:\" if NAME has word syntax, otherwise NAME." + (if (string-match "\\`\\w+\\'" name) + (format "/%s:"name) name)) (defun shadow-site-primary (site) - "If SITE is a cluster, return primary host, otherwise return SITE." - (let ((c (shadow-get-cluster site))) - (if c - (shadow-cluster-primary c) + "If SITE is a cluster, return primary identification, otherwise return SITE." + (let ((cluster (shadow-get-cluster (shadow-site-name site)))) + (if cluster + (shadow-cluster-primary cluster) site))) -;;; SITES - (defun shadow-site-cluster (site) - "Given a SITE (hostname or cluster name), return cluster it is in, or nil." - (or (assoc site shadow-clusters) + "Given a SITE, return cluster it is in, or nil." + (or (shadow-get-cluster (shadow-site-name site)) (shadow-find - (function (lambda (x) - (string-match (shadow-cluster-regexp x) - site))) + (lambda (x) + (string-match (shadow-cluster-regexp x) (shadow-name-site site))) shadow-clusters))) (defun shadow-read-site () - "Read a cluster name or hostname from the minibuffer." - (let ((ans (completing-read "Host or cluster name [RET when done]: " + "Read a cluster name or host identification from the minibuffer." + (let ((ans (completing-read "Host identification or cluster name: " shadow-clusters))) - (if (equal "" ans) - nil + (when (or (shadow-get-cluster (shadow-site-name ans)) + (string-equal ans shadow-system-name) + (string-equal ans (shadow-site-name shadow-system-name)) + (setq ans (file-remote-p ans))) ans))) (defun shadow-site-match (site1 site2) @@ -281,63 +275,95 @@ be matched against the primary of SITE2." (string-match (shadow-cluster-regexp cluster1) primary2) (string-equal site1 primary2))))) -(defun shadow-get-user (site) - "Return the default username for a SITE." - (ange-ftp-get-user (shadow-site-primary site))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Filename manipulation ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun shadow-parse-fullname (fullname) - "Parse FULLNAME into (site user path) list. -Leave it alone if it already is one. Return nil if the argument is -not a full ange-ftp pathname." - (if (listp fullname) - fullname - (ange-ftp-ftp-name fullname))) - (defun shadow-parse-name (name) - "Parse any NAME into (site user name) list. -Argument can be a simple name, full ange-ftp name, or already a hup list." - (or (shadow-parse-fullname name) - (list shadow-system-name - (user-login-name) - name))) - -(defsubst shadow-make-fullname (host user name) - "Make an ange-ftp style fullname out of HOST, USER (optional), and NAME. -This is probably not as general as it ought to be." - (concat "/" - (if user (concat user "@")) - host ":" - name)) + "Parse any NAME into a `tramp-file-name' structure. +Argument can be a simple name, remote file name, or already a +`tramp-file-name' structure." + (cond + ((null name) nil) + ((tramp-file-name-p name) name) + ((file-remote-p name) (tramp-dissect-file-name name)) + ((shadow-local-file name) + (make-tramp-file-name + :host (shadow-site-name shadow-system-name) + :localname (shadow-local-file name))) + ;; Cluster name. + ((string-match "^/\\([^:/]+\\):\\([^:]*\\)$" name) + (let ((name (match-string 1 name)) + (file (match-string 2 name))) + (when (shadow-get-cluster name) + (make-tramp-file-name :host name :localname file)))))) + +(defsubst shadow-make-fullname (hup &optional host name) + "Make a Tramp style fullname out of HUP, a `tramp-file-name' structure. +Replace HOST, and NAME when non-nil." + (let ((hup (copy-tramp-file-name hup))) + (when host (setf (tramp-file-name-host hup) host)) + (when name (setf (tramp-file-name-localname hup) name)) + (if (null (tramp-file-name-method hup)) + (format + "/%s:%s" (tramp-file-name-host hup) (tramp-file-name-localname hup)) + (tramp-make-tramp-file-name + (tramp-file-name-method hup) + (tramp-file-name-user hup) + (tramp-file-name-domain hup) + (tramp-file-name-host hup) + (tramp-file-name-port hup) + (tramp-file-name-localname hup) + (tramp-file-name-hop hup))))) (defun shadow-replace-name-component (fullname newname) "Return FULLNAME with the name component changed to NEWNAME." - (let ((hup (shadow-parse-fullname fullname))) - (shadow-make-fullname (nth 0 hup) (nth 1 hup) newname))) + (concat (file-remote-p fullname) newname)) (defun shadow-local-file (file) - "If FILE is at this site, remove /user@host part. -If refers to a different system or a different user on this system, -return nil." - (let ((hup (shadow-parse-fullname file))) - (cond ((null hup) file) - ((and (shadow-site-match (nth 0 hup) shadow-system-name) - (string-equal (nth 1 hup) (user-login-name))) - (nth 2 hup)) - (t nil)))) + "If FILE is not remote, return it. +If it refers to a different system, return nil." + (cond + ((null file) nil) + ;; `tramp-file-name' structure. + ((and (tramp-file-name-p file) (null (tramp-file-name-method file))) + (tramp-file-name-localname file)) + ((tramp-file-name-p file) nil) + ;; Local host name. + ((string-match + (format "^%s\\([^:]*\\)$" (regexp-quote shadow-system-name)) file) + (match-string 1 file)) + ;; Cluster name. + ((and (string-match "^/\\([^:/]+\\):\\([^:]*\\)$" file) + (shadow-get-cluster (match-string 1 file))) + (let ((file (match-string 2 file)) + (primary + (shadow-cluster-primary + (shadow-get-cluster (match-string 1 file))))) + (when (string-equal primary shadow-system-name) (setq primary nil)) + (shadow-local-file (concat primary file)))) + ;; Local name. + ((null (file-remote-p file)) file))) (defun shadow-expand-cluster-in-file-name (file) "If hostname part of FILE is a cluster, expand it to cluster's primary hostname. Will return the name bare if it is a local file." - (let ((hup (shadow-parse-name file))) - (cond ((null hup) file) - ((shadow-local-file hup)) - ((shadow-make-fullname (shadow-site-primary (nth 0 hup)) - (nth 1 hup) - (nth 2 hup)))))) + (when (stringp file) + (cond + ;; Local file. + ((shadow-local-file file)) + ;; Cluster name. + ((string-match "^\\(/[^:/]+:\\)[^:]*$" file) + (let ((primary + (save-match-data + (shadow-cluster-primary + (shadow-get-cluster + (shadow-site-name (match-string 1 file))))))) + (if (not primary) + file + (setq file (replace-match primary nil nil file 1)) + (or (shadow-local-file file) file)))) + (t file)))) (defun shadow-expand-file-name (file &optional default) "Expand file name and get FILE's true name." @@ -352,46 +378,50 @@ true." (homedir (if (shadow-local-file hup) shadow-homedir (file-name-as-directory - (nth 2 (shadow-parse-fullname - (expand-file-name - (shadow-make-fullname - (nth 0 hup) (nth 1 hup) "~"))))))) - (suffix (shadow-suffix homedir (nth 2 hup))) - (cluster (shadow-site-cluster (nth 0 hup)))) + (file-local-name + (expand-file-name (shadow-make-fullname hup nil "~")))))) + (suffix (shadow-suffix homedir (tramp-file-name-localname hup))) + (cluster (shadow-site-cluster (shadow-make-fullname hup nil "")))) + (when cluster + (setf (tramp-file-name-method hup) nil + (tramp-file-name-host hup) (shadow-cluster-name cluster))) (shadow-make-fullname - (if cluster - (shadow-cluster-name cluster) - (nth 0 hup)) - (nth 1 hup) + hup nil (if suffix - (concat "~/" suffix) - (nth 2 hup))))) + (concat "~/" suffix) + (tramp-file-name-localname hup))))) (defun shadow-same-site (pattern file) "True if the site of PATTERN and of FILE are on the same site. -If usernames are supplied, they must also match exactly. PATTERN and FILE may -be lists of host, user, name, or ange-ftp file names. FILE may also be just a -local filename." - (let ((pattern-sup (shadow-parse-fullname pattern)) +PATTERN and FILE may be Tramp vectors, or remote file names. +FILE may also be just a local filename." + (let ((pattern-sup (shadow-parse-name pattern)) (file-sup (shadow-parse-name file))) (and - (shadow-site-match (nth 0 pattern-sup) (nth 0 file-sup)) - (or (null (nth 1 pattern-sup)) - (string-equal (nth 1 pattern-sup) (nth 1 file-sup)))))) + (shadow-site-match + (tramp-file-name-host pattern-sup) (tramp-file-name-host file-sup)) + (or (null (tramp-file-name-user pattern-sup)) + (string-equal + (tramp-file-name-user pattern-sup) + (tramp-file-name-user file-sup)))))) (defun shadow-file-match (pattern file &optional regexp) "Return t if PATTERN matches FILE. If REGEXP is supplied and non-nil, the file part of the pattern is a regular -expression, otherwise it must match exactly. The sites and usernames must -match---see `shadow-same-site'. The pattern must be in full ange-ftp format, +expression, otherwise it must match exactly. The sites must +match---see `shadow-same-site'. The pattern must be in full Tramp format, but the file can be any valid filename. This function does not do any filename expansion or contraction, you must do that yourself first." - (let* ((pattern-sup (shadow-parse-fullname pattern)) + (let* ((pattern-sup (shadow-parse-name pattern)) (file-sup (shadow-parse-name file))) (and (shadow-same-site pattern-sup file-sup) (if regexp - (string-match (nth 2 pattern-sup) (nth 2 file-sup)) - (string-equal (nth 2 pattern-sup) (nth 2 file-sup)))))) + (string-match + (tramp-file-name-localname pattern-sup) + (tramp-file-name-localname file-sup)) + (string-equal + (tramp-file-name-localname pattern-sup) + (tramp-file-name-localname file-sup)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; User-level Commands @@ -405,30 +435,34 @@ one of them is sufficient to update the file on all of them. Clusters are defined by a name, the network address of a primary host (the one we copy files to), and a regular expression that matches the hostnames of all the sites in the cluster." - (interactive (list (completing-read "Cluster name: " shadow-clusters () ()))) + (interactive (list (completing-read "Cluster name: " shadow-clusters))) (let* ((old (shadow-get-cluster name)) - (primary (read-string "Primary host: " - (if old (shadow-cluster-primary old) - name))) - (regexp (let (try-regexp) - (while (not - (string-match - (setq try-regexp + (primary (let (try-primary) + (while (not + (or + (string-equal + (setq try-primary (read-string - "Regexp matching all host names: " - (if old (shadow-cluster-regexp old) - (shadow-regexp-superquote primary)))) - primary)) - (message "Regexp doesn't include the primary host!") - (sit-for 2)) - try-regexp)) -; (username (read-no-blanks-input -; (format "Username (default %s): " -; (shadow-get-user primary)) -; (if old (or (shadow-cluster-username old) "") -; (user-login-name)))) - ) -; (if (string-equal "" username) (setq username nil)) + "Primary host: " + (if old (shadow-cluster-primary old) + name))) + shadow-system-name) + (file-remote-p try-primary))) + (message "Not a valid primary!") + (sit-for 2)) + try-primary)) + (regexp (let (try-regexp) + (while (not + (string-match + (setq try-regexp + (read-string + "Regexp matching all host names: " + (if old (shadow-cluster-regexp old) + (shadow-regexp-superquote primary)))) + primary)) + (message "Regexp doesn't include the primary host!") + (sit-for 2)) + try-regexp))) (shadow-set-cluster name primary regexp))) ;;;###autoload @@ -438,20 +472,14 @@ It may have different filenames on each site. When this file is edited, the new version will be copied to each of the other locations. Sites can be specific hostnames, or names of clusters (see `shadow-define-cluster')." (interactive) - (let* ((hup (shadow-parse-fullname + (let* ((hup (shadow-parse-name (shadow-contract-file-name (buffer-file-name)))) - (name (nth 2 hup)) - user site group) + (name (tramp-file-name-localname hup)) + site group) (while (setq site (shadow-read-site)) - (setq user (read-string (format "Username (default %s): " - (shadow-get-user site))) - name (read-string "Filename: " name)) - (setq group (cons (shadow-make-fullname site - (if (string-equal "" user) - (shadow-get-user site) - user) - name) - group))) + (setq name (read-string "Filename: " name) + hup (shadow-parse-name (shadow-contract-file-name name)) + group (cons (shadow-make-fullname hup site) group))) (setq shadow-literal-groups (cons group shadow-literal-groups))) (shadow-write-info-file)) @@ -468,19 +496,12 @@ function). Each site can be either a hostname or the name of a cluster (see "Filename regexp: " (if (buffer-file-name) (shadow-regexp-superquote - (nth 2 - (shadow-parse-name - (shadow-contract-file-name - (buffer-file-name)))))))) - site sites usernames) + (file-local-name (buffer-file-name)))))) + site sites) (while (setq site (shadow-read-site)) - (setq sites (cons site sites)) - (setq usernames - (cons (read-string (format "Username for %s: " site) - (shadow-get-user site)) - usernames))) + (setq sites (cons site sites))) (setq shadow-regexp-groups - (cons (shadow-make-group regexp sites usernames) + (cons (shadow-make-group regexp sites) shadow-regexp-groups)) (shadow-write-info-file))) @@ -537,14 +558,14 @@ permanently, remove the group from `shadow-literal-groups' or ;;; Internal functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun shadow-make-group (regexp sites usernames) +(defun shadow-make-group (regexp sites) "Make a description of a file group--- -actually a list of regexp ange-ftp file names---from REGEXP (name of file to -be shadowed), list of SITES, and corresponding list of USERNAMES for each -site." +actually a list of regexp Tramp file names---from REGEXP (name of file to +be shadowed), and list of SITES" (if sites - (cons (shadow-make-fullname (car sites) (car usernames) regexp) - (shadow-make-group regexp (cdr sites) (cdr usernames))) + (cons (shadow-make-fullname + (shadow-parse-name (shadow-site-primary (car sites))) nil regexp) + (shadow-make-group regexp (cdr sites))) nil)) (defun shadow-copy-file (s) @@ -601,7 +622,9 @@ Consider them as regular expressions if third arg REGEXP is true." (car groups)))) (append (cond ((equal nonmatching (car groups)) nil) (regexp - (let ((realname (nth 2 (shadow-parse-fullname file)))) + (let ((realname + (tramp-file-name-localname + (shadow-parse-name file)))) (mapcar (function (lambda (x) @@ -636,9 +659,8 @@ PAIR must be `eq' to one of the elements of that list." Thus restores shadowfile's state from your last Emacs session. Return t unless files were locked; then return nil." (interactive) - (if (and (fboundp 'file-locked-p) - (or (stringp (file-locked-p shadow-info-file)) - (stringp (file-locked-p shadow-todo-file)))) + (if (or (stringp (file-locked-p shadow-info-file)) + (stringp (file-locked-p shadow-todo-file))) (progn (message "Shadowfile is running in another Emacs; can't have two.") (beep) @@ -647,7 +669,7 @@ Return t unless files were locked; then return nil." (save-current-buffer (when shadow-info-file (set-buffer (setq shadow-info-buffer - (find-file-noselect shadow-info-file))) + (find-file-noselect shadow-info-file 'nowarn))) (when (and (not (buffer-modified-p)) (file-newer-than-file-p (make-auto-save-file-name) shadow-info-file)) @@ -680,6 +702,7 @@ defined, the old hashtable info is invalid." (if (not shadow-info-buffer) (setq shadow-info-buffer (find-file-noselect shadow-info-file))) (set-buffer shadow-info-buffer) + (setq buffer-read-only nil) (delete-region (point-min) (point-max)) (shadow-insert-var 'shadow-clusters) (shadow-insert-var 'shadow-literal-groups) @@ -692,6 +715,7 @@ With non-nil argument also saves the buffer." (if (not shadow-todo-buffer) (setq shadow-todo-buffer (find-file-noselect shadow-todo-file))) (set-buffer shadow-todo-buffer) + (setq buffer-read-only nil) (delete-region (point-min) (point-max)) (shadow-insert-var 'shadow-files-to-copy) (if save (shadow-save-todo-file)))) @@ -764,24 +788,6 @@ look for files that have been changed and need to be copied to other systems." (yes-or-no-p "Active processes exist; kill them and exit anyway? ")))) (kill-emacs))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Lucid Emacs compatibility -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; This is on hold until someone tells me about a working version of -;; map-ynp for Lucid Emacs. - -;(when (string-match "Lucid" emacs-version) -; (require 'symlink-fix) -; (require 'ange-ftp) -; (require 'map-ynp) -; (if (not (fboundp 'file-truename)) -; (fset 'shadow-expand-file-name -; (symbol-function 'symlink-expand-file-name))) -; (if (not (fboundp 'ange-ftp-ftp-name)) -; (fset 'ange-ftp-ftp-name -; (symbol-function 'ange-ftp-ftp-name)))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Hook us up ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -790,18 +796,10 @@ look for files that have been changed and need to be copied to other systems." (defun shadow-initialize () "Set up file shadowing." (interactive) - (if (null shadow-homedir) - (setq shadow-homedir - (file-name-as-directory (shadow-expand-file-name "~")))) - (if (null shadow-info-file) - (setq shadow-info-file - ;; FIXME: Move defaults to their defcustom. - (shadow-expand-file-name - (locate-user-emacs-file "shadows" ".shadows")))) - (if (null shadow-todo-file) - (setq shadow-todo-file - (shadow-expand-file-name - (locate-user-emacs-file "shadow_todo" ".shadow_todo")))) + (setq shadow-homedir + (file-name-as-directory (shadow-expand-file-name shadow-homedir)) + shadow-info-file (shadow-expand-file-name shadow-info-file) + shadow-todo-file (shadow-expand-file-name shadow-todo-file)) (if (not (shadow-read-files)) (progn (message "Shadowfile information files not found - aborting") diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el new file mode 100644 index 0000000000..5ded94480e --- /dev/null +++ b/test/lisp/shadowfile-tests.el @@ -0,0 +1,876 @@ +;;; shadowfile-tests.el --- Tests of shadowfile + +;; Copyright (C) 2018 Free Software Foundation, Inc. + +;; Author: Michael Albinus + +;; This program 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. +;; +;; This program 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 this program. If not, see `http://www.gnu.org/licenses/'. + +;;; Commentary: + +;; A whole test run can be performed calling the command `shadowfile-test-all'. + +;;; Code: + +(require 'ert) +(require 'shadowfile) +(require 'tramp) + +;; There is no default value on w32 systems, which could work out of the box. +(defconst shadow-test-remote-temporary-file-directory + (cond + ((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY")) + ((eq system-type 'windows-nt) null-device) + (t (add-to-list + 'tramp-methods + '("mock" + (tramp-login-program "sh") + (tramp-login-args (("-i"))) + (tramp-remote-shell "/bin/sh") + (tramp-remote-shell-args ("-c")) + (tramp-connection-timeout 10))) + (add-to-list + 'tramp-default-host-alist + `("\\`mock\\'" nil ,(system-name))) + ;; Emacs' Makefile sets $HOME to a nonexistent value. Needed in + ;; batch mode only, therefore. It cannot be + ;; `temporary-directory', because the tests with "~" would fail. + (unless (and (null noninteractive) (file-directory-p "~/")) + (setenv "HOME" invocation-directory)) + (format "/mock::%s" temporary-file-directory))) + "Temporary directory for Tramp tests.") + +(defconst shadow-test-info-file + (expand-file-name "shadows_test" temporary-file-directory) + "File to keep shadow information in during tests.") + +(defconst shadow-test-todo-file + (expand-file-name "shadow_todo_test" temporary-file-directory) + "File to store the list of uncopied shadows in during tests.") + +(ert-deftest shadow-test00-clusters () + "Check cluster definitions. +Per definition, all files are identical on the different hosts of +a cluster (or site). This is not tested here; it must be +guaranteed by the originator of a cluster definition." + (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) + + (let ((text-quoting-style 'grave) ;; We inspect the *Messages* buffer! + (inhibit-message t) + (shadow-info-file shadow-test-info-file) + (shadow-todo-file shadow-test-todo-file) + shadow-clusters + cluster primary regexp mocked-input) + (unwind-protect + ;; We must mock `read-from-minibuffer' and `read-string', in + ;; order to avoid interactive arguments. + (cl-letf* (((symbol-function 'read-from-minibuffer) + (lambda (&rest args) (pop mocked-input))) + ((symbol-function 'read-string) + (lambda (&rest args) (pop mocked-input)))) + + ;; Cleanup. + (when (file-exists-p shadow-info-file) + (delete-file shadow-info-file)) + (when (file-exists-p shadow-todo-file) + (delete-file shadow-todo-file)) + + ;; Define a cluster. + (setq cluster "cluster" + primary shadow-system-name + regexp (shadow-regexp-superquote primary) + mocked-input `(,cluster ,primary ,regexp)) + (call-interactively 'shadow-define-cluster) + (should + (string-equal + (shadow-cluster-name (shadow-get-cluster cluster)) cluster)) + (should + (string-equal + (shadow-cluster-primary (shadow-get-cluster cluster)) primary)) + (should + (string-equal + (shadow-cluster-regexp (shadow-get-cluster cluster)) regexp)) + (should-not (shadow-get-cluster "non-existent-cluster-name")) + + ;; Test `shadow-set-cluster' and `make-shadow-cluster'. + (shadow-set-cluster cluster primary regexp) + (should + (equal (shadow-get-cluster cluster) + (make-shadow-cluster + :name cluster :primary primary :regexp regexp))) + + ;; The primary must be either `shadow-system-name', or a remote file. + (setq ;; The second "cluster" is wrong. + mocked-input `(,cluster ,cluster ,primary ,regexp)) + (with-current-buffer (messages-buffer) + (narrow-to-region (point-max) (point-max))) + (call-interactively 'shadow-define-cluster) + (should + (string-match + (regexp-quote "Not a valid primary!") + (with-current-buffer (messages-buffer) (buffer-string)))) + ;; The first cluster definition is still valid. + (should + (string-equal + (shadow-cluster-name (shadow-get-cluster cluster)) cluster)) + (should + (string-equal + (shadow-cluster-primary (shadow-get-cluster cluster)) primary)) + (should + (string-equal + (shadow-cluster-regexp (shadow-get-cluster cluster)) regexp)) + + ;; The regexp must match the primary name. + (setq ;; The second "cluster" is wrong. + mocked-input `(,cluster ,primary ,cluster ,regexp)) + (with-current-buffer (messages-buffer) + (narrow-to-region (point-max) (point-max))) + (call-interactively 'shadow-define-cluster) + (should + (string-match + (regexp-quote "Regexp doesn't include the primary host!") + (with-current-buffer (messages-buffer) (buffer-string)))) + ;; The first cluster definition is still valid. + (should + (string-equal + (shadow-cluster-name (shadow-get-cluster cluster)) cluster)) + (should + (string-equal + (shadow-cluster-primary (shadow-get-cluster cluster)) primary)) + (should + (string-equal + (shadow-cluster-regexp (shadow-get-cluster cluster)) regexp)) + + ;; Redefine the cluster. + (setq primary + (file-remote-p shadow-test-remote-temporary-file-directory) + regexp (shadow-regexp-superquote primary) + mocked-input `(,cluster ,primary ,regexp)) + (call-interactively 'shadow-define-cluster) + (should + (string-equal + (shadow-cluster-name (shadow-get-cluster cluster)) cluster)) + (should + (string-equal + (shadow-cluster-primary (shadow-get-cluster cluster)) primary)) + (should + (string-equal + (shadow-cluster-regexp (shadow-get-cluster cluster)) regexp)) + + ;; Test `shadow-set-cluster' and `make-shadow-cluster'. + (shadow-set-cluster cluster primary regexp) + (should + (equal (shadow-get-cluster cluster) + (make-shadow-cluster + :name cluster :primary primary :regexp regexp)))) + + ;; Cleanup. + (with-current-buffer (messages-buffer) (widen)) + (when (file-exists-p shadow-info-file) + (delete-file shadow-info-file)) + (when (file-exists-p shadow-todo-file) + (delete-file shadow-todo-file))))) + +(ert-deftest shadow-test01-sites () + "Check site definitions. +Per definition, all files are identical on the different hosts of +a cluster (or site). This is not tested here; it must be +guaranteed by the originator of a cluster definition." + (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) + + (let ((shadow-info-file shadow-test-info-file) + (shadow-todo-file shadow-test-todo-file) + shadow-clusters + cluster1 cluster2 primary1 primary2 regexp1 regexp2 mocked-input) + (unwind-protect + ;; We must mock `read-from-minibuffer' and `read-string', in + ;; order to avoid interactive arguments. + (cl-letf* (((symbol-function 'read-from-minibuffer) + (lambda (&rest args) (pop mocked-input))) + ((symbol-function 'read-string) + (lambda (&rest args) (pop mocked-input)))) + + ;; Cleanup. + (when (file-exists-p shadow-info-file) + (delete-file shadow-info-file)) + (when (file-exists-p shadow-todo-file) + (delete-file shadow-todo-file)) + + ;; Define a cluster. + (setq cluster1 "cluster1" + primary1 shadow-system-name + regexp1 (shadow-regexp-superquote primary1)) + (shadow-set-cluster cluster1 primary1 regexp1) + + ;; A site is either a cluster identification, or a primary host. + (should (string-equal cluster1 (shadow-site-name cluster1))) + (should (string-equal primary1 (shadow-name-site primary1))) + (should + (string-equal (format "/%s:" cluster1) (shadow-name-site cluster1))) + (should (string-equal (system-name) (shadow-site-name primary1))) + (should + (string-equal + (file-remote-p shadow-test-remote-temporary-file-directory) + (shadow-name-site + (file-remote-p shadow-test-remote-temporary-file-directory)))) + (should + (string-equal + (file-remote-p shadow-test-remote-temporary-file-directory) + (shadow-site-name + (file-remote-p shadow-test-remote-temporary-file-directory)))) + + (should (equal (shadow-site-cluster cluster1) + (shadow-get-cluster cluster1))) + (should (equal (shadow-site-cluster (shadow-name-site cluster1)) + (shadow-get-cluster cluster1))) + (should (equal (shadow-site-cluster primary1) + (shadow-get-cluster cluster1))) + (should (equal (shadow-site-cluster (shadow-site-name primary1)) + (shadow-get-cluster cluster1))) + (should (string-equal (shadow-site-primary cluster1) primary1)) + (should (string-equal (shadow-site-primary primary1) primary1)) + + ;; `shadow-read-site' accepts "cluster", "/cluster:", + ;; "system", "/system:". It shall reject bad site names. + (setq mocked-input + `(,cluster1 ,(shadow-name-site cluster1) + ,primary1 ,(shadow-site-name primary1) + ,shadow-system-name "" "bad" "/bad:")) + (should (string-equal (shadow-read-site) cluster1)) + (should (string-equal (shadow-read-site) (shadow-name-site cluster1))) + (should (string-equal (shadow-read-site) primary1)) + (should (string-equal (shadow-read-site) (shadow-site-name primary1))) + (should (string-equal (shadow-read-site) shadow-system-name)) + (should-not (shadow-read-site)) ; "" + (should-not (shadow-read-site)) ; "bad" + (should-not (shadow-read-site)) ; "/bad:" + (should-error (shadow-read-site)) ; no input at all + + ;; Define a second cluster. + (setq cluster2 "cluster2" + primary2 + (file-remote-p shadow-test-remote-temporary-file-directory) + regexp2 (format "^\\(%s\\|%s\\)$" shadow-system-name primary2)) + (shadow-set-cluster cluster2 primary2 regexp2) + + ;; `shadow-site-match' shall know all different kind of site names. + (should (shadow-site-match cluster1 cluster1)) + (should (shadow-site-match primary1 primary1)) + (should (shadow-site-match cluster1 primary1)) + (should (shadow-site-match primary1 cluster1)) + (should (shadow-site-match cluster2 cluster2)) + (should (shadow-site-match primary2 primary2)) + (should (shadow-site-match cluster2 primary2)) + (should (shadow-site-match primary2 cluster2)) + + ;; The regexp of `cluster2' matches the primary of + ;; `cluster1'. Not vice versa. + (should (shadow-site-match cluster2 cluster1)) + (should-not (shadow-site-match cluster1 cluster2)) + + ;; If we use the primaries of a cluster, it doesn't match. + (should-not + (shadow-site-match (shadow-site-primary cluster2) cluster1)) + (should-not + (shadow-site-match (shadow-site-primary cluster1) cluster2))) + + ;; Cleanup. + (when (file-exists-p shadow-info-file) + (delete-file shadow-info-file)) + (when (file-exists-p shadow-todo-file) + (delete-file shadow-todo-file))))) + +(ert-deftest shadow-test02-files () + "Check file manipulation functions." + (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) + + (let ((shadow-info-file shadow-test-info-file) + (shadow-todo-file shadow-test-todo-file) + shadow-clusters + cluster primary regexp file hup) + (unwind-protect + (progn + ;; Cleanup. + (when (file-exists-p shadow-info-file) + (delete-file shadow-info-file)) + (when (file-exists-p shadow-todo-file) + (delete-file shadow-todo-file)) + + ;; Define a cluster. + (setq cluster "cluster" + primary shadow-system-name + regexp (shadow-regexp-superquote primary) + file (make-temp-name + (expand-file-name + "shadowfile-tests" temporary-file-directory))) + (shadow-set-cluster cluster primary regexp) + + ;; The constant structure to compare with. + (setq hup (make-tramp-file-name :host (system-name) :localname file)) + + ;; The structure a local file is transformed in. + (should (equal (shadow-parse-name file) hup)) + (should (equal (shadow-parse-name (concat "/" cluster ":" file)) hup)) + (should (equal (shadow-parse-name (concat primary file)) hup)) + + ;; A local file name is kept. + (should + (string-equal (shadow-local-file file) file)) + ;; A file on this cluster is also local. + (should + (string-equal + (shadow-local-file (concat "/" cluster ":" file)) file)) + ;; A file on the primary host is also local. + (should + (string-equal (shadow-local-file (concat primary file)) file)) + + ;; Redefine the cluster. + (setq primary + (file-remote-p shadow-test-remote-temporary-file-directory) + regexp (shadow-regexp-superquote primary)) + (shadow-set-cluster cluster primary regexp) + + ;; The structure of the local file is still the same. + (should (equal (shadow-parse-name file) hup)) + ;; The cluster name must be used. + (setf (tramp-file-name-host hup) cluster) + (should (equal (shadow-parse-name (concat "/" cluster ":" file)) hup)) + ;; The structure of a remote file is different. + (should + (equal (shadow-parse-name (concat primary file)) + (tramp-dissect-file-name (concat primary file)))) + + ;; A local file is still local. + (should (shadow-local-file file)) + ;; A file on this cluster is not local. + (should-not (shadow-local-file (concat "/" cluster ":" file))) + ;; A file on the primary host is not local. + (should-not (shadow-local-file (concat primary file))) + ;; There's no error on wrong FILE. + (should-not (shadow-local-file nil))) + + ;; Cleanup. + (when (file-exists-p shadow-info-file) + (delete-file shadow-info-file)) + (when (file-exists-p shadow-todo-file) + (delete-file shadow-todo-file))))) + +(ert-deftest shadow-test03-expand-cluster-in-file-name () + "Check canonical file name of a cluster or site." + (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) + + (let ((shadow-info-file shadow-test-info-file) + (shadow-todo-file shadow-test-todo-file) + shadow-clusters + cluster primary regexp file1 file2) + (unwind-protect + (progn + ;; Cleanup. + (when (file-exists-p shadow-info-file) + (delete-file shadow-info-file)) + (when (file-exists-p shadow-todo-file) + (delete-file shadow-todo-file)) + + ;; Define a cluster. + (setq cluster "cluster" + primary shadow-system-name + regexp (shadow-regexp-superquote primary)) + (shadow-set-cluster cluster primary regexp) + + (setq file1 + (make-temp-name + (expand-file-name "shadowfile-tests" temporary-file-directory)) + file2 + (make-temp-name + (expand-file-name + "shadowfile-tests" + shadow-test-remote-temporary-file-directory))) + + ;; A local file name is kept. + (should + (string-equal (shadow-expand-cluster-in-file-name file1) file1)) + ;; A remote file is kept. + (should + (string-equal (shadow-expand-cluster-in-file-name file2) file2)) + ;; A cluster name is expanded to the primary name. + (should + (string-equal + (shadow-expand-cluster-in-file-name (format "/%s:%s" cluster file1)) + (shadow-expand-cluster-in-file-name (concat primary file1)))) + ;; A primary name is expanded if it is a local file name. + (should + (string-equal + (shadow-expand-cluster-in-file-name (concat primary file1)) file1)) + + ;; Redefine the cluster. + (setq primary + (file-remote-p shadow-test-remote-temporary-file-directory) + regexp (shadow-regexp-superquote primary)) + (shadow-set-cluster cluster primary regexp) + + ;; A cluster name is expanded to the primary name. + (should + (string-equal + (shadow-expand-cluster-in-file-name (format "/%s:%s" cluster file1)) + (shadow-expand-cluster-in-file-name (concat primary file1)))) + ;; A primary name is not expanded if it isn't is a local file name. + (should + (string-equal + (shadow-expand-cluster-in-file-name (concat primary file1)) + (concat primary file1)))) + + ;; Cleanup. + (when (file-exists-p shadow-info-file) + (delete-file shadow-info-file)) + (when (file-exists-p shadow-todo-file) + (delete-file shadow-todo-file))))) + +(ert-deftest shadow-test04-contract-file-name () + "Check canonical file name of a cluster or site." + (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) + + (let ((shadow-info-file shadow-test-info-file) + (shadow-todo-file shadow-test-todo-file) + shadow-clusters + cluster primary regexp file) + (unwind-protect + (progn + ;; Cleanup. + (when (file-exists-p shadow-info-file) + (delete-file shadow-info-file)) + (when (file-exists-p shadow-todo-file) + (delete-file shadow-todo-file)) + + ;; Define a cluster. + (setq cluster "cluster" + primary shadow-system-name + regexp (shadow-regexp-superquote primary) + file (make-temp-name + (expand-file-name + "shadowfile-tests" temporary-file-directory))) + (shadow-set-cluster cluster primary regexp) + + ;; The cluster name is prepended for local files. + (should + (string-equal + (shadow-contract-file-name file) (concat "/cluster:" file))) + ;; A cluster file name is preserved. + (should + (string-equal + (shadow-contract-file-name (concat "/cluster:" file)) + (concat "/cluster:" file))) + ;; `shadow-system-name' is mapped to the cluster. + (should + (string-equal + (shadow-contract-file-name (concat shadow-system-name file)) + (concat "/cluster:" file))) + + ;; Redefine the cluster. + (setq primary + (file-remote-p shadow-test-remote-temporary-file-directory) + regexp (shadow-regexp-superquote primary)) + (shadow-set-cluster cluster primary regexp) + + ;; A remote file name is mapped to the cluster. + (should + (string-equal + (shadow-contract-file-name + (concat + (file-remote-p shadow-test-remote-temporary-file-directory) file)) + (concat "/cluster:" file)))) + + ;; Cleanup. + (when (file-exists-p shadow-info-file) + (delete-file shadow-info-file)) + (when (file-exists-p shadow-todo-file) + (delete-file shadow-todo-file))))) + +(ert-deftest shadow-test05-file-match () + "Check `shadow-same-site' and `shadow-file-match'." + (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) + + (let ((shadow-info-file shadow-test-info-file) + (shadow-todo-file shadow-test-todo-file) + shadow-clusters + cluster primary regexp file) + (unwind-protect + (progn + ;; Cleanup. + (when (file-exists-p shadow-info-file) + (delete-file shadow-info-file)) + (when (file-exists-p shadow-todo-file) + (delete-file shadow-todo-file)) + + ;; Define a cluster. + (setq cluster "cluster" + primary shadow-system-name + regexp (shadow-regexp-superquote primary) + file (make-temp-name + (expand-file-name + "shadowfile-tests" temporary-file-directory))) + (shadow-set-cluster cluster primary regexp) + + (should (shadow-same-site (shadow-parse-name "/cluster:") file)) + (should + (shadow-same-site (shadow-parse-name shadow-system-name) file)) + (should (shadow-same-site (shadow-parse-name file) file)) + + (should + (shadow-file-match + (shadow-parse-name (concat "/cluster:" file)) file)) + (should + (shadow-file-match + (shadow-parse-name (concat shadow-system-name file)) file)) + (should (shadow-file-match (shadow-parse-name file) file)) + + ;; Redefine the cluster. + (setq primary + (file-remote-p shadow-test-remote-temporary-file-directory) + regexp (shadow-regexp-superquote primary)) + (shadow-set-cluster cluster primary regexp) + + (should + (shadow-file-match + (shadow-parse-name + (concat + (file-remote-p shadow-test-remote-temporary-file-directory) + file)) + file))) + + ;; Cleanup. + (when (file-exists-p shadow-info-file) + (delete-file shadow-info-file)) + (when (file-exists-p shadow-todo-file) + (delete-file shadow-todo-file))))) + +(ert-deftest shadow-test06-literal-groups () + "Check literal group definitions." + (let ((shadow-info-file shadow-test-info-file) + (shadow-todo-file shadow-test-todo-file) + shadow-clusters shadow-literal-groups + cluster1 cluster2 primary regexp file1 file2 mocked-input) + (unwind-protect + ;; We must mock `read-from-minibuffer' and `read-string', in + ;; order to avoid interactive arguments. + (cl-letf* (((symbol-function 'read-from-minibuffer) + (lambda (&rest args) (pop mocked-input))) + ((symbol-function 'read-string) + (lambda (&rest args) (pop mocked-input)))) + + ;; Cleanup. + (when (file-exists-p shadow-info-file) + (delete-file shadow-info-file)) + (when (file-exists-p shadow-todo-file) + (delete-file shadow-todo-file)) + + ;; Define clusters. + (setq cluster1 "cluster1" + primary shadow-system-name + regexp (shadow-regexp-superquote primary)) + (shadow-set-cluster cluster1 primary regexp) + + (setq cluster2 "cluster2" + primary + (file-remote-p shadow-test-remote-temporary-file-directory) + regexp (format "^\\(%s\\|%s\\)$" shadow-system-name primary)) + (shadow-set-cluster cluster2 primary regexp) + + ;; Define a literal group. + (setq file1 + (make-temp-name + (expand-file-name "shadowfile-tests" temporary-file-directory)) + file2 + (make-temp-name + (expand-file-name + "shadowfile-tests" + shadow-test-remote-temporary-file-directory)) + mocked-input `(,cluster1 ,file1 ,cluster2 ,file2 ,(kbd "RET"))) + (with-temp-buffer + (setq-local buffer-file-name file1) + (call-interactively 'shadow-define-literal-group)) + + ;; `shadow-literal-groups' is a list of lists. + (should (consp shadow-literal-groups)) + (should (consp (car shadow-literal-groups))) + (should-not (cdr shadow-literal-groups)) + + (should (member (format "/%s:%s" cluster1 (file-local-name file1)) + (car shadow-literal-groups))) + (should (member (format "/%s:%s" cluster2 (file-local-name file2)) + (car shadow-literal-groups)))) + + ;; Cleanup. + (when (file-exists-p shadow-info-file) + (delete-file shadow-info-file)) + (when (file-exists-p shadow-todo-file) + (delete-file shadow-todo-file))))) + +(ert-deftest shadow-test07-regexp-groups () + "Check regexp group definitions." + (let ((shadow-info-file shadow-test-info-file) + (shadow-todo-file shadow-test-todo-file) + shadow-clusters shadow-regexp-groups + cluster1 cluster2 primary regexp file mocked-input) + (unwind-protect + ;; We must mock `read-from-minibuffer' and `read-string', in + ;; order to avoid interactive arguments. + (cl-letf* (((symbol-function 'read-from-minibuffer) + (lambda (&rest args) (pop mocked-input))) + ((symbol-function 'read-string) + (lambda (&rest args) (pop mocked-input)))) + + ;; Cleanup. + (when (file-exists-p shadow-info-file) + (delete-file shadow-info-file)) + (when (file-exists-p shadow-todo-file) + (delete-file shadow-todo-file)) + + ;; Define clusters. + (setq cluster1 "cluster1" + primary shadow-system-name + regexp (shadow-regexp-superquote primary)) + (shadow-set-cluster cluster1 primary regexp) + + (setq cluster2 "cluster2" + primary + (file-remote-p shadow-test-remote-temporary-file-directory) + regexp (format "^\\(%s\\|%s\\)$" shadow-system-name primary)) + (shadow-set-cluster cluster2 primary regexp) + + ;; Define a regexp group. + (setq file + (make-temp-name + (expand-file-name "shadowfile-tests" temporary-file-directory)) + mocked-input `(,(shadow-regexp-superquote file) + ,cluster1 ,cluster2 ,(kbd "RET"))) + (with-temp-buffer + (setq-local buffer-file-name nil) + (call-interactively 'shadow-define-regexp-group)) + + ;; `shadow-regexp-groups' is a list of lists. + (should (consp shadow-regexp-groups)) + (should (consp (car shadow-regexp-groups))) + (should-not (cdr shadow-regexp-groups)) + + (should + (member + (concat + (shadow-site-primary cluster1) (shadow-regexp-superquote file)) + (car shadow-regexp-groups))) + (should + (member + (concat + (shadow-site-primary cluster2) (shadow-regexp-superquote file)) + (car shadow-regexp-groups)))) + + ;; Cleanup. + (when (file-exists-p shadow-info-file) + (delete-file shadow-info-file)) + (when (file-exists-p shadow-todo-file) + (delete-file shadow-todo-file))))) + +(ert-deftest shadow-test08-shadow-todo () + "Check that needed shadows are added to todo." + (let ((backup-inhibited t) + (shadow-info-file shadow-test-info-file) + (shadow-todo-file shadow-test-todo-file) + (shadow-inhibit-message t) + shadow-clusters shadow-literal-groups shadow-regexp-groups + shadow-files-to-copy + cluster1 cluster2 primary regexp file) + (unwind-protect + (progn + ;; Cleanup. + (when (file-exists-p shadow-info-file) + (delete-file shadow-info-file)) + (when (file-exists-p shadow-todo-file) + (delete-file shadow-todo-file)) + + ;; Define clusters. + (setq cluster1 "cluster1" + primary shadow-system-name + regexp (shadow-regexp-superquote primary)) + (shadow-set-cluster cluster1 primary regexp) + + (setq cluster2 "cluster2" + primary + (file-remote-p shadow-test-remote-temporary-file-directory) + regexp (shadow-regexp-superquote primary)) + (shadow-set-cluster cluster2 primary regexp) + + ;; Define a literal group. + (setq file + (make-temp-name + (expand-file-name "shadowfile-tests" temporary-file-directory)) + shadow-literal-groups + `((,(concat "/cluster1:" file) ,(concat "/cluster2:" file)))) + + ;; Save file from "cluster1" definition. + (with-temp-buffer + (setq buffer-file-name file) + (insert "foo") + (save-buffer)) + (should + (member + (cons file (shadow-contract-file-name (concat "/cluster2:" file))) + shadow-files-to-copy)) + + ;; Save file from "cluster2" definition. + (with-temp-buffer + (setq buffer-file-name (concat (shadow-site-primary cluster2) file)) + (insert "foo") + (save-buffer)) + (should + (member + (cons + (concat (shadow-site-primary cluster2) file) + (shadow-contract-file-name (concat "/cluster1:" file))) + shadow-files-to-copy)) + + ;; Define a regexp group. + (setq shadow-files-to-copy nil + shadow-regexp-groups + `((,(concat (shadow-site-primary cluster1) + (shadow-regexp-superquote file)) + ,(concat (shadow-site-primary cluster2) + (shadow-regexp-superquote file))))) + + ;; Save file from "cluster1" definition. + (with-temp-buffer + (setq buffer-file-name file) + (insert "foo") + (save-buffer)) + (should + (member + (cons file (shadow-contract-file-name (concat "/cluster2:" file))) + shadow-files-to-copy)) + + ;; Save file from "cluster2" definition. + (with-temp-buffer + (setq buffer-file-name (concat (shadow-site-primary cluster2) file)) + (insert "foo") + (save-buffer)) + (should + (member + (cons + (concat (shadow-site-primary cluster2) file) + (shadow-contract-file-name (concat "/cluster1:" file))) + shadow-files-to-copy))) + + ;; Cleanup. + (when (file-exists-p shadow-info-file) + (delete-file shadow-info-file)) + (when (file-exists-p shadow-todo-file) + (delete-file shadow-todo-file)) + (when (file-exists-p file) + (delete-file file)) + (when (file-exists-p (concat (shadow-site-primary cluster2) file)) + (delete-file (concat (shadow-site-primary cluster2) file)))))) + +(ert-deftest shadow-test09-shadow-copy-files () + "Check that needed shadow files are copied." + (let ((backup-inhibited t) + (shadow-info-file shadow-test-info-file) + (shadow-todo-file shadow-test-todo-file) + (shadow-inhibit-message t) + (shadow-noquery t) + shadow-clusters shadow-files-to-copy + cluster1 cluster2 primary regexp file mocked-input) + (unwind-protect + (progn + ;; Cleanup. + (when (file-exists-p shadow-info-file) + (delete-file shadow-info-file)) + (when (file-exists-p shadow-todo-file) + (delete-file shadow-todo-file)) + (when (buffer-live-p shadow-todo-buffer) + (with-current-buffer shadow-todo-buffer (erase-buffer))) + + ;; Define clusters. + (setq cluster1 "cluster1" + primary shadow-system-name + regexp (shadow-regexp-superquote primary)) + (shadow-set-cluster cluster1 primary regexp) + + (setq cluster2 "cluster2" + primary + (file-remote-p shadow-test-remote-temporary-file-directory) + regexp (shadow-regexp-superquote primary)) + (shadow-set-cluster cluster2 primary regexp) + + ;; Define files to copy. + (setq file + (make-temp-name + (expand-file-name "shadowfile-tests" temporary-file-directory)) + shadow-literal-groups + `((,(concat "/cluster1:" file) ,(concat "/cluster2:" file))) + shadow-regexp-groups + `((,(concat (shadow-site-primary cluster1) + (shadow-regexp-superquote file)) + ,(concat (shadow-site-primary cluster2) + (shadow-regexp-superquote file)))) + mocked-input `(,(concat (shadow-site-primary cluster2) file) + ,file)) + + ;; Save files. + (with-temp-buffer + (setq buffer-file-name file) + (insert "foo") + (save-buffer)) + (with-temp-buffer + (setq buffer-file-name (concat (shadow-site-primary cluster2) file)) + (insert "foo") + (save-buffer)) + + ;; We must mock `write-region', in order to check proper + ;; action. + (add-function + :before (symbol-function 'write-region) + (lambda (&rest args) + (when (and (buffer-file-name) mocked-input) + (should (equal (buffer-file-name) (pop mocked-input))))) + '((name . "write-region-mock"))) + + ;; Copy the files. + (shadow-copy-files 'noquery) + (should-not shadow-files-to-copy) + (with-current-buffer shadow-todo-buffer + (goto-char (point-min)) + (should + (looking-at (regexp-quote "(setq shadow-files-to-copy nil)"))))) + + ;; Cleanup. + (remove-function (symbol-function 'write-region) "write-region-mock") + (when (file-exists-p shadow-info-file) + (delete-file shadow-info-file)) + (when (file-exists-p shadow-todo-file) + (delete-file shadow-todo-file)) + (when (file-exists-p file) + (delete-file file)) + (when (file-exists-p (concat (shadow-site-primary cluster2) file)) + (delete-file (concat (shadow-site-primary cluster2) file)))))) + +(defun shadowfile-test-all (&optional interactive) + "Run all tests for \\[shadowfile]." + (interactive "p") + (if interactive + (ert-run-tests-interactively "^shadowfile-") + (ert-run-tests-batch "^shadowfile-"))) + +(let ((shadow-info-file shadow-test-info-file) + (shadow-todo-file shadow-test-todo-file)) + (shadow-initialize)) + +(provide 'shadowfile-tests) +;;; shadowfile-tests.el ends here commit 04a32fa60bead4359bc9353af67f26958c795593 Author: Stefan Monnier Date: Wed Jul 18 10:23:20 2018 -0400 * lisp/comint.el: Clean up namespace (shell-strip-ctrl-m): Mark as obsolete. (comint-send-invisible): Rename from `send-invisible`. (send-invisible): Make it an obsolete alias. * lisp/net/rlogin.el: Adjust accordingly; Use lexical-binding. * lisp/shell.el: Adjust accordingly. diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 3d3441401d..236cb07785 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -1026,8 +1026,8 @@ Move backward across one shell command, but not beyond the current line Ask the shell for its working directory, and update the Shell buffer's default directory. @xref{Directory Tracking}. -@item M-x send-invisible @key{RET} @var{text} @key{RET} -@findex send-invisible +@item M-x comint-send-invisible @key{RET} @var{text} @key{RET} +@findex comint-send-invisible Send @var{text} as input to the shell, after reading it without echoing. This is useful when a shell command runs a program that asks for a password. diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index 903c56cef9..5b432d5b2f 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -2988,7 +2988,7 @@ Emacs compiled on a 64-bit machine can handle much larger buffers. @cindex Shell buffer, echoed commands and @samp{^M} in @cindex Echoed commands in @code{shell-mode} -Try typing @kbd{M-x shell-strip-ctrl-m @key{RET}} while in @code{shell-mode} to +Try typing @kbd{M-x comint-strip-ctrl-m @key{RET}} while in @code{shell-mode} to make them go away. If that doesn't work, you have several options: For @code{tcsh}, put this in your @file{.cshrc} (or @file{.tcshrc}) @@ -3041,7 +3041,7 @@ characters from the buffer by adding this to your @file{.emacs} init file: @smalllisp -(add-hook 'comint-output-filter-functions 'shell-strip-ctrl-m) +(add-hook 'comint-output-filter-functions #'comint-strip-ctrl-m) @end smalllisp On a related note: if your shell is echoing your input line in the shell diff --git a/etc/NEWS b/etc/NEWS index 5648dd0a63..861520bd14 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -232,6 +232,10 @@ shown in the currently selected window. ** Comint ++++ +*** 'send-invisible' is now an obsolete alias for `comint-send-invisible' +Also, 'shell-strip-ctrl-m' is declared obsolete. + +++ *** 'C-c .' (comint-insert-previous-argument) no longer interprets '&'. This feature caused problems when '&&' was present in the previous diff --git a/lisp/comint.el b/lisp/comint.el index 71a2b5eca5..a9c3e47f88 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -78,7 +78,7 @@ ;; ;; Not bound by default in comint-mode (some are in shell mode) ;; comint-run Run a program under comint-mode -;; send-invisible Read a line w/o echo, and send to proc +;; comint-send-invisible Read a line w/o echo, and send to proc ;; comint-dynamic-complete-filename Complete filename at point. ;; comint-dynamic-list-filename-completions List completions in help buffer. ;; comint-replace-by-expanded-filename Expand and complete filename at point; @@ -632,7 +632,7 @@ Input ring history expansion can be achieved with the commands Input ring expansion is controlled by the variable `comint-input-autoexpand', and addition is controlled by the variable `comint-input-ignoredups'. -Commands with no default key bindings include `send-invisible', +Commands with no default key bindings include `comint-send-invisible', `completion-at-point', `comint-dynamic-list-filename-completions', and `comint-magic-space'. @@ -2247,7 +2247,7 @@ This function could be on `comint-output-filter-functions' or bound to a key." (error nil)) (while (re-search-forward "\r+$" pmark t) (replace-match "" t t))))) -(defalias 'shell-strip-ctrl-m 'comint-strip-ctrl-m) +(define-obsolete-function-alias 'shell-strip-ctrl-m #'comint-strip-ctrl-m "27.1") (defun comint-show-maximum-output () "Put the end of the buffer at the bottom of the window." @@ -2357,9 +2357,9 @@ a buffer local variable." ;; These three functions are for entering text you don't want echoed or ;; saved -- typically passwords to ftp, telnet, or somesuch. -;; Just enter m-x send-invisible and type in your line. +;; Just enter m-x comint-send-invisible and type in your line. -(defun send-invisible (&optional prompt) +(defun comint-send-invisible (&optional prompt) "Read a string without echoing. Then send it to the process running in the current buffer. The string is sent using `comint-input-sender'. @@ -2382,18 +2382,19 @@ Security bug: your string can still be temporarily recovered with (message "Warning: text will be echoed"))) (error "Buffer %s has no process" (current-buffer))))) +(define-obsolete-function-alias 'send-invisible #'comint-send-invisible "27.1") + (defun comint-watch-for-password-prompt (string) "Prompt in the minibuffer for password and send without echoing. -This function uses `send-invisible' to read and send a password to the buffer's -process if STRING contains a password prompt defined by -`comint-password-prompt-regexp'. +Looks for a match to `comint-password-prompt-regexp' in order +to detect the need to (prompt and) send a password. This function could be in the list `comint-output-filter-functions'." (when (let ((case-fold-search t)) (string-match comint-password-prompt-regexp string)) (when (string-match "^[ \n\r\t\v\f\b\a]+" string) (setq string (replace-match "" t t string))) - (send-invisible string))) + (comint-send-invisible string))) ;; Low-level process communication diff --git a/lisp/net/rlogin.el b/lisp/net/rlogin.el index 3bfc4d7f35..015e04f407 100644 --- a/lisp/net/rlogin.el +++ b/lisp/net/rlogin.el @@ -1,4 +1,4 @@ -;;; rlogin.el --- remote login interface +;;; rlogin.el --- remote login interface -*- lexical-binding:t -*- ;; Copyright (C) 1992-1995, 1997-1998, 2001-2018 Free Software ;; Foundation, Inc. @@ -30,9 +30,9 @@ ;; tracking and the sending of some special characters. ;; If you wish for rlogin mode to prompt you in the minibuffer for -;; passwords when a password prompt appears, just enter m-x send-invisible -;; and type in your line, or add `comint-watch-for-password-prompt' to -;; `comint-output-filter-functions'. +;; passwords when a password prompt appears, just enter +;; M-x comint-send-invisible and type in your line (or tweak +;; `comint-password-prompt-regexp' to match your password prompt). ;;; Code: diff --git a/lisp/shell.el b/lisp/shell.el index fa6eee0f18..ac6f11aeb4 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -73,7 +73,7 @@ ;; c-c c-o comint-delete-output Delete last batch of process output ;; c-c c-r comint-show-output Show last batch of process output ;; c-c c-l comint-dynamic-list-input-ring List input history -;; send-invisible Read line w/o echo & send to proc +;; comint-send-invisible Read line w/o echo & send to proc ;; comint-continue-subjob Useful if you accidentally suspend ;; top-level job ;; comint-mode-hook is the comint mode hook. @@ -500,7 +500,7 @@ Shell buffers. It implements `shell-completion-execonly' for the end of process to the end of the current line. \\[comint-send-input] before end of process output copies the current line minus the prompt to the end of the buffer and sends it (\\[comint-copy-old-input] just copies the current line). -\\[send-invisible] reads a line of text without echoing it, and sends it to +\\[comint-send-invisible] reads a line of text without echoing it, and sends it to the shell. This is useful for entering passwords. Or, add the function `comint-watch-for-password-prompt' to `comint-output-filter-functions'. commit 343b29381cc53d53b1a2c1fdfacf0f5c4761f505 Author: Filipp Gunbin Date: Wed Jul 18 16:11:47 2018 +0300 Fix imenu--generic-function after fix for Bug#32024. * lisp/imenu.el (imenu--generic-function): Restore returning of nconc result from the function. Move filtering out empty menus so it is done before removing dummy element and splicing main element into index-alist. diff --git a/lisp/imenu.el b/lisp/imenu.el index edca51e3ad..7285b10574 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -832,15 +832,14 @@ depending on PATTERNS." (dolist (item index-alist) (when (listp item) (setcdr item (sort (cdr item) 'imenu--sort-by-position)))) - (let ((main-element (assq nil index-alist))) - (nconc (delq main-element (delq 'dummy index-alist)) - (cdr main-element))) ;; Remove any empty menus. That can happen because of skipping ;; things inside comments or strings. - (when (consp (car index-alist)) - (setq index-alist (cl-delete-if-not - (lambda (it) (cdr it)) - index-alist))))) + (setq index-alist (cl-delete-if + (lambda (it) (and (consp it) (null (cdr it)))) + index-alist)) + (let ((main-element (assq nil index-alist))) + (nconc (delq main-element (delq 'dummy index-alist)) + (cdr main-element))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; commit a68270785be1301fd4d416ae0bdfa06b81fb1cda Author: Paul Eggert Date: Wed Jul 18 04:55:34 2018 -0700 * etc/NEWS: Mention eql etc. NaN fix. diff --git a/etc/NEWS b/etc/NEWS index c0f380614a..5648dd0a63 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -821,6 +821,13 @@ changes and the change hooks are time consuming. ** The function 'get-free-disk-space' returns now a non-nil value for remote systems, which support this check. ++++ +** 'eql', 'make-hash-table', etc. now treat NaNs consistently. +Formerly, some of these functions ignored signs and significands of +NaNs. Now, all these functions treat NaN signs and significands as +significant. For example, (eql 0.0e+NaN -0.0e+NaN) now returns t +because the two NaNs have different signs; formerly it returned nil. + +++ ** The function 'make-string' accepts an additional optional argument. If the optional third argument is non-nil, 'make-string' will produce commit c70d22f70b77b053d01c7380122d166ecb728610 Author: Paul Eggert Date: Wed Jul 18 03:16:54 2018 -0700 Fix bug with eql etc. on NaNs Fix a bug where eql, sxhash-eql, memql, and make-hash-table were not consistent on NaNs. Likewise for equal, sxhash-equal, member, and make-hash-table. Some of these functions ignored NaN significands, whereas others treated them as significant. It's more logical to treat significands as significant, and this typically makes eql a bit more efficient on floats, with just one integer comparison instead of one to three floating-point comparisons. * doc/lispref/numbers.texi (Float Basics): Document that NaNs are never numerically equal, but might be eql. * src/fns.c (WORDS_PER_DOUBLE): Move to top level of this file. (union double_and_words): Now named, and at the top level of this file. (same_float): New function. (Fmemql, Feql, internal_equal, cmpfn_eql): Use it, so that the corresponding functions treat NaNs consistently. (sxhash_float): Simplify based on above-mentioned changes. * test/src/fns-tests.el (fns-tests-equality-nan): New test. diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi index 2fed2b642f..6c51b849d3 100644 --- a/doc/lispref/numbers.texi +++ b/doc/lispref/numbers.texi @@ -232,13 +232,18 @@ distinguish them. @cindex negative infinity @cindex infinity @cindex NaN +@findex eql +@findex sxhash-eql The @acronym{IEEE} floating-point standard supports positive infinity and negative infinity as floating-point values. It also provides for a class of values called NaN, or ``not a number''; numerical functions return such values in cases where there is no correct answer. For example, @code{(/ 0.0 0.0)} returns a NaN@. -Although NaN values carry a sign, for practical purposes there is no other -significant difference between different NaN values in Emacs Lisp. +A NaN is never numerically equal to any value, not even to itself. +NaNs carry a sign and a significand, and non-numeric functions like +@code{eql} and @code{sxhash-eql} treat two NaNs as equal when their +signs and significands agree. Significands of NaNs are +machine-dependent and are not directly visible to Emacs Lisp. Here are read syntaxes for these special floating-point values: diff --git a/src/fns.c b/src/fns.c index c171784d29..10997da0d4 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1419,6 +1419,29 @@ DEFUN ("elt", Felt, Selt, 2, 2, 0, return Faref (sequence, n); } +enum { WORDS_PER_DOUBLE = (sizeof (double) / sizeof (EMACS_UINT) + + (sizeof (double) % sizeof (EMACS_UINT) != 0)) }; +union double_and_words +{ + double val; + EMACS_UINT word[WORDS_PER_DOUBLE]; +}; + +/* Return true if X and Y are the same floating-point value. + This looks at X's and Y's representation, since (unlike '==') + it returns true if X and Y are the same NaN. */ +static bool +same_float (Lisp_Object x, Lisp_Object y) +{ + union double_and_words + xu = { .val = XFLOAT_DATA (x) }, + yu = { .val = XFLOAT_DATA (y) }; + EMACS_UINT neql = 0; + for (int i = 0; i < WORDS_PER_DOUBLE; i++) + neql |= xu.word[i] ^ yu.word[i]; + return !neql; +} + DEFUN ("member", Fmember, Smember, 2, 2, 0, doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `equal'. The value is actually the tail of LIST whose car is ELT. */) @@ -1457,7 +1480,7 @@ The value is actually the tail of LIST whose car is ELT. */) FOR_EACH_TAIL (tail) { Lisp_Object tem = XCAR (tail); - if (FLOATP (tem) && equal_no_quit (elt, tem)) + if (FLOATP (tem) && same_float (elt, tem)) return tail; } CHECK_LIST_END (tail, list); @@ -2175,7 +2198,7 @@ Floating-point numbers of equal value are `eql', but they may not be `eq'. */) (Lisp_Object obj1, Lisp_Object obj2) { if (FLOATP (obj1)) - return equal_no_quit (obj1, obj2) ? Qt : Qnil; + return FLOATP (obj2) && same_float (obj1, obj2) ? Qt : Qnil; else return EQ (obj1, obj2) ? Qt : Qnil; } @@ -2266,13 +2289,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, switch (XTYPE (o1)) { case Lisp_Float: - { - double d1 = XFLOAT_DATA (o1); - double d2 = XFLOAT_DATA (o2); - /* If d is a NaN, then d != d. Two NaNs should be `equal' even - though they are not =. */ - return d1 == d2 || (d1 != d1 && d2 != d2); - } + return same_float (o1, o2); case Lisp_Cons: if (equal_kind == EQUAL_NO_QUIT) @@ -3706,24 +3723,20 @@ HASH_INDEX (struct Lisp_Hash_Table *h, ptrdiff_t idx) return XINT (AREF (h->index, idx)); } -/* Compare KEY1 which has hash code HASH1 and KEY2 with hash code - HASH2 in hash table H using `eql'. Value is true if KEY1 and - KEY2 are the same. */ +/* Compare KEY1 and KEY2 in hash table HT using `eql'. Value is true + if KEY1 and KEY2 are the same. KEY1 and KEY2 must not be eq. */ static bool cmpfn_eql (struct hash_table_test *ht, Lisp_Object key1, Lisp_Object key2) { - return (FLOATP (key1) - && FLOATP (key2) - && XFLOAT_DATA (key1) == XFLOAT_DATA (key2)); + return FLOATP (key1) && FLOATP (key2) && same_float (key1, key2); } -/* Compare KEY1 which has hash code HASH1 and KEY2 with hash code - HASH2 in hash table H using `equal'. Value is true if KEY1 and - KEY2 are the same. */ +/* Compare KEY1 and KEY2 in hash table HT using `equal'. Value is + true if KEY1 and KEY2 are the same. */ static bool cmpfn_equal (struct hash_table_test *ht, @@ -3734,9 +3747,8 @@ cmpfn_equal (struct hash_table_test *ht, } -/* Compare KEY1 which has hash code HASH1, and KEY2 with hash code - HASH2 in hash table H using H->user_cmp_function. Value is true - if KEY1 and KEY2 are the same. */ +/* Compare KEY1 and KEY2 in hash table HT using HT->user_cmp_function. + Value is true if KEY1 and KEY2 are the same. */ static bool cmpfn_user_defined (struct hash_table_test *ht, @@ -4328,18 +4340,8 @@ static EMACS_UINT sxhash_float (double val) { EMACS_UINT hash = 0; - enum { - WORDS_PER_DOUBLE = (sizeof val / sizeof hash - + (sizeof val % sizeof hash != 0)) - }; - union { - double val; - EMACS_UINT word[WORDS_PER_DOUBLE]; - } u; - int i; - u.val = val; - memset (&u.val + 1, 0, sizeof u - sizeof u.val); - for (i = 0; i < WORDS_PER_DOUBLE; i++) + union double_and_words u = { .val = val }; + for (int i = 0; i < WORDS_PER_DOUBLE; i++) hash = sxhash_combine (hash, u.word[i]); return SXHASH_REDUCE (hash); } diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index d9cca557cf..e4b9cbe25a 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -23,6 +23,17 @@ (require 'cl-lib) +;; Test that equality predicates work correctly on NaNs when combined +;; with hash tables based on those predicates. This was not the case +;; for eql in Emacs 26. +(ert-deftest fns-tests-equality-nan () + (dolist (test (list #'eq #'eql #'equal)) + (let* ((h (make-hash-table :test test)) + (nan 0.0e+NaN) + (-nan (- nan))) + (puthash nan t h) + (should (eq (funcall test nan -nan) (gethash -nan h)))))) + (ert-deftest fns-tests-reverse () (should-error (reverse)) (should-error (reverse 1)) commit ba6cc1d04cef8e25534a72e90a8f0f8db0026c9f Author: Stefan Monnier Date: Tue Jul 17 22:22:15 2018 -0400 * lisp/net/soap-client.el (soap-type-of): Optimize for Emacs≥26 diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el index 17f83082f8..f5de05dc3d 100644 --- a/lisp/net/soap-client.el +++ b/lisp/net/soap-client.el @@ -685,14 +685,17 @@ This is a specialization of `soap-decode-type' for (anyType (soap-decode-any-type node)) (Array (soap-decode-array node)))))) -(defun soap-type-of (element) - "Return the type of ELEMENT." - ;; Support Emacs < 26 byte-code running in Emacs >= 26 sessions - ;; (Bug#31742). - (let ((type (type-of element))) - (if (eq type 'vector) - (aref element 0) ; For Emacs 25 and earlier. - type))) +(defalias 'soap-type-of + (if (eq 'soap-xs-basic-type (type-of (make-soap-xs-basic-type))) + ;; `type-of' in Emacs ≥ 26 already does what we need. + #'type-of + ;; For Emacs < 26, use our own function. + (lambda (element) + "Return the type of ELEMENT." + (if (vectorp element) + (aref element 0) ;Assume this vector is actually a struct! + ;; This should never happen. + (type-of element))))) ;; Register methods for `soap-xs-basic-type' (let ((tag (soap-type-of (make-soap-xs-basic-type)))) @@ -2881,6 +2884,8 @@ reference multiRef parts which are external to RESPONSE-NODE." ;;;; SOAP type encoding +;; FIXME: Use `cl-defmethod' (but this requires Emacs-25). + (defun soap-encode-attributes (value type) "Encode XML attributes for VALUE according to TYPE. This is a generic function which determines the attribute encoder commit 1c79d15863b768fe3156647a54d03a90688dd361 Author: Alex Date: Wed Aug 9 17:07:57 2017 -0600 Remove menu name from emacs-lisp-mode-map (Bug#27114) * lisp/progmodes/elisp-mode.el (emacs-lisp-mode-map): Don't give a menu name to the top-level map, the menu name is only useful for the menu-map. diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 58a58b4639..f694252c40 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -45,7 +45,7 @@ It has `lisp-mode-abbrev-table' as its parent." "Syntax table used in `emacs-lisp-mode'.") (defvar emacs-lisp-mode-map - (let ((map (make-sparse-keymap "Emacs-Lisp")) + (let ((map (make-sparse-keymap)) (menu-map (make-sparse-keymap "Emacs-Lisp")) (lint-map (make-sparse-keymap)) (prof-map (make-sparse-keymap)) commit cb50077b1eb7c1467f2f200e01599b391d025bfa Author: Noam Postavsky Date: Tue Jul 17 21:00:27 2018 -0400 Fix auth-source-delete (Bug#26184) * lisp/auth-source.el (auth-source-delete): Fix `auth-source-search' call. * test/lisp/auth-source-tests.el (auth-source-delete): New test. diff --git a/lisp/auth-source.el b/lisp/auth-source.el index b733054ae5..374b7f1e86 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -763,7 +763,7 @@ Calls `auth-source-search' with the :delete property in SPEC set to t. The backend may not actually delete the entries. Returns the deleted entries." - (auth-source-search (plist-put spec :delete t))) + (apply #'auth-source-search (plist-put spec :delete t))) (defun auth-source-search-collection (collection value) "Returns t is VALUE is t or COLLECTION is t or COLLECTION contains VALUE." diff --git a/test/lisp/auth-source-tests.el b/test/lisp/auth-source-tests.el index eb93f7488e..c1ee909374 100644 --- a/test/lisp/auth-source-tests.el +++ b/test/lisp/auth-source-tests.el @@ -289,5 +289,25 @@ (should (equal found-as-string (concat testname ": " needed))))) (delete-file netrc-file))) +(ert-deftest auth-source-delete () + (let* ((netrc-file (make-temp-file "auth-source-test" nil nil "\ +machine a1 port a2 user a3 password a4 +machine b1 port b2 user b3 password b4 +machine c1 port c2 user c3 password c4\n")) + (auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (expected '((:host "a1" :port "a2" :user "a3" :secret "a4"))) + (parameters '(:max 1 :host t))) + (unwind-protect + (let ((found (apply #'auth-source-delete parameters))) + (dolist (f found) + (let ((s (plist-get f :secret))) + (setf f (plist-put f :secret + (if (functionp s) (funcall s) s))))) + ;; Note: The netrc backend doesn't delete anything, so + ;; this is actually the same as `auth-source-search'. + (should (equal found expected))) + (delete-file netrc-file)))) + (provide 'auth-source-tests) ;;; auth-source-tests.el ends here commit 3f391c89fde26bb62af1f4d1116f2824fc931fba Author: Paul Eggert Date: Tue Jul 17 15:45:27 2018 -0700 Update from gnulib This incorporates: 2018-07-17 gnulib-tool: limit line length for git send-email * lib/gnulib.mk.in: Regenerate. diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 3e917387d0..e623921091 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -20,7 +20,123 @@ # the same distribution terms as the rest of that program. # # Generated by gnulib-tool. -# Reproduce by: gnulib-tool --import --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=close --avoid=dup --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=setenv --avoid=sigprocmask --avoid=stat --avoid=stdarg --avoid=stdbool --avoid=threadlib --avoid=tzset --avoid=unsetenv --avoid=utime --avoid=utime-h --gnu-make --makefile-name=gnulib.mk.in --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt binary-io byteswap c-ctype c-strcase careadlinkat close-stream count-leading-zeros count-one-bits count-trailing-zeros crypto/md5-buffer crypto/sha1-buffer crypto/sha256-buffer crypto/sha512-buffer d-type diffseq dtoastr dtotimespec dup2 environ execinfo explicit_bzero faccessat fcntl fcntl-h fdatasync fdopendir filemode filevercmp flexmember fpieee fstatat fsusage fsync getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog ignore-value intprops largefile lstat manywarnings memrchr minmax mkostemp mktime nstrftime pipe2 pselect pthread_sigmask putenv qcopy-acl readlink readlinkat sig2str socklen stat-time std-gnu11 stdalign stddef stdio stpcpy strtoimax symlink sys_stat sys_time tempname time time_r time_rz timegm timer-time timespec-add timespec-sub unlocked-io update-copyright utimens vla warnings +# Reproduce by: +# gnulib-tool --import \ +# --lib=libgnu \ +# --source-base=lib \ +# --m4-base=m4 \ +# --doc-base=doc \ +# --tests-base=tests \ +# --aux-dir=build-aux \ +# --gnu-make \ +# --makefile-name=gnulib.mk.in \ +# --conditional-dependencies \ +# --no-libtool \ +# --macro-prefix=gl \ +# --no-vc-files \ +# --avoid=close \ +# --avoid=dup \ +# --avoid=fchdir \ +# --avoid=fstat \ +# --avoid=malloc-posix \ +# --avoid=msvc-inval \ +# --avoid=msvc-nothrow \ +# --avoid=openat-die \ +# --avoid=opendir \ +# --avoid=raise \ +# --avoid=save-cwd \ +# --avoid=select \ +# --avoid=setenv \ +# --avoid=sigprocmask \ +# --avoid=stat \ +# --avoid=stdarg \ +# --avoid=stdbool \ +# --avoid=threadlib \ +# --avoid=tzset \ +# --avoid=unsetenv \ +# --avoid=utime \ +# --avoid=utime-h \ +# alloca-opt \ +# binary-io \ +# byteswap \ +# c-ctype \ +# c-strcase \ +# careadlinkat \ +# close-stream \ +# count-leading-zeros \ +# count-one-bits \ +# count-trailing-zeros \ +# crypto/md5-buffer \ +# crypto/sha1-buffer \ +# crypto/sha256-buffer \ +# crypto/sha512-buffer \ +# d-type \ +# diffseq \ +# dtoastr \ +# dtotimespec \ +# dup2 \ +# environ \ +# execinfo \ +# explicit_bzero \ +# faccessat \ +# fcntl \ +# fcntl-h \ +# fdatasync \ +# fdopendir \ +# filemode \ +# filevercmp \ +# flexmember \ +# fpieee \ +# fstatat \ +# fsusage \ +# fsync \ +# getloadavg \ +# getopt-gnu \ +# gettime \ +# gettimeofday \ +# gitlog-to-changelog \ +# ignore-value \ +# intprops \ +# largefile \ +# lstat \ +# manywarnings \ +# memrchr \ +# minmax \ +# mkostemp \ +# mktime \ +# nstrftime \ +# pipe2 \ +# pselect \ +# pthread_sigmask \ +# putenv \ +# qcopy-acl \ +# readlink \ +# readlinkat \ +# sig2str \ +# socklen \ +# stat-time \ +# std-gnu11 \ +# stdalign \ +# stddef \ +# stdio \ +# stpcpy \ +# strtoimax \ +# symlink \ +# sys_stat \ +# sys_time \ +# tempname \ +# time \ +# time_r \ +# time_rz \ +# timegm \ +# timer-time \ +# timespec-add \ +# timespec-sub \ +# unlocked-io \ +# update-copyright \ +# utimens \ +# vla \ +# warnings MOSTLYCLEANFILES += core *.stackdump commit a4767a662bf360b489059e2cbf028138f2399252 Author: Eli Zaretskii Date: Tue Jul 17 19:58:27 2018 +0300 Avoid assertion violations in gnutls.c * src/gnutls.c (Fgnutls_hash_digest, gnutls_symmetric) (Fgnutls_hash_mac): Check CONSP before invoking XCDR. (Bug#32187) Report values of invalid arguments when signaling an error. diff --git a/src/gnutls.c b/src/gnutls.c index 903393fed1..461260e27f 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -2024,7 +2024,14 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher, cipher = intern (SSDATA (cipher)); if (SYMBOLP (cipher)) - info = XCDR (Fassq (cipher, Fgnutls_ciphers ())); + { + info = Fassq (cipher, Fgnutls_ciphers ()); + if (!CONSP (info)) + xsignal2 (Qerror, + build_string ("GnuTLS cipher is invalid or not found"), + cipher); + info = XCDR (info); + } else if (TYPE_RANGED_INTEGERP (gnutls_cipher_algorithm_t, cipher)) gca = XINT (cipher); else @@ -2039,7 +2046,8 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher, ptrdiff_t key_size = gnutls_cipher_get_key_size (gca); if (key_size == 0) - error ("GnuTLS cipher is invalid or not found"); + xsignal2 (Qerror, + build_string ("GnuTLS cipher is invalid or not found"), cipher); ptrdiff_t kstart_byte, kend_byte; const char *kdata = extract_data_from_object (key, &kstart_byte, &kend_byte); @@ -2295,7 +2303,14 @@ itself. */) hash_method = intern (SSDATA (hash_method)); if (SYMBOLP (hash_method)) - info = XCDR (Fassq (hash_method, Fgnutls_macs ())); + { + info = Fassq (hash_method, Fgnutls_macs ()); + if (!CONSP (info)) + xsignal2 (Qerror, + build_string ("GnuTLS MAC-method is invalid or not found"), + hash_method); + info = XCDR (info); + } else if (TYPE_RANGED_INTEGERP (gnutls_mac_algorithm_t, hash_method)) gma = XINT (hash_method); else @@ -2310,7 +2325,9 @@ itself. */) ptrdiff_t digest_length = gnutls_hmac_get_len (gma); if (digest_length == 0) - error ("GnuTLS MAC-method is invalid or not found"); + xsignal2 (Qerror, + build_string ("GnuTLS MAC-method is invalid or not found"), + hash_method); ptrdiff_t kstart_byte, kend_byte; const char *kdata = extract_data_from_object (key, &kstart_byte, &kend_byte); @@ -2376,7 +2393,14 @@ the number itself. */) digest_method = intern (SSDATA (digest_method)); if (SYMBOLP (digest_method)) - info = XCDR (Fassq (digest_method, Fgnutls_digests ())); + { + info = Fassq (digest_method, Fgnutls_digests ()); + if (!CONSP (info)) + xsignal2 (Qerror, + build_string ("GnuTLS digest-method is invalid or not found"), + digest_method); + info = XCDR (info); + } else if (TYPE_RANGED_INTEGERP (gnutls_digest_algorithm_t, digest_method)) gda = XINT (digest_method); else @@ -2391,7 +2415,9 @@ the number itself. */) ptrdiff_t digest_length = gnutls_hash_get_len (gda); if (digest_length == 0) - error ("GnuTLS digest-method is invalid or not found"); + xsignal2 (Qerror, + build_string ("GnuTLS digest-method is invalid or not found"), + digest_method); gnutls_hash_hd_t hash; int ret = gnutls_hash_init (&hash, gda); commit 04599bb1b219b236356ba3393a23e1c1dd8c541b Author: Paul Eggert Date: Tue Jul 17 09:26:39 2018 -0700 Update from Gnulib This causes config.guess to assume support for shell functions, a safe assumption nowadays. * build-aux/config.guess, build-aux/config.sub: Copy from Gnulib. diff --git a/build-aux/config.guess b/build-aux/config.guess index 2b79f6d837..ced991e417 100755 --- a/build-aux/config.guess +++ b/build-aux/config.guess @@ -2,7 +2,7 @@ # Attempt to guess a canonical system name. # Copyright 1992-2018 Free Software Foundation, Inc. -timestamp='2018-07-06' +timestamp='2018-07-13' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -84,8 +84,6 @@ if test $# != 0; then exit 1 fi -trap 'exit 1' 1 2 15 - # CC_FOR_BUILD -- compiler used by this script. Note that the use of a # compiler to aid in system detection is discouraged as it requires # temporary files to be created and, as you can see below, it is a @@ -96,30 +94,35 @@ trap 'exit 1' 1 2 15 # Portable tmp directory creation inspired by the Autoconf team. -set_cc_for_build=' -trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ; -trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ; -: ${TMPDIR=/tmp} ; - { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } || - { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp 2>/dev/null) ; } || - { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp 2>/dev/null) && echo "Warning: creating insecure temp directory" >&2 ; } || - { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ; -dummy=$tmp/dummy ; -tmpfiles="$dummy.c $dummy.o $dummy.rel $dummy" ; -case ${CC_FOR_BUILD-},${HOST_CC-},${CC-} in - ,,) echo "int x;" > "$dummy.c" ; - for c in cc gcc c89 c99 ; do - if ($c -c -o "$dummy.o" "$dummy.c") >/dev/null 2>&1 ; then - CC_FOR_BUILD="$c"; break ; - fi ; - done ; - if test x"$CC_FOR_BUILD" = x ; then - CC_FOR_BUILD=no_compiler_found ; - fi - ;; - ,,*) CC_FOR_BUILD=$CC ;; - ,*,*) CC_FOR_BUILD=$HOST_CC ;; -esac ; set_cc_for_build= ;' +tmp= +# shellcheck disable=SC2172 +trap 'test -z "$tmp" || rm -fr "$tmp"' 1 2 13 15 +trap 'exitcode=$?; test -z "$tmp" || rm -fr "$tmp"; exit $exitcode' 0 + +set_cc_for_build() { + : "${TMPDIR=/tmp}" + # shellcheck disable=SC2039 + { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } || + { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir "$tmp" 2>/dev/null) ; } || + { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir "$tmp" 2>/dev/null) && echo "Warning: creating insecure temp directory" >&2 ; } || + { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } + dummy=$tmp/dummy + case ${CC_FOR_BUILD-},${HOST_CC-},${CC-} in + ,,) echo "int x;" > "$dummy.c" + for driver in cc gcc c89 c99 ; do + if ($driver -c -o "$dummy.o" "$dummy.c") >/dev/null 2>&1 ; then + CC_FOR_BUILD="$driver" + break + fi + done + if test x"$CC_FOR_BUILD" = x ; then + CC_FOR_BUILD=no_compiler_found + fi + ;; + ,,*) CC_FOR_BUILD=$CC ;; + ,*,*) CC_FOR_BUILD=$HOST_CC ;; + esac +} # This is needed to find uname on a Pyramid OSx when run in the BSD universe. # (ghazi@noc.rutgers.edu 1994-08-24) @@ -138,7 +141,7 @@ Linux|GNU|GNU/*) # We could probably try harder. LIBC=gnu - eval "$set_cc_for_build" + set_cc_for_build cat <<-EOF > "$dummy.c" #include #if defined(__UCLIBC__) @@ -199,7 +202,7 @@ case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in os=netbsdelf ;; arm*|i386|m68k|ns32k|sh3*|sparc|vax) - eval "$set_cc_for_build" + set_cc_for_build if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ | grep -q __ELF__ then @@ -389,7 +392,7 @@ case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in echo i386-pc-auroraux"$UNAME_RELEASE" exit ;; i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) - eval "$set_cc_for_build" + set_cc_for_build SUN_ARCH=i386 # If there is a compiler, see if it is configured for 64-bit objects. # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. @@ -482,7 +485,7 @@ case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in echo clipper-intergraph-clix"$UNAME_RELEASE" exit ;; mips:*:*:UMIPS | mips:*:*:RISCos) - eval "$set_cc_for_build" + set_cc_for_build sed 's/^ //' << EOF > "$dummy.c" #ifdef __cplusplus #include /* for printf() prototype */ @@ -579,7 +582,7 @@ EOF exit ;; *:AIX:2:3) if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then - eval "$set_cc_for_build" + set_cc_for_build sed 's/^ //' << EOF > "$dummy.c" #include @@ -660,7 +663,7 @@ EOF esac fi if [ "$HP_ARCH" = "" ]; then - eval "$set_cc_for_build" + set_cc_for_build sed 's/^ //' << EOF > "$dummy.c" #define _HPUX_SOURCE @@ -700,7 +703,7 @@ EOF esac if [ "$HP_ARCH" = hppa2.0w ] then - eval "$set_cc_for_build" + set_cc_for_build # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating # 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler @@ -726,7 +729,7 @@ EOF echo ia64-hp-hpux"$HPUX_REV" exit ;; 3050*:HI-UX:*:*) - eval "$set_cc_for_build" + set_cc_for_build sed 's/^ //' << EOF > "$dummy.c" #include int @@ -922,7 +925,7 @@ EOF echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" exit ;; arm*:Linux:*:*) - eval "$set_cc_for_build" + set_cc_for_build if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ | grep -q __ARM_EABI__ then @@ -971,7 +974,7 @@ EOF echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" exit ;; mips:Linux:*:* | mips64:Linux:*:*) - eval "$set_cc_for_build" + set_cc_for_build sed 's/^ //' << EOF > "$dummy.c" #undef CPU #undef ${UNAME_MACHINE} @@ -1285,7 +1288,7 @@ EOF exit ;; *:Darwin:*:*) UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown - eval "$set_cc_for_build" + set_cc_for_build if test "$UNAME_PROCESSOR" = unknown ; then UNAME_PROCESSOR=powerpc fi @@ -1358,6 +1361,7 @@ EOF # "uname -m" is not consistent, so use $cputype instead. 386 # is converted to i386 for consistency with other x86 # operating systems. + # shellcheck disable=SC2154 if test "$cputype" = 386; then UNAME_MACHINE=i386 else diff --git a/build-aux/config.sub b/build-aux/config.sub index c95acc681d..64f9b14b55 100755 --- a/build-aux/config.sub +++ b/build-aux/config.sub @@ -2,7 +2,7 @@ # Configuration validation subroutine script. # Copyright 1992-2018 Free Software Foundation, Inc. -timestamp='2018-07-03' +timestamp='2018-07-13' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -739,6 +739,7 @@ case $basic_machine in | mipsr5900-* | mipsr5900el-* \ | mipstx39-* | mipstx39el-* \ | mmix-* \ + | moxie-* \ | mt-* \ | msp430-* \ | nds32-* | nds32le-* | nds32be-* \ @@ -1263,9 +1264,6 @@ case $basic_machine in pmac | pmac-mpw) basic_machine=powerpc-apple ;; - *-unknown) - # Make sure to match an already-canonicalized machine name. - ;; *) echo Invalid configuration \`"$1"\': machine \`"$basic_machine"\' not recognized 1>&2 exit 1 commit 00fa9467339271fcaeabd08301b72f0fd802e03a Author: Eli Zaretskii Date: Tue Jul 17 18:46:02 2018 +0300 ; * etc/NEWS: Mention 'main-thread'. (Bug#32169) diff --git a/etc/NEWS b/etc/NEWS index 76c19acd8c..c0f380614a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -172,6 +172,11 @@ from a remote host. This triggers to search the program on the remote host as indicated by 'default-directory'. ++++ +** New variable 'main-thread' holds Emacs's main thread. +This is handy in Lisp programs that run on a non-main thread and want +to signal the main thread, e.g., when they encounter an error. + * Editing Changes in Emacs 27.1 commit 798cbac170f05a749a4d5130d64d83c202f09158 Author: Michael Albinus Date: Tue Jul 17 12:03:43 2018 +0200 Add variable main-thread, fix Bug#32169 * doc/lispref/threads.texi (Basic Thread Functions): Add example, how to propagate signals to the main thread. Describe variable `main-thread'. Document optional argument CLEANUP of `thread-last-error'. * src/thread.c (Fthread_last_error): Add optional argument CLEANUP. (Bug#32169) (main-thread): New defvar. * test/src/thread-tests.el (thread-last-error): Adapt declaration. (main-thread): Declare. (threads-main-thread): New test. (threads-errors): Extend test. diff --git a/doc/lispref/threads.texi b/doc/lispref/threads.texi index f05af49618..4cef9c9c6e 100644 --- a/doc/lispref/threads.texi +++ b/doc/lispref/threads.texi @@ -87,6 +87,15 @@ thread, then this just calls @code{signal} immediately. Otherwise, If @var{thread} was blocked by a call to @code{mutex-lock}, @code{condition-wait}, or @code{thread-join}; @code{thread-signal} will unblock it. + +Since signal handlers in Emacs are located in the main thread, a +signal must be propagated there in order to become visible. The +second @code{signal} call let the thread die: + +@example +(thread-signal main-thread 'error data) +(signal 'error data) +@end example @end defun @defun thread-yield @@ -127,15 +136,21 @@ Return a list of all the live thread objects. A new list is returned by each invocation. @end defun +@defvar main-thread +This variable keeps the main thread Emacs is running, or @code{nil} if +Emacs is compiled without thread support. +@end defvar + When code run by a thread signals an error that is unhandled, the thread exits. Other threads can access the error form which caused the thread to exit using the following function. -@defun thread-last-error +@defun thread-last-error &optional cleanup This function returns the last error form recorded when a thread exited due to an error. Each thread that exits abnormally overwrites the form stored by the previous thread's error with a new value, so -only the last one can be accessed. +only the last one can be accessed. If @var{cleanup} is +non-@code{nil}, the stored form is reset to @code{nil}. @end defun @node Mutexes diff --git a/src/thread.c b/src/thread.c index 3eba25b7b4..754d286e9f 100644 --- a/src/thread.c +++ b/src/thread.c @@ -973,11 +973,17 @@ DEFUN ("all-threads", Fall_threads, Sall_threads, 0, 0, 0, return result; } -DEFUN ("thread-last-error", Fthread_last_error, Sthread_last_error, 0, 0, 0, - doc: /* Return the last error form recorded by a dying thread. */) - (void) +DEFUN ("thread-last-error", Fthread_last_error, Sthread_last_error, 0, 1, 0, + doc: /* Return the last error form recorded by a dying thread. +If CLEANUP is non-nil, remove this error form from history. */) + (Lisp_Object cleanup) { - return last_thread_error; + Lisp_Object result = last_thread_error; + + if (!NILP (cleanup)) + last_thread_error = Qnil; + + return result; } @@ -1083,4 +1089,13 @@ syms_of_threads (void) DEFSYM (Qthreadp, "threadp"); DEFSYM (Qmutexp, "mutexp"); DEFSYM (Qcondition_variable_p, "condition-variable-p"); + + DEFVAR_LISP ("main-thread", + Vmain_thread, + doc: /* The main thread of Emacs. */); +#ifdef THREADS_ENABLED + XSETTHREAD (Vmain_thread, &main_thread); +#else + Vmain_thread = Qnil; +#endif } diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el index a00a9c84bd..a447fb3914 100644 --- a/test/src/thread-tests.el +++ b/test/src/thread-tests.el @@ -34,10 +34,11 @@ (declare-function thread--blocker "thread.c" (thread)) (declare-function thread-alive-p "thread.c" (thread)) (declare-function thread-join "thread.c" (thread)) -(declare-function thread-last-error "thread.c" ()) +(declare-function thread-last-error "thread.c" (&optional cleanup)) (declare-function thread-name "thread.c" (thread)) (declare-function thread-signal "thread.c" (thread error-symbol data)) (declare-function thread-yield "thread.c" ()) +(defvar main-thread) (ert-deftest threads-is-one () "Test for existence of a thread." @@ -71,6 +72,11 @@ (skip-unless (featurep 'threads)) (should (listp (all-threads)))) +(ert-deftest threads-main-thread () + "Simple test for all-threads." + (skip-unless (featurep 'threads)) + (should (eq main-thread (car (all-threads))))) + (defvar threads-test-global nil) (defun threads-test-thread1 () @@ -275,6 +281,9 @@ (thread-yield)) (should (equal (thread-last-error) '(error "Error is called"))) + (should (equal (thread-last-error 'cleanup) + '(error "Error is called"))) + (should-not (thread-last-error)) (setq th2 (make-thread #'threads-custom "threads-custom")) (should (threadp th2)))) commit 94a16e7360b69191001bc594ab1b66f2b6bf97c2 Author: Charles A. Roelli Date: Mon Jul 16 20:57:06 2018 +0200 Improve description of window configs in 'register-val-describe' * etc/NEWS: Describe the change. * lisp/register.el (register-val-describe) [(window-configuration-p (car val))]: Include the shown buffers in the return value to make 'register-read-with-preview' more useful. (Bug#30863) diff --git a/etc/NEWS b/etc/NEWS index 2a93bdf025..76c19acd8c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -539,6 +539,10 @@ are obsoleted in GVFS. Tramp for some look-alike remote file names. --- +** Register +*** The return value of method 'register-val-describe' includes the +names of buffers shown by the windows of a window configuration. + ** The options.el library has been removed. It was obsolete since Emacs 22.1, replaced by customize. diff --git a/lisp/register.el b/lisp/register.el index 3d61044c03..e25f9fd588 100644 --- a/lisp/register.el +++ b/lisp/register.el @@ -391,7 +391,20 @@ Interactively, reads the register using `register-read-with-preview'." (cl-defmethod register-val-describe ((val cons) verbose) (cond ((window-configuration-p (car val)) - (princ "a window configuration.")) + (let* ((stored-window-config (car val)) + (window-config-frame (window-configuration-frame stored-window-config)) + (current-frame (selected-frame))) + (princ (format "a window configuration: %s." + (if (frame-live-p window-config-frame) + (with-selected-frame window-config-frame + (save-window-excursion + (set-window-configuration stored-window-config) + (concat + (mapconcat (lambda (w) (buffer-name (window-buffer w))) + (window-list (selected-frame)) ", ") + (unless (eq current-frame window-config-frame) + " in another frame")))) + "dead frame"))))) ((frame-configuration-p (car val)) (princ "a frame configuration.")) commit d45b2a31ca1181e8ee6d177e2e48669746ebbb79 Author: Charles A. Roelli Date: Mon Jul 16 20:36:31 2018 +0200 * configure.ac [$HAVE_NS]: Correct build instructions. Running 'make install' to test a repo build on macOS used to be required, but is no longer needed. diff --git a/configure.ac b/configure.ac index 6613ce1eaa..b6918671e4 100644 --- a/configure.ac +++ b/configure.ac @@ -5468,9 +5468,10 @@ echo if test "$HAVE_NS" = "yes"; then echo - AS_ECHO(["You must run \"${MAKE-make} install\" in order to test the built application. -The installed application will go to nextstep/Emacs.app and can be -run or moved from there."]) + AS_ECHO(["Run '${MAKE-make}' to build Emacs, then run 'src/emacs' to test it. +Run '${MAKE-make} install' in order to build an application bundle. +The application will go to nextstep/Emacs.app and can be run or moved +from there."]) if test "$EN_NS_SELF_CONTAINED" = "yes"; then echo "The application will be fully self-contained." else commit 46d7c786324f98e73b7615fbc9515ce9a14fa5d4 Author: Noam Postavsky Date: Mon Jul 16 07:10:14 2018 -0400 ; Remove tracing for epg-tests (Bug#23561) diff --git a/lisp/epg-config.el b/lisp/epg-config.el index 39d264c05a..fb866df392 100644 --- a/lisp/epg-config.el +++ b/lisp/epg-config.el @@ -174,13 +174,10 @@ version requirement is met." (defun epg-config--make-gpg-configuration (program) (let (config groups type args) (with-temp-buffer - (apply #'call-process program nil - (list t (and (boundp 'trace-level) (> trace-level 0))) nil + (apply #'call-process program nil (list t nil) nil (append (if epg-gpg-home-directory (list "--homedir" epg-gpg-home-directory)) '("--with-colons" "--list-config"))) - (when (and (boundp 'trace-level) (> trace-level 0)) - (trace-values (concat "gpg output:\n" (buffer-string)))) (goto-char (point-min)) (while (re-search-forward "^cfg:\\([^:]+\\):\\(.*\\)" nil t) (setq type (intern (match-string 1)) diff --git a/test/Makefile.in b/test/Makefile.in index 6070932508..0bc893bc0c 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -169,7 +169,6 @@ WRITE_LOG = > $@ 2>&1 || { STAT=$$?; cat $@; exit $$STAT; } ifdef EMACS_HYDRA_CI ## On Hydra, always show logs for certain problematic tests. lisp/net/tramp-tests.log \ -lisp/epg-tests.log \ : WRITE_LOG = 2>&1 | tee $@ endif diff --git a/test/lisp/epg-tests.el b/test/lisp/epg-tests.el index a72a917fe9..c1e98a6935 100644 --- a/test/lisp/epg-tests.el +++ b/test/lisp/epg-tests.el @@ -23,7 +23,6 @@ (require 'ert) (require 'epg) -(require 'trace) (defvar epg-tests-context nil) @@ -42,34 +41,17 @@ "2.0") prog-alist)) -(defvar epg-tests--trace nil) - (defun epg-tests-find-usable-gpg-configuration (&optional require-passphrase require-public-key) ;; Clear config cache because we may be using a different ;; program-alist. We do want to update the cache, so that ;; `epg-make-context' can use our result. (setq epg--configurations nil) - ;; Tracing for Bug#23561, but only do it once per run. - (when epg-tests--trace - (dolist (fun '(epg-find-configuration - executable-find - epg-check-configuration - epg-config--make-gpg-configuration)) - (trace-function-background fun)) - (setq epg-tests--trace nil)) - (prog1 (unwind-protect - (epg-find-configuration - 'OpenPGP nil - ;; The symmetric operations fail on Hydra - ;; with gpg 2.0. - (if (or (not require-passphrase) require-public-key) - epg-tests--config-program-alist)) - (untrace-all)) - (when (get-buffer "*trace-output*") - (princ (with-current-buffer "*trace-output*" (prog1 (buffer-string) - (erase-buffer))) - #'external-debugging-output)))) + (epg-find-configuration 'OpenPGP nil + ;; The symmetric operations fail on Hydra + ;; with gpg 2.0. + (if (or (not require-passphrase) require-public-key) + epg-tests--config-program-alist))) (defun epg-tests-passphrase-callback (_c _k _d) ;; Need to create a copy here, since the string will be wiped out @@ -82,8 +64,7 @@ &rest body) "Set up temporary locations and variables for testing." (declare (indent 1) (debug (sexp body))) - `(let* ((epg-debug epg-tests--trace) - (epg-tests-home-directory (make-temp-file "epg-tests-homedir" t)) + `(let* ((epg-tests-home-directory (make-temp-file "epg-tests-homedir" t)) (process-environment (append (list "GPG_AGENT_INFO" @@ -122,15 +103,10 @@ (make-local-variable 'epg-tests-context) (setq epg-tests-context context) ,@body)) - (when epg-debug-buffer - (princ (with-current-buffer epg-debug-buffer - (prog1 (buffer-string) (erase-buffer))) - #'external-debugging-output)) (when (file-directory-p epg-tests-home-directory) (delete-directory epg-tests-home-directory t))))) (ert-deftest epg-decrypt-1 () - (setq epg-tests--trace t) (with-epg-tests (:require-passphrase t) (should (equal "test" (epg-decrypt-string epg-tests-context "\ @@ -142,7 +118,6 @@ jA0EAwMCE19JBLTvvmhgyRrGGglRbnKkK9PJG8fDwO5ccjysrR7IcdNcnA== -----END PGP MESSAGE-----"))))) (ert-deftest epg-roundtrip-1 () - (setq epg-tests--trace t) (with-epg-tests (:require-passphrase t) (let ((cipher (epg-encrypt-string epg-tests-context "symmetric" nil))) (should (equal "symmetric" commit 4318d70677dedea12a3dcfb689bce71e409212f0 Author: Noam Postavsky Date: Sun Jul 15 21:40:05 2018 -0400 Reject gpg 2.0 for epg configs by default (Bug#23561) Previously, gpg2 2.0 would be rejected, but the same version installed as "gpg" would be accepted. * lisp/epg-config.el (epg-gpg2-minimum-version): New constant. (epg-config--program-alist) : Require a version in 1.4.3..2.0 or 2.1.6+., not just anything above 1.4.3. (epg-check-configuration): Accept a list of required version intervals, in addtion to just a single minimum. diff --git a/lisp/epg-config.el b/lisp/epg-config.el index 85434985d3..39d264c05a 100644 --- a/lisp/epg-config.el +++ b/lisp/epg-config.el @@ -98,11 +98,14 @@ Note that the buffer name starts with a space." :type 'boolean) (defconst epg-gpg-minimum-version "1.4.3") +(defconst epg-gpg2-minimum-version "2.1.6") (defconst epg-config--program-alist `((OpenPGP epg-gpg-program - ("gpg2" . "2.1.6") ("gpg" . ,epg-gpg-minimum-version)) + ("gpg2" . ,epg-gpg2-minimum-version) + ("gpg" . ((,epg-gpg-minimum-version . "2.0") + ,epg-gpg2-minimum-version))) (CMS epg-gpgsm-program ("gpgsm" . "2.0.4"))) @@ -231,14 +234,26 @@ version requirement is met." (epg-config--make-gpg-configuration epg-gpg-program)) ;;;###autoload -(defun epg-check-configuration (config &optional minimum-version) - "Verify that a sufficient version of GnuPG is installed." +(defun epg-check-configuration (config &optional req-versions) + "Verify that a sufficient version of GnuPG is installed. +CONFIG should be a `epg-configuration' object (a plist). +REQ-VERSIONS should be a list with elements of the form (MIN +. MAX) where MIN and MAX are version strings indicating a +semi-open range of acceptable versions. REQ-VERSIONS may also be +a single minimum version string." (let ((version (alist-get 'version config))) (unless (stringp version) (error "Undetermined version: %S" version)) - (unless (version<= (or minimum-version - epg-gpg-minimum-version) - version) + (catch 'version-ok + (pcase-dolist ((or `(,min . ,max) + (and min (let max nil))) + (if (listp req-versions) req-versions + (list req-versions))) + (when (and (version<= (or min epg-gpg-minimum-version) + version) + (or (null max) + (version< version max))) + (throw 'version-ok t))) (error "Unsupported version: %s" version)))) ;;;###autoload commit f521161c1bc5a9cd10ee25ff5f4b7b8d753db55d Author: Paul Eggert Date: Sun Jul 15 18:28:35 2018 -0700 * lisp/format.el (format-proper-list-p): New alias. diff --git a/etc/NEWS b/etc/NEWS index c69bbe9d0f..2a93bdf025 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -713,7 +713,8 @@ manual for more details. +++ ** New function 'proper-list-p'. Given a proper list as argument, this predicate returns its length; -otherwise, it returns nil. +otherwise, it returns nil. 'format-proper-list-p' is now an obsolete +alias for the new function. ** define-minor-mode automatically documents the meaning of ARG diff --git a/lisp/format.el b/lisp/format.el index 5bf1be3947..49d3c718ab 100644 --- a/lisp/format.el +++ b/lisp/format.el @@ -539,6 +539,8 @@ Compare using `equal'." (setq tail next))) (cons acopy bcopy))) +(define-obsolete-function-alias 'format-proper-list-p 'proper-list-p "27.1") + (defun format-reorder (items order) "Arrange ITEMS to follow partial ORDER. Elements of ITEMS equal to elements of ORDER will be rearranged commit 6de91809a35719a2dbbc121e234a7a154ef121c3 Author: Noam Postavsky Date: Sat Jul 14 08:58:26 2018 -0400 ; Trace epg-tests (Bug#23561) diff --git a/test/lisp/epg-tests.el b/test/lisp/epg-tests.el index d249e77fb1..a72a917fe9 100644 --- a/test/lisp/epg-tests.el +++ b/test/lisp/epg-tests.el @@ -42,17 +42,34 @@ "2.0") prog-alist)) +(defvar epg-tests--trace nil) + (defun epg-tests-find-usable-gpg-configuration (&optional require-passphrase require-public-key) ;; Clear config cache because we may be using a different ;; program-alist. We do want to update the cache, so that ;; `epg-make-context' can use our result. (setq epg--configurations nil) - (epg-find-configuration 'OpenPGP nil - ;; The symmetric operations fail on Hydra - ;; with gpg 2.0. - (if (or (not require-passphrase) require-public-key) - epg-tests--config-program-alist))) + ;; Tracing for Bug#23561, but only do it once per run. + (when epg-tests--trace + (dolist (fun '(epg-find-configuration + executable-find + epg-check-configuration + epg-config--make-gpg-configuration)) + (trace-function-background fun)) + (setq epg-tests--trace nil)) + (prog1 (unwind-protect + (epg-find-configuration + 'OpenPGP nil + ;; The symmetric operations fail on Hydra + ;; with gpg 2.0. + (if (or (not require-passphrase) require-public-key) + epg-tests--config-program-alist)) + (untrace-all)) + (when (get-buffer "*trace-output*") + (princ (with-current-buffer "*trace-output*" (prog1 (buffer-string) + (erase-buffer))) + #'external-debugging-output)))) (defun epg-tests-passphrase-callback (_c _k _d) ;; Need to create a copy here, since the string will be wiped out @@ -65,7 +82,8 @@ &rest body) "Set up temporary locations and variables for testing." (declare (indent 1) (debug (sexp body))) - `(let* ((epg-tests-home-directory (make-temp-file "epg-tests-homedir" t)) + `(let* ((epg-debug epg-tests--trace) + (epg-tests-home-directory (make-temp-file "epg-tests-homedir" t)) (process-environment (append (list "GPG_AGENT_INFO" @@ -104,10 +122,15 @@ (make-local-variable 'epg-tests-context) (setq epg-tests-context context) ,@body)) + (when epg-debug-buffer + (princ (with-current-buffer epg-debug-buffer + (prog1 (buffer-string) (erase-buffer))) + #'external-debugging-output)) (when (file-directory-p epg-tests-home-directory) (delete-directory epg-tests-home-directory t))))) (ert-deftest epg-decrypt-1 () + (setq epg-tests--trace t) (with-epg-tests (:require-passphrase t) (should (equal "test" (epg-decrypt-string epg-tests-context "\ @@ -119,6 +142,7 @@ jA0EAwMCE19JBLTvvmhgyRrGGglRbnKkK9PJG8fDwO5ccjysrR7IcdNcnA== -----END PGP MESSAGE-----"))))) (ert-deftest epg-roundtrip-1 () + (setq epg-tests--trace t) (with-epg-tests (:require-passphrase t) (let ((cipher (epg-encrypt-string epg-tests-context "symmetric" nil))) (should (equal "symmetric" commit 7acb87ab97082026e692e1d1d679df2313148343 Author: Noam Postavsky Date: Sun Jul 15 09:37:59 2018 -0400 Don't test symmetric operations on gpg 2.0 (Bug#23561) On the Hydra test machines, which have gpg 2.0, the symmetric tests fail. * test/lisp/epg-tests.el (with-epg-tests): Pass REQUIRE-PUBLIC-KEY to `epg-tests-find-usable-gpg-configuration' and call it before `epg-make-context' so that the latter uses the resulting cached config. (epg-tests-find-usable-gpg-configuration): Only allow gpg 2.0 for symmetric operations. Clear `epg--configurations' and don't pass NO-CACHE to `epg-find-configuration'. (epg-tests--config-program-alist): Use copy-tree to avoid modifying the epg-config--program-alist cons values. * test/lisp/emacs-lisp/package-tests.el (package-test-signed): Allow running with gpg 2.0. diff --git a/test/lisp/emacs-lisp/package-tests.el b/test/lisp/emacs-lisp/package-tests.el index b1adfabe52..f08bc92ff2 100644 --- a/test/lisp/emacs-lisp/package-tests.el +++ b/test/lisp/emacs-lisp/package-tests.el @@ -473,7 +473,17 @@ Must called from within a `tar-mode' buffer." (let ((process-environment (cons (concat "HOME=" homedir) process-environment))) - (epg-find-configuration 'OpenPGP)) + (epg-find-configuration + 'OpenPGP nil + ;; By default we require gpg2 2.1+ due to some + ;; practical problems with pinentry. But this + ;; test works fine with 2.0 as well. + (let ((prog-alist (copy-tree epg-config--program-alist))) + (setf (alist-get "gpg2" + (alist-get 'OpenPGP prog-alist) + nil nil #'equal) + "2.0") + prog-alist))) (delete-directory homedir t)))) (let* ((keyring (expand-file-name "key.pub" package-test-data-dir)) (package-test-data-dir diff --git a/test/lisp/epg-tests.el b/test/lisp/epg-tests.el index c34e589a4a..d249e77fb1 100644 --- a/test/lisp/epg-tests.el +++ b/test/lisp/epg-tests.el @@ -33,17 +33,26 @@ (defconst epg-tests--config-program-alist ;; The default `epg-config--program-alist' requires gpg2 2.1 or - ;; greater due to some practical problems with pinentry. But the - ;; tests here all work fine with 2.0 as well. - (let ((prog-alist (copy-sequence epg-config--program-alist))) + ;; greater due to some practical problems with pinentry. But most + ;; tests here work fine with 2.0 as well. + (let ((prog-alist (copy-tree epg-config--program-alist))) (setf (alist-get "gpg2" (alist-get 'OpenPGP prog-alist) nil nil #'equal) "2.0") prog-alist)) -(defun epg-tests-find-usable-gpg-configuration (&optional _require-passphrase) - (epg-find-configuration 'OpenPGP 'no-cache epg-tests--config-program-alist)) +(defun epg-tests-find-usable-gpg-configuration + (&optional require-passphrase require-public-key) + ;; Clear config cache because we may be using a different + ;; program-alist. We do want to update the cache, so that + ;; `epg-make-context' can use our result. + (setq epg--configurations nil) + (epg-find-configuration 'OpenPGP nil + ;; The symmetric operations fail on Hydra + ;; with gpg 2.0. + (if (or (not require-passphrase) require-public-key) + epg-tests--config-program-alist))) (defun epg-tests-passphrase-callback (_c _k _d) ;; Need to create a copy here, since the string will be wiped out @@ -63,14 +72,12 @@ (format "GNUPGHOME=%s" epg-tests-home-directory)) process-environment))) (unwind-protect - (let ((context (epg-make-context 'OpenPGP)) - (epg-config (epg-tests-find-usable-gpg-configuration - ,(if require-passphrase - `'require-passphrase)))) - ;; GNUPGHOME is needed to find a usable gpg, so we can't - ;; check whether to skip any earlier (Bug#23561). - (unless epg-config - (ert-skip "No usable gpg config")) + ;; GNUPGHOME is needed to find a usable gpg, so we can't + ;; check whether to skip any earlier (Bug#23561). + (let ((epg-config (or (epg-tests-find-usable-gpg-configuration + ,require-passphrase ,require-public-key) + (ert-skip "No usable gpg config"))) + (context (epg-make-context 'OpenPGP))) (setf (epg-context-program context) (alist-get 'program epg-config)) (setf (epg-context-home-directory context) commit 95931085fafc67aebc62ec0c672d29bfbecd1e8a Author: Michael Albinus Date: Sun Jul 15 09:47:47 2018 +0200 Precise dav/davs in Tramp manual * doc/misc/tramp.texi (GVFS based methods): Mention `owncloud' method for special `dav'/`davs' file names. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index f2d7786940..a96f4ddf74 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -1096,7 +1096,7 @@ but with SSL encryption. Both methods support the port numbers. Paths being part of the WebDAV volume to be mounted by GVFS, as it is common for OwnCloud or NextCloud file names, are not supported by -these methods. +these methods. See method @option{owncloud} for handling them. @item @option{gdrive} @cindex method @option{gdrive} commit 02db06fc8ebc06519088505b033fd6819a71bef8 Author: Michael Albinus Date: Sun Jul 15 09:47:08 2018 +0200 Fix Bug#32147 * test/lisp/net/secrets-tests.el (secrets-test02-collections) (secrets-test03-items): Test for both "Login" or "login" collection. (Bug#32147) diff --git a/test/lisp/net/secrets-tests.el b/test/lisp/net/secrets-tests.el index 9aa79dab0e..de3ce731be 100644 --- a/test/lisp/net/secrets-tests.el +++ b/test/lisp/net/secrets-tests.el @@ -92,7 +92,8 @@ (should (secrets-open-session)) ;; There must be at least the collections "Login" and "session". - (should (member "Login" (secrets-list-collections))) + (should (or (member "Login" (secrets-list-collections)) + (member "login" (secrets-list-collections)))) (should (member "session" (secrets-list-collections))) ;; Create a random collection. This asks for a password @@ -160,7 +161,8 @@ ;; There shall be no items in the "session" collection. (should-not (secrets-list-items "session")) ;; There shall be items in the "Login" collection. - (should (secrets-list-items "Login")) + (should (or (secrets-list-items "Login") + (secrets-list-items "login"))) ;; Create a new item. (should (setq item-path (secrets-create-item "session" "foo" "secret"))) commit b1ebc123396f91b51e27f8c61a2cfe730ed202ad Author: Noam Postavsky Date: Sun Jul 15 00:06:29 2018 -0400 Update package.el test for message format changes * test/lisp/emacs-lisp/package-tests.el (package-test-signed): Update the expected message. The message was changed in 2018-06-25 "Reformat package.el message strings for future l10n". (with-package-test, with-fake-help-buffer): Add debug declarations. diff --git a/test/lisp/emacs-lisp/package-tests.el b/test/lisp/emacs-lisp/package-tests.el index db8e1ae37e..b1adfabe52 100644 --- a/test/lisp/emacs-lisp/package-tests.el +++ b/test/lisp/emacs-lisp/package-tests.el @@ -112,7 +112,7 @@ upload-base) &rest body) "Set up temporary locations and variables for testing." - (declare (indent 1)) + (declare (indent 1) (debug (([&rest form]) body))) `(let* ((package-test-user-dir (make-temp-file "pkg-test-user-dir-" t)) (process-environment (cons (format "HOME=%s" package-test-user-dir) process-environment)) @@ -158,6 +158,7 @@ (defmacro with-fake-help-buffer (&rest body) "Execute BODY in a temp buffer which is treated as the \"*Help*\" buffer." + (declare (debug body)) `(with-temp-buffer (help-mode) ;; Trick `help-buffer' into using the temp buffer. @@ -504,7 +505,7 @@ Must called from within a `tar-mode' buffer." (with-fake-help-buffer (describe-package 'signed-good) (goto-char (point-min)) - (should (re-search-forward "signed-good is an? \\(\\S-+\\) package." nil t)) + (should (re-search-forward "Package signed-good is \\(\\S-+\\)\\." nil t)) (should (string-equal (match-string-no-properties 1) "installed")) (should (re-search-forward "Status: Installed in ['`â€]signed-good-1.0/['’]." commit 10a7e91956ebc5d808c88aecffb9d71a568d0233 Author: Noam Postavsky Date: Sat Jul 14 23:45:27 2018 -0400 Fix gpg detection for tests (Bug#23561) * test/lisp/emacs-lisp/package-tests.el (package-test-signed): Stop using epg-check-configuration and ignore-errors, they're redundant because epg-find-configuration already does all that. * test/lisp/epg-tests.el (epg-tests-find-usable-gpg-configuration): Remove tracing. (with-epg-tests): Skip test if no gpg config is found. (epg-decrypt-1 epg-roundtrip-1, epg-sign-verify-1, epg-sign-verify-2) (epg-import-1): Don't check gpg configuration at top-level, rely on `with-epg-tests' instead. Checking the gpg configuration requires a valid HOME (or GNUPGHOME), which is provided by `with-epg-tests'. diff --git a/test/lisp/emacs-lisp/package-tests.el b/test/lisp/emacs-lisp/package-tests.el index db6d103a2e..db8e1ae37e 100644 --- a/test/lisp/emacs-lisp/package-tests.el +++ b/test/lisp/emacs-lisp/package-tests.el @@ -467,15 +467,13 @@ Must called from within a `tar-mode' buffer." (ert-deftest package-test-signed () "Test verifying package signature." - (skip-unless (ignore-errors - (let ((homedir (make-temp-file "package-test" t))) - (unwind-protect - (let ((process-environment - (cons (format "HOME=%s" homedir) - process-environment))) - (epg-check-configuration - (epg-find-configuration 'OpenPGP))) - (delete-directory homedir t))))) + (skip-unless (let ((homedir (make-temp-file "package-test" t))) + (unwind-protect + (let ((process-environment + (cons (concat "HOME=" homedir) + process-environment))) + (epg-find-configuration 'OpenPGP)) + (delete-directory homedir t)))) (let* ((keyring (expand-file-name "key.pub" package-test-data-dir)) (package-test-data-dir (expand-file-name "package-resources/signed" package-test-file-dir))) diff --git a/test/lisp/epg-tests.el b/test/lisp/epg-tests.el index 361ba8fc0c..c34e589a4a 100644 --- a/test/lisp/epg-tests.el +++ b/test/lisp/epg-tests.el @@ -43,19 +43,7 @@ prog-alist)) (defun epg-tests-find-usable-gpg-configuration (&optional _require-passphrase) - ;; Tracing for Bug#23561, but only do it once per run. - (if (get-buffer "*trace-output*") - (epg-find-configuration 'OpenPGP 'no-cache epg-tests--config-program-alist) - (dolist (fun '(epg-find-configuration - executable-find - epg-check-configuration - epg-config--make-gpg-configuration)) - (trace-function-background fun)) - (prog1 (unwind-protect - (epg-find-configuration 'OpenPGP 'no-cache epg-tests--config-program-alist) - (untrace-all)) - (princ (with-current-buffer "*trace-output*" (buffer-string)) - #'external-debugging-output)))) + (epg-find-configuration 'OpenPGP 'no-cache epg-tests--config-program-alist)) (defun epg-tests-passphrase-callback (_c _k _d) ;; Need to create a copy here, since the string will be wiped out @@ -75,12 +63,16 @@ (format "GNUPGHOME=%s" epg-tests-home-directory)) process-environment))) (unwind-protect - (let ((context (epg-make-context 'OpenPGP))) + (let ((context (epg-make-context 'OpenPGP)) + (epg-config (epg-tests-find-usable-gpg-configuration + ,(if require-passphrase + `'require-passphrase)))) + ;; GNUPGHOME is needed to find a usable gpg, so we can't + ;; check whether to skip any earlier (Bug#23561). + (unless epg-config + (ert-skip "No usable gpg config")) (setf (epg-context-program context) - (alist-get 'program - (epg-tests-find-usable-gpg-configuration - ,(if require-passphrase - `'require-passphrase)))) + (alist-get 'program epg-config)) (setf (epg-context-home-directory context) epg-tests-home-directory) ,(if require-passphrase @@ -109,7 +101,6 @@ (delete-directory epg-tests-home-directory t))))) (ert-deftest epg-decrypt-1 () - (skip-unless (epg-tests-find-usable-gpg-configuration 'require-passphrase)) (with-epg-tests (:require-passphrase t) (should (equal "test" (epg-decrypt-string epg-tests-context "\ @@ -121,14 +112,12 @@ jA0EAwMCE19JBLTvvmhgyRrGGglRbnKkK9PJG8fDwO5ccjysrR7IcdNcnA== -----END PGP MESSAGE-----"))))) (ert-deftest epg-roundtrip-1 () - (skip-unless (epg-tests-find-usable-gpg-configuration 'require-passphrase)) (with-epg-tests (:require-passphrase t) (let ((cipher (epg-encrypt-string epg-tests-context "symmetric" nil))) (should (equal "symmetric" (epg-decrypt-string epg-tests-context cipher)))))) (ert-deftest epg-roundtrip-2 () - (skip-unless (epg-tests-find-usable-gpg-configuration 'require-passphrase)) (with-epg-tests (:require-passphrase t :require-public-key t :require-secret-key t) @@ -139,7 +128,6 @@ jA0EAwMCE19JBLTvvmhgyRrGGglRbnKkK9PJG8fDwO5ccjysrR7IcdNcnA== (epg-decrypt-string epg-tests-context cipher)))))) (ert-deftest epg-sign-verify-1 () - (skip-unless (epg-tests-find-usable-gpg-configuration 'require-passphrase)) (with-epg-tests (:require-passphrase t :require-public-key t :require-secret-key t) @@ -153,7 +141,6 @@ jA0EAwMCE19JBLTvvmhgyRrGGglRbnKkK9PJG8fDwO5ccjysrR7IcdNcnA== (should (eq 'good (epg-signature-status (car verify-result))))))) (ert-deftest epg-sign-verify-2 () - (skip-unless (epg-tests-find-usable-gpg-configuration 'require-passphrase)) (with-epg-tests (:require-passphrase t :require-public-key t :require-secret-key t) @@ -169,7 +156,6 @@ jA0EAwMCE19JBLTvvmhgyRrGGglRbnKkK9PJG8fDwO5ccjysrR7IcdNcnA== (should (eq 'good (epg-signature-status (car verify-result))))))) (ert-deftest epg-sign-verify-3 () - (skip-unless (epg-tests-find-usable-gpg-configuration 'require-passphrase)) (with-epg-tests (:require-passphrase t :require-public-key t :require-secret-key t) @@ -184,7 +170,6 @@ jA0EAwMCE19JBLTvvmhgyRrGGglRbnKkK9PJG8fDwO5ccjysrR7IcdNcnA== (should (eq 'good (epg-signature-status (car verify-result))))))) (ert-deftest epg-import-1 () - (skip-unless (epg-tests-find-usable-gpg-configuration 'require-passphrase)) (with-epg-tests (:require-passphrase nil) (should (= 0 (length (epg-list-keys epg-tests-context)))) (should (= 0 (length (epg-list-keys epg-tests-context nil t))))) commit 4d42d1d351fbdd236a11ae86f7d0796337e629b3 Author: Noam Postavsky Date: Sat Jul 14 20:04:25 2018 -0400 ; Trace gpg stderr config output during epg-tests (Bug#23561) diff --git a/lisp/epg-config.el b/lisp/epg-config.el index e5fd12d967..85434985d3 100644 --- a/lisp/epg-config.el +++ b/lisp/epg-config.el @@ -171,7 +171,8 @@ version requirement is met." (defun epg-config--make-gpg-configuration (program) (let (config groups type args) (with-temp-buffer - (apply #'call-process program nil (list t nil) nil + (apply #'call-process program nil + (list t (and (boundp 'trace-level) (> trace-level 0))) nil (append (if epg-gpg-home-directory (list "--homedir" epg-gpg-home-directory)) '("--with-colons" "--list-config"))) commit bc7ed164b88710a7f79cab7a1e7915ab11392216 Author: Noam Postavsky Date: Sat Jul 14 18:31:49 2018 -0400 ; Further tracing of epg-tests gpg config (Bug#23561) diff --git a/lisp/epg-config.el b/lisp/epg-config.el index 98f458d996..e5fd12d967 100644 --- a/lisp/epg-config.el +++ b/lisp/epg-config.el @@ -175,6 +175,8 @@ version requirement is met." (append (if epg-gpg-home-directory (list "--homedir" epg-gpg-home-directory)) '("--with-colons" "--list-config"))) + (when (and (boundp 'trace-level) (> trace-level 0)) + (trace-values (concat "gpg output:\n" (buffer-string)))) (goto-char (point-min)) (while (re-search-forward "^cfg:\\([^:]+\\):\\(.*\\)" nil t) (setq type (intern (match-string 1)) commit 90110f8499c5b3e26c67d3e15cc8dccd9ef057cf Author: Eli Zaretskii Date: Sat Jul 14 18:53:40 2018 +0300 Don't use a literal "C-u" in ispell.el help message text * lisp/textmodes/ispell.el (ispell-command-loop): Use "\\[universal-argument]" instead of a literal "C-u". (Bug#32142) diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 39e8869ea9..e77bc7e112 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -2271,8 +2271,9 @@ Global `ispell-quit' set to start location to continue spell session." (ispell-pdict-save ispell-silently-savep) (message "%s" (substitute-command-keys - (concat "Spell-checking suspended;" - " use C-u \\[ispell-word] to resume"))) + (concat + "Spell-checking suspended; use " + "\\[universal-argument] \\[ispell-word] to resume"))) (setq ispell-quit start) nil) ((= char ?q) commit 155d7303808345dd73427302d9a352ec5461c11a Author: Charles A. Roelli Date: Sat Jul 14 15:12:36 2018 +0200 Add to documentation of 'jump-to-register' * lisp/register.el (jump-to-register): * doc/emacs/regs.texi (Position Registers): Document that jumping to a register can push the mark. diff --git a/doc/emacs/regs.texi b/doc/emacs/regs.texi index 7d16d53912..98eed06453 100644 --- a/doc/emacs/regs.texi +++ b/doc/emacs/regs.texi @@ -80,7 +80,9 @@ information until you store something else in it. @kindex C-x r j @findex jump-to-register The command @kbd{C-x r j @var{r}} switches to the buffer recorded in -register @var{r}, and moves point to the recorded position. The +register @var{r}, pushes a mark, and moves point to the recorded +position. (The mark is not pushed if point was already at the +recorded position, or in successive calls to the command.) The contents of the register are not changed, so you can jump to the saved position any number of times. diff --git a/lisp/register.el b/lisp/register.el index 77d84c047a..3d61044c03 100644 --- a/lisp/register.el +++ b/lisp/register.el @@ -231,6 +231,7 @@ Interactively, reads the register using `register-read-with-preview'." (defalias 'register-to-point 'jump-to-register) (defun jump-to-register (register &optional delete) "Move point to location stored in a register. +Push the mark if jumping moves point, unless called in succession. If the register contains a file name, find that file. \(To put a file name in a register, you must use `set-register'.) If the register contains a window configuration (one frame) or a frameset commit 5936f6cdac09aa2f420f7f3756cf77629af99344 Author: Noam Postavsky Date: Sat Jul 14 08:58:26 2018 -0400 ; Trace epg-tests gpg config finding (Bug#23561) diff --git a/test/Makefile.in b/test/Makefile.in index 0bc893bc0c..6070932508 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -169,6 +169,7 @@ WRITE_LOG = > $@ 2>&1 || { STAT=$$?; cat $@; exit $$STAT; } ifdef EMACS_HYDRA_CI ## On Hydra, always show logs for certain problematic tests. lisp/net/tramp-tests.log \ +lisp/epg-tests.log \ : WRITE_LOG = 2>&1 | tee $@ endif diff --git a/test/lisp/epg-tests.el b/test/lisp/epg-tests.el index 7efe04bfc0..361ba8fc0c 100644 --- a/test/lisp/epg-tests.el +++ b/test/lisp/epg-tests.el @@ -23,6 +23,7 @@ (require 'ert) (require 'epg) +(require 'trace) (defvar epg-tests-context nil) @@ -42,7 +43,19 @@ prog-alist)) (defun epg-tests-find-usable-gpg-configuration (&optional _require-passphrase) - (epg-find-configuration 'OpenPGP 'no-cache epg-tests--config-program-alist)) + ;; Tracing for Bug#23561, but only do it once per run. + (if (get-buffer "*trace-output*") + (epg-find-configuration 'OpenPGP 'no-cache epg-tests--config-program-alist) + (dolist (fun '(epg-find-configuration + executable-find + epg-check-configuration + epg-config--make-gpg-configuration)) + (trace-function-background fun)) + (prog1 (unwind-protect + (epg-find-configuration 'OpenPGP 'no-cache epg-tests--config-program-alist) + (untrace-all)) + (princ (with-current-buffer "*trace-output*" (buffer-string)) + #'external-debugging-output)))) (defun epg-tests-passphrase-callback (_c _k _d) ;; Need to create a copy here, since the string will be wiped out commit 9f25231f354a973d5331b62717ec46e0cbcbbc6e Author: Jonathan Kyle Mitchell Date: Wed Jul 4 22:38:29 2018 -0500 Avoid infloop in redisplay due to faulty mode-line properties * xdisp.c (safe_set_text_properties): New function. (display_mode_element): Call Fset_text_properties through internal_condition_case_n, using safe_set_text_properties as a wrapper. (Bug#32038) diff --git a/src/xdisp.c b/src/xdisp.c index 9b4febdd61..1199e1c1b7 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -23516,6 +23516,17 @@ move_elt_to_front (Lisp_Object elt, Lisp_Object list) return list; } +/* Subroutine to call Fset_text_properties through + internal_condition_case_n. ARGS are the arguments of + Fset_text_properties, in order. */ + +static Lisp_Object +safe_set_text_properties (ptrdiff_t nargs, Lisp_Object *args) +{ + eassert (nargs == 4); + return Fset_text_properties (args[0], args[1], args[2], args[3]); +} + /* Contribute ELT to the mode line for window IT->w. How it translates into text depends on its data type. @@ -23610,8 +23621,17 @@ display_mode_element (struct it *it, int depth, int field_width, int precision, = Fdelq (aelt, mode_line_proptrans_alist); elt = Fcopy_sequence (elt); - Fset_text_properties (make_number (0), Flength (elt), - props, elt); + /* PROPS might cause set-text-properties to signal + an error, so we call it via internal_condition_case_n, + to avoid an infloop in redisplay due to the error. */ + internal_condition_case_n (safe_set_text_properties, + 4, + ((Lisp_Object []) + {make_number (0), + Flength (elt), + props, + elt}), + Qt, safe_eval_handler); /* Add this item to mode_line_proptrans_alist. */ mode_line_proptrans_alist = Fcons (Fcons (elt, props), commit f4e7f6d73d1dbb260dfce3fcc51cb0d5838cf1bf Author: Eli Zaretskii Date: Sat Jul 14 11:18:04 2018 +0300 Improve documentation of 'seqp' * doc/lispref/sequences.texi (Sequence Functions): Add text to explain the relation between 'seqp' and 'sequencep'. (Bug#32125) diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 327de6eb86..51d724cb1d 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -63,7 +63,8 @@ But it is possible to add elements to the list, or remove elements. @defun sequencep object This function returns @code{t} if @var{object} is a list, vector, -string, bool-vector, or char-table, @code{nil} otherwise. +string, bool-vector, or char-table, @code{nil} otherwise. See also +@code{seqp} below. @end defun @defun length sequence @@ -479,7 +480,8 @@ built-in sequence types, @code{seq-length} behaves like @code{length}. @defun seqp object This function returns non-@code{nil} if @var{object} is a sequence (a list or array), or any additional type of sequence defined via -@file{seq.el} generic functions. +@file{seq.el} generic functions. This is an extensible variant of +@code{sequencep}. @example @group commit ed13639c0f6b4bcfddab55bcca60f8a258d41e2f Author: Eli Zaretskii Date: Sat Jul 14 10:43:32 2018 +0300 Clarify usage and dependencies between several Flyspell features * lisp/textmodes/flyspell.el (flyspell-region) (flyspell-small-region, flyspell-persistent-highlight): Documentation improvements. (Bug#32142) diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index b6c8ac393c..5726bd82cb 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -138,7 +138,9 @@ This variable specifies how far to search to find such a duplicate. "Non-nil means misspelled words remain highlighted until corrected. If this variable is nil, only the most recently detected misspelled word is highlighted, and the highlight is turned off as soon as point moves -off the misspelled word." +off the misspelled word. + +Make sure this variable is non-nil if you use `flyspell-region'." :group 'flyspell :type 'boolean) @@ -1368,7 +1370,10 @@ language." ;;* flyspell-small-region ... */ ;;*---------------------------------------------------------------------*/ (defun flyspell-small-region (beg end) - "Flyspell text between BEG and END." + "Flyspell text between BEG and END. + +This function is intended to work on small regions, as +determined by `flyspell-large-region'." (save-excursion (if (> beg end) (let ((old beg)) @@ -1639,7 +1644,10 @@ The buffer to mark them in is `flyspell-large-region-buffer'." ;;*---------------------------------------------------------------------*/ ;;;###autoload (defun flyspell-region (beg end) - "Flyspell text between BEG and END." + "Flyspell text between BEG and END. + +Make sure `flyspell-mode' is turned on if you want the highlight +of a misspelled word removed when you've corrected it." (interactive "r") (ispell-set-spellchecker-params) ; Initialize variables and dicts alists (if (= beg end) commit 41f5de7c8ac3da19ccc8c96be52a6714a9b49a8f Author: Stefan Monnier Date: Fri Jul 13 12:34:50 2018 -0400 * lisp/vc/diff-mode.el (diff-font-lock-prettify): New var (diff--font-lock-prettify): New function. (diff-font-lock-keywords): Use it. diff --git a/etc/NEWS b/etc/NEWS index 1a1e0d8b70..c69bbe9d0f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -212,6 +212,13 @@ navigation and editing of large files. * Changes in Specialized Modes and Packages in Emacs 27.1 +** diff-mode +*** Hunks are now automatically refined by default +To disable it, set the new defcustom 'diff-font-lock-refine' to nil. + +*** File headers can be shortened, mimicking Magit's diff format +To enable it, set the new defcustom 'diff-font-lock-prettify to t. + ** Browse-url *** The function 'browse-url-emacs' can now visit a URL in selected window. diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index ffbd9e5479..b91a2ba45a 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -96,6 +96,11 @@ when editing big diffs)." :version "27.1" :type 'boolean) +(defcustom diff-font-lock-prettify nil + "If non-nil, font-lock will try and make the format prettier." + :version "27.1" + :type 'boolean) + (defvar diff-vc-backend nil "The VC backend that created the current Diff buffer, if any.") @@ -396,6 +401,7 @@ and the face `diff-added' for added lines.") (1 font-lock-comment-delimiter-face) (2 font-lock-comment-face)) ("^[^-=+*!<>#].*\n" (0 'diff-context)) + (,#'diff--font-lock-prettify) (,#'diff--font-lock-refined))) (defconst diff-font-lock-defaults @@ -2195,6 +2201,35 @@ fixed, visit it in a buffer." modified-buffers ", ")) (message "No trailing whitespace to delete."))))) + +;;; Prettifying from font-lock + +(defun diff--font-lock-prettify (limit) + ;; Mimicks the output of Magit's diff. + ;; FIXME: This has only been tested with Git's diff output. + (when diff-font-lock-prettify + (while (re-search-forward "^diff " limit t) + (when (save-excursion + (forward-line 0) + (looking-at (eval-when-compile + (concat "diff.*\n" + "\\(?:\\(?:new file\\|deleted\\).*\n\\)?" + "\\(?:index.*\n\\)?" + "--- \\(?:/dev/null\\|a/\\(.*\\)\\)\n" + "\\+\\+\\+ \\(?:/dev/null\\|b/\\(.*\\)\\)\n")))) + (put-text-property (match-beginning 0) + (or (match-beginning 2) (match-beginning 1)) + 'display (propertize + (cond + ((null (match-beginning 1)) "new file ") + ((null (match-beginning 2)) "deleted ") + (t "modified ")) + 'face '(diff-file-header diff-header))) + (unless (match-beginning 2) + (put-text-property (match-end 1) (1- (match-end 0)) + 'display ""))))) + nil) + ;;; Support for converting a diff to diff3 markers via `wiggle'. ;; Wiggle can be found at http://neil.brown.name/wiggle/ or in your nearest commit cda7e1850f2f19a5025fd163ff2c6c6cba275acf Merge: 1013e0392b 17ebb6e5ae Author: Glenn Morris Date: Fri Jul 13 09:28:15 2018 -0700 Merge from origin/emacs-26 17ebb6e (origin/emacs-26) Use consistent function names in thread-tes... 1c86229 Fix format error in Faccept_process_output b38b91a Lessen stack consumption in recursive read1 3eb4603 Match w32 paths in grep sans --null hits (Bug#32051) 5cc7c4b Fix previous make-network-process change d6a1b69 Another documentation improvement in flyspell.el 9b49a8e Improve documentation of Flyspell 3744fda Provide feature 'threads ef9025f Save the server alias on reconnect (Bug#29657) db3874b Refer to "proper lists" instead of "true lists" 35e0305 Avoid turning on the global-minor-mode recursively 51bf4e4 Fix Bug#32085 commit 1013e0392b78ee0e2199fb51859dc9e939315f9b Author: Basil L. Contovounesios Date: Fri Jun 1 21:58:10 2018 +0100 Tweak subr-x.el substring functions * lisp/emacs-lisp/subr-x.el (string-join): #'-quote function symbol. (string-trim-left, string-trim-right): Make better use of substring for minor speedup. * test/lisp/emacs-lisp/subr-x-tests.el (subr-x-test-string-trim-left, subr-x-test-string-trim-right) (subr-x-test-string-remove-prefix) (subr-x-test-string-remove-suffix): New tests. diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index e03a81c892..20eb0d5d05 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -211,7 +211,7 @@ The variable list SPEC is the same as in `if-let'." (defsubst string-join (strings &optional separator) "Join all STRINGS using SEPARATOR." - (mapconcat 'identity strings separator)) + (mapconcat #'identity strings separator)) (define-obsolete-function-alias 'string-reverse 'reverse "25.1") @@ -219,17 +219,17 @@ The variable list SPEC is the same as in `if-let'." "Trim STRING of leading string matching REGEXP. REGEXP defaults to \"[ \\t\\n\\r]+\"." - (if (string-match (concat "\\`\\(?:" (or regexp "[ \t\n\r]+")"\\)") string) - (replace-match "" t t string) + (if (string-match (concat "\\`\\(?:" (or regexp "[ \t\n\r]+") "\\)") string) + (substring string (match-end 0)) string)) (defsubst string-trim-right (string &optional regexp) "Trim STRING of trailing string matching REGEXP. REGEXP defaults to \"[ \\t\\n\\r]+\"." - (if (string-match (concat "\\(?:" (or regexp "[ \t\n\r]+") "\\)\\'") string) - (replace-match "" t t string) - string)) + (let ((i (string-match-p (concat "\\(?:" (or regexp "[ \t\n\r]+") "\\)\\'") + string))) + (if i (substring string 0 i) string))) (defsubst string-trim (string &optional trim-left trim-right) "Trim STRING of leading and trailing strings matching TRIM-LEFT and TRIM-RIGHT. diff --git a/test/lisp/emacs-lisp/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el index f7f0ef384f..81467bab2d 100644 --- a/test/lisp/emacs-lisp/subr-x-tests.el +++ b/test/lisp/emacs-lisp/subr-x-tests.el @@ -532,6 +532,53 @@ (format "abs sum is: %s")) "abs sum is: 15"))) + +;; Substring tests + +(ert-deftest subr-x-test-string-trim-left () + "Test `string-trim-left' behavior." + (should (equal (string-trim-left "") "")) + (should (equal (string-trim-left " \t\n\r") "")) + (should (equal (string-trim-left " \t\n\ra") "a")) + (should (equal (string-trim-left "a \t\n\r") "a \t\n\r")) + (should (equal (string-trim-left "" "") "")) + (should (equal (string-trim-left "a" "") "a")) + (should (equal (string-trim-left "aa" "a*") "")) + (should (equal (string-trim-left "ba" "a*") "ba")) + (should (equal (string-trim-left "aa" "a*?") "aa")) + (should (equal (string-trim-left "aa" "a+?") "a"))) + +(ert-deftest subr-x-test-string-trim-right () + "Test `string-trim-right' behavior." + (should (equal (string-trim-right "") "")) + (should (equal (string-trim-right " \t\n\r") "")) + (should (equal (string-trim-right " \t\n\ra") " \t\n\ra")) + (should (equal (string-trim-right "a \t\n\r") "a")) + (should (equal (string-trim-right "" "") "")) + (should (equal (string-trim-right "a" "") "a")) + (should (equal (string-trim-right "aa" "a*") "")) + (should (equal (string-trim-right "ab" "a*") "ab")) + (should (equal (string-trim-right "aa" "a*?") ""))) + +(ert-deftest subr-x-test-string-remove-prefix () + "Test `string-remove-prefix' behavior." + (should (equal (string-remove-prefix "" "") "")) + (should (equal (string-remove-prefix "" "a") "a")) + (should (equal (string-remove-prefix "a" "") "")) + (should (equal (string-remove-prefix "a" "b") "b")) + (should (equal (string-remove-prefix "a" "a") "")) + (should (equal (string-remove-prefix "a" "aa") "a")) + (should (equal (string-remove-prefix "a" "ab") "b"))) + +(ert-deftest subr-x-test-string-remove-suffix () + "Test `string-remove-suffix' behavior." + (should (equal (string-remove-suffix "" "") "")) + (should (equal (string-remove-suffix "" "a") "a")) + (should (equal (string-remove-suffix "a" "") "")) + (should (equal (string-remove-suffix "a" "b") "b")) + (should (equal (string-remove-suffix "a" "a") "")) + (should (equal (string-remove-suffix "a" "aa") "a")) + (should (equal (string-remove-suffix "a" "ba") "b"))) (provide 'subr-x-tests) ;;; subr-x-tests.el ends here commit 34eba3e33334166a3b195f00650dee4674c80a9d Author: Basil L. Contovounesios Date: Thu May 10 03:08:10 2018 +0100 Minor cus-theme.el simplifications * lisp/cus-theme.el (custom-new-theme-mode, customize-themes) (custom-theme-choose-mode): Use setq-local. (customize-create-theme): Ditto. Use delete-all-overlays. (describe-theme-1, custom-theme-summary): Simplify logic. diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el index 53389956ad..995c55b2b2 100644 --- a/lisp/cus-theme.el +++ b/lisp/cus-theme.el @@ -47,7 +47,7 @@ Do not call this mode function yourself. It is meant for internal use." (use-local-map custom-new-theme-mode-map) (custom--initialize-widget-variables) - (set (make-local-variable 'revert-buffer-function) #'custom-theme-revert)) + (setq-local revert-buffer-function #'custom-theme-revert)) (put 'custom-new-theme-mode 'mode-class 'special) (defvar custom-theme-name nil) @@ -93,15 +93,14 @@ named *Custom Theme*." (switch-to-buffer (get-buffer-create (or buffer "*Custom Theme*"))) (let ((inhibit-read-only t)) (erase-buffer) - (dolist (ov (overlays-in (point-min) (point-max))) - (delete-overlay ov))) + (delete-all-overlays)) (custom-new-theme-mode) (make-local-variable 'custom-theme-name) - (set (make-local-variable 'custom-theme--save-name) theme) - (set (make-local-variable 'custom-theme-faces) nil) - (set (make-local-variable 'custom-theme-variables) nil) - (set (make-local-variable 'custom-theme-description) "") - (set (make-local-variable 'custom-theme--migrate-settings) nil) + (setq-local custom-theme--save-name theme) + (setq-local custom-theme-faces nil) + (setq-local custom-theme-variables nil) + (setq-local custom-theme-description "") + (setq-local custom-theme--migrate-settings nil) (make-local-variable 'custom-theme-insert-face-marker) (make-local-variable 'custom-theme-insert-variable-marker) (make-local-variable 'custom-theme--listed-faces) @@ -513,8 +512,7 @@ It includes all faces in list FACES." (condition-case nil (read (current-buffer)) (end-of-file nil))))) - (and sexp (listp sexp) - (eq (car sexp) 'deftheme) + (and (eq (car-safe sexp) 'deftheme) (setq doc (nth 2 sexp))))))) (princ "\n\nDocumentation:\n") (princ (if (stringp doc) @@ -552,10 +550,10 @@ It includes all faces in list FACES." Do not call this mode function yourself. It is meant for internal use." (use-local-map custom-theme-choose-mode-map) (custom--initialize-widget-variables) - (set (make-local-variable 'revert-buffer-function) - (lambda (_ignore-auto noconfirm) - (when (or noconfirm (y-or-n-p "Discard current choices? ")) - (customize-themes (current-buffer)))))) + (setq-local revert-buffer-function + (lambda (_ignore-auto noconfirm) + (when (or noconfirm (y-or-n-p "Discard current choices? ")) + (customize-themes (current-buffer)))))) (put 'custom-theme-choose-mode 'mode-class 'special) ;;;###autoload @@ -568,7 +566,7 @@ omitted, a buffer named *Custom Themes* is used." (let ((inhibit-read-only t)) (erase-buffer)) (custom-theme-choose-mode) - (set (make-local-variable 'custom--listed-themes) nil) + (setq-local custom--listed-themes nil) (make-local-variable 'custom-theme-allow-multiple-selections) (and (null custom-theme-allow-multiple-selections) (> (length custom-enabled-themes) 1) @@ -662,8 +660,7 @@ Theme files are named *-theme.el in `")) (condition-case nil (read (current-buffer)) (end-of-file nil))))) - (and sexp (listp sexp) - (eq (car sexp) 'deftheme) + (and (eq (car-safe sexp) 'deftheme) (setq doc (nth 2 sexp)))))))) (cond ((null doc) "(no documentation available)") commit b16f08015f69ecb1e665411533e6f8b64ccb847e Author: Basil L. Contovounesios Date: Thu May 31 18:37:02 2018 +0100 Minor custom.el simplifications * lisp/custom.el (custom-quote): Duplicate macroexp-quote. (custom-load-symbol, customize-mark-to-save, customize-mark-as-set) (custom-theme-name-valid-p, enable-theme, custom-enabled-themes) (disable-theme): Simplify logic. diff --git a/lisp/custom.el b/lisp/custom.el index 1c667c8aa2..a08f7fda70 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -630,14 +630,12 @@ The result is that the change is treated as having been made through Custom." (let ((custom-load-recursion t)) ;; Load these files if not already done, ;; to make sure we know all the dependencies of SYMBOL. - (condition-case nil - (require 'cus-load) - (error nil)) - (condition-case nil - (require 'cus-start) - (error nil)) + (ignore-errors + (require 'cus-load)) + (ignore-errors + (require 'cus-start)) (dolist (load (get symbol 'custom-loads)) - (cond ((symbolp load) (condition-case nil (require load) (error nil))) + (cond ((symbolp load) (ignore-errors (require load))) ;; This is subsumed by the test below, but it's much faster. ((assoc load load-history)) ;; This was just (assoc (locate-library load) load-history) @@ -655,7 +653,7 @@ The result is that the change is treated as having been made through Custom." ;; We are still loading it when we call this, ;; and it is not in load-history yet. ((equal load "cus-edit")) - (t (condition-case nil (load load) (error nil)))))))) + (t (ignore-errors (load load)))))))) (defvar custom-local-buffer nil "Non-nil, in a Customization buffer, means customize a specific buffer. @@ -688,16 +686,12 @@ this sets the local binding in that buffer instead." (defun custom-quote (sexp) "Quote SEXP if it is not self quoting." - (if (or (memq sexp '(t nil)) - (keywordp sexp) - (and (listp sexp) - (memq (car sexp) '(lambda))) - (stringp sexp) - (numberp sexp) - (vectorp sexp) -;;; (and (fboundp 'characterp) -;;; (characterp sexp)) - ) + ;; Can't use `macroexp-quote' because it is loaded after `custom.el' + ;; during bootstrap. See `loadup.el'. + (if (and (not (consp sexp)) + (or (keywordp sexp) + (not (symbolp sexp)) + (booleanp sexp))) sexp (list 'quote sexp))) @@ -718,12 +712,10 @@ Return non-nil if the `saved-value' property actually changed." (standard (get symbol 'standard-value)) (comment (get symbol 'customized-variable-comment))) ;; Save default value if different from standard value. - (if (or (null standard) - (not (equal value (condition-case nil - (eval (car standard)) - (error nil))))) - (put symbol 'saved-value (list (custom-quote value))) - (put symbol 'saved-value nil)) + (put symbol 'saved-value + (unless (and standard + (equal value (ignore-errors (eval (car standard))))) + (list (custom-quote value)))) ;; Clear customized information (set, but not saved). (put symbol 'customized-value nil) ;; Save any comment that might have been set. @@ -747,9 +739,8 @@ Return non-nil if the `customized-value' property actually changed." (old (or (get symbol 'saved-value) (get symbol 'standard-value)))) ;; Mark default value as set if different from old value. (if (not (and old - (equal value (condition-case nil - (eval (car old)) - (error nil))))) + (equal value (ignore-errors + (eval (car old)))))) (progn (put symbol 'customized-value (list (custom-quote value))) (custom-push-theme 'theme-value symbol 'user 'set (custom-quote value))) @@ -1296,11 +1287,9 @@ query also about adding HASH to `custom-safe-themes'." (defun custom-theme-name-valid-p (name) "Return t if NAME is a valid name for a Custom theme, nil otherwise. NAME should be a symbol." - (and (symbolp name) - name - (not (or (zerop (length (symbol-name name))) - (eq name 'user) - (eq name 'changed))))) + (and (not (memq name '(nil user changed))) + (symbolp name) + (not (string= "" (symbol-name name))))) (defun custom-available-themes () "Return a list of Custom themes available for loading. @@ -1356,8 +1345,8 @@ function runs. To disable other themes, use `disable-theme'." (completing-read "Enable custom theme: " obarray (lambda (sym) (get sym 'theme-settings)) t)))) - (if (not (custom-theme-p theme)) - (error "Undefined Custom theme %s" theme)) + (unless (custom-theme-p theme) + (error "Undefined Custom theme %s" theme)) (let ((settings (get theme 'theme-settings))) ;; Loop through theme settings, recalculating vars/faces. (dolist (s settings) @@ -1397,18 +1386,18 @@ Setting this variable through Customize calls `enable-theme' or (let (failures) (setq themes (delq 'user (delete-dups themes))) ;; Disable all themes not in THEMES. - (if (boundp symbol) - (dolist (theme (symbol-value symbol)) - (if (not (memq theme themes)) - (disable-theme theme)))) + (dolist (theme (and (boundp symbol) + (symbol-value symbol))) + (unless (memq theme themes) + (disable-theme theme))) ;; Call `enable-theme' or `load-theme' on each of THEMES. (dolist (theme (reverse themes)) (condition-case nil (if (custom-theme-p theme) (enable-theme theme) (load-theme theme)) - (error (setq failures (cons theme failures) - themes (delq theme themes))))) + (error (push theme failures) + (setq themes (delq theme themes))))) (enable-theme 'user) (custom-set-default symbol themes) (when failures @@ -1441,23 +1430,23 @@ See `custom-enabled-themes' for a list of enabled themes." ;; If the face spec specified by this theme is in the ;; saved-face property, reset that property. (when (equal (nth 3 s) (get symbol 'saved-face)) - (put symbol 'saved-face (and val (cadr (car val))))))))) - ;; Recompute faces on all frames. - (dolist (frame (frame-list)) - ;; We must reset the fg and bg color frame parameters, or - ;; `face-set-after-frame-default' will use the existing - ;; parameters, which could be from the disabled theme. - (set-frame-parameter frame 'background-color - (custom--frame-color-default - frame :background "background" "Background" - "unspecified-bg" "white")) - (set-frame-parameter frame 'foreground-color - (custom--frame-color-default - frame :foreground "foreground" "Foreground" - "unspecified-fg" "black")) - (face-set-after-frame-default frame)) - (setq custom-enabled-themes - (delq theme custom-enabled-themes))))) + (put symbol 'saved-face (cadar val)))))))) + ;; Recompute faces on all frames. + (dolist (frame (frame-list)) + ;; We must reset the fg and bg color frame parameters, or + ;; `face-set-after-frame-default' will use the existing + ;; parameters, which could be from the disabled theme. + (set-frame-parameter frame 'background-color + (custom--frame-color-default + frame :background "background" "Background" + "unspecified-bg" "white")) + (set-frame-parameter frame 'foreground-color + (custom--frame-color-default + frame :foreground "foreground" "Foreground" + "unspecified-fg" "black")) + (face-set-after-frame-default frame)) + (setq custom-enabled-themes + (delq theme custom-enabled-themes)))) ;; Only used if window-system not null. (declare-function x-get-resource "frame.c" commit feb6863e64a94466af867d63c1e8fef4cc5e84fc Author: Basil L. Contovounesios Date: Fri May 11 15:35:09 2018 +0100 * lisp/cus-theme.el: Use lexical-binding diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el index e5e787771b..53389956ad 100644 --- a/lisp/cus-theme.el +++ b/lisp/cus-theme.el @@ -1,4 +1,4 @@ -;;; cus-theme.el -- custom theme creation user interface +;;; cus-theme.el -- custom theme creation user interface -*- lexical-binding: t -*- ;; ;; Copyright (C) 2001-2018 Free Software Foundation, Inc. ;; @@ -47,7 +47,7 @@ Do not call this mode function yourself. It is meant for internal use." (use-local-map custom-new-theme-mode-map) (custom--initialize-widget-variables) - (set (make-local-variable 'revert-buffer-function) 'custom-theme-revert)) + (set (make-local-variable 'revert-buffer-function) #'custom-theme-revert)) (put 'custom-new-theme-mode 'mode-class 'special) (defvar custom-theme-name nil) @@ -118,13 +118,13 @@ remove them from your saved Custom file.\n\n")) :tag " Visit Theme " :help-echo "Insert the settings of a pre-defined theme." :action (lambda (_widget &optional _event) - (call-interactively 'custom-theme-visit-theme))) + (call-interactively #'custom-theme-visit-theme))) (widget-insert " ") (widget-create 'push-button :tag " Merge Theme " :help-echo "Merge in the settings of a pre-defined theme." :action (lambda (_widget &optional _event) - (call-interactively 'custom-theme-merge-theme))) + (call-interactively #'custom-theme-merge-theme))) (widget-insert " ") (widget-create 'push-button :tag " Revert " @@ -142,7 +142,7 @@ remove them from your saved Custom file.\n\n")) (widget-create 'text :value (format-time-string "Created %Y-%m-%d."))) (widget-create 'push-button - :notify (function custom-theme-write) + :notify #'custom-theme-write " Save Theme ") (when (eq theme 'user) (setq custom-theme--migrate-settings t) @@ -188,7 +188,7 @@ remove them from your saved Custom file.\n\n")) :mouse-face 'highlight :pressed-face 'highlight :action (lambda (_widget &optional _event) - (call-interactively 'custom-theme-add-face))) + (call-interactively #'custom-theme-add-face))) ;; If THEME is non-nil, insert all of that theme's variables. (widget-insert "\n\n Theme variables:\n ") @@ -207,7 +207,7 @@ remove them from your saved Custom file.\n\n")) :mouse-face 'highlight :pressed-face 'highlight :action (lambda (_widget &optional _event) - (call-interactively 'custom-theme-add-variable))) + (call-interactively #'custom-theme-add-variable))) (widget-insert ?\n) (widget-setup) (goto-char (point-min)) @@ -254,7 +254,7 @@ interactively, this defaults to the current value of VAR." :tag (custom-unlispify-tag-name symbol) :value symbol :shown-value (list val) - :notify 'ignore + :notify #'ignore :custom-level 0 :custom-state 'hidden :custom-style 'simple)) @@ -313,7 +313,7 @@ SPEC, if non-nil, should be a face spec to which to set the widget." (interactive (list (intern (completing-read "Find custom theme: " - (mapcar 'symbol-name + (mapcar #'symbol-name (custom-available-themes)))))) (unless (custom-theme-name-valid-p theme) (error "No valid theme named `%s'" theme)) @@ -328,7 +328,7 @@ SPEC, if non-nil, should be a face spec to which to set the widget." (interactive (list (intern (completing-read "Merge custom theme: " - (mapcar 'symbol-name + (mapcar #'symbol-name (custom-available-themes)))))) (unless (eq theme 'user) (unless (custom-theme-name-valid-p theme) @@ -343,8 +343,8 @@ SPEC, if non-nil, should be a face spec to which to set the widget." (memq name '(custom-enabled-themes custom-safe-themes))) (funcall (if option - 'custom-theme-add-variable - 'custom-theme-add-face) + #'custom-theme-add-variable + #'custom-theme-add-face) name value))))) theme) @@ -475,7 +475,7 @@ It includes all faces in list FACES." (interactive (list (intern (completing-read "Describe custom theme: " - (mapcar 'symbol-name + (mapcar #'symbol-name (custom-available-themes)))))) (unless (custom-theme-name-valid-p theme) (error "Invalid theme name `%s'" theme)) @@ -616,11 +616,11 @@ Theme files are named *-theme.el in `")) (widget-create 'push-button :tag " Save Theme Settings " :help-echo "Save the selected themes for future sessions." - :action 'custom-theme-save) + :action #'custom-theme-save) (widget-insert ?\n) (widget-create 'checkbox :value custom-theme-allow-multiple-selections - :action 'custom-theme-selections-toggle) + :action #'custom-theme-selections-toggle) (widget-insert (propertize " Select more than one theme at a time" 'face '(variable-pitch (:height 0.9)))) @@ -632,13 +632,13 @@ Theme files are named *-theme.el in `")) :value (custom-theme-enabled-p theme) :theme-name theme :help-echo help-echo - :action 'custom-theme-checkbox-toggle)) + :action #'custom-theme-checkbox-toggle)) (push (cons theme widget) custom--listed-themes) (widget-create-child-and-convert widget 'push-button :button-face-get 'ignore :mouse-face-get 'ignore :value (format " %s" theme) - :action 'widget-parent-action + :action #'widget-parent-action :help-echo help-echo) (widget-insert " -- " (propertize (custom-theme-summary theme) commit 5c3db916927e08361d6a3172b53460f91ec81047 Author: Basil L. Contovounesios Date: Fri May 11 16:09:57 2018 +0100 * lisp/custom.el: Use lexical-binding Remove duplicate 'Custom Themes' comment heading. (deftheme, custom-declare-theme): Fix advertised calling convention. (custom-enabled-themes): Fix message grammar. diff --git a/lisp/custom.el b/lisp/custom.el index 4536788eb2..1c667c8aa2 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -1,4 +1,4 @@ -;;; custom.el --- tools for declaring and initializing options +;;; custom.el --- tools for declaring and initializing options -*- lexical-binding: t -*- ;; ;; Copyright (C) 1996-1997, 1999, 2001-2018 Free Software Foundation, ;; Inc. @@ -150,7 +150,7 @@ set to nil, as the value is no longer rogue." (put symbol 'force-value nil)) (if (keywordp doc) (error "Doc string is missing")) - (let ((initialize 'custom-initialize-reset) + (let ((initialize #'custom-initialize-reset) (requests nil)) (unless (memq :group args) (custom-add-to-group (custom-current-group) symbol 'custom-variable)) @@ -426,7 +426,7 @@ information." (defun custom-declare-group (symbol members doc &rest args) "Like `defgroup', but SYMBOL is evaluated as a normal argument." (while members - (apply 'custom-add-to-group symbol (car members)) + (apply #'custom-add-to-group symbol (car members)) (setq members (cdr members))) (when doc ;; This text doesn't get into DOC. @@ -618,11 +618,8 @@ VARIABLE is a symbol that names a user option. The result is that the change is treated as having been made through Custom." (put variable 'customized-value (list (custom-quote (eval variable))))) - -;;; Custom Themes - -;;; Loading files needed to customize a symbol. -;;; This is in custom.el because menu-bar.el needs it for toggle cmds. +;; Loading files needed to customize a symbol. +;; This is in custom.el because menu-bar.el needs it for toggle cmds. (defvar custom-load-recursion nil "Hack to avoid recursive dependencies.") @@ -715,7 +712,7 @@ To actually save the value, call `custom-save-all'. Return non-nil if the `saved-value' property actually changed." (custom-load-symbol symbol) - (let* ((get (or (get symbol 'custom-get) 'default-value)) + (let* ((get (or (get symbol 'custom-get) #'default-value)) (value (funcall get symbol)) (saved (get symbol 'saved-value)) (standard (get symbol 'standard-value)) @@ -744,7 +741,7 @@ default value. Otherwise, set it to nil. Return non-nil if the `customized-value' property actually changed." (custom-load-symbol symbol) - (let* ((get (or (get symbol 'custom-get) 'default-value)) + (let* ((get (or (get symbol 'custom-get) #'default-value)) (value (funcall get symbol)) (customized (get symbol 'customized-value)) (old (or (get symbol 'saved-value) (get symbol 'standard-value)))) @@ -776,7 +773,7 @@ E.g. dumped variables whose default depends on run-time information." ;; always do the funcall step, even if symbol was not bound before. (or (default-boundp symbol) (eval `(defvar ,symbol nil))) ; reset below, so any value is fine - (funcall (or (get symbol 'custom-set) 'set-default) + (funcall (or (get symbol 'custom-set) #'set-default) symbol (eval (car (or (get symbol 'saved-value) (get symbol 'standard-value)))))) @@ -946,7 +943,7 @@ the default value for the SYMBOL to the value of EXP. REQUEST is a list of features we must require in order to handle SYMBOL properly. COMMENT is a comment string about SYMBOL." - (apply 'custom-theme-set-variables 'user args)) + (apply #'custom-theme-set-variables 'user args)) (defun custom-theme-set-variables (theme &rest args) "Initialize variables for theme THEME according to settings in ARGS. @@ -994,8 +991,8 @@ COMMENT is a comment string about SYMBOL." set) (when requests (put symbol 'custom-requests requests) - (mapc 'require requests)) - (setq set (or (get symbol 'custom-set) 'custom-set-default)) + (mapc #'require requests)) + (setq set (or (get symbol 'custom-set) #'custom-set-default)) (put symbol 'saved-value (list value)) (put symbol 'saved-variable-comment comment) ;; Allow for errors in the case where the setter has @@ -1091,26 +1088,29 @@ list, in which A occurs before B if B was defined with a ;; they were used to supply keyword-value pairs like `:immediate', ;; `:variable-reset-string', etc. We don't use any of these, so ignore them. -(defmacro deftheme (theme &optional doc &rest ignored) +(defmacro deftheme (theme &optional doc &rest _ignored) "Declare THEME to be a Custom theme. The optional argument DOC is a doc string describing the theme. Any theme `foo' should be defined in a file called `foo-theme.el'; see `custom-make-theme-feature' for more information." - (declare (doc-string 2)) + (declare (doc-string 2) + (advertised-calling-convention (theme &optional doc) "22.1")) (let ((feature (custom-make-theme-feature theme))) ;; It is better not to use backquote in this file, ;; because that makes a bootstrapping problem ;; if you need to recompile all the Lisp files using interpreted code. (list 'custom-declare-theme (list 'quote theme) (list 'quote feature) doc))) -(defun custom-declare-theme (theme feature &optional doc &rest ignored) +(defun custom-declare-theme (theme feature &optional doc &rest _ignored) "Like `deftheme', but THEME is evaluated as a normal argument. FEATURE is the feature this theme provides. Normally, this is a symbol created from THEME by `custom-make-theme-feature'." + (declare (advertised-calling-convention (theme feature &optional doc) "22.1")) (unless (custom-theme-name-valid-p theme) (error "Custom theme cannot be named %S" theme)) - (add-to-list 'custom-known-themes theme) + (unless (memq theme custom-known-themes) + (push theme custom-known-themes)) (put theme 'theme-feature feature) (when doc (put theme 'theme-documentation doc))) @@ -1218,7 +1218,7 @@ Return t if THEME was successfully loaded, nil otherwise." (interactive (list (intern (completing-read "Load custom theme: " - (mapcar 'symbol-name + (mapcar #'symbol-name (custom-available-themes)))) nil nil)) (unless (custom-theme-name-valid-p theme) @@ -1411,9 +1411,9 @@ Setting this variable through Customize calls `enable-theme' or themes (delq theme themes))))) (enable-theme 'user) (custom-set-default symbol themes) - (if failures - (message "Failed to enable theme: %s" - (mapconcat 'symbol-name failures ", ")))))) + (when failures + (message "Failed to enable theme(s): %s" + (mapconcat #'symbol-name failures ", ")))))) (defsubst custom-theme-enabled-p (theme) "Return non-nil if THEME is enabled." @@ -1425,7 +1425,7 @@ See `custom-enabled-themes' for a list of enabled themes." (interactive (list (intern (completing-read "Disable custom theme: " - (mapcar 'symbol-name custom-enabled-themes) + (mapcar #'symbol-name custom-enabled-themes) nil t)))) (when (custom-theme-enabled-p theme) (let ((settings (get theme 'theme-settings))) @@ -1491,7 +1491,7 @@ This function returns nil if no custom theme specifies a value for VARIABLE." (if (and valspec (or (get variable 'force-value) (default-boundp variable))) - (funcall (or (get variable 'custom-set) 'set-default) variable + (funcall (or (get variable 'custom-set) #'set-default) variable (eval (car valspec)))))) (defun custom-theme-recalc-face (face) @@ -1532,7 +1532,7 @@ Each of the arguments ARGS has this form: (VARIABLE IGNORED) This means reset VARIABLE. (The argument IGNORED is ignored)." - (apply 'custom-theme-reset-variables 'user args)) + (apply #'custom-theme-reset-variables 'user args)) ;;; The End. commit 70d702d3b1c40f72059bb5694bd805b1c65d141d Author: Basil L. Contovounesios Date: Mon Jun 4 02:12:33 2018 +0100 Fix custom-available-themes file expansion For discussion, see thread starting at https://lists.gnu.org/archive/html/emacs-devel/2018-05/msg00222.html. * lisp/custom.el: (custom-available-themes): Use directory-files instead of performing arbitrary wildcard expansion in file names. (custom-theme--load-path): Document return value. * test/lisp/custom-tests.el: New file. (custom-theme--load-path): New test. diff --git a/lisp/custom.el b/lisp/custom.el index b8ea8811a2..4536788eb2 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -1311,19 +1311,25 @@ The returned symbols may not correspond to themes that have been loaded, and no effort is made to check that the files contain valid Custom themes. For a list of loaded themes, check the variable `custom-known-themes'." - (let (sym themes) + (let ((suffix "-theme\\.el\\'") + themes) (dolist (dir (custom-theme--load-path)) - (when (file-directory-p dir) - (dolist (file (file-expand-wildcards - (expand-file-name "*-theme.el" dir) t)) - (setq file (file-name-nondirectory file)) - (and (string-match "\\`\\(.+\\)-theme.el\\'" file) - (setq sym (intern (match-string 1 file))) - (custom-theme-name-valid-p sym) - (push sym themes))))) - (nreverse (delete-dups themes)))) + ;; `custom-theme--load-path' promises DIR exists and is a + ;; directory, but `custom.el' is loaded too early during + ;; bootstrap to use `cl-lib' macros, so guard with + ;; `file-directory-p' instead of calling `cl-assert'. + (dolist (file (and (file-directory-p dir) + (directory-files dir nil suffix))) + (let ((theme (intern (substring file 0 (string-match-p suffix file))))) + (and (custom-theme-name-valid-p theme) + (not (memq theme themes)) + (push theme themes))))) + (nreverse themes))) (defun custom-theme--load-path () + "Expand `custom-theme-load-path' into a list of directories. +Members of `custom-theme-load-path' that either don't exist or +are not directories are omitted from the expansion." (let (lpath) (dolist (f custom-theme-load-path) (cond ((eq f 'custom-theme-directory) diff --git a/test/lisp/custom-tests.el b/test/lisp/custom-tests.el new file mode 100644 index 0000000000..96887f8f5f --- /dev/null +++ b/test/lisp/custom-tests.el @@ -0,0 +1,87 @@ +;;; custom-tests.el --- tests for custom.el -*- lexical-binding: t -*- + +;; Copyright (C) 2018 Free Software Foundation, Inc. + +;; 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 this program. If not, see . + +;;; Code: + +(require 'ert) + +(ert-deftest custom-theme--load-path () + "Test `custom-theme--load-path' behavior." + (let ((tmpdir (file-name-as-directory (make-temp-file "custom-tests-" t)))) + (unwind-protect + ;; Create all temporary files under the same deletable parent. + (let ((temporary-file-directory tmpdir)) + ;; Path is empty. + (let ((custom-theme-load-path ())) + (should (null (custom-theme--load-path)))) + + ;; Path comprises non-existent file. + (let* ((name (make-temp-name tmpdir)) + (custom-theme-load-path (list name))) + (should (not (file-exists-p name))) + (should (null (custom-theme--load-path)))) + + ;; Path comprises existing file. + (let* ((file (make-temp-file "file")) + (custom-theme-load-path (list file))) + (should (file-exists-p file)) + (should (not (file-directory-p file))) + (should (null (custom-theme--load-path)))) + + ;; Path comprises existing directory. + (let* ((dir (make-temp-file "dir" t)) + (custom-theme-load-path (list dir))) + (should (file-directory-p dir)) + (should (equal (custom-theme--load-path) custom-theme-load-path))) + + ;; Expand `custom-theme-directory' path element. + (let ((custom-theme-load-path '(custom-theme-directory))) + (let ((custom-theme-directory (make-temp-name tmpdir))) + (should (not (file-exists-p custom-theme-directory))) + (should (null (custom-theme--load-path)))) + (let ((custom-theme-directory (make-temp-file "file"))) + (should (file-exists-p custom-theme-directory)) + (should (not (file-directory-p custom-theme-directory))) + (should (null (custom-theme--load-path)))) + (let ((custom-theme-directory (make-temp-file "dir" t))) + (should (file-directory-p custom-theme-directory)) + (should (equal (custom-theme--load-path) + (list custom-theme-directory))))) + + ;; Expand t path element. + (let ((custom-theme-load-path '(t))) + (let ((data-directory (make-temp-name tmpdir))) + (should (not (file-exists-p data-directory))) + (should (null (custom-theme--load-path)))) + (let ((data-directory tmpdir) + (themedir (expand-file-name "themes" tmpdir))) + (should (not (file-exists-p themedir))) + (should (null (custom-theme--load-path))) + (with-temp-file themedir) + (should (file-exists-p themedir)) + (should (not (file-directory-p themedir))) + (should (null (custom-theme--load-path))) + (delete-file themedir) + (make-directory themedir) + (should (file-directory-p themedir)) + (should (equal (custom-theme--load-path) (list themedir)))))) + (when (file-directory-p tmpdir) + (delete-directory tmpdir t))))) + +;;; custom-tests.el ends here commit 530aa469a4de7b4800557ae783f6c450df59a5b4 Author: Basil L. Contovounesios Date: Wed May 9 22:30:48 2018 +0100 Disable no-byte-compile in built-in themes * etc/themes/adwaita-theme.el: * etc/themes/deeper-blue-theme.el: * etc/themes/dichromacy-theme.el: * etc/themes/leuven-theme.el: * etc/themes/light-blue-theme.el: * etc/themes/manoj-dark-theme.el: * etc/themes/misterioso-theme.el: * etc/themes/tango-dark-theme.el: * etc/themes/tango-theme.el: * etc/themes/tsdh-dark-theme.el: * etc/themes/tsdh-light-theme.el: * etc/themes/wheatgrass-theme.el: * etc/themes/whiteboard-theme.el: * etc/themes/wombat-theme.el: Disable no-byte-compile. https://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00614.html https://lists.gnu.org/archive/html/emacs-devel/2018-02/msg00060.html diff --git a/etc/themes/adwaita-theme.el b/etc/themes/adwaita-theme.el index b376153510..415db8a191 100644 --- a/etc/themes/adwaita-theme.el +++ b/etc/themes/adwaita-theme.el @@ -99,8 +99,4 @@ default look of the Gnome 3 desktop.") `(diff-added ((,class (:bold t :foreground "#4E9A06")))) `(diff-removed ((,class (:bold t :foreground "#F5666D")))))) -;; Local Variables: -;; no-byte-compile: t -;; End: - ;;; adwaita-theme.el ends here diff --git a/etc/themes/deeper-blue-theme.el b/etc/themes/deeper-blue-theme.el index c6aa1751f4..0700f4f23d 100644 --- a/etc/themes/deeper-blue-theme.el +++ b/etc/themes/deeper-blue-theme.el @@ -110,8 +110,4 @@ (provide-theme 'deeper-blue) -;; Local Variables: -;; no-byte-compile: t -;; End: - ;;; deeper-blue-theme.el ends here diff --git a/etc/themes/dichromacy-theme.el b/etc/themes/dichromacy-theme.el index 793209c055..bfced43aee 100644 --- a/etc/themes/dichromacy-theme.el +++ b/etc/themes/dichromacy-theme.el @@ -122,8 +122,4 @@ Ansi-Color faces are included.") (provide-theme 'dichromacy) -;; Local Variables: -;; no-byte-compile: t -;; End: - ;;; dichromacy-theme.el ends here diff --git a/etc/themes/leuven-theme.el b/etc/themes/leuven-theme.el index 5c0d19ce81..c3c666588b 100644 --- a/etc/themes/leuven-theme.el +++ b/etc/themes/leuven-theme.el @@ -708,7 +708,6 @@ Semantic, and Ansi-Color faces are included -- and much more...") ;; time-stamp-format: "%:y%02m%02d.%02H%02M" ;; time-stamp-start: "Version: " ;; time-stamp-end: "$" -;; no-byte-compile: t ;; End: ;;; leuven-theme.el ends here diff --git a/etc/themes/light-blue-theme.el b/etc/themes/light-blue-theme.el index 9935c565fb..ba00db6a49 100644 --- a/etc/themes/light-blue-theme.el +++ b/etc/themes/light-blue-theme.el @@ -61,8 +61,4 @@ (provide-theme 'light-blue) -;; Local Variables: -;; no-byte-compile: t -;; End: - ;;; light-blue-theme.el ends here diff --git a/etc/themes/manoj-dark-theme.el b/etc/themes/manoj-dark-theme.el index fe61441d78..ddcaa0bd99 100644 --- a/etc/themes/manoj-dark-theme.el +++ b/etc/themes/manoj-dark-theme.el @@ -700,8 +700,4 @@ jarring angry fruit salad look to reduce eye fatigue.") (provide-theme 'manoj-dark) -;; Local Variables: -;; no-byte-compile: t -;; End: - ;;; manoj-dark.el ends here diff --git a/etc/themes/misterioso-theme.el b/etc/themes/misterioso-theme.el index 42e448d28b..6c1eec0f42 100644 --- a/etc/themes/misterioso-theme.el +++ b/etc/themes/misterioso-theme.el @@ -103,8 +103,4 @@ (provide-theme 'misterioso) -;; Local Variables: -;; no-byte-compile: t -;; End: - ;;; misterioso-theme.el ends here diff --git a/etc/themes/tango-dark-theme.el b/etc/themes/tango-dark-theme.el index 3b6eeb702e..dae77a5e62 100644 --- a/etc/themes/tango-dark-theme.el +++ b/etc/themes/tango-dark-theme.el @@ -170,8 +170,4 @@ Semantic, and Ansi-Color faces are included.") (provide-theme 'tango-dark) -;; Local Variables: -;; no-byte-compile: t -;; End: - ;;; tango-dark-theme.el ends here diff --git a/etc/themes/tango-theme.el b/etc/themes/tango-theme.el index a7a79c04ad..4fe2480bc7 100644 --- a/etc/themes/tango-theme.el +++ b/etc/themes/tango-theme.el @@ -154,8 +154,4 @@ Semantic, and Ansi-Color faces are included.") (provide-theme 'tango) -;; Local Variables: -;; no-byte-compile: t -;; End: - ;;; tango-theme.el ends here diff --git a/etc/themes/tsdh-dark-theme.el b/etc/themes/tsdh-dark-theme.el index 287fef8253..c216750cb2 100644 --- a/etc/themes/tsdh-dark-theme.el +++ b/etc/themes/tsdh-dark-theme.el @@ -144,8 +144,4 @@ (provide-theme 'tsdh-dark) -;; Local Variables: -;; no-byte-compile: t -;; End: - ;;; tsdh-dark-theme.el ends here diff --git a/etc/themes/tsdh-light-theme.el b/etc/themes/tsdh-light-theme.el index 17a86fdbfe..ce9d1a2c3c 100644 --- a/etc/themes/tsdh-light-theme.el +++ b/etc/themes/tsdh-light-theme.el @@ -106,9 +106,4 @@ Used and created by Tassilo Horn.") (provide-theme 'tsdh-light) - -;; Local Variables: -;; no-byte-compile: t -;; End: - ;;; tsdh-light-theme.el ends here diff --git a/etc/themes/wheatgrass-theme.el b/etc/themes/wheatgrass-theme.el index 9585e3aa6e..8d34c28bf4 100644 --- a/etc/themes/wheatgrass-theme.el +++ b/etc/themes/wheatgrass-theme.el @@ -83,8 +83,4 @@ of green, brown, and blue.") (provide-theme 'wheatgrass) -;; Local Variables: -;; no-byte-compile: t -;; End: - ;;; wheatgrass-theme.el ends here diff --git a/etc/themes/whiteboard-theme.el b/etc/themes/whiteboard-theme.el index 5db0ddd68d..fe46cb0928 100644 --- a/etc/themes/whiteboard-theme.el +++ b/etc/themes/whiteboard-theme.el @@ -100,8 +100,4 @@ (provide-theme 'whiteboard) -;; Local Variables: -;; no-byte-compile: t -;; End: - ;;; whiteboard-theme.el ends here diff --git a/etc/themes/wombat-theme.el b/etc/themes/wombat-theme.el index 583b8dc3f6..00f29bb9fa 100644 --- a/etc/themes/wombat-theme.el +++ b/etc/themes/wombat-theme.el @@ -102,8 +102,4 @@ are included.") (provide-theme 'wombat) -;; Local Variables: -;; no-byte-compile: t -;; End: - ;;; wombat-theme.el ends here commit 82e19fede8e46755c9860952fd5c6c9336fb7dd4 Author: Basil L. Contovounesios Date: Wed May 9 22:20:47 2018 +0100 Improve loading of byte-compiled custom themes * lisp/custom.el (load-theme): Load byte-compiled file of safe themes when available. https://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00614.html https://lists.gnu.org/archive/html/emacs-devel/2018-02/msg00060.html diff --git a/lisp/custom.el b/lisp/custom.el index 4a778a0573..b8ea8811a2 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -1233,43 +1233,47 @@ Return t if THEME was successfully loaded, nil otherwise." (put theme 'theme-settings nil) (put theme 'theme-feature nil) (put theme 'theme-documentation nil)) - (let ((fn (locate-file (concat (symbol-name theme) "-theme.el") - (custom-theme--load-path) - '("" "c")))) - (unless fn - (error "Unable to find theme file for `%s'" theme)) - (with-temp-buffer - (insert-file-contents fn) - ;; Check file safety with `custom-safe-themes', prompting the - ;; user if necessary. - (when (or no-confirm - (eq custom-safe-themes t) - (and (memq 'default custom-safe-themes) - (equal (file-name-directory fn) - (expand-file-name "themes/" data-directory))) - (let ((hash (secure-hash 'sha256 (current-buffer)))) - (or (member hash custom-safe-themes) - (custom-theme-load-confirm hash)))) - (let ((custom--inhibit-theme-enable t) - (buffer-file-name fn)) ;For load-history. - (eval-buffer)) - ;; Optimization: if the theme changes the `default' face, put that - ;; entry first. This avoids some `frame-set-background-mode' rigmarole - ;; by assigning the new background immediately. - (let* ((settings (get theme 'theme-settings)) - (tail settings) - found) - (while (and tail (not found)) - (and (eq (nth 0 (car tail)) 'theme-face) - (eq (nth 1 (car tail)) 'default) - (setq found (car tail))) - (setq tail (cdr tail))) - (if found - (put theme 'theme-settings (cons found (delq found settings))))) - ;; Finally, enable the theme. - (unless no-enable - (enable-theme theme)) - t)))) + (let ((file (locate-file (concat (symbol-name theme) "-theme.el") + (custom-theme--load-path) + '("" "c"))) + (custom--inhibit-theme-enable t)) + ;; Check file safety with `custom-safe-themes', prompting the + ;; user if necessary. + (cond ((not file) + (error "Unable to find theme file for `%s'" theme)) + ((or no-confirm + (eq custom-safe-themes t) + (and (memq 'default custom-safe-themes) + (equal (file-name-directory file) + (expand-file-name "themes/" data-directory)))) + ;; Theme is safe; load byte-compiled version if available. + (load (file-name-sans-extension file) nil t nil t)) + ((with-temp-buffer + (insert-file-contents file) + (let ((hash (secure-hash 'sha256 (current-buffer)))) + (when (or (member hash custom-safe-themes) + (custom-theme-load-confirm hash)) + (eval-buffer nil nil file) + t)))) + (t + (error "Unable to load theme `%s'" theme)))) + ;; Optimization: if the theme changes the `default' face, put that + ;; entry first. This avoids some `frame-set-background-mode' rigmarole + ;; by assigning the new background immediately. + (let* ((settings (get theme 'theme-settings)) + (tail settings) + found) + (while (and tail (not found)) + (and (eq (nth 0 (car tail)) 'theme-face) + (eq (nth 1 (car tail)) 'default) + (setq found (car tail))) + (setq tail (cdr tail))) + (when found + (put theme 'theme-settings (cons found (delq found settings))))) + ;; Finally, enable the theme. + (unless no-enable + (enable-theme theme)) + t) (defun custom-theme-load-confirm (hash) "Query the user about loading a Custom theme that may not be safe. commit 155ec5096928ddb121fb725fca65436d6353cb67 Author: Robert Pluim Date: Fri Jul 13 15:26:30 2018 +0200 Add GMP to emacs_config_features * configure.ac : Add GMP to emacs_config_features. This allows us to determine whether the built-in gmp-mini is being used or not. diff --git a/configure.ac b/configure.ac index e202acf8cd..2708091050 100644 --- a/configure.ac +++ b/configure.ac @@ -5412,7 +5412,7 @@ emacs_config_features= for opt in XAW3D XPM JPEG TIFF GIF PNG RSVG CAIRO IMAGEMAGICK SOUND GPM DBUS \ GCONF GSETTINGS NOTIFY ACL LIBSELINUX GNUTLS LIBXML2 FREETYPE M17N_FLT \ LIBOTF XFT ZLIB TOOLKIT_SCROLL_BARS X_TOOLKIT OLDXMENU X11 NS MODULES \ - THREADS XWIDGETS LIBSYSTEMD JSON CANNOT_DUMP LCMS2; do + THREADS XWIDGETS LIBSYSTEMD JSON CANNOT_DUMP LCMS2 GMP; do case $opt in CANNOT_DUMP) eval val=\${$opt} ;; commit 17ebb6e5ae9cdd2586d1b4d6f2347ae09c6f653f Author: Michael Albinus Date: Fri Jul 13 14:28:12 2018 +0200 Use consistent function names in thread-tests.el * test/src/thread-tests.el (threads-call-error, threads-custom) (threads-errors, threads-sticky-point, threads-signal-early): Rename, using naming convention to prefix with "threads-". diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el index 3c7fde33d8..a00a9c84bd 100644 --- a/test/src/thread-tests.el +++ b/test/src/thread-tests.el @@ -253,31 +253,32 @@ (string= "hi bob" (condition-name (make-condition-variable (make-mutex) "hi bob"))))) -(defun call-error () + +(defun threads-call-error () "Call `error'." (error "Error is called")) ;; This signals an error internally; the error should be caught. -(defun thread-custom () - (defcustom thread-custom-face 'highlight +(defun threads-custom () + (defcustom threads-custom-face 'highlight "Face used for thread customizations." :type 'face :group 'widget-faces)) -(ert-deftest thread-errors () +(ert-deftest threads-errors () "Test what happens when a thread signals an error." (skip-unless (featurep 'threads)) (let (th1 th2) - (setq th1 (make-thread #'call-error "call-error")) + (setq th1 (make-thread #'threads-call-error "call-error")) (should (threadp th1)) (while (thread-alive-p th1) (thread-yield)) (should (equal (thread-last-error) '(error "Error is called"))) - (setq th2 (make-thread #'thread-custom "thread-custom")) + (setq th2 (make-thread #'threads-custom "threads-custom")) (should (threadp th2)))) -(ert-deftest thread-sticky-point () +(ert-deftest threads-sticky-point () "Test bug #25165 with point movement in cloned buffer." (skip-unless (featurep 'threads)) (with-temp-buffer @@ -288,7 +289,7 @@ (sit-for 1) (should (= (point) 21)))) -(ert-deftest thread-signal-early () +(ert-deftest threads-signal-early () "Test signaling a thread as soon as it is started by the OS." (skip-unless (featurep 'threads)) (let ((thread commit 1c862297e4ad50b14f246fca724e148538e7421b Author: Michael Albinus Date: Fri Jul 13 14:27:33 2018 +0200 Fix format error in Faccept_process_output * src/process.c (Faccept_process_output): Do not use format spec "%p", it isn't valid for error(). diff --git a/src/process.c b/src/process.c index f7b96d2854..8629f834e7 100644 --- a/src/process.c +++ b/src/process.c @@ -4602,12 +4602,11 @@ is nil, from any process) before the timeout expired. */) { Lisp_Object proc_thread_name = XTHREAD (proc->thread)->name; - if (STRINGP (proc_thread_name)) - error ("Attempt to accept output from process %s locked to thread %s", - SDATA (proc->name), SDATA (proc_thread_name)); - else - error ("Attempt to accept output from process %s locked to thread %p", - SDATA (proc->name), XTHREAD (proc->thread)); + error ("Attempt to accept output from process %s locked to thread %s", + SDATA (proc->name), + STRINGP (proc_thread_name) + ? SDATA (proc_thread_name) + : SDATA (Fprin1_to_string (proc->thread, Qt))); } } else commit cc3d7580fc1cab3119e5e05c427575a2668cbb4f Author: Tom Tromey Date: Sun Jul 8 23:10:53 2018 -0600 Document bignums * doc/lispref/numbers.texi (Numbers, Integer Basics) (Predicates on Numbers, Comparison of Numbers) (Arithmetic Operations, Bitwise Operations): Update for bignums. * doc/lispref/objects.texi (Integer Type, Type Predicates): Update for bignums. * etc/NEWS: Update for bigums. diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi index 2fed2b642f..a95c31f468 100644 --- a/doc/lispref/numbers.texi +++ b/doc/lispref/numbers.texi @@ -14,9 +14,9 @@ fractional parts, such as @minus{}4.5, 0.0, and 2.71828. They can also be expressed in exponential notation: @samp{1.5e2} is the same as @samp{150.0}; here, @samp{e2} stands for ten to the second power, and -that is multiplied by 1.5. Integer computations are exact, though -they may overflow. Floating-point computations often involve rounding -errors, as the numbers have a fixed amount of precision. +that is multiplied by 1.5. Integer computations are exact. +Floating-point computations often involve rounding errors, as the +numbers have a fixed amount of precision. @menu * Integer Basics:: Representation and range of integers. @@ -34,7 +34,15 @@ errors, as the numbers have a fixed amount of precision. @node Integer Basics @section Integer Basics - The range of values for an integer depends on the machine. The + Integers in Emacs Lisp can have arbitrary precision. + + Under the hood, though, there are two kinds of integers: smaller +ones, called @dfn{fixnums}, and larger ones, called @dfn{bignums} +Some functions in Emacs only accept fixnums. Also, while fixnums can +always be compared for equality with @code{eq}, bignums require the +use of @code{eql}. + + The range of values for a fixnum depends on the machine. The minimum range is @minus{}536,870,912 to 536,870,911 (30 bits; i.e., @ifnottex @minus{}2**29 @@ -49,9 +57,7 @@ to @tex @math{2^{29}-1}), @end tex -but many machines provide a wider range. Many examples in this -chapter assume the minimum integer width of 30 bits. -@cindex overflow +but many machines provide a wider range. The Lisp reader reads an integer as a nonempty sequence of decimal digits with optional initial sign and optional @@ -91,14 +97,8 @@ For example: #24r1k @result{} 44 @end example - If an integer is outside the Emacs range, the Lisp reader ordinarily -signals an overflow. However, if a too-large plain integer ends in a -period, the Lisp reader treats it as a floating-point number instead. -This lets an Emacs Lisp program specify a large integer that is -quietly approximated by a floating-point number on machines with -limited word width. For example, @samp{536870912.} is a -floating-point number if Emacs integers are only 30 bits wide and is -an integer otherwise. + An integer is read as a fixnum if it is in the correct range. +Otherwise, it will be read as a bignum. To understand how various functions work on integers, especially the bitwise operators (@pxref{Bitwise Operations}), it is often helpful to @@ -141,16 +141,6 @@ In binary, the decimal integer 4 is 100. Consequently, 0111...111111 (30 bits total) @end example - Since the arithmetic functions do not check whether integers go -outside their range, when you add 1 to 536,870,911, the value is the -negative integer @minus{}536,870,912: - -@example -(+ 1 536870911) - @result{} -536870912 - @result{} 1000...000000 (30 bits total) -@end example - Many of the functions described in this chapter accept markers for arguments in place of numbers. (@xref{Markers}.) Since the actual arguments to such functions may be either numbers or markers, we often @@ -160,8 +150,8 @@ value is a marker, its position value is used and its buffer is ignored. @cindex largest Lisp integer @cindex maximum Lisp integer @defvar most-positive-fixnum -The value of this variable is the largest integer that Emacs Lisp can -handle. Typical values are +The value of this variable is the largest ``small'' integer that Emacs +Lisp can handle. Typical values are @ifnottex 2**29 @minus{} 1 @end ifnottex @@ -181,8 +171,8 @@ on 64-bit platforms. @cindex smallest Lisp integer @cindex minimum Lisp integer @defvar most-negative-fixnum -The value of this variable is the smallest integer that Emacs Lisp can -handle. It is negative. Typical values are +The value of this variable is the smallest small integer that Emacs +Lisp can handle. It is negative. Typical values are @ifnottex @minus{}2**29 @end ifnottex @@ -315,6 +305,20 @@ use otherwise), but the @code{zerop} predicate requires a number as its argument. See also @code{integer-or-marker-p} and @code{number-or-marker-p}, in @ref{Predicates on Markers}. +@defun bignump object +This predicate tests whether its argument is a large integer, and +returns @code{t} if so, @code{nil} otherwise. Large integers cannot +be compared with @code{eq}, only with @code{=} or @code{eql}. Also, +large integers are only available if Emacs was compiled with the GMP +library. +@end defun + +@defun fixnump object +This predicate tests whether its argument is a small integer, and +returns @code{t} if so, @code{nil} otherwise. Small integers can be +compared with @code{eq}. +@end defun + @defun floatp object This predicate tests whether its argument is floating point and returns @code{t} if so, @code{nil} otherwise. @@ -355,13 +359,13 @@ if so, @code{nil} otherwise. The argument must be a number. To test numbers for numerical equality, you should normally use @code{=}, not @code{eq}. There can be many distinct floating-point -objects with the same numeric value. If you use @code{eq} to -compare them, then you test whether two values are the same -@emph{object}. By contrast, @code{=} compares only the numeric values -of the objects. +and large integer objects with the same numeric value. If you use +@code{eq} to compare them, then you test whether two values are the +same @emph{object}. By contrast, @code{=} compares only the numeric +values of the objects. - In Emacs Lisp, each integer is a unique Lisp object. -Therefore, @code{eq} is equivalent to @code{=} where integers are + In Emacs Lisp, each small integer is a unique Lisp object. +Therefore, @code{eq} is equivalent to @code{=} where small integers are concerned. It is sometimes convenient to use @code{eq} for comparing an unknown value with an integer, because @code{eq} does not report an error if the unknown value is not a number---it accepts arguments of @@ -389,15 +393,6 @@ Here's a function to do this: fuzz-factor))) @end example -@cindex CL note---integers vrs @code{eq} -@quotation -@b{Common Lisp note:} Comparing numbers in Common Lisp always requires -@code{=} because Common Lisp implements multi-word integers, and two -distinct integer objects can have the same numeric value. Emacs Lisp -can have just one integer object for any given value because it has a -limited range of integers. -@end quotation - @defun = number-or-marker &rest number-or-markers This function tests whether all its arguments are numerically equal, and returns @code{t} if so, @code{nil} otherwise. @@ -407,7 +402,8 @@ and returns @code{t} if so, @code{nil} otherwise. This function acts like @code{eq} except when both arguments are numbers. It compares numbers by type and numeric value, so that @code{(eql 1.0 1)} returns @code{nil}, but @code{(eql 1.0 1.0)} and -@code{(eql 1 1)} both return @code{t}. +@code{(eql 1 1)} both return @code{t}. This can be used to compare +large integers as well as small ones. @end defun @defun /= number-or-marker1 number-or-marker2 @@ -567,10 +563,6 @@ Except for @code{%}, each of these functions accepts both integer and floating-point arguments, and returns a floating-point number if any argument is floating point. - Emacs Lisp arithmetic functions do not check for integer overflow. -Thus @code{(1+ 536870911)} may evaluate to -@minus{}536870912, depending on your hardware. - @defun 1+ number-or-marker This function returns @var{number-or-marker} plus 1. For example, @@ -897,36 +889,6 @@ On the other hand, shifting one place to the right looks like this: As the example illustrates, shifting one place to the right divides the value of a positive integer by two, rounding downward. -The function @code{lsh}, like all Emacs Lisp arithmetic functions, does -not check for overflow, so shifting left can discard significant bits -and change the sign of the number. For example, left shifting -536,870,911 produces @minus{}2 in the 30-bit implementation: - -@example -(lsh 536870911 1) ; @r{left shift} - @result{} -2 -@end example - -In binary, the argument looks like this: - -@example -@group -;; @r{Decimal 536,870,911} -0111...111111 (30 bits total) -@end group -@end example - -@noindent -which becomes the following when left shifted: - -@example -@group -;; @r{Decimal @minus{}2} -1111...111110 (30 bits total) -@end group -@end example -@end defun - @defun ash integer1 count @cindex arithmetic shift @code{ash} (@dfn{arithmetic shift}) shifts the bits in @var{integer1} @@ -951,19 +913,6 @@ looks like this: @end group @end example -In contrast, shifting the pattern of bits one place to the right with -@code{lsh} looks like this: - -@example -@group -(lsh -6 -1) @result{} 536870909 -;; @r{Decimal @minus{}6 becomes decimal 536,870,909.} -1111...111010 (30 bits total) - @result{} -0111...111101 (30 bits total) -@end group -@end example - Here are other examples: @c !!! Check if lined up in smallbook format! XDVI shows problem diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index b94de80b65..8c92de123c 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -166,7 +166,10 @@ latter are unique to Emacs Lisp. @node Integer Type @subsection Integer Type - The range of values for an integer depends on the machine. The + Under the hood, there are two kinds of integers---small integers, +called @dfn{fixnums}, and large integers, called @dfn{bignums}. + + The range of values for a fixnum depends on the machine. The minimum range is @minus{}536,870,912 to 536,870,911 (30 bits; i.e., @ifnottex @minus{}2**29 @@ -182,8 +185,14 @@ to @math{2^{29}-1}) @end tex but many machines provide a wider range. -Emacs Lisp arithmetic functions do not check for integer overflow. Thus -@code{(1+ 536870911)} is @minus{}536,870,912 if Emacs integers are 30 bits. + + Bignums can have arbitrary precision. Operations that overflow a +fixnum will return a bignum instead. + + Fixnums can be compared with @code{eq}, but bignums require +@code{eql} or @code{=}. The @code{fixnump} predicate can be used to +detect such small integers, and @code{bignump} can be used to detect +large integers. The read syntax for integers is a sequence of (base ten) digits with an optional sign at the beginning and an optional period at the end. The @@ -200,11 +209,6 @@ leading @samp{+} or a final @samp{.}. @end example @noindent -As a special exception, if a sequence of digits specifies an integer -too large or too small to be a valid integer object, the Lisp reader -reads it as a floating-point number (@pxref{Floating-Point Type}). -For instance, if Emacs integers are 30 bits, @code{536870912} is read -as the floating-point number @code{536870912.0}. @xref{Numbers}, for more information. @@ -1895,6 +1899,9 @@ with references to further information. @item arrayp @xref{Array Functions, arrayp}. +@item bignump +@xref{Predicates on Numbers, floatp}. + @item bool-vector-p @xref{Bool-Vectors, bool-vector-p}. @@ -1928,6 +1935,9 @@ with references to further information. @item custom-variable-p @xref{Variable Definitions, custom-variable-p}. +@item fixnump +@xref{Predicates on Numbers, floatp}. + @item floatp @xref{Predicates on Numbers, floatp}. diff --git a/etc/NEWS b/etc/NEWS index 1a1e0d8b70..2be4fe983a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -24,6 +24,9 @@ When you add a new item, use the appropriate mark if you are sure it applies, * Installation Changes in Emacs 27.1 +** configure now checks for the GMP library. If not found, the +included "mini-gmp" library is used instead. + ** The new configure option '--with-json' adds support for JSON using the Jansson library. It is on by default; use 'configure --with-json=no' to build without Jansson support. The new JSON @@ -644,15 +647,6 @@ as new-style, bind the new variable 'force-new-style-backquotes' to t. integer, Emacs now signals an error if the number is too large for the implementation to format (Bug#30408). -+++ -** The Lisp reader now signals an overflow for plain decimal integers -that do not end in '.' and are outside Emacs range. Formerly the Lisp -reader silently converted them to floating-point numbers, and signaled -overflow only for integers with a radix that are outside machine range. -To get the old behavior, set the new, experimental variable -read-integer-overflow-as-float to t and please email -30408@debbugs.gnu.org if you need that. (Bug#30408). - --- ** Some functions and variables obsolete since Emacs 22 have been removed: archive-mouse-extract, assoc-ignore-case, assoc-ignore-representation, @@ -708,6 +702,11 @@ manual for more details. Given a proper list as argument, this predicate returns its length; otherwise, it returns nil. ++++ +** Emacs Lisp integers can be of arbitrary precision. The new +predicates 'bignump' and 'fixnump' can be used to distinguish between +the types of integers. + ** define-minor-mode automatically documents the meaning of ARG +++ commit e2a78b0d6d844f29acaaddd775c7b1cd6dec7af8 Author: Tom Tromey Date: Sun Jul 8 09:36:37 2018 -0600 Bignum fixes for byte-compiler and bytecode interpreter * lisp/emacs-lisp/byte-opt.el: Mark bignump and fixnump as side-effect-and-error-free-fns. * src/bytecode.c (exec_byte_code): Handle bignums. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 5c0b5e340b..1920503b8c 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1195,14 +1195,14 @@ window-width zerop)) (side-effect-and-error-free-fns '(arrayp atom - bobp bolp bool-vector-p + bignump bobp bolp bool-vector-p buffer-end buffer-list buffer-size buffer-string bufferp car-safe case-table-p cdr-safe char-or-string-p characterp charsetp commandp cons consp current-buffer current-global-map current-indentation current-local-map current-minor-mode-maps current-time eobp eolp eq equal eventp - floatp following-char framep + fixnump floatp following-char framep get-largest-window get-lru-window hash-table-p identity ignore integerp integer-or-marker-p interactive-p diff --git a/src/bytecode.c b/src/bytecode.c index 282754d22b..f87983a59c 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -972,11 +972,15 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; CASE (Bsub1): - TOP = FIXNUMP (TOP) ? make_fixnum (XINT (TOP) - 1) : Fsub1 (TOP); + TOP = (FIXNUMP (TOP) && XINT (TOP) != MOST_NEGATIVE_FIXNUM + ? make_fixnum (XINT (TOP) - 1) + : Fsub1 (TOP)); NEXT; CASE (Badd1): - TOP = FIXNUMP (TOP) ? make_fixnum (XINT (TOP) + 1) : Fadd1 (TOP); + TOP = (FIXNUMP (TOP) && XINT (TOP) != MOST_POSITIVE_FIXNUM + ? make_fixnum (XINT (TOP) + 1) + : Fadd1 (TOP)); NEXT; CASE (Beqlsign): @@ -1027,7 +1031,9 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; CASE (Bnegate): - TOP = FIXNUMP (TOP) ? make_fixnum (- XINT (TOP)) : Fminus (1, &TOP); + TOP = (FIXNUMP (TOP) && XINT (TOP) != MOST_NEGATIVE_FIXNUM + ? make_fixnum (- XINT (TOP)) + : Fminus (1, &TOP)); NEXT; CASE (Bplus): @@ -1324,11 +1330,11 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; CASE (Bnumberp): - TOP = FIXED_OR_FLOATP (TOP) ? Qt : Qnil; + TOP = NUMBERP (TOP) ? Qt : Qnil; NEXT; CASE (Bintegerp): - TOP = FIXNUMP (TOP) ? Qt : Qnil; + TOP = INTEGERP (TOP) ? Qt : Qnil; NEXT; #if BYTE_CODE_SAFE commit 45eb3b3513619d97d046a8efbe0d16fafc75a734 Author: Tom Tromey Date: Sun Jul 8 09:31:13 2018 -0600 Use fixnump rather than integerp in some spots * src/buffer.c (syms_of_buffer): Use Qfixnump, not Qintegerp. * src/data.c (syms_of_data): Define fixnump symbol. * src/lisp.h (lisp_h_CHECK_FIXNUM): Use Qfixnump. (struct Lisp_Buffer_Objfwd): Update comment. diff --git a/src/buffer.c b/src/buffer.c index 2924885563..2a165c5f54 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -5584,17 +5584,17 @@ Use the command `abbrev-mode' to change this variable. */); doc: /* Non-nil if searches and matches should ignore case. */); DEFVAR_PER_BUFFER ("fill-column", &BVAR (current_buffer, fill_column), - Qintegerp, + Qfixnump, doc: /* Column beyond which automatic line-wrapping should happen. Interactively, you can set the buffer local value using \\[set-fill-column]. */); DEFVAR_PER_BUFFER ("left-margin", &BVAR (current_buffer, left_margin), - Qintegerp, + Qfixnump, doc: /* Column for the default `indent-line-function' to indent to. Linefeed indents to this column in Fundamental mode. */); DEFVAR_PER_BUFFER ("tab-width", &BVAR (current_buffer, tab_width), - Qintegerp, + Qfixnump, doc: /* Distance between tab stops (for display of tab characters), in columns. NOTE: This controls the display width of a TAB character, and not the size of an indentation step. @@ -5765,7 +5765,7 @@ If it is nil, that means don't auto-save this buffer. */); Backing up is done before the first time the file is saved. */); DEFVAR_PER_BUFFER ("buffer-saved-size", &BVAR (current_buffer, save_length), - Qintegerp, + Qfixnump, doc: /* Length of current buffer when last read in, saved or auto-saved. 0 initially. -1 means auto-saving turned off until next real save. @@ -5839,7 +5839,7 @@ In addition, a char-table has six extra slots to control the display of: See also the functions `display-table-slot' and `set-display-table-slot'. */); DEFVAR_PER_BUFFER ("left-margin-width", &BVAR (current_buffer, left_margin_cols), - Qintegerp, + Qfixnump, doc: /* Width in columns of left marginal area for display of a buffer. A value of nil means no marginal area. @@ -5847,7 +5847,7 @@ Setting this variable does not take effect until a new buffer is displayed in a window. To make the change take effect, call `set-window-buffer'. */); DEFVAR_PER_BUFFER ("right-margin-width", &BVAR (current_buffer, right_margin_cols), - Qintegerp, + Qfixnump, doc: /* Width in columns of right marginal area for display of a buffer. A value of nil means no marginal area. @@ -5855,7 +5855,7 @@ Setting this variable does not take effect until a new buffer is displayed in a window. To make the change take effect, call `set-window-buffer'. */); DEFVAR_PER_BUFFER ("left-fringe-width", &BVAR (current_buffer, left_fringe_width), - Qintegerp, + Qfixnump, doc: /* Width of this buffer's left fringe (in pixels). A value of 0 means no left fringe is shown in this buffer's window. A value of nil means to use the left fringe width from the window's frame. @@ -5864,7 +5864,7 @@ Setting this variable does not take effect until a new buffer is displayed in a window. To make the change take effect, call `set-window-buffer'. */); DEFVAR_PER_BUFFER ("right-fringe-width", &BVAR (current_buffer, right_fringe_width), - Qintegerp, + Qfixnump, doc: /* Width of this buffer's right fringe (in pixels). A value of 0 means no right fringe is shown in this buffer's window. A value of nil means to use the right fringe width from the window's frame. @@ -5881,12 +5881,12 @@ Setting this variable does not take effect until a new buffer is displayed in a window. To make the change take effect, call `set-window-buffer'. */); DEFVAR_PER_BUFFER ("scroll-bar-width", &BVAR (current_buffer, scroll_bar_width), - Qintegerp, + Qfixnump, doc: /* Width of this buffer's vertical scroll bars in pixels. A value of nil means to use the scroll bar width from the window's frame. */); DEFVAR_PER_BUFFER ("scroll-bar-height", &BVAR (current_buffer, scroll_bar_height), - Qintegerp, + Qfixnump, doc: /* Height of this buffer's horizontal scroll bars in pixels. A value of nil means to use the scroll bar height from the window's frame. */); @@ -6156,7 +6156,7 @@ Setting this variable is very fast, much faster than scanning all the text in the buffer looking for properties to change. */); DEFVAR_PER_BUFFER ("buffer-display-count", - &BVAR (current_buffer, display_count), Qintegerp, + &BVAR (current_buffer, display_count), Qfixnump, doc: /* A number incremented each time this buffer is displayed in a window. The function `set-window-buffer' increments it. */); diff --git a/src/data.c b/src/data.c index 8a2d600b30..862381229d 100644 --- a/src/data.c +++ b/src/data.c @@ -3921,6 +3921,7 @@ syms_of_data (void) DEFSYM (Qlistp, "listp"); DEFSYM (Qconsp, "consp"); DEFSYM (Qsymbolp, "symbolp"); + DEFSYM (Qfixnump, "fixnump"); DEFSYM (Qintegerp, "integerp"); DEFSYM (Qnatnump, "natnump"); DEFSYM (Qwholenump, "wholenump"); diff --git a/src/lisp.h b/src/lisp.h index 846e955d3a..e046429c1b 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -357,7 +357,7 @@ typedef EMACS_INT Lisp_Word; # endif #endif -#define lisp_h_CHECK_FIXNUM(x) CHECK_TYPE (FIXNUMP (x), Qintegerp, x) +#define lisp_h_CHECK_FIXNUM(x) CHECK_TYPE (FIXNUMP (x), Qfixnump, x) #define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) #define lisp_h_CHECK_TYPE(ok, predicate, x) \ ((ok) ? (void) 0 : wrong_type_argument (predicate, x)) @@ -2590,7 +2590,7 @@ struct Lisp_Buffer_Objfwd { enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Buffer_Obj */ int offset; - /* One of Qnil, Qintegerp, Qsymbolp, Qstringp, Qfloatp or Qnumberp. */ + /* One of Qnil, Qfixnump, Qsymbolp, Qstringp, Qfloatp or Qnumberp. */ Lisp_Object predicate; }; commit 27980e36040d0693fe997de6b6b73c09c3ce1cb5 Author: Tom Tromey Date: Sun Jul 8 09:22:17 2018 -0600 Make ash and lsh handle bignums * src/data.c (ash_lsh_impl): Handle bignums. * test/src/data-tests.el (data-tests-ash-lsh): New test. diff --git a/src/data.c b/src/data.c index ac74ff5547..8a2d600b30 100644 --- a/src/data.c +++ b/src/data.c @@ -3298,18 +3298,37 @@ ash_lsh_impl (Lisp_Object value, Lisp_Object count, bool lsh) Lisp_Object val; - CHECK_FIXNUM (value); + CHECK_INTEGER (value); CHECK_FIXNUM (count); - if (XINT (count) >= EMACS_INT_WIDTH) - XSETINT (val, 0); - else if (XINT (count) > 0) - XSETINT (val, XUINT (value) << XINT (count)); - else if (XINT (count) <= -EMACS_INT_WIDTH) - XSETINT (val, lsh ? 0 : XINT (value) < 0 ? -1 : 0); + if (BIGNUMP (value)) + { + mpz_t result; + mpz_init (result); + if (XINT (count) >= 0) + mpz_mul_2exp (result, XBIGNUM (value)->value, XINT (count)); + else + mpz_tdiv_q_2exp (result, XBIGNUM (value)->value, - XINT (count)); + val = make_number (result); + mpz_clear (result); + } else - XSETINT (val, (lsh ? XUINT (value) >> -XINT (count) - : XINT (value) >> -XINT (count))); + { + /* Just do the work as bignums to make the code simpler. */ + mpz_t result; + eassume (FIXNUMP (value)); + if (lsh) + mpz_init_set_ui (result, XUINT (value)); + else + mpz_init_set_si (result, XINT (value)); + if (XINT (count) >= 0) + mpz_mul_2exp (result, result, XINT (count)); + else + mpz_tdiv_q_2exp (result, result, - XINT (count)); + val = make_number (result); + mpz_clear (result); + } + return val; } diff --git a/test/src/data-tests.el b/test/src/data-tests.el index 2423d7a709..07159df48c 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -614,4 +614,10 @@ comparing the subr with a much slower lisp implementation." (data-tests-check-sign (% -1 -3) (% nb1 nb3)) (data-tests-check-sign (mod -1 -3) (mod nb1 nb3)))) +(ert-deftest data-tests-ash-lsh () + (should (= (ash most-negative-fixnum 1) + (* most-negative-fixnum 2))) + (should (= (lsh most-negative-fixnum 1) + (* (abs most-negative-fixnum) 2)))) + ;;; data-tests.el ends here commit cca0e79ea81712786f92a6668c61001e60d24f32 Author: Tom Tromey Date: Sun Jul 8 00:10:54 2018 -0600 Make logb handle bignums * src/floatfns.c (Flogb): Handle bignums. * test/src/floatfns-tests.el (bignum-logb): New test. diff --git a/src/floatfns.c b/src/floatfns.c index 6d7fc1452d..9a5f0a3ad2 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -328,7 +328,7 @@ This is the same as the exponent of a float. */) (Lisp_Object arg) { EMACS_INT value; - CHECK_FIXNUM_OR_FLOAT (arg); + CHECK_NUMBER (arg); if (FLOATP (arg)) { @@ -345,8 +345,11 @@ This is the same as the exponent of a float. */) else value = MOST_POSITIVE_FIXNUM; } + else if (BIGNUMP (arg)) + value = mpz_sizeinbase (XBIGNUM (arg)->value, 2) - 1; else { + eassert (FIXNUMP (arg)); EMACS_INT i = eabs (XINT (arg)); value = (i == 0 ? MOST_NEGATIVE_FIXNUM diff --git a/test/src/floatfns-tests.el b/test/src/floatfns-tests.el index 0911ff4651..7714c05d60 100644 --- a/test/src/floatfns-tests.el +++ b/test/src/floatfns-tests.el @@ -42,4 +42,8 @@ (should (= most-positive-fixnum (- (abs most-negative-fixnum) 1)))) +(ert-deftest bignum-logb () + (should (= (+ (logb most-positive-fixnum) 1) + (logb (+ most-positive-fixnum 1))))) + (provide 'floatfns-tests) commit 3dea8f8f53f81a1d15a55c9e3c87a7eade7ca273 Author: Tom Tromey Date: Sat Jul 7 23:42:10 2018 -0600 Make % and mod handle bignums * src/data.c (Frem, Fmod): Handle bignums. * src/lisp.h (CHECK_INTEGER_COERCE_MARKER): New macro. * test/src/data-tests.el (data-tests-check-sign) (data-tests-%-mod): New tests. diff --git a/src/data.c b/src/data.c index 7ded8366e3..ac74ff5547 100644 --- a/src/data.c +++ b/src/data.c @@ -3073,13 +3073,47 @@ Both must be integers or markers. */) { Lisp_Object val; - CHECK_FIXNUM_COERCE_MARKER (x); - CHECK_FIXNUM_COERCE_MARKER (y); + CHECK_INTEGER_COERCE_MARKER (x); + CHECK_INTEGER_COERCE_MARKER (y); - if (XINT (y) == 0) + /* Note that a bignum can never be 0, so we don't need to check that + case. */ + if (FIXNUMP (y) && XINT (y) == 0) xsignal0 (Qarith_error); - XSETINT (val, XINT (x) % XINT (y)); + if (FIXNUMP (x) && FIXNUMP (y)) + XSETINT (val, XINT (x) % XINT (y)); + else + { + mpz_t xm, ym, *xmp, *ymp; + mpz_t result; + + if (BIGNUMP (x)) + xmp = &XBIGNUM (x)->value; + else + { + mpz_init_set_si (xm, XINT (x)); + xmp = &xm; + } + + if (BIGNUMP (y)) + ymp = &XBIGNUM (y)->value; + else + { + mpz_init_set_si (ym, XINT (y)); + ymp = &ym; + } + + mpz_init (result); + mpz_tdiv_r (result, *xmp, *ymp); + val = make_number (result); + mpz_clear (result); + + if (xmp == &xm) + mpz_clear (xm); + if (ymp == &ym) + mpz_clear (ym); + } return val; } @@ -3092,25 +3126,73 @@ Both X and Y must be numbers or markers. */) Lisp_Object val; EMACS_INT i1, i2; - CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (x); - CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (y); + CHECK_NUMBER_COERCE_MARKER (x); + CHECK_NUMBER_COERCE_MARKER (y); + + /* Note that a bignum can never be 0, so we don't need to check that + case. */ + if (FIXNUMP (y) && XINT (y) == 0) + xsignal0 (Qarith_error); if (FLOATP (x) || FLOATP (y)) return fmod_float (x, y); - i1 = XINT (x); - i2 = XINT (y); + if (FIXNUMP (x) && FIXNUMP (y)) + { + i1 = XINT (x); + i2 = XINT (y); - if (i2 == 0) - xsignal0 (Qarith_error); + if (i2 == 0) + xsignal0 (Qarith_error); - i1 %= i2; + i1 %= i2; - /* If the "remainder" comes out with the wrong sign, fix it. */ - if (i2 < 0 ? i1 > 0 : i1 < 0) - i1 += i2; + /* If the "remainder" comes out with the wrong sign, fix it. */ + if (i2 < 0 ? i1 > 0 : i1 < 0) + i1 += i2; + + XSETINT (val, i1); + } + else + { + mpz_t xm, ym, *xmp, *ymp; + mpz_t result; + int cmpr, cmpy; + + if (BIGNUMP (x)) + xmp = &XBIGNUM (x)->value; + else + { + mpz_init_set_si (xm, XINT (x)); + xmp = &xm; + } + + if (BIGNUMP (y)) + ymp = &XBIGNUM (y)->value; + else + { + mpz_init_set_si (ym, XINT (y)); + ymp = &ym; + } + + mpz_init (result); + mpz_mod (result, *xmp, *ymp); + + /* Fix the sign if needed. */ + cmpr = mpz_cmp_si (result, 0); + cmpy = mpz_cmp_si (*ymp, 0); + if (cmpy < 0 ? cmpr > 0 : cmpr < 0) + mpz_add (result, result, *ymp); + + val = make_number (result); + mpz_clear (result); + + if (xmp == &xm) + mpz_clear (xm); + if (ymp == &ym) + mpz_clear (ym); + } - XSETINT (val, i1); return val; } diff --git a/src/lisp.h b/src/lisp.h index 63b057073d..846e955d3a 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2958,6 +2958,14 @@ CHECK_INTEGER (Lisp_Object x) CHECK_TYPE (NUMBERP (x), Qnumber_or_marker_p, x); \ } while (false) +#define CHECK_INTEGER_COERCE_MARKER(x) \ + do { \ + if (MARKERP (x)) \ + XSETFASTINT (x, marker_position (x)); \ + else \ + CHECK_TYPE (INTEGERP (x), Qnumber_or_marker_p, x); \ + } while (false) + /* Since we can't assign directly to the CAR or CDR fields of a cons cell, use these when checking that those fields contain numbers. */ INLINE void diff --git a/test/src/data-tests.el b/test/src/data-tests.el index 4565cfb387..2423d7a709 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -597,4 +597,21 @@ comparing the subr with a much slower lisp implementation." (should (= (min a b c) a)) (should (= (max a b c) b)))) +(defun data-tests-check-sign (x y) + (should (eq (cl-signum x) (cl-signum y)))) + +(ert-deftest data-tests-%-mod () + (let* ((b1 (+ most-positive-fixnum 1)) + (nb1 (- b1)) + (b3 (+ most-positive-fixnum 3)) + (nb3 (- b3))) + (data-tests-check-sign (% 1 3) (% b1 b3)) + (data-tests-check-sign (mod 1 3) (mod b1 b3)) + (data-tests-check-sign (% 1 -3) (% b1 nb3)) + (data-tests-check-sign (mod 1 -3) (mod b1 nb3)) + (data-tests-check-sign (% -1 3) (% nb1 b3)) + (data-tests-check-sign (mod -1 3) (mod nb1 b3)) + (data-tests-check-sign (% -1 -3) (% nb1 nb3)) + (data-tests-check-sign (mod -1 -3) (mod nb1 nb3)))) + ;;; data-tests.el ends here commit d0fac17abdf6883bbf82b1752988db38d05282e6 Author: Tom Tromey Date: Sat Jul 7 22:51:58 2018 -0600 Let C modules access bignum values * src/emacs-module.c (module_extract_integer, module_make_integer): Handle bignums. diff --git a/src/emacs-module.c b/src/emacs-module.c index e781c38f46..7709eeca94 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -518,17 +518,31 @@ module_extract_integer (emacs_env *env, emacs_value n) { MODULE_FUNCTION_BEGIN (0); Lisp_Object l = value_to_lisp (n); - CHECK_FIXNUM (l); + CHECK_INTEGER (l); + if (BIGNUMP (l)) + { + if (!mpz_fits_slong_p (XBIGNUM (l)->value)) + xsignal1 (Qoverflow_error, l); + return mpz_get_si (XBIGNUM (l)->value); + } return XINT (l); } static emacs_value module_make_integer (emacs_env *env, intmax_t n) { + Lisp_Object obj; MODULE_FUNCTION_BEGIN (module_nil); if (FIXNUM_OVERFLOW_P (n)) - xsignal0 (Qoverflow_error); - return lisp_to_value (env, make_fixnum (n)); + { + mpz_t val; + mpz_init_set_si (val, n); + obj = make_number (val); + mpz_clear (val); + } + else + obj = make_fixnum (n); + return lisp_to_value (env, obj); } static double commit 8fb995b9e360270b6a4d7b7732a127a6234eba23 Author: Tom Tromey Date: Sat Jul 7 22:19:21 2018 -0600 Make min and max handle bignums * src/data.c (minmax_driver): Handle bignums. * test/src/data-tests.el (data-tests-minmax): New test. diff --git a/src/data.c b/src/data.c index 2e366b5313..7ded8366e3 100644 --- a/src/data.c +++ b/src/data.c @@ -3119,11 +3119,11 @@ minmax_driver (ptrdiff_t nargs, Lisp_Object *args, enum Arith_Comparison comparison) { Lisp_Object accum = args[0]; - CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (accum); + CHECK_NUMBER_COERCE_MARKER (accum); for (ptrdiff_t argnum = 1; argnum < nargs; argnum++) { Lisp_Object val = args[argnum]; - CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (val); + CHECK_NUMBER_COERCE_MARKER (val); if (!NILP (arithcompare (val, accum, comparison))) accum = val; else if (FLOATP (val) && isnan (XFLOAT_DATA (val))) diff --git a/test/src/data-tests.el b/test/src/data-tests.el index 561b7bd9ca..4565cfb387 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -590,4 +590,11 @@ comparing the subr with a much slower lisp implementation." (ert-deftest data-tests-logcount () (should (= (logcount (read "#xffffffffffffffffffffffffffffffff")) 128))) +(ert-deftest data-tests-minmax () + (let ((a (- most-negative-fixnum 1)) + (b (+ most-positive-fixnum 1)) + (c 0)) + (should (= (min a b c) a)) + (should (= (max a b c) b)))) + ;;; data-tests.el ends here commit a770fb44288c75fa2b0471ceaf00bf741376e40f Author: Tom Tromey Date: Sat Jul 7 14:22:44 2018 -0600 Make logcount handle bignums * src/data.c (Flogcount): Handle bignums. * test/src/data-tests.el (data-tests-logcount): New test. diff --git a/src/data.c b/src/data.c index c9504694e3..2e366b5313 100644 --- a/src/data.c +++ b/src/data.c @@ -3184,7 +3184,22 @@ of VALUE. If VALUE is negative, return the number of zero bits in the representation. */) (Lisp_Object value) { - CHECK_FIXNUM (value); + CHECK_INTEGER (value); + + if (BIGNUMP (value)) + { + if (mpz_cmp_si (XBIGNUM (value)->value, 0) >= 0) + return make_fixnum (mpz_popcount (XBIGNUM (value)->value)); + mpz_t tem; + mpz_init (tem); + mpz_neg (tem, XBIGNUM (value)->value); + mpz_sub_ui (tem, tem, 1); + Lisp_Object result = make_fixnum (mpz_popcount (tem)); + mpz_clear (tem); + return result; + } + + eassume (FIXNUMP (value)); EMACS_INT v = XINT (value) < 0 ? -1 - XINT (value) : XINT (value); return make_fixnum (EMACS_UINT_WIDTH <= UINT_WIDTH ? count_one_bits (v) diff --git a/test/src/data-tests.el b/test/src/data-tests.el index dd6ce196f9..561b7bd9ca 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -587,4 +587,7 @@ comparing the subr with a much slower lisp implementation." (should (< (1- most-negative-fixnum) most-negative-fixnum)) (should (fixnump (1- (1+ most-positive-fixnum))))) +(ert-deftest data-tests-logcount () + (should (= (logcount (read "#xffffffffffffffffffffffffffffffff")) 128))) + ;;; data-tests.el ends here commit c7e393bc4130c871a92fef7e9ac0c7c1832aa614 Author: Tom Tromey Date: Fri Jul 6 23:44:30 2018 -0600 Make lognot handle bignums * src/data.c (Flognot): Handle bignums. diff --git a/src/data.c b/src/data.c index d7175683c8..c9504694e3 100644 --- a/src/data.c +++ b/src/data.c @@ -3306,8 +3306,20 @@ DEFUN ("lognot", Flognot, Slognot, 1, 1, 0, doc: /* Return the bitwise complement of NUMBER. NUMBER must be an integer. */) (register Lisp_Object number) { - CHECK_FIXNUM (number); - XSETINT (number, ~XINT (number)); + CHECK_INTEGER (number); + if (BIGNUMP (number)) + { + mpz_t value; + mpz_init (value); + mpz_com (value, XBIGNUM (number)->value); + number = make_number (value); + mpz_clear (value); + } + else + { + eassume (FIXNUMP (number)); + XSETINT (number, ~XINT (number)); + } return number; } commit 0d868917efb46400cf7dd57a1cdbba7404f322a7 Author: Tom Tromey Date: Fri Jul 6 23:26:13 2018 -0600 Make 1+ and 1- handle bignums * src/data.c (Fadd1, Fsub1): Handle bignums. * test/src/data-tests.el (data-tests-1+, data-tests-1-): New tests. diff --git a/src/data.c b/src/data.c index 18b572de97..d7175683c8 100644 --- a/src/data.c +++ b/src/data.c @@ -3239,12 +3239,32 @@ DEFUN ("1+", Fadd1, Sadd1, 1, 1, 0, Markers are converted to integers. */) (register Lisp_Object number) { - CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (number); + CHECK_NUMBER_COERCE_MARKER (number); if (FLOATP (number)) return (make_float (1.0 + XFLOAT_DATA (number))); - XSETINT (number, XINT (number) + 1); + if (BIGNUMP (number)) + { + mpz_t num; + mpz_init (num); + mpz_add_ui (num, XBIGNUM (number)->value, 1); + number = make_number (num); + mpz_clear (num); + } + else + { + eassume (FIXNUMP (number)); + if (XINT (number) < MOST_POSITIVE_FIXNUM) + XSETINT (number, XINT (number) + 1); + else + { + mpz_t num; + mpz_init_set_si (num, XINT (number) + 1); + number = make_number (num); + mpz_clear (num); + } + } return number; } @@ -3253,12 +3273,32 @@ DEFUN ("1-", Fsub1, Ssub1, 1, 1, 0, Markers are converted to integers. */) (register Lisp_Object number) { - CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (number); + CHECK_NUMBER_COERCE_MARKER (number); if (FLOATP (number)) return (make_float (-1.0 + XFLOAT_DATA (number))); - XSETINT (number, XINT (number) - 1); + if (BIGNUMP (number)) + { + mpz_t num; + mpz_init (num); + mpz_sub_ui (num, XBIGNUM (number)->value, 1); + number = make_number (num); + mpz_clear (num); + } + else + { + eassume (FIXNUMP (number)); + if (XINT (number) > MOST_POSITIVE_FIXNUM) + XSETINT (number, XINT (number) - 1); + else + { + mpz_t num; + mpz_init_set_si (num, XINT (number) - 1); + number = make_number (num); + mpz_clear (num); + } + } return number; } diff --git a/test/src/data-tests.el b/test/src/data-tests.el index 1143028a12..dd6ce196f9 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -579,4 +579,12 @@ comparing the subr with a much slower lisp implementation." (v (read s))) (should (equal (number-to-string v) s)))) +(ert-deftest data-tests-1+ () + (should (> (1+ most-positive-fixnum) most-positive-fixnum)) + (should (fixnump (1+ (1- most-negative-fixnum))))) + +(ert-deftest data-tests-1- () + (should (< (1- most-negative-fixnum) most-negative-fixnum)) + (should (fixnump (1- (1+ most-positive-fixnum))))) + ;;; data-tests.el ends here commit 025adce2cf43f4ce9f3c543c1b8973541e1414d2 Author: Tom Tromey Date: Thu Jul 5 13:19:32 2018 -0600 Make abs handle bignums * src/floatfns.c (Fabs): Handle bignums. * test/src/floatfns-tests.el (bignum-abs): New test. diff --git a/src/floatfns.c b/src/floatfns.c index bd3f2dec80..6d7fc1452d 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -275,9 +275,24 @@ DEFUN ("abs", Fabs, Sabs, 1, 1, 0, doc: /* Return the absolute value of ARG. */) (register Lisp_Object arg) { - CHECK_FIXNUM_OR_FLOAT (arg); + CHECK_NUMBER (arg); - if (FLOATP (arg)) + if (BIGNUMP (arg)) + { + mpz_t val; + mpz_init (val); + mpz_abs (val, XBIGNUM (arg)->value); + arg = make_number (val); + mpz_clear (val); + } + else if (FIXNUMP (arg) && XINT (arg) == MOST_NEGATIVE_FIXNUM) + { + mpz_t val; + mpz_init_set_si (val, - MOST_NEGATIVE_FIXNUM); + arg = make_number (val); + mpz_clear (val); + } + else if (FLOATP (arg)) arg = make_float (fabs (XFLOAT_DATA (arg))); else if (XINT (arg) < 0) XSETINT (arg, - XINT (arg)); diff --git a/test/src/floatfns-tests.el b/test/src/floatfns-tests.el index c87445b6bd..0911ff4651 100644 --- a/test/src/floatfns-tests.el +++ b/test/src/floatfns-tests.el @@ -38,4 +38,8 @@ (should (eql (float (+ most-positive-fixnum 1)) (+ (float most-positive-fixnum) 1)))) +(ert-deftest bignum-abs () + (should (= most-positive-fixnum + (- (abs most-negative-fixnum) 1)))) + (provide 'floatfns-tests) commit 872faabbd8cb0f5518777b2d4fe7de187f684a92 Author: Tom Tromey Date: Thu Jul 5 13:17:36 2018 -0600 Allow conversion of bignums to floats * src/floatfns.c (extract_float, Ffloat): Handle bignums. * src/lisp.h (XFLOATINT): Handle bignums. * test/src/floatfns-tests.el (bignum-to-float): New test. diff --git a/src/floatfns.c b/src/floatfns.c index 766044ba35..bd3f2dec80 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -67,7 +67,7 @@ CHECK_FLOAT (Lisp_Object x) double extract_float (Lisp_Object num) { - CHECK_FIXNUM_OR_FLOAT (num); + CHECK_NUMBER (num); return XFLOATINT (num); } @@ -289,8 +289,10 @@ DEFUN ("float", Ffloat, Sfloat, 1, 1, 0, doc: /* Return the floating point number equal to ARG. */) (register Lisp_Object arg) { - CHECK_FIXNUM_OR_FLOAT (arg); + CHECK_NUMBER (arg); + if (BIGNUMP (arg)) + return make_float (mpz_get_d (XBIGNUM (arg)->value)); if (FIXNUMP (arg)) return make_float ((double) XINT (arg)); else /* give 'em the same float back */ diff --git a/src/lisp.h b/src/lisp.h index be67932049..63b057073d 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2919,6 +2919,8 @@ CHECK_FIXNAT (Lisp_Object x) INLINE double XFLOATINT (Lisp_Object n) { + if (BIGNUMP (n)) + return mpz_get_d (XBIGNUM (n)->value); return FLOATP (n) ? XFLOAT_DATA (n) : XINT (n); } diff --git a/test/src/floatfns-tests.el b/test/src/floatfns-tests.el index cb173eea76..c87445b6bd 100644 --- a/test/src/floatfns-tests.el +++ b/test/src/floatfns-tests.el @@ -34,4 +34,8 @@ (should-error (ftruncate 0) :type 'wrong-type-argument) (should-error (fround 0) :type 'wrong-type-argument)) +(ert-deftest bignum-to-float () + (should (eql (float (+ most-positive-fixnum 1)) + (+ (float most-positive-fixnum) 1)))) + (provide 'floatfns-tests) commit d14808cd271abf6a723bf495a6a01c14d18b5893 Author: Tom Tromey Date: Thu Jul 5 14:46:26 2018 -0600 Make format handle bignums * src/editfns.c (styled_format): Handle bignums. * test/src/editfns-tests.el (read-large-integer): Update. (format-bignum): New test. diff --git a/src/editfns.c b/src/editfns.c index 6b54b41cbd..09c17cbd92 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -4489,6 +4489,25 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) conversion = 's'; zero_flag = false; } + else if ((conversion == 'd' || conversion == 'i' + || conversion == 'o' || conversion == 'x' + || conversion == 'X') + && BIGNUMP (arg)) + { + int base = 10; + + if (conversion == 'o') + base = 8; + else if (conversion == 'x') + base = 16; + else if (conversion == 'X') + base = -16; + + char *str = mpz_get_str (NULL, base, XBIGNUM (arg)->value); + arg = make_unibyte_string (str, strlen (str)); + xfree (str); + conversion = 's'; + } if (SYMBOLP (arg)) { @@ -4600,7 +4619,8 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) || conversion == 'X')) error ("Invalid format operation %%%c", STRING_CHAR ((unsigned char *) format - 1)); - else if (! (FIXNUMP (arg) || (FLOATP (arg) && conversion != 'c'))) + else if (! (FIXNUMP (arg) || ((BIGNUMP (arg) || FLOATP (arg)) + && conversion != 'c'))) error ("Format specifier doesn't match argument type"); else { diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index c828000bb4..501e0d8781 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -159,18 +159,17 @@ (should-error (format "%x" 18446744073709551616.0) :type 'overflow-error)) (ert-deftest read-large-integer () - (should-error (read (format "%d0" most-negative-fixnum)) - :type 'overflow-error) - (should-error (read (format "%+d" (* -8.0 most-negative-fixnum))) - :type 'overflow-error) - (should-error (read (substring (format "%d" most-negative-fixnum) 1)) - :type 'overflow-error) - (should-error (read (format "#x%x" most-negative-fixnum)) - :type 'overflow-error) - (should-error (read (format "#o%o" most-negative-fixnum)) - :type 'overflow-error) - (should-error (read (format "#32rG%x" most-positive-fixnum)) - :type 'overflow-error)) + (should (eq (type-of (read (format "%d0" most-negative-fixnum))) 'integer)) + (should (eq (type-of (read (format "%+d" (* -8.0 most-negative-fixnum)))) + 'integer)) + (should (eq (type-of (read (substring (format "%d" most-negative-fixnum) 1))) + 'integer)) + (should (eq (type-of (read (format "#x%x" most-negative-fixnum))) + 'integer)) + (should (eq (type-of (read (format "#o%o" most-negative-fixnum))) + 'integer)) + (should (eq (type-of (read (format "#32rG%x" most-positive-fixnum))) + 'integer))) (ert-deftest format-%o-invalid-float () (should-error (format "%o" -1e-37) @@ -358,4 +357,14 @@ (should (eq (type-of (car (nth 4 buffer-undo-list))) 'marker)) (garbage-collect))) +(ert-deftest format-bignum () + (let* ((s1 "FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF") + (v1 (read (concat "#x" s1))) + (s2 "99999999999999999999999999999999") + (v2 (read s2))) + (should (> v1 most-positive-fixnum)) + (should (equal (format "%X" v1) s1)) + (should (> v2 most-positive-fixnum)) + (should (equal (format "%d" v2) s2)))) + ;;; editfns-tests.el ends here commit 23eab9a6a67604b5ebcdc99efc42fbfd3345c0b0 Author: Tom Tromey Date: Thu Jul 5 11:45:21 2018 -0600 Make number-to-string work for bignums * src/data.c (Fnumber_to_string): Handle bignum. * test/src/data-tests.el (data-tests-number-to-string): New test. diff --git a/src/data.c b/src/data.c index b49daabe85..18b572de97 100644 --- a/src/data.c +++ b/src/data.c @@ -2756,6 +2756,14 @@ NUMBER may be an integer or a floating point number. */) char buffer[max (FLOAT_TO_STRING_BUFSIZE, INT_BUFSIZE_BOUND (EMACS_INT))]; int len; + if (BIGNUMP (number)) + { + ptrdiff_t count = SPECPDL_INDEX (); + char *str = mpz_get_str (NULL, 10, XBIGNUM (number)->value); + record_unwind_protect_ptr (xfree, str); + return unbind_to (count, make_unibyte_string (str, strlen (str))); + } + CHECK_FIXNUM_OR_FLOAT (number); if (FLOATP (number)) diff --git a/test/src/data-tests.el b/test/src/data-tests.el index 543bb90f73..1143028a12 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -574,4 +574,9 @@ comparing the subr with a much slower lisp implementation." (should-not (fixnump (+ most-positive-fixnum 1))) (should (bignump (+ most-positive-fixnum 1)))) +(ert-deftest data-tests-number-to-string () + (let* ((s "99999999999999999999999999999") + (v (read s))) + (should (equal (number-to-string v) s)))) + ;;; data-tests.el ends here commit 6d4bf2cedab365411f0aedb373b63291086658e9 Author: Tom Tromey Date: Sat Jul 7 15:32:34 2018 -0600 Add some bignum tests * test/src/data-tests.el (data-tests-bignum, data-tests-+) (data-tests-/, data-tests-number-predicates): New tests. * test/src/fns-tests (test-bignum-eql): New test. * test/src/lread-tests (lread-long-hex-integer): Expect bignum. * test/src/print-tests (print-bignum): New test. diff --git a/test/src/data-tests.el b/test/src/data-tests.el index 3cd537859f..543bb90f73 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -515,4 +515,63 @@ comparing the subr with a much slower lisp implementation." (bound-and-true-p data-tests-foo2) (bound-and-true-p data-tests-foo3))))))) +(ert-deftest data-tests-bignum () + (should (bignump (+ most-positive-fixnum 1))) + (let ((f0 (+ (float most-positive-fixnum) 1)) + (f-1 (- (float most-negative-fixnum) 1)) + (b0 (+ most-positive-fixnum 1)) + (b-1 (- most-negative-fixnum 1))) + (should (> b0 -1)) + (should (> b0 f-1)) + (should (> b0 b-1)) + (should (>= b0 -1)) + (should (>= b0 f-1)) + (should (>= b0 b-1)) + (should (>= b-1 b-1)) + + (should (< -1 b0)) + (should (< f-1 b0)) + (should (< b-1 b0)) + (should (<= -1 b0)) + (should (<= f-1 b0)) + (should (<= b-1 b0)) + (should (<= b-1 b-1)) + + (should (= b0 f0)) + (should (= b0 b0)) + + (should (/= b0 f-1)) + (should (/= b0 b-1)))) + +(ert-deftest data-tests-+ () + (should-not (fixnump (+ most-positive-fixnum most-positive-fixnum))) + (should (> (+ most-positive-fixnum most-positive-fixnum) most-positive-fixnum)) + (should (eq (- (+ most-positive-fixnum most-positive-fixnum) + (+ most-positive-fixnum most-positive-fixnum)) + 0))) + +(ert-deftest data-tests-/ () + (let* ((x (* most-positive-fixnum 8)) + (y (* most-negative-fixnum 8)) + (z (- y))) + (should (= most-positive-fixnum (/ x 8))) + (should (= most-negative-fixnum (/ y 8))) + (should (= -1 (/ y z))) + (should (= -1 (/ z y))) + (should (= 0 (/ x (* 2 x)))) + (should (= 0 (/ y (* 2 y)))) + (should (= 0 (/ z (* 2 z)))))) + +(ert-deftest data-tests-number-predicates () + (should (fixnump 0)) + (should (fixnump most-negative-fixnum)) + (should (fixnump most-positive-fixnum)) + (should (integerp (+ most-positive-fixnum 1))) + (should (integer-or-marker-p (+ most-positive-fixnum 1))) + (should (numberp (+ most-positive-fixnum 1))) + (should (number-or-marker-p (+ most-positive-fixnum 1))) + (should (natnump (+ most-positive-fixnum 1))) + (should-not (fixnump (+ most-positive-fixnum 1))) + (should (bignump (+ most-positive-fixnum 1)))) + ;;; data-tests.el ends here diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index d9cca557cf..f5f3b89244 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -593,4 +593,12 @@ (should (equal 1 (string-distance "ab" "ać‘b"))) (should (equal 1 (string-distance "ć‘" "她")))) +(ert-deftest test-bignum-eql () + "Test that `eql' works for bignums." + (let ((x (+ most-positive-fixnum 1)) + (y (+ most-positive-fixnum 1))) + (should (eq x x)) + (should (eql x y)) + (should (equal x y)))) + (provide 'fns-tests) diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index 639a6da93a..17381340c7 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -195,9 +195,7 @@ literals (Bug#20852)." (should (eq x (cdr x))))) (ert-deftest lread-long-hex-integer () - (should-error - (read "#xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff") - :type 'overflow-error)) + (should (bignump (read "#xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff")))) (ert-deftest lread-test-bug-31186 () (with-temp-buffer diff --git a/test/src/print-tests.el b/test/src/print-tests.el index c96cb5d2b6..091f1aa1af 100644 --- a/test/src/print-tests.el +++ b/test/src/print-tests.el @@ -98,5 +98,11 @@ otherwise, use a different charset." (let ((sym '\’bar)) (should (eq (read (prin1-to-string sym)) sym)))) +(ert-deftest print-bignum () + (let* ((str "999999999999999999999999999999999") + (val (read str))) + (should (> val most-positive-fixnum)) + (should (equal (prin1-to-string val) str)))) + (provide 'print-tests) ;;; print-tests.el ends here commit 5875fbaa2dfd919a2ba22db1d20ffa6c4c6e13bd Author: Tom Tromey Date: Fri Jul 6 10:12:14 2018 -0600 Make arithmetic work with bignums * src/data.c (free_mpz_value): New function. (arith_driver): Rewrite. (float_arith_driver): Handle bignums. diff --git a/src/data.c b/src/data.c index 97554c7e1d..b49daabe85 100644 --- a/src/data.c +++ b/src/data.c @@ -2809,16 +2809,25 @@ enum arithop Alogxor }; +static void +free_mpz_value (void *value_ptr) +{ + mpz_clear (*(mpz_t *) value_ptr); +} + static Lisp_Object float_arith_driver (double, ptrdiff_t, enum arithop, ptrdiff_t, Lisp_Object *); + static Lisp_Object arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) { - Lisp_Object val; - ptrdiff_t argnum, ok_args; - EMACS_INT accum = 0; - EMACS_INT next, ok_accum; - bool overflow = 0; + Lisp_Object val = Qnil; + ptrdiff_t argnum; + ptrdiff_t count = SPECPDL_INDEX (); + mpz_t accum; + + mpz_init (accum); + record_unwind_protect_ptr (free_mpz_value, &accum); switch (code) { @@ -2826,14 +2835,14 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) case Alogxor: case Aadd: case Asub: - accum = 0; + /* ACCUM is already 0. */ break; case Amult: case Adiv: - accum = 1; + mpz_set_si (accum, 1); break; case Alogand: - accum = -1; + mpz_set_si (accum, -1); break; default: break; @@ -2841,62 +2850,112 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) for (argnum = 0; argnum < nargs; argnum++) { - if (! overflow) - { - ok_args = argnum; - ok_accum = accum; - } - - /* Using args[argnum] as argument to CHECK_FIXNUM_... */ + /* Using args[argnum] as argument to CHECK_NUMBER... */ val = args[argnum]; - CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (val); + CHECK_NUMBER (val); if (FLOATP (val)) - return float_arith_driver (ok_accum, ok_args, code, - nargs, args); - args[argnum] = val; - next = XINT (args[argnum]); + return unbind_to (count, + float_arith_driver (mpz_get_d (accum), argnum, code, + nargs, args)); switch (code) { case Aadd: - overflow |= INT_ADD_WRAPV (accum, next, &accum); + if (BIGNUMP (val)) + mpz_add (accum, accum, XBIGNUM (val)->value); + else if (XINT (val) < 0) + mpz_sub_ui (accum, accum, - XINT (val)); + else + mpz_add_ui (accum, accum, XINT (val)); break; case Asub: if (! argnum) - accum = nargs == 1 ? - next : next; + { + if (BIGNUMP (val)) + mpz_set (accum, XBIGNUM (val)->value); + else + mpz_set_si (accum, XINT (val)); + if (nargs == 1) + mpz_neg (accum, accum); + } + else if (BIGNUMP (val)) + mpz_sub (accum, accum, XBIGNUM (val)->value); + else if (XINT (val) < 0) + mpz_add_ui (accum, accum, - XINT (val)); else - overflow |= INT_SUBTRACT_WRAPV (accum, next, &accum); + mpz_sub_ui (accum, accum, XINT (val)); break; case Amult: - overflow |= INT_MULTIPLY_WRAPV (accum, next, &accum); + if (BIGNUMP (val)) + mpz_mul (accum, accum, XBIGNUM (val)->value); + else + mpz_mul_si (accum, accum, XINT (val)); break; case Adiv: if (! (argnum || nargs == 1)) - accum = next; + { + if (BIGNUMP (val)) + mpz_set (accum, XBIGNUM (val)->value); + else + mpz_set_si (accum, XINT (val)); + } else { - if (next == 0) + /* Note that a bignum can never be 0, so we don't need + to check that case. */ + if (FIXNUMP (val) && XINT (val) == 0) xsignal0 (Qarith_error); - if (INT_DIVIDE_OVERFLOW (accum, next)) - overflow = true; + if (BIGNUMP (val)) + mpz_tdiv_q (accum, accum, XBIGNUM (val)->value); else - accum /= next; + { + EMACS_INT value = XINT (val); + bool negate = value < 0; + if (negate) + value = -value; + mpz_tdiv_q_ui (accum, accum, value); + if (negate) + mpz_neg (accum, accum); + } } break; case Alogand: - accum &= next; + if (BIGNUMP (val)) + mpz_and (accum, accum, XBIGNUM (val)->value); + else + { + mpz_t tem; + mpz_init_set_ui (tem, XUINT (val)); + mpz_and (accum, accum, tem); + mpz_clear (tem); + } break; case Alogior: - accum |= next; + if (BIGNUMP (val)) + mpz_ior (accum, accum, XBIGNUM (val)->value); + else + { + mpz_t tem; + mpz_init_set_ui (tem, XUINT (val)); + mpz_ior (accum, accum, tem); + mpz_clear (tem); + } break; case Alogxor: - accum ^= next; + if (BIGNUMP (val)) + mpz_xor (accum, accum, XBIGNUM (val)->value); + else + { + mpz_t tem; + mpz_init_set_ui (tem, XUINT (val)); + mpz_xor (accum, accum, tem); + mpz_clear (tem); + } break; } } - XSETINT (val, accum); - return val; + return unbind_to (count, make_number (accum)); } #ifndef isnan @@ -2919,6 +2978,8 @@ float_arith_driver (double accum, ptrdiff_t argnum, enum arithop code, { next = XFLOAT_DATA (val); } + else if (BIGNUMP (val)) + next = mpz_get_d (XBIGNUM (val)->value); else { args[argnum] = val; /* runs into a compiler bug. */ commit eefa65e90392df9bab287b0de5dedf73b40ca0fc Author: Tom Tromey Date: Sat Jul 7 15:44:15 2018 -0600 Make comparison operators handle bignums * sc/data.c (bignumcompare): New function. (arithcompare): Handle bignums. diff --git a/src/data.c b/src/data.c index 8ffed8bbb5..97554c7e1d 100644 --- a/src/data.c +++ b/src/data.c @@ -2397,6 +2397,70 @@ bool-vector. IDX starts at 0. */) /* Arithmetic functions */ +static Lisp_Object +bignumcompare (Lisp_Object num1, Lisp_Object num2, + enum Arith_Comparison comparison) +{ + int cmp; + bool test; + + if (BIGNUMP (num1)) + { + if (FLOATP (num2)) + cmp = mpz_cmp_d (XBIGNUM (num1)->value, XFLOAT_DATA (num2)); + else if (FIXNUMP (num2)) + cmp = mpz_cmp_si (XBIGNUM (num1)->value, XINT (num2)); + else + { + eassume (BIGNUMP (num2)); + cmp = mpz_cmp (XBIGNUM (num1)->value, XBIGNUM (num2)->value); + } + } + else + { + eassume (BIGNUMP (num2)); + if (FLOATP (num1)) + cmp = - mpz_cmp_d (XBIGNUM (num2)->value, XFLOAT_DATA (num1)); + else + { + eassume (FIXNUMP (num1)); + cmp = - mpz_cmp_si (XBIGNUM (num2)->value, XINT (num1)); + } + } + + switch (comparison) + { + case ARITH_EQUAL: + test = cmp == 0; + break; + + case ARITH_NOTEQUAL: + test = cmp != 0; + break; + + case ARITH_LESS: + test = cmp < 0; + break; + + case ARITH_LESS_OR_EQUAL: + test = cmp <= 0; + break; + + case ARITH_GRTR: + test = cmp > 0; + break; + + case ARITH_GRTR_OR_EQUAL: + test = cmp >= 0; + break; + + default: + eassume (false); + } + + return test ? Qt : Qnil; +} + Lisp_Object arithcompare (Lisp_Object num1, Lisp_Object num2, enum Arith_Comparison comparison) @@ -2406,8 +2470,11 @@ arithcompare (Lisp_Object num1, Lisp_Object num2, bool fneq; bool test; - CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (num1); - CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (num2); + CHECK_NUMBER_COERCE_MARKER (num1); + CHECK_NUMBER_COERCE_MARKER (num2); + + if (BIGNUMP (num1) || BIGNUMP (num2)) + return bignumcompare (num1, num2, comparison); /* If either arg is floating point, set F1 and F2 to the 'double' approximations of the two arguments, and set FNEQ if floating-point commit 1e8ae6ca237e22e11b3db63a01e558ad5a3d6ef3 Author: Tom Tromey Date: Sat Jul 7 15:32:52 2018 -0600 Make the reader accept bignums * src/data.c (Fstring_to_number): Update. * src/lisp.h (S2N_OVERFLOW_TO_FLOAT): Remove. * src/lread.c (free_contents): New function. (read_integer): Handle bignums. (read1): Update. (string_to_number): Handle bignums. (syms_of_lread): Remove read-integer-overflow-as-float. * src/process.c (Fsignal_process): Update. diff --git a/src/data.c b/src/data.c index efcffbbf6a..8ffed8bbb5 100644 --- a/src/data.c +++ b/src/data.c @@ -2727,8 +2727,7 @@ If the base used is not 10, STRING is always parsed as an integer. */) while (*p == ' ' || *p == '\t') p++; - int flags = S2N_IGNORE_TRAILING | S2N_OVERFLOW_TO_FLOAT; - Lisp_Object val = string_to_number (p, b, flags); + Lisp_Object val = string_to_number (p, b, S2N_IGNORE_TRAILING); return NILP (val) ? make_fixnum (0) : val; } diff --git a/src/lisp.h b/src/lisp.h index 6a3db24949..be67932049 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3858,7 +3858,7 @@ LOADHIST_ATTACH (Lisp_Object x) } extern int openp (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object *, Lisp_Object, bool); -enum { S2N_IGNORE_TRAILING = 1, S2N_OVERFLOW_TO_FLOAT = 2 }; +enum { S2N_IGNORE_TRAILING = 1 }; extern Lisp_Object string_to_number (char const *, int, int); extern void map_obarray (Lisp_Object, void (*) (Lisp_Object, Lisp_Object), Lisp_Object); diff --git a/src/lread.c b/src/lread.c index 49fa51d1a8..ff86c96c9b 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2631,6 +2631,13 @@ digit_to_number (int character, int base) return digit < base ? digit : -1; } +static void +free_contents (void *p) +{ + void **ptr = (void **) p; + xfree (*ptr); +} + /* Read an integer in radix RADIX using READCHARFUN to read characters. RADIX must be in the interval [2..36]; if it isn't, a read error is signaled . Value is the integer read. Signals an @@ -2642,17 +2649,24 @@ read_integer (Lisp_Object readcharfun, EMACS_INT radix) { /* Room for sign, leading 0, other digits, trailing null byte. Also, room for invalid syntax diagnostic. */ - char buf[max (1 + 1 + UINTMAX_WIDTH + 1, - sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT))]; + size_t len = max (1 + 1 + UINTMAX_WIDTH + 1, + sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT)); + char *buf = NULL; char *p = buf; int valid = -1; /* 1 if valid, 0 if not, -1 if incomplete. */ + ptrdiff_t count = SPECPDL_INDEX (); + if (radix < 2 || radix > 36) valid = 0; else { int c, digit; + buf = xmalloc (len); + record_unwind_protect_ptr (free_contents, &buf); + p = buf; + c = READCHAR; if (c == '-' || c == '+') { @@ -2678,8 +2692,15 @@ read_integer (Lisp_Object readcharfun, EMACS_INT radix) valid = 0; if (valid < 0) valid = 1; - if (p < buf + sizeof buf) - *p++ = c; + /* Allow 1 extra byte for the \0. */ + if (p + 1 == buf + len) + { + ptrdiff_t where = p - buf; + len *= 2; + buf = xrealloc (buf, len); + p = buf + where; + } + *p++ = c; c = READCHAR; } @@ -2692,14 +2713,8 @@ read_integer (Lisp_Object readcharfun, EMACS_INT radix) invalid_syntax (buf); } - if (p == buf + sizeof buf) - { - memset (p - 3, '.', 3); - xsignal1 (Qoverflow_error, make_unibyte_string (buf, sizeof buf)); - } - *p = '\0'; - return string_to_number (buf, radix, 0); + return unbind_to (count, string_to_number (buf, radix, 0)); } @@ -3508,9 +3523,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) if (!quoted && !uninterned_symbol) { - int flags = (read_integer_overflow_as_float - ? S2N_OVERFLOW_TO_FLOAT : 0); - Lisp_Object result = string_to_number (read_buffer, 10, flags); + Lisp_Object result = string_to_number (read_buffer, 10, 0); if (! NILP (result)) return unbind_to (count, result); } @@ -3677,12 +3690,10 @@ substitute_in_interval (INTERVAL interval, void *arg) /* Convert STRING to a number, assuming base BASE. When STRING has floating point syntax and BASE is 10, return a nearest float. When - STRING has integer syntax, return a fixnum if the integer fits, and - signal an overflow otherwise (unless BASE is 10 and STRING ends in - period or FLAGS & S2N_OVERFLOW_TO_FLOAT is nonzero; in this case, - return a nearest float instead). Otherwise, return nil. If FLAGS - & S2N_IGNORE_TRAILING is nonzero, consider just the longest prefix - of STRING that has valid syntax. */ + STRING has integer syntax, return a fixnum if the integer fits, or + else a bignum. Otherwise, return nil. If FLAGS & + S2N_IGNORE_TRAILING is nonzero, consider just the longest prefix of + STRING that has valid syntax. */ Lisp_Object string_to_number (char const *string, int base, int flags) @@ -3796,13 +3807,7 @@ string_to_number (char const *string, int base, int flags) else value = n; - if (! (state & DOT_CHAR) && ! (flags & S2N_OVERFLOW_TO_FLOAT)) - { - AUTO_STRING (fmt, ("%s is out of fixnum range; " - "maybe set `read-integer-overflow-as-float'?")); - AUTO_STRING_WITH_LEN (arg, string, cp - string); - xsignal1 (Qoverflow_error, CALLN (Fformat_message, fmt, arg)); - } + return make_bignum_str (string, base); } /* Either the number uses float syntax, or it does not fit into a fixnum. @@ -4845,13 +4850,6 @@ were read in. */); doc: /* Non-nil means read recursive structures using #N= and #N# syntax. */); Vread_circle = Qt; - DEFVAR_BOOL ("read-integer-overflow-as-float", - read_integer_overflow_as_float, - doc: /* Non-nil means `read' quietly treats an out-of-range integer as floating point. -Nil (the default) means signal an overflow unless the integer ends in `.'. -This variable is experimental; email 30408@debbugs.gnu.org if you need it. */); - read_integer_overflow_as_float = false; - DEFVAR_LISP ("load-path", Vload_path, doc: /* List of directories to search for files to load. Each element is a string (directory file name) or nil (meaning diff --git a/src/process.c b/src/process.c index 10af79a015..350cfe0f80 100644 --- a/src/process.c +++ b/src/process.c @@ -6842,7 +6842,7 @@ SIGCODE may be an integer, or a symbol whose name is a signal name. */) { Lisp_Object tem = Fget_process (process); if (NILP (tem)) - tem = string_to_number (SSDATA (process), 10, S2N_OVERFLOW_TO_FLOAT); + tem = string_to_number (SSDATA (process), 10, 0); process = tem; } else if (!FIXED_OR_FLOATP (process)) commit 580d173b9a7db78f6d62972ef8e943d31dde5c9d Author: Tom Tromey Date: Sat Jul 7 15:32:30 2018 -0600 Make eql work for bignums * src/fns.c (Feql, internal_equal): Handle bignums. diff --git a/src/fns.c b/src/fns.c index ec88f8476c..b14481d010 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2174,7 +2174,7 @@ DEFUN ("eql", Feql, Seql, 2, 2, 0, Floating-point numbers of equal value are `eql', but they may not be `eq'. */) (Lisp_Object obj1, Lisp_Object obj2) { - if (FLOATP (obj1)) + if (FLOATP (obj1) || BIGNUMP (obj1)) return equal_no_quit (obj1, obj2) ? Qt : Qnil; else return EQ (obj1, obj2) ? Qt : Qnil; @@ -2322,6 +2322,8 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, && (XMARKER (o1)->buffer == 0 || XMARKER (o1)->bytepos == XMARKER (o2)->bytepos)); } + if (BIGNUMP (o1)) + return mpz_cmp (XBIGNUM (o1)->value, XBIGNUM (o2)->value) == 0; break; case Lisp_Vectorlike: commit b2f3f4ee29ba8510d3cad8025d9ce2c2014b1b7f Author: Tom Tromey Date: Sat Jul 7 14:53:23 2018 -0600 Provide new functions to create bignums * src/alloc.c (make_bignum_str, make_number): New functions. * src/lisp.h (make_bignum_str, make_number): Declare. diff --git a/src/alloc.c b/src/alloc.c index 8ebf3e05d6..b775948fd9 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3780,6 +3780,51 @@ build_marker (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t bytepos) } + +Lisp_Object +make_bignum_str (const char *num, int base) +{ + Lisp_Object obj; + struct Lisp_Bignum *b; + int check; + + obj = allocate_misc (Lisp_Misc_Bignum); + b = XBIGNUM (obj); + mpz_init (b->value); + check = mpz_set_str (b->value, num, base); + eassert (check == 0); + return obj; +} + +/* Given an mpz_t, make a number. This may return a bignum or a + fixnum depending on VALUE. */ + +Lisp_Object +make_number (mpz_t value) +{ + Lisp_Object obj; + struct Lisp_Bignum *b; + + if (mpz_fits_slong_p (value)) + { + long l = mpz_get_si (value); + if (!FIXNUM_OVERFLOW_P (l)) + { + XSETINT (obj, l); + return obj; + } + } + + obj = allocate_misc (Lisp_Misc_Bignum); + b = XBIGNUM (obj); + /* We could mpz_init + mpz_swap here, to avoid a copy, but the + resulting API seemed possibly confusing. */ + mpz_init_set (b->value, value); + + return obj; +} + + /* Return a newly created vector or string with specified arguments as elements. If all the arguments are characters that can fit in a string of events, make a string; otherwise, make a vector. diff --git a/src/lisp.h b/src/lisp.h index 37e43b0c5a..6a3db24949 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3643,6 +3643,9 @@ extern Lisp_Object list5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, enum constype {CONSTYPE_HEAP, CONSTYPE_PURE}; extern Lisp_Object listn (enum constype, ptrdiff_t, Lisp_Object, ...); +extern Lisp_Object make_bignum_str (const char *num, int base); +extern Lisp_Object make_number (mpz_t value); + /* Build a frequently used 2/3/4-integer lists. */ INLINE Lisp_Object commit a0f2adbfc9cb1b69415f551a5e529f7e1162b9c7 Author: Tom Tromey Date: Sat Jul 7 14:52:09 2018 -0600 Introduce the bignum type * src/alloc.c (mark_object): Handle Lisp_Misc_Bignum. (sweep_misc): Call mpz_clear for Lisp_Misc_Bignum. * src/data.c (Ftype_of): Handle Lisp_Misc_Bignum. (Fintegerp, Finteger_or_marker_p, Fnatnump, Fnumberp) (Fnumber_or_marker_p): Update for bignum. (Ffixnump, Fbignump): New defuns. (syms_of_data): Update. * src/emacs.c (xrealloc_for_gmp, xfree_for_gmp): New functions. (main): Call mp_set_memory_functions. * src/lisp.h (enum Lisp_Misc_Type) : New constant. (struct Lisp_Bignum): New. (union Lisp_Misc): Add u_bignum. (BIGNUMP, XBIGNUM, INTEGERP, NATNUMP, NUMBERP, CHECK_NUMBER) (CHECK_INTEGER, CHECK_NUMBER_COERCE_MARKER): New functions. * src/print.c (print_object): Handle Lisp_Misc_Bignum. diff --git a/src/alloc.c b/src/alloc.c index 91c5152ca8..8ebf3e05d6 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -6554,6 +6554,7 @@ mark_object (Lisp_Object arg) break; case Lisp_Misc_Ptr: + case Lisp_Misc_Bignum: XMISCANY (obj)->gcmarkbit = true; break; @@ -6973,6 +6974,8 @@ sweep_misc (void) uptr->finalizer (uptr->p); } #endif + else if (mblk->markers[i].m.u_any.type == Lisp_Misc_Bignum) + mpz_clear (mblk->markers[i].m.u_bignum.value); /* Set the type of the freed object to Lisp_Misc_Free. We could leave the type alone, since nobody checks it, but this might catch bugs faster. */ diff --git a/src/data.c b/src/data.c index aad5708464..efcffbbf6a 100644 --- a/src/data.c +++ b/src/data.c @@ -234,6 +234,8 @@ for example, (type-of 1) returns `integer'. */) case Lisp_Misc_User_Ptr: return Quser_ptr; #endif + case Lisp_Misc_Bignum: + return Qinteger; default: emacs_abort (); } @@ -514,6 +516,16 @@ DEFUN ("integerp", Fintegerp, Sintegerp, 1, 1, 0, doc: /* Return t if OBJECT is an integer. */ attributes: const) (Lisp_Object object) +{ + if (INTEGERP (object)) + return Qt; + return Qnil; +} + +DEFUN ("fixnump", Ffixnump, Sfixnump, 1, 1, 0, + doc: /* Return t if OBJECT is an fixnum. */ + attributes: const) + (Lisp_Object object) { if (FIXNUMP (object)) return Qt; @@ -524,7 +536,7 @@ DEFUN ("integer-or-marker-p", Finteger_or_marker_p, Sinteger_or_marker_p, 1, 1, doc: /* Return t if OBJECT is an integer or a marker (editor pointer). */) (register Lisp_Object object) { - if (MARKERP (object) || FIXNUMP (object)) + if (MARKERP (object) || INTEGERP (object)) return Qt; return Qnil; } @@ -534,7 +546,7 @@ DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0, attributes: const) (Lisp_Object object) { - if (FIXNATP (object)) + if (NATNUMP (object)) return Qt; return Qnil; } @@ -544,7 +556,7 @@ DEFUN ("numberp", Fnumberp, Snumberp, 1, 1, 0, attributes: const) (Lisp_Object object) { - if (FIXED_OR_FLOATP (object)) + if (NUMBERP (object)) return Qt; else return Qnil; @@ -555,7 +567,7 @@ DEFUN ("number-or-marker-p", Fnumber_or_marker_p, doc: /* Return t if OBJECT is a number or a marker. */) (Lisp_Object object) { - if (FIXED_OR_FLOATP (object) || MARKERP (object)) + if (NUMBERP (object) || MARKERP (object)) return Qt; return Qnil; } @@ -597,6 +609,15 @@ DEFUN ("condition-variable-p", Fcondition_variable_p, Scondition_variable_p, return Qt; return Qnil; } + +DEFUN ("bignump", Fbignump, Sbignump, 1, 1, 0, + doc: /* Return t if OBJECT is a bignum. */) + (Lisp_Object object) +{ + if (BIGNUMP (object)) + return Qt; + return Qnil; +} /* Extract and set components of lists. */ @@ -3745,6 +3766,7 @@ syms_of_data (void) defsubr (&Sconsp); defsubr (&Satom); defsubr (&Sintegerp); + defsubr (&Sfixnump); defsubr (&Sinteger_or_marker_p); defsubr (&Snumberp); defsubr (&Snumber_or_marker_p); @@ -3770,6 +3792,7 @@ syms_of_data (void) defsubr (&Sthreadp); defsubr (&Smutexp); defsubr (&Scondition_variable_p); + defsubr (&Sbignump); defsubr (&Scar); defsubr (&Scdr); defsubr (&Scar_safe); diff --git a/src/emacs.c b/src/emacs.c index 2c1311b846..aef4f93d02 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -673,6 +673,20 @@ close_output_streams (void) _exit (EXIT_FAILURE); } +/* Wrapper function for GMP. */ +static void * +xrealloc_for_gmp (void *ptr, size_t ignore, size_t size) +{ + return xrealloc (ptr, size); +} + +/* Wrapper function for GMP. */ +static void +xfree_for_gmp (void *ptr, size_t ignore) +{ + xfree (ptr); +} + /* ARGSUSED */ int main (int argc, char **argv) @@ -771,6 +785,8 @@ main (int argc, char **argv) init_standard_fds (); atexit (close_output_streams); + mp_set_memory_functions (xmalloc, xrealloc_for_gmp, xfree_for_gmp); + sort_args (argc, argv); argc = 0; while (argv[argc]) argc++; diff --git a/src/lisp.h b/src/lisp.h index 9cf10c1962..37e43b0c5a 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -30,6 +30,11 @@ along with GNU Emacs. If not, see . */ #include #include #include +#ifdef HAVE_GMP +#include +#else +#include "mini-gmp.h" +#endif #include #include @@ -516,6 +521,7 @@ enum Lisp_Misc_Type #ifdef HAVE_MODULES Lisp_Misc_User_Ptr, #endif + Lisp_Misc_Bignum, /* This is not a type code. It is for range checking. */ Lisp_Misc_Limit }; @@ -2456,6 +2462,14 @@ struct Lisp_Free union Lisp_Misc *chain; }; +struct Lisp_Bignum + { + ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Bignum */ + bool_bf gcmarkbit : 1; + unsigned spacer : 15; + mpz_t value; + }; + /* To get the type field of a union Lisp_Misc, use XMISCTYPE. It uses one of these struct subtypes to get the type field. */ @@ -2470,6 +2484,7 @@ union Lisp_Misc #ifdef HAVE_MODULES struct Lisp_User_Ptr u_user_ptr; #endif + struct Lisp_Bignum u_bignum; }; INLINE union Lisp_Misc * @@ -2519,6 +2534,25 @@ XUSER_PTR (Lisp_Object a) } #endif +INLINE bool +BIGNUMP (Lisp_Object x) +{ + return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Bignum; +} + +INLINE struct Lisp_Bignum * +XBIGNUM (Lisp_Object a) +{ + eassert (BIGNUMP (a)); + return XUNTAG (a, Lisp_Misc, struct Lisp_Bignum); +} + +INLINE bool +INTEGERP (Lisp_Object x) +{ + return FIXNUMP (x) || BIGNUMP (x); +} + /* Forwarding pointer to an int variable. This is allowed only in the value cell of a symbol, @@ -2734,6 +2768,18 @@ FIXNATP (Lisp_Object x) { return FIXNUMP (x) && 0 <= XINT (x); } +INLINE bool +NATNUMP (Lisp_Object x) +{ + if (BIGNUMP (x)) + return mpz_cmp_si (XBIGNUM (x)->value, 0) >= 0; + return FIXNUMP (x) && 0 <= XINT (x); +} +INLINE bool +NUMBERP (Lisp_Object x) +{ + return INTEGERP (x) || FLOATP (x) || BIGNUMP (x); +} INLINE bool RANGED_FIXNUMP (intmax_t lo, Lisp_Object x, intmax_t hi) @@ -2882,6 +2928,18 @@ CHECK_FIXNUM_OR_FLOAT (Lisp_Object x) CHECK_TYPE (FIXED_OR_FLOATP (x), Qnumberp, x); } +INLINE void +CHECK_NUMBER (Lisp_Object x) +{ + CHECK_TYPE (NUMBERP (x), Qnumberp, x); +} + +INLINE void +CHECK_INTEGER (Lisp_Object x) +{ + CHECK_TYPE (INTEGERP (x), Qnumberp, x); +} + #define CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER(x) \ do { \ if (MARKERP (x)) \ @@ -2890,6 +2948,14 @@ CHECK_FIXNUM_OR_FLOAT (Lisp_Object x) CHECK_TYPE (FIXED_OR_FLOATP (x), Qnumber_or_marker_p, x); \ } while (false) +#define CHECK_NUMBER_COERCE_MARKER(x) \ + do { \ + if (MARKERP (x)) \ + XSETFASTINT (x, marker_position (x)); \ + else \ + CHECK_TYPE (NUMBERP (x), Qnumber_or_marker_p, x); \ + } while (false) + /* Since we can't assign directly to the CAR or CDR fields of a cons cell, use these when checking that those fields contain numbers. */ INLINE void diff --git a/src/print.c b/src/print.c index 1327ef303b..2b1d1fec72 100644 --- a/src/print.c +++ b/src/print.c @@ -2185,6 +2185,15 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) } break; + case Lisp_Misc_Bignum: + { + struct Lisp_Bignum *b = XBIGNUM (obj); + char *str = mpz_get_str (NULL, 10, b->value); + record_unwind_protect_ptr (xfree, str); + print_c_string (str, printcharfun); + } + break; + default: goto badtype; } commit 7cb45cd25e510cf3c20adeb9ac11c0c3ea1dd340 Author: Tom Tromey Date: Fri Jul 6 22:37:51 2018 -0600 Add configury for GMP library * configure.ac (GMP_LIB, GMP_OBJ): New substs. * src/Makefile.in (GMP_OBJ, GMP_OBJ): New variables. (base_obj): Add GMP_OBJ. (LIBES): Add GMP_LIB. * src/mini-gmp.h: New file. * src/mini-gmp.c: New file. diff --git a/configure.ac b/configure.ac index 6613ce1eaa..e202acf8cd 100644 --- a/configure.ac +++ b/configure.ac @@ -4302,6 +4302,20 @@ AC_SUBST(KRB5LIB) AC_SUBST(DESLIB) AC_SUBST(KRB4LIB) +GMP_LIB= +GMP_OBJ= +HAVE_GMP=no +AC_CHECK_LIB(gmp, __gmpz_init, [ + AC_CHECK_HEADERS(gmp.h, [ + GMP_LIB=-lgmp + HAVE_GMP=yes + AC_DEFINE(HAVE_GMP, 1, [Define to 1 if you have gmp.h and -lgmp])])]) +if test $HAVE_GMP = no; then + GMP_OBJ=mini-gmp.o +fi +AC_SUBST(GMP_LIB) +AC_SUBST(GMP_OBJ) + AC_CHECK_HEADERS(valgrind/valgrind.h) AC_CHECK_MEMBERS([struct unipair.unicode], [], [], [[#include ]]) @@ -5450,6 +5464,7 @@ AS_ECHO([" Does Emacs use -lXaw3d? ${HAVE_XAW3D Does Emacs use -lxft? ${HAVE_XFT} Does Emacs use -lsystemd? ${HAVE_LIBSYSTEMD} Does Emacs use -ljansson? ${HAVE_JSON} + Does Emacs use -lgmp? ${HAVE_GMP} Does Emacs directly use zlib? ${HAVE_ZLIB} Does Emacs have dynamic modules support? ${HAVE_MODULES} Does Emacs use toolkit scroll bars? ${USE_TOOLKIT_SCROLL_BARS} diff --git a/src/Makefile.in b/src/Makefile.in index c3bcc50349..05d24acef6 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -322,6 +322,9 @@ INTERVALS_H = dispextern.h intervals.h composite.h GETLOADAVG_LIBS = @GETLOADAVG_LIBS@ +GMP_LIB = @GMP_LIB@ +GMP_OBJ = @GMP_OBJ@ + RUN_TEMACS = ./temacs # Whether builds should contain details. '--no-build-details' or empty. @@ -403,7 +406,7 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \ thread.o systhread.o \ $(if $(HYBRID_MALLOC),sheap.o) \ $(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) \ - $(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ) $(JSON_OBJ) + $(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ) $(JSON_OBJ) $(GMP_OBJ) obj = $(base_obj) $(NS_OBJC_OBJ) ## Object files used on some machine or other. @@ -501,7 +504,7 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(LIBX_BASE) $(LIBIMAGE) \ $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \ $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) $(GETADDRINFO_A_LIBS) $(LCMS2_LIBS) \ $(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(LIBSYSTEMD_LIBS) \ - $(JSON_LIBS) + $(JSON_LIBS) $(GMP_LIB) ## FORCE it so that admin/unidata can decide whether these files ## are up-to-date. Although since charprop depends on bootstrap-emacs, diff --git a/src/mini-gmp.c b/src/mini-gmp.c new file mode 100644 index 0000000000..c0d5b879a8 --- /dev/null +++ b/src/mini-gmp.c @@ -0,0 +1,4452 @@ +/* mini-gmp, a minimalistic implementation of a GNU GMP subset. + + Contributed to the GNU project by Niels Möller + +Copyright 1991-1997, 1999-2018 Free Software Foundation, Inc. + +This file is part of the GNU MP Library. + +The GNU MP Library is free software; you can redistribute it and/or modify +it under the terms of either: + + * the GNU Lesser General Public License as published by the Free + Software Foundation; either version 3 of the License, or (at your + option) any later version. + +or + + * the GNU General Public License as published by the Free Software + Foundation; either version 2 of the License, or (at your option) any + later version. + +or both in parallel, as here. + +The GNU MP Library 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 copies of the GNU General Public License and the +GNU Lesser General Public License along with the GNU MP Library. If not, +see https://www.gnu.org/licenses/. */ + +/* NOTE: All functions in this file which are not declared in + mini-gmp.h are internal, and are not intended to be compatible + neither with GMP nor with future versions of mini-gmp. */ + +/* Much of the material copied from GMP files, including: gmp-impl.h, + longlong.h, mpn/generic/add_n.c, mpn/generic/addmul_1.c, + mpn/generic/lshift.c, mpn/generic/mul_1.c, + mpn/generic/mul_basecase.c, mpn/generic/rshift.c, + mpn/generic/sbpi1_div_qr.c, mpn/generic/sub_n.c, + mpn/generic/submul_1.c. */ + +#include +#include +#include +#include +#include +#include + +#include "mini-gmp.h" + +#if !defined(MINI_GMP_DONT_USE_FLOAT_H) +#include +#endif + + +/* Macros */ +#define GMP_LIMB_BITS (sizeof(mp_limb_t) * CHAR_BIT) + +#define GMP_LIMB_MAX (~ (mp_limb_t) 0) +#define GMP_LIMB_HIGHBIT ((mp_limb_t) 1 << (GMP_LIMB_BITS - 1)) + +#define GMP_HLIMB_BIT ((mp_limb_t) 1 << (GMP_LIMB_BITS / 2)) +#define GMP_LLIMB_MASK (GMP_HLIMB_BIT - 1) + +#define GMP_ULONG_BITS (sizeof(unsigned long) * CHAR_BIT) +#define GMP_ULONG_HIGHBIT ((unsigned long) 1 << (GMP_ULONG_BITS - 1)) + +#define GMP_ABS(x) ((x) >= 0 ? (x) : -(x)) +#define GMP_NEG_CAST(T,x) (-((T)((x) + 1) - 1)) + +#define GMP_MIN(a, b) ((a) < (b) ? (a) : (b)) +#define GMP_MAX(a, b) ((a) > (b) ? (a) : (b)) + +#define GMP_CMP(a,b) (((a) > (b)) - ((a) < (b))) + +#if defined(DBL_MANT_DIG) && FLT_RADIX == 2 +#define GMP_DBL_MANT_BITS DBL_MANT_DIG +#else +#define GMP_DBL_MANT_BITS (53) +#endif + +/* Return non-zero if xp,xsize and yp,ysize overlap. + If xp+xsize<=yp there's no overlap, or if yp+ysize<=xp there's no + overlap. If both these are false, there's an overlap. */ +#define GMP_MPN_OVERLAP_P(xp, xsize, yp, ysize) \ + ((xp) + (xsize) > (yp) && (yp) + (ysize) > (xp)) + +#define gmp_assert_nocarry(x) do { \ + mp_limb_t __cy = (x); \ + assert (__cy == 0); \ + } while (0) + +#define gmp_clz(count, x) do { \ + mp_limb_t __clz_x = (x); \ + unsigned __clz_c; \ + for (__clz_c = 0; \ + (__clz_x & ((mp_limb_t) 0xff << (GMP_LIMB_BITS - 8))) == 0; \ + __clz_c += 8) \ + __clz_x <<= 8; \ + for (; (__clz_x & GMP_LIMB_HIGHBIT) == 0; __clz_c++) \ + __clz_x <<= 1; \ + (count) = __clz_c; \ + } while (0) + +#define gmp_ctz(count, x) do { \ + mp_limb_t __ctz_x = (x); \ + unsigned __ctz_c = 0; \ + gmp_clz (__ctz_c, __ctz_x & - __ctz_x); \ + (count) = GMP_LIMB_BITS - 1 - __ctz_c; \ + } while (0) + +#define gmp_add_ssaaaa(sh, sl, ah, al, bh, bl) \ + do { \ + mp_limb_t __x; \ + __x = (al) + (bl); \ + (sh) = (ah) + (bh) + (__x < (al)); \ + (sl) = __x; \ + } while (0) + +#define gmp_sub_ddmmss(sh, sl, ah, al, bh, bl) \ + do { \ + mp_limb_t __x; \ + __x = (al) - (bl); \ + (sh) = (ah) - (bh) - ((al) < (bl)); \ + (sl) = __x; \ + } while (0) + +#define gmp_umul_ppmm(w1, w0, u, v) \ + do { \ + mp_limb_t __x0, __x1, __x2, __x3; \ + unsigned __ul, __vl, __uh, __vh; \ + mp_limb_t __u = (u), __v = (v); \ + \ + __ul = __u & GMP_LLIMB_MASK; \ + __uh = __u >> (GMP_LIMB_BITS / 2); \ + __vl = __v & GMP_LLIMB_MASK; \ + __vh = __v >> (GMP_LIMB_BITS / 2); \ + \ + __x0 = (mp_limb_t) __ul * __vl; \ + __x1 = (mp_limb_t) __ul * __vh; \ + __x2 = (mp_limb_t) __uh * __vl; \ + __x3 = (mp_limb_t) __uh * __vh; \ + \ + __x1 += __x0 >> (GMP_LIMB_BITS / 2);/* this can't give carry */ \ + __x1 += __x2; /* but this indeed can */ \ + if (__x1 < __x2) /* did we get it? */ \ + __x3 += GMP_HLIMB_BIT; /* yes, add it in the proper pos. */ \ + \ + (w1) = __x3 + (__x1 >> (GMP_LIMB_BITS / 2)); \ + (w0) = (__x1 << (GMP_LIMB_BITS / 2)) + (__x0 & GMP_LLIMB_MASK); \ + } while (0) + +#define gmp_udiv_qrnnd_preinv(q, r, nh, nl, d, di) \ + do { \ + mp_limb_t _qh, _ql, _r, _mask; \ + gmp_umul_ppmm (_qh, _ql, (nh), (di)); \ + gmp_add_ssaaaa (_qh, _ql, _qh, _ql, (nh) + 1, (nl)); \ + _r = (nl) - _qh * (d); \ + _mask = -(mp_limb_t) (_r > _ql); /* both > and >= are OK */ \ + _qh += _mask; \ + _r += _mask & (d); \ + if (_r >= (d)) \ + { \ + _r -= (d); \ + _qh++; \ + } \ + \ + (r) = _r; \ + (q) = _qh; \ + } while (0) + +#define gmp_udiv_qr_3by2(q, r1, r0, n2, n1, n0, d1, d0, dinv) \ + do { \ + mp_limb_t _q0, _t1, _t0, _mask; \ + gmp_umul_ppmm ((q), _q0, (n2), (dinv)); \ + gmp_add_ssaaaa ((q), _q0, (q), _q0, (n2), (n1)); \ + \ + /* Compute the two most significant limbs of n - q'd */ \ + (r1) = (n1) - (d1) * (q); \ + gmp_sub_ddmmss ((r1), (r0), (r1), (n0), (d1), (d0)); \ + gmp_umul_ppmm (_t1, _t0, (d0), (q)); \ + gmp_sub_ddmmss ((r1), (r0), (r1), (r0), _t1, _t0); \ + (q)++; \ + \ + /* Conditionally adjust q and the remainders */ \ + _mask = - (mp_limb_t) ((r1) >= _q0); \ + (q) += _mask; \ + gmp_add_ssaaaa ((r1), (r0), (r1), (r0), _mask & (d1), _mask & (d0)); \ + if ((r1) >= (d1)) \ + { \ + if ((r1) > (d1) || (r0) >= (d0)) \ + { \ + (q)++; \ + gmp_sub_ddmmss ((r1), (r0), (r1), (r0), (d1), (d0)); \ + } \ + } \ + } while (0) + +/* Swap macros. */ +#define MP_LIMB_T_SWAP(x, y) \ + do { \ + mp_limb_t __mp_limb_t_swap__tmp = (x); \ + (x) = (y); \ + (y) = __mp_limb_t_swap__tmp; \ + } while (0) +#define MP_SIZE_T_SWAP(x, y) \ + do { \ + mp_size_t __mp_size_t_swap__tmp = (x); \ + (x) = (y); \ + (y) = __mp_size_t_swap__tmp; \ + } while (0) +#define MP_BITCNT_T_SWAP(x,y) \ + do { \ + mp_bitcnt_t __mp_bitcnt_t_swap__tmp = (x); \ + (x) = (y); \ + (y) = __mp_bitcnt_t_swap__tmp; \ + } while (0) +#define MP_PTR_SWAP(x, y) \ + do { \ + mp_ptr __mp_ptr_swap__tmp = (x); \ + (x) = (y); \ + (y) = __mp_ptr_swap__tmp; \ + } while (0) +#define MP_SRCPTR_SWAP(x, y) \ + do { \ + mp_srcptr __mp_srcptr_swap__tmp = (x); \ + (x) = (y); \ + (y) = __mp_srcptr_swap__tmp; \ + } while (0) + +#define MPN_PTR_SWAP(xp,xs, yp,ys) \ + do { \ + MP_PTR_SWAP (xp, yp); \ + MP_SIZE_T_SWAP (xs, ys); \ + } while(0) +#define MPN_SRCPTR_SWAP(xp,xs, yp,ys) \ + do { \ + MP_SRCPTR_SWAP (xp, yp); \ + MP_SIZE_T_SWAP (xs, ys); \ + } while(0) + +#define MPZ_PTR_SWAP(x, y) \ + do { \ + mpz_ptr __mpz_ptr_swap__tmp = (x); \ + (x) = (y); \ + (y) = __mpz_ptr_swap__tmp; \ + } while (0) +#define MPZ_SRCPTR_SWAP(x, y) \ + do { \ + mpz_srcptr __mpz_srcptr_swap__tmp = (x); \ + (x) = (y); \ + (y) = __mpz_srcptr_swap__tmp; \ + } while (0) + +const int mp_bits_per_limb = GMP_LIMB_BITS; + + +/* Memory allocation and other helper functions. */ +static void +gmp_die (const char *msg) +{ + fprintf (stderr, "%s\n", msg); + abort(); +} + +static void * +gmp_default_alloc (size_t size) +{ + void *p; + + assert (size > 0); + + p = malloc (size); + if (!p) + gmp_die("gmp_default_alloc: Virtual memory exhausted."); + + return p; +} + +static void * +gmp_default_realloc (void *old, size_t old_size, size_t new_size) +{ + void * p; + + p = realloc (old, new_size); + + if (!p) + gmp_die("gmp_default_realloc: Virtual memory exhausted."); + + return p; +} + +static void +gmp_default_free (void *p, size_t size) +{ + free (p); +} + +static void * (*gmp_allocate_func) (size_t) = gmp_default_alloc; +static void * (*gmp_reallocate_func) (void *, size_t, size_t) = gmp_default_realloc; +static void (*gmp_free_func) (void *, size_t) = gmp_default_free; + +void +mp_get_memory_functions (void *(**alloc_func) (size_t), + void *(**realloc_func) (void *, size_t, size_t), + void (**free_func) (void *, size_t)) +{ + if (alloc_func) + *alloc_func = gmp_allocate_func; + + if (realloc_func) + *realloc_func = gmp_reallocate_func; + + if (free_func) + *free_func = gmp_free_func; +} + +void +mp_set_memory_functions (void *(*alloc_func) (size_t), + void *(*realloc_func) (void *, size_t, size_t), + void (*free_func) (void *, size_t)) +{ + if (!alloc_func) + alloc_func = gmp_default_alloc; + if (!realloc_func) + realloc_func = gmp_default_realloc; + if (!free_func) + free_func = gmp_default_free; + + gmp_allocate_func = alloc_func; + gmp_reallocate_func = realloc_func; + gmp_free_func = free_func; +} + +#define gmp_xalloc(size) ((*gmp_allocate_func)((size))) +#define gmp_free(p) ((*gmp_free_func) ((p), 0)) + +static mp_ptr +gmp_xalloc_limbs (mp_size_t size) +{ + return (mp_ptr) gmp_xalloc (size * sizeof (mp_limb_t)); +} + +static mp_ptr +gmp_xrealloc_limbs (mp_ptr old, mp_size_t size) +{ + assert (size > 0); + return (mp_ptr) (*gmp_reallocate_func) (old, 0, size * sizeof (mp_limb_t)); +} + + +/* MPN interface */ + +void +mpn_copyi (mp_ptr d, mp_srcptr s, mp_size_t n) +{ + mp_size_t i; + for (i = 0; i < n; i++) + d[i] = s[i]; +} + +void +mpn_copyd (mp_ptr d, mp_srcptr s, mp_size_t n) +{ + while (--n >= 0) + d[n] = s[n]; +} + +int +mpn_cmp (mp_srcptr ap, mp_srcptr bp, mp_size_t n) +{ + while (--n >= 0) + { + if (ap[n] != bp[n]) + return ap[n] > bp[n] ? 1 : -1; + } + return 0; +} + +static int +mpn_cmp4 (mp_srcptr ap, mp_size_t an, mp_srcptr bp, mp_size_t bn) +{ + if (an != bn) + return an < bn ? -1 : 1; + else + return mpn_cmp (ap, bp, an); +} + +static mp_size_t +mpn_normalized_size (mp_srcptr xp, mp_size_t n) +{ + while (n > 0 && xp[n-1] == 0) + --n; + return n; +} + +int +mpn_zero_p(mp_srcptr rp, mp_size_t n) +{ + return mpn_normalized_size (rp, n) == 0; +} + +void +mpn_zero (mp_ptr rp, mp_size_t n) +{ + while (--n >= 0) + rp[n] = 0; +} + +mp_limb_t +mpn_add_1 (mp_ptr rp, mp_srcptr ap, mp_size_t n, mp_limb_t b) +{ + mp_size_t i; + + assert (n > 0); + i = 0; + do + { + mp_limb_t r = ap[i] + b; + /* Carry out */ + b = (r < b); + rp[i] = r; + } + while (++i < n); + + return b; +} + +mp_limb_t +mpn_add_n (mp_ptr rp, mp_srcptr ap, mp_srcptr bp, mp_size_t n) +{ + mp_size_t i; + mp_limb_t cy; + + for (i = 0, cy = 0; i < n; i++) + { + mp_limb_t a, b, r; + a = ap[i]; b = bp[i]; + r = a + cy; + cy = (r < cy); + r += b; + cy += (r < b); + rp[i] = r; + } + return cy; +} + +mp_limb_t +mpn_add (mp_ptr rp, mp_srcptr ap, mp_size_t an, mp_srcptr bp, mp_size_t bn) +{ + mp_limb_t cy; + + assert (an >= bn); + + cy = mpn_add_n (rp, ap, bp, bn); + if (an > bn) + cy = mpn_add_1 (rp + bn, ap + bn, an - bn, cy); + return cy; +} + +mp_limb_t +mpn_sub_1 (mp_ptr rp, mp_srcptr ap, mp_size_t n, mp_limb_t b) +{ + mp_size_t i; + + assert (n > 0); + + i = 0; + do + { + mp_limb_t a = ap[i]; + /* Carry out */ + mp_limb_t cy = a < b; + rp[i] = a - b; + b = cy; + } + while (++i < n); + + return b; +} + +mp_limb_t +mpn_sub_n (mp_ptr rp, mp_srcptr ap, mp_srcptr bp, mp_size_t n) +{ + mp_size_t i; + mp_limb_t cy; + + for (i = 0, cy = 0; i < n; i++) + { + mp_limb_t a, b; + a = ap[i]; b = bp[i]; + b += cy; + cy = (b < cy); + cy += (a < b); + rp[i] = a - b; + } + return cy; +} + +mp_limb_t +mpn_sub (mp_ptr rp, mp_srcptr ap, mp_size_t an, mp_srcptr bp, mp_size_t bn) +{ + mp_limb_t cy; + + assert (an >= bn); + + cy = mpn_sub_n (rp, ap, bp, bn); + if (an > bn) + cy = mpn_sub_1 (rp + bn, ap + bn, an - bn, cy); + return cy; +} + +mp_limb_t +mpn_mul_1 (mp_ptr rp, mp_srcptr up, mp_size_t n, mp_limb_t vl) +{ + mp_limb_t ul, cl, hpl, lpl; + + assert (n >= 1); + + cl = 0; + do + { + ul = *up++; + gmp_umul_ppmm (hpl, lpl, ul, vl); + + lpl += cl; + cl = (lpl < cl) + hpl; + + *rp++ = lpl; + } + while (--n != 0); + + return cl; +} + +mp_limb_t +mpn_addmul_1 (mp_ptr rp, mp_srcptr up, mp_size_t n, mp_limb_t vl) +{ + mp_limb_t ul, cl, hpl, lpl, rl; + + assert (n >= 1); + + cl = 0; + do + { + ul = *up++; + gmp_umul_ppmm (hpl, lpl, ul, vl); + + lpl += cl; + cl = (lpl < cl) + hpl; + + rl = *rp; + lpl = rl + lpl; + cl += lpl < rl; + *rp++ = lpl; + } + while (--n != 0); + + return cl; +} + +mp_limb_t +mpn_submul_1 (mp_ptr rp, mp_srcptr up, mp_size_t n, mp_limb_t vl) +{ + mp_limb_t ul, cl, hpl, lpl, rl; + + assert (n >= 1); + + cl = 0; + do + { + ul = *up++; + gmp_umul_ppmm (hpl, lpl, ul, vl); + + lpl += cl; + cl = (lpl < cl) + hpl; + + rl = *rp; + lpl = rl - lpl; + cl += lpl > rl; + *rp++ = lpl; + } + while (--n != 0); + + return cl; +} + +mp_limb_t +mpn_mul (mp_ptr rp, mp_srcptr up, mp_size_t un, mp_srcptr vp, mp_size_t vn) +{ + assert (un >= vn); + assert (vn >= 1); + assert (!GMP_MPN_OVERLAP_P(rp, un + vn, up, un)); + assert (!GMP_MPN_OVERLAP_P(rp, un + vn, vp, vn)); + + /* We first multiply by the low order limb. This result can be + stored, not added, to rp. We also avoid a loop for zeroing this + way. */ + + rp[un] = mpn_mul_1 (rp, up, un, vp[0]); + + /* Now accumulate the product of up[] and the next higher limb from + vp[]. */ + + while (--vn >= 1) + { + rp += 1, vp += 1; + rp[un] = mpn_addmul_1 (rp, up, un, vp[0]); + } + return rp[un]; +} + +void +mpn_mul_n (mp_ptr rp, mp_srcptr ap, mp_srcptr bp, mp_size_t n) +{ + mpn_mul (rp, ap, n, bp, n); +} + +void +mpn_sqr (mp_ptr rp, mp_srcptr ap, mp_size_t n) +{ + mpn_mul (rp, ap, n, ap, n); +} + +mp_limb_t +mpn_lshift (mp_ptr rp, mp_srcptr up, mp_size_t n, unsigned int cnt) +{ + mp_limb_t high_limb, low_limb; + unsigned int tnc; + mp_limb_t retval; + + assert (n >= 1); + assert (cnt >= 1); + assert (cnt < GMP_LIMB_BITS); + + up += n; + rp += n; + + tnc = GMP_LIMB_BITS - cnt; + low_limb = *--up; + retval = low_limb >> tnc; + high_limb = (low_limb << cnt); + + while (--n != 0) + { + low_limb = *--up; + *--rp = high_limb | (low_limb >> tnc); + high_limb = (low_limb << cnt); + } + *--rp = high_limb; + + return retval; +} + +mp_limb_t +mpn_rshift (mp_ptr rp, mp_srcptr up, mp_size_t n, unsigned int cnt) +{ + mp_limb_t high_limb, low_limb; + unsigned int tnc; + mp_limb_t retval; + + assert (n >= 1); + assert (cnt >= 1); + assert (cnt < GMP_LIMB_BITS); + + tnc = GMP_LIMB_BITS - cnt; + high_limb = *up++; + retval = (high_limb << tnc); + low_limb = high_limb >> cnt; + + while (--n != 0) + { + high_limb = *up++; + *rp++ = low_limb | (high_limb << tnc); + low_limb = high_limb >> cnt; + } + *rp = low_limb; + + return retval; +} + +static mp_bitcnt_t +mpn_common_scan (mp_limb_t limb, mp_size_t i, mp_srcptr up, mp_size_t un, + mp_limb_t ux) +{ + unsigned cnt; + + assert (ux == 0 || ux == GMP_LIMB_MAX); + assert (0 <= i && i <= un ); + + while (limb == 0) + { + i++; + if (i == un) + return (ux == 0 ? ~(mp_bitcnt_t) 0 : un * GMP_LIMB_BITS); + limb = ux ^ up[i]; + } + gmp_ctz (cnt, limb); + return (mp_bitcnt_t) i * GMP_LIMB_BITS + cnt; +} + +mp_bitcnt_t +mpn_scan1 (mp_srcptr ptr, mp_bitcnt_t bit) +{ + mp_size_t i; + i = bit / GMP_LIMB_BITS; + + return mpn_common_scan ( ptr[i] & (GMP_LIMB_MAX << (bit % GMP_LIMB_BITS)), + i, ptr, i, 0); +} + +mp_bitcnt_t +mpn_scan0 (mp_srcptr ptr, mp_bitcnt_t bit) +{ + mp_size_t i; + i = bit / GMP_LIMB_BITS; + + return mpn_common_scan (~ptr[i] & (GMP_LIMB_MAX << (bit % GMP_LIMB_BITS)), + i, ptr, i, GMP_LIMB_MAX); +} + +void +mpn_com (mp_ptr rp, mp_srcptr up, mp_size_t n) +{ + while (--n >= 0) + *rp++ = ~ *up++; +} + +mp_limb_t +mpn_neg (mp_ptr rp, mp_srcptr up, mp_size_t n) +{ + while (*up == 0) + { + *rp = 0; + if (!--n) + return 0; + ++up; ++rp; + } + *rp = - *up; + mpn_com (++rp, ++up, --n); + return 1; +} + + +/* MPN division interface. */ + +/* The 3/2 inverse is defined as + + m = floor( (B^3-1) / (B u1 + u0)) - B +*/ +mp_limb_t +mpn_invert_3by2 (mp_limb_t u1, mp_limb_t u0) +{ + mp_limb_t r, p, m, ql; + unsigned ul, uh, qh; + + assert (u1 >= GMP_LIMB_HIGHBIT); + + /* For notation, let b denote the half-limb base, so that B = b^2. + Split u1 = b uh + ul. */ + ul = u1 & GMP_LLIMB_MASK; + uh = u1 >> (GMP_LIMB_BITS / 2); + + /* Approximation of the high half of quotient. Differs from the 2/1 + inverse of the half limb uh, since we have already subtracted + u0. */ + qh = ~u1 / uh; + + /* Adjust to get a half-limb 3/2 inverse, i.e., we want + + qh' = floor( (b^3 - 1) / u) - b = floor ((b^3 - b u - 1) / u + = floor( (b (~u) + b-1) / u), + + and the remainder + + r = b (~u) + b-1 - qh (b uh + ul) + = b (~u - qh uh) + b-1 - qh ul + + Subtraction of qh ul may underflow, which implies adjustments. + But by normalization, 2 u >= B > qh ul, so we need to adjust by + at most 2. + */ + + r = ((~u1 - (mp_limb_t) qh * uh) << (GMP_LIMB_BITS / 2)) | GMP_LLIMB_MASK; + + p = (mp_limb_t) qh * ul; + /* Adjustment steps taken from udiv_qrnnd_c */ + if (r < p) + { + qh--; + r += u1; + if (r >= u1) /* i.e. we didn't get carry when adding to r */ + if (r < p) + { + qh--; + r += u1; + } + } + r -= p; + + /* Low half of the quotient is + + ql = floor ( (b r + b-1) / u1). + + This is a 3/2 division (on half-limbs), for which qh is a + suitable inverse. */ + + p = (r >> (GMP_LIMB_BITS / 2)) * qh + r; + /* Unlike full-limb 3/2, we can add 1 without overflow. For this to + work, it is essential that ql is a full mp_limb_t. */ + ql = (p >> (GMP_LIMB_BITS / 2)) + 1; + + /* By the 3/2 trick, we don't need the high half limb. */ + r = (r << (GMP_LIMB_BITS / 2)) + GMP_LLIMB_MASK - ql * u1; + + if (r >= (p << (GMP_LIMB_BITS / 2))) + { + ql--; + r += u1; + } + m = ((mp_limb_t) qh << (GMP_LIMB_BITS / 2)) + ql; + if (r >= u1) + { + m++; + r -= u1; + } + + /* Now m is the 2/1 invers of u1. If u0 > 0, adjust it to become a + 3/2 inverse. */ + if (u0 > 0) + { + mp_limb_t th, tl; + r = ~r; + r += u0; + if (r < u0) + { + m--; + if (r >= u1) + { + m--; + r -= u1; + } + r -= u1; + } + gmp_umul_ppmm (th, tl, u0, m); + r += th; + if (r < th) + { + m--; + m -= ((r > u1) | ((r == u1) & (tl > u0))); + } + } + + return m; +} + +struct gmp_div_inverse +{ + /* Normalization shift count. */ + unsigned shift; + /* Normalized divisor (d0 unused for mpn_div_qr_1) */ + mp_limb_t d1, d0; + /* Inverse, for 2/1 or 3/2. */ + mp_limb_t di; +}; + +static void +mpn_div_qr_1_invert (struct gmp_div_inverse *inv, mp_limb_t d) +{ + unsigned shift; + + assert (d > 0); + gmp_clz (shift, d); + inv->shift = shift; + inv->d1 = d << shift; + inv->di = mpn_invert_limb (inv->d1); +} + +static void +mpn_div_qr_2_invert (struct gmp_div_inverse *inv, + mp_limb_t d1, mp_limb_t d0) +{ + unsigned shift; + + assert (d1 > 0); + gmp_clz (shift, d1); + inv->shift = shift; + if (shift > 0) + { + d1 = (d1 << shift) | (d0 >> (GMP_LIMB_BITS - shift)); + d0 <<= shift; + } + inv->d1 = d1; + inv->d0 = d0; + inv->di = mpn_invert_3by2 (d1, d0); +} + +static void +mpn_div_qr_invert (struct gmp_div_inverse *inv, + mp_srcptr dp, mp_size_t dn) +{ + assert (dn > 0); + + if (dn == 1) + mpn_div_qr_1_invert (inv, dp[0]); + else if (dn == 2) + mpn_div_qr_2_invert (inv, dp[1], dp[0]); + else + { + unsigned shift; + mp_limb_t d1, d0; + + d1 = dp[dn-1]; + d0 = dp[dn-2]; + assert (d1 > 0); + gmp_clz (shift, d1); + inv->shift = shift; + if (shift > 0) + { + d1 = (d1 << shift) | (d0 >> (GMP_LIMB_BITS - shift)); + d0 = (d0 << shift) | (dp[dn-3] >> (GMP_LIMB_BITS - shift)); + } + inv->d1 = d1; + inv->d0 = d0; + inv->di = mpn_invert_3by2 (d1, d0); + } +} + +/* Not matching current public gmp interface, rather corresponding to + the sbpi1_div_* functions. */ +static mp_limb_t +mpn_div_qr_1_preinv (mp_ptr qp, mp_srcptr np, mp_size_t nn, + const struct gmp_div_inverse *inv) +{ + mp_limb_t d, di; + mp_limb_t r; + mp_ptr tp = NULL; + + if (inv->shift > 0) + { + /* Shift, reusing qp area if possible. In-place shift if qp == np. */ + tp = qp ? qp : gmp_xalloc_limbs (nn); + r = mpn_lshift (tp, np, nn, inv->shift); + np = tp; + } + else + r = 0; + + d = inv->d1; + di = inv->di; + while (--nn >= 0) + { + mp_limb_t q; + + gmp_udiv_qrnnd_preinv (q, r, r, np[nn], d, di); + if (qp) + qp[nn] = q; + } + if ((inv->shift > 0) && (tp != qp)) + gmp_free (tp); + + return r >> inv->shift; +} + +static mp_limb_t +mpn_div_qr_1 (mp_ptr qp, mp_srcptr np, mp_size_t nn, mp_limb_t d) +{ + assert (d > 0); + + /* Special case for powers of two. */ + if ((d & (d-1)) == 0) + { + mp_limb_t r = np[0] & (d-1); + if (qp) + { + if (d <= 1) + mpn_copyi (qp, np, nn); + else + { + unsigned shift; + gmp_ctz (shift, d); + mpn_rshift (qp, np, nn, shift); + } + } + return r; + } + else + { + struct gmp_div_inverse inv; + mpn_div_qr_1_invert (&inv, d); + return mpn_div_qr_1_preinv (qp, np, nn, &inv); + } +} + +static void +mpn_div_qr_2_preinv (mp_ptr qp, mp_ptr np, mp_size_t nn, + const struct gmp_div_inverse *inv) +{ + unsigned shift; + mp_size_t i; + mp_limb_t d1, d0, di, r1, r0; + + assert (nn >= 2); + shift = inv->shift; + d1 = inv->d1; + d0 = inv->d0; + di = inv->di; + + if (shift > 0) + r1 = mpn_lshift (np, np, nn, shift); + else + r1 = 0; + + r0 = np[nn - 1]; + + i = nn - 2; + do + { + mp_limb_t n0, q; + n0 = np[i]; + gmp_udiv_qr_3by2 (q, r1, r0, r1, r0, n0, d1, d0, di); + + if (qp) + qp[i] = q; + } + while (--i >= 0); + + if (shift > 0) + { + assert ((r0 << (GMP_LIMB_BITS - shift)) == 0); + r0 = (r0 >> shift) | (r1 << (GMP_LIMB_BITS - shift)); + r1 >>= shift; + } + + np[1] = r1; + np[0] = r0; +} + +static void +mpn_div_qr_pi1 (mp_ptr qp, + mp_ptr np, mp_size_t nn, mp_limb_t n1, + mp_srcptr dp, mp_size_t dn, + mp_limb_t dinv) +{ + mp_size_t i; + + mp_limb_t d1, d0; + mp_limb_t cy, cy1; + mp_limb_t q; + + assert (dn > 2); + assert (nn >= dn); + + d1 = dp[dn - 1]; + d0 = dp[dn - 2]; + + assert ((d1 & GMP_LIMB_HIGHBIT) != 0); + /* Iteration variable is the index of the q limb. + * + * We divide + * by + */ + + i = nn - dn; + do + { + mp_limb_t n0 = np[dn-1+i]; + + if (n1 == d1 && n0 == d0) + { + q = GMP_LIMB_MAX; + mpn_submul_1 (np+i, dp, dn, q); + n1 = np[dn-1+i]; /* update n1, last loop's value will now be invalid */ + } + else + { + gmp_udiv_qr_3by2 (q, n1, n0, n1, n0, np[dn-2+i], d1, d0, dinv); + + cy = mpn_submul_1 (np + i, dp, dn-2, q); + + cy1 = n0 < cy; + n0 = n0 - cy; + cy = n1 < cy1; + n1 = n1 - cy1; + np[dn-2+i] = n0; + + if (cy != 0) + { + n1 += d1 + mpn_add_n (np + i, np + i, dp, dn - 1); + q--; + } + } + + if (qp) + qp[i] = q; + } + while (--i >= 0); + + np[dn - 1] = n1; +} + +static void +mpn_div_qr_preinv (mp_ptr qp, mp_ptr np, mp_size_t nn, + mp_srcptr dp, mp_size_t dn, + const struct gmp_div_inverse *inv) +{ + assert (dn > 0); + assert (nn >= dn); + + if (dn == 1) + np[0] = mpn_div_qr_1_preinv (qp, np, nn, inv); + else if (dn == 2) + mpn_div_qr_2_preinv (qp, np, nn, inv); + else + { + mp_limb_t nh; + unsigned shift; + + assert (inv->d1 == dp[dn-1]); + assert (inv->d0 == dp[dn-2]); + assert ((inv->d1 & GMP_LIMB_HIGHBIT) != 0); + + shift = inv->shift; + if (shift > 0) + nh = mpn_lshift (np, np, nn, shift); + else + nh = 0; + + mpn_div_qr_pi1 (qp, np, nn, nh, dp, dn, inv->di); + + if (shift > 0) + gmp_assert_nocarry (mpn_rshift (np, np, dn, shift)); + } +} + +static void +mpn_div_qr (mp_ptr qp, mp_ptr np, mp_size_t nn, mp_srcptr dp, mp_size_t dn) +{ + struct gmp_div_inverse inv; + mp_ptr tp = NULL; + + assert (dn > 0); + assert (nn >= dn); + + mpn_div_qr_invert (&inv, dp, dn); + if (dn > 2 && inv.shift > 0) + { + tp = gmp_xalloc_limbs (dn); + gmp_assert_nocarry (mpn_lshift (tp, dp, dn, inv.shift)); + dp = tp; + } + mpn_div_qr_preinv (qp, np, nn, dp, dn, &inv); + if (tp) + gmp_free (tp); +} + + +/* MPN base conversion. */ +static unsigned +mpn_base_power_of_two_p (unsigned b) +{ + switch (b) + { + case 2: return 1; + case 4: return 2; + case 8: return 3; + case 16: return 4; + case 32: return 5; + case 64: return 6; + case 128: return 7; + case 256: return 8; + default: return 0; + } +} + +struct mpn_base_info +{ + /* bb is the largest power of the base which fits in one limb, and + exp is the corresponding exponent. */ + unsigned exp; + mp_limb_t bb; +}; + +static void +mpn_get_base_info (struct mpn_base_info *info, mp_limb_t b) +{ + mp_limb_t m; + mp_limb_t p; + unsigned exp; + + m = GMP_LIMB_MAX / b; + for (exp = 1, p = b; p <= m; exp++) + p *= b; + + info->exp = exp; + info->bb = p; +} + +static mp_bitcnt_t +mpn_limb_size_in_base_2 (mp_limb_t u) +{ + unsigned shift; + + assert (u > 0); + gmp_clz (shift, u); + return GMP_LIMB_BITS - shift; +} + +static size_t +mpn_get_str_bits (unsigned char *sp, unsigned bits, mp_srcptr up, mp_size_t un) +{ + unsigned char mask; + size_t sn, j; + mp_size_t i; + unsigned shift; + + sn = ((un - 1) * GMP_LIMB_BITS + mpn_limb_size_in_base_2 (up[un-1]) + + bits - 1) / bits; + + mask = (1U << bits) - 1; + + for (i = 0, j = sn, shift = 0; j-- > 0;) + { + unsigned char digit = up[i] >> shift; + + shift += bits; + + if (shift >= GMP_LIMB_BITS && ++i < un) + { + shift -= GMP_LIMB_BITS; + digit |= up[i] << (bits - shift); + } + sp[j] = digit & mask; + } + return sn; +} + +/* We generate digits from the least significant end, and reverse at + the end. */ +static size_t +mpn_limb_get_str (unsigned char *sp, mp_limb_t w, + const struct gmp_div_inverse *binv) +{ + mp_size_t i; + for (i = 0; w > 0; i++) + { + mp_limb_t h, l, r; + + h = w >> (GMP_LIMB_BITS - binv->shift); + l = w << binv->shift; + + gmp_udiv_qrnnd_preinv (w, r, h, l, binv->d1, binv->di); + assert ( (r << (GMP_LIMB_BITS - binv->shift)) == 0); + r >>= binv->shift; + + sp[i] = r; + } + return i; +} + +static size_t +mpn_get_str_other (unsigned char *sp, + int base, const struct mpn_base_info *info, + mp_ptr up, mp_size_t un) +{ + struct gmp_div_inverse binv; + size_t sn; + size_t i; + + mpn_div_qr_1_invert (&binv, base); + + sn = 0; + + if (un > 1) + { + struct gmp_div_inverse bbinv; + mpn_div_qr_1_invert (&bbinv, info->bb); + + do + { + mp_limb_t w; + size_t done; + w = mpn_div_qr_1_preinv (up, up, un, &bbinv); + un -= (up[un-1] == 0); + done = mpn_limb_get_str (sp + sn, w, &binv); + + for (sn += done; done < info->exp; done++) + sp[sn++] = 0; + } + while (un > 1); + } + sn += mpn_limb_get_str (sp + sn, up[0], &binv); + + /* Reverse order */ + for (i = 0; 2*i + 1 < sn; i++) + { + unsigned char t = sp[i]; + sp[i] = sp[sn - i - 1]; + sp[sn - i - 1] = t; + } + + return sn; +} + +size_t +mpn_get_str (unsigned char *sp, int base, mp_ptr up, mp_size_t un) +{ + unsigned bits; + + assert (un > 0); + assert (up[un-1] > 0); + + bits = mpn_base_power_of_two_p (base); + if (bits) + return mpn_get_str_bits (sp, bits, up, un); + else + { + struct mpn_base_info info; + + mpn_get_base_info (&info, base); + return mpn_get_str_other (sp, base, &info, up, un); + } +} + +static mp_size_t +mpn_set_str_bits (mp_ptr rp, const unsigned char *sp, size_t sn, + unsigned bits) +{ + mp_size_t rn; + size_t j; + unsigned shift; + + for (j = sn, rn = 0, shift = 0; j-- > 0; ) + { + if (shift == 0) + { + rp[rn++] = sp[j]; + shift += bits; + } + else + { + rp[rn-1] |= (mp_limb_t) sp[j] << shift; + shift += bits; + if (shift >= GMP_LIMB_BITS) + { + shift -= GMP_LIMB_BITS; + if (shift > 0) + rp[rn++] = (mp_limb_t) sp[j] >> (bits - shift); + } + } + } + rn = mpn_normalized_size (rp, rn); + return rn; +} + +/* Result is usually normalized, except for all-zero input, in which + case a single zero limb is written at *RP, and 1 is returned. */ +static mp_size_t +mpn_set_str_other (mp_ptr rp, const unsigned char *sp, size_t sn, + mp_limb_t b, const struct mpn_base_info *info) +{ + mp_size_t rn; + mp_limb_t w; + unsigned k; + size_t j; + + assert (sn > 0); + + k = 1 + (sn - 1) % info->exp; + + j = 0; + w = sp[j++]; + while (--k != 0) + w = w * b + sp[j++]; + + rp[0] = w; + + for (rn = 1; j < sn;) + { + mp_limb_t cy; + + w = sp[j++]; + for (k = 1; k < info->exp; k++) + w = w * b + sp[j++]; + + cy = mpn_mul_1 (rp, rp, rn, info->bb); + cy += mpn_add_1 (rp, rp, rn, w); + if (cy > 0) + rp[rn++] = cy; + } + assert (j == sn); + + return rn; +} + +mp_size_t +mpn_set_str (mp_ptr rp, const unsigned char *sp, size_t sn, int base) +{ + unsigned bits; + + if (sn == 0) + return 0; + + bits = mpn_base_power_of_two_p (base); + if (bits) + return mpn_set_str_bits (rp, sp, sn, bits); + else + { + struct mpn_base_info info; + + mpn_get_base_info (&info, base); + return mpn_set_str_other (rp, sp, sn, base, &info); + } +} + + +/* MPZ interface */ +void +mpz_init (mpz_t r) +{ + static const mp_limb_t dummy_limb = 0xc1a0; + + r->_mp_alloc = 0; + r->_mp_size = 0; + r->_mp_d = (mp_ptr) &dummy_limb; +} + +/* The utility of this function is a bit limited, since many functions + assigns the result variable using mpz_swap. */ +void +mpz_init2 (mpz_t r, mp_bitcnt_t bits) +{ + mp_size_t rn; + + bits -= (bits != 0); /* Round down, except if 0 */ + rn = 1 + bits / GMP_LIMB_BITS; + + r->_mp_alloc = rn; + r->_mp_size = 0; + r->_mp_d = gmp_xalloc_limbs (rn); +} + +void +mpz_clear (mpz_t r) +{ + if (r->_mp_alloc) + gmp_free (r->_mp_d); +} + +static mp_ptr +mpz_realloc (mpz_t r, mp_size_t size) +{ + size = GMP_MAX (size, 1); + + if (r->_mp_alloc) + r->_mp_d = gmp_xrealloc_limbs (r->_mp_d, size); + else + r->_mp_d = gmp_xalloc_limbs (size); + r->_mp_alloc = size; + + if (GMP_ABS (r->_mp_size) > size) + r->_mp_size = 0; + + return r->_mp_d; +} + +/* Realloc for an mpz_t WHAT if it has less than NEEDED limbs. */ +#define MPZ_REALLOC(z,n) ((n) > (z)->_mp_alloc \ + ? mpz_realloc(z,n) \ + : (z)->_mp_d) + +/* MPZ assignment and basic conversions. */ +void +mpz_set_si (mpz_t r, signed long int x) +{ + if (x >= 0) + mpz_set_ui (r, x); + else /* (x < 0) */ + { + r->_mp_size = -1; + MPZ_REALLOC (r, 1)[0] = GMP_NEG_CAST (unsigned long int, x); + } +} + +void +mpz_set_ui (mpz_t r, unsigned long int x) +{ + if (x > 0) + { + r->_mp_size = 1; + MPZ_REALLOC (r, 1)[0] = x; + } + else + r->_mp_size = 0; +} + +void +mpz_set (mpz_t r, const mpz_t x) +{ + /* Allow the NOP r == x */ + if (r != x) + { + mp_size_t n; + mp_ptr rp; + + n = GMP_ABS (x->_mp_size); + rp = MPZ_REALLOC (r, n); + + mpn_copyi (rp, x->_mp_d, n); + r->_mp_size = x->_mp_size; + } +} + +void +mpz_init_set_si (mpz_t r, signed long int x) +{ + mpz_init (r); + mpz_set_si (r, x); +} + +void +mpz_init_set_ui (mpz_t r, unsigned long int x) +{ + mpz_init (r); + mpz_set_ui (r, x); +} + +void +mpz_init_set (mpz_t r, const mpz_t x) +{ + mpz_init (r); + mpz_set (r, x); +} + +int +mpz_fits_slong_p (const mpz_t u) +{ + mp_size_t us = u->_mp_size; + + if (us == 1) + return u->_mp_d[0] < GMP_LIMB_HIGHBIT; + else if (us == -1) + return u->_mp_d[0] <= GMP_LIMB_HIGHBIT; + else + return (us == 0); +} + +int +mpz_fits_ulong_p (const mpz_t u) +{ + mp_size_t us = u->_mp_size; + + return (us == (us > 0)); +} + +long int +mpz_get_si (const mpz_t u) +{ + if (u->_mp_size < 0) + /* This expression is necessary to properly handle 0x80000000 */ + return -1 - (long) ((u->_mp_d[0] - 1) & ~GMP_LIMB_HIGHBIT); + else + return (long) (mpz_get_ui (u) & ~GMP_LIMB_HIGHBIT); +} + +unsigned long int +mpz_get_ui (const mpz_t u) +{ + return u->_mp_size == 0 ? 0 : u->_mp_d[0]; +} + +size_t +mpz_size (const mpz_t u) +{ + return GMP_ABS (u->_mp_size); +} + +mp_limb_t +mpz_getlimbn (const mpz_t u, mp_size_t n) +{ + if (n >= 0 && n < GMP_ABS (u->_mp_size)) + return u->_mp_d[n]; + else + return 0; +} + +void +mpz_realloc2 (mpz_t x, mp_bitcnt_t n) +{ + mpz_realloc (x, 1 + (n - (n != 0)) / GMP_LIMB_BITS); +} + +mp_srcptr +mpz_limbs_read (mpz_srcptr x) +{ + return x->_mp_d; +} + +mp_ptr +mpz_limbs_modify (mpz_t x, mp_size_t n) +{ + assert (n > 0); + return MPZ_REALLOC (x, n); +} + +mp_ptr +mpz_limbs_write (mpz_t x, mp_size_t n) +{ + return mpz_limbs_modify (x, n); +} + +void +mpz_limbs_finish (mpz_t x, mp_size_t xs) +{ + mp_size_t xn; + xn = mpn_normalized_size (x->_mp_d, GMP_ABS (xs)); + x->_mp_size = xs < 0 ? -xn : xn; +} + +static mpz_srcptr +mpz_roinit_normal_n (mpz_t x, mp_srcptr xp, mp_size_t xs) +{ + x->_mp_alloc = 0; + x->_mp_d = (mp_ptr) xp; + x->_mp_size = xs; + return x; +} + +mpz_srcptr +mpz_roinit_n (mpz_t x, mp_srcptr xp, mp_size_t xs) +{ + mpz_roinit_normal_n (x, xp, xs); + mpz_limbs_finish (x, xs); + return x; +} + + +/* Conversions and comparison to double. */ +void +mpz_set_d (mpz_t r, double x) +{ + int sign; + mp_ptr rp; + mp_size_t rn, i; + double B; + double Bi; + mp_limb_t f; + + /* x != x is true when x is a NaN, and x == x * 0.5 is true when x is + zero or infinity. */ + if (x != x || x == x * 0.5) + { + r->_mp_size = 0; + return; + } + + sign = x < 0.0 ; + if (sign) + x = - x; + + if (x < 1.0) + { + r->_mp_size = 0; + return; + } + B = 2.0 * (double) GMP_LIMB_HIGHBIT; + Bi = 1.0 / B; + for (rn = 1; x >= B; rn++) + x *= Bi; + + rp = MPZ_REALLOC (r, rn); + + f = (mp_limb_t) x; + x -= f; + assert (x < 1.0); + i = rn-1; + rp[i] = f; + while (--i >= 0) + { + x = B * x; + f = (mp_limb_t) x; + x -= f; + assert (x < 1.0); + rp[i] = f; + } + + r->_mp_size = sign ? - rn : rn; +} + +void +mpz_init_set_d (mpz_t r, double x) +{ + mpz_init (r); + mpz_set_d (r, x); +} + +double +mpz_get_d (const mpz_t u) +{ + int m; + mp_limb_t l; + mp_size_t un; + double x; + double B = 2.0 * (double) GMP_LIMB_HIGHBIT; + + un = GMP_ABS (u->_mp_size); + + if (un == 0) + return 0.0; + + l = u->_mp_d[--un]; + gmp_clz (m, l); + m = m + GMP_DBL_MANT_BITS - GMP_LIMB_BITS; + if (m < 0) + l &= GMP_LIMB_MAX << -m; + + for (x = l; --un >= 0;) + { + x = B*x; + if (m > 0) { + l = u->_mp_d[un]; + m -= GMP_LIMB_BITS; + if (m < 0) + l &= GMP_LIMB_MAX << -m; + x += l; + } + } + + if (u->_mp_size < 0) + x = -x; + + return x; +} + +int +mpz_cmpabs_d (const mpz_t x, double d) +{ + mp_size_t xn; + double B, Bi; + mp_size_t i; + + xn = x->_mp_size; + d = GMP_ABS (d); + + if (xn != 0) + { + xn = GMP_ABS (xn); + + B = 2.0 * (double) GMP_LIMB_HIGHBIT; + Bi = 1.0 / B; + + /* Scale d so it can be compared with the top limb. */ + for (i = 1; i < xn; i++) + d *= Bi; + + if (d >= B) + return -1; + + /* Compare floor(d) to top limb, subtract and cancel when equal. */ + for (i = xn; i-- > 0;) + { + mp_limb_t f, xl; + + f = (mp_limb_t) d; + xl = x->_mp_d[i]; + if (xl > f) + return 1; + else if (xl < f) + return -1; + d = B * (d - f); + } + } + return - (d > 0.0); +} + +int +mpz_cmp_d (const mpz_t x, double d) +{ + if (x->_mp_size < 0) + { + if (d >= 0.0) + return -1; + else + return -mpz_cmpabs_d (x, d); + } + else + { + if (d < 0.0) + return 1; + else + return mpz_cmpabs_d (x, d); + } +} + + +/* MPZ comparisons and the like. */ +int +mpz_sgn (const mpz_t u) +{ + return GMP_CMP (u->_mp_size, 0); +} + +int +mpz_cmp_si (const mpz_t u, long v) +{ + mp_size_t usize = u->_mp_size; + + if (usize < -1) + return -1; + else if (v >= 0) + return mpz_cmp_ui (u, v); + else if (usize >= 0) + return 1; + else /* usize == -1 */ + return GMP_CMP (GMP_NEG_CAST (mp_limb_t, v), u->_mp_d[0]); +} + +int +mpz_cmp_ui (const mpz_t u, unsigned long v) +{ + mp_size_t usize = u->_mp_size; + + if (usize > 1) + return 1; + else if (usize < 0) + return -1; + else + return GMP_CMP (mpz_get_ui (u), v); +} + +int +mpz_cmp (const mpz_t a, const mpz_t b) +{ + mp_size_t asize = a->_mp_size; + mp_size_t bsize = b->_mp_size; + + if (asize != bsize) + return (asize < bsize) ? -1 : 1; + else if (asize >= 0) + return mpn_cmp (a->_mp_d, b->_mp_d, asize); + else + return mpn_cmp (b->_mp_d, a->_mp_d, -asize); +} + +int +mpz_cmpabs_ui (const mpz_t u, unsigned long v) +{ + if (GMP_ABS (u->_mp_size) > 1) + return 1; + else + return GMP_CMP (mpz_get_ui (u), v); +} + +int +mpz_cmpabs (const mpz_t u, const mpz_t v) +{ + return mpn_cmp4 (u->_mp_d, GMP_ABS (u->_mp_size), + v->_mp_d, GMP_ABS (v->_mp_size)); +} + +void +mpz_abs (mpz_t r, const mpz_t u) +{ + mpz_set (r, u); + r->_mp_size = GMP_ABS (r->_mp_size); +} + +void +mpz_neg (mpz_t r, const mpz_t u) +{ + mpz_set (r, u); + r->_mp_size = -r->_mp_size; +} + +void +mpz_swap (mpz_t u, mpz_t v) +{ + MP_SIZE_T_SWAP (u->_mp_size, v->_mp_size); + MP_SIZE_T_SWAP (u->_mp_alloc, v->_mp_alloc); + MP_PTR_SWAP (u->_mp_d, v->_mp_d); +} + + +/* MPZ addition and subtraction */ + +/* Adds to the absolute value. Returns new size, but doesn't store it. */ +static mp_size_t +mpz_abs_add_ui (mpz_t r, const mpz_t a, unsigned long b) +{ + mp_size_t an; + mp_ptr rp; + mp_limb_t cy; + + an = GMP_ABS (a->_mp_size); + if (an == 0) + { + MPZ_REALLOC (r, 1)[0] = b; + return b > 0; + } + + rp = MPZ_REALLOC (r, an + 1); + + cy = mpn_add_1 (rp, a->_mp_d, an, b); + rp[an] = cy; + an += cy; + + return an; +} + +/* Subtract from the absolute value. Returns new size, (or -1 on underflow), + but doesn't store it. */ +static mp_size_t +mpz_abs_sub_ui (mpz_t r, const mpz_t a, unsigned long b) +{ + mp_size_t an = GMP_ABS (a->_mp_size); + mp_ptr rp; + + if (an == 0) + { + MPZ_REALLOC (r, 1)[0] = b; + return -(b > 0); + } + rp = MPZ_REALLOC (r, an); + if (an == 1 && a->_mp_d[0] < b) + { + rp[0] = b - a->_mp_d[0]; + return -1; + } + else + { + gmp_assert_nocarry (mpn_sub_1 (rp, a->_mp_d, an, b)); + return mpn_normalized_size (rp, an); + } +} + +void +mpz_add_ui (mpz_t r, const mpz_t a, unsigned long b) +{ + if (a->_mp_size >= 0) + r->_mp_size = mpz_abs_add_ui (r, a, b); + else + r->_mp_size = -mpz_abs_sub_ui (r, a, b); +} + +void +mpz_sub_ui (mpz_t r, const mpz_t a, unsigned long b) +{ + if (a->_mp_size < 0) + r->_mp_size = -mpz_abs_add_ui (r, a, b); + else + r->_mp_size = mpz_abs_sub_ui (r, a, b); +} + +void +mpz_ui_sub (mpz_t r, unsigned long a, const mpz_t b) +{ + if (b->_mp_size < 0) + r->_mp_size = mpz_abs_add_ui (r, b, a); + else + r->_mp_size = -mpz_abs_sub_ui (r, b, a); +} + +static mp_size_t +mpz_abs_add (mpz_t r, const mpz_t a, const mpz_t b) +{ + mp_size_t an = GMP_ABS (a->_mp_size); + mp_size_t bn = GMP_ABS (b->_mp_size); + mp_ptr rp; + mp_limb_t cy; + + if (an < bn) + { + MPZ_SRCPTR_SWAP (a, b); + MP_SIZE_T_SWAP (an, bn); + } + + rp = MPZ_REALLOC (r, an + 1); + cy = mpn_add (rp, a->_mp_d, an, b->_mp_d, bn); + + rp[an] = cy; + + return an + cy; +} + +static mp_size_t +mpz_abs_sub (mpz_t r, const mpz_t a, const mpz_t b) +{ + mp_size_t an = GMP_ABS (a->_mp_size); + mp_size_t bn = GMP_ABS (b->_mp_size); + int cmp; + mp_ptr rp; + + cmp = mpn_cmp4 (a->_mp_d, an, b->_mp_d, bn); + if (cmp > 0) + { + rp = MPZ_REALLOC (r, an); + gmp_assert_nocarry (mpn_sub (rp, a->_mp_d, an, b->_mp_d, bn)); + return mpn_normalized_size (rp, an); + } + else if (cmp < 0) + { + rp = MPZ_REALLOC (r, bn); + gmp_assert_nocarry (mpn_sub (rp, b->_mp_d, bn, a->_mp_d, an)); + return -mpn_normalized_size (rp, bn); + } + else + return 0; +} + +void +mpz_add (mpz_t r, const mpz_t a, const mpz_t b) +{ + mp_size_t rn; + + if ( (a->_mp_size ^ b->_mp_size) >= 0) + rn = mpz_abs_add (r, a, b); + else + rn = mpz_abs_sub (r, a, b); + + r->_mp_size = a->_mp_size >= 0 ? rn : - rn; +} + +void +mpz_sub (mpz_t r, const mpz_t a, const mpz_t b) +{ + mp_size_t rn; + + if ( (a->_mp_size ^ b->_mp_size) >= 0) + rn = mpz_abs_sub (r, a, b); + else + rn = mpz_abs_add (r, a, b); + + r->_mp_size = a->_mp_size >= 0 ? rn : - rn; +} + + +/* MPZ multiplication */ +void +mpz_mul_si (mpz_t r, const mpz_t u, long int v) +{ + if (v < 0) + { + mpz_mul_ui (r, u, GMP_NEG_CAST (unsigned long int, v)); + mpz_neg (r, r); + } + else + mpz_mul_ui (r, u, (unsigned long int) v); +} + +void +mpz_mul_ui (mpz_t r, const mpz_t u, unsigned long int v) +{ + mp_size_t un, us; + mp_ptr tp; + mp_limb_t cy; + + us = u->_mp_size; + + if (us == 0 || v == 0) + { + r->_mp_size = 0; + return; + } + + un = GMP_ABS (us); + + tp = MPZ_REALLOC (r, un + 1); + cy = mpn_mul_1 (tp, u->_mp_d, un, v); + tp[un] = cy; + + un += (cy > 0); + r->_mp_size = (us < 0) ? - un : un; +} + +void +mpz_mul (mpz_t r, const mpz_t u, const mpz_t v) +{ + int sign; + mp_size_t un, vn, rn; + mpz_t t; + mp_ptr tp; + + un = u->_mp_size; + vn = v->_mp_size; + + if (un == 0 || vn == 0) + { + r->_mp_size = 0; + return; + } + + sign = (un ^ vn) < 0; + + un = GMP_ABS (un); + vn = GMP_ABS (vn); + + mpz_init2 (t, (un + vn) * GMP_LIMB_BITS); + + tp = t->_mp_d; + if (un >= vn) + mpn_mul (tp, u->_mp_d, un, v->_mp_d, vn); + else + mpn_mul (tp, v->_mp_d, vn, u->_mp_d, un); + + rn = un + vn; + rn -= tp[rn-1] == 0; + + t->_mp_size = sign ? - rn : rn; + mpz_swap (r, t); + mpz_clear (t); +} + +void +mpz_mul_2exp (mpz_t r, const mpz_t u, mp_bitcnt_t bits) +{ + mp_size_t un, rn; + mp_size_t limbs; + unsigned shift; + mp_ptr rp; + + un = GMP_ABS (u->_mp_size); + if (un == 0) + { + r->_mp_size = 0; + return; + } + + limbs = bits / GMP_LIMB_BITS; + shift = bits % GMP_LIMB_BITS; + + rn = un + limbs + (shift > 0); + rp = MPZ_REALLOC (r, rn); + if (shift > 0) + { + mp_limb_t cy = mpn_lshift (rp + limbs, u->_mp_d, un, shift); + rp[rn-1] = cy; + rn -= (cy == 0); + } + else + mpn_copyd (rp + limbs, u->_mp_d, un); + + mpn_zero (rp, limbs); + + r->_mp_size = (u->_mp_size < 0) ? - rn : rn; +} + +void +mpz_addmul_ui (mpz_t r, const mpz_t u, unsigned long int v) +{ + mpz_t t; + mpz_init (t); + mpz_mul_ui (t, u, v); + mpz_add (r, r, t); + mpz_clear (t); +} + +void +mpz_submul_ui (mpz_t r, const mpz_t u, unsigned long int v) +{ + mpz_t t; + mpz_init (t); + mpz_mul_ui (t, u, v); + mpz_sub (r, r, t); + mpz_clear (t); +} + +void +mpz_addmul (mpz_t r, const mpz_t u, const mpz_t v) +{ + mpz_t t; + mpz_init (t); + mpz_mul (t, u, v); + mpz_add (r, r, t); + mpz_clear (t); +} + +void +mpz_submul (mpz_t r, const mpz_t u, const mpz_t v) +{ + mpz_t t; + mpz_init (t); + mpz_mul (t, u, v); + mpz_sub (r, r, t); + mpz_clear (t); +} + + +/* MPZ division */ +enum mpz_div_round_mode { GMP_DIV_FLOOR, GMP_DIV_CEIL, GMP_DIV_TRUNC }; + +/* Allows q or r to be zero. Returns 1 iff remainder is non-zero. */ +static int +mpz_div_qr (mpz_t q, mpz_t r, + const mpz_t n, const mpz_t d, enum mpz_div_round_mode mode) +{ + mp_size_t ns, ds, nn, dn, qs; + ns = n->_mp_size; + ds = d->_mp_size; + + if (ds == 0) + gmp_die("mpz_div_qr: Divide by zero."); + + if (ns == 0) + { + if (q) + q->_mp_size = 0; + if (r) + r->_mp_size = 0; + return 0; + } + + nn = GMP_ABS (ns); + dn = GMP_ABS (ds); + + qs = ds ^ ns; + + if (nn < dn) + { + if (mode == GMP_DIV_CEIL && qs >= 0) + { + /* q = 1, r = n - d */ + if (r) + mpz_sub (r, n, d); + if (q) + mpz_set_ui (q, 1); + } + else if (mode == GMP_DIV_FLOOR && qs < 0) + { + /* q = -1, r = n + d */ + if (r) + mpz_add (r, n, d); + if (q) + mpz_set_si (q, -1); + } + else + { + /* q = 0, r = d */ + if (r) + mpz_set (r, n); + if (q) + q->_mp_size = 0; + } + return 1; + } + else + { + mp_ptr np, qp; + mp_size_t qn, rn; + mpz_t tq, tr; + + mpz_init_set (tr, n); + np = tr->_mp_d; + + qn = nn - dn + 1; + + if (q) + { + mpz_init2 (tq, qn * GMP_LIMB_BITS); + qp = tq->_mp_d; + } + else + qp = NULL; + + mpn_div_qr (qp, np, nn, d->_mp_d, dn); + + if (qp) + { + qn -= (qp[qn-1] == 0); + + tq->_mp_size = qs < 0 ? -qn : qn; + } + rn = mpn_normalized_size (np, dn); + tr->_mp_size = ns < 0 ? - rn : rn; + + if (mode == GMP_DIV_FLOOR && qs < 0 && rn != 0) + { + if (q) + mpz_sub_ui (tq, tq, 1); + if (r) + mpz_add (tr, tr, d); + } + else if (mode == GMP_DIV_CEIL && qs >= 0 && rn != 0) + { + if (q) + mpz_add_ui (tq, tq, 1); + if (r) + mpz_sub (tr, tr, d); + } + + if (q) + { + mpz_swap (tq, q); + mpz_clear (tq); + } + if (r) + mpz_swap (tr, r); + + mpz_clear (tr); + + return rn != 0; + } +} + +void +mpz_cdiv_qr (mpz_t q, mpz_t r, const mpz_t n, const mpz_t d) +{ + mpz_div_qr (q, r, n, d, GMP_DIV_CEIL); +} + +void +mpz_fdiv_qr (mpz_t q, mpz_t r, const mpz_t n, const mpz_t d) +{ + mpz_div_qr (q, r, n, d, GMP_DIV_FLOOR); +} + +void +mpz_tdiv_qr (mpz_t q, mpz_t r, const mpz_t n, const mpz_t d) +{ + mpz_div_qr (q, r, n, d, GMP_DIV_TRUNC); +} + +void +mpz_cdiv_q (mpz_t q, const mpz_t n, const mpz_t d) +{ + mpz_div_qr (q, NULL, n, d, GMP_DIV_CEIL); +} + +void +mpz_fdiv_q (mpz_t q, const mpz_t n, const mpz_t d) +{ + mpz_div_qr (q, NULL, n, d, GMP_DIV_FLOOR); +} + +void +mpz_tdiv_q (mpz_t q, const mpz_t n, const mpz_t d) +{ + mpz_div_qr (q, NULL, n, d, GMP_DIV_TRUNC); +} + +void +mpz_cdiv_r (mpz_t r, const mpz_t n, const mpz_t d) +{ + mpz_div_qr (NULL, r, n, d, GMP_DIV_CEIL); +} + +void +mpz_fdiv_r (mpz_t r, const mpz_t n, const mpz_t d) +{ + mpz_div_qr (NULL, r, n, d, GMP_DIV_FLOOR); +} + +void +mpz_tdiv_r (mpz_t r, const mpz_t n, const mpz_t d) +{ + mpz_div_qr (NULL, r, n, d, GMP_DIV_TRUNC); +} + +void +mpz_mod (mpz_t r, const mpz_t n, const mpz_t d) +{ + mpz_div_qr (NULL, r, n, d, d->_mp_size >= 0 ? GMP_DIV_FLOOR : GMP_DIV_CEIL); +} + +static void +mpz_div_q_2exp (mpz_t q, const mpz_t u, mp_bitcnt_t bit_index, + enum mpz_div_round_mode mode) +{ + mp_size_t un, qn; + mp_size_t limb_cnt; + mp_ptr qp; + int adjust; + + un = u->_mp_size; + if (un == 0) + { + q->_mp_size = 0; + return; + } + limb_cnt = bit_index / GMP_LIMB_BITS; + qn = GMP_ABS (un) - limb_cnt; + bit_index %= GMP_LIMB_BITS; + + if (mode == ((un > 0) ? GMP_DIV_CEIL : GMP_DIV_FLOOR)) /* un != 0 here. */ + /* Note: Below, the final indexing at limb_cnt is valid because at + that point we have qn > 0. */ + adjust = (qn <= 0 + || !mpn_zero_p (u->_mp_d, limb_cnt) + || (u->_mp_d[limb_cnt] + & (((mp_limb_t) 1 << bit_index) - 1))); + else + adjust = 0; + + if (qn <= 0) + qn = 0; + else + { + qp = MPZ_REALLOC (q, qn); + + if (bit_index != 0) + { + mpn_rshift (qp, u->_mp_d + limb_cnt, qn, bit_index); + qn -= qp[qn - 1] == 0; + } + else + { + mpn_copyi (qp, u->_mp_d + limb_cnt, qn); + } + } + + q->_mp_size = qn; + + if (adjust) + mpz_add_ui (q, q, 1); + if (un < 0) + mpz_neg (q, q); +} + +static void +mpz_div_r_2exp (mpz_t r, const mpz_t u, mp_bitcnt_t bit_index, + enum mpz_div_round_mode mode) +{ + mp_size_t us, un, rn; + mp_ptr rp; + mp_limb_t mask; + + us = u->_mp_size; + if (us == 0 || bit_index == 0) + { + r->_mp_size = 0; + return; + } + rn = (bit_index + GMP_LIMB_BITS - 1) / GMP_LIMB_BITS; + assert (rn > 0); + + rp = MPZ_REALLOC (r, rn); + un = GMP_ABS (us); + + mask = GMP_LIMB_MAX >> (rn * GMP_LIMB_BITS - bit_index); + + if (rn > un) + { + /* Quotient (with truncation) is zero, and remainder is + non-zero */ + if (mode == ((us > 0) ? GMP_DIV_CEIL : GMP_DIV_FLOOR)) /* us != 0 here. */ + { + /* Have to negate and sign extend. */ + mp_size_t i; + + gmp_assert_nocarry (! mpn_neg (rp, u->_mp_d, un)); + for (i = un; i < rn - 1; i++) + rp[i] = GMP_LIMB_MAX; + + rp[rn-1] = mask; + us = -us; + } + else + { + /* Just copy */ + if (r != u) + mpn_copyi (rp, u->_mp_d, un); + + rn = un; + } + } + else + { + if (r != u) + mpn_copyi (rp, u->_mp_d, rn - 1); + + rp[rn-1] = u->_mp_d[rn-1] & mask; + + if (mode == ((us > 0) ? GMP_DIV_CEIL : GMP_DIV_FLOOR)) /* us != 0 here. */ + { + /* If r != 0, compute 2^{bit_count} - r. */ + mpn_neg (rp, rp, rn); + + rp[rn-1] &= mask; + + /* us is not used for anything else, so we can modify it + here to indicate flipped sign. */ + us = -us; + } + } + rn = mpn_normalized_size (rp, rn); + r->_mp_size = us < 0 ? -rn : rn; +} + +void +mpz_cdiv_q_2exp (mpz_t r, const mpz_t u, mp_bitcnt_t cnt) +{ + mpz_div_q_2exp (r, u, cnt, GMP_DIV_CEIL); +} + +void +mpz_fdiv_q_2exp (mpz_t r, const mpz_t u, mp_bitcnt_t cnt) +{ + mpz_div_q_2exp (r, u, cnt, GMP_DIV_FLOOR); +} + +void +mpz_tdiv_q_2exp (mpz_t r, const mpz_t u, mp_bitcnt_t cnt) +{ + mpz_div_q_2exp (r, u, cnt, GMP_DIV_TRUNC); +} + +void +mpz_cdiv_r_2exp (mpz_t r, const mpz_t u, mp_bitcnt_t cnt) +{ + mpz_div_r_2exp (r, u, cnt, GMP_DIV_CEIL); +} + +void +mpz_fdiv_r_2exp (mpz_t r, const mpz_t u, mp_bitcnt_t cnt) +{ + mpz_div_r_2exp (r, u, cnt, GMP_DIV_FLOOR); +} + +void +mpz_tdiv_r_2exp (mpz_t r, const mpz_t u, mp_bitcnt_t cnt) +{ + mpz_div_r_2exp (r, u, cnt, GMP_DIV_TRUNC); +} + +void +mpz_divexact (mpz_t q, const mpz_t n, const mpz_t d) +{ + gmp_assert_nocarry (mpz_div_qr (q, NULL, n, d, GMP_DIV_TRUNC)); +} + +int +mpz_divisible_p (const mpz_t n, const mpz_t d) +{ + return mpz_div_qr (NULL, NULL, n, d, GMP_DIV_TRUNC) == 0; +} + +int +mpz_congruent_p (const mpz_t a, const mpz_t b, const mpz_t m) +{ + mpz_t t; + int res; + + /* a == b (mod 0) iff a == b */ + if (mpz_sgn (m) == 0) + return (mpz_cmp (a, b) == 0); + + mpz_init (t); + mpz_sub (t, a, b); + res = mpz_divisible_p (t, m); + mpz_clear (t); + + return res; +} + +static unsigned long +mpz_div_qr_ui (mpz_t q, mpz_t r, + const mpz_t n, unsigned long d, enum mpz_div_round_mode mode) +{ + mp_size_t ns, qn; + mp_ptr qp; + mp_limb_t rl; + mp_size_t rs; + + ns = n->_mp_size; + if (ns == 0) + { + if (q) + q->_mp_size = 0; + if (r) + r->_mp_size = 0; + return 0; + } + + qn = GMP_ABS (ns); + if (q) + qp = MPZ_REALLOC (q, qn); + else + qp = NULL; + + rl = mpn_div_qr_1 (qp, n->_mp_d, qn, d); + assert (rl < d); + + rs = rl > 0; + rs = (ns < 0) ? -rs : rs; + + if (rl > 0 && ( (mode == GMP_DIV_FLOOR && ns < 0) + || (mode == GMP_DIV_CEIL && ns >= 0))) + { + if (q) + gmp_assert_nocarry (mpn_add_1 (qp, qp, qn, 1)); + rl = d - rl; + rs = -rs; + } + + if (r) + { + MPZ_REALLOC (r, 1)[0] = rl; + r->_mp_size = rs; + } + if (q) + { + qn -= (qp[qn-1] == 0); + assert (qn == 0 || qp[qn-1] > 0); + + q->_mp_size = (ns < 0) ? - qn : qn; + } + + return rl; +} + +unsigned long +mpz_cdiv_qr_ui (mpz_t q, mpz_t r, const mpz_t n, unsigned long d) +{ + return mpz_div_qr_ui (q, r, n, d, GMP_DIV_CEIL); +} + +unsigned long +mpz_fdiv_qr_ui (mpz_t q, mpz_t r, const mpz_t n, unsigned long d) +{ + return mpz_div_qr_ui (q, r, n, d, GMP_DIV_FLOOR); +} + +unsigned long +mpz_tdiv_qr_ui (mpz_t q, mpz_t r, const mpz_t n, unsigned long d) +{ + return mpz_div_qr_ui (q, r, n, d, GMP_DIV_TRUNC); +} + +unsigned long +mpz_cdiv_q_ui (mpz_t q, const mpz_t n, unsigned long d) +{ + return mpz_div_qr_ui (q, NULL, n, d, GMP_DIV_CEIL); +} + +unsigned long +mpz_fdiv_q_ui (mpz_t q, const mpz_t n, unsigned long d) +{ + return mpz_div_qr_ui (q, NULL, n, d, GMP_DIV_FLOOR); +} + +unsigned long +mpz_tdiv_q_ui (mpz_t q, const mpz_t n, unsigned long d) +{ + return mpz_div_qr_ui (q, NULL, n, d, GMP_DIV_TRUNC); +} + +unsigned long +mpz_cdiv_r_ui (mpz_t r, const mpz_t n, unsigned long d) +{ + return mpz_div_qr_ui (NULL, r, n, d, GMP_DIV_CEIL); +} +unsigned long +mpz_fdiv_r_ui (mpz_t r, const mpz_t n, unsigned long d) +{ + return mpz_div_qr_ui (NULL, r, n, d, GMP_DIV_FLOOR); +} +unsigned long +mpz_tdiv_r_ui (mpz_t r, const mpz_t n, unsigned long d) +{ + return mpz_div_qr_ui (NULL, r, n, d, GMP_DIV_TRUNC); +} + +unsigned long +mpz_cdiv_ui (const mpz_t n, unsigned long d) +{ + return mpz_div_qr_ui (NULL, NULL, n, d, GMP_DIV_CEIL); +} + +unsigned long +mpz_fdiv_ui (const mpz_t n, unsigned long d) +{ + return mpz_div_qr_ui (NULL, NULL, n, d, GMP_DIV_FLOOR); +} + +unsigned long +mpz_tdiv_ui (const mpz_t n, unsigned long d) +{ + return mpz_div_qr_ui (NULL, NULL, n, d, GMP_DIV_TRUNC); +} + +unsigned long +mpz_mod_ui (mpz_t r, const mpz_t n, unsigned long d) +{ + return mpz_div_qr_ui (NULL, r, n, d, GMP_DIV_FLOOR); +} + +void +mpz_divexact_ui (mpz_t q, const mpz_t n, unsigned long d) +{ + gmp_assert_nocarry (mpz_div_qr_ui (q, NULL, n, d, GMP_DIV_TRUNC)); +} + +int +mpz_divisible_ui_p (const mpz_t n, unsigned long d) +{ + return mpz_div_qr_ui (NULL, NULL, n, d, GMP_DIV_TRUNC) == 0; +} + + +/* GCD */ +static mp_limb_t +mpn_gcd_11 (mp_limb_t u, mp_limb_t v) +{ + unsigned shift; + + assert ( (u | v) > 0); + + if (u == 0) + return v; + else if (v == 0) + return u; + + gmp_ctz (shift, u | v); + + u >>= shift; + v >>= shift; + + if ( (u & 1) == 0) + MP_LIMB_T_SWAP (u, v); + + while ( (v & 1) == 0) + v >>= 1; + + while (u != v) + { + if (u > v) + { + u -= v; + do + u >>= 1; + while ( (u & 1) == 0); + } + else + { + v -= u; + do + v >>= 1; + while ( (v & 1) == 0); + } + } + return u << shift; +} + +unsigned long +mpz_gcd_ui (mpz_t g, const mpz_t u, unsigned long v) +{ + mp_size_t un; + + if (v == 0) + { + if (g) + mpz_abs (g, u); + } + else + { + un = GMP_ABS (u->_mp_size); + if (un != 0) + v = mpn_gcd_11 (mpn_div_qr_1 (NULL, u->_mp_d, un, v), v); + + if (g) + mpz_set_ui (g, v); + } + + return v; +} + +static mp_bitcnt_t +mpz_make_odd (mpz_t r) +{ + mp_bitcnt_t shift; + + assert (r->_mp_size > 0); + /* Count trailing zeros, equivalent to mpn_scan1, because we know that there is a 1 */ + shift = mpn_common_scan (r->_mp_d[0], 0, r->_mp_d, 0, 0); + mpz_tdiv_q_2exp (r, r, shift); + + return shift; +} + +void +mpz_gcd (mpz_t g, const mpz_t u, const mpz_t v) +{ + mpz_t tu, tv; + mp_bitcnt_t uz, vz, gz; + + if (u->_mp_size == 0) + { + mpz_abs (g, v); + return; + } + if (v->_mp_size == 0) + { + mpz_abs (g, u); + return; + } + + mpz_init (tu); + mpz_init (tv); + + mpz_abs (tu, u); + uz = mpz_make_odd (tu); + mpz_abs (tv, v); + vz = mpz_make_odd (tv); + gz = GMP_MIN (uz, vz); + + if (tu->_mp_size < tv->_mp_size) + mpz_swap (tu, tv); + + mpz_tdiv_r (tu, tu, tv); + if (tu->_mp_size == 0) + { + mpz_swap (g, tv); + } + else + for (;;) + { + int c; + + mpz_make_odd (tu); + c = mpz_cmp (tu, tv); + if (c == 0) + { + mpz_swap (g, tu); + break; + } + if (c < 0) + mpz_swap (tu, tv); + + if (tv->_mp_size == 1) + { + mp_limb_t vl = tv->_mp_d[0]; + mp_limb_t ul = mpz_tdiv_ui (tu, vl); + mpz_set_ui (g, mpn_gcd_11 (ul, vl)); + break; + } + mpz_sub (tu, tu, tv); + } + mpz_clear (tu); + mpz_clear (tv); + mpz_mul_2exp (g, g, gz); +} + +void +mpz_gcdext (mpz_t g, mpz_t s, mpz_t t, const mpz_t u, const mpz_t v) +{ + mpz_t tu, tv, s0, s1, t0, t1; + mp_bitcnt_t uz, vz, gz; + mp_bitcnt_t power; + + if (u->_mp_size == 0) + { + /* g = 0 u + sgn(v) v */ + signed long sign = mpz_sgn (v); + mpz_abs (g, v); + if (s) + mpz_set_ui (s, 0); + if (t) + mpz_set_si (t, sign); + return; + } + + if (v->_mp_size == 0) + { + /* g = sgn(u) u + 0 v */ + signed long sign = mpz_sgn (u); + mpz_abs (g, u); + if (s) + mpz_set_si (s, sign); + if (t) + mpz_set_ui (t, 0); + return; + } + + mpz_init (tu); + mpz_init (tv); + mpz_init (s0); + mpz_init (s1); + mpz_init (t0); + mpz_init (t1); + + mpz_abs (tu, u); + uz = mpz_make_odd (tu); + mpz_abs (tv, v); + vz = mpz_make_odd (tv); + gz = GMP_MIN (uz, vz); + + uz -= gz; + vz -= gz; + + /* Cofactors corresponding to odd gcd. gz handled later. */ + if (tu->_mp_size < tv->_mp_size) + { + mpz_swap (tu, tv); + MPZ_SRCPTR_SWAP (u, v); + MPZ_PTR_SWAP (s, t); + MP_BITCNT_T_SWAP (uz, vz); + } + + /* Maintain + * + * u = t0 tu + t1 tv + * v = s0 tu + s1 tv + * + * where u and v denote the inputs with common factors of two + * eliminated, and det (s0, t0; s1, t1) = 2^p. Then + * + * 2^p tu = s1 u - t1 v + * 2^p tv = -s0 u + t0 v + */ + + /* After initial division, tu = q tv + tu', we have + * + * u = 2^uz (tu' + q tv) + * v = 2^vz tv + * + * or + * + * t0 = 2^uz, t1 = 2^uz q + * s0 = 0, s1 = 2^vz + */ + + mpz_setbit (t0, uz); + mpz_tdiv_qr (t1, tu, tu, tv); + mpz_mul_2exp (t1, t1, uz); + + mpz_setbit (s1, vz); + power = uz + vz; + + if (tu->_mp_size > 0) + { + mp_bitcnt_t shift; + shift = mpz_make_odd (tu); + mpz_mul_2exp (t0, t0, shift); + mpz_mul_2exp (s0, s0, shift); + power += shift; + + for (;;) + { + int c; + c = mpz_cmp (tu, tv); + if (c == 0) + break; + + if (c < 0) + { + /* tv = tv' + tu + * + * u = t0 tu + t1 (tv' + tu) = (t0 + t1) tu + t1 tv' + * v = s0 tu + s1 (tv' + tu) = (s0 + s1) tu + s1 tv' */ + + mpz_sub (tv, tv, tu); + mpz_add (t0, t0, t1); + mpz_add (s0, s0, s1); + + shift = mpz_make_odd (tv); + mpz_mul_2exp (t1, t1, shift); + mpz_mul_2exp (s1, s1, shift); + } + else + { + mpz_sub (tu, tu, tv); + mpz_add (t1, t0, t1); + mpz_add (s1, s0, s1); + + shift = mpz_make_odd (tu); + mpz_mul_2exp (t0, t0, shift); + mpz_mul_2exp (s0, s0, shift); + } + power += shift; + } + } + + /* Now tv = odd part of gcd, and -s0 and t0 are corresponding + cofactors. */ + + mpz_mul_2exp (tv, tv, gz); + mpz_neg (s0, s0); + + /* 2^p g = s0 u + t0 v. Eliminate one factor of two at a time. To + adjust cofactors, we need u / g and v / g */ + + mpz_divexact (s1, v, tv); + mpz_abs (s1, s1); + mpz_divexact (t1, u, tv); + mpz_abs (t1, t1); + + while (power-- > 0) + { + /* s0 u + t0 v = (s0 - v/g) u - (t0 + u/g) v */ + if (mpz_odd_p (s0) || mpz_odd_p (t0)) + { + mpz_sub (s0, s0, s1); + mpz_add (t0, t0, t1); + } + mpz_divexact_ui (s0, s0, 2); + mpz_divexact_ui (t0, t0, 2); + } + + /* Arrange so that |s| < |u| / 2g */ + mpz_add (s1, s0, s1); + if (mpz_cmpabs (s0, s1) > 0) + { + mpz_swap (s0, s1); + mpz_sub (t0, t0, t1); + } + if (u->_mp_size < 0) + mpz_neg (s0, s0); + if (v->_mp_size < 0) + mpz_neg (t0, t0); + + mpz_swap (g, tv); + if (s) + mpz_swap (s, s0); + if (t) + mpz_swap (t, t0); + + mpz_clear (tu); + mpz_clear (tv); + mpz_clear (s0); + mpz_clear (s1); + mpz_clear (t0); + mpz_clear (t1); +} + +void +mpz_lcm (mpz_t r, const mpz_t u, const mpz_t v) +{ + mpz_t g; + + if (u->_mp_size == 0 || v->_mp_size == 0) + { + r->_mp_size = 0; + return; + } + + mpz_init (g); + + mpz_gcd (g, u, v); + mpz_divexact (g, u, g); + mpz_mul (r, g, v); + + mpz_clear (g); + mpz_abs (r, r); +} + +void +mpz_lcm_ui (mpz_t r, const mpz_t u, unsigned long v) +{ + if (v == 0 || u->_mp_size == 0) + { + r->_mp_size = 0; + return; + } + + v /= mpz_gcd_ui (NULL, u, v); + mpz_mul_ui (r, u, v); + + mpz_abs (r, r); +} + +int +mpz_invert (mpz_t r, const mpz_t u, const mpz_t m) +{ + mpz_t g, tr; + int invertible; + + if (u->_mp_size == 0 || mpz_cmpabs_ui (m, 1) <= 0) + return 0; + + mpz_init (g); + mpz_init (tr); + + mpz_gcdext (g, tr, NULL, u, m); + invertible = (mpz_cmp_ui (g, 1) == 0); + + if (invertible) + { + if (tr->_mp_size < 0) + { + if (m->_mp_size >= 0) + mpz_add (tr, tr, m); + else + mpz_sub (tr, tr, m); + } + mpz_swap (r, tr); + } + + mpz_clear (g); + mpz_clear (tr); + return invertible; +} + + +/* Higher level operations (sqrt, pow and root) */ + +void +mpz_pow_ui (mpz_t r, const mpz_t b, unsigned long e) +{ + unsigned long bit; + mpz_t tr; + mpz_init_set_ui (tr, 1); + + bit = GMP_ULONG_HIGHBIT; + do + { + mpz_mul (tr, tr, tr); + if (e & bit) + mpz_mul (tr, tr, b); + bit >>= 1; + } + while (bit > 0); + + mpz_swap (r, tr); + mpz_clear (tr); +} + +void +mpz_ui_pow_ui (mpz_t r, unsigned long blimb, unsigned long e) +{ + mpz_t b; + mpz_pow_ui (r, mpz_roinit_normal_n (b, &blimb, blimb != 0), e); +} + +void +mpz_powm (mpz_t r, const mpz_t b, const mpz_t e, const mpz_t m) +{ + mpz_t tr; + mpz_t base; + mp_size_t en, mn; + mp_srcptr mp; + struct gmp_div_inverse minv; + unsigned shift; + mp_ptr tp = NULL; + + en = GMP_ABS (e->_mp_size); + mn = GMP_ABS (m->_mp_size); + if (mn == 0) + gmp_die ("mpz_powm: Zero modulo."); + + if (en == 0) + { + mpz_set_ui (r, 1); + return; + } + + mp = m->_mp_d; + mpn_div_qr_invert (&minv, mp, mn); + shift = minv.shift; + + if (shift > 0) + { + /* To avoid shifts, we do all our reductions, except the final + one, using a *normalized* m. */ + minv.shift = 0; + + tp = gmp_xalloc_limbs (mn); + gmp_assert_nocarry (mpn_lshift (tp, mp, mn, shift)); + mp = tp; + } + + mpz_init (base); + + if (e->_mp_size < 0) + { + if (!mpz_invert (base, b, m)) + gmp_die ("mpz_powm: Negative exponent and non-invertible base."); + } + else + { + mp_size_t bn; + mpz_abs (base, b); + + bn = base->_mp_size; + if (bn >= mn) + { + mpn_div_qr_preinv (NULL, base->_mp_d, base->_mp_size, mp, mn, &minv); + bn = mn; + } + + /* We have reduced the absolute value. Now take care of the + sign. Note that we get zero represented non-canonically as + m. */ + if (b->_mp_size < 0) + { + mp_ptr bp = MPZ_REALLOC (base, mn); + gmp_assert_nocarry (mpn_sub (bp, mp, mn, bp, bn)); + bn = mn; + } + base->_mp_size = mpn_normalized_size (base->_mp_d, bn); + } + mpz_init_set_ui (tr, 1); + + while (--en >= 0) + { + mp_limb_t w = e->_mp_d[en]; + mp_limb_t bit; + + bit = GMP_LIMB_HIGHBIT; + do + { + mpz_mul (tr, tr, tr); + if (w & bit) + mpz_mul (tr, tr, base); + if (tr->_mp_size > mn) + { + mpn_div_qr_preinv (NULL, tr->_mp_d, tr->_mp_size, mp, mn, &minv); + tr->_mp_size = mpn_normalized_size (tr->_mp_d, mn); + } + bit >>= 1; + } + while (bit > 0); + } + + /* Final reduction */ + if (tr->_mp_size >= mn) + { + minv.shift = shift; + mpn_div_qr_preinv (NULL, tr->_mp_d, tr->_mp_size, mp, mn, &minv); + tr->_mp_size = mpn_normalized_size (tr->_mp_d, mn); + } + if (tp) + gmp_free (tp); + + mpz_swap (r, tr); + mpz_clear (tr); + mpz_clear (base); +} + +void +mpz_powm_ui (mpz_t r, const mpz_t b, unsigned long elimb, const mpz_t m) +{ + mpz_t e; + mpz_powm (r, b, mpz_roinit_normal_n (e, &elimb, elimb != 0), m); +} + +/* x=trunc(y^(1/z)), r=y-x^z */ +void +mpz_rootrem (mpz_t x, mpz_t r, const mpz_t y, unsigned long z) +{ + int sgn; + mpz_t t, u; + + sgn = y->_mp_size < 0; + if ((~z & sgn) != 0) + gmp_die ("mpz_rootrem: Negative argument, with even root."); + if (z == 0) + gmp_die ("mpz_rootrem: Zeroth root."); + + if (mpz_cmpabs_ui (y, 1) <= 0) { + if (x) + mpz_set (x, y); + if (r) + r->_mp_size = 0; + return; + } + + mpz_init (u); + mpz_init (t); + mpz_setbit (t, mpz_sizeinbase (y, 2) / z + 1); + + if (z == 2) /* simplify sqrt loop: z-1 == 1 */ + do { + mpz_swap (u, t); /* u = x */ + mpz_tdiv_q (t, y, u); /* t = y/x */ + mpz_add (t, t, u); /* t = y/x + x */ + mpz_tdiv_q_2exp (t, t, 1); /* x'= (y/x + x)/2 */ + } while (mpz_cmpabs (t, u) < 0); /* |x'| < |x| */ + else /* z != 2 */ { + mpz_t v; + + mpz_init (v); + if (sgn) + mpz_neg (t, t); + + do { + mpz_swap (u, t); /* u = x */ + mpz_pow_ui (t, u, z - 1); /* t = x^(z-1) */ + mpz_tdiv_q (t, y, t); /* t = y/x^(z-1) */ + mpz_mul_ui (v, u, z - 1); /* v = x*(z-1) */ + mpz_add (t, t, v); /* t = y/x^(z-1) + x*(z-1) */ + mpz_tdiv_q_ui (t, t, z); /* x'=(y/x^(z-1) + x*(z-1))/z */ + } while (mpz_cmpabs (t, u) < 0); /* |x'| < |x| */ + + mpz_clear (v); + } + + if (r) { + mpz_pow_ui (t, u, z); + mpz_sub (r, y, t); + } + if (x) + mpz_swap (x, u); + mpz_clear (u); + mpz_clear (t); +} + +int +mpz_root (mpz_t x, const mpz_t y, unsigned long z) +{ + int res; + mpz_t r; + + mpz_init (r); + mpz_rootrem (x, r, y, z); + res = r->_mp_size == 0; + mpz_clear (r); + + return res; +} + +/* Compute s = floor(sqrt(u)) and r = u - s^2. Allows r == NULL */ +void +mpz_sqrtrem (mpz_t s, mpz_t r, const mpz_t u) +{ + mpz_rootrem (s, r, u, 2); +} + +void +mpz_sqrt (mpz_t s, const mpz_t u) +{ + mpz_rootrem (s, NULL, u, 2); +} + +int +mpz_perfect_square_p (const mpz_t u) +{ + if (u->_mp_size <= 0) + return (u->_mp_size == 0); + else + return mpz_root (NULL, u, 2); +} + +int +mpn_perfect_square_p (mp_srcptr p, mp_size_t n) +{ + mpz_t t; + + assert (n > 0); + assert (p [n-1] != 0); + return mpz_root (NULL, mpz_roinit_normal_n (t, p, n), 2); +} + +mp_size_t +mpn_sqrtrem (mp_ptr sp, mp_ptr rp, mp_srcptr p, mp_size_t n) +{ + mpz_t s, r, u; + mp_size_t res; + + assert (n > 0); + assert (p [n-1] != 0); + + mpz_init (r); + mpz_init (s); + mpz_rootrem (s, r, mpz_roinit_normal_n (u, p, n), 2); + + assert (s->_mp_size == (n+1)/2); + mpn_copyd (sp, s->_mp_d, s->_mp_size); + mpz_clear (s); + res = r->_mp_size; + if (rp) + mpn_copyd (rp, r->_mp_d, res); + mpz_clear (r); + return res; +} + +/* Combinatorics */ + +void +mpz_mfac_uiui (mpz_t x, unsigned long n, unsigned long m) +{ + mpz_set_ui (x, n + (n == 0)); + if (m + 1 < 2) return; + while (n > m + 1) + mpz_mul_ui (x, x, n -= m); +} + +void +mpz_2fac_ui (mpz_t x, unsigned long n) +{ + mpz_mfac_uiui (x, n, 2); +} + +void +mpz_fac_ui (mpz_t x, unsigned long n) +{ + mpz_mfac_uiui (x, n, 1); +} + +void +mpz_bin_uiui (mpz_t r, unsigned long n, unsigned long k) +{ + mpz_t t; + + mpz_set_ui (r, k <= n); + + if (k > (n >> 1)) + k = (k <= n) ? n - k : 0; + + mpz_init (t); + mpz_fac_ui (t, k); + + for (; k > 0; --k) + mpz_mul_ui (r, r, n--); + + mpz_divexact (r, r, t); + mpz_clear (t); +} + + +/* Primality testing */ +static int +gmp_millerrabin (const mpz_t n, const mpz_t nm1, mpz_t y, + const mpz_t q, mp_bitcnt_t k) +{ + assert (k > 0); + + /* Caller must initialize y to the base. */ + mpz_powm (y, y, q, n); + + if (mpz_cmp_ui (y, 1) == 0 || mpz_cmp (y, nm1) == 0) + return 1; + + while (--k > 0) + { + mpz_powm_ui (y, y, 2, n); + if (mpz_cmp (y, nm1) == 0) + return 1; + /* y == 1 means that the previous y was a non-trivial square root + of 1 (mod n). y == 0 means that n is a power of the base. + In either case, n is not prime. */ + if (mpz_cmp_ui (y, 1) <= 0) + return 0; + } + return 0; +} + +/* This product is 0xc0cfd797, and fits in 32 bits. */ +#define GMP_PRIME_PRODUCT \ + (3UL*5UL*7UL*11UL*13UL*17UL*19UL*23UL*29UL) + +/* Bit (p+1)/2 is set, for each odd prime <= 61 */ +#define GMP_PRIME_MASK 0xc96996dcUL + +int +mpz_probab_prime_p (const mpz_t n, int reps) +{ + mpz_t nm1; + mpz_t q; + mpz_t y; + mp_bitcnt_t k; + int is_prime; + int j; + + /* Note that we use the absolute value of n only, for compatibility + with the real GMP. */ + if (mpz_even_p (n)) + return (mpz_cmpabs_ui (n, 2) == 0) ? 2 : 0; + + /* Above test excludes n == 0 */ + assert (n->_mp_size != 0); + + if (mpz_cmpabs_ui (n, 64) < 0) + return (GMP_PRIME_MASK >> (n->_mp_d[0] >> 1)) & 2; + + if (mpz_gcd_ui (NULL, n, GMP_PRIME_PRODUCT) != 1) + return 0; + + /* All prime factors are >= 31. */ + if (mpz_cmpabs_ui (n, 31*31) < 0) + return 2; + + /* Use Miller-Rabin, with a deterministic sequence of bases, a[j] = + j^2 + j + 41 using Euler's polynomial. We potentially stop early, + if a[j] >= n - 1. Since n >= 31*31, this can happen only if reps > + 30 (a[30] == 971 > 31*31 == 961). */ + + mpz_init (nm1); + mpz_init (q); + mpz_init (y); + + /* Find q and k, where q is odd and n = 1 + 2**k * q. */ + nm1->_mp_size = mpz_abs_sub_ui (nm1, n, 1); + k = mpz_scan1 (nm1, 0); + mpz_tdiv_q_2exp (q, nm1, k); + + for (j = 0, is_prime = 1; is_prime & (j < reps); j++) + { + mpz_set_ui (y, (unsigned long) j*j+j+41); + if (mpz_cmp (y, nm1) >= 0) + { + /* Don't try any further bases. This "early" break does not affect + the result for any reasonable reps value (<=5000 was tested) */ + assert (j >= 30); + break; + } + is_prime = gmp_millerrabin (n, nm1, y, q, k); + } + mpz_clear (nm1); + mpz_clear (q); + mpz_clear (y); + + return is_prime; +} + + +/* Logical operations and bit manipulation. */ + +/* Numbers are treated as if represented in two's complement (and + infinitely sign extended). For a negative values we get the two's + complement from -x = ~x + 1, where ~ is bitwise complement. + Negation transforms + + xxxx10...0 + + into + + yyyy10...0 + + where yyyy is the bitwise complement of xxxx. So least significant + bits, up to and including the first one bit, are unchanged, and + the more significant bits are all complemented. + + To change a bit from zero to one in a negative number, subtract the + corresponding power of two from the absolute value. This can never + underflow. To change a bit from one to zero, add the corresponding + power of two, and this might overflow. E.g., if x = -001111, the + two's complement is 110001. Clearing the least significant bit, we + get two's complement 110000, and -010000. */ + +int +mpz_tstbit (const mpz_t d, mp_bitcnt_t bit_index) +{ + mp_size_t limb_index; + unsigned shift; + mp_size_t ds; + mp_size_t dn; + mp_limb_t w; + int bit; + + ds = d->_mp_size; + dn = GMP_ABS (ds); + limb_index = bit_index / GMP_LIMB_BITS; + if (limb_index >= dn) + return ds < 0; + + shift = bit_index % GMP_LIMB_BITS; + w = d->_mp_d[limb_index]; + bit = (w >> shift) & 1; + + if (ds < 0) + { + /* d < 0. Check if any of the bits below is set: If so, our bit + must be complemented. */ + if (shift > 0 && (w << (GMP_LIMB_BITS - shift)) > 0) + return bit ^ 1; + while (--limb_index >= 0) + if (d->_mp_d[limb_index] > 0) + return bit ^ 1; + } + return bit; +} + +static void +mpz_abs_add_bit (mpz_t d, mp_bitcnt_t bit_index) +{ + mp_size_t dn, limb_index; + mp_limb_t bit; + mp_ptr dp; + + dn = GMP_ABS (d->_mp_size); + + limb_index = bit_index / GMP_LIMB_BITS; + bit = (mp_limb_t) 1 << (bit_index % GMP_LIMB_BITS); + + if (limb_index >= dn) + { + mp_size_t i; + /* The bit should be set outside of the end of the number. + We have to increase the size of the number. */ + dp = MPZ_REALLOC (d, limb_index + 1); + + dp[limb_index] = bit; + for (i = dn; i < limb_index; i++) + dp[i] = 0; + dn = limb_index + 1; + } + else + { + mp_limb_t cy; + + dp = d->_mp_d; + + cy = mpn_add_1 (dp + limb_index, dp + limb_index, dn - limb_index, bit); + if (cy > 0) + { + dp = MPZ_REALLOC (d, dn + 1); + dp[dn++] = cy; + } + } + + d->_mp_size = (d->_mp_size < 0) ? - dn : dn; +} + +static void +mpz_abs_sub_bit (mpz_t d, mp_bitcnt_t bit_index) +{ + mp_size_t dn, limb_index; + mp_ptr dp; + mp_limb_t bit; + + dn = GMP_ABS (d->_mp_size); + dp = d->_mp_d; + + limb_index = bit_index / GMP_LIMB_BITS; + bit = (mp_limb_t) 1 << (bit_index % GMP_LIMB_BITS); + + assert (limb_index < dn); + + gmp_assert_nocarry (mpn_sub_1 (dp + limb_index, dp + limb_index, + dn - limb_index, bit)); + dn = mpn_normalized_size (dp, dn); + d->_mp_size = (d->_mp_size < 0) ? - dn : dn; +} + +void +mpz_setbit (mpz_t d, mp_bitcnt_t bit_index) +{ + if (!mpz_tstbit (d, bit_index)) + { + if (d->_mp_size >= 0) + mpz_abs_add_bit (d, bit_index); + else + mpz_abs_sub_bit (d, bit_index); + } +} + +void +mpz_clrbit (mpz_t d, mp_bitcnt_t bit_index) +{ + if (mpz_tstbit (d, bit_index)) + { + if (d->_mp_size >= 0) + mpz_abs_sub_bit (d, bit_index); + else + mpz_abs_add_bit (d, bit_index); + } +} + +void +mpz_combit (mpz_t d, mp_bitcnt_t bit_index) +{ + if (mpz_tstbit (d, bit_index) ^ (d->_mp_size < 0)) + mpz_abs_sub_bit (d, bit_index); + else + mpz_abs_add_bit (d, bit_index); +} + +void +mpz_com (mpz_t r, const mpz_t u) +{ + mpz_neg (r, u); + mpz_sub_ui (r, r, 1); +} + +void +mpz_and (mpz_t r, const mpz_t u, const mpz_t v) +{ + mp_size_t un, vn, rn, i; + mp_ptr up, vp, rp; + + mp_limb_t ux, vx, rx; + mp_limb_t uc, vc, rc; + mp_limb_t ul, vl, rl; + + un = GMP_ABS (u->_mp_size); + vn = GMP_ABS (v->_mp_size); + if (un < vn) + { + MPZ_SRCPTR_SWAP (u, v); + MP_SIZE_T_SWAP (un, vn); + } + if (vn == 0) + { + r->_mp_size = 0; + return; + } + + uc = u->_mp_size < 0; + vc = v->_mp_size < 0; + rc = uc & vc; + + ux = -uc; + vx = -vc; + rx = -rc; + + /* If the smaller input is positive, higher limbs don't matter. */ + rn = vx ? un : vn; + + rp = MPZ_REALLOC (r, rn + (mp_size_t) rc); + + up = u->_mp_d; + vp = v->_mp_d; + + i = 0; + do + { + ul = (up[i] ^ ux) + uc; + uc = ul < uc; + + vl = (vp[i] ^ vx) + vc; + vc = vl < vc; + + rl = ( (ul & vl) ^ rx) + rc; + rc = rl < rc; + rp[i] = rl; + } + while (++i < vn); + assert (vc == 0); + + for (; i < rn; i++) + { + ul = (up[i] ^ ux) + uc; + uc = ul < uc; + + rl = ( (ul & vx) ^ rx) + rc; + rc = rl < rc; + rp[i] = rl; + } + if (rc) + rp[rn++] = rc; + else + rn = mpn_normalized_size (rp, rn); + + r->_mp_size = rx ? -rn : rn; +} + +void +mpz_ior (mpz_t r, const mpz_t u, const mpz_t v) +{ + mp_size_t un, vn, rn, i; + mp_ptr up, vp, rp; + + mp_limb_t ux, vx, rx; + mp_limb_t uc, vc, rc; + mp_limb_t ul, vl, rl; + + un = GMP_ABS (u->_mp_size); + vn = GMP_ABS (v->_mp_size); + if (un < vn) + { + MPZ_SRCPTR_SWAP (u, v); + MP_SIZE_T_SWAP (un, vn); + } + if (vn == 0) + { + mpz_set (r, u); + return; + } + + uc = u->_mp_size < 0; + vc = v->_mp_size < 0; + rc = uc | vc; + + ux = -uc; + vx = -vc; + rx = -rc; + + /* If the smaller input is negative, by sign extension higher limbs + don't matter. */ + rn = vx ? vn : un; + + rp = MPZ_REALLOC (r, rn + (mp_size_t) rc); + + up = u->_mp_d; + vp = v->_mp_d; + + i = 0; + do + { + ul = (up[i] ^ ux) + uc; + uc = ul < uc; + + vl = (vp[i] ^ vx) + vc; + vc = vl < vc; + + rl = ( (ul | vl) ^ rx) + rc; + rc = rl < rc; + rp[i] = rl; + } + while (++i < vn); + assert (vc == 0); + + for (; i < rn; i++) + { + ul = (up[i] ^ ux) + uc; + uc = ul < uc; + + rl = ( (ul | vx) ^ rx) + rc; + rc = rl < rc; + rp[i] = rl; + } + if (rc) + rp[rn++] = rc; + else + rn = mpn_normalized_size (rp, rn); + + r->_mp_size = rx ? -rn : rn; +} + +void +mpz_xor (mpz_t r, const mpz_t u, const mpz_t v) +{ + mp_size_t un, vn, i; + mp_ptr up, vp, rp; + + mp_limb_t ux, vx, rx; + mp_limb_t uc, vc, rc; + mp_limb_t ul, vl, rl; + + un = GMP_ABS (u->_mp_size); + vn = GMP_ABS (v->_mp_size); + if (un < vn) + { + MPZ_SRCPTR_SWAP (u, v); + MP_SIZE_T_SWAP (un, vn); + } + if (vn == 0) + { + mpz_set (r, u); + return; + } + + uc = u->_mp_size < 0; + vc = v->_mp_size < 0; + rc = uc ^ vc; + + ux = -uc; + vx = -vc; + rx = -rc; + + rp = MPZ_REALLOC (r, un + (mp_size_t) rc); + + up = u->_mp_d; + vp = v->_mp_d; + + i = 0; + do + { + ul = (up[i] ^ ux) + uc; + uc = ul < uc; + + vl = (vp[i] ^ vx) + vc; + vc = vl < vc; + + rl = (ul ^ vl ^ rx) + rc; + rc = rl < rc; + rp[i] = rl; + } + while (++i < vn); + assert (vc == 0); + + for (; i < un; i++) + { + ul = (up[i] ^ ux) + uc; + uc = ul < uc; + + rl = (ul ^ ux) + rc; + rc = rl < rc; + rp[i] = rl; + } + if (rc) + rp[un++] = rc; + else + un = mpn_normalized_size (rp, un); + + r->_mp_size = rx ? -un : un; +} + +static unsigned +gmp_popcount_limb (mp_limb_t x) +{ + unsigned c; + + /* Do 16 bits at a time, to avoid limb-sized constants. */ + for (c = 0; x > 0; x >>= 16) + { + unsigned w = x - ((x >> 1) & 0x5555); + w = ((w >> 2) & 0x3333) + (w & 0x3333); + w = (w >> 4) + w; + w = ((w >> 8) & 0x000f) + (w & 0x000f); + c += w; + } + return c; +} + +mp_bitcnt_t +mpn_popcount (mp_srcptr p, mp_size_t n) +{ + mp_size_t i; + mp_bitcnt_t c; + + for (c = 0, i = 0; i < n; i++) + c += gmp_popcount_limb (p[i]); + + return c; +} + +mp_bitcnt_t +mpz_popcount (const mpz_t u) +{ + mp_size_t un; + + un = u->_mp_size; + + if (un < 0) + return ~(mp_bitcnt_t) 0; + + return mpn_popcount (u->_mp_d, un); +} + +mp_bitcnt_t +mpz_hamdist (const mpz_t u, const mpz_t v) +{ + mp_size_t un, vn, i; + mp_limb_t uc, vc, ul, vl, comp; + mp_srcptr up, vp; + mp_bitcnt_t c; + + un = u->_mp_size; + vn = v->_mp_size; + + if ( (un ^ vn) < 0) + return ~(mp_bitcnt_t) 0; + + comp = - (uc = vc = (un < 0)); + if (uc) + { + assert (vn < 0); + un = -un; + vn = -vn; + } + + up = u->_mp_d; + vp = v->_mp_d; + + if (un < vn) + MPN_SRCPTR_SWAP (up, un, vp, vn); + + for (i = 0, c = 0; i < vn; i++) + { + ul = (up[i] ^ comp) + uc; + uc = ul < uc; + + vl = (vp[i] ^ comp) + vc; + vc = vl < vc; + + c += gmp_popcount_limb (ul ^ vl); + } + assert (vc == 0); + + for (; i < un; i++) + { + ul = (up[i] ^ comp) + uc; + uc = ul < uc; + + c += gmp_popcount_limb (ul ^ comp); + } + + return c; +} + +mp_bitcnt_t +mpz_scan1 (const mpz_t u, mp_bitcnt_t starting_bit) +{ + mp_ptr up; + mp_size_t us, un, i; + mp_limb_t limb, ux; + + us = u->_mp_size; + un = GMP_ABS (us); + i = starting_bit / GMP_LIMB_BITS; + + /* Past the end there's no 1 bits for u>=0, or an immediate 1 bit + for u<0. Notice this test picks up any u==0 too. */ + if (i >= un) + return (us >= 0 ? ~(mp_bitcnt_t) 0 : starting_bit); + + up = u->_mp_d; + ux = 0; + limb = up[i]; + + if (starting_bit != 0) + { + if (us < 0) + { + ux = mpn_zero_p (up, i); + limb = ~ limb + ux; + ux = - (mp_limb_t) (limb >= ux); + } + + /* Mask to 0 all bits before starting_bit, thus ignoring them. */ + limb &= (GMP_LIMB_MAX << (starting_bit % GMP_LIMB_BITS)); + } + + return mpn_common_scan (limb, i, up, un, ux); +} + +mp_bitcnt_t +mpz_scan0 (const mpz_t u, mp_bitcnt_t starting_bit) +{ + mp_ptr up; + mp_size_t us, un, i; + mp_limb_t limb, ux; + + us = u->_mp_size; + ux = - (mp_limb_t) (us >= 0); + un = GMP_ABS (us); + i = starting_bit / GMP_LIMB_BITS; + + /* When past end, there's an immediate 0 bit for u>=0, or no 0 bits for + u<0. Notice this test picks up all cases of u==0 too. */ + if (i >= un) + return (ux ? starting_bit : ~(mp_bitcnt_t) 0); + + up = u->_mp_d; + limb = up[i] ^ ux; + + if (ux == 0) + limb -= mpn_zero_p (up, i); /* limb = ~(~limb + zero_p) */ + + /* Mask all bits before starting_bit, thus ignoring them. */ + limb &= (GMP_LIMB_MAX << (starting_bit % GMP_LIMB_BITS)); + + return mpn_common_scan (limb, i, up, un, ux); +} + + +/* MPZ base conversion. */ + +size_t +mpz_sizeinbase (const mpz_t u, int base) +{ + mp_size_t un; + mp_srcptr up; + mp_ptr tp; + mp_bitcnt_t bits; + struct gmp_div_inverse bi; + size_t ndigits; + + assert (base >= 2); + assert (base <= 62); + + un = GMP_ABS (u->_mp_size); + if (un == 0) + return 1; + + up = u->_mp_d; + + bits = (un - 1) * GMP_LIMB_BITS + mpn_limb_size_in_base_2 (up[un-1]); + switch (base) + { + case 2: + return bits; + case 4: + return (bits + 1) / 2; + case 8: + return (bits + 2) / 3; + case 16: + return (bits + 3) / 4; + case 32: + return (bits + 4) / 5; + /* FIXME: Do something more clever for the common case of base + 10. */ + } + + tp = gmp_xalloc_limbs (un); + mpn_copyi (tp, up, un); + mpn_div_qr_1_invert (&bi, base); + + ndigits = 0; + do + { + ndigits++; + mpn_div_qr_1_preinv (tp, tp, un, &bi); + un -= (tp[un-1] == 0); + } + while (un > 0); + + gmp_free (tp); + return ndigits; +} + +char * +mpz_get_str (char *sp, int base, const mpz_t u) +{ + unsigned bits; + const char *digits; + mp_size_t un; + size_t i, sn; + + digits = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"; + if (base > 1) + { + if (base <= 36) + digits = "0123456789abcdefghijklmnopqrstuvwxyz"; + else if (base > 62) + return NULL; + } + else if (base >= -1) + base = 10; + else + { + base = -base; + if (base > 36) + return NULL; + } + + sn = 1 + mpz_sizeinbase (u, base); + if (!sp) + sp = (char *) gmp_xalloc (1 + sn); + + un = GMP_ABS (u->_mp_size); + + if (un == 0) + { + sp[0] = '0'; + sp[1] = '\0'; + return sp; + } + + i = 0; + + if (u->_mp_size < 0) + sp[i++] = '-'; + + bits = mpn_base_power_of_two_p (base); + + if (bits) + /* Not modified in this case. */ + sn = i + mpn_get_str_bits ((unsigned char *) sp + i, bits, u->_mp_d, un); + else + { + struct mpn_base_info info; + mp_ptr tp; + + mpn_get_base_info (&info, base); + tp = gmp_xalloc_limbs (un); + mpn_copyi (tp, u->_mp_d, un); + + sn = i + mpn_get_str_other ((unsigned char *) sp + i, base, &info, tp, un); + gmp_free (tp); + } + + for (; i < sn; i++) + sp[i] = digits[(unsigned char) sp[i]]; + + sp[sn] = '\0'; + return sp; +} + +int +mpz_set_str (mpz_t r, const char *sp, int base) +{ + unsigned bits, value_of_a; + mp_size_t rn, alloc; + mp_ptr rp; + size_t dn; + int sign; + unsigned char *dp; + + assert (base == 0 || (base >= 2 && base <= 62)); + + while (isspace( (unsigned char) *sp)) + sp++; + + sign = (*sp == '-'); + sp += sign; + + if (base == 0) + { + if (sp[0] == '0') + { + if (sp[1] == 'x' || sp[1] == 'X') + { + base = 16; + sp += 2; + } + else if (sp[1] == 'b' || sp[1] == 'B') + { + base = 2; + sp += 2; + } + else + base = 8; + } + else + base = 10; + } + + if (!*sp) + { + r->_mp_size = 0; + return -1; + } + dp = (unsigned char *) gmp_xalloc (strlen (sp)); + + value_of_a = (base > 36) ? 36 : 10; + for (dn = 0; *sp; sp++) + { + unsigned digit; + + if (isspace ((unsigned char) *sp)) + continue; + else if (*sp >= '0' && *sp <= '9') + digit = *sp - '0'; + else if (*sp >= 'a' && *sp <= 'z') + digit = *sp - 'a' + value_of_a; + else if (*sp >= 'A' && *sp <= 'Z') + digit = *sp - 'A' + 10; + else + digit = base; /* fail */ + + if (digit >= (unsigned) base) + { + gmp_free (dp); + r->_mp_size = 0; + return -1; + } + + dp[dn++] = digit; + } + + if (!dn) + { + gmp_free (dp); + r->_mp_size = 0; + return -1; + } + bits = mpn_base_power_of_two_p (base); + + if (bits > 0) + { + alloc = (dn * bits + GMP_LIMB_BITS - 1) / GMP_LIMB_BITS; + rp = MPZ_REALLOC (r, alloc); + rn = mpn_set_str_bits (rp, dp, dn, bits); + } + else + { + struct mpn_base_info info; + mpn_get_base_info (&info, base); + alloc = (dn + info.exp - 1) / info.exp; + rp = MPZ_REALLOC (r, alloc); + rn = mpn_set_str_other (rp, dp, dn, base, &info); + /* Normalization, needed for all-zero input. */ + assert (rn > 0); + rn -= rp[rn-1] == 0; + } + assert (rn <= alloc); + gmp_free (dp); + + r->_mp_size = sign ? - rn : rn; + + return 0; +} + +int +mpz_init_set_str (mpz_t r, const char *sp, int base) +{ + mpz_init (r); + return mpz_set_str (r, sp, base); +} + +size_t +mpz_out_str (FILE *stream, int base, const mpz_t x) +{ + char *str; + size_t len; + + str = mpz_get_str (NULL, base, x); + len = strlen (str); + len = fwrite (str, 1, len, stream); + gmp_free (str); + return len; +} + + +static int +gmp_detect_endian (void) +{ + static const int i = 2; + const unsigned char *p = (const unsigned char *) &i; + return 1 - *p; +} + +/* Import and export. Does not support nails. */ +void +mpz_import (mpz_t r, size_t count, int order, size_t size, int endian, + size_t nails, const void *src) +{ + const unsigned char *p; + ptrdiff_t word_step; + mp_ptr rp; + mp_size_t rn; + + /* The current (partial) limb. */ + mp_limb_t limb; + /* The number of bytes already copied to this limb (starting from + the low end). */ + size_t bytes; + /* The index where the limb should be stored, when completed. */ + mp_size_t i; + + if (nails != 0) + gmp_die ("mpz_import: Nails not supported."); + + assert (order == 1 || order == -1); + assert (endian >= -1 && endian <= 1); + + if (endian == 0) + endian = gmp_detect_endian (); + + p = (unsigned char *) src; + + word_step = (order != endian) ? 2 * size : 0; + + /* Process bytes from the least significant end, so point p at the + least significant word. */ + if (order == 1) + { + p += size * (count - 1); + word_step = - word_step; + } + + /* And at least significant byte of that word. */ + if (endian == 1) + p += (size - 1); + + rn = (size * count + sizeof(mp_limb_t) - 1) / sizeof(mp_limb_t); + rp = MPZ_REALLOC (r, rn); + + for (limb = 0, bytes = 0, i = 0; count > 0; count--, p += word_step) + { + size_t j; + for (j = 0; j < size; j++, p -= (ptrdiff_t) endian) + { + limb |= (mp_limb_t) *p << (bytes++ * CHAR_BIT); + if (bytes == sizeof(mp_limb_t)) + { + rp[i++] = limb; + bytes = 0; + limb = 0; + } + } + } + assert (i + (bytes > 0) == rn); + if (limb != 0) + rp[i++] = limb; + else + i = mpn_normalized_size (rp, i); + + r->_mp_size = i; +} + +void * +mpz_export (void *r, size_t *countp, int order, size_t size, int endian, + size_t nails, const mpz_t u) +{ + size_t count; + mp_size_t un; + + if (nails != 0) + gmp_die ("mpz_import: Nails not supported."); + + assert (order == 1 || order == -1); + assert (endian >= -1 && endian <= 1); + assert (size > 0 || u->_mp_size == 0); + + un = u->_mp_size; + count = 0; + if (un != 0) + { + size_t k; + unsigned char *p; + ptrdiff_t word_step; + /* The current (partial) limb. */ + mp_limb_t limb; + /* The number of bytes left to to in this limb. */ + size_t bytes; + /* The index where the limb was read. */ + mp_size_t i; + + un = GMP_ABS (un); + + /* Count bytes in top limb. */ + limb = u->_mp_d[un-1]; + assert (limb != 0); + + k = 0; + do { + k++; limb >>= CHAR_BIT; + } while (limb != 0); + + count = (k + (un-1) * sizeof (mp_limb_t) + size - 1) / size; + + if (!r) + r = gmp_xalloc (count * size); + + if (endian == 0) + endian = gmp_detect_endian (); + + p = (unsigned char *) r; + + word_step = (order != endian) ? 2 * size : 0; + + /* Process bytes from the least significant end, so point p at the + least significant word. */ + if (order == 1) + { + p += size * (count - 1); + word_step = - word_step; + } + + /* And at least significant byte of that word. */ + if (endian == 1) + p += (size - 1); + + for (bytes = 0, i = 0, k = 0; k < count; k++, p += word_step) + { + size_t j; + for (j = 0; j < size; j++, p -= (ptrdiff_t) endian) + { + if (bytes == 0) + { + if (i < un) + limb = u->_mp_d[i++]; + bytes = sizeof (mp_limb_t); + } + *p = limb; + limb >>= CHAR_BIT; + bytes--; + } + } + assert (i == un); + assert (k == count); + } + + if (countp) + *countp = count; + + return r; +} diff --git a/src/mini-gmp.h b/src/mini-gmp.h new file mode 100644 index 0000000000..27e0c0671a --- /dev/null +++ b/src/mini-gmp.h @@ -0,0 +1,300 @@ +/* mini-gmp, a minimalistic implementation of a GNU GMP subset. + +Copyright 2011-2015, 2017 Free Software Foundation, Inc. + +This file is part of the GNU MP Library. + +The GNU MP Library is free software; you can redistribute it and/or modify +it under the terms of either: + + * the GNU Lesser General Public License as published by the Free + Software Foundation; either version 3 of the License, or (at your + option) any later version. + +or + + * the GNU General Public License as published by the Free Software + Foundation; either version 2 of the License, or (at your option) any + later version. + +or both in parallel, as here. + +The GNU MP Library 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 copies of the GNU General Public License and the +GNU Lesser General Public License along with the GNU MP Library. If not, +see https://www.gnu.org/licenses/. */ + +/* About mini-gmp: This is a minimal implementation of a subset of the + GMP interface. It is intended for inclusion into applications which + have modest bignums needs, as a fallback when the real GMP library + is not installed. + + This file defines the public interface. */ + +#ifndef __MINI_GMP_H__ +#define __MINI_GMP_H__ + +/* For size_t */ +#include + +#if defined (__cplusplus) +extern "C" { +#endif + +void mp_set_memory_functions (void *(*) (size_t), + void *(*) (void *, size_t, size_t), + void (*) (void *, size_t)); + +void mp_get_memory_functions (void *(**) (size_t), + void *(**) (void *, size_t, size_t), + void (**) (void *, size_t)); + +typedef unsigned long mp_limb_t; +typedef long mp_size_t; +typedef unsigned long mp_bitcnt_t; + +typedef mp_limb_t *mp_ptr; +typedef const mp_limb_t *mp_srcptr; + +typedef struct +{ + int _mp_alloc; /* Number of *limbs* allocated and pointed + to by the _mp_d field. */ + int _mp_size; /* abs(_mp_size) is the number of limbs the + last field points to. If _mp_size is + negative this is a negative number. */ + mp_limb_t *_mp_d; /* Pointer to the limbs. */ +} __mpz_struct; + +typedef __mpz_struct mpz_t[1]; + +typedef __mpz_struct *mpz_ptr; +typedef const __mpz_struct *mpz_srcptr; + +extern const int mp_bits_per_limb; + +void mpn_copyi (mp_ptr, mp_srcptr, mp_size_t); +void mpn_copyd (mp_ptr, mp_srcptr, mp_size_t); +void mpn_zero (mp_ptr, mp_size_t); + +int mpn_cmp (mp_srcptr, mp_srcptr, mp_size_t); +int mpn_zero_p (mp_srcptr, mp_size_t); + +mp_limb_t mpn_add_1 (mp_ptr, mp_srcptr, mp_size_t, mp_limb_t); +mp_limb_t mpn_add_n (mp_ptr, mp_srcptr, mp_srcptr, mp_size_t); +mp_limb_t mpn_add (mp_ptr, mp_srcptr, mp_size_t, mp_srcptr, mp_size_t); + +mp_limb_t mpn_sub_1 (mp_ptr, mp_srcptr, mp_size_t, mp_limb_t); +mp_limb_t mpn_sub_n (mp_ptr, mp_srcptr, mp_srcptr, mp_size_t); +mp_limb_t mpn_sub (mp_ptr, mp_srcptr, mp_size_t, mp_srcptr, mp_size_t); + +mp_limb_t mpn_mul_1 (mp_ptr, mp_srcptr, mp_size_t, mp_limb_t); +mp_limb_t mpn_addmul_1 (mp_ptr, mp_srcptr, mp_size_t, mp_limb_t); +mp_limb_t mpn_submul_1 (mp_ptr, mp_srcptr, mp_size_t, mp_limb_t); + +mp_limb_t mpn_mul (mp_ptr, mp_srcptr, mp_size_t, mp_srcptr, mp_size_t); +void mpn_mul_n (mp_ptr, mp_srcptr, mp_srcptr, mp_size_t); +void mpn_sqr (mp_ptr, mp_srcptr, mp_size_t); +int mpn_perfect_square_p (mp_srcptr, mp_size_t); +mp_size_t mpn_sqrtrem (mp_ptr, mp_ptr, mp_srcptr, mp_size_t); + +mp_limb_t mpn_lshift (mp_ptr, mp_srcptr, mp_size_t, unsigned int); +mp_limb_t mpn_rshift (mp_ptr, mp_srcptr, mp_size_t, unsigned int); + +mp_bitcnt_t mpn_scan0 (mp_srcptr, mp_bitcnt_t); +mp_bitcnt_t mpn_scan1 (mp_srcptr, mp_bitcnt_t); + +void mpn_com (mp_ptr, mp_srcptr, mp_size_t); +mp_limb_t mpn_neg (mp_ptr, mp_srcptr, mp_size_t); + +mp_bitcnt_t mpn_popcount (mp_srcptr, mp_size_t); + +mp_limb_t mpn_invert_3by2 (mp_limb_t, mp_limb_t); +#define mpn_invert_limb(x) mpn_invert_3by2 ((x), 0) + +size_t mpn_get_str (unsigned char *, int, mp_ptr, mp_size_t); +mp_size_t mpn_set_str (mp_ptr, const unsigned char *, size_t, int); + +void mpz_init (mpz_t); +void mpz_init2 (mpz_t, mp_bitcnt_t); +void mpz_clear (mpz_t); + +#define mpz_odd_p(z) (((z)->_mp_size != 0) & (int) (z)->_mp_d[0]) +#define mpz_even_p(z) (! mpz_odd_p (z)) + +int mpz_sgn (const mpz_t); +int mpz_cmp_si (const mpz_t, long); +int mpz_cmp_ui (const mpz_t, unsigned long); +int mpz_cmp (const mpz_t, const mpz_t); +int mpz_cmpabs_ui (const mpz_t, unsigned long); +int mpz_cmpabs (const mpz_t, const mpz_t); +int mpz_cmp_d (const mpz_t, double); +int mpz_cmpabs_d (const mpz_t, double); + +void mpz_abs (mpz_t, const mpz_t); +void mpz_neg (mpz_t, const mpz_t); +void mpz_swap (mpz_t, mpz_t); + +void mpz_add_ui (mpz_t, const mpz_t, unsigned long); +void mpz_add (mpz_t, const mpz_t, const mpz_t); +void mpz_sub_ui (mpz_t, const mpz_t, unsigned long); +void mpz_ui_sub (mpz_t, unsigned long, const mpz_t); +void mpz_sub (mpz_t, const mpz_t, const mpz_t); + +void mpz_mul_si (mpz_t, const mpz_t, long int); +void mpz_mul_ui (mpz_t, const mpz_t, unsigned long int); +void mpz_mul (mpz_t, const mpz_t, const mpz_t); +void mpz_mul_2exp (mpz_t, const mpz_t, mp_bitcnt_t); +void mpz_addmul_ui (mpz_t, const mpz_t, unsigned long int); +void mpz_addmul (mpz_t, const mpz_t, const mpz_t); +void mpz_submul_ui (mpz_t, const mpz_t, unsigned long int); +void mpz_submul (mpz_t, const mpz_t, const mpz_t); + +void mpz_cdiv_qr (mpz_t, mpz_t, const mpz_t, const mpz_t); +void mpz_fdiv_qr (mpz_t, mpz_t, const mpz_t, const mpz_t); +void mpz_tdiv_qr (mpz_t, mpz_t, const mpz_t, const mpz_t); +void mpz_cdiv_q (mpz_t, const mpz_t, const mpz_t); +void mpz_fdiv_q (mpz_t, const mpz_t, const mpz_t); +void mpz_tdiv_q (mpz_t, const mpz_t, const mpz_t); +void mpz_cdiv_r (mpz_t, const mpz_t, const mpz_t); +void mpz_fdiv_r (mpz_t, const mpz_t, const mpz_t); +void mpz_tdiv_r (mpz_t, const mpz_t, const mpz_t); + +void mpz_cdiv_q_2exp (mpz_t, const mpz_t, mp_bitcnt_t); +void mpz_fdiv_q_2exp (mpz_t, const mpz_t, mp_bitcnt_t); +void mpz_tdiv_q_2exp (mpz_t, const mpz_t, mp_bitcnt_t); +void mpz_cdiv_r_2exp (mpz_t, const mpz_t, mp_bitcnt_t); +void mpz_fdiv_r_2exp (mpz_t, const mpz_t, mp_bitcnt_t); +void mpz_tdiv_r_2exp (mpz_t, const mpz_t, mp_bitcnt_t); + +void mpz_mod (mpz_t, const mpz_t, const mpz_t); + +void mpz_divexact (mpz_t, const mpz_t, const mpz_t); + +int mpz_divisible_p (const mpz_t, const mpz_t); +int mpz_congruent_p (const mpz_t, const mpz_t, const mpz_t); + +unsigned long mpz_cdiv_qr_ui (mpz_t, mpz_t, const mpz_t, unsigned long); +unsigned long mpz_fdiv_qr_ui (mpz_t, mpz_t, const mpz_t, unsigned long); +unsigned long mpz_tdiv_qr_ui (mpz_t, mpz_t, const mpz_t, unsigned long); +unsigned long mpz_cdiv_q_ui (mpz_t, const mpz_t, unsigned long); +unsigned long mpz_fdiv_q_ui (mpz_t, const mpz_t, unsigned long); +unsigned long mpz_tdiv_q_ui (mpz_t, const mpz_t, unsigned long); +unsigned long mpz_cdiv_r_ui (mpz_t, const mpz_t, unsigned long); +unsigned long mpz_fdiv_r_ui (mpz_t, const mpz_t, unsigned long); +unsigned long mpz_tdiv_r_ui (mpz_t, const mpz_t, unsigned long); +unsigned long mpz_cdiv_ui (const mpz_t, unsigned long); +unsigned long mpz_fdiv_ui (const mpz_t, unsigned long); +unsigned long mpz_tdiv_ui (const mpz_t, unsigned long); + +unsigned long mpz_mod_ui (mpz_t, const mpz_t, unsigned long); + +void mpz_divexact_ui (mpz_t, const mpz_t, unsigned long); + +int mpz_divisible_ui_p (const mpz_t, unsigned long); + +unsigned long mpz_gcd_ui (mpz_t, const mpz_t, unsigned long); +void mpz_gcd (mpz_t, const mpz_t, const mpz_t); +void mpz_gcdext (mpz_t, mpz_t, mpz_t, const mpz_t, const mpz_t); +void mpz_lcm_ui (mpz_t, const mpz_t, unsigned long); +void mpz_lcm (mpz_t, const mpz_t, const mpz_t); +int mpz_invert (mpz_t, const mpz_t, const mpz_t); + +void mpz_sqrtrem (mpz_t, mpz_t, const mpz_t); +void mpz_sqrt (mpz_t, const mpz_t); +int mpz_perfect_square_p (const mpz_t); + +void mpz_pow_ui (mpz_t, const mpz_t, unsigned long); +void mpz_ui_pow_ui (mpz_t, unsigned long, unsigned long); +void mpz_powm (mpz_t, const mpz_t, const mpz_t, const mpz_t); +void mpz_powm_ui (mpz_t, const mpz_t, unsigned long, const mpz_t); + +void mpz_rootrem (mpz_t, mpz_t, const mpz_t, unsigned long); +int mpz_root (mpz_t, const mpz_t, unsigned long); + +void mpz_fac_ui (mpz_t, unsigned long); +void mpz_2fac_ui (mpz_t, unsigned long); +void mpz_mfac_uiui (mpz_t, unsigned long, unsigned long); +void mpz_bin_uiui (mpz_t, unsigned long, unsigned long); + +int mpz_probab_prime_p (const mpz_t, int); + +int mpz_tstbit (const mpz_t, mp_bitcnt_t); +void mpz_setbit (mpz_t, mp_bitcnt_t); +void mpz_clrbit (mpz_t, mp_bitcnt_t); +void mpz_combit (mpz_t, mp_bitcnt_t); + +void mpz_com (mpz_t, const mpz_t); +void mpz_and (mpz_t, const mpz_t, const mpz_t); +void mpz_ior (mpz_t, const mpz_t, const mpz_t); +void mpz_xor (mpz_t, const mpz_t, const mpz_t); + +mp_bitcnt_t mpz_popcount (const mpz_t); +mp_bitcnt_t mpz_hamdist (const mpz_t, const mpz_t); +mp_bitcnt_t mpz_scan0 (const mpz_t, mp_bitcnt_t); +mp_bitcnt_t mpz_scan1 (const mpz_t, mp_bitcnt_t); + +int mpz_fits_slong_p (const mpz_t); +int mpz_fits_ulong_p (const mpz_t); +long int mpz_get_si (const mpz_t); +unsigned long int mpz_get_ui (const mpz_t); +double mpz_get_d (const mpz_t); +size_t mpz_size (const mpz_t); +mp_limb_t mpz_getlimbn (const mpz_t, mp_size_t); + +void mpz_realloc2 (mpz_t, mp_bitcnt_t); +mp_srcptr mpz_limbs_read (mpz_srcptr); +mp_ptr mpz_limbs_modify (mpz_t, mp_size_t); +mp_ptr mpz_limbs_write (mpz_t, mp_size_t); +void mpz_limbs_finish (mpz_t, mp_size_t); +mpz_srcptr mpz_roinit_n (mpz_t, mp_srcptr, mp_size_t); + +#define MPZ_ROINIT_N(xp, xs) {{0, (xs),(xp) }} + +void mpz_set_si (mpz_t, signed long int); +void mpz_set_ui (mpz_t, unsigned long int); +void mpz_set (mpz_t, const mpz_t); +void mpz_set_d (mpz_t, double); + +void mpz_init_set_si (mpz_t, signed long int); +void mpz_init_set_ui (mpz_t, unsigned long int); +void mpz_init_set (mpz_t, const mpz_t); +void mpz_init_set_d (mpz_t, double); + +size_t mpz_sizeinbase (const mpz_t, int); +char *mpz_get_str (char *, int, const mpz_t); +int mpz_set_str (mpz_t, const char *, int); +int mpz_init_set_str (mpz_t, const char *, int); + +/* This long list taken from gmp.h. */ +/* For reference, "defined(EOF)" cannot be used here. In g++ 2.95.4, + defines EOF but not FILE. */ +#if defined (FILE) \ + || defined (H_STDIO) \ + || defined (_H_STDIO) /* AIX */ \ + || defined (_STDIO_H) /* glibc, Sun, SCO */ \ + || defined (_STDIO_H_) /* BSD, OSF */ \ + || defined (__STDIO_H) /* Borland */ \ + || defined (__STDIO_H__) /* IRIX */ \ + || defined (_STDIO_INCLUDED) /* HPUX */ \ + || defined (__dj_include_stdio_h_) /* DJGPP */ \ + || defined (_FILE_DEFINED) /* Microsoft */ \ + || defined (__STDIO__) /* Apple MPW MrC */ \ + || defined (_MSL_STDIO_H) /* Metrowerks */ \ + || defined (_STDIO_H_INCLUDED) /* QNX4 */ \ + || defined (_ISO_STDIO_ISO_H) /* Sun C++ */ \ + || defined (__STDIO_LOADED) /* VMS */ +size_t mpz_out_str (FILE *, int, const mpz_t); +#endif + +void mpz_import (mpz_t, size_t, int, size_t, int, size_t, const void *); +void *mpz_export (void *, size_t *, int, size_t, int, size_t, const mpz_t); + +#if defined (__cplusplus) +} +#endif +#endif /* __MINI_GMP_H__ */ commit 42fe787b0f26c2df682b2797407a669ef8522ccb Author: Tom Tromey Date: Fri Jul 6 21:56:17 2018 -0600 Rename integerp->fixnum, etc, in preparation for bignums * src/json.c, src/keyboard.c, src/keyboard.h, src/keymap.c, src/kqueue.c, src/lcms.c, src/lisp.h, src/lread.c, src/macros.c, src/marker.c, src/menu.c, src/minibuf.c, src/msdos.c, src/print.c, src/process.c, src/profiler.c, src/search.c, src/sound.c, src/syntax.c, src/sysdep.c, src/term.c, src/terminal.c, src/textprop.c, src/undo.c, src/w16select.c, src/w32.c, src/w32console.c, src/w32cygwinx.c, src/w32fns.c, src/w32font.c, src/w32inevt.c, src/w32proc.c, src/w32select.c, src/w32term.c, src/w32uniscribe.c, src/widget.c, src/window.c, src/xdisp.c, src/xfaces.c, src/xfns.c, src/xfont.c, src/xftfont.c, src/xmenu.c, src/xrdb.c, src/xselect.c, src/xterm.c, src/xwidget.c: Rename INTEGERP->FIXNUM, make_number->make_fixnum, CHECK_NUMBER->CHECK_FIXNUM, make_natnum->make_fixed_natum, NUMBERP->FIXED_OR_FLOATP, NATNUMP->FIXNATP, CHECK_NATNUM->CHECK_FIXNAT. diff --git a/src/alloc.c b/src/alloc.c index 8764591336..91c5152ca8 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2321,7 +2321,7 @@ a multibyte string even if INIT is an ASCII character. */) int c; EMACS_INT nbytes; - CHECK_NATNUM (length); + CHECK_FIXNAT (length); CHECK_CHARACTER (init); c = XFASTINT (init); @@ -2415,7 +2415,7 @@ LENGTH must be a number. INIT matters only in whether it is t or nil. */) { Lisp_Object val; - CHECK_NATNUM (length); + CHECK_FIXNAT (length); val = make_uninit_bool_vector (XFASTINT (length)); return bool_vector_fill (val, init); } @@ -2894,7 +2894,7 @@ DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0, (Lisp_Object length, Lisp_Object init) { Lisp_Object val = Qnil; - CHECK_NATNUM (length); + CHECK_FIXNAT (length); for (EMACS_INT size = XFASTINT (length); 0 < size; size--) { @@ -3439,7 +3439,7 @@ symbol or a type descriptor. SLOTS is the number of non-type slots, each initialized to INIT. */) (Lisp_Object type, Lisp_Object slots, Lisp_Object init) { - CHECK_NATNUM (slots); + CHECK_FIXNAT (slots); EMACS_INT size = XFASTINT (slots) + 1; struct Lisp_Vector *p = allocate_record (size); p->contents[0] = type; @@ -3468,7 +3468,7 @@ DEFUN ("make-vector", Fmake_vector, Smake_vector, 2, 2, 0, See also the function `vector'. */) (Lisp_Object length, Lisp_Object init) { - CHECK_NATNUM (length); + CHECK_FIXNAT (length); struct Lisp_Vector *p = allocate_vector (XFASTINT (length)); for (ptrdiff_t i = 0; i < XFASTINT (length); i++) p->contents[i] = init; @@ -3795,7 +3795,7 @@ make_event_array (ptrdiff_t nargs, Lisp_Object *args) /* The things that fit in a string are characters that are in 0...127, after discarding the meta bit and all the bits above it. */ - if (!INTEGERP (args[i]) + if (!FIXNUMP (args[i]) || (XINT (args[i]) & ~(-CHAR_META)) >= 0200) return Fvector (nargs, args); @@ -3804,7 +3804,7 @@ make_event_array (ptrdiff_t nargs, Lisp_Object *args) { Lisp_Object result; - result = Fmake_string (make_number (nargs), make_number (0), Qnil); + result = Fmake_string (make_fixnum (nargs), make_fixnum (0), Qnil); for (i = 0; i < nargs; i++) { SSET (result, i, XINT (args[i])); @@ -4691,7 +4691,7 @@ mark_maybe_object (Lisp_Object obj) VALGRIND_MAKE_MEM_DEFINED (&obj, sizeof (obj)); #endif - if (INTEGERP (obj)) + if (FIXNUMP (obj)) return; void *po = XPNTR (obj); @@ -5171,7 +5171,7 @@ valid_pointer_p (void *p) int valid_lisp_object_p (Lisp_Object obj) { - if (INTEGERP (obj)) + if (FIXNUMP (obj)) return 1; void *p = XPNTR (obj); @@ -5504,7 +5504,7 @@ static struct pinned_object static Lisp_Object purecopy (Lisp_Object obj) { - if (INTEGERP (obj) + if (FIXNUMP (obj) || (! SYMBOLP (obj) && PURE_P (XPNTR (obj))) || SUBRP (obj)) return obj; /* Already pure. */ @@ -5614,7 +5614,7 @@ inhibit_garbage_collection (void) { ptrdiff_t count = SPECPDL_INDEX (); - specbind (Qgc_cons_threshold, make_number (MOST_POSITIVE_FIXNUM)); + specbind (Qgc_cons_threshold, make_fixnum (MOST_POSITIVE_FIXNUM)); return count; } @@ -5624,7 +5624,7 @@ inhibit_garbage_collection (void) static Lisp_Object bounded_number (EMACS_INT number) { - return make_number (min (MOST_POSITIVE_FIXNUM, number)); + return make_fixnum (min (MOST_POSITIVE_FIXNUM, number)); } /* Calculate total bytes of live objects. */ @@ -5977,37 +5977,37 @@ garbage_collect_1 (void *end) unbind_to (count, Qnil); Lisp_Object total[] = { - list4 (Qconses, make_number (sizeof (struct Lisp_Cons)), + list4 (Qconses, make_fixnum (sizeof (struct Lisp_Cons)), bounded_number (total_conses), bounded_number (total_free_conses)), - list4 (Qsymbols, make_number (sizeof (struct Lisp_Symbol)), + list4 (Qsymbols, make_fixnum (sizeof (struct Lisp_Symbol)), bounded_number (total_symbols), bounded_number (total_free_symbols)), - list4 (Qmiscs, make_number (sizeof (union Lisp_Misc)), + list4 (Qmiscs, make_fixnum (sizeof (union Lisp_Misc)), bounded_number (total_markers), bounded_number (total_free_markers)), - list4 (Qstrings, make_number (sizeof (struct Lisp_String)), + list4 (Qstrings, make_fixnum (sizeof (struct Lisp_String)), bounded_number (total_strings), bounded_number (total_free_strings)), - list3 (Qstring_bytes, make_number (1), + list3 (Qstring_bytes, make_fixnum (1), bounded_number (total_string_bytes)), list3 (Qvectors, - make_number (header_size + sizeof (Lisp_Object)), + make_fixnum (header_size + sizeof (Lisp_Object)), bounded_number (total_vectors)), - list4 (Qvector_slots, make_number (word_size), + list4 (Qvector_slots, make_fixnum (word_size), bounded_number (total_vector_slots), bounded_number (total_free_vector_slots)), - list4 (Qfloats, make_number (sizeof (struct Lisp_Float)), + list4 (Qfloats, make_fixnum (sizeof (struct Lisp_Float)), bounded_number (total_floats), bounded_number (total_free_floats)), - list4 (Qintervals, make_number (sizeof (struct interval)), + list4 (Qintervals, make_fixnum (sizeof (struct interval)), bounded_number (total_intervals), bounded_number (total_free_intervals)), - list3 (Qbuffers, make_number (sizeof (struct buffer)), + list3 (Qbuffers, make_fixnum (sizeof (struct buffer)), bounded_number (total_buffers)), #ifdef DOUG_LEA_MALLOC - list4 (Qheap, make_number (1024), + list4 (Qheap, make_fixnum (1024), bounded_number ((mallinfo ().uordblks + 1023) >> 10), bounded_number ((mallinfo ().fordblks + 1023) >> 10)), #endif @@ -6142,7 +6142,7 @@ mark_char_table (struct Lisp_Vector *ptr, enum pvec_type pvectype) { Lisp_Object val = ptr->contents[i]; - if (INTEGERP (val) || (SYMBOLP (val) && XSYMBOL (val)->u.s.gcmarkbit)) + if (FIXNUMP (val) || (SYMBOLP (val) && XSYMBOL (val)->u.s.gcmarkbit)) continue; if (SUB_CHAR_TABLE_P (val)) { diff --git a/src/bidi.c b/src/bidi.c index 9bc8dbe860..30a7d6673e 100644 --- a/src/bidi.c +++ b/src/bidi.c @@ -379,7 +379,7 @@ bidi_mirror_char (int c) emacs_abort (); val = CHAR_TABLE_REF (bidi_mirror_table, c); - if (INTEGERP (val)) + if (FIXNUMP (val)) { int v; diff --git a/src/buffer.c b/src/buffer.c index 244c1851fa..2924885563 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -849,7 +849,7 @@ CLONE nil means the indirect buffer's state is reset to default values. */) clone_per_buffer_values (b->base_buffer, b); bset_filename (b, Qnil); bset_file_truename (b, Qnil); - bset_display_count (b, make_number (0)); + bset_display_count (b, make_fixnum (0)); bset_backed_up (b, Qnil); bset_auto_save_file_name (b, Qnil); set_buffer_internal_1 (b); @@ -939,7 +939,7 @@ reset_buffer (register struct buffer *b) bset_file_format (b, Qnil); bset_auto_save_file_format (b, Qt); bset_last_selected_window (b, Qnil); - bset_display_count (b, make_number (0)); + bset_display_count (b, make_fixnum (0)); bset_display_time (b, Qnil); bset_enable_multibyte_characters (b, BVAR (&buffer_defaults, enable_multibyte_characters)); @@ -1103,7 +1103,7 @@ is first appended to NAME, to speed up finding a non-existent buffer. */) char number[sizeof "-999999"]; /* Use XINT instead of XFASTINT to work around GCC bug 80776. */ - int i = XINT (Frandom (make_number (1000000))); + int i = XINT (Frandom (make_fixnum (1000000))); eassume (0 <= i && i < 1000000); AUTO_STRING_WITH_LEN (lnumber, number, sprintf (number, "-%d", i)); @@ -1421,7 +1421,7 @@ text in that buffer is changed. It wraps around occasionally. No argument or nil as argument means use current buffer as BUFFER. */) (register Lisp_Object buffer) { - return make_number (BUF_MODIFF (decode_buffer (buffer))); + return make_fixnum (BUF_MODIFF (decode_buffer (buffer))); } DEFUN ("buffer-chars-modified-tick", Fbuffer_chars_modified_tick, @@ -1436,7 +1436,7 @@ between these calls. No argument or nil as argument means use current buffer as BUFFER. */) (register Lisp_Object buffer) { - return make_number (BUF_CHARS_MODIFF (decode_buffer (buffer))); + return make_fixnum (BUF_CHARS_MODIFF (decode_buffer (buffer))); } DEFUN ("rename-buffer", Frename_buffer, Srename_buffer, 1, 2, @@ -2203,7 +2203,7 @@ If the text under POSITION (which defaults to point) has the if (NILP (position)) XSETFASTINT (position, PT); else - CHECK_NUMBER (position); + CHECK_FIXNUM (position); if (!NILP (BVAR (current_buffer, read_only)) && NILP (Vinhibit_read_only) @@ -2233,8 +2233,8 @@ so the buffer is truly empty after this. */) void validate_region (register Lisp_Object *b, register Lisp_Object *e) { - CHECK_NUMBER_COERCE_MARKER (*b); - CHECK_NUMBER_COERCE_MARKER (*e); + CHECK_FIXNUM_COERCE_MARKER (*b); + CHECK_FIXNUM_COERCE_MARKER (*e); if (XINT (*b) > XINT (*e)) { @@ -2409,7 +2409,7 @@ results, see Info node `(elisp)Swapping Text'. */) && (EQ (XWINDOW (w)->contents, buf1) || EQ (XWINDOW (w)->contents, buf2))) Fset_marker (XWINDOW (w)->pointm, - make_number + make_fixnum (BUF_BEGV (XBUFFER (XWINDOW (w)->contents))), XWINDOW (w)->contents); /* Blindly copied from pointm part. */ @@ -2417,14 +2417,14 @@ results, see Info node `(elisp)Swapping Text'. */) && (EQ (XWINDOW (w)->contents, buf1) || EQ (XWINDOW (w)->contents, buf2))) Fset_marker (XWINDOW (w)->old_pointm, - make_number + make_fixnum (BUF_BEGV (XBUFFER (XWINDOW (w)->contents))), XWINDOW (w)->contents); if (MARKERP (XWINDOW (w)->start) && (EQ (XWINDOW (w)->contents, buf1) || EQ (XWINDOW (w)->contents, buf2))) Fset_marker (XWINDOW (w)->start, - make_number + make_fixnum (XBUFFER (XWINDOW (w)->contents)->last_window_start), XWINDOW (w)->contents); w = Fnext_window (w, Qt, Qt); @@ -2547,7 +2547,7 @@ current buffer is cleared. */) } } if (narrowed) - Fnarrow_to_region (make_number (begv), make_number (zv)); + Fnarrow_to_region (make_fixnum (begv), make_fixnum (zv)); } else { @@ -2628,7 +2628,7 @@ current buffer is cleared. */) TEMP_SET_PT (pt); if (narrowed) - Fnarrow_to_region (make_number (begv), make_number (zv)); + Fnarrow_to_region (make_fixnum (begv), make_fixnum (zv)); /* Do this first, so that chars_in_text asks the right question. set_intervals_multibyte needs it too. */ @@ -3212,7 +3212,7 @@ sort_overlays (Lisp_Object *overlay_vec, ptrdiff_t noverlays, struct window *w) sortvec[j].priority = 0; sortvec[j].spriority = 0; } - else if (INTEGERP (tem)) + else if (FIXNUMP (tem)) { sortvec[j].priority = XINT (tem); sortvec[j].spriority = 0; @@ -3221,8 +3221,8 @@ sort_overlays (Lisp_Object *overlay_vec, ptrdiff_t noverlays, struct window *w) { Lisp_Object car = XCAR (tem); Lisp_Object cdr = XCDR (tem); - sortvec[j].priority = INTEGERP (car) ? XINT (car) : 0; - sortvec[j].spriority = INTEGERP (cdr) ? XINT (cdr) : 0; + sortvec[j].priority = FIXNUMP (car) ? XINT (car) : 0; + sortvec[j].spriority = FIXNUMP (cdr) ? XINT (cdr) : 0; } j++; } @@ -3290,7 +3290,7 @@ record_overlay_string (struct sortstrlist *ssl, Lisp_Object str, ssl->buf[ssl->used].string = str; ssl->buf[ssl->used].string2 = str2; ssl->buf[ssl->used].size = size; - ssl->buf[ssl->used].priority = (INTEGERP (pri) ? XINT (pri) : 0); + ssl->buf[ssl->used].priority = (FIXNUMP (pri) ? XINT (pri) : 0); ssl->used++; if (NILP (BVAR (current_buffer, enable_multibyte_characters))) @@ -3644,7 +3644,7 @@ fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end) if (endpos < startpos) { startpos = endpos; - Fset_marker (OVERLAY_START (overlay), make_number (startpos), + Fset_marker (OVERLAY_START (overlay), make_fixnum (startpos), Qnil); } @@ -3692,7 +3692,7 @@ fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end) if (endpos < startpos) { startpos = endpos; - Fset_marker (OVERLAY_START (overlay), make_number (startpos), + Fset_marker (OVERLAY_START (overlay), make_fixnum (startpos), Qnil); } @@ -3867,8 +3867,8 @@ for the rear of the overlay advance when text is inserted there if (MARKERP (end) && !EQ (Fmarker_buffer (end), buffer)) signal_error ("Marker points into wrong buffer", end); - CHECK_NUMBER_COERCE_MARKER (beg); - CHECK_NUMBER_COERCE_MARKER (end); + CHECK_FIXNUM_COERCE_MARKER (beg); + CHECK_FIXNUM_COERCE_MARKER (end); if (XINT (beg) > XINT (end)) { @@ -3987,8 +3987,8 @@ buffer. */) if (MARKERP (end) && !EQ (Fmarker_buffer (end), buffer)) signal_error ("Marker points into wrong buffer", end); - CHECK_NUMBER_COERCE_MARKER (beg); - CHECK_NUMBER_COERCE_MARKER (end); + CHECK_FIXNUM_COERCE_MARKER (beg); + CHECK_FIXNUM_COERCE_MARKER (end); if (XINT (beg) > XINT (end)) { @@ -4156,7 +4156,7 @@ If SORTED is non-nil, then sort them by decreasing priority. */) Lisp_Object *overlay_vec; Lisp_Object result; - CHECK_NUMBER_COERCE_MARKER (pos); + CHECK_FIXNUM_COERCE_MARKER (pos); if (!buffer_has_overlays ()) return Qnil; @@ -4200,8 +4200,8 @@ end of the buffer. */) Lisp_Object *overlay_vec; Lisp_Object result; - CHECK_NUMBER_COERCE_MARKER (beg); - CHECK_NUMBER_COERCE_MARKER (end); + CHECK_FIXNUM_COERCE_MARKER (beg); + CHECK_FIXNUM_COERCE_MARKER (end); if (!buffer_has_overlays ()) return Qnil; @@ -4232,10 +4232,10 @@ the value is (point-max). */) ptrdiff_t endpos; Lisp_Object *overlay_vec; - CHECK_NUMBER_COERCE_MARKER (pos); + CHECK_FIXNUM_COERCE_MARKER (pos); if (!buffer_has_overlays ()) - return make_number (ZV); + return make_fixnum (ZV); len = 10; overlay_vec = xmalloc (len * sizeof *overlay_vec); @@ -4260,7 +4260,7 @@ the value is (point-max). */) } xfree (overlay_vec); - return make_number (endpos); + return make_fixnum (endpos); } DEFUN ("previous-overlay-change", Fprevious_overlay_change, @@ -4274,10 +4274,10 @@ the value is (point-min). */) Lisp_Object *overlay_vec; ptrdiff_t len; - CHECK_NUMBER_COERCE_MARKER (pos); + CHECK_FIXNUM_COERCE_MARKER (pos); if (!buffer_has_overlays ()) - return make_number (BEGV); + return make_fixnum (BEGV); /* At beginning of buffer, we know the answer; avoid bug subtracting 1 below. */ @@ -4294,7 +4294,7 @@ the value is (point-min). */) 0, &prevpos, 1); xfree (overlay_vec); - return make_number (prevpos); + return make_fixnum (prevpos); } /* These functions are for debugging overlays. */ @@ -4332,7 +4332,7 @@ for positions far away from POS). */) (Lisp_Object pos) { ptrdiff_t p; - CHECK_NUMBER_COERCE_MARKER (pos); + CHECK_FIXNUM_COERCE_MARKER (pos); p = clip_to_bounds (PTRDIFF_MIN, XINT (pos), PTRDIFF_MAX); recenter_overlay_lists (current_buffer, p); @@ -5082,41 +5082,41 @@ init_buffer_once (void) /* 0 means not a lisp var, -1 means always local, else mask. */ memset (&buffer_local_flags, 0, sizeof buffer_local_flags); - bset_filename (&buffer_local_flags, make_number (-1)); - bset_directory (&buffer_local_flags, make_number (-1)); - bset_backed_up (&buffer_local_flags, make_number (-1)); - bset_save_length (&buffer_local_flags, make_number (-1)); - bset_auto_save_file_name (&buffer_local_flags, make_number (-1)); - bset_read_only (&buffer_local_flags, make_number (-1)); - bset_major_mode (&buffer_local_flags, make_number (-1)); - bset_mode_name (&buffer_local_flags, make_number (-1)); - bset_undo_list (&buffer_local_flags, make_number (-1)); - bset_mark_active (&buffer_local_flags, make_number (-1)); - bset_point_before_scroll (&buffer_local_flags, make_number (-1)); - bset_file_truename (&buffer_local_flags, make_number (-1)); - bset_invisibility_spec (&buffer_local_flags, make_number (-1)); - bset_file_format (&buffer_local_flags, make_number (-1)); - bset_auto_save_file_format (&buffer_local_flags, make_number (-1)); - bset_display_count (&buffer_local_flags, make_number (-1)); - bset_display_time (&buffer_local_flags, make_number (-1)); - bset_enable_multibyte_characters (&buffer_local_flags, make_number (-1)); + bset_filename (&buffer_local_flags, make_fixnum (-1)); + bset_directory (&buffer_local_flags, make_fixnum (-1)); + bset_backed_up (&buffer_local_flags, make_fixnum (-1)); + bset_save_length (&buffer_local_flags, make_fixnum (-1)); + bset_auto_save_file_name (&buffer_local_flags, make_fixnum (-1)); + bset_read_only (&buffer_local_flags, make_fixnum (-1)); + bset_major_mode (&buffer_local_flags, make_fixnum (-1)); + bset_mode_name (&buffer_local_flags, make_fixnum (-1)); + bset_undo_list (&buffer_local_flags, make_fixnum (-1)); + bset_mark_active (&buffer_local_flags, make_fixnum (-1)); + bset_point_before_scroll (&buffer_local_flags, make_fixnum (-1)); + bset_file_truename (&buffer_local_flags, make_fixnum (-1)); + bset_invisibility_spec (&buffer_local_flags, make_fixnum (-1)); + bset_file_format (&buffer_local_flags, make_fixnum (-1)); + bset_auto_save_file_format (&buffer_local_flags, make_fixnum (-1)); + bset_display_count (&buffer_local_flags, make_fixnum (-1)); + bset_display_time (&buffer_local_flags, make_fixnum (-1)); + bset_enable_multibyte_characters (&buffer_local_flags, make_fixnum (-1)); /* These used to be stuck at 0 by default, but now that the all-zero value means Qnil, we have to initialize them explicitly. */ - bset_name (&buffer_local_flags, make_number (0)); - bset_mark (&buffer_local_flags, make_number (0)); - bset_local_var_alist (&buffer_local_flags, make_number (0)); - bset_keymap (&buffer_local_flags, make_number (0)); - bset_downcase_table (&buffer_local_flags, make_number (0)); - bset_upcase_table (&buffer_local_flags, make_number (0)); - bset_case_canon_table (&buffer_local_flags, make_number (0)); - bset_case_eqv_table (&buffer_local_flags, make_number (0)); - bset_minor_modes (&buffer_local_flags, make_number (0)); - bset_width_table (&buffer_local_flags, make_number (0)); - bset_pt_marker (&buffer_local_flags, make_number (0)); - bset_begv_marker (&buffer_local_flags, make_number (0)); - bset_zv_marker (&buffer_local_flags, make_number (0)); - bset_last_selected_window (&buffer_local_flags, make_number (0)); + bset_name (&buffer_local_flags, make_fixnum (0)); + bset_mark (&buffer_local_flags, make_fixnum (0)); + bset_local_var_alist (&buffer_local_flags, make_fixnum (0)); + bset_keymap (&buffer_local_flags, make_fixnum (0)); + bset_downcase_table (&buffer_local_flags, make_fixnum (0)); + bset_upcase_table (&buffer_local_flags, make_fixnum (0)); + bset_case_canon_table (&buffer_local_flags, make_fixnum (0)); + bset_case_eqv_table (&buffer_local_flags, make_fixnum (0)); + bset_minor_modes (&buffer_local_flags, make_fixnum (0)); + bset_width_table (&buffer_local_flags, make_fixnum (0)); + bset_pt_marker (&buffer_local_flags, make_fixnum (0)); + bset_begv_marker (&buffer_local_flags, make_fixnum (0)); + bset_zv_marker (&buffer_local_flags, make_fixnum (0)); + bset_last_selected_window (&buffer_local_flags, make_fixnum (0)); idx = 1; XSETFASTINT (BVAR (&buffer_local_flags, mode_line_format), idx); ++idx; @@ -5443,7 +5443,7 @@ syms_of_buffer (void) { staticpro (&last_overlay_modification_hooks); last_overlay_modification_hooks - = Fmake_vector (make_number (10), Qnil); + = Fmake_vector (make_fixnum (10), Qnil); staticpro (&QSFundamental); staticpro (&Vbuffer_alist); diff --git a/src/buffer.h b/src/buffer.h index 85b5631736..c97e3d8fa5 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -295,7 +295,7 @@ extern void enlarge_buffer_text (struct buffer *, ptrdiff_t); do \ { \ Lisp_Object __pos = (pos); \ - if (NUMBERP (__pos)) \ + if (FIXED_OR_FLOATP (__pos)) \ { \ charpos = __pos; \ bytepos = buf_charpos_to_bytepos (current_buffer, __pos); \ @@ -1387,7 +1387,7 @@ downcase (int c) { Lisp_Object downcase_table = BVAR (current_buffer, downcase_table); Lisp_Object down = CHAR_TABLE_REF (downcase_table, c); - return NATNUMP (down) ? XFASTINT (down) : c; + return FIXNATP (down) ? XFASTINT (down) : c; } /* Upcase a character C, or make no change if that cannot be done. */ @@ -1396,7 +1396,7 @@ upcase (int c) { Lisp_Object upcase_table = BVAR (current_buffer, upcase_table); Lisp_Object up = CHAR_TABLE_REF (upcase_table, c); - return NATNUMP (up) ? XFASTINT (up) : c; + return FIXNATP (up) ? XFASTINT (up) : c; } /* True if C is upper case. */ diff --git a/src/bytecode.c b/src/bytecode.c index 772cc982f9..282754d22b 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -346,7 +346,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CHECK_STRING (bytestr); CHECK_VECTOR (vector); - CHECK_NATNUM (maxdepth); + CHECK_FIXNAT (maxdepth); ptrdiff_t const_length = ASIZE (vector); @@ -378,7 +378,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, if (!NILP (args_template)) { - eassert (INTEGERP (args_template)); + eassert (FIXNUMP (args_template)); ptrdiff_t at = XINT (args_template); bool rest = (at & 128) != 0; int mandatory = at & 127; @@ -386,8 +386,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, ptrdiff_t maxargs = rest ? PTRDIFF_MAX : nonrest; if (! (mandatory <= nargs && nargs <= maxargs)) Fsignal (Qwrong_number_of_arguments, - list2 (Fcons (make_number (mandatory), make_number (nonrest)), - make_number (nargs))); + list2 (Fcons (make_fixnum (mandatory), make_fixnum (nonrest)), + make_fixnum (nargs))); ptrdiff_t pushedargs = min (nonrest, nargs); for (ptrdiff_t i = 0; i < pushedargs; i++, args++) PUSH (*args); @@ -621,7 +621,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, { Lisp_Object v1 = TOP; Lisp_Object v2 = Fget (v1, Qbyte_code_meter); - if (INTEGERP (v2) + if (FIXNUMP (v2) && XINT (v2) < MOST_POSITIVE_FIXNUM) { XSETINT (v2, XINT (v2) + 1); @@ -832,7 +832,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Bnth): { Lisp_Object v2 = POP, v1 = TOP; - CHECK_NUMBER (v1); + CHECK_FIXNUM (v1); for (EMACS_INT n = XINT (v1); 0 < n && CONSP (v2); n--) { v2 = XCDR (v2); @@ -972,11 +972,11 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; CASE (Bsub1): - TOP = INTEGERP (TOP) ? make_number (XINT (TOP) - 1) : Fsub1 (TOP); + TOP = FIXNUMP (TOP) ? make_fixnum (XINT (TOP) - 1) : Fsub1 (TOP); NEXT; CASE (Badd1): - TOP = INTEGERP (TOP) ? make_number (XINT (TOP) + 1) : Fadd1 (TOP); + TOP = FIXNUMP (TOP) ? make_fixnum (XINT (TOP) + 1) : Fadd1 (TOP); NEXT; CASE (Beqlsign): @@ -986,8 +986,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, TOP = arithcompare (v1, v2, ARITH_EQUAL); else { - CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1); - CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2); + CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (v1); + CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (v2); TOP = EQ (v1, v2) ? Qt : Qnil; } NEXT; @@ -1027,7 +1027,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; CASE (Bnegate): - TOP = INTEGERP (TOP) ? make_number (- XINT (TOP)) : Fminus (1, &TOP); + TOP = FIXNUMP (TOP) ? make_fixnum (- XINT (TOP)) : Fminus (1, &TOP); NEXT; CASE (Bplus): @@ -1063,7 +1063,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, } CASE (Bpoint): - PUSH (make_natnum (PT)); + PUSH (make_fixed_natnum (PT)); NEXT; CASE (Bgoto_char): @@ -1089,7 +1089,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, } CASE (Bpoint_min): - PUSH (make_natnum (BEGV)); + PUSH (make_fixed_natnum (BEGV)); NEXT; CASE (Bchar_after): @@ -1105,7 +1105,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; CASE (Bcurrent_column): - PUSH (make_natnum (current_column ())); + PUSH (make_fixed_natnum (current_column ())); NEXT; CASE (Bindent_to): @@ -1262,7 +1262,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, { /* Exchange args and then do nth. */ Lisp_Object v2 = POP, v1 = TOP; - CHECK_NUMBER (v2); + CHECK_FIXNUM (v2); for (EMACS_INT n = XINT (v2); 0 < n && CONSP (v1); n--) { v1 = XCDR (v1); @@ -1324,11 +1324,11 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; CASE (Bnumberp): - TOP = NUMBERP (TOP) ? Qt : Qnil; + TOP = FIXED_OR_FLOATP (TOP) ? Qt : Qnil; NEXT; CASE (Bintegerp): - TOP = INTEGERP (TOP) ? Qt : Qnil; + TOP = FIXNUMP (TOP) ? Qt : Qnil; NEXT; #if BYTE_CODE_SAFE @@ -1415,7 +1415,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, { /* Do a linear search if there are not many cases FIXME: 5 is arbitrarily chosen. */ Lisp_Object hash_code = h->test.cmpfn - ? make_number (h->test.hashfn (&h->test, v1)) : Qnil; + ? make_fixnum (h->test.hashfn (&h->test, v1)) : Qnil; for (i = h->count; 0 <= --i; ) if (EQ (v1, HASH_KEY (h, i)) @@ -1431,7 +1431,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, if (i >= 0) { Lisp_Object val = HASH_VALUE (h, i); - if (BYTE_CODE_SAFE && !INTEGERP (val)) + if (BYTE_CODE_SAFE && !FIXNUMP (val)) emacs_abort (); op = XINT (val); goto op_branch; @@ -1468,14 +1468,14 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, Lisp_Object get_byte_code_arity (Lisp_Object args_template) { - eassert (NATNUMP (args_template)); + eassert (FIXNATP (args_template)); EMACS_INT at = XINT (args_template); bool rest = (at & 128) != 0; int mandatory = at & 127; EMACS_INT nonrest = at >> 8; - return Fcons (make_number (mandatory), - rest ? Qmany : make_number (nonrest)); + return Fcons (make_fixnum (mandatory), + rest ? Qmany : make_fixnum (nonrest)); } void @@ -1500,13 +1500,13 @@ If a symbol has a property named `byte-code-meter' whose value is an integer, it is incremented each time that symbol's function is called. */); byte_metering_on = false; - Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0)); + Vbyte_code_meter = Fmake_vector (make_fixnum (256), make_fixnum (0)); DEFSYM (Qbyte_code_meter, "byte-code-meter"); { int i = 256; while (i--) ASET (Vbyte_code_meter, i, - Fmake_vector (make_number (256), make_number (0))); + Fmake_vector (make_fixnum (256), make_fixnum (0))); } #endif } diff --git a/src/callint.c b/src/callint.c index c6e003ed40..c18eab488d 100644 --- a/src/callint.c +++ b/src/callint.c @@ -200,8 +200,8 @@ fix_command (Lisp_Object input, Lisp_Object values) carelt = XCAR (elt); /* If it is (if X Y), look at Y. */ if (EQ (carelt, Qif) - && EQ (Fnthcdr (make_number (3), elt), Qnil)) - elt = Fnth (make_number (2), elt); + && EQ (Fnthcdr (make_fixnum (3), elt), Qnil)) + elt = Fnth (make_fixnum (2), elt); /* If it is (when ... Y), look at Y. */ else if (EQ (carelt, Qwhen)) { @@ -479,8 +479,8 @@ invoke it. If KEYS is omitted or nil, the return value of case 'c': /* Character. */ /* Prompt in `minibuffer-prompt' face. */ - Fput_text_property (make_number (0), - make_number (SCHARS (callint_message)), + Fput_text_property (make_fixnum (0), + make_fixnum (SCHARS (callint_message)), Qface, Qminibuffer_prompt, callint_message); args[i] = Fread_char (callint_message, Qnil, Qnil); message1_nolog (0); @@ -531,8 +531,8 @@ invoke it. If KEYS is omitted or nil, the return value of ptrdiff_t speccount1 = SPECPDL_INDEX (); specbind (Qcursor_in_echo_area, Qt); /* Prompt in `minibuffer-prompt' face. */ - Fput_text_property (make_number (0), - make_number (SCHARS (callint_message)), + Fput_text_property (make_fixnum (0), + make_fixnum (SCHARS (callint_message)), Qface, Qminibuffer_prompt, callint_message); args[i] = Fread_key_sequence (callint_message, Qnil, Qnil, Qnil, Qnil); @@ -542,7 +542,7 @@ invoke it. If KEYS is omitted or nil, the return value of /* If the key sequence ends with a down-event, discard the following up-event. */ Lisp_Object teml - = Faref (args[i], make_number (XINT (Flength (args[i])) - 1)); + = Faref (args[i], make_fixnum (XINT (Flength (args[i])) - 1)); if (CONSP (teml)) teml = XCAR (teml); if (SYMBOLP (teml)) @@ -561,8 +561,8 @@ invoke it. If KEYS is omitted or nil, the return value of ptrdiff_t speccount1 = SPECPDL_INDEX (); specbind (Qcursor_in_echo_area, Qt); /* Prompt in `minibuffer-prompt' face. */ - Fput_text_property (make_number (0), - make_number (SCHARS (callint_message)), + Fput_text_property (make_fixnum (0), + make_fixnum (SCHARS (callint_message)), Qface, Qminibuffer_prompt, callint_message); args[i] = Fread_key_sequence_vector (callint_message, Qnil, Qt, Qnil, Qnil); @@ -572,7 +572,7 @@ invoke it. If KEYS is omitted or nil, the return value of /* If the key sequence ends with a down-event, discard the following up-event. */ Lisp_Object teml - = Faref (args[i], make_number (XINT (Flength (args[i])) - 1)); + = Faref (args[i], make_fixnum (XINT (Flength (args[i])) - 1)); if (CONSP (teml)) teml = XCAR (teml); if (SYMBOLP (teml)) @@ -589,7 +589,7 @@ invoke it. If KEYS is omitted or nil, the return value of case 'U': /* Up event from last k or K. */ if (!NILP (up_event)) { - args[i] = Fmake_vector (make_number (1), up_event); + args[i] = Fmake_vector (make_fixnum (1), up_event); up_event = Qnil; visargs[i] = Fkey_description (args[i], Qnil); } @@ -795,9 +795,9 @@ Its numeric meaning is what you would get from `(interactive "p")'. */) XSETFASTINT (val, 1); else if (EQ (raw, Qminus)) XSETINT (val, -1); - else if (CONSP (raw) && INTEGERP (XCAR (raw))) + else if (CONSP (raw) && FIXNUMP (XCAR (raw))) XSETINT (val, XINT (XCAR (raw))); - else if (INTEGERP (raw)) + else if (FIXNUMP (raw)) val = raw; else XSETFASTINT (val, 1); diff --git a/src/callproc.c b/src/callproc.c index 17eb8132d9..f959927d37 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -83,7 +83,7 @@ static pid_t synch_process_pid; #ifdef MSDOS static Lisp_Object synch_process_tempfile; #else -# define synch_process_tempfile make_number (0) +# define synch_process_tempfile make_fixnum (0) #endif /* Indexes of file descriptors that need closing on call_process_kill. */ @@ -324,7 +324,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, #ifndef subprocesses /* Without asynchronous processes we cannot have BUFFER == 0. */ if (nargs >= 3 - && (INTEGERP (CONSP (args[2]) ? XCAR (args[2]) : args[2]))) + && (FIXNUMP (CONSP (args[2]) ? XCAR (args[2]) : args[2]))) error ("Operating system cannot handle asynchronous subprocesses"); #endif /* subprocesses */ @@ -403,7 +403,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, buffer = Qnil; } - if (! (NILP (buffer) || EQ (buffer, Qt) || INTEGERP (buffer))) + if (! (NILP (buffer) || EQ (buffer, Qt) || FIXNUMP (buffer))) { Lisp_Object spec_buffer; spec_buffer = buffer; @@ -431,7 +431,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, for (i = 0; i < CALLPROC_FDS; i++) callproc_fd[i] = -1; #ifdef MSDOS - synch_process_tempfile = make_number (0); + synch_process_tempfile = make_fixnum (0); #endif record_unwind_protect_ptr (call_process_kill, callproc_fd); @@ -440,7 +440,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, int ok; ok = openp (Vexec_path, args[0], Vexec_suffixes, &path, - make_number (X_OK), false); + make_fixnum (X_OK), false); if (ok < 0) report_file_error ("Searching for program", args[0]); } @@ -471,7 +471,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, path = ENCODE_FILE (path); new_argv[0] = SSDATA (path); - discard_output = INTEGERP (buffer) || (NILP (buffer) && NILP (output_file)); + discard_output = FIXNUMP (buffer) || (NILP (buffer) && NILP (output_file)); #ifdef MSDOS if (! discard_output && ! STRINGP (output_file)) @@ -670,7 +670,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, { synch_process_pid = pid; - if (INTEGERP (buffer)) + if (FIXNUMP (buffer)) { if (tempfile_index < 0) record_deleted_pid (pid, Qnil); @@ -703,7 +703,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, #endif /* not MSDOS */ - if (INTEGERP (buffer)) + if (FIXNUMP (buffer)) return unbind_to (count, Qnil); if (BUFFERP (buffer)) @@ -870,7 +870,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, coding-system used to decode the process output. */ if (inherit_process_coding_system) call1 (intern ("after-insert-file-set-buffer-file-coding-system"), - make_number (total_read)); + make_fixnum (total_read)); } bool wait_ok = true; @@ -903,7 +903,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, } eassert (WIFEXITED (status)); - return make_number (WEXITSTATUS (status)); + return make_fixnum (WEXITSTATUS (status)); } /* Create a temporary file suitable for storing the input data of @@ -1644,7 +1644,7 @@ syms_of_callproc (void) staticpro (&Vtemp_file_name_pattern); #ifdef MSDOS - synch_process_tempfile = make_number (0); + synch_process_tempfile = make_fixnum (0); staticpro (&synch_process_tempfile); #endif diff --git a/src/casefiddle.c b/src/casefiddle.c index 8befc5ae7c..a6656b1e68 100644 --- a/src/casefiddle.c +++ b/src/casefiddle.c @@ -250,7 +250,7 @@ do_casify_natnum (struct casing_context *ctx, Lisp_Object obj) if (! multibyte) MAKE_CHAR_UNIBYTE (cased); - return make_natnum (cased | flags); + return make_fixed_natnum (cased | flags); } static Lisp_Object @@ -319,7 +319,7 @@ casify_object (enum case_action flag, Lisp_Object obj) struct casing_context ctx; prepare_casing_context (&ctx, flag, false); - if (NATNUMP (obj)) + if (FIXNATP (obj)) return do_casify_natnum (&ctx, obj); else if (!STRINGP (obj)) wrong_type_argument (Qchar_or_string_p, obj); @@ -601,11 +601,11 @@ character positions to operate on. */) static Lisp_Object casify_word (enum case_action flag, Lisp_Object arg) { - CHECK_NUMBER (arg); + CHECK_FIXNUM (arg); ptrdiff_t farend = scan_words (PT, XINT (arg)); if (!farend) farend = XINT (arg) <= 0 ? BEGV : ZV; - SET_PT (casify_region (flag, make_number (PT), make_number (farend))); + SET_PT (casify_region (flag, make_fixnum (PT), make_fixnum (farend))); return Qnil; } diff --git a/src/casetab.c b/src/casetab.c index 8f806a0647..58847fc330 100644 --- a/src/casetab.c +++ b/src/casetab.c @@ -178,7 +178,7 @@ set_canon (Lisp_Object case_table, Lisp_Object range, Lisp_Object elt) Lisp_Object up = XCHAR_TABLE (case_table)->extras[0]; Lisp_Object canon = XCHAR_TABLE (case_table)->extras[1]; - if (NATNUMP (elt)) + if (FIXNATP (elt)) Fset_char_table_range (canon, range, Faref (case_table, Faref (up, elt))); } @@ -190,7 +190,7 @@ set_canon (Lisp_Object case_table, Lisp_Object range, Lisp_Object elt) static void set_identity (Lisp_Object table, Lisp_Object c, Lisp_Object elt) { - if (NATNUMP (elt)) + if (FIXNATP (elt)) { int from, to; @@ -204,7 +204,7 @@ set_identity (Lisp_Object table, Lisp_Object c, Lisp_Object elt) to++; for (; from < to; from++) - CHAR_TABLE_SET (table, from, make_number (from)); + CHAR_TABLE_SET (table, from, make_fixnum (from)); } } @@ -216,7 +216,7 @@ set_identity (Lisp_Object table, Lisp_Object c, Lisp_Object elt) static void shuffle (Lisp_Object table, Lisp_Object c, Lisp_Object elt) { - if (NATNUMP (elt)) + if (FIXNATP (elt)) { int from, to; @@ -232,8 +232,8 @@ shuffle (Lisp_Object table, Lisp_Object c, Lisp_Object elt) for (; from < to; from++) { Lisp_Object tem = Faref (table, elt); - Faset (table, elt, make_number (from)); - Faset (table, make_number (from), tem); + Faset (table, elt, make_fixnum (from)); + Faset (table, make_fixnum (from), tem); } } } @@ -245,7 +245,7 @@ init_casetab_once (void) Lisp_Object down, up, eqv; DEFSYM (Qcase_table, "case-table"); - Fput (Qcase_table, Qchar_table_extra_slots, make_number (3)); + Fput (Qcase_table, Qchar_table_extra_slots, make_fixnum (3)); down = Fmake_char_table (Qcase_table, Qnil); Vascii_downcase_table = down; @@ -254,7 +254,7 @@ init_casetab_once (void) for (i = 0; i < 128; i++) { int c = (i >= 'A' && i <= 'Z') ? i + ('a' - 'A') : i; - CHAR_TABLE_SET (down, i, make_number (c)); + CHAR_TABLE_SET (down, i, make_fixnum (c)); } set_char_table_extras (down, 1, Fcopy_sequence (down)); @@ -265,7 +265,7 @@ init_casetab_once (void) for (i = 0; i < 128; i++) { int c = (i >= 'a' && i <= 'z') ? i + ('A' - 'a') : i; - CHAR_TABLE_SET (up, i, make_number (c)); + CHAR_TABLE_SET (up, i, make_fixnum (c)); } eqv = Fmake_char_table (Qcase_table, Qnil); @@ -275,7 +275,7 @@ init_casetab_once (void) int c = ((i >= 'A' && i <= 'Z') ? i + ('a' - 'A') : ((i >= 'a' && i <= 'z') ? i + ('A' - 'a') : i)); - CHAR_TABLE_SET (eqv, i, make_number (c)); + CHAR_TABLE_SET (eqv, i, make_fixnum (c)); } set_char_table_extras (down, 2, eqv); diff --git a/src/category.c b/src/category.c index 62bb7f1a6c..72b589c790 100644 --- a/src/category.c +++ b/src/category.c @@ -103,7 +103,7 @@ those categories. */) while (--len >= 0) { unsigned char cat = SREF (categories, len); - Lisp_Object category = make_number (cat); + Lisp_Object category = make_fixnum (cat); CHECK_CATEGORY (category); set_category_set (val, cat, 1); @@ -165,7 +165,7 @@ it defaults to the current buffer's category table. */) for (i = ' '; i <= '~'; i++) if (NILP (CATEGORY_DOCSTRING (table, i))) - return make_number (i); + return make_fixnum (i); return Qnil; } @@ -271,8 +271,8 @@ DEFUN ("make-category-table", Fmake_category_table, Smake_category_table, set_char_table_defalt (val, MAKE_CATEGORY_SET); for (i = 0; i < (1 << CHARTAB_SIZE_BITS_0); i++) set_char_table_contents (val, i, MAKE_CATEGORY_SET); - Fset_char_table_extra_slot (val, make_number (0), - Fmake_vector (make_number (95), Qnil)); + Fset_char_table_extra_slot (val, make_fixnum (0), + Fmake_vector (make_fixnum (95), Qnil)); return val; } @@ -346,7 +346,7 @@ then delete CATEGORY from the category set instead of adding it. */) int start, end; int from, to; - if (INTEGERP (character)) + if (FIXNUMP (character)) { CHECK_CHARACTER (character); start = end = XFASTINT (character); @@ -440,13 +440,13 @@ init_category_once (void) { /* This has to be done here, before we call Fmake_char_table. */ DEFSYM (Qcategory_table, "category-table"); - Fput (Qcategory_table, Qchar_table_extra_slots, make_number (2)); + Fput (Qcategory_table, Qchar_table_extra_slots, make_fixnum (2)); Vstandard_category_table = Fmake_char_table (Qcategory_table, Qnil); /* Set a category set which contains nothing to the default. */ set_char_table_defalt (Vstandard_category_table, MAKE_CATEGORY_SET); - Fset_char_table_extra_slot (Vstandard_category_table, make_number (0), - Fmake_vector (make_number (95), Qnil)); + Fset_char_table_extra_slot (Vstandard_category_table, make_fixnum (0), + Fmake_vector (make_fixnum (95), Qnil)); } void diff --git a/src/category.h b/src/category.h index c4feedd358..cc32990478 100644 --- a/src/category.h +++ b/src/category.h @@ -59,7 +59,7 @@ along with GNU Emacs. If not, see . */ INLINE_HEADER_BEGIN -#define CATEGORYP(x) RANGED_INTEGERP (0x20, x, 0x7E) +#define CATEGORYP(x) RANGED_FIXNUMP (0x20, x, 0x7E) #define CHECK_CATEGORY(x) \ CHECK_TYPE (CATEGORYP (x), Qcategoryp, x) @@ -68,7 +68,7 @@ INLINE_HEADER_BEGIN (BOOL_VECTOR_P (x) && bool_vector_size (x) == 128) /* Return a new empty category set. */ -#define MAKE_CATEGORY_SET (Fmake_bool_vector (make_number (128), Qnil)) +#define MAKE_CATEGORY_SET (Fmake_bool_vector (make_fixnum (128), Qnil)) #define CHECK_CATEGORY_SET(x) \ CHECK_TYPE (CATEGORY_SET_P (x), Qcategorysetp, x) @@ -77,7 +77,7 @@ INLINE_HEADER_BEGIN #define CATEGORY_SET(c) char_category_set (c) /* Return true if CATEGORY_SET contains CATEGORY. - Faster than '!NILP (Faref (category_set, make_number (category)))'. */ + Faster than '!NILP (Faref (category_set, make_fixnum (category)))'. */ INLINE bool CATEGORY_MEMBER (EMACS_INT category, Lisp_Object category_set) { @@ -98,16 +98,16 @@ CHAR_HAS_CATEGORY (int ch, int category) /* Return the doc string of CATEGORY in category table TABLE. */ #define CATEGORY_DOCSTRING(table, category) \ - AREF (Fchar_table_extra_slot (table, make_number (0)), ((category) - ' ')) + AREF (Fchar_table_extra_slot (table, make_fixnum (0)), ((category) - ' ')) /* Set the doc string of CATEGORY to VALUE in category table TABLE. */ #define SET_CATEGORY_DOCSTRING(table, category, value) \ - ASET (Fchar_table_extra_slot (table, make_number (0)), ((category) - ' '), value) + ASET (Fchar_table_extra_slot (table, make_fixnum (0)), ((category) - ' '), value) /* Return the version number of category table TABLE. Not used for the moment. */ #define CATEGORY_TABLE_VERSION (table) \ - Fchar_table_extra_slot (table, make_number (1)) + Fchar_table_extra_slot (table, make_fixnum (1)) /* Return true if there is a word boundary between two word-constituent characters C1 and C2 if they appear in this order. diff --git a/src/ccl.c b/src/ccl.c index ed8588d7f8..529b302ed9 100644 --- a/src/ccl.c +++ b/src/ccl.c @@ -1291,7 +1291,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size : -1)); h = GET_HASH_TABLE (eop); - eop = hash_lookup (h, make_number (reg[RRR]), NULL); + eop = hash_lookup (h, make_fixnum (reg[RRR]), NULL); if (eop >= 0) { Lisp_Object opl; @@ -1318,12 +1318,12 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size i = CCL_DECODE_CHAR (reg[RRR], reg[rrr]); h = GET_HASH_TABLE (eop); - eop = hash_lookup (h, make_number (i), NULL); + eop = hash_lookup (h, make_fixnum (i), NULL); if (eop >= 0) { Lisp_Object opl; opl = HASH_VALUE (h, eop); - if (! (INTEGERP (opl) && IN_INT_RANGE (XINT (opl)))) + if (! (FIXNUMP (opl) && IN_INT_RANGE (XINT (opl)))) CCL_INVALID_CMD; reg[RRR] = XINT (opl); reg[7] = 1; /* r7 true for success */ @@ -1375,7 +1375,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size /* check map type, [STARTPOINT VAL1 VAL2 ...] or [t ELEMENT STARTPOINT ENDPOINT] */ - if (INTEGERP (content)) + if (FIXNUMP (content)) { point = XINT (content); if (!(point <= op && op - point + 1 < size)) continue; @@ -1384,9 +1384,9 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size else if (EQ (content, Qt)) { if (size != 4) continue; - if (INTEGERP (AREF (map, 2)) + if (FIXNUMP (AREF (map, 2)) && XINT (AREF (map, 2)) <= op - && INTEGERP (AREF (map, 3)) + && FIXNUMP (AREF (map, 3)) && op < XINT (AREF (map, 3))) content = AREF (map, 1); else @@ -1397,7 +1397,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size if (NILP (content)) continue; - else if (INTEGERP (content) && IN_INT_RANGE (XINT (content))) + else if (FIXNUMP (content) && IN_INT_RANGE (XINT (content))) { reg[RRR] = i; reg[rrr] = XINT (content); @@ -1412,7 +1412,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size { attrib = XCAR (content); value = XCDR (content); - if (! (INTEGERP (attrib) && INTEGERP (value) + if (! (FIXNUMP (attrib) && FIXNUMP (value) && IN_INT_RANGE (XINT (value)))) continue; reg[RRR] = i; @@ -1554,7 +1554,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size /* check map type, [STARTPOINT VAL1 VAL2 ...] or [t ELEMENT STARTPOINT ENDPOINT] */ - if (INTEGERP (content)) + if (FIXNUMP (content)) { point = XINT (content); if (!(point <= op && op - point + 1 < size)) continue; @@ -1563,9 +1563,9 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size else if (EQ (content, Qt)) { if (size != 4) continue; - if (INTEGERP (AREF (map, 2)) + if (FIXNUMP (AREF (map, 2)) && XINT (AREF (map, 2)) <= op - && INTEGERP (AREF (map, 3)) + && FIXNUMP (AREF (map, 3)) && op < XINT (AREF (map, 3))) content = AREF (map, 1); else @@ -1578,7 +1578,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size continue; reg[RRR] = i; - if (INTEGERP (content) && IN_INT_RANGE (XINT (content))) + if (FIXNUMP (content) && IN_INT_RANGE (XINT (content))) { op = XINT (content); i += map_set_rest_length - 1; @@ -1590,7 +1590,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size { attrib = XCAR (content); value = XCDR (content); - if (! (INTEGERP (attrib) && INTEGERP (value) + if (! (FIXNUMP (attrib) && FIXNUMP (value) && IN_INT_RANGE (XINT (value)))) continue; op = XINT (value); @@ -1656,7 +1656,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size map = XCDR (map); if (! (VECTORP (map) && 0 < ASIZE (map) - && INTEGERP (AREF (map, 0)) + && FIXNUMP (AREF (map, 0)) && XINT (AREF (map, 0)) <= op && op - XINT (AREF (map, 0)) + 1 < ASIZE (map))) { @@ -1668,15 +1668,15 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size content = AREF (map, point); if (NILP (content)) reg[RRR] = -1; - else if (TYPE_RANGED_INTEGERP (int, content)) + else if (TYPE_RANGED_FIXNUMP (int, content)) reg[rrr] = XINT (content); else if (EQ (content, Qt)); else if (CONSP (content)) { attrib = XCAR (content); value = XCDR (content); - if (!INTEGERP (attrib) - || !TYPE_RANGED_INTEGERP (int, value)) + if (!FIXNUMP (attrib) + || !TYPE_RANGED_FIXNUMP (int, value)) continue; reg[rrr] = XINT (value); break; @@ -1809,7 +1809,7 @@ resolve_symbol_ccl_program (Lisp_Object ccl) for (i = 0; i < veclen; i++) { contents = AREF (result, i); - if (TYPE_RANGED_INTEGERP (int, contents)) + if (TYPE_RANGED_FIXNUMP (int, contents)) continue; else if (CONSP (contents) && SYMBOLP (XCAR (contents)) @@ -1819,7 +1819,7 @@ resolve_symbol_ccl_program (Lisp_Object ccl) (SYMBOL . PROPERTY). (get SYMBOL PROPERTY) should give an index number. */ val = Fget (XCAR (contents), XCDR (contents)); - if (RANGED_INTEGERP (0, val, INT_MAX)) + if (RANGED_FIXNUMP (0, val, INT_MAX)) ASET (result, i, val); else unresolved = 1; @@ -1831,17 +1831,17 @@ resolve_symbol_ccl_program (Lisp_Object ccl) may lead to a bug if, for instance, a translation table and a code conversion map have the same name. */ val = Fget (contents, Qtranslation_table_id); - if (RANGED_INTEGERP (0, val, INT_MAX)) + if (RANGED_FIXNUMP (0, val, INT_MAX)) ASET (result, i, val); else { val = Fget (contents, Qcode_conversion_map_id); - if (RANGED_INTEGERP (0, val, INT_MAX)) + if (RANGED_FIXNUMP (0, val, INT_MAX)) ASET (result, i, val); else { val = Fget (contents, Qccl_program_idx); - if (RANGED_INTEGERP (0, val, INT_MAX)) + if (RANGED_FIXNUMP (0, val, INT_MAX)) ASET (result, i, val); else unresolved = 1; @@ -1881,7 +1881,7 @@ ccl_get_compiled_code (Lisp_Object ccl_prog, ptrdiff_t *idx) return Qnil; val = Fget (ccl_prog, Qccl_program_idx); - if (! NATNUMP (val) + if (! FIXNATP (val) || XINT (val) >= ASIZE (Vccl_program_table)) return Qnil; slot = AREF (Vccl_program_table, XINT (val)); @@ -1956,7 +1956,7 @@ See the documentation of `define-ccl-program' for the detail of CCL program. */ return Qnil; val = Fget (object, Qccl_program_idx); - return ((! NATNUMP (val) + return ((! FIXNATP (val) || XINT (val) >= ASIZE (Vccl_program_table)) ? Qnil : Qt); } @@ -1990,7 +1990,7 @@ programs. */) error ("Length of vector REGISTERS is not 8"); for (i = 0; i < 8; i++) - ccl.reg[i] = (TYPE_RANGED_INTEGERP (int, AREF (reg, i)) + ccl.reg[i] = (TYPE_RANGED_FIXNUMP (int, AREF (reg, i)) ? XINT (AREF (reg, i)) : 0); @@ -2000,7 +2000,7 @@ programs. */) error ("Error in CCL program at %dth code", ccl.ic); for (i = 0; i < 8; i++) - ASET (reg, i, make_number (ccl.reg[i])); + ASET (reg, i, make_fixnum (ccl.reg[i])); return Qnil; } @@ -2058,11 +2058,11 @@ usage: (ccl-execute-on-string CCL-PROGRAM STATUS STRING &optional CONTINUE UNIBY for (i = 0; i < 8; i++) { if (NILP (AREF (status, i))) - ASET (status, i, make_number (0)); - if (TYPE_RANGED_INTEGERP (int, AREF (status, i))) + ASET (status, i, make_fixnum (0)); + if (TYPE_RANGED_FIXNUMP (int, AREF (status, i))) ccl.reg[i] = XINT (AREF (status, i)); } - if (INTEGERP (AREF (status, i))) + if (FIXNUMP (AREF (status, i))) { i = XFASTINT (AREF (status, 8)); if (ccl.ic < i && i < ccl.size) @@ -2139,8 +2139,8 @@ usage: (ccl-execute-on-string CCL-PROGRAM STATUS STRING &optional CONTINUE UNIBY error ("CCL program interrupted at %dth code", ccl.ic); for (i = 0; i < 8; i++) - ASET (status, i, make_number (ccl.reg[i])); - ASET (status, 8, make_number (ccl.ic)); + ASET (status, i, make_fixnum (ccl.reg[i])); + ASET (status, 8, make_fixnum (ccl.ic)); val = make_specified_string ((const char *) outbuf, produced_chars, outp - outbuf, NILP (unibyte_p)); @@ -2193,7 +2193,7 @@ Return index number of the registered CCL program. */) ASET (slot, 1, ccl_prog); ASET (slot, 2, resolved); ASET (slot, 3, Qt); - return make_number (idx); + return make_fixnum (idx); } } @@ -2211,8 +2211,8 @@ Return index number of the registered CCL program. */) ASET (Vccl_program_table, idx, elt); } - Fput (name, Qccl_program_idx, make_number (idx)); - return make_number (idx); + Fput (name, Qccl_program_idx, make_fixnum (idx)); + return make_fixnum (idx); } /* Register code conversion map. @@ -2251,7 +2251,7 @@ Return index number of the registered map. */) if (EQ (symbol, XCAR (slot))) { - idx = make_number (i); + idx = make_fixnum (i); XSETCDR (slot, map); Fput (symbol, Qcode_conversion_map, map); Fput (symbol, Qcode_conversion_map_id, idx); @@ -2263,7 +2263,7 @@ Return index number of the registered map. */) Vcode_conversion_map_vector = larger_vector (Vcode_conversion_map_vector, 1, -1); - idx = make_number (i); + idx = make_fixnum (i); Fput (symbol, Qcode_conversion_map, map); Fput (symbol, Qcode_conversion_map_id, idx); ASET (Vcode_conversion_map_vector, i, Fcons (symbol, map)); @@ -2275,7 +2275,7 @@ void syms_of_ccl (void) { staticpro (&Vccl_program_table); - Vccl_program_table = Fmake_vector (make_number (32), Qnil); + Vccl_program_table = Fmake_vector (make_fixnum (32), Qnil); DEFSYM (Qccl, "ccl"); DEFSYM (Qcclp, "cclp"); @@ -2291,7 +2291,7 @@ syms_of_ccl (void) DEFVAR_LISP ("code-conversion-map-vector", Vcode_conversion_map_vector, doc: /* Vector of code conversion maps. */); - Vcode_conversion_map_vector = Fmake_vector (make_number (16), Qnil); + Vcode_conversion_map_vector = Fmake_vector (make_fixnum (16), Qnil); DEFVAR_LISP ("font-ccl-encoder-alist", Vfont_ccl_encoder_alist, doc: /* Alist of fontname patterns vs corresponding CCL program. diff --git a/src/character.c b/src/character.c index 6a68980804..f9b32e7a5b 100644 --- a/src/character.c +++ b/src/character.c @@ -233,7 +233,7 @@ DEFUN ("max-char", Fmax_char, Smax_char, 0, 0, 0, attributes: const) (void) { - return make_number (MAX_CHAR); + return make_fixnum (MAX_CHAR); } DEFUN ("unibyte-char-to-multibyte", Funibyte_char_to_multibyte, @@ -248,7 +248,7 @@ DEFUN ("unibyte-char-to-multibyte", Funibyte_char_to_multibyte, if (c >= 0x100) error ("Not a unibyte character: %d", c); MAKE_CHAR_MULTIBYTE (c); - return make_number (c); + return make_fixnum (c); } DEFUN ("multibyte-char-to-unibyte", Fmultibyte_char_to_unibyte, @@ -268,7 +268,7 @@ If the multibyte character does not represent a byte, return -1. */) else { int cu = CHAR_TO_BYTE_SAFE (cm); - return make_number (cu); + return make_fixnum (cu); } } @@ -314,7 +314,7 @@ usage: (char-width CHAR) */) CHECK_CHARACTER (ch); c = XINT (ch); width = char_width (c, buffer_display_table ()); - return make_number (width); + return make_fixnum (width); } /* Return width of string STR of length LEN when displayed in the @@ -896,9 +896,9 @@ usage: (char-resolve-modifiers CHAR) */) { EMACS_INT c; - CHECK_NUMBER (character); + CHECK_FIXNUM (character); c = XINT (character); - return make_number (char_resolve_modifier_mask (c)); + return make_fixnum (char_resolve_modifier_mask (c)); } DEFUN ("get-byte", Fget_byte, Sget_byte, 0, 2, 0, @@ -925,14 +925,14 @@ character is not ASCII nor 8-bit character, an error is signaled. */) } else { - CHECK_NUMBER_COERCE_MARKER (position); + CHECK_FIXNUM_COERCE_MARKER (position); if (XINT (position) < BEGV || XINT (position) >= ZV) - args_out_of_range_3 (position, make_number (BEGV), make_number (ZV)); + args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV)); pos = XFASTINT (position); p = CHAR_POS_ADDR (pos); } if (NILP (BVAR (current_buffer, enable_multibyte_characters))) - return make_number (*p); + return make_fixnum (*p); } else { @@ -943,21 +943,21 @@ character is not ASCII nor 8-bit character, an error is signaled. */) } else { - CHECK_NATNUM (position); + CHECK_FIXNAT (position); if (XINT (position) >= SCHARS (string)) args_out_of_range (string, position); pos = XFASTINT (position); p = SDATA (string) + string_char_to_byte (string, pos); } if (! STRING_MULTIBYTE (string)) - return make_number (*p); + return make_fixnum (*p); } c = STRING_CHAR (p); if (CHAR_BYTE8_P (c)) c = CHAR_TO_BYTE8 (c); else if (! ASCII_CHAR_P (c)) error ("Not an ASCII nor an 8-bit character: %d", c); - return make_number (c); + return make_fixnum (c); } /* Return true if C is an alphabetic character. */ @@ -965,7 +965,7 @@ bool alphabeticp (int c) { Lisp_Object category = CHAR_TABLE_REF (Vunicode_category_table, c); - if (! INTEGERP (category)) + if (! FIXNUMP (category)) return false; EMACS_INT gen_cat = XINT (category); @@ -988,7 +988,7 @@ bool alphanumericp (int c) { Lisp_Object category = CHAR_TABLE_REF (Vunicode_category_table, c); - if (! INTEGERP (category)) + if (! FIXNUMP (category)) return false; EMACS_INT gen_cat = XINT (category); @@ -1010,7 +1010,7 @@ bool graphicp (int c) { Lisp_Object category = CHAR_TABLE_REF (Vunicode_category_table, c); - if (! INTEGERP (category)) + if (! FIXNUMP (category)) return false; EMACS_INT gen_cat = XINT (category); @@ -1028,7 +1028,7 @@ bool printablep (int c) { Lisp_Object category = CHAR_TABLE_REF (Vunicode_category_table, c); - if (! INTEGERP (category)) + if (! FIXNUMP (category)) return false; EMACS_INT gen_cat = XINT (category); @@ -1044,7 +1044,7 @@ bool blankp (int c) { Lisp_Object category = CHAR_TABLE_REF (Vunicode_category_table, c); - if (! INTEGERP (category)) + if (! FIXNUMP (category)) return false; return XINT (category) == UNICODE_CATEGORY_Zs; /* separator, space */ @@ -1118,7 +1118,7 @@ syms_of_character (void) Vector recording all translation tables ever defined. Each element is a pair (SYMBOL . TABLE) relating the table to the symbol naming it. The ID of a translation table is an index into this vector. */); - Vtranslation_table_vector = Fmake_vector (make_number (16), Qnil); + Vtranslation_table_vector = Fmake_vector (make_fixnum (16), Qnil); DEFVAR_LISP ("auto-fill-chars", Vauto_fill_chars, doc: /* @@ -1131,26 +1131,26 @@ Such characters have value t in this table. */); DEFVAR_LISP ("char-width-table", Vchar_width_table, doc: /* A char-table for width (columns) of each character. */); - Vchar_width_table = Fmake_char_table (Qnil, make_number (1)); - char_table_set_range (Vchar_width_table, 0x80, 0x9F, make_number (4)); + Vchar_width_table = Fmake_char_table (Qnil, make_fixnum (1)); + char_table_set_range (Vchar_width_table, 0x80, 0x9F, make_fixnum (4)); char_table_set_range (Vchar_width_table, MAX_5_BYTE_CHAR + 1, MAX_CHAR, - make_number (4)); + make_fixnum (4)); DEFVAR_LISP ("printable-chars", Vprintable_chars, doc: /* A char-table for each printable character. */); Vprintable_chars = Fmake_char_table (Qnil, Qnil); Fset_char_table_range (Vprintable_chars, - Fcons (make_number (32), make_number (126)), Qt); + Fcons (make_fixnum (32), make_fixnum (126)), Qt); Fset_char_table_range (Vprintable_chars, - Fcons (make_number (160), - make_number (MAX_5_BYTE_CHAR)), Qt); + Fcons (make_fixnum (160), + make_fixnum (MAX_5_BYTE_CHAR)), Qt); DEFVAR_LISP ("char-script-table", Vchar_script_table, doc: /* Char table of script symbols. It has one extra slot whose value is a list of script symbols. */); DEFSYM (Qchar_script_table, "char-script-table"); - Fput (Qchar_script_table, Qchar_table_extra_slots, make_number (1)); + Fput (Qchar_script_table, Qchar_table_extra_slots, make_fixnum (1)); Vchar_script_table = Fmake_char_table (Qchar_script_table, Qnil); DEFVAR_LISP ("script-representative-chars", Vscript_representative_chars, diff --git a/src/character.h b/src/character.h index 66dfa5526e..78b84870f5 100644 --- a/src/character.h +++ b/src/character.h @@ -123,7 +123,7 @@ enum #define MAX_MULTIBYTE_LENGTH 5 /* Nonzero iff X is a character. */ -#define CHARACTERP(x) (NATNUMP (x) && XFASTINT (x) <= MAX_CHAR) +#define CHARACTERP(x) (FIXNATP (x) && XFASTINT (x) <= MAX_CHAR) /* Nonzero iff C is valid as a character code. */ #define CHAR_VALID_P(c) UNSIGNED_CMP (c, <=, MAX_CHAR) diff --git a/src/charset.c b/src/charset.c index 05290e86b4..8d957abeb5 100644 --- a/src/charset.c +++ b/src/charset.c @@ -261,7 +261,7 @@ load_charset_map (struct charset *charset, struct charset_map_entries *entries, { int n = CODE_POINT_TO_INDEX (charset, max_code) + 1; - vec = Fmake_vector (make_number (n), make_number (-1)); + vec = Fmake_vector (make_fixnum (n), make_fixnum (-1)); set_charset_attr (charset, charset_decoder, vec); } else @@ -340,12 +340,12 @@ load_charset_map (struct charset *charset, struct charset_map_entries *entries, { if (charset->method == CHARSET_METHOD_MAP) for (; from_index < lim_index; from_index++, from_c++) - ASET (vec, from_index, make_number (from_c)); + ASET (vec, from_index, make_fixnum (from_c)); else for (; from_index < lim_index; from_index++, from_c++) CHAR_TABLE_SET (Vchar_unify_table, CHARSET_CODE_OFFSET (charset) + from_index, - make_number (from_c)); + make_fixnum (from_c)); } else if (control_flag == 2) { @@ -357,13 +357,13 @@ load_charset_map (struct charset *charset, struct charset_map_entries *entries, code = INDEX_TO_CODE_POINT (charset, code); if (NILP (CHAR_TABLE_REF (table, from_c))) - CHAR_TABLE_SET (table, from_c, make_number (code)); + CHAR_TABLE_SET (table, from_c, make_fixnum (code)); } else for (; from_index < lim_index; from_index++, from_c++) { if (NILP (CHAR_TABLE_REF (table, from_c))) - CHAR_TABLE_SET (table, from_c, make_number (from_index)); + CHAR_TABLE_SET (table, from_c, make_fixnum (from_index)); } } else if (control_flag == 3) @@ -593,7 +593,7 @@ load_charset_map_from_vector (struct charset *charset, Lisp_Object vec, int cont else from = to = XFASTINT (val); val = AREF (vec, i + 1); - CHECK_NATNUM (val); + CHECK_FIXNAT (val); c = XFASTINT (val); if (from < min_code || to > max_code || from > to || c > MAX_CHAR) @@ -675,11 +675,11 @@ map_charset_for_dump (void (*c_function) (Lisp_Object, Lisp_Object), if (idx >= from_idx && idx <= to_idx) { if (NILP (XCAR (range))) - XSETCAR (range, make_number (c)); + XSETCAR (range, make_fixnum (c)); } else if (! NILP (XCAR (range))) { - XSETCDR (range, make_number (c - 1)); + XSETCDR (range, make_fixnum (c - 1)); if (c_function) (*c_function) (arg, range); else @@ -692,7 +692,7 @@ map_charset_for_dump (void (*c_function) (Lisp_Object, Lisp_Object), { if (! NILP (XCAR (range))) { - XSETCDR (range, make_number (c)); + XSETCDR (range, make_fixnum (c)); if (c_function) (*c_function) (arg, range); else @@ -734,7 +734,7 @@ map_charset_chars (void (*c_function)(Lisp_Object, Lisp_Object), Lisp_Object fun map_charset_for_dump (c_function, function, arg, from, to); } - range = Fcons (make_number (from_c), make_number (to_c)); + range = Fcons (make_fixnum (from_c), make_fixnum (to_c)); if (NILP (function)) (*c_function) (arg, range); else @@ -854,9 +854,9 @@ usage: (define-charset-internal ...) */) if (nargs != charset_arg_max) Fsignal (Qwrong_number_of_arguments, Fcons (intern ("define-charset-internal"), - make_number (nargs))); + make_fixnum (nargs))); - attrs = Fmake_vector (make_number (charset_attr_max), Qnil); + attrs = Fmake_vector (make_fixnum (charset_attr_max), Qnil); CHECK_SYMBOL (args[charset_arg_name]); ASET (attrs, charset_name, args[charset_arg_name]); @@ -867,8 +867,8 @@ usage: (define-charset-internal ...) */) Lisp_Object min_byte_obj, max_byte_obj; int min_byte, max_byte; - min_byte_obj = Faref (val, make_number (i * 2)); - max_byte_obj = Faref (val, make_number (i * 2 + 1)); + min_byte_obj = Faref (val, make_fixnum (i * 2)); + max_byte_obj = Faref (val, make_fixnum (i * 2 + 1)); CHECK_RANGED_INTEGER (min_byte_obj, 0, 255); min_byte = XINT (min_byte_obj); CHECK_RANGED_INTEGER (max_byte_obj, min_byte, 255); @@ -970,7 +970,7 @@ usage: (define-charset-internal ...) */) charset.iso_final = -1; else { - CHECK_NUMBER (val); + CHECK_FIXNUM (val); if (XINT (val) < '0' || XINT (val) > 127) error ("Invalid iso-final-char: %"pI"d", XINT (val)); charset.iso_final = XINT (val); @@ -990,7 +990,7 @@ usage: (define-charset-internal ...) */) charset.emacs_mule_id = -1; else { - CHECK_NATNUM (val); + CHECK_FIXNAT (val); if ((XINT (val) > 0 && XINT (val) <= 128) || XINT (val) >= 256) error ("Invalid emacs-mule-id: %"pI"d", XINT (val)); charset.emacs_mule_id = XINT (val); @@ -1043,14 +1043,14 @@ usage: (define-charset-internal ...) */) val = args[charset_arg_subset]; parent = Fcar (val); CHECK_CHARSET_GET_CHARSET (parent, parent_charset); - parent_min_code = Fnth (make_number (1), val); - CHECK_NATNUM (parent_min_code); - parent_max_code = Fnth (make_number (2), val); - CHECK_NATNUM (parent_max_code); - parent_code_offset = Fnth (make_number (3), val); - CHECK_NUMBER (parent_code_offset); + parent_min_code = Fnth (make_fixnum (1), val); + CHECK_FIXNAT (parent_min_code); + parent_max_code = Fnth (make_fixnum (2), val); + CHECK_FIXNAT (parent_max_code); + parent_code_offset = Fnth (make_fixnum (3), val); + CHECK_FIXNUM (parent_code_offset); val = make_uninit_vector (4); - ASET (val, 0, make_number (parent_charset->id)); + ASET (val, 0, make_fixnum (parent_charset->id)); ASET (val, 1, parent_min_code); ASET (val, 2, parent_max_code); ASET (val, 3, parent_code_offset); @@ -1096,7 +1096,7 @@ usage: (define-charset-internal ...) */) CHECK_CHARSET_GET_ID (elt, this_id); offset = 0; } - XSETCAR (val, Fcons (make_number (this_id), make_number (offset))); + XSETCAR (val, Fcons (make_fixnum (this_id), make_fixnum (offset))); this_charset = CHARSET_FROM_ID (this_id); if (charset.min_char > this_charset->min_char) @@ -1158,7 +1158,7 @@ usage: (define-charset-internal ...) */) new_definition_p = 1; } - ASET (attrs, charset_id, make_number (id)); + ASET (attrs, charset_id, make_fixnum (id)); charset.id = id; charset_table[id] = charset; @@ -1174,7 +1174,7 @@ usage: (define-charset-internal ...) */) charset.iso_final) = id; if (new_definition_p) Viso_2022_charset_list = nconc2 (Viso_2022_charset_list, - list1 (make_number (id))); + list1 (make_fixnum (id))); if (ISO_CHARSET_TABLE (1, 0, 'J') == id) charset_jisx0201_roman = id; else if (ISO_CHARSET_TABLE (2, 0, '@') == id) @@ -1194,7 +1194,7 @@ usage: (define-charset-internal ...) */) emacs_mule_bytes[charset.emacs_mule_id] = charset.dimension + 2; if (new_definition_p) Vemacs_mule_charset_list = nconc2 (Vemacs_mule_charset_list, - list1 (make_number (id))); + list1 (make_fixnum (id))); } if (new_definition_p) @@ -1202,7 +1202,7 @@ usage: (define-charset-internal ...) */) Vcharset_list = Fcons (args[charset_arg_name], Vcharset_list); if (charset.supplementary_p) Vcharset_ordered_list = nconc2 (Vcharset_ordered_list, - list1 (make_number (id))); + list1 (make_fixnum (id))); else { Lisp_Object tail; @@ -1215,16 +1215,16 @@ usage: (define-charset-internal ...) */) break; } if (EQ (tail, Vcharset_ordered_list)) - Vcharset_ordered_list = Fcons (make_number (id), + Vcharset_ordered_list = Fcons (make_fixnum (id), Vcharset_ordered_list); else if (NILP (tail)) Vcharset_ordered_list = nconc2 (Vcharset_ordered_list, - list1 (make_number (id))); + list1 (make_fixnum (id))); else { val = Fcons (XCAR (tail), XCDR (tail)); XSETCDR (tail, val); - XSETCAR (tail, make_number (id)); + XSETCAR (tail, make_fixnum (id)); } } charset_ordered_list_tick++; @@ -1254,22 +1254,22 @@ define_charset_internal (Lisp_Object name, int i; args[charset_arg_name] = name; - args[charset_arg_dimension] = make_number (dimension); + args[charset_arg_dimension] = make_fixnum (dimension); val = make_uninit_vector (8); for (i = 0; i < 8; i++) - ASET (val, i, make_number (code_space[i])); + ASET (val, i, make_fixnum (code_space[i])); args[charset_arg_code_space] = val; - args[charset_arg_min_code] = make_number (min_code); - args[charset_arg_max_code] = make_number (max_code); + args[charset_arg_min_code] = make_fixnum (min_code); + args[charset_arg_max_code] = make_fixnum (max_code); args[charset_arg_iso_final] - = (iso_final < 0 ? Qnil : make_number (iso_final)); - args[charset_arg_iso_revision] = make_number (iso_revision); + = (iso_final < 0 ? Qnil : make_fixnum (iso_final)); + args[charset_arg_iso_revision] = make_fixnum (iso_revision); args[charset_arg_emacs_mule_id] - = (emacs_mule_id < 0 ? Qnil : make_number (emacs_mule_id)); + = (emacs_mule_id < 0 ? Qnil : make_fixnum (emacs_mule_id)); args[charset_arg_ascii_compatible_p] = ascii_compatible ? Qt : Qnil; args[charset_arg_supplementary_p] = supplementary ? Qt : Qnil; args[charset_arg_invalid_code] = Qnil; - args[charset_arg_code_offset] = make_number (code_offset); + args[charset_arg_code_offset] = make_fixnum (code_offset); args[charset_arg_map] = Qnil; args[charset_arg_subset] = Qnil; args[charset_arg_superset] = Qnil; @@ -1396,8 +1396,8 @@ static bool check_iso_charset_parameter (Lisp_Object dimension, Lisp_Object chars, Lisp_Object final_char) { - CHECK_NUMBER (dimension); - CHECK_NUMBER (chars); + CHECK_FIXNUM (dimension); + CHECK_FIXNUM (chars); CHECK_CHARACTER (final_char); if (! (1 <= XINT (dimension) && XINT (dimension) <= 3)) @@ -1428,10 +1428,10 @@ return nil. */) (Lisp_Object dimension, Lisp_Object chars) { bool chars_flag = check_iso_charset_parameter (dimension, chars, - make_number ('0')); + make_fixnum ('0')); for (int final_char = '0'; final_char <= '?'; final_char++) if (ISO_CHARSET_TABLE (XINT (dimension), chars_flag, final_char) < 0) - return make_number (final_char); + return make_fixnum (final_char); return Qnil; } @@ -1563,7 +1563,7 @@ only `ascii', `eight-bit-control', and `eight-bit-graphic'. */) from_byte = CHAR_TO_BYTE (from); - charsets = Fmake_vector (make_number (charset_table_used), Qnil); + charsets = Fmake_vector (make_fixnum (charset_table_used), Qnil); while (1) { find_charsets_in_text (BYTE_POS_ADDR (from_byte), stop - from, @@ -1600,7 +1600,7 @@ only `ascii', `eight-bit-control', and `eight-bit-graphic'. */) CHECK_STRING (str); - charsets = Fmake_vector (make_number (charset_table_used), Qnil); + charsets = Fmake_vector (make_fixnum (charset_table_used), Qnil); find_charsets_in_text (SDATA (str), SCHARS (str), SBYTES (str), charsets, table, STRING_MULTIBYTE (str)); @@ -1621,7 +1621,7 @@ maybe_unify_char (int c, Lisp_Object val) { struct charset *charset; - if (INTEGERP (val)) + if (FIXNUMP (val)) return XFASTINT (val); if (NILP (val)) return c; @@ -1762,7 +1762,7 @@ encode_char (struct charset *charset, int c) { Lisp_Object deunified = CHAR_TABLE_REF (deunifier, c); - if (INTEGERP (deunified)) + if (FIXNUMP (deunified)) code_index = XINT (deunified); } else @@ -1863,7 +1863,7 @@ CODE-POINT may be a cons (HIGHER-16-BIT-VALUE . LOWER-16-BIT-VALUE). */) code = cons_to_unsigned (code_point, UINT_MAX); charsetp = CHARSET_FROM_ID (id); c = DECODE_CHAR (charsetp, code); - return (c >= 0 ? make_number (c) : Qnil); + return (c >= 0 ? make_fixnum (c) : Qnil); } @@ -1910,9 +1910,9 @@ is specified. */) ? 0 : CHARSET_MIN_CODE (charsetp)); else { - CHECK_NATNUM (code1); + CHECK_FIXNAT (code1); if (XFASTINT (code1) >= 0x100) - args_out_of_range (make_number (0xFF), code1); + args_out_of_range (make_fixnum (0xFF), code1); code = XFASTINT (code1); if (dimension > 1) @@ -1922,9 +1922,9 @@ is specified. */) code |= charsetp->code_space[(dimension - 2) * 4]; else { - CHECK_NATNUM (code2); + CHECK_FIXNAT (code2); if (XFASTINT (code2) >= 0x100) - args_out_of_range (make_number (0xFF), code2); + args_out_of_range (make_fixnum (0xFF), code2); code |= XFASTINT (code2); } @@ -1935,9 +1935,9 @@ is specified. */) code |= charsetp->code_space[(dimension - 3) * 4]; else { - CHECK_NATNUM (code3); + CHECK_FIXNAT (code3); if (XFASTINT (code3) >= 0x100) - args_out_of_range (make_number (0xFF), code3); + args_out_of_range (make_fixnum (0xFF), code3); code |= XFASTINT (code3); } @@ -1948,9 +1948,9 @@ is specified. */) code |= charsetp->code_space[0]; else { - CHECK_NATNUM (code4); + CHECK_FIXNAT (code4); if (XFASTINT (code4) >= 0x100) - args_out_of_range (make_number (0xFF), code4); + args_out_of_range (make_fixnum (0xFF), code4); code |= XFASTINT (code4); } } @@ -1963,7 +1963,7 @@ is specified. */) c = DECODE_CHAR (charsetp, code); if (c < 0) error ("Invalid code(s)"); - return make_number (c); + return make_fixnum (c); } @@ -2028,7 +2028,7 @@ CH in the charset. */) dimension = CHARSET_DIMENSION (charset); for (val = Qnil; dimension > 0; dimension--) { - val = Fcons (make_number (code & 0xFF), val); + val = Fcons (make_fixnum (code & 0xFF), val); code >>= 8; } return Fcons (CHARSET_NAME (charset), val); @@ -2085,7 +2085,7 @@ If POS is out of range, the value is nil. */) struct charset *charset; ch = Fchar_after (pos); - if (! INTEGERP (ch)) + if (! FIXNUMP (ch)) return ch; charset = CHAR_CHARSET (XINT (ch)); return (CHARSET_NAME (charset)); @@ -2165,10 +2165,10 @@ usage: (set-charset-priority &rest charsets) */) for (i = 0; i < nargs; i++) { CHECK_CHARSET_GET_ID (args[i], id); - if (! NILP (Fmemq (make_number (id), old_list))) + if (! NILP (Fmemq (make_fixnum (id), old_list))) { - old_list = Fdelq (make_number (id), old_list); - new_head = Fcons (make_number (id), new_head); + old_list = Fdelq (make_fixnum (id), old_list); + new_head = Fcons (make_fixnum (id), new_head); } } Vcharset_non_preferred_head = old_list; @@ -2211,7 +2211,7 @@ Return charset identification number of CHARSET. */) int id; CHECK_CHARSET_GET_ID (charset, id); - return make_number (id); + return make_fixnum (id); } struct charset_sort_data diff --git a/src/chartab.c b/src/chartab.c index 065ae4f9f2..f09e9738a5 100644 --- a/src/chartab.c +++ b/src/chartab.c @@ -118,14 +118,14 @@ the char-table has no extra slot. */) n_extras = 0; else { - CHECK_NATNUM (n); + CHECK_FIXNAT (n); if (XINT (n) > 10) args_out_of_range (n, Qnil); n_extras = XINT (n); } size = CHAR_TABLE_STANDARD_SLOTS + n_extras; - vector = Fmake_vector (make_number (size), init); + vector = Fmake_vector (make_fixnum (size), init); XSETPVECTYPE (XVECTOR (vector), PVEC_CHAR_TABLE); set_char_table_parent (vector, Qnil); set_char_table_purpose (vector, purpose); @@ -188,7 +188,7 @@ copy_char_table (Lisp_Object table) int size = PVSIZE (table); int i; - copy = Fmake_vector (make_number (size), Qnil); + copy = Fmake_vector (make_fixnum (size), Qnil); XSETPVECTYPE (XVECTOR (copy), PVEC_CHAR_TABLE); set_char_table_defalt (copy, XCHAR_TABLE (table)->defalt); set_char_table_parent (copy, XCHAR_TABLE (table)->parent); @@ -571,7 +571,7 @@ DEFUN ("char-table-extra-slot", Fchar_table_extra_slot, Schar_table_extra_slot, (Lisp_Object char_table, Lisp_Object n) { CHECK_CHAR_TABLE (char_table); - CHECK_NUMBER (n); + CHECK_FIXNUM (n); if (XINT (n) < 0 || XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table))) args_out_of_range (char_table, n); @@ -586,7 +586,7 @@ DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot, (Lisp_Object char_table, Lisp_Object n, Lisp_Object value) { CHECK_CHAR_TABLE (char_table); - CHECK_NUMBER (n); + CHECK_FIXNUM (n); if (XINT (n) < 0 || XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table))) args_out_of_range (char_table, n); @@ -783,7 +783,7 @@ map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object), if (SUB_CHAR_TABLE_P (this)) { if (to >= nextc) - XSETCDR (range, make_number (nextc - 1)); + XSETCDR (range, make_fixnum (nextc - 1)); val = map_sub_char_table (c_function, function, this, arg, val, range, top); } @@ -807,7 +807,7 @@ map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object), set_char_table_parent (parent, Qnil); val = CHAR_TABLE_REF (parent, from); set_char_table_parent (parent, temp); - XSETCDR (range, make_number (c - 1)); + XSETCDR (range, make_fixnum (c - 1)); val = map_sub_char_table (c_function, function, parent, arg, val, range, parent); @@ -817,7 +817,7 @@ map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object), } if (! NILP (val) && different_value) { - XSETCDR (range, make_number (c - 1)); + XSETCDR (range, make_fixnum (c - 1)); if (EQ (XCAR (range), XCDR (range))) { if (c_function) @@ -843,10 +843,10 @@ map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object), } val = this; from = c; - XSETCAR (range, make_number (c)); + XSETCAR (range, make_fixnum (c)); } } - XSETCDR (range, make_number (to)); + XSETCDR (range, make_fixnum (to)); } return val; } @@ -864,7 +864,7 @@ map_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object), Lisp_Object range, val, parent; uniprop_decoder_t decoder = UNIPROP_GET_DECODER (table); - range = Fcons (make_number (0), make_number (MAX_CHAR)); + range = Fcons (make_fixnum (0), make_fixnum (MAX_CHAR)); parent = XCHAR_TABLE (table)->parent; val = XCHAR_TABLE (table)->ascii; @@ -957,7 +957,7 @@ map_sub_char_table_for_charset (void (*c_function) (Lisp_Object, Lisp_Object), { if (! NILP (XCAR (range))) { - XSETCDR (range, make_number (c - 1)); + XSETCDR (range, make_fixnum (c - 1)); if (c_function) (*c_function) (arg, range); else @@ -980,7 +980,7 @@ map_sub_char_table_for_charset (void (*c_function) (Lisp_Object, Lisp_Object), { if (! NILP (XCAR (range))) { - XSETCDR (range, make_number (c - 1)); + XSETCDR (range, make_fixnum (c - 1)); if (c_function) (*c_function) (arg, range); else @@ -991,7 +991,7 @@ map_sub_char_table_for_charset (void (*c_function) (Lisp_Object, Lisp_Object), else { if (NILP (XCAR (range))) - XSETCAR (range, make_number (c)); + XSETCAR (range, make_fixnum (c)); } } } @@ -1041,7 +1041,7 @@ map_char_table_for_charset (void (*c_function) (Lisp_Object, Lisp_Object), { if (! NILP (XCAR (range))) { - XSETCDR (range, make_number (c - 1)); + XSETCDR (range, make_fixnum (c - 1)); if (c_function) (*c_function) (arg, range); else @@ -1052,7 +1052,7 @@ map_char_table_for_charset (void (*c_function) (Lisp_Object, Lisp_Object), } if (! NILP (XCAR (range))) { - XSETCDR (range, make_number (c - 1)); + XSETCDR (range, make_fixnum (c - 1)); if (c_function) (*c_function) (arg, range); else @@ -1125,7 +1125,7 @@ uniprop_table_uncompress (Lisp_Object table, int idx) { int v = STRING_CHAR_ADVANCE (p); set_sub_char_table_contents - (sub, idx++, v > 0 ? make_number (v) : Qnil); + (sub, idx++, v > 0 ? make_fixnum (v) : Qnil); } } else if (*p == 2) @@ -1150,7 +1150,7 @@ uniprop_table_uncompress (Lisp_Object table, int idx) } } while (count-- > 0) - set_sub_char_table_contents (sub, idx++, make_number (v)); + set_sub_char_table_contents (sub, idx++, make_fixnum (v)); } } /* It seems that we don't need this function because C code won't need @@ -1192,7 +1192,7 @@ uniprop_get_decoder (Lisp_Object table) { EMACS_INT i; - if (! INTEGERP (XCHAR_TABLE (table)->extras[1])) + if (! FIXNUMP (XCHAR_TABLE (table)->extras[1])) return NULL; i = XINT (XCHAR_TABLE (table)->extras[1]); if (i < 0 || i >= uniprop_decoder_count) @@ -1227,7 +1227,7 @@ uniprop_encode_value_run_length (Lisp_Object table, Lisp_Object value) break; if (i == size) wrong_type_argument (build_string ("Unicode property value"), value); - return make_number (i); + return make_fixnum (i); } @@ -1240,17 +1240,17 @@ uniprop_encode_value_numeric (Lisp_Object table, Lisp_Object value) Lisp_Object *value_table = XVECTOR (XCHAR_TABLE (table)->extras[4])->contents; int i, size = ASIZE (XCHAR_TABLE (table)->extras[4]); - CHECK_NUMBER (value); + CHECK_FIXNUM (value); for (i = 0; i < size; i++) if (EQ (value, value_table[i])) break; - value = make_number (i); + value = make_fixnum (i); if (i == size) set_char_table_extras (table, 4, CALLN (Fvconcat, XCHAR_TABLE (table)->extras[4], - Fmake_vector (make_number (1), value))); - return make_number (i); + Fmake_vector (make_fixnum (1), value))); + return make_fixnum (i); } static uniprop_encoder_t uniprop_encoder[] = @@ -1267,7 +1267,7 @@ uniprop_get_encoder (Lisp_Object table) { EMACS_INT i; - if (! INTEGERP (XCHAR_TABLE (table)->extras[2])) + if (! FIXNUMP (XCHAR_TABLE (table)->extras[2])) return NULL; i = XINT (XCHAR_TABLE (table)->extras[2]); if (i < 0 || i >= uniprop_encoder_count) @@ -1300,7 +1300,7 @@ uniprop_table (Lisp_Object prop) || ! UNIPROP_TABLE_P (table)) return Qnil; val = XCHAR_TABLE (table)->extras[1]; - if (INTEGERP (val) + if (FIXNUMP (val) ? (XINT (val) < 0 || XINT (val) >= uniprop_decoder_count) : ! NILP (val)) return Qnil; diff --git a/src/cmds.c b/src/cmds.c index 96b712ed6d..857197cf9b 100644 --- a/src/cmds.c +++ b/src/cmds.c @@ -35,9 +35,9 @@ DEFUN ("forward-point", Fforward_point, Sforward_point, 1, 1, 0, doc: /* Return buffer position N characters after (before if N negative) point. */) (Lisp_Object n) { - CHECK_NUMBER (n); + CHECK_FIXNUM (n); - return make_number (PT + XINT (n)); + return make_fixnum (PT + XINT (n)); } /* Add N to point; or subtract N if FORWARD is false. N defaults to 1. @@ -56,7 +56,7 @@ move_point (Lisp_Object n, bool forward) if (NILP (n)) XSETFASTINT (n, 1); else - CHECK_NUMBER (n); + CHECK_FIXNUM (n); new_point = PT + (forward ? XINT (n) : - XINT (n)); @@ -127,7 +127,7 @@ go to its beginning. */) count = 1; else { - CHECK_NUMBER (n); + CHECK_FIXNUM (n); count = XINT (n); } @@ -142,7 +142,7 @@ go to its beginning. */) && (FETCH_BYTE (PT_BYTE - 1) != '\n')))) shortage--; - return make_number (count <= 0 ? - shortage : shortage); + return make_fixnum (count <= 0 ? - shortage : shortage); } DEFUN ("beginning-of-line", Fbeginning_of_line, Sbeginning_of_line, 0, 1, "^p", @@ -162,7 +162,7 @@ instead. For instance, `(forward-line 0)' does the same thing as if (NILP (n)) XSETFASTINT (n, 1); else - CHECK_NUMBER (n); + CHECK_FIXNUM (n); SET_PT (XINT (Fline_beginning_position (n))); @@ -187,7 +187,7 @@ to t. */) if (NILP (n)) XSETFASTINT (n, 1); else - CHECK_NUMBER (n); + CHECK_FIXNUM (n); while (1) { @@ -210,7 +210,7 @@ to t. */) /* If we skipped something intangible and now we're not really at eol, keep going. */ - n = make_number (1); + n = make_fixnum (1); else break; } @@ -230,7 +230,7 @@ because it respects values of `delete-active-region' and `overwrite-mode'. */) { EMACS_INT pos; - CHECK_NUMBER (n); + CHECK_FIXNUM (n); if (eabs (XINT (n)) < 2) call0 (Qundo_auto_amalgamate); @@ -274,7 +274,7 @@ a non-nil value for the inserted character. At the end, it runs `post-self-insert-hook'. */) (Lisp_Object n) { - CHECK_NUMBER (n); + CHECK_FIXNUM (n); if (XINT (n) < 0) error ("Negative repetition argument %"pI"d", XINT (n)); @@ -360,7 +360,7 @@ internal_self_insert (int c, EMACS_INT n) if (EQ (overwrite, Qoverwrite_mode_binary)) chars_to_delete = min (n, PTRDIFF_MAX); else if (c != '\n' && c2 != '\n' - && (cwidth = XFASTINT (Fchar_width (make_number (c)))) != 0) + && (cwidth = XFASTINT (Fchar_width (make_fixnum (c)))) != 0) { ptrdiff_t pos = PT; ptrdiff_t pos_byte = PT_BYTE; @@ -378,7 +378,7 @@ internal_self_insert (int c, EMACS_INT n) character. In that case, the new point is set after that character. */ ptrdiff_t actual_clm - = XFASTINT (Fmove_to_column (make_number (target_clm), Qnil)); + = XFASTINT (Fmove_to_column (make_fixnum (target_clm), Qnil)); chars_to_delete = PT - pos; @@ -439,18 +439,18 @@ internal_self_insert (int c, EMACS_INT n) int mc = ((NILP (BVAR (current_buffer, enable_multibyte_characters)) && SINGLE_BYTE_CHAR_P (c)) ? UNIBYTE_TO_CHAR (c) : c); - Lisp_Object string = Fmake_string (make_number (n), make_number (mc), + Lisp_Object string = Fmake_string (make_fixnum (n), make_fixnum (mc), Qnil); if (spaces_to_insert) { - tem = Fmake_string (make_number (spaces_to_insert), - make_number (' '), Qnil); + tem = Fmake_string (make_fixnum (spaces_to_insert), + make_fixnum (' '), Qnil); string = concat2 (string, tem); } replace_range (PT, PT + chars_to_delete, string, 1, 1, 1, 0); - Fforward_char (make_number (n)); + Fforward_char (make_fixnum (n)); } else if (n > 1) { diff --git a/src/coding.c b/src/coding.c index 8ce902b06d..a4bb45f350 100644 --- a/src/coding.c +++ b/src/coding.c @@ -620,18 +620,18 @@ inhibit_flag (int encoded_flag, bool var) } while (0) static void -CHECK_NATNUM_CAR (Lisp_Object x) +CHECK_FIXNAT_CAR (Lisp_Object x) { Lisp_Object tmp = XCAR (x); - CHECK_NATNUM (tmp); + CHECK_FIXNAT (tmp); XSETCAR (x, tmp); } static void -CHECK_NATNUM_CDR (Lisp_Object x) +CHECK_FIXNAT_CDR (Lisp_Object x) { Lisp_Object tmp = XCDR (x); - CHECK_NATNUM (tmp); + CHECK_FIXNAT (tmp); XSETCDR (x, tmp); } @@ -2622,7 +2622,7 @@ encode_coding_emacs_mule (struct coding_system *coding) case CODING_ANNOTATE_CHARSET_MASK: preferred_charset_id = charbuf[3]; if (preferred_charset_id >= 0 - && NILP (Fmemq (make_number (preferred_charset_id), + && NILP (Fmemq (make_fixnum (preferred_charset_id), charset_list))) preferred_charset_id = -1; break; @@ -4459,7 +4459,7 @@ encode_coding_iso_2022 (struct coding_system *coding) case CODING_ANNOTATE_CHARSET_MASK: preferred_charset_id = charbuf[2]; if (preferred_charset_id >= 0 - && NILP (Fmemq (make_number (preferred_charset_id), + && NILP (Fmemq (make_fixnum (preferred_charset_id), charset_list))) preferred_charset_id = -1; break; @@ -5440,7 +5440,7 @@ detect_coding_charset (struct coding_system *coding, break; found = CATEGORY_MASK_CHARSET; } - if (INTEGERP (val)) + if (FIXNUMP (val)) { charset = CHARSET_FROM_ID (XFASTINT (val)); dim = CHARSET_DIMENSION (charset); @@ -5551,9 +5551,9 @@ decode_coding_charset (struct coding_system *coding) code = c; val = AREF (valids, c); - if (! INTEGERP (val) && ! CONSP (val)) + if (! FIXNUMP (val) && ! CONSP (val)) goto invalid_code; - if (INTEGERP (val)) + if (FIXNUMP (val)) { charset = CHARSET_FROM_ID (XFASTINT (val)); dim = CHARSET_DIMENSION (charset); @@ -6924,7 +6924,7 @@ get_translation_table (Lisp_Object attrs, bool encodep, int *max_lookup) && CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (translation_table)) > 1) { val = XCHAR_TABLE (translation_table)->extras[1]; - if (NATNUMP (val) && *max_lookup < XFASTINT (val)) + if (FIXNATP (val) && *max_lookup < XFASTINT (val)) *max_lookup = min (XFASTINT (val), MAX_LOOKUP_MAX); } else if (CONSP (translation_table)) @@ -6936,7 +6936,7 @@ get_translation_table (Lisp_Object attrs, bool encodep, int *max_lookup) && CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (XCAR (tail))) > 1) { Lisp_Object tailval = XCHAR_TABLE (XCAR (tail))->extras[1]; - if (NATNUMP (tailval) && *max_lookup < XFASTINT (tailval)) + if (FIXNATP (tailval) && *max_lookup < XFASTINT (tailval)) *max_lookup = min (XFASTINT (tailval), MAX_LOOKUP_MAX); } } @@ -6981,7 +6981,7 @@ get_translation_table (Lisp_Object attrs, bool encodep, int *max_lookup) static Lisp_Object get_translation (Lisp_Object trans, int *buf, int *buf_end, ptrdiff_t *nchars) { - if (INTEGERP (trans) || VECTORP (trans)) + if (FIXNUMP (trans) || VECTORP (trans)) { *nchars = 1; return trans; @@ -7048,7 +7048,7 @@ produce_chars (struct coding_system *coding, Lisp_Object translation_table, if (! NILP (trans)) { trans = get_translation (trans, buf, buf_end, &from_nchars); - if (INTEGERP (trans)) + if (FIXNUMP (trans)) c = XINT (trans); else if (VECTORP (trans)) { @@ -7239,11 +7239,11 @@ produce_composition (struct coding_system *coding, int *charbuf, ptrdiff_t pos) for (i = j = 0; i < len && charbuf[i] != -1; i++, j++) { if (charbuf[i] >= 0) - args[j] = make_number (charbuf[i]); + args[j] = make_fixnum (charbuf[i]); else { i++; - args[j] = make_number (charbuf[i] % 0x100); + args[j] = make_fixnum (charbuf[i] % 0x100); } } components = (i == j ? Fstring (j, args) : Fvector (j, args)); @@ -7263,7 +7263,7 @@ produce_charset (struct coding_system *coding, int *charbuf, ptrdiff_t pos) ptrdiff_t from = pos - charbuf[2]; struct charset *charset = CHARSET_FROM_ID (charbuf[3]); - Fput_text_property (make_number (from), make_number (pos), + Fput_text_property (make_fixnum (from), make_fixnum (pos), Qcharset, CHARSET_NAME (charset), coding->dst_object); } @@ -7546,7 +7546,7 @@ handle_composition_annotation (ptrdiff_t pos, ptrdiff_t limit, buf++; } } - else if (INTEGERP (components)) + else if (FIXNUMP (components)) { len = 1; *buf++ = XINT (components); @@ -7591,15 +7591,15 @@ handle_charset_annotation (ptrdiff_t pos, ptrdiff_t limit, Lisp_Object val, next; int id; - val = Fget_text_property (make_number (pos), Qcharset, coding->src_object); + val = Fget_text_property (make_fixnum (pos), Qcharset, coding->src_object); if (! NILP (val) && CHARSETP (val)) id = XINT (CHARSET_SYMBOL_ID (val)); else id = -1; ADD_CHARSET_DATA (buf, 0, id); - next = Fnext_single_property_change (make_number (pos), Qcharset, + next = Fnext_single_property_change (make_fixnum (pos), Qcharset, coding->src_object, - make_number (limit)); + make_fixnum (limit)); *stop = XINT (next); return buf; } @@ -7709,7 +7709,7 @@ consume_chars (struct coding_system *coding, Lisp_Object translation_table, lookup_buf_end = lookup_buf + i; trans = get_translation (trans, lookup_buf, lookup_buf_end, &from_nchars); - if (INTEGERP (trans)) + if (FIXNUMP (trans)) c = XINT (trans); else if (VECTORP (trans)) { @@ -8011,8 +8011,8 @@ decode_coding_gap (struct coding_system *coding, bset_undo_list (current_buffer, Qt); TEMP_SET_PT_BOTH (coding->dst_pos, coding->dst_pos_byte); val = call1 (CODING_ATTR_POST_READ (attrs), - make_number (coding->produced_char)); - CHECK_NATNUM (val); + make_fixnum (coding->produced_char)); + CHECK_FIXNAT (val); coding->produced_char += Z - prev_Z; coding->produced += Z_BYTE - prev_Z_BYTE; } @@ -8163,8 +8163,8 @@ decode_coding_object (struct coding_system *coding, bset_undo_list (current_buffer, Qt); TEMP_SET_PT_BOTH (coding->dst_pos, coding->dst_pos_byte); val = safe_call1 (CODING_ATTR_POST_READ (attrs), - make_number (coding->produced_char)); - CHECK_NATNUM (val); + make_fixnum (coding->produced_char)); + CHECK_FIXNAT (val); coding->produced_char += Z - prev_Z; coding->produced += Z_BYTE - prev_Z_BYTE; unbind_to (count1, Qnil); @@ -8293,7 +8293,7 @@ encode_coding_object (struct coding_system *coding, } safe_call2 (CODING_ATTR_PRE_WRITE (attrs), - make_number (BEG), make_number (Z)); + make_fixnum (BEG), make_fixnum (Z)); if (XBUFFER (coding->src_object) != current_buffer) kill_src_buffer = 1; coding->src_object = Fcurrent_buffer (); @@ -8459,7 +8459,7 @@ from_unicode (Lisp_Object str) if (!STRING_MULTIBYTE (str) && SBYTES (str) & 1) { - str = Fsubstring (str, make_number (0), make_number (-1)); + str = Fsubstring (str, make_fixnum (0), make_fixnum (-1)); } return code_convert_string_norecord (str, Qutf_16le, 0); @@ -8741,20 +8741,20 @@ detect_coding_system (const unsigned char *src, { detect_info.found = CATEGORY_MASK_RAW_TEXT; id = CODING_SYSTEM_ID (Qno_conversion); - val = list1 (make_number (id)); + val = list1 (make_fixnum (id)); } else if (! detect_info.rejected && ! detect_info.found) { detect_info.found = CATEGORY_MASK_ANY; id = coding_categories[coding_category_undecided].id; - val = list1 (make_number (id)); + val = list1 (make_fixnum (id)); } else if (highest) { if (detect_info.found) { detect_info.found = 1 << category; - val = list1 (make_number (this->id)); + val = list1 (make_fixnum (this->id)); } else for (i = 0; i < coding_category_raw_text; i++) @@ -8762,7 +8762,7 @@ detect_coding_system (const unsigned char *src, { detect_info.found = 1 << coding_priorities[i]; id = coding_categories[coding_priorities[i]].id; - val = list1 (make_number (id)); + val = list1 (make_fixnum (id)); break; } } @@ -8779,7 +8779,7 @@ detect_coding_system (const unsigned char *src, found |= 1 << category; id = coding_categories[category].id; if (id >= 0) - val = list1 (make_number (id)); + val = list1 (make_fixnum (id)); } } for (i = coding_category_raw_text - 1; i >= 0; i--) @@ -8788,7 +8788,7 @@ detect_coding_system (const unsigned char *src, if (detect_info.found & (1 << category)) { id = coding_categories[category].id; - val = Fcons (make_number (id), val); + val = Fcons (make_fixnum (id), val); } } detect_info.found |= found; @@ -8804,7 +8804,7 @@ detect_coding_system (const unsigned char *src, this = coding_categories + coding_category_utf_8_sig; else this = coding_categories + coding_category_utf_8_nosig; - val = list1 (make_number (this->id)); + val = list1 (make_fixnum (this->id)); } } else if (base_category == coding_category_utf_16_auto) @@ -8821,13 +8821,13 @@ detect_coding_system (const unsigned char *src, this = coding_categories + coding_category_utf_16_be_nosig; else this = coding_categories + coding_category_utf_16_le_nosig; - val = list1 (make_number (this->id)); + val = list1 (make_fixnum (this->id)); } } else { detect_info.found = 1 << XINT (CODING_ATTR_CATEGORY (attrs)); - val = list1 (make_number (coding.id)); + val = list1 (make_fixnum (coding.id)); } /* Then, detect eol-format if necessary. */ @@ -9011,8 +9011,8 @@ DEFUN ("find-coding-systems-region-internal", } else { - CHECK_NUMBER_COERCE_MARKER (start); - CHECK_NUMBER_COERCE_MARKER (end); + CHECK_FIXNUM_COERCE_MARKER (start); + CHECK_FIXNUM_COERCE_MARKER (end); if (XINT (start) < BEG || XINT (end) > Z || XINT (start) > XINT (end)) args_out_of_range (start, end); if (NILP (BVAR (current_buffer, enable_multibyte_characters))) @@ -9175,7 +9175,7 @@ to the string and treated as in `substring'. */) n = 1; else { - CHECK_NATNUM (count); + CHECK_FIXNAT (count); n = XINT (count); } @@ -9201,7 +9201,7 @@ to the string and treated as in `substring'. */) && ! char_charset (translate_char (translation_table, c), charset_list, NULL)) { - positions = Fcons (make_number (from), positions); + positions = Fcons (make_fixnum (from), positions); n--; if (n == 0) break; @@ -9265,8 +9265,8 @@ is nil. */) } else { - CHECK_NUMBER_COERCE_MARKER (start); - CHECK_NUMBER_COERCE_MARKER (end); + CHECK_FIXNUM_COERCE_MARKER (start); + CHECK_FIXNUM_COERCE_MARKER (end); if (XINT (start) < BEG || XINT (end) > Z || XINT (start) > XINT (end)) args_out_of_range (start, end); if (NILP (BVAR (current_buffer, enable_multibyte_characters))) @@ -9318,7 +9318,7 @@ is nil. */) { elt = XCDR (XCAR (tail)); if (! char_encodable_p (c, XCAR (elt))) - XSETCDR (elt, Fcons (make_number (pos), XCDR (elt))); + XSETCDR (elt, Fcons (make_fixnum (pos), XCDR (elt))); } if (charset_map_loaded) { @@ -9395,7 +9395,7 @@ code_convert_region (Lisp_Object start, Lisp_Object end, Vlast_coding_system_used = CODING_ID_NAME (coding.id); return (BUFFERP (dst_object) - ? make_number (coding.produced_char) + ? make_fixnum (coding.produced_char) : coding.dst_object); } @@ -9491,7 +9491,7 @@ code_convert_string (Lisp_Object string, Lisp_Object coding_system, Vlast_coding_system_used = CODING_ID_NAME (coding.id); return (BUFFERP (dst_object) - ? make_number (coding.produced_char) + ? make_fixnum (coding.produced_char) : coding.dst_object); } @@ -9610,7 +9610,7 @@ Return the corresponding character. */) EMACS_INT ch; int c; - CHECK_NATNUM (code); + CHECK_FIXNAT (code); ch = XFASTINT (code); CHECK_CODING_SYSTEM_GET_SPEC (Vsjis_coding_system, spec); attrs = AREF (spec, 0); @@ -9649,7 +9649,7 @@ Return the corresponding character. */) c = DECODE_CHAR (charset, c); if (c < 0) error ("Invalid code: %"pI"d", ch); - return make_number (c); + return make_fixnum (c); } @@ -9678,7 +9678,7 @@ Return the corresponding code in SJIS. */) error ("Can't encode by shift_jis encoding: %c", c); JIS_TO_SJIS (code); - return make_number (code); + return make_fixnum (code); } DEFUN ("decode-big5-char", Fdecode_big5_char, Sdecode_big5_char, 1, 1, 0, @@ -9691,7 +9691,7 @@ Return the corresponding character. */) EMACS_INT ch; int c; - CHECK_NATNUM (code); + CHECK_FIXNAT (code); ch = XFASTINT (code); CHECK_CODING_SYSTEM_GET_SPEC (Vbig5_coding_system, spec); attrs = AREF (spec, 0); @@ -9722,7 +9722,7 @@ Return the corresponding character. */) c = DECODE_CHAR (charset, c); if (c < 0) error ("Invalid code: %"pI"d", ch); - return make_number (c); + return make_fixnum (c); } DEFUN ("encode-big5-char", Fencode_big5_char, Sencode_big5_char, 1, 1, 0, @@ -9748,7 +9748,7 @@ Return the corresponding character code in Big5. */) if (code == CHARSET_INVALID_CODE (charset)) error ("Can't encode by Big5 encoding: %c", c); - return make_number (code); + return make_fixnum (code); } @@ -9770,7 +9770,7 @@ DEFUN ("set-terminal-coding-system-internal", Fset_terminal_coding_system_intern tset_charset_list (term, (terminal_coding->common_flags & CODING_REQUIRE_ENCODING_MASK ? coding_charset_list (terminal_coding) - : list1 (make_number (charset_ascii)))); + : list1 (make_fixnum (charset_ascii)))); return Qnil; } @@ -9883,7 +9883,7 @@ usage: (find-operation-coding-system OPERATION ARGUMENTS...) */) error ("Too few arguments"); operation = args[0]; if (!SYMBOLP (operation) - || (target_idx = Fget (operation, Qtarget_idx), !NATNUMP (target_idx))) + || (target_idx = Fget (operation, Qtarget_idx), !FIXNATP (target_idx))) error ("Invalid first argument"); if (nargs <= 1 + XFASTINT (target_idx)) error ("Too few arguments for operation `%s'", @@ -9893,7 +9893,7 @@ usage: (find-operation-coding-system OPERATION ARGUMENTS...) */) || (EQ (operation, Qinsert_file_contents) && CONSP (target) && STRINGP (XCAR (target)) && BUFFERP (XCDR (target))) || (EQ (operation, Qopen_network_stream) - && (INTEGERP (target) || EQ (target, Qt))))) + && (FIXNUMP (target) || EQ (target, Qt))))) error ("Invalid argument %"pI"d of operation `%s'", XFASTINT (target_idx) + 1, SDATA (SYMBOL_NAME (operation))); if (CONSP (target)) @@ -9917,7 +9917,7 @@ usage: (find-operation-coding-system OPERATION ARGUMENTS...) */) && ((STRINGP (target) && STRINGP (XCAR (elt)) && fast_string_match (XCAR (elt), target) >= 0) - || (INTEGERP (target) && EQ (target, XCAR (elt))))) + || (FIXNUMP (target) && EQ (target, XCAR (elt))))) { val = XCDR (elt); /* Here, if VAL is both a valid coding system and a valid @@ -10076,7 +10076,7 @@ usage: (define-coding-system-internal ...) */) if (nargs < coding_arg_max) goto short_args; - attrs = Fmake_vector (make_number (coding_attr_last_index), Qnil); + attrs = Fmake_vector (make_fixnum (coding_attr_last_index), Qnil); name = args[coding_arg_name]; CHECK_SYMBOL (name); @@ -10108,7 +10108,7 @@ usage: (define-coding-system-internal ...) */) } for (tail = charset_list; CONSP (tail); tail = XCDR (tail)) { - if (! RANGED_INTEGERP (0, XCAR (tail), INT_MAX - 1)) + if (! RANGED_FIXNUMP (0, XCAR (tail), INT_MAX - 1)) error ("Invalid charset-list"); if (max_charset_id < XFASTINT (XCAR (tail))) max_charset_id = XFASTINT (XCAR (tail)); @@ -10131,7 +10131,7 @@ usage: (define-coding-system-internal ...) */) error ("Can't handle charset `%s'", SDATA (SYMBOL_NAME (CHARSET_NAME (charset)))); - XSETCAR (tail, make_number (charset->id)); + XSETCAR (tail, make_fixnum (charset->id)); if (max_charset_id < charset->id) max_charset_id = charset->id; } @@ -10166,7 +10166,7 @@ usage: (define-coding-system-internal ...) */) val = args[coding_arg_default_char]; if (NILP (val)) - ASET (attrs, coding_attr_default_char, make_number (' ')); + ASET (attrs, coding_attr_default_char, make_fixnum (' ')); else { CHECK_CHARACTER (val); @@ -10194,7 +10194,7 @@ usage: (define-coding-system-internal ...) */) If Nth element is a list of charset IDs, N is the first byte of one of them. The list is sorted by dimensions of the charsets. A charset of smaller dimension comes first. */ - val = Fmake_vector (make_number (256), Qnil); + val = Fmake_vector (make_fixnum (256), Qnil); for (tail = charset_list; CONSP (tail); tail = XCDR (tail)) { @@ -10214,7 +10214,7 @@ usage: (define-coding-system-internal ...) */) tmp = AREF (val, i); if (NILP (tmp)) tmp = XCAR (tail); - else if (NUMBERP (tmp)) + else if (FIXED_OR_FLOATP (tmp)) { dim2 = CHARSET_DIMENSION (CHARSET_FROM_ID (XFASTINT (tmp))); if (dim < dim2) @@ -10264,30 +10264,30 @@ usage: (define-coding-system-internal ...) */) ASET (attrs, coding_attr_ccl_encoder, val); val = args[coding_arg_ccl_valids]; - valids = Fmake_string (make_number (256), make_number (0), Qnil); + valids = Fmake_string (make_fixnum (256), make_fixnum (0), Qnil); for (tail = val; CONSP (tail); tail = XCDR (tail)) { int from, to; val = XCAR (tail); - if (INTEGERP (val)) + if (FIXNUMP (val)) { if (! (0 <= XINT (val) && XINT (val) <= 255)) - args_out_of_range_3 (val, make_number (0), make_number (255)); + args_out_of_range_3 (val, make_fixnum (0), make_fixnum (255)); from = to = XINT (val); } else { CHECK_CONS (val); - CHECK_NATNUM_CAR (val); - CHECK_NUMBER_CDR (val); + CHECK_FIXNAT_CAR (val); + CHECK_FIXNUM_CDR (val); if (XINT (XCAR (val)) > 255) args_out_of_range_3 (XCAR (val), - make_number (0), make_number (255)); + make_fixnum (0), make_fixnum (255)); from = XINT (XCAR (val)); if (! (from <= XINT (XCDR (val)) && XINT (XCDR (val)) <= 255)) args_out_of_range_3 (XCDR (val), - XCAR (val), make_number (255)); + XCAR (val), make_fixnum (255)); to = XINT (XCDR (val)); } for (i = from; i <= to; i++) @@ -10352,18 +10352,18 @@ usage: (define-coding-system-internal ...) */) struct charset *charset; CHECK_CHARSET_GET_CHARSET (val, charset); - ASET (initial, i, make_number (CHARSET_ID (charset))); + ASET (initial, i, make_fixnum (CHARSET_ID (charset))); if (i == 0 && CHARSET_ASCII_COMPATIBLE_P (charset)) ASET (attrs, coding_attr_ascii_compat, Qt); } else - ASET (initial, i, make_number (-1)); + ASET (initial, i, make_fixnum (-1)); } reg_usage = args[coding_arg_iso2022_reg_usage]; CHECK_CONS (reg_usage); - CHECK_NUMBER_CAR (reg_usage); - CHECK_NUMBER_CDR (reg_usage); + CHECK_FIXNUM_CAR (reg_usage); + CHECK_FIXNUM_CDR (reg_usage); request = Fcopy_sequence (args[coding_arg_iso2022_request]); for (tail = request; CONSP (tail); tail = XCDR (tail)) @@ -10375,18 +10375,18 @@ usage: (define-coding-system-internal ...) */) CHECK_CONS (val); tmp1 = XCAR (val); CHECK_CHARSET_GET_ID (tmp1, id); - CHECK_NATNUM_CDR (val); + CHECK_FIXNAT_CDR (val); if (XINT (XCDR (val)) >= 4) error ("Invalid graphic register number: %"pI"d", XINT (XCDR (val))); - XSETCAR (val, make_number (id)); + XSETCAR (val, make_fixnum (id)); } flags = args[coding_arg_iso2022_flags]; - CHECK_NATNUM (flags); + CHECK_FIXNAT (flags); i = XINT (flags) & INT_MAX; if (EQ (args[coding_arg_charset_list], Qiso_2022)) i |= CODING_ISO_FLAG_FULL_SUPPORT; - flags = make_number (i); + flags = make_fixnum (i); ASET (attrs, coding_attr_iso_initial, initial); ASET (attrs, coding_attr_iso_usage, reg_usage); @@ -10532,7 +10532,7 @@ usage: (define-coding-system-internal ...) */) error ("Invalid coding system type: %s", SDATA (SYMBOL_NAME (coding_type))); - ASET (attrs, coding_attr_category, make_number (category)); + ASET (attrs, coding_attr_category, make_fixnum (category)); ASET (attrs, coding_attr_plist, Fcons (QCcategory, Fcons (AREF (Vcoding_category_table, category), @@ -10599,7 +10599,7 @@ usage: (define-coding-system-internal ...) */) short_args: Fsignal (Qwrong_number_of_arguments, Fcons (intern ("define-coding-system-internal"), - make_number (nargs))); + make_fixnum (nargs))); } @@ -10621,7 +10621,7 @@ DEFUN ("coding-system-put", Fcoding_system_put, Scoding_system_put, else if (EQ (prop, QCdefault_char)) { if (NILP (val)) - val = make_number (' '); + val = make_fixnum (' '); else CHECK_CHARACTER (val); ASET (attrs, coding_attr_default_char, val); @@ -10766,7 +10766,7 @@ coding system whose eol-type is N. */) if (VECTORP (eol_type)) return Fcopy_sequence (eol_type); n = EQ (eol_type, Qunix) ? 0 : EQ (eol_type, Qdos) ? 1 : 2; - return make_number (n); + return make_fixnum (n); } #endif /* emacs */ @@ -10842,25 +10842,25 @@ syms_of_coding (void) Fset (Qcoding_system_history, Qnil); /* Target FILENAME is the first argument. */ - Fput (Qinsert_file_contents, Qtarget_idx, make_number (0)); + Fput (Qinsert_file_contents, Qtarget_idx, make_fixnum (0)); /* Target FILENAME is the third argument. */ - Fput (Qwrite_region, Qtarget_idx, make_number (2)); + Fput (Qwrite_region, Qtarget_idx, make_fixnum (2)); DEFSYM (Qcall_process, "call-process"); /* Target PROGRAM is the first argument. */ - Fput (Qcall_process, Qtarget_idx, make_number (0)); + Fput (Qcall_process, Qtarget_idx, make_fixnum (0)); DEFSYM (Qcall_process_region, "call-process-region"); /* Target PROGRAM is the third argument. */ - Fput (Qcall_process_region, Qtarget_idx, make_number (2)); + Fput (Qcall_process_region, Qtarget_idx, make_fixnum (2)); DEFSYM (Qstart_process, "start-process"); /* Target PROGRAM is the third argument. */ - Fput (Qstart_process, Qtarget_idx, make_number (2)); + Fput (Qstart_process, Qtarget_idx, make_fixnum (2)); DEFSYM (Qopen_network_stream, "open-network-stream"); /* Target SERVICE is the fourth argument. */ - Fput (Qopen_network_stream, Qtarget_idx, make_number (3)); + Fput (Qopen_network_stream, Qtarget_idx, make_fixnum (3)); DEFSYM (Qunix, "unix"); DEFSYM (Qdos, "dos"); @@ -10899,7 +10899,7 @@ syms_of_coding (void) build_pure_c_string ("Invalid coding system")); DEFSYM (Qtranslation_table, "translation-table"); - Fput (Qtranslation_table, Qchar_table_extra_slots, make_number (2)); + Fput (Qtranslation_table, Qchar_table_extra_slots, make_fixnum (2)); DEFSYM (Qtranslation_table_id, "translation-table-id"); /* Coding system emacs-mule and raw-text are for converting only @@ -10916,7 +10916,7 @@ syms_of_coding (void) DEFSYM (QCascii_compatible_p, ":ascii-compatible-p"); Vcoding_category_table - = Fmake_vector (make_number (coding_category_max), Qnil); + = Fmake_vector (make_fixnum (coding_category_max), Qnil); staticpro (&Vcoding_category_table); /* Followings are target of code detection. */ ASET (Vcoding_category_table, coding_category_iso_7, @@ -11220,7 +11220,7 @@ a coding system of ISO 2022 variant which has a flag `accept-latin-extra-code' t (e.g. iso-latin-1) on reading a file or reading output of a subprocess. Only 128th through 159th elements have a meaning. */); - Vlatin_extra_code_table = Fmake_vector (make_number (256), Qnil); + Vlatin_extra_code_table = Fmake_vector (make_fixnum (256), Qnil); DEFVAR_LISP ("select-safe-coding-system-function", Vselect_safe_coding_system_function, @@ -11309,13 +11309,13 @@ internal character representation. */); QCname, args[coding_arg_name] = Qno_conversion, QCmnemonic, - args[coding_arg_mnemonic] = make_number ('='), + args[coding_arg_mnemonic] = make_fixnum ('='), intern_c_string (":coding-type"), args[coding_arg_coding_type] = Qraw_text, QCascii_compatible_p, args[coding_arg_ascii_compatible_p] = Qt, QCdefault_char, - args[coding_arg_default_char] = make_number (0), + args[coding_arg_default_char] = make_fixnum (0), intern_c_string (":for-unibyte"), args[coding_arg_for_unibyte] = Qt, intern_c_string (":docstring"), @@ -11332,7 +11332,7 @@ internal character representation. */); Fdefine_coding_system_internal (coding_arg_max, args); plist[1] = args[coding_arg_name] = Qundecided; - plist[3] = args[coding_arg_mnemonic] = make_number ('-'); + plist[3] = args[coding_arg_mnemonic] = make_fixnum ('-'); plist[5] = args[coding_arg_coding_type] = Qundecided; /* This is already set. plist[7] = args[coding_arg_ascii_compatible_p] = Qt; */ @@ -11343,8 +11343,8 @@ internal character representation. */); "automatic conversion on decoding."); plist[15] = args[coding_arg_eol_type] = Qnil; args[coding_arg_plist] = CALLMANY (Flist, plist); - args[coding_arg_undecided_inhibit_null_byte_detection] = make_number (0); - args[coding_arg_undecided_inhibit_iso_escape_detection] = make_number (0); + args[coding_arg_undecided_inhibit_null_byte_detection] = make_fixnum (0); + args[coding_arg_undecided_inhibit_iso_escape_detection] = make_fixnum (0); Fdefine_coding_system_internal (coding_arg_undecided_max, args); setup_coding_system (Qno_conversion, &safe_terminal_coding); diff --git a/src/composite.c b/src/composite.c index 746c2959f8..f5e05d6875 100644 --- a/src/composite.c +++ b/src/composite.c @@ -193,7 +193,7 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars, goto invalid_composition; id = XCAR (prop); - if (INTEGERP (id)) + if (FIXNUMP (id)) { /* PROP should be Form-B. */ if (XINT (id) < 0 || XINT (id) >= n_compositions) @@ -206,7 +206,7 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars, if (!CONSP (id)) goto invalid_composition; length = XCAR (id); - if (!INTEGERP (length) || XINT (length) != nchars) + if (!FIXNUMP (length) || XINT (length) != nchars) goto invalid_composition; components = XCDR (id); @@ -215,8 +215,8 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars, by consulting composition_hash_table. The key for this table is COMPONENTS (converted to a vector COMPONENTS-VEC) or, if it is nil, vector of characters in the composition range. */ - if (INTEGERP (components)) - key = Fmake_vector (make_number (1), components); + if (FIXNUMP (components)) + key = Fmake_vector (make_fixnum (1), components); else if (STRINGP (components) || CONSP (components)) key = Fvconcat (1, &components); else if (VECTORP (components)) @@ -228,13 +228,13 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars, for (i = 0; i < nchars; i++) { FETCH_STRING_CHAR_ADVANCE (ch, string, charpos, bytepos); - ASET (key, i, make_number (ch)); + ASET (key, i, make_fixnum (ch)); } else for (i = 0; i < nchars; i++) { FETCH_CHAR_ADVANCE (ch, charpos, bytepos); - ASET (key, i, make_number (ch)); + ASET (key, i, make_fixnum (ch)); } } else @@ -250,7 +250,7 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars, key = HASH_KEY (hash_table, hash_index); id = HASH_VALUE (hash_table, hash_index); XSETCAR (prop, id); - XSETCDR (prop, Fcons (make_number (nchars), Fcons (key, XCDR (prop)))); + XSETCDR (prop, Fcons (make_fixnum (nchars), Fcons (key, XCDR (prop)))); return XINT (id); } @@ -289,7 +289,7 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars, composition rule). */ for (i = 0; i < len; i++) { - if (!INTEGERP (key_contents[i])) + if (!FIXNUMP (key_contents[i])) goto invalid_composition; } } @@ -298,14 +298,14 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars, the cons cell of PROP because it is not shared. */ XSETFASTINT (id, n_compositions); XSETCAR (prop, id); - XSETCDR (prop, Fcons (make_number (nchars), Fcons (key, XCDR (prop)))); + XSETCDR (prop, Fcons (make_fixnum (nchars), Fcons (key, XCDR (prop)))); /* Register the composition in composition_hash_table. */ hash_index = hash_put (hash_table, key, id, hash_code); method = (NILP (components) ? COMPOSITION_RELATIVE - : ((INTEGERP (components) || STRINGP (components)) + : ((FIXNUMP (components) || STRINGP (components)) ? COMPOSITION_WITH_ALTCHARS : COMPOSITION_WITH_RULE_ALTCHARS)); @@ -431,8 +431,8 @@ find_composition (ptrdiff_t pos, ptrdiff_t limit, if (limit > pos) /* search forward */ { - val = Fnext_single_property_change (make_number (pos), Qcomposition, - object, make_number (limit)); + val = Fnext_single_property_change (make_fixnum (pos), Qcomposition, + object, make_fixnum (limit)); pos = XINT (val); if (pos == limit) return 0; @@ -442,8 +442,8 @@ find_composition (ptrdiff_t pos, ptrdiff_t limit, if (get_property_and_range (pos - 1, Qcomposition, prop, start, end, object)) return 1; - val = Fprevious_single_property_change (make_number (pos), Qcomposition, - object, make_number (limit)); + val = Fprevious_single_property_change (make_fixnum (pos), Qcomposition, + object, make_fixnum (limit)); pos = XINT (val); if (pos == limit) return 0; @@ -474,7 +474,7 @@ run_composition_function (ptrdiff_t from, ptrdiff_t to, Lisp_Object prop) && !composition_valid_p (start, end, prop)) to = end; if (!NILP (Ffboundp (func))) - call2 (func, make_number (from), make_number (to)); + call2 (func, make_fixnum (from), make_fixnum (to)); } /* Make invalid compositions adjacent to or inside FROM and TO valid. @@ -519,7 +519,7 @@ update_compositions (ptrdiff_t from, ptrdiff_t to, int check_mask) if (end > to) max_pos = end; if (from < end) - Fput_text_property (make_number (from), make_number (end), + Fput_text_property (make_fixnum (from), make_fixnum (end), Qcomposition, Fcons (XCAR (prop), XCDR (prop)), Qnil); run_composition_function (start, end, prop); @@ -560,7 +560,7 @@ update_compositions (ptrdiff_t from, ptrdiff_t to, int check_mask) the former to the copy of it. */ if (to < end) { - Fput_text_property (make_number (start), make_number (to), + Fput_text_property (make_fixnum (start), make_fixnum (to), Qcomposition, Fcons (XCAR (prop), XCDR (prop)), Qnil); max_pos = end; @@ -582,8 +582,8 @@ update_compositions (ptrdiff_t from, ptrdiff_t to, int check_mask) specbind (Qinhibit_read_only, Qt); specbind (Qinhibit_modification_hooks, Qt); specbind (Qinhibit_point_motion_hooks, Qt); - Fremove_list_of_text_properties (make_number (min_pos), - make_number (max_pos), + Fremove_list_of_text_properties (make_fixnum (min_pos), + make_fixnum (max_pos), list1 (Qauto_composed), Qnil); unbind_to (count, Qnil); } @@ -625,9 +625,9 @@ compose_text (ptrdiff_t start, ptrdiff_t end, Lisp_Object components, { Lisp_Object prop; - prop = Fcons (Fcons (make_number (end - start), components), + prop = Fcons (Fcons (make_fixnum (end - start), components), modification_func); - Fput_text_property (make_number (start), make_number (end), + Fput_text_property (make_fixnum (start), make_fixnum (end), Qcomposition, prop, string); } @@ -669,12 +669,12 @@ composition_gstring_put_cache (Lisp_Object gstring, ptrdiff_t len) len = j; } - copy = Fmake_vector (make_number (len + 2), Qnil); + copy = Fmake_vector (make_fixnum (len + 2), Qnil); LGSTRING_SET_HEADER (copy, Fcopy_sequence (header)); for (i = 0; i < len; i++) LGSTRING_SET_GLYPH (copy, i, Fcopy_sequence (LGSTRING_GLYPH (gstring, i))); i = hash_put (h, LGSTRING_HEADER (copy), copy, hash); - LGSTRING_SET_ID (copy, make_number (i)); + LGSTRING_SET_ID (copy, make_fixnum (i)); return copy; } @@ -692,7 +692,7 @@ DEFUN ("clear-composition-cache", Fclear_composition_cache, Clear composition cache. */) (void) { - Lisp_Object args[] = {QCtest, Qequal, QCsize, make_number (311)}; + Lisp_Object args[] = {QCtest, Qequal, QCsize, make_fixnum (311)}; gstring_hash_table = CALLMANY (Fmake_hash_table, args); /* Fixme: We call Fclear_face_cache to force complete re-building of display glyphs. But, it may be better to call this function from @@ -716,9 +716,9 @@ composition_gstring_p (Lisp_Object gstring) && ! CODING_SYSTEM_P (LGSTRING_FONT (gstring)))) return 0; for (i = 1; i < ASIZE (LGSTRING_HEADER (gstring)); i++) - if (! NATNUMP (AREF (LGSTRING_HEADER (gstring), i))) + if (! FIXNATP (AREF (LGSTRING_HEADER (gstring), i))) return 0; - if (! NILP (LGSTRING_ID (gstring)) && ! NATNUMP (LGSTRING_ID (gstring))) + if (! NILP (LGSTRING_ID (gstring)) && ! FIXNATP (LGSTRING_ID (gstring))) return 0; for (i = 0; i < LGSTRING_GLYPH_LEN (gstring); i++) { @@ -801,7 +801,7 @@ fill_gstring_header (Lisp_Object header, ptrdiff_t from, ptrdiff_t from_byte, if (VECTORP (header)) { if (ASIZE (header) != len + 1) - args_out_of_range (header, make_number (len + 1)); + args_out_of_range (header, make_fixnum (len + 1)); } else { @@ -820,7 +820,7 @@ fill_gstring_header (Lisp_Object header, ptrdiff_t from, ptrdiff_t from_byte, FETCH_CHAR_ADVANCE_NO_CHECK (c, from, from_byte); else FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, from, from_byte); - ASET (header, i + 1, make_number (c)); + ASET (header, i + 1, make_fixnum (c)); } return header; } @@ -881,7 +881,7 @@ autocmp_chars (Lisp_Object rule, ptrdiff_t charpos, ptrdiff_t bytepos, Lisp_Object string) { ptrdiff_t count = SPECPDL_INDEX (); - Lisp_Object pos = make_number (charpos); + Lisp_Object pos = make_fixnum (charpos); ptrdiff_t to; ptrdiff_t pt = PT, pt_byte = PT_BYTE; Lisp_Object re, font_object, lgstring; @@ -917,7 +917,7 @@ autocmp_chars (Lisp_Object rule, ptrdiff_t charpos, ptrdiff_t bytepos, return unbind_to (count, Qnil); } #endif - lgstring = Fcomposition_get_gstring (pos, make_number (to), font_object, + lgstring = Fcomposition_get_gstring (pos, make_fixnum (to), font_object, string); if (NILP (LGSTRING_ID (lgstring))) { @@ -926,7 +926,7 @@ autocmp_chars (Lisp_Object rule, ptrdiff_t charpos, ptrdiff_t bytepos, record_unwind_protect (restore_point_unwind, build_marker (current_buffer, pt, pt_byte)); lgstring = safe_call (6, Vauto_composition_function, AREF (rule, 2), - pos, make_number (to), font_object, string); + pos, make_fixnum (to), font_object, string); } return unbind_to (count, lgstring); } @@ -941,7 +941,7 @@ char_composable_p (int c) return (c > ' ' && (c == ZERO_WIDTH_NON_JOINER || c == ZERO_WIDTH_JOINER || (val = CHAR_TABLE_REF (Vunicode_category_table, c), - (INTEGERP (val) && (XINT (val) <= UNICODE_CATEGORY_So))))); + (FIXNUMP (val) && (XINT (val) <= UNICODE_CATEGORY_So))))); } /* Update cmp_it->stop_pos to the next position after CHARPOS (and @@ -1030,7 +1030,7 @@ composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos, { Lisp_Object elt = XCAR (val); if (VECTORP (elt) && ASIZE (elt) == 3 - && NATNUMP (AREF (elt, 1)) + && FIXNATP (AREF (elt, 1)) && charpos - 1 - XFASTINT (AREF (elt, 1)) >= start) { cmp_it->rule_idx = ridx; @@ -1081,7 +1081,7 @@ composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos, { Lisp_Object elt = XCAR (val); if (VECTORP (elt) && ASIZE (elt) == 3 - && NATNUMP (AREF (elt, 1)) + && FIXNATP (AREF (elt, 1)) && charpos - XFASTINT (AREF (elt, 1)) > endpos) { ptrdiff_t back = XFASTINT (AREF (elt, 1)); @@ -1221,7 +1221,7 @@ composition_reseat_it (struct composition_it *cmp_it, ptrdiff_t charpos, { elt = XCAR (val); if (! VECTORP (elt) || ASIZE (elt) != 3 - || ! INTEGERP (AREF (elt, 1))) + || ! FIXNUMP (AREF (elt, 1))) continue; if (XFASTINT (AREF (elt, 1)) != cmp_it->lookback) goto no_composition; @@ -1559,7 +1559,7 @@ find_automatic_composition (ptrdiff_t pos, ptrdiff_t limit, { Lisp_Object elt = XCAR (val); - if (VECTORP (elt) && ASIZE (elt) == 3 && NATNUMP (AREF (elt, 1))) + if (VECTORP (elt) && ASIZE (elt) == 3 && FIXNATP (AREF (elt, 1))) { EMACS_INT check_pos = cur.pos - XFASTINT (AREF (elt, 1)); struct position_record check; @@ -1759,7 +1759,7 @@ should be ignored. */) return gstring; if (LGSTRING_GLYPH_LEN (gstring_work) < topos - frompos) - gstring_work = Fmake_vector (make_number (topos - frompos + 2), Qnil); + gstring_work = Fmake_vector (make_fixnum (topos - frompos + 2), Qnil); LGSTRING_SET_HEADER (gstring_work, header); LGSTRING_SET_ID (gstring_work, Qnil); fill_gstring_body (gstring_work); @@ -1780,7 +1780,7 @@ for the composition. See `compose-region' for more details. */) { validate_region (&start, &end); if (!NILP (components) - && !INTEGERP (components) + && !FIXNUMP (components) && !CONSP (components) && !STRINGP (components)) CHECK_VECTOR (components); @@ -1820,10 +1820,10 @@ See `find-composition' for more details. */) ptrdiff_t start, end, from, to; int id; - CHECK_NUMBER_COERCE_MARKER (pos); + CHECK_FIXNUM_COERCE_MARKER (pos); if (!NILP (limit)) { - CHECK_NUMBER_COERCE_MARKER (limit); + CHECK_FIXNUM_COERCE_MARKER (limit); to = min (XINT (limit), ZV); } else @@ -1848,7 +1848,7 @@ See `find-composition' for more details. */) && ! NILP (Vauto_composition_mode) && find_automatic_composition (from, to, &start, &end, &gstring, string)) - return list3 (make_number (start), make_number (end), gstring); + return list3 (make_fixnum (start), make_fixnum (end), gstring); return Qnil; } if ((end <= XINT (pos) || start > XINT (pos))) @@ -1857,12 +1857,12 @@ See `find-composition' for more details. */) if (find_automatic_composition (from, to, &s, &e, &gstring, string) && (e <= XINT (pos) ? e > end : s < start)) - return list3 (make_number (s), make_number (e), gstring); + return list3 (make_fixnum (s), make_fixnum (e), gstring); } if (!composition_valid_p (start, end, prop)) - return list3 (make_number (start), make_number (end), Qnil); + return list3 (make_fixnum (start), make_fixnum (end), Qnil); if (NILP (detail_p)) - return list3 (make_number (start), make_number (end), Qt); + return list3 (make_fixnum (start), make_fixnum (end), Qt); if (composition_registered_p (prop)) id = COMPOSITION_ID (prop); @@ -1884,12 +1884,12 @@ See `find-composition' for more details. */) relative_p = (method == COMPOSITION_WITH_RULE_ALTCHARS ? Qnil : Qt); mod_func = COMPOSITION_MODIFICATION_FUNC (prop); - tail = list4 (components, relative_p, mod_func, make_number (width)); + tail = list4 (components, relative_p, mod_func, make_fixnum (width)); } else tail = Qnil; - return Fcons (make_number (start), Fcons (make_number (end), tail)); + return Fcons (make_fixnum (start), Fcons (make_fixnum (end), tail)); } @@ -1906,7 +1906,7 @@ syms_of_composite (void) created compositions are repeatedly used in an Emacs session, and thus it's not worth to save memory in such a way. So, we make the table not weak. */ - Lisp_Object args[] = {QCtest, Qequal, QCsize, make_number (311)}; + Lisp_Object args[] = {QCtest, Qequal, QCsize, make_fixnum (311)}; composition_hash_table = CALLMANY (Fmake_hash_table, args); staticpro (&composition_hash_table); @@ -1917,9 +1917,9 @@ syms_of_composite (void) staticpro (&gstring_work_headers); gstring_work_headers = make_uninit_vector (8); for (i = 0; i < 8; i++) - ASET (gstring_work_headers, i, Fmake_vector (make_number (i + 2), Qnil)); + ASET (gstring_work_headers, i, Fmake_vector (make_fixnum (i + 2), Qnil)); staticpro (&gstring_work); - gstring_work = Fmake_vector (make_number (10), Qnil); + gstring_work = Fmake_vector (make_fixnum (10), Qnil); /* Text property `composition' should be nonsticky by default. */ Vtext_property_default_nonsticky diff --git a/src/composite.h b/src/composite.h index 19d20fb2b2..175381fad0 100644 --- a/src/composite.h +++ b/src/composite.h @@ -59,7 +59,7 @@ enum composition_method { INLINE bool composition_registered_p (Lisp_Object prop) { - return INTEGERP (XCAR (prop)); + return FIXNUMP (XCAR (prop)); } /* Return ID number of the already registered composition. */ @@ -213,7 +213,7 @@ composition_method (Lisp_Object prop) Lisp_Object temp = XCDR (XCAR (prop)); return (NILP (temp) ? COMPOSITION_RELATIVE - : INTEGERP (temp) || STRINGP (temp) + : FIXNUMP (temp) || STRINGP (temp) ? COMPOSITION_WITH_ALTCHARS : COMPOSITION_WITH_RULE_ALTCHARS); } @@ -234,7 +234,7 @@ composition_valid_p (ptrdiff_t start, ptrdiff_t end, Lisp_Object prop) && (NILP (XCDR (XCAR (prop))) || STRINGP (XCDR (XCAR (prop))) || VECTORP (XCDR (XCAR (prop))) - || INTEGERP (XCDR (XCAR (prop))) + || FIXNUMP (XCDR (XCAR (prop))) || CONSP (XCDR (XCAR (prop)))))) && COMPOSITION_LENGTH (prop) == end - start); } @@ -274,7 +274,7 @@ enum lglyph_indices LGLYPH_SIZE }; -#define LGLYPH_NEW() Fmake_vector (make_number (LGLYPH_SIZE), Qnil) +#define LGLYPH_NEW() Fmake_vector (make_fixnum (LGLYPH_SIZE), Qnil) #define LGLYPH_FROM(g) XINT (AREF ((g), LGLYPH_IX_FROM)) #define LGLYPH_TO(g) XINT (AREF ((g), LGLYPH_IX_TO)) #define LGLYPH_CHAR(g) XINT (AREF ((g), LGLYPH_IX_CHAR)) @@ -288,19 +288,19 @@ enum lglyph_indices #define LGLYPH_ASCENT(g) XINT (AREF ((g), LGLYPH_IX_ASCENT)) #define LGLYPH_DESCENT(g) XINT (AREF ((g), LGLYPH_IX_DESCENT)) #define LGLYPH_ADJUSTMENT(g) AREF ((g), LGLYPH_IX_ADJUSTMENT) -#define LGLYPH_SET_FROM(g, val) ASET ((g), LGLYPH_IX_FROM, make_number (val)) -#define LGLYPH_SET_TO(g, val) ASET ((g), LGLYPH_IX_TO, make_number (val)) -#define LGLYPH_SET_CHAR(g, val) ASET ((g), LGLYPH_IX_CHAR, make_number (val)) +#define LGLYPH_SET_FROM(g, val) ASET ((g), LGLYPH_IX_FROM, make_fixnum (val)) +#define LGLYPH_SET_TO(g, val) ASET ((g), LGLYPH_IX_TO, make_fixnum (val)) +#define LGLYPH_SET_CHAR(g, val) ASET ((g), LGLYPH_IX_CHAR, make_fixnum (val)) /* Callers must assure that VAL is not negative! */ #define LGLYPH_SET_CODE(g, val) \ ASET (g, LGLYPH_IX_CODE, \ val == FONT_INVALID_CODE ? Qnil : INTEGER_TO_CONS (val)) -#define LGLYPH_SET_WIDTH(g, val) ASET ((g), LGLYPH_IX_WIDTH, make_number (val)) -#define LGLYPH_SET_LBEARING(g, val) ASET ((g), LGLYPH_IX_LBEARING, make_number (val)) -#define LGLYPH_SET_RBEARING(g, val) ASET ((g), LGLYPH_IX_RBEARING, make_number (val)) -#define LGLYPH_SET_ASCENT(g, val) ASET ((g), LGLYPH_IX_ASCENT, make_number (val)) -#define LGLYPH_SET_DESCENT(g, val) ASET ((g), LGLYPH_IX_DESCENT, make_number (val)) +#define LGLYPH_SET_WIDTH(g, val) ASET ((g), LGLYPH_IX_WIDTH, make_fixnum (val)) +#define LGLYPH_SET_LBEARING(g, val) ASET ((g), LGLYPH_IX_LBEARING, make_fixnum (val)) +#define LGLYPH_SET_RBEARING(g, val) ASET ((g), LGLYPH_IX_RBEARING, make_fixnum (val)) +#define LGLYPH_SET_ASCENT(g, val) ASET ((g), LGLYPH_IX_ASCENT, make_fixnum (val)) +#define LGLYPH_SET_DESCENT(g, val) ASET ((g), LGLYPH_IX_DESCENT, make_fixnum (val)) #define LGLYPH_SET_ADJUSTMENT(g, val) ASET ((g), LGLYPH_IX_ADJUSTMENT, (val)) #define LGLYPH_XOFF(g) (VECTORP (LGLYPH_ADJUSTMENT (g)) \ diff --git a/src/conf_post.h b/src/conf_post.h index 080d7b7e68..0927fca7ca 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -206,7 +206,7 @@ extern void _DebPrint (const char *fmt, ...); /* Tell regex.c to use a type compatible with Emacs. */ #define RE_TRANSLATE_TYPE Lisp_Object #define RE_TRANSLATE(TBL, C) char_table_translate (TBL, C) -#define RE_TRANSLATE_P(TBL) (!EQ (TBL, make_number (0))) +#define RE_TRANSLATE_P(TBL) (!EQ (TBL, make_fixnum (0))) #endif /* Tell time_rz.c to use Emacs's getter and setter for TZ. diff --git a/src/data.c b/src/data.c index c8beeda720..aad5708464 100644 --- a/src/data.c +++ b/src/data.c @@ -132,13 +132,13 @@ set_blv_valcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val) static _Noreturn void wrong_length_argument (Lisp_Object a1, Lisp_Object a2, Lisp_Object a3) { - Lisp_Object size1 = make_number (bool_vector_size (a1)); - Lisp_Object size2 = make_number (bool_vector_size (a2)); + Lisp_Object size1 = make_fixnum (bool_vector_size (a1)); + Lisp_Object size2 = make_fixnum (bool_vector_size (a2)); if (NILP (a3)) xsignal2 (Qwrong_length_argument, size1, size2); else xsignal3 (Qwrong_length_argument, size1, size2, - make_number (bool_vector_size (a3))); + make_fixnum (bool_vector_size (a3))); } _Noreturn void @@ -515,7 +515,7 @@ DEFUN ("integerp", Fintegerp, Sintegerp, 1, 1, 0, attributes: const) (Lisp_Object object) { - if (INTEGERP (object)) + if (FIXNUMP (object)) return Qt; return Qnil; } @@ -524,7 +524,7 @@ DEFUN ("integer-or-marker-p", Finteger_or_marker_p, Sinteger_or_marker_p, 1, 1, doc: /* Return t if OBJECT is an integer or a marker (editor pointer). */) (register Lisp_Object object) { - if (MARKERP (object) || INTEGERP (object)) + if (MARKERP (object) || FIXNUMP (object)) return Qt; return Qnil; } @@ -534,7 +534,7 @@ DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0, attributes: const) (Lisp_Object object) { - if (NATNUMP (object)) + if (FIXNATP (object)) return Qt; return Qnil; } @@ -544,7 +544,7 @@ DEFUN ("numberp", Fnumberp, Snumberp, 1, 1, 0, attributes: const) (Lisp_Object object) { - if (NUMBERP (object)) + if (FIXED_OR_FLOATP (object)) return Qt; else return Qnil; @@ -555,7 +555,7 @@ DEFUN ("number-or-marker-p", Fnumber_or_marker_p, doc: /* Return t if OBJECT is a number or a marker. */) (Lisp_Object object) { - if (NUMBERP (object) || MARKERP (object)) + if (FIXED_OR_FLOATP (object) || MARKERP (object)) return Qt; return Qnil; } @@ -858,10 +858,10 @@ function with `&rest' args, or `unevalled' for a special form. */) CHECK_SUBR (subr); minargs = XSUBR (subr)->min_args; maxargs = XSUBR (subr)->max_args; - return Fcons (make_number (minargs), + return Fcons (make_fixnum (minargs), maxargs == MANY ? Qmany : maxargs == UNEVALLED ? Qunevalled - : make_number (maxargs)); + : make_fixnum (maxargs)); } DEFUN ("subr-name", Fsubr_name, Ssubr_name, 1, 1, 0, @@ -1084,7 +1084,7 @@ store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newva switch (XFWDTYPE (valcontents)) { case Lisp_Fwd_Int: - CHECK_NUMBER (newval); + CHECK_FIXNUM (newval); *XINTFWD (valcontents)->intvar = XINT (newval); break; @@ -1140,7 +1140,7 @@ store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newva else if ((prop = Fget (predicate, Qrange), !NILP (prop))) { Lisp_Object min = XCAR (prop), max = XCDR (prop); - if (! NUMBERP (newval) + if (! FIXED_OR_FLOATP (newval) || NILP (CALLN (Fleq, min, newval, max))) wrong_range (min, max, newval); } @@ -2232,7 +2232,7 @@ or a byte-code object. IDX starts at 0. */) { register EMACS_INT idxval; - CHECK_NUMBER (idx); + CHECK_FIXNUM (idx); idxval = XINT (idx); if (STRINGP (array)) { @@ -2242,11 +2242,11 @@ or a byte-code object. IDX starts at 0. */) if (idxval < 0 || idxval >= SCHARS (array)) args_out_of_range (array, idx); if (! STRING_MULTIBYTE (array)) - return make_number ((unsigned char) SREF (array, idxval)); + return make_fixnum ((unsigned char) SREF (array, idxval)); idxval_byte = string_char_to_byte (array, idxval); c = STRING_CHAR (SDATA (array) + idxval_byte); - return make_number (c); + return make_fixnum (c); } else if (BOOL_VECTOR_P (array)) { @@ -2283,7 +2283,7 @@ bool-vector. IDX starts at 0. */) { register EMACS_INT idxval; - CHECK_NUMBER (idx); + CHECK_FIXNUM (idx); idxval = XINT (idx); if (! RECORDP (array)) CHECK_ARRAY (array, Qarrayp); @@ -2385,8 +2385,8 @@ arithcompare (Lisp_Object num1, Lisp_Object num2, bool fneq; bool test; - CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1); - CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2); + CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (num1); + CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (num2); /* If either arg is floating point, set F1 and F2 to the 'double' approximations of the two arguments, and set FNEQ if floating-point @@ -2532,12 +2532,12 @@ DEFUN ("/=", Fneq, Sneq, 2, 2, 0, (eassert (FIXNUM_OVERFLOW_P (i)), \ (! (FIXNUM_OVERFLOW_P ((extremum) >> 16) \ && FIXNUM_OVERFLOW_P ((i) >> 16)) \ - ? Fcons (make_number ((i) >> 16), make_number ((i) & 0xffff)) \ + ? Fcons (make_fixnum ((i) >> 16), make_fixnum ((i) & 0xffff)) \ : ! (FIXNUM_OVERFLOW_P ((extremum) >> 16 >> 24) \ && FIXNUM_OVERFLOW_P ((i) >> 16 >> 24)) \ - ? Fcons (make_number ((i) >> 16 >> 24), \ - Fcons (make_number ((i) >> 16 & 0xffffff), \ - make_number ((i) & 0xffff))) \ + ? Fcons (make_fixnum ((i) >> 16 >> 24), \ + Fcons (make_fixnum ((i) >> 16 & 0xffffff), \ + make_fixnum ((i) & 0xffff))) \ : make_float (i))) Lisp_Object @@ -2561,7 +2561,7 @@ cons_to_unsigned (Lisp_Object c, uintmax_t max) { bool valid = false; uintmax_t val UNINIT; - if (INTEGERP (c)) + if (FIXNUMP (c)) { valid = XINT (c) >= 0; val = XINT (c); @@ -2575,14 +2575,14 @@ cons_to_unsigned (Lisp_Object c, uintmax_t max) valid = val == d; } } - else if (CONSP (c) && NATNUMP (XCAR (c))) + else if (CONSP (c) && FIXNATP (XCAR (c))) { uintmax_t top = XFASTINT (XCAR (c)); Lisp_Object rest = XCDR (c); if (top <= UINTMAX_MAX >> 24 >> 16 && CONSP (rest) - && NATNUMP (XCAR (rest)) && XFASTINT (XCAR (rest)) < 1 << 24 - && NATNUMP (XCDR (rest)) && XFASTINT (XCDR (rest)) < 1 << 16) + && FIXNATP (XCAR (rest)) && XFASTINT (XCAR (rest)) < 1 << 24 + && FIXNATP (XCDR (rest)) && XFASTINT (XCDR (rest)) < 1 << 16) { uintmax_t mid = XFASTINT (XCAR (rest)); val = top << 24 << 16 | mid << 16 | XFASTINT (XCDR (rest)); @@ -2592,7 +2592,7 @@ cons_to_unsigned (Lisp_Object c, uintmax_t max) { if (CONSP (rest)) rest = XCAR (rest); - if (NATNUMP (rest) && XFASTINT (rest) < 1 << 16) + if (FIXNATP (rest) && XFASTINT (rest) < 1 << 16) { val = top << 16 | XFASTINT (rest); valid = true; @@ -2615,7 +2615,7 @@ cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max) { bool valid = false; intmax_t val UNINIT; - if (INTEGERP (c)) + if (FIXNUMP (c)) { val = XINT (c); valid = true; @@ -2629,14 +2629,14 @@ cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max) valid = val == d; } } - else if (CONSP (c) && INTEGERP (XCAR (c))) + else if (CONSP (c) && FIXNUMP (XCAR (c))) { intmax_t top = XINT (XCAR (c)); Lisp_Object rest = XCDR (c); if (top >= INTMAX_MIN >> 24 >> 16 && top <= INTMAX_MAX >> 24 >> 16 && CONSP (rest) - && NATNUMP (XCAR (rest)) && XFASTINT (XCAR (rest)) < 1 << 24 - && NATNUMP (XCDR (rest)) && XFASTINT (XCDR (rest)) < 1 << 16) + && FIXNATP (XCAR (rest)) && XFASTINT (XCAR (rest)) < 1 << 24 + && FIXNATP (XCDR (rest)) && XFASTINT (XCDR (rest)) < 1 << 16) { intmax_t mid = XFASTINT (XCAR (rest)); val = top << 24 << 16 | mid << 16 | XFASTINT (XCDR (rest)); @@ -2646,7 +2646,7 @@ cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max) { if (CONSP (rest)) rest = XCAR (rest); - if (NATNUMP (rest) && XFASTINT (rest) < 1 << 16) + if (FIXNATP (rest) && XFASTINT (rest) < 1 << 16) { val = top << 16 | XFASTINT (rest); valid = true; @@ -2668,7 +2668,7 @@ NUMBER may be an integer or a floating point number. */) char buffer[max (FLOAT_TO_STRING_BUFSIZE, INT_BUFSIZE_BOUND (EMACS_INT))]; int len; - CHECK_NUMBER_OR_FLOAT (number); + CHECK_FIXNUM_OR_FLOAT (number); if (FLOATP (number)) len = float_to_string (buffer, XFLOAT_DATA (number)); @@ -2696,7 +2696,7 @@ If the base used is not 10, STRING is always parsed as an integer. */) b = 10; else { - CHECK_NUMBER (base); + CHECK_FIXNUM (base); if (! (XINT (base) >= 2 && XINT (base) <= 16)) xsignal1 (Qargs_out_of_range, base); b = XINT (base); @@ -2708,7 +2708,7 @@ If the base used is not 10, STRING is always parsed as an integer. */) int flags = S2N_IGNORE_TRAILING | S2N_OVERFLOW_TO_FLOAT; Lisp_Object val = string_to_number (p, b, flags); - return NILP (val) ? make_number (0) : val; + return NILP (val) ? make_fixnum (0) : val; } enum arithop @@ -2760,9 +2760,9 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) ok_accum = accum; } - /* Using args[argnum] as argument to CHECK_NUMBER_... */ + /* Using args[argnum] as argument to CHECK_FIXNUM_... */ val = args[argnum]; - CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val); + CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (val); if (FLOATP (val)) return float_arith_driver (ok_accum, ok_args, code, @@ -2825,8 +2825,8 @@ float_arith_driver (double accum, ptrdiff_t argnum, enum arithop code, for (; argnum < nargs; argnum++) { - val = args[argnum]; /* using args[argnum] as argument to CHECK_NUMBER_... */ - CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val); + val = args[argnum]; /* using args[argnum] as argument to CHECK_FIXNUM_... */ + CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (val); if (FLOATP (val)) { @@ -2917,8 +2917,8 @@ Both must be integers or markers. */) { Lisp_Object val; - CHECK_NUMBER_COERCE_MARKER (x); - CHECK_NUMBER_COERCE_MARKER (y); + CHECK_FIXNUM_COERCE_MARKER (x); + CHECK_FIXNUM_COERCE_MARKER (y); if (XINT (y) == 0) xsignal0 (Qarith_error); @@ -2936,8 +2936,8 @@ Both X and Y must be numbers or markers. */) Lisp_Object val; EMACS_INT i1, i2; - CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (x); - CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (y); + CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (x); + CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (y); if (FLOATP (x) || FLOATP (y)) return fmod_float (x, y); @@ -2963,11 +2963,11 @@ minmax_driver (ptrdiff_t nargs, Lisp_Object *args, enum Arith_Comparison comparison) { Lisp_Object accum = args[0]; - CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (accum); + CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (accum); for (ptrdiff_t argnum = 1; argnum < nargs; argnum++) { Lisp_Object val = args[argnum]; - CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val); + CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (val); if (!NILP (arithcompare (val, accum, comparison))) accum = val; else if (FLOATP (val) && isnan (XFLOAT_DATA (val))) @@ -3028,9 +3028,9 @@ of VALUE. If VALUE is negative, return the number of zero bits in the representation. */) (Lisp_Object value) { - CHECK_NUMBER (value); + CHECK_FIXNUM (value); EMACS_INT v = XINT (value) < 0 ? -1 - XINT (value) : XINT (value); - return make_number (EMACS_UINT_WIDTH <= UINT_WIDTH + return make_fixnum (EMACS_UINT_WIDTH <= UINT_WIDTH ? count_one_bits (v) : EMACS_UINT_WIDTH <= ULONG_WIDTH ? count_one_bits_l (v) @@ -3045,8 +3045,8 @@ ash_lsh_impl (Lisp_Object value, Lisp_Object count, bool lsh) Lisp_Object val; - CHECK_NUMBER (value); - CHECK_NUMBER (count); + CHECK_FIXNUM (value); + CHECK_FIXNUM (count); if (XINT (count) >= EMACS_INT_WIDTH) XSETINT (val, 0); @@ -3083,7 +3083,7 @@ DEFUN ("1+", Fadd1, Sadd1, 1, 1, 0, Markers are converted to integers. */) (register Lisp_Object number) { - CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (number); + CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (number); if (FLOATP (number)) return (make_float (1.0 + XFLOAT_DATA (number))); @@ -3097,7 +3097,7 @@ DEFUN ("1-", Fsub1, Ssub1, 1, 1, 0, Markers are converted to integers. */) (register Lisp_Object number) { - CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (number); + CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (number); if (FLOATP (number)) return (make_float (-1.0 + XFLOAT_DATA (number))); @@ -3110,7 +3110,7 @@ DEFUN ("lognot", Flognot, Slognot, 1, 1, 0, doc: /* Return the bitwise complement of NUMBER. NUMBER must be an integer. */) (register Lisp_Object number) { - CHECK_NUMBER (number); + CHECK_FIXNUM (number); XSETINT (number, ~XINT (number)); return number; } @@ -3125,7 +3125,7 @@ lowercase l) for small endian machines. */ unsigned i = 0x04030201; int order = *(char *)&i == 1 ? 108 : 66; - return make_number (order); + return make_fixnum (order); } /* Because we round up the bool vector allocate size to word_size @@ -3478,7 +3478,7 @@ value from A's length. */) for (i = 0; i < nwords; i++) count += count_one_bits_word (adata[i]); - return make_number (count); + return make_fixnum (count); } DEFUN ("bool-vector-count-consecutive", Fbool_vector_count_consecutive, @@ -3497,7 +3497,7 @@ A is a bool vector, B is t or nil, and I is an index into A. */) ptrdiff_t nr_words; CHECK_BOOL_VECTOR (a); - CHECK_NATNUM (i); + CHECK_FIXNAT (i); nr_bits = bool_vector_size (a); if (XFASTINT (i) > nr_bits) /* Allow one past the end for convenience */ @@ -3527,7 +3527,7 @@ A is a bool vector, B is t or nil, and I is an index into A. */) count = count_trailing_zero_bits (mword); pos++; if (count + offset < BITS_PER_BITS_WORD) - return make_number (count); + return make_fixnum (count); } /* Scan whole words until we either reach the end of the vector or @@ -3554,7 +3554,7 @@ A is a bool vector, B is t or nil, and I is an index into A. */) count -= BITS_PER_BITS_WORD - nr_bits % BITS_PER_BITS_WORD; } - return make_number (count); + return make_fixnum (count); } @@ -3847,13 +3847,13 @@ syms_of_data (void) DEFVAR_LISP ("most-positive-fixnum", Vmost_positive_fixnum, doc: /* The largest value that is representable in a Lisp integer. This variable cannot be set; trying to do so will signal an error. */); - Vmost_positive_fixnum = make_number (MOST_POSITIVE_FIXNUM); + Vmost_positive_fixnum = make_fixnum (MOST_POSITIVE_FIXNUM); make_symbol_constant (intern_c_string ("most-positive-fixnum")); DEFVAR_LISP ("most-negative-fixnum", Vmost_negative_fixnum, doc: /* The smallest value that is representable in a Lisp integer. This variable cannot be set; trying to do so will signal an error. */); - Vmost_negative_fixnum = make_number (MOST_NEGATIVE_FIXNUM); + Vmost_negative_fixnum = make_fixnum (MOST_NEGATIVE_FIXNUM); make_symbol_constant (intern_c_string ("most-negative-fixnum")); DEFSYM (Qwatchers, "watchers"); diff --git a/src/dbusbind.c b/src/dbusbind.c index 4ebea5712a..ac3e062600 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -201,8 +201,8 @@ xd_symbol_to_dbus_type (Lisp_Object object) arguments to a D-Bus message. */ #define XD_OBJECT_TO_DBUS_TYPE(object) \ ((EQ (object, Qt) || EQ (object, Qnil)) ? DBUS_TYPE_BOOLEAN \ - : (NATNUMP (object)) ? DBUS_TYPE_UINT32 \ - : (INTEGERP (object)) ? DBUS_TYPE_INT32 \ + : (FIXNATP (object)) ? DBUS_TYPE_UINT32 \ + : (FIXNUMP (object)) ? DBUS_TYPE_INT32 \ : (FLOATP (object)) ? DBUS_TYPE_DOUBLE \ : (STRINGP (object)) ? DBUS_TYPE_STRING \ : (XD_DBUS_TYPE_P (object)) ? xd_symbol_to_dbus_type (object) \ @@ -355,7 +355,7 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) { case DBUS_TYPE_BYTE: case DBUS_TYPE_UINT16: - CHECK_NATNUM (object); + CHECK_FIXNAT (object); sprintf (signature, "%c", dtype); break; @@ -366,7 +366,7 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) break; case DBUS_TYPE_INT16: - CHECK_NUMBER (object); + CHECK_FIXNUM (object); sprintf (signature, "%c", dtype); break; @@ -378,7 +378,7 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) case DBUS_TYPE_INT32: case DBUS_TYPE_INT64: case DBUS_TYPE_DOUBLE: - CHECK_NUMBER_OR_FLOAT (object); + CHECK_FIXNUM_OR_FLOAT (object); sprintf (signature, "%c", dtype); break; @@ -519,8 +519,8 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) static intmax_t xd_extract_signed (Lisp_Object x, intmax_t lo, intmax_t hi) { - CHECK_NUMBER_OR_FLOAT (x); - if (INTEGERP (x)) + CHECK_FIXNUM_OR_FLOAT (x); + if (FIXNUMP (x)) { if (lo <= XINT (x) && XINT (x) <= hi) return XINT (x); @@ -547,8 +547,8 @@ xd_extract_signed (Lisp_Object x, intmax_t lo, intmax_t hi) static uintmax_t xd_extract_unsigned (Lisp_Object x, uintmax_t hi) { - CHECK_NUMBER_OR_FLOAT (x); - if (INTEGERP (x)) + CHECK_FIXNUM_OR_FLOAT (x); + if (FIXNUMP (x)) { if (0 <= XINT (x) && XINT (x) <= hi) return XINT (x); @@ -566,7 +566,7 @@ xd_extract_unsigned (Lisp_Object x, uintmax_t hi) if (xd_in_read_queued_messages) Fthrow (Qdbus_error, Qnil); else - args_out_of_range_3 (x, make_number (0), make_fixnum_or_float (hi)); + args_out_of_range_3 (x, make_fixnum (0), make_fixnum_or_float (hi)); } /* Append C value, extracted from Lisp OBJECT, to iteration ITER. @@ -584,7 +584,7 @@ xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter) switch (dtype) { case DBUS_TYPE_BYTE: - CHECK_NATNUM (object); + CHECK_FIXNAT (object); { unsigned char val = XFASTINT (object) & 0xFF; XD_DEBUG_MESSAGE ("%c %u", dtype, val); @@ -750,7 +750,7 @@ xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter) if (!dbus_message_iter_open_container (iter, dtype, signature, &subiter)) XD_SIGNAL3 (build_string ("Cannot open container"), - make_number (dtype), build_string (signature)); + make_fixnum (dtype), build_string (signature)); break; case DBUS_TYPE_VARIANT: @@ -763,7 +763,7 @@ xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter) if (!dbus_message_iter_open_container (iter, dtype, signature, &subiter)) XD_SIGNAL3 (build_string ("Cannot open container"), - make_number (dtype), build_string (signature)); + make_fixnum (dtype), build_string (signature)); break; case DBUS_TYPE_STRUCT: @@ -772,7 +772,7 @@ xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter) XD_DEBUG_MESSAGE ("%c %s", dtype, XD_OBJECT_TO_STRING (object)); if (!dbus_message_iter_open_container (iter, dtype, NULL, &subiter)) XD_SIGNAL2 (build_string ("Cannot open container"), - make_number (dtype)); + make_fixnum (dtype)); break; } @@ -790,7 +790,7 @@ xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter) /* Close the subiteration. */ if (!dbus_message_iter_close_container (iter, &subiter)) XD_SIGNAL2 (build_string ("Cannot close container"), - make_number (dtype)); + make_fixnum (dtype)); } } @@ -810,7 +810,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter) dbus_message_iter_get_basic (iter, &val); val = val & 0xFF; XD_DEBUG_MESSAGE ("%c %u", dtype, val); - return make_number (val); + return make_fixnum (val); } case DBUS_TYPE_BOOLEAN: @@ -828,7 +828,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter) dbus_message_iter_get_basic (iter, &val); pval = val; XD_DEBUG_MESSAGE ("%c %d", dtype, pval); - return make_number (val); + return make_fixnum (val); } case DBUS_TYPE_UINT16: @@ -838,7 +838,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter) dbus_message_iter_get_basic (iter, &val); pval = val; XD_DEBUG_MESSAGE ("%c %d", dtype, pval); - return make_number (val); + return make_fixnum (val); } case DBUS_TYPE_INT32: @@ -1200,7 +1200,7 @@ this connection to those buses. */) refcount = xd_get_connection_references (connection); XD_DEBUG_MESSAGE ("Bus %s, Reference counter %"pD"d", XD_OBJECT_TO_STRING (bus), refcount); - return make_number (refcount); + return make_fixnum (refcount); } DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name, @@ -1275,7 +1275,7 @@ usage: (dbus-message-internal &rest REST) */) service = args[2]; handler = Qnil; - CHECK_NATNUM (message_type); + CHECK_FIXNAT (message_type); if (! (DBUS_MESSAGE_TYPE_INVALID < XFASTINT (message_type) && XFASTINT (message_type) < DBUS_NUM_MESSAGE_TYPES)) XD_SIGNAL2 (build_string ("Invalid message type"), message_type); @@ -1303,7 +1303,7 @@ usage: (dbus-message-internal &rest REST) */) if (nargs < count) xsignal2 (Qwrong_number_of_arguments, Qdbus_message_internal, - make_number (nargs)); + make_fixnum (nargs)); if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL) || (mtype == DBUS_MESSAGE_TYPE_SIGNAL)) @@ -1409,7 +1409,7 @@ usage: (dbus-message-internal &rest REST) */) /* Check for timeout parameter. */ if ((count + 2 <= nargs) && EQ (args[count], QCtimeout)) { - CHECK_NATNUM (args[count+1]); + CHECK_FIXNAT (args[count+1]); timeout = min (XFASTINT (args[count+1]), INT_MAX); count = count+2; } @@ -1609,7 +1609,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) event.arg = Fcons ((uname == NULL ? Qnil : build_string (uname)), event.arg); event.arg = Fcons (make_fixnum_or_float (serial), event.arg); - event.arg = Fcons (make_number (mtype), event.arg); + event.arg = Fcons (make_fixnum (mtype), event.arg); /* Add the bus symbol to the event. */ event.arg = Fcons (bus, event.arg); @@ -1754,28 +1754,28 @@ syms_of_dbusbind (void) DEFVAR_LISP ("dbus-message-type-invalid", Vdbus_message_type_invalid, doc: /* This value is never a valid message type. */); - Vdbus_message_type_invalid = make_number (DBUS_MESSAGE_TYPE_INVALID); + Vdbus_message_type_invalid = make_fixnum (DBUS_MESSAGE_TYPE_INVALID); DEFVAR_LISP ("dbus-message-type-method-call", Vdbus_message_type_method_call, doc: /* Message type of a method call message. */); - Vdbus_message_type_method_call = make_number (DBUS_MESSAGE_TYPE_METHOD_CALL); + Vdbus_message_type_method_call = make_fixnum (DBUS_MESSAGE_TYPE_METHOD_CALL); DEFVAR_LISP ("dbus-message-type-method-return", Vdbus_message_type_method_return, doc: /* Message type of a method return message. */); Vdbus_message_type_method_return - = make_number (DBUS_MESSAGE_TYPE_METHOD_RETURN); + = make_fixnum (DBUS_MESSAGE_TYPE_METHOD_RETURN); DEFVAR_LISP ("dbus-message-type-error", Vdbus_message_type_error, doc: /* Message type of an error reply message. */); - Vdbus_message_type_error = make_number (DBUS_MESSAGE_TYPE_ERROR); + Vdbus_message_type_error = make_fixnum (DBUS_MESSAGE_TYPE_ERROR); DEFVAR_LISP ("dbus-message-type-signal", Vdbus_message_type_signal, doc: /* Message type of a signal message. */); - Vdbus_message_type_signal = make_number (DBUS_MESSAGE_TYPE_SIGNAL); + Vdbus_message_type_signal = make_fixnum (DBUS_MESSAGE_TYPE_SIGNAL); DEFVAR_LISP ("dbus-registered-objects-table", Vdbus_registered_objects_table, diff --git a/src/dired.c b/src/dired.c index 5812c569fa..a0b10d070e 100644 --- a/src/dired.c +++ b/src/dired.c @@ -671,15 +671,15 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, /* Reject entries where the encoded strings match, but the decoded don't. For example, "a" should not match "a-ring" on file systems that store decomposed characters. */ - Lisp_Object zero = make_number (0); + Lisp_Object zero = make_fixnum (0); if (check_decoded && SCHARS (file) <= SCHARS (name)) { /* FIXME: This is a copy of the code below. */ ptrdiff_t compare = SCHARS (file); Lisp_Object cmp - = Fcompare_strings (name, zero, make_number (compare), - file, zero, make_number (compare), + = Fcompare_strings (name, zero, make_fixnum (compare), + file, zero, make_fixnum (compare), completion_ignore_case ? Qt : Qnil); if (!EQ (cmp, Qt)) continue; @@ -701,8 +701,8 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, /* FIXME: This is a copy of the code in Ftry_completion. */ ptrdiff_t compare = min (bestmatchsize, SCHARS (name)); Lisp_Object cmp - = Fcompare_strings (bestmatch, zero, make_number (compare), - name, zero, make_number (compare), + = Fcompare_strings (bestmatch, zero, make_fixnum (compare), + name, zero, make_fixnum (compare), completion_ignore_case ? Qt : Qnil); ptrdiff_t matchsize = EQ (cmp, Qt) ? compare : eabs (XINT (cmp)) - 1; @@ -729,13 +729,13 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, == (matchsize + directoryp == SCHARS (bestmatch))) && (cmp = Fcompare_strings (name, zero, - make_number (SCHARS (file)), + make_fixnum (SCHARS (file)), file, zero, Qnil, Qnil), EQ (Qt, cmp)) && (cmp = Fcompare_strings (bestmatch, zero, - make_number (SCHARS (file)), + make_fixnum (SCHARS (file)), file, zero, Qnil, Qnil), @@ -769,8 +769,8 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, it does not require any change to be made. */ if (matchcount == 1 && !NILP (Fequal (bestmatch, file))) return Qt; - bestmatch = Fsubstring (bestmatch, make_number (0), - make_number (bestmatchsize)); + bestmatch = Fsubstring (bestmatch, make_fixnum (0), + make_fixnum (bestmatchsize)); return bestmatch; } @@ -1009,7 +1009,7 @@ file_attributes (int fd, char const *name, return CALLN (Flist, file_type, - make_number (s.st_nlink), + make_fixnum (s.st_nlink), (uname ? DECODE_SYSTEM (build_unibyte_string (uname)) : make_fixnum_or_float (s.st_uid)), diff --git a/src/dispextern.h b/src/dispextern.h index 2180c9ae63..0e70b3f724 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -1837,8 +1837,8 @@ GLYPH_CODE_P (Lisp_Object gc) { return (CONSP (gc) ? (CHARACTERP (XCAR (gc)) - && RANGED_INTEGERP (0, XCDR (gc), MAX_FACE_ID)) - : (RANGED_INTEGERP + && RANGED_FIXNUMP (0, XCDR (gc), MAX_FACE_ID)) + : (RANGED_FIXNUMP (0, gc, (MAX_FACE_ID < TYPE_MAXIMUM (EMACS_INT) >> CHARACTERBITS ? ((EMACS_INT) MAX_FACE_ID << CHARACTERBITS) | MAX_CHAR diff --git a/src/dispnew.c b/src/dispnew.c index fc6f9e2263..0daa23e700 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -5717,7 +5717,7 @@ additional wait period, in milliseconds; this is for backwards compatibility. if (!NILP (milliseconds)) { - CHECK_NUMBER (milliseconds); + CHECK_FIXNUM (milliseconds); duration += XINT (milliseconds) / 1000.0; } @@ -5766,7 +5766,7 @@ sit_for (Lisp_Object timeout, bool reading, int display_option) if (display_option > 1) redisplay_preserve_echo_area (2); - if (INTEGERP (timeout)) + if (FIXNUMP (timeout)) { sec = XINT (timeout); if (sec <= 0) @@ -5925,7 +5925,7 @@ pass nil for VARIABLE. */) || n + 20 < ASIZE (state) / 2) /* Add 20 extra so we grow it less often. */ { - state = Fmake_vector (make_number (n + 20), Qlambda); + state = Fmake_vector (make_fixnum (n + 20), Qlambda); if (! NILP (variable)) Fset (variable, state); else @@ -6041,7 +6041,7 @@ init_display (void) { Vinitial_window_system = Qx; #ifdef HAVE_X11 - Vwindow_system_version = make_number (11); + Vwindow_system_version = make_fixnum (11); #endif #ifdef USE_NCURSES /* In some versions of ncurses, @@ -6057,7 +6057,7 @@ init_display (void) if (!inhibit_window_system) { Vinitial_window_system = Qw32; - Vwindow_system_version = make_number (1); + Vwindow_system_version = make_fixnum (1); return; } #endif /* HAVE_NTGUI */ @@ -6070,7 +6070,7 @@ init_display (void) ) { Vinitial_window_system = Qns; - Vwindow_system_version = make_number (10); + Vwindow_system_version = make_fixnum (10); return; } #endif @@ -6223,7 +6223,7 @@ syms_of_display (void) defsubr (&Sdump_redisplay_history); #endif - frame_and_buffer_state = Fmake_vector (make_number (20), Qlambda); + frame_and_buffer_state = Fmake_vector (make_fixnum (20), Qlambda); staticpro (&frame_and_buffer_state); /* This is the "purpose" slot of a display table. */ diff --git a/src/disptab.h b/src/disptab.h index a86a9130ac..3911efcf4f 100644 --- a/src/disptab.h +++ b/src/disptab.h @@ -72,7 +72,7 @@ extern struct Lisp_Char_Table *buffer_display_table (void); /* Given BASE and LEN returned by the two previous macros, return nonzero if GLYPH code G is aliased to a different code. */ #define GLYPH_ALIAS_P(base,len,g) \ - (GLYPH_FACE (g) == DEFAULT_FACE_ID && GLYPH_CHAR (g) < (len) && INTEGERP (base[GLYPH_CHAR (g)])) + (GLYPH_FACE (g) == DEFAULT_FACE_ID && GLYPH_CHAR (g) < (len) && FIXNUMP (base[GLYPH_CHAR (g)])) /* Follow all aliases for G in the glyph table given by (BASE, LENGTH), and set G to the final glyph. */ diff --git a/src/doc.c b/src/doc.c index 075154e94b..a71c81b4e9 100644 --- a/src/doc.c +++ b/src/doc.c @@ -89,7 +89,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition) ptrdiff_t count = SPECPDL_INDEX (); USE_SAFE_ALLOCA; - if (INTEGERP (filepos)) + if (FIXNUMP (filepos)) { file = Vdoc_file_name; pos = filepos; @@ -339,7 +339,7 @@ string is passed through `substitute-command-keys'. */) if (CONSP (fun) && EQ (XCAR (fun), Qmacro)) fun = XCDR (fun); if (SUBRP (fun)) - doc = make_number (XSUBR (fun)->doc); + doc = make_fixnum (XSUBR (fun)->doc); else if (MODULE_FUNCTIONP (fun)) doc = XMODULE_FUNCTION (fun)->documentation; else if (COMPILEDP (fun)) @@ -351,7 +351,7 @@ string is passed through `substitute-command-keys'. */) Lisp_Object tem = AREF (fun, COMPILED_DOC_STRING); if (STRINGP (tem)) doc = tem; - else if (NATNUMP (tem) || CONSP (tem)) + else if (FIXNATP (tem) || CONSP (tem)) doc = tem; else return Qnil; @@ -378,7 +378,7 @@ string is passed through `substitute-command-keys'. */) doc = tem; /* Handle a doc reference--but these never come last in the function body, so reject them if they are last. */ - else if ((NATNUMP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem)))) + else if ((FIXNATP (tem) || (CONSP (tem) && FIXNUMP (XCDR (tem)))) && !NILP (XCDR (tem1))) doc = tem; else @@ -395,9 +395,9 @@ string is passed through `substitute-command-keys'. */) /* If DOC is 0, it's typically because of a dumped file missing from the DOC file (bug in src/Makefile.in). */ - if (EQ (doc, make_number (0))) + if (EQ (doc, make_fixnum (0))) doc = Qnil; - if (INTEGERP (doc) || CONSP (doc)) + if (FIXNUMP (doc) || CONSP (doc)) { Lisp_Object tem; tem = get_doc_string (doc, 0, 0); @@ -437,9 +437,9 @@ aren't strings. */) documentation_property: tem = Fget (symbol, prop); - if (EQ (tem, make_number (0))) + if (EQ (tem, make_fixnum (0))) tem = Qnil; - if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem)))) + if (FIXNUMP (tem) || (CONSP (tem) && FIXNUMP (XCDR (tem)))) { Lisp_Object doc = tem; tem = get_doc_string (tem, 0, 0); @@ -486,10 +486,10 @@ store_function_docstring (Lisp_Object obj, EMACS_INT offset) || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1))) { tem = Fcdr (Fcdr (fun)); - if (CONSP (tem) && INTEGERP (XCAR (tem))) + if (CONSP (tem) && FIXNUMP (XCAR (tem))) /* FIXME: This modifies typically pure hash-cons'd data, so its correctness is quite delicate. */ - XSETCAR (tem, make_number (offset)); + XSETCAR (tem, make_fixnum (offset)); } } @@ -503,7 +503,7 @@ store_function_docstring (Lisp_Object obj, EMACS_INT offset) /* This bytecode object must have a slot for the docstring, since we've found a docstring for it. */ if (PVSIZE (fun) > COMPILED_DOC_STRING) - ASET (fun, COMPILED_DOC_STRING, make_number (offset)); + ASET (fun, COMPILED_DOC_STRING, make_fixnum (offset)); else { AUTO_STRING (format, "No docstring slot for %s"); @@ -635,7 +635,7 @@ the same file name is found in the `doc-directory'. */) || !NILP (Fmemq (sym, delayed_init))) && strncmp (end, "\nSKIP", 5)) Fput (sym, Qvariable_documentation, - make_number ((pos + end + 1 - buf) + make_fixnum ((pos + end + 1 - buf) * (end[1] == '*' ? -1 : 1))); } @@ -671,7 +671,7 @@ default_to_grave_quoting_style (void) Lisp_Object dv = DISP_CHAR_VECTOR (XCHAR_TABLE (Vstandard_display_table), LEFT_SINGLE_QUOTATION_MARK); return (VECTORP (dv) && ASIZE (dv) == 1 - && EQ (AREF (dv, 0), make_number ('`'))); + && EQ (AREF (dv, 0), make_fixnum ('`'))); } /* Return the current effective text quoting style. */ diff --git a/src/dosfns.c b/src/dosfns.c index f9845a3049..e68c1a7135 100644 --- a/src/dosfns.c +++ b/src/dosfns.c @@ -66,13 +66,13 @@ REGISTERS should be a vector produced by `make-register' and int no; union REGS inregs, outregs; - CHECK_NUMBER (interrupt); + CHECK_FIXNUM (interrupt); no = (unsigned long) XINT (interrupt); CHECK_VECTOR (registers); if (no < 0 || no > 0xff || ASIZE (registers) != 8) return Qnil; for (i = 0; i < 8; i++) - CHECK_NUMBER (AREF (registers, i)); + CHECK_FIXNUM (AREF (registers, i)); inregs.x.ax = (unsigned long) XFASTINT (AREF (registers, 0)); inregs.x.bx = (unsigned long) XFASTINT (AREF (registers, 1)); @@ -85,14 +85,14 @@ REGISTERS should be a vector produced by `make-register' and int86 (no, &inregs, &outregs); - ASET (registers, 0, make_number (outregs.x.ax)); - ASET (registers, 1, make_number (outregs.x.bx)); - ASET (registers, 2, make_number (outregs.x.cx)); - ASET (registers, 3, make_number (outregs.x.dx)); - ASET (registers, 4, make_number (outregs.x.si)); - ASET (registers, 5, make_number (outregs.x.di)); - ASET (registers, 6, make_number (outregs.x.cflag)); - ASET (registers, 7, make_number (outregs.x.flags)); + ASET (registers, 0, make_fixnum (outregs.x.ax)); + ASET (registers, 1, make_fixnum (outregs.x.bx)); + ASET (registers, 2, make_fixnum (outregs.x.cx)); + ASET (registers, 3, make_fixnum (outregs.x.dx)); + ASET (registers, 4, make_fixnum (outregs.x.si)); + ASET (registers, 5, make_fixnum (outregs.x.di)); + ASET (registers, 6, make_fixnum (outregs.x.cflag)); + ASET (registers, 7, make_fixnum (outregs.x.flags)); return registers; } @@ -106,7 +106,7 @@ Return the updated VECTOR. */) int offs, len; char *buf; - CHECK_NUMBER (address); + CHECK_FIXNUM (address); offs = (unsigned long) XINT (address); CHECK_VECTOR (vector); len = ASIZE (vector); @@ -116,7 +116,7 @@ Return the updated VECTOR. */) dosmemget (offs, len, buf); for (i = 0; i < len; i++) - ASET (vector, i, make_number (buf[i])); + ASET (vector, i, make_fixnum (buf[i])); return vector; } @@ -129,7 +129,7 @@ DEFUN ("msdos-memput", Fdos_memput, Sdos_memput, 2, 2, 0, int offs, len; char *buf; - CHECK_NUMBER (address); + CHECK_FIXNUM (address); offs = (unsigned long) XINT (address); CHECK_VECTOR (vector); len = ASIZE (vector); @@ -139,7 +139,7 @@ DEFUN ("msdos-memput", Fdos_memput, Sdos_memput, 2, 2, 0, for (i = 0; i < len; i++) { - CHECK_NUMBER (AREF (vector, i)); + CHECK_FIXNUM (AREF (vector, i)); buf[i] = (unsigned char) XFASTINT (AREF (vector, i)) & 0xFF; } @@ -154,7 +154,7 @@ all keys; otherwise it is only used when the ALT key is pressed. The current keyboard layout is available in dos-keyboard-code. */) (Lisp_Object country_code, Lisp_Object allkeys) { - CHECK_NUMBER (country_code); + CHECK_FIXNUM (country_code); if (!dos_set_keyboard (XINT (country_code), !NILP (allkeys))) return Qnil; return Qt; @@ -280,7 +280,7 @@ init_dosfns (void) regs.x.ax = 0x3000; intdos (®s, ®s); - Vdos_version = Fcons (make_number (regs.h.al), make_number (regs.h.ah)); + Vdos_version = Fcons (make_fixnum (regs.h.al), make_fixnum (regs.h.ah)); /* Obtain the country code via DPMI, use DJGPP transfer buffer. */ dpmiregs.x.ax = 0x3800; @@ -341,7 +341,7 @@ init_dosfns (void) { dos_windows_version = dpmiregs.x.ax; Vdos_windows_version = - Fcons (make_number (dpmiregs.h.al), make_number (dpmiregs.h.ah)); + Fcons (make_fixnum (dpmiregs.h.al), make_fixnum (dpmiregs.h.ah)); /* Save the current title of this virtual machine, so we can restore it before exiting. Otherwise, Windows 95 will continue to use @@ -520,7 +520,7 @@ system_process_attributes (Lisp_Object pid) int proc_id; Lisp_Object attrs = Qnil; - CHECK_NUMBER_OR_FLOAT (pid); + CHECK_FIXNUM_OR_FLOAT (pid); proc_id = FLOATP (pid) ? XFLOAT_DATA (pid) : XINT (pid); if (proc_id == getpid ()) @@ -555,13 +555,13 @@ system_process_attributes (Lisp_Object pid) Vlocale_coding_system, 0); attrs = Fcons (Fcons (Qcomm, decoded_cmd), attrs); /* Pretend we have 0 as PPID. */ - attrs = Fcons (Fcons (Qppid, make_number (0)), attrs); + attrs = Fcons (Fcons (Qppid, make_fixnum (0)), attrs); attrs = Fcons (Fcons (Qpgrp, pid), attrs); attrs = Fcons (Fcons (Qttname, build_string ("/dev/tty")), attrs); /* We are never idle! */ tem = Fget_internal_run_time (); attrs = Fcons (Fcons (Qtime, tem), attrs); - attrs = Fcons (Fcons (Qthcount, make_number (1)), attrs); + attrs = Fcons (Fcons (Qthcount, make_fixnum (1)), attrs); attrs = Fcons (Fcons (Qstart, Fsymbol_value (intern ("before-init-time"))), attrs); diff --git a/src/editfns.c b/src/editfns.c index 4dbf480572..6b54b41cbd 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -158,20 +158,20 @@ tzlookup (Lisp_Object zone, bool settz) if (NILP (zone)) return local_tz; - else if (EQ (zone, Qt) || EQ (zone, make_number (0))) + else if (EQ (zone, Qt) || EQ (zone, make_fixnum (0))) { zone_string = "UTC0"; new_tz = utc_tz; } else { - bool plain_integer = INTEGERP (zone); + bool plain_integer = FIXNUMP (zone); if (EQ (zone, Qwall)) zone_string = 0; else if (STRINGP (zone)) zone_string = SSDATA (ENCODE_SYSTEM (zone)); - else if (plain_integer || (CONSP (zone) && INTEGERP (XCAR (zone)) + else if (plain_integer || (CONSP (zone) && FIXNUMP (XCAR (zone)) && CONSP (XCDR (zone)))) { Lisp_Object abbr; @@ -370,7 +370,7 @@ DEFUN ("byte-to-string", Fbyte_to_string, Sbyte_to_string, 1, 1, 0, (Lisp_Object byte) { unsigned char b; - CHECK_NUMBER (byte); + CHECK_FIXNUM (byte); if (XINT (byte) < 0 || XINT (byte) > 255) error ("Invalid byte"); b = XINT (byte); @@ -421,7 +421,7 @@ The return value is POSITION. */) { if (MARKERP (position)) set_point_from_marker (position); - else if (INTEGERP (position)) + else if (FIXNUMP (position)) SET_PT (clip_to_bounds (BEGV, XINT (position), ZV)); else wrong_type_argument (Qinteger_or_marker_p, position); @@ -448,7 +448,7 @@ region_limit (bool beginningp) error ("The mark is not set now, so there is no region"); /* Clip to the current narrowing (bug#11770). */ - return make_number ((PT < XFASTINT (m)) == beginningp + return make_fixnum ((PT < XFASTINT (m)) == beginningp ? PT : clip_to_bounds (BEGV, XFASTINT (m), ZV)); } @@ -539,7 +539,7 @@ i.e. the property that a char would inherit if it were inserted at POSITION. */) (Lisp_Object position, register Lisp_Object prop, Lisp_Object object) { - CHECK_NUMBER_COERCE_MARKER (position); + CHECK_FIXNUM_COERCE_MARKER (position); if (NILP (object)) XSETBUFFER (object, current_buffer); @@ -607,7 +607,7 @@ at POSITION. */) return Fget_text_property (position, prop, object); else if (stickiness < 0 && XINT (position) > BUF_BEGV (XBUFFER (object))) - return Fget_text_property (make_number (XINT (position) - 1), + return Fget_text_property (make_fixnum (XINT (position) - 1), prop, object); else return Qnil; @@ -650,13 +650,13 @@ find_field (Lisp_Object pos, Lisp_Object merge_at_boundary, if (NILP (pos)) XSETFASTINT (pos, PT); else - CHECK_NUMBER_COERCE_MARKER (pos); + CHECK_FIXNUM_COERCE_MARKER (pos); after_field = get_char_property_and_overlay (pos, Qfield, Qnil, NULL); before_field = (XFASTINT (pos) > BEGV - ? get_char_property_and_overlay (make_number (XINT (pos) - 1), + ? get_char_property_and_overlay (make_fixnum (XINT (pos) - 1), Qfield, Qnil, NULL) /* Using nil here would be a more obvious choice, but it would fail when the buffer starts with a non-sticky field. */ @@ -795,7 +795,7 @@ is before LIMIT, then LIMIT will be returned instead. */) { ptrdiff_t beg; find_field (pos, escape_from_edge, limit, &beg, Qnil, 0); - return make_number (beg); + return make_fixnum (beg); } DEFUN ("field-end", Ffield_end, Sfield_end, 0, 3, 0, @@ -810,7 +810,7 @@ is after LIMIT, then LIMIT will be returned instead. */) { ptrdiff_t end; find_field (pos, escape_from_edge, Qnil, 0, limit, &end); - return make_number (end); + return make_fixnum (end); } DEFUN ("constrain-to-field", Fconstrain_to_field, Sconstrain_to_field, 2, 5, 0, @@ -856,13 +856,13 @@ Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil. */) XSETFASTINT (new_pos, PT); } - CHECK_NUMBER_COERCE_MARKER (new_pos); - CHECK_NUMBER_COERCE_MARKER (old_pos); + CHECK_FIXNUM_COERCE_MARKER (new_pos); + CHECK_FIXNUM_COERCE_MARKER (old_pos); fwd = (XINT (new_pos) > XINT (old_pos)); - prev_old = make_number (XINT (old_pos) - 1); - prev_new = make_number (XINT (new_pos) - 1); + prev_old = make_fixnum (XINT (old_pos) - 1); + prev_new = make_fixnum (XINT (new_pos) - 1); if (NILP (Vinhibit_field_text_motion) && !EQ (new_pos, old_pos) @@ -950,12 +950,12 @@ This function does not move point. */) if (NILP (n)) XSETFASTINT (n, 1); else - CHECK_NUMBER (n); + CHECK_FIXNUM (n); scan_newline_from_point (XINT (n) - 1, &charpos, &bytepos); /* Return END constrained to the current input field. */ - return Fconstrain_to_field (make_number (charpos), make_number (PT), + return Fconstrain_to_field (make_fixnum (charpos), make_fixnum (PT), XINT (n) != 1 ? Qt : Qnil, Qt, Qnil); } @@ -985,14 +985,14 @@ This function does not move point. */) if (NILP (n)) XSETFASTINT (n, 1); else - CHECK_NUMBER (n); + CHECK_FIXNUM (n); clipped_n = clip_to_bounds (PTRDIFF_MIN + 1, XINT (n), PTRDIFF_MAX); end_pos = find_before_next_newline (orig, 0, clipped_n - (clipped_n <= 0), NULL); /* Return END_POS constrained to the current input field. */ - return Fconstrain_to_field (make_number (end_pos), make_number (orig), + return Fconstrain_to_field (make_fixnum (end_pos), make_fixnum (orig), Qnil, Qt, Qnil); } @@ -1034,7 +1034,7 @@ save_excursion_restore (Lisp_Object marker, Lisp_Object window) /* Set window point if WINDOW is live and shows the current buffer. */ Lisp_Object contents = XWINDOW (window)->contents; if (BUFFERP (contents) && XBUFFER (contents) == current_buffer) - Fset_window_point (window, make_number (PT)); + Fset_window_point (window, make_fixnum (PT)); } } @@ -1088,11 +1088,11 @@ in some other BUFFER, use (Lisp_Object buffer) { if (NILP (buffer)) - return make_number (Z - BEG); + return make_fixnum (Z - BEG); else { CHECK_BUFFER (buffer); - return make_number (BUF_Z (XBUFFER (buffer)) + return make_fixnum (BUF_Z (XBUFFER (buffer)) - BUF_BEG (XBUFFER (buffer))); } } @@ -1160,10 +1160,10 @@ DEFUN ("position-bytes", Fposition_bytes, Sposition_bytes, 1, 1, 0, If POSITION is out of range, the value is nil. */) (Lisp_Object position) { - CHECK_NUMBER_COERCE_MARKER (position); + CHECK_FIXNUM_COERCE_MARKER (position); if (XINT (position) < BEG || XINT (position) > Z) return Qnil; - return make_number (CHAR_TO_BYTE (XINT (position))); + return make_fixnum (CHAR_TO_BYTE (XINT (position))); } DEFUN ("byte-to-position", Fbyte_to_position, Sbyte_to_position, 1, 1, 0, @@ -1173,7 +1173,7 @@ If BYTEPOS is out of range, the value is nil. */) { ptrdiff_t pos_byte; - CHECK_NUMBER (bytepos); + CHECK_FIXNUM (bytepos); pos_byte = XINT (bytepos); if (pos_byte < BEG_BYTE || pos_byte > Z_BYTE) return Qnil; @@ -1184,7 +1184,7 @@ If BYTEPOS is out of range, the value is nil. */) character. */ while (!CHAR_HEAD_P (FETCH_BYTE (pos_byte))) pos_byte--; - return make_number (BYTE_TO_CHAR (pos_byte)); + return make_fixnum (BYTE_TO_CHAR (pos_byte)); } DEFUN ("following-char", Ffollowing_char, Sfollowing_char, 0, 0, 0, @@ -1280,14 +1280,14 @@ If POS is out of range, the value is nil. */) } else { - CHECK_NUMBER_COERCE_MARKER (pos); + CHECK_FIXNUM_COERCE_MARKER (pos); if (XINT (pos) < BEGV || XINT (pos) >= ZV) return Qnil; pos_byte = CHAR_TO_BYTE (XINT (pos)); } - return make_number (FETCH_CHAR (pos_byte)); + return make_fixnum (FETCH_CHAR (pos_byte)); } DEFUN ("char-before", Fchar_before, Schar_before, 0, 1, 0, @@ -1314,7 +1314,7 @@ If POS is out of range, the value is nil. */) } else { - CHECK_NUMBER_COERCE_MARKER (pos); + CHECK_FIXNUM_COERCE_MARKER (pos); if (XINT (pos) <= BEGV || XINT (pos) > ZV) return Qnil; @@ -1432,7 +1432,7 @@ name, or nil if there is no such user. */) if (NILP (uid)) return Vuser_full_name; - else if (NUMBERP (uid)) + else if (FIXED_OR_FLOATP (uid)) { uid_t u; CONS_TO_INTEGER (uid, uid_t, u); @@ -1463,7 +1463,7 @@ name, or nil if there is no such user. */) /* Substitute the login name for the &, upcasing the first character. */ if (q) { - Lisp_Object login = Fuser_login_name (make_number (pw->pw_uid)); + Lisp_Object login = Fuser_login_name (make_fixnum (pw->pw_uid)); USE_SAFE_ALLOCA; char *r = SAFE_ALLOCA (strlen (p) + SBYTES (login) + 1); memcpy (r, p, q - p); @@ -1605,14 +1605,14 @@ time_arith (Lisp_Object a, Lisp_Object b, switch (max (alen, blen)) { default: - val = Fcons (make_number (t.ps), val); + val = Fcons (make_fixnum (t.ps), val); FALLTHROUGH; case 3: - val = Fcons (make_number (t.us), val); + val = Fcons (make_fixnum (t.us), val); FALLTHROUGH; case 2: - val = Fcons (make_number (t.lo), val); - val = Fcons (make_number (t.hi), val); + val = Fcons (make_fixnum (t.lo), val); + val = Fcons (make_fixnum (t.hi), val); break; } @@ -1714,10 +1714,10 @@ disassemble_lisp_time (Lisp_Object specified_time, Lisp_Object *phigh, Lisp_Object *plow, Lisp_Object *pusec, Lisp_Object *ppsec) { - Lisp_Object high = make_number (0); + Lisp_Object high = make_fixnum (0); Lisp_Object low = specified_time; - Lisp_Object usec = make_number (0); - Lisp_Object psec = make_number (0); + Lisp_Object usec = make_fixnum (0); + Lisp_Object psec = make_fixnum (0); int len = 4; if (CONSP (specified_time)) @@ -1750,10 +1750,10 @@ disassemble_lisp_time (Lisp_Object specified_time, Lisp_Object *phigh, /* When combining components, require LOW to be an integer, as otherwise it would be a pain to add up times. */ - if (! INTEGERP (low)) + if (! FIXNUMP (low)) return 0; } - else if (INTEGERP (specified_time)) + else if (FIXNUMP (specified_time)) len = 2; *phigh = high; @@ -1815,10 +1815,10 @@ decode_time_components (Lisp_Object high, Lisp_Object low, Lisp_Object usec, struct lisp_time *result, double *dresult) { EMACS_INT hi, lo, us, ps; - if (! (INTEGERP (high) - && INTEGERP (usec) && INTEGERP (psec))) + if (! (FIXNUMP (high) + && FIXNUMP (usec) && FIXNUMP (psec))) return 0; - if (! INTEGERP (low)) + if (! FIXNUMP (low)) { if (FLOATP (low)) { @@ -1933,8 +1933,8 @@ lisp_seconds_argument (Lisp_Object specified_time) int val = disassemble_lisp_time (specified_time, &high, &low, &usec, &psec); if (val != 0) { - val = decode_time_components (high, low, make_number (0), - make_number (0), &t, 0); + val = decode_time_components (high, low, make_fixnum (0), + make_fixnum (0), &t, 0); if (0 < val && ! ((TYPE_SIGNED (time_t) ? TIME_T_MIN >> LO_TIME_BITS <= t.hi @@ -2186,18 +2186,18 @@ usage: (decode-time &optional TIME ZONE) */) EMACS_INT tm_year_base = TM_YEAR_BASE; return CALLN (Flist, - make_number (local_tm.tm_sec), - make_number (local_tm.tm_min), - make_number (local_tm.tm_hour), - make_number (local_tm.tm_mday), - make_number (local_tm.tm_mon + 1), - make_number (local_tm.tm_year + tm_year_base), - make_number (local_tm.tm_wday), + make_fixnum (local_tm.tm_sec), + make_fixnum (local_tm.tm_min), + make_fixnum (local_tm.tm_hour), + make_fixnum (local_tm.tm_mday), + make_fixnum (local_tm.tm_mon + 1), + make_fixnum (local_tm.tm_year + tm_year_base), + make_fixnum (local_tm.tm_wday), local_tm.tm_isdst ? Qt : Qnil, (HAVE_TM_GMTOFF - ? make_number (tm_gmtoff (&local_tm)) + ? make_fixnum (tm_gmtoff (&local_tm)) : gmtime_r (&time_spec, &gmt_tm) - ? make_number (tm_diff (&local_tm, &gmt_tm)) + ? make_fixnum (tm_diff (&local_tm, &gmt_tm)) : Qnil)); } @@ -2206,7 +2206,7 @@ usage: (decode-time &optional TIME ZONE) */) static int check_tm_member (Lisp_Object obj, int offset) { - CHECK_NUMBER (obj); + CHECK_FIXNUM (obj); EMACS_INT n = XINT (obj); int result; if (INT_SUBTRACT_WRAPV (n, offset, &result)) @@ -2389,7 +2389,7 @@ the data it can't find. */) long int offset = (HAVE_TM_GMTOFF ? tm_gmtoff (&local_tm) : tm_diff (&local_tm, &gmt_tm)); - zone_offset = make_number (offset); + zone_offset = make_fixnum (offset); if (SCHARS (zone_name) == 0) { /* No local time zone name is available; use numeric zone instead. */ @@ -2688,7 +2688,7 @@ called interactively, INHERIT is t. */) CHECK_CHARACTER (character); if (NILP (count)) XSETFASTINT (count, 1); - CHECK_NUMBER (count); + CHECK_FIXNUM (count); c = XFASTINT (character); if (!NILP (BVAR (current_buffer, enable_multibyte_characters))) @@ -2732,9 +2732,9 @@ The optional third arg INHERIT, if non-nil, says to inherit text properties from adjoining text, if those properties are sticky. */) (Lisp_Object byte, Lisp_Object count, Lisp_Object inherit) { - CHECK_NUMBER (byte); + CHECK_FIXNUM (byte); if (XINT (byte) < 0 || XINT (byte) > 255) - args_out_of_range_3 (byte, make_number (0), make_number (255)); + args_out_of_range_3 (byte, make_fixnum (0), make_fixnum (255)); if (XINT (byte) >= 128 && ! NILP (BVAR (current_buffer, enable_multibyte_characters))) XSETFASTINT (byte, BYTE8_TO_CHAR (XINT (byte))); @@ -2820,8 +2820,8 @@ make_buffer_string_both (ptrdiff_t start, ptrdiff_t start_byte, { update_buffer_properties (start, end); - tem = Fnext_property_change (make_number (start), Qnil, make_number (end)); - tem1 = Ftext_properties_at (make_number (start), Qnil); + tem = Fnext_property_change (make_fixnum (start), Qnil, make_fixnum (end)); + tem1 = Ftext_properties_at (make_fixnum (start), Qnil); if (XINT (tem) != end || !NILP (tem1)) copy_intervals_to_string (result, current_buffer, start, @@ -2846,7 +2846,7 @@ update_buffer_properties (ptrdiff_t start, ptrdiff_t end) if (!NILP (Vbuffer_access_fontified_property)) { Lisp_Object tem - = Ftext_property_any (make_number (start), make_number (end), + = Ftext_property_any (make_fixnum (start), make_fixnum (end), Vbuffer_access_fontified_property, Qnil, Qnil); if (NILP (tem)) @@ -2854,7 +2854,7 @@ update_buffer_properties (ptrdiff_t start, ptrdiff_t end) } CALLN (Frun_hook_with_args, Qbuffer_access_fontify_functions, - make_number (start), make_number (end)); + make_fixnum (start), make_fixnum (end)); } } @@ -2934,14 +2934,14 @@ using `string-make-multibyte' or `string-make-unibyte', which see. */) b = BUF_BEGV (bp); else { - CHECK_NUMBER_COERCE_MARKER (start); + CHECK_FIXNUM_COERCE_MARKER (start); b = XINT (start); } if (NILP (end)) e = BUF_ZV (bp); else { - CHECK_NUMBER_COERCE_MARKER (end); + CHECK_FIXNUM_COERCE_MARKER (end); e = XINT (end); } @@ -3002,14 +3002,14 @@ determines whether case is significant or ignored. */) begp1 = BUF_BEGV (bp1); else { - CHECK_NUMBER_COERCE_MARKER (start1); + CHECK_FIXNUM_COERCE_MARKER (start1); begp1 = XINT (start1); } if (NILP (end1)) endp1 = BUF_ZV (bp1); else { - CHECK_NUMBER_COERCE_MARKER (end1); + CHECK_FIXNUM_COERCE_MARKER (end1); endp1 = XINT (end1); } @@ -3040,14 +3040,14 @@ determines whether case is significant or ignored. */) begp2 = BUF_BEGV (bp2); else { - CHECK_NUMBER_COERCE_MARKER (start2); + CHECK_FIXNUM_COERCE_MARKER (start2); begp2 = XINT (start2); } if (NILP (end2)) endp2 = BUF_ZV (bp2); else { - CHECK_NUMBER_COERCE_MARKER (end2); + CHECK_FIXNUM_COERCE_MARKER (end2); endp2 = XINT (end2); } @@ -3103,7 +3103,7 @@ determines whether case is significant or ignored. */) } if (c1 != c2) - return make_number (c1 < c2 ? -1 - chars : chars + 1); + return make_fixnum (c1 < c2 ? -1 - chars : chars + 1); chars++; rarely_quit (chars); @@ -3112,12 +3112,12 @@ determines whether case is significant or ignored. */) /* The strings match as far as they go. If one is shorter, that one is less. */ if (chars < endp1 - begp1) - return make_number (chars + 1); + return make_fixnum (chars + 1); else if (chars < endp2 - begp2) - return make_number (- chars - 1); + return make_fixnum (- chars - 1); /* Same length too => they are equal. */ - return make_number (0); + return make_fixnum (0); } @@ -3310,8 +3310,8 @@ differences between the two buffers. */) if (beg_b < end_b) { SET_PT (beg_a); - Finsert_buffer_substring (source, make_natnum (beg_b), - make_natnum (end_b)); + Finsert_buffer_substring (source, make_fixed_natnum (beg_b), + make_fixed_natnum (end_b)); } } --i; @@ -3803,7 +3803,7 @@ It returns the number of characters changed. */) } else { - string = Fmake_string (make_number (1), val, Qnil); + string = Fmake_string (make_fixnum (1), val, Qnil); } replace_range (pos, pos + len, string, 1, 0, 1, 0); pos_byte += SBYTES (string); @@ -3817,7 +3817,7 @@ It returns the number of characters changed. */) pos++; } - return make_number (cnt); + return make_fixnum (cnt); } DEFUN ("delete-region", Fdelete_region, Sdelete_region, 2, 2, "r", @@ -3868,8 +3868,8 @@ When calling from a program, pass two arguments; positions (integers or markers) bounding the text that should remain visible. */) (register Lisp_Object start, Lisp_Object end) { - CHECK_NUMBER_COERCE_MARKER (start); - CHECK_NUMBER_COERCE_MARKER (end); + CHECK_FIXNUM_COERCE_MARKER (start); + CHECK_FIXNUM_COERCE_MARKER (end); if (XINT (start) > XINT (end)) { @@ -4134,8 +4134,8 @@ usage: (propertize STRING &rest PROPERTIES) */) for (i = 1; i < nargs; i += 2) properties = Fcons (args[i], Fcons (args[i + 1], properties)); - Fadd_text_properties (make_number (0), - make_number (SCHARS (string)), + Fadd_text_properties (make_fixnum (0), + make_fixnum (SCHARS (string)), properties, string); return string; } @@ -4475,7 +4475,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) } else if (conversion == 'c') { - if (INTEGERP (arg) && ! ASCII_CHAR_P (XINT (arg))) + if (FIXNUMP (arg) && ! ASCII_CHAR_P (XINT (arg))) { if (!multibyte) { @@ -4600,7 +4600,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) || conversion == 'X')) error ("Invalid format operation %%%c", STRING_CHAR ((unsigned char *) format - 1)); - else if (! (INTEGERP (arg) || (FLOATP (arg) && conversion != 'c'))) + else if (! (FIXNUMP (arg) || (FLOATP (arg) && conversion != 'c'))) error ("Format specifier doesn't match argument type"); else { @@ -4661,7 +4661,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) if (INT_AS_LDBL) { *f = 'L'; - f += INTEGERP (arg); + f += FIXNUMP (arg); } } else if (conversion != 'c') @@ -4692,7 +4692,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) ptrdiff_t sprintf_bytes; if (float_conversion) { - if (INT_AS_LDBL && INTEGERP (arg)) + if (INT_AS_LDBL && FIXNUMP (arg)) { /* Although long double may have a rounding error if DIG_BITS_LBOUND * LDBL_MANT_DIG < FIXNUM_BITS - 1, @@ -4713,7 +4713,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) } else if (conversion == 'd' || conversion == 'i') { - if (INTEGERP (arg)) + if (FIXNUMP (arg)) { printmax_t x = XINT (arg); sprintf_bytes = sprintf (sprintf_buf, convspec, prec, x); @@ -4738,7 +4738,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) { /* Don't sign-extend for octal or hex printing. */ uprintmax_t x; - if (INTEGERP (arg)) + if (FIXNUMP (arg)) x = XUINT (arg); else { @@ -4971,8 +4971,8 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) if (string_intervals (args[0]) || arg_intervals) { /* Add text properties from the format string. */ - Lisp_Object len = make_number (SCHARS (args[0])); - Lisp_Object props = text_property_list (args[0], make_number (0), + Lisp_Object len = make_fixnum (SCHARS (args[0])); + Lisp_Object props = text_property_list (args[0], make_fixnum (0), len, Qnil); if (CONSP (props)) { @@ -5015,7 +5015,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) } } - XSETCAR (item, make_number (translated)); + XSETCAR (item, make_fixnum (translated)); /* Likewise adjust the property end position. */ pos = XINT (XCAR (XCDR (item))); @@ -5035,10 +5035,10 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) } } - XSETCAR (XCDR (item), make_number (translated)); + XSETCAR (XCDR (item), make_fixnum (translated)); } - add_text_properties_from_list (val, props, make_number (0)); + add_text_properties_from_list (val, props, make_fixnum (0)); } /* Add text properties from arguments. */ @@ -5046,17 +5046,17 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) for (ptrdiff_t i = 0; i < nspec; i++) if (info[i].intervals) { - len = make_number (SCHARS (info[i].argument)); - Lisp_Object new_len = make_number (info[i].end - info[i].start); + len = make_fixnum (SCHARS (info[i].argument)); + Lisp_Object new_len = make_fixnum (info[i].end - info[i].start); props = text_property_list (info[i].argument, - make_number (0), len, Qnil); + make_fixnum (0), len, Qnil); props = extend_property_ranges (props, len, new_len); /* If successive arguments have properties, be sure that the value of `composition' property be the copy. */ if (1 < i && info[i - 1].end) make_composition_value_copy (props); add_text_properties_from_list (val, props, - make_number (info[i].start)); + make_fixnum (info[i].start)); } } diff --git a/src/emacs-module.c b/src/emacs-module.c index 5b9f6629e7..e781c38f46 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -305,12 +305,12 @@ module_make_global_ref (emacs_env *env, emacs_value ref) EMACS_INT refcount = XFASTINT (value) + 1; if (MOST_POSITIVE_FIXNUM < refcount) xsignal0 (Qoverflow_error); - value = make_natnum (refcount); + value = make_fixed_natnum (refcount); set_hash_value_slot (h, i, value); } else { - hash_put (h, new_obj, make_natnum (1), hashcode); + hash_put (h, new_obj, make_fixed_natnum (1), hashcode); } return lisp_to_value (module_assertions ? global_env : env, new_obj); @@ -331,7 +331,7 @@ module_free_global_ref (emacs_env *env, emacs_value ref) { EMACS_INT refcount = XFASTINT (HASH_VALUE (h, i)) - 1; if (refcount > 0) - set_hash_value_slot (h, i, make_natnum (refcount)); + set_hash_value_slot (h, i, make_fixed_natnum (refcount)); else { eassert (refcount == 0); @@ -441,7 +441,7 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity, ? (min_arity <= MOST_POSITIVE_FIXNUM && max_arity == emacs_variadic_function) : min_arity <= max_arity && max_arity <= MOST_POSITIVE_FIXNUM))) - xsignal2 (Qinvalid_arity, make_number (min_arity), make_number (max_arity)); + xsignal2 (Qinvalid_arity, make_fixnum (min_arity), make_fixnum (max_arity)); struct Lisp_Module_Function *function = allocate_module_function (); function->min_arity = min_arity; @@ -518,7 +518,7 @@ module_extract_integer (emacs_env *env, emacs_value n) { MODULE_FUNCTION_BEGIN (0); Lisp_Object l = value_to_lisp (n); - CHECK_NUMBER (l); + CHECK_FIXNUM (l); return XINT (l); } @@ -528,7 +528,7 @@ module_make_integer (emacs_env *env, intmax_t n) MODULE_FUNCTION_BEGIN (module_nil); if (FIXNUM_OVERFLOW_P (n)) xsignal0 (Qoverflow_error); - return lisp_to_value (env, make_number (n)); + return lisp_to_value (env, make_fixnum (n)); } static double @@ -640,7 +640,7 @@ check_vec_index (Lisp_Object lvec, ptrdiff_t i) CHECK_VECTOR (lvec); if (! (0 <= i && i < ASIZE (lvec))) args_out_of_range_3 (make_fixnum_or_float (i), - make_number (0), make_number (ASIZE (lvec) - 1)); + make_fixnum (0), make_fixnum (ASIZE (lvec) - 1)); } static void @@ -749,7 +749,7 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0, { if (FIXNUM_OVERFLOW_P (r)) xsignal0 (Qoverflow_error); - xsignal2 (Qmodule_init_failed, file, make_number (r)); + xsignal2 (Qmodule_init_failed, file, make_fixnum (r)); } module_signal_or_throw (&env_priv); @@ -763,7 +763,7 @@ funcall_module (Lisp_Object function, ptrdiff_t nargs, Lisp_Object *arglist) eassume (0 <= func->min_arity); if (! (func->min_arity <= nargs && (func->max_arity < 0 || nargs <= func->max_arity))) - xsignal2 (Qwrong_number_of_arguments, function, make_number (nargs)); + xsignal2 (Qwrong_number_of_arguments, function, make_fixnum (nargs)); emacs_env pub; struct emacs_env_private priv; @@ -802,8 +802,8 @@ module_function_arity (const struct Lisp_Module_Function *const function) { ptrdiff_t minargs = function->min_arity; ptrdiff_t maxargs = function->max_arity; - return Fcons (make_number (minargs), - maxargs == MANY ? Qmany : make_number (maxargs)); + return Fcons (make_fixnum (minargs), + maxargs == MANY ? Qmany : make_fixnum (maxargs)); } @@ -991,7 +991,7 @@ lisp_to_value_bits (Lisp_Object o) /* Compress O into the space of a pointer, possibly losing information. */ EMACS_UINT u = XLI (o); - if (INTEGERP (o)) + if (FIXNUMP (o)) { uintptr_t i = (u << VALBITS) + XTYPE (o); return (emacs_value) i; diff --git a/src/emacs.c b/src/emacs.c index 861d70735c..2c1311b846 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -377,7 +377,7 @@ terminate_due_to_signal (int sig, int backtrace_limit) totally_unblock_input (); if (sig == SIGTERM || sig == SIGHUP || sig == SIGINT) - Fkill_emacs (make_number (sig)); + Fkill_emacs (make_fixnum (sig)); shut_down_emacs (sig, Qnil); emacs_backtrace (backtrace_limit); @@ -446,7 +446,7 @@ init_cmdargs (int argc, char **argv, int skip_args, char *original_pwd) { Lisp_Object found; int yes = openp (Vexec_path, Vinvocation_name, - Vexec_suffixes, &found, make_number (X_OK), false); + Vexec_suffixes, &found, make_fixnum (X_OK), false); if (yes == 1) { /* Add /: to the front of the name @@ -2048,7 +2048,7 @@ all of which are called before Emacs is actually killed. */ unlink (SSDATA (listfile)); } - if (INTEGERP (arg)) + if (FIXNUMP (arg)) exit_code = (XINT (arg) < 0 ? XINT (arg) | INT_MIN : XINT (arg) & INT_MAX); @@ -2412,7 +2412,7 @@ decode_env_path (const char *evarname, const char *defalt, bool empty) && strncmp (path, emacs_dir_env, emacs_dir_len) == 0) element = Fexpand_file_name (Fsubstring (element, - make_number (emacs_dir_len), + make_fixnum (emacs_dir_len), Qnil), build_unibyte_string (emacs_dir)); #endif diff --git a/src/eval.c b/src/eval.c index 256ca8ffdc..800d7f2afb 100644 --- a/src/eval.c +++ b/src/eval.c @@ -303,8 +303,8 @@ call_debugger (Lisp_Object arg) /* Restore limits after leaving the debugger. */ record_unwind_protect (restore_stack_limits, - Fcons (make_number (old_max), - make_number (old_depth))); + Fcons (make_fixnum (old_max), + make_fixnum (old_depth))); #ifdef HAVE_WINDOW_SYSTEM if (display_hourglass_p) @@ -511,7 +511,7 @@ usage: (setq [SYM VAL]...) */) Lisp_Object sym = XCAR (tail), lex_binding; tail = XCDR (tail); if (!CONSP (tail)) - xsignal2 (Qwrong_number_of_arguments, Qsetq, make_number (nargs + 1)); + xsignal2 (Qwrong_number_of_arguments, Qsetq, make_fixnum (nargs + 1)); Lisp_Object arg = XCAR (tail); tail = XCDR (tail); val = eval_sub (arg); @@ -2007,12 +2007,12 @@ this does nothing and returns nil. */) && !AUTOLOADP (XSYMBOL (function)->u.s.function)) return Qnil; - if (!NILP (Vpurify_flag) && EQ (docstring, make_number (0))) + if (!NILP (Vpurify_flag) && EQ (docstring, make_fixnum (0))) /* `read1' in lread.c has found the docstring starting with "\ and assumed the docstring will be provided by Snarf-documentation, so it passed us 0 instead. But that leads to accidental sharing in purecopy's hash-consing, so we use a (hopefully) unique integer instead. */ - docstring = make_number (XHASH (function)); + docstring = make_fixnum (XHASH (function)); return Fdefalias (function, list5 (Qautoload, file, docstring, interactive, type), Qnil); @@ -2032,7 +2032,7 @@ un_autoload (Lisp_Object oldqueue) first = XCAR (queue); second = Fcdr (first); first = Fcar (first); - if (EQ (first, make_number (0))) + if (EQ (first, make_fixnum (0))) Vfeatures = second; else Ffset (first, second); @@ -2057,7 +2057,7 @@ it defines a macro. */) if (!CONSP (fundef) || !EQ (Qautoload, XCAR (fundef))) return fundef; - Lisp_Object kind = Fnth (make_number (4), fundef); + Lisp_Object kind = Fnth (make_fixnum (4), fundef); if (EQ (macro_only, Qmacro) && !(EQ (kind, Qt) || EQ (kind, Qmacro))) return fundef; @@ -2879,7 +2879,7 @@ funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *args) { Lisp_Object fun; XSETSUBR (fun, subr); - xsignal2 (Qwrong_number_of_arguments, fun, make_number (numargs)); + xsignal2 (Qwrong_number_of_arguments, fun, make_fixnum (numargs)); } else if (subr->max_args == UNEVALLED) @@ -3022,7 +3022,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, if (size <= COMPILED_STACK_DEPTH) xsignal1 (Qinvalid_function, fun); syms_left = AREF (fun, COMPILED_ARGLIST); - if (INTEGERP (syms_left)) + if (FIXNUMP (syms_left)) /* A byte-code object with an integer args template means we shouldn't bind any arguments, instead just call the byte-code interpreter directly; it will push arguments as necessary. @@ -3083,7 +3083,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, else if (i < nargs) arg = arg_vector[i++]; else if (!optional) - xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs)); + xsignal2 (Qwrong_number_of_arguments, fun, make_fixnum (nargs)); else arg = Qnil; @@ -3100,7 +3100,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, if (!NILP (syms_left)) xsignal1 (Qinvalid_function, fun); else if (i < nargs) - xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs)); + xsignal2 (Qwrong_number_of_arguments, fun, make_fixnum (nargs)); if (!EQ (lexenv, Vinternal_interpreter_environment)) /* Instantiate a new lexical environment. */ @@ -3207,7 +3207,7 @@ lambda_arity (Lisp_Object fun) if (size <= COMPILED_STACK_DEPTH) xsignal1 (Qinvalid_function, fun); syms_left = AREF (fun, COMPILED_ARGLIST); - if (INTEGERP (syms_left)) + if (FIXNUMP (syms_left)) return get_byte_code_arity (syms_left); } else @@ -3222,7 +3222,7 @@ lambda_arity (Lisp_Object fun) xsignal1 (Qinvalid_function, fun); if (EQ (next, Qand_rest)) - return Fcons (make_number (minargs), Qmany); + return Fcons (make_fixnum (minargs), Qmany); else if (EQ (next, Qand_optional)) optional = true; else @@ -3236,7 +3236,7 @@ lambda_arity (Lisp_Object fun) if (!NILP (syms_left)) xsignal1 (Qinvalid_function, fun); - return Fcons (make_number (minargs), make_number (maxargs)); + return Fcons (make_fixnum (minargs), make_fixnum (maxargs)); } DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode, @@ -3663,7 +3663,7 @@ get_backtrace_frame (Lisp_Object nframes, Lisp_Object base) { register EMACS_INT i; - CHECK_NATNUM (nframes); + CHECK_FIXNAT (nframes); union specbinding *pdl = get_backtrace_starting_at (base); /* Find the frame requested. */ @@ -3697,7 +3697,7 @@ DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0, The debugger is entered when that frame exits, if the flag is non-nil. */) (Lisp_Object level, Lisp_Object flag) { - CHECK_NUMBER (level); + CHECK_FIXNUM (level); union specbinding *pdl = get_backtrace_frame(level, Qnil); if (backtrace_p (pdl)) @@ -3868,7 +3868,7 @@ NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'. { union specbinding *frame = get_backtrace_frame (nframes, base); union specbinding *prevframe - = get_backtrace_frame (make_number (XFASTINT (nframes) - 1), base); + = get_backtrace_frame (make_fixnum (XFASTINT (nframes) - 1), base); ptrdiff_t distance = specpdl_ptr - frame; Lisp_Object result = Qnil; eassert (distance >= 0); diff --git a/src/fileio.c b/src/fileio.c index 5a1c7ae10e..b8809853e0 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -683,7 +683,7 @@ This function does not grok magic file names. */) memset (data + prefix_len, 'X', nX); memcpy (data + prefix_len + nX, SSDATA (encoded_suffix), suffix_len); int kind = (NILP (dir_flag) ? GT_FILE - : EQ (dir_flag, make_number (0)) ? GT_NOCREATE + : EQ (dir_flag, make_fixnum (0)) ? GT_NOCREATE : GT_DIR); int fd = gen_tempname (data, suffix_len, O_BINARY | O_CLOEXEC, kind); bool failed = fd < 0; @@ -724,7 +724,7 @@ later creating the file, which opens all kinds of security holes. For that reason, you should normally use `make-temp-file' instead. */) (Lisp_Object prefix) { - return Fmake_temp_file_internal (prefix, make_number (0), + return Fmake_temp_file_internal (prefix, make_fixnum (0), empty_unibyte_string, Qnil); } @@ -1937,9 +1937,9 @@ permissions. */) #ifdef WINDOWSNT if (NILP (ok_if_already_exists) - || INTEGERP (ok_if_already_exists)) + || FIXNUMP (ok_if_already_exists)) barf_or_query_if_file_exists (newname, false, "copy to it", - INTEGERP (ok_if_already_exists), false); + FIXNUMP (ok_if_already_exists), false); result = w32_copy_file (SSDATA (encoded_file), SSDATA (encoded_newname), !NILP (keep_time), !NILP (preserve_uid_gid), @@ -1994,9 +1994,9 @@ permissions. */) new_mask); if (ofd < 0 && errno == EEXIST) { - if (NILP (ok_if_already_exists) || INTEGERP (ok_if_already_exists)) + if (NILP (ok_if_already_exists) || FIXNUMP (ok_if_already_exists)) barf_or_query_if_file_exists (newname, true, "copy to it", - INTEGERP (ok_if_already_exists), false); + FIXNUMP (ok_if_already_exists), false); already_exists = true; ofd = emacs_open (SSDATA (encoded_newname), O_WRONLY, 0); } @@ -2342,7 +2342,7 @@ This is what happens in interactive use with M-x. */) bool plain_rename = (case_only_rename || (!NILP (ok_if_already_exists) - && !INTEGERP (ok_if_already_exists))); + && !FIXNUMP (ok_if_already_exists))); int rename_errno UNINIT; if (!plain_rename) { @@ -2360,7 +2360,7 @@ This is what happens in interactive use with M-x. */) #endif barf_or_query_if_file_exists (newname, rename_errno == EEXIST, "rename to it", - INTEGERP (ok_if_already_exists), + FIXNUMP (ok_if_already_exists), false); plain_rename = true; break; @@ -2453,9 +2453,9 @@ This is what happens in interactive use with M-x. */) if (errno == EEXIST) { if (NILP (ok_if_already_exists) - || INTEGERP (ok_if_already_exists)) + || FIXNUMP (ok_if_already_exists)) barf_or_query_if_file_exists (newname, true, "make it a new name", - INTEGERP (ok_if_already_exists), false); + FIXNUMP (ok_if_already_exists), false); unlink (SSDATA (newname)); if (link (SSDATA (encoded_file), SSDATA (encoded_newname)) == 0) return Qnil; @@ -2481,12 +2481,12 @@ This happens for interactive use with M-x. */) Lisp_Object encoded_target, encoded_linkname; CHECK_STRING (target); - if (INTEGERP (ok_if_already_exists)) + if (FIXNUMP (ok_if_already_exists)) { if (SREF (target, 0) == '~') target = Fexpand_file_name (target, Qnil); else if (SREF (target, 0) == '/' && SREF (target, 1) == ':') - target = Fsubstring_no_properties (target, make_number (2), Qnil); + target = Fsubstring_no_properties (target, make_fixnum (2), Qnil); } linkname = expand_cp_target (target, linkname); @@ -2510,9 +2510,9 @@ This happens for interactive use with M-x. */) if (errno == EEXIST) { if (NILP (ok_if_already_exists) - || INTEGERP (ok_if_already_exists)) + || FIXNUMP (ok_if_already_exists)) barf_or_query_if_file_exists (linkname, true, "make it a link", - INTEGERP (ok_if_already_exists), false); + FIXNUMP (ok_if_already_exists), false); unlink (SSDATA (encoded_linkname)); if (symlink (SSDATA (encoded_target), SSDATA (encoded_linkname)) == 0) return Qnil; @@ -3168,7 +3168,7 @@ Return nil, if file does not exist or is not accessible. */) if (stat (SSDATA (absname), &st) < 0) return Qnil; - return make_number (st.st_mode & 07777); + return make_fixnum (st.st_mode & 07777); } DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 2, @@ -3185,7 +3185,7 @@ symbolic notation, like the `chmod' command from GNU Coreutils. */) Lisp_Object handler; absname = Fexpand_file_name (filename, BVAR (current_buffer, directory)); - CHECK_NUMBER (mode); + CHECK_FIXNUM (mode); /* If the file name has special constructs in it, call the corresponding file handler. */ @@ -3216,7 +3216,7 @@ by having the corresponding bit in the mask reset. */) (Lisp_Object mode) { mode_t oldrealmask, oldumask, newumask; - CHECK_NUMBER (mode); + CHECK_FIXNUM (mode); oldrealmask = realmask; newumask = ~ XINT (mode) & 0777; @@ -3383,7 +3383,7 @@ read_non_regular (Lisp_Object state) ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE + data->s.inserted), data->s.trytry); - return make_number (nbytes); + return make_fixnum (nbytes); } @@ -3401,7 +3401,7 @@ read_non_regular_quit (Lisp_Object ignore) static off_t file_offset (Lisp_Object val) { - if (RANGED_INTEGERP (0, val, TYPE_MAXIMUM (off_t))) + if (RANGED_FIXNUMP (0, val, TYPE_MAXIMUM (off_t))) return XINT (val); if (FLOATP (val)) @@ -3461,7 +3461,7 @@ restore_window_points (Lisp_Object window_markers, ptrdiff_t inserted, Lisp_Object car = XCAR (window_markers); Lisp_Object marker = XCAR (car); Lisp_Object oldpos = XCDR (car); - if (MARKERP (marker) && INTEGERP (oldpos) + if (MARKERP (marker) && FIXNUMP (oldpos) && XINT (oldpos) > same_at_start && XINT (oldpos) < same_at_end) { @@ -3470,7 +3470,7 @@ restore_window_points (Lisp_Object window_markers, ptrdiff_t inserted, double growth = newsize / (double)oldsize; ptrdiff_t newpos = same_at_start + growth * (XINT (oldpos) - same_at_start); - Fset_marker (marker, make_number (newpos), Qnil); + Fset_marker (marker, make_fixnum (newpos), Qnil); } } } @@ -3583,7 +3583,7 @@ by calling `format-decode', which see. */) val = call6 (handler, Qinsert_file_contents, filename, visit, beg, end, replace); if (CONSP (val) && CONSP (XCDR (val)) - && RANGED_INTEGERP (0, XCAR (XCDR (val)), ZV - PT)) + && RANGED_FIXNUMP (0, XCAR (XCDR (val)), ZV - PT)) inserted = XINT (XCAR (XCDR (val))); goto handled; } @@ -3769,7 +3769,7 @@ by calling `format-decode', which see. */) insert_1_both ((char *) read_buf, nread, nread, 0, 0, 0); TEMP_SET_PT_BOTH (BEG, BEG_BYTE); coding_system = call2 (Vset_auto_coding_function, - filename, make_number (nread)); + filename, make_fixnum (nread)); set_buffer_internal (prev); /* Discard the unwind protect for recovering the @@ -4344,7 +4344,7 @@ by calling `format-decode', which see. */) if (inserted > 0 && ! NILP (Vset_auto_coding_function)) { coding_system = call2 (Vset_auto_coding_function, - filename, make_number (inserted)); + filename, make_fixnum (inserted)); } if (NILP (coding_system)) @@ -4463,11 +4463,11 @@ by calling `format-decode', which see. */) if (! NILP (Ffboundp (Qafter_insert_file_set_coding))) { - insval = call2 (Qafter_insert_file_set_coding, make_number (inserted), + insval = call2 (Qafter_insert_file_set_coding, make_fixnum (inserted), visit); if (! NILP (insval)) { - if (! RANGED_INTEGERP (0, insval, ZV - PT)) + if (! RANGED_FIXNUMP (0, insval, ZV - PT)) wrong_type_argument (intern ("inserted-chars"), insval); inserted = XFASTINT (insval); } @@ -4489,8 +4489,8 @@ by calling `format-decode', which see. */) if (NILP (replace)) { insval = call3 (Qformat_decode, - Qnil, make_number (inserted), visit); - if (! RANGED_INTEGERP (0, insval, ZV - PT)) + Qnil, make_fixnum (inserted), visit); + if (! RANGED_FIXNUMP (0, insval, ZV - PT)) wrong_type_argument (intern ("inserted-chars"), insval); inserted = XFASTINT (insval); } @@ -4512,8 +4512,8 @@ by calling `format-decode', which see. */) TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE); insval = call3 (Qformat_decode, - Qnil, make_number (oinserted), visit); - if (! RANGED_INTEGERP (0, insval, ZV - PT)) + Qnil, make_fixnum (oinserted), visit); + if (! RANGED_FIXNUMP (0, insval, ZV - PT)) wrong_type_argument (intern ("inserted-chars"), insval); if (ochars_modiff == CHARS_MODIFF) /* format_decode didn't modify buffer's characters => move @@ -4533,10 +4533,10 @@ by calling `format-decode', which see. */) { if (NILP (replace)) { - insval = call1 (XCAR (p), make_number (inserted)); + insval = call1 (XCAR (p), make_fixnum (inserted)); if (!NILP (insval)) { - if (! RANGED_INTEGERP (0, insval, ZV - PT)) + if (! RANGED_FIXNUMP (0, insval, ZV - PT)) wrong_type_argument (intern ("inserted-chars"), insval); inserted = XFASTINT (insval); } @@ -4551,10 +4551,10 @@ by calling `format-decode', which see. */) EMACS_INT ochars_modiff = CHARS_MODIFF; TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE); - insval = call1 (XCAR (p), make_number (oinserted)); + insval = call1 (XCAR (p), make_fixnum (oinserted)); if (!NILP (insval)) { - if (! RANGED_INTEGERP (0, insval, ZV - PT)) + if (! RANGED_FIXNUMP (0, insval, ZV - PT)) wrong_type_argument (intern ("inserted-chars"), insval); if (ochars_modiff == CHARS_MODIFF) /* after_insert_file_functions didn't modify @@ -4582,10 +4582,10 @@ by calling `format-decode', which see. */) /* Adjust the last undo record for the size change during the format conversion. */ Lisp_Object tem = XCAR (old_undo); - if (CONSP (tem) && INTEGERP (XCAR (tem)) - && INTEGERP (XCDR (tem)) + if (CONSP (tem) && FIXNUMP (XCAR (tem)) + && FIXNUMP (XCDR (tem)) && XFASTINT (XCDR (tem)) == PT + old_inserted) - XSETCDR (tem, make_number (PT + inserted)); + XSETCDR (tem, make_fixnum (PT + inserted)); } } else @@ -4620,7 +4620,7 @@ by calling `format-decode', which see. */) /* Retval needs to be dealt with in all cases consistently. */ if (NILP (val)) - val = list2 (orig_filename, make_number (inserted)); + val = list2 (orig_filename, make_fixnum (inserted)); return unbind_to (count, val); } @@ -4923,7 +4923,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, fn = SSDATA (encoded_filename); open_flags = O_WRONLY | O_CREAT; open_flags |= EQ (mustbenew, Qexcl) ? O_EXCL : !NILP (append) ? 0 : O_TRUNC; - if (NUMBERP (append)) + if (FIXED_OR_FLOATP (append)) offset = file_offset (append); else if (!NILP (append)) open_flags |= O_APPEND; @@ -4948,7 +4948,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, record_unwind_protect_int (close_file_unwind, desc); } - if (NUMBERP (append)) + if (FIXED_OR_FLOATP (append)) { off_t ret = lseek (desc, offset, SEEK_SET); if (ret < 0) @@ -5131,7 +5131,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, } if (!auto_saving && !noninteractive) - message_with_string ((NUMBERP (append) + message_with_string ((FIXED_OR_FLOATP (append) ? "Updated %s" : ! NILP (append) ? "Added to %s" @@ -5216,7 +5216,7 @@ build_annotations (Lisp_Object start, Lisp_Object end) has written annotations to a temporary buffer, which is now current. */ res = call5 (Qformat_annotate_function, XCAR (p), start, end, - original_buffer, make_number (i)); + original_buffer, make_fixnum (i)); if (current_buffer != given_buffer) { XSETFASTINT (start, BEGV); @@ -5255,7 +5255,7 @@ a_write (int desc, Lisp_Object string, ptrdiff_t pos, { tem = Fcar_safe (Fcar (*annot)); nextpos = pos - 1; - if (INTEGERP (tem)) + if (FIXNUMP (tem)) nextpos = XFASTINT (tem); /* If there are no more annotations in this range, @@ -5437,7 +5437,7 @@ See Info node `(elisp)Modification Time' for more details. */) { int ns = current_buffer->modtime.tv_nsec; if (ns < 0) - return make_number (UNKNOWN_MODTIME_NSECS - ns); + return make_fixnum (UNKNOWN_MODTIME_NSECS - ns); return make_lisp_time (current_buffer->modtime); } @@ -5455,7 +5455,7 @@ An argument specifies the modification time value to use if (!NILP (time_flag)) { struct timespec mtime; - if (INTEGERP (time_flag)) + if (FIXNUMP (time_flag)) { CHECK_RANGED_INTEGER (time_flag, -1, 0); mtime = make_timespec (0, UNKNOWN_MODTIME_NSECS - XINT (time_flag)); @@ -5524,7 +5524,7 @@ auto_save_1 (void) /* But make sure we can overwrite it later! */ auto_save_mode_bits = (st.st_mode | 0600) & 0777; else if (modes = Ffile_modes (BVAR (current_buffer, filename)), - INTEGERP (modes)) + FIXNUMP (modes)) /* Remote files don't cooperate with stat. */ auto_save_mode_bits = (XINT (modes) | 0600) & 0777; } @@ -5725,7 +5725,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) /* Turn off auto-saving until there's a real save, and prevent any more warnings. */ XSETINT (BVAR (b, save_length), -1); - Fsleep_for (make_number (1), Qnil); + Fsleep_for (make_fixnum (1), Qnil); continue; } if (!auto_saved && NILP (no_message)) @@ -5754,7 +5754,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) { /* If we are going to restore an old message, give time to read ours. */ - sit_for (make_number (1), 0, 0); + sit_for (make_fixnum (1), 0, 0); restore_message (); } else if (!auto_save_error_occurred) diff --git a/src/floatfns.c b/src/floatfns.c index e7d404a84e..766044ba35 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -67,7 +67,7 @@ CHECK_FLOAT (Lisp_Object x) double extract_float (Lisp_Object num) { - CHECK_NUMBER_OR_FLOAT (num); + CHECK_FIXNUM_OR_FLOAT (num); return XFLOATINT (num); } @@ -185,7 +185,7 @@ If X is zero, both parts (SGNFCAND and EXP) are zero. */) double f = extract_float (x); int exponent; double sgnfcand = frexp (f, &exponent); - return Fcons (make_float (sgnfcand), make_number (exponent)); + return Fcons (make_float (sgnfcand), make_fixnum (exponent)); } DEFUN ("ldexp", Fldexp, Sldexp, 2, 2, 0, @@ -193,7 +193,7 @@ DEFUN ("ldexp", Fldexp, Sldexp, 2, 2, 0, EXPONENT must be an integer. */) (Lisp_Object sgnfcand, Lisp_Object exponent) { - CHECK_NUMBER (exponent); + CHECK_FIXNUM (exponent); int e = min (max (INT_MIN, XINT (exponent)), INT_MAX); return make_float (ldexp (extract_float (sgnfcand), e)); } @@ -211,10 +211,10 @@ DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, doc: /* Return the exponential ARG1 ** ARG2. */) (Lisp_Object arg1, Lisp_Object arg2) { - CHECK_NUMBER_OR_FLOAT (arg1); - CHECK_NUMBER_OR_FLOAT (arg2); - if (INTEGERP (arg1) /* common lisp spec */ - && INTEGERP (arg2) /* don't promote, if both are ints, and */ + CHECK_FIXNUM_OR_FLOAT (arg1); + CHECK_FIXNUM_OR_FLOAT (arg2); + if (FIXNUMP (arg1) /* common lisp spec */ + && FIXNUMP (arg2) /* don't promote, if both are ints, and */ && XINT (arg2) >= 0) /* we are sure the result is not fractional */ { /* this can be improved by pre-calculating */ EMACS_INT y; /* some binary powers of x then accumulating */ @@ -275,7 +275,7 @@ DEFUN ("abs", Fabs, Sabs, 1, 1, 0, doc: /* Return the absolute value of ARG. */) (register Lisp_Object arg) { - CHECK_NUMBER_OR_FLOAT (arg); + CHECK_FIXNUM_OR_FLOAT (arg); if (FLOATP (arg)) arg = make_float (fabs (XFLOAT_DATA (arg))); @@ -289,9 +289,9 @@ DEFUN ("float", Ffloat, Sfloat, 1, 1, 0, doc: /* Return the floating point number equal to ARG. */) (register Lisp_Object arg) { - CHECK_NUMBER_OR_FLOAT (arg); + CHECK_FIXNUM_OR_FLOAT (arg); - if (INTEGERP (arg)) + if (FIXNUMP (arg)) return make_float ((double) XINT (arg)); else /* give 'em the same float back */ return arg; @@ -311,7 +311,7 @@ This is the same as the exponent of a float. */) (Lisp_Object arg) { EMACS_INT value; - CHECK_NUMBER_OR_FLOAT (arg); + CHECK_FIXNUM_OR_FLOAT (arg); if (FLOATP (arg)) { @@ -336,7 +336,7 @@ This is the same as the exponent of a float. */) : EMACS_UINT_WIDTH - 1 - ecount_leading_zeros (i)); } - return make_number (value); + return make_fixnum (value); } @@ -348,7 +348,7 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor, EMACS_INT (*int_round2) (EMACS_INT, EMACS_INT), const char *name) { - CHECK_NUMBER_OR_FLOAT (arg); + CHECK_FIXNUM_OR_FLOAT (arg); double d; if (NILP (divisor)) @@ -359,12 +359,12 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor, } else { - CHECK_NUMBER_OR_FLOAT (divisor); + CHECK_FIXNUM_OR_FLOAT (divisor); if (!FLOATP (arg) && !FLOATP (divisor)) { if (XINT (divisor) == 0) xsignal0 (Qarith_error); - return make_number (int_round2 (XINT (arg), XINT (divisor))); + return make_fixnum (int_round2 (XINT (arg), XINT (divisor))); } double f1 = FLOATP (arg) ? XFLOAT_DATA (arg) : XINT (arg); @@ -383,7 +383,7 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor, { EMACS_INT ir = dr; if (! FIXNUM_OVERFLOW_P (ir)) - return make_number (ir); + return make_fixnum (ir); } xsignal2 (Qrange_error, build_string (name), arg); } diff --git a/src/fns.c b/src/fns.c index c171784d29..ec88f8476c 100644 --- a/src/fns.c +++ b/src/fns.c @@ -77,7 +77,7 @@ See Info node `(elisp)Random Numbers' for more details. */) seed_random (SSDATA (limit), SBYTES (limit)); val = get_random (); - if (INTEGERP (limit) && 0 < XINT (limit)) + if (FIXNUMP (limit) && 0 < XINT (limit)) while (true) { /* Return the remainder, except reject the rare case where @@ -85,10 +85,10 @@ See Info node `(elisp)Random Numbers' for more details. */) remainder isn't random. */ EMACS_INT remainder = val % XINT (limit); if (val - remainder <= INTMASK - XINT (limit) + 1) - return make_number (remainder); + return make_fixnum (remainder); val = get_random (); } - return make_number (val); + return make_fixnum (val); } /* Random data-structure functions. */ @@ -121,7 +121,7 @@ To get the number of bytes, use `string-bytes'. */) CHECK_LIST_END (sequence, sequence); if (MOST_POSITIVE_FIXNUM < i) error ("List too long"); - val = make_number (i); + val = make_fixnum (i); } else if (NILP (sequence)) XSETFASTINT (val, 0); @@ -150,7 +150,7 @@ If STRING is multibyte, this may be greater than the length of STRING. */) (Lisp_Object string) { CHECK_STRING (string); - return make_number (SBYTES (string)); + return make_fixnum (SBYTES (string)); } DEFUN ("string-distance", Fstring_distance, Sstring_distance, 2, 3, 0, @@ -216,7 +216,7 @@ Letter-case is significant, but text properties are ignored. */) } SAFE_FREE (); - return make_number (column[len1]); + return make_fixnum (column[len1]); } DEFUN ("string-equal", Fstring_equal, Sstring_equal, 2, 2, 0, @@ -270,10 +270,10 @@ If string STR1 is greater, the value is a positive number N; /* For backward compatibility, silently bring too-large positive end values into range. */ - if (INTEGERP (end1) && SCHARS (str1) < XINT (end1)) - end1 = make_number (SCHARS (str1)); - if (INTEGERP (end2) && SCHARS (str2) < XINT (end2)) - end2 = make_number (SCHARS (str2)); + if (FIXNUMP (end1) && SCHARS (str1) < XINT (end1)) + end1 = make_fixnum (SCHARS (str1)); + if (FIXNUMP (end2) && SCHARS (str2) < XINT (end2)) + end2 = make_fixnum (SCHARS (str2)); validate_subarray (str1, start1, end1, SCHARS (str1), &from1, &to1); validate_subarray (str2, start2, end2, SCHARS (str2), &from2, &to2); @@ -298,8 +298,8 @@ If string STR1 is greater, the value is a positive number N; if (! NILP (ignore_case)) { - c1 = XINT (Fupcase (make_number (c1))); - c2 = XINT (Fupcase (make_number (c2))); + c1 = XINT (Fupcase (make_fixnum (c1))); + c2 = XINT (Fupcase (make_fixnum (c2))); } if (c1 == c2) @@ -309,15 +309,15 @@ If string STR1 is greater, the value is a positive number N; past the character that we are comparing; hence we don't add or subtract 1 here. */ if (c1 < c2) - return make_number (- i1 + from1); + return make_fixnum (- i1 + from1); else - return make_number (i1 - from1); + return make_fixnum (i1 - from1); } if (i1 < to1) - return make_number (i1 - from1 + 1); + return make_fixnum (i1 - from1 + 1); if (i2 < to2) - return make_number (- i1 + from1 - 1); + return make_fixnum (- i1 + from1 - 1); return Qt; } @@ -669,7 +669,7 @@ concat (ptrdiff_t nargs, Lisp_Object *args, some_multibyte = 1; } else if (BOOL_VECTOR_P (this) && bool_vector_size (this) > 0) - wrong_type_argument (Qintegerp, Faref (this, make_number (0))); + wrong_type_argument (Qintegerp, Faref (this, make_fixnum (0))); else if (CONSP (this)) for (; CONSP (this); this = XCDR (this)) { @@ -709,9 +709,9 @@ concat (ptrdiff_t nargs, Lisp_Object *args, /* Create the output object. */ if (target_type == Lisp_Cons) - val = Fmake_list (make_number (result_len), Qnil); + val = Fmake_list (make_fixnum (result_len), Qnil); else if (target_type == Lisp_Vectorlike) - val = Fmake_vector (make_number (result_len), Qnil); + val = Fmake_vector (make_fixnum (result_len), Qnil); else if (some_multibyte) val = make_uninit_multibyte_string (result_len, result_len_byte); else @@ -848,15 +848,15 @@ concat (ptrdiff_t nargs, Lisp_Object *args, { this = args[textprops[argnum].argnum]; props = text_property_list (this, - make_number (0), - make_number (SCHARS (this)), + make_fixnum (0), + make_fixnum (SCHARS (this)), Qnil); /* If successive arguments have properties, be sure that the value of `composition' property be the copy. */ if (last_to_end == textprops[argnum].to) make_composition_value_copy (props); add_text_properties_from_list (val, props, - make_number (textprops[argnum].to)); + make_fixnum (textprops[argnum].to)); last_to_end = textprops[argnum].to + SCHARS (this); } } @@ -1258,7 +1258,7 @@ validate_subarray (Lisp_Object array, Lisp_Object from, Lisp_Object to, { EMACS_INT f, t; - if (INTEGERP (from)) + if (FIXNUMP (from)) { f = XINT (from); if (f < 0) @@ -1269,7 +1269,7 @@ validate_subarray (Lisp_Object array, Lisp_Object from, Lisp_Object to, else wrong_type_argument (Qintegerp, from); - if (INTEGERP (to)) + if (FIXNUMP (to)) { t = XINT (to); if (t < 0) @@ -1317,8 +1317,8 @@ With one argument, just copy STRING (with properties, if any). */) res = make_specified_string (SSDATA (string) + from_byte, ito - ifrom, to_byte - from_byte, STRING_MULTIBYTE (string)); - copy_text_properties (make_number (ifrom), make_number (ito), - string, make_number (0), res, Qnil); + copy_text_properties (make_fixnum (ifrom), make_fixnum (ito), + string, make_fixnum (0), res, Qnil); } else res = Fvector (ito - ifrom, aref_addr (string, ifrom)); @@ -1363,15 +1363,15 @@ substring_both (Lisp_Object string, ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t size = CHECK_VECTOR_OR_STRING (string); if (!(0 <= from && from <= to && to <= size)) - args_out_of_range_3 (string, make_number (from), make_number (to)); + args_out_of_range_3 (string, make_fixnum (from), make_fixnum (to)); if (STRINGP (string)) { res = make_specified_string (SSDATA (string) + from_byte, to - from, to_byte - from_byte, STRING_MULTIBYTE (string)); - copy_text_properties (make_number (from), make_number (to), - string, make_number (0), res, Qnil); + copy_text_properties (make_fixnum (from), make_fixnum (to), + string, make_fixnum (0), res, Qnil); } else res = Fvector (to - from, aref_addr (string, from)); @@ -1383,7 +1383,7 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0, doc: /* Take cdr N times on LIST, return the result. */) (Lisp_Object n, Lisp_Object list) { - CHECK_NUMBER (n); + CHECK_FIXNUM (n); Lisp_Object tail = list; for (EMACS_INT num = XINT (n); 0 < num; num--) { @@ -1410,7 +1410,7 @@ DEFUN ("elt", Felt, Selt, 2, 2, 0, doc: /* Return element of SEQUENCE at index N. */) (register Lisp_Object sequence, Lisp_Object n) { - CHECK_NUMBER (n); + CHECK_FIXNUM (n); if (CONSP (sequence) || NILP (sequence)) return Fcar (Fnthcdr (n, sequence)); @@ -1645,7 +1645,7 @@ changing the value of a sequence `foo'. */) cbytes = 1; } - if (!INTEGERP (elt) || c != XINT (elt)) + if (!FIXNUMP (elt) || c != XINT (elt)) { ++nchars; nbytes += cbytes; @@ -1675,7 +1675,7 @@ changing the value of a sequence `foo'. */) cbytes = 1; } - if (!INTEGERP (elt) || c != XINT (elt)) + if (!FIXNUMP (elt) || c != XINT (elt)) { unsigned char *from = SDATA (seq) + ibyte; unsigned char *to = SDATA (tem) + nbytes; @@ -1955,7 +1955,7 @@ sort_vector (Lisp_Object vector, Lisp_Object predicate) USE_SAFE_ALLOCA; SAFE_ALLOCA_LISP (tmp, halflen); for (ptrdiff_t i = 0; i < halflen; i++) - tmp[i] = make_number (0); + tmp[i] = make_fixnum (0); sort_vector_inplace (predicate, len, XVECTOR (vector)->contents, tmp); SAFE_FREE (); } @@ -2695,7 +2695,7 @@ if `last-nonmenu-event' is nil, and `use-dialog-box' is non-nil. */) Fding (Qnil); Fdiscard_input (); message1 ("Please answer yes or no."); - Fsleep_for (make_number (2), Qnil); + Fsleep_for (make_fixnum (2), Qnil); } } @@ -2727,7 +2727,7 @@ advisable. */) while (loads-- > 0) { Lisp_Object load = (NILP (use_floats) - ? make_number (100.0 * load_ave[loads]) + ? make_fixnum (100.0 * load_ave[loads]) : make_float (load_ave[loads])); ret = Fcons (load, ret); } @@ -2763,7 +2763,7 @@ particular subfeatures supported in this version of FEATURE. */) CHECK_SYMBOL (feature); CHECK_LIST (subfeatures); if (!NILP (Vautoload_queue)) - Vautoload_queue = Fcons (Fcons (make_number (0), Vfeatures), + Vautoload_queue = Fcons (Fcons (make_fixnum (0), Vfeatures), Vautoload_queue); tem = Fmemq (feature, Vfeatures); if (NILP (tem)) @@ -3015,7 +3015,7 @@ The data read from the system are decoded using `locale-coding-system'. */) #ifdef DAY_1 else if (EQ (item, Qdays)) /* e.g. for calendar-day-name-array */ { - Lisp_Object v = Fmake_vector (make_number (7), Qnil); + Lisp_Object v = Fmake_vector (make_fixnum (7), Qnil); const int days[7] = {DAY_1, DAY_2, DAY_3, DAY_4, DAY_5, DAY_6, DAY_7}; int i; synchronize_system_time_locale (); @@ -3034,7 +3034,7 @@ The data read from the system are decoded using `locale-coding-system'. */) #ifdef MON_1 else if (EQ (item, Qmonths)) /* e.g. for calendar-month-name-array */ { - Lisp_Object v = Fmake_vector (make_number (12), Qnil); + Lisp_Object v = Fmake_vector (make_fixnum (12), Qnil); const int months[12] = {MON_1, MON_2, MON_3, MON_4, MON_5, MON_6, MON_7, MON_8, MON_9, MON_10, MON_11, MON_12}; int i; @@ -3198,7 +3198,7 @@ into shorter lines. */) SET_PT (old_pos); /* We return the length of the encoded text. */ - return make_number (encoded_length); + return make_fixnum (encoded_length); } DEFUN ("base64-encode-string", Fbase64_encode_string, Sbase64_encode_string, @@ -3400,7 +3400,7 @@ If the region can't be decoded, signal an error and don't modify the buffer. */ old_pos = XFASTINT (beg); SET_PT (old_pos > ZV ? ZV : old_pos); - return make_number (inserted_chars); + return make_fixnum (inserted_chars); } DEFUN ("base64-decode-string", Fbase64_decode_string, Sbase64_decode_string, @@ -3571,7 +3571,7 @@ set_hash_next (struct Lisp_Hash_Table *h, Lisp_Object next) static void set_hash_next_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val) { - gc_aset (h->next, idx, make_number (val)); + gc_aset (h->next, idx, make_fixnum (val)); } static void set_hash_hash (struct Lisp_Hash_Table *h, Lisp_Object hash) @@ -3591,7 +3591,7 @@ set_hash_index (struct Lisp_Hash_Table *h, Lisp_Object index) static void set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val) { - gc_aset (h->index, idx, make_number (val)); + gc_aset (h->index, idx, make_fixnum (val)); } /* If OBJ is a Lisp hash table, return a pointer to its struct @@ -3872,10 +3872,10 @@ make_hash_table (struct hash_table_test test, EMACS_INT size, h->rehash_threshold = rehash_threshold; h->rehash_size = rehash_size; h->count = 0; - h->key_and_value = Fmake_vector (make_number (2 * size), Qnil); - h->hash = Fmake_vector (make_number (size), Qnil); - h->next = Fmake_vector (make_number (size), make_number (-1)); - h->index = Fmake_vector (make_number (index_size), make_number (-1)); + h->key_and_value = Fmake_vector (make_fixnum (2 * size), Qnil); + h->hash = Fmake_vector (make_fixnum (size), Qnil); + h->next = Fmake_vector (make_fixnum (size), make_fixnum (-1)); + h->index = Fmake_vector (make_fixnum (index_size), make_fixnum (-1)); h->pure = pure; /* Set up the free list. */ @@ -3970,8 +3970,8 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) set_hash_key_and_value (h, larger_vector (h->key_and_value, 2 * (new_size - old_size), -1)); set_hash_hash (h, larger_vector (h->hash, new_size - old_size, -1)); - set_hash_index (h, Fmake_vector (make_number (index_size), - make_number (-1))); + set_hash_index (h, Fmake_vector (make_fixnum (index_size), + make_fixnum (-1))); set_hash_next (h, larger_vecalloc (h->next, new_size - old_size, -1)); /* Update the free list. Do it so that new entries are added at @@ -4060,7 +4060,7 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value, set_hash_value_slot (h, i, value); /* Remember its hash code. */ - set_hash_hash_slot (h, i, make_number (hash)); + set_hash_hash_slot (h, i, make_fixnum (hash)); /* Add new entry to its collision chain. */ start_of_bucket = hash % ASIZE (h->index); @@ -4130,7 +4130,7 @@ hash_clear (struct Lisp_Hash_Table *h) } for (i = 0; i < ASIZE (h->index); ++i) - ASET (h->index, i, make_number (-1)); + ASET (h->index, i, make_fixnum (-1)); h->next_free = 0; h->count = 0; @@ -4476,7 +4476,7 @@ DEFUN ("sxhash-eq", Fsxhash_eq, Ssxhash_eq, 1, 1, 0, If (eq A B), then (= (sxhash-eq A) (sxhash-eq B)). */) (Lisp_Object obj) { - return make_number (hashfn_eq (NULL, obj)); + return make_fixnum (hashfn_eq (NULL, obj)); } DEFUN ("sxhash-eql", Fsxhash_eql, Ssxhash_eql, 1, 1, 0, @@ -4484,7 +4484,7 @@ DEFUN ("sxhash-eql", Fsxhash_eql, Ssxhash_eql, 1, 1, 0, If (eql A B), then (= (sxhash-eql A) (sxhash-eql B)). */) (Lisp_Object obj) { - return make_number (hashfn_eql (NULL, obj)); + return make_fixnum (hashfn_eql (NULL, obj)); } DEFUN ("sxhash-equal", Fsxhash_equal, Ssxhash_equal, 1, 1, 0, @@ -4492,7 +4492,7 @@ DEFUN ("sxhash-equal", Fsxhash_equal, Ssxhash_equal, 1, 1, 0, If (equal A B), then (= (sxhash-equal A) (sxhash-equal B)). */) (Lisp_Object obj) { - return make_number (hashfn_equal (NULL, obj)); + return make_fixnum (hashfn_equal (NULL, obj)); } DEFUN ("make-hash-table", Fmake_hash_table, Smake_hash_table, 0, MANY, 0, @@ -4578,7 +4578,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) EMACS_INT size; if (NILP (size_arg)) size = DEFAULT_HASH_SIZE; - else if (NATNUMP (size_arg)) + else if (FIXNATP (size_arg)) size = XFASTINT (size_arg); else signal_error ("Invalid hash table size", size_arg); @@ -4588,7 +4588,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) i = get_key_arg (QCrehash_size, nargs, args, used); if (!i) rehash_size = DEFAULT_REHASH_SIZE; - else if (INTEGERP (args[i]) && 0 < XINT (args[i])) + else if (FIXNUMP (args[i]) && 0 < XINT (args[i])) rehash_size = - XINT (args[i]); else if (FLOATP (args[i]) && 0 < (float) (XFLOAT_DATA (args[i]) - 1)) rehash_size = (float) (XFLOAT_DATA (args[i]) - 1); @@ -4638,7 +4638,7 @@ DEFUN ("hash-table-count", Fhash_table_count, Shash_table_count, 1, 1, 0, doc: /* Return the number of elements in TABLE. */) (Lisp_Object table) { - return make_number (check_hash_table (table)->count); + return make_fixnum (check_hash_table (table)->count); } @@ -4651,7 +4651,7 @@ DEFUN ("hash-table-rehash-size", Fhash_table_rehash_size, if (rehash_size < 0) { EMACS_INT s = -rehash_size; - return make_number (min (s, MOST_POSITIVE_FIXNUM)); + return make_fixnum (min (s, MOST_POSITIVE_FIXNUM)); } else return make_float (rehash_size + 1); @@ -4675,7 +4675,7 @@ without need for resizing. */) (Lisp_Object table) { struct Lisp_Hash_Table *h = check_hash_table (table); - return make_number (HASH_TABLE_SIZE (h)); + return make_fixnum (HASH_TABLE_SIZE (h)); } @@ -4903,7 +4903,7 @@ extract_data_from_object (Lisp_Object spec, b = BEGV; else { - CHECK_NUMBER_COERCE_MARKER (start); + CHECK_FIXNUM_COERCE_MARKER (start); b = XINT (start); } @@ -4911,7 +4911,7 @@ extract_data_from_object (Lisp_Object spec, e = ZV; else { - CHECK_NUMBER_COERCE_MARKER (end); + CHECK_FIXNUM_COERCE_MARKER (end); e = XINT (end); } @@ -4967,7 +4967,7 @@ extract_data_from_object (Lisp_Object spec, && !NILP (Ffboundp (Vselect_safe_coding_system_function))) /* Confirm that VAL can surely encode the current region. */ coding_system = call4 (Vselect_safe_coding_system_function, - make_number (b), make_number (e), + make_fixnum (b), make_fixnum (e), coding_system, Qnil); if (force_raw_text) @@ -5001,7 +5001,7 @@ extract_data_from_object (Lisp_Object spec, #ifdef HAVE_GNUTLS3 /* Format: (iv-auto REQUIRED-LENGTH). */ - if (! NATNUMP (start)) + if (! FIXNATP (start)) error ("Without a length, `iv-auto' can't be used; see ELisp manual"); else { diff --git a/src/font.c b/src/font.c index 3a82e501a8..382cd78a23 100644 --- a/src/font.c +++ b/src/font.c @@ -201,7 +201,7 @@ font_make_object (int size, Lisp_Object entity, int pixelsize) = Fcopy_alist (AREF (entity, FONT_EXTRA_INDEX)); } if (size > 0) - font->props[FONT_SIZE_INDEX] = make_number (pixelsize); + font->props[FONT_SIZE_INDEX] = make_fixnum (pixelsize); return font_object; } @@ -270,7 +270,7 @@ font_intern_prop (const char *str, ptrdiff_t len, bool force_symbol) (n += str[i++] - '0') <= MOST_POSITIVE_FIXNUM; ) { if (i == len) - return make_number (n); + return make_fixnum (n); if (INT_MULTIPLY_WRAPV (n, 10, &n)) break; } @@ -302,7 +302,7 @@ font_pixel_size (struct frame *f, Lisp_Object spec) int dpi, pixel_size; Lisp_Object val; - if (INTEGERP (size)) + if (FIXNUMP (size)) return XINT (size); if (NILP (size)) return 0; @@ -311,7 +311,7 @@ font_pixel_size (struct frame *f, Lisp_Object spec) eassert (FLOATP (size)); point_size = XFLOAT_DATA (size); val = AREF (spec, FONT_DPI_INDEX); - if (INTEGERP (val)) + if (FIXNUMP (val)) dpi = XINT (val); else dpi = FRAME_RES_Y (f); @@ -353,7 +353,7 @@ font_style_to_value (enum font_property_index prop, Lisp_Object val, for (j = 1; j < ASIZE (AREF (table, i)); j++) if (EQ (val, AREF (AREF (table, i), j))) { - CHECK_NUMBER (AREF (AREF (table, i), 0)); + CHECK_FIXNUM (AREF (AREF (table, i), 0)); return ((XINT (AREF (AREF (table, i), 0)) << 8) | (i << 4) | (j - 1)); } @@ -366,7 +366,7 @@ font_style_to_value (enum font_property_index prop, Lisp_Object val, elt = AREF (AREF (table, i), j); if (xstrcasecmp (s, SSDATA (SYMBOL_NAME (elt))) == 0) { - CHECK_NUMBER (AREF (AREF (table, i), 0)); + CHECK_FIXNUM (AREF (AREF (table, i), 0)); return ((XINT (AREF (AREF (table, i), 0)) << 8) | (i << 4) | (j - 1)); } @@ -374,10 +374,10 @@ font_style_to_value (enum font_property_index prop, Lisp_Object val, if (! noerror) return -1; eassert (len < 255); - elt = Fmake_vector (make_number (2), make_number (100)); + elt = Fmake_vector (make_fixnum (2), make_fixnum (100)); ASET (elt, 1, val); ASET (font_style_table, prop - FONT_WEIGHT_INDEX, - CALLN (Fvconcat, table, Fmake_vector (make_number (1), elt))); + CALLN (Fvconcat, table, Fmake_vector (make_fixnum (1), elt))); return (100 << 8) | (i << 4); } else @@ -390,7 +390,7 @@ font_style_to_value (enum font_property_index prop, Lisp_Object val, int n; CHECK_VECTOR (AREF (table, i)); - CHECK_NUMBER (AREF (AREF (table, i), 0)); + CHECK_FIXNUM (AREF (AREF (table, i), 0)); n = XINT (AREF (AREF (table, i), 0)); if (numeric == n) return (n << 8) | (i << 4); @@ -496,7 +496,7 @@ font_registry_charsets (Lisp_Object registry, struct charset **encoding, struct } else goto invalid_entry; - val = Fcons (make_number (encoding_id), make_number (repertory_id)); + val = Fcons (make_fixnum (encoding_id), make_fixnum (repertory_id)); font_charset_alist = nconc2 (font_charset_alist, list1 (Fcons (registry, val))); } @@ -543,7 +543,7 @@ font_prop_validate_style (Lisp_Object style, Lisp_Object val) enum font_property_index prop = (EQ (style, QCweight) ? FONT_WEIGHT_INDEX : EQ (style, QCslant) ? FONT_SLANT_INDEX : FONT_WIDTH_INDEX); - if (INTEGERP (val)) + if (FIXNUMP (val)) { EMACS_INT n = XINT (val); CHECK_VECTOR (AREF (font_style_table, prop - FONT_WEIGHT_INDEX)); @@ -559,7 +559,7 @@ font_prop_validate_style (Lisp_Object style, Lisp_Object val) val = Qerror; else { - CHECK_NUMBER (AREF (elt, 0)); + CHECK_FIXNUM (AREF (elt, 0)); if (XINT (AREF (elt, 0)) != (n >> 8)) val = Qerror; } @@ -569,7 +569,7 @@ font_prop_validate_style (Lisp_Object style, Lisp_Object val) { int n = font_style_to_value (prop, val, 0); - val = n >= 0 ? make_number (n) : Qerror; + val = n >= 0 ? make_fixnum (n) : Qerror; } else val = Qerror; @@ -579,27 +579,27 @@ font_prop_validate_style (Lisp_Object style, Lisp_Object val) static Lisp_Object font_prop_validate_non_neg (Lisp_Object prop, Lisp_Object val) { - return (NATNUMP (val) || (FLOATP (val) && XFLOAT_DATA (val) >= 0) + return (FIXNATP (val) || (FLOATP (val) && XFLOAT_DATA (val) >= 0) ? val : Qerror); } static Lisp_Object font_prop_validate_spacing (Lisp_Object prop, Lisp_Object val) { - if (NILP (val) || (NATNUMP (val) && XINT (val) <= FONT_SPACING_CHARCELL)) + if (NILP (val) || (FIXNATP (val) && XINT (val) <= FONT_SPACING_CHARCELL)) return val; if (SYMBOLP (val) && SBYTES (SYMBOL_NAME (val)) == 1) { char spacing = SDATA (SYMBOL_NAME (val))[0]; if (spacing == 'c' || spacing == 'C') - return make_number (FONT_SPACING_CHARCELL); + return make_fixnum (FONT_SPACING_CHARCELL); if (spacing == 'm' || spacing == 'M') - return make_number (FONT_SPACING_MONO); + return make_fixnum (FONT_SPACING_MONO); if (spacing == 'p' || spacing == 'P') - return make_number (FONT_SPACING_PROPORTIONAL); + return make_fixnum (FONT_SPACING_PROPORTIONAL); if (spacing == 'd' || spacing == 'D') - return make_number (FONT_SPACING_DUAL); + return make_fixnum (FONT_SPACING_DUAL); } return Qerror; } @@ -875,7 +875,7 @@ font_expand_wildcards (Lisp_Object *field, int n) int from, to; unsigned mask; - if (INTEGERP (val)) + if (FIXNUMP (val)) { EMACS_INT numeric = XINT (val); @@ -999,7 +999,7 @@ font_expand_wildcards (Lisp_Object *field, int n) if (! NILP (tmp[n - 1]) && j < XLFD_REGISTRY_INDEX) return -1; memclear (field + j, (XLFD_LAST_INDEX - j) * word_size); - if (INTEGERP (field[XLFD_ENCODING_INDEX])) + if (FIXNUMP (field[XLFD_ENCODING_INDEX])) field[XLFD_ENCODING_INDEX] = Fintern (Fnumber_to_string (field[XLFD_ENCODING_INDEX]), Qnil); return 0; @@ -1064,7 +1064,7 @@ font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font) { if ((n = font_style_to_value (j, INTERN_FIELD_SYM (i), 0)) < 0) return -1; - ASET (font, j, make_number (n)); + ASET (font, j, make_fixnum (n)); } } ASET (font, FONT_ADSTYLE_INDEX, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX)); @@ -1077,11 +1077,11 @@ font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font) 1)); p = f[XLFD_PIXEL_INDEX]; if (*p == '[' && (pixel_size = parse_matrix (p)) >= 0) - ASET (font, FONT_SIZE_INDEX, make_number (pixel_size)); + ASET (font, FONT_SIZE_INDEX, make_fixnum (pixel_size)); else { val = INTERN_FIELD (XLFD_PIXEL_INDEX); - if (INTEGERP (val)) + if (FIXNUMP (val)) ASET (font, FONT_SIZE_INDEX, val); else if (FONT_ENTITY_P (font)) return -1; @@ -1101,14 +1101,14 @@ font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font) } val = INTERN_FIELD (XLFD_RESY_INDEX); - if (! NILP (val) && ! INTEGERP (val)) + if (! NILP (val) && ! FIXNUMP (val)) return -1; ASET (font, FONT_DPI_INDEX, val); val = INTERN_FIELD (XLFD_SPACING_INDEX); if (! NILP (val)) { val = font_prop_validate_spacing (QCspacing, val); - if (! INTEGERP (val)) + if (! FIXNUMP (val)) return -1; ASET (font, FONT_SPACING_INDEX, val); } @@ -1116,7 +1116,7 @@ font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font) if (*p == '~') p++; val = font_intern_prop (p, f[XLFD_REGISTRY_INDEX] - 1 - p, 0); - if (! NILP (val) && ! INTEGERP (val)) + if (! NILP (val) && ! FIXNUMP (val)) return -1; ASET (font, FONT_AVGWIDTH_INDEX, val); } @@ -1154,7 +1154,7 @@ font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font) { if ((n = font_style_to_value (j, prop[i], 1)) < 0) return -1; - ASET (font, j, make_number (n)); + ASET (font, j, make_fixnum (n)); } ASET (font, FONT_ADSTYLE_INDEX, prop[XLFD_ADSTYLE_INDEX]); val = prop[XLFD_REGISTRY_INDEX]; @@ -1181,26 +1181,26 @@ font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font) if (! NILP (val)) ASET (font, FONT_REGISTRY_INDEX, Fintern (val, Qnil)); - if (INTEGERP (prop[XLFD_PIXEL_INDEX])) + if (FIXNUMP (prop[XLFD_PIXEL_INDEX])) ASET (font, FONT_SIZE_INDEX, prop[XLFD_PIXEL_INDEX]); - else if (INTEGERP (prop[XLFD_POINT_INDEX])) + else if (FIXNUMP (prop[XLFD_POINT_INDEX])) { double point_size = XINT (prop[XLFD_POINT_INDEX]); ASET (font, FONT_SIZE_INDEX, make_float (point_size / 10)); } - if (INTEGERP (prop[XLFD_RESX_INDEX])) + if (FIXNUMP (prop[XLFD_RESX_INDEX])) ASET (font, FONT_DPI_INDEX, prop[XLFD_RESY_INDEX]); if (! NILP (prop[XLFD_SPACING_INDEX])) { val = font_prop_validate_spacing (QCspacing, prop[XLFD_SPACING_INDEX]); - if (! INTEGERP (val)) + if (! FIXNUMP (val)) return -1; ASET (font, FONT_SPACING_INDEX, val); } - if (INTEGERP (prop[XLFD_AVGWIDTH_INDEX])) + if (FIXNUMP (prop[XLFD_AVGWIDTH_INDEX])) ASET (font, FONT_AVGWIDTH_INDEX, prop[XLFD_AVGWIDTH_INDEX]); } @@ -1283,11 +1283,11 @@ font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes) } val = AREF (font, FONT_SIZE_INDEX); - eassert (NUMBERP (val) || NILP (val)); + eassert (FIXED_OR_FLOATP (val) || NILP (val)); char font_size_index_buf[sizeof "-*" + max (INT_STRLEN_BOUND (EMACS_INT), 1 + DBL_MAX_10_EXP + 1)]; - if (INTEGERP (val)) + if (FIXNUMP (val)) { EMACS_INT v = XINT (val); if (v <= 0) @@ -1310,7 +1310,7 @@ font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes) f[XLFD_PIXEL_INDEX] = "*-*"; char dpi_index_buf[sizeof "-" + 2 * INT_STRLEN_BOUND (EMACS_INT)]; - if (INTEGERP (AREF (font, FONT_DPI_INDEX))) + if (FIXNUMP (AREF (font, FONT_DPI_INDEX))) { EMACS_INT v = XINT (AREF (font, FONT_DPI_INDEX)); f[XLFD_RESX_INDEX] = p = dpi_index_buf; @@ -1319,7 +1319,7 @@ font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes) else f[XLFD_RESX_INDEX] = "*-*"; - if (INTEGERP (AREF (font, FONT_SPACING_INDEX))) + if (FIXNUMP (AREF (font, FONT_SPACING_INDEX))) { EMACS_INT spacing = XINT (AREF (font, FONT_SPACING_INDEX)); @@ -1332,7 +1332,7 @@ font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes) f[XLFD_SPACING_INDEX] = "*"; char avgwidth_index_buf[INT_BUFSIZE_BOUND (EMACS_INT)]; - if (INTEGERP (AREF (font, FONT_AVGWIDTH_INDEX))) + if (FIXNUMP (AREF (font, FONT_AVGWIDTH_INDEX))) { f[XLFD_AVGWIDTH_INDEX] = p = avgwidth_index_buf; sprintf (p, "%"pI"d", XINT (AREF (font, FONT_AVGWIDTH_INDEX))); @@ -1456,13 +1456,13 @@ font_parse_fcname (char *name, ptrdiff_t len, Lisp_Object font) FONT_SET_STYLE (font, FONT_SLANT_INDEX, val); else if (PROP_MATCH ("charcell")) ASET (font, FONT_SPACING_INDEX, - make_number (FONT_SPACING_CHARCELL)); + make_fixnum (FONT_SPACING_CHARCELL)); else if (PROP_MATCH ("mono")) ASET (font, FONT_SPACING_INDEX, - make_number (FONT_SPACING_MONO)); + make_fixnum (FONT_SPACING_MONO)); else if (PROP_MATCH ("proportional")) ASET (font, FONT_SPACING_INDEX, - make_number (FONT_SPACING_PROPORTIONAL)); + make_fixnum (FONT_SPACING_PROPORTIONAL)); #undef PROP_MATCH } else @@ -1621,7 +1621,7 @@ font_unparse_fcname (Lisp_Object font, int pixel_size, char *name, int nbytes) } val = AREF (font, FONT_SIZE_INDEX); - if (INTEGERP (val)) + if (FIXNUMP (val)) { if (XINT (val) != 0) pixel_size = XINT (val); @@ -1688,7 +1688,7 @@ font_unparse_fcname (Lisp_Object font, int pixel_size, char *name, int nbytes) p += len; } - if (INTEGERP (AREF (font, FONT_DPI_INDEX))) + if (FIXNUMP (AREF (font, FONT_DPI_INDEX))) { int len = snprintf (p, lim - p, ":dpi=%"pI"d", XINT (AREF (font, FONT_DPI_INDEX))); @@ -1697,7 +1697,7 @@ font_unparse_fcname (Lisp_Object font, int pixel_size, char *name, int nbytes) p += len; } - if (INTEGERP (AREF (font, FONT_SPACING_INDEX))) + if (FIXNUMP (AREF (font, FONT_SPACING_INDEX))) { int len = snprintf (p, lim - p, ":spacing=%"pI"d", XINT (AREF (font, FONT_SPACING_INDEX))); @@ -1706,7 +1706,7 @@ font_unparse_fcname (Lisp_Object font, int pixel_size, char *name, int nbytes) p += len; } - if (INTEGERP (AREF (font, FONT_AVGWIDTH_INDEX))) + if (FIXNUMP (AREF (font, FONT_AVGWIDTH_INDEX))) { int len = snprintf (p, lim - p, (XINT (AREF (font, FONT_AVGWIDTH_INDEX)) == 0 @@ -1807,15 +1807,15 @@ check_gstring (Lisp_Object gstring) goto err; CHECK_FONT_OBJECT (LGSTRING_FONT (gstring)); if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING))) - CHECK_NUMBER (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING)); + CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING)); if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING))) - CHECK_NUMBER (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING)); + CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING)); if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH))) - CHECK_NATNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH)); + CHECK_FIXNAT (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH)); if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT))) - CHECK_NUMBER (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)); + CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)); if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT))) - CHECK_NUMBER (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)); + CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)); for (i = 0; i < LGSTRING_GLYPH_LEN (gstring); i++) { @@ -1825,13 +1825,13 @@ check_gstring (Lisp_Object gstring) goto err; if (NILP (AREF (val, LGLYPH_IX_CHAR))) break; - CHECK_NATNUM (AREF (val, LGLYPH_IX_FROM)); - CHECK_NATNUM (AREF (val, LGLYPH_IX_TO)); + CHECK_FIXNAT (AREF (val, LGLYPH_IX_FROM)); + CHECK_FIXNAT (AREF (val, LGLYPH_IX_TO)); CHECK_CHARACTER (AREF (val, LGLYPH_IX_CHAR)); if (!NILP (AREF (val, LGLYPH_IX_CODE))) - CHECK_NATNUM (AREF (val, LGLYPH_IX_CODE)); + CHECK_FIXNAT (AREF (val, LGLYPH_IX_CODE)); if (!NILP (AREF (val, LGLYPH_IX_WIDTH))) - CHECK_NATNUM (AREF (val, LGLYPH_IX_WIDTH)); + CHECK_FIXNAT (AREF (val, LGLYPH_IX_WIDTH)); if (!NILP (AREF (val, LGLYPH_IX_ADJUSTMENT))) { val = AREF (val, LGLYPH_IX_ADJUSTMENT); @@ -1839,7 +1839,7 @@ check_gstring (Lisp_Object gstring) if (ASIZE (val) < 3) goto err; for (j = 0; j < 3; j++) - CHECK_NUMBER (AREF (val, j)); + CHECK_FIXNUM (AREF (val, j)); } } return i; @@ -2026,23 +2026,23 @@ font_otf_DeviceTable (OTF_DeviceTable *device_table) { int len = device_table->StartSize - device_table->EndSize + 1; - return Fcons (make_number (len), + return Fcons (make_fixnum (len), make_unibyte_string (device_table->DeltaValue, len)); } Lisp_Object font_otf_ValueRecord (int value_format, OTF_ValueRecord *value_record) { - Lisp_Object val = Fmake_vector (make_number (8), Qnil); + Lisp_Object val = Fmake_vector (make_fixnum (8), Qnil); if (value_format & OTF_XPlacement) - ASET (val, 0, make_number (value_record->XPlacement)); + ASET (val, 0, make_fixnum (value_record->XPlacement)); if (value_format & OTF_YPlacement) - ASET (val, 1, make_number (value_record->YPlacement)); + ASET (val, 1, make_fixnum (value_record->YPlacement)); if (value_format & OTF_XAdvance) - ASET (val, 2, make_number (value_record->XAdvance)); + ASET (val, 2, make_fixnum (value_record->XAdvance)); if (value_format & OTF_YAdvance) - ASET (val, 3, make_number (value_record->YAdvance)); + ASET (val, 3, make_fixnum (value_record->YAdvance)); if (value_format & OTF_XPlaDevice) ASET (val, 4, font_otf_DeviceTable (&value_record->XPlaDevice)); if (value_format & OTF_YPlaDevice) @@ -2059,11 +2059,11 @@ font_otf_Anchor (OTF_Anchor *anchor) { Lisp_Object val; - val = Fmake_vector (make_number (anchor->AnchorFormat + 1), Qnil); - ASET (val, 0, make_number (anchor->XCoordinate)); - ASET (val, 1, make_number (anchor->YCoordinate)); + val = Fmake_vector (make_fixnum (anchor->AnchorFormat + 1), Qnil); + ASET (val, 0, make_fixnum (anchor->XCoordinate)); + ASET (val, 1, make_fixnum (anchor->YCoordinate)); if (anchor->AnchorFormat == 2) - ASET (val, 2, make_number (anchor->f.f1.AnchorPoint)); + ASET (val, 2, make_fixnum (anchor->f.f1.AnchorPoint)); else { ASET (val, 3, font_otf_DeviceTable (&anchor->f.f2.XDeviceTable)); @@ -2244,7 +2244,7 @@ font_sort_entities (Lisp_Object list, Lisp_Object prefer, prefer_prop[i] = AREF (prefer, i); if (FLOATP (prefer_prop[FONT_SIZE_INDEX])) prefer_prop[FONT_SIZE_INDEX] - = make_number (font_pixel_size (f, prefer)); + = make_fixnum (font_pixel_size (f, prefer)); if (NILP (XCDR (list))) { @@ -2446,7 +2446,7 @@ font_match_p (Lisp_Object spec, Lisp_Object font) for (i = FONT_FOUNDRY_INDEX; i < FONT_SIZE_INDEX; i++) prop[i] = AREF (spec, i); prop[FONT_SIZE_INDEX] - = make_number (font_pixel_size (XFRAME (selected_frame), spec)); + = make_fixnum (font_pixel_size (XFRAME (selected_frame), spec)); props = prop; } @@ -2559,13 +2559,13 @@ font_prepare_cache (struct frame *f, struct font_driver const *driver) val = XCDR (val); if (NILP (val)) { - val = list2 (driver->type, make_number (1)); + val = list2 (driver->type, make_fixnum (1)); XSETCDR (cache, Fcons (val, XCDR (cache))); } else { val = XCDR (XCAR (val)); - XSETCAR (val, make_number (XINT (XCAR (val)) + 1)); + XSETCAR (val, make_fixnum (XINT (XCAR (val)) + 1)); } } @@ -2582,7 +2582,7 @@ font_finish_cache (struct frame *f, struct font_driver const *driver) cache = val, val = XCDR (val); eassert (! NILP (val)); tmp = XCDR (XCAR (val)); - XSETCAR (tmp, make_number (XINT (XCAR (tmp)) - 1)); + XSETCAR (tmp, make_fixnum (XINT (XCAR (tmp)) - 1)); if (XINT (XCAR (tmp)) == 0) { font_clear_cache (f, XCAR (val), driver); @@ -2698,7 +2698,7 @@ font_delete_unmatched (Lisp_Object vec, Lisp_Object spec, int size) continue; } for (prop = FONT_WEIGHT_INDEX; prop < FONT_SIZE_INDEX; prop++) - if (INTEGERP (AREF (spec, prop)) + if (FIXNUMP (AREF (spec, prop)) && ((XINT (AREF (spec, prop)) >> 8) != (XINT (AREF (entity, prop)) >> 8))) prop = FONT_SPEC_MAX; @@ -2712,14 +2712,14 @@ font_delete_unmatched (Lisp_Object vec, Lisp_Object spec, int size) prop = FONT_SPEC_MAX; } if (prop < FONT_SPEC_MAX - && INTEGERP (AREF (spec, FONT_DPI_INDEX)) - && INTEGERP (AREF (entity, FONT_DPI_INDEX)) + && FIXNUMP (AREF (spec, FONT_DPI_INDEX)) + && FIXNUMP (AREF (entity, FONT_DPI_INDEX)) && XINT (AREF (entity, FONT_DPI_INDEX)) != 0 && ! EQ (AREF (spec, FONT_DPI_INDEX), AREF (entity, FONT_DPI_INDEX))) prop = FONT_SPEC_MAX; if (prop < FONT_SPEC_MAX - && INTEGERP (AREF (spec, FONT_AVGWIDTH_INDEX)) - && INTEGERP (AREF (entity, FONT_AVGWIDTH_INDEX)) + && FIXNUMP (AREF (spec, FONT_AVGWIDTH_INDEX)) + && FIXNUMP (AREF (entity, FONT_AVGWIDTH_INDEX)) && XINT (AREF (entity, FONT_AVGWIDTH_INDEX)) != 0 && ! EQ (AREF (spec, FONT_AVGWIDTH_INDEX), AREF (entity, FONT_AVGWIDTH_INDEX))) @@ -2747,7 +2747,7 @@ font_list_entities (struct frame *f, Lisp_Object spec) eassert (FONT_SPEC_P (spec)); - if (INTEGERP (AREF (spec, FONT_SIZE_INDEX))) + if (FIXNUMP (AREF (spec, FONT_SIZE_INDEX))) size = XINT (AREF (spec, FONT_SIZE_INDEX)); else if (FLOATP (AREF (spec, FONT_SIZE_INDEX))) size = font_pixel_size (f, spec); @@ -2824,7 +2824,7 @@ font_matching_entity (struct frame *f, Lisp_Object *attrs, Lisp_Object spec) size = AREF (spec, FONT_SIZE_INDEX); if (FLOATP (size)) - ASET (work, FONT_SIZE_INDEX, make_number (font_pixel_size (f, spec))); + ASET (work, FONT_SIZE_INDEX, make_fixnum (font_pixel_size (f, spec))); FONT_SET_STYLE (work, FONT_WEIGHT_INDEX, attrs[LFACE_WEIGHT_INDEX]); FONT_SET_STYLE (work, FONT_SLANT_INDEX, attrs[LFACE_SLANT_INDEX]); FONT_SET_STYLE (work, FONT_WIDTH_INDEX, attrs[LFACE_SWIDTH_INDEX]); @@ -2910,7 +2910,7 @@ font_open_entity (struct frame *f, Lisp_Object entity, int pixel_size) if (psize > pixel_size + 15) return Qnil; } - ASET (font_object, FONT_SIZE_INDEX, make_number (pixel_size)); + ASET (font_object, FONT_SIZE_INDEX, make_fixnum (pixel_size)); FONT_ADD_LOG ("open", entity, font_object); ASET (entity, FONT_OBJLIST_INDEX, Fcons (font_object, AREF (entity, FONT_OBJLIST_INDEX))); @@ -3133,7 +3133,7 @@ font_select_entity (struct frame *f, Lisp_Object entities, FONT_SET_STYLE (prefer, FONT_SLANT_INDEX, attrs[LFACE_SLANT_INDEX]); if (NILP (AREF (prefer, FONT_WIDTH_INDEX))) FONT_SET_STYLE (prefer, FONT_WIDTH_INDEX, attrs[LFACE_SWIDTH_INDEX]); - ASET (prefer, FONT_SIZE_INDEX, make_number (pixel_size)); + ASET (prefer, FONT_SIZE_INDEX, make_fixnum (pixel_size)); return font_sort_entities (entities, prefer, f, c); } @@ -3179,7 +3179,7 @@ font_find_for_lface (struct frame *f, Lisp_Object *attrs, Lisp_Object spec, int work = copy_font_spec (spec); ASET (work, FONT_TYPE_INDEX, AREF (spec, FONT_TYPE_INDEX)); pixel_size = font_pixel_size (f, spec); - if (pixel_size == 0 && INTEGERP (attrs[LFACE_HEIGHT_INDEX])) + if (pixel_size == 0 && FIXNUMP (attrs[LFACE_HEIGHT_INDEX])) { double pt = XINT (attrs[LFACE_HEIGHT_INDEX]); @@ -3298,7 +3298,7 @@ font_open_for_lface (struct frame *f, Lisp_Object entity, Lisp_Object *attrs, Li { int size; - if (INTEGERP (AREF (entity, FONT_SIZE_INDEX)) + if (FIXNUMP (AREF (entity, FONT_SIZE_INDEX)) && XINT (AREF (entity, FONT_SIZE_INDEX)) > 0) size = XINT (AREF (entity, FONT_SIZE_INDEX)); else @@ -3308,13 +3308,13 @@ font_open_for_lface (struct frame *f, Lisp_Object entity, Lisp_Object *attrs, Li else { double pt; - if (INTEGERP (attrs[LFACE_HEIGHT_INDEX])) + if (FIXNUMP (attrs[LFACE_HEIGHT_INDEX])) pt = XINT (attrs[LFACE_HEIGHT_INDEX]); else { struct face *def = FACE_FROM_ID (f, DEFAULT_FACE_ID); Lisp_Object height = def->lface[LFACE_HEIGHT_INDEX]; - eassert (INTEGERP (height)); + eassert (FIXNUMP (height)); pt = XINT (height); } @@ -3324,7 +3324,7 @@ font_open_for_lface (struct frame *f, Lisp_Object entity, Lisp_Object *attrs, Li if (size == 0) { Lisp_Object ffsize = get_frame_param (f, Qfontsize); - size = (NUMBERP (ffsize) + size = (FIXED_OR_FLOATP (ffsize) ? POINT_TO_PIXEL (XINT (ffsize), FRAME_RES_Y (f)) : 0); } #endif @@ -3372,7 +3372,7 @@ font_load_for_lface (struct frame *f, Lisp_Object *attrs, Lisp_Object spec) Lisp_Object lsize = Ffont_get (spec, QCsize); if ((FLOATP (lsize) && XFLOAT_DATA (lsize) == font_size) - || (INTEGERP (lsize) && XINT (lsize) == font_size)) + || (FIXNUMP (lsize) && XINT (lsize) == font_size)) { ASET (spec, FONT_FAMILY_INDEX, font_intern_prop (p, tail - p, 1)); @@ -3433,9 +3433,9 @@ font_open_by_spec (struct frame *f, Lisp_Object spec) attrs[LFACE_SWIDTH_INDEX] = attrs[LFACE_WEIGHT_INDEX] = attrs[LFACE_SLANT_INDEX] = Qnormal; #ifndef HAVE_NS - attrs[LFACE_HEIGHT_INDEX] = make_number (120); + attrs[LFACE_HEIGHT_INDEX] = make_fixnum (120); #else - attrs[LFACE_HEIGHT_INDEX] = make_number (0); + attrs[LFACE_HEIGHT_INDEX] = make_fixnum (0); #endif attrs[LFACE_FONT_INDEX] = Qnil; @@ -3673,7 +3673,7 @@ font_filter_properties (Lisp_Object font, if (strcmp (boolean_properties[i], keystr) == 0) { - const char *str = INTEGERP (val) ? (XINT (val) ? "true" : "false") + const char *str = FIXNUMP (val) ? (XINT (val) ? "true" : "false") : SYMBOLP (val) ? SSDATA (SYMBOL_NAME (val)) : "true"; @@ -3827,7 +3827,7 @@ font_range (ptrdiff_t pos, ptrdiff_t pos_byte, ptrdiff_t *limit, else FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, pos, pos_byte); category = CHAR_TABLE_REF (Vunicode_category_table, c); - if (INTEGERP (category) + if (FIXNUMP (category) && (XINT (category) == UNICODE_CATEGORY_Cf || CHAR_VARIATION_SELECTOR_P (c))) continue; @@ -4142,17 +4142,17 @@ are to be displayed on. If omitted, the selected frame is used. */) } val = AREF (font, FONT_SIZE_INDEX); - if (INTEGERP (val)) + if (FIXNUMP (val)) { Lisp_Object font_dpi = AREF (font, FONT_DPI_INDEX); - int dpi = INTEGERP (font_dpi) ? XINT (font_dpi) : FRAME_RES_Y (f); + int dpi = FIXNUMP (font_dpi) ? XINT (font_dpi) : FRAME_RES_Y (f); plist[n++] = QCheight; - plist[n++] = make_number (PIXEL_TO_POINT (XINT (val) * 10, dpi)); + plist[n++] = make_fixnum (PIXEL_TO_POINT (XINT (val) * 10, dpi)); } else if (FLOATP (val)) { plist[n++] = QCheight; - plist[n++] = make_number (10 * (int) XFLOAT_DATA (val)); + plist[n++] = make_fixnum (10 * (int) XFLOAT_DATA (val)); } val = FONT_WEIGHT_FOR_FACE (font); @@ -4231,7 +4231,7 @@ how close they are to PREFER. */) CHECK_FONT_SPEC (font_spec); if (! NILP (num)) { - CHECK_NUMBER (num); + CHECK_FIXNUM (num); n = XINT (num); if (n <= 0) return Qnil; @@ -4289,7 +4289,7 @@ DEFUN ("find-font", Ffind_font, Sfind_font, 1, 2, 0, Optional 2nd argument FRAME, if non-nil, specifies the target frame. */) (Lisp_Object font_spec, Lisp_Object frame) { - Lisp_Object val = Flist_fonts (font_spec, frame, make_number (1), Qnil); + Lisp_Object val = Flist_fonts (font_spec, frame, make_fixnum (1), Qnil); if (CONSP (val)) val = XCAR (val); @@ -4427,7 +4427,7 @@ GSTRING. */) for (i = 0; i < 3; i++) { n = font->driver->shape (gstring); - if (INTEGERP (n)) + if (FIXNUMP (n)) break; gstring = larger_vector (gstring, LGSTRING_GLYPH_LEN (gstring), -1); @@ -4504,7 +4504,7 @@ where { int vs = (i < 16 ? 0xFE00 + i : 0xE0100 + (i - 16)); Lisp_Object code = INTEGER_TO_CONS (variations[i]); - val = Fcons (Fcons (make_number (vs), code), val); + val = Fcons (Fcons (make_fixnum (vs), code), val); } return val; } @@ -4566,16 +4566,16 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0, Lisp_Object window; struct window *w; - CHECK_NUMBER_COERCE_MARKER (position); + CHECK_FIXNUM_COERCE_MARKER (position); if (! (BEGV <= XINT (position) && XINT (position) < ZV)) - args_out_of_range_3 (position, make_number (BEGV), make_number (ZV)); + args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV)); pos = XINT (position); pos_byte = CHAR_TO_BYTE (pos); if (NILP (ch)) c = FETCH_CHAR (pos_byte); else { - CHECK_NATNUM (ch); + CHECK_FIXNAT (ch); c = XINT (ch); } window = Fget_buffer_window (Fcurrent_buffer (), Qnil); @@ -4665,20 +4665,20 @@ glyph-string. */) CHECK_CONS (val); len = check_gstring (gstring_in); CHECK_VECTOR (gstring_out); - CHECK_NATNUM (from); - CHECK_NATNUM (to); - CHECK_NATNUM (index); + CHECK_FIXNAT (from); + CHECK_FIXNAT (to); + CHECK_FIXNAT (index); if (XINT (from) >= XINT (to) || XINT (to) > len) - args_out_of_range_3 (from, to, make_number (len)); + args_out_of_range_3 (from, to, make_fixnum (len)); if (XINT (index) >= ASIZE (gstring_out)) - args_out_of_range (index, make_number (ASIZE (gstring_out))); + args_out_of_range (index, make_fixnum (ASIZE (gstring_out))); num = font->driver->otf_drive (font, otf_features, gstring_in, XINT (from), XINT (to), gstring_out, XINT (index), 0); if (num < 0) return Qnil; - return make_number (num); + return make_fixnum (num); } DEFUN ("font-otf-alternates", Ffont_otf_alternates, Sfont_otf_alternates, @@ -4706,14 +4706,14 @@ corresponding character. */) CHECK_CHARACTER (character); CHECK_CONS (otf_features); - gstring_in = Ffont_make_gstring (font_object, make_number (1)); + gstring_in = Ffont_make_gstring (font_object, make_fixnum (1)); g = LGSTRING_GLYPH (gstring_in, 0); LGLYPH_SET_CHAR (g, XINT (character)); - gstring_out = Ffont_make_gstring (font_object, make_number (10)); + gstring_out = Ffont_make_gstring (font_object, make_fixnum (10)); while ((num = font->driver->otf_drive (font, otf_features, gstring_in, 0, 1, gstring_out, 0, 1)) < 0) gstring_out = Ffont_make_gstring (font_object, - make_number (ASIZE (gstring_out) * 2)); + make_fixnum (ASIZE (gstring_out) * 2)); alternates = Qnil; for (i = 0; i < num; i++) { @@ -4721,8 +4721,8 @@ corresponding character. */) int c = LGLYPH_CHAR (g); unsigned code = LGLYPH_CODE (g); - alternates = Fcons (Fcons (make_number (code), - c > 0 ? make_number (c) : Qnil), + alternates = Fcons (Fcons (make_fixnum (code), + c > 0 ? make_fixnum (c) : Qnil), alternates); } return Fnreverse (alternates); @@ -4744,7 +4744,7 @@ DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0, isize = XINT (AREF (font_entity, FONT_SIZE_INDEX)); else { - CHECK_NUMBER_OR_FLOAT (size); + CHECK_FIXNUM_OR_FLOAT (size); if (FLOATP (size)) isize = POINT_TO_PIXEL (XFLOAT_DATA (size), FRAME_RES_Y (f)); else @@ -4814,12 +4814,12 @@ If the font is not OpenType font, CAPABILITY is nil. */) ASET (val, 0, AREF (font_object, FONT_NAME_INDEX)); ASET (val, 1, AREF (font_object, FONT_FILE_INDEX)); - ASET (val, 2, make_number (font->pixel_size)); - ASET (val, 3, make_number (font->max_width)); - ASET (val, 4, make_number (font->ascent)); - ASET (val, 5, make_number (font->descent)); - ASET (val, 6, make_number (font->space_width)); - ASET (val, 7, make_number (font->average_width)); + ASET (val, 2, make_fixnum (font->pixel_size)); + ASET (val, 3, make_fixnum (font->max_width)); + ASET (val, 4, make_fixnum (font->ascent)); + ASET (val, 5, make_fixnum (font->descent)); + ASET (val, 6, make_fixnum (font->space_width)); + ASET (val, 7, make_fixnum (font->average_width)); if (font->driver->otf_capability) ASET (val, 8, Fcons (Qopentype, font->driver->otf_capability (font))); else @@ -4870,7 +4870,7 @@ the corresponding element is nil. */) { int c; FETCH_CHAR_ADVANCE (c, charpos, bytepos); - chars[i] = make_number (c); + chars[i] = make_fixnum (c); } } else if (STRINGP (object)) @@ -4896,12 +4896,12 @@ the corresponding element is nil. */) for (i = 0; i < len; i++) { c = STRING_CHAR_ADVANCE (p); - chars[i] = make_number (c); + chars[i] = make_fixnum (c); } } else for (i = 0; i < len; i++) - chars[i] = make_number (p[ifrom + i]); + chars[i] = make_fixnum (p[ifrom + i]); } else if (VECTORP (object)) { @@ -4978,13 +4978,13 @@ character at index specified by POSITION. */) { if (XBUFFER (w->contents) != current_buffer) error ("Specified window is not displaying the current buffer"); - CHECK_NUMBER_COERCE_MARKER (position); + CHECK_FIXNUM_COERCE_MARKER (position); if (! (BEGV <= XINT (position) && XINT (position) < ZV)) - args_out_of_range_3 (position, make_number (BEGV), make_number (ZV)); + args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV)); } else { - CHECK_NUMBER (position); + CHECK_FIXNUM (position); CHECK_STRING (string); if (! (0 <= XINT (position) && XINT (position) < SCHARS (string))) args_out_of_range (string, position); @@ -5013,7 +5013,7 @@ Type C-l to recover what previously shown. */) code = alloca (sizeof (unsigned) * len); for (i = 0; i < len; i++) { - Lisp_Object ch = Faref (string, make_number (i)); + Lisp_Object ch = Faref (string, make_fixnum (i)); Lisp_Object val; int c = XINT (ch); @@ -5030,7 +5030,7 @@ Type C-l to recover what previously shown. */) if (font->driver->done_face) font->driver->done_face (f, face); face->fontp = NULL; - return make_number (len); + return make_fixnum (len); } #endif @@ -5133,16 +5133,16 @@ If the named font is not yet loaded, return nil. */) info = make_uninit_vector (14); ASET (info, 0, AREF (font_object, FONT_NAME_INDEX)); ASET (info, 1, AREF (font_object, FONT_FULLNAME_INDEX)); - ASET (info, 2, make_number (font->pixel_size)); - ASET (info, 3, make_number (font->height)); - ASET (info, 4, make_number (font->baseline_offset)); - ASET (info, 5, make_number (font->relative_compose)); - ASET (info, 6, make_number (font->default_ascent)); - ASET (info, 7, make_number (font->max_width)); - ASET (info, 8, make_number (font->ascent)); - ASET (info, 9, make_number (font->descent)); - ASET (info, 10, make_number (font->space_width)); - ASET (info, 11, make_number (font->average_width)); + ASET (info, 2, make_fixnum (font->pixel_size)); + ASET (info, 3, make_fixnum (font->height)); + ASET (info, 4, make_fixnum (font->baseline_offset)); + ASET (info, 5, make_fixnum (font->relative_compose)); + ASET (info, 6, make_fixnum (font->default_ascent)); + ASET (info, 7, make_fixnum (font->max_width)); + ASET (info, 8, make_fixnum (font->ascent)); + ASET (info, 9, make_fixnum (font->descent)); + ASET (info, 10, make_fixnum (font->space_width)); + ASET (info, 11, make_fixnum (font->average_width)); ASET (info, 12, AREF (font_object, FONT_FILE_INDEX)); if (font->driver->otf_capability) ASET (info, 13, Fcons (Qopentype, font->driver->otf_capability (font))); @@ -5172,8 +5172,8 @@ build_style_table (const struct table_entry *entry, int nelement) for (i = 0; i < nelement; i++) { for (j = 0; entry[i].names[j]; j++); - elt = Fmake_vector (make_number (j + 1), Qnil); - ASET (elt, 0, make_number (entry[i].numeric)); + elt = Fmake_vector (make_fixnum (j + 1), Qnil); + ASET (elt, 0, make_fixnum (entry[i].numeric)); for (j = 0; entry[i].names[j]; j++) ASET (elt, j + 1, intern_c_string (entry[i].names[j])); ASET (table, i, elt); @@ -5354,7 +5354,7 @@ syms_of_font (void) scratch_font_prefer = Ffont_spec (0, NULL); staticpro (&Vfont_log_deferred); - Vfont_log_deferred = Fmake_vector (make_number (3), Qnil); + Vfont_log_deferred = Fmake_vector (make_fixnum (3), Qnil); #if 0 #ifdef HAVE_LIBOTF diff --git a/src/font.h b/src/font.h index e84c6f3ff8..62a9920e59 100644 --- a/src/font.h +++ b/src/font.h @@ -185,15 +185,15 @@ enum font_property_index /* Return the numeric weight value of FONT. */ #define FONT_WEIGHT_NUMERIC(font) \ - (INTEGERP (AREF ((font), FONT_WEIGHT_INDEX)) \ + (FIXNUMP (AREF ((font), FONT_WEIGHT_INDEX)) \ ? (XINT (AREF ((font), FONT_WEIGHT_INDEX)) >> 8) : -1) /* Return the numeric slant value of FONT. */ #define FONT_SLANT_NUMERIC(font) \ - (INTEGERP (AREF ((font), FONT_SLANT_INDEX)) \ + (FIXNUMP (AREF ((font), FONT_SLANT_INDEX)) \ ? (XINT (AREF ((font), FONT_SLANT_INDEX)) >> 8) : -1) /* Return the numeric width value of FONT. */ #define FONT_WIDTH_NUMERIC(font) \ - (INTEGERP (AREF ((font), FONT_WIDTH_INDEX)) \ + (FIXNUMP (AREF ((font), FONT_WIDTH_INDEX)) \ ? (XINT (AREF ((font), FONT_WIDTH_INDEX)) >> 8) : -1) /* Return the symbolic weight value of FONT. */ #define FONT_WEIGHT_SYMBOLIC(font) \ @@ -228,7 +228,7 @@ enum font_property_index style-related font property index (FONT_WEIGHT/SLANT/WIDTH_INDEX). VAL (integer or symbol) is the numeric or symbolic style value. */ #define FONT_SET_STYLE(font, prop, val) \ - ASET ((font), prop, make_number (font_style_to_value (prop, val, true))) + ASET ((font), prop, make_fixnum (font_style_to_value (prop, val, true))) #ifndef MSDOS #define FONT_WIDTH(f) ((f)->max_width) diff --git a/src/fontset.c b/src/fontset.c index 6ca6406871..d4a2e4ea5b 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -266,7 +266,7 @@ set_fontset_fallback (Lisp_Object fontset, Lisp_Object fallback) #define RFONT_DEF_FACE(rfont_def) AREF (rfont_def, 0) #define RFONT_DEF_SET_FACE(rfont_def, face_id) \ - ASET ((rfont_def), 0, make_number (face_id)) + ASET ((rfont_def), 0, make_fixnum (face_id)) #define RFONT_DEF_FONT_DEF(rfont_def) AREF (rfont_def, 1) #define RFONT_DEF_SPEC(rfont_def) FONT_DEF_SPEC (AREF (rfont_def, 1)) #define RFONT_DEF_OBJECT(rfont_def) AREF (rfont_def, 2) @@ -278,10 +278,10 @@ set_fontset_fallback (Lisp_Object fontset, Lisp_Object fallback) preferable. */ #define RFONT_DEF_SCORE(rfont_def) XINT (AREF (rfont_def, 3)) #define RFONT_DEF_SET_SCORE(rfont_def, score) \ - ASET ((rfont_def), 3, make_number (score)) + ASET ((rfont_def), 3, make_fixnum (score)) #define RFONT_DEF_NEW(rfont_def, font_def) \ do { \ - (rfont_def) = Fmake_vector (make_number (4), Qnil); \ + (rfont_def) = Fmake_vector (make_fixnum (4), Qnil); \ ASET ((rfont_def), 1, (font_def)); \ RFONT_DEF_SET_SCORE ((rfont_def), 0); \ } while (0) @@ -328,10 +328,10 @@ fontset_ref (Lisp_Object fontset, int c) (NILP (add) \ ? (NILP (range) \ ? (set_fontset_fallback \ - (fontset, Fmake_vector (make_number (1), (elt)))) \ + (fontset, Fmake_vector (make_fixnum (1), (elt)))) \ : ((void) \ Fset_char_table_range (fontset, range, \ - Fmake_vector (make_number (1), elt)))) \ + Fmake_vector (make_fixnum (1), elt)))) \ : fontset_add ((fontset), (range), (elt), (add))) static void @@ -340,7 +340,7 @@ fontset_add (Lisp_Object fontset, Lisp_Object range, Lisp_Object elt, Lisp_Objec Lisp_Object args[2]; int idx = (EQ (add, Qappend) ? 0 : 1); - args[1 - idx] = Fmake_vector (make_number (1), elt); + args[1 - idx] = Fmake_vector (make_fixnum (1), elt); if (CONSP (range)) { @@ -456,7 +456,7 @@ reorder_font_vector (Lisp_Object font_group, struct font *font) qsort (XVECTOR (vec)->contents, size, word_size, fontset_compare_rfontdef); EMACS_INT low_tick_bits = charset_ordered_list_tick & MOST_POSITIVE_FIXNUM; - XSETCAR (font_group, make_number (low_tick_bits)); + XSETCAR (font_group, make_fixnum (low_tick_bits)); } /* Return a font-group (actually a cons (CHARSET_ORDERED_LIST_TICK @@ -496,7 +496,7 @@ fontset_get_font_group (Lisp_Object fontset, int c) for C, or the fontset does not have fallback fonts. */ if (NILP (font_group)) { - font_group = make_number (0); + font_group = make_fixnum (0); if (c >= 0) /* Record that FONTSET does not specify fonts for C. As there's a possibility that a font is found in a fallback @@ -520,7 +520,7 @@ fontset_get_font_group (Lisp_Object fontset, int c) RFONT_DEF_SET_SCORE (rfont_def, i); ASET (font_group, i, rfont_def); } - font_group = Fcons (make_number (-1), font_group); + font_group = Fcons (make_fixnum (-1), font_group); if (c >= 0) char_table_set_range (fontset, from, to, font_group); else @@ -633,7 +633,7 @@ fontset_find_font (Lisp_Object fontset, int c, struct face *face, /* This is a sign of not to try the other fonts. */ return Qt; } - if (INTEGERP (RFONT_DEF_FACE (rfont_def)) + if (FIXNUMP (RFONT_DEF_FACE (rfont_def)) && XINT (RFONT_DEF_FACE (rfont_def)) < 0) /* We couldn't open this font last time. */ continue; @@ -711,7 +711,7 @@ fontset_find_font (Lisp_Object fontset, int c, struct face *face, RFONT_DEF_NEW (rfont_def, font_def); RFONT_DEF_SET_OBJECT (rfont_def, font_object); RFONT_DEF_SET_SCORE (rfont_def, RFONT_DEF_SCORE (rfont_def)); - new_vec = Fmake_vector (make_number (ASIZE (vec) + 1), Qnil); + new_vec = Fmake_vector (make_fixnum (ASIZE (vec) + 1), Qnil); found_index++; for (j = 0; j < found_index; j++) ASET (new_vec, j, AREF (vec, j)); @@ -727,7 +727,7 @@ fontset_find_font (Lisp_Object fontset, int c, struct face *face, } /* Record that no font in this font group supports C. */ - FONTSET_SET (fontset, make_number (c), make_number (0)); + FONTSET_SET (fontset, make_fixnum (c), make_fixnum (0)); return Qnil; found: @@ -756,12 +756,12 @@ fontset_font (Lisp_Object fontset, int c, struct face *face, int id) Lisp_Object base_fontset; /* Try a font-group of FONTSET. */ - FONT_DEFERRED_LOG ("current fontset: font for", make_number (c), Qnil); + FONT_DEFERRED_LOG ("current fontset: font for", make_fixnum (c), Qnil); rfont_def = fontset_find_font (fontset, c, face, id, 0); if (VECTORP (rfont_def)) return rfont_def; if (NILP (rfont_def)) - FONTSET_SET (fontset, make_number (c), make_number (0)); + FONTSET_SET (fontset, make_fixnum (c), make_fixnum (0)); /* Try a font-group of the default fontset. */ base_fontset = FONTSET_BASE (fontset); @@ -771,37 +771,37 @@ fontset_font (Lisp_Object fontset, int c, struct face *face, int id) set_fontset_default (fontset, make_fontset (FONTSET_FRAME (fontset), Qnil, Vdefault_fontset)); - FONT_DEFERRED_LOG ("default fontset: font for", make_number (c), Qnil); + FONT_DEFERRED_LOG ("default fontset: font for", make_fixnum (c), Qnil); default_rfont_def = fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 0); if (VECTORP (default_rfont_def)) return default_rfont_def; if (NILP (default_rfont_def)) - FONTSET_SET (FONTSET_DEFAULT (fontset), make_number (c), - make_number (0)); + FONTSET_SET (FONTSET_DEFAULT (fontset), make_fixnum (c), + make_fixnum (0)); } /* Try a fallback font-group of FONTSET. */ if (! EQ (rfont_def, Qt)) { - FONT_DEFERRED_LOG ("current fallback: font for", make_number (c), Qnil); + FONT_DEFERRED_LOG ("current fallback: font for", make_fixnum (c), Qnil); rfont_def = fontset_find_font (fontset, c, face, id, 1); if (VECTORP (rfont_def)) return rfont_def; /* Remember that FONTSET has no font for C. */ - FONTSET_SET (fontset, make_number (c), Qt); + FONTSET_SET (fontset, make_fixnum (c), Qt); } /* Try a fallback font-group of the default fontset. */ if (! EQ (base_fontset, Vdefault_fontset) && ! EQ (default_rfont_def, Qt)) { - FONT_DEFERRED_LOG ("default fallback: font for", make_number (c), Qnil); + FONT_DEFERRED_LOG ("default fallback: font for", make_fixnum (c), Qnil); rfont_def = fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 1); if (VECTORP (rfont_def)) return rfont_def; /* Remember that the default fontset has no font for C. */ - FONTSET_SET (FONTSET_DEFAULT (fontset), make_number (c), Qt); + FONTSET_SET (FONTSET_DEFAULT (fontset), make_fixnum (c), Qt); } return Qnil; @@ -830,7 +830,7 @@ make_fontset (Lisp_Object frame, Lisp_Object name, Lisp_Object base) fontset = Fmake_char_table (Qfontset, Qnil); - set_fontset_id (fontset, make_number (id)); + set_fontset_id (fontset, make_fixnum (id)); if (NILP (base)) set_fontset_name (fontset, name); else @@ -973,7 +973,7 @@ face_for_char (struct frame *f, struct face *face, int c, } else { - charset = Fget_char_property (make_number (pos), Qcharset, object); + charset = Fget_char_property (make_fixnum (pos), Qcharset, object); if (CHARSETP (charset)) { Lisp_Object val; @@ -990,7 +990,7 @@ face_for_char (struct frame *f, struct face *face, int c, rfont_def = fontset_font (fontset, c, face, id); if (VECTORP (rfont_def)) { - if (INTEGERP (RFONT_DEF_FACE (rfont_def))) + if (FIXNUMP (RFONT_DEF_FACE (rfont_def))) face_id = XINT (RFONT_DEF_FACE (rfont_def)); else { @@ -1003,12 +1003,12 @@ face_for_char (struct frame *f, struct face *face, int c, } else { - if (INTEGERP (FONTSET_NOFONT_FACE (fontset))) + if (FIXNUMP (FONTSET_NOFONT_FACE (fontset))) face_id = XINT (FONTSET_NOFONT_FACE (fontset)); else { face_id = face_for_font (f, Qnil, face); - set_fontset_nofont_face (fontset, make_number (face_id)); + set_fontset_nofont_face (fontset, make_fixnum (face_id)); } } eassert (face_id >= 0); @@ -1040,7 +1040,7 @@ font_for_char (struct face *face, int c, ptrdiff_t pos, Lisp_Object object) } else { - charset = Fget_char_property (make_number (pos), Qcharset, object); + charset = Fget_char_property (make_fixnum (pos), Qcharset, object); if (CHARSETP (charset)) { Lisp_Object val; @@ -1412,7 +1412,7 @@ set_fontset_font (Lisp_Object arg, Lisp_Object range) if (to < 0x80) return; from = 0x80; - range = Fcons (make_number (0x80), XCDR (range)); + range = Fcons (make_fixnum (0x80), XCDR (range)); } #define SCRIPT_FROM XINT (XCAR (XCAR (script_range_list))) @@ -1424,11 +1424,11 @@ set_fontset_font (Lisp_Object arg, Lisp_Object range) if (CONSP (script_range_list)) { if (SCRIPT_FROM < from) - range = Fcons (make_number (SCRIPT_FROM), XCDR (range)); + range = Fcons (make_fixnum (SCRIPT_FROM), XCDR (range)); while (CONSP (script_range_list) && SCRIPT_TO <= to) POP_SCRIPT_RANGE (); if (CONSP (script_range_list) && SCRIPT_FROM <= to) - XSETCAR (XCAR (script_range_list), make_number (to + 1)); + XSETCAR (XCAR (script_range_list), make_fixnum (to + 1)); } FONTSET_ADD (fontset, range, font_def, add); @@ -2000,7 +2000,7 @@ patterns. */) if (NILP (val)) return Qnil; repertory = AREF (val, 1); - if (INTEGERP (repertory)) + if (FIXNUMP (repertory)) { struct charset *charset = CHARSET_FROM_ID (XINT (repertory)); @@ -2061,7 +2061,7 @@ dump_fontset (Lisp_Object fontset) { Lisp_Object vec; - vec = Fmake_vector (make_number (3), Qnil); + vec = Fmake_vector (make_fixnum (3), Qnil); ASET (vec, 0, FONTSET_ID (fontset)); if (BASE_FONTSET_P (fontset)) @@ -2109,9 +2109,9 @@ void syms_of_fontset (void) { DEFSYM (Qfontset, "fontset"); - Fput (Qfontset, Qchar_table_extra_slots, make_number (8)); + Fput (Qfontset, Qchar_table_extra_slots, make_fixnum (8)); DEFSYM (Qfontset_info, "fontset-info"); - Fput (Qfontset_info, Qchar_table_extra_slots, make_number (1)); + Fput (Qfontset_info, Qchar_table_extra_slots, make_fixnum (1)); DEFSYM (Qappend, "append"); DEFSYM (Qlatin, "latin"); @@ -2119,12 +2119,12 @@ syms_of_fontset (void) Vcached_fontset_data = Qnil; staticpro (&Vcached_fontset_data); - Vfontset_table = Fmake_vector (make_number (32), Qnil); + Vfontset_table = Fmake_vector (make_fixnum (32), Qnil); staticpro (&Vfontset_table); Vdefault_fontset = Fmake_char_table (Qfontset, Qnil); staticpro (&Vdefault_fontset); - set_fontset_id (Vdefault_fontset, make_number (0)); + set_fontset_id (Vdefault_fontset, make_fixnum (0)); set_fontset_name (Vdefault_fontset, build_pure_c_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default")); diff --git a/src/frame.c b/src/frame.c index d477c1acc3..e13b392eca 100644 --- a/src/frame.c +++ b/src/frame.c @@ -158,17 +158,17 @@ frame_size_history_add (struct frame *f, Lisp_Object fun_symbol, XSETFRAME (frame, f); if (CONSP (frame_size_history) - && INTEGERP (XCAR (frame_size_history)) + && FIXNUMP (XCAR (frame_size_history)) && 0 < XINT (XCAR (frame_size_history))) frame_size_history = - Fcons (make_number (XINT (XCAR (frame_size_history)) - 1), + Fcons (make_fixnum (XINT (XCAR (frame_size_history)) - 1), Fcons (list4 (frame, fun_symbol, ((width > 0) - ? list4 (make_number (FRAME_TEXT_WIDTH (f)), - make_number (FRAME_TEXT_HEIGHT (f)), - make_number (width), - make_number (height)) + ? list4 (make_fixnum (FRAME_TEXT_WIDTH (f)), + make_fixnum (FRAME_TEXT_HEIGHT (f)), + make_fixnum (width), + make_fixnum (height)) : Qnil), rest), XCDR (frame_size_history))); @@ -219,7 +219,7 @@ set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) if (FRAME_MINIBUF_ONLY_P (f)) return; - if (TYPE_RANGED_INTEGERP (int, value)) + if (TYPE_RANGED_FIXNUMP (int, value)) nlines = XINT (value); else nlines = 0; @@ -322,7 +322,7 @@ DEFUN ("frame-windows-min-size", Fframe_windows_min_size, (Lisp_Object frame, Lisp_Object horizontal, Lisp_Object ignore, Lisp_Object pixelwise) { - return make_number (0); + return make_fixnum (0); } /** @@ -355,9 +355,9 @@ frame_windows_min_size (Lisp_Object frame, Lisp_Object horizontal, int retval; if ((!NILP (horizontal) - && NUMBERP (par_size = get_frame_param (f, Qmin_width))) + && FIXED_OR_FLOATP (par_size = get_frame_param (f, Qmin_width))) || (NILP (horizontal) - && NUMBERP (par_size = get_frame_param (f, Qmin_height)))) + && FIXED_OR_FLOATP (par_size = get_frame_param (f, Qmin_height)))) { int min_size = XINT (par_size); @@ -596,7 +596,7 @@ adjust_frame_size (struct frame *f, int new_width, int new_height, int inhibit, frame_size_history_add (f, Qadjust_frame_size_1, new_text_width, new_text_height, - list2 (parameter, make_number (inhibit))); + list2 (parameter, make_fixnum (inhibit))); /* The following two values are calculated from the old window body sizes and any "new" settings for scroll bars, dividers, fringes and @@ -742,8 +742,8 @@ adjust_frame_size (struct frame *f, int new_width, int new_height, int inhibit, frame_size_history_add (f, Qadjust_frame_size_3, new_text_width, new_text_height, - list4 (make_number (old_pixel_width), make_number (old_pixel_height), - make_number (new_pixel_width), make_number (new_pixel_height))); + list4 (make_fixnum (old_pixel_width), make_fixnum (old_pixel_height), + make_fixnum (new_pixel_width), make_fixnum (new_pixel_height))); /* Assign new sizes. */ FRAME_TEXT_WIDTH (f) = new_text_width; @@ -1080,7 +1080,7 @@ make_initial_frame (void) #endif /* The default value of menu-bar-mode is t. */ - set_menu_bar_lines (f, make_number (1), Qnil); + set_menu_bar_lines (f, make_fixnum (1), Qnil); /* Allocate glyph matrices. */ adjust_frame_glyphs (f); @@ -1598,7 +1598,7 @@ candidate_frame (Lisp_Object candidate, Lisp_Object frame, Lisp_Object minibuf) FRAME_FOCUS_FRAME (c))) return candidate; } - else if (INTEGERP (minibuf) && XINT (minibuf) == 0) + else if (FIXNUMP (minibuf) && XINT (minibuf) == 0) { if (FRAME_VISIBLE_P (c) || FRAME_ICONIFIED_P (c)) return candidate; @@ -1790,7 +1790,7 @@ check_minibuf_window (Lisp_Object frame, int select) if (WINDOWP (minibuf_window) && EQ (f->minibuffer_window, minibuf_window)) { - Lisp_Object frames, this, window = make_number (0); + Lisp_Object frames, this, window = make_fixnum (0); if (!EQ (frame, selected_frame) && FRAME_HAS_MINIBUF_P (XFRAME (selected_frame))) @@ -2989,7 +2989,7 @@ store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val) if (! FRAME_WINDOW_P (f)) { if (EQ (prop, Qmenu_bar_lines)) - set_menu_bar_lines (f, val, make_number (FRAME_MENU_BAR_LINES (f))); + set_menu_bar_lines (f, val, make_fixnum (FRAME_MENU_BAR_LINES (f))); else if (EQ (prop, Qname)) set_term_frame_name (f, val); } @@ -3062,13 +3062,13 @@ If FRAME is omitted or nil, return information on the currently selected frame. ? (f->new_height / FRAME_LINE_HEIGHT (f)) : f->new_height) : FRAME_LINES (f)); - store_in_alist (&alist, Qheight, make_number (height)); + store_in_alist (&alist, Qheight, make_fixnum (height)); width = (f->new_width ? (f->new_pixelwise ? (f->new_width / FRAME_COLUMN_WIDTH (f)) : f->new_width) : FRAME_COLS (f)); - store_in_alist (&alist, Qwidth, make_number (width)); + store_in_alist (&alist, Qwidth, make_fixnum (width)); store_in_alist (&alist, Qmodeline, (FRAME_WANTS_MODELINE_P (f) ? Qt : Qnil)); store_in_alist (&alist, Qunsplittable, (FRAME_NO_SPLIT_P (f) ? Qt : Qnil)); store_in_alist (&alist, Qbuffer_list, f->buffer_list); @@ -3120,7 +3120,7 @@ If FRAME is nil, describe the currently selected frame. */) else if (EQ (parameter, Qline_spacing) && f->extra_line_spacing == 0) /* If this is non-zero, we can't determine whether the user specified an integer or float value without looking through 'param_alist'. */ - value = make_number (0); + value = make_fixnum (0); else if (EQ (parameter, Qfont) && FRAME_X_P (f)) value = FRAME_FONT (f)->props[FONT_NAME_INDEX]; #endif /* HAVE_WINDOW_SYSTEM */ @@ -3241,10 +3241,10 @@ For a terminal frame, the value is always 1. */) struct frame *f = decode_any_frame (frame); if (FRAME_WINDOW_P (f)) - return make_number (FRAME_LINE_HEIGHT (f)); + return make_fixnum (FRAME_LINE_HEIGHT (f)); else #endif - return make_number (1); + return make_fixnum (1); } @@ -3260,10 +3260,10 @@ For a terminal screen, the value is always 1. */) struct frame *f = decode_any_frame (frame); if (FRAME_WINDOW_P (f)) - return make_number (FRAME_COLUMN_WIDTH (f)); + return make_fixnum (FRAME_COLUMN_WIDTH (f)); else #endif - return make_number (1); + return make_fixnum (1); } DEFUN ("frame-native-width", Fframe_native_width, @@ -3277,10 +3277,10 @@ If FRAME is omitted or nil, the selected frame is used. */) #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (f)) - return make_number (FRAME_PIXEL_WIDTH (f)); + return make_fixnum (FRAME_PIXEL_WIDTH (f)); else #endif - return make_number (FRAME_TOTAL_COLS (f)); + return make_fixnum (FRAME_TOTAL_COLS (f)); } DEFUN ("frame-native-height", Fframe_native_height, @@ -3303,10 +3303,10 @@ to `frame-height'). */) #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (f)) - return make_number (FRAME_PIXEL_HEIGHT (f)); + return make_fixnum (FRAME_PIXEL_HEIGHT (f)); else #endif - return make_number (FRAME_TOTAL_LINES (f)); + return make_fixnum (FRAME_TOTAL_LINES (f)); } DEFUN ("tool-bar-pixel-width", Ftool_bar_pixel_width, @@ -3321,93 +3321,93 @@ is used. */) struct frame *f = decode_any_frame (frame); if (FRAME_WINDOW_P (f)) - return make_number (FRAME_TOOLBAR_WIDTH (f)); + return make_fixnum (FRAME_TOOLBAR_WIDTH (f)); #endif - return make_number (0); + return make_fixnum (0); } DEFUN ("frame-text-cols", Fframe_text_cols, Sframe_text_cols, 0, 1, 0, doc: /* Return width in columns of FRAME's text area. */) (Lisp_Object frame) { - return make_number (FRAME_COLS (decode_any_frame (frame))); + return make_fixnum (FRAME_COLS (decode_any_frame (frame))); } DEFUN ("frame-text-lines", Fframe_text_lines, Sframe_text_lines, 0, 1, 0, doc: /* Return height in lines of FRAME's text area. */) (Lisp_Object frame) { - return make_number (FRAME_LINES (decode_any_frame (frame))); + return make_fixnum (FRAME_LINES (decode_any_frame (frame))); } DEFUN ("frame-total-cols", Fframe_total_cols, Sframe_total_cols, 0, 1, 0, doc: /* Return number of total columns of FRAME. */) (Lisp_Object frame) { - return make_number (FRAME_TOTAL_COLS (decode_any_frame (frame))); + return make_fixnum (FRAME_TOTAL_COLS (decode_any_frame (frame))); } DEFUN ("frame-total-lines", Fframe_total_lines, Sframe_total_lines, 0, 1, 0, doc: /* Return number of total lines of FRAME. */) (Lisp_Object frame) { - return make_number (FRAME_TOTAL_LINES (decode_any_frame (frame))); + return make_fixnum (FRAME_TOTAL_LINES (decode_any_frame (frame))); } DEFUN ("frame-text-width", Fframe_text_width, Sframe_text_width, 0, 1, 0, doc: /* Return text area width of FRAME in pixels. */) (Lisp_Object frame) { - return make_number (FRAME_TEXT_WIDTH (decode_any_frame (frame))); + return make_fixnum (FRAME_TEXT_WIDTH (decode_any_frame (frame))); } DEFUN ("frame-text-height", Fframe_text_height, Sframe_text_height, 0, 1, 0, doc: /* Return text area height of FRAME in pixels. */) (Lisp_Object frame) { - return make_number (FRAME_TEXT_HEIGHT (decode_any_frame (frame))); + return make_fixnum (FRAME_TEXT_HEIGHT (decode_any_frame (frame))); } DEFUN ("frame-scroll-bar-width", Fscroll_bar_width, Sscroll_bar_width, 0, 1, 0, doc: /* Return scroll bar width of FRAME in pixels. */) (Lisp_Object frame) { - return make_number (FRAME_SCROLL_BAR_AREA_WIDTH (decode_any_frame (frame))); + return make_fixnum (FRAME_SCROLL_BAR_AREA_WIDTH (decode_any_frame (frame))); } DEFUN ("frame-scroll-bar-height", Fscroll_bar_height, Sscroll_bar_height, 0, 1, 0, doc: /* Return scroll bar height of FRAME in pixels. */) (Lisp_Object frame) { - return make_number (FRAME_SCROLL_BAR_AREA_HEIGHT (decode_any_frame (frame))); + return make_fixnum (FRAME_SCROLL_BAR_AREA_HEIGHT (decode_any_frame (frame))); } DEFUN ("frame-fringe-width", Ffringe_width, Sfringe_width, 0, 1, 0, doc: /* Return fringe width of FRAME in pixels. */) (Lisp_Object frame) { - return make_number (FRAME_TOTAL_FRINGE_WIDTH (decode_any_frame (frame))); + return make_fixnum (FRAME_TOTAL_FRINGE_WIDTH (decode_any_frame (frame))); } DEFUN ("frame-internal-border-width", Fframe_internal_border_width, Sframe_internal_border_width, 0, 1, 0, doc: /* Return width of FRAME's internal border in pixels. */) (Lisp_Object frame) { - return make_number (FRAME_INTERNAL_BORDER_WIDTH (decode_any_frame (frame))); + return make_fixnum (FRAME_INTERNAL_BORDER_WIDTH (decode_any_frame (frame))); } DEFUN ("frame-right-divider-width", Fright_divider_width, Sright_divider_width, 0, 1, 0, doc: /* Return width (in pixels) of vertical window dividers on FRAME. */) (Lisp_Object frame) { - return make_number (FRAME_RIGHT_DIVIDER_WIDTH (decode_any_frame (frame))); + return make_fixnum (FRAME_RIGHT_DIVIDER_WIDTH (decode_any_frame (frame))); } DEFUN ("frame-bottom-divider-width", Fbottom_divider_width, Sbottom_divider_width, 0, 1, 0, doc: /* Return width (in pixels) of horizontal window dividers on FRAME. */) (Lisp_Object frame) { - return make_number (FRAME_BOTTOM_DIVIDER_WIDTH (decode_any_frame (frame))); + return make_fixnum (FRAME_BOTTOM_DIVIDER_WIDTH (decode_any_frame (frame))); } DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 4, 0, @@ -3497,7 +3497,7 @@ display. */) { register struct frame *f = decode_live_frame (frame); - return Fcons (make_number (f->left_pos), make_number (f->top_pos)); + return Fcons (make_fixnum (f->left_pos), make_fixnum (f->top_pos)); } DEFUN ("set-frame-position", Fset_frame_position, @@ -3689,10 +3689,10 @@ frame_float (struct frame *f, Lisp_Object val, enum frame_float_type what, } /* Workarea available. */ - parent_left = XINT (Fnth (make_number (0), workarea)); - parent_top = XINT (Fnth (make_number (1), workarea)); - parent_width = XINT (Fnth (make_number (2), workarea)); - parent_height = XINT (Fnth (make_number (3), workarea)); + parent_left = XINT (Fnth (make_fixnum (0), workarea)); + parent_top = XINT (Fnth (make_fixnum (1), workarea)); + parent_width = XINT (Fnth (make_fixnum (2), workarea)); + parent_height = XINT (Fnth (make_fixnum (3), workarea)); *parent_done = 1; } } @@ -3720,12 +3720,12 @@ frame_float (struct frame *f, Lisp_Object val, enum frame_float_type what, if (!NILP (outer_edges)) { outer_minus_text_width - = (XINT (Fnth (make_number (2), outer_edges)) - - XINT (Fnth (make_number (0), outer_edges)) + = (XINT (Fnth (make_fixnum (2), outer_edges)) + - XINT (Fnth (make_fixnum (0), outer_edges)) - FRAME_TEXT_WIDTH (f)); outer_minus_text_height - = (XINT (Fnth (make_number (3), outer_edges)) - - XINT (Fnth (make_number (1), outer_edges)) + = (XINT (Fnth (make_fixnum (3), outer_edges)) + - XINT (Fnth (make_fixnum (1), outer_edges)) - FRAME_TEXT_HEIGHT (f)); } else @@ -3874,10 +3874,10 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist) if (EQ (prop, Qwidth)) { - if (RANGED_INTEGERP (0, val, INT_MAX)) + if (RANGED_FIXNUMP (0, val, INT_MAX)) width = XFASTINT (val) * FRAME_COLUMN_WIDTH (f) ; else if (CONSP (val) && EQ (XCAR (val), Qtext_pixels) - && RANGED_INTEGERP (0, XCDR (val), INT_MAX)) + && RANGED_FIXNUMP (0, XCDR (val), INT_MAX)) width = XFASTINT (XCDR (val)); else if (FLOATP (val)) width = frame_float (f, val, FRAME_FLOAT_WIDTH, &parent_done, @@ -3885,10 +3885,10 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist) } else if (EQ (prop, Qheight)) { - if (RANGED_INTEGERP (0, val, INT_MAX)) + if (RANGED_FIXNUMP (0, val, INT_MAX)) height = XFASTINT (val) * FRAME_LINE_HEIGHT (f); else if (CONSP (val) && EQ (XCAR (val), Qtext_pixels) - && RANGED_INTEGERP (0, XCDR (val), INT_MAX)) + && RANGED_FIXNUMP (0, XCDR (val), INT_MAX)) height = XFASTINT (XCDR (val)); else if (FLOATP (val)) height = frame_float (f, val, FRAME_FLOAT_HEIGHT, &parent_done, @@ -3916,7 +3916,7 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist) store_frame_param (f, prop, val); param_index = Fget (prop, Qx_frame_parameter); - if (NATNUMP (param_index) + if (FIXNATP (param_index) && XFASTINT (param_index) < ARRAYELTS (frame_parms) && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)]) (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value); @@ -3928,7 +3928,7 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist) { left_no_change = 1; if (f->left_pos < 0) - left = list2 (Qplus, make_number (f->left_pos)); + left = list2 (Qplus, make_fixnum (f->left_pos)); else XSETINT (left, f->left_pos); } @@ -3936,13 +3936,13 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist) { top_no_change = 1; if (f->top_pos < 0) - top = list2 (Qplus, make_number (f->top_pos)); + top = list2 (Qplus, make_fixnum (f->top_pos)); else XSETINT (top, f->top_pos); } /* If one of the icon positions was not set, preserve or default it. */ - if (! TYPE_RANGED_INTEGERP (int, icon_left)) + if (! TYPE_RANGED_FIXNUMP (int, icon_left)) { #ifdef HAVE_X_WINDOWS icon_left_no_change = 1; @@ -3951,7 +3951,7 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist) if (NILP (icon_left)) XSETINT (icon_left, 0); } - if (! TYPE_RANGED_INTEGERP (int, icon_top)) + if (! TYPE_RANGED_FIXNUMP (int, icon_top)) { #ifdef HAVE_X_WINDOWS icon_top_no_change = 1; @@ -3981,8 +3981,8 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist) if ((!NILP (left) || !NILP (top)) && ! (left_no_change && top_no_change) - && ! (NUMBERP (left) && XINT (left) == f->left_pos - && NUMBERP (top) && XINT (top) == f->top_pos)) + && ! (FIXED_OR_FLOATP (left) && XINT (left) == f->left_pos + && FIXED_OR_FLOATP (top) && XINT (top) == f->top_pos)) { int leftpos = 0; int toppos = 0; @@ -3991,7 +3991,7 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist) f->size_hint_flags &= ~ (XNegative | YNegative); if (EQ (left, Qminus)) f->size_hint_flags |= XNegative; - else if (TYPE_RANGED_INTEGERP (int, left)) + else if (TYPE_RANGED_FIXNUMP (int, left)) { leftpos = XINT (left); if (leftpos < 0) @@ -3999,14 +3999,14 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist) } else if (CONSP (left) && EQ (XCAR (left), Qminus) && CONSP (XCDR (left)) - && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (left)), INT_MAX)) + && RANGED_FIXNUMP (-INT_MAX, XCAR (XCDR (left)), INT_MAX)) { leftpos = - XINT (XCAR (XCDR (left))); f->size_hint_flags |= XNegative; } else if (CONSP (left) && EQ (XCAR (left), Qplus) && CONSP (XCDR (left)) - && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (left)))) + && TYPE_RANGED_FIXNUMP (int, XCAR (XCDR (left)))) leftpos = XINT (XCAR (XCDR (left))); else if (FLOATP (left)) leftpos = frame_float (f, left, FRAME_FLOAT_LEFT, &parent_done, @@ -4014,7 +4014,7 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist) if (EQ (top, Qminus)) f->size_hint_flags |= YNegative; - else if (TYPE_RANGED_INTEGERP (int, top)) + else if (TYPE_RANGED_FIXNUMP (int, top)) { toppos = XINT (top); if (toppos < 0) @@ -4022,14 +4022,14 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist) } else if (CONSP (top) && EQ (XCAR (top), Qminus) && CONSP (XCDR (top)) - && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (top)), INT_MAX)) + && RANGED_FIXNUMP (-INT_MAX, XCAR (XCDR (top)), INT_MAX)) { toppos = - XINT (XCAR (XCDR (top))); f->size_hint_flags |= YNegative; } else if (CONSP (top) && EQ (XCAR (top), Qplus) && CONSP (XCDR (top)) - && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (top)))) + && TYPE_RANGED_FIXNUMP (int, XCAR (XCDR (top)))) toppos = XINT (XCAR (XCDR (top))); else if (FLOATP (top)) toppos = frame_float (f, top, FRAME_FLOAT_TOP, &parent_done, @@ -4096,31 +4096,31 @@ x_report_frame_params (struct frame *f, Lisp_Object *alistptr) store_in_alist (alistptr, Qtop, list2 (Qplus, tem)); store_in_alist (alistptr, Qborder_width, - make_number (f->border_width)); + make_fixnum (f->border_width)); store_in_alist (alistptr, Qinternal_border_width, - make_number (FRAME_INTERNAL_BORDER_WIDTH (f))); + make_fixnum (FRAME_INTERNAL_BORDER_WIDTH (f))); store_in_alist (alistptr, Qright_divider_width, - make_number (FRAME_RIGHT_DIVIDER_WIDTH (f))); + make_fixnum (FRAME_RIGHT_DIVIDER_WIDTH (f))); store_in_alist (alistptr, Qbottom_divider_width, - make_number (FRAME_BOTTOM_DIVIDER_WIDTH (f))); + make_fixnum (FRAME_BOTTOM_DIVIDER_WIDTH (f))); store_in_alist (alistptr, Qleft_fringe, - make_number (FRAME_LEFT_FRINGE_WIDTH (f))); + make_fixnum (FRAME_LEFT_FRINGE_WIDTH (f))); store_in_alist (alistptr, Qright_fringe, - make_number (FRAME_RIGHT_FRINGE_WIDTH (f))); + make_fixnum (FRAME_RIGHT_FRINGE_WIDTH (f))); store_in_alist (alistptr, Qscroll_bar_width, (! FRAME_HAS_VERTICAL_SCROLL_BARS (f) - ? make_number (0) + ? make_fixnum (0) : FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0 - ? make_number (FRAME_CONFIG_SCROLL_BAR_WIDTH (f)) + ? make_fixnum (FRAME_CONFIG_SCROLL_BAR_WIDTH (f)) /* nil means "use default width" for non-toolkit scroll bar. ruler-mode.el depends on this. */ : Qnil)); store_in_alist (alistptr, Qscroll_bar_height, (! FRAME_HAS_HORIZONTAL_SCROLL_BARS (f) - ? make_number (0) + ? make_fixnum (0) : FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) > 0 - ? make_number (FRAME_CONFIG_SCROLL_BAR_HEIGHT (f)) + ? make_fixnum (FRAME_CONFIG_SCROLL_BAR_HEIGHT (f)) /* nil means "use default height" for non-toolkit scroll bar. */ : Qnil)); @@ -4150,7 +4150,7 @@ x_report_frame_params (struct frame *f, Lisp_Object *alistptr) if (FRAME_X_OUTPUT (f)->parent_desc == FRAME_DISPLAY_INFO (f)->root_window) tem = Qnil; else - tem = make_natnum ((uintptr_t) FRAME_X_OUTPUT (f)->parent_desc); + tem = make_fixed_natnum ((uintptr_t) FRAME_X_OUTPUT (f)->parent_desc); store_in_alist (alistptr, Qexplicit_name, (f->explicit_name ? Qt : Qnil)); store_in_alist (alistptr, Qparent_id, tem); store_in_alist (alistptr, Qtool_bar_position, FRAME_TOOL_BAR_POSITION (f)); @@ -4187,7 +4187,7 @@ x_set_line_spacing (struct frame *f, Lisp_Object new_value, Lisp_Object old_valu { if (NILP (new_value)) f->extra_line_spacing = 0; - else if (RANGED_INTEGERP (0, new_value, INT_MAX)) + else if (RANGED_FIXNUMP (0, new_value, INT_MAX)) f->extra_line_spacing = XFASTINT (new_value); else if (FLOATP (new_value)) { @@ -4215,7 +4215,7 @@ x_set_screen_gamma (struct frame *f, Lisp_Object new_value, Lisp_Object old_valu if (NILP (new_value)) f->gamma = 0; - else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0) + else if (FIXED_OR_FLOATP (new_value) && XFLOATINT (new_value) > 0) /* The value 0.4545 is the normal viewing gamma. */ f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value)); else @@ -4226,7 +4226,7 @@ x_set_screen_gamma (struct frame *f, Lisp_Object new_value, Lisp_Object old_valu if (CONSP (bgcolor) && (bgcolor = XCDR (bgcolor), STRINGP (bgcolor))) { Lisp_Object parm_index = Fget (Qbackground_color, Qx_frame_parameter); - if (NATNUMP (parm_index) + if (FIXNATP (parm_index) && XFASTINT (parm_index) < ARRAYELTS (frame_parms) && FRAME_RIF (f)->frame_parm_handlers[XFASTINT (parm_index)]) (*FRAME_RIF (f)->frame_parm_handlers[XFASTINT (parm_index)]) @@ -4414,7 +4414,7 @@ x_set_left_fringe (struct frame *f, Lisp_Object new_value, Lisp_Object old_value int old_width = FRAME_LEFT_FRINGE_WIDTH (f); int new_width; - new_width = (RANGED_INTEGERP (-INT_MAX, new_value, INT_MAX) + new_width = (RANGED_FIXNUMP (-INT_MAX, new_value, INT_MAX) ? eabs (XINT (new_value)) : 8); if (new_width != old_width) @@ -4438,7 +4438,7 @@ x_set_right_fringe (struct frame *f, Lisp_Object new_value, Lisp_Object old_valu int old_width = FRAME_RIGHT_FRINGE_WIDTH (f); int new_width; - new_width = (RANGED_INTEGERP (-INT_MAX, new_value, INT_MAX) + new_width = (RANGED_FIXNUMP (-INT_MAX, new_value, INT_MAX) ? eabs (XINT (new_value)) : 8); if (new_width != old_width) @@ -4598,7 +4598,7 @@ x_set_scroll_bar_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval) SET_FRAME_GARBAGED (f); } - else if (RANGED_INTEGERP (1, arg, INT_MAX) + else if (RANGED_FIXNUMP (1, arg, INT_MAX) && XFASTINT (arg) != FRAME_CONFIG_SCROLL_BAR_WIDTH (f)) { FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = XFASTINT (arg); @@ -4628,7 +4628,7 @@ x_set_scroll_bar_height (struct frame *f, Lisp_Object arg, Lisp_Object oldval) SET_FRAME_GARBAGED (f); } - else if (RANGED_INTEGERP (1, arg, INT_MAX) + else if (RANGED_FIXNUMP (1, arg, INT_MAX) && XFASTINT (arg) != FRAME_CONFIG_SCROLL_BAR_HEIGHT (f)) { FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) = XFASTINT (arg); @@ -4671,11 +4671,11 @@ x_set_alpha (struct frame *f, Lisp_Object arg, Lisp_Object oldval) if (! (0 <= alpha && alpha <= 1.0)) args_out_of_range (make_float (0.0), make_float (1.0)); } - else if (INTEGERP (item)) + else if (FIXNUMP (item)) { EMACS_INT ialpha = XINT (item); if (! (0 <= ialpha && ialpha <= 100)) - args_out_of_range (make_number (0), make_number (100)); + args_out_of_range (make_fixnum (0), make_fixnum (100)); alpha = ialpha / 100.0; } else @@ -4987,13 +4987,13 @@ x_get_arg (Display_Info *dpyinfo, Lisp_Object alist, Lisp_Object param, switch (type) { case RES_TYPE_NUMBER: - return make_number (atoi (SSDATA (tem))); + return make_fixnum (atoi (SSDATA (tem))); case RES_TYPE_BOOLEAN_NUMBER: if (!strcmp (SSDATA (tem), "on") || !strcmp (SSDATA (tem), "true")) - return make_number (1); - return make_number (atoi (SSDATA (tem))); + return make_fixnum (1); + return make_fixnum (atoi (SSDATA (tem))); break; case RES_TYPE_FLOAT: @@ -5222,11 +5222,11 @@ On Nextstep, this just calls `ns-parse-geometry'. */) Lisp_Object element; if (x >= 0 && (geometry & XNegative)) - element = list3 (Qleft, Qminus, make_number (-x)); + element = list3 (Qleft, Qminus, make_fixnum (-x)); else if (x < 0 && ! (geometry & XNegative)) - element = list3 (Qleft, Qplus, make_number (x)); + element = list3 (Qleft, Qplus, make_fixnum (x)); else - element = Fcons (Qleft, make_number (x)); + element = Fcons (Qleft, make_fixnum (x)); result = Fcons (element, result); } @@ -5235,18 +5235,18 @@ On Nextstep, this just calls `ns-parse-geometry'. */) Lisp_Object element; if (y >= 0 && (geometry & YNegative)) - element = list3 (Qtop, Qminus, make_number (-y)); + element = list3 (Qtop, Qminus, make_fixnum (-y)); else if (y < 0 && ! (geometry & YNegative)) - element = list3 (Qtop, Qplus, make_number (y)); + element = list3 (Qtop, Qplus, make_fixnum (y)); else - element = Fcons (Qtop, make_number (y)); + element = Fcons (Qtop, make_fixnum (y)); result = Fcons (element, result); } if (geometry & WidthValue) - result = Fcons (Fcons (Qwidth, make_number (width)), result); + result = Fcons (Fcons (Qwidth, make_fixnum (width)), result); if (geometry & HeightValue) - result = Fcons (Fcons (Qheight, make_number (height)), result); + result = Fcons (Fcons (Qheight, make_fixnum (height)), result); return result; } @@ -5302,10 +5302,10 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x ? tool_bar_button_relief : DEFAULT_TOOL_BAR_BUTTON_RELIEF); - if (RANGED_INTEGERP (1, Vtool_bar_button_margin, INT_MAX)) + if (RANGED_FIXNUMP (1, Vtool_bar_button_margin, INT_MAX)) margin = XFASTINT (Vtool_bar_button_margin); else if (CONSP (Vtool_bar_button_margin) - && RANGED_INTEGERP (1, XCDR (Vtool_bar_button_margin), INT_MAX)) + && RANGED_FIXNUMP (1, XCDR (Vtool_bar_button_margin), INT_MAX)) margin = XFASTINT (XCDR (Vtool_bar_button_margin)); else margin = 0; @@ -5327,7 +5327,7 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x { if (CONSP (width) && EQ (XCAR (width), Qtext_pixels)) { - CHECK_NUMBER (XCDR (width)); + CHECK_FIXNUM (XCDR (width)); if ((XINT (XCDR (width)) < 0 || XINT (XCDR (width)) > INT_MAX)) xsignal1 (Qargs_out_of_range, XCDR (width)); @@ -5352,7 +5352,7 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x } else { - CHECK_NUMBER (width); + CHECK_FIXNUM (width); if ((XINT (width) < 0 || XINT (width) > INT_MAX)) xsignal1 (Qargs_out_of_range, width); @@ -5364,7 +5364,7 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x { if (CONSP (height) && EQ (XCAR (height), Qtext_pixels)) { - CHECK_NUMBER (XCDR (height)); + CHECK_FIXNUM (XCDR (height)); if ((XINT (XCDR (height)) < 0 || XINT (XCDR (height)) > INT_MAX)) xsignal1 (Qargs_out_of_range, XCDR (height)); @@ -5389,7 +5389,7 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x } else { - CHECK_NUMBER (height); + CHECK_FIXNUM (height); if ((XINT (height) < 0) || (XINT (height) > INT_MAX)) xsignal1 (Qargs_out_of_range, height); @@ -5416,14 +5416,14 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x } else if (CONSP (top) && EQ (XCAR (top), Qminus) && CONSP (XCDR (top)) - && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (top)), INT_MAX)) + && RANGED_FIXNUMP (-INT_MAX, XCAR (XCDR (top)), INT_MAX)) { f->top_pos = - XINT (XCAR (XCDR (top))); window_prompting |= YNegative; } else if (CONSP (top) && EQ (XCAR (top), Qplus) && CONSP (XCDR (top)) - && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (top)))) + && TYPE_RANGED_FIXNUMP (int, XCAR (XCDR (top)))) { f->top_pos = XINT (XCAR (XCDR (top))); } @@ -5447,14 +5447,14 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x } else if (CONSP (left) && EQ (XCAR (left), Qminus) && CONSP (XCDR (left)) - && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (left)), INT_MAX)) + && RANGED_FIXNUMP (-INT_MAX, XCAR (XCDR (left)), INT_MAX)) { f->left_pos = - XINT (XCAR (XCDR (left))); window_prompting |= XNegative; } else if (CONSP (left) && EQ (XCAR (left), Qplus) && CONSP (XCDR (left)) - && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (left)))) + && TYPE_RANGED_FIXNUMP (int, XCAR (XCDR (left)))) { f->left_pos = XINT (XCAR (XCDR (left))); } @@ -5791,7 +5791,7 @@ syms_of_frame (void) Lisp_Object v = (frame_parms[i].sym < 0 ? intern_c_string (frame_parms[i].name) : builtin_lisp_symbol (frame_parms[i].sym)); - Fput (v, Qx_frame_parameter, make_number (i)); + Fput (v, Qx_frame_parameter, make_fixnum (i)); } } @@ -5824,7 +5824,7 @@ is a reasonable practice. See also the variable `x-resource-name'. */); doc: /* The lower limit of the frame opacity (alpha transparency). The value should range from 0 (invisible) to 100 (completely opaque). You can also use a floating number between 0.0 and 1.0. */); - Vframe_alpha_lower_limit = make_number (20); + Vframe_alpha_lower_limit = make_fixnum (20); #endif DEFVAR_LISP ("default-frame-alist", Vdefault_frame_alist, diff --git a/src/frame.h b/src/frame.h index 1f438d3f69..03e23027ec 100644 --- a/src/frame.h +++ b/src/frame.h @@ -699,7 +699,7 @@ fset_desired_tool_bar_string (struct frame *f, Lisp_Object val) INLINE double NUMVAL (Lisp_Object x) { - return NUMBERP (x) ? XFLOATINT (x) : -1; + return FIXED_OR_FLOATP (x) ? XFLOATINT (x) : -1; } INLINE double @@ -1360,7 +1360,7 @@ FRAME_BOTTOM_DIVIDER_WIDTH (struct frame *f) canonical char width is to be used. X must be a Lisp integer or float. Value is a C integer. */ #define FRAME_PIXEL_X_FROM_CANON_X(F, X) \ - (INTEGERP (X) \ + (FIXNUMP (X) \ ? XINT (X) * FRAME_COLUMN_WIDTH (F) \ : (int) (XFLOAT_DATA (X) * FRAME_COLUMN_WIDTH (F))) @@ -1368,7 +1368,7 @@ FRAME_BOTTOM_DIVIDER_WIDTH (struct frame *f) canonical character height is to be used. X must be a Lisp integer or float. Value is a C integer. */ #define FRAME_PIXEL_Y_FROM_CANON_Y(F, Y) \ - (INTEGERP (Y) \ + (FIXNUMP (Y) \ ? XINT (Y) * FRAME_LINE_HEIGHT (F) \ : (int) (XFLOAT_DATA (Y) * FRAME_LINE_HEIGHT (F))) @@ -1379,7 +1379,7 @@ FRAME_BOTTOM_DIVIDER_WIDTH (struct frame *f) #define FRAME_CANON_X_FROM_PIXEL_X(F, X) \ ((X) % FRAME_COLUMN_WIDTH (F) != 0 \ ? make_float ((double) (X) / FRAME_COLUMN_WIDTH (F)) \ - : make_number ((X) / FRAME_COLUMN_WIDTH (F))) + : make_fixnum ((X) / FRAME_COLUMN_WIDTH (F))) /* Convert pixel-value Y to canonical units. F is the frame whose canonical character height is to be used. Y is a C integer. @@ -1388,7 +1388,7 @@ FRAME_BOTTOM_DIVIDER_WIDTH (struct frame *f) #define FRAME_CANON_Y_FROM_PIXEL_Y(F, Y) \ ((Y) % FRAME_LINE_HEIGHT (F) \ ? make_float ((double) (Y) / FRAME_LINE_HEIGHT (F)) \ - : make_number ((Y) / FRAME_LINE_HEIGHT (F))) + : make_fixnum ((Y) / FRAME_LINE_HEIGHT (F))) diff --git a/src/fringe.c b/src/fringe.c index 6069184681..c1784c01b9 100644 --- a/src/fringe.c +++ b/src/fringe.c @@ -488,7 +488,7 @@ lookup_fringe_bitmap (Lisp_Object bitmap) EMACS_INT bn; bitmap = Fget (bitmap, Qfringe); - if (!INTEGERP (bitmap)) + if (!FIXNUMP (bitmap)) return 0; bn = XINT (bitmap); @@ -519,7 +519,7 @@ get_fringe_bitmap_name (int bn) return Qnil; bitmaps = Vfringe_bitmaps; - num = make_number (bn); + num = make_fixnum (bn); while (CONSP (bitmaps)) { @@ -748,7 +748,7 @@ get_logical_fringe_bitmap (struct window *w, Lisp_Object bitmap, int right_p, in { if (ln1 > ix2) { - bm = Fnth (make_number (ix2), bm1); + bm = Fnth (make_fixnum (ix2), bm1); if (!EQ (bm, Qt)) goto found; } @@ -757,7 +757,7 @@ get_logical_fringe_bitmap (struct window *w, Lisp_Object bitmap, int right_p, in { if (ln1 > ix1) { - bm = Fnth (make_number (ix1), bm1); + bm = Fnth (make_fixnum (ix1), bm1); if (!EQ (bm, Qt)) goto found; } @@ -783,7 +783,7 @@ get_logical_fringe_bitmap (struct window *w, Lisp_Object bitmap, int right_p, in { if (ln2 > ix2) { - bm = Fnth (make_number (ix2), bm2); + bm = Fnth (make_fixnum (ix2), bm2); if (!EQ (bm, Qt)) goto found; } @@ -795,14 +795,14 @@ get_logical_fringe_bitmap (struct window *w, Lisp_Object bitmap, int right_p, in if (ln1 > ix1) { - bm = Fnth (make_number (ix1), bm1); + bm = Fnth (make_fixnum (ix1), bm1); if (!EQ (bm, Qt)) goto found; } if (ln2 > ix1) { - bm = Fnth (make_number (ix1), bm2); + bm = Fnth (make_fixnum (ix1), bm2); if (!EQ (bm, Qt)) goto found; return NO_FRINGE_BITMAP; @@ -1509,7 +1509,7 @@ If BITMAP already exists, the existing definition is replaced. */) fb.height = h; else { - CHECK_NUMBER (height); + CHECK_FIXNUM (height); fb.height = max (0, min (XINT (height), 255)); if (fb.height > h) { @@ -1522,7 +1522,7 @@ If BITMAP already exists, the existing definition is replaced. */) fb.width = 8; else { - CHECK_NUMBER (width); + CHECK_FIXNUM (width); fb.width = max (0, min (XINT (width), 255)); } @@ -1586,7 +1586,7 @@ If BITMAP already exists, the existing definition is replaced. */) } Vfringe_bitmaps = Fcons (bitmap, Vfringe_bitmaps); - Fput (bitmap, Qfringe, make_number (n)); + Fput (bitmap, Qfringe, make_fixnum (n)); } fb.dynamic = true; @@ -1604,8 +1604,8 @@ If BITMAP already exists, the existing definition is replaced. */) b[j++] = 0; for (i = 0; i < h && j < fb.height; i++) { - Lisp_Object elt = Faref (bits, make_number (i)); - b[j++] = NUMBERP (elt) ? XINT (elt) : 0; + Lisp_Object elt = Faref (bits, make_fixnum (i)); + b[j++] = FIXED_OR_FLOATP (elt) ? XINT (elt) : 0; } for (i = 0; i < fill2 && j < fb.height; i++) b[j++] = 0; @@ -1661,7 +1661,7 @@ Return nil if POS is not visible in WINDOW. */) if (!NILP (pos)) { - CHECK_NUMBER_COERCE_MARKER (pos); + CHECK_FIXNUM_COERCE_MARKER (pos); if (! (BEGV <= XINT (pos) && XINT (pos) <= ZV)) args_out_of_range (window, pos); textpos = XINT (pos); diff --git a/src/ftfont.c b/src/ftfont.c index d50fa39fa7..741a592c0b 100644 --- a/src/ftfont.c +++ b/src/ftfont.c @@ -196,7 +196,7 @@ ftfont_pattern_entity (FcPattern *p, Lisp_Object extra) return Qnil; file = (char *) str; - key = Fcons (build_unibyte_string (file), make_number (idx)); + key = Fcons (build_unibyte_string (file), make_fixnum (idx)); cache = ftfont_lookup_cache (key, FTFONT_CACHE_FOR_ENTITY); entity = XCAR (cache); if (! NILP (entity)) @@ -232,35 +232,35 @@ ftfont_pattern_entity (FcPattern *p, Lisp_Object extra) { if (numeric >= FC_WEIGHT_REGULAR && numeric < FC_WEIGHT_MEDIUM) numeric = FC_WEIGHT_MEDIUM; - FONT_SET_STYLE (entity, FONT_WEIGHT_INDEX, make_number (numeric)); + FONT_SET_STYLE (entity, FONT_WEIGHT_INDEX, make_fixnum (numeric)); } if (FcPatternGetInteger (p, FC_SLANT, 0, &numeric) == FcResultMatch) { numeric += 100; - FONT_SET_STYLE (entity, FONT_SLANT_INDEX, make_number (numeric)); + FONT_SET_STYLE (entity, FONT_SLANT_INDEX, make_fixnum (numeric)); } if (FcPatternGetInteger (p, FC_WIDTH, 0, &numeric) == FcResultMatch) { - FONT_SET_STYLE (entity, FONT_WIDTH_INDEX, make_number (numeric)); + FONT_SET_STYLE (entity, FONT_WIDTH_INDEX, make_fixnum (numeric)); } if (FcPatternGetDouble (p, FC_PIXEL_SIZE, 0, &dbl) == FcResultMatch) { - ASET (entity, FONT_SIZE_INDEX, make_number (dbl)); + ASET (entity, FONT_SIZE_INDEX, make_fixnum (dbl)); } else - ASET (entity, FONT_SIZE_INDEX, make_number (0)); + ASET (entity, FONT_SIZE_INDEX, make_fixnum (0)); if (FcPatternGetInteger (p, FC_SPACING, 0, &numeric) == FcResultMatch) - ASET (entity, FONT_SPACING_INDEX, make_number (numeric)); + ASET (entity, FONT_SPACING_INDEX, make_fixnum (numeric)); if (FcPatternGetDouble (p, FC_DPI, 0, &dbl) == FcResultMatch) { int dpi = dbl; - ASET (entity, FONT_DPI_INDEX, make_number (dpi)); + ASET (entity, FONT_DPI_INDEX, make_fixnum (dpi)); } if (FcPatternGetBool (p, FC_SCALABLE, 0, &b) == FcResultMatch && b == FcTrue) { - ASET (entity, FONT_SIZE_INDEX, make_number (0)); - ASET (entity, FONT_AVGWIDTH_INDEX, make_number (0)); + ASET (entity, FONT_SIZE_INDEX, make_fixnum (0)); + ASET (entity, FONT_AVGWIDTH_INDEX, make_fixnum (0)); } else { @@ -276,7 +276,7 @@ ftfont_pattern_entity (FcPattern *p, Lisp_Object extra) if (FT_Get_BDF_Property (ft_face, "AVERAGE_WIDTH", &rec) == 0 && rec.type == BDF_PROPERTY_TYPE_INTEGER) - ASET (entity, FONT_AVGWIDTH_INDEX, make_number (rec.u.integer)); + ASET (entity, FONT_AVGWIDTH_INDEX, make_fixnum (rec.u.integer)); FT_Done_Face (ft_face); } } @@ -646,9 +646,9 @@ ftfont_spec_pattern (Lisp_Object spec, char *otlayout, struct OpenTypeSpec **ots /* Fontconfig doesn't support reverse-italic/oblique. */ return NULL; - if (INTEGERP (AREF (spec, FONT_DPI_INDEX))) + if (FIXNUMP (AREF (spec, FONT_DPI_INDEX))) dpi = XINT (AREF (spec, FONT_DPI_INDEX)); - if (INTEGERP (AREF (spec, FONT_AVGWIDTH_INDEX)) + if (FIXNUMP (AREF (spec, FONT_AVGWIDTH_INDEX)) && XINT (AREF (spec, FONT_AVGWIDTH_INDEX)) == 0) scalable = 1; @@ -686,7 +686,7 @@ ftfont_spec_pattern (Lisp_Object spec, char *otlayout, struct OpenTypeSpec **ots key = XCAR (XCAR (extra)), val = XCDR (XCAR (extra)); if (EQ (key, QCdpi)) { - if (INTEGERP (val)) + if (FIXNUMP (val)) dpi = XINT (val); } else if (EQ (key, QClang)) @@ -832,7 +832,7 @@ ftfont_list (struct frame *f, Lisp_Object spec) } val = Qnil; } - if (INTEGERP (AREF (spec, FONT_SPACING_INDEX))) + if (FIXNUMP (AREF (spec, FONT_SPACING_INDEX))) spacing = XINT (AREF (spec, FONT_SPACING_INDEX)); family = AREF (spec, FONT_FAMILY_INDEX); if (! NILP (family)) @@ -955,7 +955,7 @@ ftfont_list (struct frame *f, Lisp_Object spec) != FcResultMatch) continue; for (j = 0; j < ASIZE (chars); j++) - if (TYPE_RANGED_INTEGERP (FcChar32, AREF (chars, j)) + if (TYPE_RANGED_FIXNUMP (FcChar32, AREF (chars, j)) && FcCharSetHasChar (charset, XFASTINT (AREF (chars, j)))) break; if (j == ASIZE (chars)) @@ -1016,7 +1016,7 @@ ftfont_match (struct frame *f, Lisp_Object spec) if (! pattern) return Qnil; - if (INTEGERP (AREF (spec, FONT_SIZE_INDEX))) + if (FIXNUMP (AREF (spec, FONT_SIZE_INDEX))) { FcValue value; @@ -1160,7 +1160,7 @@ ftfont_open2 (struct frame *f, font->encoding_charset = font->repertory_charset = -1; upEM = ft_face->units_per_EM; - scalable = (INTEGERP (AREF (entity, FONT_AVGWIDTH_INDEX)) + scalable = (FIXNUMP (AREF (entity, FONT_AVGWIDTH_INDEX)) && XINT (AREF (entity, FONT_AVGWIDTH_INDEX)) == 0); if (scalable) { @@ -1174,7 +1174,7 @@ ftfont_open2 (struct frame *f, font->descent = - ft_face->size->metrics.descender >> 6; font->height = ft_face->size->metrics.height >> 6; } - if (INTEGERP (AREF (entity, FONT_SPACING_INDEX))) + if (FIXNUMP (AREF (entity, FONT_SPACING_INDEX))) spacing = XINT (AREF (entity, FONT_SPACING_INDEX)); else spacing = FC_PROPORTIONAL; @@ -1250,7 +1250,7 @@ ftfont_close (struct font *font) struct ftfont_info *ftfont_info = (struct ftfont_info *) font; Lisp_Object val, cache; - val = Fcons (font->props[FONT_FILE_INDEX], make_number (ftfont_info->index)); + val = Fcons (font->props[FONT_FILE_INDEX], make_fixnum (ftfont_info->index)); cache = ftfont_lookup_cache (val, FTFONT_CACHE_FOR_FACE); eassert (CONSP (cache)); val = XCDR (cache); @@ -2534,7 +2534,7 @@ ftfont_shape_by_flt (Lisp_Object lgstring, struct font *font, flt = mflt_find (LGLYPH_CHAR (LGSTRING_GLYPH (lgstring, 0)), &flt_font_ft.flt_font); if (! flt) - return make_number (0); + return make_fixnum (0); } MFLTGlyphFT *glyphs = (MFLTGlyphFT *) gstring.glyphs; @@ -2603,13 +2603,13 @@ ftfont_shape_by_flt (Lisp_Object lgstring, struct font *font, { Lisp_Object vec = make_uninit_vector (3); - ASET (vec, 0, make_number (g->g.xoff >> 6)); - ASET (vec, 1, make_number (g->g.yoff >> 6)); - ASET (vec, 2, make_number (g->g.xadv >> 6)); + ASET (vec, 0, make_fixnum (g->g.xoff >> 6)); + ASET (vec, 1, make_fixnum (g->g.yoff >> 6)); + ASET (vec, 2, make_fixnum (g->g.xadv >> 6)); LGLYPH_SET_ADJUSTMENT (lglyph, vec); } } - return make_number (i); + return make_fixnum (i); } Lisp_Object diff --git a/src/gfilenotify.c b/src/gfilenotify.c index 650df0fcbb..674ae069f6 100644 --- a/src/gfilenotify.c +++ b/src/gfilenotify.c @@ -77,7 +77,7 @@ dir_monitor_callback (GFileMonitor *monitor, /* Determine callback function. */ monitor_object = make_pointer_integer (monitor); - eassert (INTEGERP (monitor_object)); + eassert (FIXNUMP (monitor_object)); watch_object = assq_no_quit (monitor_object, watch_list); if (CONSP (watch_object)) @@ -206,7 +206,7 @@ will be reported only in case of the `moved' event. */) Lisp_Object watch_descriptor = make_pointer_integer (monitor); /* Check the dicey assumption that make_pointer_integer is safe. */ - if (! INTEGERP (watch_descriptor)) + if (! FIXNUMP (watch_descriptor)) { g_object_unref (monitor); xsignal2 (Qfile_notify_error, build_string ("Unsupported file watcher"), @@ -239,7 +239,7 @@ WATCH-DESCRIPTOR should be an object returned by `gfile-add-watch'. */) xsignal2 (Qfile_notify_error, build_string ("Not a watch descriptor"), watch_descriptor); - eassert (INTEGERP (watch_descriptor)); + eassert (FIXNUMP (watch_descriptor)); GFileMonitor *monitor = XINTPTR (watch_descriptor); if (!g_file_monitor_is_cancelled (monitor) && !g_file_monitor_cancel (monitor)) diff --git a/src/gnutls.c b/src/gnutls.c index d7a4ee474f..337b3d65ce 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -816,7 +816,7 @@ gnutls_make_error (int err) } check_memory_full (err); - return make_number (err); + return make_fixnum (err); } static void @@ -893,7 +893,7 @@ See also `gnutls-boot'. */) { CHECK_PROCESS (proc); - return make_number (GNUTLS_INITSTAGE (proc)); + return make_fixnum (GNUTLS_INITSTAGE (proc)); } DEFUN ("gnutls-errorp", Fgnutls_errorp, Sgnutls_errorp, 1, 1, 0, @@ -923,7 +923,7 @@ Usage: (gnutls-error-fatalp ERROR) */) if (SYMBOLP (err)) { code = Fget (err, Qgnutls_code); - if (NUMBERP (code)) + if (FIXED_OR_FLOATP (code)) { err = code; } @@ -933,7 +933,7 @@ Usage: (gnutls-error-fatalp ERROR) */) } } - if (! TYPE_RANGED_INTEGERP (int, err)) + if (! TYPE_RANGED_FIXNUMP (int, err)) error ("Not an error symbol or code"); if (0 == gnutls_error_is_fatal (XINT (err))) @@ -955,7 +955,7 @@ usage: (gnutls-error-string ERROR) */) if (SYMBOLP (err)) { code = Fget (err, Qgnutls_code); - if (NUMBERP (code)) + if (FIXED_OR_FLOATP (code)) { err = code; } @@ -965,7 +965,7 @@ usage: (gnutls-error-string ERROR) */) } } - if (! TYPE_RANGED_INTEGERP (int, err)) + if (! TYPE_RANGED_FIXNUMP (int, err)) return build_string ("Not an error symbol or code"); return build_string (emacs_gnutls_strerror (XINT (err))); @@ -1012,7 +1012,7 @@ gnutls_certificate_details (gnutls_x509_crt_t cert) check_memory_full (version); if (version >= GNUTLS_E_SUCCESS) res = nconc2 (res, list2 (intern (":version"), - make_number (version))); + make_fixnum (version))); } /* Serial. */ @@ -1296,7 +1296,7 @@ returned as the :certificate entry. */) check_memory_full (bits); if (bits > 0) result = nconc2 (result, list2 (intern (":diffie-hellman-prime-bits"), - make_number (bits))); + make_fixnum (bits))); } /* Key exchange. */ @@ -1650,7 +1650,7 @@ one trustfile (usually a CA bundle). */) state = XPROCESS (proc)->gnutls_state; - if (TYPE_RANGED_INTEGERP (int, loglevel)) + if (TYPE_RANGED_FIXNUMP (int, loglevel)) { gnutls_global_set_log_function (gnutls_log_function); # ifdef HAVE_GNUTLS3 @@ -1690,7 +1690,7 @@ one trustfile (usually a CA bundle). */) XPROCESS (proc)->gnutls_x509_cred = x509_cred; verify_flags = Fplist_get (proplist, QCverify_flags); - if (TYPE_RANGED_INTEGERP (unsigned int, verify_flags)) + if (TYPE_RANGED_FIXNUMP (unsigned int, verify_flags)) { gnutls_verify_flags = XFASTINT (verify_flags); GNUTLS_LOG (2, max_log_level, "setting verification flags"); @@ -1851,7 +1851,7 @@ one trustfile (usually a CA bundle). */) GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_PRIORITY; - if (INTEGERP (prime_bits)) + if (FIXNUMP (prime_bits)) gnutls_dh_set_prime_bits (state, XUINT (prime_bits)); ret = EQ (type, Qgnutls_x509pki) @@ -1937,19 +1937,19 @@ The alist key is the cipher name. */) Lisp_Object cp = listn (CONSTYPE_HEAP, 15, cipher_symbol, - QCcipher_id, make_number (gca), + QCcipher_id, make_fixnum (gca), QCtype, Qgnutls_type_cipher, QCcipher_aead_capable, cipher_tag_size == 0 ? Qnil : Qt, - QCcipher_tagsize, make_number (cipher_tag_size), + QCcipher_tagsize, make_fixnum (cipher_tag_size), QCcipher_blocksize, - make_number (gnutls_cipher_get_block_size (gca)), + make_fixnum (gnutls_cipher_get_block_size (gca)), QCcipher_keysize, - make_number (gnutls_cipher_get_key_size (gca)), + make_fixnum (gnutls_cipher_get_key_size (gca)), QCcipher_ivsize, - make_number (gnutls_cipher_get_iv_size (gca))); + make_fixnum (gnutls_cipher_get_iv_size (gca))); ciphers = Fcons (cp, ciphers); } @@ -2072,7 +2072,7 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher, if (SYMBOLP (cipher)) info = XCDR (Fassq (cipher, Fgnutls_ciphers ())); - else if (TYPE_RANGED_INTEGERP (gnutls_cipher_algorithm_t, cipher)) + else if (TYPE_RANGED_FIXNUMP (gnutls_cipher_algorithm_t, cipher)) gca = XINT (cipher); else info = cipher; @@ -2080,7 +2080,7 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher, if (!NILP (info) && CONSP (info)) { Lisp_Object v = Fplist_get (info, QCcipher_id); - if (TYPE_RANGED_INTEGERP (gnutls_cipher_algorithm_t, v)) + if (TYPE_RANGED_FIXNUMP (gnutls_cipher_algorithm_t, v)) gca = XINT (v); } @@ -2260,17 +2260,17 @@ name. */) nonce_size = gnutls_mac_get_nonce_size (gma); #endif Lisp_Object mp = listn (CONSTYPE_HEAP, 11, gma_symbol, - QCmac_algorithm_id, make_number (gma), + QCmac_algorithm_id, make_fixnum (gma), QCtype, Qgnutls_type_mac_algorithm, QCmac_algorithm_length, - make_number (gnutls_hmac_get_len (gma)), + make_fixnum (gnutls_hmac_get_len (gma)), QCmac_algorithm_keysize, - make_number (gnutls_mac_get_key_size (gma)), + make_fixnum (gnutls_mac_get_key_size (gma)), QCmac_algorithm_noncesize, - make_number (nonce_size)); + make_fixnum (nonce_size)); mac_algorithms = Fcons (mp, mac_algorithms); } @@ -2295,11 +2295,11 @@ method name. */) Lisp_Object gda_symbol = intern (gnutls_digest_get_name (gda)); Lisp_Object mp = listn (CONSTYPE_HEAP, 7, gda_symbol, - QCdigest_algorithm_id, make_number (gda), + QCdigest_algorithm_id, make_fixnum (gda), QCtype, Qgnutls_type_digest_algorithm, QCdigest_algorithm_length, - make_number (gnutls_hash_get_len (gda))); + make_fixnum (gnutls_hash_get_len (gda))); digest_algorithms = Fcons (mp, digest_algorithms); } @@ -2343,7 +2343,7 @@ itself. */) if (SYMBOLP (hash_method)) info = XCDR (Fassq (hash_method, Fgnutls_macs ())); - else if (TYPE_RANGED_INTEGERP (gnutls_mac_algorithm_t, hash_method)) + else if (TYPE_RANGED_FIXNUMP (gnutls_mac_algorithm_t, hash_method)) gma = XINT (hash_method); else info = hash_method; @@ -2351,7 +2351,7 @@ itself. */) if (!NILP (info) && CONSP (info)) { Lisp_Object v = Fplist_get (info, QCmac_algorithm_id); - if (TYPE_RANGED_INTEGERP (gnutls_mac_algorithm_t, v)) + if (TYPE_RANGED_FIXNUMP (gnutls_mac_algorithm_t, v)) gma = XINT (v); } @@ -2424,7 +2424,7 @@ the number itself. */) if (SYMBOLP (digest_method)) info = XCDR (Fassq (digest_method, Fgnutls_digests ())); - else if (TYPE_RANGED_INTEGERP (gnutls_digest_algorithm_t, digest_method)) + else if (TYPE_RANGED_FIXNUMP (gnutls_digest_algorithm_t, digest_method)) gda = XINT (digest_method); else info = digest_method; @@ -2432,7 +2432,7 @@ the number itself. */) if (!NILP (info) && CONSP (info)) { Lisp_Object v = Fplist_get (info, QCdigest_algorithm_id); - if (TYPE_RANGED_INTEGERP (gnutls_digest_algorithm_t, v)) + if (TYPE_RANGED_FIXNUMP (gnutls_digest_algorithm_t, v)) gda = XINT (v); } @@ -2545,11 +2545,11 @@ syms_of_gnutls (void) DEFSYM (Qlibgnutls_version, "libgnutls-version"); Fset (Qlibgnutls_version, #ifdef HAVE_GNUTLS - make_number (GNUTLS_VERSION_MAJOR * 10000 + make_fixnum (GNUTLS_VERSION_MAJOR * 10000 + GNUTLS_VERSION_MINOR * 100 + GNUTLS_VERSION_PATCH) #else - make_number (-1) + make_fixnum (-1) #endif ); #ifdef HAVE_GNUTLS @@ -2593,19 +2593,19 @@ syms_of_gnutls (void) DEFSYM (Qgnutls_e_interrupted, "gnutls-e-interrupted"); Fput (Qgnutls_e_interrupted, Qgnutls_code, - make_number (GNUTLS_E_INTERRUPTED)); + make_fixnum (GNUTLS_E_INTERRUPTED)); DEFSYM (Qgnutls_e_again, "gnutls-e-again"); Fput (Qgnutls_e_again, Qgnutls_code, - make_number (GNUTLS_E_AGAIN)); + make_fixnum (GNUTLS_E_AGAIN)); DEFSYM (Qgnutls_e_invalid_session, "gnutls-e-invalid-session"); Fput (Qgnutls_e_invalid_session, Qgnutls_code, - make_number (GNUTLS_E_INVALID_SESSION)); + make_fixnum (GNUTLS_E_INVALID_SESSION)); DEFSYM (Qgnutls_e_not_ready_for_handshake, "gnutls-e-not-ready-for-handshake"); Fput (Qgnutls_e_not_ready_for_handshake, Qgnutls_code, - make_number (GNUTLS_E_APPLICATION_ERROR_MIN)); + make_fixnum (GNUTLS_E_APPLICATION_ERROR_MIN)); defsubr (&Sgnutls_get_initstage); defsubr (&Sgnutls_asynchronous_parameters); diff --git a/src/gtkutil.c b/src/gtkutil.c index 69325ff00a..79b453d2a5 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -963,7 +963,7 @@ xg_frame_set_char_size (struct frame *f, int width, int height) { frame_size_history_add (f, Qxg_frame_set_char_size_1, width, height, - list2 (make_number (gheight), make_number (totalheight))); + list2 (make_fixnum (gheight), make_fixnum (totalheight))); gtk_window_resize (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), gwidth, totalheight); @@ -972,7 +972,7 @@ xg_frame_set_char_size (struct frame *f, int width, int height) { frame_size_history_add (f, Qxg_frame_set_char_size_2, width, height, - list2 (make_number (gwidth), make_number (totalwidth))); + list2 (make_fixnum (gwidth), make_fixnum (totalwidth))); gtk_window_resize (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), totalwidth, gheight); @@ -981,7 +981,7 @@ xg_frame_set_char_size (struct frame *f, int width, int height) { frame_size_history_add (f, Qxg_frame_set_char_size_3, width, height, - list2 (make_number (totalwidth), make_number (totalheight))); + list2 (make_fixnum (totalwidth), make_fixnum (totalheight))); gtk_window_resize (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), totalwidth, totalheight); @@ -4279,7 +4279,7 @@ draw_page (GtkPrintOperation *operation, GtkPrintContext *context, gint page_nr, gpointer user_data) { Lisp_Object frames = *((Lisp_Object *) user_data); - struct frame *f = XFRAME (Fnth (make_number (page_nr), frames)); + struct frame *f = XFRAME (Fnth (make_fixnum (page_nr), frames)); cairo_t *cr = gtk_print_context_get_cairo_context (context); x_cr_draw_frame (cr, f); @@ -4889,17 +4889,17 @@ update_frame_tool_bar (struct frame *f) block_input (); - if (RANGED_INTEGERP (1, Vtool_bar_button_margin, INT_MAX)) + if (RANGED_FIXNUMP (1, Vtool_bar_button_margin, INT_MAX)) { hmargin = XFASTINT (Vtool_bar_button_margin); vmargin = XFASTINT (Vtool_bar_button_margin); } else if (CONSP (Vtool_bar_button_margin)) { - if (RANGED_INTEGERP (1, XCAR (Vtool_bar_button_margin), INT_MAX)) + if (RANGED_FIXNUMP (1, XCAR (Vtool_bar_button_margin), INT_MAX)) hmargin = XFASTINT (XCAR (Vtool_bar_button_margin)); - if (RANGED_INTEGERP (1, XCDR (Vtool_bar_button_margin), INT_MAX)) + if (RANGED_FIXNUMP (1, XCDR (Vtool_bar_button_margin), INT_MAX)) vmargin = XFASTINT (XCDR (Vtool_bar_button_margin)); } diff --git a/src/image.c b/src/image.c index 992b225d7b..980911e0d1 100644 --- a/src/image.c +++ b/src/image.c @@ -322,7 +322,7 @@ x_create_bitmap_from_file (struct frame *f, Lisp_Object file) /* Search bitmap-file-path for the file, if appropriate. */ if (openp (Vx_bitmap_file_path, file, Qnil, &found, - make_number (R_OK), false) + make_fixnum (R_OK), false) < 0) return -1; @@ -761,23 +761,23 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords, break; case IMAGE_POSITIVE_INTEGER_VALUE: - if (! RANGED_INTEGERP (1, value, INT_MAX)) + if (! RANGED_FIXNUMP (1, value, INT_MAX)) return 0; break; case IMAGE_NON_NEGATIVE_INTEGER_VALUE_OR_PAIR: - if (RANGED_INTEGERP (0, value, INT_MAX)) + if (RANGED_FIXNUMP (0, value, INT_MAX)) break; if (CONSP (value) - && RANGED_INTEGERP (0, XCAR (value), INT_MAX) - && RANGED_INTEGERP (0, XCDR (value), INT_MAX)) + && RANGED_FIXNUMP (0, XCAR (value), INT_MAX) + && RANGED_FIXNUMP (0, XCDR (value), INT_MAX)) break; return 0; case IMAGE_ASCENT_VALUE: if (SYMBOLP (value) && EQ (value, Qcenter)) break; - else if (RANGED_INTEGERP (0, value, 100)) + else if (RANGED_FIXNUMP (0, value, 100)) break; return 0; @@ -785,7 +785,7 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords, /* Unlike the other integer-related cases, this one does not verify that VALUE fits in 'int'. This is because callers want EMACS_INT. */ - if (!INTEGERP (value) || XINT (value) < 0) + if (!FIXNUMP (value) || XINT (value) < 0) return 0; break; @@ -799,12 +799,12 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords, return 0; case IMAGE_NUMBER_VALUE: - if (! NUMBERP (value)) + if (! FIXED_OR_FLOATP (value)) return 0; break; case IMAGE_INTEGER_VALUE: - if (! TYPE_RANGED_INTEGERP (int, value)) + if (! TYPE_RANGED_FIXNUMP (int, value)) return 0; break; @@ -883,7 +883,7 @@ or omitted means use the selected frame. */) size = Fcons (make_float ((double) width / FRAME_COLUMN_WIDTH (f)), make_float ((double) height / FRAME_LINE_HEIGHT (f))); else - size = Fcons (make_number (width), make_number (height)); + size = Fcons (make_fixnum (width), make_fixnum (height)); } else error ("Invalid image specification"); @@ -1004,7 +1004,7 @@ check_image_size (struct frame *f, int width, int height) if (width <= 0 || height <= 0) return 0; - if (INTEGERP (Vmax_image_size)) + if (FIXNUMP (Vmax_image_size)) return (width <= XINT (Vmax_image_size) && height <= XINT (Vmax_image_size)); else if (FLOATP (Vmax_image_size)) @@ -1534,7 +1534,7 @@ clear_image_cache (struct frame *f, Lisp_Object filter) } } } - else if (INTEGERP (Vimage_cache_eviction_delay)) + else if (FIXNUMP (Vimage_cache_eviction_delay)) { /* Free cache based on timestamp. */ struct timespec old, t; @@ -1761,10 +1761,10 @@ lookup_image (struct frame *f, Lisp_Object spec) Lisp_Object value; value = image_spec_value (spec, QCwidth, NULL); - img->width = (INTEGERP (value) + img->width = (FIXNUMP (value) ? XFASTINT (value) : DEFAULT_IMAGE_WIDTH); value = image_spec_value (spec, QCheight, NULL); - img->height = (INTEGERP (value) + img->height = (FIXNUMP (value) ? XFASTINT (value) : DEFAULT_IMAGE_HEIGHT); } else @@ -1776,13 +1776,13 @@ lookup_image (struct frame *f, Lisp_Object spec) int relief_bound; ascent = image_spec_value (spec, QCascent, NULL); - if (INTEGERP (ascent)) + if (FIXNUMP (ascent)) img->ascent = XFASTINT (ascent); else if (EQ (ascent, Qcenter)) img->ascent = CENTERED_IMAGE_ASCENT; margin = image_spec_value (spec, QCmargin, NULL); - if (INTEGERP (margin)) + if (FIXNUMP (margin)) img->vmargin = img->hmargin = XFASTINT (margin); else if (CONSP (margin)) { @@ -1792,7 +1792,7 @@ lookup_image (struct frame *f, Lisp_Object spec) relief = image_spec_value (spec, QCrelief, NULL); relief_bound = INT_MAX - max (img->hmargin, img->vmargin); - if (RANGED_INTEGERP (- relief_bound, relief, relief_bound)) + if (RANGED_FIXNUMP (- relief_bound, relief, relief_bound)) { img->relief = XINT (relief); img->hmargin += eabs (img->relief); @@ -1973,7 +1973,7 @@ x_create_x_image_and_pixmap (struct frame *f, int width, int height, int depth, x_destroy_x_image (*ximg); *ximg = NULL; image_error ("Image too large (%dx%d)", - make_number (width), make_number (height)); + make_fixnum (width), make_fixnum (height)); return 0; } @@ -2306,7 +2306,7 @@ x_find_image_fd (Lisp_Object file, int *pfd) /* Try to find FILE in data-directory/images, then x-bitmap-file-path. */ fd = openp (search_path, file, Qnil, &file_found, - pfd ? Qt : make_number (R_OK), false); + pfd ? Qt : make_fixnum (R_OK), false); if (fd >= 0 || fd == -2) { file_found = ENCODE_FILE (file_found); @@ -2875,7 +2875,7 @@ xbm_read_bitmap_data (struct frame *f, char *contents, char *end, { if (!inhibit_image_error) image_error ("Image too large (%dx%d)", - make_number (*width), make_number (*height)); + make_fixnum (*width), make_fixnum (*height)); goto failure; } bytes_per_line = (*width + 7) / 8 + padding_p; @@ -4000,7 +4000,7 @@ xpm_make_color_table_v (void (**put_func) (Lisp_Object, const char *, int, { *put_func = xpm_put_color_table_v; *get_func = xpm_get_color_table_v; - return Fmake_vector (make_number (256), Qnil); + return Fmake_vector (make_fixnum (256), Qnil); } static void @@ -4239,7 +4239,7 @@ xpm_load_image (struct frame *f, color_val = Qt; else if (x_defined_color (f, SSDATA (XCDR (specified_color)), &cdef, 0)) - color_val = make_number (cdef.pixel); + color_val = make_fixnum (cdef.pixel); } } if (NILP (color_val) && max_key > 0) @@ -4247,7 +4247,7 @@ xpm_load_image (struct frame *f, if (xstrcasecmp (max_color, "None") == 0) color_val = Qt; else if (x_defined_color (f, max_color, &cdef, 0)) - color_val = make_number (cdef.pixel); + color_val = make_fixnum (cdef.pixel); } if (!NILP (color_val)) (*put_color_table) (color_table, beg, chars_per_pixel, color_val); @@ -4267,7 +4267,7 @@ xpm_load_image (struct frame *f, (*get_color_table) (color_table, str, chars_per_pixel); XPutPixel (ximg, x, y, - (INTEGERP (color_val) ? XINT (color_val) + (FIXNUMP (color_val) ? XINT (color_val) : FRAME_FOREGROUND_PIXEL (f))); #ifndef HAVE_NS XPutPixel (mask_img, x, y, @@ -4928,20 +4928,20 @@ x_edge_detection (struct frame *f, struct image *img, Lisp_Object matrix, if (CONSP (matrix)) { for (i = 0; - i < 9 && CONSP (matrix) && NUMBERP (XCAR (matrix)); + i < 9 && CONSP (matrix) && FIXED_OR_FLOATP (XCAR (matrix)); ++i, matrix = XCDR (matrix)) trans[i] = XFLOATINT (XCAR (matrix)); } else if (VECTORP (matrix) && ASIZE (matrix) >= 9) { - for (i = 0; i < 9 && NUMBERP (AREF (matrix, i)); ++i) + for (i = 0; i < 9 && FIXED_OR_FLOATP (AREF (matrix, i)); ++i) trans[i] = XFLOATINT (AREF (matrix, i)); } if (NILP (color_adjust)) - color_adjust = make_number (0xffff / 2); + color_adjust = make_fixnum (0xffff / 2); - if (i == 9 && NUMBERP (color_adjust)) + if (i == 9 && FIXED_OR_FLOATP (color_adjust)) x_detect_edges (f, img, trans, XFLOATINT (color_adjust)); } @@ -5093,7 +5093,7 @@ x_build_heuristic_mask (struct frame *f, struct image *img, Lisp_Object how) { int rgb[3], i; - for (i = 0; i < 3 && CONSP (how) && NATNUMP (XCAR (how)); ++i) + for (i = 0; i < 3 && CONSP (how) && FIXNATP (XCAR (how)); ++i) { rgb[i] = XFASTINT (XCAR (how)) & 0xffff; how = XCDR (how); @@ -7280,7 +7280,7 @@ tiff_load (struct frame *f, struct image *img) } image = image_spec_value (img->spec, QCindex, NULL); - if (INTEGERP (image)) + if (FIXNUMP (image)) { EMACS_INT ino = XFASTINT (image); if (! (TYPE_MINIMUM (tdir_t) <= ino && ino <= TYPE_MAXIMUM (tdir_t) @@ -7324,7 +7324,7 @@ tiff_load (struct frame *f, struct image *img) if (count > 1) img->lisp_data = Fcons (Qcount, - Fcons (make_number (count), + Fcons (make_fixnum (count), img->lisp_data)); TIFFClose (tiff); @@ -7746,7 +7746,7 @@ gif_load (struct frame *f, struct image *img) /* Which sub-image are we to display? */ { Lisp_Object image_number = image_spec_value (img->spec, QCindex, NULL); - idx = INTEGERP (image_number) ? XFASTINT (image_number) : 0; + idx = FIXNUMP (image_number) ? XFASTINT (image_number) : 0; if (idx < 0 || idx >= gif->ImageCount) { image_error ("Invalid image number `%s' in image `%s'", @@ -8000,7 +8000,7 @@ gif_load (struct frame *f, struct image *img) /* Append (... FUNCTION "BYTES") */ { img->lisp_data - = Fcons (make_number (ext->Function), + = Fcons (make_fixnum (ext->Function), Fcons (make_unibyte_string ((char *) ext->Bytes, ext->ByteCount), img->lisp_data)); @@ -8021,7 +8021,7 @@ gif_load (struct frame *f, struct image *img) if (gif->ImageCount > 1) img->lisp_data = Fcons (Qcount, - Fcons (make_number (gif->ImageCount), + Fcons (make_fixnum (gif->ImageCount), img->lisp_data)); if (gif_close (gif, &gif_err) == GIF_ERROR) @@ -8102,15 +8102,15 @@ compute_image_size (size_t width, size_t height, double scale = 1; value = image_spec_value (spec, QCscale, NULL); - if (NUMBERP (value)) + if (FIXED_OR_FLOATP (value)) scale = XFLOATINT (value); value = image_spec_value (spec, QCmax_width, NULL); - if (NATNUMP (value)) + if (FIXNATP (value)) max_width = min (XFASTINT (value), INT_MAX); value = image_spec_value (spec, QCmax_height, NULL); - if (NATNUMP (value)) + if (FIXNATP (value)) max_height = min (XFASTINT (value), INT_MAX); /* If width and/or height is set in the display spec assume we want @@ -8118,7 +8118,7 @@ compute_image_size (size_t width, size_t height, unspecified should be calculated from the specified to preserve aspect ratio. */ value = image_spec_value (spec, QCwidth, NULL); - if (NATNUMP (value)) + if (FIXNATP (value)) { desired_width = min (XFASTINT (value) * scale, INT_MAX); /* :width overrides :max-width. */ @@ -8126,7 +8126,7 @@ compute_image_size (size_t width, size_t height, } value = image_spec_value (spec, QCheight, NULL); - if (NATNUMP (value)) + if (FIXNATP (value)) { desired_height = min (XFASTINT (value) * scale, INT_MAX); /* :height overrides :max-height. */ @@ -8573,7 +8573,7 @@ imagemagick_load_image (struct frame *f, struct image *img, find out things about it. */ image = image_spec_value (img->spec, QCindex, NULL); - ino = INTEGERP (image) ? XFASTINT (image) : 0; + ino = FIXNUMP (image) ? XFASTINT (image) : 0; image_wand = NewMagickWand (); if (filename) @@ -8583,7 +8583,7 @@ imagemagick_load_image (struct frame *f, struct image *img, Lisp_Object lwidth = image_spec_value (img->spec, QCwidth, NULL); Lisp_Object lheight = image_spec_value (img->spec, QCheight, NULL); - if (NATNUMP (lwidth) && NATNUMP (lheight)) + if (FIXNATP (lwidth) && FIXNATP (lheight)) { MagickSetSize (image_wand, XFASTINT (lwidth), XFASTINT (lheight)); MagickSetDepth (image_wand, 8); @@ -8628,7 +8628,7 @@ imagemagick_load_image (struct frame *f, struct image *img, if (MagickGetNumberImages (image_wand) > 1) img->lisp_data = Fcons (Qcount, - Fcons (make_number (MagickGetNumberImages (image_wand)), + Fcons (make_fixnum (MagickGetNumberImages (image_wand)), img->lisp_data)); /* If we have an animated image, get the new wand based on the @@ -8678,7 +8678,7 @@ imagemagick_load_image (struct frame *f, struct image *img, efficient. */ crop = image_spec_value (img->spec, QCcrop, NULL); - if (CONSP (crop) && TYPE_RANGED_INTEGERP (size_t, XCAR (crop))) + if (CONSP (crop) && TYPE_RANGED_FIXNUMP (size_t, XCAR (crop))) { /* After some testing, it seems MagickCropImage is the fastest crop function in ImageMagick. This crop function seems to do less copying @@ -8687,15 +8687,15 @@ imagemagick_load_image (struct frame *f, struct image *img, imagemagick. */ size_t crop_width = XINT (XCAR (crop)); crop = XCDR (crop); - if (CONSP (crop) && TYPE_RANGED_INTEGERP (size_t, XCAR (crop))) + if (CONSP (crop) && TYPE_RANGED_FIXNUMP (size_t, XCAR (crop))) { size_t crop_height = XINT (XCAR (crop)); crop = XCDR (crop); - if (CONSP (crop) && TYPE_RANGED_INTEGERP (ssize_t, XCAR (crop))) + if (CONSP (crop) && TYPE_RANGED_FIXNUMP (ssize_t, XCAR (crop))) { ssize_t crop_x = XINT (XCAR (crop)); crop = XCDR (crop); - if (CONSP (crop) && TYPE_RANGED_INTEGERP (ssize_t, XCAR (crop))) + if (CONSP (crop) && TYPE_RANGED_FIXNUMP (ssize_t, XCAR (crop))) { ssize_t crop_y = XINT (XCAR (crop)); MagickCropImage (image_wand, crop_width, crop_height, @@ -9551,7 +9551,7 @@ gs_image_p (Lisp_Object object) if (CONSP (tem)) { for (i = 0; i < 4; ++i, tem = XCDR (tem)) - if (!CONSP (tem) || !INTEGERP (XCAR (tem))) + if (!CONSP (tem) || !FIXNUMP (XCAR (tem))) return 0; if (!NILP (tem)) return 0; @@ -9561,7 +9561,7 @@ gs_image_p (Lisp_Object object) if (ASIZE (tem) != 4) return 0; for (i = 0; i < 4; ++i) - if (!INTEGERP (AREF (tem, i))) + if (!FIXNUMP (AREF (tem, i))) return 0; } else @@ -9589,10 +9589,10 @@ gs_load (struct frame *f, struct image *img) = 1/72 in, xdpi and ydpi are stored in the frame's X display info. */ pt_width = image_spec_value (img->spec, QCpt_width, NULL); - in_width = INTEGERP (pt_width) ? XFASTINT (pt_width) / 72.0 : 0; + in_width = FIXNUMP (pt_width) ? XFASTINT (pt_width) / 72.0 : 0; in_width *= FRAME_RES_X (f); pt_height = image_spec_value (img->spec, QCpt_height, NULL); - in_height = INTEGERP (pt_height) ? XFASTINT (pt_height) / 72.0 : 0; + in_height = FIXNUMP (pt_height) ? XFASTINT (pt_height) / 72.0 : 0; in_height *= FRAME_RES_Y (f); if (! (in_width <= INT_MAX && in_height <= INT_MAX @@ -9643,8 +9643,8 @@ gs_load (struct frame *f, struct image *img) loader = intern ("gs-load-image"); img->lisp_data = call6 (loader, frame, img->spec, - make_number (img->width), - make_number (img->height), + make_fixnum (img->width), + make_fixnum (img->height), window_and_pixmap_id, pixel_colors); return PROCESSP (img->lisp_data); @@ -9768,7 +9768,7 @@ DEFUN ("lookup-image", Flookup_image, Slookup_image, 1, 1, 0, id = lookup_image (SELECTED_FRAME (), spec); debug_print (spec); - return make_number (id); + return make_fixnum (id); } #endif /* GLYPH_DEBUG */ @@ -9933,27 +9933,27 @@ non-numeric, there is no explicit limit on the size of images. */); DEFSYM (Qlibpng_version, "libpng-version"); Fset (Qlibpng_version, #if HAVE_PNG - make_number (PNG_LIBPNG_VER) + make_fixnum (PNG_LIBPNG_VER) #else - make_number (-1) + make_fixnum (-1) #endif ); DEFSYM (Qlibgif_version, "libgif-version"); Fset (Qlibgif_version, #ifdef HAVE_GIF - make_number (GIFLIB_MAJOR * 10000 + make_fixnum (GIFLIB_MAJOR * 10000 + GIFLIB_MINOR * 100 + GIFLIB_RELEASE) #else - make_number (-1) + make_fixnum (-1) #endif ); DEFSYM (Qlibjpeg_version, "libjpeg-version"); Fset (Qlibjpeg_version, #if HAVE_JPEG - make_number (JPEG_LIB_VERSION) + make_fixnum (JPEG_LIB_VERSION) #else - make_number (-1) + make_fixnum (-1) #endif ); #endif @@ -10038,7 +10038,7 @@ a large number of images, the actual eviction time may be shorter. The value can also be nil, meaning the cache is never cleared. The function `clear-image-cache' disregards this variable. */); - Vimage_cache_eviction_delay = make_number (300); + Vimage_cache_eviction_delay = make_fixnum (300); #ifdef HAVE_IMAGEMAGICK DEFVAR_INT ("imagemagick-render-type", imagemagick_render_type, doc: /* Integer indicating which ImageMagick rendering method to use. diff --git a/src/indent.c b/src/indent.c index a86db71642..fd505bceeb 100644 --- a/src/indent.c +++ b/src/indent.c @@ -472,7 +472,7 @@ check_display_width (ptrdiff_t pos, ptrdiff_t col, ptrdiff_t *endpos) Lisp_Object val, overlay; if (CONSP (val = get_char_property_and_overlay - (make_number (pos), Qdisplay, Qnil, &overlay)) + (make_fixnum (pos), Qdisplay, Qnil, &overlay)) && EQ (Qspace, XCAR (val))) { /* FIXME: Use calc_pixel_width_or_height. */ Lisp_Object plist = XCDR (val), prop; @@ -483,15 +483,15 @@ check_display_width (ptrdiff_t pos, ptrdiff_t col, ptrdiff_t *endpos) : MOST_POSITIVE_FIXNUM); if ((prop = Fplist_get (plist, QCwidth), - RANGED_INTEGERP (0, prop, INT_MAX)) + RANGED_FIXNUMP (0, prop, INT_MAX)) || (prop = Fplist_get (plist, QCrelative_width), - RANGED_INTEGERP (0, prop, INT_MAX))) + RANGED_FIXNUMP (0, prop, INT_MAX))) width = XINT (prop); else if (FLOATP (prop) && 0 <= XFLOAT_DATA (prop) && XFLOAT_DATA (prop) <= INT_MAX) width = (int)(XFLOAT_DATA (prop) + 0.5); else if ((prop = Fplist_get (plist, QCalign_to), - RANGED_INTEGERP (col, prop, align_to_max))) + RANGED_FIXNUMP (col, prop, align_to_max))) width = XINT (prop) - col; else if (FLOATP (prop) && col <= XFLOAT_DATA (prop) && (XFLOAT_DATA (prop) <= align_to_max)) @@ -751,7 +751,7 @@ string_display_width (Lisp_Object string, Lisp_Object beg, Lisp_Object end) e = SCHARS (string); else { - CHECK_NUMBER (end); + CHECK_FIXNUM (end); e = XINT (end); } @@ -759,7 +759,7 @@ string_display_width (Lisp_Object string, Lisp_Object beg, Lisp_Object end) b = 0; else { - CHECK_NUMBER (beg); + CHECK_FIXNUM (beg); b = XINT (beg); } @@ -820,17 +820,17 @@ The return value is the column where the insertion ends. */) register ptrdiff_t fromcol; int tab_width = SANE_TAB_WIDTH (current_buffer); - CHECK_NUMBER (column); + CHECK_FIXNUM (column); if (NILP (minimum)) XSETFASTINT (minimum, 0); - CHECK_NUMBER (minimum); + CHECK_FIXNUM (minimum); fromcol = current_column (); mincol = fromcol + XINT (minimum); if (mincol < XINT (column)) mincol = XINT (column); if (fromcol == mincol) - return make_number (mincol); + return make_fixnum (mincol); if (indent_tabs_mode) { @@ -838,14 +838,14 @@ The return value is the column where the insertion ends. */) XSETFASTINT (n, mincol / tab_width - fromcol / tab_width); if (XFASTINT (n) != 0) { - Finsert_char (make_number ('\t'), n, Qt); + Finsert_char (make_fixnum ('\t'), n, Qt); fromcol = (mincol / tab_width) * tab_width; } } XSETFASTINT (column, mincol - fromcol); - Finsert_char (make_number (' '), column, Qt); + Finsert_char (make_fixnum (' '), column, Qt); last_known_column = mincol; last_known_column_point = PT; @@ -866,7 +866,7 @@ following any initial whitespace. */) ptrdiff_t posbyte; find_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, -1, NULL, &posbyte, 1); - return make_number (position_indentation (posbyte)); + return make_fixnum (position_indentation (posbyte)); } static ptrdiff_t @@ -994,7 +994,7 @@ The return value is the current column. */) EMACS_INT col; EMACS_INT goal; - CHECK_NATNUM (column); + CHECK_FIXNAT (column); goal = XINT (column); col = goal; @@ -1020,13 +1020,13 @@ The return value is the current column. */) first so that a marker at the end of the tab gets adjusted. */ SET_PT_BOTH (PT - 1, PT_BYTE - 1); - Finsert_char (make_number (' '), make_number (goal - prev_col), Qt); + Finsert_char (make_fixnum (' '), make_fixnum (goal - prev_col), Qt); /* Now delete the tab, and indent to COL. */ del_range (PT, PT + 1); goal_pt = PT; goal_pt_byte = PT_BYTE; - Findent_to (make_number (col), Qnil); + Findent_to (make_fixnum (col), Qnil); SET_PT_BOTH (goal_pt, goal_pt_byte); /* Set the last_known... vars consistently. */ @@ -1036,13 +1036,13 @@ The return value is the current column. */) /* If line ends prematurely, add space to the end. */ if (col < goal && EQ (force, Qt)) - Findent_to (make_number (col = goal), Qnil); + Findent_to (make_fixnum (col = goal), Qnil); last_known_column = col; last_known_column_point = PT; last_known_column_modified = MODIFF; - return make_number (col); + return make_fixnum (col); } /* compute_motion: compute buffer posn given screen posn and vice versa */ @@ -1128,7 +1128,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos, bool ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow)); struct Lisp_Char_Table *dp = window_display_table (win); EMACS_INT selective - = (INTEGERP (BVAR (current_buffer, selective_display)) + = (FIXNUMP (BVAR (current_buffer, selective_display)) ? XINT (BVAR (current_buffer, selective_display)) : !NILP (BVAR (current_buffer, selective_display)) ? -1 : 0); ptrdiff_t selective_rlen @@ -1338,7 +1338,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos, if (!NILP (Vtruncate_partial_width_windows) && (total_width < FRAME_COLS (XFRAME (WINDOW_FRAME (win))))) { - if (INTEGERP (Vtruncate_partial_width_windows)) + if (FIXNUMP (Vtruncate_partial_width_windows)) truncate = total_width < XFASTINT (Vtruncate_partial_width_windows); else @@ -1754,25 +1754,25 @@ visible section of the buffer, and pass LINE and COL as TOPOS. */) ptrdiff_t hscroll; int tab_offset; - CHECK_NUMBER_COERCE_MARKER (from); + CHECK_FIXNUM_COERCE_MARKER (from); CHECK_CONS (frompos); - CHECK_NUMBER_CAR (frompos); - CHECK_NUMBER_CDR (frompos); - CHECK_NUMBER_COERCE_MARKER (to); + CHECK_FIXNUM_CAR (frompos); + CHECK_FIXNUM_CDR (frompos); + CHECK_FIXNUM_COERCE_MARKER (to); if (!NILP (topos)) { CHECK_CONS (topos); - CHECK_NUMBER_CAR (topos); - CHECK_NUMBER_CDR (topos); + CHECK_FIXNUM_CAR (topos); + CHECK_FIXNUM_CDR (topos); } if (!NILP (width)) - CHECK_NUMBER (width); + CHECK_FIXNUM (width); if (!NILP (offsets)) { CHECK_CONS (offsets); - CHECK_NUMBER_CAR (offsets); - CHECK_NUMBER_CDR (offsets); + CHECK_FIXNUM_CAR (offsets); + CHECK_FIXNUM_CDR (offsets); if (! (0 <= XINT (XCAR (offsets)) && XINT (XCAR (offsets)) <= PTRDIFF_MAX && 0 <= XINT (XCDR (offsets)) && XINT (XCDR (offsets)) <= INT_MAX)) args_out_of_range (XCAR (offsets), XCDR (offsets)); @@ -1785,9 +1785,9 @@ visible section of the buffer, and pass LINE and COL as TOPOS. */) w = decode_live_window (window); if (XINT (from) < BEGV || XINT (from) > ZV) - args_out_of_range_3 (from, make_number (BEGV), make_number (ZV)); + args_out_of_range_3 (from, make_fixnum (BEGV), make_fixnum (ZV)); if (XINT (to) < BEGV || XINT (to) > ZV) - args_out_of_range_3 (to, make_number (BEGV), make_number (ZV)); + args_out_of_range_3 (to, make_fixnum (BEGV), make_fixnum (ZV)); pos = compute_motion (XINT (from), CHAR_TO_BYTE (XINT (from)), XINT (XCDR (frompos)), @@ -1831,7 +1831,7 @@ vmotion (register ptrdiff_t from, register ptrdiff_t from_byte, register ptrdiff_t first; ptrdiff_t lmargin = hscroll > 0 ? 1 - hscroll : 0; ptrdiff_t selective - = (INTEGERP (BVAR (current_buffer, selective_display)) + = (FIXNUMP (BVAR (current_buffer, selective_display)) ? clip_to_bounds (-1, XINT (BVAR (current_buffer, selective_display)), PTRDIFF_MAX) : !NILP (BVAR (current_buffer, selective_display)) ? -1 : 0); @@ -1870,7 +1870,7 @@ vmotion (register ptrdiff_t from, register ptrdiff_t from_byte, && indented_beyond_p (prevline, bytepos, selective)) /* Watch out for newlines with `invisible' property. When moving upward, check the newline before. */ - || (propval = Fget_char_property (make_number (prevline - 1), + || (propval = Fget_char_property (make_fixnum (prevline - 1), Qinvisible, text_prop_object), TEXT_PROP_MEANS_INVISIBLE (propval)))) @@ -1920,7 +1920,7 @@ vmotion (register ptrdiff_t from, register ptrdiff_t from_byte, && indented_beyond_p (prevline, bytepos, selective)) /* Watch out for newlines with `invisible' property. When moving downward, check the newline after. */ - || (propval = Fget_char_property (make_number (prevline), + || (propval = Fget_char_property (make_fixnum (prevline), Qinvisible, text_prop_object), TEXT_PROP_MEANS_INVISIBLE (propval)))) @@ -2016,8 +2016,8 @@ numbers on display. */) return make_float ((double) pixel_width / FRAME_COLUMN_WIDTH (f)); } else if (!NILP (pixelwise)) - return make_number (pixel_width); - return make_number (width); + return make_fixnum (pixel_width); + return make_fixnum (width); } /* In window W (derived from WINDOW), return x coordinate for column @@ -2100,15 +2100,15 @@ whether or not it is currently displayed in some window. */) lines = XCDR (lines); } - CHECK_NUMBER (lines); + CHECK_FIXNUM (lines); w = decode_live_window (window); if (XBUFFER (w->contents) != current_buffer) { /* Set the window's buffer temporarily to the current buffer. */ Lisp_Object old = list4 (window, w->contents, - make_number (marker_position (w->pointm)), - make_number (marker_byte_position (w->pointm))); + make_fixnum (marker_position (w->pointm)), + make_fixnum (marker_byte_position (w->pointm))); record_unwind_protect (restore_window_buffer, old); wset_buffer (w, Fcurrent_buffer ()); set_marker_both (w->pointm, w->contents, @@ -2356,7 +2356,7 @@ whether or not it is currently displayed in some window. */) bidi_unshelve_cache (itdata, 0); } - return unbind_to (count, make_number (it.vpos)); + return unbind_to (count, make_fixnum (it.vpos)); } diff --git a/src/inotify.c b/src/inotify.c index e06cc97c6a..9e76060ee9 100644 --- a/src/inotify.c +++ b/src/inotify.c @@ -176,7 +176,7 @@ inotifyevent_to_event (Lisp_Object watch, struct inotify_event const *ev) { Lisp_Object name; uint32_t mask; - CONS_TO_INTEGER (Fnth (make_number (3), watch), uint32_t, mask); + CONS_TO_INTEGER (Fnth (make_fixnum (3), watch), uint32_t, mask); if (! (mask & ev->mask)) return Qnil; @@ -194,7 +194,7 @@ inotifyevent_to_event (Lisp_Object watch, struct inotify_event const *ev) mask_to_aspects (ev->mask), name, INTEGER_TO_CONS (ev->cookie)), - Fnth (make_number (2), watch)); + Fnth (make_fixnum (2), watch)); } /* Add a new watch to watch-descriptor WD watching FILENAME and using @@ -220,7 +220,7 @@ add_watch (int wd, Lisp_Object filename, /* Assign a watch ID that is not already in use, by looking for a gap in the existing sorted list. */ for (; ! NILP (XCDR (tail)); tail = XCDR (tail), id++) - if (!EQ (XCAR (XCAR (XCDR (tail))), make_number (id))) + if (!EQ (XCAR (XCAR (XCDR (tail))), make_fixnum (id))) break; if (MOST_POSITIVE_FIXNUM < id) emacs_abort (); @@ -229,7 +229,7 @@ add_watch (int wd, Lisp_Object filename, /* Insert the newly-assigned ID into the previously-discovered gap, which is possibly at the end of the list. Inserting it there keeps the list sorted. */ - watch_id = make_number (id); + watch_id = make_fixnum (id); watch = list4 (watch_id, filename, callback, mask); XSETCDR (tail, Fcons (watch, XCDR (tail))); @@ -446,12 +446,12 @@ static bool valid_watch_descriptor (Lisp_Object wd) { return (CONSP (wd) - && (RANGED_INTEGERP (0, XCAR (wd), INT_MAX) + && (RANGED_FIXNUMP (0, XCAR (wd), INT_MAX) || (CONSP (XCAR (wd)) - && RANGED_INTEGERP ((MOST_POSITIVE_FIXNUM >> 16) + 1, + && RANGED_FIXNUMP ((MOST_POSITIVE_FIXNUM >> 16) + 1, XCAR (XCAR (wd)), INT_MAX >> 16) - && RANGED_INTEGERP (0, XCDR (XCAR (wd)), (1 << 16) - 1))) - && NATNUMP (XCDR (wd))); + && RANGED_FIXNUMP (0, XCDR (XCAR (wd)), (1 << 16) - 1))) + && FIXNATP (XCDR (wd))); } DEFUN ("inotify-rm-watch", Finotify_rm_watch, Sinotify_rm_watch, 1, 1, 0, diff --git a/src/insdel.c b/src/insdel.c index 173c243834..a365b95fc1 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -930,7 +930,7 @@ insert_1_both (const char *string, offset_intervals (current_buffer, PT, nchars); if (!inherit && buffer_intervals (current_buffer)) - set_text_properties (make_number (PT), make_number (PT + nchars), + set_text_properties (make_fixnum (PT), make_fixnum (PT + nchars), Qnil, Qnil, Qnil); adjust_point (nchars, nbytes); @@ -1936,7 +1936,7 @@ prepare_to_modify_buffer_1 (ptrdiff_t start, ptrdiff_t end, if (preserve_ptr) { Lisp_Object preserve_marker; - preserve_marker = Fcopy_marker (make_number (*preserve_ptr), Qnil); + preserve_marker = Fcopy_marker (make_fixnum (*preserve_ptr), Qnil); verify_interval_modification (current_buffer, start, end); *preserve_ptr = marker_position (preserve_marker); unchain_marker (XMARKER (preserve_marker)); @@ -2046,7 +2046,7 @@ invalidate_buffer_caches (struct buffer *buf, ptrdiff_t start, ptrdiff_t end) #define PRESERVE_VALUE \ if (preserve_ptr && NILP (preserve_marker)) \ - preserve_marker = Fcopy_marker (make_number (*preserve_ptr), Qnil) + preserve_marker = Fcopy_marker (make_fixnum (*preserve_ptr), Qnil) #define RESTORE_VALUE \ if (! NILP (preserve_marker)) \ @@ -2103,8 +2103,8 @@ signal_before_change (ptrdiff_t start_int, ptrdiff_t end_int, ptrdiff_t count = SPECPDL_INDEX (); struct rvoe_arg rvoe_arg; - start = make_number (start_int); - end = make_number (end_int); + start = make_fixnum (start_int); + end = make_fixnum (end_int); preserve_marker = Qnil; start_marker = Qnil; end_marker = Qnil; @@ -2210,26 +2210,26 @@ signal_after_change (ptrdiff_t charpos, ptrdiff_t lendel, ptrdiff_t lenins) /* Actually run the hook functions. */ CALLN (Frun_hook_with_args, Qafter_change_functions, - make_number (charpos), make_number (charpos + lenins), - make_number (lendel)); + make_fixnum (charpos), make_fixnum (charpos + lenins), + make_fixnum (lendel)); /* There was no error: unarm the reset_on_error. */ rvoe_arg.errorp = 0; } if (buffer_has_overlays ()) - report_overlay_modification (make_number (charpos), - make_number (charpos + lenins), + report_overlay_modification (make_fixnum (charpos), + make_fixnum (charpos + lenins), 1, - make_number (charpos), - make_number (charpos + lenins), - make_number (lendel)); + make_fixnum (charpos), + make_fixnum (charpos + lenins), + make_fixnum (lendel)); /* After an insertion, call the text properties insert-behind-hooks or insert-in-front-hooks. */ if (lendel == 0) - report_interval_modification (make_number (charpos), - make_number (charpos + lenins)); + report_interval_modification (make_fixnum (charpos), + make_fixnum (charpos + lenins)); unbind_to (count, Qnil); } diff --git a/src/intervals.c b/src/intervals.c index 4c624ea79c..90ec4bd053 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -1557,8 +1557,8 @@ graft_intervals_into_buffer (INTERVAL source, ptrdiff_t position, if (!inherit && tree && length > 0) { XSETBUFFER (buf, buffer); - set_text_properties_1 (make_number (position), - make_number (position + length), + set_text_properties_1 (make_fixnum (position), + make_fixnum (position + length), Qnil, buf, find_interval (tree, position)); } @@ -1793,7 +1793,7 @@ adjust_for_invis_intang (ptrdiff_t pos, ptrdiff_t test_offs, ptrdiff_t adj, /* POS + ADJ would be beyond the buffer bounds, so do no adjustment. */ return pos; - test_pos = make_number (pos + test_offs); + test_pos = make_fixnum (pos + test_offs); invis_propval = get_char_property_and_overlay (test_pos, Qinvisible, Qnil, @@ -1806,7 +1806,7 @@ adjust_for_invis_intang (ptrdiff_t pos, ptrdiff_t test_offs, ptrdiff_t adj, such that an insertion at POS would inherit it. */ && (NILP (invis_overlay) /* Invisible property is from a text-property. */ - ? (text_property_stickiness (Qinvisible, make_number (pos), Qnil) + ? (text_property_stickiness (Qinvisible, make_fixnum (pos), Qnil) == (test_offs == 0 ? 1 : -1)) /* Invisible property is from an overlay. */ : (test_offs == 0 @@ -1927,7 +1927,7 @@ set_point_both (ptrdiff_t charpos, ptrdiff_t bytepos) if (! NILP (intangible_propval)) { while (XINT (pos) > BEGV - && EQ (Fget_char_property (make_number (XINT (pos) - 1), + && EQ (Fget_char_property (make_fixnum (XINT (pos) - 1), Qintangible, Qnil), intangible_propval)) pos = Fprevious_char_property_change (pos, Qnil); @@ -1954,7 +1954,7 @@ set_point_both (ptrdiff_t charpos, ptrdiff_t bytepos) /* If preceding char is intangible, skip forward over all chars with matching intangible property. */ - intangible_propval = Fget_char_property (make_number (charpos - 1), + intangible_propval = Fget_char_property (make_fixnum (charpos - 1), Qintangible, Qnil); if (! NILP (intangible_propval)) @@ -2026,18 +2026,18 @@ set_point_both (ptrdiff_t charpos, ptrdiff_t bytepos) enter_after = Qnil; if (! EQ (leave_before, enter_before) && !NILP (leave_before)) - call2 (leave_before, make_number (old_position), - make_number (charpos)); + call2 (leave_before, make_fixnum (old_position), + make_fixnum (charpos)); if (! EQ (leave_after, enter_after) && !NILP (leave_after)) - call2 (leave_after, make_number (old_position), - make_number (charpos)); + call2 (leave_after, make_fixnum (old_position), + make_fixnum (charpos)); if (! EQ (enter_before, leave_before) && !NILP (enter_before)) - call2 (enter_before, make_number (old_position), - make_number (charpos)); + call2 (enter_before, make_fixnum (old_position), + make_fixnum (charpos)); if (! EQ (enter_after, leave_after) && !NILP (enter_after)) - call2 (enter_after, make_number (old_position), - make_number (charpos)); + call2 (enter_after, make_fixnum (old_position), + make_fixnum (charpos)); } } @@ -2066,7 +2066,7 @@ move_if_not_intangible (ptrdiff_t position) skip back over all chars with matching intangible property. */ if (! NILP (intangible_propval)) while (XINT (pos) > BEGV - && EQ (Fget_char_property (make_number (XINT (pos) - 1), + && EQ (Fget_char_property (make_fixnum (XINT (pos) - 1), Qintangible, Qnil), intangible_propval)) pos = Fprevious_char_property_change (pos, Qnil); @@ -2075,7 +2075,7 @@ move_if_not_intangible (ptrdiff_t position) { /* We want to move backward, so check the text after POSITION. */ - intangible_propval = Fget_char_property (make_number (XINT (pos) - 1), + intangible_propval = Fget_char_property (make_fixnum (XINT (pos) - 1), Qintangible, Qnil); /* If following char is intangible, diff --git a/src/json.c b/src/json.c index ea941d7bb5..da6e34d89c 100644 --- a/src/json.c +++ b/src/json.c @@ -284,8 +284,8 @@ json_parse_error (const json_error_t *error) #endif xsignal (symbol, list5 (json_build_string (error->text), - json_build_string (error->source), make_natnum (error->line), - make_natnum (error->column), make_natnum (error->position))); + json_build_string (error->source), make_fixed_natnum (error->line), + make_fixed_natnum (error->column), make_fixed_natnum (error->position))); } static void @@ -482,7 +482,7 @@ lisp_to_json (Lisp_Object lisp, struct json_configuration *conf) return json_check (json_false ()); else if (EQ (lisp, Qt)) return json_check (json_true ()); - else if (INTEGERP (lisp)) + else if (FIXNUMP (lisp)) { CHECK_TYPE_RANGED_INTEGER (json_int_t, lisp); return json_check (json_integer (XINT (lisp))); @@ -735,7 +735,7 @@ json_to_lisp (json_t *json, struct json_configuration *conf) size_t size = json_array_size (json); if (FIXNUM_OVERFLOW_P (size)) xsignal0 (Qoverflow_error); - Lisp_Object result = Fmake_vector (make_natnum (size), Qunbound); + Lisp_Object result = Fmake_vector (make_fixed_natnum (size), Qunbound); for (ptrdiff_t i = 0; i < size; ++i) ASET (result, i, json_to_lisp (json_array_get (json, i), conf)); @@ -755,7 +755,7 @@ json_to_lisp (json_t *json, struct json_configuration *conf) if (FIXNUM_OVERFLOW_P (size)) xsignal0 (Qoverflow_error); result = CALLN (Fmake_hash_table, QCtest, Qequal, QCsize, - make_natnum (size)); + make_fixed_natnum (size)); struct Lisp_Hash_Table *h = XHASH_TABLE (result); const char *key_str; json_t *value; diff --git a/src/keyboard.c b/src/keyboard.c index aa58e26843..25864b5b5f 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -441,7 +441,7 @@ static bool echo_keystrokes_p (void) { return (FLOATP (Vecho_keystrokes) ? XFLOAT_DATA (Vecho_keystrokes) > 0.0 - : INTEGERP (Vecho_keystrokes) ? XINT (Vecho_keystrokes) > 0 + : FIXNUMP (Vecho_keystrokes) ? XINT (Vecho_keystrokes) > 0 : false); } @@ -466,7 +466,7 @@ echo_add_key (Lisp_Object c) /* If someone has passed us a composite event, use its head symbol. */ c = EVENT_HEAD (c); - if (INTEGERP (c)) + if (FIXNUMP (c)) ptr = push_key_description (XINT (c), ptr); else if (SYMBOLP (c)) { @@ -535,10 +535,10 @@ echo_dash (void) { Lisp_Object last_char, prev_char, idx; - idx = make_number (SCHARS (KVAR (current_kboard, echo_string)) - 2); + idx = make_fixnum (SCHARS (KVAR (current_kboard, echo_string)) - 2); prev_char = Faref (KVAR (current_kboard, echo_string), idx); - idx = make_number (SCHARS (KVAR (current_kboard, echo_string)) - 1); + idx = make_fixnum (SCHARS (KVAR (current_kboard, echo_string)) - 1); last_char = Faref (KVAR (current_kboard, echo_string), idx); if (XINT (last_char) == '-' && XINT (prev_char) != ' ') @@ -643,7 +643,7 @@ echo_truncate (ptrdiff_t nchars) if (STRINGP (es) && SCHARS (es) > nchars) kset_echo_string (current_kboard, Fsubstring (KVAR (current_kboard, echo_string), - make_number (0), make_number (nchars))); + make_fixnum (0), make_fixnum (nchars))); truncate_echo_area (nchars); } @@ -945,7 +945,7 @@ cmd_error (Lisp_Object data) Vquit_flag = Qnil; Vinhibit_quit = Qnil; - return make_number (0); + return make_fixnum (0); } /* Take actions on handling an error. DATA is the data that describes @@ -1005,7 +1005,7 @@ Default value of `command-error-function'. */) print_error_message (data, Qexternal_debugging_output, SSDATA (context), signal); Fterpri (Qexternal_debugging_output, Qnil); - Fkill_emacs (make_number (-1)); + Fkill_emacs (make_fixnum (-1)); } else { @@ -1298,7 +1298,7 @@ command_loop_1 (void) if (minibuf_level && !NILP (echo_area_buffer[0]) && EQ (minibuf_window, echo_area_window) - && NUMBERP (Vminibuffer_message_timeout)) + && FIXED_OR_FLOATP (Vminibuffer_message_timeout)) { /* Bind inhibit-quit to t so that C-g gets read in rather than quitting back to the minibuffer. */ @@ -1317,7 +1317,7 @@ command_loop_1 (void) if (!NILP (Vquit_flag)) { Vquit_flag = Qnil; - Vunread_command_events = list1 (make_number (quit_char)); + Vunread_command_events = list1 (make_fixnum (quit_char)); } } @@ -1575,7 +1575,7 @@ read_menu_command (void) /* We don't want to echo the keystrokes while navigating the menus. */ - specbind (Qecho_keystrokes, make_number (0)); + specbind (Qecho_keystrokes, make_fixnum (0)); Lisp_Object keybuf[READ_KEY_ELTS]; int i = read_key_sequence (keybuf, Qnil, false, true, true, true); @@ -1626,7 +1626,7 @@ adjust_point_for_property (ptrdiff_t last_pt, bool modified) if (check_display && PT > BEGV && PT < ZV && !NILP (val = get_char_property_and_overlay - (make_number (PT), Qdisplay, selected_window, + (make_fixnum (PT), Qdisplay, selected_window, &overlay)) && display_prop_intangible_p (val, overlay, PT, PT_BYTE) && (!OVERLAYP (overlay) @@ -1663,12 +1663,12 @@ adjust_point_for_property (ptrdiff_t last_pt, bool modified) than skip both boundaries. However, this code also stops anywhere in a non-sticky text-property, which breaks (e.g.) Org mode. */ - && (val = Fget_pos_property (make_number (end), + && (val = Fget_pos_property (make_fixnum (end), Qinvisible, Qnil), TEXT_PROP_MEANS_INVISIBLE (val)) #endif && !NILP (val = get_char_property_and_overlay - (make_number (end), Qinvisible, Qnil, &overlay)) + (make_fixnum (end), Qinvisible, Qnil, &overlay)) && (inv = TEXT_PROP_MEANS_INVISIBLE (val))) { ellipsis = ellipsis || inv > 1 @@ -1676,17 +1676,17 @@ adjust_point_for_property (ptrdiff_t last_pt, bool modified) && (!NILP (Foverlay_get (overlay, Qafter_string)) || !NILP (Foverlay_get (overlay, Qbefore_string)))); tmp = Fnext_single_char_property_change - (make_number (end), Qinvisible, Qnil, Qnil); - end = NATNUMP (tmp) ? XFASTINT (tmp) : ZV; + (make_fixnum (end), Qinvisible, Qnil, Qnil); + end = FIXNATP (tmp) ? XFASTINT (tmp) : ZV; } while (beg > BEGV #if 0 - && (val = Fget_pos_property (make_number (beg), + && (val = Fget_pos_property (make_fixnum (beg), Qinvisible, Qnil), TEXT_PROP_MEANS_INVISIBLE (val)) #endif && !NILP (val = get_char_property_and_overlay - (make_number (beg - 1), Qinvisible, Qnil, &overlay)) + (make_fixnum (beg - 1), Qinvisible, Qnil, &overlay)) && (inv = TEXT_PROP_MEANS_INVISIBLE (val))) { ellipsis = ellipsis || inv > 1 @@ -1694,8 +1694,8 @@ adjust_point_for_property (ptrdiff_t last_pt, bool modified) && (!NILP (Foverlay_get (overlay, Qafter_string)) || !NILP (Foverlay_get (overlay, Qbefore_string)))); tmp = Fprevious_single_char_property_change - (make_number (beg), Qinvisible, Qnil, Qnil); - beg = NATNUMP (tmp) ? XFASTINT (tmp) : BEGV; + (make_fixnum (beg), Qinvisible, Qnil, Qnil); + beg = FIXNATP (tmp) ? XFASTINT (tmp) : BEGV; } /* Move away from the inside area. */ @@ -1735,11 +1735,11 @@ adjust_point_for_property (ptrdiff_t last_pt, bool modified) to the other end would mean moving backwards and thus could lead to an infinite loop. */ ; - else if (val = Fget_pos_property (make_number (PT), + else if (val = Fget_pos_property (make_fixnum (PT), Qinvisible, Qnil), TEXT_PROP_MEANS_INVISIBLE (val) && (val = (Fget_pos_property - (make_number (PT == beg ? end : beg), + (make_fixnum (PT == beg ? end : beg), Qinvisible, Qnil)), !TEXT_PROP_MEANS_INVISIBLE (val))) (check_composition = check_display = true, @@ -1962,7 +1962,7 @@ bind_polling_period (int n) stop_other_atimers (poll_timer); stop_polling (); - specbind (Qpolling_period, make_number (new)); + specbind (Qpolling_period, make_fixnum (new)); /* Start a new alarm with the new period. */ start_polling (); #endif @@ -2141,14 +2141,14 @@ read_event_from_main_queue (struct timespec *end_time, if (single_kboard) goto start; current_kboard = kb; - return make_number (-2); + return make_fixnum (-2); } /* Terminate Emacs in batch mode if at eof. */ - if (noninteractive && INTEGERP (c) && XINT (c) < 0) - Fkill_emacs (make_number (1)); + if (noninteractive && FIXNUMP (c) && XINT (c) < 0) + Fkill_emacs (make_fixnum (1)); - if (INTEGERP (c)) + if (FIXNUMP (c)) { /* Add in any extra modifiers, where appropriate. */ if ((extra_keyboard_modifiers & CHAR_CTL) @@ -2207,7 +2207,7 @@ read_decoded_event_from_main_queue (struct timespec *end_time, int meta_key = terminal->display_info.tty->meta_key; eassert (n < MAX_ENCODED_BYTES); events[n++] = nextevt; - if (NATNUMP (nextevt) + if (FIXNATP (nextevt) && XINT (nextevt) < (meta_key == 1 ? 0x80 : 0x100)) { /* An encoded byte sequence, let's try to decode it. */ struct coding_system *coding @@ -2218,7 +2218,7 @@ read_decoded_event_from_main_queue (struct timespec *end_time, int i; if (meta_key != 2) for (i = 0; i < n; i++) - events[i] = make_number (XINT (events[i]) & ~0x80); + events[i] = make_fixnum (XINT (events[i]) & ~0x80); } else { @@ -2245,7 +2245,7 @@ read_decoded_event_from_main_queue (struct timespec *end_time, eassert (coding->carryover_bytes == 0); n = 0; while (n < coding->produced_char) - events[n++] = make_number (STRING_CHAR_ADVANCE (p)); + events[n++] = make_fixnum (STRING_CHAR_ADVANCE (p)); } } } @@ -2323,7 +2323,7 @@ read_char (int commandflag, Lisp_Object map, /* Undo what read_char_x_menu_prompt did when it unread additional keys returned by Fx_popup_menu. */ if (CONSP (c) - && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c))) + && (SYMBOLP (XCAR (c)) || FIXNUMP (XCAR (c))) && NILP (XCDR (c))) c = XCAR (c); @@ -2353,7 +2353,7 @@ read_char (int commandflag, Lisp_Object map, additional keys returned by Fx_popup_menu. */ if (CONSP (c) && EQ (XCDR (c), Qdisabled) - && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c)))) + && (SYMBOLP (XCAR (c)) || FIXNUMP (XCAR (c)))) { was_disabled = true; c = XCAR (c); @@ -2378,7 +2378,7 @@ read_char (int commandflag, Lisp_Object map, /* Undo what read_char_x_menu_prompt did when it unread additional keys returned by Fx_popup_menu. */ if (CONSP (c) - && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c))) + && (SYMBOLP (XCAR (c)) || FIXNUMP (XCAR (c))) && NILP (XCDR (c))) c = XCAR (c); reread = true; @@ -2409,7 +2409,7 @@ read_char (int commandflag, Lisp_Object map, goto exit; } - c = Faref (Vexecuting_kbd_macro, make_number (executing_kbd_macro_index)); + c = Faref (Vexecuting_kbd_macro, make_fixnum (executing_kbd_macro_index)); if (STRINGP (Vexecuting_kbd_macro) && (XFASTINT (c) & 0x80) && (XFASTINT (c) <= 0xff)) XSETFASTINT (c, CHAR_META | (XFASTINT (c) & ~0x80)); @@ -2516,7 +2516,7 @@ read_char (int commandflag, Lisp_Object map, { c = read_char_minibuf_menu_prompt (commandflag, map); - if (INTEGERP (c) && XINT (c) == -2) + if (FIXNUMP (c) && XINT (c) == -2) return c; /* wrong_kboard_jmpbuf */ if (! NILP (c)) @@ -2567,7 +2567,7 @@ read_char (int commandflag, Lisp_Object map, XSETCDR (last, list1 (c)); kb->kbd_queue_has_data = true; current_kboard = kb; - return make_number (-2); /* wrong_kboard_jmpbuf */ + return make_fixnum (-2); /* wrong_kboard_jmpbuf */ } } goto non_reread; @@ -2675,7 +2675,7 @@ read_char (int commandflag, Lisp_Object map, /* Auto save if enough time goes by without input. */ if (commandflag != 0 && commandflag != -2 && num_nonmacro_input_events > last_auto_save - && INTEGERP (Vauto_save_timeout) + && FIXNUMP (Vauto_save_timeout) && XINT (Vauto_save_timeout) > 0) { Lisp_Object tem0; @@ -2685,7 +2685,7 @@ read_char (int commandflag, Lisp_Object map, timeout = delay_level * timeout / 4; save_getcjmp (save_jump); restore_getcjmp (local_getcjmp); - tem0 = sit_for (make_number (timeout), 1, 1); + tem0 = sit_for (make_fixnum (timeout), 1, 1); restore_getcjmp (save_jump); if (EQ (tem0, Qt) @@ -2709,7 +2709,7 @@ read_char (int commandflag, Lisp_Object map, interpret the next key sequence using the wrong translation tables and function keymaps. */ if (NILP (c) && current_kboard != orig_kboard) - return make_number (-2); /* wrong_kboard_jmpbuf */ + return make_fixnum (-2); /* wrong_kboard_jmpbuf */ /* If this has become non-nil here, it has been set by a timer or sentinel or filter. */ @@ -2760,7 +2760,7 @@ read_char (int commandflag, Lisp_Object map, if (kb->kbd_queue_has_data) { current_kboard = kb; - return make_number (-2); /* wrong_kboard_jmpbuf */ + return make_fixnum (-2); /* wrong_kboard_jmpbuf */ } } @@ -2778,7 +2778,7 @@ read_char (int commandflag, Lisp_Object map, goto exit; } - if (EQ (c, make_number (-2))) + if (EQ (c, make_fixnum (-2))) return c; if (CONSP (c) && EQ (XCAR (c), Qt)) @@ -2841,7 +2841,7 @@ read_char (int commandflag, Lisp_Object map, /* The command may have changed the keymaps. Pretend there is input in another keyboard and return. This will recalculate keymaps. */ - c = make_number (-2); + c = make_fixnum (-2); goto exit; } else @@ -2849,7 +2849,7 @@ read_char (int commandflag, Lisp_Object map, } /* Handle things that only apply to characters. */ - if (INTEGERP (c)) + if (FIXNUMP (c)) { /* If kbd_buffer_get_event gave us an EOF, return that. */ if (XINT (c) == -1) @@ -2908,7 +2908,7 @@ read_char (int commandflag, Lisp_Object map, /* Wipe the echo area. But first, if we are about to use an input method, save the echo area contents for it to refer to. */ - if (INTEGERP (c) + if (FIXNUMP (c) && ! NILP (Vinput_method_function) && ' ' <= XINT (c) && XINT (c) < 256 && XINT (c) != 127) { @@ -2935,7 +2935,7 @@ read_char (int commandflag, Lisp_Object map, reread_for_input_method: from_macro: /* Pass this to the input method, if appropriate. */ - if (INTEGERP (c) + if (FIXNUMP (c) && ! NILP (Vinput_method_function) /* Don't run the input method within a key sequence, after the first event of the key sequence. */ @@ -3091,7 +3091,7 @@ read_char (int commandflag, Lisp_Object map, unbind_to (count, Qnil); redisplay (); - if (EQ (c, make_number (040))) + if (EQ (c, make_fixnum (040))) { cancel_echoing (); do @@ -3259,7 +3259,7 @@ record_char (Lisp_Object c) if (dribble) { block_input (); - if (INTEGERP (c)) + if (FIXNUMP (c)) { if (XUINT (c) < 0x100) putc_unlocked (XUINT (c), dribble); @@ -3456,7 +3456,7 @@ kbd_buffer_store_buffered_event (union buffered_input_event *event, { kset_kbd_queue (kb, list2 (make_lispy_switch_frame (event->ie.frame_or_window), - make_number (c))); + make_fixnum (c))); kb->kbd_queue_has_data = true; union buffered_input_event *sp; for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++) @@ -4156,7 +4156,7 @@ decode_timer (Lisp_Object timer, struct timespec *result) vec = XVECTOR (timer)->contents; if (! NILP (vec[0])) return 0; - if (! INTEGERP (vec[2])) + if (! FIXNUMP (vec[2])) return false; struct lisp_time t; @@ -5051,7 +5051,7 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, string = mode_line_string (w, part, &col, &row, &charpos, &object, &dx, &dy, &width, &height); if (STRINGP (string)) - string_info = Fcons (string, make_number (charpos)); + string_info = Fcons (string, make_fixnum (charpos)); textpos = -1; xret = wx; @@ -5070,7 +5070,7 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, string = marginal_area_string (w, part, &col, &row, &charpos, &object, &dx, &dy, &width, &height); if (STRINGP (string)) - string_info = Fcons (string, make_number (charpos)); + string_info = Fcons (string, make_fixnum (charpos)); xret = wx; yret = wy - WINDOW_HEADER_LINE_HEIGHT (w); } @@ -5169,10 +5169,10 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, if (NILP (posn)) { - posn = make_number (textpos); + posn = make_fixnum (textpos); if (STRINGP (string2)) string_info = Fcons (string2, - make_number (CHARPOS (p.string_pos))); + make_fixnum (CHARPOS (p.string_pos))); } if (NILP (object)) object = object2; @@ -5194,14 +5194,14 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, /* Object info. */ extra_info = list3 (object, - Fcons (make_number (dx), make_number (dy)), - Fcons (make_number (width), make_number (height))); + Fcons (make_fixnum (dx), make_fixnum (dy)), + Fcons (make_fixnum (width), make_fixnum (height))); /* String info. */ extra_info = Fcons (string_info, - Fcons (textpos < 0 ? Qnil : make_number (textpos), - Fcons (Fcons (make_number (col), - make_number (row)), + Fcons (textpos < 0 ? Qnil : make_fixnum (textpos), + Fcons (Fcons (make_fixnum (col), + make_fixnum (row)), extra_info))); } @@ -5230,9 +5230,9 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, return Fcons (window_or_frame, Fcons (posn, - Fcons (Fcons (make_number (xret), - make_number (yret)), - Fcons (make_number (t), + Fcons (Fcons (make_fixnum (xret), + make_fixnum (yret)), + Fcons (make_fixnum (t), extra_info)))); } @@ -5257,7 +5257,7 @@ static Lisp_Object make_scroll_bar_position (struct input_event *ev, Lisp_Object type) { return list5 (ev->frame_or_window, type, Fcons (ev->x, ev->y), - make_number (ev->timestamp), + make_fixnum (ev->timestamp), builtin_lisp_symbol (scroll_bar_parts[ev->part])); } @@ -5318,7 +5318,7 @@ make_lispy_event (struct input_event *event) Lisp_Object frame = event->frame_or_window; Lisp_Object object = event->arg; Lisp_Object position - = make_number (Time_to_position (event->timestamp)); + = make_fixnum (Time_to_position (event->timestamp)); Lisp_Object window = event->x; Lisp_Object help = event->y; clear_event (event); @@ -5474,8 +5474,8 @@ make_lispy_event (struct input_event *event) /* Make an event (language-change FRAME CODEPAGE LANGUAGE-ID). */ return list4 (Qlanguage_change, event->frame_or_window, - make_number (event->code), - make_number (event->modifiers)); + make_fixnum (event->code), + make_fixnum (event->modifiers)); case MULTIMEDIA_KEY_EVENT: if (event->code < ARRAYELTS (lispy_multimedia_keys) @@ -5569,7 +5569,7 @@ make_lispy_event (struct input_event *event) position = list4 (event->frame_or_window, Qmenu_bar, Fcons (event->x, event->y), - make_number (event->timestamp)); + make_fixnum (event->timestamp)); return list2 (item, position); } @@ -5620,7 +5620,7 @@ make_lispy_event (struct input_event *event) && (eabs (XINT (event->y) - last_mouse_y) <= fuzz) && button_down_time != 0 && (EQ (Vdouble_click_time, Qt) - || (NATNUMP (Vdouble_click_time) + || (FIXNATP (Vdouble_click_time) && (event->timestamp - button_down_time < XFASTINT (Vdouble_click_time))))); } @@ -5672,7 +5672,7 @@ make_lispy_event (struct input_event *event) new_down = Fcar (Fcdr (Fcdr (position))); if (CONSP (down) - && INTEGERP (XCAR (down)) && INTEGERP (XCDR (down))) + && FIXNUMP (XCAR (down)) && FIXNUMP (XCDR (down))) { xdiff = XINT (XCAR (new_down)) - XINT (XCAR (down)); ydiff = XINT (XCDR (new_down)) - XINT (XCDR (down)); @@ -5730,7 +5730,7 @@ make_lispy_event (struct input_event *event) if (event->modifiers & drag_modifier) return list3 (head, start_pos, position); else if (event->modifiers & (double_modifier | triple_modifier)) - return list3 (head, position, make_number (double_click_count)); + return list3 (head, position, make_fixnum (double_click_count)); else return list2 (head, position); } @@ -5798,7 +5798,7 @@ make_lispy_event (struct input_event *event) && (eabs (XINT (event->y) - last_mouse_y) <= fuzz) && button_down_time != 0 && (EQ (Vdouble_click_time, Qt) - || (NATNUMP (Vdouble_click_time) + || (FIXNATP (Vdouble_click_time) && (event->timestamp - button_down_time < XFASTINT (Vdouble_click_time))))); if (is_double) @@ -5830,11 +5830,11 @@ make_lispy_event (struct input_event *event) ASIZE (wheel_syms)); } - if (NUMBERP (event->arg)) - return list4 (head, position, make_number (double_click_count), + if (FIXED_OR_FLOATP (event->arg)) + return list4 (head, position, make_fixnum (double_click_count), event->arg); else if (event->modifiers & (double_modifier | triple_modifier)) - return list3 (head, position, make_number (double_click_count)); + return list3 (head, position, make_fixnum (double_click_count)); else return list2 (head, position); } @@ -6020,7 +6020,7 @@ make_lispy_movement (struct frame *frame, Lisp_Object bar_window, enum scroll_ba list5 (bar_window, Qvertical_scroll_bar, Fcons (x, y), - make_number (t), + make_fixnum (t), part_sym)); } /* Or is it an ordinary mouse movement? */ @@ -6267,7 +6267,7 @@ parse_modifiers (Lisp_Object symbol) { Lisp_Object elements; - if (INTEGERP (symbol)) + if (FIXNUMP (symbol)) return list2i (KEY_TO_CHAR (symbol), XINT (symbol) & CHAR_MODIFIER_MASK); else if (!SYMBOLP (symbol)) return Qnil; @@ -6335,8 +6335,8 @@ apply_modifiers (int modifiers, Lisp_Object base) /* Mask out upper bits. We don't know where this value's been. */ modifiers &= INTMASK; - if (INTEGERP (base)) - return make_number (XINT (base) | modifiers); + if (FIXNUMP (base)) + return make_fixnum (XINT (base) | modifiers); /* The click modifier never figures into cache indices. */ cache = Fget (base, Qmodifier_cache); @@ -6574,7 +6574,7 @@ has the same base event type and all the specified modifiers. */) if (SYMBOLP (base) && SCHARS (SYMBOL_NAME (base)) == 1) XSETINT (base, SREF (SYMBOL_NAME (base), 0)); - if (INTEGERP (base)) + if (FIXNUMP (base)) { /* Turn (shift a) into A. */ if ((modifiers & shift_modifier) != 0 @@ -6586,10 +6586,10 @@ has the same base event type and all the specified modifiers. */) /* Turn (control a) into C-a. */ if (modifiers & ctrl_modifier) - return make_number ((modifiers & ~ctrl_modifier) + return make_fixnum ((modifiers & ~ctrl_modifier) | make_ctrl_char (XINT (base))); else - return make_number (modifiers | XINT (base)); + return make_fixnum (modifiers | XINT (base)); } else if (SYMBOLP (base)) return apply_modifiers (modifiers, base); @@ -6732,7 +6732,7 @@ lucid_event_type_list_p (Lisp_Object object) { Lisp_Object elt; elt = XCAR (tail); - if (! (INTEGERP (elt) || SYMBOLP (elt))) + if (! (FIXNUMP (elt) || SYMBOLP (elt))) return 0; } @@ -7381,7 +7381,7 @@ menu_bar_items (Lisp_Object old) if (!NILP (old)) menu_bar_items_vector = old; else - menu_bar_items_vector = Fmake_vector (make_number (24), Qnil); + menu_bar_items_vector = Fmake_vector (make_fixnum (24), Qnil); menu_bar_items_index = 0; /* Build our list of keymaps. @@ -7553,7 +7553,7 @@ menu_bar_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy1, void *dumm ASET (menu_bar_items_vector, i, AREF (item_properties, ITEM_PROPERTY_NAME)); i++; ASET (menu_bar_items_vector, i, list1 (item)); i++; - ASET (menu_bar_items_vector, i, make_number (0)); i++; + ASET (menu_bar_items_vector, i, make_fixnum (0)); i++; menu_bar_items_index = i; } /* We did find an item for this KEY. Add ITEM to its list of maps. */ @@ -7625,7 +7625,7 @@ parse_menu_item (Lisp_Object item, int inmenubar) /* Create item_properties vector if necessary. */ if (NILP (item_properties)) item_properties - = Fmake_vector (make_number (ITEM_PROPERTY_ENABLE + 1), Qnil); + = Fmake_vector (make_fixnum (ITEM_PROPERTY_ENABLE + 1), Qnil); /* Initialize optional entries. */ for (i = ITEM_PROPERTY_DEF; i < ITEM_PROPERTY_ENABLE; i++) @@ -8120,7 +8120,7 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item) } else tool_bar_item_properties - = Fmake_vector (make_number (TOOL_BAR_ITEM_NSLOTS), Qnil); + = Fmake_vector (make_fixnum (TOOL_BAR_ITEM_NSLOTS), Qnil); /* Set defaults. */ set_prop (TOOL_BAR_ITEM_KEY, key); @@ -8315,7 +8315,7 @@ init_tool_bar_items (Lisp_Object reuse) if (VECTORP (reuse)) tool_bar_items_vector = reuse; else - tool_bar_items_vector = Fmake_vector (make_number (64), Qnil); + tool_bar_items_vector = Fmake_vector (make_fixnum (64), Qnil); ntool_bar_items = 0; } @@ -8405,7 +8405,7 @@ read_char_x_menu_prompt (Lisp_Object map, { record_menu_key (XCAR (tem)); if (SYMBOLP (XCAR (tem)) - || INTEGERP (XCAR (tem))) + || FIXNUMP (XCAR (tem))) XSETCAR (tem, Fcons (XCAR (tem), Qdisabled)); } @@ -8516,7 +8516,7 @@ read_char_minibuf_menu_prompt (int commandflag, } /* Ignore the element if it has no prompt string. */ - if (INTEGERP (event) && parse_menu_item (elt, -1)) + if (FIXNUMP (event) && parse_menu_item (elt, -1)) { /* True if the char to type matches the string. */ bool char_matches; @@ -8584,8 +8584,8 @@ read_char_minibuf_menu_prompt (int commandflag, /* Add as much of string as fits. */ thiswidth = min (SCHARS (desc), width - i); menu_strings - = Fcons (Fsubstring (desc, make_number (0), - make_number (thiswidth)), + = Fcons (Fsubstring (desc, make_fixnum (0), + make_fixnum (thiswidth)), menu_strings); i += thiswidth; PUSH_C_STR (" = ", menu_strings); @@ -8595,8 +8595,8 @@ read_char_minibuf_menu_prompt (int commandflag, /* Add as much of string as fits. */ thiswidth = min (SCHARS (s), width - i); menu_strings - = Fcons (Fsubstring (s, make_number (0), - make_number (thiswidth)), + = Fcons (Fsubstring (s, make_fixnum (0), + make_fixnum (thiswidth)), menu_strings); i += thiswidth; } @@ -8633,10 +8633,10 @@ read_char_minibuf_menu_prompt (int commandflag, while (BUFFERP (obj)); kset_defining_kbd_macro (current_kboard, orig_defn_macro); - if (!INTEGERP (obj) || XINT (obj) == -2 + if (!FIXNUMP (obj) || XINT (obj) == -2 || (! EQ (obj, menu_prompt_more_char) - && (!INTEGERP (menu_prompt_more_char) - || ! EQ (obj, make_number (Ctl (XINT (menu_prompt_more_char))))))) + && (!FIXNUMP (menu_prompt_more_char) + || ! EQ (obj, make_fixnum (Ctl (XINT (menu_prompt_more_char))))))) { if (!NILP (KVAR (current_kboard, defining_kbd_macro))) store_kbd_macro_char (obj); @@ -8775,7 +8775,7 @@ keyremap_step (Lisp_Object *keybuf, volatile keyremap *fkey, /* Overwrite the old keys with the new ones. */ for (i = 0; i < len; i++) keybuf[fkey->start + i] - = Faref (next, make_number (i)); + = Faref (next, make_fixnum (i)); fkey->start = fkey->end += *diff; fkey->map = fkey->parent; @@ -9105,7 +9105,7 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt, current_binding, last_nonmenu_event, &used_mouse_menu, NULL); used_mouse_menu_history[t] = used_mouse_menu; - if ((INTEGERP (key) && XINT (key) == -2) /* wrong_kboard_jmpbuf */ + if ((FIXNUMP (key) && XINT (key) == -2) /* wrong_kboard_jmpbuf */ /* When switching to a new tty (with a new keyboard), read_char returns the new buffer, rather than -2 (Bug#5095). This is because `terminal-init-xterm' @@ -9173,7 +9173,7 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt, /* read_char returns -1 at the end of a macro. Emacs 18 handles this by returning immediately with a zero, so that's what we'll do. */ - if (INTEGERP (key) && XINT (key) == -1) + if (FIXNUMP (key) && XINT (key) == -1) { t = 0; /* The Microsoft C compiler can't handle the goto that @@ -9208,7 +9208,7 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt, /* If we have a quit that was typed in another frame, and quit_throw_to_read_char switched buffers, replay to get the right keymap. */ - if (INTEGERP (key) + if (FIXNUMP (key) && XINT (key) == quit_char && current_buffer != starting_buffer) { @@ -9639,14 +9639,14 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt, use the corresponding lower-case letter instead. */ if (NILP (current_binding) && /* indec.start >= t && fkey.start >= t && */ keytran.start >= t - && INTEGERP (key)) + && FIXNUMP (key)) { Lisp_Object new_key; EMACS_INT k = XINT (key); if (k & shift_modifier) XSETINT (new_key, k & ~shift_modifier); - else if (CHARACTERP (make_number (k & ~CHAR_MODIFIER_MASK))) + else if (CHARACTERP (make_fixnum (k & ~CHAR_MODIFIER_MASK))) { int dc = downcase (k & ~CHAR_MODIFIER_MASK); if (dc == (k & ~CHAR_MODIFIER_MASK)) @@ -9693,7 +9693,7 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt, if (modifiers & shift_modifier /* Treat uppercase keys as shifted. */ - || (INTEGERP (key) + || (FIXNUMP (key) && (KEY_TO_CHAR (key) < XCHAR_TABLE (BVAR (current_buffer, downcase_table))->header.size) && uppercasep (KEY_TO_CHAR (key)))) @@ -9702,7 +9702,7 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt, = (modifiers & shift_modifier ? apply_modifiers (modifiers & ~shift_modifier, XCAR (breakdown)) - : make_number (downcase (KEY_TO_CHAR (key)) | modifiers)); + : make_fixnum (downcase (KEY_TO_CHAR (key)) | modifiers)); original_uppercase = key; original_uppercase_position = t - 1; @@ -10023,16 +10023,16 @@ Internal use only. */) /* Kludge alert: this makes M-x be in the form expected by novice.el. (248 is \370, a.k.a. "Meta-x".) Any better ideas? */ if (key0 == 248) - add_command_key (make_number ('x' | meta_modifier)); + add_command_key (make_fixnum ('x' | meta_modifier)); else - add_command_key (make_number (key0)); + add_command_key (make_fixnum (key0)); for (ptrdiff_t i = 1; i < SCHARS (keys); i++) { int key_i; FETCH_STRING_CHAR_ADVANCE (key_i, keys, charidx, byteidx); if (CHAR_BYTE8_P (key_i)) key_i = CHAR_TO_BYTE8 (key_i); - add_command_key (make_number (key_i)); + add_command_key (make_fixnum (key_i)); } return Qnil; } @@ -10105,7 +10105,7 @@ DEFUN ("recursion-depth", Frecursion_depth, Srecursion_depth, 0, 0, 0, { EMACS_INT sum; INT_ADD_WRAPV (command_loop_level, minibuf_level, &sum); - return make_number (sum); + return make_fixnum (sum); } DEFUN ("open-dribble-file", Fopen_dribble_file, Sopen_dribble_file, 1, 1, @@ -10655,7 +10655,7 @@ See also `current-input-mode'. */) return Qnil; tty = t->display_info.tty; - if (NILP (quit) || !INTEGERP (quit) || XINT (quit) < 0 || XINT (quit) > 0400) + if (NILP (quit) || !FIXNUMP (quit) || XINT (quit) < 0 || XINT (quit) > 0400) error ("QUIT must be an ASCII character"); #ifndef DOS_NT @@ -10718,7 +10718,7 @@ The elements of this list correspond to the arguments of { flow = FRAME_TTY (sf)->flow_control ? Qt : Qnil; meta = (FRAME_TTY (sf)->meta_key == 2 - ? make_number (0) + ? make_fixnum (0) : (CURTTY ()->meta_key == 1 ? Qt : Qnil)); } else @@ -10726,7 +10726,7 @@ The elements of this list correspond to the arguments of flow = Qnil; meta = Qt; } - Lisp_Object quit = make_number (quit_char); + Lisp_Object quit = make_fixnum (quit_char); return list4 (interrupt, flow, meta, quit); } @@ -10744,12 +10744,12 @@ The return value is similar to a mouse click position: The `posn-' functions access elements of such lists. */) (Lisp_Object x, Lisp_Object y, Lisp_Object frame_or_window, Lisp_Object whole) { - CHECK_NUMBER (x); + CHECK_FIXNUM (x); /* We allow X of -1, for the newline in a R2L line that overflowed into the left fringe. */ if (XINT (x) != -1) - CHECK_NATNUM (x); - CHECK_NATNUM (y); + CHECK_FIXNAT (x); + CHECK_FIXNAT (y); if (NILP (frame_or_window)) frame_or_window = selected_window; @@ -10806,7 +10806,7 @@ The `posn-' functions access elements of such lists. */) { int rtop = XINT (XCAR (aux_info)); - y = make_number (y_coord + rtop); + y = make_fixnum (y_coord + rtop); } tem = Fposn_at_x_y (x, y, window, Qnil); } @@ -11195,11 +11195,11 @@ syms_of_keyboard (void) } } - button_down_location = Fmake_vector (make_number (5), Qnil); + button_down_location = Fmake_vector (make_fixnum (5), Qnil); staticpro (&button_down_location); - mouse_syms = Fmake_vector (make_number (5), Qnil); + mouse_syms = Fmake_vector (make_fixnum (5), Qnil); staticpro (&mouse_syms); - wheel_syms = Fmake_vector (make_number (ARRAYELTS (lispy_wheel_names)), + wheel_syms = Fmake_vector (make_fixnum (ARRAYELTS (lispy_wheel_names)), Qnil); staticpro (&wheel_syms); @@ -11207,20 +11207,20 @@ syms_of_keyboard (void) int i; int len = ARRAYELTS (modifier_names); - modifier_symbols = Fmake_vector (make_number (len), Qnil); + modifier_symbols = Fmake_vector (make_fixnum (len), Qnil); for (i = 0; i < len; i++) if (modifier_names[i]) ASET (modifier_symbols, i, intern_c_string (modifier_names[i])); staticpro (&modifier_symbols); } - recent_keys = Fmake_vector (make_number (NUM_RECENT_KEYS), Qnil); + recent_keys = Fmake_vector (make_fixnum (NUM_RECENT_KEYS), Qnil); staticpro (&recent_keys); - this_command_keys = Fmake_vector (make_number (40), Qnil); + this_command_keys = Fmake_vector (make_fixnum (40), Qnil); staticpro (&this_command_keys); - raw_keybuf = Fmake_vector (make_number (30), Qnil); + raw_keybuf = Fmake_vector (make_fixnum (30), Qnil); staticpro (&raw_keybuf); DEFSYM (Qcommand_execute, "command-execute"); @@ -11395,7 +11395,7 @@ Emacs also does a garbage collection if that seems to be warranted. */); doc: /* Nonzero means echo unfinished commands after this many seconds of pause. The value may be integer or floating point. If the value is zero, don't echo at all. */); - Vecho_keystrokes = make_number (1); + Vecho_keystrokes = make_fixnum (1); DEFVAR_INT ("polling-period", polling_period, doc: /* Interval between polling for input during Lisp execution. @@ -11409,7 +11409,7 @@ Polling is automatically disabled in all other cases. */); Measured in milliseconds. The value nil means disable double-click recognition; t means double-clicks have no time limit and are detected by position only. */); - Vdouble_click_time = make_number (500); + Vdouble_click_time = make_fixnum (500); DEFVAR_INT ("double-click-fuzz", double_click_fuzz, doc: /* Maximum mouse movement between clicks to make a double-click. @@ -11759,7 +11759,7 @@ suppressed only after special commands that leave doc: /* How long to display an echo-area message when the minibuffer is active. If the value is a number, it should be specified in seconds. If the value is not a number, such messages never time out. */); - Vminibuffer_message_timeout = make_number (2); + Vminibuffer_message_timeout = make_fixnum (2); DEFVAR_LISP ("throw-on-input", Vthrow_on_input, doc: /* If non-nil, any keyboard input throws to this symbol. diff --git a/src/keyboard.h b/src/keyboard.h index cae949893f..ce4630b8a3 100644 --- a/src/keyboard.h +++ b/src/keyboard.h @@ -391,7 +391,7 @@ extern void unuse_menu_items (void); #define EVENT_END(event) (CAR_SAFE (CDR_SAFE (CDR_SAFE (event)))) /* Extract the click count from a multi-click event. */ -#define EVENT_CLICK_COUNT(event) (Fnth (make_number (2), (event))) +#define EVENT_CLICK_COUNT(event) (Fnth (make_fixnum (2), (event))) /* Extract the fields of a position. */ #define POSN_WINDOW(posn) (CAR_SAFE (posn)) @@ -399,17 +399,17 @@ extern void unuse_menu_items (void); #define POSN_SET_POSN(posn,x) (XSETCAR (XCDR (posn), (x))) #define POSN_WINDOW_POSN(posn) (CAR_SAFE (CDR_SAFE (CDR_SAFE (posn)))) #define POSN_TIMESTAMP(posn) (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (posn))))) -#define POSN_SCROLLBAR_PART(posn) (Fnth (make_number (4), (posn))) +#define POSN_SCROLLBAR_PART(posn) (Fnth (make_fixnum (4), (posn))) /* A cons (STRING . STRING-CHARPOS), or nil in mouse-click events. It's a cons if the click is over a string in the mode line. */ -#define POSN_STRING(posn) (Fnth (make_number (4), (posn))) +#define POSN_STRING(posn) (Fnth (make_fixnum (4), (posn))) /* If POSN_STRING is nil, event refers to buffer location. */ #define POSN_INBUFFER_P(posn) (NILP (POSN_STRING (posn))) -#define POSN_BUFFER_POSN(posn) (Fnth (make_number (5), (posn))) +#define POSN_BUFFER_POSN(posn) (Fnth (make_fixnum (5), (posn))) /* Getting the kind of an event head. */ #define EVENT_HEAD_KIND(event_head) \ diff --git a/src/keymap.c b/src/keymap.c index fcee788e6f..a7e0557ebd 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -159,7 +159,7 @@ in case you use it as a menu with `x-popup-menu'. */) void initial_define_key (Lisp_Object keymap, int key, const char *defname) { - store_in_keymap (keymap, make_number (key), intern_c_string (defname)); + store_in_keymap (keymap, make_fixnum (key), intern_c_string (defname)); } void @@ -248,7 +248,7 @@ get_keymap (Lisp_Object object, bool error_if_not_keymap, bool autoload) { Lisp_Object tail; - tail = Fnth (make_number (4), tem); + tail = Fnth (make_fixnum (4), tem); if (EQ (tail, Qkeymap)) { if (autoload) @@ -379,13 +379,13 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx, be put in the canonical order. */ if (SYMBOLP (idx)) idx = reorder_modifiers (idx); - else if (INTEGERP (idx)) + else if (FIXNUMP (idx)) /* Clobber the high bits that can be present on a machine with more than 24 bits of integer. */ XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1))); /* Handle the special meta -> esc mapping. */ - if (INTEGERP (idx) && XFASTINT (idx) & meta_modifier) + if (FIXNUMP (idx) && XFASTINT (idx) & meta_modifier) { /* See if there is a meta-map. If there's none, there is no binding for IDX, unless a default binding exists in MAP. */ @@ -393,14 +393,14 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx, /* A strange value in which Meta is set would cause infinite recursion. Protect against that. */ if (XINT (meta_prefix_char) & CHAR_META) - meta_prefix_char = make_number (27); + meta_prefix_char = make_fixnum (27); event_meta_binding = access_keymap_1 (map, meta_prefix_char, t_ok, noinherit, autoload); event_meta_map = get_keymap (event_meta_binding, 0, autoload); if (CONSP (event_meta_map)) { map = event_meta_map; - idx = make_number (XFASTINT (idx) & ~meta_modifier); + idx = make_fixnum (XFASTINT (idx) & ~meta_modifier); } else if (t_ok) /* Set IDX to t, so that we only find a default binding. */ @@ -473,7 +473,7 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx, } else if (VECTORP (binding)) { - if (INTEGERP (idx) && XFASTINT (idx) < ASIZE (binding)) + if (FIXNUMP (idx) && XFASTINT (idx) < ASIZE (binding)) val = AREF (binding, XFASTINT (idx)); } else if (CHAR_TABLE_P (binding)) @@ -481,7 +481,7 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx, /* Character codes with modifiers are not included in a char-table. All character codes without modifiers are included. */ - if (INTEGERP (idx) && (XFASTINT (idx) & CHAR_MODIFIER_MASK) == 0) + if (FIXNUMP (idx) && (XFASTINT (idx) & CHAR_MODIFIER_MASK) == 0) { val = Faref (binding, idx); /* nil has a special meaning for char-tables, so @@ -782,7 +782,7 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def) be put in the canonical order. */ if (SYMBOLP (idx)) idx = reorder_modifiers (idx); - else if (INTEGERP (idx)) + else if (FIXNUMP (idx)) /* Clobber the high bits that can be present on a machine with more than 24 bits of integer. */ XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1))); @@ -807,7 +807,7 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def) elt = XCAR (tail); if (VECTORP (elt)) { - if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (elt)) + if (FIXNATP (idx) && XFASTINT (idx) < ASIZE (elt)) { CHECK_IMPURE (elt, XVECTOR (elt)); ASET (elt, XFASTINT (idx), def); @@ -833,7 +833,7 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def) /* Character codes with modifiers are not included in a char-table. All character codes without modifiers are included. */ - if (NATNUMP (idx) && !(XFASTINT (idx) & CHAR_MODIFIER_MASK)) + if (FIXNATP (idx) && !(XFASTINT (idx) & CHAR_MODIFIER_MASK)) { Faset (elt, idx, /* nil has a special meaning for char-tables, so @@ -1093,7 +1093,7 @@ binding KEY to DEF is added at the front of KEYMAP. */) if (VECTORP (def) && ASIZE (def) > 0 && CONSP (AREF (def, 0))) { /* DEF is apparently an XEmacs-style keyboard macro. */ - Lisp_Object tmp = Fmake_vector (make_number (ASIZE (def)), Qnil); + Lisp_Object tmp = Fmake_vector (make_fixnum (ASIZE (def)), Qnil); ptrdiff_t i = ASIZE (def); while (--i >= 0) { @@ -1108,7 +1108,7 @@ binding KEY to DEF is added at the front of KEYMAP. */) idx = 0; while (1) { - c = Faref (key, make_number (idx)); + c = Faref (key, make_fixnum (idx)); if (CONSP (c)) { @@ -1123,7 +1123,7 @@ binding KEY to DEF is added at the front of KEYMAP. */) if (SYMBOLP (c)) silly_event_symbol_error (c); - if (INTEGERP (c) + if (FIXNUMP (c) && (XINT (c) & meta_bit) && !metized) { @@ -1132,17 +1132,17 @@ binding KEY to DEF is added at the front of KEYMAP. */) } else { - if (INTEGERP (c)) + if (FIXNUMP (c)) XSETINT (c, XINT (c) & ~meta_bit); metized = 0; idx++; } - if (!INTEGERP (c) && !SYMBOLP (c) + if (!FIXNUMP (c) && !SYMBOLP (c) && (!CONSP (c) /* If C is a range, it must be a leaf. */ - || (INTEGERP (XCAR (c)) && idx != length))) + || (FIXNUMP (XCAR (c)) && idx != length))) message_with_string ("Key sequence contains invalid event %s", c, 1); if (idx == length) @@ -1165,8 +1165,8 @@ binding KEY to DEF is added at the front of KEYMAP. */) error; key might be a vector, not a string. */ error ("Key sequence %s starts with non-prefix key %s%s", SDATA (Fkey_description (key, Qnil)), - SDATA (Fkey_description (Fsubstring (key, make_number (0), - make_number (idx)), + SDATA (Fkey_description (Fsubstring (key, make_fixnum (0), + make_fixnum (idx)), Qnil)), trailing_esc); } @@ -1201,7 +1201,7 @@ remapping in all currently active keymaps. */) else command = Flookup_key (Fcons (Qkeymap, keymaps), command_remapping_vector, Qnil); - return INTEGERP (command) ? Qnil : command; + return FIXNUMP (command) ? Qnil : command; } /* Value is number if KEY is too long; nil if valid but has no definition. */ @@ -1240,7 +1240,7 @@ recognize the default bindings, just as `read-key-sequence' does. */) idx = 0; while (1) { - c = Faref (key, make_number (idx++)); + c = Faref (key, make_fixnum (idx++)); if (CONSP (c) && lucid_event_type_list_p (c)) c = Fevent_convert_list (c); @@ -1251,7 +1251,7 @@ recognize the default bindings, just as `read-key-sequence' does. */) /* Allow string since binding for `menu-bar-select-buffer' includes the buffer name in the key sequence. */ - if (!INTEGERP (c) && !SYMBOLP (c) && !CONSP (c) && !STRINGP (c)) + if (!FIXNUMP (c) && !SYMBOLP (c) && !CONSP (c) && !STRINGP (c)) message_with_string ("Key sequence contains invalid event %s", c, 1); cmd = access_keymap (keymap, c, t_ok, 0, 1); @@ -1260,7 +1260,7 @@ recognize the default bindings, just as `read-key-sequence' does. */) keymap = get_keymap (cmd, 0, 1); if (!CONSP (keymap)) - return make_number (idx); + return make_fixnum (idx); maybe_quit (); } @@ -1474,7 +1474,7 @@ current_minor_maps (Lisp_Object **modeptr, Lisp_Object **mapptr) static ptrdiff_t click_position (Lisp_Object position) { - EMACS_INT pos = (INTEGERP (position) ? XINT (position) + EMACS_INT pos = (FIXNUMP (position) ? XINT (position) : MARKERP (position) ? marker_position (position) : PT); if (! (BEGV <= pos && pos <= ZV)) @@ -1552,7 +1552,7 @@ like in the respective argument of `key-binding'. */) Lisp_Object pos; pos = POSN_BUFFER_POSN (position); - if (INTEGERP (pos) + if (FIXNUMP (pos) && XINT (pos) >= BEG && XINT (pos) <= Z) { local_map = get_local_map (XINT (pos), @@ -1575,7 +1575,7 @@ like in the respective argument of `key-binding'. */) pos = XCDR (string); string = XCAR (string); - if (INTEGERP (pos) + if (FIXNUMP (pos) && XINT (pos) >= 0 && XINT (pos) < SCHARS (string)) { @@ -1667,7 +1667,7 @@ specified buffer position instead of point are used. value = Flookup_key (Fcons (Qkeymap, Fcurrent_active_maps (Qt, position)), key, accept_default); - if (NILP (value) || INTEGERP (value)) + if (NILP (value) || FIXNUMP (value)) return Qnil; /* If the result of the ordinary keymap lookup is an interactive @@ -1745,7 +1745,7 @@ bindings; see the description of `lookup-key' for more details about this. */) for (i = j = 0; i < nmaps; i++) if (!NILP (maps[i]) && !NILP (binding = Flookup_key (maps[i], key, accept_default)) - && !INTEGERP (binding)) + && !FIXNUMP (binding)) { if (KEYMAPP (binding)) maps[j++] = Fcons (modes[i], binding); @@ -1843,7 +1843,7 @@ accessible_keymaps_1 (Lisp_Object key, Lisp_Object cmd, Lisp_Object args, void * Lisp_Object maps = d->maps; Lisp_Object tail = d->tail; Lisp_Object thisseq = d->thisseq; - bool is_metized = d->is_metized && INTEGERP (key); + bool is_metized = d->is_metized && FIXNUMP (key); Lisp_Object tem; cmd = get_keymap (get_keyelt (cmd, 0), 0, 0); @@ -1858,8 +1858,8 @@ accessible_keymaps_1 (Lisp_Object key, Lisp_Object cmd, Lisp_Object args, void * if (lim <= XINT (Flength (thisseq))) { /* This keymap was already seen with a smaller prefix. */ ptrdiff_t i = 0; - while (i < lim && EQ (Faref (prefix, make_number (i)), - Faref (thisseq, make_number (i)))) + while (i < lim && EQ (Faref (prefix, make_fixnum (i)), + Faref (thisseq, make_fixnum (i)))) i++; if (i >= lim) /* `prefix' is a prefix of `thisseq' => there's a cycle. */ @@ -1879,10 +1879,10 @@ accessible_keymaps_1 (Lisp_Object key, Lisp_Object cmd, Lisp_Object args, void * if (is_metized) { int meta_bit = meta_modifier; - Lisp_Object last = make_number (XINT (Flength (thisseq)) - 1); + Lisp_Object last = make_fixnum (XINT (Flength (thisseq)) - 1); tem = Fcopy_sequence (thisseq); - Faset (tem, last, make_number (XINT (key) | meta_bit)); + Faset (tem, last, make_fixnum (XINT (key) | meta_bit)); /* This new sequence is the same length as thisseq, so stick it in the list right @@ -1933,7 +1933,7 @@ then the value includes only maps for prefixes that start with PREFIX. */) int i, i_byte, c; Lisp_Object copy; - copy = Fmake_vector (make_number (SCHARS (prefix)), Qnil); + copy = Fmake_vector (make_fixnum (SCHARS (prefix)), Qnil); for (i = 0, i_byte = 0; i < SCHARS (prefix);) { int i_before = i; @@ -1941,7 +1941,7 @@ then the value includes only maps for prefixes that start with PREFIX. */) FETCH_STRING_CHAR_ADVANCE (c, prefix, i, i_byte); if (SINGLE_BYTE_CHAR_P (c) && (c & 0200)) c ^= 0200 | meta_modifier; - ASET (copy, i_before, make_number (c)); + ASET (copy, i_before, make_fixnum (c)); } prefix = copy; } @@ -1969,7 +1969,7 @@ then the value includes only maps for prefixes that start with PREFIX. */) data.thisseq = Fcar (XCAR (tail)); data.maps = maps; data.tail = tail; - last = make_number (XINT (Flength (data.thisseq)) - 1); + last = make_fixnum (XINT (Flength (data.thisseq)) - 1); /* Does the current sequence end in the meta-prefix-char? */ data.is_metized = (XINT (last) >= 0 /* Don't metize the last char of PREFIX. */ @@ -2072,7 +2072,7 @@ For an approximate inverse of this, see `kbd'. */) if (add_meta) { - if (!INTEGERP (key) + if (!FIXNUMP (key) || EQ (key, meta_prefix_char) || (XINT (key) & meta_modifier)) { @@ -2108,7 +2108,7 @@ push_key_description (EMACS_INT ch, char *p) c2 = c & ~(alt_modifier | ctrl_modifier | hyper_modifier | meta_modifier | shift_modifier | super_modifier); - if (! CHARACTERP (make_number (c2))) + if (! CHARACTERP (make_fixnum (c2))) { /* KEY_DESCRIPTION_SIZE is large enough for this. */ p += sprintf (p, "[%d]", c); @@ -2226,7 +2226,7 @@ around function keys and event symbols. */) if (CONSP (key) && lucid_event_type_list_p (key)) key = Fevent_convert_list (key); - if (CONSP (key) && INTEGERP (XCAR (key)) && INTEGERP (XCDR (key))) + if (CONSP (key) && FIXNUMP (XCAR (key)) && FIXNUMP (XCDR (key))) /* An interval from a map-char-table. */ { AUTO_STRING (dot_dot, ".."); @@ -2237,7 +2237,7 @@ around function keys and event symbols. */) key = EVENT_HEAD (key); - if (INTEGERP (key)) /* Normal character. */ + if (FIXNUMP (key)) /* Normal character. */ { char tem[KEY_DESCRIPTION_SIZE]; char *p = push_key_description (XINT (key), tem); @@ -2338,7 +2338,7 @@ preferred_sequence_p (Lisp_Object seq) XSETFASTINT (ii, i); elt = Faref (seq, ii); - if (!INTEGERP (elt)) + if (!FIXNUMP (elt)) return 0; else { @@ -2373,10 +2373,10 @@ shadow_lookup (Lisp_Object shadow, Lisp_Object key, Lisp_Object flag, for (tail = shadow; CONSP (tail); tail = XCDR (tail)) { value = Flookup_key (XCAR (tail), key, flag); - if (NATNUMP (value)) + if (FIXNATP (value)) { value = Flookup_key (XCAR (tail), - Fsubstring (key, make_number (0), value), flag); + Fsubstring (key, make_fixnum (0), value), flag); if (!NILP (value)) return Qnil; } @@ -2463,13 +2463,13 @@ where_is_internal (Lisp_Object definition, Lisp_Object keymaps, this = Fcar (XCAR (maps)); map = Fcdr (XCAR (maps)); - last = make_number (XINT (Flength (this)) - 1); + last = make_fixnum (XINT (Flength (this)) - 1); last_is_meta = (XINT (last) >= 0 && EQ (Faref (this, last), meta_prefix_char)); /* if (nomenus && !preferred_sequence_p (this)) */ if (nomenus && XINT (last) >= 0 - && SYMBOLP (tem = Faref (this, make_number (0))) + && SYMBOLP (tem = Faref (this, make_fixnum (0))) && !NILP (Fmemq (XCAR (parse_modifiers (tem)), Vmouse_events))) /* If no menu entries should be returned, skip over the keymaps bound to `menu-bar' and `tool-bar' and other @@ -2646,9 +2646,9 @@ The optional 5th arg NO-REMAP alters how command remapping is handled: if (! NILP (sequence)) { Lisp_Object tem1; - tem1 = Faref (sequence, make_number (ASIZE (sequence) - 1)); + tem1 = Faref (sequence, make_fixnum (ASIZE (sequence) - 1)); if (STRINGP (tem1)) - Faset (sequence, make_number (ASIZE (sequence) - 1), + Faset (sequence, make_fixnum (ASIZE (sequence) - 1), build_string ("(any string)")); } @@ -2717,10 +2717,10 @@ where_is_internal_1 (Lisp_Object key, Lisp_Object binding, Lisp_Object args, voi return; /* We have found a match. Construct the key sequence where we found it. */ - if (INTEGERP (key) && last_is_meta) + if (FIXNUMP (key) && last_is_meta) { sequence = Fcopy_sequence (this); - Faset (sequence, last, make_number (XINT (key) | meta_modifier)); + Faset (sequence, last, make_fixnum (XINT (key) | meta_modifier)); } else { @@ -2786,7 +2786,7 @@ You type Translation\n\ bufend = push_key_description (translate[c], buf); insert (buf, bufend - buf); - Findent_to (make_number (16), make_number (1)); + Findent_to (make_fixnum (16), make_fixnum (1)); bufend = push_key_description (c, buf); insert (buf, bufend - buf); @@ -2962,7 +2962,7 @@ key binding\n\ elt_prefix = Fcar (elt); if (ASIZE (elt_prefix) >= 1) { - tem = Faref (elt_prefix, make_number (0)); + tem = Faref (elt_prefix, make_fixnum (0)); if (EQ (tem, Qmenu_bar)) maps = Fdelq (elt, maps); } @@ -3011,7 +3011,7 @@ key binding\n\ else { shmap = Flookup_key (shmap, Fcar (elt), Qt); - if (INTEGERP (shmap)) + if (FIXNUMP (shmap)) shmap = Qnil; } @@ -3066,7 +3066,7 @@ describe_command (Lisp_Object definition, Lisp_Object args) else description_column = 16; - Findent_to (make_number (description_column), make_number (1)); + Findent_to (make_fixnum (description_column), make_fixnum (1)); previous_description_column = description_column; if (SYMBOLP (definition)) @@ -3088,7 +3088,7 @@ describe_translation (Lisp_Object definition, Lisp_Object args) { register Lisp_Object tem1; - Findent_to (make_number (16), make_number (1)); + Findent_to (make_fixnum (16), make_fixnum (1)); if (SYMBOLP (definition)) { @@ -3125,12 +3125,12 @@ static int describe_map_compare (const void *aa, const void *bb) { const struct describe_map_elt *a = aa, *b = bb; - if (INTEGERP (a->event) && INTEGERP (b->event)) + if (FIXNUMP (a->event) && FIXNUMP (b->event)) return ((XINT (a->event) > XINT (b->event)) - (XINT (a->event) < XINT (b->event))); - if (!INTEGERP (a->event) && INTEGERP (b->event)) + if (!FIXNUMP (a->event) && FIXNUMP (b->event)) return 1; - if (INTEGERP (a->event) && !INTEGERP (b->event)) + if (FIXNUMP (a->event) && !FIXNUMP (b->event)) return -1; if (SYMBOLP (a->event) && SYMBOLP (b->event)) return (!NILP (Fstring_lessp (a->event, b->event)) ? -1 @@ -3170,7 +3170,7 @@ describe_map (Lisp_Object map, Lisp_Object prefix, /* This vector gets used to present single keys to Flookup_key. Since that is done once per keymap element, we don't want to cons up a fresh vector every time. */ - kludge = Fmake_vector (make_number (1), Qnil); + kludge = Fmake_vector (make_fixnum (1), Qnil); definition = Qnil; map = call1 (Qkeymap_canonicalize, map); @@ -3198,7 +3198,7 @@ describe_map (Lisp_Object map, Lisp_Object prefix, /* Ignore bindings whose "prefix" are not really valid events. (We get these in the frames and buffers menu.) */ - if (!(SYMBOLP (event) || INTEGERP (event))) + if (!(SYMBOLP (event) || FIXNUMP (event))) continue; if (nomenu && EQ (event, Qmenu_bar)) @@ -3282,10 +3282,10 @@ describe_map (Lisp_Object map, Lisp_Object prefix, definition = vect[i].definition; /* Find consecutive chars that are identically defined. */ - if (INTEGERP (vect[i].event)) + if (FIXNUMP (vect[i].event)) { while (i + 1 < slots_used - && EQ (vect[i+1].event, make_number (XINT (vect[i].event) + 1)) + && EQ (vect[i+1].event, make_fixnum (XINT (vect[i].event) + 1)) && !NILP (Fequal (vect[i + 1].definition, definition)) && vect[i].shadowed == vect[i + 1].shadowed) i++; @@ -3328,7 +3328,7 @@ describe_map (Lisp_Object map, Lisp_Object prefix, static void describe_vector_princ (Lisp_Object elt, Lisp_Object fun) { - Findent_to (make_number (16), make_number (1)); + Findent_to (make_fixnum (16), make_fixnum (1)); call1 (fun, elt); Fterpri (Qnil, Qnil); } @@ -3419,7 +3419,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args, /* This vector gets used to present single keys to Flookup_key. Since that is done once per vector element, we don't want to cons up a fresh vector every time. */ - kludge = Fmake_vector (make_number (1), Qnil); + kludge = Fmake_vector (make_fixnum (1), Qnil); if (partial) suppress = intern ("suppress-keymap"); @@ -3469,7 +3469,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args, if (!NILP (tem)) continue; } - character = make_number (starting_i); + character = make_fixnum (starting_i); ASET (kludge, 0, character); /* If this binding is shadowed by some other map, ignore it. */ @@ -3541,7 +3541,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args, { insert (" .. ", 4); - ASET (kludge, 0, make_number (i)); + ASET (kludge, 0, make_fixnum (i)); if (!NILP (elt_prefix)) insert1 (elt_prefix); @@ -3618,7 +3618,7 @@ syms_of_keymap (void) /* Now we are ready to set up this property, so we can create char tables. */ - Fput (Qkeymap, Qchar_table_extra_slots, make_number (0)); + Fput (Qkeymap, Qchar_table_extra_slots, make_fixnum (0)); /* Initialize the keymaps standardly used. Each one is the value of a Lisp variable, and is also @@ -3719,7 +3719,7 @@ be preferred. */); DEFSYM (Qremap, "remap"); DEFSYM (QCadvertised_binding, ":advertised-binding"); - command_remapping_vector = Fmake_vector (make_number (2), Qremap); + command_remapping_vector = Fmake_vector (make_fixnum (2), Qremap); staticpro (&command_remapping_vector); where_is_cache_keymaps = Qt; diff --git a/src/kqueue.c b/src/kqueue.c index 7a4f6a471c..b45c316b93 100644 --- a/src/kqueue.c +++ b/src/kqueue.c @@ -55,15 +55,15 @@ kqueue_directory_listing (Lisp_Object directory_files) result = Fcons (list5 (/* inode. */ - Fnth (make_number (11), XCAR (dl)), + Fnth (make_fixnum (11), XCAR (dl)), /* filename. */ XCAR (XCAR (dl)), /* last modification time. */ - Fnth (make_number (6), XCAR (dl)), + Fnth (make_fixnum (6), XCAR (dl)), /* last status change time. */ - Fnth (make_number (7), XCAR (dl)), + Fnth (make_fixnum (7), XCAR (dl)), /* size. */ - Fnth (make_number (8), XCAR (dl))), + Fnth (make_fixnum (8), XCAR (dl))), result); } return result; @@ -78,7 +78,7 @@ kqueue_generate_event (Lisp_Object watch_object, Lisp_Object actions, struct input_event event; /* Check, whether all actions shall be monitored. */ - flags = Fnth (make_number (2), watch_object); + flags = Fnth (make_fixnum (2), watch_object); action = actions; do { if (NILP (action)) @@ -101,7 +101,7 @@ kqueue_generate_event (Lisp_Object watch_object, Lisp_Object actions, NILP (file1) ? Fcons (file, Qnil) : list2 (file, file1))), - Fnth (make_number (3), watch_object)); + Fnth (make_fixnum (3), watch_object)); kbd_buffer_store_event (&event); } } @@ -121,7 +121,7 @@ kqueue_compare_dir_list (Lisp_Object watch_object) pending_dl = Qnil; deleted_dl = Qnil; - old_directory_files = Fnth (make_number (4), watch_object); + old_directory_files = Fnth (make_fixnum (4), watch_object); old_dl = kqueue_directory_listing (old_directory_files); /* When the directory is not accessible anymore, it has been deleted. */ @@ -155,14 +155,14 @@ kqueue_compare_dir_list (Lisp_Object watch_object) if (strcmp (SSDATA (XCAR (XCDR (old_entry))), SSDATA (XCAR (XCDR (new_entry)))) == 0) { /* Modification time has been changed, the file has been written. */ - if (NILP (Fequal (Fnth (make_number (2), old_entry), - Fnth (make_number (2), new_entry)))) + if (NILP (Fequal (Fnth (make_fixnum (2), old_entry), + Fnth (make_fixnum (2), new_entry)))) kqueue_generate_event (watch_object, Fcons (Qwrite, Qnil), XCAR (XCDR (old_entry)), Qnil); /* Status change time has been changed, the file attributes have changed. */ - if (NILP (Fequal (Fnth (make_number (3), old_entry), - Fnth (make_number (3), new_entry)))) + if (NILP (Fequal (Fnth (make_fixnum (3), old_entry), + Fnth (make_fixnum (3), new_entry)))) kqueue_generate_event (watch_object, Fcons (Qattrib, Qnil), XCAR (XCDR (old_entry)), Qnil); @@ -233,7 +233,7 @@ kqueue_compare_dir_list (Lisp_Object watch_object) (watch_object, Fcons (Qcreate, Qnil), XCAR (XCDR (entry)), Qnil); /* Check size of that file. */ - Lisp_Object size = Fnth (make_number (4), entry); + Lisp_Object size = Fnth (make_fixnum (4), entry); if (FLOATP (size) || (XINT (size) > 0)) kqueue_generate_event (watch_object, Fcons (Qwrite, Qnil), XCAR (XCDR (entry)), Qnil); @@ -270,7 +270,7 @@ kqueue_compare_dir_list (Lisp_Object watch_object) report_file_error ("Pending events list not empty", pending_dl); /* Replace old directory listing with the new one. */ - XSETCDR (Fnthcdr (make_number (3), watch_object), + XSETCDR (Fnthcdr (make_fixnum (3), watch_object), Fcons (new_directory_files, Qnil)); return; } @@ -293,7 +293,7 @@ kqueue_callback (int fd, void *data) } /* Determine descriptor and file name. */ - descriptor = make_number (kev.ident); + descriptor = make_fixnum (kev.ident); watch_object = assq_no_quit (descriptor, watch_list); if (CONSP (watch_object)) file = XCAR (XCDR (watch_object)); @@ -306,7 +306,7 @@ kqueue_callback (int fd, void *data) actions = Fcons (Qdelete, actions); if (kev.fflags & NOTE_WRITE) { /* Check, whether this is a directory event. */ - if (NILP (Fnth (make_number (4), watch_object))) + if (NILP (Fnth (make_fixnum (4), watch_object))) actions = Fcons (Qwrite, actions); else kqueue_compare_dir_list (watch_object); @@ -449,7 +449,7 @@ only when the upper directory of the renamed file is watched. */) } /* Store watch object in watch list. */ - Lisp_Object watch_descriptor = make_number (fd); + Lisp_Object watch_descriptor = make_fixnum (fd); if (NILP (Ffile_directory_p (file))) watch_object = list4 (watch_descriptor, file, flags, callback); else { @@ -473,7 +473,7 @@ WATCH-DESCRIPTOR should be an object returned by `kqueue-add-watch'. */) xsignal2 (Qfile_notify_error, build_string ("Not a watch descriptor"), watch_descriptor); - eassert (INTEGERP (watch_descriptor)); + eassert (FIXNUMP (watch_descriptor)); int fd = XINT (watch_descriptor); if ( fd >= 0) emacs_close (fd); diff --git a/src/lcms.c b/src/lcms.c index 3dcb77c8a5..9df85c2c18 100644 --- a/src/lcms.c +++ b/src/lcms.c @@ -92,7 +92,7 @@ static bool parse_lab_list (Lisp_Object lab_list, cmsCIELab *color) { #define PARSE_LAB_LIST_FIELD(field) \ - if (CONSP (lab_list) && NUMBERP (XCAR (lab_list))) \ + if (CONSP (lab_list) && FIXED_OR_FLOATP (XCAR (lab_list))) \ { \ color->field = XFLOATINT (XCAR (lab_list)); \ lab_list = XCDR (lab_list); \ @@ -137,15 +137,15 @@ chroma, and hue, respectively. The parameters each default to 1. */) signal_error ("Invalid color", color1); if (NILP (kL)) Kl = 1.0f; - else if (!(NUMBERP (kL) && (Kl = XFLOATINT(kL)))) + else if (!(FIXED_OR_FLOATP (kL) && (Kl = XFLOATINT(kL)))) wrong_type_argument(Qnumberp, kL); if (NILP (kC)) Kc = 1.0f; - else if (!(NUMBERP (kC) && (Kc = XFLOATINT(kC)))) + else if (!(FIXED_OR_FLOATP (kC) && (Kc = XFLOATINT(kC)))) wrong_type_argument(Qnumberp, kC); if (NILP (kL)) Kh = 1.0f; - else if (!(NUMBERP (kH) && (Kh = XFLOATINT(kH)))) + else if (!(FIXED_OR_FLOATP (kH) && (Kh = XFLOATINT(kH)))) wrong_type_argument(Qnumberp, kH); return make_float (cmsCIE2000DeltaE (&Lab1, &Lab2, Kl, Kc, Kh)); @@ -183,7 +183,7 @@ static bool parse_xyz_list (Lisp_Object xyz_list, cmsCIEXYZ *color) { #define PARSE_XYZ_LIST_FIELD(field) \ - if (CONSP (xyz_list) && NUMBERP (XCAR (xyz_list))) \ + if (CONSP (xyz_list) && FIXED_OR_FLOATP (XCAR (xyz_list))) \ { \ color->field = 100.0 * XFLOATINT (XCAR (xyz_list)); \ xyz_list = XCDR (xyz_list); \ @@ -202,7 +202,7 @@ static bool parse_jch_list (Lisp_Object jch_list, cmsJCh *color) { #define PARSE_JCH_LIST_FIELD(field) \ - if (CONSP (jch_list) && NUMBERP (XCAR (jch_list))) \ + if (CONSP (jch_list) && FIXED_OR_FLOATP (XCAR (jch_list))) \ { \ color->field = XFLOATINT (XCAR (jch_list)); \ jch_list = XCDR (jch_list); \ @@ -223,7 +223,7 @@ static bool parse_jab_list (Lisp_Object jab_list, lcmsJab_t *color) { #define PARSE_JAB_LIST_FIELD(field) \ - if (CONSP (jab_list) && NUMBERP (XCAR (jab_list))) \ + if (CONSP (jab_list) && FIXED_OR_FLOATP (XCAR (jab_list))) \ { \ color->field = XFLOATINT (XCAR (jab_list)); \ jab_list = XCDR (jab_list); \ @@ -243,7 +243,7 @@ parse_viewing_conditions (Lisp_Object view, const cmsCIEXYZ *wp, cmsViewingConditions *vc) { #define PARSE_VIEW_CONDITION_FLOAT(field) \ - if (CONSP (view) && NUMBERP (XCAR (view))) \ + if (CONSP (view) && FIXED_OR_FLOATP (XCAR (view))) \ { \ vc->field = XFLOATINT (XCAR (view)); \ view = XCDR (view); \ @@ -251,7 +251,7 @@ parse_viewing_conditions (Lisp_Object view, const cmsCIEXYZ *wp, else \ return false; #define PARSE_VIEW_CONDITION_INT(field) \ - if (CONSP (view) && NATNUMP (XCAR (view))) \ + if (CONSP (view) && FIXNATP (XCAR (view))) \ { \ CHECK_RANGED_INTEGER (XCAR (view), 1, 4); \ vc->field = XINT (XCAR (view)); \ @@ -554,7 +554,7 @@ Valid range of TEMPERATURE is from 4000K to 25000K. */) } #endif - CHECK_NUMBER_OR_FLOAT (temperature); + CHECK_FIXNUM_OR_FLOAT (temperature); tempK = XFLOATINT (temperature); if (!(cmsWhitePointFromTemp (&whitepoint, tempK))) diff --git a/src/lisp.h b/src/lisp.h index 731a45da11..9cf10c1962 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -352,14 +352,14 @@ typedef EMACS_INT Lisp_Word; # endif #endif -#define lisp_h_CHECK_NUMBER(x) CHECK_TYPE (INTEGERP (x), Qintegerp, x) +#define lisp_h_CHECK_FIXNUM(x) CHECK_TYPE (FIXNUMP (x), Qintegerp, x) #define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) #define lisp_h_CHECK_TYPE(ok, predicate, x) \ ((ok) ? (void) 0 : wrong_type_argument (predicate, x)) #define lisp_h_CONSP(x) (XTYPE (x) == Lisp_Cons) #define lisp_h_EQ(x, y) (XLI (x) == XLI (y)) #define lisp_h_FLOATP(x) (XTYPE (x) == Lisp_Float) -#define lisp_h_INTEGERP(x) ((XTYPE (x) & (Lisp_Int0 | ~Lisp_Int1)) == Lisp_Int0) +#define lisp_h_FIXNUMP(x) ((XTYPE (x) & (Lisp_Int0 | ~Lisp_Int1)) == Lisp_Int0) #define lisp_h_MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker) #define lisp_h_MISCP(x) (XTYPE (x) == Lisp_Misc) #define lisp_h_NILP(x) EQ (x, Qnil) @@ -382,7 +382,7 @@ typedef EMACS_INT Lisp_Word; # define lisp_h_check_cons_list() ((void) 0) #endif #if USE_LSB_TAG -# define lisp_h_make_number(n) \ +# define lisp_h_make_fixnum(n) \ XIL ((EMACS_INT) (((EMACS_UINT) (n) << INTTYPEBITS) + Lisp_Int0)) # define lisp_h_XFASTINT(a) XINT (a) # define lisp_h_XINT(a) (XLI (a) >> INTTYPEBITS) @@ -418,13 +418,13 @@ typedef EMACS_INT Lisp_Word; # define XIL(i) lisp_h_XIL (i) # define XLP(o) lisp_h_XLP (o) # define XPL(p) lisp_h_XPL (p) -# define CHECK_NUMBER(x) lisp_h_CHECK_NUMBER (x) +# define CHECK_FIXNUM(x) lisp_h_CHECK_FIXNUM (x) # define CHECK_SYMBOL(x) lisp_h_CHECK_SYMBOL (x) # define CHECK_TYPE(ok, predicate, x) lisp_h_CHECK_TYPE (ok, predicate, x) # define CONSP(x) lisp_h_CONSP (x) # define EQ(x, y) lisp_h_EQ (x, y) # define FLOATP(x) lisp_h_FLOATP (x) -# define INTEGERP(x) lisp_h_INTEGERP (x) +# define FIXNUMP(x) lisp_h_FIXNUMP (x) # define MARKERP(x) lisp_h_MARKERP (x) # define MISCP(x) lisp_h_MISCP (x) # define NILP(x) lisp_h_NILP (x) @@ -442,7 +442,7 @@ typedef EMACS_INT Lisp_Word; # define check_cons_list() lisp_h_check_cons_list () # endif # if USE_LSB_TAG -# define make_number(n) lisp_h_make_number (n) +# define make_fixnum(n) lisp_h_make_fixnum (n) # define XFASTINT(a) lisp_h_XFASTINT (a) # define XINT(a) lisp_h_XINT (a) # define XSYMBOL(a) lisp_h_XSYMBOL (a) @@ -1026,9 +1026,9 @@ enum More_Lisp_Bits #if USE_LSB_TAG INLINE Lisp_Object -(make_number) (EMACS_INT n) +(make_fixnum) (EMACS_INT n) { - return lisp_h_make_number (n); + return lisp_h_make_fixnum (n); } INLINE EMACS_INT @@ -1054,7 +1054,7 @@ INLINE EMACS_INT /* Make a Lisp integer representing the value of the low order bits of N. */ INLINE Lisp_Object -make_number (EMACS_INT n) +make_fixnum (EMACS_INT n) { EMACS_INT int0 = Lisp_Int0; if (USE_LSB_TAG) @@ -1116,13 +1116,13 @@ INLINE EMACS_INT return lisp_h_XHASH (a); } -/* Like make_number (N), but may be faster. N must be in nonnegative range. */ +/* Like make_fixnum (N), but may be faster. N must be in nonnegative range. */ INLINE Lisp_Object -make_natnum (EMACS_INT n) +make_fixed_natnum (EMACS_INT n) { eassert (0 <= n && n <= MOST_POSITIVE_FIXNUM); EMACS_INT int0 = Lisp_Int0; - return USE_LSB_TAG ? make_number (n) : XIL (n + (int0 << VALBITS)); + return USE_LSB_TAG ? make_fixnum (n) : XIL (n + (int0 << VALBITS)); } /* Return true if X and Y are the same object. */ @@ -1155,13 +1155,13 @@ make_lisp_ptr (void *ptr, enum Lisp_Type type) } INLINE bool -(INTEGERP) (Lisp_Object x) +(FIXNUMP) (Lisp_Object x) { - return lisp_h_INTEGERP (x); + return lisp_h_FIXNUMP (x); } -#define XSETINT(a, b) ((a) = make_number (b)) -#define XSETFASTINT(a, b) ((a) = make_natnum (b)) +#define XSETINT(a, b) ((a) = make_fixnum (b)) +#define XSETFASTINT(a, b) ((a) = make_fixed_natnum (b)) #define XSETCONS(a, b) ((a) = make_lisp_ptr (b, Lisp_Cons)) #define XSETVECTOR(a, b) ((a) = make_lisp_ptr (b, Lisp_Vectorlike)) #define XSETSTRING(a, b) ((a) = make_lisp_ptr (b, Lisp_String)) @@ -1221,7 +1221,7 @@ INLINE Lisp_Object make_pointer_integer (void *p) { Lisp_Object a = TAG_PTR (Lisp_Int0, p); - eassert (INTEGERP (a) && XINTPTR (a) == p); + eassert (FIXNUMP (a) && XINTPTR (a) == p); return a; } @@ -2389,20 +2389,20 @@ INLINE Lisp_Object make_mint_ptr (void *a) { Lisp_Object val = TAG_PTR (Lisp_Int0, a); - return INTEGERP (val) && XINTPTR (val) == a ? val : make_misc_ptr (a); + return FIXNUMP (val) && XINTPTR (val) == a ? val : make_misc_ptr (a); } INLINE bool mint_ptrp (Lisp_Object x) { - return INTEGERP (x) || (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Ptr); + return FIXNUMP (x) || (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Ptr); } INLINE void * xmint_pointer (Lisp_Object a) { eassert (mint_ptrp (a)); - if (INTEGERP (a)) + if (FIXNUMP (a)) return XINTPTR (a); return XUNTAG (a, Lisp_Misc, struct Lisp_Misc_Ptr)->pointer; } @@ -2725,24 +2725,24 @@ enum char_bits /* Data type checking. */ INLINE bool -NUMBERP (Lisp_Object x) +FIXED_OR_FLOATP (Lisp_Object x) { - return INTEGERP (x) || FLOATP (x); + return FIXNUMP (x) || FLOATP (x); } INLINE bool -NATNUMP (Lisp_Object x) +FIXNATP (Lisp_Object x) { - return INTEGERP (x) && 0 <= XINT (x); + return FIXNUMP (x) && 0 <= XINT (x); } INLINE bool -RANGED_INTEGERP (intmax_t lo, Lisp_Object x, intmax_t hi) +RANGED_FIXNUMP (intmax_t lo, Lisp_Object x, intmax_t hi) { - return INTEGERP (x) && lo <= XINT (x) && XINT (x) <= hi; + return FIXNUMP (x) && lo <= XINT (x) && XINT (x) <= hi; } -#define TYPE_RANGED_INTEGERP(type, x) \ - (INTEGERP (x) \ +#define TYPE_RANGED_FIXNUMP(type, x) \ + (FIXNUMP (x) \ && (TYPE_SIGNED (type) ? TYPE_MINIMUM (type) <= XINT (x) : 0 <= XINT (x)) \ && XINT (x) <= TYPE_MAXIMUM (type)) @@ -2812,9 +2812,9 @@ CHECK_LIST_END (Lisp_Object x, Lisp_Object y) } INLINE void -(CHECK_NUMBER) (Lisp_Object x) +(CHECK_FIXNUM) (Lisp_Object x) { - lisp_h_CHECK_NUMBER (x); + lisp_h_CHECK_FIXNUM (x); } INLINE void @@ -2838,21 +2838,21 @@ CHECK_ARRAY (Lisp_Object x, Lisp_Object predicate) CHECK_TYPE (ARRAYP (x), predicate, x); } INLINE void -CHECK_NATNUM (Lisp_Object x) +CHECK_FIXNAT (Lisp_Object x) { - CHECK_TYPE (NATNUMP (x), Qwholenump, x); + CHECK_TYPE (FIXNATP (x), Qwholenump, x); } #define CHECK_RANGED_INTEGER(x, lo, hi) \ do { \ - CHECK_NUMBER (x); \ + CHECK_FIXNUM (x); \ if (! ((lo) <= XINT (x) && XINT (x) <= (hi))) \ args_out_of_range_3 \ (x, \ - make_number ((lo) < 0 && (lo) < MOST_NEGATIVE_FIXNUM \ + make_fixnum ((lo) < 0 && (lo) < MOST_NEGATIVE_FIXNUM \ ? MOST_NEGATIVE_FIXNUM \ : (lo)), \ - make_number (min (hi, MOST_POSITIVE_FIXNUM))); \ + make_fixnum (min (hi, MOST_POSITIVE_FIXNUM))); \ } while (false) #define CHECK_TYPE_RANGED_INTEGER(type, x) \ do { \ @@ -2862,12 +2862,12 @@ CHECK_NATNUM (Lisp_Object x) CHECK_RANGED_INTEGER (x, 0, TYPE_MAXIMUM (type)); \ } while (false) -#define CHECK_NUMBER_COERCE_MARKER(x) \ +#define CHECK_FIXNUM_COERCE_MARKER(x) \ do { \ if (MARKERP ((x))) \ XSETFASTINT (x, marker_position (x)); \ else \ - CHECK_TYPE (INTEGERP (x), Qinteger_or_marker_p, x); \ + CHECK_TYPE (FIXNUMP (x), Qinteger_or_marker_p, x); \ } while (false) INLINE double @@ -2877,34 +2877,34 @@ XFLOATINT (Lisp_Object n) } INLINE void -CHECK_NUMBER_OR_FLOAT (Lisp_Object x) +CHECK_FIXNUM_OR_FLOAT (Lisp_Object x) { - CHECK_TYPE (NUMBERP (x), Qnumberp, x); + CHECK_TYPE (FIXED_OR_FLOATP (x), Qnumberp, x); } -#define CHECK_NUMBER_OR_FLOAT_COERCE_MARKER(x) \ +#define CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER(x) \ do { \ if (MARKERP (x)) \ XSETFASTINT (x, marker_position (x)); \ else \ - CHECK_TYPE (NUMBERP (x), Qnumber_or_marker_p, x); \ + CHECK_TYPE (FIXED_OR_FLOATP (x), Qnumber_or_marker_p, x); \ } while (false) /* Since we can't assign directly to the CAR or CDR fields of a cons cell, use these when checking that those fields contain numbers. */ INLINE void -CHECK_NUMBER_CAR (Lisp_Object x) +CHECK_FIXNUM_CAR (Lisp_Object x) { Lisp_Object tmp = XCAR (x); - CHECK_NUMBER (tmp); + CHECK_FIXNUM (tmp); XSETCAR (x, tmp); } INLINE void -CHECK_NUMBER_CDR (Lisp_Object x) +CHECK_FIXNUM_CDR (Lisp_Object x) { Lisp_Object tmp = XCDR (x); - CHECK_NUMBER (tmp); + CHECK_FIXNUM (tmp); XSETCDR (x, tmp); } @@ -3327,7 +3327,7 @@ extern Lisp_Object arithcompare (Lisp_Object num1, Lisp_Object num2, I should not have side effects. */ #define INTEGER_TO_CONS(i) \ (! FIXNUM_OVERFLOW_P (i) \ - ? make_number (i) \ + ? make_fixnum (i) \ : EXPR_SIGNED (i) ? intbig_to_lisp (i) : uintbig_to_lisp (i)) extern Lisp_Object intbig_to_lisp (intmax_t); extern Lisp_Object uintbig_to_lisp (uintmax_t); @@ -3582,20 +3582,20 @@ extern Lisp_Object listn (enum constype, ptrdiff_t, Lisp_Object, ...); INLINE Lisp_Object list2i (EMACS_INT x, EMACS_INT y) { - return list2 (make_number (x), make_number (y)); + return list2 (make_fixnum (x), make_fixnum (y)); } INLINE Lisp_Object list3i (EMACS_INT x, EMACS_INT y, EMACS_INT w) { - return list3 (make_number (x), make_number (y), make_number (w)); + return list3 (make_fixnum (x), make_fixnum (y), make_fixnum (w)); } INLINE Lisp_Object list4i (EMACS_INT x, EMACS_INT y, EMACS_INT w, EMACS_INT h) { - return list4 (make_number (x), make_number (y), - make_number (w), make_number (h)); + return list4 (make_fixnum (x), make_fixnum (y), + make_fixnum (w), make_fixnum (h)); } extern Lisp_Object make_uninit_bool_vector (EMACS_INT); @@ -4488,7 +4488,7 @@ extern void init_system_name (void); in a Lisp fixnum. */ #define make_fixnum_or_float(val) \ - (FIXNUM_OVERFLOW_P (val) ? make_float (val) : make_number (val)) + (FIXNUM_OVERFLOW_P (val) ? make_float (val) : make_fixnum (val)) /* SAFE_ALLOCA normally allocates memory on the stack, but if size is larger than MAX_ALLOCA, use xmalloc to avoid overflowing the stack. */ diff --git a/src/lread.c b/src/lread.c index d4e5be21b4..49fa51d1a8 100644 --- a/src/lread.c +++ b/src/lread.c @@ -463,7 +463,7 @@ unreadchar (Lisp_Object readcharfun, int c) unread_char = c; } else - call1 (readcharfun, make_number (c)); + call1 (readcharfun, make_fixnum (c)); } static int @@ -661,7 +661,7 @@ read_filtered_event (bool no_switch_frame, bool ascii_required, delayed_switch_frame = Qnil; /* Compute timeout. */ - if (NUMBERP (seconds)) + if (FIXED_OR_FLOATP (seconds)) { double duration = XFLOATINT (seconds); struct timespec wait_time = dtotimespec (duration); @@ -672,8 +672,8 @@ read_filtered_event (bool no_switch_frame, bool ascii_required, retry: do val = read_char (0, Qnil, (input_method ? Qnil : Qt), 0, - NUMBERP (seconds) ? &end_time : NULL); - while (INTEGERP (val) && XINT (val) == -2); /* wrong_kboard_jmpbuf */ + FIXED_OR_FLOATP (seconds) ? &end_time : NULL); + while (FIXNUMP (val) && XINT (val) == -2); /* wrong_kboard_jmpbuf */ if (BUFFERP (val)) goto retry; @@ -691,7 +691,7 @@ read_filtered_event (bool no_switch_frame, bool ascii_required, goto retry; } - if (ascii_required && !(NUMBERP (seconds) && NILP (val))) + if (ascii_required && !(FIXED_OR_FLOATP (seconds) && NILP (val))) { /* Convert certain symbols to their ASCII equivalents. */ if (SYMBOLP (val)) @@ -709,7 +709,7 @@ read_filtered_event (bool no_switch_frame, bool ascii_required, } /* If we don't have a character now, deal with it appropriately. */ - if (!INTEGERP (val)) + if (!FIXNUMP (val)) { if (error_nonascii) { @@ -766,7 +766,7 @@ floating-point value. */) val = read_filtered_event (1, 1, 1, ! NILP (inherit_input_method), seconds); return (NILP (val) ? Qnil - : make_number (char_resolve_modifier_mask (XINT (val)))); + : make_fixnum (char_resolve_modifier_mask (XINT (val)))); } DEFUN ("read-event", Fread_event, Sread_event, 0, 3, 0, @@ -810,7 +810,7 @@ floating-point value. */) val = read_filtered_event (1, 1, 0, ! NILP (inherit_input_method), seconds); return (NILP (val) ? Qnil - : make_number (char_resolve_modifier_mask (XINT (val)))); + : make_fixnum (char_resolve_modifier_mask (XINT (val)))); } DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0, @@ -819,7 +819,7 @@ DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0, { if (!infile) error ("get-file-char misused"); - return make_number (readbyte_from_stdio ()); + return make_fixnum (readbyte_from_stdio ()); } @@ -1345,7 +1345,7 @@ Return t if the file exists and loads successfully. */) if (!NILP (nomessage) && !force_load_messages) { Lisp_Object msg_file; - msg_file = Fsubstring (found, make_number (0), make_number (-1)); + msg_file = Fsubstring (found, make_fixnum (0), make_fixnum (-1)); message_with_string ("Source file `%s' newer than byte-compiled file", msg_file, 1); } @@ -1660,7 +1660,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, string = make_string (fn, fnlen); handler = Ffind_file_name_handler (string, Qfile_exists_p); if ((!NILP (handler) || (!NILP (predicate) && !EQ (predicate, Qt))) - && !NATNUMP (predicate)) + && !FIXNATP (predicate)) { bool exists; if (NILP (predicate) || EQ (predicate, Qt)) @@ -1699,7 +1699,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, pfn = SSDATA (encoded_fn); /* Check that we can access or open it. */ - if (NATNUMP (predicate)) + if (FIXNATP (predicate)) { fd = -1; if (INT_MAX < XFASTINT (predicate)) @@ -1737,7 +1737,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, if (fd >= 0) { - if (newer && !NATNUMP (predicate)) + if (newer && !FIXNATP (predicate)) { struct timespec mtime = get_stat_mtime (&st); @@ -1988,11 +1988,11 @@ readevalloop (Lisp_Object readcharfun, /* Set point and ZV around stuff to be read. */ Fgoto_char (start); if (!NILP (end)) - Fnarrow_to_region (make_number (BEGV), end); + Fnarrow_to_region (make_fixnum (BEGV), end); /* Just for cleanliness, convert END to a marker if it is an integer. */ - if (INTEGERP (end)) + if (FIXNUMP (end)) end = Fpoint_max_marker (); } @@ -2222,7 +2222,7 @@ the end of STRING. */) CHECK_STRING (string); /* `read_internal_start' sets `read_from_string_index'. */ ret = read_internal_start (string, start, end); - return Fcons (ret, make_number (read_from_string_index)); + return Fcons (ret, make_fixnum (read_from_string_index)); } /* Function to set up the global context we need in toplevel read @@ -2308,7 +2308,7 @@ read0 (Lisp_Object readcharfun) return val; xsignal1 (Qinvalid_read_syntax, - Fmake_string (make_number (1), make_number (c), Qnil)); + Fmake_string (make_fixnum (1), make_fixnum (c), Qnil)); } /* Grow a read buffer BUF that contains OFFSET useful bytes of data, @@ -2347,7 +2347,7 @@ character_name_to_code (char const *name, ptrdiff_t name_len) ? string_to_number (name + 1, 16, 0) : call2 (Qchar_from_name, make_unibyte_string (name, name_len), Qt)); - if (! RANGED_INTEGERP (0, code, MAX_UNICODE_CHAR) + if (! RANGED_FIXNUMP (0, code, MAX_UNICODE_CHAR) || char_surrogate_p (XINT (code))) { AUTO_STRING (format, "\\N{%s}"); @@ -2579,7 +2579,7 @@ read_escape (Lisp_Object readcharfun, bool stringp) AUTO_STRING (format, "Invalid character U+%04X in character name"); xsignal1 (Qinvalid_read_syntax, - CALLN (Fformat, format, make_natnum (c))); + CALLN (Fformat, format, make_fixed_natnum (c))); } /* Treat multiple adjacent whitespace characters as a single space character. This makes it easier to use @@ -2766,7 +2766,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) { ptrdiff_t size = XINT (Flength (tmp)); Lisp_Object record = Fmake_record (CAR_SAFE (tmp), - make_number (size - 1), + make_fixnum (size - 1), Qnil); for (int i = 1; i < size; i++) { @@ -2858,7 +2858,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) if (size == 0) error ("Zero-sized sub char-table"); - if (! RANGED_INTEGERP (1, XCAR (tmp), 3)) + if (! RANGED_FIXNUMP (1, XCAR (tmp), 3)) error ("Invalid depth in sub char-table"); depth = XINT (XCAR (tmp)); if (chartab_size[depth] != size - 2) @@ -2866,7 +2866,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) cell = XCONS (tmp), tmp = XCDR (tmp), size--; free_cons (cell); - if (! RANGED_INTEGERP (0, XCAR (tmp), MAX_CHAR)) + if (! RANGED_FIXNUMP (0, XCAR (tmp), MAX_CHAR)) error ("Invalid minimum character in sub-char-table"); min_char = XINT (XCAR (tmp)); cell = XCONS (tmp), tmp = XCDR (tmp), size--; @@ -3127,7 +3127,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) struct Lisp_Hash_Table *h = XHASH_TABLE (read_objects_map); EMACS_UINT hash; - Lisp_Object number = make_number (n); + Lisp_Object number = make_fixnum (n); ptrdiff_t i = hash_lookup (h, number, &hash); if (i >= 0) @@ -3142,7 +3142,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) /* If it can be recursive, remember it for future substitutions. */ if (! SYMBOLP (tem) - && ! NUMBERP (tem) + && ! FIXED_OR_FLOATP (tem) && ! (STRINGP (tem) && !string_intervals (tem))) { struct Lisp_Hash_Table *h2 @@ -3178,7 +3178,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) { struct Lisp_Hash_Table *h = XHASH_TABLE (read_objects_map); - ptrdiff_t i = hash_lookup (h, make_number (n), NULL); + ptrdiff_t i = hash_lookup (h, make_fixnum (n), NULL); if (i >= 0) return HASH_VALUE (h, i); } @@ -3286,13 +3286,13 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) Other literal whitespace like NL, CR, and FF are not accepted, as there are well-established escape sequences for these. */ if (c == ' ' || c == '\t') - return make_number (c); + return make_fixnum (c); if (c == '(' || c == ')' || c == '[' || c == ']' || c == '"' || c == ';') { CHECK_LIST (Vlread_unescaped_character_literals); - Lisp_Object char_obj = make_natnum (c); + Lisp_Object char_obj = make_fixed_natnum (c); if (NILP (Fmemq (char_obj, Vlread_unescaped_character_literals))) Vlread_unescaped_character_literals = Fcons (char_obj, Vlread_unescaped_character_literals); @@ -3312,7 +3312,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) && strchr ("\"';()[]#?`,.", next_char) != NULL)); UNREAD (next_char); if (ok) - return make_number (c); + return make_fixnum (c); invalid_syntax ("?"); } @@ -3421,7 +3421,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) return zero instead. This is for doc strings that we are really going to find in etc/DOC.nn.nn. */ if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel) - return unbind_to (count, make_number (0)); + return unbind_to (count, make_fixnum (0)); if (! force_multibyte && force_singlebyte) { @@ -3519,7 +3519,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) int ch = STRING_CHAR ((unsigned char *) read_buffer); if (confusable_symbol_character_p (ch)) xsignal2 (Qinvalid_read_syntax, build_string ("strange quote"), - CALLN (Fstring, make_number (ch))); + CALLN (Fstring, make_fixnum (ch))); } { Lisp_Object result; @@ -3562,7 +3562,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) if (EQ (Vread_with_symbol_positions, Qt) || EQ (Vread_with_symbol_positions, readcharfun)) Vread_symbol_positions_list - = Fcons (Fcons (result, make_number (start_position)), + = Fcons (Fcons (result, make_fixnum (start_position)), Vread_symbol_positions_list); return unbind_to (count, result); } @@ -3599,7 +3599,7 @@ substitute_object_recurse (struct subst *subst, Lisp_Object subtree) bother looking them up; we're done. */ if (SYMBOLP (subtree) || (STRINGP (subtree) && !string_intervals (subtree)) - || NUMBERP (subtree)) + || FIXED_OR_FLOATP (subtree)) return subtree; /* If we've been to this node before, don't explore it again. */ @@ -3791,7 +3791,7 @@ string_to_number (char const *string, int base, int flags) else if (n <= (negative ? -MOST_NEGATIVE_FIXNUM : MOST_POSITIVE_FIXNUM)) { EMACS_INT signed_n = n; - return make_number (negative ? -signed_n : signed_n); + return make_fixnum (negative ? -signed_n : signed_n); } else value = n; @@ -3969,8 +3969,8 @@ read_list (bool flag, Lisp_Object readcharfun) if (ch == ')') { if (doc_reference == 1) - return make_number (0); - if (doc_reference == 2 && INTEGERP (XCDR (val))) + return make_fixnum (0); + if (doc_reference == 2 && FIXNUMP (XCDR (val))) { char *saved = NULL; file_offset saved_position; @@ -4148,7 +4148,7 @@ define_symbol (Lisp_Object sym, char const *str) if (! EQ (sym, Qunbound)) { Lisp_Object bucket = oblookup (initial_obarray, str, len, len); - eassert (INTEGERP (bucket)); + eassert (FIXNUMP (bucket)); intern_sym (sym, initial_obarray, bucket); } } @@ -4194,7 +4194,7 @@ it defaults to the value of `obarray'. */) string = SYMBOL_NAME (name); tem = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string)); - if (INTEGERP (tem) || (SYMBOLP (name) && !EQ (name, tem))) + if (FIXNUMP (tem) || (SYMBOLP (name) && !EQ (name, tem))) return Qnil; else return tem; @@ -4226,7 +4226,7 @@ usage: (unintern NAME OBARRAY) */) tem = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string)); - if (INTEGERP (tem)) + if (FIXNUMP (tem)) return Qnil; /* If arg was a symbol, don't delete anything but that symbol itself. */ if (SYMBOLP (name) && !EQ (name, tem)) @@ -4252,7 +4252,7 @@ usage: (unintern NAME OBARRAY) */) ASET (obarray, hash, sym); } else - ASET (obarray, hash, make_number (0)); + ASET (obarray, hash, make_fixnum (0)); } else { @@ -4295,7 +4295,7 @@ oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff hash = hash_string (ptr, size_byte) % obsize; bucket = AREF (obarray, hash); oblookup_last_bucket_number = hash; - if (EQ (bucket, make_number (0))) + if (EQ (bucket, make_fixnum (0))) ; else if (!SYMBOLP (bucket)) error ("Bad data in guts of obarray"); /* Like CADR error message. */ @@ -4356,7 +4356,7 @@ OBARRAY defaults to the value of `obarray'. */) void init_obarray (void) { - Vobarray = Fmake_vector (make_number (OBARRAY_SIZE), make_number (0)); + Vobarray = Fmake_vector (make_fixnum (OBARRAY_SIZE), make_fixnum (0)); initial_obarray = Vobarray; staticpro (&initial_obarray); diff --git a/src/macros.c b/src/macros.c index b1fc7a037f..be84106992 100644 --- a/src/macros.c +++ b/src/macros.c @@ -97,8 +97,8 @@ macro before appending to it. */) for (i = 0; i < len; i++) { Lisp_Object c; - c = Faref (KVAR (current_kboard, Vlast_kbd_macro), make_number (i)); - if (cvt && NATNUMP (c) && (XFASTINT (c) & 0x80)) + c = Faref (KVAR (current_kboard, Vlast_kbd_macro), make_fixnum (i)); + if (cvt && FIXNATP (c) && (XFASTINT (c) & 0x80)) XSETFASTINT (c, CHAR_META | (XFASTINT (c) & ~0x80)); current_kboard->kbd_macro_buffer[i] = c; } @@ -110,7 +110,7 @@ macro before appending to it. */) for consistency of behavior. */ if (NILP (no_exec)) Fexecute_kbd_macro (KVAR (current_kboard, Vlast_kbd_macro), - make_number (1), Qnil); + make_fixnum (1), Qnil); message1 ("Appending to kbd macro..."); } @@ -154,7 +154,7 @@ each iteration of the macro. Iteration stops if LOOPFUNC returns nil. */) if (NILP (repeat)) XSETFASTINT (repeat, 1); else - CHECK_NUMBER (repeat); + CHECK_FIXNUM (repeat); if (!NILP (KVAR (current_kboard, defining_kbd_macro))) { @@ -301,7 +301,7 @@ each iteration of the macro. Iteration stops if LOOPFUNC returns nil. */) error ("Keyboard macros must be strings or vectors"); tem = Fcons (Vexecuting_kbd_macro, - Fcons (make_number (executing_kbd_macro_index), + Fcons (make_fixnum (executing_kbd_macro_index), Vreal_this_command)); record_unwind_protect (pop_kbd_macro, tem); diff --git a/src/marker.c b/src/marker.c index 2d5b05cc2b..ab1eb9f5bf 100644 --- a/src/marker.c +++ b/src/marker.c @@ -447,7 +447,7 @@ DEFUN ("marker-position", Fmarker_position, Smarker_position, 1, 1, 0, { CHECK_MARKER (marker); if (XMARKER (marker)->buffer) - return make_number (XMARKER (marker)->charpos); + return make_fixnum (XMARKER (marker)->charpos); return Qnil; } @@ -521,10 +521,10 @@ set_marker_internal (Lisp_Object marker, Lisp_Object position, { register ptrdiff_t charpos, bytepos; - /* Do not use CHECK_NUMBER_COERCE_MARKER because we + /* Do not use CHECK_FIXNUM_COERCE_MARKER because we don't want to call buf_charpos_to_bytepos if POSITION is a marker and so we know the bytepos already. */ - if (INTEGERP (position)) + if (FIXNUMP (position)) charpos = XINT (position), bytepos = -1; else if (MARKERP (position)) { @@ -712,7 +712,7 @@ see `marker-insertion-type'. */) register Lisp_Object new; if (!NILP (marker)) - CHECK_TYPE (INTEGERP (marker) || MARKERP (marker), Qinteger_or_marker_p, marker); + CHECK_TYPE (FIXNUMP (marker) || MARKERP (marker), Qinteger_or_marker_p, marker); new = Fmake_marker (); Fset_marker (new, marker, diff --git a/src/menu.c b/src/menu.c index e7d4d782fe..1d0ba3c258 100644 --- a/src/menu.c +++ b/src/menu.c @@ -86,7 +86,7 @@ init_menu_items (void) if (NILP (menu_items)) { menu_items_allocated = 60; - menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil); + menu_items = Fmake_vector (make_fixnum (menu_items_allocated), Qnil); } menu_items_inuse = Qt; @@ -148,9 +148,9 @@ void save_menu_items (void) { Lisp_Object saved = list4 (!NILP (menu_items_inuse) ? menu_items : Qnil, - make_number (menu_items_used), - make_number (menu_items_n_panes), - make_number (menu_items_submenu_depth)); + make_fixnum (menu_items_used), + make_fixnum (menu_items_n_panes), + make_fixnum (menu_items_submenu_depth)); record_unwind_protect (restore_menu_items, saved); menu_items_inuse = Qnil; menu_items = Qnil; @@ -1202,9 +1202,9 @@ x_popup_menu_1 (Lisp_Object position, Lisp_Object menu) int cur_x, cur_y; x_relative_mouse_position (new_f, &cur_x, &cur_y); - /* cur_x/y may be negative, so use make_number. */ - x = make_number (cur_x); - y = make_number (cur_y); + /* cur_x/y may be negative, so use make_fixnum. */ + x = make_fixnum (cur_x); + y = make_fixnum (cur_y); } } else diff --git a/src/minibuf.c b/src/minibuf.c index abc4866380..a6d03b2cb5 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -291,7 +291,7 @@ Return (point-min) if current buffer is not a minibuffer. */) { /* This function is written to be most efficient when there's a prompt. */ Lisp_Object beg, end, tem; - beg = make_number (BEGV); + beg = make_fixnum (BEGV); tem = Fmemq (Fcurrent_buffer (), Vminibuffer_list); if (NILP (tem)) @@ -393,7 +393,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, CHECK_STRING (initial); if (!NILP (backup_n)) { - CHECK_NUMBER (backup_n); + CHECK_FIXNUM (backup_n); /* Convert to distance from end of input. */ if (XINT (backup_n) < 1) /* A number too small means the beginning of the string. */ @@ -431,7 +431,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, && NILP (Vexecuting_kbd_macro)) { val = read_minibuf_noninteractive (map, initial, prompt, - make_number (pos), + make_fixnum (pos), expflag, histvar, histpos, defalt, allow_props, inherit_input_method); return unbind_to (count, val); @@ -478,7 +478,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, minibuf_save_list)); minibuf_save_list = Fcons (minibuf_prompt, - Fcons (make_number (minibuf_prompt_width), + Fcons (make_fixnum (minibuf_prompt_width), Fcons (Vhelp_form, Fcons (Vcurrent_prefix_arg, Fcons (Vminibuffer_history_position, @@ -610,11 +610,11 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, Finsert (1, &minibuf_prompt); if (PT > BEG) { - Fput_text_property (make_number (BEG), make_number (PT), + Fput_text_property (make_fixnum (BEG), make_fixnum (PT), Qfront_sticky, Qt, Qnil); - Fput_text_property (make_number (BEG), make_number (PT), + Fput_text_property (make_fixnum (BEG), make_fixnum (PT), Qrear_nonsticky, Qt, Qnil); - Fput_text_property (make_number (BEG), make_number (PT), + Fput_text_property (make_fixnum (BEG), make_fixnum (PT), Qfield, Qt, Qnil); if (CONSP (Vminibuffer_prompt_properties)) { @@ -633,10 +633,10 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, Lisp_Object val = XCAR (list); list = XCDR (list); if (EQ (key, Qface)) - Fadd_face_text_property (make_number (BEG), - make_number (PT), val, Qt, Qnil); + Fadd_face_text_property (make_fixnum (BEG), + make_fixnum (PT), val, Qt, Qnil); else - Fput_text_property (make_number (BEG), make_number (PT), + Fput_text_property (make_fixnum (BEG), make_fixnum (PT), key, val, Qnil); } } @@ -651,7 +651,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, if (!NILP (initial)) { Finsert (1, &initial); - Fforward_char (make_number (pos)); + Fforward_char (make_fixnum (pos)); } clear_message (1, 1); @@ -721,7 +721,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, Lisp_Object get_minibuffer (EMACS_INT depth) { - Lisp_Object tail = Fnthcdr (make_number (depth), Vminibuffer_list); + Lisp_Object tail = Fnthcdr (make_fixnum (depth), Vminibuffer_list); if (NILP (tail)) { tail = list1 (Qnil); @@ -995,7 +995,7 @@ the current input method and the setting of`enable-multibyte-characters'. */) { CHECK_STRING (prompt); return read_minibuf (Vminibuffer_local_ns_map, initial, prompt, - 0, Qminibuffer_history, make_number (0), Qnil, 0, + 0, Qminibuffer_history, make_fixnum (0), Qnil, 0, !NILP (inherit_input_method)); } @@ -1195,7 +1195,7 @@ is used to further constrain the set of candidates. */) return call3 (collection, string, predicate, Qnil); bestmatch = bucket = Qnil; - zero = make_number (0); + zero = make_fixnum (0); /* If COLLECTION is not a list, set TAIL just for gc pro. */ tail = collection; @@ -1261,7 +1261,7 @@ is used to further constrain the set of candidates. */) if (STRINGP (eltstring) && SCHARS (string) <= SCHARS (eltstring) && (tem = Fcompare_strings (eltstring, zero, - make_number (SCHARS (string)), + make_fixnum (SCHARS (string)), string, zero, Qnil, completion_ignore_case ? Qt : Qnil), EQ (Qt, tem))) @@ -1323,9 +1323,9 @@ is used to further constrain the set of candidates. */) { compare = min (bestmatchsize, SCHARS (eltstring)); tem = Fcompare_strings (bestmatch, zero, - make_number (compare), + make_fixnum (compare), eltstring, zero, - make_number (compare), + make_fixnum (compare), completion_ignore_case ? Qt : Qnil); matchsize = EQ (tem, Qt) ? compare : eabs (XINT (tem)) - 1; @@ -1348,13 +1348,13 @@ is used to further constrain the set of candidates. */) == (matchsize == SCHARS (bestmatch)) && (tem = Fcompare_strings (eltstring, zero, - make_number (SCHARS (string)), + make_fixnum (SCHARS (string)), string, zero, Qnil, Qnil), EQ (Qt, tem)) && (tem = Fcompare_strings (bestmatch, zero, - make_number (SCHARS (string)), + make_fixnum (SCHARS (string)), string, zero, Qnil, Qnil), @@ -1447,7 +1447,7 @@ with a space are ignored unless STRING itself starts with a space. */) if (type == 0) return call3 (collection, string, predicate, Qt); allmatches = bucket = Qnil; - zero = make_number (0); + zero = make_fixnum (0); /* If COLLECTION is not a list, set TAIL just for gc pro. */ tail = collection; @@ -1519,9 +1519,9 @@ with a space are ignored unless STRING itself starts with a space. */) && SREF (string, 0) == ' ') || SREF (eltstring, 0) != ' ') && (tem = Fcompare_strings (eltstring, zero, - make_number (SCHARS (string)), + make_fixnum (SCHARS (string)), string, zero, - make_number (SCHARS (string)), + make_fixnum (SCHARS (string)), completion_ignore_case ? Qt : Qnil), EQ (Qt, tem))) { @@ -1694,9 +1694,9 @@ the values STRING, PREDICATE and `lambda'. */) if (SYMBOLP (tail)) while (1) { - if (EQ (Fcompare_strings (string, make_number (0), Qnil, + if (EQ (Fcompare_strings (string, make_fixnum (0), Qnil, Fsymbol_name (tail), - make_number (0) , Qnil, Qt), + make_fixnum (0) , Qnil, Qt), Qt)) { tem = tail; @@ -1839,8 +1839,8 @@ single string, rather than a cons cell whose car is a string. */) thiscar = Fsymbol_name (thiscar); else if (!STRINGP (thiscar)) continue; - tem = Fcompare_strings (thiscar, make_number (0), Qnil, - key, make_number (0), Qnil, + tem = Fcompare_strings (thiscar, make_fixnum (0), Qnil, + key, make_fixnum (0), Qnil, case_fold); if (EQ (tem, Qt)) return elt; @@ -1854,7 +1854,7 @@ DEFUN ("minibuffer-depth", Fminibuffer_depth, Sminibuffer_depth, 0, 0, 0, doc: /* Return current depth of activations of minibuffer, a nonnegative integer. */) (void) { - return make_number (minibuf_level); + return make_fixnum (minibuf_level); } DEFUN ("minibuffer-prompt", Fminibuffer_prompt, Sminibuffer_prompt, 0, 0, 0, diff --git a/src/msdos.c b/src/msdos.c index 6c0dfa0c46..4f38b1de7d 100644 --- a/src/msdos.c +++ b/src/msdos.c @@ -223,7 +223,7 @@ them. This happens with wheeled mice on Windows 9X, for example. */) { int n; - CHECK_NUMBER (nbuttons); + CHECK_FIXNUM (nbuttons); n = XINT (nbuttons); if (n < 2 || n > 3) xsignal2 (Qargs_out_of_range, @@ -322,8 +322,8 @@ mouse_get_pos (struct frame **f, int insist, Lisp_Object *bar_window, *bar_window = Qnil; mouse_get_xy (&ix, &iy); *time = event_timestamp (); - *x = make_number (mouse_last_x = ix); - *y = make_number (mouse_last_y = iy); + *x = make_fixnum (mouse_last_x = ix); + *y = make_fixnum (mouse_last_y = iy); } static void @@ -539,7 +539,7 @@ dos_set_window_size (int *rows, int *cols) (video_name, "screen-dimensions-%dx%d", *rows, *cols), Qnil)); - if (INTEGERP (video_mode) + if (FIXNUMP (video_mode) && (video_mode_value = XINT (video_mode)) > 0) { regs.x.ax = video_mode_value; @@ -742,7 +742,7 @@ IT_set_cursor_type (struct frame *f, Lisp_Object cursor_type) Lisp_Object bar_parms = XCDR (cursor_type); int width; - if (INTEGERP (bar_parms)) + if (FIXNUMP (bar_parms)) { /* Feature: negative WIDTH means cursor at the top of the character cell, zero means invisible cursor. */ @@ -751,8 +751,8 @@ IT_set_cursor_type (struct frame *f, Lisp_Object cursor_type) width); } else if (CONSP (bar_parms) - && INTEGERP (XCAR (bar_parms)) - && INTEGERP (XCDR (bar_parms))) + && FIXNUMP (XCAR (bar_parms)) + && FIXNUMP (XCDR (bar_parms))) { int start_line = XINT (XCDR (bar_parms)); @@ -1321,7 +1321,7 @@ IT_frame_up_to_date (struct frame *f) if (EQ (BVAR (b,cursor_type), Qt)) new_cursor = frame_desired_cursor; else if (NILP (BVAR (b, cursor_type))) /* nil means no cursor */ - new_cursor = Fcons (Qbar, make_number (0)); + new_cursor = Fcons (Qbar, make_fixnum (0)); else new_cursor = BVAR (b, cursor_type); } @@ -1791,7 +1791,7 @@ internal_terminal_init (void) } Vinitial_window_system = Qpc; - Vwindow_system_version = make_number (27); /* RE Emacs version */ + Vwindow_system_version = make_fixnum (27); /* RE Emacs version */ tty->terminal->type = output_msdos_raw; /* If Emacs was dumped on DOS/V machine, forget the stale VRAM @@ -2423,11 +2423,11 @@ dos_rawgetc (void) sc = regs.h.ah; total_doskeys += 2; - ASET (recent_doskeys, recent_doskeys_index, make_number (c)); + ASET (recent_doskeys, recent_doskeys_index, make_fixnum (c)); recent_doskeys_index++; if (recent_doskeys_index == NUM_RECENT_DOSKEYS) recent_doskeys_index = 0; - ASET (recent_doskeys, recent_doskeys_index, make_number (sc)); + ASET (recent_doskeys, recent_doskeys_index, make_fixnum (sc)); recent_doskeys_index++; if (recent_doskeys_index == NUM_RECENT_DOSKEYS) recent_doskeys_index = 0; @@ -2609,7 +2609,7 @@ dos_rawgetc (void) if (code == 0) continue; - if (!hlinfo->mouse_face_hidden && INTEGERP (Vmouse_highlight)) + if (!hlinfo->mouse_face_hidden && FIXNUMP (Vmouse_highlight)) { clear_mouse_face (hlinfo); hlinfo->mouse_face_hidden = 1; @@ -2718,8 +2718,8 @@ dos_rawgetc (void) event.code = button_num; event.modifiers = dos_get_modifiers (0) | (press ? down_modifier : up_modifier); - event.x = make_number (x); - event.y = make_number (y); + event.x = make_fixnum (x); + event.y = make_fixnum (y); event.frame_or_window = selected_frame; event.arg = Qnil; event.timestamp = event_timestamp (); @@ -4196,7 +4196,7 @@ msdos_fatal_signal (int sig) void syms_of_msdos (void) { - recent_doskeys = Fmake_vector (make_number (NUM_RECENT_DOSKEYS), Qnil); + recent_doskeys = Fmake_vector (make_fixnum (NUM_RECENT_DOSKEYS), Qnil); staticpro (&recent_doskeys); #ifndef HAVE_X_WINDOWS @@ -4207,7 +4207,7 @@ syms_of_msdos (void) DEFVAR_LISP ("dos-unsupported-char-glyph", Vdos_unsupported_char_glyph, doc: /* Glyph to display instead of chars not supported by current codepage. This variable is used only by MS-DOS terminals. */); - Vdos_unsupported_char_glyph = make_number ('\177'); + Vdos_unsupported_char_glyph = make_fixnum ('\177'); #endif diff --git a/src/print.c b/src/print.c index 71591952a2..1327ef303b 100644 --- a/src/print.c +++ b/src/print.c @@ -274,7 +274,7 @@ static void printchar (unsigned int ch, Lisp_Object fun) { if (!NILP (fun) && !EQ (fun, Qt)) - call1 (fun, make_number (ch)); + call1 (fun, make_fixnum (ch)); else { unsigned char str[MAX_MULTIBYTE_LENGTH]; @@ -520,7 +520,7 @@ PRINTCHARFUN defaults to the value of `standard-output' (which see). */) { if (NILP (printcharfun)) printcharfun = Vstandard_output; - CHECK_NUMBER (character); + CHECK_FIXNUM (character); PRINTPREPARE; printchar (XINT (character), printcharfun); PRINTFINISH; @@ -771,7 +771,7 @@ You can call `print' while debugging emacs, and pass it this function to make it write to the debugging output. */) (Lisp_Object character) { - CHECK_NUMBER (character); + CHECK_FIXNUM (character); printchar_to_stream (XINT (character), stderr); return character; } @@ -1224,11 +1224,11 @@ print_preprocess (Lisp_Object obj) && SYMBOLP (obj) && !SYMBOL_INTERNED_P (obj))) { /* OBJ appears more than once. Let's remember that. */ - if (!INTEGERP (num)) + if (!FIXNUMP (num)) { print_number_index++; /* Negative number indicates it hasn't been printed yet. */ - Fputhash (obj, make_number (- print_number_index), + Fputhash (obj, make_fixnum (- print_number_index), Vprint_number_table); } print_depth--; @@ -1366,12 +1366,12 @@ print_prune_string_charset (Lisp_Object string) { if (NILP (print_prune_charset_plist)) print_prune_charset_plist = list1 (Qcharset); - Fremove_text_properties (make_number (0), - make_number (SCHARS (string)), + Fremove_text_properties (make_fixnum (0), + make_fixnum (SCHARS (string)), print_prune_charset_plist, string); } else - Fset_text_properties (make_number (0), make_number (SCHARS (string)), + Fset_text_properties (make_fixnum (0), make_fixnum (SCHARS (string)), Qnil, string); } return string; @@ -1407,7 +1407,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, /* Don't print more bytes than the specified maximum. Negative values of print-length are invalid. Treat them like a print-length of nil. */ - if (NATNUMP (Vprint_length) + if (FIXNATP (Vprint_length) && XFASTINT (Vprint_length) < size_in_bytes) size_in_bytes = XFASTINT (Vprint_length); @@ -1521,7 +1521,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, ptrdiff_t size = real_size; /* Don't print more elements than the specified maximum. */ - if (NATNUMP (Vprint_length) && XFASTINT (Vprint_length) < size) + if (FIXNATP (Vprint_length) && XFASTINT (Vprint_length) < size) size = XFASTINT (Vprint_length); printchar ('(', printcharfun); @@ -1652,7 +1652,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, /* Don't print more elements than the specified maximum. */ ptrdiff_t n - = (NATNUMP (Vprint_length) && XFASTINT (Vprint_length) < size + = (FIXNATP (Vprint_length) && XFASTINT (Vprint_length) < size ? XFASTINT (Vprint_length) : size); print_c_string ("#s(", printcharfun); @@ -1713,7 +1713,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, } /* Don't print more elements than the specified maximum. */ - if (NATNUMP (Vprint_length) + if (FIXNATP (Vprint_length) && XFASTINT (Vprint_length) < size) size = XFASTINT (Vprint_length); @@ -1805,7 +1805,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) { /* With the print-circle feature. */ Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil); - if (INTEGERP (num)) + if (FIXNUMP (num)) { EMACS_INT n = XINT (num); if (n < 0) @@ -1814,7 +1814,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) int len = sprintf (buf, "#%"pI"d=", -n); strout (buf, len, len, printcharfun); /* OBJ is going to be printed. Remember that fact. */ - Fputhash (obj, make_number (- n), Vprint_number_table); + Fputhash (obj, make_fixnum (- n), Vprint_number_table); } else { @@ -2007,7 +2007,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) case Lisp_Cons: /* If deeper than spec'd depth, print placeholder. */ - if (INTEGERP (Vprint_level) + if (FIXNUMP (Vprint_level) && print_depth > XINT (Vprint_level)) print_c_string ("...", printcharfun); else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj))) @@ -2049,7 +2049,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) /* Negative values of print-length are invalid in CL. Treat them like nil, as CMUCL does. */ - printmax_t print_length = (NATNUMP (Vprint_length) + printmax_t print_length = (FIXNATP (Vprint_length) ? XFASTINT (Vprint_length) : TYPE_MAXIMUM (printmax_t)); @@ -2073,7 +2073,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) if (i != 0) { Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil); - if (INTEGERP (num)) + if (FIXNUMP (num)) { print_c_string (" . ", printcharfun); print_object (obj, printcharfun, escapeflag); @@ -2223,9 +2223,9 @@ print_interval (INTERVAL interval, Lisp_Object printcharfun) if (NILP (interval->plist)) return; printchar (' ', printcharfun); - print_object (make_number (interval->position), printcharfun, 1); + print_object (make_fixnum (interval->position), printcharfun, 1); printchar (' ', printcharfun); - print_object (make_number (interval->position + LENGTH (interval)), + print_object (make_fixnum (interval->position + LENGTH (interval)), printcharfun, 1); printchar (' ', printcharfun); print_object (interval->plist, printcharfun, 1); diff --git a/src/process.c b/src/process.c index 5bd8c255a2..10af79a015 100644 --- a/src/process.c +++ b/src/process.c @@ -684,12 +684,12 @@ static Lisp_Object status_convert (int w) { if (WIFSTOPPED (w)) - return Fcons (Qstop, Fcons (make_number (WSTOPSIG (w)), Qnil)); + return Fcons (Qstop, Fcons (make_fixnum (WSTOPSIG (w)), Qnil)); else if (WIFEXITED (w)) - return Fcons (Qexit, Fcons (make_number (WEXITSTATUS (w)), + return Fcons (Qexit, Fcons (make_fixnum (WEXITSTATUS (w)), WCOREDUMP (w) ? Qt : Qnil)); else if (WIFSIGNALED (w)) - return Fcons (Qsignal, Fcons (make_number (WTERMSIG (w)), + return Fcons (Qsignal, Fcons (make_fixnum (WTERMSIG (w)), WCOREDUMP (w) ? Qt : Qnil)); else return Qrun; @@ -718,7 +718,7 @@ decode_status (Lisp_Object l, Lisp_Object *symbol, Lisp_Object *code, if (SYMBOLP (l)) { *symbol = l; - *code = make_number (0); + *code = make_fixnum (0); *coredump = 0; } else @@ -761,7 +761,7 @@ status_message (struct Lisp_Process *p) c1 = STRING_CHAR (SDATA (string)); c2 = downcase (c1); if (c1 != c2) - Faset (string, make_number (0), make_number (c2)); + Faset (string, make_fixnum (0), make_fixnum (c2)); } AUTO_STRING (suffix, coredump ? " (core dumped)\n" : "\n"); return concat2 (string, suffix); @@ -1064,7 +1064,7 @@ nil, indicating the current buffer's process. */) p->raw_status_new = 0; if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p)) { - pset_status (p, list2 (Qexit, make_number (0))); + pset_status (p, list2 (Qexit, make_fixnum (0))); p->tick = ++process_tick; status_notify (p, NULL); redisplay_preserve_echo_area (13); @@ -1083,7 +1083,7 @@ nil, indicating the current buffer's process. */) update_status (p); symbol = CONSP (p->status) ? XCAR (p->status) : p->status; if (! (EQ (symbol, Qsignal) || EQ (symbol, Qexit))) - pset_status (p, list2 (Qsignal, make_number (SIGKILL))); + pset_status (p, list2 (Qsignal, make_fixnum (SIGKILL))); p->tick = ++process_tick; status_notify (p, NULL); @@ -1151,7 +1151,7 @@ If PROCESS has not yet exited or died, return 0. */) update_status (XPROCESS (process)); if (CONSP (XPROCESS (process)->status)) return XCAR (XCDR (XPROCESS (process)->status)); - return make_number (0); + return make_fixnum (0); } DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0, @@ -1584,7 +1584,7 @@ Return nil if format of ADDRESS is invalid. */) for (i = 0; i < nargs; i++) { - if (! RANGED_INTEGERP (0, p->contents[i], 65535)) + if (! RANGED_FIXNUMP (0, p->contents[i], 65535)) return Qnil; if (nargs <= 5 /* IPv4 */ @@ -1864,7 +1864,7 @@ usage: (make-process &rest ARGS) */) { tem = Qnil; openp (Vexec_path, program, Vexec_suffixes, &tem, - make_number (X_OK), false); + make_fixnum (X_OK), false); if (NILP (tem)) report_file_error ("Searching for program", program); tem = Fexpand_file_name (tem, Qnil); @@ -2503,9 +2503,9 @@ conv_sockaddr_to_lisp (struct sockaddr *sa, ptrdiff_t len) { DECLARE_POINTER_ALIAS (sin, struct sockaddr_in, sa); len = sizeof (sin->sin_addr) + 1; - address = Fmake_vector (make_number (len), Qnil); + address = Fmake_vector (make_fixnum (len), Qnil); p = XVECTOR (address); - p->contents[--len] = make_number (ntohs (sin->sin_port)); + p->contents[--len] = make_fixnum (ntohs (sin->sin_port)); cp = (unsigned char *) &sin->sin_addr; break; } @@ -2515,11 +2515,11 @@ conv_sockaddr_to_lisp (struct sockaddr *sa, ptrdiff_t len) DECLARE_POINTER_ALIAS (sin6, struct sockaddr_in6, sa); DECLARE_POINTER_ALIAS (ip6, uint16_t, &sin6->sin6_addr); len = sizeof (sin6->sin6_addr) / 2 + 1; - address = Fmake_vector (make_number (len), Qnil); + address = Fmake_vector (make_fixnum (len), Qnil); p = XVECTOR (address); - p->contents[--len] = make_number (ntohs (sin6->sin6_port)); + p->contents[--len] = make_fixnum (ntohs (sin6->sin6_port)); for (i = 0; i < len; i++) - p->contents[i] = make_number (ntohs (ip6[i])); + p->contents[i] = make_fixnum (ntohs (ip6[i])); return address; } #endif @@ -2547,8 +2547,8 @@ conv_sockaddr_to_lisp (struct sockaddr *sa, ptrdiff_t len) #endif default: len -= offsetof (struct sockaddr, sa_family) + sizeof (sa->sa_family); - address = Fcons (make_number (sa->sa_family), - Fmake_vector (make_number (len), Qnil)); + address = Fcons (make_fixnum (sa->sa_family), + Fmake_vector (make_fixnum (len), Qnil)); p = XVECTOR (XCDR (address)); cp = (unsigned char *) &sa->sa_family + sizeof (sa->sa_family); break; @@ -2556,7 +2556,7 @@ conv_sockaddr_to_lisp (struct sockaddr *sa, ptrdiff_t len) i = 0; while (i < len) - p->contents[i++] = make_number (*cp++); + p->contents[i++] = make_fixnum (*cp++); return address; } @@ -2566,7 +2566,7 @@ conv_sockaddr_to_lisp (struct sockaddr *sa, ptrdiff_t len) static Lisp_Object conv_addrinfo_to_lisp (struct addrinfo *res) { - Lisp_Object protocol = make_number (res->ai_protocol); + Lisp_Object protocol = make_fixnum (res->ai_protocol); eassert (XINT (protocol) == res->ai_protocol); return Fcons (protocol, conv_sockaddr_to_lisp (res->ai_addr, res->ai_addrlen)); } @@ -2602,7 +2602,7 @@ get_lisp_to_sockaddr_size (Lisp_Object address, int *familyp) return sizeof (struct sockaddr_un); } #endif - else if (CONSP (address) && TYPE_RANGED_INTEGERP (int, XCAR (address)) + else if (CONSP (address) && TYPE_RANGED_FIXNUMP (int, XCAR (address)) && VECTORP (XCDR (address))) { struct sockaddr *sa; @@ -2653,7 +2653,7 @@ conv_lisp_to_sockaddr (int family, Lisp_Object address, struct sockaddr *sa, int hostport = XINT (p->contents[--len]); sin6->sin6_port = htons (hostport); for (i = 0; i < len; i++) - if (INTEGERP (p->contents[i])) + if (FIXNUMP (p->contents[i])) { int j = XFASTINT (p->contents[i]) & 0xffff; ip6[i] = ntohs (j); @@ -2686,7 +2686,7 @@ conv_lisp_to_sockaddr (int family, Lisp_Object address, struct sockaddr *sa, int } for (i = 0; i < len; i++) - if (INTEGERP (p->contents[i])) + if (FIXNUMP (p->contents[i])) *cp++ = XFASTINT (p->contents[i]) & 0xff; } @@ -2818,7 +2818,7 @@ set_socket_option (int s, Lisp_Object opt, Lisp_Object val) case SOPT_INT: { int optval; - if (TYPE_RANGED_INTEGERP (int, val)) + if (TYPE_RANGED_FIXNUMP (int, val)) optval = XINT (val); else error ("Bad option value for %s", name); @@ -2857,7 +2857,7 @@ set_socket_option (int s, Lisp_Object opt, Lisp_Object val) linger.l_onoff = 1; linger.l_linger = 0; - if (TYPE_RANGED_INTEGERP (int, val)) + if (TYPE_RANGED_FIXNUMP (int, val)) linger.l_linger = XINT (val); else linger.l_onoff = NILP (val) ? 0 : 1; @@ -3102,7 +3102,7 @@ usage: (make-serial-process &rest ARGS) */) if (NILP (Fplist_member (contact, QCspeed))) error (":speed not specified"); if (!NILP (Fplist_get (contact, QCspeed))) - CHECK_NUMBER (Fplist_get (contact, QCspeed)); + CHECK_FIXNUM (Fplist_get (contact, QCspeed)); name = Fplist_get (contact, QCname); if (NILP (name)) @@ -3464,7 +3464,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, DECLARE_POINTER_ALIAS (psa1, struct sockaddr, &sa1); if (getsockname (s, psa1, &len1) == 0) { - Lisp_Object service = make_number (ntohs (sa1.sin_port)); + Lisp_Object service = make_fixnum (ntohs (sa1.sin_port)); contact = Fplist_put (contact, QCservice, service); /* Save the port number so that we can stash it in the process object later. */ @@ -3916,7 +3916,7 @@ usage: (make-network-process &rest ARGS) */) if (!get_lisp_to_sockaddr_size (address, &family)) error ("Malformed :address"); - addrinfos = list1 (Fcons (make_number (any_protocol), address)); + addrinfos = list1 (Fcons (make_fixnum (any_protocol), address)); goto open_socket; } @@ -3940,7 +3940,7 @@ usage: (make-network-process &rest ARGS) */) #endif else if (EQ (tem, Qipv4)) family = AF_INET; - else if (TYPE_RANGED_INTEGERP (int, tem)) + else if (TYPE_RANGED_FIXNUMP (int, tem)) family = XINT (tem); else error ("Unknown address family"); @@ -3980,7 +3980,7 @@ usage: (make-network-process &rest ARGS) */) CHECK_STRING (service); if (sizeof address_un.sun_path <= SBYTES (service)) error ("Service name too long"); - addrinfos = list1 (Fcons (make_number (any_protocol), service)); + addrinfos = list1 (Fcons (make_fixnum (any_protocol), service)); goto open_socket; } #endif @@ -4007,7 +4007,7 @@ usage: (make-network-process &rest ARGS) */) portstring = "0"; portstringlen = 1; } - else if (INTEGERP (service)) + else if (FIXNUMP (service)) { portstring = portbuf; portstringlen = sprintf (portbuf, "%"pI"d", XINT (service)); @@ -4095,7 +4095,7 @@ usage: (make-network-process &rest ARGS) */) if (EQ (service, Qt)) port = 0; - else if (INTEGERP (service)) + else if (FIXNUMP (service)) port = XINT (service); else { @@ -4169,7 +4169,7 @@ usage: (make-network-process &rest ARGS) */) /* :server QLEN */ p->is_server = !NILP (server); - if (TYPE_RANGED_INTEGERP (int, server)) + if (TYPE_RANGED_FIXNUMP (int, server)) p->backlog = XINT (server); /* :nowait BOOL */ @@ -4394,7 +4394,7 @@ network_interface_info (Lisp_Object ifname) { if (flags & 1) { - elt = Fcons (make_number (fnum), elt); + elt = Fcons (make_fixnum (fnum), elt); } } } @@ -4405,21 +4405,21 @@ network_interface_info (Lisp_Object ifname) #if defined (SIOCGIFHWADDR) && defined (HAVE_STRUCT_IFREQ_IFR_HWADDR) if (ioctl (s, SIOCGIFHWADDR, &rq) == 0) { - Lisp_Object hwaddr = Fmake_vector (make_number (6), Qnil); + Lisp_Object hwaddr = Fmake_vector (make_fixnum (6), Qnil); register struct Lisp_Vector *p = XVECTOR (hwaddr); int n; any = 1; for (n = 0; n < 6; n++) - p->contents[n] = make_number (((unsigned char *) + p->contents[n] = make_fixnum (((unsigned char *) &rq.ifr_hwaddr.sa_data[0]) [n]); - elt = Fcons (make_number (rq.ifr_hwaddr.sa_family), hwaddr); + elt = Fcons (make_fixnum (rq.ifr_hwaddr.sa_family), hwaddr); } #elif defined (HAVE_GETIFADDRS) && defined (LLADDR) if (getifaddrs (&ifap) != -1) { - Lisp_Object hwaddr = Fmake_vector (make_number (6), Qnil); + Lisp_Object hwaddr = Fmake_vector (make_fixnum (6), Qnil); register struct Lisp_Vector *p = XVECTOR (hwaddr); struct ifaddrs *it; @@ -4436,9 +4436,9 @@ network_interface_info (Lisp_Object ifname) memcpy (linkaddr, LLADDR (sdl), sdl->sdl_alen); for (n = 0; n < 6; n++) - p->contents[n] = make_number (linkaddr[n]); + p->contents[n] = make_fixnum (linkaddr[n]); - elt = Fcons (make_number (it->ifa_addr->sa_family), hwaddr); + elt = Fcons (make_fixnum (it->ifa_addr->sa_family), hwaddr); break; } } @@ -4625,12 +4625,12 @@ is nil, from any process) before the timeout expired. */) if (!NILP (millisec)) { /* Obsolete calling convention using integers rather than floats. */ - CHECK_NUMBER (millisec); + CHECK_FIXNUM (millisec); if (NILP (seconds)) seconds = make_float (XINT (millisec) / 1000.0); else { - CHECK_NUMBER (seconds); + CHECK_FIXNUM (seconds); seconds = make_float (XINT (millisec) / 1000.0 + XINT (seconds)); } } @@ -4640,7 +4640,7 @@ is nil, from any process) before the timeout expired. */) if (!NILP (seconds)) { - if (INTEGERP (seconds)) + if (FIXNUMP (seconds)) { if (XINT (seconds) > 0) { @@ -4668,7 +4668,7 @@ is nil, from any process) before the timeout expired. */) Qnil, !NILP (process) ? XPROCESS (process) : NULL, (NILP (just_this_one) ? 0 - : !INTEGERP (just_this_one) ? 1 : -1)) + : !FIXNUMP (just_this_one) ? 1 : -1)) <= 0) ? Qnil : Qt); } @@ -4697,7 +4697,7 @@ server_accept_connection (Lisp_Object server, int channel) if (!would_block (code) && !NILP (ps->log)) call3 (ps->log, server, Qnil, concat3 (build_string ("accept failed with code"), - Fnumber_to_string (make_number (code)), + Fnumber_to_string (make_fixnum (code)), build_string ("\n"))); return; } @@ -4725,9 +4725,9 @@ server_accept_connection (Lisp_Object server, int channel) args[nargs++] = procname_format_in; nargs++; unsigned char *ip = (unsigned char *)&saddr.in.sin_addr.s_addr; - service = make_number (ntohs (saddr.in.sin_port)); + service = make_fixnum (ntohs (saddr.in.sin_port)); for (int i = 0; i < 4; i++) - args[nargs++] = make_number (ip[i]); + args[nargs++] = make_fixnum (ip[i]); args[nargs++] = service; } break; @@ -4738,9 +4738,9 @@ server_accept_connection (Lisp_Object server, int channel) args[nargs++] = procname_format_in6; nargs++; DECLARE_POINTER_ALIAS (ip6, uint16_t, &saddr.in6.sin6_addr); - service = make_number (ntohs (saddr.in.sin_port)); + service = make_fixnum (ntohs (saddr.in.sin_port)); for (int i = 0; i < 8; i++) - args[nargs++] = make_number (ip6[i]); + args[nargs++] = make_fixnum (ip6[i]); args[nargs++] = service; } break; @@ -4749,7 +4749,7 @@ server_accept_connection (Lisp_Object server, int channel) default: args[nargs++] = procname_format_default; nargs++; - args[nargs++] = make_number (connect_counter); + args[nargs++] = make_fixnum (connect_counter); break; } @@ -5671,7 +5671,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, deactivate_process (proc); if (EQ (XPROCESS (proc)->status, Qrun)) pset_status (XPROCESS (proc), - list2 (Qexit, make_number (0))); + list2 (Qexit, make_fixnum (0))); } else { @@ -5682,7 +5682,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, update_status (XPROCESS (proc)); if (EQ (XPROCESS (proc)->status, Qrun)) pset_status (XPROCESS (proc), - list2 (Qexit, make_number (256))); + list2 (Qexit, make_fixnum (256))); } } if (FD_ISSET (channel, &Writeok) @@ -5734,7 +5734,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, else { p->tick = ++process_tick; - pset_status (p, list2 (Qfailed, make_number (xerrno))); + pset_status (p, list2 (Qfailed, make_fixnum (xerrno))); } deactivate_process (proc); if (!NILP (addrinfos)) @@ -5803,7 +5803,7 @@ read_process_output_error_handler (Lisp_Object error_val) cmd_error_internal (error_val, "error in process filter: "); Vinhibit_quit = Qt; update_echo_area (); - Fsleep_for (make_number (2), Qnil); + Fsleep_for (make_fixnum (2), Qnil); return Qt; } @@ -6121,7 +6121,7 @@ Otherwise it discards the output. */) /* If the restriction isn't what it should be, set it. */ if (old_begv != BEGV || old_zv != ZV) - Fnarrow_to_region (make_number (old_begv), make_number (old_zv)); + Fnarrow_to_region (make_fixnum (old_begv), make_fixnum (old_zv)); bset_read_only (current_buffer, old_read_only); SET_PT_BOTH (opoint, opoint_byte); @@ -6168,7 +6168,7 @@ write_queue_push (struct Lisp_Process *p, Lisp_Object input_obj, obj = make_unibyte_string (buf, len); } - entry = Fcons (obj, Fcons (make_number (offset), make_number (len))); + entry = Fcons (obj, Fcons (make_fixnum (offset), make_fixnum (len))); if (front) pset_write_queue (p, Fcons (entry, p->write_queue)); @@ -6415,7 +6415,7 @@ send_process (Lisp_Object proc, const char *buf, ptrdiff_t len, else if (errno == EPIPE) { p->raw_status_new = 0; - pset_status (p, list2 (Qexit, make_number (256))); + pset_status (p, list2 (Qexit, make_fixnum (256))); p->tick = ++process_tick; deactivate_process (proc); error ("process %s no longer connected to pipe; closed it", @@ -6537,7 +6537,7 @@ process group. */) if (gid == p->pid) return Qnil; if (gid != -1) - return make_number (gid); + return make_fixnum (gid); return Qt; } @@ -6845,13 +6845,13 @@ SIGCODE may be an integer, or a symbol whose name is a signal name. */) tem = string_to_number (SSDATA (process), 10, S2N_OVERFLOW_TO_FLOAT); process = tem; } - else if (!NUMBERP (process)) + else if (!FIXED_OR_FLOATP (process)) process = get_process (process); if (NILP (process)) return process; - if (NUMBERP (process)) + if (FIXED_OR_FLOATP (process)) CONS_TO_INTEGER (process, pid_t, pid); else { @@ -6861,7 +6861,7 @@ SIGCODE may be an integer, or a symbol whose name is a signal name. */) error ("Cannot signal process %s", SDATA (XPROCESS (process)->name)); } - if (INTEGERP (sigcode)) + if (FIXNUMP (sigcode)) { CHECK_TYPE_RANGED_INTEGER (int, sigcode); signo = XINT (sigcode); @@ -6878,7 +6878,7 @@ SIGCODE may be an integer, or a symbol whose name is a signal name. */) error ("Undefined signal name %s", name); } - return make_number (kill (pid, signo)); + return make_fixnum (kill (pid, signo)); } DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0, @@ -7048,10 +7048,10 @@ handle_child_signal (int sig) if (! CONSP (head)) continue; xpid = XCAR (head); - if (all_pids_are_fixnums ? INTEGERP (xpid) : NUMBERP (xpid)) + if (all_pids_are_fixnums ? FIXNUMP (xpid) : FIXED_OR_FLOATP (xpid)) { pid_t deleted_pid; - if (INTEGERP (xpid)) + if (FIXNUMP (xpid)) deleted_pid = XINT (xpid); else deleted_pid = XFLOAT_DATA (xpid); @@ -7118,7 +7118,7 @@ exec_sentinel_error_handler (Lisp_Object error_val) cmd_error_internal (error_val, "error in process sentinel: "); Vinhibit_quit = Qt; update_echo_area (); - Fsleep_for (make_number (2), Qnil); + Fsleep_for (make_fixnum (2), Qnil); return Qt; } diff --git a/src/profiler.c b/src/profiler.c index 312574d752..4c7812aa77 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -55,7 +55,7 @@ make_log (EMACS_INT heap_size, EMACS_INT max_stack_depth) ptrdiff_t i = ASIZE (h->key_and_value) >> 1; while (i > 0) set_hash_key_slot (h, --i, - Fmake_vector (make_number (max_stack_depth), Qnil)); + Fmake_vector (make_fixnum (max_stack_depth), Qnil)); return log; } @@ -158,13 +158,13 @@ record_backtrace (log_t *log, EMACS_INT count) { EMACS_INT old_val = XINT (HASH_VALUE (log, j)); EMACS_INT new_val = saturated_add (old_val, count); - set_hash_value_slot (log, j, make_number (new_val)); + set_hash_value_slot (log, j, make_fixnum (new_val)); } else { /* BEWARE! hash_put in general can allocate memory. But currently it only does that if log->next_free is -1. */ eassert (0 <= log->next_free); - ptrdiff_t j = hash_put (log, backtrace, make_number (count), hash); + ptrdiff_t j = hash_put (log, backtrace, make_fixnum (count), hash); /* Let's make sure we've put `backtrace' right where it already was to start with. */ eassert (index == j); @@ -266,7 +266,7 @@ setup_cpu_timer (Lisp_Object sampling_interval) struct timespec interval; int billion = 1000000000; - if (! RANGED_INTEGERP (1, sampling_interval, + if (! RANGED_FIXNUMP (1, sampling_interval, (TYPE_MAXIMUM (time_t) < EMACS_INT_MAX / billion ? ((EMACS_INT) TYPE_MAXIMUM (time_t) * billion + (billion - 1)) @@ -422,8 +422,8 @@ Before returning, a new log is allocated for future samples. */) cpu_log = (profiler_cpu_running ? make_log (profiler_log_size, profiler_max_stack_depth) : Qnil); - Fputhash (Fmake_vector (make_number (1), QAutomatic_GC), - make_number (cpu_gc_count), + Fputhash (Fmake_vector (make_fixnum (1), QAutomatic_GC), + make_fixnum (cpu_gc_count), result); cpu_gc_count = 0; return result; diff --git a/src/search.c b/src/search.c index ccdb659776..72374c8b9b 100644 --- a/src/search.c +++ b/src/search.c @@ -132,7 +132,7 @@ compile_pattern_1 (struct regexp_cache *cp, Lisp_Object pattern, eassert (!cp->busy); cp->regexp = Qnil; - cp->buf.translate = (! NILP (translate) ? translate : make_number (0)); + cp->buf.translate = (! NILP (translate) ? translate : make_fixnum (0)); cp->posix = posix; cp->buf.multibyte = STRING_MULTIBYTE (pattern); cp->buf.charset_unibyte = charset_unibyte; @@ -238,7 +238,7 @@ compile_pattern (Lisp_Object pattern, struct re_registers *regp, && !cp->busy && STRING_MULTIBYTE (cp->regexp) == STRING_MULTIBYTE (pattern) && !NILP (Fstring_equal (cp->regexp, pattern)) - && EQ (cp->buf.translate, (! NILP (translate) ? translate : make_number (0))) + && EQ (cp->buf.translate, (! NILP (translate) ? translate : make_fixnum (0))) && cp->posix == posix && (EQ (cp->syntax_table, Qt) || EQ (cp->syntax_table, BVAR (current_buffer, syntax_table))) @@ -401,7 +401,7 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, { ptrdiff_t len = SCHARS (string); - CHECK_NUMBER (start); + CHECK_FIXNUM (start); pos = XINT (start); if (pos < 0 && -pos <= len) pos = len + pos; @@ -446,7 +446,7 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, = string_byte_to_char (string, search_regs.end[i]); } - return make_number (string_byte_to_char (string, val)); + return make_fixnum (string_byte_to_char (string, val)); } DEFUN ("string-match", Fstring_match, Sstring_match, 2, 3, 0, @@ -1036,7 +1036,7 @@ search_command (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, if (!NILP (count)) { - CHECK_NUMBER (count); + CHECK_FIXNUM (count); n *= XINT (count); } @@ -1050,7 +1050,7 @@ search_command (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, } else { - CHECK_NUMBER_COERCE_MARKER (bound); + CHECK_FIXNUM_COERCE_MARKER (bound); lim = XINT (bound); if (n > 0 ? lim < PT : lim > PT) error ("Invalid search bound (wrong side of point)"); @@ -1096,7 +1096,7 @@ search_command (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, eassert (BEGV <= np && np <= ZV); SET_PT (np); - return make_number (np); + return make_fixnum (np); } /* Return true if REGEXP it matches just one constant string. */ @@ -1151,8 +1151,8 @@ do \ if (! NILP (trt)) \ { \ Lisp_Object temp; \ - temp = Faref (trt, make_number (d)); \ - if (INTEGERP (temp)) \ + temp = Faref (trt, make_fixnum (d)); \ + if (FIXNUMP (temp)) \ out = XINT (temp); \ else \ out = d; \ @@ -2420,9 +2420,9 @@ since only regular expressions have distinguished subexpressions. */) sub = 0; else { - CHECK_NUMBER (subexp); + CHECK_FIXNUM (subexp); if (! (0 <= XINT (subexp) && XINT (subexp) < search_regs.num_regs)) - args_out_of_range (subexp, make_number (search_regs.num_regs)); + args_out_of_range (subexp, make_fixnum (search_regs.num_regs)); sub = XINT (subexp); } @@ -2431,16 +2431,16 @@ since only regular expressions have distinguished subexpressions. */) if (search_regs.start[sub] < BEGV || search_regs.start[sub] > search_regs.end[sub] || search_regs.end[sub] > ZV) - args_out_of_range (make_number (search_regs.start[sub]), - make_number (search_regs.end[sub])); + args_out_of_range (make_fixnum (search_regs.start[sub]), + make_fixnum (search_regs.end[sub])); } else { if (search_regs.start[sub] < 0 || search_regs.start[sub] > search_regs.end[sub] || search_regs.end[sub] > SCHARS (string)) - args_out_of_range (make_number (search_regs.start[sub]), - make_number (search_regs.end[sub])); + args_out_of_range (make_fixnum (search_regs.start[sub]), + make_fixnum (search_regs.end[sub])); } if (NILP (fixedcase)) @@ -2525,9 +2525,9 @@ since only regular expressions have distinguished subexpressions. */) { Lisp_Object before, after; - before = Fsubstring (string, make_number (0), - make_number (search_regs.start[sub])); - after = Fsubstring (string, make_number (search_regs.end[sub]), Qnil); + before = Fsubstring (string, make_fixnum (0), + make_fixnum (search_regs.start[sub])); + after = Fsubstring (string, make_fixnum (search_regs.end[sub]), Qnil); /* Substitute parts of the match into NEWTEXT if desired. */ @@ -2590,8 +2590,8 @@ since only regular expressions have distinguished subexpressions. */) middle = Qnil; accum = concat3 (accum, middle, Fsubstring (string, - make_number (substart), - make_number (subend))); + make_fixnum (substart), + make_fixnum (subend))); lastpos = pos; lastpos_byte = pos_byte; } @@ -2780,12 +2780,12 @@ since only regular expressions have distinguished subexpressions. */) } if (case_action == all_caps) - Fupcase_region (make_number (search_regs.start[sub]), - make_number (newpoint), + Fupcase_region (make_fixnum (search_regs.start[sub]), + make_fixnum (newpoint), Qnil); else if (case_action == cap_initial) - Fupcase_initials_region (make_number (search_regs.start[sub]), - make_number (newpoint)); + Fupcase_initials_region (make_fixnum (search_regs.start[sub]), + make_fixnum (newpoint)); if (search_regs.start[sub] != sub_start || search_regs.end[sub] != sub_end @@ -2809,16 +2809,16 @@ match_limit (Lisp_Object num, bool beginningp) { EMACS_INT n; - CHECK_NUMBER (num); + CHECK_FIXNUM (num); n = XINT (num); if (n < 0) - args_out_of_range (num, make_number (0)); + args_out_of_range (num, make_fixnum (0)); if (search_regs.num_regs <= 0) error ("No match data, because no search succeeded"); if (n >= search_regs.num_regs || search_regs.start[n] < 0) return Qnil; - return (make_number ((beginningp) ? search_regs.start[n] + return (make_fixnum ((beginningp) ? search_regs.start[n] : search_regs.end[n])); } @@ -2908,11 +2908,11 @@ Return value is undefined if the last search failed. */) { data[2 * i] = Fmake_marker (); Fset_marker (data[2 * i], - make_number (start), + make_fixnum (start), last_thing_searched); data[2 * i + 1] = Fmake_marker (); Fset_marker (data[2 * i + 1], - make_number (search_regs.end[i]), + make_fixnum (search_regs.end[i]), last_thing_searched); } else @@ -3037,7 +3037,7 @@ If optional arg RESEAT is non-nil, make markers on LIST point nowhere. */) XSETBUFFER (last_thing_searched, XMARKER (marker)->buffer); } - CHECK_NUMBER_COERCE_MARKER (marker); + CHECK_FIXNUM_COERCE_MARKER (marker); from = marker; if (!NILP (reseat) && MARKERP (m)) @@ -3054,7 +3054,7 @@ If optional arg RESEAT is non-nil, make markers on LIST point nowhere. */) if (MARKERP (marker) && XMARKER (marker)->buffer == 0) XSETFASTINT (marker, 0); - CHECK_NUMBER_COERCE_MARKER (marker); + CHECK_FIXNUM_COERCE_MARKER (marker); if ((XINT (from) < 0 ? TYPE_MINIMUM (regoff_t) <= XINT (from) : XINT (from) <= TYPE_MAXIMUM (regoff_t)) @@ -3349,11 +3349,11 @@ the buffer. If the buffer doesn't have a cache, the value is nil. */) NULL, true); if (shortage != 0 || i >= nl_count_cache) break; - ASET (cache_newlines, i, make_number (found - 1)); + ASET (cache_newlines, i, make_fixnum (found - 1)); } /* Fill the rest of slots with an invalid position. */ for ( ; i < nl_count_cache; i++) - ASET (cache_newlines, i, make_number (-1)); + ASET (cache_newlines, i, make_fixnum (-1)); } /* Now do the same, but without using the cache. */ @@ -3371,10 +3371,10 @@ the buffer. If the buffer doesn't have a cache, the value is nil. */) NULL, true); if (shortage != 0 || i >= nl_count_buf) break; - ASET (buf_newlines, i, make_number (found - 1)); + ASET (buf_newlines, i, make_fixnum (found - 1)); } for ( ; i < nl_count_buf; i++) - ASET (buf_newlines, i, make_number (-1)); + ASET (buf_newlines, i, make_fixnum (-1)); } /* Construct the value and return it. */ diff --git a/src/sound.c b/src/sound.c index b149acd752..ea57dc43bc 100644 --- a/src/sound.c +++ b/src/sound.c @@ -385,7 +385,7 @@ parse_sound (Lisp_Object sound, Lisp_Object *attrs) /* Volume must be in the range 0..100 or unspecified. */ if (!NILP (attrs[SOUND_VOLUME])) { - if (INTEGERP (attrs[SOUND_VOLUME])) + if (FIXNUMP (attrs[SOUND_VOLUME])) { EMACS_INT volume = XINT (attrs[SOUND_VOLUME]); if (! (0 <= volume && volume <= 100)) @@ -1400,7 +1400,7 @@ Internal use only, use `play-sound' instead. */) /* Set up a device. */ current_sound_device->file = attrs[SOUND_DEVICE]; - if (INTEGERP (attrs[SOUND_VOLUME])) + if (FIXNUMP (attrs[SOUND_VOLUME])) current_sound_device->volume = XFASTINT (attrs[SOUND_VOLUME]); else if (FLOATP (attrs[SOUND_VOLUME])) current_sound_device->volume = XFLOAT_DATA (attrs[SOUND_VOLUME]) * 100; @@ -1423,7 +1423,7 @@ Internal use only, use `play-sound' instead. */) file = Fexpand_file_name (attrs[SOUND_FILE], Vdata_directory); file = ENCODE_FILE (file); - if (INTEGERP (attrs[SOUND_VOLUME])) + if (FIXNUMP (attrs[SOUND_VOLUME])) { ui_volume_tmp = XFASTINT (attrs[SOUND_VOLUME]); } diff --git a/src/syntax.c b/src/syntax.c index c5a4b03955..8434f47a5f 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -490,7 +490,7 @@ parse_sexp_propertize (ptrdiff_t charpos) { EMACS_INT modiffs = CHARS_MODIFF; safe_call1 (Qinternal__syntax_propertize, - make_number (min (zv, 1 + charpos))); + make_fixnum (min (zv, 1 + charpos))); if (modiffs != CHARS_MODIFF) error ("parse-sexp-propertize-function modified the buffer!"); if (syntax_propertize__done <= charpos @@ -608,12 +608,12 @@ find_defun_start (ptrdiff_t pos, ptrdiff_t pos_byte) if (!NILP (Vcomment_use_syntax_ppss)) { EMACS_INT modiffs = CHARS_MODIFF; - Lisp_Object ppss = call1 (Qsyntax_ppss, make_number (pos)); + Lisp_Object ppss = call1 (Qsyntax_ppss, make_fixnum (pos)); if (modiffs != CHARS_MODIFF) error ("syntax-ppss modified the buffer!"); TEMP_SET_PT_BOTH (opoint, opoint_byte); - Lisp_Object boc = Fnth (make_number (8), ppss); - if (NUMBERP (boc)) + Lisp_Object boc = Fnth (make_fixnum (8), ppss); + if (FIXED_OR_FLOATP (boc)) { find_start_value = XINT (boc); find_start_value_byte = CHAR_TO_BYTE (find_start_value); @@ -1120,7 +1120,7 @@ this is probably the wrong function to use, because it can't take CHECK_CHARACTER (character); char_int = XINT (character); SETUP_BUFFER_SYNTAX_TABLE (); - return make_number (syntax_code_spec[SYNTAX (char_int)]); + return make_fixnum (syntax_code_spec[SYNTAX (char_int)]); } DEFUN ("matching-paren", Fmatching_paren, Smatching_paren, 1, 1, 0, @@ -1212,7 +1212,7 @@ the value of a `syntax-table' text property. */) return AREF (Vsyntax_code_object, val); else /* Since we can't use a shared object, let's make a new one. */ - return Fcons (make_number (val), match); + return Fcons (make_fixnum (val), match); } /* I really don't know why this is interactive @@ -1319,7 +1319,7 @@ DEFUN ("internal-describe-syntax-value", Finternal_describe_syntax_value, first = XCAR (value); match_lisp = XCDR (value); - if (!INTEGERP (first) || !(NILP (match_lisp) || CHARACTERP (match_lisp))) + if (!FIXNUMP (first) || !(NILP (match_lisp) || CHARACTERP (match_lisp))) { insert_string ("invalid"); return syntax; @@ -1480,8 +1480,8 @@ scan_words (ptrdiff_t from, EMACS_INT count) func = CHAR_TABLE_REF (Vfind_word_boundary_function_table, ch0); if (! NILP (Ffboundp (func))) { - pos = call2 (func, make_number (from - 1), make_number (end)); - if (INTEGERP (pos) && from < XINT (pos) && XINT (pos) <= ZV) + pos = call2 (func, make_fixnum (from - 1), make_fixnum (end)); + if (FIXNUMP (pos) && from < XINT (pos) && XINT (pos) <= ZV) { from = XINT (pos); from_byte = CHAR_TO_BYTE (from); @@ -1529,8 +1529,8 @@ scan_words (ptrdiff_t from, EMACS_INT count) func = CHAR_TABLE_REF (Vfind_word_boundary_function_table, ch1); if (! NILP (Ffboundp (func))) { - pos = call2 (func, make_number (from), make_number (beg)); - if (INTEGERP (pos) && BEGV <= XINT (pos) && XINT (pos) < from) + pos = call2 (func, make_fixnum (from), make_fixnum (beg)); + if (FIXNUMP (pos) && BEGV <= XINT (pos) && XINT (pos) < from) { from = XINT (pos); from_byte = CHAR_TO_BYTE (from); @@ -1586,14 +1586,14 @@ instead. See Info node `(elisp) Word Motion' for details. */) if (NILP (arg)) XSETFASTINT (arg, 1); else - CHECK_NUMBER (arg); + CHECK_FIXNUM (arg); val = orig_val = scan_words (PT, XINT (arg)); if (! orig_val) val = XINT (arg) > 0 ? ZV : BEGV; /* Avoid jumping out of an input field. */ - tmp = Fconstrain_to_field (make_number (val), make_number (PT), + tmp = Fconstrain_to_field (make_fixnum (val), make_fixnum (PT), Qnil, Qnil, Qnil); val = XFASTINT (tmp); @@ -1676,7 +1676,7 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, if (NILP (lim)) XSETINT (lim, forwardp ? ZV : BEGV); else - CHECK_NUMBER_COERCE_MARKER (lim); + CHECK_FIXNUM_COERCE_MARKER (lim); /* In any case, don't allow scan outside bounds of buffer. */ if (XINT (lim) > ZV) @@ -1721,7 +1721,7 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, error ("Invalid ISO C character class"); if (cc != -1) { - iso_classes = Fcons (make_number (cc), iso_classes); + iso_classes = Fcons (make_fixnum (cc), iso_classes); i_byte = ch - str; continue; } @@ -1817,7 +1817,7 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, error ("Invalid ISO C character class"); if (cc != -1) { - iso_classes = Fcons (make_number (cc), iso_classes); + iso_classes = Fcons (make_fixnum (cc), iso_classes); i_byte = ch - str; continue; } @@ -2094,7 +2094,7 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, SET_PT_BOTH (pos, pos_byte); SAFE_FREE (); - return make_number (PT - start_point); + return make_fixnum (PT - start_point); } } @@ -2115,7 +2115,7 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim) if (NILP (lim)) XSETINT (lim, forwardp ? ZV : BEGV); else - CHECK_NUMBER_COERCE_MARKER (lim); + CHECK_FIXNUM_COERCE_MARKER (lim); /* In any case, don't allow scan outside bounds of buffer. */ if (XINT (lim) > ZV) @@ -2124,7 +2124,7 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim) XSETFASTINT (lim, BEGV); if (forwardp ? (PT >= XFASTINT (lim)) : (PT <= XFASTINT (lim))) - return make_number (0); + return make_fixnum (0); multibyte = (!NILP (BVAR (current_buffer, enable_multibyte_characters)) && (XINT (lim) - PT != CHAR_TO_BYTE (XINT (lim)) - PT_BYTE)); @@ -2256,7 +2256,7 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim) done: SET_PT_BOTH (pos, pos_byte); - return make_number (PT - start_point); + return make_fixnum (PT - start_point); } } @@ -2442,7 +2442,7 @@ between them, return t; otherwise return nil. */) int dummy2; unsigned short int quit_count = 0; - CHECK_NUMBER (count); + CHECK_FIXNUM (count); count1 = XINT (count); stop = count1 > 0 ? ZV : BEGV; @@ -2793,7 +2793,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) if (depth < min_depth) xsignal3 (Qscan_error, build_string ("Containing expression ends prematurely"), - make_number (last_good), make_number (from)); + make_fixnum (last_good), make_fixnum (from)); break; case Sstring: @@ -2949,7 +2949,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) if (depth < min_depth) xsignal3 (Qscan_error, build_string ("Containing expression ends prematurely"), - make_number (last_good), make_number (from)); + make_fixnum (last_good), make_fixnum (from)); break; case Sendcomment: @@ -3029,7 +3029,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) lose: xsignal3 (Qscan_error, build_string ("Unbalanced parentheses"), - make_number (last_good), make_number (from)); + make_fixnum (last_good), make_fixnum (from)); } DEFUN ("scan-lists", Fscan_lists, Sscan_lists, 3, 3, 0, @@ -3053,9 +3053,9 @@ before we have scanned over COUNT lists, return nil if the depth at that point is zero, and signal an error if the depth is nonzero. */) (Lisp_Object from, Lisp_Object count, Lisp_Object depth) { - CHECK_NUMBER (from); - CHECK_NUMBER (count); - CHECK_NUMBER (depth); + CHECK_FIXNUM (from); + CHECK_FIXNUM (count); + CHECK_FIXNUM (depth); return scan_lists (XINT (from), XINT (count), XINT (depth), 0); } @@ -3073,8 +3073,8 @@ If the beginning or end is reached between groupings but before count is used up, nil is returned. */) (Lisp_Object from, Lisp_Object count) { - CHECK_NUMBER (from); - CHECK_NUMBER (count); + CHECK_FIXNUM (from); + CHECK_FIXNUM (count); return scan_lists (XINT (from), XINT (count), 0, 1); } @@ -3216,7 +3216,7 @@ do { prev_from = from; \ while (!NILP (tem)) /* >= second enclosing sexps. */ { Lisp_Object temhd = Fcar (tem); - if (RANGED_INTEGERP (PTRDIFF_MIN, temhd, PTRDIFF_MAX)) + if (RANGED_FIXNUMP (PTRDIFF_MIN, temhd, PTRDIFF_MAX)) curlevel->last = XINT (temhd); if (++curlevel == endlevel) curlevel--; /* error ("Nesting too deep for parser"); */ @@ -3462,7 +3462,7 @@ do { prev_from = from; \ state->location_byte = from_byte; state->levelstarts = Qnil; while (curlevel > levelstart) - state->levelstarts = Fcons (make_number ((--curlevel)->last), + state->levelstarts = Fcons (make_fixnum ((--curlevel)->last), state->levelstarts); state->prev_syntax = (SYNTAX_FLAGS_COMSTARTEND_FIRST (prev_from_syntax) || state->quoted) ? prev_from_syntax : Smax; @@ -3506,7 +3506,7 @@ internalize_parse_state (Lisp_Object external, struct lisp_parse_state *state) external = Fcdr (external); tem = Fcar (external); state->incomment = (!NILP (tem) - ? (INTEGERP (tem) ? XINT (tem) : -1) + ? (FIXNUMP (tem) ? XINT (tem) : -1) : 0); external = Fcdr (external); @@ -3520,14 +3520,14 @@ internalize_parse_state (Lisp_Object external, struct lisp_parse_state *state) tem = Fcar (external); state->comstyle = (NILP (tem) ? 0 - : (RANGED_INTEGERP (0, tem, ST_COMMENT_STYLE) + : (RANGED_FIXNUMP (0, tem, ST_COMMENT_STYLE) ? XINT (tem) : ST_COMMENT_STYLE)); external = Fcdr (external); tem = Fcar (external); state->comstr_start = - RANGED_INTEGERP (PTRDIFF_MIN, tem, PTRDIFF_MAX) ? XINT (tem) : -1; + RANGED_FIXNUMP (PTRDIFF_MIN, tem, PTRDIFF_MAX) ? XINT (tem) : -1; external = Fcdr (external); tem = Fcar (external); state->levelstarts = tem; @@ -3583,7 +3583,7 @@ Sixth arg COMMENTSTOP non-nil means stop after the start of a comment. if (!NILP (targetdepth)) { - CHECK_NUMBER (targetdepth); + CHECK_FIXNUM (targetdepth); target = XINT (targetdepth); } else @@ -3600,32 +3600,32 @@ Sixth arg COMMENTSTOP non-nil means stop after the start of a comment. SET_PT_BOTH (state.location, state.location_byte); return - Fcons (make_number (state.depth), + Fcons (make_fixnum (state.depth), Fcons (state.prevlevelstart < 0 - ? Qnil : make_number (state.prevlevelstart), + ? Qnil : make_fixnum (state.prevlevelstart), Fcons (state.thislevelstart < 0 - ? Qnil : make_number (state.thislevelstart), + ? Qnil : make_fixnum (state.thislevelstart), Fcons (state.instring >= 0 ? (state.instring == ST_STRING_STYLE - ? Qt : make_number (state.instring)) : Qnil, + ? Qt : make_fixnum (state.instring)) : Qnil, Fcons (state.incomment < 0 ? Qt : (state.incomment == 0 ? Qnil : - make_number (state.incomment)), + make_fixnum (state.incomment)), Fcons (state.quoted ? Qt : Qnil, - Fcons (make_number (state.mindepth), + Fcons (make_fixnum (state.mindepth), Fcons ((state.comstyle ? (state.comstyle == ST_COMMENT_STYLE ? Qsyntax_table - : make_number (state.comstyle)) + : make_fixnum (state.comstyle)) : Qnil), Fcons (((state.incomment || (state.instring >= 0)) - ? make_number (state.comstr_start) + ? make_fixnum (state.comstr_start) : Qnil), Fcons (state.levelstarts, Fcons (state.prev_syntax == Smax ? Qnil - : make_number (state.prev_syntax), + : make_fixnum (state.prev_syntax), Qnil))))))))))); } @@ -3641,11 +3641,11 @@ init_syntax_once (void) /* Create objects which can be shared among syntax tables. */ Vsyntax_code_object = make_uninit_vector (Smax); for (i = 0; i < Smax; i++) - ASET (Vsyntax_code_object, i, Fcons (make_number (i), Qnil)); + ASET (Vsyntax_code_object, i, Fcons (make_fixnum (i), Qnil)); /* Now we are ready to set up this property, so we can create syntax tables. */ - Fput (Qsyntax_table, Qchar_table_extra_slots, make_number (0)); + Fput (Qsyntax_table, Qchar_table_extra_slots, make_fixnum (0)); temp = AREF (Vsyntax_code_object, Swhitespace); @@ -3677,21 +3677,21 @@ init_syntax_once (void) SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '%', temp); SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '(', - Fcons (make_number (Sopen), make_number (')'))); + Fcons (make_fixnum (Sopen), make_fixnum (')'))); SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, ')', - Fcons (make_number (Sclose), make_number ('('))); + Fcons (make_fixnum (Sclose), make_fixnum ('('))); SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '[', - Fcons (make_number (Sopen), make_number (']'))); + Fcons (make_fixnum (Sopen), make_fixnum (']'))); SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, ']', - Fcons (make_number (Sclose), make_number ('['))); + Fcons (make_fixnum (Sclose), make_fixnum ('['))); SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '{', - Fcons (make_number (Sopen), make_number ('}'))); + Fcons (make_fixnum (Sopen), make_fixnum ('}'))); SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '}', - Fcons (make_number (Sclose), make_number ('{'))); + Fcons (make_fixnum (Sclose), make_fixnum ('{'))); SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '"', - Fcons (make_number (Sstring), Qnil)); + Fcons (make_fixnum (Sstring), Qnil)); SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '\\', - Fcons (make_number (Sescape), Qnil)); + Fcons (make_fixnum (Sescape), Qnil)); temp = AREF (Vsyntax_code_object, Ssymbol); for (i = 0; i < 10; i++) diff --git a/src/sysdep.c b/src/sysdep.c index 231b11614f..3bc7adcc89 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -2850,7 +2850,7 @@ serial_configure (struct Lisp_Process *p, tem = Fplist_get (contact, QCspeed); else tem = Fplist_get (p->childp, QCspeed); - CHECK_NUMBER (tem); + CHECK_FIXNUM (tem); err = cfsetspeed (&attr, XINT (tem)); if (err != 0) report_file_error ("Failed cfsetspeed", tem); @@ -2862,8 +2862,8 @@ serial_configure (struct Lisp_Process *p, else tem = Fplist_get (p->childp, QCbytesize); if (NILP (tem)) - tem = make_number (8); - CHECK_NUMBER (tem); + tem = make_fixnum (8); + CHECK_FIXNUM (tem); if (XINT (tem) != 7 && XINT (tem) != 8) error (":bytesize must be nil (8), 7, or 8"); summary[0] = XINT (tem) + '0'; @@ -2916,8 +2916,8 @@ serial_configure (struct Lisp_Process *p, else tem = Fplist_get (p->childp, QCstopbits); if (NILP (tem)) - tem = make_number (1); - CHECK_NUMBER (tem); + tem = make_fixnum (1); + CHECK_FIXNUM (tem); if (XINT (tem) != 1 && XINT (tem) != 2) error (":stopbits must be nil (1 stopbit), 1, or 2"); summary[2] = XINT (tem) + '0'; @@ -3261,7 +3261,7 @@ system_process_attributes (Lisp_Object pid) Lisp_Object decoded_cmd; ptrdiff_t count; - CHECK_NUMBER_OR_FLOAT (pid); + CHECK_FIXNUM_OR_FLOAT (pid); CONS_TO_INTEGER (pid, pid_t, proc_id); sprintf (procfn, "/proc/%"pMd, proc_id); if (stat (procfn, &st) < 0) @@ -3369,8 +3369,8 @@ system_process_attributes (Lisp_Object pid) ltime_from_jiffies (cstime + cutime, clocks_per_sec)), attrs); - attrs = Fcons (Fcons (Qpri, make_number (priority)), attrs); - attrs = Fcons (Fcons (Qnice, make_number (niceness)), attrs); + attrs = Fcons (Fcons (Qpri, make_fixnum (priority)), attrs); + attrs = Fcons (Fcons (Qnice, make_fixnum (niceness)), attrs); attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (thcount)), attrs); tnow = current_timespec (); @@ -3495,7 +3495,7 @@ system_process_attributes (Lisp_Object pid) Lisp_Object decoded_cmd; ptrdiff_t count; - CHECK_NUMBER_OR_FLOAT (pid); + CHECK_FIXNUM_OR_FLOAT (pid); CONS_TO_INTEGER (pid, pid_t, proc_id); sprintf (procfn, "/proc/%"pMd, proc_id); if (stat (procfn, &st) < 0) @@ -3563,8 +3563,8 @@ system_process_attributes (Lisp_Object pid) attrs = Fcons (Fcons (Qtime, make_lisp_time (pinfo.pr_time)), attrs); attrs = Fcons (Fcons (Qctime, make_lisp_time (pinfo.pr_ctime)), attrs); - attrs = Fcons (Fcons (Qpri, make_number (pinfo.pr_lwp.pr_pri)), attrs); - attrs = Fcons (Fcons (Qnice, make_number (pinfo.pr_lwp.pr_nice)), attrs); + attrs = Fcons (Fcons (Qpri, make_fixnum (pinfo.pr_lwp.pr_pri)), attrs); + attrs = Fcons (Fcons (Qnice, make_fixnum (pinfo.pr_lwp.pr_nice)), attrs); attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (pinfo.pr_nlwp)), attrs); @@ -3630,7 +3630,7 @@ system_process_attributes (Lisp_Object pid) Lisp_Object attrs = Qnil; Lisp_Object decoded_comm; - CHECK_NUMBER_OR_FLOAT (pid); + CHECK_FIXNUM_OR_FLOAT (pid); CONS_TO_INTEGER (pid, int, proc_id); mib[3] = proc_id; @@ -3697,8 +3697,8 @@ system_process_attributes (Lisp_Object pid) attrs = Fcons (Fcons (Qtpgid, make_fixnum_or_float (proc.ki_tpgid)), attrs); attrs = Fcons (Fcons (Qminflt, make_fixnum_or_float (proc.ki_rusage.ru_minflt)), attrs); attrs = Fcons (Fcons (Qmajflt, make_fixnum_or_float (proc.ki_rusage.ru_majflt)), attrs); - attrs = Fcons (Fcons (Qcminflt, make_number (proc.ki_rusage_ch.ru_minflt)), attrs); - attrs = Fcons (Fcons (Qcmajflt, make_number (proc.ki_rusage_ch.ru_majflt)), attrs); + attrs = Fcons (Fcons (Qcminflt, make_fixnum (proc.ki_rusage_ch.ru_minflt)), attrs); + attrs = Fcons (Fcons (Qcmajflt, make_fixnum (proc.ki_rusage_ch.ru_majflt)), attrs); attrs = Fcons (Fcons (Qutime, make_lisp_timeval (proc.ki_rusage.ru_utime)), attrs); @@ -3720,11 +3720,11 @@ system_process_attributes (Lisp_Object pid) attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (proc.ki_numthreads)), attrs); - attrs = Fcons (Fcons (Qpri, make_number (proc.ki_pri.pri_native)), attrs); - attrs = Fcons (Fcons (Qnice, make_number (proc.ki_nice)), attrs); + attrs = Fcons (Fcons (Qpri, make_fixnum (proc.ki_pri.pri_native)), attrs); + attrs = Fcons (Fcons (Qnice, make_fixnum (proc.ki_nice)), attrs); attrs = Fcons (Fcons (Qstart, make_lisp_timeval (proc.ki_start)), attrs); - attrs = Fcons (Fcons (Qvsize, make_number (proc.ki_size >> 10)), attrs); - attrs = Fcons (Fcons (Qrss, make_number (proc.ki_rssize * pagesize >> 10)), + attrs = Fcons (Fcons (Qvsize, make_fixnum (proc.ki_size >> 10)), attrs); + attrs = Fcons (Fcons (Qrss, make_fixnum (proc.ki_rssize * pagesize >> 10)), attrs); now = current_timespec (); @@ -3810,7 +3810,7 @@ system_process_attributes (Lisp_Object pid) Lisp_Object attrs = Qnil; Lisp_Object decoded_comm; - CHECK_NUMBER_OR_FLOAT (pid); + CHECK_FIXNUM_OR_FLOAT (pid); CONS_TO_INTEGER (pid, int, proc_id); mib[3] = proc_id; @@ -3900,7 +3900,7 @@ system_process_attributes (Lisp_Object pid) } starttime = proc.kp_proc.p_starttime; - attrs = Fcons (Fcons (Qnice, make_number (proc.kp_proc.p_nice)), attrs); + attrs = Fcons (Fcons (Qnice, make_fixnum (proc.kp_proc.p_nice)), attrs); attrs = Fcons (Fcons (Qstart, make_lisp_timeval (starttime)), attrs); now = current_timespec (); diff --git a/src/term.c b/src/term.c index f5fca7f987..026ead3f9a 100644 --- a/src/term.c +++ b/src/term.c @@ -1359,7 +1359,7 @@ term_get_fkeys_1 (void) char *sequence = tgetstr (keys[i].cap, address); if (sequence) Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (sequence), - Fmake_vector (make_number (1), + Fmake_vector (make_fixnum (1), intern (keys[i].name))); } @@ -1379,13 +1379,13 @@ term_get_fkeys_1 (void) /* Define f0 first, so that f10 takes precedence in case the key sequences happens to be the same. */ Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (k0), - Fmake_vector (make_number (1), intern ("f0"))); + Fmake_vector (make_fixnum (1), intern ("f0"))); Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (k_semi), - Fmake_vector (make_number (1), intern ("f10"))); + Fmake_vector (make_fixnum (1), intern ("f10"))); } else if (k0) Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (k0), - Fmake_vector (make_number (1), intern (k0_name))); + Fmake_vector (make_fixnum (1), intern (k0_name))); } /* Set up cookies for numbered function keys above f10. */ @@ -1408,7 +1408,7 @@ term_get_fkeys_1 (void) { sprintf (fkey, "f%d", i); Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (sequence), - Fmake_vector (make_number (1), + Fmake_vector (make_fixnum (1), intern (fkey))); } } @@ -1425,7 +1425,7 @@ term_get_fkeys_1 (void) char *sequence = tgetstr (cap2, address); \ if (sequence) \ Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (sequence), \ - Fmake_vector (make_number (1), \ + Fmake_vector (make_fixnum (1), \ intern (sym))); \ } @@ -2050,7 +2050,7 @@ TERMINAL does not refer to a text terminal. */) { struct terminal *t = decode_tty_terminal (terminal); - return make_number (t ? t->display_info.tty->TN_max_colors : 0); + return make_fixnum (t ? t->display_info.tty->TN_max_colors : 0); } #ifndef DOS_NT @@ -2137,7 +2137,7 @@ set_tty_color_mode (struct tty_display_info *tty, struct frame *f) tem = assq_no_quit (Qtty_color_mode, f->param_alist); val = CONSP (tem) ? XCDR (tem) : Qnil; - if (INTEGERP (val)) + if (FIXNUMP (val)) color_mode = val; else if (SYMBOLP (tty_color_mode_alist)) { @@ -2147,7 +2147,7 @@ set_tty_color_mode (struct tty_display_info *tty, struct frame *f) else color_mode = Qnil; - mode = TYPE_RANGED_INTEGERP (int, color_mode) ? XINT (color_mode) : 0; + mode = TYPE_RANGED_FIXNUMP (int, color_mode) ? XINT (color_mode) : 0; if (mode != tty->previous_color_mode) { @@ -3403,9 +3403,9 @@ tty_menu_help_callback (char const *help_string, int pane, int item) pane_name = first_item[MENU_ITEMS_ITEM_NAME]; /* (menu-item MENU-NAME PANE-NUMBER) */ - menu_object = list3 (Qmenu_item, pane_name, make_number (pane)); + menu_object = list3 (Qmenu_item, pane_name, make_fixnum (pane)); show_help_echo (help_string ? build_string (help_string) : Qnil, - Qnil, menu_object, make_number (item)); + Qnil, menu_object, make_fixnum (item)); } struct tty_pop_down_menu @@ -3754,7 +3754,7 @@ tty_menu_show (struct frame *f, int x, int y, int menuflags, case TTYM_NEXT: case TTYM_PREV: tty_menu_new_item_coords (f, status, &item_x, &item_y); - entry = Fcons (make_number (item_x), make_number (item_y)); + entry = Fcons (make_fixnum (item_x), make_fixnum (item_y)); break; case TTYM_FAILURE: diff --git a/src/terminal.c b/src/terminal.c index 070b8aac1f..76ac4ca200 100644 --- a/src/terminal.c +++ b/src/terminal.c @@ -551,10 +551,10 @@ calculate_glyph_code_table (struct terminal *t) struct unimapdesc unimapdesc = { entry_ct, entries }; if (ioctl (fd, GIO_UNIMAP, &unimapdesc) == 0) { - glyphtab = Fmake_char_table (Qnil, make_number (-1)); + glyphtab = Fmake_char_table (Qnil, make_fixnum (-1)); for (int i = 0; i < unimapdesc.entry_ct; i++) char_table_set (glyphtab, entries[i].unicode, - make_number (entries[i].fontpos)); + make_fixnum (entries[i].fontpos)); break; } if (errno != ENOMEM) diff --git a/src/textprop.c b/src/textprop.c index f7e69f30ea..3f636a125a 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -137,8 +137,8 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin, ptrdiff_t searchpos; CHECK_STRING_OR_BUFFER (object); - CHECK_NUMBER_COERCE_MARKER (*begin); - CHECK_NUMBER_COERCE_MARKER (*end); + CHECK_FIXNUM_COERCE_MARKER (*begin); + CHECK_FIXNUM_COERCE_MARKER (*end); /* If we are asked for a point, but from a subr which operates on a range, then return nothing. */ @@ -544,7 +544,7 @@ interval_of (ptrdiff_t position, Lisp_Object object) } if (!(beg <= position && position <= end)) - args_out_of_range (make_number (position), make_number (position)); + args_out_of_range (make_fixnum (position), make_fixnum (position)); if (beg == end || !i) return NULL; @@ -604,7 +604,7 @@ get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop, { struct window *w = 0; - CHECK_NUMBER_COERCE_MARKER (position); + CHECK_FIXNUM_COERCE_MARKER (position); if (NILP (object)) XSETBUFFER (object, current_buffer); @@ -714,7 +714,7 @@ before LIMIT. LIMIT is a no-op if it is greater than (point-max). */) temp = Fnext_overlay_change (position); if (! NILP (limit)) { - CHECK_NUMBER_COERCE_MARKER (limit); + CHECK_FIXNUM_COERCE_MARKER (limit); if (XINT (limit) < XINT (temp)) temp = limit; } @@ -740,7 +740,7 @@ before LIMIT. LIMIT is a no-op if it is less than (point-min). */) temp = Fprevious_overlay_change (position); if (! NILP (limit)) { - CHECK_NUMBER_COERCE_MARKER (limit); + CHECK_FIXNUM_COERCE_MARKER (limit); if (XINT (limit) > XINT (temp)) temp = limit; } @@ -774,10 +774,10 @@ last valid position in OBJECT. */) if (NILP (position)) { if (NILP (limit)) - position = make_number (SCHARS (object)); + position = make_fixnum (SCHARS (object)); else { - CHECK_NUMBER (limit); + CHECK_FIXNUM (limit); position = limit; } } @@ -796,14 +796,14 @@ last valid position in OBJECT. */) Fset_buffer (object); } - CHECK_NUMBER_COERCE_MARKER (position); + CHECK_FIXNUM_COERCE_MARKER (position); initial_value = Fget_char_property (position, prop, object); if (NILP (limit)) XSETFASTINT (limit, ZV); else - CHECK_NUMBER_COERCE_MARKER (limit); + CHECK_FIXNUM_COERCE_MARKER (limit); if (XFASTINT (position) >= XFASTINT (limit)) { @@ -859,10 +859,10 @@ first valid position in OBJECT. */) if (NILP (position)) { if (NILP (limit)) - position = make_number (0); + position = make_fixnum (0); else { - CHECK_NUMBER (limit); + CHECK_FIXNUM (limit); position = limit; } } @@ -880,12 +880,12 @@ first valid position in OBJECT. */) Fset_buffer (object); } - CHECK_NUMBER_COERCE_MARKER (position); + CHECK_FIXNUM_COERCE_MARKER (position); if (NILP (limit)) XSETFASTINT (limit, BEGV); else - CHECK_NUMBER_COERCE_MARKER (limit); + CHECK_FIXNUM_COERCE_MARKER (limit); if (XFASTINT (position) <= XFASTINT (limit)) { @@ -896,7 +896,7 @@ first valid position in OBJECT. */) else { Lisp_Object initial_value - = Fget_char_property (make_number (XFASTINT (position) - 1), + = Fget_char_property (make_fixnum (XFASTINT (position) - 1), prop, object); while (true) @@ -911,7 +911,7 @@ first valid position in OBJECT. */) else { Lisp_Object value - = Fget_char_property (make_number (XFASTINT (position) - 1), + = Fget_char_property (make_fixnum (XFASTINT (position) - 1), prop, object); if (!EQ (value, initial_value)) @@ -948,7 +948,7 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT. */) XSETBUFFER (object, current_buffer); if (!NILP (limit) && !EQ (limit, Qt)) - CHECK_NUMBER_COERCE_MARKER (limit); + CHECK_FIXNUM_COERCE_MARKER (limit); i = validate_interval_range (object, &position, &position, soft); @@ -981,14 +981,14 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT. */) if (!next || (next->position - >= (INTEGERP (limit) + >= (FIXNUMP (limit) ? XFASTINT (limit) : (STRINGP (object) ? SCHARS (object) : BUF_ZV (XBUFFER (object)))))) return limit; else - return make_number (next->position); + return make_fixnum (next->position); } DEFUN ("next-single-property-change", Fnext_single_property_change, @@ -1015,7 +1015,7 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT. */) XSETBUFFER (object, current_buffer); if (!NILP (limit)) - CHECK_NUMBER_COERCE_MARKER (limit); + CHECK_FIXNUM_COERCE_MARKER (limit); i = validate_interval_range (object, &position, &position, soft); if (!i) @@ -1030,14 +1030,14 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT. */) if (!next || (next->position - >= (INTEGERP (limit) + >= (FIXNUMP (limit) ? XFASTINT (limit) : (STRINGP (object) ? SCHARS (object) : BUF_ZV (XBUFFER (object)))))) return limit; else - return make_number (next->position); + return make_fixnum (next->position); } DEFUN ("previous-property-change", Fprevious_property_change, @@ -1062,7 +1062,7 @@ back past position LIMIT; return LIMIT if nothing is found until LIMIT. */) XSETBUFFER (object, current_buffer); if (!NILP (limit)) - CHECK_NUMBER_COERCE_MARKER (limit); + CHECK_FIXNUM_COERCE_MARKER (limit); i = validate_interval_range (object, &position, &position, soft); if (!i) @@ -1080,12 +1080,12 @@ back past position LIMIT; return LIMIT if nothing is found until LIMIT. */) if (!previous || (previous->position + LENGTH (previous) - <= (INTEGERP (limit) + <= (FIXNUMP (limit) ? XFASTINT (limit) : (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object)))))) return limit; else - return make_number (previous->position + LENGTH (previous)); + return make_fixnum (previous->position + LENGTH (previous)); } DEFUN ("previous-single-property-change", Fprevious_single_property_change, @@ -1112,7 +1112,7 @@ back past position LIMIT; return LIMIT if nothing is found until LIMIT. */) XSETBUFFER (object, current_buffer); if (!NILP (limit)) - CHECK_NUMBER_COERCE_MARKER (limit); + CHECK_FIXNUM_COERCE_MARKER (limit); i = validate_interval_range (object, &position, &position, soft); @@ -1133,12 +1133,12 @@ back past position LIMIT; return LIMIT if nothing is found until LIMIT. */) if (!previous || (previous->position + LENGTH (previous) - <= (INTEGERP (limit) + <= (FIXNUMP (limit) ? XFASTINT (limit) : (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object)))))) return limit; else - return make_number (previous->position + LENGTH (previous)); + return make_fixnum (previous->position + LENGTH (previous)); } /* Used by add-text-properties and add-face-text-property. */ @@ -1757,7 +1757,7 @@ markers). If OBJECT is a string, START and END are 0-based indices into it. */ pos = i->position; if (pos < XINT (start)) pos = XINT (start); - return make_number (pos); + return make_fixnum (pos); } i = next_interval (i); } @@ -1793,7 +1793,7 @@ markers). If OBJECT is a string, START and END are 0-based indices into it. */ { if (i->position > s) s = i->position; - return make_number (s); + return make_fixnum (s); } i = next_interval (i); } @@ -1811,7 +1811,7 @@ int text_property_stickiness (Lisp_Object prop, Lisp_Object pos, Lisp_Object buffer) { bool ignore_previous_character; - Lisp_Object prev_pos = make_number (XINT (pos) - 1); + Lisp_Object prev_pos = make_fixnum (XINT (pos) - 1); Lisp_Object front_sticky; bool is_rear_sticky = true, is_front_sticky = false; /* defaults */ Lisp_Object defalt = Fassq (prop, Vtext_property_default_nonsticky); @@ -1891,7 +1891,7 @@ copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src, if (!i) return Qnil; - CHECK_NUMBER_COERCE_MARKER (pos); + CHECK_FIXNUM_COERCE_MARKER (pos); { Lisp_Object dest_start, dest_end; @@ -1932,7 +1932,7 @@ copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src, if (! NILP (plist)) /* Must defer modifications to the interval tree in case src and dest refer to the same string or buffer. */ - stuff = Fcons (list3 (make_number (p), make_number (p + len), plist), + stuff = Fcons (list3 (make_fixnum (p), make_fixnum (p + len), plist), stuff); i = next_interval (i); @@ -1999,7 +1999,7 @@ text_property_list (Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp } if (!NILP (plist)) - result = Fcons (list3 (make_number (s), make_number (s + len), + result = Fcons (list3 (make_fixnum (s), make_fixnum (s + len), plist), result); @@ -2027,8 +2027,8 @@ add_text_properties_from_list (Lisp_Object object, Lisp_Object list, Lisp_Object Lisp_Object item, start, end, plist; item = XCAR (list); - start = make_number (XINT (XCAR (item)) + XINT (delta)); - end = make_number (XINT (XCAR (XCDR (item))) + XINT (delta)); + start = make_fixnum (XINT (XCAR (item)) + XINT (delta)); + end = make_fixnum (XINT (XCAR (XCDR (item))) + XINT (delta)); plist = XCAR (XCDR (XCDR (item))); Fadd_text_properties (start, end, plist, object); @@ -2271,8 +2271,8 @@ verify_interval_modification (struct buffer *buf, hooks = Fnreverse (hooks); while (! EQ (hooks, Qnil)) { - call_mod_hooks (Fcar (hooks), make_number (start), - make_number (end)); + call_mod_hooks (Fcar (hooks), make_fixnum (start), + make_fixnum (end)); hooks = Fcdr (hooks); } } diff --git a/src/undo.c b/src/undo.c index c34faa4272..7d2402fda3 100644 --- a/src/undo.c +++ b/src/undo.c @@ -74,7 +74,7 @@ record_point (ptrdiff_t beg) && point_before_last_command_or_undo != beg && buffer_before_last_command_or_undo == current_buffer ) bset_undo_list (current_buffer, - Fcons (make_number (point_before_last_command_or_undo), + Fcons (make_fixnum (point_before_last_command_or_undo), BVAR (current_buffer, undo_list))); } @@ -102,11 +102,11 @@ record_insert (ptrdiff_t beg, ptrdiff_t length) Lisp_Object elt; elt = XCAR (BVAR (current_buffer, undo_list)); if (CONSP (elt) - && INTEGERP (XCAR (elt)) - && INTEGERP (XCDR (elt)) + && FIXNUMP (XCAR (elt)) + && FIXNUMP (XCDR (elt)) && XINT (XCDR (elt)) == beg) { - XSETCDR (elt, make_number (beg + length)); + XSETCDR (elt, make_fixnum (beg + length)); return; } } @@ -153,7 +153,7 @@ record_marker_adjustments (ptrdiff_t from, ptrdiff_t to) XSETMISC (marker, m); bset_undo_list (current_buffer, - Fcons (Fcons (marker, make_number (adjustment)), + Fcons (Fcons (marker, make_fixnum (adjustment)), BVAR (current_buffer, undo_list))); } } @@ -352,14 +352,14 @@ truncate_undo_list (struct buffer *b) /* If by the first boundary we have already passed undo_outer_limit, we're heading for memory full, so offer to clear out the list. */ - if (INTEGERP (Vundo_outer_limit) + if (FIXNUMP (Vundo_outer_limit) && size_so_far > XINT (Vundo_outer_limit) && !NILP (Vundo_outer_limit_function)) { Lisp_Object tem; /* Normally the function this calls is undo-outer-limit-truncate. */ - tem = call1 (Vundo_outer_limit_function, make_number (size_so_far)); + tem = call1 (Vundo_outer_limit_function, make_fixnum (size_so_far)); if (! NILP (tem)) { /* The function is responsible for making @@ -472,7 +472,7 @@ In fact, this calls the function which is the value of `undo-outer-limit-function' with one argument, the size. The text above describes the behavior of the function that variable usually specifies. */); - Vundo_outer_limit = make_number (12000000); + Vundo_outer_limit = make_fixnum (12000000); DEFVAR_LISP ("undo-outer-limit-function", Vundo_outer_limit_function, doc: /* Function to call when an undo list exceeds `undo-outer-limit'. diff --git a/src/w16select.c b/src/w16select.c index 5a80d1cba6..a5f0757867 100644 --- a/src/w16select.c +++ b/src/w16select.c @@ -536,7 +536,7 @@ DEFUN ("w16-set-clipboard-data", Fw16_set_clipboard_data, Sw16_set_clipboard_dat message3 (make_unibyte_string (system_error_msg, sizeof (system_error_msg) - 1)); break; } - sit_for (make_number (2), 0, 2); + sit_for (make_fixnum (2), 0, 2); } done: diff --git a/src/w32.c b/src/w32.c index c848b33b2a..6eb6b0bbee 100644 --- a/src/w32.c +++ b/src/w32.c @@ -7042,7 +7042,7 @@ system_process_attributes (Lisp_Object pid) double pcpu; BOOL result = FALSE; - CHECK_NUMBER_OR_FLOAT (pid); + CHECK_FIXNUM_OR_FLOAT (pid); proc_id = FLOATP (pid) ? XFLOAT_DATA (pid) : XINT (pid); h_snapshot = create_toolhelp32_snapshot (TH32CS_SNAPPROCESS, 0); @@ -7074,7 +7074,7 @@ system_process_attributes (Lisp_Object pid) attrs = Fcons (Fcons (Qppid, make_fixnum_or_float (pe.th32ParentProcessID)), attrs); - attrs = Fcons (Fcons (Qpri, make_number (pe.pcPriClassBase)), + attrs = Fcons (Fcons (Qpri, make_fixnum (pe.pcPriClassBase)), attrs); attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (pe.cntThreads)), @@ -9214,7 +9214,7 @@ network_interface_get_info (Lisp_Object ifname) res); else if (strcmp (namebuf, SSDATA (ifname)) == 0) { - Lisp_Object hwaddr = Fmake_vector (make_number (6), Qnil); + Lisp_Object hwaddr = Fmake_vector (make_fixnum (6), Qnil); register struct Lisp_Vector *p = XVECTOR (hwaddr); Lisp_Object flags = Qnil; int n; @@ -9243,11 +9243,11 @@ network_interface_get_info (Lisp_Object ifname) /* Hardware address and its family. */ for (n = 0; n < adapter->AddressLength; n++) - p->contents[n] = make_number ((int) adapter->Address[n]); + p->contents[n] = make_fixnum ((int) adapter->Address[n]); /* Windows does not support AF_LINK or AF_PACKET family of addresses. Use an arbitrary family number that is identical to what GNU/Linux returns. */ - res = Fcons (Fcons (make_number (1), hwaddr), res); + res = Fcons (Fcons (make_fixnum (1), hwaddr), res); /* Network mask. */ sa.sin_family = AF_INET; @@ -9309,9 +9309,9 @@ network_interface_get_info (Lisp_Object ifname) Fcons (intern ("up"), Qnil))), Qnil); /* 772 is what 3 different GNU/Linux systems report for the loopback interface. */ - res = Fcons (Fcons (make_number (772), - Fmake_vector (make_number (6), - make_number (0))), + res = Fcons (Fcons (make_fixnum (772), + Fmake_vector (make_fixnum (6), + make_fixnum (0))), res); sa.sin_addr.s_addr = sys_inet_addr ("255.0.0.0"); res = Fcons (conv_sockaddr_to_lisp ((struct sockaddr *) &sa, @@ -9456,7 +9456,7 @@ w32_read_registry (HKEY rootkey, Lisp_Object lkey, Lisp_Object lname) val = make_uninit_vector (vsize); for (i = 0; i < vsize; i++) - ASET (val, i, make_number (dbuf[i])); + ASET (val, i, make_fixnum (dbuf[i])); retval = val; break; @@ -10106,7 +10106,7 @@ serial_configure (struct Lisp_Process *p, Lisp_Object contact) tem = Fplist_get (contact, QCspeed); else tem = Fplist_get (p->childp, QCspeed); - CHECK_NUMBER (tem); + CHECK_FIXNUM (tem); dcb.BaudRate = XINT (tem); childp2 = Fplist_put (childp2, QCspeed, tem); @@ -10116,8 +10116,8 @@ serial_configure (struct Lisp_Process *p, Lisp_Object contact) else tem = Fplist_get (p->childp, QCbytesize); if (NILP (tem)) - tem = make_number (8); - CHECK_NUMBER (tem); + tem = make_fixnum (8); + CHECK_FIXNUM (tem); if (XINT (tem) != 7 && XINT (tem) != 8) error (":bytesize must be nil (8), 7, or 8"); dcb.ByteSize = XINT (tem); @@ -10160,8 +10160,8 @@ serial_configure (struct Lisp_Process *p, Lisp_Object contact) else tem = Fplist_get (p->childp, QCstopbits); if (NILP (tem)) - tem = make_number (1); - CHECK_NUMBER (tem); + tem = make_fixnum (1); + CHECK_FIXNUM (tem); if (XINT (tem) != 1 && XINT (tem) != 2) error (":stopbits must be nil (1 stopbit), 1, or 2"); summary[2] = XINT (tem) + '0'; diff --git a/src/w32console.c b/src/w32console.c index 330aef5758..c322a8e699 100644 --- a/src/w32console.c +++ b/src/w32console.c @@ -493,7 +493,7 @@ w32con_set_terminal_modes (struct terminal *t) /* Initialize input mode: interrupt_input off, no flow control, allow 8 bit character input, standard quit char. */ - Fset_input_mode (Qnil, Qnil, make_number (2), Qnil); + Fset_input_mode (Qnil, Qnil, make_fixnum (2), Qnil); } /* hmmm... perhaps these let us bracket screen changes so that we can flush @@ -805,8 +805,8 @@ See w32console.el and `tty-defined-color-alist' for mapping of indices to colors. */) (void) { - return Fcons (make_number (char_attr_normal & 0x000f), - Fcons (make_number ((char_attr_normal >> 4) & 0x000f), Qnil)); + return Fcons (make_fixnum (char_attr_normal & 0x000f), + Fcons (make_fixnum ((char_attr_normal >> 4) & 0x000f), Qnil)); } DEFUN ("set-cursor-size", Fset_cursor_size, Sset_cursor_size, 1, 1, 0, diff --git a/src/w32cygwinx.c b/src/w32cygwinx.c index 8d3ae164cf..7bbb8be76c 100644 --- a/src/w32cygwinx.c +++ b/src/w32cygwinx.c @@ -121,14 +121,14 @@ The following %-sequences are provided: } status = listn (CONSTYPE_HEAP, 8, - Fcons (make_number ('L'), line_status), - Fcons (make_number ('B'), battery_status), - Fcons (make_number ('b'), battery_status_symbol), - Fcons (make_number ('p'), load_percentage), - Fcons (make_number ('s'), seconds), - Fcons (make_number ('m'), minutes), - Fcons (make_number ('h'), hours), - Fcons (make_number ('t'), remain)); + Fcons (make_fixnum ('L'), line_status), + Fcons (make_fixnum ('B'), battery_status), + Fcons (make_fixnum ('b'), battery_status_symbol), + Fcons (make_fixnum ('p'), load_percentage), + Fcons (make_fixnum ('s'), seconds), + Fcons (make_fixnum ('m'), minutes), + Fcons (make_fixnum ('h'), hours), + Fcons (make_fixnum ('t'), remain)); } return status; } diff --git a/src/w32fns.c b/src/w32fns.c index 760801cd1d..e8962b491f 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -457,9 +457,9 @@ if the entry is new. */) Lisp_Object oldrgb = Qnil; Lisp_Object entry; - CHECK_NUMBER (red); - CHECK_NUMBER (green); - CHECK_NUMBER (blue); + CHECK_FIXNUM (red); + CHECK_FIXNUM (green); + CHECK_FIXNUM (blue); CHECK_STRING (name); XSETINT (rgb, RGB (XUINT (red), XUINT (green), XUINT (blue))); @@ -748,7 +748,7 @@ w32_default_color_map (void) for (i = 0; i < ARRAYELTS (w32_color_map); pc++, i++) cmap = Fcons (Fcons (build_string (pc->name), - make_number (pc->colorref)), + make_fixnum (pc->colorref)), cmap); unblock_input (); @@ -828,7 +828,7 @@ add_system_logical_colors_to_map (Lisp_Object *system_colors) unsigned r, g, b; if (sscanf (color_buffer, " %u %u %u", &r, &g, &b) == 3) *system_colors = Fcons (Fcons (build_string (full_name_buffer), - make_number (RGB (r, g, b))), + make_fixnum (RGB (r, g, b))), *system_colors); name_size = sizeof (full_name_buffer) - SYSTEM_COLOR_PREFIX_LEN; @@ -1343,7 +1343,7 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) if (!EQ (Qnil, Vx_pointer_shape)) { - CHECK_NUMBER (Vx_pointer_shape); + CHECK_FIXNUM (Vx_pointer_shape); cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XINT (Vx_pointer_shape)); } else @@ -1352,7 +1352,7 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) if (!EQ (Qnil, Vx_nontext_pointer_shape)) { - CHECK_NUMBER (Vx_nontext_pointer_shape); + CHECK_FIXNUM (Vx_nontext_pointer_shape); nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XINT (Vx_nontext_pointer_shape)); } @@ -1362,7 +1362,7 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) if (!EQ (Qnil, Vx_hourglass_pointer_shape)) { - CHECK_NUMBER (Vx_hourglass_pointer_shape); + CHECK_FIXNUM (Vx_hourglass_pointer_shape); hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XINT (Vx_hourglass_pointer_shape)); } @@ -1373,7 +1373,7 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s"); if (!EQ (Qnil, Vx_mode_pointer_shape)) { - CHECK_NUMBER (Vx_mode_pointer_shape); + CHECK_FIXNUM (Vx_mode_pointer_shape); mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XINT (Vx_mode_pointer_shape)); } @@ -1383,7 +1383,7 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) if (!EQ (Qnil, Vx_sensitive_text_pointer_shape)) { - CHECK_NUMBER (Vx_sensitive_text_pointer_shape); + CHECK_FIXNUM (Vx_sensitive_text_pointer_shape); hand_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XINT (Vx_sensitive_text_pointer_shape)); @@ -1393,7 +1393,7 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) if (!NILP (Vx_window_horizontal_drag_shape)) { - CHECK_NUMBER (Vx_window_horizontal_drag_shape); + CHECK_FIXNUM (Vx_window_horizontal_drag_shape); horizontal_drag_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XINT (Vx_window_horizontal_drag_shape)); @@ -1404,7 +1404,7 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) if (!NILP (Vx_window_vertical_drag_shape)) { - CHECK_NUMBER (Vx_window_vertical_drag_shape); + CHECK_FIXNUM (Vx_window_vertical_drag_shape); vertical_drag_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XINT (Vx_window_vertical_drag_shape)); @@ -1725,7 +1725,7 @@ x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) if (!FRAME_MINIBUF_ONLY_P (f) && !FRAME_PARENT_FRAME (f)) { boolean old = FRAME_EXTERNAL_MENU_BAR (f); - boolean new = (INTEGERP (value) && XINT (value) > 0) ? true : false; + boolean new = (FIXNUMP (value) && XINT (value) > 0) ? true : false; FRAME_MENU_BAR_LINES (f) = 0; FRAME_MENU_BAR_HEIGHT (f) = 0; @@ -1757,7 +1757,7 @@ x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) x_clear_under_internal_border (f); /* Don't store anything but 1 or 0 in the parameter. */ - store_frame_param (f, Qmenu_bar_lines, make_number (new ? 1 : 0)); + store_frame_param (f, Qmenu_bar_lines, make_fixnum (new ? 1 : 0)); } } } @@ -1780,7 +1780,7 @@ x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) return; /* Use VALUE only if an integer >= 0. */ - if (INTEGERP (value) && XINT (value) >= 0) + if (FIXNUMP (value) && XINT (value) >= 0) nlines = XFASTINT (value); else nlines = 0; @@ -1805,8 +1805,8 @@ x_change_tool_bar_height (struct frame *f, int height) FRAME_TOOL_BAR_HEIGHT (f) = height; FRAME_TOOL_BAR_LINES (f) = lines; /* Store `tool-bar-lines' and `height' frame parameters. */ - store_frame_param (f, Qtool_bar_lines, make_number (lines)); - store_frame_param (f, Qheight, make_number (FRAME_LINES (f))); + store_frame_param (f, Qtool_bar_lines, make_fixnum (lines)); + store_frame_param (f, Qheight, make_fixnum (FRAME_LINES (f))); if (FRAME_W32_WINDOW (f) && FRAME_TOOL_BAR_HEIGHT (f) == 0) { @@ -2027,7 +2027,7 @@ x_set_undecorated (struct frame *f, Lisp_Object new_value, Lisp_Object old_value if (!NILP (new_value) && !FRAME_UNDECORATED (f)) { dwStyle = ((dwStyle & ~WS_THICKFRAME & ~WS_CAPTION) - | ((NUMBERP (border_width) && (XINT (border_width) > 0)) + | ((FIXED_OR_FLOATP (border_width) && (XINT (border_width) > 0)) ? WS_BORDER : false)); SetWindowLong (hwnd, GWL_STYLE, dwStyle); SetWindowPos (hwnd, HWND_TOP, 0, 0, 0, 0, @@ -2334,7 +2334,7 @@ w32_createwindow (struct frame *f, int *coords) if (FRAME_UNDECORATED (f)) { /* If we want a thin border, specify it here. */ - if (NUMBERP (border_width) && (XINT (border_width) > 0)) + if (FIXED_OR_FLOATP (border_width) && (XINT (border_width) > 0)) f->output_data.w32->dwStyle |= WS_BORDER; } else @@ -2350,7 +2350,7 @@ w32_createwindow (struct frame *f, int *coords) f->output_data.w32->dwStyle = WS_POPUP; /* If we want a thin border, specify it here. */ - if (NUMBERP (border_width) && (XINT (border_width) > 0)) + if (FIXED_OR_FLOATP (border_width) && (XINT (border_width) > 0)) f->output_data.w32->dwStyle |= WS_BORDER; } else @@ -3116,7 +3116,7 @@ map_keypad_keys (unsigned int virt_key, unsigned int extended) (Windows 2000 and later). */ static Lisp_Object w32_grabbed_keys; -#define HOTKEY(vk, mods) make_number (((vk) & 255) | ((mods) << 8)) +#define HOTKEY(vk, mods) make_fixnum (((vk) & 255) | ((mods) << 8)) #define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff) #define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255) #define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8) @@ -3140,7 +3140,7 @@ register_hot_keys (HWND hwnd) Lisp_Object key = XCAR (keylist); /* Deleted entries get set to nil. */ - if (!INTEGERP (key)) + if (!FIXNUMP (key)) continue; RegisterHotKey (hwnd, HOTKEY_ID (key), @@ -3157,7 +3157,7 @@ unregister_hot_keys (HWND hwnd) { Lisp_Object key = XCAR (keylist); - if (!INTEGERP (key)) + if (!FIXNUMP (key)) continue; UnregisterHotKey (hwnd, HOTKEY_ID (key)); @@ -4199,7 +4199,7 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) press of Space which we will ignore. */ if (GetAsyncKeyState (wParam) & 1) { - if (NUMBERP (Vw32_phantom_key_code)) + if (FIXED_OR_FLOATP (Vw32_phantom_key_code)) key = XUINT (Vw32_phantom_key_code) & 255; else key = VK_SPACE; @@ -4215,7 +4215,7 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) { if (GetAsyncKeyState (wParam) & 1) { - if (NUMBERP (Vw32_phantom_key_code)) + if (FIXED_OR_FLOATP (Vw32_phantom_key_code)) key = XUINT (Vw32_phantom_key_code) & 255; else key = VK_SPACE; @@ -5529,8 +5529,8 @@ x_icon (struct frame *f, Lisp_Object parms) icon_y = x_get_arg (dpyinfo, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER); if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound)) { - CHECK_NUMBER (icon_x); - CHECK_NUMBER (icon_y); + CHECK_FIXNUM (icon_x); + CHECK_FIXNUM (icon_y); } else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound)) error ("Both left and top icon corners of icon must be specified"); @@ -5728,7 +5728,7 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, if (EQ (parent, Qunbound)) parent = Qnil; else if (!NILP (parent)) - CHECK_NUMBER (parent); + CHECK_FIXNUM (parent); /* make_frame_without_minibuffer can run Lisp code and garbage collect. */ /* No need to protect DISPLAY because that's not used after passing @@ -5845,7 +5845,7 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, x_default_font_parameter (f, parameters); /* Default BorderWidth to 0 to match other platforms. */ - x_default_parameter (f, parameters, Qborder_width, make_number (0), + x_default_parameter (f, parameters, Qborder_width, make_fixnum (0), "borderWidth", "BorderWidth", RES_TYPE_NUMBER); /* We recognize either internalBorderWidth or internalBorder @@ -5861,11 +5861,11 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, parameters); } - x_default_parameter (f, parameters, Qinternal_border_width, make_number (0), + x_default_parameter (f, parameters, Qinternal_border_width, make_fixnum (0), "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER); - x_default_parameter (f, parameters, Qright_divider_width, make_number (0), + x_default_parameter (f, parameters, Qright_divider_width, make_fixnum (0), NULL, NULL, RES_TYPE_NUMBER); - x_default_parameter (f, parameters, Qbottom_divider_width, make_number (0), + x_default_parameter (f, parameters, Qbottom_divider_width, make_fixnum (0), NULL, NULL, RES_TYPE_NUMBER); x_default_parameter (f, parameters, Qvertical_scroll_bars, Qright, "verticalScrollBars", "ScrollBars", RES_TYPE_SYMBOL); @@ -5921,11 +5921,11 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, because `frame-windows-min-size' needs them. */ tem = x_get_arg (dpyinfo, parameters, Qmin_width, NULL, NULL, RES_TYPE_NUMBER); - if (NUMBERP (tem)) + if (FIXED_OR_FLOATP (tem)) store_frame_param (f, Qmin_width, tem); tem = x_get_arg (dpyinfo, parameters, Qmin_height, NULL, NULL, RES_TYPE_NUMBER); - if (NUMBERP (tem)) + if (FIXED_OR_FLOATP (tem)) store_frame_param (f, Qmin_height, tem); adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f), FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, true, @@ -5938,16 +5938,16 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, { x_default_parameter (f, parameters, Qmenu_bar_lines, NILP (Vmenu_bar_mode) - ? make_number (0) : make_number (1), + ? make_fixnum (0) : make_fixnum (1), NULL, NULL, RES_TYPE_NUMBER); } else /* No menu bar for child frames. */ - store_frame_param (f, Qmenu_bar_lines, make_number (0)); + store_frame_param (f, Qmenu_bar_lines, make_fixnum (0)); x_default_parameter (f, parameters, Qtool_bar_lines, NILP (Vtool_bar_mode) - ? make_number (0) : make_number (1), + ? make_fixnum (0) : make_fixnum (1), NULL, NULL, RES_TYPE_NUMBER); x_default_parameter (f, parameters, Qbuffer_predicate, Qnil, @@ -6157,7 +6157,7 @@ DEFUN ("x-display-pixel-width", Fx_display_pixel_width, { struct w32_display_info *dpyinfo = check_x_display_info (display); - return make_number (x_display_pixel_width (dpyinfo)); + return make_fixnum (x_display_pixel_width (dpyinfo)); } DEFUN ("x-display-pixel-height", Fx_display_pixel_height, @@ -6167,7 +6167,7 @@ DEFUN ("x-display-pixel-height", Fx_display_pixel_height, { struct w32_display_info *dpyinfo = check_x_display_info (display); - return make_number (x_display_pixel_height (dpyinfo)); + return make_fixnum (x_display_pixel_height (dpyinfo)); } DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes, @@ -6177,7 +6177,7 @@ DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes, { struct w32_display_info *dpyinfo = check_x_display_info (display); - return make_number (dpyinfo->n_planes * dpyinfo->n_cbits); + return make_fixnum (dpyinfo->n_planes * dpyinfo->n_cbits); } DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells, @@ -6194,7 +6194,7 @@ DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells, * anyway. */ cap = 1 << min (dpyinfo->n_planes * dpyinfo->n_cbits, 24); - return make_number (cap); + return make_fixnum (cap); } DEFUN ("x-server-max-request-size", Fx_server_max_request_size, @@ -6203,7 +6203,7 @@ DEFUN ("x-server-max-request-size", Fx_server_max_request_size, doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object display) { - return make_number (1); + return make_fixnum (1); } DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0, @@ -6224,7 +6224,7 @@ DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0, doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object display) { - return make_number (1); + return make_fixnum (1); } DEFUN ("x-display-mm-height", Fx_display_mm_height, @@ -6241,7 +6241,7 @@ DEFUN ("x-display-mm-height", Fx_display_mm_height, / GetDeviceCaps (hdc, VERTRES)); ReleaseDC (NULL, hdc); - return make_number (x_display_pixel_height (dpyinfo) * mm_per_pixel + 0.5); + return make_fixnum (x_display_pixel_height (dpyinfo) * mm_per_pixel + 0.5); } DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0, @@ -6257,7 +6257,7 @@ DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0, / GetDeviceCaps (hdc, HORZRES)); ReleaseDC (NULL, hdc); - return make_number (x_display_pixel_width (dpyinfo) * mm_per_pixel + 0.5); + return make_fixnum (x_display_pixel_width (dpyinfo) * mm_per_pixel + 0.5); } DEFUN ("x-display-backing-store", Fx_display_backing_store, @@ -6334,7 +6334,7 @@ w32_display_monitor_attributes_list (void) monitor_list = XCDR (monitor_list); } - monitor_frames = Fmake_vector (make_number (n_monitors), Qnil); + monitor_frames = Fmake_vector (make_fixnum (n_monitors), Qnil); FOR_EACH_FRAME (rest, frame) { struct frame *f = XFRAME (frame); @@ -6912,7 +6912,7 @@ x_create_tip_frame (struct w32_display_info *dpyinfo, Lisp_Object parms) that are needed to determine window geometry. */ x_default_font_parameter (f, parms); - x_default_parameter (f, parms, Qborder_width, make_number (2), + x_default_parameter (f, parms, Qborder_width, make_fixnum (2), "borderWidth", "BorderWidth", RES_TYPE_NUMBER); /* This defaults to 2 in order to match xterm. We recognize either internalBorderWidth or internalBorder (which is what xterm calls @@ -6928,7 +6928,7 @@ x_create_tip_frame (struct w32_display_info *dpyinfo, Lisp_Object parms) parms); } - x_default_parameter (f, parms, Qinternal_border_width, make_number (1), + x_default_parameter (f, parms, Qinternal_border_width, make_fixnum (1), "internalBorderWidth", "internalBorderWidth", RES_TYPE_NUMBER); /* Also do the stuff which must be set before the window exists. */ @@ -7064,8 +7064,8 @@ compute_tip_xy (struct frame *f, /* Move the tooltip window where the mouse pointer is. Resize and show it. */ - if ((!INTEGERP (left) && !INTEGERP (right)) - || (!INTEGERP (top) && !INTEGERP (bottom))) + if ((!FIXNUMP (left) && !FIXNUMP (right)) + || (!FIXNUMP (top) && !FIXNUMP (bottom))) { POINT pt; @@ -7104,9 +7104,9 @@ compute_tip_xy (struct frame *f, } } - if (INTEGERP (top)) + if (FIXNUMP (top)) *root_y = XINT (top); - else if (INTEGERP (bottom)) + else if (FIXNUMP (bottom)) *root_y = XINT (bottom) - height; else if (*root_y + XINT (dy) <= min_y) *root_y = min_y; /* Can happen for negative dy */ @@ -7120,9 +7120,9 @@ compute_tip_xy (struct frame *f, /* Put it on the top. */ *root_y = min_y; - if (INTEGERP (left)) + if (FIXNUMP (left)) *root_x = XINT (left); - else if (INTEGERP (right)) + else if (FIXNUMP (right)) *root_x = XINT (right) - width; else if (*root_x + XINT (dx) <= min_x) *root_x = 0; /* Can happen for negative dx */ @@ -7221,19 +7221,19 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, decode_window_system_frame (frame); if (NILP (timeout)) - timeout = make_number (5); + timeout = make_fixnum (5); else - CHECK_NATNUM (timeout); + CHECK_FIXNAT (timeout); if (NILP (dx)) - dx = make_number (5); + dx = make_fixnum (5); else - CHECK_NUMBER (dx); + CHECK_FIXNUM (dx); if (NILP (dy)) - dy = make_number (-10); + dy = make_fixnum (-10); else - CHECK_NUMBER (dy); + CHECK_FIXNUM (dy); if (FRAMEP (tip_frame) && FRAME_LIVE_P (XFRAME (tip_frame))) { @@ -7344,9 +7344,9 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, if (NILP (Fassq (Qname, parms))) parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms); if (NILP (Fassq (Qinternal_border_width, parms))) - parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms); + parms = Fcons (Fcons (Qinternal_border_width, make_fixnum (3)), parms); if (NILP (Fassq (Qborder_width, parms))) - parms = Fcons (Fcons (Qborder_width, make_number (1)), parms); + parms = Fcons (Fcons (Qborder_width, make_fixnum (1)), parms); if (NILP (Fassq (Qborder_color, parms))) parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms); @@ -7370,8 +7370,8 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, tip_buf = Fget_buffer_create (tip); /* We will mark the tip window a "pseudo-window" below, and such windows cannot have display margins. */ - bset_left_margin_cols (XBUFFER (tip_buf), make_number (0)); - bset_right_margin_cols (XBUFFER (tip_buf), make_number (0)); + bset_left_margin_cols (XBUFFER (tip_buf), make_fixnum (0)); + bset_right_margin_cols (XBUFFER (tip_buf), make_fixnum (0)); set_window_buffer (window, tip_buf, false, false); w = XWINDOW (window); w->pseudo_window_p = true; @@ -7386,8 +7386,8 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, w->pixel_top = 0; if (CONSP (Vx_max_tooltip_size) - && RANGED_INTEGERP (1, XCAR (Vx_max_tooltip_size), INT_MAX) - && RANGED_INTEGERP (1, XCDR (Vx_max_tooltip_size), INT_MAX)) + && RANGED_FIXNUMP (1, XCAR (Vx_max_tooltip_size), INT_MAX) + && RANGED_FIXNUMP (1, XCDR (Vx_max_tooltip_size), INT_MAX)) { w->total_cols = XFASTINT (XCAR (Vx_max_tooltip_size)); w->total_lines = XFASTINT (XCDR (Vx_max_tooltip_size)); @@ -7420,7 +7420,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, try_window (window, pos, TRY_WINDOW_IGNORE_FONTS_CHANGE); /* Calculate size of tooltip window. */ size = Fwindow_text_pixel_size (window, Qnil, Qnil, Qnil, - make_number (w->pixel_height), Qnil); + make_fixnum (w->pixel_height), Qnil); /* Add the frame's internal border to calculated size. */ width = XINT (Fcar (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); height = XINT (Fcdr (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); @@ -7430,7 +7430,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, /* Show tooltip frame. */ { RECT rect; - int pad = (NUMBERP (Vw32_tooltip_extra_pixels) + int pad = (FIXED_OR_FLOATP (Vw32_tooltip_extra_pixels) ? max (0, XINT (Vw32_tooltip_extra_pixels)) : FRAME_COLUMN_WIDTH (tip_f)); @@ -8033,7 +8033,7 @@ If optional parameter FRAME is not specified, use selected frame. */) { struct frame *f = decode_window_system_frame (frame); - CHECK_NUMBER (command); + CHECK_FIXNUM (command); if (FRAME_W32_P (f)) PostMessage (FRAME_W32_WINDOW (f), WM_SYSCOMMAND, XINT (command), 0); @@ -8143,7 +8143,7 @@ a ShowWindow flag: } result = (intptr_t) ShellExecuteW (NULL, ops_w, doc_w, params_w, GUI_SDATA (current_dir), - (INTEGERP (show_flag) + (FIXNUMP (show_flag) ? XINT (show_flag) : SW_SHOWDEFAULT)); if (result > 32) @@ -8209,7 +8209,7 @@ a ShowWindow flag: if (c_isalpha (*p) && p[1] == ':' && IS_DIRECTORY_SEP (p[2])) document = Fsubstring_no_properties (document, - make_number (file_url_len), Qnil); + make_fixnum (file_url_len), Qnil); } /* We have a situation here. If DOCUMENT is a relative file name, but its name includes leading directories, i.e. it lives not in @@ -8301,7 +8301,7 @@ a ShowWindow flag: shexinfo_w.lpParameters = params_w; shexinfo_w.lpDirectory = current_dir_w; shexinfo_w.nShow = - (INTEGERP (show_flag) ? XINT (show_flag) : SW_SHOWDEFAULT); + (FIXNUMP (show_flag) ? XINT (show_flag) : SW_SHOWDEFAULT); success = ShellExecuteExW (&shexinfo_w); xfree (doc_w); } @@ -8336,7 +8336,7 @@ a ShowWindow flag: shexinfo_a.lpParameters = params_a; shexinfo_a.lpDirectory = current_dir_a; shexinfo_a.nShow = - (INTEGERP (show_flag) ? XINT (show_flag) : SW_SHOWDEFAULT); + (FIXNUMP (show_flag) ? XINT (show_flag) : SW_SHOWDEFAULT); success = ShellExecuteExA (&shexinfo_a); xfree (doc_w); xfree (doc_a); @@ -8412,7 +8412,7 @@ w32_parse_and_hook_hot_key (Lisp_Object key, int hook) if (CONSP (c) && lucid_event_type_list_p (c)) c = Fevent_convert_list (c); - if (! INTEGERP (c) && ! SYMBOLP (c)) + if (! FIXNUMP (c) && ! SYMBOLP (c)) error ("Key definition is invalid"); /* Work out the base key and the modifiers. */ @@ -8430,7 +8430,7 @@ w32_parse_and_hook_hot_key (Lisp_Object key, int hook) else vk_code = lookup_vk_code (vkname); } - else if (INTEGERP (c)) + else if (FIXNUMP (c)) { lisp_modifiers = XINT (c) & ~CHARACTERBITS; /* Many ascii characters are their own virtual key code. */ @@ -8547,7 +8547,7 @@ DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key, { Lisp_Object item; - if (!INTEGERP (key)) + if (!FIXNUMP (key)) key = w32_parse_and_hook_hot_key (key, 0); if (w32_kbdhook_active) @@ -8594,7 +8594,7 @@ usage: (w32-reconstruct-hot-key ID) */) int vk_code, w32_modifiers; Lisp_Object key; - CHECK_NUMBER (hotkeyid); + CHECK_FIXNUM (hotkeyid); vk_code = HOTKEY_VK_CODE (hotkeyid); w32_modifiers = HOTKEY_MODIFIERS (hotkeyid); @@ -8602,7 +8602,7 @@ usage: (w32-reconstruct-hot-key ID) */) if (vk_code < 256 && lispy_function_keys[vk_code]) key = intern (lispy_function_keys[vk_code]); else - key = make_number (vk_code); + key = make_fixnum (vk_code); key = Fcons (key, Qnil); if (w32_modifiers & MOD_SHIFT) @@ -8642,7 +8642,7 @@ to change the state. */) return Qnil; if (!dwWindowsThreadId) - return make_number (w32_console_toggle_lock_key (vk_code, new_state)); + return make_fixnum (w32_console_toggle_lock_key (vk_code, new_state)); if (NILP (new_state)) lparam = -1; @@ -8653,7 +8653,7 @@ to change the state. */) { MSG msg; GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE); - return make_number (msg.wParam); + return make_fixnum (msg.wParam); } return Qnil; } @@ -8787,32 +8787,32 @@ and width values are in pixels. return listn (CONSTYPE_HEAP, 10, Fcons (Qouter_position, - Fcons (make_number (left), make_number (top))), + Fcons (make_fixnum (left), make_fixnum (top))), Fcons (Qouter_size, - Fcons (make_number (right - left), - make_number (bottom - top))), + Fcons (make_fixnum (right - left), + make_fixnum (bottom - top))), Fcons (Qexternal_border_size, - Fcons (make_number (external_border_width), - make_number (external_border_height))), + Fcons (make_fixnum (external_border_width), + make_fixnum (external_border_height))), Fcons (Qtitle_bar_size, - Fcons (make_number (title_bar_width), - make_number (title_bar_height))), + Fcons (make_fixnum (title_bar_width), + make_fixnum (title_bar_height))), Fcons (Qmenu_bar_external, Qt), Fcons (Qmenu_bar_size, - Fcons (make_number + Fcons (make_fixnum (menu_bar.rcBar.right - menu_bar.rcBar.left), - make_number (menu_bar_height))), + make_fixnum (menu_bar_height))), Fcons (Qtool_bar_external, Qnil), Fcons (Qtool_bar_position, tool_bar_height ? Qtop : Qnil), Fcons (Qtool_bar_size, - Fcons (make_number + Fcons (make_fixnum (tool_bar_height ? (right - left - 2 * external_border_width - 2 * internal_border_width) : 0), - make_number (tool_bar_height))), + make_fixnum (tool_bar_height))), Fcons (Qinternal_border_width, - make_number (internal_border_width))); + make_fixnum (internal_border_width))); } DEFUN ("w32-frame-edges", Fw32_frame_edges, Sw32_frame_edges, 0, 2, 0, @@ -8849,10 +8849,10 @@ menu bar or tool bar of FRAME. */) unblock_input (); if (success) - return list4 (make_number (rectangle.left), - make_number (rectangle.top), - make_number (rectangle.right), - make_number (rectangle.bottom)); + return list4 (make_fixnum (rectangle.left), + make_fixnum (rectangle.top), + make_fixnum (rectangle.right), + make_fixnum (rectangle.bottom)); else return Qnil; } @@ -8891,16 +8891,16 @@ menu bar or tool bar of FRAME. */) { int internal_border_width = FRAME_INTERNAL_BORDER_WIDTH (f); - return list4 (make_number (left + internal_border_width), - make_number (top + return list4 (make_fixnum (left + internal_border_width), + make_fixnum (top + FRAME_TOOL_BAR_HEIGHT (f) + internal_border_width), - make_number (right - internal_border_width), - make_number (bottom - internal_border_width)); + make_fixnum (right - internal_border_width), + make_fixnum (bottom - internal_border_width)); } else - return list4 (make_number (left), make_number (top), - make_number (right), make_number (bottom)); + return list4 (make_fixnum (left), make_fixnum (top), + make_fixnum (right), make_fixnum (bottom)); } } @@ -9048,7 +9048,7 @@ selected frame's display. */) GetCursorPos (&pt); unblock_input (); - return Fcons (make_number (pt.x), make_number (pt.y)); + return Fcons (make_fixnum (pt.x), make_fixnum (pt.y)); } DEFUN ("w32-set-mouse-absolute-pixel-position", Fw32_set_mouse_absolute_pixel_position, @@ -9431,7 +9431,7 @@ w32_console_toggle_lock_key (int vk_code, Lisp_Object new_state) int cur_state = (GetKeyState (vk_code) & 1); if (NILP (new_state) - || (NUMBERP (new_state) + || (FIXED_OR_FLOATP (new_state) && ((XUINT (new_state)) & 1) != cur_state)) { #ifdef WINDOWSNT @@ -10059,7 +10059,7 @@ usage: (w32-notification-notify &rest PARAMS) */) /* Do it! */ retval = add_tray_notification (f, icon, tip, severity, timeout, title, msg); - return (retval < 0 ? Qnil : make_number (retval)); + return (retval < 0 ? Qnil : make_fixnum (retval)); } DEFUN ("w32-notification-close", @@ -10070,7 +10070,7 @@ DEFUN ("w32-notification-close", { struct frame *f = SELECTED_FRAME (); - if (INTEGERP (id)) + if (FIXNUMP (id)) delete_tray_notification (f, XINT (id)); return Qnil; @@ -10483,7 +10483,7 @@ bass-down, bass-boost, bass-up, treble-down, treble-up */); DEFVAR_LISP ("x-max-tooltip-size", Vx_max_tooltip_size, doc: /* SKIP: real doc in xfns.c. */); - Vx_max_tooltip_size = Fcons (make_number (80), make_number (40)); + Vx_max_tooltip_size = Fcons (make_fixnum (80), make_fixnum (40)); DEFVAR_LISP ("x-no-window-manager", Vx_no_window_manager, doc: /* SKIP: real doc in xfns.c. */); diff --git a/src/w32font.c b/src/w32font.c index 65409b92d2..ed68656a00 100644 --- a/src/w32font.c +++ b/src/w32font.c @@ -1096,9 +1096,9 @@ w32_enumfont_pattern_entity (Lisp_Object frame, ASET (entity, FONT_ADSTYLE_INDEX, tem); if (physical_font->ntmTm.tmPitchAndFamily & 0x01) - ASET (entity, FONT_SPACING_INDEX, make_number (FONT_SPACING_PROPORTIONAL)); + ASET (entity, FONT_SPACING_INDEX, make_fixnum (FONT_SPACING_PROPORTIONAL)); else - ASET (entity, FONT_SPACING_INDEX, make_number (FONT_SPACING_CHARCELL)); + ASET (entity, FONT_SPACING_INDEX, make_fixnum (FONT_SPACING_CHARCELL)); if (requested_font->lfQuality != DEFAULT_QUALITY) { @@ -1109,19 +1109,19 @@ w32_enumfont_pattern_entity (Lisp_Object frame, intern_font_name (lf->lfFaceName)); FONT_SET_STYLE (entity, FONT_WEIGHT_INDEX, - make_number (w32_decode_weight (lf->lfWeight))); + make_fixnum (w32_decode_weight (lf->lfWeight))); FONT_SET_STYLE (entity, FONT_SLANT_INDEX, - make_number (lf->lfItalic ? 200 : 100)); + make_fixnum (lf->lfItalic ? 200 : 100)); /* TODO: PANOSE struct has this info, but need to call GetOutlineTextMetrics to get it. */ - FONT_SET_STYLE (entity, FONT_WIDTH_INDEX, make_number (100)); + FONT_SET_STYLE (entity, FONT_WIDTH_INDEX, make_fixnum (100)); if (font_type & RASTER_FONTTYPE) ASET (entity, FONT_SIZE_INDEX, - make_number (physical_font->ntmTm.tmHeight + make_fixnum (physical_font->ntmTm.tmHeight + physical_font->ntmTm.tmExternalLeading)); else - ASET (entity, FONT_SIZE_INDEX, make_number (0)); + ASET (entity, FONT_SIZE_INDEX, make_fixnum (0)); /* Cache Unicode codepoints covered by this font, as there is no other way of getting this information easily. */ @@ -1229,7 +1229,7 @@ font_matches_spec (DWORD type, NEWTEXTMETRICEX *font, /* Check spacing */ val = AREF (spec, FONT_SPACING_INDEX); - if (INTEGERP (val)) + if (FIXNUMP (val)) { int spacing = XINT (val); int proportional = (spacing < FONT_SPACING_MONO); @@ -1822,7 +1822,7 @@ w32_to_x_charset (int fncharset, char *matching) /* Look for Same charset and a valid codepage (or non-int which means ignore). */ if (EQ (w32_charset, charset_type) - && (!INTEGERP (codepage) || XINT (codepage) == CP_DEFAULT + && (!FIXNUMP (codepage) || XINT (codepage) == CP_DEFAULT || IsValidCodePage (XINT (codepage)))) { /* If we don't have a match already, then this is the @@ -1955,7 +1955,7 @@ fill_in_logfont (struct frame *f, LOGFONT *logfont, Lisp_Object font_spec) int dpi = FRAME_RES_Y (f); tmp = AREF (font_spec, FONT_DPI_INDEX); - if (INTEGERP (tmp)) + if (FIXNUMP (tmp)) { dpi = XINT (tmp); } @@ -1966,7 +1966,7 @@ fill_in_logfont (struct frame *f, LOGFONT *logfont, Lisp_Object font_spec) /* Height */ tmp = AREF (font_spec, FONT_SIZE_INDEX); - if (INTEGERP (tmp)) + if (FIXNUMP (tmp)) logfont->lfHeight = -1 * XINT (tmp); else if (FLOATP (tmp)) logfont->lfHeight = (int) (-1.0 * dpi * XFLOAT_DATA (tmp) / 72.27 + 0.5); @@ -1977,12 +1977,12 @@ fill_in_logfont (struct frame *f, LOGFONT *logfont, Lisp_Object font_spec) /* Weight */ tmp = AREF (font_spec, FONT_WEIGHT_INDEX); - if (INTEGERP (tmp)) + if (FIXNUMP (tmp)) logfont->lfWeight = w32_encode_weight (FONT_WEIGHT_NUMERIC (font_spec)); /* Italic */ tmp = AREF (font_spec, FONT_SLANT_INDEX); - if (INTEGERP (tmp)) + if (FIXNUMP (tmp)) { int slant = FONT_SLANT_NUMERIC (font_spec); logfont->lfItalic = slant > 150 ? 1 : 0; @@ -2036,7 +2036,7 @@ fill_in_logfont (struct frame *f, LOGFONT *logfont, Lisp_Object font_spec) /* Set pitch based on the spacing property. */ tmp = AREF (font_spec, FONT_SPACING_INDEX); - if (INTEGERP (tmp)) + if (FIXNUMP (tmp)) { int spacing = XINT (tmp); if (spacing < FONT_SPACING_MONO) diff --git a/src/w32inevt.c b/src/w32inevt.c index 907cc476a9..6c5a1c6d47 100644 --- a/src/w32inevt.c +++ b/src/w32inevt.c @@ -181,7 +181,7 @@ key_event (KEY_EVENT_RECORD *event, struct input_event *emacs_ev, int *isdead) Space which we will ignore. */ if ((mod_key_state & LEFT_WIN_PRESSED) == 0) { - if (NUMBERP (Vw32_phantom_key_code)) + if (FIXED_OR_FLOATP (Vw32_phantom_key_code)) faked_key = XUINT (Vw32_phantom_key_code) & 255; else faked_key = VK_SPACE; @@ -198,7 +198,7 @@ key_event (KEY_EVENT_RECORD *event, struct input_event *emacs_ev, int *isdead) { if ((mod_key_state & RIGHT_WIN_PRESSED) == 0) { - if (NUMBERP (Vw32_phantom_key_code)) + if (FIXED_OR_FLOATP (Vw32_phantom_key_code)) faked_key = XUINT (Vw32_phantom_key_code) & 255; else faked_key = VK_SPACE; diff --git a/src/w32proc.c b/src/w32proc.c index 5934669c36..4cffdd0d9d 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -1766,7 +1766,7 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp) { program = build_string (cmdname); full = Qnil; - openp (Vexec_path, program, Vexec_suffixes, &full, make_number (X_OK), 0); + openp (Vexec_path, program, Vexec_suffixes, &full, make_fixnum (X_OK), 0); if (NILP (full)) { errno = EINVAL; @@ -1889,7 +1889,7 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp) do_quoting = 1; /* Override escape char by binding w32-quote-process-args to desired character, or use t for auto-selection. */ - if (INTEGERP (Vw32_quote_process_args)) + if (FIXNUMP (Vw32_quote_process_args)) escape_char = XINT (Vw32_quote_process_args); else escape_char = (is_cygnus_app || is_msys_app) ? '"' : '\\'; @@ -3017,7 +3017,7 @@ If successful, the return value is t, otherwise nil. */) DWORD pid; child_process *cp; - CHECK_NUMBER (process); + CHECK_FIXNUM (process); /* Allow pid to be an internally generated one, or one obtained externally. This is necessary because real pids on Windows 95 are @@ -3186,7 +3186,7 @@ If LCID (a 16-bit number) is not a valid locale, the result is nil. */) char abbrev_name[32] = { 0 }; char full_name[256] = { 0 }; - CHECK_NUMBER (lcid); + CHECK_FIXNUM (lcid); if (!IsValidLocale (XINT (lcid), LCID_SUPPORTED)) return Qnil; @@ -3207,7 +3207,7 @@ If LCID (a 16-bit number) is not a valid locale, the result is nil. */) if (got_full) return DECODE_SYSTEM (build_string (full_name)); } - else if (NUMBERP (longform)) + else if (FIXED_OR_FLOATP (longform)) { got_full = GetLocaleInfo (XINT (lcid), XINT (longform), @@ -3231,7 +3231,7 @@ This is a numerical value; use `w32-get-locale-info' to convert to a human-readable form. */) (void) { - return make_number (GetThreadLocale ()); + return make_fixnum (GetThreadLocale ()); } static DWORD @@ -3260,7 +3260,7 @@ static BOOL CALLBACK ALIGN_STACK enum_locale_fn (LPTSTR localeNum) { DWORD id = int_from_hex (localeNum); - Vw32_valid_locale_ids = Fcons (make_number (id), Vw32_valid_locale_ids); + Vw32_valid_locale_ids = Fcons (make_fixnum (id), Vw32_valid_locale_ids); return TRUE; } @@ -3289,8 +3289,8 @@ human-readable form. */) (Lisp_Object userp) { if (NILP (userp)) - return make_number (GetSystemDefaultLCID ()); - return make_number (GetUserDefaultLCID ()); + return make_fixnum (GetSystemDefaultLCID ()); + return make_fixnum (GetUserDefaultLCID ()); } @@ -3299,7 +3299,7 @@ DEFUN ("w32-set-current-locale", Fw32_set_current_locale, Sw32_set_current_local If successful, the new locale id is returned, otherwise nil. */) (Lisp_Object lcid) { - CHECK_NUMBER (lcid); + CHECK_FIXNUM (lcid); if (!IsValidLocale (XINT (lcid), LCID_SUPPORTED)) return Qnil; @@ -3312,7 +3312,7 @@ If successful, the new locale id is returned, otherwise nil. */) /* Reply is not needed. */ PostThreadMessage (dwWindowsThreadId, WM_EMACS_SETLOCALE, XINT (lcid), 0); - return make_number (GetThreadLocale ()); + return make_fixnum (GetThreadLocale ()); } @@ -3324,7 +3324,7 @@ static BOOL CALLBACK ALIGN_STACK enum_codepage_fn (LPTSTR codepageNum) { DWORD id = atoi (codepageNum); - Vw32_valid_codepages = Fcons (make_number (id), Vw32_valid_codepages); + Vw32_valid_codepages = Fcons (make_fixnum (id), Vw32_valid_codepages); return TRUE; } @@ -3347,7 +3347,7 @@ DEFUN ("w32-get-console-codepage", Fw32_get_console_codepage, doc: /* Return current Windows codepage for console input. */) (void) { - return make_number (GetConsoleCP ()); + return make_fixnum (GetConsoleCP ()); } @@ -3358,7 +3358,7 @@ This codepage setting affects keyboard input in tty mode. If successful, the new CP is returned, otherwise nil. */) (Lisp_Object cp) { - CHECK_NUMBER (cp); + CHECK_FIXNUM (cp); if (!IsValidCodePage (XINT (cp))) return Qnil; @@ -3366,7 +3366,7 @@ If successful, the new CP is returned, otherwise nil. */) if (!SetConsoleCP (XINT (cp))) return Qnil; - return make_number (GetConsoleCP ()); + return make_fixnum (GetConsoleCP ()); } @@ -3375,7 +3375,7 @@ DEFUN ("w32-get-console-output-codepage", Fw32_get_console_output_codepage, doc: /* Return current Windows codepage for console output. */) (void) { - return make_number (GetConsoleOutputCP ()); + return make_fixnum (GetConsoleOutputCP ()); } @@ -3386,7 +3386,7 @@ This codepage setting affects display in tty mode. If successful, the new CP is returned, otherwise nil. */) (Lisp_Object cp) { - CHECK_NUMBER (cp); + CHECK_FIXNUM (cp); if (!IsValidCodePage (XINT (cp))) return Qnil; @@ -3394,7 +3394,7 @@ If successful, the new CP is returned, otherwise nil. */) if (!SetConsoleOutputCP (XINT (cp))) return Qnil; - return make_number (GetConsoleOutputCP ()); + return make_fixnum (GetConsoleOutputCP ()); } @@ -3412,7 +3412,7 @@ yield nil. */) CHARSETINFO info; DWORD_PTR dwcp; - CHECK_NUMBER (cp); + CHECK_FIXNUM (cp); if (!IsValidCodePage (XINT (cp))) return Qnil; @@ -3422,7 +3422,7 @@ yield nil. */) building --with-wide-int or building for 64bit. */ dwcp = XINT (cp); if (TranslateCharsetInfo ((DWORD *) dwcp, &info, TCI_SRCCODEPAGE)) - return make_number (info.ciCharset); + return make_fixnum (info.ciCharset); return Qnil; } @@ -3444,8 +3444,8 @@ The return value is a list of pairs of language id and layout id. */) { HKL kl = layouts[num_layouts]; - obj = Fcons (Fcons (make_number (LOWORD (kl)), - make_number (HIWORD (kl))), + obj = Fcons (Fcons (make_fixnum (LOWORD (kl)), + make_fixnum (HIWORD (kl))), obj); } } @@ -3462,8 +3462,8 @@ The return value is the cons of the language id and the layout id. */) { HKL kl = GetKeyboardLayout (dwWindowsThreadId); - return Fcons (make_number (LOWORD (kl)), - make_number (HIWORD (kl))); + return Fcons (make_fixnum (LOWORD (kl)), + make_fixnum (HIWORD (kl))); } @@ -3477,8 +3477,8 @@ If successful, the new layout id is returned, otherwise nil. */) HKL kl; CHECK_CONS (layout); - CHECK_NUMBER_CAR (layout); - CHECK_NUMBER_CDR (layout); + CHECK_FIXNUM_CAR (layout); + CHECK_FIXNUM_CDR (layout); kl = (HKL) (UINT_PTR) ((XINT (XCAR (layout)) & 0xffff) | (XINT (XCDR (layout)) << 16)); diff --git a/src/w32select.c b/src/w32select.c index a9df3f770b..9255bf068a 100644 --- a/src/w32select.c +++ b/src/w32select.c @@ -371,8 +371,8 @@ render_all (Lisp_Object ignore) render_locale (); if (current_clipboard_type == CF_UNICODETEXT) - render (make_number (CF_TEXT)); - render (make_number (current_clipboard_type)); + render (make_fixnum (CF_TEXT)); + render (make_fixnum (current_clipboard_type)); CloseClipboard (); @@ -419,7 +419,7 @@ owner_callback (HWND win, UINT msg, WPARAM wp, LPARAM lp) { case WM_RENDERFORMAT: ONTRACE (fprintf (stderr, "WM_RENDERFORMAT\n")); - run_protected (render, make_number (wp)); + run_protected (render, make_fixnum (wp)); return 0; case WM_RENDERALLFORMATS: @@ -631,7 +631,7 @@ validate_coding_system (Lisp_Object coding_system) eol_type = Fcoding_system_eol_type (coding_system); /* Already a DOS coding system? */ - if (EQ (eol_type, make_number (1))) + if (EQ (eol_type, make_fixnum (1))) return coding_system; /* Get EOL_TYPE vector of the base of CODING_SYSTEM. */ @@ -742,7 +742,7 @@ DEFUN ("w32-set-clipboard-data", Fw32_set_clipboard_data, /* If for some reason we don't have a clipboard_owner, we just set the text format as chosen by the configuration and than forget about the whole thing. */ - ok = !NILP (render (make_number (current_clipboard_type))); + ok = !NILP (render (make_fixnum (current_clipboard_type))); current_text = Qnil; current_coding_system = Qnil; } @@ -1123,7 +1123,7 @@ representing a data format that is currently available in the clipboard. */) /* We generate a vector because that's what xselect.c does in this case. */ - val = Fmake_vector (make_number (fmtcount), Qnil); + val = Fmake_vector (make_fixnum (fmtcount), Qnil); /* Note: when stepping with GDB through this code, the loop below terminates immediately because EnumClipboardFormats for some reason returns with diff --git a/src/w32term.c b/src/w32term.c index ff0d2bf5dd..cf6d516d58 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -478,7 +478,7 @@ x_set_frame_alpha (struct frame *f) if (FLOATP (Vframe_alpha_lower_limit)) alpha_min = XFLOAT_DATA (Vframe_alpha_lower_limit); - else if (INTEGERP (Vframe_alpha_lower_limit)) + else if (FIXNUMP (Vframe_alpha_lower_limit)) alpha_min = (XINT (Vframe_alpha_lower_limit)) / 100.0; if (alpha < 0.0) @@ -1979,13 +1979,13 @@ x_draw_image_relief (struct glyph_string *s) if (s->face->id == TOOL_BAR_FACE_ID) { if (CONSP (Vtool_bar_button_margin) - && INTEGERP (XCAR (Vtool_bar_button_margin)) - && INTEGERP (XCDR (Vtool_bar_button_margin))) + && FIXNUMP (XCAR (Vtool_bar_button_margin)) + && FIXNUMP (XCDR (Vtool_bar_button_margin))) { extra_x = XINT (XCAR (Vtool_bar_button_margin)); extra_y = XINT (XCDR (Vtool_bar_button_margin)); } - else if (INTEGERP (Vtool_bar_button_margin)) + else if (FIXNUMP (Vtool_bar_button_margin)) extra_x = extra_y = XINT (Vtool_bar_button_margin); } @@ -2481,7 +2481,7 @@ x_draw_glyph_string (struct glyph_string *s) Lisp_Object val = buffer_local_value (Qunderline_minimum_offset, s->w->contents); - if (INTEGERP (val)) + if (FIXNUMP (val)) minimum_offset = XFASTINT (val); else minimum_offset = 1; @@ -4769,7 +4769,7 @@ w32_read_socket (struct terminal *terminal, if (f && !FRAME_ICONIFIED_P (f)) { - if (!hlinfo->mouse_face_hidden && INTEGERP (Vmouse_highlight) + if (!hlinfo->mouse_face_hidden && FIXNUMP (Vmouse_highlight) && !EQ (f->tool_bar_window, hlinfo->mouse_face_window)) { clear_mouse_face (hlinfo); @@ -4794,7 +4794,7 @@ w32_read_socket (struct terminal *terminal, if (f && !FRAME_ICONIFIED_P (f)) { - if (!hlinfo->mouse_face_hidden && INTEGERP (Vmouse_highlight) + if (!hlinfo->mouse_face_hidden && FIXNUMP (Vmouse_highlight) && !EQ (f->tool_bar_window, hlinfo->mouse_face_window)) { clear_mouse_face (hlinfo); @@ -4872,7 +4872,7 @@ w32_read_socket (struct terminal *terminal, if (f && !FRAME_ICONIFIED_P (f)) { - if (!hlinfo->mouse_face_hidden && INTEGERP (Vmouse_highlight) + if (!hlinfo->mouse_face_hidden && FIXNUMP (Vmouse_highlight) && !EQ (f->tool_bar_window, hlinfo->mouse_face_window)) { clear_mouse_face (hlinfo); @@ -6142,8 +6142,8 @@ x_calc_absolute_position (struct frame *f) geometry = Fassoc (Qgeometry, attributes, Qnil); if (!NILP (geometry)) { - monitor_left = Fnth (make_number (1), geometry); - monitor_top = Fnth (make_number (2), geometry); + monitor_left = Fnth (make_fixnum (1), geometry); + monitor_top = Fnth (make_fixnum (2), geometry); display_left = min (display_left, XINT (monitor_left)); display_top = min (display_top, XINT (monitor_top)); @@ -6432,10 +6432,10 @@ x_set_window_size (struct frame *f, bool change_gravity, { frame_size_history_add (f, Qx_set_window_size_1, width, height, - list2 (Fcons (make_number (pixelwidth), - make_number (pixelheight)), - Fcons (make_number (rect.right - rect.left), - make_number (rect.bottom - rect.top)))); + list2 (Fcons (make_fixnum (pixelwidth), + make_fixnum (pixelheight)), + Fcons (make_fixnum (rect.right - rect.left), + make_fixnum (rect.bottom - rect.top)))); if (!FRAME_PARENT_FRAME (f)) my_set_window_pos (FRAME_W32_WINDOW (f), NULL, @@ -7265,7 +7265,7 @@ w32_initialize (void) /* Initialize input mode: interrupt_input off, no flow control, allow 8 bit character input, standard quit char. */ - Fset_input_mode (Qnil, Qnil, make_number (2), Qnil); + Fset_input_mode (Qnil, Qnil, make_fixnum (2), Qnil); { LCID input_locale_id = LOWORD (GetKeyboardLayout (0)); diff --git a/src/w32uniscribe.c b/src/w32uniscribe.c index 884b4cf8bc..149f03d6ac 100644 --- a/src/w32uniscribe.c +++ b/src/w32uniscribe.c @@ -460,21 +460,21 @@ uniscribe_shape (Lisp_Object lgstring) the direction, the Hebrew point HOLAM is drawn above the right edge of the base consonant, instead of above the left edge. */ - ASET (vec, 0, make_number (-offsets[j].du + ASET (vec, 0, make_fixnum (-offsets[j].du + adj_offset)); /* Update the adjustment value for the width advance of the glyph we just emitted. */ adj_offset -= 2 * advances[j]; } else - ASET (vec, 0, make_number (offsets[j].du + adj_offset)); + ASET (vec, 0, make_fixnum (offsets[j].du + adj_offset)); /* In the font definition coordinate system, the Y coordinate points up, while in our screen coordinates Y grows downwards. So we need to reverse the sign of Y-OFFSET here. */ - ASET (vec, 1, make_number (-offsets[j].dv)); + ASET (vec, 1, make_fixnum (-offsets[j].dv)); /* Based on what ftfont.c does... */ - ASET (vec, 2, make_number (advances[j])); + ASET (vec, 2, make_fixnum (advances[j])); LGLYPH_SET_ADJUSTMENT (lglyph, vec); } else @@ -502,7 +502,7 @@ uniscribe_shape (Lisp_Object lgstring) if (NILP (lgstring)) return Qnil; else - return make_number (done_glyphs); + return make_fixnum (done_glyphs); } /* Uniscribe implementation of encode_char for font backend. diff --git a/src/widget.c b/src/widget.c index 2d66c093eb..2e9295f1cd 100644 --- a/src/widget.c +++ b/src/widget.c @@ -282,7 +282,7 @@ set_frame_size (EmacsFrame ew) frame_size_history_add (f, Qset_frame_size, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), - list2 (make_number (ew->core.width), make_number (ew->core.height))); + list2 (make_fixnum (ew->core.width), make_fixnum (ew->core.height))); } static void @@ -421,10 +421,10 @@ EmacsFrameResize (Widget widget) frame_size_history_add (f, QEmacsFrameResize, width, height, - list5 (make_number (ew->core.width), make_number (ew->core.height), - make_number (FRAME_TOP_MARGIN_HEIGHT (f)), - make_number (FRAME_SCROLL_BAR_AREA_HEIGHT (f)), - make_number (2 * FRAME_INTERNAL_BORDER_WIDTH (f)))); + list5 (make_fixnum (ew->core.width), make_fixnum (ew->core.height), + make_fixnum (FRAME_TOP_MARGIN_HEIGHT (f)), + make_fixnum (FRAME_SCROLL_BAR_AREA_HEIGHT (f)), + make_fixnum (2 * FRAME_INTERNAL_BORDER_WIDTH (f)))); change_frame_size (f, width, height, 0, 1, 0, 1); diff --git a/src/window.c b/src/window.c index 422b06a49f..e3b0c3a66a 100644 --- a/src/window.c +++ b/src/window.c @@ -695,7 +695,7 @@ one. The window with the lowest use time is the least recently selected one. */) (Lisp_Object window) { - return make_number (decode_live_window (window)->use_time); + return make_fixnum (decode_live_window (window)->use_time); } DEFUN ("window-pixel-width", Fwindow_pixel_width, Swindow_pixel_width, 0, 1, 0, @@ -708,7 +708,7 @@ an internal window, its pixel width is the width of the screen areas spanned by its children. */) (Lisp_Object window) { - return make_number (decode_valid_window (window)->pixel_width); + return make_fixnum (decode_valid_window (window)->pixel_width); } DEFUN ("window-pixel-height", Fwindow_pixel_height, Swindow_pixel_height, 0, 1, 0, @@ -720,7 +720,7 @@ divider, if any. If WINDOW is an internal window, its pixel height is the height of the screen areas spanned by its children. */) (Lisp_Object window) { - return make_number (decode_valid_window (window)->pixel_height); + return make_fixnum (decode_valid_window (window)->pixel_height); } DEFUN ("window-pixel-width-before-size-change", @@ -734,7 +734,7 @@ The return value is the pixel width of WINDOW at the last time after that. */) (Lisp_Object window) { - return (make_number + return (make_fixnum (decode_valid_window (window)->pixel_width_before_size_change)); } @@ -749,7 +749,7 @@ The return value is the pixel height of WINDOW at the last time after that. */) (Lisp_Object window) { - return (make_number + return (make_fixnum (decode_valid_window (window)->pixel_height_before_size_change)); } @@ -778,12 +778,12 @@ total height of WINDOW. */) struct window *w = decode_valid_window (window); if (! EQ (round, Qfloor) && ! EQ (round, Qceiling)) - return make_number (w->total_lines); + return make_fixnum (w->total_lines); else { int unit = FRAME_LINE_HEIGHT (WINDOW_XFRAME (w)); - return make_number (EQ (round, Qceiling) + return make_fixnum (EQ (round, Qceiling) ? ((w->pixel_height + unit - 1) /unit) : (w->pixel_height / unit)); } @@ -815,12 +815,12 @@ total width of WINDOW. */) struct window *w = decode_valid_window (window); if (! EQ (round, Qfloor) && ! EQ (round, Qceiling)) - return make_number (w->total_cols); + return make_fixnum (w->total_cols); else { int unit = FRAME_COLUMN_WIDTH (WINDOW_XFRAME (w)); - return make_number (EQ (round, Qceiling) + return make_fixnum (EQ (round, Qceiling) ? ((w->pixel_width + unit - 1) /unit) : (w->pixel_width / unit)); } @@ -898,7 +898,7 @@ DEFUN ("window-pixel-left", Fwindow_pixel_left, Swindow_pixel_left, 0, 1, 0, WINDOW must be a valid window and defaults to the selected one. */) (Lisp_Object window) { - return make_number (decode_valid_window (window)->pixel_left); + return make_fixnum (decode_valid_window (window)->pixel_left); } DEFUN ("window-pixel-top", Fwindow_pixel_top, Swindow_pixel_top, 0, 1, 0, @@ -906,7 +906,7 @@ DEFUN ("window-pixel-top", Fwindow_pixel_top, Swindow_pixel_top, 0, 1, 0, WINDOW must be a valid window and defaults to the selected one. */) (Lisp_Object window) { - return make_number (decode_valid_window (window)->pixel_top); + return make_fixnum (decode_valid_window (window)->pixel_top); } DEFUN ("window-left-column", Fwindow_left_column, Swindow_left_column, 0, 1, 0, @@ -918,7 +918,7 @@ value is 0 if there is no window to the left of WINDOW. WINDOW must be a valid window and defaults to the selected one. */) (Lisp_Object window) { - return make_number (decode_valid_window (window)->left_col); + return make_fixnum (decode_valid_window (window)->left_col); } DEFUN ("window-top-line", Fwindow_top_line, Swindow_top_line, 0, 1, 0, @@ -930,7 +930,7 @@ there is no window above WINDOW. WINDOW must be a valid window and defaults to the selected one. */) (Lisp_Object window) { - return make_number (decode_valid_window (window)->top_line); + return make_fixnum (decode_valid_window (window)->top_line); } /* Return the number of lines/pixels of W's body. Don't count any mode @@ -997,7 +997,7 @@ means that if a line at the bottom of the text area is only partially visible, that line is not counted. */) (Lisp_Object window, Lisp_Object pixelwise) { - return make_number (window_body_height (decode_live_window (window), + return make_fixnum (window_body_height (decode_live_window (window), !NILP (pixelwise))); } @@ -1017,7 +1017,7 @@ Note that the returned value includes the column reserved for the continuation glyph. */) (Lisp_Object window, Lisp_Object pixelwise) { - return make_number (window_body_width (decode_live_window (window), + return make_fixnum (window_body_width (decode_live_window (window), !NILP (pixelwise))); } @@ -1027,7 +1027,7 @@ DEFUN ("window-mode-line-height", Fwindow_mode_line_height, WINDOW must be a live window and defaults to the selected one. */) (Lisp_Object window) { - return (make_number (WINDOW_MODE_LINE_HEIGHT (decode_live_window (window)))); + return (make_fixnum (WINDOW_MODE_LINE_HEIGHT (decode_live_window (window)))); } DEFUN ("window-header-line-height", Fwindow_header_line_height, @@ -1036,7 +1036,7 @@ DEFUN ("window-header-line-height", Fwindow_header_line_height, WINDOW must be a live window and defaults to the selected one. */) (Lisp_Object window) { - return (make_number (WINDOW_HEADER_LINE_HEIGHT (decode_live_window (window)))); + return (make_fixnum (WINDOW_HEADER_LINE_HEIGHT (decode_live_window (window)))); } DEFUN ("window-right-divider-width", Fwindow_right_divider_width, @@ -1045,7 +1045,7 @@ DEFUN ("window-right-divider-width", Fwindow_right_divider_width, WINDOW must be a live window and defaults to the selected one. */) (Lisp_Object window) { - return (make_number (WINDOW_RIGHT_DIVIDER_WIDTH (decode_live_window (window)))); + return (make_fixnum (WINDOW_RIGHT_DIVIDER_WIDTH (decode_live_window (window)))); } DEFUN ("window-bottom-divider-width", Fwindow_bottom_divider_width, @@ -1054,7 +1054,7 @@ DEFUN ("window-bottom-divider-width", Fwindow_bottom_divider_width, WINDOW must be a live window and defaults to the selected one. */) (Lisp_Object window) { - return (make_number (WINDOW_BOTTOM_DIVIDER_WIDTH (decode_live_window (window)))); + return (make_fixnum (WINDOW_BOTTOM_DIVIDER_WIDTH (decode_live_window (window)))); } DEFUN ("window-scroll-bar-width", Fwindow_scroll_bar_width, @@ -1063,7 +1063,7 @@ DEFUN ("window-scroll-bar-width", Fwindow_scroll_bar_width, WINDOW must be a live window and defaults to the selected one. */) (Lisp_Object window) { - return (make_number (WINDOW_SCROLL_BAR_AREA_WIDTH (decode_live_window (window)))); + return (make_fixnum (WINDOW_SCROLL_BAR_AREA_WIDTH (decode_live_window (window)))); } DEFUN ("window-scroll-bar-height", Fwindow_scroll_bar_height, @@ -1072,7 +1072,7 @@ DEFUN ("window-scroll-bar-height", Fwindow_scroll_bar_height, WINDOW must be a live window and defaults to the selected one. */) (Lisp_Object window) { - return (make_number (WINDOW_SCROLL_BAR_AREA_HEIGHT (decode_live_window (window)))); + return (make_fixnum (WINDOW_SCROLL_BAR_AREA_HEIGHT (decode_live_window (window)))); } DEFUN ("window-hscroll", Fwindow_hscroll, Swindow_hscroll, 0, 1, 0, @@ -1080,7 +1080,7 @@ DEFUN ("window-hscroll", Fwindow_hscroll, Swindow_hscroll, 0, 1, 0, WINDOW must be a live window and defaults to the selected one. */) (Lisp_Object window) { - return make_number (decode_live_window (window)->hscroll); + return make_fixnum (decode_live_window (window)->hscroll); } /* Set W's horizontal scroll amount to HSCROLL clipped to a reasonable @@ -1104,7 +1104,7 @@ set_window_hscroll (struct window *w, EMACS_INT hscroll) w->hscroll = new_hscroll; w->suspend_auto_hscroll = true; - return make_number (new_hscroll); + return make_fixnum (new_hscroll); } DEFUN ("set-window-hscroll", Fset_window_hscroll, Sset_window_hscroll, 2, 2, 0, @@ -1117,7 +1117,7 @@ Note that if `automatic-hscrolling' is non-nil, you cannot scroll the window so that the location of point moves off-window. */) (Lisp_Object window, Lisp_Object ncol) { - CHECK_NUMBER (ncol); + CHECK_FIXNUM (ncol); return set_window_hscroll (decode_live_window (window), XINT (ncol)); } @@ -1383,8 +1383,8 @@ If they are in the windows's left or right marginal areas, `left-margin'\n\ CHECK_CONS (coordinates); lx = Fcar (coordinates); ly = Fcdr (coordinates); - CHECK_NUMBER_OR_FLOAT (lx); - CHECK_NUMBER_OR_FLOAT (ly); + CHECK_FIXNUM_OR_FLOAT (lx); + CHECK_FIXNUM_OR_FLOAT (ly); x = FRAME_PIXEL_X_FROM_CANON_X (f, lx) + FRAME_INTERNAL_BORDER_WIDTH (f); y = FRAME_PIXEL_Y_FROM_CANON_Y (f, ly) + FRAME_INTERNAL_BORDER_WIDTH (f); @@ -1534,8 +1534,8 @@ column 0. */) struct frame *f = decode_live_frame (frame); /* Check that arguments are integers or floats. */ - CHECK_NUMBER_OR_FLOAT (x); - CHECK_NUMBER_OR_FLOAT (y); + CHECK_FIXNUM_OR_FLOAT (x); + CHECK_FIXNUM_OR_FLOAT (y); return window_from_coordinates (f, (FRAME_PIXEL_X_FROM_CANON_X (f, x) @@ -1561,7 +1561,7 @@ correct to return the top-level value of `point', outside of any register struct window *w = decode_live_window (window); if (w == XWINDOW (selected_window)) - return make_number (BUF_PT (XBUFFER (w->contents))); + return make_fixnum (BUF_PT (XBUFFER (w->contents))); else return Fmarker_position (w->pointm); } @@ -1652,7 +1652,7 @@ if it isn't already recorded. */) move_it_vertically (&it, window_box_height (w)); if (it.current_y < it.last_visible_y) move_it_past_eol (&it); - value = make_number (IT_CHARPOS (it)); + value = make_fixnum (IT_CHARPOS (it)); bidi_unshelve_cache (itdata, false); if (old_buffer) @@ -1683,7 +1683,7 @@ Return POS. */) struct buffer *old_buffer = current_buffer; /* ... but here we want to catch type error before buffer change. */ - CHECK_NUMBER_COERCE_MARKER (pos); + CHECK_FIXNUM_COERCE_MARKER (pos); set_buffer_internal (XBUFFER (w->contents)); Fgoto_char (pos); set_buffer_internal (old_buffer); @@ -1763,7 +1763,7 @@ POS, ROWH is the visible height of that row, and VPOS is the row number posint = -1; else if (!NILP (pos)) { - CHECK_NUMBER_COERCE_MARKER (pos); + CHECK_FIXNUM_COERCE_MARKER (pos); posint = XINT (pos); } else if (w == XWINDOW (selected_window)) @@ -1789,8 +1789,8 @@ POS, ROWH is the visible height of that row, and VPOS is the row number Lisp_Object part = Qnil; if (!fully_p) part = list4i (rtop, rbot, rowh, vpos); - in_window = Fcons (make_number (x), - Fcons (make_number (y), part)); + in_window = Fcons (make_fixnum (x), + Fcons (make_fixnum (y), part)); } return in_window; @@ -1869,7 +1869,7 @@ Return nil if window display is not up-to-date. In that case, use : Qnil); } - CHECK_NUMBER (line); + CHECK_FIXNUM (line); n = XINT (line); row = MATRIX_FIRST_TEXT_ROW (w->current_matrix); @@ -1972,7 +1972,7 @@ though when run from an idle timer with a delay of zero seconds. */) row = (NILP (body) ? MATRIX_ROW (w->current_matrix, 0) : MATRIX_FIRST_TEXT_ROW (w->current_matrix)); - else if (NUMBERP (first)) + else if (FIXED_OR_FLOATP (first)) { CHECK_RANGED_INTEGER (first, 0, w->current_matrix->nrows); row = MATRIX_ROW (w->current_matrix, XINT (first)); @@ -1985,7 +1985,7 @@ though when run from an idle timer with a delay of zero seconds. */) end_row = (NILP (body) ? MATRIX_ROW (w->current_matrix, w->current_matrix->nrows) : MATRIX_BOTTOM_TEXT_ROW (w->current_matrix, w)); - else if (NUMBERP (last)) + else if (FIXED_OR_FLOATP (last)) { CHECK_RANGED_INTEGER (last, 0, w->current_matrix->nrows); end_row = MATRIX_ROW (w->current_matrix, XINT (last)); @@ -2001,19 +2001,19 @@ though when run from an idle timer with a delay of zero seconds. */) { struct glyph *glyph = row->glyphs[TEXT_AREA]; - rows = Fcons (Fcons (make_number + rows = Fcons (Fcons (make_fixnum (invert ? glyph->pixel_width : window_width - glyph->pixel_width), - make_number (row->y + row->height - subtract)), + make_fixnum (row->y + row->height - subtract)), rows); } else - rows = Fcons (Fcons (make_number + rows = Fcons (Fcons (make_fixnum (invert ? window_width - row->pixel_width : row->pixel_width), - make_number (row->y + row->height - subtract)), + make_fixnum (row->y + row->height - subtract)), rows); row++; } @@ -2492,7 +2492,7 @@ candidate_window_p (Lisp_Object window, Lisp_Object owindow, == FRAME_TERMINAL (XFRAME (selected_frame))); } - else if (INTEGERP (all_frames) && XINT (all_frames) == 0) + else if (FIXNUMP (all_frames) && XINT (all_frames) == 0) { candidate_p = (FRAME_VISIBLE_P (f) || FRAME_ICONIFIED_P (f) #ifdef HAVE_X_WINDOWS @@ -2551,7 +2551,7 @@ decode_next_window_args (Lisp_Object *window, Lisp_Object *minibuf, Lisp_Object : Qnil); else if (EQ (*all_frames, Qvisible)) ; - else if (EQ (*all_frames, make_number (0))) + else if (EQ (*all_frames, make_fixnum (0))) ; else if (FRAMEP (*all_frames)) ; @@ -2834,7 +2834,7 @@ window_loop (enum window_loop type, Lisp_Object obj, bool mini, if (f) frame_arg = Qlambda; - else if (EQ (frames, make_number (0))) + else if (EQ (frames, make_fixnum (0))) frame_arg = frames; else if (EQ (frames, Qvisible)) frame_arg = frames; @@ -3494,8 +3494,8 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer, b->display_error_modiff = 0; /* Update time stamps of buffer display. */ - if (INTEGERP (BVAR (b, display_count))) - bset_display_count (b, make_number (XINT (BVAR (b, display_count)) + 1)); + if (FIXNUMP (BVAR (b, display_count))) + bset_display_count (b, make_fixnum (XINT (BVAR (b, display_count)) + 1)); bset_display_time (b, Fcurrent_time ()); w->window_end_pos = 0; @@ -3513,7 +3513,7 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer, set_marker_both (w->pointm, buffer, BUF_PT (b), BUF_PT_BYTE (b)); set_marker_both (w->old_pointm, buffer, BUF_PT (b), BUF_PT_BYTE (b)); set_marker_restricted (w->start, - make_number (b->last_window_start), + make_fixnum (b->last_window_start), buffer); w->start_at_line_beg = false; w->force_start = false; @@ -3769,9 +3769,9 @@ make_window (void) Lisp data to nil, so do it only for slots which should not be nil. */ wset_normal_lines (w, make_float (1.0)); wset_normal_cols (w, make_float (1.0)); - wset_new_total (w, make_number (0)); - wset_new_normal (w, make_number (0)); - wset_new_pixel (w, make_number (0)); + wset_new_total (w, make_fixnum (0)); + wset_new_normal (w, make_fixnum (0)); + wset_new_pixel (w, make_fixnum (0)); wset_start (w, Fmake_marker ()); wset_pointm (w, Fmake_marker ()); wset_old_pointm (w, Fmake_marker ()); @@ -3827,7 +3827,7 @@ Note: This function does not operate on any child windows of WINDOW. */) if (NILP (add)) wset_new_pixel (w, size); else - wset_new_pixel (w, make_number (XINT (w->new_pixel) + XINT (size))); + wset_new_pixel (w, make_fixnum (XINT (w->new_pixel) + XINT (size))); return w->new_pixel; } @@ -3849,11 +3849,11 @@ Note: This function does not operate on any child windows of WINDOW. */) { struct window *w = decode_valid_window (window); - CHECK_NUMBER (size); + CHECK_FIXNUM (size); if (NILP (add)) wset_new_total (w, size); else - wset_new_total (w, make_number (XINT (w->new_total) + XINT (size))); + wset_new_total (w, make_fixnum (XINT (w->new_total) + XINT (size))); return w->new_total; } @@ -3994,7 +3994,7 @@ window_resize_apply (struct window *w, bool horflag) { w->pixel_width = XFASTINT (w->new_pixel); w->total_cols = w->pixel_width / unit; - if (NUMBERP (w->new_normal)) + if (FIXED_OR_FLOATP (w->new_normal)) wset_normal_cols (w, w->new_normal); edge = w->pixel_left; @@ -4003,7 +4003,7 @@ window_resize_apply (struct window *w, bool horflag) { w->pixel_height = XFASTINT (w->new_pixel); w->total_lines = w->pixel_height / unit; - if (NUMBERP (w->new_normal)) + if (FIXED_OR_FLOATP (w->new_normal)) wset_normal_lines (w, w->new_normal); edge = w->pixel_top; @@ -4369,7 +4369,7 @@ set correctly. See the code of `split-window' for how this is done. */) frame = WINDOW_FRAME (o); f = XFRAME (frame); - CHECK_NUMBER (pixel_size); + CHECK_FIXNUM (pixel_size); EMACS_INT total_size = XINT (pixel_size) / (horflag ? FRAME_COLUMN_WIDTH (f) @@ -4406,13 +4406,13 @@ set correctly. See the code of `split-window' for how this is done. */) p = XWINDOW (o->parent); /* Temporarily pretend we split the parent window. */ wset_new_pixel - (p, make_number ((horflag ? p->pixel_width : p->pixel_height) + (p, make_fixnum ((horflag ? p->pixel_width : p->pixel_height) - XINT (pixel_size))); if (!window_resize_check (p, horflag)) error ("Window sizes don't fit"); else /* Undo the temporary pretension. */ - wset_new_pixel (p, make_number (horflag ? p->pixel_width : p->pixel_height)); + wset_new_pixel (p, make_fixnum (horflag ? p->pixel_width : p->pixel_height)); } else { @@ -4440,9 +4440,9 @@ set correctly. See the code of `split-window' for how this is done. */) wset_combination_limit (p, Qt); /* These get applied below. */ wset_new_pixel - (p, make_number (horflag ? o->pixel_width : o->pixel_height)); + (p, make_fixnum (horflag ? o->pixel_width : o->pixel_height)); wset_new_total - (p, make_number (horflag ? o->total_cols : o->total_lines)); + (p, make_fixnum (horflag ? o->total_cols : o->total_lines)); wset_new_normal (p, new_normal); } else @@ -4514,7 +4514,7 @@ set correctly. See the code of `split-window' for how this is done. */) sum = sum + XINT (c->new_total); c = NILP (c->next) ? 0 : XWINDOW (c->next); } - wset_new_total (n, make_number ((horflag + wset_new_total (n, make_fixnum ((horflag ? p->total_cols : p->total_lines) - sum)); @@ -4727,8 +4727,8 @@ grow_mini_window (struct window *w, int delta, bool pixelwise) root = FRAME_ROOT_WINDOW (f); r = XWINDOW (root); height = call3 (Qwindow__resize_root_window_vertically, - root, make_number (- delta), pixelwise ? Qt : Qnil); - if (INTEGERP (height) && window_resize_check (r, false)) + root, make_fixnum (- delta), pixelwise ? Qt : Qnil); + if (FIXNUMP (height) && window_resize_check (r, false)) { block_input (); window_resize_apply (r, false); @@ -4784,9 +4784,9 @@ shrink_mini_window (struct window *w, bool pixelwise) root = FRAME_ROOT_WINDOW (f); r = XWINDOW (root); delta = call3 (Qwindow__resize_root_window_vertically, - root, make_number (height - unit), + root, make_fixnum (height - unit), pixelwise ? Qt : Qnil); - if (INTEGERP (delta) && window_resize_check (r, false)) + if (FIXNUMP (delta) && window_resize_check (r, false)) { block_input (); window_resize_apply (r, false); @@ -5105,7 +5105,7 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) if (w->vscroll < 0 && rtop > 0) { px = max (0, -w->vscroll - min (rtop, -dy)); - Fset_window_vscroll (window, make_number (px), Qt); + Fset_window_vscroll (window, make_fixnum (px), Qt); return; } } @@ -5115,7 +5115,7 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) if (rbot > 0 && (w->vscroll < 0 || vpos == 0)) { px = max (0, -w->vscroll + min (rbot, dy)); - Fset_window_vscroll (window, make_number (px), Qt); + Fset_window_vscroll (window, make_fixnum (px), Qt); return; } @@ -5124,14 +5124,14 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) { ptrdiff_t spos; - Fset_window_vscroll (window, make_number (0), Qt); + Fset_window_vscroll (window, make_fixnum (0), Qt); /* If there are other text lines above the current row, move window start to current row. Else to next row. */ if (rbot > 0) spos = XINT (Fline_beginning_position (Qnil)); else spos = min (XINT (Fline_end_position (Qnil)) + 1, ZV); - set_marker_restricted (w->start, make_number (spos), + set_marker_restricted (w->start, make_fixnum (spos), w->contents); w->start_at_line_beg = true; wset_update_mode_line (w); @@ -5143,7 +5143,7 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) } } /* Cancel previous vscroll. */ - Fset_window_vscroll (window, make_number (0), Qt); + Fset_window_vscroll (window, make_fixnum (0), Qt); } itdata = bidi_shelve_cache (); @@ -5448,7 +5448,7 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) if (adjust_old_pointm) Fset_marker (w->old_pointm, ((w == XWINDOW (selected_window)) - ? make_number (BUF_PT (XBUFFER (w->contents))) + ? make_fixnum (BUF_PT (XBUFFER (w->contents))) : Fmarker_position (w->pointm)), w->contents); } @@ -5497,8 +5497,8 @@ window_scroll_line_based (Lisp_Object window, int n, bool whole, bool noerror) window_scroll_preserve_hpos = posit.hpos + w->hscroll; } - original_pos = Fcons (make_number (window_scroll_preserve_hpos), - make_number (window_scroll_preserve_vpos)); + original_pos = Fcons (make_fixnum (window_scroll_preserve_hpos), + make_fixnum (window_scroll_preserve_vpos)); } XSETFASTINT (tem, PT); @@ -5506,14 +5506,14 @@ window_scroll_line_based (Lisp_Object window, int n, bool whole, bool noerror) if (NILP (tem)) { - Fvertical_motion (make_number (- (ht / 2)), window, Qnil); + Fvertical_motion (make_fixnum (- (ht / 2)), window, Qnil); startpos = PT; startbyte = PT_BYTE; } SET_PT_BOTH (startpos, startbyte); lose = n < 0 && PT == BEGV; - Fvertical_motion (make_number (n), window, Qnil); + Fvertical_motion (make_fixnum (n), window, Qnil); pos = PT; pos_byte = PT_BYTE; bolp = Fbolp (); @@ -5555,7 +5555,7 @@ window_scroll_line_based (Lisp_Object window, int n, bool whole, bool noerror) if (this_scroll_margin > 0) { SET_PT_BOTH (pos, pos_byte); - Fvertical_motion (make_number (this_scroll_margin), window, Qnil); + Fvertical_motion (make_fixnum (this_scroll_margin), window, Qnil); top_margin = PT; } else @@ -5574,8 +5574,8 @@ window_scroll_line_based (Lisp_Object window, int n, bool whole, bool noerror) else if (window_scroll_preserve_vpos >= w->total_lines - this_scroll_margin) nlines = w->total_lines - this_scroll_margin - 1; - Fvertical_motion (Fcons (make_number (window_scroll_preserve_hpos), - make_number (nlines)), window, Qnil); + Fvertical_motion (Fcons (make_fixnum (window_scroll_preserve_hpos), + make_fixnum (nlines)), window, Qnil); } else SET_PT (top_margin); @@ -5587,7 +5587,7 @@ window_scroll_line_based (Lisp_Object window, int n, bool whole, bool noerror) /* If we scrolled backward, put point near the end of the window but not within the scroll margin. */ SET_PT_BOTH (pos, pos_byte); - tem = Fvertical_motion (make_number (ht - this_scroll_margin), window, + tem = Fvertical_motion (make_fixnum (ht - this_scroll_margin), window, Qnil); if (XFASTINT (tem) == ht - this_scroll_margin) bottom_margin = PT; @@ -5609,11 +5609,11 @@ window_scroll_line_based (Lisp_Object window, int n, bool whole, bool noerror) else if (window_scroll_preserve_vpos >= ht - this_scroll_margin) nlines = ht - this_scroll_margin - 1; - Fvertical_motion (Fcons (make_number (window_scroll_preserve_hpos), - make_number (nlines)), window, Qnil); + Fvertical_motion (Fcons (make_fixnum (window_scroll_preserve_hpos), + make_fixnum (nlines)), window, Qnil); } else - Fvertical_motion (make_number (-1), window, Qnil); + Fvertical_motion (make_fixnum (-1), window, Qnil); } } } @@ -5628,7 +5628,7 @@ window_scroll_line_based (Lisp_Object window, int n, bool whole, bool noerror) if (adjust_old_pointm) Fset_marker (w->old_pointm, ((w == XWINDOW (selected_window)) - ? make_number (BUF_PT (XBUFFER (w->contents))) + ? make_fixnum (BUF_PT (XBUFFER (w->contents))) : Fmarker_position (w->pointm)), w->contents); } @@ -5961,7 +5961,7 @@ and redisplay normally--don't erase and redraw the frame. */) else { arg = Fprefix_numeric_value (arg); - CHECK_NUMBER (arg); + CHECK_FIXNUM (arg); iarg = XINT (arg); } @@ -6139,10 +6139,10 @@ pixels. */) struct window *w = decode_live_window (window); if (NILP (pixelwise)) - return make_number (window_box_width (w, TEXT_AREA) + return make_fixnum (window_box_width (w, TEXT_AREA) / FRAME_COLUMN_WIDTH (WINDOW_XFRAME (w))); else - return make_number (window_box_width (w, TEXT_AREA)); + return make_fixnum (window_box_width (w, TEXT_AREA)); } DEFUN ("window-text-height", Fwindow_text_height, Swindow_text_height, @@ -6160,10 +6160,10 @@ pixels. */) struct window *w = decode_live_window (window); if (NILP (pixelwise)) - return make_number (window_box_height (w) + return make_fixnum (window_box_height (w) / FRAME_LINE_HEIGHT (WINDOW_XFRAME (w))); else - return make_number (window_box_height (w)); + return make_fixnum (window_box_height (w)); } DEFUN ("move-to-window-line", Fmove_to_window_line, Smove_to_window_line, @@ -6196,7 +6196,7 @@ from the top of the window. */) if (start < BEGV || start > ZV) { int height = window_internal_height (w); - Fvertical_motion (make_number (- (height / 2)), window, Qnil); + Fvertical_motion (make_fixnum (- (height / 2)), window, Qnil); set_marker_both (w->start, w->contents, PT, PT_BYTE); w->start_at_line_beg = !NILP (Fbolp ()); w->force_start = true; @@ -6228,7 +6228,7 @@ from the top of the window. */) iarg = min (iarg, lines - this_scroll_margin - 1); #endif - arg = make_number (iarg); + arg = make_fixnum (iarg); } /* Skip past a partially visible first line. */ @@ -6611,7 +6611,7 @@ the return value is nil. Otherwise the value is t. */) current when the window configuration was saved. */ if (EQ (XWINDOW (data->current_window)->contents, new_current_buffer)) set_marker_restricted (XWINDOW (data->current_window)->pointm, - make_number (old_point), + make_fixnum (old_point), XWINDOW (data->current_window)->contents); /* In the following call to select_window, prevent "swapping out @@ -6715,7 +6715,7 @@ the return value is nil. Otherwise the value is t. */) the "normal" frame's selected window and that window *does* show new_current_buffer. */ if (!EQ (XWINDOW (selected_window)->contents, new_current_buffer)) - Fgoto_char (make_number (old_point)); + Fgoto_char (make_fixnum (old_point)); } Vminibuf_scroll_window = data->minibuf_scroll_window; @@ -6850,21 +6850,21 @@ save_window_save (Lisp_Object window, struct Lisp_Vector *vector, ptrdiff_t i) p = SAVED_WINDOW_N (vector, i); w = XWINDOW (window); - wset_temslot (w, make_number (i)); i++; + wset_temslot (w, make_fixnum (i)); i++; p->window = window; p->buffer = (WINDOW_LEAF_P (w) ? w->contents : Qnil); - p->pixel_left = make_number (w->pixel_left); - p->pixel_top = make_number (w->pixel_top); - p->pixel_width = make_number (w->pixel_width); - p->pixel_height = make_number (w->pixel_height); + p->pixel_left = make_fixnum (w->pixel_left); + p->pixel_top = make_fixnum (w->pixel_top); + p->pixel_width = make_fixnum (w->pixel_width); + p->pixel_height = make_fixnum (w->pixel_height); p->pixel_width_before_size_change - = make_number (w->pixel_width_before_size_change); + = make_fixnum (w->pixel_width_before_size_change); p->pixel_height_before_size_change - = make_number (w->pixel_height_before_size_change); - p->left_col = make_number (w->left_col); - p->top_line = make_number (w->top_line); - p->total_cols = make_number (w->total_cols); - p->total_lines = make_number (w->total_lines); + = make_fixnum (w->pixel_height_before_size_change); + p->left_col = make_fixnum (w->left_col); + p->top_line = make_fixnum (w->top_line); + p->total_cols = make_fixnum (w->total_cols); + p->total_lines = make_fixnum (w->total_lines); p->normal_cols = w->normal_cols; p->normal_lines = w->normal_lines; XSETFASTINT (p->hscroll, w->hscroll); @@ -6872,13 +6872,13 @@ save_window_save (Lisp_Object window, struct Lisp_Vector *vector, ptrdiff_t i) XSETFASTINT (p->min_hscroll, w->min_hscroll); XSETFASTINT (p->hscroll_whole, w->hscroll_whole); p->display_table = w->display_table; - p->left_margin_cols = make_number (w->left_margin_cols); - p->right_margin_cols = make_number (w->right_margin_cols); - p->left_fringe_width = make_number (w->left_fringe_width); - p->right_fringe_width = make_number (w->right_fringe_width); + p->left_margin_cols = make_fixnum (w->left_margin_cols); + p->right_margin_cols = make_fixnum (w->right_margin_cols); + p->left_fringe_width = make_fixnum (w->left_fringe_width); + p->right_fringe_width = make_fixnum (w->right_fringe_width); p->fringes_outside_margins = w->fringes_outside_margins ? Qt : Qnil; - p->scroll_bar_width = make_number (w->scroll_bar_width); - p->scroll_bar_height = make_number (w->scroll_bar_height); + p->scroll_bar_width = make_fixnum (w->scroll_bar_width); + p->scroll_bar_height = make_fixnum (w->scroll_bar_height); p->vertical_scroll_bar_type = w->vertical_scroll_bar_type; p->horizontal_scroll_bar_type = w->horizontal_scroll_bar_type; p->dedicated = w->dedicated; @@ -7013,7 +7013,7 @@ saved by this function. */) data->saved_windows = tem; for (i = 0; i < n_windows; i++) ASET (tem, i, - Fmake_vector (make_number (VECSIZE (struct saved_window)), Qnil)); + Fmake_vector (make_fixnum (VECSIZE (struct saved_window)), Qnil)); save_window_save (FRAME_ROOT_WINDOW (f), XVECTOR (tem), 0); XSETWINDOW_CONFIGURATION (tem, data); return (tem); @@ -7105,9 +7105,9 @@ as nil. */) { struct window *w = decode_live_window (window); return Fcons (w->left_margin_cols - ? make_number (w->left_margin_cols) : Qnil, + ? make_fixnum (w->left_margin_cols) : Qnil, w->right_margin_cols - ? make_number (w->right_margin_cols) : Qnil); + ? make_fixnum (w->right_margin_cols) : Qnil); } @@ -7186,8 +7186,8 @@ Value is a list of the form (LEFT-WIDTH RIGHT-WIDTH OUTSIDE-MARGINS). */) { struct window *w = decode_live_window (window); - return list3 (make_number (WINDOW_LEFT_FRINGE_WIDTH (w)), - make_number (WINDOW_RIGHT_FRINGE_WIDTH (w)), + return list3 (make_fixnum (WINDOW_LEFT_FRINGE_WIDTH (w)), + make_fixnum (WINDOW_RIGHT_FRINGE_WIDTH (w)), WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w) ? Qt : Qnil); } @@ -7309,14 +7309,14 @@ value. */) struct window *w = decode_live_window (window); return Fcons (((w->scroll_bar_width >= 0) - ? make_number (w->scroll_bar_width) + ? make_fixnum (w->scroll_bar_width) : Qnil), - list5 (make_number (WINDOW_SCROLL_BAR_COLS (w)), + list5 (make_fixnum (WINDOW_SCROLL_BAR_COLS (w)), w->vertical_scroll_bar_type, ((w->scroll_bar_height >= 0) - ? make_number (w->scroll_bar_height) + ? make_fixnum (w->scroll_bar_height) : Qnil), - make_number (WINDOW_SCROLL_BAR_LINES (w)), + make_fixnum (WINDOW_SCROLL_BAR_LINES (w)), w->horizontal_scroll_bar_type)); } @@ -7338,9 +7338,9 @@ optional second arg PIXELS-P means value is measured in pixels. */) if (FRAME_WINDOW_P (f)) result = (NILP (pixels_p) ? FRAME_CANON_Y_FROM_PIXEL_Y (f, -w->vscroll) - : make_number (-w->vscroll)); + : make_fixnum (-w->vscroll)); else - result = make_number (0); + result = make_fixnum (0); return result; } @@ -7360,7 +7360,7 @@ If PIXELS-P is non-nil, the return value is VSCROLL. */) struct window *w = decode_live_window (window); struct frame *f = XFRAME (w->frame); - CHECK_NUMBER_OR_FLOAT (vscroll); + CHECK_FIXNUM_OR_FLOAT (vscroll); if (FRAME_WINDOW_P (f)) { diff --git a/src/xdisp.c b/src/xdisp.c index 9b4febdd61..4af0a6d2e3 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -1214,7 +1214,7 @@ Value is the height in pixels of the line at point. */) move_it_by_lines (&it, 0); it.vpos = it.current_y = 0; last_height = 0; - result = make_number (line_bottom_y (&it)); + result = make_fixnum (line_bottom_y (&it)); if (old_buffer) set_buffer_internal_1 (old_buffer); @@ -1250,7 +1250,7 @@ default_line_pixel_height (struct window *w) val = BVAR (&buffer_defaults, extra_line_spacing); if (!NILP (val)) { - if (RANGED_INTEGERP (0, val, INT_MAX)) + if (RANGED_FIXNUMP (0, val, INT_MAX)) height += XFASTINT (val); else if (FLOATP (val)) { @@ -1507,7 +1507,7 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y, } else if (IT_CHARPOS (it) != charpos) { - Lisp_Object cpos = make_number (charpos); + Lisp_Object cpos = make_fixnum (charpos); Lisp_Object spec = Fget_char_property (cpos, Qdisplay, Qnil); Lisp_Object string = string_from_display_spec (spec); struct text_pos tpos; @@ -2842,7 +2842,7 @@ init_iterator (struct it *it, struct window *w, if (base_face_id == DEFAULT_FACE_ID && FRAME_WINDOW_P (it->f)) { - if (NATNUMP (BVAR (current_buffer, extra_line_spacing))) + if (FIXNATP (BVAR (current_buffer, extra_line_spacing))) it->extra_line_spacing = XFASTINT (BVAR (current_buffer, extra_line_spacing)); else if (FLOATP (BVAR (current_buffer, extra_line_spacing))) it->extra_line_spacing = (XFLOAT_DATA (BVAR (current_buffer, extra_line_spacing)) @@ -2868,7 +2868,7 @@ init_iterator (struct it *it, struct window *w, /* -1 means everything between a CR and the following line end is invisible. >0 means lines indented more than this value are invisible. */ - it->selective = (INTEGERP (BVAR (current_buffer, selective_display)) + it->selective = (FIXNUMP (BVAR (current_buffer, selective_display)) ? (clip_to_bounds (-1, XINT (BVAR (current_buffer, selective_display)), PTRDIFF_MAX)) @@ -2889,7 +2889,7 @@ init_iterator (struct it *it, struct window *w, && XMARKER (w->redisplay_end_trigger)->buffer != 0) it->redisplay_end_trigger_charpos = marker_position (w->redisplay_end_trigger); - else if (INTEGERP (w->redisplay_end_trigger)) + else if (FIXNUMP (w->redisplay_end_trigger)) it->redisplay_end_trigger_charpos = clip_to_bounds (PTRDIFF_MIN, XINT (w->redisplay_end_trigger), PTRDIFF_MAX); @@ -2903,7 +2903,7 @@ init_iterator (struct it *it, struct window *w, && !it->w->hscroll && (WINDOW_FULL_WIDTH_P (it->w) || NILP (Vtruncate_partial_width_windows) - || (INTEGERP (Vtruncate_partial_width_windows) + || (FIXNUMP (Vtruncate_partial_width_windows) /* PXW: Shall we do something about this? */ && (XINT (Vtruncate_partial_width_windows) <= WINDOW_TOTAL_COLS (it->w)))) @@ -3188,11 +3188,11 @@ in_ellipses_for_invisible_text_p (struct display_pos *pos, struct window *w) && CHARPOS (pos->string_pos) < 0 && charpos > BEGV && (XSETWINDOW (window, w), - prop = Fget_char_property (make_number (charpos), + prop = Fget_char_property (make_fixnum (charpos), Qinvisible, window), TEXT_PROP_MEANS_INVISIBLE (prop) == 0)) { - prop = Fget_char_property (make_number (charpos - 1), Qinvisible, + prop = Fget_char_property (make_fixnum (charpos - 1), Qinvisible, window); ellipses_p = 2 == TEXT_PROP_MEANS_INVISIBLE (prop); } @@ -3577,12 +3577,12 @@ compute_stop_pos (struct it *it) /* Set up variables for computing the stop position from text property changes. */ XSETBUFFER (object, current_buffer); - limit = make_number (IT_CHARPOS (*it) + TEXT_PROP_DISTANCE_LIMIT); + limit = make_fixnum (IT_CHARPOS (*it) + TEXT_PROP_DISTANCE_LIMIT); } /* Get the interval containing IT's position. Value is a null interval if there isn't such an interval. */ - position = make_number (charpos); + position = make_fixnum (charpos); iv = validate_interval_range (object, &position, &position, false); if (iv) { @@ -3616,7 +3616,7 @@ compute_stop_pos (struct it *it) if (next_iv) { - if (INTEGERP (limit) + if (FIXNUMP (limit) && next_iv->position >= XFASTINT (limit)) /* No text property change up to limit. */ it->stop_charpos = min (XFASTINT (limit), it->stop_charpos); @@ -3734,7 +3734,7 @@ compute_display_string_pos (struct text_pos *position, /* If the character at CHARPOS is where the display string begins, return CHARPOS. */ - pos = make_number (charpos); + pos = make_fixnum (charpos); if (STRINGP (object)) bufpos = string->bufpos; else @@ -3742,7 +3742,7 @@ compute_display_string_pos (struct text_pos *position, tpos = *position; if (!NILP (spec = Fget_char_property (pos, Qdisplay, object)) && (charpos <= begb - || !EQ (Fget_char_property (make_number (charpos - 1), Qdisplay, + || !EQ (Fget_char_property (make_fixnum (charpos - 1), Qdisplay, object), spec)) && (rv = handle_display_spec (NULL, spec, object, Qnil, &tpos, bufpos, @@ -3755,7 +3755,7 @@ compute_display_string_pos (struct text_pos *position, /* Look forward for the first character with a `display' property that will replace the underlying text when displayed. */ - limpos = make_number (lim); + limpos = make_fixnum (lim); do { pos = Fnext_single_char_property_change (pos, Qdisplay, object1, limpos); CHARPOS (tpos) = XFASTINT (pos); @@ -3791,7 +3791,7 @@ compute_display_string_end (ptrdiff_t charpos, struct bidi_string_data *string) /* OBJECT = nil means current buffer. */ Lisp_Object object = (string && STRINGP (string->lstring)) ? string->lstring : Qnil; - Lisp_Object pos = make_number (charpos); + Lisp_Object pos = make_fixnum (charpos); ptrdiff_t eob = (STRINGP (object) || (string && string->s)) ? string->schars : ZV; @@ -3849,7 +3849,7 @@ handle_fontified_prop (struct it *it) && it->s == NULL && !NILP (Vfontification_functions) && !NILP (Vrun_hooks) - && (pos = make_number (IT_CHARPOS (*it)), + && (pos = make_fixnum (IT_CHARPOS (*it)), prop = Fget_char_property (pos, Qfontified, Qnil), /* Ignore the special cased nil value always present at EOB since no amount of fontifying will be able to change it. */ @@ -4349,7 +4349,7 @@ handle_invisible_prop (struct it *it) /* Get the value of the invisible text property at the current position. Value will be nil if there is no such property. */ - end_charpos = make_number (IT_STRING_CHARPOS (*it)); + end_charpos = make_fixnum (IT_STRING_CHARPOS (*it)); prop = Fget_text_property (end_charpos, Qinvisible, it->string); invis = TEXT_PROP_MEANS_INVISIBLE (prop); @@ -4373,8 +4373,8 @@ handle_invisible_prop (struct it *it) it->string, limit); /* Since LIMIT is always an integer, so should be the value returned by Fnext_single_property_change. */ - eassert (INTEGERP (end_charpos)); - if (INTEGERP (end_charpos)) + eassert (FIXNUMP (end_charpos)); + if (FIXNUMP (end_charpos)) { endpos = XFASTINT (end_charpos); prop = Fget_text_property (end_charpos, Qinvisible, it->string); @@ -4452,7 +4452,7 @@ handle_invisible_prop (struct it *it) /* First of all, is there invisible text at this position? */ tem = start_charpos = IT_CHARPOS (*it); - pos = make_number (tem); + pos = make_fixnum (tem); prop = get_char_property_and_overlay (pos, Qinvisible, it->window, &overlay); invis = TEXT_PROP_MEANS_INVISIBLE (prop); @@ -4490,7 +4490,7 @@ handle_invisible_prop (struct it *it) the char before the given position, i.e. if we get invis = 0, this means that the char at newpos is visible. */ - pos = make_number (newpos); + pos = make_fixnum (newpos); prop = Fget_char_property (pos, Qinvisible, it->window); invis = TEXT_PROP_MEANS_INVISIBLE (prop); } @@ -4745,7 +4745,7 @@ handle_display_prop (struct it *it) if (!it->string_from_display_prop_p) it->area = TEXT_AREA; - propval = get_char_property_and_overlay (make_number (position->charpos), + propval = get_char_property_and_overlay (make_fixnum (position->charpos), Qdisplay, object, &overlay); if (NILP (propval)) return HANDLED_NORMALLY; @@ -4861,7 +4861,7 @@ display_prop_end (struct it *it, Lisp_Object object, struct text_pos start_pos) Lisp_Object end; struct text_pos end_pos; - end = Fnext_single_char_property_change (make_number (CHARPOS (start_pos)), + end = Fnext_single_char_property_change (make_fixnum (CHARPOS (start_pos)), Qdisplay, object, Qnil); CHARPOS (end_pos) = XFASTINT (end); if (STRINGP (object)) @@ -4934,8 +4934,8 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, if (NILP (object)) XSETBUFFER (object, current_buffer); specbind (Qobject, object); - specbind (Qposition, make_number (CHARPOS (*position))); - specbind (Qbuffer_position, make_number (bufpos)); + specbind (Qposition, make_fixnum (CHARPOS (*position))); + specbind (Qbuffer_position, make_fixnum (bufpos)); form = safe_eval (form); form = unbind_to (count, form); } @@ -4962,7 +4962,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, && (EQ (XCAR (it->font_height), Qplus) || EQ (XCAR (it->font_height), Qminus)) && CONSP (XCDR (it->font_height)) - && RANGED_INTEGERP (0, XCAR (XCDR (it->font_height)), INT_MAX)) + && RANGED_FIXNUMP (0, XCAR (XCDR (it->font_height)), INT_MAX)) { /* `(+ N)' or `(- N)' where N is an integer. */ int steps = XINT (XCAR (XCDR (it->font_height))); @@ -4978,10 +4978,10 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, Lisp_Object height; height = safe_call1 (it->font_height, face->lface[LFACE_HEIGHT_INDEX]); - if (NUMBERP (height)) + if (FIXED_OR_FLOATP (height)) new_height = XFLOATINT (height); } - else if (NUMBERP (it->font_height)) + else if (FIXED_OR_FLOATP (it->font_height)) { /* Value is a multiple of the canonical char height. */ struct face *f; @@ -5002,7 +5002,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, value = safe_eval (it->font_height); value = unbind_to (count, value); - if (NUMBERP (value)) + if (FIXED_OR_FLOATP (value)) new_height = XFLOATINT (value); } @@ -5025,7 +5025,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, return 0; value = XCAR (XCDR (spec)); - if (NUMBERP (value) && XFLOATINT (value) > 0) + if (FIXED_OR_FLOATP (value) && XFLOATINT (value) > 0) it->space_width = value; } @@ -5074,7 +5074,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, #ifdef HAVE_WINDOW_SYSTEM value = XCAR (XCDR (spec)); - if (NUMBERP (value)) + if (FIXED_OR_FLOATP (value)) { struct face *face = FACE_FROM_ID (it->f, it->face_id); it->voffset = - (XFLOATINT (value) @@ -5488,11 +5488,11 @@ string_buffer_position_lim (Lisp_Object string, Lisp_Object limit, prop, pos; bool found = false; - pos = make_number (max (from, BEGV)); + pos = make_fixnum (max (from, BEGV)); if (!back_p) /* looking forward */ { - limit = make_number (min (to, ZV)); + limit = make_fixnum (min (to, ZV)); while (!found && !EQ (pos, limit)) { prop = Fget_char_property (pos, Qdisplay, Qnil); @@ -5505,7 +5505,7 @@ string_buffer_position_lim (Lisp_Object string, } else /* looking back */ { - limit = make_number (max (to, BEGV)); + limit = make_fixnum (max (to, BEGV)); while (!found && !EQ (pos, limit)) { prop = Fget_char_property (pos, Qdisplay, Qnil); @@ -5852,7 +5852,7 @@ load_overlay_strings (struct it *it, ptrdiff_t charpos) entries[n].string = (STRING); \ entries[n].overlay = (OVERLAY); \ priority = Foverlay_get ((OVERLAY), Qpriority); \ - entries[n].priority = INTEGERP (priority) ? XINT (priority) : 0; \ + entries[n].priority = FIXNUMP (priority) ? XINT (priority) : 0; \ entries[n].after_string_p = (AFTER_P); \ ++n; \ } \ @@ -6385,9 +6385,9 @@ forward_to_next_line_start (struct it *it, bool *skipped_p, overlays, we can just use the position of the newline in buffer text. */ if (it->stop_charpos >= limit - || ((pos = Fnext_single_property_change (make_number (start), + || ((pos = Fnext_single_property_change (make_fixnum (start), Qdisplay, Qnil, - make_number (limit)), + make_fixnum (limit)), NILP (pos)) && next_overlay_change (start) == ZV)) { @@ -6463,7 +6463,7 @@ back_to_previous_visible_line_start (struct it *it) /* Check the newline before point for invisibility. */ { Lisp_Object prop; - prop = Fget_char_property (make_number (IT_CHARPOS (*it) - 1), + prop = Fget_char_property (make_fixnum (IT_CHARPOS (*it) - 1), Qinvisible, it->window); if (TEXT_PROP_MEANS_INVISIBLE (prop) != 0) continue; @@ -6496,7 +6496,7 @@ back_to_previous_visible_line_start (struct it *it) it2.from_disp_prop_p = false; if (handle_display_prop (&it2) == HANDLED_RETURN && !NILP (val = get_char_property_and_overlay - (make_number (pos), Qdisplay, Qnil, &overlay)) + (make_fixnum (pos), Qdisplay, Qnil, &overlay)) && (OVERLAYP (overlay) ? (beg = OVERLAY_POSITION (OVERLAY_START (overlay))) : get_property_and_range (pos, Qdisplay, &val, &beg, &end, Qnil))) @@ -8188,7 +8188,7 @@ next_element_from_c_string (struct it *it) eassert (!it->bidi_p || it->s == it->bidi_it.string.s); it->what = IT_CHARACTER; BYTEPOS (it->position) = CHARPOS (it->position) = 0; - it->object = make_number (0); + it->object = make_fixnum (0); /* With bidi reordering, the character to display might not be the character at IT_CHARPOS. BIDI_IT.FIRST_ELT means that @@ -8570,7 +8570,7 @@ run_redisplay_end_trigger_hook (struct it *it) them again, even if they get an error. */ wset_redisplay_end_trigger (it->w, Qnil); CALLN (Frun_hook_with_args, Qredisplay_end_trigger_functions, it->window, - make_number (charpos)); + make_fixnum (charpos)); /* Notice if it changed the face of the character we are on. */ handle_face_prop (it); @@ -10143,7 +10143,7 @@ include the height of both, if present, in the return value. */) } else { - CHECK_NUMBER_COERCE_MARKER (from); + CHECK_FIXNUM_COERCE_MARKER (from); start = min (max (XINT (from), BEGV), ZV); } @@ -10160,16 +10160,16 @@ include the height of both, if present, in the return value. */) } else { - CHECK_NUMBER_COERCE_MARKER (to); + CHECK_FIXNUM_COERCE_MARKER (to); end = max (start, min (XINT (to), ZV)); } - if (!NILP (x_limit) && RANGED_INTEGERP (0, x_limit, INT_MAX)) + if (!NILP (x_limit) && RANGED_FIXNUMP (0, x_limit, INT_MAX)) max_x = XINT (x_limit); if (NILP (y_limit)) max_y = INT_MAX; - else if (RANGED_INTEGERP (0, y_limit, INT_MAX)) + else if (RANGED_FIXNUMP (0, y_limit, INT_MAX)) max_y = XINT (y_limit); itdata = bidi_shelve_cache (); @@ -10250,7 +10250,7 @@ include the height of both, if present, in the return value. */) if (old_b) set_buffer_internal (old_b); - return Fcons (make_number (x), make_number (y)); + return Fcons (make_fixnum (x), make_fixnum (y)); } /*********************************************************************** @@ -10457,7 +10457,7 @@ message_dolog (const char *m, ptrdiff_t nbytes, bool nlflag, bool multibyte) in the *Messages* buffer now, delete the oldest ones. This is safe because we don't have undo in this buffer. */ - if (NATNUMP (Vmessage_log_max)) + if (FIXNATP (Vmessage_log_max)) { scan_newline (Z, Z_BYTE, BEG, BEG_BYTE, -XFASTINT (Vmessage_log_max) - 1, false); @@ -10963,22 +10963,22 @@ with_echo_area_buffer_unwind_data (struct window *w) Vwith_echo_area_save_vector = Qnil; if (NILP (vector)) - vector = Fmake_vector (make_number (11), Qnil); + vector = Fmake_vector (make_fixnum (11), Qnil); XSETBUFFER (tmp, current_buffer); ASET (vector, i, tmp); ++i; ASET (vector, i, Vdeactivate_mark); ++i; - ASET (vector, i, make_number (windows_or_buffers_changed)); ++i; + ASET (vector, i, make_fixnum (windows_or_buffers_changed)); ++i; if (w) { XSETWINDOW (tmp, w); ASET (vector, i, tmp); ++i; ASET (vector, i, w->contents); ++i; - ASET (vector, i, make_number (marker_position (w->pointm))); ++i; - ASET (vector, i, make_number (marker_byte_position (w->pointm))); ++i; - ASET (vector, i, make_number (marker_position (w->old_pointm))); ++i; - ASET (vector, i, make_number (marker_byte_position (w->old_pointm))); ++i; - ASET (vector, i, make_number (marker_position (w->start))); ++i; - ASET (vector, i, make_number (marker_byte_position (w->start))); ++i; + ASET (vector, i, make_fixnum (marker_position (w->pointm))); ++i; + ASET (vector, i, make_fixnum (marker_byte_position (w->pointm))); ++i; + ASET (vector, i, make_fixnum (marker_position (w->old_pointm))); ++i; + ASET (vector, i, make_fixnum (marker_byte_position (w->old_pointm))); ++i; + ASET (vector, i, make_fixnum (marker_position (w->start))); ++i; + ASET (vector, i, make_fixnum (marker_byte_position (w->start))); ++i; } else { @@ -11279,7 +11279,7 @@ resize_mini_window (struct window *w, bool exact_p) /* Compute the max. number of lines specified by the user. */ if (FLOATP (Vmax_mini_window_height)) max_height = XFLOAT_DATA (Vmax_mini_window_height) * total_height; - else if (INTEGERP (Vmax_mini_window_height)) + else if (FIXNUMP (Vmax_mini_window_height)) max_height = XINT (Vmax_mini_window_height) * unit; else max_height = total_height / 4; @@ -11836,10 +11836,10 @@ format_mode_line_unwind_data (struct frame *target_frame, Vmode_line_unwind_vector = Qnil; if (NILP (vector)) - vector = Fmake_vector (make_number (10), Qnil); + vector = Fmake_vector (make_fixnum (10), Qnil); - ASET (vector, 0, make_number (mode_line_target)); - ASET (vector, 1, make_number (MODE_LINE_NOPROP_LEN (0))); + ASET (vector, 0, make_fixnum (mode_line_target)); + ASET (vector, 1, make_fixnum (MODE_LINE_NOPROP_LEN (0))); ASET (vector, 2, mode_line_string_list); ASET (vector, 3, save_proptrans ? mode_line_proptrans_alist : Qt); ASET (vector, 4, mode_line_string_face); @@ -12432,11 +12432,11 @@ build_desired_tool_bar_string (struct frame *f) /* Reuse f->desired_tool_bar_string, if possible. */ if (size < size_needed || NILP (f->desired_tool_bar_string)) fset_desired_tool_bar_string - (f, Fmake_string (make_number (size_needed), make_number (' '), Qnil)); + (f, Fmake_string (make_fixnum (size_needed), make_fixnum (' '), Qnil)); else { AUTO_LIST4 (props, Qdisplay, Qnil, Qmenu_item, Qnil); - Fremove_text_properties (make_number (0), make_number (size), + Fremove_text_properties (make_fixnum (0), make_fixnum (size), props, f->desired_tool_bar_string); } @@ -12485,7 +12485,7 @@ build_desired_tool_bar_string (struct frame *f) : DEFAULT_TOOL_BAR_BUTTON_RELIEF); hmargin = vmargin = relief; - if (RANGED_INTEGERP (1, Vtool_bar_button_margin, + if (RANGED_FIXNUMP (1, Vtool_bar_button_margin, INT_MAX - max (hmargin, vmargin))) { hmargin += XFASTINT (Vtool_bar_button_margin); @@ -12493,11 +12493,11 @@ build_desired_tool_bar_string (struct frame *f) } else if (CONSP (Vtool_bar_button_margin)) { - if (RANGED_INTEGERP (1, XCAR (Vtool_bar_button_margin), + if (RANGED_FIXNUMP (1, XCAR (Vtool_bar_button_margin), INT_MAX - hmargin)) hmargin += XFASTINT (XCAR (Vtool_bar_button_margin)); - if (RANGED_INTEGERP (1, XCDR (Vtool_bar_button_margin), + if (RANGED_FIXNUMP (1, XCDR (Vtool_bar_button_margin), INT_MAX - vmargin)) vmargin += XFASTINT (XCDR (Vtool_bar_button_margin)); } @@ -12508,7 +12508,7 @@ build_desired_tool_bar_string (struct frame *f) selected. */ if (selected_p) { - plist = Fplist_put (plist, QCrelief, make_number (-relief)); + plist = Fplist_put (plist, QCrelief, make_fixnum (-relief)); hmargin -= relief; vmargin -= relief; } @@ -12520,8 +12520,8 @@ build_desired_tool_bar_string (struct frame *f) raised relief. */ plist = Fplist_put (plist, QCrelief, (selected_p - ? make_number (-relief) - : make_number (relief))); + ? make_fixnum (-relief) + : make_fixnum (relief))); hmargin -= relief; vmargin -= relief; } @@ -12530,11 +12530,11 @@ build_desired_tool_bar_string (struct frame *f) if (hmargin || vmargin) { if (hmargin == vmargin) - plist = Fplist_put (plist, QCmargin, make_number (hmargin)); + plist = Fplist_put (plist, QCmargin, make_fixnum (hmargin)); else plist = Fplist_put (plist, QCmargin, - Fcons (make_number (hmargin), - make_number (vmargin))); + Fcons (make_fixnum (hmargin), + make_fixnum (vmargin))); } /* If button is not enabled, and we don't have special images @@ -12549,7 +12549,7 @@ build_desired_tool_bar_string (struct frame *f) vector. */ image = Fcons (Qimage, plist); AUTO_LIST4 (props, Qdisplay, image, Qmenu_item, - make_number (i * TOOL_BAR_ITEM_NSLOTS)); + make_fixnum (i * TOOL_BAR_ITEM_NSLOTS)); /* Let the last image hide all remaining spaces in the tool bar string. The string can be longer than needed when we reuse a @@ -12558,7 +12558,7 @@ build_desired_tool_bar_string (struct frame *f) end = SCHARS (f->desired_tool_bar_string); else end = i + 1; - Fadd_text_properties (make_number (i), make_number (end), + Fadd_text_properties (make_fixnum (i), make_fixnum (end), props, f->desired_tool_bar_string); #undef PROP } @@ -12764,7 +12764,7 @@ PIXELWISE non-nil means return the height of the tool bar in pixels. */) } #endif - return make_number (height); + return make_fixnum (height); } @@ -12835,7 +12835,7 @@ redisplay_tool_bar (struct frame *f) { int border, rows, height, extra; - if (TYPE_RANGED_INTEGERP (int, Vtool_bar_border)) + if (TYPE_RANGED_FIXNUMP (int, Vtool_bar_border)) border = XINT (Vtool_bar_border); else if (EQ (Vtool_bar_border, Qinternal_border_width)) border = FRAME_INTERNAL_BORDER_WIDTH (f); @@ -12954,9 +12954,9 @@ tool_bar_item_info (struct frame *f, struct glyph *glyph, int *prop_idx) /* Get the text property `menu-item' at pos. The value of that property is the start index of this item's properties in F->tool_bar_items. */ - prop = Fget_text_property (make_number (charpos), + prop = Fget_text_property (make_fixnum (charpos), Qmenu_item, f->current_tool_bar_string); - if (! INTEGERP (prop)) + if (! FIXNUMP (prop)) return false; *prop_idx = XINT (prop); return true; @@ -13203,7 +13203,7 @@ hscroll_window_tree (Lisp_Object window) hscroll_step_abs = 0; } } - else if (TYPE_RANGED_INTEGERP (int, Vhscroll_step)) + else if (TYPE_RANGED_FIXNUMP (int, Vhscroll_step)) { hscroll_step_abs = XINT (Vhscroll_step); if (hscroll_step_abs < 0) @@ -13304,7 +13304,7 @@ hscroll_window_tree (Lisp_Object window) /* Remember window point. */ Fset_marker (w->old_pointm, ((w == XWINDOW (selected_window)) - ? make_number (BUF_PT (XBUFFER (w->contents))) + ? make_fixnum (BUF_PT (XBUFFER (w->contents))) : Fmarker_position (w->pointm)), w->contents); @@ -13561,7 +13561,7 @@ text_outside_line_unchanged_p (struct window *w, /* If selective display, can't optimize if changes start at the beginning of the line. */ if (unchanged_p - && INTEGERP (BVAR (current_buffer, selective_display)) + && FIXNUMP (BVAR (current_buffer, selective_display)) && XINT (BVAR (current_buffer, selective_display)) > 0 && (BEG_UNCHANGED < start || GPT <= start)) unchanged_p = false; @@ -13764,10 +13764,10 @@ overlay_arrow_at_row (struct it *it, struct glyph_row *row) { int fringe_bitmap = lookup_fringe_bitmap (val); if (fringe_bitmap != 0) - return make_number (fringe_bitmap); + return make_fixnum (fringe_bitmap); } #endif - return make_number (-1); /* Use default arrow bitmap. */ + return make_fixnum (-1); /* Use default arrow bitmap. */ } return overlay_arrow_string_or_property (var); } @@ -14142,9 +14142,9 @@ redisplay_internal (void) #define AINC(a,i) \ { \ - Lisp_Object entry = Fgethash (make_number (i), a, make_number (0)); \ - if (INTEGERP (entry)) \ - Fputhash (make_number (i), make_number (1 + XINT (entry)), a); \ + Lisp_Object entry = Fgethash (make_fixnum (i), a, make_fixnum (0)); \ + if (FIXNUMP (entry)) \ + Fputhash (make_fixnum (i), make_fixnum (1 + XINT (entry)), a); \ } AINC (Vredisplay__all_windows_cause, windows_or_buffers_changed); @@ -15113,7 +15113,7 @@ set_cursor_from_row (struct window *w, struct glyph_row *row, Lisp_Object chprop; ptrdiff_t glyph_pos = glyph->charpos; - chprop = Fget_char_property (make_number (glyph_pos), Qcursor, + chprop = Fget_char_property (make_fixnum (glyph_pos), Qcursor, glyph->object); if (!NILP (chprop)) { @@ -15134,7 +15134,7 @@ set_cursor_from_row (struct window *w, struct glyph_row *row, if (prop_pos >= pos_before) bpos_max = prop_pos; } - if (INTEGERP (chprop)) + if (FIXNUMP (chprop)) { bpos_covered = bpos_max + XINT (chprop); /* If the `cursor' property covers buffer positions up @@ -15197,7 +15197,7 @@ set_cursor_from_row (struct window *w, struct glyph_row *row, Lisp_Object chprop; ptrdiff_t glyph_pos = glyph->charpos; - chprop = Fget_char_property (make_number (glyph_pos), Qcursor, + chprop = Fget_char_property (make_fixnum (glyph_pos), Qcursor, glyph->object); if (!NILP (chprop)) { @@ -15208,7 +15208,7 @@ set_cursor_from_row (struct window *w, struct glyph_row *row, if (prop_pos >= pos_before) bpos_max = prop_pos; } - if (INTEGERP (chprop)) + if (FIXNUMP (chprop)) { bpos_covered = bpos_max + XINT (chprop); /* If the `cursor' property covers buffer positions up @@ -15384,7 +15384,7 @@ set_cursor_from_row (struct window *w, struct glyph_row *row, Lisp_Object cprop; ptrdiff_t gpos = glyph->charpos; - cprop = Fget_char_property (make_number (gpos), + cprop = Fget_char_property (make_fixnum (gpos), Qcursor, glyph->object); if (!NILP (cprop)) @@ -15515,7 +15515,7 @@ set_cursor_from_row (struct window *w, struct glyph_row *row, /* Previous candidate is a glyph from a string that has a non-nil `cursor' property. */ || (STRINGP (g1->object) - && (!NILP (Fget_char_property (make_number (g1->charpos), + && (!NILP (Fget_char_property (make_fixnum (g1->charpos), Qcursor, g1->object)) /* Previous candidate is from the same display string as this one, and the display string @@ -15598,7 +15598,7 @@ run_window_scroll_functions (Lisp_Object window, struct text_pos startp) if (!NILP (Vwindow_scroll_functions)) { run_hook_with_args_2 (Qwindow_scroll_functions, window, - make_number (CHARPOS (startp))); + make_fixnum (CHARPOS (startp))); SET_TEXT_POS_FROM_MARKER (startp, w->start); /* In case the hook functions switch buffers. */ set_buffer_internal (XBUFFER (w->contents)); @@ -15730,8 +15730,8 @@ try_scrolling (Lisp_Object window, bool just_this_one_p, scroll_max = (max (scroll_step, max (arg_scroll_conservatively, temp_scroll_step)) * frame_line_height); - else if (NUMBERP (BVAR (current_buffer, scroll_down_aggressively)) - || NUMBERP (BVAR (current_buffer, scroll_up_aggressively))) + else if (FIXED_OR_FLOATP (BVAR (current_buffer, scroll_down_aggressively)) + || FIXED_OR_FLOATP (BVAR (current_buffer, scroll_up_aggressively))) /* We're trying to scroll because of aggressive scrolling but no scroll_step is set. Choose an arbitrary one. */ scroll_max = 10 * frame_line_height; @@ -15831,7 +15831,7 @@ try_scrolling (Lisp_Object window, bool just_this_one_p, { aggressive = BVAR (current_buffer, scroll_up_aggressively); height = WINDOW_BOX_TEXT_HEIGHT (w); - if (NUMBERP (aggressive)) + if (FIXED_OR_FLOATP (aggressive)) { double float_amount = XFLOATINT (aggressive) * height; int aggressive_scroll = float_amount; @@ -15947,7 +15947,7 @@ try_scrolling (Lisp_Object window, bool just_this_one_p, { aggressive = BVAR (current_buffer, scroll_down_aggressively); height = WINDOW_BOX_TEXT_HEIGHT (w); - if (NUMBERP (aggressive)) + if (FIXED_OR_FLOATP (aggressive)) { double float_amount = XFLOATINT (aggressive) * height; int aggressive_scroll = float_amount; @@ -16932,17 +16932,17 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) position past that. */ struct glyph_row *r = NULL; Lisp_Object invprop = - get_char_property_and_overlay (make_number (PT), Qinvisible, + get_char_property_and_overlay (make_fixnum (PT), Qinvisible, Qnil, NULL); if (TEXT_PROP_MEANS_INVISIBLE (invprop) != 0) { ptrdiff_t alt_pt; Lisp_Object invprop_end = - Fnext_single_char_property_change (make_number (PT), Qinvisible, + Fnext_single_char_property_change (make_fixnum (PT), Qinvisible, Qnil, Qnil); - if (NATNUMP (invprop_end)) + if (FIXNATP (invprop_end)) alt_pt = XFASTINT (invprop_end); else alt_pt = ZV; @@ -17223,8 +17223,8 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) if ((scroll_conservatively || emacs_scroll_step || temp_scroll_step - || NUMBERP (BVAR (current_buffer, scroll_up_aggressively)) - || NUMBERP (BVAR (current_buffer, scroll_down_aggressively))) + || FIXED_OR_FLOATP (BVAR (current_buffer, scroll_up_aggressively)) + || FIXED_OR_FLOATP (BVAR (current_buffer, scroll_down_aggressively))) && CHARPOS (startp) >= BEGV && CHARPOS (startp) <= ZV) { @@ -17299,13 +17299,13 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) : BVAR (current_buffer, scroll_down_aggressively); if (!MINI_WINDOW_P (w) - && (scroll_conservatively > SCROLL_LIMIT || NUMBERP (aggressive))) + && (scroll_conservatively > SCROLL_LIMIT || FIXED_OR_FLOATP (aggressive))) { int pt_offset = 0; /* Setting scroll-conservatively overrides scroll-*-aggressively. */ - if (!scroll_conservatively && NUMBERP (aggressive)) + if (!scroll_conservatively && FIXED_OR_FLOATP (aggressive)) { double float_amount = XFLOATINT (aggressive); @@ -17464,17 +17464,17 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) if (!row) { Lisp_Object val = - get_char_property_and_overlay (make_number (PT), Qinvisible, + get_char_property_and_overlay (make_fixnum (PT), Qinvisible, Qnil, NULL); if (TEXT_PROP_MEANS_INVISIBLE (val) != 0) { ptrdiff_t alt_pos; Lisp_Object invis_end = - Fnext_single_char_property_change (make_number (PT), Qinvisible, + Fnext_single_char_property_change (make_fixnum (PT), Qinvisible, Qnil, Qnil); - if (NATNUMP (invis_end)) + if (FIXNATP (invis_end)) alt_pos = XFASTINT (invis_end); else alt_pos = ZV; @@ -19584,7 +19584,7 @@ with numeric argument, its value is passed as the GLYPHS flag. */) w->cursor.x, w->cursor.y, w->cursor.hpos, w->cursor.vpos); fprintf (stderr, "=============================================\n"); dump_glyph_matrix (w->current_matrix, - TYPE_RANGED_INTEGERP (int, glyphs) ? XINT (glyphs) : 0); + TYPE_RANGED_FIXNUMP (int, glyphs) ? XINT (glyphs) : 0); return Qnil; } @@ -19628,14 +19628,14 @@ GLYPHS > 1 or omitted means dump glyphs in long form. */) } else { - CHECK_NUMBER (row); + CHECK_FIXNUM (row); vpos = XINT (row); } matrix = XWINDOW (selected_window)->current_matrix; if (vpos >= 0 && vpos < matrix->nrows) dump_glyph_row (MATRIX_ROW (matrix, vpos), vpos, - TYPE_RANGED_INTEGERP (int, glyphs) ? XINT (glyphs) : 2); + TYPE_RANGED_FIXNUMP (int, glyphs) ? XINT (glyphs) : 2); return Qnil; } @@ -19660,12 +19660,12 @@ do nothing. */) vpos = 0; else { - CHECK_NUMBER (row); + CHECK_FIXNUM (row); vpos = XINT (row); } if (vpos >= 0 && vpos < m->nrows) dump_glyph_row (MATRIX_ROW (m, vpos), vpos, - TYPE_RANGED_INTEGERP (int, glyphs) ? XINT (glyphs) : 2); + TYPE_RANGED_FIXNUMP (int, glyphs) ? XINT (glyphs) : 2); #endif return Qnil; } @@ -19747,7 +19747,7 @@ get_overlay_arrow_glyph_row (struct window *w, Lisp_Object overlay_arrow_string) p += it.len; /* Get its face. */ - ilisp = make_number (p - arrow_string); + ilisp = make_fixnum (p - arrow_string); face = Fget_text_property (ilisp, Qface, overlay_arrow_string); it.face_id = compute_char_face (f, it.char_to_display, face); @@ -20159,7 +20159,7 @@ append_space_for_newline (struct it *it, bool default_face_p) spacing = calc_line_height_property (it, spacing, font, boff, false); } - if (INTEGERP (spacing)) + if (FIXNUMP (spacing)) { extra_line_spacing = XINT (spacing); if (!NILP (total_height)) @@ -20597,7 +20597,7 @@ row_for_charpos_p (struct glyph_row *row, ptrdiff_t charpos) if (STRINGP (glyph->object)) { Lisp_Object prop - = Fget_char_property (make_number (charpos), + = Fget_char_property (make_fixnum (charpos), Qdisplay, Qnil); result = (!NILP (prop) @@ -20613,7 +20613,7 @@ row_for_charpos_p (struct glyph_row *row, ptrdiff_t charpos) { ptrdiff_t gpos = glyph->charpos; - if (!NILP (Fget_char_property (make_number (gpos), + if (!NILP (Fget_char_property (make_fixnum (gpos), Qcursor, s))) { result = true; @@ -20752,10 +20752,10 @@ get_it_property (struct it *it, Lisp_Object prop) Lisp_Object position, object = it->object; if (STRINGP (object)) - position = make_number (IT_STRING_CHARPOS (*it)); + position = make_fixnum (IT_STRING_CHARPOS (*it)); else if (BUFFERP (object)) { - position = make_number (IT_CHARPOS (*it)); + position = make_fixnum (IT_CHARPOS (*it)); object = it->window; } else @@ -21128,7 +21128,7 @@ maybe_produce_line_number (struct it *it) /* Compute the required width if needed. */ if (!it->lnum_width) { - if (NATNUMP (Vdisplay_line_numbers_width)) + if (FIXNATP (Vdisplay_line_numbers_width)) it->lnum_width = XFASTINT (Vdisplay_line_numbers_width); /* Max line number to be displayed cannot be more than the one @@ -21296,7 +21296,7 @@ should_produce_line_number (struct it *it) property, disable line numbers for this row. This is for packages such as company-mode, which need this for their tricky layout, where line numbers get in the way. */ - Lisp_Object val = Fget_char_property (make_number (IT_CHARPOS (*it)), + Lisp_Object val = Fget_char_property (make_fixnum (IT_CHARPOS (*it)), Qdisplay_line_numbers_disable, it->window); /* For ZV, we need to also look in empty overlays at that point, @@ -22185,7 +22185,7 @@ display_line (struct it *it, int cursor_vpos) } else { - eassert (INTEGERP (overlay_arrow_string)); + eassert (FIXNUMP (overlay_arrow_string)); row->overlay_arrow_bitmap = XINT (overlay_arrow_string); } overlay_arrow_seen = true; @@ -22492,7 +22492,7 @@ the `bidi-class' property of a character. */) bidi_unshelve_cache (itb_data, false); set_buffer_temp (old); - return (from_pos <= found && found < to_pos) ? make_number (found) : Qnil; + return (from_pos <= found && found < to_pos) ? make_fixnum (found) : Qnil; } DEFUN ("move-point-visually", Fmove_point_visually, @@ -22518,7 +22518,7 @@ Value is the new character position of point. */) && (GLYPH)->charpos >= 0 \ && !(GLYPH)->avoid_cursor_p) - CHECK_NUMBER (direction); + CHECK_FIXNUM (direction); dir = XINT (direction); if (dir > 0) dir = 1; @@ -22552,7 +22552,7 @@ Value is the new character position of point. */) { SET_PT (g->charpos); w->cursor.vpos = -1; - return make_number (PT); + return make_fixnum (PT); } else if (!NILP (g->object) && !EQ (g->object, gpt->object)) { @@ -22577,7 +22577,7 @@ Value is the new character position of point. */) break; SET_PT (new_pos); w->cursor.vpos = -1; - return make_number (PT); + return make_fixnum (PT); } else if (ROW_GLYPH_NEWLINE_P (row, g)) { @@ -22593,7 +22593,7 @@ Value is the new character position of point. */) else break; w->cursor.vpos = -1; - return make_number (PT); + return make_fixnum (PT); } } if (g == e || NILP (g->object)) @@ -22614,7 +22614,7 @@ Value is the new character position of point. */) { SET_PT (MATRIX_ROW_END_CHARPOS (row) - 1); w->cursor.vpos = -1; - return make_number (PT); + return make_fixnum (PT); } g = row->glyphs[TEXT_AREA]; e = g + row->used[TEXT_AREA]; @@ -22642,7 +22642,7 @@ Value is the new character position of point. */) else continue; w->cursor.vpos = -1; - return make_number (PT); + return make_fixnum (PT); } } } @@ -22652,7 +22652,7 @@ Value is the new character position of point. */) { SET_PT (MATRIX_ROW_END_CHARPOS (row) - 1); w->cursor.vpos = -1; - return make_number (PT); + return make_fixnum (PT); } e = row->glyphs[TEXT_AREA]; g = e + row->used[TEXT_AREA] - 1; @@ -22680,7 +22680,7 @@ Value is the new character position of point. */) else continue; w->cursor.vpos = -1; - return make_number (PT); + return make_fixnum (PT); } } } @@ -22940,7 +22940,7 @@ Value is the new character position of point. */) SET_PT_BOTH (IT_CHARPOS (it), IT_BYTEPOS (it)); } - return make_number (PT); + return make_fixnum (PT); #undef ROW_GLYPH_NEWLINE_P } @@ -22989,7 +22989,7 @@ Emacs UBA implementation, in particular with the test suite. */) } else { - CHECK_NUMBER_COERCE_MARKER (vpos); + CHECK_FIXNUM_COERCE_MARKER (vpos); nrow = XINT (vpos); } @@ -23029,7 +23029,7 @@ Emacs UBA implementation, in particular with the test suite. */) /* Create and fill the array. */ levels = make_uninit_vector (nglyphs); for (i = 0; g1 < g; i++, g1++) - ASET (levels, i, make_number (g1->resolved_level)); + ASET (levels, i, make_fixnum (g1->resolved_level)); } else /* Right-to-left glyph row. */ { @@ -23044,7 +23044,7 @@ Emacs UBA implementation, in particular with the test suite. */) nglyphs++; levels = make_uninit_vector (nglyphs); for (i = 0; g1 > g; i++, g1--) - ASET (levels, i, make_number (g1->resolved_level)); + ASET (levels, i, make_fixnum (g1->resolved_level)); } return levels; } @@ -23146,7 +23146,7 @@ display_menu_bar (struct window *w) break; /* Remember where item was displayed. */ - ASET (items, i + 3, make_number (it.hpos)); + ASET (items, i + 3, make_fixnum (it.hpos)); /* Display the item, pad with one space. */ if (it.current_x < it.last_visible_x) @@ -23565,7 +23565,7 @@ display_mode_element (struct it *it, int depth, int field_width, int precision, && (!NILP (props) || risky)) { Lisp_Object oprops, aelt; - oprops = Ftext_properties_at (make_number (0), elt); + oprops = Ftext_properties_at (make_fixnum (0), elt); /* If the starting string's properties are not what we want, translate the string. Also, if the string @@ -23610,7 +23610,7 @@ display_mode_element (struct it *it, int depth, int field_width, int precision, = Fdelq (aelt, mode_line_proptrans_alist); elt = Fcopy_sequence (elt); - Fset_text_properties (make_number (0), Flength (elt), + Fset_text_properties (make_fixnum (0), Flength (elt), props, elt); /* Add this item to mode_line_proptrans_alist. */ mode_line_proptrans_alist @@ -23618,7 +23618,7 @@ display_mode_element (struct it *it, int depth, int field_width, int precision, mode_line_proptrans_alist); /* Truncate mode_line_proptrans_alist to at most 50 elements. */ - tem = Fnthcdr (make_number (50), + tem = Fnthcdr (make_fixnum (50), mode_line_proptrans_alist); if (! NILP (tem)) XSETCDR (tem, Qnil); @@ -23689,8 +23689,8 @@ display_mode_element (struct it *it, int depth, int field_width, int precision, ? string_byte_to_char (elt, offset) : charpos + nchars); Lisp_Object mode_string - = Fsubstring (elt, make_number (charpos), - make_number (endpos)); + = Fsubstring (elt, make_fixnum (charpos), + make_fixnum (endpos)); n += store_mode_line_string (NULL, mode_string, false, 0, 0, Qnil); } @@ -23753,7 +23753,7 @@ display_mode_element (struct it *it, int depth, int field_width, int precision, case MODE_LINE_STRING: { Lisp_Object tem = build_string (spec); - props = Ftext_properties_at (make_number (charpos), elt); + props = Ftext_properties_at (make_fixnum (charpos), elt); /* Should only keep face property in props */ n += store_mode_line_string (NULL, tem, false, field, prec, props); @@ -23910,7 +23910,7 @@ display_mode_element (struct it *it, int depth, int field_width, int precision, elt = XCAR (elt); goto tail_recurse; } - else if (INTEGERP (car)) + else if (FIXNUMP (car)) { register int lim = XINT (car); elt = XCDR (elt); @@ -24027,7 +24027,7 @@ store_mode_line_string (const char *string, Lisp_Object lisp_string, face = list2 (face, mode_line_string_face); props = Fplist_put (props, Qface, face); } - Fadd_text_properties (make_number (0), make_number (len), + Fadd_text_properties (make_fixnum (0), make_fixnum (len), props, lisp_string); } else @@ -24036,14 +24036,14 @@ store_mode_line_string (const char *string, Lisp_Object lisp_string, if (precision > 0 && len > precision) { len = precision; - lisp_string = Fsubstring (lisp_string, make_number (0), make_number (len)); + lisp_string = Fsubstring (lisp_string, make_fixnum (0), make_fixnum (len)); precision = -1; } if (!NILP (mode_line_string_face)) { Lisp_Object face; if (NILP (props)) - props = Ftext_properties_at (make_number (0), lisp_string); + props = Ftext_properties_at (make_fixnum (0), lisp_string); face = Fplist_get (props, Qface); if (NILP (face)) face = mode_line_string_face; @@ -24054,7 +24054,7 @@ store_mode_line_string (const char *string, Lisp_Object lisp_string, lisp_string = Fcopy_sequence (lisp_string); } if (!NILP (props)) - Fadd_text_properties (make_number (0), make_number (len), + Fadd_text_properties (make_fixnum (0), make_fixnum (len), props, lisp_string); } @@ -24067,10 +24067,10 @@ store_mode_line_string (const char *string, Lisp_Object lisp_string, if (field_width > len) { field_width -= len; - lisp_string = Fmake_string (make_number (field_width), make_number (' '), + lisp_string = Fmake_string (make_fixnum (field_width), make_fixnum (' '), Qnil); if (!NILP (props)) - Fadd_text_properties (make_number (0), make_number (field_width), + Fadd_text_properties (make_fixnum (0), make_fixnum (field_width), props, lisp_string); mode_line_string_list = Fcons (lisp_string, mode_line_string_list); n += field_width; @@ -24107,7 +24107,7 @@ are the selected window and the WINDOW's buffer). */) struct window *w; struct buffer *old_buffer = NULL; int face_id; - bool no_props = INTEGERP (face); + bool no_props = FIXNUMP (face); ptrdiff_t count = SPECPDL_INDEX (); Lisp_Object str; int string_start = 0; @@ -24597,7 +24597,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, goto no_value; /* If the buffer is very big, don't waste time. */ - if (INTEGERP (Vline_number_display_limit) + if (FIXNUMP (Vline_number_display_limit) && BUF_ZV (b) - BUF_BEGV (b) > XINT (Vline_number_display_limit)) { w->base_line_pos = 0; @@ -24886,7 +24886,7 @@ display_count_lines (ptrdiff_t start_byte, check only for newlines. */ bool selective_display = (!NILP (BVAR (current_buffer, selective_display)) - && !INTEGERP (BVAR (current_buffer, selective_display))); + && !FIXNUMP (BVAR (current_buffer, selective_display))); if (count > 0) { @@ -25285,13 +25285,13 @@ display may depend on `buffer-invisibility-spec', which see. */) (Lisp_Object pos) { Lisp_Object prop - = (NATNUMP (pos) || MARKERP (pos) + = (FIXNATP (pos) || MARKERP (pos) ? Fget_char_property (pos, Qinvisible, Qnil) : pos); int invis = TEXT_PROP_MEANS_INVISIBLE (prop); return (invis == 0 ? Qnil : invis == 1 ? Qt - : make_number (invis)); + : make_fixnum (invis)); } /* Calculate a width or height in pixels from a specification using @@ -25500,7 +25500,7 @@ calc_pixel_width_or_height (double *res, struct it *it, Lisp_Object prop, prop = Qnil; } - if (NUMBERP (prop)) + if (FIXED_OR_FLOATP (prop)) { int base_unit = (width_p ? FRAME_COLUMN_WIDTH (it->f) @@ -25564,7 +25564,7 @@ calc_pixel_width_or_height (double *res, struct it *it, Lisp_Object prop, } /* '(NUM)': absolute number of pixels. */ - if (NUMBERP (car)) + if (FIXED_OR_FLOATP (car)) { double fact; int offset = @@ -27190,22 +27190,22 @@ produce_image_glyph (struct it *it) slice.width = img->width; slice.height = img->height; - if (INTEGERP (it->slice.x)) + if (FIXNUMP (it->slice.x)) slice.x = XINT (it->slice.x); else if (FLOATP (it->slice.x)) slice.x = XFLOAT_DATA (it->slice.x) * img->width; - if (INTEGERP (it->slice.y)) + if (FIXNUMP (it->slice.y)) slice.y = XINT (it->slice.y); else if (FLOATP (it->slice.y)) slice.y = XFLOAT_DATA (it->slice.y) * img->height; - if (INTEGERP (it->slice.width)) + if (FIXNUMP (it->slice.width)) slice.width = XINT (it->slice.width); else if (FLOATP (it->slice.width)) slice.width = XFLOAT_DATA (it->slice.width) * img->width; - if (INTEGERP (it->slice.height)) + if (FIXNUMP (it->slice.height)) slice.height = XINT (it->slice.height); else if (FLOATP (it->slice.height)) slice.height = XFLOAT_DATA (it->slice.height) * img->height; @@ -27832,15 +27832,15 @@ calc_line_height_property (struct it *it, Lisp_Object val, struct font *font, Lisp_Object face_name = Qnil; int ascent, descent, height; - if (NILP (val) || INTEGERP (val) || (override && EQ (val, Qt))) + if (NILP (val) || FIXNUMP (val) || (override && EQ (val, Qt))) return val; if (CONSP (val)) { face_name = XCAR (val); val = XCDR (val); - if (!NUMBERP (val)) - val = make_number (1); + if (!FIXED_OR_FLOATP (val)) + val = make_fixnum (1); if (NILP (face_name)) { height = it->ascent + it->descent; @@ -27865,7 +27865,7 @@ calc_line_height_property (struct it *it, Lisp_Object val, struct font *font, face_id = lookup_named_face (it->w, it->f, face_name, false); face = FACE_FROM_ID_OR_NULL (it->f, face_id); if (face == NULL || ((font = face->font) == NULL)) - return make_number (-1); + return make_fixnum (-1); boff = font->baseline_offset; if (font->vertical_centering) boff = VCENTER_BASELINE_OFFSET (font, it->f) - boff; @@ -27885,10 +27885,10 @@ calc_line_height_property (struct it *it, Lisp_Object val, struct font *font, scale: if (FLOATP (val)) height = (int)(XFLOAT_DATA (val) * height); - else if (INTEGERP (val)) + else if (FIXNUMP (val)) height *= XINT (val); - return make_number (height); + return make_fixnum (height); } @@ -28388,7 +28388,7 @@ x_produce_glyphs (struct it *it) spacing = calc_line_height_property (it, spacing, font, boff, false); } - if (INTEGERP (spacing)) + if (FIXNUMP (spacing)) { extra_line_spacing = XINT (spacing); if (!NILP (total_height)) @@ -28607,7 +28607,7 @@ x_produce_glyphs (struct it *it) && font->default_ascent && CHAR_TABLE_P (Vuse_default_ascent) && !NILP (Faref (Vuse_default_ascent, - make_number (it->char_to_display)))) + make_fixnum (it->char_to_display)))) highest = font->default_ascent + boff; /* Draw the first glyph at the normal position. It may be @@ -28658,7 +28658,7 @@ x_produce_glyphs (struct it *it) if (font->relative_compose && (! CHAR_TABLE_P (Vignore_relative_composition) || NILP (Faref (Vignore_relative_composition, - make_number (ch))))) + make_fixnum (ch))))) { if (- descent >= font->relative_compose) @@ -29094,7 +29094,7 @@ get_specified_cursor_type (Lisp_Object arg, int *width) if (CONSP (arg) && EQ (XCAR (arg), Qbar) - && RANGED_INTEGERP (0, XCDR (arg), INT_MAX)) + && RANGED_FIXNUMP (0, XCDR (arg), INT_MAX)) { *width = XINT (XCDR (arg)); return BAR_CURSOR; @@ -29108,7 +29108,7 @@ get_specified_cursor_type (Lisp_Object arg, int *width) if (CONSP (arg) && EQ (XCAR (arg), Qhbar) - && RANGED_INTEGERP (0, XCDR (arg), INT_MAX)) + && RANGED_FIXNUMP (0, XCDR (arg), INT_MAX)) { *width = XINT (XCDR (arg)); return HBAR_CURSOR; @@ -30733,13 +30733,13 @@ on_hot_spot_p (Lisp_Object hot_spot, int x, int y) return false; if (!CONSP (XCDR (rect))) return false; - if (!(tem = XCAR (XCAR (rect)), INTEGERP (tem) && x >= XINT (tem))) + if (!(tem = XCAR (XCAR (rect)), FIXNUMP (tem) && x >= XINT (tem))) return false; - if (!(tem = XCDR (XCAR (rect)), INTEGERP (tem) && y >= XINT (tem))) + if (!(tem = XCDR (XCAR (rect)), FIXNUMP (tem) && y >= XINT (tem))) return false; - if (!(tem = XCAR (XCDR (rect)), INTEGERP (tem) && x <= XINT (tem))) + if (!(tem = XCAR (XCDR (rect)), FIXNUMP (tem) && x <= XINT (tem))) return false; - if (!(tem = XCDR (XCDR (rect)), INTEGERP (tem) && y <= XINT (tem))) + if (!(tem = XCDR (XCDR (rect)), FIXNUMP (tem) && y <= XINT (tem))) return false; return true; } @@ -30750,9 +30750,9 @@ on_hot_spot_p (Lisp_Object hot_spot, int x, int y) Lisp_Object lr, lx0, ly0; if (CONSP (circ) && CONSP (XCAR (circ)) - && (lr = XCDR (circ), NUMBERP (lr)) - && (lx0 = XCAR (XCAR (circ)), INTEGERP (lx0)) - && (ly0 = XCDR (XCAR (circ)), INTEGERP (ly0))) + && (lr = XCDR (circ), FIXED_OR_FLOATP (lr)) + && (lx0 = XCAR (XCAR (circ)), FIXNUMP (lx0)) + && (ly0 = XCDR (XCAR (circ)), FIXNUMP (ly0))) { double r = XFLOATINT (lr); double dx = XINT (lx0) - x; @@ -30781,15 +30781,15 @@ on_hot_spot_p (Lisp_Object hot_spot, int x, int y) If count is odd, we are inside polygon. Pixels on edges may or may not be included depending on actual geometry of the polygon. */ - if ((lx = poly[n-2], !INTEGERP (lx)) - || (ly = poly[n-1], !INTEGERP (lx))) + if ((lx = poly[n-2], !FIXNUMP (lx)) + || (ly = poly[n-1], !FIXNUMP (lx))) return false; x0 = XINT (lx), y0 = XINT (ly); for (i = 0; i < n; i += 2) { int x1 = x0, y1 = y0; - if ((lx = poly[i], !INTEGERP (lx)) - || (ly = poly[i+1], !INTEGERP (ly))) + if ((lx = poly[i], !FIXNUMP (lx)) + || (ly = poly[i+1], !FIXNUMP (ly))) return false; x0 = XINT (lx), y0 = XINT (ly); @@ -30843,8 +30843,8 @@ Returns the alist element for the first matching AREA in MAP. */) if (NILP (map)) return Qnil; - CHECK_NUMBER (x); - CHECK_NUMBER (y); + CHECK_FIXNUM (x); + CHECK_FIXNUM (y); return find_hot_spot (map, clip_to_bounds (INT_MIN, XINT (x), INT_MAX), @@ -30996,7 +30996,7 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y, #endif /* HAVE_WINDOW_SYSTEM */ if (STRINGP (string)) - pos = make_number (charpos); + pos = make_fixnum (charpos); /* Set the help text and mouse pointer. If the mouse is on a part of the mode line without any text (e.g. past the right edge of @@ -31085,7 +31085,7 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y, int vpos, hpos; - b = Fprevious_single_property_change (make_number (charpos + 1), + b = Fprevious_single_property_change (make_fixnum (charpos + 1), Qmouse_face, string, Qnil); if (NILP (b)) begpos = 0; @@ -31494,7 +31494,7 @@ note_mouse_highlight (struct frame *f, int x, int y) ZV = Z; /* Is this char mouse-active or does it have help-echo? */ - position = make_number (pos); + position = make_fixnum (pos); USE_SAFE_ALLOCA; @@ -31565,13 +31565,13 @@ note_mouse_highlight (struct frame *f, int x, int y) ptrdiff_t ignore; s = Fprevious_single_property_change - (make_number (pos + 1), Qmouse_face, object, Qnil); + (make_fixnum (pos + 1), Qmouse_face, object, Qnil); e = Fnext_single_property_change (position, Qmouse_face, object, Qnil); if (NILP (s)) - s = make_number (0); + s = make_fixnum (0); if (NILP (e)) - e = make_number (SCHARS (object)); + e = make_fixnum (SCHARS (object)); mouse_face_from_string_pos (w, hlinfo, object, XINT (s), XINT (e)); hlinfo->mouse_face_past_end = false; @@ -31599,7 +31599,7 @@ note_mouse_highlight (struct frame *f, int x, int y) if (pos > 0) { mouse_face = get_char_property_and_overlay - (make_number (pos), Qmouse_face, w->contents, &overlay); + (make_fixnum (pos), Qmouse_face, w->contents, &overlay); buffer = w->contents; disp_string = object; } @@ -31630,7 +31630,7 @@ note_mouse_highlight (struct frame *f, int x, int y) : Qnil; Lisp_Object lim2 = NILP (BVAR (XBUFFER (buffer), bidi_display_reordering)) - ? make_number (BUF_Z (XBUFFER (buffer)) + ? make_fixnum (BUF_Z (XBUFFER (buffer)) - w->window_end_pos) : Qnil; @@ -31638,9 +31638,9 @@ note_mouse_highlight (struct frame *f, int x, int y) { /* Handle the text property case. */ before = Fprevious_single_property_change - (make_number (pos + 1), Qmouse_face, buffer, lim1); + (make_fixnum (pos + 1), Qmouse_face, buffer, lim1); after = Fnext_single_property_change - (make_number (pos), Qmouse_face, buffer, lim2); + (make_fixnum (pos), Qmouse_face, buffer, lim2); before_string = after_string = Qnil; } else @@ -31700,7 +31700,7 @@ note_mouse_highlight (struct frame *f, int x, int y) && charpos >= 0 && charpos < SCHARS (obj)) { - help = Fget_text_property (make_number (charpos), + help = Fget_text_property (make_fixnum (charpos), Qhelp_echo, obj); if (NILP (help)) { @@ -31712,7 +31712,7 @@ note_mouse_highlight (struct frame *f, int x, int y) ptrdiff_t p = string_buffer_position (obj, start); if (p > 0) { - help = Fget_char_property (make_number (p), + help = Fget_char_property (make_fixnum (p), Qhelp_echo, w->contents); if (!NILP (help)) { @@ -31725,7 +31725,7 @@ note_mouse_highlight (struct frame *f, int x, int y) else if (BUFFERP (obj) && charpos >= BEGV && charpos < ZV) - help = Fget_text_property (make_number (charpos), Qhelp_echo, + help = Fget_text_property (make_fixnum (charpos), Qhelp_echo, obj); if (!NILP (help)) @@ -31756,7 +31756,7 @@ note_mouse_highlight (struct frame *f, int x, int y) && charpos >= 0 && charpos < SCHARS (obj)) { - pointer = Fget_text_property (make_number (charpos), + pointer = Fget_text_property (make_fixnum (charpos), Qpointer, obj); if (NILP (pointer)) { @@ -31767,14 +31767,14 @@ note_mouse_highlight (struct frame *f, int x, int y) ptrdiff_t start = MATRIX_ROW_START_CHARPOS (r); ptrdiff_t p = string_buffer_position (obj, start); if (p > 0) - pointer = Fget_char_property (make_number (p), + pointer = Fget_char_property (make_fixnum (p), Qpointer, w->contents); } } else if (BUFFERP (obj) && charpos >= BEGV && charpos < ZV) - pointer = Fget_text_property (make_number (charpos), + pointer = Fget_text_property (make_fixnum (charpos), Qpointer, obj); } } @@ -32751,7 +32751,7 @@ not span the full frame width. A value of nil means to respect the value of `truncate-lines'. If `word-wrap' is enabled, you might want to reduce this. */); - Vtruncate_partial_width_windows = make_number (50); + Vtruncate_partial_width_windows = make_fixnum (50); DEFVAR_LISP ("line-number-display-limit", Vline_number_display_limit, doc: /* Maximum buffer size for which line number should be displayed. @@ -32805,7 +32805,7 @@ and is used only on frames for which no explicit name has been set doc: /* Maximum number of lines to keep in the message log buffer. If nil, disable message logging. If t, log messages but don't truncate the buffer when it becomes large. */); - Vmessage_log_max = make_number (1000); + Vmessage_log_max = make_fixnum (1000); DEFVAR_LISP ("window-scroll-functions", Vwindow_scroll_functions, doc: /* List of functions to call before redisplaying a window with scrolling. @@ -32883,7 +32883,7 @@ If an integer, use that for both horizontal and vertical margins. Otherwise, value should be a pair of integers `(HORZ . VERT)' with HORZ specifying the horizontal margin, and VERT specifying the vertical margin. */); - Vtool_bar_button_margin = make_number (DEFAULT_TOOL_BAR_BUTTON_MARGIN); + Vtool_bar_button_margin = make_fixnum (DEFAULT_TOOL_BAR_BUTTON_MARGIN); DEFVAR_INT ("tool-bar-button-relief", tool_bar_button_relief, doc: /* Relief thickness of tool-bar buttons. */); @@ -32991,7 +32991,7 @@ scroll more than the value given by the scroll step. Note that the lower bound for automatic hscrolling specified by `scroll-left' and `scroll-right' overrides this variable's effect. */); - Vhscroll_step = make_number (0); + Vhscroll_step = make_fixnum (0); DEFVAR_BOOL ("message-truncate-lines", message_truncate_lines, doc: /* If non-nil, messages are truncated instead of resizing the echo area. @@ -33140,7 +33140,7 @@ cursor shapes. */); DEFVAR_LISP ("hourglass-delay", Vhourglass_delay, doc: /* Seconds to wait before displaying an hourglass pointer when Emacs is busy. */); - Vhourglass_delay = make_number (DEFAULT_HOURGLASS_DELAY); + Vhourglass_delay = make_fixnum (DEFAULT_HOURGLASS_DELAY); #ifdef HAVE_WINDOW_SYSTEM hourglass_atimer = NULL; @@ -33165,7 +33165,7 @@ or t (meaning all windows). */); /* Symbol for the purpose of Vglyphless_char_display. */ DEFSYM (Qglyphless_char_display, "glyphless-char-display"); - Fput (Qglyphless_char_display, Qchar_table_extra_slots, make_number (1)); + Fput (Qglyphless_char_display, Qchar_table_extra_slots, make_fixnum (1)); DEFVAR_LISP ("glyphless-char-display", Vglyphless_char_display, doc: /* Char-table defining glyphless characters. @@ -33188,7 +33188,7 @@ If a character has a non-nil entry in an active display table, the display table takes effect; in this case, Emacs does not consult `glyphless-char-display' at all. */); Vglyphless_char_display = Fmake_char_table (Qglyphless_char_display, Qnil); - Fset_char_table_extra_slot (Vglyphless_char_display, make_number (0), + Fset_char_table_extra_slot (Vglyphless_char_display, make_fixnum (0), Qempty_box); DEFVAR_LISP ("debug-on-message", Vdebug_on_message, @@ -33256,7 +33256,7 @@ init_xdisp (void) /* The default ellipsis glyphs `...'. */ for (i = 0; i < 3; ++i) - default_invis_vector[i] = make_number ('.'); + default_invis_vector[i] = make_fixnum ('.'); } { @@ -33315,7 +33315,7 @@ start_hourglass (void) cancel_hourglass (); - if (INTEGERP (Vhourglass_delay) + if (FIXNUMP (Vhourglass_delay) && XINT (Vhourglass_delay) > 0) delay = make_timespec (min (XINT (Vhourglass_delay), TYPE_MAXIMUM (time_t)), diff --git a/src/xfaces.c b/src/xfaces.c index eea0672418..f87eb66b3a 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -736,8 +736,8 @@ the pixmap. Bits are stored row by row, each row occupies } if (STRINGP (data) - && RANGED_INTEGERP (1, width, INT_MAX) - && RANGED_INTEGERP (1, height, INT_MAX)) + && RANGED_FIXNUMP (1, width, INT_MAX) + && RANGED_FIXNUMP (1, height, INT_MAX)) { int bytes_per_row = (XINT (width) + CHAR_BIT - 1) / CHAR_BIT; if (XINT (height) <= SBYTES (data) / bytes_per_row) @@ -818,7 +818,7 @@ static bool parse_rgb_list (Lisp_Object rgb_list, XColor *color) { #define PARSE_RGB_LIST_FIELD(field) \ - if (CONSP (rgb_list) && INTEGERP (XCAR (rgb_list))) \ + if (CONSP (rgb_list) && FIXNUMP (XCAR (rgb_list))) \ { \ color->field = XINT (XCAR (rgb_list)); \ rgb_list = XCDR (rgb_list); \ @@ -855,7 +855,7 @@ tty_lookup_color (struct frame *f, Lisp_Object color, XColor *tty_color, { Lisp_Object rgb; - if (! INTEGERP (XCAR (XCDR (color_desc)))) + if (! FIXNUMP (XCAR (XCDR (color_desc)))) return false; tty_color->pixel = XINT (XCAR (XCDR (color_desc))); @@ -971,7 +971,7 @@ tty_color_name (struct frame *f, int idx) Lisp_Object coldesc; XSETFRAME (frame, f); - coldesc = call2 (Qtty_color_by_index, make_number (idx), frame); + coldesc = call2 (Qtty_color_by_index, make_fixnum (idx), frame); if (!NILP (coldesc)) return XCAR (coldesc); @@ -1390,12 +1390,12 @@ compare_fonts_by_sort_order (const void *v1, const void *v2) } else { - if (INTEGERP (val1)) - result = (INTEGERP (val2) && XINT (val1) >= XINT (val2) + if (FIXNUMP (val1)) + result = (FIXNUMP (val2) && XINT (val1) >= XINT (val2) ? XINT (val1) > XINT (val2) : -1); else - result = INTEGERP (val2) ? 1 : 0; + result = FIXNUMP (val2) ? 1 : 0; } if (result) return result; @@ -1479,7 +1479,7 @@ the face font sort order. */) ASET (v, 1, FONT_WIDTH_SYMBOLIC (font)); point = PIXEL_TO_POINT (XINT (AREF (font, FONT_SIZE_INDEX)) * 10, FRAME_RES_Y (f)); - ASET (v, 2, make_number (point)); + ASET (v, 2, make_fixnum (point)); ASET (v, 3, FONT_WEIGHT_SYMBOLIC (font)); ASET (v, 4, FONT_SLANT_SYMBOLIC (font)); spacing = Ffont_get (font, QCspacing); @@ -1526,10 +1526,10 @@ the WIDTH times as wide as FACE on FRAME. */) CHECK_STRING (pattern); if (! NILP (maximum)) - CHECK_NATNUM (maximum); + CHECK_FIXNAT (maximum); if (!NILP (width)) - CHECK_NUMBER (width); + CHECK_FIXNUM (width); /* We can't simply call decode_window_system_frame because this function may be called before any frame is created. */ @@ -1575,8 +1575,8 @@ the WIDTH times as wide as FACE on FRAME. */) if (size) { - Ffont_put (font_spec, QCsize, make_number (size)); - Ffont_put (font_spec, QCavgwidth, make_number (avgwidth)); + Ffont_put (font_spec, QCsize, make_fixnum (size)); + Ffont_put (font_spec, QCavgwidth, make_fixnum (avgwidth)); } Lisp_Object fonts = Flist_fonts (font_spec, frame, maximum, font_spec); for (Lisp_Object tail = fonts; CONSP (tail); tail = XCDR (tail)) @@ -1659,7 +1659,7 @@ check_lface_attrs (Lisp_Object attrs[LFACE_VECTOR_SIZE]) || SYMBOLP (attrs[LFACE_SWIDTH_INDEX])); eassert (UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX]) || IGNORE_DEFFACE_P (attrs[LFACE_HEIGHT_INDEX]) - || NUMBERP (attrs[LFACE_HEIGHT_INDEX]) + || FIXED_OR_FLOATP (attrs[LFACE_HEIGHT_INDEX]) || FUNCTIONP (attrs[LFACE_HEIGHT_INDEX])); eassert (UNSPECIFIEDP (attrs[LFACE_WEIGHT_INDEX]) || IGNORE_DEFFACE_P (attrs[LFACE_WEIGHT_INDEX]) @@ -1684,7 +1684,7 @@ check_lface_attrs (Lisp_Object attrs[LFACE_VECTOR_SIZE]) || IGNORE_DEFFACE_P (attrs[LFACE_BOX_INDEX]) || SYMBOLP (attrs[LFACE_BOX_INDEX]) || STRINGP (attrs[LFACE_BOX_INDEX]) - || INTEGERP (attrs[LFACE_BOX_INDEX]) + || FIXNUMP (attrs[LFACE_BOX_INDEX]) || CONSP (attrs[LFACE_BOX_INDEX])); eassert (UNSPECIFIEDP (attrs[LFACE_INVERSE_INDEX]) || IGNORE_DEFFACE_P (attrs[LFACE_INVERSE_INDEX]) @@ -2007,7 +2007,7 @@ set_lface_from_font (struct frame *f, Lisp_Object lface, int pt = PIXEL_TO_POINT (font->pixel_size * 10, FRAME_RES_Y (f)); eassert (pt > 0); - ASET (lface, LFACE_HEIGHT_INDEX, make_number (pt)); + ASET (lface, LFACE_HEIGHT_INDEX, make_fixnum (pt)); } if (force_p || UNSPECIFIEDP (LFACE_WEIGHT (lface))) @@ -2043,15 +2043,15 @@ merge_face_heights (Lisp_Object from, Lisp_Object to, Lisp_Object invalid) { Lisp_Object result = invalid; - if (INTEGERP (from)) + if (FIXNUMP (from)) /* FROM is absolute, just use it as is. */ result = from; else if (FLOATP (from)) /* FROM is a scale, use it to adjust TO. */ { - if (INTEGERP (to)) + if (FIXNUMP (to)) /* relative X absolute => absolute */ - result = make_number (XFLOAT_DATA (from) * XINT (to)); + result = make_fixnum (XFLOAT_DATA (from) * XINT (to)); else if (FLOATP (to)) /* relative X relative => relative */ result = make_float (XFLOAT_DATA (from) * XFLOAT_DATA (to)); @@ -2066,7 +2066,7 @@ merge_face_heights (Lisp_Object from, Lisp_Object to, Lisp_Object invalid) result = safe_call1 (from, to); /* Ensure that if TO was absolute, so is the result. */ - if (INTEGERP (to) && !INTEGERP (result)) + if (FIXNUMP (to) && !FIXNUMP (result)) result = invalid; } @@ -2113,7 +2113,7 @@ merge_face_vectors (struct window *w, for (i = 1; i < LFACE_VECTOR_SIZE; ++i) if (!UNSPECIFIEDP (from[i])) { - if (i == LFACE_HEIGHT_INDEX && !INTEGERP (from[i])) + if (i == LFACE_HEIGHT_INDEX && !FIXNUMP (from[i])) { to[i] = merge_face_heights (from[i], to[i], to[i]); font_clear_prop (to, FONT_SIZE_INDEX); @@ -2476,8 +2476,8 @@ merge_face_ref (struct window *w, else if (EQ (keyword, QCbox)) { if (EQ (value, Qt)) - value = make_number (1); - if (INTEGERP (value) + value = make_fixnum (1); + if (FIXNUMP (value) || STRINGP (value) || CONSP (value) || NILP (value)) @@ -2615,7 +2615,7 @@ Value is a vector of face attributes. */) /* Add a global definition if there is none. */ if (NILP (global_lface)) { - global_lface = Fmake_vector (make_number (LFACE_VECTOR_SIZE), + global_lface = Fmake_vector (make_fixnum (LFACE_VECTOR_SIZE), Qunspecified); ASET (global_lface, 0, Qface); Vface_new_frame_defaults = Fcons (Fcons (face, global_lface), @@ -2631,7 +2631,7 @@ Value is a vector of face attributes. */) sizeof *lface_id_to_name); lface_id_to_name[next_lface_id] = face; - Fput (face, Qface, make_number (next_lface_id)); + Fput (face, Qface, make_fixnum (next_lface_id)); ++next_lface_id; } else if (f == NULL) @@ -2643,7 +2643,7 @@ Value is a vector of face attributes. */) { if (NILP (lface)) { - lface = Fmake_vector (make_number (LFACE_VECTOR_SIZE), + lface = Fmake_vector (make_fixnum (LFACE_VECTOR_SIZE), Qunspecified); ASET (lface, 0, Qface); fset_face_alist (f, Fcons (Fcons (face, lface), f->face_alist)); @@ -2792,7 +2792,7 @@ FRAME 0 means change the face on all frames, and change the default /* If FRAME is 0, change face on all frames, and change the default for new frames. */ - if (INTEGERP (frame) && XINT (frame) == 0) + if (FIXNUMP (frame) && XINT (frame) == 0) { Lisp_Object tail; Finternal_set_lisp_face_attribute (face, attr, value, Qt); @@ -2862,7 +2862,7 @@ FRAME 0 means change the face on all frames, and change the default if (EQ (face, Qdefault)) { /* The default face must have an absolute size. */ - if (!INTEGERP (value) || XINT (value) <= 0) + if (!FIXNUMP (value) || XINT (value) <= 0) signal_error ("Default face height not absolute and positive", value); } @@ -2871,9 +2871,9 @@ FRAME 0 means change the face on all frames, and change the default /* For non-default faces, do a test merge with a random height to see if VALUE's ok. */ Lisp_Object test = merge_face_heights (value, - make_number (10), + make_fixnum (10), Qnil); - if (!INTEGERP (test) || XINT (test) <= 0) + if (!FIXNUMP (test) || XINT (test) <= 0) signal_error ("Face height does not produce a positive integer", value); } @@ -3001,13 +3001,13 @@ FRAME 0 means change the face on all frames, and change the default /* Allow t meaning a simple box of width 1 in foreground color of the face. */ if (EQ (value, Qt)) - value = make_number (1); + value = make_fixnum (1); if (UNSPECIFIEDP (value) || IGNORE_DEFFACE_P (value)) valid_p = true; else if (NILP (value)) valid_p = true; - else if (INTEGERP (value)) + else if (FIXNUMP (value)) valid_p = XINT (value) != 0; else if (STRINGP (value)) valid_p = SCHARS (value) > 0; @@ -3029,7 +3029,7 @@ FRAME 0 means change the face on all frames, and change the default if (EQ (k, QCline_width)) { - if (!INTEGERP (v) || XINT (v) == 0) + if (!FIXNUMP (v) || XINT (v) == 0) break; } else if (EQ (k, QCcolor)) @@ -3504,7 +3504,7 @@ ordinary `x-get-resource' doesn't take a frame argument. */) static Lisp_Object face_boolean_x_resource_value (Lisp_Object value, bool signal_p) { - Lisp_Object result = make_number (0); + Lisp_Object result = make_fixnum (0); eassert (STRINGP (value)); @@ -3538,7 +3538,7 @@ DEFUN ("internal-set-lisp-face-attribute-from-resource", else if (EQ (attr, QCheight)) { value = Fstring_to_number (value, Qnil); - if (!INTEGERP (value) || XINT (value) <= 0) + if (!FIXNUMP (value) || XINT (value) <= 0) signal_error ("Invalid face height from X resource", value); } else if (EQ (attr, QCbold) || EQ (attr, QCitalic)) @@ -3698,7 +3698,7 @@ However, for :height, floating point values are also relative. */ if (EQ (value, Qunspecified) || (EQ (value, QCignore_defface))) return Qt; else if (EQ (attribute, QCheight)) - return INTEGERP (value) ? Qnil : Qt; + return FIXNUMP (value) ? Qnil : Qt; else return Qnil; } @@ -4256,15 +4256,15 @@ two lists of the form (RED GREEN BLUE) aforementioned. */) signal_error ("Invalid color", color2); if (NILP (metric)) - return make_number (color_distance (&cdef1, &cdef2)); + return make_fixnum (color_distance (&cdef1, &cdef2)); else return call2 (metric, - list3 (make_number (cdef1.red), - make_number (cdef1.green), - make_number (cdef1.blue)), - list3 (make_number (cdef2.red), - make_number (cdef2.green), - make_number (cdef2.blue))); + list3 (make_fixnum (cdef1.red), + make_fixnum (cdef1.green), + make_fixnum (cdef1.blue)), + list3 (make_fixnum (cdef2.red), + make_fixnum (cdef2.green), + make_fixnum (cdef2.blue))); } @@ -4696,7 +4696,7 @@ smaller_face (struct frame *f, int face_id, int steps) { /* Look up a face for a slightly smaller/larger font. */ pt += delta; - attrs[LFACE_HEIGHT_INDEX] = make_number (pt); + attrs[LFACE_HEIGHT_INDEX] = make_fixnum (pt); new_face_id = lookup_face (f, attrs); new_face = FACE_FROM_ID (f, new_face_id); @@ -4736,7 +4736,7 @@ face_with_height (struct frame *f, int face_id, int height) face = FACE_FROM_ID (f, face_id); memcpy (attrs, face->lface, sizeof attrs); - attrs[LFACE_HEIGHT_INDEX] = make_number (height); + attrs[LFACE_HEIGHT_INDEX] = make_fixnum (height); font_clear_prop (attrs, FONT_SIZE_INDEX); face_id = lookup_face (f, attrs); #endif /* HAVE_WINDOW_SYSTEM */ @@ -4776,7 +4776,7 @@ DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector, (Lisp_Object plist) { Lisp_Object lface; - lface = Fmake_vector (make_number (LFACE_VECTOR_SIZE), + lface = Fmake_vector (make_fixnum (LFACE_VECTOR_SIZE), Qunspecified); merge_face_ref (NULL, XFRAME (selected_frame), plist, XVECTOR (lface)->contents, @@ -4886,8 +4886,8 @@ x_supports_face_attributes_p (struct frame *f, return true; s1 = SYMBOL_NAME (face->font->props[i]); s2 = SYMBOL_NAME (def_face->font->props[i]); - if (! EQ (Fcompare_strings (s1, make_number (0), Qnil, - s2, make_number (0), Qnil, Qt), Qt)) + if (! EQ (Fcompare_strings (s1, make_fixnum (0), Qnil, + s2, make_fixnum (0), Qnil, Qt), Qt)) return true; } return false; @@ -5391,7 +5391,7 @@ realize_default_face (struct frame *f) ASET (lface, LFACE_FAMILY_INDEX, build_string ("default")); ASET (lface, LFACE_FOUNDRY_INDEX, LFACE_FAMILY (lface)); ASET (lface, LFACE_SWIDTH_INDEX, Qnormal); - ASET (lface, LFACE_HEIGHT_INDEX, make_number (1)); + ASET (lface, LFACE_HEIGHT_INDEX, make_fixnum (1)); if (UNSPECIFIEDP (LFACE_WEIGHT (lface))) ASET (lface, LFACE_WEIGHT_INDEX, Qnormal); if (UNSPECIFIEDP (LFACE_SLANT (lface))) @@ -5675,7 +5675,7 @@ realize_x_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE]) face->box = FACE_SIMPLE_BOX; face->box_line_width = 1; } - else if (INTEGERP (box)) + else if (FIXNUMP (box)) { /* Simple box of specified line width in foreground color of the face. */ @@ -5708,7 +5708,7 @@ realize_x_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE]) if (EQ (keyword, QCline_width)) { - if (INTEGERP (value) && XINT (value) != 0) + if (FIXNUMP (value) && XINT (value) != 0) face->box_line_width = XINT (value); } else if (EQ (keyword, QCcolor)) @@ -6074,7 +6074,7 @@ face_at_buffer_position (struct window *w, ptrdiff_t pos, prop = Fget_text_property (position, propname, w->contents); XSETFASTINT (limit1, (limit < endpos ? limit : endpos)); end = Fnext_single_property_change (position, propname, w->contents, limit1); - if (INTEGERP (end)) + if (FIXNUMP (end)) endpos = XINT (end); /* Look at properties from overlays. */ @@ -6203,7 +6203,7 @@ face_for_overlay_string (struct window *w, ptrdiff_t pos, prop = Fget_text_property (position, propname, w->contents); XSETFASTINT (limit1, (limit < endpos ? limit : endpos)); end = Fnext_single_property_change (position, propname, w->contents, limit1); - if (INTEGERP (end)) + if (FIXNUMP (end)) endpos = XINT (end); *endptr = endpos; @@ -6276,7 +6276,7 @@ face_at_string_position (struct window *w, Lisp_Object string, short, so set the limit to the end of the string. */ XSETFASTINT (limit, SCHARS (string)); end = Fnext_single_property_change (position, prop_name, string, limit); - if (INTEGERP (end)) + if (FIXNUMP (end)) *endptr = XFASTINT (end); else *endptr = -1; @@ -6406,7 +6406,7 @@ where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */) char *name = buf + num; ptrdiff_t len = strlen (name); len -= 0 < len && name[len - 1] == '\n'; - cmap = Fcons (Fcons (make_string (name, len), make_number (color)), + cmap = Fcons (Fcons (make_string (name, len), make_fixnum (color)), cmap); } } @@ -6471,12 +6471,12 @@ DEFUN ("dump-face", Fdump_face, Sdump_face, 0, 1, 0, doc: /* */) fprintf (stderr, "\n"); for (i = 0; i < FRAME_FACE_CACHE (SELECTED_FRAME ())->used; ++i) - Fdump_face (make_number (i)); + Fdump_face (make_fixnum (i)); } else { struct face *face; - CHECK_NUMBER (n); + CHECK_FIXNUM (n); face = FACE_FROM_ID_OR_NULL (SELECTED_FRAME (), XINT (n)); if (face == NULL) error ("Not a valid face"); diff --git a/src/xfns.c b/src/xfns.c index fe8170cf63..224e090ebc 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -1531,7 +1531,7 @@ x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) if (FRAME_MINIBUF_ONLY_P (f) || FRAME_PARENT_FRAME (f)) return; - if (TYPE_RANGED_INTEGERP (int, value)) + if (TYPE_RANGED_FIXNUMP (int, value)) nlines = XINT (value); else nlines = 0; @@ -1618,7 +1618,7 @@ x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) return; /* Use VALUE only if an int >= 0. */ - if (RANGED_INTEGERP (0, value, INT_MAX)) + if (RANGED_FIXNUMP (0, value, INT_MAX)) nlines = XFASTINT (value); else nlines = 0; @@ -1661,8 +1661,8 @@ x_change_tool_bar_height (struct frame *f, int height) FRAME_TOOL_BAR_HEIGHT (f) = height; FRAME_TOOL_BAR_LINES (f) = lines; /* Store the `tool-bar-lines' and `height' frame parameters. */ - store_frame_param (f, Qtool_bar_lines, make_number (lines)); - store_frame_param (f, Qheight, make_number (FRAME_LINES (f))); + store_frame_param (f, Qtool_bar_lines, make_fixnum (lines)); + store_frame_param (f, Qheight, make_fixnum (FRAME_LINES (f))); /* We also have to make sure that the internal border at the top of the frame, below the menu bar or tool bar, is redrawn when the @@ -3261,8 +3261,8 @@ x_icon_verify (struct frame *f, Lisp_Object parms) icon_y = x_frame_get_and_record_arg (f, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER); if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound)) { - CHECK_NUMBER (icon_x); - CHECK_NUMBER (icon_y); + CHECK_FIXNUM (icon_x); + CHECK_FIXNUM (icon_y); } else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound)) error ("Both left and top icon corners of icon must be specified"); @@ -3617,7 +3617,7 @@ This function is an internal primitive--use `make-frame' instead. */) if (EQ (parent, Qunbound)) parent = Qnil; if (! NILP (parent)) - CHECK_NUMBER (parent); + CHECK_FIXNUM (parent); frame = Qnil; tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer", @@ -3782,7 +3782,7 @@ This function is an internal primitive--use `make-frame' instead. */) /* Frame contents get displaced if an embedded X window has a border. */ if (! FRAME_X_EMBEDDED_P (f)) - x_default_parameter (f, parms, Qborder_width, make_number (0), + x_default_parameter (f, parms, Qborder_width, make_fixnum (0), "borderWidth", "BorderWidth", RES_TYPE_NUMBER); /* This defaults to 1 in order to match xterm. We recognize either @@ -3800,15 +3800,15 @@ This function is an internal primitive--use `make-frame' instead. */) } x_default_parameter (f, parms, Qinternal_border_width, #ifdef USE_GTK /* We used to impose 0 in xg_create_frame_widgets. */ - make_number (0), + make_fixnum (0), #else - make_number (1), + make_fixnum (1), #endif "internalBorderWidth", "internalBorderWidth", RES_TYPE_NUMBER); - x_default_parameter (f, parms, Qright_divider_width, make_number (0), + x_default_parameter (f, parms, Qright_divider_width, make_fixnum (0), NULL, NULL, RES_TYPE_NUMBER); - x_default_parameter (f, parms, Qbottom_divider_width, make_number (0), + x_default_parameter (f, parms, Qbottom_divider_width, make_fixnum (0), NULL, NULL, RES_TYPE_NUMBER); x_default_parameter (f, parms, Qvertical_scroll_bars, #if defined (USE_GTK) && defined (USE_TOOLKIT_SCROLL_BARS) @@ -3866,10 +3866,10 @@ This function is an internal primitive--use `make-frame' instead. */) Also process `min-width' and `min-height' parameters right here because `frame-windows-min-size' needs them. */ tem = x_get_arg (dpyinfo, parms, Qmin_width, NULL, NULL, RES_TYPE_NUMBER); - if (NUMBERP (tem)) + if (FIXED_OR_FLOATP (tem)) store_frame_param (f, Qmin_width, tem); tem = x_get_arg (dpyinfo, parms, Qmin_height, NULL, NULL, RES_TYPE_NUMBER); - if (NUMBERP (tem)) + if (FIXED_OR_FLOATP (tem)) store_frame_param (f, Qmin_height, tem); adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f), FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, true, @@ -3882,11 +3882,11 @@ This function is an internal primitive--use `make-frame' instead. */) x_default_parameter (f, parms, Qmenu_bar_lines, NILP (Vmenu_bar_mode) - ? make_number (0) : make_number (1), + ? make_fixnum (0) : make_fixnum (1), NULL, NULL, RES_TYPE_NUMBER); x_default_parameter (f, parms, Qtool_bar_lines, NILP (Vtool_bar_mode) - ? make_number (0) : make_number (1), + ? make_fixnum (0) : make_fixnum (1), NULL, NULL, RES_TYPE_NUMBER); x_default_parameter (f, parms, Qbuffer_predicate, Qnil, @@ -4222,7 +4222,7 @@ each physical monitor, use `display-monitor-attributes-list'. */) { struct x_display_info *dpyinfo = check_x_display_info (terminal); - return make_number (x_display_pixel_width (dpyinfo)); + return make_fixnum (x_display_pixel_width (dpyinfo)); } DEFUN ("x-display-pixel-height", Fx_display_pixel_height, @@ -4240,7 +4240,7 @@ each physical monitor, use `display-monitor-attributes-list'. */) { struct x_display_info *dpyinfo = check_x_display_info (terminal); - return make_number (x_display_pixel_height (dpyinfo)); + return make_fixnum (x_display_pixel_height (dpyinfo)); } DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes, @@ -4254,7 +4254,7 @@ If omitted or nil, that stands for the selected frame's display. { struct x_display_info *dpyinfo = check_x_display_info (terminal); - return make_number (dpyinfo->n_planes); + return make_fixnum (dpyinfo->n_planes); } DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells, @@ -4278,7 +4278,7 @@ If omitted or nil, that stands for the selected frame's display. it "should be enough for everyone". */ if (nr_planes > 24) nr_planes = 24; - return make_number (1 << nr_planes); + return make_fixnum (1 << nr_planes); } DEFUN ("x-server-max-request-size", Fx_server_max_request_size, @@ -4295,7 +4295,7 @@ On Nextstep, this function just returns nil. */) { struct x_display_info *dpyinfo = check_x_display_info (terminal); - return make_number (MAXREQUEST (dpyinfo->display)); + return make_fixnum (MAXREQUEST (dpyinfo->display)); } DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0, @@ -4358,7 +4358,7 @@ For the number of physical monitors, use `(length { struct x_display_info *dpyinfo = check_x_display_info (terminal); - return make_number (ScreenCount (dpyinfo->display)); + return make_fixnum (ScreenCount (dpyinfo->display)); } DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0, @@ -4375,7 +4375,7 @@ for each physical monitor, use `display-monitor-attributes-list'. */) { struct x_display_info *dpyinfo = check_x_display_info (terminal); - return make_number (HeightMMOfScreen (dpyinfo->screen)); + return make_fixnum (HeightMMOfScreen (dpyinfo->screen)); } DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0, @@ -4392,7 +4392,7 @@ for each physical monitor, use `display-monitor-attributes-list'. */) { struct x_display_info *dpyinfo = check_x_display_info (terminal); - return make_number (WidthMMOfScreen (dpyinfo->screen)); + return make_fixnum (WidthMMOfScreen (dpyinfo->screen)); } DEFUN ("x-display-backing-store", Fx_display_backing_store, @@ -4628,7 +4628,7 @@ x_make_monitor_attribute_list (struct MonitorInfo *monitors, struct x_display_info *dpyinfo, const char *source) { - Lisp_Object monitor_frames = Fmake_vector (make_number (n_monitors), Qnil); + Lisp_Object monitor_frames = Fmake_vector (make_fixnum (n_monitors), Qnil); Lisp_Object frame, rest; FOR_EACH_FRAME (rest, frame) @@ -4931,7 +4931,7 @@ Internal use only, use `display-monitor-attributes-list' instead. */) #endif n_monitors = gdk_screen_get_n_monitors (gscreen); #endif - monitor_frames = Fmake_vector (make_number (n_monitors), Qnil); + monitor_frames = Fmake_vector (make_fixnum (n_monitors), Qnil); monitors = xzalloc (n_monitors * sizeof *monitors); FOR_EACH_FRAME (rest, frame) @@ -5099,8 +5099,8 @@ frame_geometry (Lisp_Object frame, Lisp_Object attribute) edges = Fx_frame_edges (parent, Qnative_edges); if (!NILP (edges)) { - x_native += XINT (Fnth (make_number (0), edges)); - y_native += XINT (Fnth (make_number (1), edges)); + x_native += XINT (Fnth (make_fixnum (0), edges)); + y_native += XINT (Fnth (make_fixnum (1), edges)); } outer_left = x_native; @@ -5185,43 +5185,43 @@ frame_geometry (Lisp_Object frame, Lisp_Object attribute) /* Construct list. */ if (EQ (attribute, Qouter_edges)) - return list4 (make_number (outer_left), make_number (outer_top), - make_number (outer_right), make_number (outer_bottom)); + return list4 (make_fixnum (outer_left), make_fixnum (outer_top), + make_fixnum (outer_right), make_fixnum (outer_bottom)); else if (EQ (attribute, Qnative_edges)) - return list4 (make_number (native_left), make_number (native_top), - make_number (native_right), make_number (native_bottom)); + return list4 (make_fixnum (native_left), make_fixnum (native_top), + make_fixnum (native_right), make_fixnum (native_bottom)); else if (EQ (attribute, Qinner_edges)) - return list4 (make_number (inner_left), make_number (inner_top), - make_number (inner_right), make_number (inner_bottom)); + return list4 (make_fixnum (inner_left), make_fixnum (inner_top), + make_fixnum (inner_right), make_fixnum (inner_bottom)); else return listn (CONSTYPE_HEAP, 11, Fcons (Qouter_position, - Fcons (make_number (outer_left), - make_number (outer_top))), + Fcons (make_fixnum (outer_left), + make_fixnum (outer_top))), Fcons (Qouter_size, - Fcons (make_number (outer_right - outer_left), - make_number (outer_bottom - outer_top))), + Fcons (make_fixnum (outer_right - outer_left), + make_fixnum (outer_bottom - outer_top))), /* Approximate. */ Fcons (Qexternal_border_size, - Fcons (make_number (right_off), - make_number (bottom_off))), - Fcons (Qouter_border_width, make_number (x_border_width)), + Fcons (make_fixnum (right_off), + make_fixnum (bottom_off))), + Fcons (Qouter_border_width, make_fixnum (x_border_width)), /* Approximate. */ Fcons (Qtitle_bar_size, - Fcons (make_number (0), - make_number (top_off - bottom_off))), + Fcons (make_fixnum (0), + make_fixnum (top_off - bottom_off))), Fcons (Qmenu_bar_external, menu_bar_external ? Qt : Qnil), Fcons (Qmenu_bar_size, - Fcons (make_number (menu_bar_width), - make_number (menu_bar_height))), + Fcons (make_fixnum (menu_bar_width), + make_fixnum (menu_bar_height))), Fcons (Qtool_bar_external, tool_bar_external ? Qt : Qnil), Fcons (Qtool_bar_position, FRAME_TOOL_BAR_POSITION (f)), Fcons (Qtool_bar_size, - Fcons (make_number (tool_bar_width), - make_number (tool_bar_height))), + Fcons (make_fixnum (tool_bar_width), + make_fixnum (tool_bar_height))), Fcons (Qinternal_border_width, - make_number (internal_border_width))); + make_fixnum (internal_border_width))); } DEFUN ("x-frame-geometry", Fx_frame_geometry, Sx_frame_geometry, 0, 1, 0, @@ -5456,7 +5456,7 @@ selected frame's display. */) (unsigned int *) &dummy); unblock_input (); - return Fcons (make_number (x), make_number (y)); + return Fcons (make_fixnum (x), make_fixnum (y)); } DEFUN ("x-set-mouse-absolute-pixel-position", Fx_set_mouse_absolute_pixel_position, @@ -5774,7 +5774,7 @@ FRAME. Default is to change on the edit X window. */) if (! NILP (format)) { - CHECK_NUMBER (format); + CHECK_FIXNUM (format); if (XINT (format) != 8 && XINT (format) != 16 && XINT (format) != 32) @@ -6072,9 +6072,9 @@ Otherwise, the return value is a vector with the following fields: XFree (tmp_data); prop_attr = make_uninit_vector (3); - ASET (prop_attr, 0, make_number (actual_type)); - ASET (prop_attr, 1, make_number (actual_format)); - ASET (prop_attr, 2, make_number (bytes_remaining / (actual_format >> 3))); + ASET (prop_attr, 0, make_fixnum (actual_type)); + ASET (prop_attr, 1, make_fixnum (actual_format)); + ASET (prop_attr, 2, make_fixnum (bytes_remaining / (actual_format >> 3))); } unblock_input (); @@ -6257,7 +6257,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms) needed to determine window geometry. */ x_default_font_parameter (f, parms); - x_default_parameter (f, parms, Qborder_width, make_number (0), + x_default_parameter (f, parms, Qborder_width, make_fixnum (0), "borderWidth", "BorderWidth", RES_TYPE_NUMBER); /* This defaults to 2 in order to match xterm. We recognize either @@ -6274,12 +6274,12 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms) parms); } - x_default_parameter (f, parms, Qinternal_border_width, make_number (1), + x_default_parameter (f, parms, Qinternal_border_width, make_fixnum (1), "internalBorderWidth", "internalBorderWidth", RES_TYPE_NUMBER); - x_default_parameter (f, parms, Qright_divider_width, make_number (0), + x_default_parameter (f, parms, Qright_divider_width, make_fixnum (0), NULL, NULL, RES_TYPE_NUMBER); - x_default_parameter (f, parms, Qbottom_divider_width, make_number (0), + x_default_parameter (f, parms, Qbottom_divider_width, make_fixnum (0), NULL, NULL, RES_TYPE_NUMBER); /* Also do the stuff which must be set before the window exists. */ @@ -6463,8 +6463,8 @@ compute_tip_xy (struct frame *f, /* Move the tooltip window where the mouse pointer is. Resize and show it. */ - if ((!INTEGERP (left) && !INTEGERP (right)) - || (!INTEGERP (top) && !INTEGERP (bottom))) + if ((!FIXNUMP (left) && !FIXNUMP (right)) + || (!FIXNUMP (top) && !FIXNUMP (bottom))) { Lisp_Object frame, attributes, monitor, geometry; @@ -6484,10 +6484,10 @@ compute_tip_xy (struct frame *f, geometry = Fassq (Qgeometry, monitor); if (CONSP (geometry)) { - min_x = XINT (Fnth (make_number (1), geometry)); - min_y = XINT (Fnth (make_number (2), geometry)); - max_x = min_x + XINT (Fnth (make_number (3), geometry)); - max_y = min_y + XINT (Fnth (make_number (4), geometry)); + min_x = XINT (Fnth (make_fixnum (1), geometry)); + min_y = XINT (Fnth (make_fixnum (2), geometry)); + max_x = min_x + XINT (Fnth (make_fixnum (3), geometry)); + max_y = min_y + XINT (Fnth (make_fixnum (4), geometry)); if (min_x <= *root_x && *root_x < max_x && min_y <= *root_y && *root_y < max_y) { @@ -6510,9 +6510,9 @@ compute_tip_xy (struct frame *f, max_y = x_display_pixel_height (FRAME_DISPLAY_INFO (f)); } - if (INTEGERP (top)) + if (FIXNUMP (top)) *root_y = XINT (top); - else if (INTEGERP (bottom)) + else if (FIXNUMP (bottom)) *root_y = XINT (bottom) - height; else if (*root_y + XINT (dy) <= min_y) *root_y = min_y; /* Can happen for negative dy */ @@ -6526,9 +6526,9 @@ compute_tip_xy (struct frame *f, /* Put it on the top. */ *root_y = min_y; - if (INTEGERP (left)) + if (FIXNUMP (left)) *root_x = XINT (left); - else if (INTEGERP (right)) + else if (FIXNUMP (right)) *root_x = XINT (right) - width; else if (*root_x + XINT (dx) <= min_x) *root_x = 0; /* Can happen for negative dx */ @@ -6758,19 +6758,19 @@ Text larger than the specified size is clipped. */) f = decode_window_system_frame (frame); if (NILP (timeout)) - timeout = make_number (5); + timeout = make_fixnum (5); else - CHECK_NATNUM (timeout); + CHECK_FIXNAT (timeout); if (NILP (dx)) - dx = make_number (5); + dx = make_fixnum (5); else - CHECK_NUMBER (dx); + CHECK_FIXNUM (dx); if (NILP (dy)) - dy = make_number (-10); + dy = make_fixnum (-10); else - CHECK_NUMBER (dy); + CHECK_FIXNUM (dy); #ifdef USE_GTK if (x_gtk_use_system_tooltips) @@ -6885,9 +6885,9 @@ Text larger than the specified size is clipped. */) if (NILP (Fassq (Qname, parms))) parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms); if (NILP (Fassq (Qinternal_border_width, parms))) - parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms); + parms = Fcons (Fcons (Qinternal_border_width, make_fixnum (3)), parms); if (NILP (Fassq (Qborder_width, parms))) - parms = Fcons (Fcons (Qborder_width, make_number (1)), parms); + parms = Fcons (Fcons (Qborder_width, make_fixnum (1)), parms); if (NILP (Fassq (Qborder_color, parms))) parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms); if (NILP (Fassq (Qbackground_color, parms))) @@ -6906,8 +6906,8 @@ Text larger than the specified size is clipped. */) tip_buf = Fget_buffer_create (tip); /* We will mark the tip window a "pseudo-window" below, and such windows cannot have display margins. */ - bset_left_margin_cols (XBUFFER (tip_buf), make_number (0)); - bset_right_margin_cols (XBUFFER (tip_buf), make_number (0)); + bset_left_margin_cols (XBUFFER (tip_buf), make_fixnum (0)); + bset_right_margin_cols (XBUFFER (tip_buf), make_fixnum (0)); set_window_buffer (window, tip_buf, false, false); w = XWINDOW (window); w->pseudo_window_p = true; @@ -6922,8 +6922,8 @@ Text larger than the specified size is clipped. */) w->pixel_top = 0; if (CONSP (Vx_max_tooltip_size) - && RANGED_INTEGERP (1, XCAR (Vx_max_tooltip_size), INT_MAX) - && RANGED_INTEGERP (1, XCDR (Vx_max_tooltip_size), INT_MAX)) + && RANGED_FIXNUMP (1, XCAR (Vx_max_tooltip_size), INT_MAX) + && RANGED_FIXNUMP (1, XCDR (Vx_max_tooltip_size), INT_MAX)) { w->total_cols = XFASTINT (XCAR (Vx_max_tooltip_size)); w->total_lines = XFASTINT (XCDR (Vx_max_tooltip_size)); @@ -6956,7 +6956,7 @@ Text larger than the specified size is clipped. */) try_window (window, pos, TRY_WINDOW_IGNORE_FONTS_CHANGE); /* Calculate size of tooltip window. */ size = Fwindow_text_pixel_size (window, Qnil, Qnil, Qnil, - make_number (w->pixel_height), Qnil); + make_fixnum (w->pixel_height), Qnil); /* Add the frame's internal border to calculated size. */ width = XINT (Fcar (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); height = XINT (Fcdr (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); @@ -7797,7 +7797,7 @@ or when you set the mouse color. */); DEFVAR_LISP ("x-max-tooltip-size", Vx_max_tooltip_size, doc: /* Maximum size for tooltips. Value is a pair (COLUMNS . ROWS). Text larger than this is clipped. */); - Vx_max_tooltip_size = Fcons (make_number (80), make_number (40)); + Vx_max_tooltip_size = Fcons (make_fixnum (80), make_fixnum (40)); DEFVAR_LISP ("x-no-window-manager", Vx_no_window_manager, doc: /* Non-nil if no X window manager is in use. diff --git a/src/xfont.c b/src/xfont.c index c2e416bc05..53f7070a64 100644 --- a/src/xfont.c +++ b/src/xfont.c @@ -376,8 +376,8 @@ xfont_list_pattern (Display *display, const char *pattern, continue; ASET (entity, FONT_TYPE_INDEX, Qx); /* Avoid auto-scaled fonts. */ - if (INTEGERP (AREF (entity, FONT_DPI_INDEX)) - && INTEGERP (AREF (entity, FONT_AVGWIDTH_INDEX)) + if (FIXNUMP (AREF (entity, FONT_DPI_INDEX)) + && FIXNUMP (AREF (entity, FONT_AVGWIDTH_INDEX)) && XINT (AREF (entity, FONT_DPI_INDEX)) != 0 && XINT (AREF (entity, FONT_AVGWIDTH_INDEX)) == 0) continue; @@ -386,7 +386,7 @@ xfont_list_pattern (Display *display, const char *pattern, { int size = 0; - if (INTEGERP (AREF (entity, FONT_SIZE_INDEX))) + if (FIXNUMP (AREF (entity, FONT_SIZE_INDEX))) size = XINT (AREF (entity, FONT_SIZE_INDEX)); else if (FLOATP (AREF (entity, FONT_SIZE_INDEX))) size = XFLOAT_DATA (AREF (entity, FONT_SIZE_INDEX)); @@ -811,7 +811,7 @@ xfont_open (struct frame *f, Lisp_Object entity, int pixel_size) font->space_width = 0; val = Ffont_get (font_object, QCavgwidth); - if (INTEGERP (val)) + if (FIXNUMP (val)) font->average_width = XINT (val) / 10; if (font->average_width < 0) font->average_width = - font->average_width; @@ -1101,6 +1101,6 @@ syms_of_xfont (void) staticpro (&xfont_scripts_cache); xfont_scripts_cache = CALLN (Fmake_hash_table, QCtest, Qequal); staticpro (&xfont_scratch_props); - xfont_scratch_props = Fmake_vector (make_number (8), Qnil); + xfont_scratch_props = Fmake_vector (make_fixnum (8), Qnil); register_font_driver (&xfont_driver, NULL); } diff --git a/src/xftfont.c b/src/xftfont.c index 5ef90a014e..b5749add66 100644 --- a/src/xftfont.c +++ b/src/xftfont.c @@ -219,7 +219,7 @@ xftfont_add_rendering_parameters (FcPattern *pat, Lisp_Object entity) FcPatternAddBool (pat, FC_AUTOHINT, NILP (val) ? FcFalse : FcTrue); else if (EQ (key, QChintstyle)) { - if (INTEGERP (val)) + if (FIXNUMP (val)) FcPatternAddInteger (pat, FC_HINT_STYLE, XINT (val)); else if (SYMBOLP (val) && FcNameConstant (SDATA (SYMBOL_NAME (val)), &ival)) @@ -227,7 +227,7 @@ xftfont_add_rendering_parameters (FcPattern *pat, Lisp_Object entity) } else if (EQ (key, QCrgba)) { - if (INTEGERP (val)) + if (FIXNUMP (val)) FcPatternAddInteger (pat, FC_RGBA, XINT (val)); else if (SYMBOLP (val) && FcNameConstant (SDATA (SYMBOL_NAME (val)), &ival)) @@ -235,7 +235,7 @@ xftfont_add_rendering_parameters (FcPattern *pat, Lisp_Object entity) } else if (EQ (key, QClcdfilter)) { - if (INTEGERP (val)) + if (FIXNUMP (val)) FcPatternAddInteger (pat, FC_LCD_FILTER, ival = XINT (val)); else if (SYMBOLP (val) && FcNameConstant (SDATA (SYMBOL_NAME (val)), &ival)) @@ -298,7 +298,7 @@ xftfont_open (struct frame *f, Lisp_Object entity, int pixel_size) FcPatternAddDouble (pat, FC_DPI, dbl); } val = AREF (entity, FONT_AVGWIDTH_INDEX); - if (INTEGERP (val) && XINT (val) == 0) + if (FIXNUMP (val) && XINT (val) == 0) FcPatternAddBool (pat, FC_SCALABLE, FcTrue); /* This is necessary to identify the exact font (e.g. 10x20.pcf.gz over 10x20-ISO8859-1.pcf.gz). */ @@ -352,7 +352,7 @@ xftfont_open (struct frame *f, Lisp_Object entity, int pixel_size) xftfont_info->matrix.xy = 0x10000L * matrix->xy; xftfont_info->matrix.yx = 0x10000L * matrix->yx; } - if (INTEGERP (AREF (entity, FONT_SPACING_INDEX))) + if (FIXNUMP (AREF (entity, FONT_SPACING_INDEX))) spacing = XINT (AREF (entity, FONT_SPACING_INDEX)); else spacing = FC_PROPORTIONAL; diff --git a/src/xmenu.c b/src/xmenu.c index 58fba8c322..f51e46fb27 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -1173,17 +1173,17 @@ menu_position_func (GtkMenu *menu, gint *x, gint *y, gboolean *push_in, gpointer items in x-display-monitor-attributes-list. */ workarea = call3 (Qframe_monitor_workarea, Qnil, - make_number (data->x), - make_number (data->y)); + make_fixnum (data->x), + make_fixnum (data->y)); if (CONSP (workarea)) { int min_x, min_y; min_x = XINT (XCAR (workarea)); - min_y = XINT (Fnth (make_number (1), workarea)); - max_x = min_x + XINT (Fnth (make_number (2), workarea)); - max_y = min_y + XINT (Fnth (make_number (3), workarea)); + min_y = XINT (Fnth (make_fixnum (1), workarea)); + max_x = min_x + XINT (Fnth (make_fixnum (2), workarea)); + max_y = min_y + XINT (Fnth (make_fixnum (3), workarea)); } if (max_x < 0 || max_y < 0) @@ -2043,9 +2043,9 @@ menu_help_callback (char const *help_string, int pane, int item) pane_name = first_item[MENU_ITEMS_ITEM_NAME]; /* (menu-item MENU-NAME PANE-NUMBER) */ - menu_object = list3 (Qmenu_item, pane_name, make_number (pane)); + menu_object = list3 (Qmenu_item, pane_name, make_fixnum (pane)); show_help_echo (help_string ? build_string (help_string) : Qnil, - Qnil, menu_object, make_number (item)); + Qnil, menu_object, make_fixnum (item)); } struct pop_down_menu diff --git a/src/xrdb.c b/src/xrdb.c index 836c147947..ce0e1cce07 100644 --- a/src/xrdb.c +++ b/src/xrdb.c @@ -474,7 +474,7 @@ x_load_resources (Display *display, const char *xrm_string, /* Set double click time of list boxes in the file selection dialog from `double-click-time'. */ - if (INTEGERP (Vdouble_click_time) && XINT (Vdouble_click_time) > 0) + if (FIXNUMP (Vdouble_click_time) && XINT (Vdouble_click_time) > 0) { sprintf (line, "%s*fsb*DirList.doubleClickInterval: %"pI"d", myclass, XFASTINT (Vdouble_click_time)); diff --git a/src/xselect.c b/src/xselect.c index 1f51be4c52..d24a493294 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -401,16 +401,16 @@ x_get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type, if (STRINGP (check) || VECTORP (check) || SYMBOLP (check) - || INTEGERP (check) + || FIXNUMP (check) || NILP (value)) return value; /* Check for a value that CONS_TO_INTEGER could handle. */ else if (CONSP (check) - && INTEGERP (XCAR (check)) - && (INTEGERP (XCDR (check)) + && FIXNUMP (XCAR (check)) + && (FIXNUMP (XCDR (check)) || (CONSP (XCDR (check)) - && INTEGERP (XCAR (XCDR (check))) + && FIXNUMP (XCAR (XCDR (check))) && NILP (XCDR (XCDR (check)))))) return value; @@ -1581,7 +1581,7 @@ selection_data_to_lisp_data (struct x_display_info *dpyinfo, lispy_type = QUTF8_STRING; else lispy_type = QSTRING; - Fput_text_property (make_number (0), make_number (size), + Fput_text_property (make_fixnum (0), make_fixnum (size), Qforeign_selection, lispy_type, str); return str; } @@ -1627,9 +1627,9 @@ selection_data_to_lisp_data (struct x_display_info *dpyinfo, else if (format == 16 && size == sizeof (short)) { if (type == XA_INTEGER) - return make_number (((short *) data) [0]); + return make_fixnum (((short *) data) [0]); else - return make_number (((unsigned short *) data) [0]); + return make_fixnum (((unsigned short *) data) [0]); } /* Convert any other kind of data to a vector of numbers, represented @@ -1645,7 +1645,7 @@ selection_data_to_lisp_data (struct x_display_info *dpyinfo, for (i = 0; i < size / 2; i++) { short j = ((short *) data) [i]; - ASET (v, i, make_number (j)); + ASET (v, i, make_fixnum (j)); } } else @@ -1653,7 +1653,7 @@ selection_data_to_lisp_data (struct x_display_info *dpyinfo, for (i = 0; i < size / 2; i++) { unsigned short j = ((unsigned short *) data) [i]; - ASET (v, i, make_number (j)); + ASET (v, i, make_fixnum (j)); } } return v; @@ -1693,7 +1693,7 @@ static unsigned long cons_to_x_long (Lisp_Object obj) { if (X_ULONG_MAX <= INTMAX_MAX - || XINT (INTEGERP (obj) ? obj : XCAR (obj)) < 0) + || XINT (FIXNUMP (obj) ? obj : XCAR (obj)) < 0) return cons_to_signed (obj, X_LONG_MIN, min (X_ULONG_MAX, INTMAX_MAX)); else return cons_to_unsigned (obj, X_ULONG_MAX); @@ -1748,7 +1748,7 @@ lisp_data_to_selection_data (struct x_display_info *dpyinfo, *x_atom_ptr = symbol_to_x_atom (dpyinfo, obj); if (NILP (type)) type = QATOM; } - else if (RANGED_INTEGERP (X_SHRT_MIN, obj, X_SHRT_MAX)) + else if (RANGED_FIXNUMP (X_SHRT_MIN, obj, X_SHRT_MAX)) { void *data = xmalloc (sizeof (short) + 1); short *short_ptr = data; @@ -1759,11 +1759,11 @@ lisp_data_to_selection_data (struct x_display_info *dpyinfo, *short_ptr = XINT (obj); if (NILP (type)) type = QINTEGER; } - else if (INTEGERP (obj) - || (CONSP (obj) && INTEGERP (XCAR (obj)) - && (INTEGERP (XCDR (obj)) + else if (FIXNUMP (obj) + || (CONSP (obj) && FIXNUMP (XCAR (obj)) + && (FIXNUMP (XCDR (obj)) || (CONSP (XCDR (obj)) - && INTEGERP (XCAR (XCDR (obj))))))) + && FIXNUMP (XCAR (XCDR (obj))))))) { void *data = xmalloc (sizeof (unsigned long) + 1); unsigned long *x_long_ptr = data; @@ -1811,7 +1811,7 @@ lisp_data_to_selection_data (struct x_display_info *dpyinfo, if (NILP (type)) type = QINTEGER; for (i = 0; i < size; i++) { - if (! RANGED_INTEGERP (X_SHRT_MIN, AREF (obj, i), + if (! RANGED_FIXNUMP (X_SHRT_MIN, AREF (obj, i), X_SHRT_MAX)) { /* Use sizeof (long) even if it is more than 32 bits. @@ -1846,20 +1846,20 @@ static Lisp_Object clean_local_selection_data (Lisp_Object obj) { if (CONSP (obj) - && INTEGERP (XCAR (obj)) + && FIXNUMP (XCAR (obj)) && CONSP (XCDR (obj)) - && INTEGERP (XCAR (XCDR (obj))) + && FIXNUMP (XCAR (XCDR (obj))) && NILP (XCDR (XCDR (obj)))) obj = Fcons (XCAR (obj), XCDR (obj)); if (CONSP (obj) - && INTEGERP (XCAR (obj)) - && INTEGERP (XCDR (obj))) + && FIXNUMP (XCAR (obj)) + && FIXNUMP (XCDR (obj))) { if (XINT (XCAR (obj)) == 0) return XCDR (obj); if (XINT (XCAR (obj)) == -1) - return make_number (- XINT (XCDR (obj))); + return make_fixnum (- XINT (XCDR (obj))); } if (VECTORP (obj)) { @@ -2264,10 +2264,10 @@ x_check_property_data (Lisp_Object data) { Lisp_Object o = XCAR (iter); - if (! NUMBERP (o) && ! STRINGP (o) && ! CONSP (o)) + if (! FIXED_OR_FLOATP (o) && ! STRINGP (o) && ! CONSP (o)) return -1; else if (CONSP (o) && - (! NUMBERP (XCAR (o)) || ! NUMBERP (XCDR (o)))) + (! FIXED_OR_FLOATP (XCAR (o)) || ! FIXED_OR_FLOATP (XCDR (o)))) return -1; if (size == INT_MAX) return -1; @@ -2303,11 +2303,11 @@ x_fill_property_data (Display *dpy, Lisp_Object data, void *ret, int format) { Lisp_Object o = XCAR (iter); - if (NUMBERP (o) || CONSP (o)) + if (FIXED_OR_FLOATP (o) || CONSP (o)) { if (CONSP (o) - && RANGED_INTEGERP (X_LONG_MIN >> 16, XCAR (o), X_LONG_MAX >> 16) - && RANGED_INTEGERP (- (1 << 15), XCDR (o), -1)) + && RANGED_FIXNUMP (X_LONG_MIN >> 16, XCAR (o), X_LONG_MAX >> 16) + && RANGED_FIXNUMP (- (1 << 15), XCDR (o), -1)) { /* cons_to_x_long does not handle negative values for v2. For XDnd, v2 might be y of a window, and can be negative. @@ -2481,11 +2481,11 @@ x_handle_dnd_message (struct frame *f, const XClientMessageEvent *event, data = (unsigned char *) idata; } - vec = Fmake_vector (make_number (4), Qnil); + vec = Fmake_vector (make_fixnum (4), Qnil); ASET (vec, 0, SYMBOL_NAME (x_atom_to_symbol (FRAME_DISPLAY_INFO (f), event->message_type))); ASET (vec, 1, frame); - ASET (vec, 2, make_number (event->format)); + ASET (vec, 2, make_fixnum (event->format)); ASET (vec, 3, x_property_data_to_lisp (f, data, event->message_type, @@ -2496,8 +2496,8 @@ x_handle_dnd_message (struct frame *f, const XClientMessageEvent *event, bufp->kind = DRAG_N_DROP_EVENT; bufp->frame_or_window = frame; bufp->timestamp = CurrentTime; - bufp->x = make_number (x); - bufp->y = make_number (y); + bufp->x = make_fixnum (x); + bufp->y = make_fixnum (y); bufp->arg = vec; bufp->modifiers = 0; @@ -2554,7 +2554,7 @@ x_send_client_event (Lisp_Object display, Lisp_Object dest, Lisp_Object from, struct frame *f = decode_window_system_frame (from); bool to_root; - CHECK_NUMBER (format); + CHECK_FIXNUM (format); CHECK_CONS (values); if (x_check_property_data (values) == -1) @@ -2580,7 +2580,7 @@ x_send_client_event (Lisp_Object display, Lisp_Object dest, Lisp_Object from, else error ("DEST as a string must be one of PointerWindow or InputFocus"); } - else if (NUMBERP (dest) || CONSP (dest)) + else if (FIXED_OR_FLOATP (dest) || CONSP (dest)) CONS_TO_INTEGER (dest, Window, wdest); else error ("DEST must be a frame, nil, string, number or cons"); diff --git a/src/xterm.c b/src/xterm.c index af28dab860..f83f054802 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -917,7 +917,7 @@ x_set_frame_alpha (struct frame *f) if (FLOATP (Vframe_alpha_lower_limit)) alpha_min = XFLOAT_DATA (Vframe_alpha_lower_limit); - else if (INTEGERP (Vframe_alpha_lower_limit)) + else if (FIXNUMP (Vframe_alpha_lower_limit)) alpha_min = (XINT (Vframe_alpha_lower_limit)) / 100.0; if (alpha < 0.0) @@ -3106,13 +3106,13 @@ x_draw_image_relief (struct glyph_string *s) if (s->face->id == TOOL_BAR_FACE_ID) { if (CONSP (Vtool_bar_button_margin) - && INTEGERP (XCAR (Vtool_bar_button_margin)) - && INTEGERP (XCDR (Vtool_bar_button_margin))) + && FIXNUMP (XCAR (Vtool_bar_button_margin)) + && FIXNUMP (XCDR (Vtool_bar_button_margin))) { extra_x = XINT (XCAR (Vtool_bar_button_margin)); extra_y = XINT (XCDR (Vtool_bar_button_margin)); } - else if (INTEGERP (Vtool_bar_button_margin)) + else if (FIXNUMP (Vtool_bar_button_margin)) extra_x = extra_y = XINT (Vtool_bar_button_margin); } @@ -3704,7 +3704,7 @@ x_draw_glyph_string (struct glyph_string *s) Lisp_Object val = buffer_local_value (Qunderline_minimum_offset, s->w->contents); - if (INTEGERP (val)) + if (FIXNUMP (val)) minimum_offset = XFASTINT (val); else minimum_offset = 1; @@ -4824,15 +4824,15 @@ x_x_to_emacs_modifiers (struct x_display_info *dpyinfo, int state) Lisp_Object tem; tem = Fget (Vx_ctrl_keysym, Qmodifier_value); - if (INTEGERP (tem)) mod_ctrl = XINT (tem) & INT_MAX; + if (FIXNUMP (tem)) mod_ctrl = XINT (tem) & INT_MAX; tem = Fget (Vx_alt_keysym, Qmodifier_value); - if (INTEGERP (tem)) mod_alt = XINT (tem) & INT_MAX; + if (FIXNUMP (tem)) mod_alt = XINT (tem) & INT_MAX; tem = Fget (Vx_meta_keysym, Qmodifier_value); - if (INTEGERP (tem)) mod_meta = XINT (tem) & INT_MAX; + if (FIXNUMP (tem)) mod_meta = XINT (tem) & INT_MAX; tem = Fget (Vx_hyper_keysym, Qmodifier_value); - if (INTEGERP (tem)) mod_hyper = XINT (tem) & INT_MAX; + if (FIXNUMP (tem)) mod_hyper = XINT (tem) & INT_MAX; tem = Fget (Vx_super_keysym, Qmodifier_value); - if (INTEGERP (tem)) mod_super = XINT (tem) & INT_MAX; + if (FIXNUMP (tem)) mod_super = XINT (tem) & INT_MAX; return ( ((state & (ShiftMask | dpyinfo->shift_lock_mask)) ? shift_modifier : 0) | ((state & ControlMask) ? mod_ctrl : 0) @@ -4854,15 +4854,15 @@ x_emacs_to_x_modifiers (struct x_display_info *dpyinfo, EMACS_INT state) Lisp_Object tem; tem = Fget (Vx_ctrl_keysym, Qmodifier_value); - if (INTEGERP (tem)) mod_ctrl = XINT (tem); + if (FIXNUMP (tem)) mod_ctrl = XINT (tem); tem = Fget (Vx_alt_keysym, Qmodifier_value); - if (INTEGERP (tem)) mod_alt = XINT (tem); + if (FIXNUMP (tem)) mod_alt = XINT (tem); tem = Fget (Vx_meta_keysym, Qmodifier_value); - if (INTEGERP (tem)) mod_meta = XINT (tem); + if (FIXNUMP (tem)) mod_meta = XINT (tem); tem = Fget (Vx_hyper_keysym, Qmodifier_value); - if (INTEGERP (tem)) mod_hyper = XINT (tem); + if (FIXNUMP (tem)) mod_hyper = XINT (tem); tem = Fget (Vx_super_keysym, Qmodifier_value); - if (INTEGERP (tem)) mod_super = XINT (tem); + if (FIXNUMP (tem)) mod_super = XINT (tem); return ( ((state & mod_alt) ? dpyinfo->alt_mod_mask : 0) @@ -5511,8 +5511,8 @@ x_scroll_bar_to_input_event (const XEvent *event, #endif ievent->code = 0; ievent->part = ev->data.l[2]; - ievent->x = make_number (ev->data.l[3]); - ievent->y = make_number (ev->data.l[4]); + ievent->x = make_fixnum (ev->data.l[3]); + ievent->y = make_fixnum (ev->data.l[4]); ievent->modifiers = 0; } @@ -5546,8 +5546,8 @@ x_horizontal_scroll_bar_to_input_event (const XEvent *event, #endif ievent->code = 0; ievent->part = ev->data.l[2]; - ievent->x = make_number (ev->data.l[3]); - ievent->y = make_number (ev->data.l[4]); + ievent->x = make_fixnum (ev->data.l[3]); + ievent->y = make_fixnum (ev->data.l[4]); ievent->modifiers = 0; } @@ -8201,7 +8201,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, /* If mouse-highlight is an integer, input clears out mouse highlighting. */ - if (!hlinfo->mouse_face_hidden && INTEGERP (Vmouse_highlight) + if (!hlinfo->mouse_face_hidden && FIXNUMP (Vmouse_highlight) #if ! defined (USE_GTK) && (f == 0 || !EQ (f->tool_bar_window, hlinfo->mouse_face_window)) @@ -8358,10 +8358,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, /* Now non-ASCII. */ if (HASH_TABLE_P (Vx_keysym_table) - && (c = Fgethash (make_number (keysym), + && (c = Fgethash (make_fixnum (keysym), Vx_keysym_table, Qnil), - NATNUMP (c))) + FIXNATP (c))) { inev.ie.kind = (SINGLE_BYTE_CHAR_P (XFASTINT (c)) ? ASCII_KEYSTROKE_EVENT @@ -9853,7 +9853,7 @@ For details, see etc/PROBLEMS.\n", if (terminal_list == 0) { fprintf (stderr, "%s\n", error_msg); - Fkill_emacs (make_number (70)); + Fkill_emacs (make_fixnum (70)); /* NOTREACHED */ } @@ -10254,8 +10254,8 @@ x_calc_absolute_position (struct frame *f) XSETFRAME (frame, f); edges = Fx_frame_edges (frame, Qouter_edges); if (!NILP (edges)) - width = (XINT (Fnth (make_number (2), edges)) - - XINT (Fnth (make_number (0), edges))); + width = (XINT (Fnth (make_fixnum (2), edges)) + - XINT (Fnth (make_fixnum (0), edges))); } if (p) @@ -10296,8 +10296,8 @@ x_calc_absolute_position (struct frame *f) if (NILP (edges)) edges = Fx_frame_edges (frame, Qouter_edges); if (!NILP (edges)) - height = (XINT (Fnth (make_number (3), edges)) - - XINT (Fnth (make_number (1), edges))); + height = (XINT (Fnth (make_fixnum (3), edges)) + - XINT (Fnth (make_fixnum (1), edges))); } if (p) @@ -10501,12 +10501,12 @@ set_wm_state (Lisp_Object frame, bool add, Atom atom, Atom value) { struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (XFRAME (frame)); - x_send_client_event (frame, make_number (0), frame, + x_send_client_event (frame, make_fixnum (0), frame, dpyinfo->Xatom_net_wm_state, - make_number (32), + make_fixnum (32), /* 1 = add, 0 = remove */ Fcons - (make_number (add), + (make_fixnum (add), Fcons (make_fixnum_or_float (atom), (value != 0 @@ -11139,8 +11139,8 @@ x_set_window_size_1 (struct frame *f, bool change_gravity, { frame_size_history_add (f, Qx_set_window_size_1, width, height, - list2 (make_number (old_height), - make_number (pixelheight + FRAME_MENUBAR_HEIGHT (f)))); + list2 (make_fixnum (old_height), + make_fixnum (pixelheight + FRAME_MENUBAR_HEIGHT (f)))); XResizeWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), old_width, pixelheight + FRAME_MENUBAR_HEIGHT (f)); @@ -11149,7 +11149,7 @@ x_set_window_size_1 (struct frame *f, bool change_gravity, { frame_size_history_add (f, Qx_set_window_size_2, width, height, - list2 (make_number (old_width), make_number (pixelwidth))); + list2 (make_fixnum (old_width), make_fixnum (pixelwidth))); XResizeWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), pixelwidth, old_height); @@ -11159,10 +11159,10 @@ x_set_window_size_1 (struct frame *f, bool change_gravity, { frame_size_history_add (f, Qx_set_window_size_3, width, height, - list3 (make_number (pixelwidth + FRAME_TOOLBAR_WIDTH (f)), - make_number (pixelheight + FRAME_TOOLBAR_HEIGHT (f) + list3 (make_fixnum (pixelwidth + FRAME_TOOLBAR_WIDTH (f)), + make_fixnum (pixelheight + FRAME_TOOLBAR_HEIGHT (f) + FRAME_MENUBAR_HEIGHT (f)), - make_number (FRAME_MENUBAR_HEIGHT (f)))); + make_fixnum (FRAME_MENUBAR_HEIGHT (f)))); XResizeWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), pixelwidth, pixelheight + FRAME_MENUBAR_HEIGHT (f)); @@ -11346,9 +11346,9 @@ x_ewmh_activate_frame (struct frame *f) { Lisp_Object frame; XSETFRAME (frame, f); - x_send_client_event (frame, make_number (0), frame, + x_send_client_event (frame, make_fixnum (0), frame, dpyinfo->Xatom_net_active_window, - make_number (32), + make_fixnum (32), list2i (1, dpyinfo->last_user_time)); } } @@ -13324,15 +13324,15 @@ With MS Windows or Nextstep, the value is t. */); DEFSYM (Qmodifier_value, "modifier-value"); DEFSYM (Qctrl, "ctrl"); - Fput (Qctrl, Qmodifier_value, make_number (ctrl_modifier)); + Fput (Qctrl, Qmodifier_value, make_fixnum (ctrl_modifier)); DEFSYM (Qalt, "alt"); - Fput (Qalt, Qmodifier_value, make_number (alt_modifier)); + Fput (Qalt, Qmodifier_value, make_fixnum (alt_modifier)); DEFSYM (Qhyper, "hyper"); - Fput (Qhyper, Qmodifier_value, make_number (hyper_modifier)); + Fput (Qhyper, Qmodifier_value, make_fixnum (hyper_modifier)); DEFSYM (Qmeta, "meta"); - Fput (Qmeta, Qmodifier_value, make_number (meta_modifier)); + Fput (Qmeta, Qmodifier_value, make_fixnum (meta_modifier)); DEFSYM (Qsuper, "super"); - Fput (Qsuper, Qmodifier_value, make_number (super_modifier)); + Fput (Qsuper, Qmodifier_value, make_fixnum (super_modifier)); DEFVAR_LISP ("x-ctrl-keysym", Vx_ctrl_keysym, doc: /* Which keys Emacs uses for the ctrl modifier. diff --git a/src/xwidget.c b/src/xwidget.c index 2a53966ef4..dc1b888280 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -79,8 +79,8 @@ Returns the newly constructed xwidget, or nil if construction fails. */) Lisp_Object arguments, Lisp_Object buffer) { CHECK_SYMBOL (type); - CHECK_NATNUM (width); - CHECK_NATNUM (height); + CHECK_FIXNAT (width); + CHECK_FIXNAT (height); struct xwidget *xw = allocate_xwidget (); Lisp_Object val; @@ -294,7 +294,7 @@ webkit_js_to_lisp (JSContextRef context, JSValueRef value) case kJSTypeBoolean: return (JSValueToBoolean (context, value)) ? Qt : Qnil; case kJSTypeNumber: - return make_number (JSValueToNumber (context, value, NULL)); + return make_fixnum (JSValueToNumber (context, value, NULL)); case kJSTypeObject: { if (JSValueIsArray (context, value)) @@ -713,7 +713,7 @@ save_script_callback (struct xwidget *xw, Lisp_Object script, Lisp_Object fun) { Lisp_Object cbs = xw->script_callbacks; if (NILP (cbs)) - xw->script_callbacks = cbs = Fmake_vector (make_number (32), Qnil); + xw->script_callbacks = cbs = Fmake_vector (make_fixnum (32), Qnil); /* Find first free index. */ ptrdiff_t idx; @@ -811,8 +811,8 @@ Emacs allocated area accordingly. */) CHECK_XWIDGET (xwidget); GtkRequisition requisition; gtk_widget_size_request (XXWIDGET (xwidget)->widget_osr, &requisition); - return list2 (make_number (requisition.width), - make_number (requisition.height)); + return list2 (make_fixnum (requisition.width), + make_fixnum (requisition.height)); } DEFUN ("xwidgetp", @@ -843,7 +843,7 @@ Currently [TYPE TITLE WIDTH HEIGHT]. */) CHECK_XWIDGET (xwidget); struct xwidget *xw = XXWIDGET (xwidget); return CALLN (Fvector, xw->type, xw->title, - make_natnum (xw->width), make_natnum (xw->height)); + make_fixed_natnum (xw->width), make_fixed_natnum (xw->height)); } DEFUN ("xwidget-view-info", @@ -855,9 +855,9 @@ Currently [X Y CLIP_RIGHT CLIP_BOTTOM CLIP_TOP CLIP_LEFT]. */) { CHECK_XWIDGET_VIEW (xwidget_view); struct xwidget_view *xv = XXWIDGET_VIEW (xwidget_view); - return CALLN (Fvector, make_number (xv->x), make_number (xv->y), - make_number (xv->clip_right), make_number (xv->clip_bottom), - make_number (xv->clip_top), make_number (xv->clip_left)); + return CALLN (Fvector, make_fixnum (xv->x), make_fixnum (xv->y), + make_fixnum (xv->clip_right), make_fixnum (xv->clip_bottom), + make_fixnum (xv->clip_top), make_fixnum (xv->clip_left)); } DEFUN ("xwidget-view-model", commit b38b91a83491b6812e8267d0247355f0e8e3e189 Author: Paul Eggert Date: Thu Jul 12 20:23:07 2018 -0700 Lessen stack consumption in recursive read1 * src/lread.c (read1): Shrink local buffer size from MAX_ALLOCA to 128 (Bug#31995). diff --git a/src/lread.c b/src/lread.c index 72523c057f..d5ba48a170 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2677,7 +2677,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) int c; bool uninterned_symbol = false; bool multibyte; - char stackbuf[MAX_ALLOCA]; + char stackbuf[128]; /* Small, as read1 is recursive (Bug#31995). */ current_thread->stack_top = stackbuf; *pch = 0; commit 3eb4603b0d432740ff4e8deb637cca2f35cf5fee Author: Noam Postavsky Date: Mon Jul 9 16:56:47 2018 -0400 Match w32 paths in grep sans --null hits (Bug#32051) * lisp/progmodes/grep.el (grep-regexp-alist): Add an optional part to match paths starting with C: (other drive letters). * test/lisp/progmodes/compile-tests.el (compile-tests--grep-regexp-testcases) (compile-tests--grep-regexp-tricky-testcases) (compile-test-grep-regexps): New tests. (compile--test-error-line): Return `compilation-message'. diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index da09c900e5..0bfabd5f3f 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -379,7 +379,9 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies ;; to handle weird file names (with colons in them) as ;; well as possible. E.g., use [1-9][0-9]* rather than ;; [0-9]+ so as to accept ":034:" in file names. - "\\(?1:[^\n:]+?[^\n/:]\\):[\t ]*\\(?2:[1-9][0-9]*\\)[\t ]*:" + "\\(?1:" + "\\(?:[a-zA-Z]:\\)?" ; Allow "C:..." for w32. + "[^\n:]+?[^\n/:]\\):[\t ]*\\(?2:[1-9][0-9]*\\)[\t ]*:" "\\)") 1 2 ;; Calculate column positions (col . end-col) of first grep match on a line diff --git a/test/lisp/progmodes/compile-tests.el b/test/lisp/progmodes/compile-tests.el index a106030aea..4e2dc86eae 100644 --- a/test/lisp/progmodes/compile-tests.el +++ b/test/lisp/progmodes/compile-tests.el @@ -343,6 +343,29 @@ meaning a range of columns starting on LINE and ending on END-LINE, if that matched. TYPE can be left out, in which case any message type is accepted.") +(defconst compile-tests--grep-regexp-testcases + ;; Bug#32051. + '(("c:/Users/my.name/src/project\\src\\kbhit.hpp\0\ 29:#include " + 1 nil 29 "c:/Users/my.name/src/project\\src\\kbhit.hpp") + ("d:/gnu/emacs/branch/src/callproc.c\0\ 214:#ifdef DOS_NT" + 1 nil 214 "d:/gnu/emacs/branch/src/callproc.c") + ("/gnu/emacs/branch/src/callproc.c\0\ 214:#ifdef DOS_NT" + 1 nil 214 "/gnu/emacs/branch/src/callproc.c")) + "List of tests for `grep-regexp-list'. +The format is the same as `compile-tests--test-regexps-data', but +the match is expected to be the same when NUL bytes are replaced +with colon.") + +(defconst compile-tests--grep-regexp-tricky-testcases + ;; Bug#7378. + '(("./x11-libs---nx/3.4.0:0:C.30253.1289557929.792611.C/nx-3.4.0.exheres-0\0\ 42:some text" + 1 nil 42 "./x11-libs---nx/3.4.0:0:C.30253.1289557929.792611.C/nx-3.4.0.exheres-0") + ("2011-08-31_11:57:03_1\0\ 7:Date: Wed, 31 Aug 2011 11:57:03 +0000" + 1 nil 7 "2011-08-31_11:57:03_1")) + "List of tricky tests for `grep-regexp-list'. +Same as `compile-tests--grep-regexp-testcases', but these cases +can only work with the NUL byte to disambiguate colons.") + (defun compile--test-error-line (test) (erase-buffer) (setq compilation-locs (make-hash-table)) @@ -370,7 +393,8 @@ any message type is accepted.") (should (equal (car (nth 2 (compilation--loc->file-struct loc))) (or end-line line))) (when type - (should (equal type (compilation--message->type msg))))))) + (should (equal type (compilation--message->type msg))))) + msg)) (ert-deftest compile-test-error-regexps () "Test the `compilation-error-regexp-alist' regexps. @@ -379,4 +403,24 @@ The test data is in `compile-tests--test-regexps-data'." (font-lock-mode -1) (mapc #'compile--test-error-line compile-tests--test-regexps-data))) +(ert-deftest compile-test-grep-regexps () + "Test the `grep-regexp-alist' regexps. +The test data is in `compile-tests--grep-regexp-testcases'." + (with-temp-buffer + (grep-mode) + (setq buffer-read-only nil) + (font-lock-mode -1) + (dolist (testcase compile-tests--grep-regexp-testcases) + (let (msg1 msg2) + (setq msg1 (ert-info ((format "%S" testcase) :prefix "testcase: ") + (compile--test-error-line testcase))) + ;; Make sure replacing the NUL character with a colon still matches. + (setf (car testcase) (replace-regexp-in-string "\0" ":" (car testcase))) + (setq msg2 (ert-info ((format "%S" testcase) :prefix "testcase: ") + (compile--test-error-line testcase))) + (should (equal msg1 msg2)))) + (dolist (testcase compile-tests--grep-regexp-tricky-testcases) + (ert-info ((format "%S" testcase) :prefix "testcase: ") + (compile--test-error-line testcase))))) + ;;; compile-tests.el ends here commit 01dbf2a347944497fdcf2ec156f4605020d7ba2a Author: Noam Postavsky Date: Wed Jul 11 20:13:25 2018 -0400 Speed up smerge-refine-regions by avoiding fsync * lisp/vc/smerge-mode.el (smerge-refine-regions): Bind write-region-inhibit-fsync to t. This was reported in https://github.com/magit/magit/pull/2834 to give a noticable speedup. diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index cb51fbab8e..ff41473435 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -1075,9 +1075,10 @@ used to replace chars to try and eliminate some spurious differences." (if smerge-refine-weight-hack (make-hash-table :test #'equal)))) (unless (markerp beg1) (setq beg1 (copy-marker beg1))) (unless (markerp beg2) (setq beg2 (copy-marker beg2))) - ;; Chop up regions into smaller elements and save into files. - (smerge--refine-chopup-region beg1 end1 file1 preproc) - (smerge--refine-chopup-region beg2 end2 file2 preproc) + (let ((write-region-inhibit-fsync t)) ; Don't fsync temp files (Bug#12747). + ;; Chop up regions into smaller elements and save into files. + (smerge--refine-chopup-region beg1 end1 file1 preproc) + (smerge--refine-chopup-region beg2 end2 file2 preproc)) ;; Call diff on those files. (unwind-protect commit 1222ff5275e61e797d388489b8a88f499247321d Author: Noam Postavsky Date: Wed Jul 11 20:01:11 2018 -0400 Don't skip epg-tests even with gpg 2.0 (Bug#23561) * test/lisp/epg-tests.el (epg-tests--config-program-alist): New constant, which allows gpg2 version 2.0+. (epg-tests-find-usable-gpg-configuration): Pass it to epg-find-configuration. diff --git a/test/lisp/epg-tests.el b/test/lisp/epg-tests.el index 0fe15017dd..7efe04bfc0 100644 --- a/test/lisp/epg-tests.el +++ b/test/lisp/epg-tests.el @@ -30,8 +30,19 @@ (expand-file-name "data/epg" (getenv "EMACS_TEST_DIRECTORY")) "Directory containing epg test data.") +(defconst epg-tests--config-program-alist + ;; The default `epg-config--program-alist' requires gpg2 2.1 or + ;; greater due to some practical problems with pinentry. But the + ;; tests here all work fine with 2.0 as well. + (let ((prog-alist (copy-sequence epg-config--program-alist))) + (setf (alist-get "gpg2" + (alist-get 'OpenPGP prog-alist) + nil nil #'equal) + "2.0") + prog-alist)) + (defun epg-tests-find-usable-gpg-configuration (&optional _require-passphrase) - (epg-find-configuration 'OpenPGP 'no-cache)) + (epg-find-configuration 'OpenPGP 'no-cache epg-tests--config-program-alist)) (defun epg-tests-passphrase-callback (_c _k _d) ;; Need to create a copy here, since the string will be wiped out commit 5cc7c4b48a2d6eca5d14d12b1cd258bf9cabde74 Author: Noam Postavsky Date: Thu Jul 12 19:41:03 2018 -0400 Fix previous make-network-process change * src/process.c (Fmake_network_process): On 2018-07-09 "Explicitly reject :server and :nowait (Bug#31903)", the sense of the SERVER check was accidentally reversed so that we ended up looking for the wrong ADDRESS. Reported by T.V Raman in . diff --git a/src/process.c b/src/process.c index 4d7a735652..f7b96d2854 100644 --- a/src/process.c +++ b/src/process.c @@ -3898,7 +3898,7 @@ usage: (make-network-process &rest ARGS) */) CHECK_STRING (name); /* :local ADDRESS or :remote ADDRESS */ - if (!NILP (server)) + if (NILP (server)) address = Fplist_get (contact, QCremote); else address = Fplist_get (contact, QClocal); commit d6a1b69cf39533763bdfe81b33a54cb6afa0e7f2 Author: Eli Zaretskii Date: Thu Jul 12 19:24:06 2018 +0300 Another documentation improvement in flyspell.el * lisp/textmodes/flyspell.el (flyspell-persistent-highlight): Doc fix. diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index 3bad41ab7a..b6c8ac393c 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -137,7 +137,8 @@ This variable specifies how far to search to find such a duplicate. (defcustom flyspell-persistent-highlight t "Non-nil means misspelled words remain highlighted until corrected. If this variable is nil, only the most recently detected misspelled word -is highlighted." +is highlighted, and the highlight is turned off as soon as point moves +off the misspelled word." :group 'flyspell :type 'boolean) commit 9b49a8ed4a39c5d24336bda2ee0ee070ebe08221 Author: Eli Zaretskii Date: Thu Jul 12 18:59:18 2018 +0300 Improve documentation of Flyspell For the background, see http://lists.gnu.org/archive/html/help-gnu-emacs/2018-07/msg00099.html. * doc/emacs/fixit.texi (Spelling): Add a couple of caveats. * lisp/textmodes/flyspell.el: Update commentary. diff --git a/doc/emacs/fixit.texi b/doc/emacs/fixit.texi index fe2da7ae4f..7bbaa0016b 100644 --- a/doc/emacs/fixit.texi +++ b/doc/emacs/fixit.texi @@ -408,11 +408,15 @@ dictionary. @cindex mode, Flyspell @findex flyspell-mode Flyspell mode is a minor mode that performs automatic spell-checking -as you type. When it finds a word that it does not recognize, it -highlights that word. Type @kbd{M-x flyspell-mode} to toggle Flyspell -mode in the current buffer. To enable Flyspell mode in all text mode -buffers, add @code{flyspell-mode} to @code{text-mode-hook}. -@xref{Hooks}. +of the text you type as you type it. When it finds a word that it +does not recognize, it highlights that word. Type @kbd{M-x +flyspell-mode} to toggle Flyspell mode in the current buffer. To +enable Flyspell mode in all text mode buffers, add +@code{flyspell-mode} to @code{text-mode-hook}. @xref{Hooks}. Note +that, as Flyspell mode needs to check each word across which you move, +it will slow down cursor motion and scrolling commands. It also +doesn't automatically check the text you didn't type or move across; +use @code{flyspell-region} or @code{flyspell-buffer} for that. @findex flyspell-correct-word @findex flyspell-auto-correct-word diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index 24e424c663..3bad41ab7a 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -31,10 +31,10 @@ ;; ;; To enable Flyspell in text representing computer programs, type ;; M-x flyspell-prog-mode. -;; In that mode only text inside comments is checked. +;; In that mode only text inside comments and strings is checked. ;; ;; Some user variables control the behavior of flyspell. They are -;; those defined under the `User variables' comment. +;; those defined under the `User configuration' comment. ;;; Code: commit aeefbc41be093ceb1222d9b430fb44b69de660e2 Author: Stefan Monnier Date: Thu Jul 12 10:29:28 2018 -0400 Fix the bootstrap differently, so zerop can be where it belongs Suggested by Robert Pluim . * lisp/emacs-lisp/byte-run.el (defun-declarations-alist): Avoid cadr/cddr. * lisp/subr.el (zerop): Un-revert 2018-07-10T23:08:58-07:00!contovob@tcd.ie. diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index aa10bd3e80..5edf5a28db 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -116,7 +116,10 @@ If `error-free', drop calls even if `byte-compile-delete-errors' is nil.") (if (not (eq (car-safe compiler-function) 'lambda)) `(eval-and-compile (function-put ',f 'compiler-macro #',compiler-function)) - (let ((cfname (intern (concat (symbol-name f) "--anon-cmacro")))) + (let ((cfname (intern (concat (symbol-name f) "--anon-cmacro"))) + ;; Avoid cadr/cddr so we can use `compiler-macro' before + ;; defining cadr/cddr. + (data (cdr compiler-function))) `(progn (eval-and-compile (function-put ',f 'compiler-macro #',cfname)) @@ -125,8 +128,8 @@ If `error-free', drop calls even if `byte-compile-delete-errors' is nil.") ;; if needed. :autoload-end (eval-and-compile - (defun ,cfname (,@(cadr compiler-function) ,@args) - ,@(cddr compiler-function)))))))) + (defun ,cfname (,@(car data) ,@args) + ,@(cdr data)))))))) (list 'doc-string #'(lambda (f _args pos) (list 'function-put (list 'quote f) diff --git a/lisp/subr.el b/lisp/subr.el index a5108eb655..10343e69db 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -359,6 +359,13 @@ was called." (lambda (&rest args2) (apply fun (append args args2)))) +(defun zerop (number) + "Return t if NUMBER is zero." + ;; Used to be in C, but it's pointless since (= 0 n) is faster anyway because + ;; = has a byte-code. + (declare (compiler-macro (lambda (_) `(= 0 ,number)))) + (= 0 number)) + ;;;; List functions. @@ -548,16 +555,6 @@ If N is omitted or nil, remove the last element." (if (> n 0) (setcdr (nthcdr (- (1- m) n) list) nil)) list)))) -;; This function appears here instead of under the 'Basic Lisp -;; functions' heading because during bootstrap its compiler-macro -;; requires functions defined under the 'List functions' heading. -(defun zerop (number) - "Return t if NUMBER is zero." - ;; Used to be in C, but it's pointless since (= 0 n) is faster anyway because - ;; = has a byte-code. - (declare (compiler-macro (lambda (_) `(= 0 ,number)))) - (= 0 number)) - (defun proper-list-p (object) "Return OBJECT's length if it is a proper list, nil otherwise. A proper list is neither circular nor dotted (i.e., its last cdr commit 3744fda5fa92ed058a1eb636a7836759ae5ab06f Author: Michael Albinus Date: Thu Jul 12 10:49:06 2018 +0200 Provide feature 'threads * src/thread.c (syms_of_threads): Provide feature "threads". * test/src/thread-tests.el (top): Declare the functions. (all): Use (featurep 'threads) check. diff --git a/src/thread.c b/src/thread.c index 60902b252b..04c2808e5c 100644 --- a/src/thread.c +++ b/src/thread.c @@ -1068,6 +1068,8 @@ syms_of_threads (void) staticpro (&last_thread_error); last_thread_error = Qnil; + + Fprovide (intern_c_string ("threads"), Qnil); } DEFSYM (Qthreadp, "threadp"); diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el index 0e909d3e51..3c7fde33d8 100644 --- a/test/src/thread-tests.el +++ b/test/src/thread-tests.el @@ -19,36 +19,56 @@ ;;; Code: +;; Declare the functions in case Emacs has been configured --without-threads. +(declare-function all-threads "thread.c" ()) +(declare-function condition-mutex "thread.c" (cond)) +(declare-function condition-name "thread.c" (cond)) +(declare-function condition-notify "thread.c" (cond &optional all)) +(declare-function condition-wait "thread.c" (cond)) +(declare-function current-thread "thread.c" ()) +(declare-function make-condition-variable "thread.c" (mutex &optional name)) +(declare-function make-mutex "thread.c" (&optional name)) +(declare-function make-thread "thread.c" (function &optional name)) +(declare-function mutex-lock "thread.c" (mutex)) +(declare-function mutex-unlock "thread.c" (mutex)) +(declare-function thread--blocker "thread.c" (thread)) +(declare-function thread-alive-p "thread.c" (thread)) +(declare-function thread-join "thread.c" (thread)) +(declare-function thread-last-error "thread.c" ()) +(declare-function thread-name "thread.c" (thread)) +(declare-function thread-signal "thread.c" (thread error-symbol data)) +(declare-function thread-yield "thread.c" ()) + (ert-deftest threads-is-one () "Test for existence of a thread." - (skip-unless (fboundp 'make-thread)) + (skip-unless (featurep 'threads)) (should (current-thread))) (ert-deftest threads-threadp () "Test of threadp." - (skip-unless (fboundp 'make-thread)) + (skip-unless (featurep 'threads)) (should (threadp (current-thread)))) (ert-deftest threads-type () "Test of thread type." - (skip-unless (fboundp 'make-thread)) + (skip-unless (featurep 'threads)) (should (eq (type-of (current-thread)) 'thread))) (ert-deftest threads-name () "Test for name of a thread." - (skip-unless (fboundp 'make-thread)) + (skip-unless (featurep 'threads)) (should (string= "hi bob" (thread-name (make-thread #'ignore "hi bob"))))) (ert-deftest threads-alive () "Test for thread liveness." - (skip-unless (fboundp 'make-thread)) + (skip-unless (featurep 'threads)) (should (thread-alive-p (make-thread #'ignore)))) (ert-deftest threads-all-threads () "Simple test for all-threads." - (skip-unless (fboundp 'make-thread)) + (skip-unless (featurep 'threads)) (should (listp (all-threads)))) (defvar threads-test-global nil) @@ -58,7 +78,7 @@ (ert-deftest threads-basic () "Basic thread test." - (skip-unless (fboundp 'make-thread)) + (skip-unless (featurep 'threads)) (should (progn (setq threads-test-global nil) @@ -69,7 +89,7 @@ (ert-deftest threads-join () "Test of `thread-join'." - (skip-unless (fboundp 'make-thread)) + (skip-unless (featurep 'threads)) (should (progn (setq threads-test-global nil) @@ -80,7 +100,7 @@ (ert-deftest threads-join-self () "Cannot `thread-join' the current thread." - (skip-unless (fboundp 'make-thread)) + (skip-unless (featurep 'threads)) (should-error (thread-join (current-thread)))) (defvar threads-test-binding nil) @@ -92,7 +112,7 @@ (ert-deftest threads-let-binding () "Simple test of threads and let bindings." - (skip-unless (fboundp 'make-thread)) + (skip-unless (featurep 'threads)) (should (progn (setq threads-test-global nil) @@ -104,22 +124,22 @@ (ert-deftest threads-mutexp () "Simple test of `mutexp'." - (skip-unless (fboundp 'make-thread)) + (skip-unless (featurep 'threads)) (should-not (mutexp 'hi))) (ert-deftest threads-mutexp-2 () "Another simple test of `mutexp'." - (skip-unless (fboundp 'make-thread)) + (skip-unless (featurep 'threads)) (should (mutexp (make-mutex)))) (ert-deftest threads-mutex-type () "type-of mutex." - (skip-unless (fboundp 'make-thread)) + (skip-unless (featurep 'threads)) (should (eq (type-of (make-mutex)) 'mutex))) (ert-deftest threads-mutex-lock-unlock () "Test mutex-lock and unlock." - (skip-unless (fboundp 'make-thread)) + (skip-unless (featurep 'threads)) (should (let ((mx (make-mutex))) (mutex-lock mx) @@ -128,7 +148,7 @@ (ert-deftest threads-mutex-recursive () "Test mutex recursion." - (skip-unless (fboundp 'make-thread)) + (skip-unless (featurep 'threads)) (should (let ((mx (make-mutex))) (mutex-lock mx) @@ -149,7 +169,7 @@ (ert-deftest threads-mutex-contention () "Test of mutex contention." - (skip-unless (fboundp 'make-thread)) + (skip-unless (featurep 'threads)) (should (progn (setq threads-mutex (make-mutex)) @@ -170,7 +190,7 @@ (ert-deftest threads-mutex-signal () "Test signaling a blocked thread." - (skip-unless (fboundp 'make-thread)) + (skip-unless (featurep 'threads)) (should (progn (setq threads-mutex (make-mutex)) @@ -188,7 +208,7 @@ (ert-deftest threads-io-switch () "Test that `accept-process-output' causes thread switch." - (skip-unless (fboundp 'make-thread)) + (skip-unless (featurep 'threads)) (should (progn (setq threads-test-global nil) @@ -199,36 +219,36 @@ (ert-deftest threads-condvarp () "Simple test of `condition-variable-p'." - (skip-unless (fboundp 'make-thread)) + (skip-unless (featurep 'threads)) (should-not (condition-variable-p 'hi))) (ert-deftest threads-condvarp-2 () "Another simple test of `condition-variable-p'." - (skip-unless (fboundp 'make-thread)) + (skip-unless (featurep 'threads)) (should (condition-variable-p (make-condition-variable (make-mutex))))) (ert-deftest threads-condvar-type () "type-of condvar" - (skip-unless (fboundp 'make-thread)) + (skip-unless (featurep 'threads)) (should (eq (type-of (make-condition-variable (make-mutex))) 'condition-variable))) (ert-deftest threads-condvar-mutex () "Simple test of `condition-mutex'." - (skip-unless (fboundp 'make-thread)) + (skip-unless (featurep 'threads)) (should (let ((m (make-mutex))) (eq m (condition-mutex (make-condition-variable m)))))) (ert-deftest threads-condvar-name () "Simple test of `condition-name'." - (skip-unless (fboundp 'make-thread)) + (skip-unless (featurep 'threads)) (should (eq nil (condition-name (make-condition-variable (make-mutex)))))) (ert-deftest threads-condvar-name-2 () "Another simple test of `condition-name'." - (skip-unless (fboundp 'make-thread)) + (skip-unless (featurep 'threads)) (should (string= "hi bob" (condition-name (make-condition-variable (make-mutex) @@ -246,7 +266,7 @@ (ert-deftest thread-errors () "Test what happens when a thread signals an error." - (skip-unless (fboundp 'make-thread)) + (skip-unless (featurep 'threads)) (let (th1 th2) (setq th1 (make-thread #'call-error "call-error")) (should (threadp th1)) @@ -259,7 +279,7 @@ (ert-deftest thread-sticky-point () "Test bug #25165 with point movement in cloned buffer." - (skip-unless (fboundp 'make-thread)) + (skip-unless (featurep 'threads)) (with-temp-buffer (insert "Lorem ipsum dolor sit amet, consectetur adipiscing elit.") (goto-char (point-min)) @@ -270,7 +290,7 @@ (ert-deftest thread-signal-early () "Test signaling a thread as soon as it is started by the OS." - (skip-unless (fboundp 'make-thread)) + (skip-unless (featurep 'threads)) (let ((thread (make-thread #'(lambda () (while t (thread-yield)))))) @@ -291,7 +311,7 @@ (ert-deftest threads-condvar-wait () "Test waiting on conditional variable." - (skip-unless (fboundp 'make-thread)) + (skip-unless (featurep 'threads)) (let ((cv-mutex (make-mutex)) new-thread) ;; We could have spurious threads from the previous tests still commit 84e5986902c7d7274f438c48c82949436eb9093d Author: Basil L. Contovounesios Date: Wed Jul 11 20:11:55 2018 +0300 ; Add commentary on location of zerop * lisp/subr.el (zerop): Add commentary explaining why moving the function's location within the file broke bootstrap in 2018-07-10T23:08:58-07:00!contovob@tcd.ie. diff --git a/lisp/subr.el b/lisp/subr.el index c1d90e3fb1..a5108eb655 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -548,6 +548,9 @@ If N is omitted or nil, remove the last element." (if (> n 0) (setcdr (nthcdr (- (1- m) n) list) nil)) list)))) +;; This function appears here instead of under the 'Basic Lisp +;; functions' heading because during bootstrap its compiler-macro +;; requires functions defined under the 'List functions' heading. (defun zerop (number) "Return t if NUMBER is zero." ;; Used to be in C, but it's pointless since (= 0 n) is faster anyway because commit 78125f37444acd4f1ec4a0a5b0a338d80672f2ec Author: Glenn Morris Date: Wed Jul 11 08:27:14 2018 -0700 Unbreak bootstrap * lisp/subr.el (zerop): Revert previous change, which caused bootstrap to fail with void function cadr. diff --git a/lisp/subr.el b/lisp/subr.el index 10343e69db..c1d90e3fb1 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -359,13 +359,6 @@ was called." (lambda (&rest args2) (apply fun (append args args2)))) -(defun zerop (number) - "Return t if NUMBER is zero." - ;; Used to be in C, but it's pointless since (= 0 n) is faster anyway because - ;; = has a byte-code. - (declare (compiler-macro (lambda (_) `(= 0 ,number)))) - (= 0 number)) - ;;;; List functions. @@ -555,6 +548,13 @@ If N is omitted or nil, remove the last element." (if (> n 0) (setcdr (nthcdr (- (1- m) n) list) nil)) list)))) +(defun zerop (number) + "Return t if NUMBER is zero." + ;; Used to be in C, but it's pointless since (= 0 n) is faster anyway because + ;; = has a byte-code. + (declare (compiler-macro (lambda (_) `(= 0 ,number)))) + (= 0 number)) + (defun proper-list-p (object) "Return OBJECT's length if it is a proper list, nil otherwise. A proper list is neither circular nor dotted (i.e., its last cdr commit babe0d4508273c5fe0a3228b3d2b4d3dcb72cd58 Author: Basil L. Contovounesios Date: Tue Jul 10 23:08:58 2018 -0700 ; Rearrange definition of zerop in subr.el * lisp/subr.el (zerop): Move from under 'List functions' heading to under 'Basic Lisp functions' heading. diff --git a/lisp/subr.el b/lisp/subr.el index c1d90e3fb1..10343e69db 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -359,6 +359,13 @@ was called." (lambda (&rest args2) (apply fun (append args args2)))) +(defun zerop (number) + "Return t if NUMBER is zero." + ;; Used to be in C, but it's pointless since (= 0 n) is faster anyway because + ;; = has a byte-code. + (declare (compiler-macro (lambda (_) `(= 0 ,number)))) + (= 0 number)) + ;;;; List functions. @@ -548,13 +555,6 @@ If N is omitted or nil, remove the last element." (if (> n 0) (setcdr (nthcdr (- (1- m) n) list) nil)) list)))) -(defun zerop (number) - "Return t if NUMBER is zero." - ;; Used to be in C, but it's pointless since (= 0 n) is faster anyway because - ;; = has a byte-code. - (declare (compiler-macro (lambda (_) `(= 0 ,number)))) - (= 0 number)) - (defun proper-list-p (object) "Return OBJECT's length if it is a proper list, nil otherwise. A proper list is neither circular nor dotted (i.e., its last cdr commit ef9025f5bcfb996fbabf5869584e9143bbc81af4 Author: Miciah Masters Date: Sun Dec 10 20:14:09 2017 -0500 Save the server alias on reconnect (Bug#29657) rcirc does not retain the server alias on reconnect. As a result, rcirc fails to re-use server and channel buffers when an alias is used. Further problems may ensue when aliases are used to differentiate multiple connections to the same host, for example when using a single IRC bouncer or proxy to connect to multiple IRC networks. Save the server alias when connecting to a server so that reconnect will retain the alias. * lisp/net/rcirc.el (rcirc-connect): Include server-alias when setting rcirc-connection-info. Copyright-paperwork-exempt: yes diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 5acbec7dcb..c09bff765b 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -585,7 +585,7 @@ If ARG is non-nil, instead prompt for connection parameters." (setq-local rcirc-connection-info (list server port nick user-name full-name startup-channels - password encryption)) + password encryption server-alias)) (setq-local rcirc-process process) (setq-local rcirc-server server) (setq-local rcirc-server-name commit db3874b16192142f473d53e3b80213ad74d19eff Author: Basil L. Contovounesios Date: Tue Jul 10 19:51:28 2018 -0700 Refer to "proper lists" instead of "true lists" * doc/lispref/lists.texi (Cons Cells, Building Lists): * doc/lispref/sequences.texi (Vector Functions): Use the more popular term "proper", rather than "true", to qualify nil-terminated lists. For discussion, see the following emacs-devel subthreads: https://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00112.html https://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00138.html diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index 431f5fbbab..e05633a881 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -50,16 +50,19 @@ convention; at the level of cons cells, the @sc{car} and @sc{cdr} slots have similar properties). Hence, the @sc{cdr} slot of each cons cell in a list refers to the following cons cell. +@cindex proper list @cindex true list Also by convention, the @sc{cdr} of the last cons cell in a list is @code{nil}. We call such a @code{nil}-terminated structure a -@dfn{true list}. In Emacs Lisp, the symbol @code{nil} is both a -symbol and a list with no elements. For convenience, the symbol -@code{nil} is considered to have @code{nil} as its @sc{cdr} (and also -as its @sc{car}). - - Hence, the @sc{cdr} of a true list is always a true list. The -@sc{cdr} of a nonempty true list is a true list containing all the +@dfn{proper list}@footnote{It is sometimes also referred to as a +@dfn{true list}, but we generally do not use this terminology in this +manual.}. In Emacs Lisp, the symbol @code{nil} is both a symbol and a +list with no elements. For convenience, the symbol @code{nil} is +considered to have @code{nil} as its @sc{cdr} (and also as its +@sc{car}). + + Hence, the @sc{cdr} of a proper list is always a proper list. The +@sc{cdr} of a nonempty proper list is a proper list containing all the elements except the first. @cindex dotted list @@ -71,10 +74,10 @@ Pair Notation}). There is one other possibility: some cons cell's @sc{cdr} could point to one of the previous cons cells in the list. We call that structure a @dfn{circular list}. - For some purposes, it does not matter whether a list is true, + For some purposes, it does not matter whether a list is proper, circular or dotted. If a program doesn't look far enough down the list to see the @sc{cdr} of the final cons cell, it won't care. -However, some functions that operate on lists demand true lists and +However, some functions that operate on lists demand proper lists and signal errors if given a dotted list. Most functions that try to find the end of a list enter infinite loops if given a circular list. @@ -522,7 +525,7 @@ object. The final argument is not copied or converted; it becomes the is itself a list, then its elements become in effect elements of the result list. If the final element is not a list, the result is a dotted list since its final @sc{cdr} is not @code{nil} as required -in a true list. +in a proper list (@pxref{Cons Cells}). @end defun Here is an example of using @code{append}: diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 188a345114..327de6eb86 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -1355,7 +1355,7 @@ each initialized to @var{object}. @defun vconcat &rest sequences @cindex copying vectors This function returns a new vector containing all the elements of -@var{sequences}. The arguments @var{sequences} may be true lists, +@var{sequences}. The arguments @var{sequences} may be proper lists, vectors, strings or bool-vectors. If no @var{sequences} are given, the empty vector is returned. commit f8b1e40fb63b0a6bc6692cc0bc84e5f5e65c2644 Author: Stefan Monnier Date: Tue Jul 10 22:52:21 2018 -0400 * lisp/vc/diff-mode.el: Perform hunk refinement from font-lock Remove redundant :group arguments. (diff-font-lock-refine): New var. (diff--refine-hunk): New function, extracted from diff-refine-hunk. (diff-refine-hunk): Use it. (diff--font-lock-refine--refresh): New function. (diff--font-lock-refined): New function. (diff-font-lock-keywords): Use it. diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index e88ccece41..ffbd9e5479 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -66,14 +66,12 @@ (defcustom diff-default-read-only nil "If non-nil, `diff-mode' buffers default to being read-only." - :type 'boolean - :group 'diff-mode) + :type 'boolean) (defcustom diff-jump-to-old-file nil "Non-nil means `diff-goto-source' jumps to the old file. Else, it jumps to the new file." - :type 'boolean - :group 'diff-mode) + :type 'boolean) (defcustom diff-update-on-the-fly t "Non-nil means hunk headers are kept up-to-date on-the-fly. @@ -82,19 +80,21 @@ need to be kept consistent with the actual diff. This can either be done on the fly (but this sometimes interacts poorly with the undo mechanism) or whenever the file is written (can be slow when editing big diffs)." - :type 'boolean - :group 'diff-mode) + :type 'boolean) (defcustom diff-advance-after-apply-hunk t "Non-nil means `diff-apply-hunk' will move to the next hunk after applying." - :type 'boolean - :group 'diff-mode) + :type 'boolean) (defcustom diff-mode-hook nil "Run after setting up the `diff-mode' major mode." :type 'hook - :options '(diff-delete-empty-files diff-make-unified) - :group 'diff-mode) + :options '(diff-delete-empty-files diff-make-unified)) + +(defcustom diff-font-lock-refine t + "If non-nil, font-lock highlighting includes hunk refinement." + :version "27.1" + :type 'boolean) (defvar diff-vc-backend nil "The VC backend that created the current Diff buffer, if any.") @@ -207,8 +207,7 @@ when editing big diffs)." (defcustom diff-minor-mode-prefix "\C-c=" "Prefix key for `diff-minor-mode' commands." - :type '(choice (string "\e") (string "C-c=") string) - :group 'diff-mode) + :type '(choice (string "\e") (string "C-c=") string)) (easy-mmode-defmap diff-minor-mode-map `((,diff-minor-mode-prefix . ,diff-mode-shared-map)) @@ -238,8 +237,7 @@ well." (((class color)) :foreground "blue1" :weight bold) (t :weight bold)) - "`diff-mode' face inherited by hunk and index header faces." - :group 'diff-mode) + "`diff-mode' face inherited by hunk and index header faces.") (defface diff-file-header '((((class color) (min-colors 88) (background light)) @@ -249,18 +247,15 @@ well." (((class color)) :foreground "cyan" :weight bold) (t :weight bold)) ; :height 1.3 - "`diff-mode' face used to highlight file header lines." - :group 'diff-mode) + "`diff-mode' face used to highlight file header lines.") (defface diff-index '((t :inherit diff-file-header)) - "`diff-mode' face used to highlight index header lines." - :group 'diff-mode) + "`diff-mode' face used to highlight index header lines.") (defface diff-hunk-header '((t :inherit diff-header)) - "`diff-mode' face used to highlight hunk header lines." - :group 'diff-mode) + "`diff-mode' face used to highlight hunk header lines.") (defface diff-removed '((default @@ -271,8 +266,7 @@ well." :background "#553333") (((class color)) :foreground "red")) - "`diff-mode' face used to highlight removed lines." - :group 'diff-mode) + "`diff-mode' face used to highlight removed lines.") (defface diff-added '((default @@ -283,40 +277,34 @@ well." :background "#335533") (((class color)) :foreground "green")) - "`diff-mode' face used to highlight added lines." - :group 'diff-mode) + "`diff-mode' face used to highlight added lines.") (defface diff-changed '((t nil)) "`diff-mode' face used to highlight changed lines." - :version "25.1" - :group 'diff-mode) + :version "25.1") (defface diff-indicator-removed '((t :inherit diff-removed)) "`diff-mode' face used to highlight indicator of removed lines (-, <)." - :group 'diff-mode :version "22.1") (defvar diff-indicator-removed-face 'diff-indicator-removed) (defface diff-indicator-added '((t :inherit diff-added)) "`diff-mode' face used to highlight indicator of added lines (+, >)." - :group 'diff-mode :version "22.1") (defvar diff-indicator-added-face 'diff-indicator-added) (defface diff-indicator-changed '((t :inherit diff-changed)) "`diff-mode' face used to highlight indicator of changed lines." - :group 'diff-mode :version "22.1") (defvar diff-indicator-changed-face 'diff-indicator-changed) (defface diff-function '((t :inherit diff-header)) - "`diff-mode' face used to highlight function names produced by \"diff -p\"." - :group 'diff-mode) + "`diff-mode' face used to highlight function names produced by \"diff -p\".") (defface diff-context '((((class color grayscale) (min-colors 88) (background light)) @@ -324,13 +312,11 @@ well." (((class color grayscale) (min-colors 88) (background dark)) :foreground "#dddddd")) "`diff-mode' face used to highlight context and other side-information." - :version "25.1" - :group 'diff-mode) + :version "25.1") (defface diff-nonexistent '((t :inherit diff-file-header)) - "`diff-mode' face used to highlight nonexistent files in recursive diffs." - :group 'diff-mode) + "`diff-mode' face used to highlight nonexistent files in recursive diffs.") (defconst diff-yank-handler '(diff-yank-function)) (defun diff-yank-function (text) @@ -409,7 +395,8 @@ and the face `diff-added' for added lines.") ("^\\(#\\)\\(.*\\)" (1 font-lock-comment-delimiter-face) (2 font-lock-comment-face)) - ("^[^-=+*!<>#].*\n" (0 'diff-context)))) + ("^[^-=+*!<>#].*\n" (0 'diff-context)) + (,#'diff--font-lock-refined))) (defconst diff-font-lock-defaults '(diff-font-lock-keywords t nil nil nil (font-lock-multiline . nil))) @@ -1964,8 +1951,7 @@ For use in `add-log-current-defun-function'." (((class color) (min-colors 88) (background dark)) :background "#aaaa22") (t :inverse-video t)) - "Face used for char-based changes shown by `diff-refine-hunk'." - :group 'diff-mode) + "Face used for char-based changes shown by `diff-refine-hunk'.") (defface diff-refine-removed '((default @@ -1975,7 +1961,6 @@ For use in `add-log-current-defun-function'." (((class color) (min-colors 88) (background dark)) :background "#aa2222")) "Face used for removed characters shown by `diff-refine-hunk'." - :group 'diff-mode :version "24.3") (defface diff-refine-added @@ -1986,7 +1971,6 @@ For use in `add-log-current-defun-function'." (((class color) (min-colors 88) (background dark)) :background "#22aa22")) "Face used for added characters shown by `diff-refine-hunk'." - :group 'diff-mode :version "24.3") (defun diff-refine-preproc () @@ -2013,59 +1997,99 @@ Return new point, if it was moved." (defun diff-refine-hunk () "Highlight changes of hunk at point at a finer granularity." (interactive) - (require 'smerge-mode) (when (diff--some-hunks-p) (save-excursion - (diff-beginning-of-hunk t) - (let* ((start (point)) - (style (diff-hunk-style)) ;Skips the hunk header as well. - (beg (point)) - (props-c '((diff-mode . fine) (face diff-refine-changed))) - (props-r '((diff-mode . fine) (face diff-refine-removed))) - (props-a '((diff-mode . fine) (face diff-refine-added))) - ;; Be careful to go back to `start' so diff-end-of-hunk gets - ;; to read the hunk header's line info. - (end (progn (goto-char start) (diff-end-of-hunk) (point)))) - - (remove-overlays beg end 'diff-mode 'fine) - - (goto-char beg) - (pcase style - (`unified - (while (re-search-forward "^-" end t) - (let ((beg-del (progn (beginning-of-line) (point))) - beg-add end-add) - (when (and (diff--forward-while-leading-char ?- end) - ;; Allow for "\ No newline at end of file". - (progn (diff--forward-while-leading-char ?\\ end) - (setq beg-add (point))) - (diff--forward-while-leading-char ?+ end) - (progn (diff--forward-while-leading-char ?\\ end) - (setq end-add (point)))) - (smerge-refine-regions beg-del beg-add beg-add end-add - nil #'diff-refine-preproc props-r props-a))))) - (`context - (let* ((middle (save-excursion (re-search-forward "^---"))) - (other middle)) - (while (re-search-forward "^\\(?:!.*\n\\)+" middle t) - (smerge-refine-regions (match-beginning 0) (match-end 0) - (save-excursion - (goto-char other) - (re-search-forward "^\\(?:!.*\n\\)+" end) - (setq other (match-end 0)) - (match-beginning 0)) - other - (if diff-use-changed-face props-c) - #'diff-refine-preproc - (unless diff-use-changed-face props-r) - (unless diff-use-changed-face props-a))))) - (_ ;; Normal diffs. - (let ((beg1 (1+ (point)))) - (when (re-search-forward "^---.*\n" end t) - ;; It's a combined add&remove, so there's something to do. - (smerge-refine-regions beg1 (match-beginning 0) - (match-end 0) end - nil #'diff-refine-preproc props-r props-a))))))))) + (let ((beg (diff-beginning-of-hunk t)) + ;; Be careful to start from the hunk header so diff-end-of-hunk + ;; gets to read the hunk header's line info. + (end (progn (diff-end-of-hunk) (point)))) + (diff--refine-hunk beg end))))) + +(defun diff--refine-hunk (start end) + (require 'smerge-mode) + (goto-char start) + (let* ((style (diff-hunk-style)) ;Skips the hunk header as well. + (beg (point)) + (props-c '((diff-mode . fine) (face . diff-refine-changed))) + (props-r '((diff-mode . fine) (face . diff-refine-removed))) + (props-a '((diff-mode . fine) (face . diff-refine-added)))) + + (remove-overlays beg end 'diff-mode 'fine) + + (goto-char beg) + (pcase style + (`unified + (while (re-search-forward "^-" end t) + (let ((beg-del (progn (beginning-of-line) (point))) + beg-add end-add) + (when (and (diff--forward-while-leading-char ?- end) + ;; Allow for "\ No newline at end of file". + (progn (diff--forward-while-leading-char ?\\ end) + (setq beg-add (point))) + (diff--forward-while-leading-char ?+ end) + (progn (diff--forward-while-leading-char ?\\ end) + (setq end-add (point)))) + (smerge-refine-regions beg-del beg-add beg-add end-add + nil #'diff-refine-preproc props-r props-a))))) + (`context + (let* ((middle (save-excursion (re-search-forward "^---"))) + (other middle)) + (while (re-search-forward "^\\(?:!.*\n\\)+" middle t) + (smerge-refine-regions (match-beginning 0) (match-end 0) + (save-excursion + (goto-char other) + (re-search-forward "^\\(?:!.*\n\\)+" end) + (setq other (match-end 0)) + (match-beginning 0)) + other + (if diff-use-changed-face props-c) + #'diff-refine-preproc + (unless diff-use-changed-face props-r) + (unless diff-use-changed-face props-a))))) + (_ ;; Normal diffs. + (let ((beg1 (1+ (point)))) + (when (re-search-forward "^---.*\n" end t) + ;; It's a combined add&remove, so there's something to do. + (smerge-refine-regions beg1 (match-beginning 0) + (match-end 0) end + nil #'diff-refine-preproc props-r props-a))))))) + +(defun diff--font-lock-refined (max) + "Apply hunk refinement from font-lock." + (when diff-font-lock-refine + (when (get-char-property (point) 'diff--font-lock-refined) + ;; Refinement works over a complete hunk, whereas font-lock limits itself + ;; to highlighting smallish chunks between point..max, so we may be + ;; called N times for a large hunk in which case we don't want to + ;; rehighlight that hunk N times (especially since each highlighting + ;; of a large hunk can itself take a long time, adding insult to injury). + ;; So, after refining a hunk (including a failed attempt), we place an + ;; overlay over the whole hunk to mark it as refined, to avoid redoing + ;; the job redundantly when asked to highlight subsequent parts of the + ;; same hunk. + (goto-char (next-single-char-property-change + (point) 'diff--font-lock-refined nil max))) + (let* ((min (point)) + (beg (or (ignore-errors (diff-beginning-of-hunk)) + (ignore-errors (diff-hunk-next) (point)) + max))) + (while (< beg max) + (let ((end + (save-excursion (goto-char beg) (diff-end-of-hunk) (point)))) + (if (< end min) (setq beg min)) + (unless (or (< end beg) + (get-char-property beg 'diff--font-lock-refined)) + (diff--refine-hunk beg end) + (let ((ol (make-overlay beg end))) + (overlay-put ol 'diff--font-lock-refined t) + (overlay-put ol 'evaporate t) + (overlay-put ol 'modification-hooks + '(diff--font-lock-refine--refresh)))) + (goto-char (max beg end)) + (setq beg (or (ignore-errors (diff-hunk-next) (point)) max))))))) + +(defun diff--font-lock-refine--refresh (ol _after _beg _end &optional _len) + (delete-overlay ol)) (defun diff-undo (&optional arg) "Perform `undo', ignoring the buffer's read-only status." commit 1d7151e98e9da5eeb4e341cfdb7d1f4462dc5b70 Author: Filipp Gunbin Date: Wed Jul 11 05:28:21 2018 +0300 Fix Bug#32107 * lisp/progmodes/sql.el (sql-buffer-live-p): Fix handling of optional connection argument. (Bug#32107) diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 223fb2ec93..ba180c2b26 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -1270,8 +1270,9 @@ specified, it's `sql-product' or `sql-connection' must match." (and (derived-mode-p 'sql-interactive-mode) (or (not product) (eq product sql-product)) - (or (stringp connection) - (string= connection sql-connection))))))) + (or (not connection) + (and (stringp connection) + (string= connection sql-connection)))))))) ;; Keymap for sql-interactive-mode. commit 39489f782e436a490d1bec32d7ed9b7bcdacda24 Author: Jonathan Kyle Mitchell Date: Wed May 2 23:09:55 2018 -0500 Fix infinite recursion in eshell/clear (Bug#31326) * lisp/eshell/esh-mode.el (eshell/clear): Bind eshell-input-filter-functions to nil to prevent entries like eshell-smart-display-setup from causing infinite recursion. diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index bbb74c3d86..9f854c7d90 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -884,8 +884,7 @@ If SCROLLBACK is non-nil, clear the scrollback contents." (interactive) (if scrollback (eshell/clear-scrollback) - (let ((eshell-input-filter-functions - (remq 'eshell-add-to-history eshell-input-filter-functions))) + (let ((eshell-input-filter-functions nil)) (insert (make-string (window-size) ?\n)) (eshell-send-input)))) commit c249e17324ddbb1ad34b510be3ad6ebd3248ba0c Author: Noam Postavsky Date: Tue Jul 10 12:07:01 2018 -0400 * lisp/indent.el (indent-line-to): Fix dedenting of tabs. diff --git a/lisp/indent.el b/lisp/indent.el index db811cf35c..450632174f 100644 --- a/lisp/indent.el +++ b/lisp/indent.el @@ -300,9 +300,11 @@ only if necessary. It leaves point at end of indentation." (progn (skip-chars-backward " ") (point)))) (indent-to column)) ((> cur-col column) ; too far right (after tab?) - (let ((cur-indent (point))) - (delete-region (progn (move-to-column column t) (point)) - cur-indent)))))) + (delete-region (progn (move-to-column column t) (point)) + ;; The `move-to-column' call may replace + ;; tabs with spaces, so we can't reuse the + ;; previous `back-to-indentation' point. + (progn (back-to-indentation) (point))))))) (defun current-left-margin () "Return the left margin to use for this line. commit 35e0305dc2a57cea6fcb515db9e0b0f938daf53a Author: John Shahid Date: Sat Jun 23 11:12:44 2018 -0400 Avoid turning on the global-minor-mode recursively * lisp/emacs-lisp/easy-mmode.el (define-globalized-minor-mode): Clear the buffer-list inside MODE-enable-in-buffers to avoid enabling the mode recursively. (Bug#31793) diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 21ca69324e..443e03eb1a 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -457,22 +457,26 @@ See `%s' for more information on %s." ;; The function that calls TURN-ON in each buffer. (defun ,MODE-enable-in-buffers () - (dolist (buf ,MODE-buffers) - (when (buffer-live-p buf) - (with-current-buffer buf - (unless ,MODE-set-explicitly - (unless (eq ,MODE-major-mode major-mode) - (if ,mode - (progn - (,mode -1) - (funcall #',turn-on)) - (funcall #',turn-on)))) - (setq ,MODE-major-mode major-mode))))) + (let ((buffers ,MODE-buffers)) + ;; Clear MODE-buffers to avoid scanning the same list of + ;; buffers in recursive calls to MODE-enable-in-buffers. + ;; Otherwise it could lead to infinite recursion. + (setq ,MODE-buffers nil) + (dolist (buf buffers) + (when (buffer-live-p buf) + (with-current-buffer buf + (unless ,MODE-set-explicitly + (unless (eq ,MODE-major-mode major-mode) + (if ,mode + (progn + (,mode -1) + (funcall #',turn-on)) + (funcall #',turn-on)))) + (setq ,MODE-major-mode major-mode)))))) (put ',MODE-enable-in-buffers 'definition-name ',global-mode) (defun ,MODE-check-buffers () (,MODE-enable-in-buffers) - (setq ,MODE-buffers nil) (remove-hook 'post-command-hook ',MODE-check-buffers)) (put ',MODE-check-buffers 'definition-name ',global-mode) commit 51bf4e4650fc11fc4ab3037f5738151f86d7fb47 Author: Michael Albinus Date: Tue Jul 10 09:49:49 2018 +0200 Fix Bug#32085 * doc/misc/tramp.texi (GVFS based methods): `dav' and `davs' do not support paths in the volume name. (Bug#32085) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 154dec11d8..0cc0b49bc4 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -1091,6 +1091,10 @@ syntax requires a leading volume (share) name, for example: based on standard protocols, such as HTTP@. @option{davs} does the same but with SSL encryption. Both methods support the port numbers. +Paths being part of the WebDAV volume to be mounted by GVFS, as it is +common for OwnCloud or NextCloud file names, are not supported by +these methods. + @item @option{gdrive} @cindex method gdrive @cindex gdrive method commit cc74539a19229ee7e70055b00e8334bd6abc0841 Author: Paul Eggert Date: Mon Jul 9 18:59:58 2018 -0700 * lisp/format.el (format-annotate-single-property-change): Simplify. diff --git a/lisp/format.el b/lisp/format.el index 1222abbf65..5bf1be3947 100644 --- a/lisp/format.el +++ b/lisp/format.el @@ -1000,9 +1000,7 @@ either strings, or lists of the form (PARAMETER VALUE)." (if (not (and (proper-list-p old) (proper-list-p new))) (format-annotate-atomic-property-change prop-alist old new) - (let* ((old (if (listp old) old (list old))) - (new (if (listp new) new (list new))) - close open) + (let (close open) (while old (setq close (append (car (format-annotate-atomic-property-change commit 2fde6275b69fd113e78243790bf112bbdd2fe2bf Author: Basil L. Contovounesios Date: Mon Jul 9 18:46:33 2018 -0700 Add predicate proper-list-p For discussion, see emacs-devel thread starting at https://lists.gnu.org/archive/html/emacs-devel/2018-04/msg00460.html. * lisp/subr.el (proper-list-p): New function. Implementation suggested by Paul Eggert in https://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00138.html. * doc/lispref/lists.texi (List Elements): * etc/NEWS: Document proper-list-p. * lisp/org/ob-core.el (org-babel-insert-result): * lisp/emacs-lisp/byte-opt.el (byte-optimize-if): * lisp/emacs-lisp/cl-macs.el (cl--make-usage-args): Use proper-list-p. * lisp/emacs-lisp/ert.el (ert--proper-list-p): Remove. Replaced by proper-list-p in lisp/subr.el. (ert--explain-equal-rec): Use proper-list-length. * lisp/format.el (format-proper-list-p): Remove. Replaced by proper-list-p in lisp/subr.el. (format-annotate-single-property-change): Use proper-list-p. * test/lisp/emacs-lisp/ert-tests.el (ert-test-proper-list-p): Move from here... * test/lisp/subr-tests.el (subr-tests--proper-list-length): ...to here, mutatis mutandis. diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index 761750eb20..57cefeac96 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -153,6 +153,22 @@ considered a list and @code{not} when it is considered a truth value @end example @end defun +@defun proper-list-p object +This function returns the length of @var{object} if it is a proper +list, @code{nil} otherwise (@pxref{Cons Cells}). In addition to +satisfying @code{listp}, a proper list is neither circular nor dotted. + +@example +@group +(proper-list-p '(a b c)) + @result{} 3 +@end group +@group +(proper-list-p '(a b . c)) + @result{} nil +@end group +@end example +@end defun @node List Elements @section Accessing Elements of Lists diff --git a/etc/NEWS b/etc/NEWS index dae028be7b..1a1e0d8b70 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -703,6 +703,11 @@ manual for more details. * Lisp Changes in Emacs 27.1 ++++ +** New function 'proper-list-p'. +Given a proper list as argument, this predicate returns its length; +otherwise, it returns nil. + ** define-minor-mode automatically documents the meaning of ARG +++ diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 3bc4c438d6..5c0b5e340b 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -982,8 +982,7 @@ ;; (if nil) ==> (if ) (let ((clause (nth 1 form))) (cond ((and (eq (car-safe clause) 'progn) - ;; `clause' is a proper list. - (null (cdr (last clause)))) + (proper-list-p clause)) (if (null (cddr clause)) ;; A trivial `progn'. (byte-optimize-if `(if ,(cadr clause) ,@(nthcdr 2 form))) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index b50961adac..011965acb5 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -498,7 +498,7 @@ its argument list allows full Common Lisp conventions." ;; `&aux' args aren't arguments, so let's just drop them from the ;; usage info. (setq arglist (cl-subseq arglist 0 aux)))) - (if (cdr-safe (last arglist)) ;Not a proper list. + (if (not (proper-list-p arglist)) (let* ((last (last arglist)) (tail (cdr last))) (unwind-protect diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 32bb367cdb..cad21044f1 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -472,18 +472,6 @@ Errors during evaluation are caught and handled like nil." ;; buffer. Perhaps explanations should be reported through `ert-info' ;; rather than as part of the condition. -(defun ert--proper-list-p (x) - "Return non-nil if X is a proper list, nil otherwise." - (cl-loop - for firstp = t then nil - for fast = x then (cddr fast) - for slow = x then (cdr slow) do - (when (null fast) (cl-return t)) - (when (not (consp fast)) (cl-return nil)) - (when (null (cdr fast)) (cl-return t)) - (when (not (consp (cdr fast))) (cl-return nil)) - (when (and (not firstp) (eq fast slow)) (cl-return nil)))) - (defun ert--explain-format-atom (x) "Format the atom X for `ert--explain-equal'." (pcase x @@ -494,17 +482,17 @@ Errors during evaluation are caught and handled like nil." (defun ert--explain-equal-rec (a b) "Return a programmer-readable explanation of why A and B are not `equal'. Returns nil if they are." - (if (not (equal (type-of a) (type-of b))) + (if (not (eq (type-of a) (type-of b))) `(different-types ,a ,b) (pcase-exhaustive a ((pred consp) - (let ((a-proper-p (ert--proper-list-p a)) - (b-proper-p (ert--proper-list-p b))) - (if (not (eql (not a-proper-p) (not b-proper-p))) + (let ((a-length (proper-list-p a)) + (b-length (proper-list-p b))) + (if (not (eq (not a-length) (not b-length))) `(one-list-proper-one-improper ,a ,b) - (if a-proper-p - (if (not (equal (length a) (length b))) - `(proper-lists-of-different-length ,(length a) ,(length b) + (if a-length + (if (/= a-length b-length) + `(proper-lists-of-different-length ,a-length ,b-length ,a ,b first-mismatch-at ,(cl-mismatch a b :test 'equal)) @@ -523,7 +511,7 @@ Returns nil if they are." (cl-assert (equal a b) t) nil)))))))) ((pred arrayp) - (if (not (equal (length a) (length b))) + (if (/= (length a) (length b)) `(arrays-of-different-length ,(length a) ,(length b) ,a ,b ,@(unless (char-table-p a) diff --git a/lisp/format.el b/lisp/format.el index 2f198e3eb7..1222abbf65 100644 --- a/lisp/format.el +++ b/lisp/format.el @@ -539,14 +539,6 @@ Compare using `equal'." (setq tail next))) (cons acopy bcopy))) -(defun format-proper-list-p (list) - "Return t if LIST is a proper list. -A proper list is a list ending with a nil cdr, not with an atom " - (when (listp list) - (while (consp list) - (setq list (cdr list))) - (null list))) - (defun format-reorder (items order) "Arrange ITEMS to follow partial ORDER. Elements of ITEMS equal to elements of ORDER will be rearranged @@ -1005,8 +997,8 @@ either strings, or lists of the form (PARAMETER VALUE)." ;; If either old or new is a list, have to treat both that way. (if (and (or (listp old) (listp new)) (not (get prop 'format-list-atomic-p))) - (if (or (not (format-proper-list-p old)) - (not (format-proper-list-p new))) + (if (not (and (proper-list-p old) + (proper-list-p new))) (format-annotate-atomic-property-change prop-alist old new) (let* ((old (if (listp old) old (list old))) (new (if (listp new) new (list new))) diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el index 5d5faaa6fd..a5449fe35e 100644 --- a/lisp/org/ob-core.el +++ b/lisp/org/ob-core.el @@ -2310,10 +2310,9 @@ INFO may provide the values of these header arguments (in the (lambda (r) ;; Non-nil when result R can be turned into ;; a table. - (and (listp r) - (null (cdr (last r))) + (and (proper-list-p r) (cl-every - (lambda (e) (or (atom e) (null (cdr (last e))))) + (lambda (e) (or (atom e) (proper-list-p e))) result))))) ;; insert results based on type (cond diff --git a/lisp/subr.el b/lisp/subr.el index ca184d8fc8..c1d90e3fb1 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -555,6 +555,12 @@ If N is omitted or nil, remove the last element." (declare (compiler-macro (lambda (_) `(= 0 ,number)))) (= 0 number)) +(defun proper-list-p (object) + "Return OBJECT's length if it is a proper list, nil otherwise. +A proper list is neither circular nor dotted (i.e., its last cdr +is nil)." + (and (listp object) (ignore-errors (length object)))) + (defun delete-dups (list) "Destructively remove `equal' duplicates from LIST. Store the result in LIST and return it. LIST must be a proper list. diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index e92b434274..cb957bd9fd 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -496,48 +496,6 @@ This macro is used to test if macroexpansion in `should' works." ;;; Tests for utility functions. -(ert-deftest ert-test-proper-list-p () - (should (ert--proper-list-p '())) - (should (ert--proper-list-p '(1))) - (should (ert--proper-list-p '(1 2))) - (should (ert--proper-list-p '(1 2 3))) - (should (ert--proper-list-p '(1 2 3 4))) - (should (not (ert--proper-list-p 'a))) - (should (not (ert--proper-list-p '(1 . a)))) - (should (not (ert--proper-list-p '(1 2 . a)))) - (should (not (ert--proper-list-p '(1 2 3 . a)))) - (should (not (ert--proper-list-p '(1 2 3 4 . a)))) - (let ((a (list 1))) - (setf (cdr (last a)) a) - (should (not (ert--proper-list-p a)))) - (let ((a (list 1 2))) - (setf (cdr (last a)) a) - (should (not (ert--proper-list-p a)))) - (let ((a (list 1 2 3))) - (setf (cdr (last a)) a) - (should (not (ert--proper-list-p a)))) - (let ((a (list 1 2 3 4))) - (setf (cdr (last a)) a) - (should (not (ert--proper-list-p a)))) - (let ((a (list 1 2))) - (setf (cdr (last a)) (cdr a)) - (should (not (ert--proper-list-p a)))) - (let ((a (list 1 2 3))) - (setf (cdr (last a)) (cdr a)) - (should (not (ert--proper-list-p a)))) - (let ((a (list 1 2 3 4))) - (setf (cdr (last a)) (cdr a)) - (should (not (ert--proper-list-p a)))) - (let ((a (list 1 2 3))) - (setf (cdr (last a)) (cddr a)) - (should (not (ert--proper-list-p a)))) - (let ((a (list 1 2 3 4))) - (setf (cdr (last a)) (cddr a)) - (should (not (ert--proper-list-p a)))) - (let ((a (list 1 2 3 4))) - (setf (cdr (last a)) (cl-cdddr a)) - (should (not (ert--proper-list-p a))))) - (ert-deftest ert-test-parse-keys-and-body () (should (equal (ert--parse-keys-and-body '(foo)) '(nil (foo)))) (should (equal (ert--parse-keys-and-body '(:bar foo)) '((:bar foo) nil))) diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 52b61d9fb9..86938d5dbe 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -306,6 +306,24 @@ cf. Bug#25477." (should (eq (string-to-char (symbol-name (gensym))) ?g)) (should (eq (string-to-char (symbol-name (gensym "X"))) ?X))) +(ert-deftest subr-tests--proper-list-p () + "Test `proper-list-p' behavior." + (dotimes (length 4) + ;; Proper and dotted lists. + (let ((list (make-list length 0))) + (should (= (proper-list-p list) length)) + (should (not (proper-list-p (nconc list 0))))) + ;; Circular lists. + (dotimes (n (1+ length)) + (let ((circle (make-list (1+ length) 0))) + (should (not (proper-list-p (nconc circle (nthcdr n circle)))))))) + ;; Atoms. + (should (not (proper-list-p 0))) + (should (not (proper-list-p ""))) + (should (not (proper-list-p []))) + (should (not (proper-list-p (make-bool-vector 0 nil)))) + (should (not (proper-list-p (make-symbol "a"))))) + (ert-deftest subr-tests--assq-delete-all () "Test `assq-delete-all' behavior." (cl-flet ((new-list-fn commit e4ad2d1a8fad8c8c786b61083b05cfaa1ea5669c Author: Noam Postavsky Date: Sat Jun 30 09:14:22 2018 -0400 Respect field boundaries in indent-line-to (Bug#32014) * lisp/indent.el (indent-line-to): Use the back-to-indentation point as the end-point of whitespace removal, rather than backward-to-indentation which doesn't respect field boundaries. * test/lisp/emacs-lisp/lisp-mode-tests.el (lisp-indent-with-read-only-field): Don't expect to fail. diff --git a/lisp/indent.el b/lisp/indent.el index 398585e1f9..db811cf35c 100644 --- a/lisp/indent.el +++ b/lisp/indent.el @@ -300,8 +300,9 @@ only if necessary. It leaves point at end of indentation." (progn (skip-chars-backward " ") (point)))) (indent-to column)) ((> cur-col column) ; too far right (after tab?) - (delete-region (progn (move-to-column column t) (point)) - (progn (backward-to-indentation 0) (point))))))) + (let ((cur-indent (point))) + (delete-region (progn (move-to-column column t) (point)) + cur-indent)))))) (defun current-left-margin () "Return the left margin to use for this line. diff --git a/test/lisp/emacs-lisp/lisp-mode-tests.el b/test/lisp/emacs-lisp/lisp-mode-tests.el index 2ac0e5ce1d..8598d41978 100644 --- a/test/lisp/emacs-lisp/lisp-mode-tests.el +++ b/test/lisp/emacs-lisp/lisp-mode-tests.el @@ -226,7 +226,6 @@ Expected initialization file: `%s'\" (ert-deftest lisp-indent-with-read-only-field () "Test indentation on line with read-only field (Bug#32014)." - :expected-result :failed (with-temp-buffer (insert (propertize "prompt> " 'field 'output 'read-only t 'rear-nonsticky t 'front-sticky '(read-only))) commit 737481cc624c62bdbd210b3eda8a6de0f23d4505 Merge: 6b8349a902 8f7d35cabd Author: Noam Postavsky Date: Mon Jul 9 20:06:29 2018 -0400 ; Merge from emacs-26 The following commit was skipped: 8f7d35cabd Stop using indent-line-to in lisp-indent-line (Bug#32014) commit 6b8349a90274686d9cb67a2ffaac2d930d5f6b46 Merge: 6de90fb41b db3f779780 Author: Noam Postavsky Date: Mon Jul 9 20:06:27 2018 -0400 Merge from emacs-26 db3f779780 ; Test for Bug#32014 90d95b000c Explicitly reject :server and :nowait (Bug#31903) 917158f8c9 Fix Bug#32090 # Conflicts: # src/process.c commit 6de90fb41b63d33457c1fa41cbb4bd8b25e4cc7f Merge: 7bcb697e19 848f0f73e9 Author: Noam Postavsky Date: Mon Jul 9 20:03:30 2018 -0400 ; Merge from emacs-26 The following commit was skipped: 848f0f73e9 Fix floating point exceptions on Alpha (Bug#32086) commit 7bcb697e198cb314980b93862a79e892009088c4 Merge: 3307353e13 65889a6d12 Author: Noam Postavsky Date: Mon Jul 9 20:03:30 2018 -0400 Merge from emacs-26 65889a6d12 Fix bootstrap infloop in GNU/Linux alpha 48efd1c98b Minor fix of a recent documentation change 3302b7cd7f Mention the NSM in the gnutls variable doc strings 40c2ce743b Remove test code from last commit e02d8e29c6 Fix Bug#32084 da5d6dbe39 Fix (length NON-SEQUENCE) documentation commit 8f7d35cabdbeb2404d53af39c5d7c12e870fa1cb Author: Noam Postavsky Date: Fri Jun 29 19:58:58 2018 -0400 Stop using indent-line-to in lisp-indent-line (Bug#32014) This is partial revert of "Remove ignored argument from lisp-indent-line", because `indent-line-to' doesn't respect field boundaries. * lisp/emacs-lisp/lisp-mode.el (lisp-indent-line): Use delete-region and indent-to instead of `indent-line-to'. * test/lisp/emacs-lisp/lisp-mode-tests.el (lisp-indent-with-read-only-field): Expect to pass. Don't merge to master, we will fix indent-line-to there instead. diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 94be5acd6d..3a03b56313 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -867,7 +867,9 @@ by more than one line to cross a string literal." (interactive) (let ((pos (- (point-max) (point))) (indent (progn (beginning-of-line) - (or indent (calculate-lisp-indent (lisp-ppss)))))) + (or indent (calculate-lisp-indent (lisp-ppss))))) + (shift-amt nil) + (beg (progn (beginning-of-line) (point)))) (skip-chars-forward " \t") (if (or (null indent) (looking-at "\\s<\\s<\\s<")) ;; Don't alter indentation of a ;;; comment line @@ -879,7 +881,11 @@ by more than one line to cross a string literal." ;; as comment lines, not as code. (progn (indent-for-comment) (forward-char -1)) (if (listp indent) (setq indent (car indent))) - (indent-line-to indent)) + (setq shift-amt (- indent (current-column))) + (if (zerop shift-amt) + nil + (delete-region beg (point)) + (indent-to indent))) ;; If initial point was within line's indentation, ;; position after the indentation. Else stay at same point in text. (if (> (- (point-max) pos) (point)) diff --git a/test/lisp/emacs-lisp/lisp-mode-tests.el b/test/lisp/emacs-lisp/lisp-mode-tests.el index 2ac0e5ce1d..8598d41978 100644 --- a/test/lisp/emacs-lisp/lisp-mode-tests.el +++ b/test/lisp/emacs-lisp/lisp-mode-tests.el @@ -226,7 +226,6 @@ Expected initialization file: `%s'\" (ert-deftest lisp-indent-with-read-only-field () "Test indentation on line with read-only field (Bug#32014)." - :expected-result :failed (with-temp-buffer (insert (propertize "prompt> " 'field 'output 'read-only t 'rear-nonsticky t 'front-sticky '(read-only))) commit db3f7797809ed9de8dd92ce38bf34f768ddc64ad Author: Noam Postavsky Date: Fri Jun 29 20:15:10 2018 -0400 ; Test for Bug#32014 * test/lisp/emacs-lisp/lisp-mode-tests.el (lisp-indent-with-read-only-field): New test. diff --git a/test/lisp/emacs-lisp/lisp-mode-tests.el b/test/lisp/emacs-lisp/lisp-mode-tests.el index 0b5b0a4019..2ac0e5ce1d 100644 --- a/test/lisp/emacs-lisp/lisp-mode-tests.el +++ b/test/lisp/emacs-lisp/lisp-mode-tests.el @@ -224,6 +224,17 @@ Expected initialization file: `%s'\" (comment-indent) (should (equal (buffer-string) correct))))) +(ert-deftest lisp-indent-with-read-only-field () + "Test indentation on line with read-only field (Bug#32014)." + :expected-result :failed + (with-temp-buffer + (insert (propertize "prompt> " 'field 'output 'read-only t + 'rear-nonsticky t 'front-sticky '(read-only))) + (insert " foo") + (lisp-indent-line) + (should (equal (buffer-string) "prompt> foo")))) + + (provide 'lisp-mode-tests) ;;; lisp-mode-tests.el ends here commit 90d95b000c37f7e85096716db96c4a940436f387 Author: Noam Postavsky Date: Thu Jul 5 19:37:28 2018 -0400 Explicitly reject :server and :nowait (Bug#31903) * src/process.c (Fmake_network_process): Explicitly check for and signal an error when passed both :server and :nowait non-nil. In Emacs 25, :nowait would be ignored in this case, but as of Emacs 26.1 this gives an error, albeit an unclear one. Also remove obsolete comment regarding configurations lacking non-blocking mode, the corresponding code was removed in 2012-11-17 "Assume POSIX 1003.1-1988 or later for fcntl.h." diff --git a/src/process.c b/src/process.c index 7f6ea1261e..4d7a735652 100644 --- a/src/process.c +++ b/src/process.c @@ -3890,12 +3890,15 @@ usage: (make-network-process &rest ARGS) */) filter = Fplist_get (contact, QCfilter); sentinel = Fplist_get (contact, QCsentinel); use_external_socket_p = Fplist_get (contact, QCuse_external_socket); + Lisp_Object server = Fplist_get (contact, QCserver); + bool nowait = !NILP (Fplist_get (contact, QCnowait)); + if (!NILP (server) && nowait) + error ("`:server' is incompatible with `:nowait'"); CHECK_STRING (name); /* :local ADDRESS or :remote ADDRESS */ - tem = Fplist_get (contact, QCserver); - if (NILP (tem)) + if (!NILP (server)) address = Fplist_get (contact, QCremote); else address = Fplist_get (contact, QClocal); @@ -4009,7 +4012,7 @@ usage: (make-network-process &rest ARGS) */) } #ifdef HAVE_GETADDRINFO_A - if (!NILP (host) && !NILP (Fplist_get (contact, QCnowait))) + if (!NILP (host) && nowait) { ptrdiff_t hostlen = SBYTES (host); struct req @@ -4154,20 +4157,13 @@ usage: (make-network-process &rest ARGS) */) set_network_socket_coding_system (proc, host, service, name); - /* :server BOOL */ - tem = Fplist_get (contact, QCserver); - if (!NILP (tem)) - { - /* Don't support network sockets when non-blocking mode is - not available, since a blocked Emacs is not useful. */ - p->is_server = true; - if (TYPE_RANGED_INTEGERP (int, tem)) - p->backlog = XINT (tem); - } + /* :server QLEN */ + p->is_server = !NILP (server); + if (TYPE_RANGED_INTEGERP (int, server)) + p->backlog = XINT (server); /* :nowait BOOL */ - if (!p->is_server && socktype != SOCK_DGRAM - && !NILP (Fplist_get (contact, QCnowait))) + if (!p->is_server && socktype != SOCK_DGRAM && nowait) p->is_non_blocking_client = true; bool postpone_connection = false; commit 917158f8c91121572f38d641096e171540d0bac2 Author: Michael Albinus Date: Mon Jul 9 16:03:49 2018 +0200 Fix Bug#32090 * lisp/files-x.el (connection-local-normalize-criteria): Do not use PROPERTIES anymore. (connection-local-get-profiles): Rewrite, in order to accept any property as optional. (Bug#32090) (connection-local-set-profiles): Adapt ´connection-local-normalize-criteria' call. * test/lisp/files-x-tests.el (files-x-test-connection-local-set-profiles) (files-x-test-hack-connection-local-variables-apply): Extend tests. diff --git a/lisp/files-x.el b/lisp/files-x.el index 74ea77678e..2a52792222 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -578,31 +578,33 @@ strings. All properties are optional; if CRITERIA is nil, it always applies. PROFILES is a list of connection profiles (symbols).") -(defsubst connection-local-normalize-criteria (criteria &rest properties) - "Normalize plist CRITERIA according to PROPERTIES. -Return a new ordered plist list containing only property names from PROPERTIES." - (delq - nil +(defsubst connection-local-normalize-criteria (criteria) + "Normalize plist CRITERIA according to properties. +Return a reordered plist." + (apply + 'append (mapcar (lambda (property) (when (and (plist-member criteria property) (plist-get criteria property)) (list property (plist-get criteria property)))) - properties))) + '(:application :protocol :user :machine)))) (defsubst connection-local-get-profiles (criteria) "Return the connection profiles list for CRITERIA. CRITERIA is a plist identifying a connection and the application using this connection, see `connection-local-criteria-alist'." - (or (cdr - (assoc - (connection-local-normalize-criteria - criteria :application :protocol :user :machine) - connection-local-criteria-alist)) - ;; Try it without :application. - (cdr - (assoc - (connection-local-normalize-criteria criteria :protocol :user :machine) - connection-local-criteria-alist)))) + (let (profiles) + (dolist (crit-alist connection-local-criteria-alist) + (let ((crit criteria) + (match t)) + (while (and crit match) + (when (plist-member (car crit-alist) (car crit)) + (setq match (equal (plist-get (car crit-alist) (car crit)) + (plist-get criteria (car crit))))) + (setq crit (cddr crit))) + (when match + (setq profiles (append profiles (cdr crit-alist)))))) + (delete-dups profiles))) ;;;###autoload (defun connection-local-set-profiles (criteria &rest profiles) @@ -621,8 +623,7 @@ variables for a connection profile are defined using (dolist (profile profiles) (unless (assq profile connection-local-profile-alist) (error "No such connection profile `%s'" (symbol-name profile)))) - (let* ((criteria (connection-local-normalize-criteria - criteria :application :protocol :user :machine)) + (let* ((criteria (connection-local-normalize-criteria criteria)) (slot (assoc criteria connection-local-criteria-alist))) (if slot (setcdr slot (delete-dups (append (cdr slot) profiles))) diff --git a/test/lisp/files-x-tests.el b/test/lisp/files-x-tests.el index 7bd69bda01..a77c6815fc 100644 --- a/test/lisp/files-x-tests.el +++ b/test/lisp/files-x-tests.el @@ -101,15 +101,19 @@ (setq files-x-test--criteria (append files-x-test--application files-x-test--protocol files-x-test--user files-x-test--machine)) + ;; An empty variable list is accepted (but makes no sense). (connection-local-set-profiles files-x-test--criteria) (should-not (connection-local-get-profiles files-x-test--criteria)) + + ;; First test, all declared properties. (connection-local-set-profiles files-x-test--criteria 'remote-bash 'remote-ksh) (should (equal (connection-local-get-profiles files-x-test--criteria) '(remote-bash remote-ksh))) + ;; Changing the order of properties doesn't matter. (setq files-x-test--criteria (append files-x-test--protocol files-x-test--application @@ -118,12 +122,14 @@ (equal (connection-local-get-profiles files-x-test--criteria) '(remote-bash remote-ksh))) - ;; A further call adds profiles. + + ;; A further call adds profiles. (connection-local-set-profiles files-x-test--criteria 'remote-nullfile) (should (equal (connection-local-get-profiles files-x-test--criteria) '(remote-bash remote-ksh remote-nullfile))) + ;; Adding existing profiles doesn't matter. (connection-local-set-profiles files-x-test--criteria 'remote-bash 'remote-nullfile) @@ -132,31 +138,38 @@ (connection-local-get-profiles files-x-test--criteria) '(remote-bash remote-ksh remote-nullfile))) - ;; Use a criteria without application. - (setq files-x-test--criteria - (append files-x-test--protocol - files-x-test--user files-x-test--machine)) - (connection-local-set-profiles files-x-test--criteria 'remote-ksh) - (should - (equal - (connection-local-get-profiles files-x-test--criteria) - '(remote-ksh))) - ;; An application not used in any registered criteria matches also this. - (setq files-x-test--criteria - (append files-x-test--another-application files-x-test--protocol - files-x-test--user files-x-test--machine)) - (should - (equal - (connection-local-get-profiles files-x-test--criteria) - '(remote-ksh))) + ;; Use different properties. + (dolist (criteria + `(;; All properties. + ,(append files-x-test--application files-x-test--protocol + files-x-test--user files-x-test--machine) + ;; Without :application. + ,(append files-x-test--protocol + files-x-test--user files-x-test--machine) + ;; Without :protocol. + ,(append files-x-test--application + files-x-test--user files-x-test--machine) + ;; Without :user. + ,(append files-x-test--application files-x-test--protocol + files-x-test--machine) + ;; Without :machine. + ,(append files-x-test--application files-x-test--protocol + files-x-test--user) + ;; No property at all. + nil)) + (should + (equal + (connection-local-get-profiles criteria) + '(remote-bash remote-ksh remote-nullfile)))) ;; Using a nil criteria also works. Duplicate profiles are trashed. (connection-local-set-profiles nil 'remote-bash 'remote-ksh 'remote-ksh 'remote-bash) + ;; This matches also the existing profiles from other criteria. (should (equal (connection-local-get-profiles nil) - '(remote-bash remote-ksh))) + '(remote-bash remote-ksh remote-nullfile))) ;; A criteria other than plist is wrong. (should-error (connection-local-set-profiles 'dummy)))) @@ -235,7 +248,9 @@ ;; declare same variables as in `remote-bash'. (should (equal connection-local-variables-alist - (nreverse (copy-tree files-x-test--variables1)))) + (append + (nreverse (copy-tree files-x-test--variables3)) + (nreverse (copy-tree files-x-test--variables1))))) ;; The variables exist also as local variables. (should (local-variable-p 'remote-shell-file-name)) ;; The proper variable value is set. commit 3307353e13a9226d477c9b1a39baae76584b90b9 Author: Sam Steingold Date: Mon Jul 9 09:29:09 2018 -0400 dired-do-find-regexp: Use rgrep-find-ignored-directories. diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 0ef1777d16..925a7d50d6 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -2856,11 +2856,11 @@ REGEXP should use constructs supported by your local `grep' command." (interactive "sSearch marked files (regexp): ") (require 'grep) (defvar grep-find-ignored-files) - (defvar grep-find-ignored-directories) + (declare-function rgrep-find-ignored-directories "grep" (dir)) (let* ((files (dired-get-marked-files nil nil nil nil t)) (ignores (nconc (mapcar (lambda (s) (concat s "/")) - grep-find-ignored-directories) + (rgrep-find-ignored-directories default-directory)) grep-find-ignored-files)) (xrefs (mapcan (lambda (file) commit 848f0f73e98dfa8f32ffbcf7c2e0ea37ce123959 Author: Paul Eggert Date: Sun Jul 8 10:51:00 2018 -0700 Fix floating point exceptions on Alpha (Bug#32086) Backport from master. * admin/merge-gnulib (GNULIB_MODULES): Add fpieee. * m4/fpieee.m4: New file, copied from Gnulib. * m4/gnulib-comp.m4: Regenerate. diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 42edfbbd36..b23adc26fb 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -33,7 +33,7 @@ GNULIB_MODULES=' d-type diffseq dtoastr dtotimespec dup2 environ execinfo explicit_bzero faccessat fcntl fcntl-h fdatasync fdopendir - filemode filevercmp flexmember fstatat fsync + filemode filevercmp flexmember fpieee fstatat fsync getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog ignore-value intprops largefile lstat manywarnings memrchr minmax mkostemp mktime nstrftime diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 71c01e3e2a..e69ae45bb5 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -21,7 +21,7 @@ # the same distribution terms as the rest of that program. # # Generated by gnulib-tool. -# Reproduce by: gnulib-tool --import --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=close --avoid=dup --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=setenv --avoid=sigprocmask --avoid=stat --avoid=stdarg --avoid=stdbool --avoid=threadlib --avoid=tzset --avoid=unsetenv --avoid=utime --avoid=utime-h --gnu-make --makefile-name=gnulib.mk.in --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt binary-io byteswap c-ctype c-strcase careadlinkat close-stream count-leading-zeros count-one-bits count-trailing-zeros crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 d-type diffseq dtoastr dtotimespec dup2 environ execinfo explicit_bzero faccessat fcntl fcntl-h fdatasync fdopendir filemode filevercmp flexmember fstatat fsync getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog ignore-value intprops largefile lstat manywarnings memrchr minmax mkostemp mktime nstrftime pipe2 pselect pthread_sigmask putenv qcopy-acl readlink readlinkat sig2str socklen stat-time std-gnu11 stdalign stddef stdio stpcpy strtoimax symlink sys_stat sys_time tempname time time_r time_rz timegm timer-time timespec-add timespec-sub unlocked-io update-copyright utimens vla warnings +# Reproduce by: gnulib-tool --import --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=close --avoid=dup --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=setenv --avoid=sigprocmask --avoid=stat --avoid=stdarg --avoid=stdbool --avoid=threadlib --avoid=tzset --avoid=unsetenv --avoid=utime --avoid=utime-h --gnu-make --makefile-name=gnulib.mk.in --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt binary-io byteswap c-ctype c-strcase careadlinkat close-stream count-leading-zeros count-one-bits count-trailing-zeros crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 d-type diffseq dtoastr dtotimespec dup2 environ execinfo explicit_bzero faccessat fcntl fcntl-h fdatasync fdopendir filemode filevercmp flexmember fpieee fstatat fsync getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog ignore-value intprops largefile lstat manywarnings memrchr minmax mkostemp mktime nstrftime pipe2 pselect pthread_sigmask putenv qcopy-acl readlink readlinkat sig2str socklen stat-time std-gnu11 stdalign stddef stdio stpcpy strtoimax symlink sys_stat sys_time tempname time time_r time_rz timegm timer-time timespec-add timespec-sub unlocked-io update-copyright utimens vla warnings MOSTLYCLEANFILES += core *.stackdump diff --git a/m4/fpieee.m4 b/m4/fpieee.m4 new file mode 100644 index 0000000000..b58840f789 --- /dev/null +++ b/m4/fpieee.m4 @@ -0,0 +1,54 @@ +# fpieee.m4 serial 2 -*- coding: utf-8 -*- +dnl Copyright (C) 2007, 2009-2018 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +dnl IEEE 754 standardized three items: +dnl - The formats of single-float and double-float - nowadays commonly +dnl available as 'float' and 'double' in C and C++. +dnl No autoconf test needed. +dnl - The overflow and division by zero behaviour: The result are values +dnl '±Inf' and 'NaN', rather than exceptions as it was before. +dnl This file provides an autoconf macro for ensuring this behaviour of +dnl floating-point operations. +dnl - A set of conditions (overflow, underflow, inexact, etc.) which can +dnl be configured to trigger an exception. +dnl This cannot be done in a portable way: it depends on the compiler, +dnl libc, kernel, and CPU. No autoconf macro is provided for this. + +dnl Ensure non-trapping behaviour of floating-point overflow and +dnl floating-point division by zero. +dnl (For integer overflow, see gcc's -ftrapv option; for integer division by +dnl zero, see the autoconf macro in intdiv0.m4.) + +AC_DEFUN([gl_FP_IEEE], +[ + AC_REQUIRE([AC_PROG_CC]) + AC_REQUIRE([AC_CANONICAL_HOST]) + # IEEE behaviour is the default on all CPUs except Alpha and SH + # (according to the test results of Bruno Haible's ieeefp/fenv_default.m4 + # and the GCC 4.1.2 manual). + case "$host_cpu" in + alpha*) + # On Alpha systems, a compiler option provides the behaviour. + # See the ieee(3) manual page, also available at + # + if test -n "$GCC"; then + # GCC has the option -mieee. + # For full IEEE compliance (rarely needed), use option -mieee-with-inexact. + CPPFLAGS="$CPPFLAGS -mieee" + else + # Compaq (ex-DEC) C has the option -ieee, equivalent to -ieee_with_no_inexact. + # For full IEEE compliance (rarely needed), use option -ieee_with_inexact. + CPPFLAGS="$CPPFLAGS -ieee" + fi + ;; + sh*) + if test -n "$GCC"; then + # GCC has the option -mieee. + CPPFLAGS="$CPPFLAGS -mieee" + fi + ;; + esac +]) diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 167356faed..e30ff1f828 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -86,6 +86,8 @@ AC_DEFUN([gl_EARLY], # Code from module filevercmp: # Code from module flexmember: # Code from module fpending: + # Code from module fpieee: + AC_REQUIRE([gl_FP_IEEE]) # Code from module fstatat: # Code from module fsync: # Code from module getdtablesize: @@ -994,6 +996,7 @@ AC_DEFUN([gl_FILE_LIST], [ m4/filemode.m4 m4/flexmember.m4 m4/fpending.m4 + m4/fpieee.m4 m4/fstatat.m4 m4/fsync.m4 m4/getdtablesize.m4 commit 9d09ced1d5d124893fbe9c176f821f6716e91392 Author: Paul Eggert Date: Sun Jul 8 10:00:17 2018 -0700 Fix etc/HELLO searching in grep.el * lisp/progmodes/grep.el (grep-compute-defaults): Search for "^Copyright", not "^English", as the latter is no longer present in etc/HELLO and the former is more likely to survive future changes to etc/HELLO (Bug#32093). diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index b7c44d6083..519b768ab4 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -632,22 +632,22 @@ This function is called from `compilation-filter-hook'." ;; `grep-command' is already set, so ;; use that for testing. (grep-probe grep-command - `(nil t nil "^English" ,hello-file) + `(nil t nil "^Copyright" ,hello-file) #'call-process-shell-command) ;; otherwise use `grep-program' (grep-probe grep-program - `(nil t nil "-nH" "^English" ,hello-file))) + `(nil t nil "-nH" "^Copyright" ,hello-file))) (progn (goto-char (point-min)) (looking-at (concat (regexp-quote hello-file) - ":[0-9]+:English"))))))))) + ":[0-9]+:Copyright"))))))))) (when (eq grep-use-null-filename-separator 'auto-detect) (setq grep-use-null-filename-separator (with-temp-buffer (let* ((hello-file (expand-file-name "HELLO" data-directory)) - (args `("--null" "-ne" "^English" ,hello-file))) + (args `("--null" "-ne" "^Copyright" ,hello-file))) (if grep-use-null-device (setq args (append args (list null-device))) (push "-H" args)) @@ -656,7 +656,7 @@ This function is called from `compilation-filter-hook'." (goto-char (point-min)) (looking-at (concat (regexp-quote hello-file) - "\0[0-9]+:English")))))))) + "\0[0-9]+:Copyright")))))))) (when (eq grep-highlight-matches 'auto-detect) (setq grep-highlight-matches commit 0c3e283c76e88ad35d9734a3657a75072047b628 Author: Paul Eggert Date: Sun Jul 8 09:24:10 2018 -0700 Fix floating point exceptions on Alpha (Bug#32086) * admin/merge-gnulib (GNULIB_MODULES): Add fpieee. * m4/fpieee.m4: New file, copied from Gnulib. * m4/gnulib-comp.m4: Regenerate. diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 9a5ad545d1..39dfaee8f4 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -33,7 +33,7 @@ GNULIB_MODULES=' d-type diffseq dtoastr dtotimespec dup2 environ execinfo explicit_bzero faccessat fcntl fcntl-h fdatasync fdopendir - filemode filevercmp flexmember fstatat fsusage fsync + filemode filevercmp flexmember fpieee fstatat fsusage fsync getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog ignore-value intprops largefile lstat manywarnings memrchr minmax mkostemp mktime nstrftime diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 220f504274..3e917387d0 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -20,7 +20,7 @@ # the same distribution terms as the rest of that program. # # Generated by gnulib-tool. -# Reproduce by: gnulib-tool --import --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=close --avoid=dup --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=setenv --avoid=sigprocmask --avoid=stat --avoid=stdarg --avoid=stdbool --avoid=threadlib --avoid=tzset --avoid=unsetenv --avoid=utime --avoid=utime-h --gnu-make --makefile-name=gnulib.mk.in --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt binary-io byteswap c-ctype c-strcase careadlinkat close-stream count-leading-zeros count-one-bits count-trailing-zeros crypto/md5-buffer crypto/sha1-buffer crypto/sha256-buffer crypto/sha512-buffer d-type diffseq dtoastr dtotimespec dup2 environ execinfo explicit_bzero faccessat fcntl fcntl-h fdatasync fdopendir filemode filevercmp flexmember fstatat fsusage fsync getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog ignore-value intprops largefile lstat manywarnings memrchr minmax mkostemp mktime nstrftime pipe2 pselect pthread_sigmask putenv qcopy-acl readlink readlinkat sig2str socklen stat-time std-gnu11 stdalign stddef stdio stpcpy strtoimax symlink sys_stat sys_time tempname time time_r time_rz timegm timer-time timespec-add timespec-sub unlocked-io update-copyright utimens vla warnings +# Reproduce by: gnulib-tool --import --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=close --avoid=dup --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=setenv --avoid=sigprocmask --avoid=stat --avoid=stdarg --avoid=stdbool --avoid=threadlib --avoid=tzset --avoid=unsetenv --avoid=utime --avoid=utime-h --gnu-make --makefile-name=gnulib.mk.in --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt binary-io byteswap c-ctype c-strcase careadlinkat close-stream count-leading-zeros count-one-bits count-trailing-zeros crypto/md5-buffer crypto/sha1-buffer crypto/sha256-buffer crypto/sha512-buffer d-type diffseq dtoastr dtotimespec dup2 environ execinfo explicit_bzero faccessat fcntl fcntl-h fdatasync fdopendir filemode filevercmp flexmember fpieee fstatat fsusage fsync getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog ignore-value intprops largefile lstat manywarnings memrchr minmax mkostemp mktime nstrftime pipe2 pselect pthread_sigmask putenv qcopy-acl readlink readlinkat sig2str socklen stat-time std-gnu11 stdalign stddef stdio stpcpy strtoimax symlink sys_stat sys_time tempname time time_r time_rz timegm timer-time timespec-add timespec-sub unlocked-io update-copyright utimens vla warnings MOSTLYCLEANFILES += core *.stackdump diff --git a/m4/fpieee.m4 b/m4/fpieee.m4 new file mode 100644 index 0000000000..b58840f789 --- /dev/null +++ b/m4/fpieee.m4 @@ -0,0 +1,54 @@ +# fpieee.m4 serial 2 -*- coding: utf-8 -*- +dnl Copyright (C) 2007, 2009-2018 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +dnl IEEE 754 standardized three items: +dnl - The formats of single-float and double-float - nowadays commonly +dnl available as 'float' and 'double' in C and C++. +dnl No autoconf test needed. +dnl - The overflow and division by zero behaviour: The result are values +dnl '±Inf' and 'NaN', rather than exceptions as it was before. +dnl This file provides an autoconf macro for ensuring this behaviour of +dnl floating-point operations. +dnl - A set of conditions (overflow, underflow, inexact, etc.) which can +dnl be configured to trigger an exception. +dnl This cannot be done in a portable way: it depends on the compiler, +dnl libc, kernel, and CPU. No autoconf macro is provided for this. + +dnl Ensure non-trapping behaviour of floating-point overflow and +dnl floating-point division by zero. +dnl (For integer overflow, see gcc's -ftrapv option; for integer division by +dnl zero, see the autoconf macro in intdiv0.m4.) + +AC_DEFUN([gl_FP_IEEE], +[ + AC_REQUIRE([AC_PROG_CC]) + AC_REQUIRE([AC_CANONICAL_HOST]) + # IEEE behaviour is the default on all CPUs except Alpha and SH + # (according to the test results of Bruno Haible's ieeefp/fenv_default.m4 + # and the GCC 4.1.2 manual). + case "$host_cpu" in + alpha*) + # On Alpha systems, a compiler option provides the behaviour. + # See the ieee(3) manual page, also available at + # + if test -n "$GCC"; then + # GCC has the option -mieee. + # For full IEEE compliance (rarely needed), use option -mieee-with-inexact. + CPPFLAGS="$CPPFLAGS -mieee" + else + # Compaq (ex-DEC) C has the option -ieee, equivalent to -ieee_with_no_inexact. + # For full IEEE compliance (rarely needed), use option -ieee_with_inexact. + CPPFLAGS="$CPPFLAGS -ieee" + fi + ;; + sh*) + if test -n "$GCC"; then + # GCC has the option -mieee. + CPPFLAGS="$CPPFLAGS -mieee" + fi + ;; + esac +]) diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 5c78f5a809..a6e3be3815 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -86,6 +86,8 @@ AC_DEFUN([gl_EARLY], # Code from module filevercmp: # Code from module flexmember: # Code from module fpending: + # Code from module fpieee: + AC_REQUIRE([gl_FP_IEEE]) # Code from module fstatat: # Code from module fsusage: # Code from module fsync: @@ -1002,6 +1004,7 @@ AC_DEFUN([gl_FILE_LIST], [ m4/filemode.m4 m4/flexmember.m4 m4/fpending.m4 + m4/fpieee.m4 m4/fstatat.m4 m4/fsusage.m4 m4/fsync.m4 commit 65889a6d127fcbbbdc1e74d26036e91bd24d1405 Author: Paul Eggert Date: Sun Jul 8 09:04:02 2018 -0700 Fix bootstrap infloop in GNU/Linux alpha * src/emacs.c (main): Do not re-exec if EMACS_HEAP_EXEC is already set (Bug#32083). diff --git a/src/emacs.c b/src/emacs.c index 017c62308c..f5e47428ef 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -707,10 +707,12 @@ main (int argc, char **argv) bool disable_aslr = dumping; # endif - if (disable_aslr && disable_address_randomization ()) + if (disable_aslr && disable_address_randomization () + && !getenv ("EMACS_HEAP_EXEC")) { /* Set this so the personality will be reverted before execs - after this one. */ + after this one, and to work around an re-exec loop on buggy + kernels (Bug#32083). */ xputenv ("EMACS_HEAP_EXEC=true"); /* Address randomization was enabled, but is now disabled. commit 48efd1c98b3d4714860e4bf355c6af57c6cee827 Author: Eli Zaretskii Date: Sun Jul 8 18:22:51 2018 +0300 Minor fix of a recent documentation change * lisp/net/gnutls.el (gnutls-algorithm-priority): Clarify the doc string. diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el index 4cc1f5f4c3..35fe680592 100644 --- a/lisp/net/gnutls.el +++ b/lisp/net/gnutls.el @@ -50,9 +50,11 @@ set this variable to \"normal:-dhe-rsa\". This variable can be useful for modifying low-level TLS connection parameters (for instance if you need to connect to a -host that only accepts a specific algorithm), but general Emacs -network security is handled by the Network Security Manager. See -Info node `(emacs) Network Security'." +host that only accepts a specific algorithm). However, in +general, Emacs network security is handled by the Network +Security Manager (NSM), and the default value of nil delegates +the job of checking the connection security to the NSM. +See Info node `(emacs) Network Security'." :group 'gnutls :type '(choice (const nil) string)) commit 9c985a3d7a84bdfad17e11a12f671605bb31b3be Author: Eli Zaretskii Date: Sun Jul 8 17:46:32 2018 +0300 Minor improvements in recent NSM documentation changes * doc/emacs/misc.texi (Network Security): Improve wording and markup of last change. * src/gnutls.c (Fgnutls_peer_status): Doc fix. * etc/NEWS: Improve wording of last change. diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 9665138196..3d3441401d 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -315,26 +315,27 @@ unverified connection, a temporary exception, or refuse the connection entirely. @vindex network-security-protocol-checks -In addition to the basic certificate corrections checks, -several @acronym{TLS} algorithm checks are available. Some encryption +In addition to the basic certificate correctness checks, several +@acronym{TLS} algorithm checks are available. Some encryption technologies that were previously thought to be secure have shown -themselves to be fragile, and Emacs will (by default) warn the users -about some of these problems. +themselves to be fragile, so Emacs (by default) warns you about some +of these problems. The protocol network checks is controlled via the @code{network-security-protocol-checks} variable. -It's an alist where the first element is the name of the check, -the second is the security level where the check kicks in, and the -optional third element is a parameter supplied to the check. +It's an alist where the first element of each association is the name +of the check, the second element is the security level where the check +should be used, and the optional third element is a parameter supplied +to the check. An element like @code{(rc4 medium)} will result in the function @code{nsm-protocol-check--rc4} being called like thus: -@code{(nsm-protocol-check--rc4 host port status optional-parameter)}. +@w{@code{(nsm-protocol-check--rc4 host port status optional-parameter)}}. The function should return non-@code{nil} if the connection should proceed and @code{nil} otherwise. -Below is a list of the checks done on the @code{medium} level. +Below is a list of the checks done on the default @code{medium} level. @table @asis @@ -374,8 +375,8 @@ connection to be encrypted. If the connection isn't encrypted, @item Diffie-Hellman low prime bits When doing the public key exchange, the number of prime bits should be -high to ensure that the channel can't be eavesdropped on by third -parties. If this number is too low, you will be warned. (This is the +high enough to ensure that the channel can't be eavesdropped on by third +parties. If this number is too low, Emacs will warn you. (This is the @code{diffie-hellman-prime-bits} check in @code{network-security-protocol-checks}). diff --git a/etc/NEWS b/etc/NEWS index 8883066237..dae028be7b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -136,12 +136,15 @@ of what checks to run via the `network-security-protocol-checks' variable. +++ -** Most of the checks for outdated, believed-to-be-weak TLS algorithms -and ciphers are now switched on by default. To get the old behaviour -back (where certificates are checked for validity, but no warnings -about weak cryptography are issued), you can either set -`network-security-protocol-checks' to nil, or adjust the elements in -that variable to only happen on the `high' security level. +** TLS connections have their security tightened by default. +Most of the checks for outdated, believed-to-be-weak TLS algorithms +and ciphers are now switched on by default. By default, the NSM will +flag connections using these weak algorithms and ask users whether to +allow them. To get the old behavior back (where certificates are +checked for validity, but no warnings about weak cryptography are +issued), you can either set 'network-security-protocol-checks' to nil, +or adjust the elements in that variable to only happen on the 'high' +security level (assuming you use the 'medium' level). +++ ** New function 'fill-polish-nobreak-p', to be used in 'fill-nobreak-predicate'. diff --git a/src/gnutls.c b/src/gnutls.c index dfbbecfc87..d7a4ee474f 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -1217,7 +1217,7 @@ The return value is a property list with top-level keys :warnings and The :warnings entry is a list of symbols you can get a description of with `gnutls-peer-status-warning-describe', and :certificates is the certificate chain for the connection, with the host certificate -first, and intermediary certificates (if any) follow. +first, and intermediary certificates (if any) following it. In addition, for backwards compatibility, the host certificate is also returned as the :certificate entry. */) commit c6de1f1592745d98e58f06332ad35efc72160787 Author: Lars Ingebrigtsen Date: Sun Jul 8 16:14:06 2018 +0200 Fix typo in sha1-intermediate check * lisp/net/nsm.el (nsm-protocol-check--intermediate-sha1): Allow storing the exception with a correct name. diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el index 0653cfbb1a..dab9003e02 100644 --- a/lisp/net/nsm.el +++ b/lisp/net/nsm.el @@ -265,7 +265,7 @@ HOST PORT STATUS OPTIONAL-PARAMETER.") (plist-get certificate :subject))) (string-match "\\bSHA1\\b" algo) (not (nsm-query - host port status :signature-sha1 + host port status :intermediate-sha1 "An intermediate certificate used to verify the connection to %s:%s uses the SHA1 algorithm (%s), which is believed to be unsafe." host port algo))) do (cl-return nil) commit 3302b7cd7f0afe9144cec2343902488fbe02d415 Author: Lars Ingebrigtsen Date: Sun Jun 24 14:48:30 2018 +0200 Mention the NSM in the gnutls variable doc strings * gnutls.el (gnutls-algorithm-priority): Mention the Network Security Manager here since this variable is an obvious place for people concerned about network security to look. (gnutls-verify-error): Ditto. (gnutls-min-prime-bits): Ditto. diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el index 85c9308c0d..4cc1f5f4c3 100644 --- a/lisp/net/gnutls.el +++ b/lisp/net/gnutls.el @@ -46,7 +46,13 @@ (defcustom gnutls-algorithm-priority nil "If non-nil, this should be a TLS priority string. For instance, if you want to skip the \"dhe-rsa\" algorithm, -set this variable to \"normal:-dhe-rsa\"." +set this variable to \"normal:-dhe-rsa\". + +This variable can be useful for modifying low-level TLS +connection parameters (for instance if you need to connect to a +host that only accepts a specific algorithm), but general Emacs +network security is handled by the Network Security Manager. See +Info node `(emacs) Network Security'." :group 'gnutls :type '(choice (const nil) string)) @@ -72,7 +78,13 @@ corresponding conditions to be tested are: If the condition test fails, an error will be signaled. If the value of this variable is t, every connection will be subjected -to all of the tests described above." +to all of the tests described above. + +The default value of this variable is nil, which means that no +checks are performed at the gnutls level. Instead the checks are +performed via `open-network-stream' at a higher level by the +Network Security Manager. See Info node `(emacs) Network +Security'." :group 'gnutls :version "24.4" :type '(choice @@ -111,7 +123,14 @@ number with fewer than this number of bits, the handshake is rejected. \(The smaller the prime number, the less secure the key exchange is against man-in-the-middle attacks.) -A value of nil says to use the default GnuTLS value." +A value of nil says to use the default GnuTLS value. + +The default value of this variable is such that virtually any +connection can be established, whether this connection can be +considered cryptographically \"safe\" or not. However, Emacs +network security is handled at a higher level via +`open-network-stream' and the Network Security Manager. See Info +node `(emacs) Network Security'." :type '(choice (const :tag "Use default value" nil) (integer :tag "Number of bits" 512)) :group 'gnutls) commit 1dc4d0909349121699bf5c623004c0edb481e9b6 Author: Lars Ingebrigtsen Date: Sun Jul 8 13:40:37 2018 +0200 Document network-security-protocol-checks better * doc/emacs/misc.texi (Network Security): Rearrange the network-security-protocol-checks documentation and try to explain more what this all means and what checks are triggered. diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 692f1fd650..9665138196 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -314,6 +314,26 @@ You can decide to register a permanent security exception for an unverified connection, a temporary exception, or refuse the connection entirely. +@vindex network-security-protocol-checks +In addition to the basic certificate corrections checks, +several @acronym{TLS} algorithm checks are available. Some encryption +technologies that were previously thought to be secure have shown +themselves to be fragile, and Emacs will (by default) warn the users +about some of these problems. + +The protocol network checks is controlled via the +@code{network-security-protocol-checks} variable. + +It's an alist where the first element is the name of the check, +the second is the security level where the check kicks in, and the +optional third element is a parameter supplied to the check. + +An element like @code{(rc4 medium)} will result in the function +@code{nsm-protocol-check--rc4} being called like thus: +@code{(nsm-protocol-check--rc4 host port status optional-parameter)}. +The function should return non-@code{nil} if the connection should +proceed and @code{nil} otherwise. + Below is a list of the checks done on the @code{medium} level. @table @asis @@ -353,24 +373,30 @@ connection to be encrypted. If the connection isn't encrypted, @acronym{NSM} will warn you. @item Diffie-Hellman low prime bits -When doing the public key exchange, the number of prime bits -should be high to ensure that the channel can't be eavesdropped on by -third parties. If this number is too low, you will be warned. +When doing the public key exchange, the number of prime bits should be +high to ensure that the channel can't be eavesdropped on by third +parties. If this number is too low, you will be warned. (This is the +@code{diffie-hellman-prime-bits} check in +@code{network-security-protocol-checks}). @item @acronym{RC4} stream cipher The @acronym{RC4} stream cipher is believed to be of low quality and -may allow eavesdropping by third parties. +may allow eavesdropping by third parties. (This is the @code{rc4} +check in @code{network-security-protocol-checks}). @item @acronym{SHA1} in the host certificate or in intermediate certificates -It is believed that if an intermediate certificate uses -the @acronym{SHA1} hashing algorithm, then third parties can issue +It is believed that if an intermediate certificate uses the +@acronym{SHA1} hashing algorithm, then third parties can issue certificates pretending to be that issuing instance. These connections are therefore vulnerable to man-in-the-middle attacks. +(These are the @code{signature-sha1} and @code{intermediate-sha1} +checks in @code{network-security-protocol-checks}). @item @acronym{SSL1}, @acronym{SSL2} and @acronym{SSL3} The protocols older than @acronym{TLS1.0} are believed to be vulnerable to a variety of attacks, and you may want to avoid using -these if what you're doing requires higher security. +these if what you're doing requires higher security. (This is the +@code{ssl} check in @code{network-security-protocol-checks}). @end table @@ -381,6 +407,8 @@ will be made, in addition to the above: @item @acronym{3DES} cipher The @acronym{3DES} stream cipher provides at most 112 bits of effective security, which is considered to be towards the low end. +(This is the @code{3des} check in +@code{network-security-protocol-checks}). @item a validated certificate changes the public key Servers change their keys occasionally, and that is normally nothing @@ -414,21 +442,6 @@ servers the user has connected to. If this variable is @code{t}, @acronym{NSM} will also save host names in the @code{nsm-settings-file}. -@item network-security-protocol-checks -@vindex network-security-protocol-checks -The protocol network checks (mostly for @acronym{TLS} weaknesses) is -controlled via the @code{network-security-protocol-checks} variable. - -It's an alist where the first element is the name of the check, -the second is the security level where the check kicks in, and the -optional third element is a parameter supplied to the check. - -An element like @code{(rc4 medium)} will result in the function -@code{nsm-protocol-check--rc4} being called like thus: -@code{(nsm-protocol-check--rc4 host port status optional-parameter)}. -The function should return non-@code{nil} if the connection should -proceed and @code{nil} otherwise. - @end table commit f9649f0e147815ddd78073c52cd0e2ad9f33c4e4 Author: Lars Ingebrigtsen Date: Sun Jul 8 13:30:08 2018 +0200 NSM-related doc fixes * src/gnutls.c (Fgnutls_peer_status): Mention :certificates in the doc string. * etc/NEWS: Mention how to switch off the additional TLS checks. diff --git a/etc/NEWS b/etc/NEWS index 375f040054..8883066237 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -137,7 +137,11 @@ variable. +++ ** Most of the checks for outdated, believed-to-be-weak TLS algorithms -and ciphers are now switched on by default. +and ciphers are now switched on by default. To get the old behaviour +back (where certificates are checked for validity, but no warnings +about weak cryptography are issued), you can either set +`network-security-protocol-checks' to nil, or adjust the elements in +that variable to only happen on the `high' security level. +++ ** New function 'fill-polish-nobreak-p', to be used in 'fill-nobreak-predicate'. diff --git a/src/gnutls.c b/src/gnutls.c index d22d5d267c..dfbbecfc87 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -1210,9 +1210,17 @@ DEFUN ("gnutls-peer-status-warning-describe", Fgnutls_peer_status_warning_descri DEFUN ("gnutls-peer-status", Fgnutls_peer_status, Sgnutls_peer_status, 1, 1, 0, doc: /* Describe a GnuTLS PROC peer certificate and any warnings about it. + The return value is a property list with top-level keys :warnings and -:certificate. The :warnings entry is a list of symbols you can describe with -`gnutls-peer-status-warning-describe'. */) +:certificates. + +The :warnings entry is a list of symbols you can get a description of +with `gnutls-peer-status-warning-describe', and :certificates is the +certificate chain for the connection, with the host certificate +first, and intermediary certificates (if any) follow. + +In addition, for backwards compatibility, the host certificate is also +returned as the :certificate entry. */) (Lisp_Object proc) { Lisp_Object warnings = Qnil, result = Qnil; commit 40c2ce743b38197e416e4578cd3fd198a1b06ff5 Author: Michael Albinus Date: Sun Jul 8 13:08:05 2018 +0200 Remove test code from last commit diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el index 8fcb8a564b..1ada2552b8 100644 --- a/test/lisp/net/dbus-tests.el +++ b/test/lisp/net/dbus-tests.el @@ -133,8 +133,7 @@ This includes initialization and closing the bus." ;; Start bus. (let ((output (ignore-errors - (shell-command-to-string - "env DISPLAY= dbus-launch --sh-syntax --close-stderr"))) + (shell-command-to-string "env DISPLAY= dbus-launch --sh-syntax"))) bus pid) (skip-unless (stringp output)) (when (string-match "DBUS_SESSION_BUS_ADDRESS='\\(.+\\)';" output) commit e02d8e29c6009dbaf04d3e1668f476ba000c7f02 Author: Michael Albinus Date: Sun Jul 8 13:02:19 2018 +0200 Fix Bug#32084 * test/lisp/net/dbus-tests.el (dbus-test02-register-service-own-bus): Unset $DISPLAY when calling dbus-launch, in order to avoid possible X11 authentication errors. (Bug#32084) diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el index 624d15ef5f..8fcb8a564b 100644 --- a/test/lisp/net/dbus-tests.el +++ b/test/lisp/net/dbus-tests.el @@ -133,7 +133,8 @@ This includes initialization and closing the bus." ;; Start bus. (let ((output (ignore-errors - (shell-command-to-string "dbus-launch --sh-syntax"))) + (shell-command-to-string + "env DISPLAY= dbus-launch --sh-syntax --close-stderr"))) bus pid) (skip-unless (stringp output)) (when (string-match "DBUS_SESSION_BUS_ADDRESS='\\(.+\\)';" output) commit da5d6dbe3974a8012d4fb6a0281d583965742aaa Author: Basil L. Contovounesios Date: Sat Jul 7 19:33:08 2018 +0300 Fix (length NON-SEQUENCE) documentation Suggested by Eli Zaretskii in the following threads: https://lists.gnu.org/archive/html/emacs-devel/2018-07/msg00171.html https://lists.gnu.org/archive/html/emacs-devel/2018-07/msg00206.html * doc/lispref/sequences.texi (Sequence Functions): Mention that 'length' signals a 'wrong-type-argument' also when given a non-sequencep argument. diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 59faf2b4f1..188a345114 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -71,13 +71,15 @@ string, bool-vector, or char-table, @code{nil} otherwise. @cindex list length @cindex vector length @cindex sequence length +@cindex bool-vector length @cindex char-table length @anchor{Definition of length} -This function returns the number of elements in @var{sequence}. If -@var{sequence} is a dotted list, a @code{wrong-type-argument} error is -signaled; if it is a circular list, a @code{circular-list} error is -signaled. For a char-table, the value returned is always one more -than the maximum Emacs character code. +This function returns the number of elements in @var{sequence}. The +function signals the @code{wrong-type-argument} error if the argument +is not a sequence or is a dotted list; it signals the +@code{circular-list} error if the argument is a circular list. For a +char-table, the value returned is always one more than the maximum +Emacs character code. @xref{Definition of safe-length}, for the related function @code{safe-length}. commit 98463bed07ecc9057094928ffdc2321eaaf3ab52 Author: Glenn Morris Date: Sat Jul 7 09:59:53 2018 -0700 * lisp/imenu.el: Require cl-lib, not internal components of same. diff --git a/lisp/imenu.el b/lisp/imenu.el index c0103dbc4c..edca51e3ad 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -59,8 +59,7 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) -(require 'cl-seq) +(require 'cl-lib) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; commit e8c8b5923a2be4e77aaac5d48e97a28d0c066697 Author: Glenn Morris Date: Sat Jul 7 12:34:16 2018 -0400 * admin/make-tarball.txt, admin/release-process: Refcard tweaks. diff --git a/admin/make-tarball.txt b/admin/make-tarball.txt index 28e369f61d..47b60173f8 100644 --- a/admin/make-tarball.txt +++ b/admin/make-tarball.txt @@ -87,9 +87,9 @@ General steps (for each step, check for possible errors): make -C etc/refcards make -C etc/refcards clean - If etc/refcards does not build you may need to downgrade or - upgrade your TeX installation, or do that part of the build by - hand. For clues, search for the string "refcard" in the file + If some of the non-English etc/refcards fail to build, you + probably need to install some TeX foreign language packages. + For more information, search for the string "refcard" in the file admin/release-process. 5. Copy lisp/loaddefs.el to lisp/ldefs-boot.el. diff --git a/admin/release-process b/admin/release-process index 71ada82356..504b70270f 100644 --- a/admin/release-process +++ b/admin/release-process @@ -166,9 +166,9 @@ emacs.pdf' (e.g., enable "smallbook"). What paper size are the English versions supposed to be on? On Debian testing, the packages texlive-lang-czechslovak and texlive-lang-polish will let you generate the cs-* and sk-* pdfs. -(You may need texlive-lang-cyrillic, texlive-lang-german for others.) -The Makefile rules did not work for me, I had to use something like: -csplain -output-format=pdf cs-refcard +(You may need texlive-lang-cyrillic, texlive-lang-german, +and texlive-fonts-extra for others.) On Fedora-like systems, +texlive-lh may help. ** Ask maintainers of refcard translations to update them. commit d3e0fdc24f85de3b33de007b8e1ca24560559d9b Merge: 77166e0da2 a427de9c86 Author: Glenn Morris Date: Sat Jul 7 09:27:44 2018 -0700 Merge from origin/emacs-26 a427de9 (origin/emacs-26) Fix bug #11732 3a04e15 Improve documentation of 'emacs-lock-mode' 9d6ca5a * lisp/imenu.el (imenu-generic-expression): Doc fix. (Bug#32... fdd7e7d Improve indexing of 'eval-defun' in ELisp manual 10af989 Fix (length CIRCULAR) documentation 271d1f7 Tramp editorials 4abf94f Clarify and improve doc strings of 'eval-last-sexp' and friends 6cfc7a7 Automate upload of Emacs manuals to gnu.org b73cde5 Fix MH-E mail composition with GNU Mailutils (SF#485) 0dce5e5 Speed up 'replace-buffer-contents' some more 00fdce0 * doc/emacs/docstyle.texi: Avoid messing up the html output. Conflicts: admin/make-tarball.txt commit 77166e0da2d58f2f6436989b7059d913be5b3439 Author: Drew Adams Date: Sat Jul 7 19:20:45 2018 +0300 Fix 2 minor bugs in 'imenu--generic-function' * lisp/imenu.el (imenu--generic-function): Move point to START before checking whether the current item is inside a comment or a string. Remove any empty menus that could have been added before returning. (Bug#32024) diff --git a/lisp/imenu.el b/lisp/imenu.el index 94ee6bc83a..7d4363993d 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -60,6 +60,7 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) +(require 'cl-seq) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -819,7 +820,8 @@ depending on PATTERNS." ;; Insert the item unless it is already present. (unless (or (member item (cdr menu)) (and imenu-generic-skip-comments-and-strings - (nth 8 (syntax-ppss)))) + (save-excursion + (goto-char start) (nth 8 (syntax-ppss))))) (setcdr menu (cons item (cdr menu))))) ;; Go to the start of the match, to make sure we @@ -833,7 +835,13 @@ depending on PATTERNS." (setcdr item (sort (cdr item) 'imenu--sort-by-position)))) (let ((main-element (assq nil index-alist))) (nconc (delq main-element (delq 'dummy index-alist)) - (cdr main-element))))) + (cdr main-element))) + ;; Remove any empty menus. That can happen because of skipping + ;; things inside comments or strings. + (when (consp (car index-alist)) + (setq index-alist (cl-delete-if-not + (lambda (it) (cdr it)) + index-alist))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; commit a427de9c86ed31b1fd7599664b3fea0733e633ee Author: Eli Zaretskii Date: Sat Jul 7 14:30:00 2018 +0300 Fix bug #11732 * src/w32fns.c (w32_wnd_proc): Fix handling of Windows input methods. (Bug#11732) diff --git a/src/w32fns.c b/src/w32fns.c index 1b199bf54f..b673cd3161 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -4550,13 +4550,13 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) set_ime_composition_window_fn (context, &form); release_ime_context_fn (hwnd, context); } - /* We should "goto dflt" here to pass WM_IME_STARTCOMPOSITION to - DefWindowProc, so that the composition window will actually - be displayed. But doing so causes trouble with displaying - dialog boxes, such as the file selection dialog or font - selection dialog. So something else is needed to fix the - former without breaking the latter. See bug#11732. */ - break; + /* FIXME: somehow "goto dflt" here instead of "break" causes + popup dialogs, such as the ones shown by File->Open File and + w32-select-font, to become hidden behind their parent frame, + when focus-follows-mouse is in effect. See bug#11732. But + if we don't "goto dflt", users of IME cannot type text + supported by the input method... */ + goto dflt; case WM_IME_ENDCOMPOSITION: ignore_ime_char = 0; commit 3a04e151af310ff0a283b1f05315c09baf5d7acf Author: Eli Zaretskii Date: Sat Jul 7 12:50:22 2018 +0300 Improve documentation of 'emacs-lock-mode' * lisp/emacs-lock.el (emacs-lock-mode): Mention in the doc string the special handling of some major modes due to 'emacs-lock-unlockable-modes'. diff --git a/lisp/emacs-lock.el b/lisp/emacs-lock.el index 0a6fa9e625..1c13d0ef97 100644 --- a/lisp/emacs-lock.el +++ b/lisp/emacs-lock.el @@ -94,7 +94,10 @@ It can be one of the following values: exit -- Emacs cannot exit while the buffer is locked kill -- the buffer cannot be killed, but Emacs can exit as usual all -- the buffer is locked against both actions - nil -- the buffer is not locked") + nil -- the buffer is not locked + +See also `emacs-lock-unlockable-modes', which exempts buffers under +some major modes from being locked under some circumstances.") (put 'emacs-lock-mode 'permanent-local t) (defvar-local emacs-lock--old-mode nil @@ -204,7 +207,10 @@ When called from Elisp code, ARG can be any locking mode: kill -- the buffer cannot be killed, but Emacs can exit as usual all -- the buffer is locked against both actions -Other values are interpreted as usual." +Other values are interpreted as usual. + +See also `emacs-lock-unlockable-modes', which exempts buffers under +some major modes from being locked under some circumstances." :init-value nil :lighter ("" (emacs-lock--try-unlocking " locked:" " Locked:") commit 9d6ca5ad4de832a0e8095ed1acf74d6bc18eb358 Author: Eli Zaretskii Date: Sat Jul 7 12:34:26 2018 +0300 * lisp/imenu.el (imenu-generic-expression): Doc fix. (Bug#32016) diff --git a/lisp/imenu.el b/lisp/imenu.el index 8cf3c768ea..89114524eb 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -207,9 +207,9 @@ string (which specifies the title of a submenu into which the matches are put). REGEXP is a regular expression matching a definition construct which is to be displayed in the menu. REGEXP may also be a -function, called without arguments. It is expected to search -backwards. It must return true and set `match-data' if it finds -another element. +function of no arguments. If REGEXP is a function, it is +expected to search backwards, return non-nil if it finds a +definition construct, and set `match-data' for that construct. INDEX is an integer specifying which subexpression of REGEXP matches the definition's name; this subexpression is displayed as the menu item. commit ea2f96837d00f5475cd48fc7bf62c19d1045c055 Author: John Shahid Date: Sun Jul 1 14:48:24 2018 -0400 Keep interactive uses of 'recenter' backward compatible (Bug#31325) * window.c (Frecenter): Change the interactive spec to always pass a non-nil value to the REDISPLAY argument when called interactively. * window.el (recenter-top-bottom): Make sure 'recenter's second argument is non-nil everywhere. * windows.texi (Textual Scrolling): Update documentation of 'recenter'. diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index ae6837b444..3eaa15a603 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -4156,7 +4156,8 @@ window. If @var{count} is @code{nil} and @var{redisplay} is non-@code{nil}, this function may redraw the frame, according to the value of @code{recenter-redisplay}. Thus, omitting the second argument can be used to countermand the effect of -@code{recenter-redisplay} being non-@code{nil}. +@code{recenter-redisplay} being non-@code{nil}. Interactive calls +pass non-â€nil’ for @var{redisplay}. When @code{recenter} is called interactively, @var{count} is the raw prefix argument. Thus, typing @kbd{C-u} as the prefix sets the diff --git a/lisp/window.el b/lisp/window.el index 6d9d8bdcd2..d56bed63da 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -8767,7 +8767,7 @@ A prefix argument is handled like `recenter': With plain `C-u', move current line to window center." (interactive "P") (cond - (arg (recenter arg)) ; Always respect ARG. + (arg (recenter arg t)) ; Always respect ARG. (t (setq recenter-last-op (if (eq this-command last-command) diff --git a/src/window.c b/src/window.c index d3c72570dd..422b06a49f 100644 --- a/src/window.c +++ b/src/window.c @@ -5901,7 +5901,7 @@ displayed_window_lines (struct window *w) } -DEFUN ("recenter", Frecenter, Srecenter, 0, 2, "P", +DEFUN ("recenter", Frecenter, Srecenter, 0, 2, "P\np", doc: /* Center point in selected window and maybe redisplay frame. With a numeric prefix argument ARG, recenter putting point on screen line ARG relative to the selected window. If ARG is negative, it counts up from the @@ -5913,7 +5913,7 @@ non-nil, also erase the entire frame and redraw it (when `auto-resize-tool-bars' is set to `grow-only', this resets the tool-bar's height to the minimum height needed); if `recenter-redisplay' has the special value `tty', then only tty frames -are redrawn. +are redrawn. Interactively, REDISPLAY is always non-nil. Just C-u as prefix means put point in the center of the window and redisplay normally--don't erase and redraw the frame. */) commit 42c0b8f3f27c8700f1f432649f2466aab9127061 Author: Eli Zaretskii Date: Sat Jul 7 12:01:08 2018 +0300 Documentation followup for bug#32029 * etc/NEWS: Mention 'xref-find-definitions-at-mouse' * doc/emacs/maintaining.texi (Looking Up Identifiers): Document 'xref-find-definitions-at-mouse'. diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index df8c447900..024fd9728c 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -1813,6 +1813,8 @@ Find definitions of identifier, but display it in another window @item C-x 5 .@: @key{RET} Find definition of identifier, and display it in a new frame (@code{xref-find-definitions-other-frame}). +@item M-x xref-find-definitions-at-mouse +Find definition of identifier at mouse click. @item M-, Go back to where you previously invoked @kbd{M-.} and friends (@code{xref-pop-marker-stack}). @@ -1853,6 +1855,11 @@ former is @w{@kbd{C-x 4 .}} (@code{xref-find-definitions-other-window}), and the latter is @w{@kbd{C-x 5 .}} (@code{xref-find-definitions-other-frame}). + The command @code{xref-find-definitions-at-mouse} works like +@code{xref-find-definitions}, but it looks for the identifier name at +or around the place of a mouse event. This command is intended to be +bound to a mouse event, such as @kbd{C-M-mouse-1}, for example. + @findex xref-find-apropos @kindex C-M-. The command @kbd{C-M-.} (@code{xref-find-apropos}) finds the diff --git a/etc/NEWS b/etc/NEWS index c92ee6e680..375f040054 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -265,6 +265,13 @@ them to the 'browse-url' function, like the other protocols: ftp, http, and https. This allows to have references to local HTML files, for example. +** Xref + ++++ +*** New command 'xref-find-definitions-at-mouse'. +This command finds definitions of the identifier at the place of a +mouse click event, and is intended to be bound to a mouse event. + ** Ecomplete *** The ecomplete sorting has changed to a decay-based algorithm. commit 455a236d415d3ca9a25564cd3f295f5e5e0bb7b4 Author: Tobias Gerdin Date: Sat Jul 7 11:59:56 2018 +0300 New function 'xref-find-definitions-at-mouse' * lisp/progmodes/xref.el (xref-find-definitions-at-mouse): New function. (Bug32029) Copyright-paperwork-exempt: yes diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 9a437b6f69..7bd1668cf4 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -873,6 +873,19 @@ With prefix argument, prompt for the identifier." (interactive (list (xref--read-identifier "Find references of: "))) (xref--find-xrefs identifier 'references identifier nil)) +;;;###autoload +(defun xref-find-definitions-at-mouse (event) + "Find the definition of identifier at or around mouse click. +This command is intended to be bound to a mouse event." + (interactive "e") + (let ((identifier + (save-excursion + (mouse-set-point event) + (xref-backend-identifier-at-point (xref-find-backend))))) + (if identifier + (xref-find-definitions identifier) + (user-error "No identifier here")))) + (declare-function apropos-parse-pattern "apropos" (pattern)) ;;;###autoload commit fdd7e7d8a80f41336f048174d6d1929fb46d00a8 Author: Eli Zaretskii Date: Sat Jul 7 11:37:43 2018 +0300 Improve indexing of 'eval-defun' in ELisp manual * doc/lispref/display.texi (Defining Faces): * doc/lispref/debugging.texi (Explicit Debug): * doc/lispref/customize.texi (Variable Definitions): * doc/lispref/variables.texi (Defining Variables): Add index entries for 'eval-defun'. (Bug#32066) diff --git a/doc/lispref/customize.texi b/doc/lispref/customize.texi index 02fcd80fa3..b3528b12d5 100644 --- a/doc/lispref/customize.texi +++ b/doc/lispref/customize.texi @@ -321,6 +321,7 @@ If a @code{defcustom} does not specify any @code{:group}, the last group defined with @code{defgroup} in the same file will be used. This way, most @code{defcustom} do not need an explicit @code{:group}. +@cindex @code{eval-defun}, and @code{defcustom} forms When you evaluate a @code{defcustom} form with @kbd{C-M-x} in Emacs Lisp mode (@code{eval-defun}), a special feature of @code{eval-defun} arranges to set the variable unconditionally, without testing whether diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi index c08a382ef1..fdd92a3780 100644 --- a/doc/lispref/debugging.texi +++ b/doc/lispref/debugging.texi @@ -336,6 +336,7 @@ which is not currently set up to break on change. @cindex debugger, explicit entry @cindex force entry to debugger +@cindex @code{eval-defun}, and explicit entry to debugger You can cause the debugger to be called at a certain point in your program by writing the expression @code{(debug)} at that point. To do this, visit the source file, insert the text @samp{(debug)} at the diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index ce7ec3ac10..0f7322a640 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -2496,6 +2496,7 @@ However, if the customizations are subsequently removed, the appearance of @var{face} will again be determined by its default face spec. +@cindex @code{eval-defun}, and @code{defface} forms As an exception, if you evaluate a @code{defface} form with @kbd{C-M-x} in Emacs Lisp mode (@code{eval-defun}), a special feature of @code{eval-defun} overrides any custom face specs on the face, diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index af1bed461c..6560660120 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -461,6 +461,7 @@ form occurs in a @code{let} form with lexical binding enabled), then @code{defvar} sets the dynamic value. The lexical binding remains in effect until its binding construct exits. @xref{Variable Scoping}. +@cindex @code{eval-defun}, and @code{defvar} forms When you evaluate a top-level @code{defvar} form with @kbd{C-M-x} in Emacs Lisp mode (@code{eval-defun}), a special feature of @code{eval-defun} arranges to set the variable unconditionally, without commit c73cf3548e7166a4ccffc578699c394b360ed0f5 Author: Eli Zaretskii Date: Sat Jul 7 10:45:45 2018 +0300 Fix recent change in window.c * src/window.c (scroll_command): Fix minor inefficiency in last change: don't call Fset_buffer if the buffer is already set to be what we want. (Bug#31988) diff --git a/src/window.c b/src/window.c index 8d1aed46df..d3c72570dd 100644 --- a/src/window.c +++ b/src/window.c @@ -5652,12 +5652,17 @@ scroll_command (Lisp_Object window, Lisp_Object n, int direction) w = XWINDOW (window); other_window = ! EQ (window, selected_window); - /* If given window's buffer isn't current, make it current for - the moment. But don't screw up if window_scroll gets an error. */ + /* If given window's buffer isn't current, make it current for the + moment. If the window's buffer is the same, but it is not the + selected window, we need to save-excursion to avoid affecting + point in the selected window (which would cause the selected + window to scroll). Don't screw up if window_scroll gets an + error. */ if (other_window || XBUFFER (w->contents) != current_buffer) { record_unwind_protect_excursion (); - Fset_buffer (w->contents); + if (XBUFFER (w->contents) != current_buffer) + Fset_buffer (w->contents); } if (other_window) commit 130310893a41b925d620ee694ac9c2adcf5046ec Author: Paul Eggert Date: Fri Jul 6 23:17:30 2018 -0700 Update from gnulib This incorporates: 2018-07-04 gnulib-tool: minor tweaks for --gnu-make * build-aux/config.guess, build-aux/config.sub: Copy from Gnulib. * lib/gnulib.mk.in: Regenerate. diff --git a/build-aux/config.guess b/build-aux/config.guess index 445c406836..2b79f6d837 100755 --- a/build-aux/config.guess +++ b/build-aux/config.guess @@ -2,7 +2,7 @@ # Attempt to guess a canonical system name. # Copyright 1992-2018 Free Software Foundation, Inc. -timestamp='2018-06-26' +timestamp='2018-07-06' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -101,8 +101,8 @@ trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && e trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ; : ${TMPDIR=/tmp} ; { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } || - { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } || - { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } || + { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp 2>/dev/null) ; } || + { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp 2>/dev/null) && echo "Warning: creating insecure temp directory" >&2 ; } || { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ; dummy=$tmp/dummy ; tmpfiles="$dummy.c $dummy.o $dummy.rel $dummy" ; diff --git a/build-aux/config.sub b/build-aux/config.sub index 072700fb03..c95acc681d 100755 --- a/build-aux/config.sub +++ b/build-aux/config.sub @@ -2,7 +2,7 @@ # Configuration validation subroutine script. # Copyright 1992-2018 Free Software Foundation, Inc. -timestamp='2018-07-02' +timestamp='2018-07-03' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -625,7 +625,7 @@ case $basic_machine in | powerpc | powerpc64 | powerpc64le | powerpcle \ | pru \ | pyramid \ - | riscv32 | riscv64 \ + | riscv | riscv32 | riscv64 \ | rl78 | rx \ | score \ | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[234]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ @@ -752,7 +752,7 @@ case $basic_machine in | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \ | pru-* \ | pyramid-* \ - | riscv32-* | riscv64-* \ + | riscv-* | riscv32-* | riscv64-* \ | rl78-* | romp-* | rs6000-* | rx-* \ | sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ @@ -1125,12 +1125,6 @@ case $basic_machine in ps2) basic_machine=i386-ibm ;; - riscv) - basic_machine=riscv32-unknown - ;; - riscv-*) - basic_machine=`echo "$basic_machine" | sed 's/^riscv/riscv32/'` - ;; rm[46]00) basic_machine=mips-siemens ;; diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 19128bab2d..220f504274 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -1,5 +1,4 @@ ## DO NOT EDIT! GENERATED AUTOMATICALLY! -## Process this file with automake to produce Makefile.in. # Copyright (C) 2002-2018 Free Software Foundation, Inc. # # This file is free software; you can redistribute it and/or modify commit 6c60c4e2ff6a8c2d70b67fca868c27ebb125ee4d Author: Basil L. Contovounesios Date: Fri Jul 6 16:23:21 2018 -0700 Fix scrolling * src/window.c (scroll_command): Fix scrolling. diff --git a/src/window.c b/src/window.c index 20f6862e3b..8d1aed46df 100644 --- a/src/window.c +++ b/src/window.c @@ -5654,7 +5654,7 @@ scroll_command (Lisp_Object window, Lisp_Object n, int direction) /* If given window's buffer isn't current, make it current for the moment. But don't screw up if window_scroll gets an error. */ - if (XBUFFER (w->contents) != current_buffer) + if (other_window || XBUFFER (w->contents) != current_buffer) { record_unwind_protect_excursion (); Fset_buffer (w->contents); commit 10af9890240d45048cf4553aa731acdb32f7251a Author: Paul Eggert Date: Fri Jul 6 10:59:53 2018 -0700 Fix (length CIRCULAR) documentation * doc/lispref/sequences.texi (Sequence Functions): Correct documentation of what (length X) does when X is a circular list. diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 76a4a46888..59faf2b4f1 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -75,9 +75,9 @@ string, bool-vector, or char-table, @code{nil} otherwise. @anchor{Definition of length} This function returns the number of elements in @var{sequence}. If @var{sequence} is a dotted list, a @code{wrong-type-argument} error is -signaled. Circular lists may cause an infinite loop. For a -char-table, the value returned is always one more than the maximum -Emacs character code. +signaled; if it is a circular list, a @code{circular-list} error is +signaled. For a char-table, the value returned is always one more +than the maximum Emacs character code. @xref{Definition of safe-length}, for the related function @code{safe-length}. commit 271d1f778e76ed086d932223af889f1a210873f1 Author: Michael Albinus Date: Fri Jul 6 14:03:42 2018 +0200 Tramp editorials * doc/misc/tramp.texi (Android shell setup): Mention Termux. * lisp/net/tramp-sh.el (tramp-remote-process-environment): Use proper spelling "Tramp" in docstring. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 4115d40340..154dec11d8 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -2085,8 +2085,8 @@ installed. Usually, it is sufficient to open the file @file{@trampfn{adb,,/}}. Then you can navigate in the filesystem via @code{dired}. -Alternatively, applications such as @code{SSHDroid} that run -@command{sshd} process on the Android device can accept any +Alternatively, applications such as @code{Termux} or @code{SSHDroid} +that run @command{sshd} process on the Android device can accept any @option{ssh}-based methods provided these settings are adjusted: @itemize diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 1a31596bf9..212be4f36a 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -544,7 +544,7 @@ The PATH environment variable should be set via `tramp-remote-path'. The TERM environment variable should be set via `tramp-terminal-type'. The INSIDE_EMACS environment variable will automatically be set -based on the TRAMP and Emacs versions, and should not be set here." +based on the Tramp and Emacs versions, and should not be set here." :group 'tramp :version "26.1" :type '(repeat string)) commit 4abf94fa3bfc9d03423c80b7ceab82905a4e3baa Author: Eli Zaretskii Date: Fri Jul 6 12:31:51 2018 +0300 Clarify and improve doc strings of 'eval-last-sexp' and friends * lisp/simple.el (eval-expression, eval-expression-print-format): * lisp/progmodes/elisp-mode.el (eval-last-sexp): Doc fixes. (Bug#32064) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 8fe6ef0550..91d05ce698 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -1189,11 +1189,11 @@ current buffer. Normally, this function truncates long output according to the value of the variables `eval-expression-print-length' and `eval-expression-print-level'. With a prefix argument of zero, -however, there is no such truncation. Such a prefix argument -also causes integers to be printed in several additional formats -\(octal, hexadecimal, and character when the prefix argument is --1 or the integer is `eval-expression-print-maximum-character' or -less). +however, there is no such truncation. +Integer values are printed in several formats (decimal, octal, +and hexadecimal). When the prefix argument is -1 or the value +doesn't exceed `eval-expression-print-maximum-character', an +integer value is also printed as a character of that codepoint. If `eval-expression-debug-on-error' is non-nil, which is the default, this command arranges for all errors to enter the debugger." diff --git a/lisp/simple.el b/lisp/simple.el index cbad75193a..8b183469f8 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1471,9 +1471,9 @@ This affects printing by `eval-expression' (via :version "26.1") (defun eval-expression-print-format (value) - "If VALUE in an integer, return a specially formatted string. + "If VALUE is an integer, return a specially formatted string. This string will typically look like \" (#o1, #x1, ?\\C-a)\". -If VALUE is not an integer, nil is returned. +If VALUE is not an integer, return nil. This function is used by commands like `eval-expression' that display the result of expression evaluation." (when (integerp value) @@ -1534,11 +1534,11 @@ non-nil (interactively, with a prefix argument of zero), however, there is no such truncation. If the resulting value is an integer, and CHAR-PRINT-LIMIT is -non-nil (interactively, unless given a positive prefix argument) +non-nil (interactively, unless given a non-zero prefix argument) it will be printed in several additional formats (octal, hexadecimal, and character). The character format is only used if the value is below CHAR-PRINT-LIMIT (interactively, if the -prefix argument is -1 or the value is below +prefix argument is -1 or the value doesn't exceed `eval-expression-print-maximum-character'). Runs the hook `eval-expression-minibuffer-setup-hook' on entering the commit 6cfc7a7b1bc3989e6d2cc271222ff7ce4eb23b5e Author: Glenn Morris Date: Thu Jul 5 21:50:18 2018 -0700 Automate upload of Emacs manuals to gnu.org * admin/make-manuals, admin/upload-manuals: New scripts. * admin/admin.el (make-manuals, make-manuals-dist): Handle batch mode. * admin/make-tarball.txt: Update web-page details. diff --git a/admin/admin.el b/admin/admin.el index dab61bb916..3cb5dbc2d9 100644 --- a/admin/admin.el +++ b/admin/admin.el @@ -261,8 +261,12 @@ ROOT should be the root of an Emacs source tree." ROOT should be the root of an Emacs source tree. Interactively with a prefix argument, prompt for TYPE. Optional argument TYPE is type of output (nil means all)." - (interactive (let ((root (read-directory-name "Emacs root directory: " - source-directory nil t))) + (interactive (let ((root + (if noninteractive + (or (pop command-line-args-left) + default-directory) + (read-directory-name "Emacs root directory: " + source-directory nil t)))) (list root (if current-prefix-arg (completing-read @@ -717,8 +721,12 @@ style=\"text-align:left\">") ROOT should be the root of an Emacs source tree. Interactively with a prefix argument, prompt for TYPE. Optional argument TYPE is type of output (nil means all)." - (interactive (let ((root (read-directory-name "Emacs root directory: " - source-directory nil t))) + (interactive (let ((root + (if noninteractive + (or (pop command-line-args-left) + default-directory) + (read-directory-name "Emacs root directory: " + source-directory nil t)))) (list root (if current-prefix-arg (completing-read diff --git a/admin/make-manuals b/admin/make-manuals new file mode 100755 index 0000000000..7b9f6a2871 --- /dev/null +++ b/admin/make-manuals @@ -0,0 +1,214 @@ +#!/bin/bash +### make-manuals - create the Emacs manuals to upload to the gnu.org website + +## Copyright 2018 Free Software Foundation, Inc. + +## Author: Glenn Morris + +## 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 . + +### Commentary: + +## This is a helper script to create the Emacs manuals as used on the +## gnu.org website. After this, use upload-manuals to upload them. +## +## Usage: +## Call from the top-level directory of an Emacs source tree. +## This should normally be a release. +## The info files should exist. + +### Code: + +die () # write error to stderr and exit +{ + [ $# -gt 0 ] && echo "$PN: $@" >&2 + exit 1 +} + +PN=${0##*/} # basename of script + +usage () +{ + cat 1>&2 <= 1.28 so that the tarballs are more reproducible. +## (Personally I think this is way OOT. I'm not even sure if anyone +## uses these tarfiles, let alone cares whether they are reproducible.) +tar --help | grep -- '--sort.*name' >& /dev/null && tar="$tar --sort=name" + +while getopts ":hce:" option ; do + case $option in + (h) usage ;; + + (c) continue=t ;; + + (e) emacs=$OPTARG ;; + + (\?) die "Bad option -$OPTARG" ;; + + (:) die "Option -$OPTARG requires an argument" ;; + + (*) die "getopts error" ;; + esac +done +shift $(( --OPTIND )) +OPTIND=1 + +[ $# -eq 0 ] || usage + + +[ -e admin/admin.el ] || die "admin/admin.el not found" + + +tempfile=/tmp/$PN.$$ +trap "rm -f $tempfile 2> /dev/null" EXIT + + +[ "$continue" ] || rm -rf $outdir + +if [ -e $outdir ]; then + ## Speed up repeat invocation. + echo "Re-using existing $outdir/ directory" + +else + + ## This creates the manuals in a manual/ directory. + ## Note makeinfo >= 5 is much slower than makeinfo 4. + echo "Making manuals (slow)..." + $emacs --batch -Q -l admin/admin.el -f make-manuals \ + >| $tempfile 2>&1 || { + cat $tempfile 1>&2 + + die "error running make-manuals" + } +fi + +find $outdir -name '*~' -exec rm {} + + + +echo "Adding compressed html files..." +for f in emacs elisp; do + $tar -C $outdir/html_node -cf - $f | $gzip \ + > $outdir/$f.html_node.tar.gz || die "error for $f" +done + + +echo "Making manual tarfiles..." +$emacs --batch -Q -l admin/admin.el -f make-manuals-dist \ + >| $tempfile || { + + cat $tempfile 1>&2 + + die "error running make-manuals-dist" +} + +o=$outdir/texi +mkdir -p $o + +for f in $outdir/*.tar; do + of=${f##*/} + of=${of#emacs-} + of=${of%%-[0-9]*}.texi.tar + of=${of/lispintro/eintr} + of=${of/lispref/elisp} + of=${of/manual/emacs} + of=$o/$of + mv $f $of + $gzip $of || die "error compressing $f" +done + + +echo "Making refcards..." +make -C etc/refcards dist >| $tempfile 2>&1 || { + cat $tempfile 1>&2 + die "failed make dist" +} + +## This may hang if eg german.sty is missing. +make -k -C etc/refcards pdf >| $tempfile 2>&1 || { + cat $tempfile 1>&2 + echo "Warning: ignored failure(s) from make pdf" +} + +## Newer Texlive only provide mex (used by pl refcards) for pdf, AFAICS. +make -k -C etc/refcards ps >| $tempfile 2>&1 || { + cat $tempfile 1>&2 + echo "Warning: ignored failure(s) from make ps" +} + +## Note that in the website, refcards/ is not a subdirectory of manual/. +refdir=$outdir/refcards + +mkdir -p $refdir + +mv etc/refcards/emacs-refcards.tar $refdir +$gzip $refdir/emacs-refcards.tar + +for fmt in pdf ps; do + + o=$refdir/$fmt + + mkdir -p $o + + [ $fmt = pdf ] && { + cp etc/refcards/*.$fmt $o + rm $o/gnus-logo.pdf + continue + } + + for f in etc/refcards/*.$fmt; do + $gzip < $f > $o/${f##*/}.gz + done +done + +make -C etc/refcards extraclean > /dev/null + + +echo "Adding compressed info files..." + +o=$outdir/info +mkdir -p $o + +for f in eintr.info elisp.info emacs.info; do + + $gzip < info/$f > $o/$f.gz || die "error for $f" +done + + +echo "Finished OK, you might want to run upload-manuals now" + + +exit 0 diff --git a/admin/make-tarball.txt b/admin/make-tarball.txt index 6d6312c9b1..092027d1e2 100644 --- a/admin/make-tarball.txt +++ b/admin/make-tarball.txt @@ -203,22 +203,8 @@ For every new release, a banner is displayed on top of the emacs.html page. Uncomment and the release banner in emacs.html. Keep it on the page for about a month, then comment it again. -Use M-x make-manuals from admin/admin.el to regenerate the html -manuals in manual/. If there are new manuals, add appropriate index -pages in manual/ and add them to manual/index.html. In the -manual/html_node directory, delete any old manual pages that are no -longer present. - -Tar up the generated html_node/emacs/ and elisp/ directories and update -the files manual/elisp.html_node.tar.gz and emacs.html_node.tar.gz. - -Use M-x make-manuals-dist from admin/admin.el to update the -manual/texi/ tarfiles. - -Add compressed copies of the main info pages from the tarfile to manual/info/. - -Update the refcards/pdf/ and ps/ directories, and also -refcards/emacs-refcards.tar.gz (use make -C etc/refcards pdf ps dist). +Regenerate the various manuals in manual/. +The scripts admin/make-manuals and admin/upload-manuals summarize the process. Browsing is one way to check for any files that still need updating. diff --git a/admin/upload-manuals b/admin/upload-manuals new file mode 100755 index 0000000000..1aa7d8be32 --- /dev/null +++ b/admin/upload-manuals @@ -0,0 +1,376 @@ +#!/bin/bash + +### upload-manuals - upload the Emacs manuals to the gnu.org website + +## Copyright 2018 Free Software Foundation, Inc. + +## Author: Glenn Morris + +## 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 . + +### Commentary: + +## Run this on the output of make-manuals. + +## We assume you have already checked out a local copy of the website +## following the instructions at +## https://savannah.gnu.org/cvs/?group=emacs + +## Usage: +## Call from the manual/ directory created by make-manual. +## upload-manuals /path/to/cvs/checkout + +### Code: + + +die () # write error to stderr and exit +{ + [ $# -gt 0 ] && echo "$PN: $@" >&2 + exit 1 +} + +PN=${0##*/} # basename of script + +usage () +{ + cat 1>&2 < /dev/null | sed -n '0,/updated for Emacs version/s/.*updated for Emacs version \([0-9.]*\).*\.$/\1/p') + +## Defaults +cvs=cvs +message="Regenerate manuals for Emacs $version" +umessage= + +while getopts ":hm:n" option ; do + case $option in + (h) usage ;; + + (m) umessage=t ; message="$OPTARG" ;; + + (n) cvs="echo $cvs" ;; + + (\?) die "Bad option -$OPTARG" ;; + + (:) die "Option -$OPTARG requires an argument" ;; + + (*) die "getopts error" ;; + esac +done +shift $(( --OPTIND )) +OPTIND=1 + +[ $# -eq 1 ] || usage + +[ "$version$umessage" ] || \ + die "Could not get version to use for commit message" + +webdir=$1 + +[ -e $webdir/CVS/Entries ] && [ -e $webdir/refcards/pdf/refcard.pdf ] || \ + die "$webdir does not look like a checkout of the Emacs webpages" + +[ -e html_mono/emacs.html ] && [ -e html_node/emacs/index.html ] || \ + die "Current directory does not like the manual/ directory" + + +echo "Doing refcards..." + +mv refcards/emacs-refcards.tar.gz $webdir/refcards/ +( + cd $webdir/refcards + $cvs commit -m "$message" emacs-refcards.tar.gz || die "commit error" +) + +## For refcards, we assume a missing file is due to a tex failure, +## rather than a refcard that should be deleted. +for fmt in pdf ps.gz; do + + clist= + + for f in $webdir/refcards/${fmt%.gz}/*.$fmt; do + + s=${f#$webdir/} + + if [ -e $s ]; then + mv $s $f + clist="$clist ${f##*/}" + else + echo "$s seems to be missing" + fi + done + + + ## Check for new files. + new= + for f in refcards/${fmt%.gz}/*.$fmt; do + [ -e $f ] || break + new="$new $f" + clist="$clist ${f##*/}" + done + + [ "$new" ] && mv $new $webdir/refcards/${fmt%.gz}/ + + [ "$clist" ] && ( + cd $webdir + [ "$new" ] && { + echo "Adding new files: $new" + $cvs add -kb $new || die "add error" + echo "Remember to add new refcards to refcards/index.html" + } + cd refcards/${fmt%.gz} + $cvs commit -m "$message" $clist || die "commit error" + ) + +done # $fmt + + +echo "Doing non-html manuals..." + +for fmt in info pdf ps texi; do + + clist= + + for f in $webdir/manual/$fmt/*; do + + [ ${f##*/} = CVS ] && continue + + s=$fmt/${f##*/} + + if [ -e $s ]; then + mv $s $f + clist="$clist ${f##*/}" + else + case ${f##*/} in + *_7x9*.pdf) continue ;; + esac + + echo "$s seems to be missing" + fi + done + + ## Check for new files. + new= + for f in $fmt/*.$fmt*; do + [ -e $f ] || break + new="$new $f" + clist="$clist ${f##*/}" + done + + [ "$new" ] && mv $new $webdir/manual/$fmt/ + + [ "$clist" ] && ( + cd $webdir/manual + [ "$new" ] && { + echo "Adding new files: $new" + $cvs add $new || die "add error" + echo "Remember to add new files to the appropriate index pages" + } + cd $fmt + $cvs commit -m "$message" $clist || die "commit error" + ) + +done + + +echo "Doing tarred html..." + +clist= + +for f in $webdir/manual/*html*.tar*; do + + s=${f##*/} + + if [ -e $s ]; then + mv $s $f + clist="$clist ${f##*/}" + else + echo "$s seems to be missing" + fi +done + +## Check for new files. +new= +for f in *html*.tar*; do + [ -e $f ] || break + new="$new $f" + clist="$clist ${f##*/}" +done + +[ "$new" ] && mv $new $webdir/manual + +[ "$clist" ] && ( + cd $webdir/manual + [ "$new" ] && { + echo "Adding new files: $new" + $cvs add -kb $new || die "add error" + echo "Remember to add new files to the appropriate index pages" + } + $cvs commit -m "$message" $clist || die "commit error" +) + + +## This happens so rarely it would be less effort to do by hand... +new_manual () { + local t=eww + local i=$webdir/manual/$t.html # template + + [ -r $i ] || die "Cannot read template $i" + + local name o mono title + + for name; do + + name=${name##*/} + name=${name%.html} + + o=$webdir/manual/$name.html + + [ -e $o ] && die "$o already exists" + + mono=$webdir/manual/html_mono/$name.html + + [ -r $mono ] || die "Cannot read $mono" + + title=$(sed -n 's|^\(.*\)|\1|p' $mono) + + : ${title:?} + + echo "$title" | grep -qi "Emacs" || title="Emacs $title" + echo "$title" | grep -qi "manual" || title="$title Manual" + + ## It is a pain to extract and insert a good "documenting...". + ## Improve it by hand if you care. + sed -e "s|^.*\( - GNU Project\)|<title>$title\1|" \ + -e "s|^<h2>.*|<h2>$title</h2>|" \ + -e "s/^documenting.*/documenting \"$title\"./" \ + -e "s/$t/$name/" \ + -e "s/©.* Free/\© $(date +%Y) Free/" $i > $o + + ( + cd $webdir/manual + $cvs add ${o##*/} || die "add error for $o" + ) + done + + return 0 +} + + +echo "Doing html_mono..." + +clist= + +for f in $webdir/manual/html_mono/*.html; do + + s=${f##*manual/} + + if [ -e $s ]; then + mv $s $f + clist="$clist ${f##*/}" + else + echo "$s seems to be missing" + fi +done + +## Check for new files. +new= +for f in html_mono/*.html; do + [ -e $f ] || break + new="$new $f" + clist="$clist ${f##*/}" +done + +[ "$new" ] && mv $new $webdir/manual/html_mono/ + +## TODO: check for removed manuals. + +[ "$clist" ] && ( + cd $webdir/manual/html_mono + [ "$new" ] && { + echo "Adding new files: $new" + $cvs add $new || die "add error" + new_manual $new || die + echo "Remember to add new entries to manual/index.html" + } + $cvs commit -m "$message" $clist || die "commit error" +) + + +echo "Doing html_node..." + +for d in html_node/*; do + + [ -e $d ] || break + + echo "Doing $d..." + + [ -e $webdir/manual/$d ] || { + echo "New directory: $d" + mkdir $webdir/manual/$d + $cvs add $webdir/manual/$d || die "add error" + } + + new= + for f in $d/*.html; do + [ -e $webdir/manual/$f ] || new="$new ${f##*/}" + done + + stale= + for f in $webdir/manual/$d/*.html; do + [ -e ${f#$webdir/manual/} ] || stale="$stale ${f##*/}" + done + + mv $d/*.html $webdir/manual/$d/ + + ( + cd $webdir/manual/$d + [ "$new" ] && { + echo "Adding new files: $new" + $cvs add $new || die "add error" + } + + [ "$stale" ] && { + echo "Removing stale files: $stale" + $cvs remove -f $stale || die "remove error" + } + + ## -f: create a new revision even if no change. + $cvs commit -f -m "$message" *.html $stale || die "commit error" + ) + +done + + +echo "Checking for stray files..." +find -type f + + +echo "Finished" + +exit 0 commit b73cde5e2815c531df7f5fd13e214a7d92f78239 Author: Mike Kupfer <mkupfer@alum.berkeley.edu> Date: Wed Jul 4 15:43:04 2018 -0700 Fix MH-E mail composition with GNU Mailutils (SF#485) * lisp/mh-e/mh-comp.el (mh-bare-components): Recursively delete the temporary folder. diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el index a9f809cfa1..aa22df8b18 100644 --- a/lisp/mh-e/mh-comp.el +++ b/lisp/mh-e/mh-comp.el @@ -925,8 +925,10 @@ CONFIG is the window configuration before sending mail." (list "-form" mh-comp-formfile))) (setq new (make-temp-file "comp.")) (rename-file (concat temp-folder "/" "1") new t) - (delete-file (concat temp-folder "/" ".mh_sequences")) - (delete-directory temp-folder) + ;; The temp folder could contain various metadata files. Rather + ;; than trying to enumerate all the known files, just do a + ;; recursive delete on the directory. + (delete-directory temp-folder t) new)) (defun mh-read-draft (use initial-contents delete-contents-file) commit 3bbd4ffc68bcc2b3e003a2179a508b82055ad770 Author: Michael Albinus <michael.albinus@gmx.de> Date: Wed Jul 4 09:04:55 2018 +0200 * lisp/shell.el (shell-completion-vars): Set `comint-file-name-prefix' to "" for local default directory. diff --git a/lisp/shell.el b/lisp/shell.el index c78903b3e5..fa6eee0f18 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -469,7 +469,7 @@ Shell buffers. It implements `shell-completion-execonly' for (set (make-local-variable 'comint-file-name-quote-list) shell-file-name-quote-list) (set (make-local-variable 'comint-file-name-prefix) - (file-remote-p default-directory)) + (or (file-remote-p default-directory) "")) (set (make-local-variable 'comint-dynamic-complete-functions) shell-dynamic-complete-functions) (setq-local comint-unquote-function #'shell--unquote-argument) commit 0bb7dfc39cdb943eeefa6c7e5575eb997fb934ba Author: Paul Eggert <eggert@cs.ucla.edu> Date: Tue Jul 3 23:51:03 2018 -0700 Adjust to Gnulib change with -Wswitch-default * configure.ac: Simplify by not bothering to omit -Wswitch-default, as Gnulib no longer enables it by default. diff --git a/configure.ac b/configure.ac index e33b1f1e35..6613ce1eaa 100644 --- a/configure.ac +++ b/configure.ac @@ -959,7 +959,6 @@ AS_IF([test $gl_gcc_warnings = no], nw="$nw -Woverlength-strings" # Not a problem these days nw="$nw -Wformat-nonliteral" # we do this a lot nw="$nw -Wvla" # Emacs uses <vla.h>. - nw="$nw -Wswitch-default" # Too many warnings for now nw="$nw -Wunused-const-variable=2" # lisp.h declares const objects. nw="$nw -Winline" # OK to ignore 'inline' nw="$nw -Wstrict-overflow" # OK to optimize assuming that commit 891536aaad5a2a456656b778735513a57bb461c3 Author: Paul Eggert <eggert@cs.ucla.edu> Date: Tue Jul 3 23:47:52 2018 -0700 Update from Gnulib This incorporates: 2018-07-01 getloadavg: don't redefine WINDOWS32 2018-07-01 manywarnings: omit -Wswitch-default * build-aux/config.sub, lib/getloadavg.c, m4/manywarnings.m4: Copy from Gnulib. diff --git a/build-aux/config.sub b/build-aux/config.sub index d1f5b54903..072700fb03 100755 --- a/build-aux/config.sub +++ b/build-aux/config.sub @@ -2,7 +2,7 @@ # Configuration validation subroutine script. # Copyright 1992-2018 Free Software Foundation, Inc. -timestamp='2018-05-24' +timestamp='2018-07-02' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -1125,6 +1125,12 @@ case $basic_machine in ps2) basic_machine=i386-ibm ;; + riscv) + basic_machine=riscv32-unknown + ;; + riscv-*) + basic_machine=`echo "$basic_machine" | sed 's/^riscv/riscv32/'` + ;; rm[46]00) basic_machine=mips-siemens ;; diff --git a/lib/getloadavg.c b/lib/getloadavg.c index 435d10a6b1..578316e34d 100644 --- a/lib/getloadavg.c +++ b/lib/getloadavg.c @@ -97,7 +97,7 @@ # include "intprops.h" -# if defined _WIN32 && ! defined __CYGWIN__ +# if defined _WIN32 && ! defined __CYGWIN__ && ! defined WINDOWS32 # define WINDOWS32 # endif diff --git a/m4/manywarnings.m4 b/m4/manywarnings.m4 index 925c40e139..516c587476 100644 --- a/m4/manywarnings.m4 +++ b/m4/manywarnings.m4 @@ -1,4 +1,4 @@ -# manywarnings.m4 serial 15 +# manywarnings.m4 serial 16 dnl Copyright (C) 2008-2018 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -239,7 +239,6 @@ m4_defun([gl_MANYWARN_ALL_GCC(C)], -Wsuggest-final-types \ -Wswitch \ -Wswitch-bool \ - -Wswitch-default \ -Wswitch-unreachable \ -Wsync-nand \ -Wsystem-headers \ commit 38ea8e147add0b386737df4145d7ee0fc841fe55 Author: Tom Tromey <tom@tromey.com> Date: Tue Jul 3 22:13:27 2018 -0600 Fix Tcl indentation in a namespace Fixes bug#32035 * lisp/progmodes/tcl.el (tcl-proc-list): Add "namespace". * test/lisp/progmodes/tcl-tests.el (tcl-mode-namespace-indent): New test. diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el index fad62e100a..586d8cc0ed 100644 --- a/lisp/progmodes/tcl.el +++ b/lisp/progmodes/tcl.el @@ -360,7 +360,7 @@ Add functions to the hook with `add-hook': (defvar tcl-proc-list - '("proc" "method" "itcl_class" "body" "configbody" "class") + '("proc" "method" "itcl_class" "body" "configbody" "class" "namespace") "List of commands whose first argument defines something. This exists because some people (eg, me) use `defvar' et al. Call `tcl-set-proc-regexp' and `tcl-set-font-lock-keywords' diff --git a/test/lisp/progmodes/tcl-tests.el b/test/lisp/progmodes/tcl-tests.el index 55211b70be..061488636d 100644 --- a/test/lisp/progmodes/tcl-tests.el +++ b/test/lisp/progmodes/tcl-tests.el @@ -63,6 +63,15 @@ (insert "proc inthis {} {\n # nothing\n") (should (equal "inthis" (add-log-current-defun))))) +;; From bug#32035 +(ert-deftest tcl-mode-namespace-indent () + (with-temp-buffer + (tcl-mode) + (let ((text "namespace eval Foo {\n variable foo\n}\n")) + (insert text) + (indent-region (point-min) (point-max)) + (should (equal (buffer-string) text))))) + (provide 'tcl-tests) ;;; tcl-tests.el ends here commit f9f0c993845cc51517cef6ed06b0cabe102dcd9f Author: Stefan Monnier <monnier@iro.umontreal.ca> Date: Tue Jul 3 18:16:52 2018 -0400 * lisp/mail/sendmail.el: Use lexical-binding (mail-recover-1): Declare dired-trivial-filenames. diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index 29a1ae2657..50dd81039e 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -1,4 +1,4 @@ -;;; sendmail.el --- mail sending commands for Emacs +;;; sendmail.el --- mail sending commands for Emacs -*- lexical-binding:t -*- ;; Copyright (C) 1985-1986, 1992-1996, 1998, 2000-2018 Free Software ;; Foundation, Inc. @@ -1144,7 +1144,7 @@ to combine them into one, and does so if the user says y." ;; Try to preserve alignment of contents of the field (let ((prefix-length (length (match-string 0)))) (replace-match " ") - (dotimes (i (1- prefix-length)) + (dotimes (_ (1- prefix-length)) (insert " "))))))) (set-marker first-to-end nil)))))) @@ -1957,6 +1957,7 @@ The seventh argument ACTIONS is a list of actions to take ;; Require dired so that dired-trivial-filenames does not get ;; unbound on exit from the let. (require 'dired) + (defvar dired-trivial-filenames) (let ((dired-trivial-filenames t)) (dired-other-window wildcard (concat dired-listing-switches " -t"))) (rename-buffer "*Auto-saved Drafts*" t) commit 0dce5e59206db7bd0b9cd43ae712272105300ae4 Author: Eli Zaretskii <eliz@gnu.org> Date: Tue Jul 3 22:16:20 2018 +0300 Speed up 'replace-buffer-contents' some more * src/editfns.c (EXTRA_CONTEXT_FIELDS): New members beg_a and beg_b. (Freplace_buffer_contents): Set up ctx.beg_a and ctx.beg_b. (buffer_chars_equal): Use ctx->beg_a and ctx->beg_b instead of calling BUF_BEGV, which is expensive. This speeds up the recipe in bug#31888 by 30%. diff --git a/src/editfns.c b/src/editfns.c index 9002211714..d1a6bfbbb1 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -3127,6 +3127,9 @@ static unsigned short rbc_quitcounter; /* Buffers to compare. */ \ struct buffer *buffer_a; \ struct buffer *buffer_b; \ + /* BEGV of each buffer */ \ + ptrdiff_t beg_a; \ + ptrdiff_t beg_b; \ /* Whether each buffer is unibyte/plain-ASCII or not. */ \ bool a_unibyte; \ bool b_unibyte; \ @@ -3208,6 +3211,8 @@ differences between the two buffers. */) struct context ctx = { .buffer_a = a, .buffer_b = b, + .beg_a = min_a, + .beg_b = min_b, .a_unibyte = BUF_ZV (a) == BUF_ZV_BYTE (a), .b_unibyte = BUF_ZV (b) == BUF_ZV_BYTE (b), .deletions = SAFE_ALLOCA (del_bytes), @@ -3349,8 +3354,8 @@ static bool buffer_chars_equal (struct context *ctx, ptrdiff_t pos_a, ptrdiff_t pos_b) { - pos_a += BUF_BEGV (ctx->buffer_a); - pos_b += BUF_BEGV (ctx->buffer_b); + pos_a += ctx->beg_a; + pos_b += ctx->beg_b; /* Allow the user to escape out of a slow compareseq call. */ rarely_quit (++rbc_quitcounter); commit 9d274c3e1c77c1f29c040901108fe5fb8a843044 Author: Paul Eggert <eggert@cs.ucla.edu> Date: Tue Jul 3 11:54:35 2018 -0700 Fix typo in --with-x-toolkit=no code * src/xmenu.c (pop_down_menu) [!USE_X_TOOLKIT && !USE_GTK]: Fix type typo introduced by 2018-06-14T22:59:08!eggert@cs.ucla.edu. diff --git a/src/xmenu.c b/src/xmenu.c index dc6f33112c..58fba8c322 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -2057,7 +2057,7 @@ struct pop_down_menu static void pop_down_menu (void *arg) { - union pop_down_menu *data = arg; + struct pop_down_menu *data = arg; struct frame *f = data->frame; XMenu *menu = data->menu; commit 4ee502ca9db022ef85c736888ec6d6b471e0332a Author: JoĂŁo Távora <joaotavora@gmail.com> Date: Tue Jul 3 08:21:42 2018 +0100 Adjust previous jsonrpc change (nth 2) is probably a better alternative to caddr, and in Emacs 26.1 we can pass 0 as :service to automatically find an available port. * lisp/jsonrpc.el (jsonrpc--call-deferred): Use cl-caddr. * test/lisp/jsonrpc-tests.el (jsonrpc--call-with-emacsrpc-fixture): Pass 0 as :service to when making the listen server. diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index add2285bbe..b2ccea5c14 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -5,11 +5,11 @@ ;; Author: JoĂŁo Távora <joaotavora@gmail.com> ;; Maintainer: JoĂŁo Távora <joaotavora@gmail.com> ;; Keywords: processes, languages, extensions -;; Package-Requires: ((emacs "25.1")) +;; Package-Requires: ((emacs "25.2")) ;; Version: 1.0.0 ;; This is an Elpa :core package. Don't use functionality that is not -;; compatible with Emacs 25.1. +;; compatible with Emacs 25.2. ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -437,8 +437,7 @@ connection object, called when the process dies .") "Call CONNECTION's deferred actions, who may again defer themselves." (when-let ((actions (hash-table-values (jsonrpc--deferred-actions connection)))) (jsonrpc--debug connection `(:maybe-run-deferred - ,(mapcar (lambda (action) (car (cdr (cdr action)))) - actions))) + ,(mapcar (apply-partially #'nth 2) actions))) (mapc #'funcall (mapcar #'car actions)))) (defun jsonrpc--process-sentinel (proc change) diff --git a/test/lisp/jsonrpc-tests.el b/test/lisp/jsonrpc-tests.el index 16986eb46f..1a84c30e33 100644 --- a/test/lisp/jsonrpc-tests.el +++ b/test/lisp/jsonrpc-tests.el @@ -48,7 +48,11 @@ (setq listen-server (make-network-process :name "Emacs RPC server" :server t :host "localhost" - :service 44444 + :service (if (version<= emacs-version "26.1") + 44444 + ;; 26.1 can automatically find ports if + ;; one passes 0 here. + 0) :log (lambda (listen-server client _message) (push (make-instance commit 00fdce071cf2918277f99ff4ed10e5599cefb626 Author: Glenn Morris <rgm@gnu.org> Date: Mon Jul 2 22:37:22 2018 -0700 * doc/emacs/docstyle.texi: Avoid messing up the html output. Previously the @hyphenation commands somehow caused the <head> section to go missing, with makeinfo 4.13 at least. diff --git a/doc/emacs/docstyle.texi b/doc/emacs/docstyle.texi index f682e3d82b..5bdcd079d9 100644 --- a/doc/emacs/docstyle.texi +++ b/doc/emacs/docstyle.texi @@ -8,9 +8,11 @@ @end ignore @set txicodequoteundirected @set txicodequotebacktick +@iftex @c It turns out TeX sometimes fails to hyphenate, so we help it here @hyphenation{au-to-mat-i-cal-ly} @hyphenation{spec-i-fied} @hyphenation{work-a-round} @hyphenation{work-a-rounds} @hyphenation{un-marked} +@end iftex commit 40db29fc5562d416a2af6c2a45b9f3f5e6a302db Author: Glenn Morris <rgm@gnu.org> Date: Mon Jul 2 22:07:08 2018 -0700 * lisp/mail/sendmail.el (mail-from-style): Improve obsolescence message. diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index aebc50f4fa..29a1ae2657 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -76,7 +76,7 @@ Otherwise, most addresses look like `angles', but they look like :group 'sendmail) (make-obsolete-variable 'mail-from-style - "Only the `angles' value is valid according to RFC2822" "27.1") + "only the `angles' value is valid according to RFC2822." "27.1" 'set) ;;;###autoload (defcustom mail-specify-envelope-from nil commit c4a93e4892b564e4ba830ef0dae91e2654735cfe Merge: 02f2f336af 8c70142ea3 Author: Glenn Morris <rgm@gnu.org> Date: Mon Jul 2 19:19:26 2018 -0700 ; Merge from origin/emacs-26 The following commit was skipped: 8c70142 (origin/emacs-26) ; Auto-commit of loaddefs files. commit 02f2f336af7c4129ec79ab00881bba3e14ff9820 Merge: bc0e36df8d fc5cae731c Author: Glenn Morris <rgm@gnu.org> Date: Mon Jul 2 19:19:26 2018 -0700 Merge from origin/emacs-26 fc5cae7 ; Fix ChangeLog typo. e17a5e5 ; make change-history-commit f205928 * etc/HISTORY: Cite Brinkoff on early history. 4e58ca8 Document internal use of 'above-suspended' z-group frame para... 4bd43b0 Increase max-lisp-eval-depth adjustment while in debugger (bu... ab98352 Improve on last change in replace-buffer-contents 2f149c0 Fix a factual error in Introduction to Emacs Lisp 8ad50a3 ; * lisp/files.el (buffer-offer-save): Doc fix. (Bug#32000) c80f31f Minor improvements in documentation of imenu.el 8ebb683 Avoid errors with recentering in 'skeleton-insert' e980a3c * src/lisp.h: Omit obsolete comment re bytecode stack. eec71eb Speed up replace-buffer-contents 93c41ce Remove extra process call from vc-git-find-file-hook 7ea0873 ; Update some commentary 4a7f423 Speed up vc-git-dir-status-files 9134c84 Avoid compiler warning using coding.h Conflicts: src/editfns.c commit bc0e36df8d33595d6411ec4c18e3f4b643c01306 Merge: 98e98b42a0 1f5037925b Author: Glenn Morris <rgm@gnu.org> Date: Mon Jul 2 19:19:05 2018 -0700 ; Merge from origin/emacs-26 The following commit was skipped: 1f50379 Sync with Tramp 2.3.4. Do not merge with master commit 98e98b42a09d7c2c74e9bf58f6eea19086f42e6e Merge: 332f4656b0 d008ef3d0b Author: Glenn Morris <rgm@gnu.org> Date: Mon Jul 2 19:19:05 2018 -0700 Merge from origin/emacs-26 d008ef3 * src/xdisp.c (Vmouse_autoselect_window): Clarify doc-string ... 6f6d525 Detect a non-list package archive content properly (Bug#22311) commit 8c70142ea3a97a5a0241890ec907c76a05fe15ea Author: Glenn Morris <rgm@gnu.org> Date: Mon Jul 2 20:45:00 2018 -0400 ; Auto-commit of loaddefs files. diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 738ad9e6ea..5740cdea86 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -5925,6 +5925,9 @@ Use `\\[info-lookup-symbol]' to look up documentation of CSS properties, at-rule pseudo-classes, and pseudo-elements on the Mozilla Developer Network (MDN). +Use `\\[fill-paragraph]' to reformat CSS declaration blocks. It can also +be used to fill comments. + \\{css-mode-map} \(fn)" t nil) @@ -27555,12 +27558,12 @@ than that of a simplified version: (defun simplified-regexp-opt (strings &optional paren) (let ((parens (cond ((stringp paren) (cons paren \"\\\\)\")) - ((eq paren 'words) '(\"\\\\\\=<\\\\(\" . \"\\\\)\\\\>\")) - ((eq paren 'symbols) '(\"\\\\_<\\\\(\" . \"\\\\)\\\\_>\")) - ((null paren) '(\"\\\\(?:\" . \"\\\\)\")) - (t '(\"\\\\(\" . \"\\\\)\"))))) + ((eq paren \\='words) \\='(\"\\\\\\=<\\\\(\" . \"\\\\)\\\\>\")) + ((eq paren \\='symbols) \\='(\"\\\\_<\\\\(\" . \"\\\\)\\\\_>\")) + ((null paren) \\='(\"\\\\(?:\" . \"\\\\)\")) + (t \\='(\"\\\\(\" . \"\\\\)\"))))) (concat (car paren) - (mapconcat 'regexp-quote strings \"\\\\|\") + (mapconcat \\='regexp-quote strings \"\\\\|\") (cdr paren)))) \(fn STRINGS &optional PAREN)" nil nil) @@ -28654,12 +28657,14 @@ CHAR matches whitespace and graphic characters. `alphanumeric', `alnum' - matches alphabetic characters and digits. (For multibyte characters, - it matches according to Unicode character properties.) + matches alphabetic characters and digits. For multibyte characters, + it matches characters whose Unicode `general-category' property + indicates they are alphabetic or decimal number characters. `letter', `alphabetic', `alpha' - matches alphabetic characters. (For multibyte characters, - it matches according to Unicode character properties.) + matches alphabetic characters. For multibyte characters, + it matches characters whose Unicode `general-category' property + indicates they are alphabetic characters. `ascii' matches ASCII (unibyte) characters. @@ -28668,10 +28673,14 @@ CHAR matches non-ASCII (multibyte) characters. `lower', `lower-case' - matches anything lower-case. + matches anything lower-case, as determined by the current case + table. If `case-fold-search' is non-nil, this also matches any + upper-case letter. `upper', `upper-case' - matches anything upper-case. + matches anything upper-case, as determined by the current case + table. If `case-fold-search' is non-nil, this also matches any + lower-case letter. `punctuation', `punct' matches punctuation. (But at present, for multibyte characters, @@ -30074,6 +30083,9 @@ argument INHIBIT-PROMPT is non-nil. To force-start a server, do \\[server-force-delete] and then \\[server-start]. +To check from a Lisp program whether a server is running, use +the `server-process' variable. + \(fn &optional LEAVE-DEAD INHIBIT-PROMPT)" t nil) (autoload 'server-force-delete "server" "\ @@ -30845,7 +30857,7 @@ then `snmpv2-mode-hook'. ;;;### (autoloads nil "soap-client" "net/soap-client.el" (0 0 0 0)) ;;; Generated autoloads from net/soap-client.el -(push (purecopy '(soap-client 3 1 3)) package--builtin-versions) +(push (purecopy '(soap-client 3 1 4)) package--builtin-versions) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "soap-client" '("soap-"))) @@ -34582,7 +34594,7 @@ Reenable Ange-FTP, when Tramp is unloaded. ;;;### (autoloads nil "trampver" "net/trampver.el" (0 0 0 0)) ;;; Generated autoloads from net/trampver.el -(push (purecopy '(tramp 2 3 4 -1)) package--builtin-versions) +(push (purecopy '(tramp 2 3 4)) package--builtin-versions) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "trampver" '("tramp-"))) commit 332f4656b019b58fed1de6e35769e83ff190908d Author: JoĂŁo Távora <joaotavora@gmail.com> Date: Mon Jul 2 15:57:24 2018 +0100 Make lisp/jsonrpc.el work with Emacs 25.1 * jsonrpc.el (Package-Requires): Require Emacs 25.1 (jsonrpc-lambda): Use cl-gensym. (jsonrpc--call-deferred): Caddr doesn't exist in emacs 25.1. * jsonrpc-tests.el (jsonrpc--call-with-emacsrpc-fixture): New function. (jsonrpc--with-emacsrpc-fixture): Use it. (deferred-action-complex-tests): Adjust test for Emacs 25.1 diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index b77db71601..add2285bbe 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -5,11 +5,11 @@ ;; Author: JoĂŁo Távora <joaotavora@gmail.com> ;; Maintainer: JoĂŁo Távora <joaotavora@gmail.com> ;; Keywords: processes, languages, extensions -;; Package-Requires: ((emacs "26.1")) +;; Package-Requires: ((emacs "25.1")) ;; Version: 1.0.0 ;; This is an Elpa :core package. Don't use functionality that is not -;; compatible with Emacs 26.1. +;; compatible with Emacs 25.1. ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -132,7 +132,7 @@ immediately." ;;; (cl-defmacro jsonrpc-lambda (cl-lambda-list &body body) (declare (indent 1) (debug (sexp &rest form))) - (let ((e (gensym "jsonrpc-lambda-elem"))) + (let ((e (cl-gensym "jsonrpc-lambda-elem"))) `(lambda (,e) (apply (cl-function (lambda ,cl-lambda-list ,@body)) ,e)))) (defun jsonrpc-events-buffer (connection) @@ -436,7 +436,9 @@ connection object, called when the process dies .") (defun jsonrpc--call-deferred (connection) "Call CONNECTION's deferred actions, who may again defer themselves." (when-let ((actions (hash-table-values (jsonrpc--deferred-actions connection)))) - (jsonrpc--debug connection `(:maybe-run-deferred ,(mapcar #'caddr actions))) + (jsonrpc--debug connection `(:maybe-run-deferred + ,(mapcar (lambda (action) (car (cdr (cdr action)))) + actions))) (mapc #'funcall (mapcar #'car actions)))) (defun jsonrpc--process-sentinel (proc change) diff --git a/test/lisp/jsonrpc-tests.el b/test/lisp/jsonrpc-tests.el index 9395ab6ac0..16986eb46f 100644 --- a/test/lisp/jsonrpc-tests.el +++ b/test/lisp/jsonrpc-tests.el @@ -22,11 +22,11 @@ ;;; Commentary: ;; About "deferred" tests, `jsonrpc--test-client' has a flag that we -;; test this flag in the this `jsonrpc-connection-ready-p' API method. -;; It holds any `jsonrpc-request's and `jsonrpc-async-request's -;; explicitly passed `:deferred'. After clearing the flag, the held -;; requests are actually sent to the server in the next opportunity -;; (when receiving or sending something to the server). +;; test in its `jsonrpc-connection-ready-p' API method. It holds any +;; `jsonrpc-request's and `jsonrpc-async-request's explicitly passed +;; `:deferred'. After clearing the flag, the held requests are +;; actually sent to the server in the next opportunity (when receiving +;; or sending something to the server). ;;; Code: @@ -40,59 +40,65 @@ (defclass jsonrpc--test-client (jsonrpc--test-endpoint) ((hold-deferred :initform t :accessor jsonrpc--hold-deferred))) +(defun jsonrpc--call-with-emacsrpc-fixture (fn) + "Do work for `jsonrpc--with-emacsrpc-fixture'. Call FN." + (let* (listen-server endpoint) + (unwind-protect + (progn + (setq listen-server + (make-network-process + :name "Emacs RPC server" :server t :host "localhost" + :service 44444 + :log (lambda (listen-server client _message) + (push + (make-instance + 'jsonrpc--test-endpoint + :name (process-name client) + :process client + :request-dispatcher + (lambda (_endpoint method params) + (unless (memq method '(+ - * / vconcat append + sit-for ignore)) + (signal 'jsonrpc-error + `((jsonrpc-error-message + . "Sorry, this isn't allowed") + (jsonrpc-error-code . -32601)))) + (apply method (append params nil))) + :on-shutdown + (lambda (conn) + (setf (jsonrpc--shutdown-complete-p conn) t))) + (process-get listen-server 'handlers))))) + (setq endpoint + (make-instance + 'jsonrpc--test-client + "Emacs RPC client" + :process + (open-network-stream "JSONRPC test tcp endpoint" + nil "localhost" + (process-contact listen-server + :service)) + :on-shutdown + (lambda (conn) + (setf (jsonrpc--shutdown-complete-p conn) t)))) + (funcall fn endpoint)) + (unwind-protect + (when endpoint + (kill-buffer (jsonrpc--events-buffer endpoint)) + (jsonrpc-shutdown endpoint)) + (when listen-server + (cl-loop do (delete-process listen-server) + while (progn (accept-process-output nil 0.1) + (process-live-p listen-server)) + do (jsonrpc--message + "test listen-server is still running, waiting")) + (cl-loop for handler in (process-get listen-server 'handlers) + do (ignore-errors (jsonrpc-shutdown handler))) + (mapc #'kill-buffer + (mapcar #'jsonrpc--events-buffer + (process-get listen-server 'handlers)))))))) + (cl-defmacro jsonrpc--with-emacsrpc-fixture ((endpoint-sym) &body body) - (declare (indent 1) (debug t)) - (let ((server (gensym "server-")) (listen-server (gensym "listen-server-"))) - `(let* (,server - (,listen-server - (make-network-process - :name "Emacs RPC server" :server t :host "localhost" - :service 0 - :log (lambda (_server client _message) - (setq ,server - (make-instance - 'jsonrpc--test-endpoint - :name (process-name client) - :process client - :request-dispatcher - (lambda (_endpoint method params) - (unless (memq method '(+ - * / vconcat append - sit-for ignore)) - (signal 'jsonrpc-error - `((jsonrpc-error-message - . "Sorry, this isn't allowed") - (jsonrpc-error-code . -32601)))) - (apply method (append params nil))) - :on-shutdown - (lambda (conn) - (setf (jsonrpc--shutdown-complete-p conn) t))))))) - (,endpoint-sym (make-instance - 'jsonrpc--test-client - "Emacs RPC client" - :process - (open-network-stream "JSONRPC test tcp endpoint" - nil "localhost" - (process-contact ,listen-server - :service)) - :on-shutdown - (lambda (conn) - (setf (jsonrpc--shutdown-complete-p conn) t))))) - (unwind-protect - (progn - (cl-assert ,endpoint-sym) - ,@body - (kill-buffer (jsonrpc--events-buffer ,endpoint-sym)) - (when ,server - (kill-buffer (jsonrpc--events-buffer ,server)))) - (unwind-protect - (jsonrpc-shutdown ,endpoint-sym) - (unwind-protect - (jsonrpc-shutdown ,server) - (cl-loop do (delete-process ,listen-server) - while (progn (accept-process-output nil 0.1) - (process-live-p ,listen-server)) - do (jsonrpc--message - "test listen-server is still running, waiting")))))))) + `(jsonrpc--call-with-emacsrpc-fixture (lambda (,endpoint-sym) ,@body))) (ert-deftest returns-3 () "A basic test for adding two numbers in our test RPC." @@ -143,10 +149,10 @@ (ert-deftest json-el-cant-serialize-this () "Can't serialize a response that is half-vector/half-list." (jsonrpc--with-emacsrpc-fixture (conn) - (should-error - ;; (append [1 2 3] [3 4 5]) => (1 2 3 . [3 4 5]), which can't be - ;; serialized - (jsonrpc-request conn 'append [[1 2 3] [3 4 5]])))) + (should-error + ;; (append [1 2 3] [3 4 5]) => (1 2 3 . [3 4 5]), which can't be + ;; serialized + (jsonrpc-request conn 'append [[1 2 3] [3 4 5]])))) (cl-defmethod jsonrpc-connection-ready-p ((conn jsonrpc--test-client) what) @@ -231,6 +237,10 @@ (jsonrpc-request conn 'ignore ["third deferred"] :deferred "third deferred" :timeout 1) + ;; Wait another 0.5 secs just in case the success handlers of + ;; one of these last two requests didn't quite have a chance to + ;; run (Emacs 25.2 apparentely needs this). + (accept-process-output nil 0.5) (should second-deferred-went-through-p) (should (eq 1 n-deferred-1)) (should (eq 2 n-deferred-2)) commit ee3e432300054ca488896e39fca57b10d733330a Author: John Shahid <jvshahid@gmail.com> Date: Sun Jul 1 23:34:53 2018 -0400 Optionally add argument description in minor mode DOC (bug#10754) Add a paragraph to minor mode's docstring documenting the mode's ARG usage if the supplied docstring doesn't already contain the word "ARG". * easy-mmode.el (easy-mmode--arg-docstring): New const. (easy-mmode--arg-docstring): New function. (define-minor-mode): Use them. Remove argument documentation from all minor modes. diff --git a/etc/NEWS b/etc/NEWS index 3f761e9210..c92ee6e680 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -689,6 +689,8 @@ manual for more details. * Lisp Changes in Emacs 27.1 +** define-minor-mode automatically documents the meaning of ARG + +++ ** The function 'recenter' now accepts an additional optional argument. By default, calling 'recenter' will not redraw the frame even if diff --git a/lisp/abbrev.el b/lisp/abbrev.el index fd2f36e198..cddce8f529 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -56,9 +56,6 @@ define global abbrevs instead." (define-minor-mode abbrev-mode "Toggle Abbrev mode in the current buffer. -With a prefix argument ARG, enable Abbrev mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -Abbrev mode if ARG is omitted or nil. In Abbrev mode, inserting an abbreviation causes it to expand and be replaced by its expansion." diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el index 71b1b39008..5abd9788dd 100644 --- a/lisp/allout-widgets.el +++ b/lisp/allout-widgets.el @@ -513,9 +513,6 @@ happens in the buffer.") ;;;###autoload (define-minor-mode allout-widgets-mode "Toggle Allout Widgets mode. -With a prefix argument ARG, enable Allout Widgets mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. Allout Widgets mode is an extension of Allout mode that provides graphical decoration of outline structure. It is meant to diff --git a/lisp/allout.el b/lisp/allout.el index 26e7f6b56c..a123ece9b9 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -1693,9 +1693,6 @@ valid values." (define-minor-mode allout-mode ;;;_ . Doc string: "Toggle Allout outline mode. -With a prefix argument ARG, enable Allout outline mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. \\<allout-mode-map-value> Allout outline mode is a minor mode that provides extensive diff --git a/lisp/autoarg.el b/lisp/autoarg.el index 096bdefc1a..4bf5785c7d 100644 --- a/lisp/autoarg.el +++ b/lisp/autoarg.el @@ -90,9 +90,6 @@ ;;;###autoload (define-minor-mode autoarg-mode "Toggle Autoarg mode, a global minor mode. -With a prefix argument ARG, enable Autoarg mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. \\<autoarg-mode-map> In Autoarg mode, digits are bound to `digit-argument', i.e. they @@ -116,9 +113,6 @@ then invokes the normal binding of \\[autoarg-terminate]. ;;;###autoload (define-minor-mode autoarg-kp-mode "Toggle Autoarg-KP mode, a global minor mode. -With a prefix argument ARG, enable Autoarg-KP mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. \\<autoarg-kp-mode-map> This is similar to `autoarg-mode' but rebinds the keypad keys diff --git a/lisp/autoinsert.el b/lisp/autoinsert.el index 7858041440..cb0d15196f 100644 --- a/lisp/autoinsert.el +++ b/lisp/autoinsert.el @@ -412,9 +412,6 @@ or if CONDITION had no actions, after all other CONDITIONs." ;;;###autoload (define-minor-mode auto-insert-mode "Toggle Auto-insert mode, a global minor mode. -With a prefix argument ARG, enable Auto-insert mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. When Auto-insert mode is enabled, when new files are created you can insert a template for the file depending on the mode of the buffer." diff --git a/lisp/autorevert.el b/lisp/autorevert.el index 0a9d3bef54..c60fe010a3 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -351,9 +351,6 @@ This has been reported by a file notification event.") ;;;###autoload (define-minor-mode auto-revert-mode "Toggle reverting buffer when the file changes (Auto-Revert Mode). -With a prefix argument ARG, enable Auto-Revert Mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. Auto-Revert Mode is a minor mode that affects only the current buffer. When enabled, it reverts the buffer when the file on @@ -393,9 +390,6 @@ This function is designed to be added to hooks, for example: ;;;###autoload (define-minor-mode auto-revert-tail-mode "Toggle reverting tail of buffer when the file grows. -With a prefix argument ARG, enable Auto-Revert Tail Mode if ARG -is positive, and disable it otherwise. If called from Lisp, -enable the mode if ARG is omitted or nil. When Auto-Revert Tail Mode is enabled, the tail of the file is constantly followed, as with the shell command `tail -f'. This @@ -460,9 +454,6 @@ This function is designed to be added to hooks, for example: ;;;###autoload (define-minor-mode global-auto-revert-mode "Toggle Global Auto-Revert Mode. -With a prefix argument ARG, enable Global Auto-Revert Mode if ARG -is positive, and disable it otherwise. If called from Lisp, -enable the mode if ARG is omitted or nil. Global Auto-Revert Mode is a global minor mode that reverts any buffer associated with a file when the file changes on disk. Use diff --git a/lisp/battery.el b/lisp/battery.el index ca17ae8fc3..192a6ae898 100644 --- a/lisp/battery.el +++ b/lisp/battery.el @@ -175,9 +175,6 @@ The text being displayed in the echo area is controlled by the variables ;;;###autoload (define-minor-mode display-battery-mode "Toggle battery status display in mode line (Display Battery mode). -With a prefix argument ARG, enable Display Battery mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. The text displayed in the mode line is controlled by `battery-mode-line-format' and `battery-status-function'. diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el index 5bbc2d0f85..1168f26842 100644 --- a/lisp/cedet/ede.el +++ b/lisp/cedet/ede.el @@ -475,9 +475,6 @@ To be used in hook functions." (define-minor-mode ede-minor-mode "Toggle EDE (Emacs Development Environment) minor mode. -With a prefix argument ARG, enable EDE minor mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -EDE minor mode if ARG is omitted or nil. If this file is contained, or could be contained in an EDE controlled project, then this mode is activated automatically @@ -563,9 +560,6 @@ Sets buffer local variables for EDE." ;;;###autoload (define-minor-mode global-ede-mode "Toggle global EDE (Emacs Development Environment) mode. -With a prefix argument ARG, enable global EDE mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. This global minor mode enables `ede-minor-mode' in all buffers in an EDE controlled project." diff --git a/lisp/cedet/ede/dired.el b/lisp/cedet/ede/dired.el index 33afc7e547..9600d3dd34 100644 --- a/lisp/cedet/ede/dired.el +++ b/lisp/cedet/ede/dired.el @@ -59,9 +59,7 @@ ;;;###autoload (define-minor-mode ede-dired-minor-mode - "A minor mode that should only be activated in DIRED buffers. -If ARG is nil or a positive number, force on, if -negative, force off." + "A minor mode that should only be activated in DIRED buffers." :lighter " EDE" :keymap ede-dired-keymap (unless (derived-mode-p 'dired-mode) (setq ede-dired-minor-mode nil) diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el index b24e2fbbb1..f0a1e6bb5a 100644 --- a/lisp/cedet/semantic.el +++ b/lisp/cedet/semantic.el @@ -1096,9 +1096,6 @@ The following modes are more targeted at people who want to see ;;;###autoload (define-minor-mode semantic-mode "Toggle parser features (Semantic mode). -With a prefix argument ARG, enable Semantic mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -Semantic mode if ARG is omitted or nil. In Semantic mode, Emacs parses the buffers you visit for their semantic content. This information is used by a variety of diff --git a/lisp/cedet/semantic/db-mode.el b/lisp/cedet/semantic/db-mode.el index e6a2340b8c..638f2915f0 100644 --- a/lisp/cedet/semantic/db-mode.el +++ b/lisp/cedet/semantic/db-mode.el @@ -56,7 +56,6 @@ ;;;###autoload (define-minor-mode global-semanticdb-minor-mode "Toggle Semantic DB mode. -With ARG, turn Semantic DB mode on if ARG is positive, off otherwise. In Semantic DB mode, Semantic parsers store results in a database, which can be saved for future Emacs sessions." diff --git a/lisp/cedet/semantic/decorate/mode.el b/lisp/cedet/semantic/decorate/mode.el index 100e221ce3..77a8471e27 100644 --- a/lisp/cedet/semantic/decorate/mode.el +++ b/lisp/cedet/semantic/decorate/mode.el @@ -249,13 +249,13 @@ by `semantic-decoration-styles'." (define-minor-mode semantic-decoration-mode "Minor mode for decorating tags. -Decorations are specified in `semantic-decoration-styles'. -You can define new decoration styles with +Decorations are specified in `semantic-decoration-styles'. You +can define new decoration styles with `define-semantic-decoration-style'. -With prefix argument ARG, turn on if positive, otherwise off. The -minor mode can be turned on only if semantic feature is available and -the current buffer was set up for parsing. Return non-nil if the -minor mode is enabled." + +The minor mode can be turned on only if semantic feature is +available and the current buffer was set up for parsing. Return +non-nil if the minor mode is enabled." ;; ;;\\{semantic-decoration-map}" nil nil nil diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el index 56398d0627..07b7af8942 100644 --- a/lisp/cedet/semantic/idle.el +++ b/lisp/cedet/semantic/idle.el @@ -172,11 +172,9 @@ some command requests the list of available tokens. When idle-scheduler is enabled, Emacs periodically checks to see if the buffer is out of date, and reparses while the user is idle (not typing.) -With prefix argument ARG, turn on if positive, otherwise off. The -minor mode can be turned on only if semantic feature is available and -the current buffer was set up for parsing. Return non-nil if the -minor mode is enabled." - nil nil nil +The minor mode can be turned on only if semantic feature is +available and the current buffer was set up for parsing. Return +non-nil if the minor mode is enabled." nil nil nil (if semantic-idle-scheduler-mode (if (not (and (featurep 'semantic) (semantic-active-p))) (progn @@ -776,8 +774,6 @@ current tag to display information." (define-minor-mode semantic-idle-summary-mode "Toggle Semantic Idle Summary mode. -With ARG, turn Semantic Idle Summary mode on if ARG is positive, -off otherwise. When this minor mode is enabled, the echo area displays a summary of the lexical token at point whenever Emacs is idle." @@ -812,8 +808,6 @@ of the lexical token at point whenever Emacs is idle." (define-minor-mode global-semantic-idle-summary-mode "Toggle Global Semantic Idle Summary mode. -With ARG, turn Global Semantic Idle Summary mode on if ARG is -positive, off otherwise. When this minor mode is enabled, `semantic-idle-summary-mode' is turned on in every Semantic-supported buffer." @@ -931,9 +925,10 @@ Call `semantic-symref-hits-in-region' to identify local references." ;;;###autoload (define-minor-mode global-semantic-idle-scheduler-mode "Toggle global use of option `semantic-idle-scheduler-mode'. -The idle scheduler will automatically reparse buffers in idle time, -and then schedule other jobs setup with `semantic-idle-scheduler-add'. -If ARG is positive or nil, enable, if it is negative, disable." + +The idle scheduler will automatically reparse buffers in idle +time, and then schedule other jobs setup with +`semantic-idle-scheduler-add'." :global t :group 'semantic :group 'semantic-modes diff --git a/lisp/cedet/semantic/mru-bookmark.el b/lisp/cedet/semantic/mru-bookmark.el index ad63014890..5789881d38 100644 --- a/lisp/cedet/semantic/mru-bookmark.el +++ b/lisp/cedet/semantic/mru-bookmark.el @@ -252,8 +252,7 @@ been edited, and you can re-visit them with \\[semantic-mrub-switch-tags]." ;;;###autoload (define-minor-mode global-semantic-mru-bookmark-mode - "Toggle global use of option `semantic-mru-bookmark-mode'. -If ARG is positive or nil, enable, if it is negative, disable." + "Toggle global use of option `semantic-mru-bookmark-mode'." :global t :group 'semantic :group 'semantic-modes ;; Not needed because it's autoloaded instead. ;; :require 'semantic-util-modes @@ -278,10 +277,9 @@ been edited, and you can re-visit them with \\[semantic-mrub-switch-tags]. \\{semantic-mru-bookmark-mode-map} -With prefix argument ARG, turn on if positive, otherwise off. The -minor mode can be turned on only if semantic feature is available and -the current buffer was set up for parsing. Return non-nil if the -minor mode is enabled." +The minor mode can be turned on only if semantic feature is +available and the current buffer was set up for parsing. Return +non-nil if the minor mode is enabled." :keymap semantic-mru-bookmark-mode-map (if semantic-mru-bookmark-mode (if (not (and (featurep 'semantic) (semantic-active-p))) diff --git a/lisp/cedet/semantic/util-modes.el b/lisp/cedet/semantic/util-modes.el index 54c9578773..180aca5b60 100644 --- a/lisp/cedet/semantic/util-modes.el +++ b/lisp/cedet/semantic/util-modes.el @@ -170,8 +170,7 @@ too an interactive function used to toggle the mode." ;;;###autoload (define-minor-mode global-semantic-highlight-edits-mode - "Toggle global use of option `semantic-highlight-edits-mode'. -If ARG is positive or nil, enable, if it is negative, disable." + "Toggle global use of option `semantic-highlight-edits-mode'." :global t :group 'semantic :group 'semantic-modes (semantic-toggle-minor-mode-globally 'semantic-highlight-edits-mode @@ -209,10 +208,10 @@ Changes are tracked by semantic so that the incremental parser can work properly. This mode will highlight those changes as they are made, and clear them when the incremental parser accounts for those edits. -With prefix argument ARG, turn on if positive, otherwise off. The -minor mode can be turned on only if semantic feature is available and -the current buffer was set up for parsing. Return non-nil if the -minor mode is enabled." + +The minor mode can be turned on only if semantic feature is +available and the current buffer was set up for parsing. Return +non-nil if the minor mode is enabled." :keymap semantic-highlight-edits-mode-map (if semantic-highlight-edits-mode (if (not (and (featurep 'semantic) (semantic-active-p))) @@ -237,8 +236,7 @@ minor mode is enabled." ;;;###autoload (define-minor-mode global-semantic-show-unmatched-syntax-mode - "Toggle global use of option `semantic-show-unmatched-syntax-mode'. -If ARG is positive or nil, enable, if it is negative, disable." + "Toggle global use of option `semantic-show-unmatched-syntax-mode'." :global t :group 'semantic :group 'semantic-modes ;; Not needed because it's autoloaded instead. ;; :require 'semantic/util-modes @@ -360,10 +358,9 @@ parser rules. These text characters are considered unmatched syntax. Often time, the display of unmatched syntax can expose coding problems before the compiler is run. -With prefix argument ARG, turn on if positive, otherwise off. The -minor mode can be turned on only if semantic feature is available and -the current buffer was set up for parsing. Return non-nil if the -minor mode is enabled. +The minor mode can be turned on only if semantic feature is +available and the current buffer was set up for parsing. Return +non-nil if the minor mode is enabled. \\{semantic-show-unmatched-syntax-mode-map}" :keymap semantic-show-unmatched-syntax-mode-map @@ -410,8 +407,7 @@ minor mode is enabled. ;;;###autoload (define-minor-mode global-semantic-show-parser-state-mode - "Toggle global use of option `semantic-show-parser-state-mode'. -If ARG is positive or nil, enable, if it is negative, disable." + "Toggle global use of option `semantic-show-parser-state-mode'." :global t :group 'semantic ;; Not needed because it's autoloaded instead. ;; :require 'semantic/util-modes @@ -440,10 +436,10 @@ The state is indicated in the modeline with the following characters: `~' -> The cache needs to be incrementally parsed. `%' -> The cache is not currently parsable. `@' -> Auto-parse in progress (not set here.) -With prefix argument ARG, turn on if positive, otherwise off. The -minor mode can be turned on only if semantic feature is available and -the current buffer was set up for parsing. Return non-nil if the -minor mode is enabled." + +The minor mode can be turned on only if semantic feature is +available and the current buffer was set up for parsing. Return +non-nil if the minor mode is enabled." :keymap semantic-show-parser-state-mode-map (if semantic-show-parser-state-mode (if (not (and (featurep 'semantic) (semantic-active-p))) @@ -557,8 +553,7 @@ to indicate a parse in progress." ;;;###autoload (define-minor-mode global-semantic-stickyfunc-mode - "Toggle global use of option `semantic-stickyfunc-mode'. -If ARG is positive or nil, enable, if it is negative, disable." + "Toggle global use of option `semantic-stickyfunc-mode'." :global t :group 'semantic :group 'semantic-modes ;; Not needed because it's autoloaded instead. ;; :require 'semantic/util-modes @@ -700,10 +695,9 @@ A function (or other tag class specified by first line which describes the rest of the construct. This first line is what is displayed in the header line. -With prefix argument ARG, turn on if positive, otherwise off. The -minor mode can be turned on only if semantic feature is available and -the current buffer was set up for parsing. Return non-nil if the -minor mode is enabled." +The minor mode can be turned on only if semantic feature is +available and the current buffer was set up for parsing. Return +non-nil if the minor mode is enabled." ;; Don't need indicator. It's quite visible :keymap semantic-stickyfunc-mode-map (if semantic-stickyfunc-mode @@ -837,8 +831,7 @@ Argument EVENT describes the event that caused this function to be called." ;;;###autoload (define-minor-mode global-semantic-highlight-func-mode - "Toggle global use of option `semantic-highlight-func-mode'. -If ARG is positive or nil, enable, if it is negative, disable." + "Toggle global use of option `semantic-highlight-func-mode'." :global t :group 'semantic :group 'semantic-modes ;; Not needed because it's autoloaded instead. ;; :require 'semantic/util-modes @@ -933,10 +926,9 @@ See `semantic-stickyfunc-mode' for putting a function in the header line. This mode recycles the stickyfunc configuration classes list. -With prefix argument ARG, turn on if positive, otherwise off. The -minor mode can be turned on only if semantic feature is available and -the current buffer was set up for parsing. Return non-nil if the -minor mode is enabled." +The minor mode can be turned on only if semantic feature is +available and the current buffer was set up for parsing. Return +non-nil if the minor mode is enabled." :lighter nil ;; Don't need indicator. It's quite visible. (if semantic-highlight-func-mode (progn diff --git a/lisp/cedet/srecode/mode.el b/lisp/cedet/srecode/mode.el index 76e7e08761..28e8b3b64e 100644 --- a/lisp/cedet/srecode/mode.el +++ b/lisp/cedet/srecode/mode.el @@ -148,10 +148,10 @@ ;;;###autoload (define-minor-mode srecode-minor-mode "Toggle srecode minor mode. -With prefix argument ARG, turn on if positive, otherwise off. The -minor mode can be turned on only if semantic feature is available and -the current buffer was set up for parsing. Return non-nil if the -minor mode is enabled. + +The minor mode can be turned on only if semantic feature is +available and the current buffer was set up for parsing. Return +non-nil if the minor mode is enabled. \\{srecode-mode-map}" :keymap srecode-mode-map @@ -176,8 +176,7 @@ minor mode is enabled. ;;;###autoload (define-minor-mode global-srecode-minor-mode - "Toggle global use of srecode minor mode. -If ARG is positive or nil, enable, if it is negative, disable." + "Toggle global use of srecode minor mode." :global t :group 'srecode ;; Not needed because it's autoloaded instead. ;; :require 'srecode/mode diff --git a/lisp/completion.el b/lisp/completion.el index 2ddf0999e4..66b413f6af 100644 --- a/lisp/completion.el +++ b/lisp/completion.el @@ -2275,10 +2275,7 @@ TYPE is the type of the wrapper to be added. Can be :before or :under." ;;;###autoload (define-minor-mode dynamic-completion-mode - "Toggle dynamic word-completion on or off. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil." + "Toggle dynamic word-completion on or off." :global t :group 'completion ;; This is always good, not specific to dynamic-completion-mode. diff --git a/lisp/composite.el b/lisp/composite.el index 76949fb582..7daea54c9e 100644 --- a/lisp/composite.el +++ b/lisp/composite.el @@ -829,9 +829,6 @@ This function is the default value of `auto-composition-function' (which see)." ;;;###autoload (define-minor-mode auto-composition-mode "Toggle Auto Composition mode. -With a prefix argument ARG, enable Auto Composition mode if ARG -is positive, and disable it otherwise. If called from Lisp, -enable the mode if ARG is omitted or nil. When Auto Composition mode is enabled, text characters are automatically composed by functions registered in @@ -847,9 +844,6 @@ Auto Composition mode in all buffers (this is the default)." ;;;###autoload (define-minor-mode global-auto-composition-mode "Toggle Auto Composition mode in all buffers. -With a prefix argument ARG, enable it if ARG is positive, and -disable it otherwise. If called from Lisp, enable it if ARG is -omitted or nil. For more information on Auto Composition mode, see `auto-composition-mode' ." diff --git a/lisp/delsel.el b/lisp/delsel.el index bfccdc6a4c..a3c2934947 100644 --- a/lisp/delsel.el +++ b/lisp/delsel.el @@ -70,12 +70,6 @@ Value must be the register (key) to use.") ;;;###autoload (define-minor-mode delete-selection-mode "Toggle Delete Selection mode. -Interactively, with a prefix argument, enable -Delete Selection mode if the prefix argument is positive, -and disable it otherwise. If called from Lisp, toggle -the mode if ARG is `toggle', disable the mode if ARG is -a non-positive integer, and enable the mode otherwise -\(including if ARG is omitted or nil or a positive integer). When Delete Selection mode is enabled, typed text replaces the selection if the selection is active. Otherwise, typed text is just inserted at diff --git a/lisp/desktop.el b/lisp/desktop.el index 3e1ba200b5..a9fa2873b3 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -161,9 +161,6 @@ Used at desktop read to provide backward compatibility.") ;;;###autoload (define-minor-mode desktop-save-mode "Toggle desktop saving (Desktop Save mode). -With a prefix argument ARG, enable Desktop Save mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode if ARG -is omitted or nil. When Desktop Save mode is enabled, the state of Emacs is saved from one session to another. In particular, Emacs will save the desktop when diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 4517dedeeb..f07a5deb4f 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -139,9 +139,6 @@ folding to be used on case-insensitive filesystems only." (define-minor-mode dired-omit-mode "Toggle omission of uninteresting files in Dired (Dired-Omit mode). -With a prefix argument ARG, enable Dired-Omit mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. Dired-Omit mode is a buffer-local minor mode. When enabled in a Dired buffer, Dired does not list files whose filenames match diff --git a/lisp/dirtrack.el b/lisp/dirtrack.el index e5e1497c4d..862268d49b 100644 --- a/lisp/dirtrack.el +++ b/lisp/dirtrack.el @@ -184,9 +184,6 @@ and ends with a forward slash." ;;;###autoload (define-minor-mode dirtrack-mode "Toggle directory tracking in shell buffers (Dirtrack mode). -With a prefix argument ARG, enable Dirtrack mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. This method requires that your shell prompt contain the current working directory at all times, and that you set the variable @@ -205,10 +202,7 @@ directory." "23.1") (define-obsolete-variable-alias 'dirtrack-debug 'dirtrack-debug-mode "23.1") (define-minor-mode dirtrack-debug-mode - "Toggle Dirtrack debugging. -With a prefix argument ARG, enable Dirtrack debugging if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil." + "Toggle Dirtrack debugging." nil nil nil (if dirtrack-debug-mode (display-buffer (get-buffer-create dirtrack-debug-buffer)))) diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 792447b4d8..2b2c6874db 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -1859,9 +1859,6 @@ to the next best mode." ;;;###autoload (define-minor-mode doc-view-minor-mode "Toggle displaying buffer via Doc View (Doc View minor mode). -With a prefix argument ARG, enable Doc View minor mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. See the command `doc-view-mode' for more information on this mode." nil " DocView" doc-view-minor-mode-map diff --git a/lisp/double.el b/lisp/double.el index 4334a4ca70..b21fe5bc20 100644 --- a/lisp/double.el +++ b/lisp/double.el @@ -150,9 +150,6 @@ but not `C-u X' or `ESC X' since the X is not the prefix key." ;;;###autoload (define-minor-mode double-mode "Toggle special insertion on double keypresses (Double mode). -With a prefix argument ARG, enable Double mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. When Double mode is enabled, some keys will insert different strings when pressed twice. See `double-map' for details." diff --git a/lisp/elec-pair.el b/lisp/elec-pair.el index 85c25f0469..7df7098295 100644 --- a/lisp/elec-pair.el +++ b/lisp/elec-pair.el @@ -581,9 +581,6 @@ ARG and KILLP are passed directly to ;;;###autoload (define-minor-mode electric-pair-mode "Toggle automatic parens pairing (Electric Pair mode). -With a prefix argument ARG, enable Electric Pair mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. Electric Pair mode is a global minor mode. When enabled, typing an open parenthesis automatically inserts the corresponding diff --git a/lisp/electric.el b/lisp/electric.el index a45faf2dbb..8730b0752c 100644 --- a/lisp/electric.el +++ b/lisp/electric.el @@ -325,9 +325,6 @@ column specified by the function `current-left-margin'." ;;;###autoload (define-minor-mode electric-indent-mode "Toggle on-the-fly reindentation (Electric Indent mode). -With a prefix argument ARG, enable Electric Indent mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. When enabled, this reindents whenever the hook `electric-indent-functions' returns non-nil, or if you insert a character from `electric-indent-chars'. @@ -411,9 +408,7 @@ newline after CHAR but stay in the same place.") ;;;###autoload (define-minor-mode electric-layout-mode "Automatically insert newlines around some chars. -With a prefix argument ARG, enable Electric Layout mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. + The variable `electric-layout-rules' says when and how to insert newlines." :global t :group 'electricity (cond (electric-layout-mode @@ -551,9 +546,6 @@ This requotes when a quoting key is typed." ;;;###autoload (define-minor-mode electric-quote-mode "Toggle on-the-fly requoting (Electric Quote mode). -With a prefix argument ARG, enable Electric Quote mode if -ARG is positive, and disable it otherwise. If called from Lisp, -enable the mode if ARG is omitted or nil. When enabled, as you type this replaces \\=` with â€, \\=' with ’, \\=`\\=` with “, and \\='\\=' with ”. This occurs only in comments, strings, diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 300a3908c1..1b3b23d887 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -1237,9 +1237,6 @@ TEXT, START, END and UNFIXABLE conform to ;;;###autoload (define-minor-mode checkdoc-minor-mode "Toggle automatic docstring checking (Checkdoc minor mode). -With a prefix argument ARG, enable Checkdoc minor mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. In Checkdoc minor mode, the usual bindings for `eval-defun' which is bound to \\<checkdoc-minor-mode-map>\\[checkdoc-eval-defun] and `checkdoc-eval-current-buffer' are overridden to include diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index a81b6fefb2..b83b53a8e5 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -81,6 +81,26 @@ replacing its case-insensitive matches with the literal string in LIGHTER." ;; space.) (replace-regexp-in-string (regexp-quote lighter) lighter name t t)))) +(defconst easy-mmode--arg-docstring + " + +If called interactively, enable %s if ARG is positive, and +disable it if ARG is zero or negative. If called from Lisp, +also enable the mode if ARG is omitted or nil, and toggle it +if ARG is `toggle'; disable the mode otherwise.") + +(defun easy-mmode--mode-docstring (doc mode-pretty-name keymap-sym) + (let ((doc (or doc (format "Toggle %s on or off. + +\\{%s}" mode-pretty-name keymap-sym)))) + (if (string-match-p "\\bARG\\b" doc) + doc + (let ((argdoc (format easy-mmode--arg-docstring + mode-pretty-name))) + (replace-regexp-in-string "\\(\n\n\\|\\'\\)\\(.\\|\n\\)*\\'" + (concat argdoc "\\1") + doc nil nil 1))))) + ;;;###autoload (defalias 'easy-mmode-define-minor-mode 'define-minor-mode) ;;;###autoload @@ -101,7 +121,9 @@ non-positive integer, and enables the mode otherwise (including if the argument is omitted or nil or a positive integer). If DOC is nil, give the mode command a basic doc-string -documenting what its argument does. +documenting what its argument does. If the word \"ARG\" does not +appear in DOC, a paragraph is added to DOC explaining +usage of the mode argument. Optional INIT-VALUE is the initial value of the mode's variable. Optional LIGHTER is displayed in the mode line when the mode is on. @@ -270,12 +292,7 @@ or call the function `%s'.")))) ;; The actual function. (defun ,modefun (&optional arg ,@extra-args) - ,(or doc - (format (concat "Toggle %s on or off. -With a prefix argument ARG, enable %s if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. -\\{%s}") pretty-name pretty-name keymap-sym)) + ,(easy-mmode--mode-docstring doc pretty-name keymap-sym) ;; Use `toggle' rather than (if ,mode 0 1) so that using ;; repeat-command still does the toggling correctly. (interactive (list (or current-prefix-arg 'toggle))) diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index a662265f4b..49ba71fb1b 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -177,9 +177,6 @@ printed after commands contained in this obarray." ;;;###autoload (define-minor-mode eldoc-mode "Toggle echo area display of Lisp objects at point (ElDoc mode). -With a prefix argument ARG, enable ElDoc mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable ElDoc mode -if ARG is omitted or nil. ElDoc mode is a buffer-local minor mode. When enabled, the echo area displays information about a function or variable in the diff --git a/lisp/emacs-lock.el b/lisp/emacs-lock.el index b6e28fb253..0733c3326c 100644 --- a/lisp/emacs-lock.el +++ b/lisp/emacs-lock.el @@ -189,9 +189,7 @@ Return a value appropriate for `kill-buffer-query-functions' (which see)." (define-minor-mode emacs-lock-mode "Toggle Emacs Lock mode in the current buffer. If called with a plain prefix argument, ask for the locking mode -to be used. With any other prefix ARG, turn mode on if ARG is -positive, off otherwise. If called from Lisp, enable the mode if -ARG is omitted or nil. +to be used. Initially, if the user does not pass an explicit locking mode, it defaults to `emacs-lock-default-locking-mode' (which see); diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index ff23484dd0..f1143425eb 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@ -1318,9 +1318,6 @@ If ARG is the atom `-', scroll upward by nearly full screen." ;;;###autoload (define-minor-mode cua-mode "Toggle Common User Access style editing (CUA mode). -With a prefix argument ARG, enable CUA mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. CUA mode is a global minor mode. When enabled, typed text replaces the active selection, and you can use C-z, C-x, C-c, and diff --git a/lisp/epa-hook.el b/lisp/epa-hook.el index 135c956c3f..19f131cc33 100644 --- a/lisp/epa-hook.el +++ b/lisp/epa-hook.el @@ -83,10 +83,7 @@ May either be a string or a list of strings.") (auto-save-mode 0))) (define-minor-mode auto-encryption-mode - "Toggle automatic file encryption/decryption (Auto Encryption mode). -With a prefix argument ARG, enable Auto Encryption mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil." + "Toggle automatic file encryption/decryption (Auto Encryption mode)." :global t :init-value t :group 'epa-file :version "23.1" ;; We'd like to use custom-initialize-set here so the setup is done ;; before dumping, but at the point where the defcustom is evaluated, diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el index 7f4c28e967..008593712b 100644 --- a/lisp/epa-mail.el +++ b/lisp/epa-mail.el @@ -47,10 +47,7 @@ ;;;###autoload (define-minor-mode epa-mail-mode - "A minor-mode for composing encrypted/clearsigned mails. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil." + "A minor-mode for composing encrypted/clearsigned mails." nil " epa-mail" epa-mail-mode-map) (defun epa-mail--find-usable-key (keys usage) @@ -238,10 +235,7 @@ The buffer is expected to contain a mail message." ;;;###autoload (define-minor-mode epa-global-mail-mode - "Minor mode to hook EasyPG into Mail mode. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil." + "Minor mode to hook EasyPG into Mail mode." :global t :init-value nil :group 'epa-mail :version "23.1" (remove-hook 'mail-mode-hook 'epa-mail-mode) (if epa-global-mail-mode diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index 7817a0799e..cae18f6093 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -495,9 +495,6 @@ START is the minimum length of the name used." ;;;###autoload (define-minor-mode erc-track-minor-mode "Toggle mode line display of ERC activity (ERC Track minor mode). -With a prefix argument ARG, enable ERC Track minor mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. ERC Track minor mode is a global minor mode. It exists for the sole purpose of providing the C-c C-SPC and C-c C-@ keybindings. diff --git a/lisp/face-remap.el b/lisp/face-remap.el index 476736773b..c6a976deb0 100644 --- a/lisp/face-remap.el +++ b/lisp/face-remap.el @@ -229,9 +229,6 @@ Each positive or negative step scales the default face height by this amount." (define-minor-mode text-scale-mode "Minor mode for displaying buffer text in a larger/smaller font. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. The amount of scaling is determined by the variable `text-scale-mode-amount': one step scales the global default @@ -387,10 +384,9 @@ plist, etc." ;;;###autoload (define-minor-mode buffer-face-mode "Minor mode for a buffer-specific default face. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. When enabled, the face specified by the -variable `buffer-face-mode-face' is used to display the buffer text." + +When enabled, the face specified by the variable +`buffer-face-mode-face' is used to display the buffer text." :lighter " BufFace" (when buffer-face-mode-remapping (face-remap-remove-relative buffer-face-mode-remapping)) diff --git a/lisp/files.el b/lisp/files.el index 398e6dc12b..31e2f39a8d 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -419,14 +419,10 @@ idle for `auto-save-visited-interval' seconds." (define-minor-mode auto-save-visited-mode "Toggle automatic saving to file-visiting buffers on or off. -With a prefix argument ARG, enable regular saving of all buffers -visiting a file if ARG is positive, and disable it otherwise. + Unlike `auto-save-mode', this mode will auto-save buffer contents to the visited files directly and will also run all save-related -hooks. See Info node `Saving' for details of the save process. - -If called from Lisp, enable the mode if ARG is omitted or nil, -and toggle it if ARG is `toggle'." +hooks. See Info node `Saving' for details of the save process." :group 'auto-save :global t (when auto-save--timer (cancel-timer auto-save--timer)) diff --git a/lisp/follow.el b/lisp/follow.el index fd397c077b..7aa7b51473 100644 --- a/lisp/follow.el +++ b/lisp/follow.el @@ -383,9 +383,6 @@ This is typically set by explicit scrolling commands.") ;;;###autoload (define-minor-mode follow-mode "Toggle Follow mode. -With a prefix argument ARG, enable Follow mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. Follow mode is a minor mode that combines windows into one tall virtual window. This is accomplished by two main techniques: diff --git a/lisp/font-core.el b/lisp/font-core.el index ace1476eda..c5b036e04f 100644 --- a/lisp/font-core.el +++ b/lisp/font-core.el @@ -78,9 +78,6 @@ It will be passed one argument, which is the current value of (define-minor-mode font-lock-mode "Toggle syntax highlighting in this buffer (Font Lock mode). -With a prefix argument ARG, enable Font Lock mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. When Font Lock mode is enabled, text is fontified as you type it: diff --git a/lisp/frame.el b/lisp/frame.el index 70b4b242a0..56b8c5487c 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1382,9 +1382,6 @@ To get the frame's current border color, use `frame-parameters'." (define-minor-mode auto-raise-mode "Toggle whether or not selected frames should auto-raise. -With a prefix argument ARG, enable Auto Raise mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. Auto Raise mode does nothing under most window managers, which switch focus on mouse clicks. It only has an effect if your @@ -1402,9 +1399,6 @@ often have their own auto-raise feature." (define-minor-mode auto-lower-mode "Toggle whether or not the selected frame should auto-lower. -With a prefix argument ARG, enable Auto Lower mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. Auto Lower mode does nothing under most window managers, which switch focus on mouse clicks. It only has an effect if your @@ -2297,9 +2291,6 @@ all divider widths to zero." (define-minor-mode window-divider-mode "Display dividers between windows (Window Divider mode). -With a prefix argument ARG, enable Window Divider mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. The option `window-divider-default-places' specifies on which side of a window dividers are displayed. The options @@ -2450,9 +2441,6 @@ stopped by `blink-cursor-suspend'. Internally calls (define-minor-mode blink-cursor-mode "Toggle cursor blinking (Blink Cursor mode). -With a prefix argument ARG, enable Blink Cursor mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. If the value of `blink-cursor-blinks' is positive (10 by default), the cursor stops blinking after that number of blinks, if Emacs diff --git a/lisp/help.el b/lisp/help.el index 985d9c567a..28288e57f6 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1107,9 +1107,6 @@ function is called, the window to be resized is selected." (define-minor-mode temp-buffer-resize-mode "Toggle auto-resizing temporary buffer windows (Temp Buffer Resize Mode). -With a prefix argument ARG, enable Temp Buffer Resize mode if ARG -is positive, and disable it otherwise. If called from Lisp, -enable the mode if ARG is omitted or nil. When Temp Buffer Resize mode is enabled, the windows in which we show a temporary buffer are automatically resized in height to diff --git a/lisp/hexl.el b/lisp/hexl.el index ad860aee18..230b64d9f2 100644 --- a/lisp/hexl.el +++ b/lisp/hexl.el @@ -997,6 +997,7 @@ Embedded whitespace, dashes, and periods in the string are ignored." (define-minor-mode hexl-follow-ascii-mode "Minor mode to follow ASCII in current Hexl buffer. + When following is enabled, the ASCII character corresponding to the element under the point is highlighted. The default activation is controlled by `hexl-follow-ascii'." diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index f3a329f467..13ebffb1af 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -289,9 +289,6 @@ a library is being loaded.") ;;;###autoload (define-minor-mode hi-lock-mode "Toggle selective highlighting of patterns (Hi Lock mode). -With a prefix argument ARG, enable Hi Lock mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. Hi Lock mode is automatically enabled when you invoke any of the highlighting commands listed below, such as \\[highlight-regexp]. diff --git a/lisp/hilit-chg.el b/lisp/hilit-chg.el index 9d4d2d8b38..70bf6b44b9 100644 --- a/lisp/hilit-chg.el +++ b/lisp/hilit-chg.el @@ -319,9 +319,6 @@ remove it from existing buffers." ;;;###autoload (define-minor-mode highlight-changes-mode "Toggle highlighting changes in this buffer (Highlight Changes mode). -With a prefix argument ARG, enable Highlight Changes mode if ARG -is positive, and disable it otherwise. If called from Lisp, -enable the mode if ARG is omitted or nil. When Highlight Changes is enabled, changes are marked with a text property. Normally they are displayed in a distinctive face, but @@ -360,9 +357,6 @@ buffer with the contents of a file ;;;###autoload (define-minor-mode highlight-changes-visible-mode "Toggle visibility of highlighting due to Highlight Changes mode. -With a prefix argument ARG, enable Highlight Changes Visible mode -if ARG is positive, and disable it otherwise. If called from -Lisp, enable the mode if ARG is omitted or nil. Highlight Changes Visible mode only has an effect when Highlight Changes mode is on. When enabled, the changed text is displayed diff --git a/lisp/hl-line.el b/lisp/hl-line.el index fc75b478c8..f0ee22a1da 100644 --- a/lisp/hl-line.el +++ b/lisp/hl-line.el @@ -132,9 +132,6 @@ This variable is expected to be made buffer-local by modes.") ;;;###autoload (define-minor-mode hl-line-mode "Toggle highlighting of the current line (Hl-Line mode). -With a prefix argument ARG, enable Hl-Line mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. Hl-Line mode is a buffer-local minor mode. If `hl-line-sticky-flag' is non-nil, Hl-Line mode highlights the @@ -203,9 +200,6 @@ such overlays in all buffers except the current one." ;;;###autoload (define-minor-mode global-hl-line-mode "Toggle line highlighting in all buffers (Global Hl-Line mode). -With a prefix argument ARG, enable Global Hl-Line mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. If `global-hl-line-sticky-flag' is non-nil, Global Hl-Line mode highlights the line about the current buffer's point in all live diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index a1adb1df35..d9949d2835 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el @@ -403,10 +403,7 @@ format. See `ibuffer-update-saved-filters-format' and ;;;###autoload (define-minor-mode ibuffer-auto-mode - "Toggle use of Ibuffer's auto-update facility (Ibuffer Auto mode). -With a prefix argument ARG, enable Ibuffer Auto mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil." + "Toggle use of Ibuffer's auto-update facility (Ibuffer Auto mode)." nil nil nil (unless (derived-mode-p 'ibuffer-mode) (error "This buffer is not in Ibuffer mode")) diff --git a/lisp/icomplete.el b/lisp/icomplete.el index b37db8869b..ad5a9d017d 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -194,9 +194,6 @@ Last entry becomes the first and can be selected with ;;;###autoload (define-minor-mode icomplete-mode "Toggle incremental minibuffer completion (Icomplete mode). -With a prefix argument ARG, enable Icomplete mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. When this global minor mode is enabled, typing in the minibuffer continuously displays a list of possible completions that match diff --git a/lisp/ido.el b/lisp/ido.el index 3b102e07c5..f9a9607a3a 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -1582,10 +1582,7 @@ Removes badly formatted data and ignored directories." (add-hook 'choose-completion-string-functions 'ido-choose-completion-string)) (define-minor-mode ido-everywhere - "Toggle use of Ido for all buffer/file reading. -With a prefix argument ARG, enable this feature if ARG is -positive, and disable it otherwise. If called from Lisp, -enable the mode if ARG is omitted or nil." + "Toggle use of Ido for all buffer/file reading." :global t :group 'ido (remove-function read-file-name-function #'ido-read-file-name) diff --git a/lisp/image-file.el b/lisp/image-file.el index 8a04afc25f..19dc7878a5 100644 --- a/lisp/image-file.el +++ b/lisp/image-file.el @@ -179,9 +179,6 @@ Optional argument ARGS are the arguments to call FUNCTION with." ;;;###autoload (define-minor-mode auto-image-file-mode "Toggle visiting of image files as images (Auto Image File mode). -With a prefix argument ARG, enable Auto Image File mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. An image file is one whose name has an extension in `image-file-name-extensions', or matches a regexp in diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 0925c6ef9c..19fa28d440 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -617,9 +617,6 @@ mouse-3: Previous frame" ;;;###autoload (define-minor-mode image-minor-mode "Toggle Image minor mode in this buffer. -With a prefix argument ARG, enable Image minor mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. Image minor mode provides the key \\<image-mode-map>\\[image-toggle-display], to switch back to `image-mode' and display an image file as the diff --git a/lisp/international/iso-ascii.el b/lisp/international/iso-ascii.el index 0103d934b2..bcb285eda0 100644 --- a/lisp/international/iso-ascii.el +++ b/lisp/international/iso-ascii.el @@ -163,10 +163,7 @@ (iso-ascii-display 255 "\"y") ; small y with diaeresis or umlaut mark (define-minor-mode iso-ascii-mode - "Toggle ISO-ASCII mode. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil." + "Toggle ISO-ASCII mode." :variable ((eq standard-display-table iso-ascii-display-table) . (lambda (v) (setq standard-display-table diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el index df7272c12e..2b13c60bc6 100644 --- a/lisp/jit-lock.el +++ b/lisp/jit-lock.el @@ -266,6 +266,7 @@ If you need to debug code run from jit-lock, see `jit-lock-debug-mode'." (define-minor-mode jit-lock-debug-mode "Minor mode to help debug code run from jit-lock. + When this minor mode is enabled, jit-lock runs as little code as possible during redisplay and moves the rest to a timer, where things like `debug-on-error' and Edebug can be used." diff --git a/lisp/jka-cmpr-hook.el b/lisp/jka-cmpr-hook.el index cca8ef703f..d800b60513 100644 --- a/lisp/jka-cmpr-hook.el +++ b/lisp/jka-cmpr-hook.el @@ -347,9 +347,6 @@ variables. Setting this through Custom does that automatically." (define-minor-mode auto-compression-mode "Toggle Auto Compression mode. -With a prefix argument ARG, enable Auto Compression mode if ARG -is positive, and disable it otherwise. If called from Lisp, -enable the mode if ARG is omitted or nil. Auto Compression mode is a global minor mode. When enabled, compressed files are automatically uncompressed for reading, and diff --git a/lisp/language/thai-util.el b/lisp/language/thai-util.el index b550b65a56..d6c9732a9e 100644 --- a/lisp/language/thai-util.el +++ b/lisp/language/thai-util.el @@ -256,11 +256,10 @@ positions (integers or markers) specifying the region." (define-minor-mode thai-word-mode "Minor mode to make word-oriented commands aware of Thai words. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. The commands affected are -\\[forward-word], \\[backward-word], \\[kill-word], \\[backward-kill-word], -\\[transpose-words], and \\[fill-paragraph]." + +The commands affected are \\[forward-word], \\[backward-word], +\\[kill-word], \\[backward-kill-word], \\[transpose-words], and +\\[fill-paragraph]." :global t :group 'mule (cond (thai-word-mode ;; This enables linebreak between Thai characters. diff --git a/lisp/linum.el b/lisp/linum.el index 9df0c5d023..6e673e58b0 100644 --- a/lisp/linum.el +++ b/lisp/linum.el @@ -75,12 +75,10 @@ and you have to scroll or press \\[recenter-top-bottom] to update the numbers." ;;;###autoload (define-minor-mode linum-mode "Toggle display of line numbers in the left margin (Linum mode). -With a prefix argument ARG, enable Linum mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. Linum mode is a buffer-local minor mode." :lighter "" ; for desktop.el + :append-arg-docstring t (if linum-mode (progn (if linum-eager diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el index d35b87046f..f5d280ae1e 100644 --- a/lisp/mail/footnote.el +++ b/lisp/mail/footnote.el @@ -945,9 +945,6 @@ being set it is automatically widened." ;;;###autoload (define-minor-mode footnote-mode "Toggle Footnote mode. -With a prefix argument ARG, enable Footnote mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. Footnote mode is a buffer-local minor mode. If enabled, it provides footnote support for `message-mode'. To get started, diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el index ba1688f411..0ce1a3b12b 100644 --- a/lisp/mail/mailabbrev.el +++ b/lisp/mail/mailabbrev.el @@ -134,9 +134,6 @@ ;;;###autoload (define-minor-mode mail-abbrevs-mode "Toggle abbrev expansion of mail aliases (Mail Abbrevs mode). -With a prefix argument ARG, enable Mail Abbrevs mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. Mail Abbrevs mode is a global minor mode. When enabled, abbrev-like expansion is performed when editing certain mail diff --git a/lisp/master.el b/lisp/master.el index 4891c07166..7176897902 100644 --- a/lisp/master.el +++ b/lisp/master.el @@ -73,9 +73,6 @@ You can set this variable using `master-set-slave'.") ;;;###autoload (define-minor-mode master-mode "Toggle Master mode. -With a prefix argument ARG, enable Master mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. When Master mode is enabled, you can scroll the slave buffer using the following commands: diff --git a/lisp/mb-depth.el b/lisp/mb-depth.el index e75e497999..84c73cadfa 100644 --- a/lisp/mb-depth.el +++ b/lisp/mb-depth.el @@ -58,9 +58,6 @@ The prompt should already have been inserted." ;;;###autoload (define-minor-mode minibuffer-depth-indicate-mode "Toggle Minibuffer Depth Indication mode. -With a prefix argument ARG, enable Minibuffer Depth Indication -mode if ARG is positive, and disable it otherwise. If called -from Lisp, enable the mode if ARG is omitted or nil. Minibuffer Depth Indication mode is a global minor mode. When enabled, any recursive use of the minibuffer will show the diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 25e016247b..ad59533e26 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -2285,9 +2285,6 @@ It must accept a buffer as its only required argument.") (define-minor-mode menu-bar-mode "Toggle display of a menu bar on each frame (Menu Bar mode). -With a prefix argument ARG, enable Menu Bar mode if ARG is -positive, and disable it otherwise. If called from Lisp, also -enable Menu Bar mode if ARG is omitted or nil. This command applies to all frames that exist and frames to be created in the future." diff --git a/lisp/minibuf-eldef.el b/lisp/minibuf-eldef.el index 07663ea6a6..a81e663589 100644 --- a/lisp/minibuf-eldef.el +++ b/lisp/minibuf-eldef.el @@ -163,9 +163,6 @@ been set up by `minibuf-eldef-setup-minibuffer'." ;;;###autoload (define-minor-mode minibuffer-electric-default-mode "Toggle Minibuffer Electric Default mode. -With a prefix argument ARG, enable Minibuffer Electric Default -mode if ARG is positive, and disable it otherwise. If called -from Lisp, enable the mode if ARG is omitted or nil. Minibuffer Electric Default mode is a global minor mode. When enabled, minibuffer prompts that show a default value only show diff --git a/lisp/msb.el b/lisp/msb.el index 383f075bf9..91d83d2e4a 100644 --- a/lisp/msb.el +++ b/lisp/msb.el @@ -1132,9 +1132,6 @@ variable `msb-menu-cond'." ;;;###autoload (define-minor-mode msb-mode "Toggle Msb mode. -With a prefix argument ARG, enable Msb mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. This mode overrides the binding(s) of `mouse-buffer-menu' to provide a different buffer menu using the function `msb'." diff --git a/lisp/mwheel.el b/lisp/mwheel.el index f055df9ee8..876659f1f7 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -309,10 +309,7 @@ non-Windows systems." (defvar mwheel-installed-bindings nil) (define-minor-mode mouse-wheel-mode - "Toggle mouse wheel support (Mouse Wheel mode). -With a prefix argument ARG, enable Mouse Wheel mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil." + "Toggle mouse wheel support (Mouse Wheel mode)." :init-value t ;; We'd like to use custom-initialize-set here so the setup is done ;; before dumping, but at the point where the defcustom is evaluated, diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el index cc1cdd1518..db59df374b 100644 --- a/lisp/net/goto-addr.el +++ b/lisp/net/goto-addr.el @@ -270,10 +270,7 @@ Also fontifies the buffer appropriately (see `goto-address-fontify-p' and ;;;###autoload (define-minor-mode goto-address-mode - "Minor mode to buttonize URLs and e-mail addresses in the current buffer. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil." + "Minor mode to buttonize URLs and e-mail addresses in the current buffer." nil "" nil diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index abd969216f..5b63e0c34d 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -186,9 +186,6 @@ underneath each nick." (define-minor-mode rcirc-omit-mode "Toggle the hiding of \"uninteresting\" lines. -With a prefix argument ARG, enable Rcirc-Omit mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. Uninteresting lines are those whose responses are listed in `rcirc-omit-responses'." @@ -1353,10 +1350,7 @@ Create the buffer if it doesn't exist." "Keymap for multiline mode in rcirc.") (define-minor-mode rcirc-multiline-minor-mode - "Minor mode for editing multiple lines in rcirc. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil." + "Minor mode for editing multiple lines in rcirc." :init-value nil :lighter " rcirc-mline" :keymap rcirc-multiline-minor-mode-map @@ -1867,10 +1861,7 @@ This function does not alter the INPUT string." ;;;###autoload (define-minor-mode rcirc-track-minor-mode - "Global minor mode for tracking activity in rcirc buffers. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil." + "Global minor mode for tracking activity in rcirc buffers." :init-value nil :lighter "" :keymap rcirc-track-minor-mode-map diff --git a/lisp/obsolete/complete.el b/lisp/obsolete/complete.el index ee6af77029..f5e4328d33 100644 --- a/lisp/obsolete/complete.el +++ b/lisp/obsolete/complete.el @@ -191,7 +191,6 @@ If nil, means use the colon-separated path in the variable $INCPATH instead." ;;;###autoload (define-minor-mode partial-completion-mode "Toggle Partial Completion mode. -With prefix ARG, turn Partial Completion mode on if ARG is positive. When Partial Completion mode is enabled, TAB (or M-TAB if `PC-meta-flag' is nil) is enhanced so that if some string is divided into words and each word is diff --git a/lisp/obsolete/crisp.el b/lisp/obsolete/crisp.el index 1d09d9e223..4bd555a72e 100644 --- a/lisp/obsolete/crisp.el +++ b/lisp/obsolete/crisp.el @@ -353,10 +353,7 @@ normal CRiSP binding) and when it is nil M-x will run ;;;###autoload (define-minor-mode crisp-mode - "Toggle CRiSP/Brief emulation (CRiSP mode). -With a prefix argument ARG, enable CRiSP mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil." + "Toggle CRiSP/Brief emulation (CRiSP mode)." :keymap crisp-mode-map :lighter crisp-mode-mode-line-string (when crisp-mode diff --git a/lisp/obsolete/iswitchb.el b/lisp/obsolete/iswitchb.el index d03621df3c..6192368f8b 100644 --- a/lisp/obsolete/iswitchb.el +++ b/lisp/obsolete/iswitchb.el @@ -1417,9 +1417,6 @@ See the variable `iswitchb-case' for details." ;;;###autoload (define-minor-mode iswitchb-mode "Toggle Iswitchb mode. -With a prefix argument ARG, enable Iswitchb mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. Iswitchb mode is a global minor mode that enables switching between buffers using substrings. See `iswitchb' for details." diff --git a/lisp/obsolete/longlines.el b/lisp/obsolete/longlines.el index e3121dbd87..d07f7bf34b 100644 --- a/lisp/obsolete/longlines.el +++ b/lisp/obsolete/longlines.el @@ -97,9 +97,6 @@ This is used when `longlines-show-hard-newlines' is on." ;;;###autoload (define-minor-mode longlines-mode "Toggle Long Lines mode in this buffer. -With a prefix argument ARG, enable Long Lines mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. When Long Lines mode is enabled, long lines are wrapped if they extend beyond `fill-column'. The soft newlines used for line diff --git a/lisp/obsolete/mouse-sel.el b/lisp/obsolete/mouse-sel.el index 52e84f2117..f54bcf01c9 100644 --- a/lisp/obsolete/mouse-sel.el +++ b/lisp/obsolete/mouse-sel.el @@ -194,9 +194,6 @@ If nil, point will always be placed at the beginning of the region." ;;;###autoload (define-minor-mode mouse-sel-mode "Toggle Mouse Sel mode. -With a prefix argument ARG, enable Mouse Sel mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. Mouse Sel mode is a global minor mode. When enabled, mouse selection is enhanced in various ways: diff --git a/lisp/obsolete/old-whitespace.el b/lisp/obsolete/old-whitespace.el index 86dd5dc842..0c9fc32118 100644 --- a/lisp/obsolete/old-whitespace.el +++ b/lisp/obsolete/old-whitespace.el @@ -747,7 +747,6 @@ If timer is not set, then set it to scan the files in ;;;###autoload (define-minor-mode whitespace-global-mode "Toggle using Whitespace mode in new buffers. -With ARG, turn the mode on if ARG is positive, otherwise turn it off. When this mode is active, `whitespace-buffer' is added to `find-file-hook' and `kill-buffer-hook'." diff --git a/lisp/obsolete/tpu-edt.el b/lisp/obsolete/tpu-edt.el index 83b713d927..c047381ef7 100644 --- a/lisp/obsolete/tpu-edt.el +++ b/lisp/obsolete/tpu-edt.el @@ -980,10 +980,7 @@ and the total number of lines in the buffer." ;;; ;;;###autoload (define-minor-mode tpu-edt-mode - "Toggle TPU/edt emulation on or off. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil." + "Toggle TPU/edt emulation on or off." :global t :group 'tpu (if tpu-edt-mode (tpu-edt-on) (tpu-edt-off))) diff --git a/lisp/obsolete/tpu-extras.el b/lisp/obsolete/tpu-extras.el index 8739e1b215..21006ff005 100644 --- a/lisp/obsolete/tpu-extras.el +++ b/lisp/obsolete/tpu-extras.el @@ -133,10 +133,7 @@ the previous line when starting from a line beginning." ;;;###autoload (define-minor-mode tpu-cursor-free-mode - "Minor mode to allow the cursor to move freely about the screen. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil." + "Minor mode to allow the cursor to move freely about the screen." :init-value nil (if (not tpu-cursor-free-mode) (tpu-trim-line-ends)) diff --git a/lisp/obsolete/xesam.el b/lisp/obsolete/xesam.el index 1f3661d924..3e91b2c8df 100644 --- a/lisp/obsolete/xesam.el +++ b/lisp/obsolete/xesam.el @@ -512,9 +512,6 @@ engine specific, widget :notify function to visualize xesam:url." (define-minor-mode xesam-minor-mode "Toggle Xesam minor mode. -With a prefix argument ARG, enable Xesam minor mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. When Xesam minor mode is enabled, all text which matches a previous Xesam query in this buffer is highlighted." diff --git a/lisp/outline.el b/lisp/outline.el index 669935bbc1..59169e4189 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -299,9 +299,6 @@ After that, changing the prefix key requires manipulating keymaps." ;;;###autoload (define-minor-mode outline-minor-mode "Toggle Outline minor mode. -With a prefix argument ARG, enable Outline minor mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. See the command `outline-mode' for more information on this mode." nil " Outl" (list (cons [menu-bar] outline-minor-mode-menu-bar-map) diff --git a/lisp/paren.el b/lisp/paren.el index 467e5e985d..1cab6eb2be 100644 --- a/lisp/paren.el +++ b/lisp/paren.el @@ -100,9 +100,6 @@ its position." ;;;###autoload (define-minor-mode show-paren-mode "Toggle visualization of matching parens (Show Paren mode). -With a prefix argument ARG, enable Show Paren mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. Show Paren mode is a global minor mode. When enabled, any matching parenthesis is highlighted in `show-paren-style' after diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el index d362419e0f..227580f4d4 100644 --- a/lisp/pixel-scroll.el +++ b/lisp/pixel-scroll.el @@ -105,10 +105,7 @@ function returns nil." ;;;###autoload (define-minor-mode pixel-scroll-mode - "A minor mode to scroll text pixel-by-pixel. -With a prefix argument ARG, enable Pixel Scroll mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable Pixel Scroll mode -if ARG is omitted or nil." + "A minor mode to scroll text pixel-by-pixel." :init-value nil :group 'scrolling :global t diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index d2b3af1972..75bd0ba51e 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -141,10 +141,7 @@ The second subexpression should match the bug reference (usually a number)." ;;;###autoload (define-minor-mode bug-reference-mode - "Toggle hyperlinking bug references in the buffer (Bug Reference mode). -With a prefix argument ARG, enable Bug Reference mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil." + "Toggle hyperlinking bug references in the buffer (Bug Reference mode)." nil "" nil diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 15503ee0b2..7e7c18fb30 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -2164,9 +2164,6 @@ Optional argument MINOR indicates this is called from ;;;###autoload (define-minor-mode compilation-shell-minor-mode "Toggle Compilation Shell minor mode. -With a prefix argument ARG, enable Compilation Shell minor mode -if ARG is positive, and disable it otherwise. If called from -Lisp, enable the mode if ARG is omitted or nil. When Compilation Shell minor mode is enabled, all the error-parsing commands of the Compilation major mode are @@ -2181,9 +2178,6 @@ See `compilation-mode'." ;;;###autoload (define-minor-mode compilation-minor-mode "Toggle Compilation minor mode. -With a prefix argument ARG, enable Compilation minor mode if ARG -is positive, and disable it otherwise. If called from Lisp, -enable the mode if ARG is omitted or nil. When Compilation minor mode is enabled, all the error-parsing commands of Compilation major mode are available. See diff --git a/lisp/progmodes/cwarn.el b/lisp/progmodes/cwarn.el index a578896dbf..ff79b90956 100644 --- a/lisp/progmodes/cwarn.el +++ b/lisp/progmodes/cwarn.el @@ -180,11 +180,7 @@ Suspicious constructs are highlighted using `font-lock-warning-face'. Note, in addition to enabling this minor mode, the major mode must be included in the variable `cwarn-configuration'. By default C and -C++ modes are included. - -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil." +C++ modes are included." :group 'cwarn :lighter cwarn-mode-text (cwarn-font-lock-keywords cwarn-mode) (font-lock-flush)) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index e8bb3355a0..60d1660e5f 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -915,9 +915,6 @@ Interactively, with a prefix arg, FORCE is t." ;;;###autoload (define-minor-mode flymake-mode "Toggle Flymake mode on or off. -With a prefix argument ARG, enable Flymake mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. Flymake is an Emacs minor mode for on-the-fly syntax checking. Flymake collects diagnostic information from multiple sources, diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 88e34d8df9..6fee895e6a 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -1138,9 +1138,7 @@ Changed values are highlighted with the face `font-lock-warning-face'." :version "22.2") (define-minor-mode gdb-speedbar-auto-raise - "Minor mode to automatically raise the speedbar for watch expressions. -With prefix argument ARG, automatically raise speedbar if ARG is -positive, otherwise don't automatically raise it." + "Minor mode to automatically raise the speedbar for watch expressions." :global t :group 'gdb :version "22.1") diff --git a/lisp/progmodes/glasses.el b/lisp/progmodes/glasses.el index c3e8ac35f3..f2bf209946 100644 --- a/lisp/progmodes/glasses.el +++ b/lisp/progmodes/glasses.el @@ -312,10 +312,9 @@ recognized according to the current value of the variable `glasses-separator'." ;;;###autoload (define-minor-mode glasses-mode "Minor mode for making identifiers likeThis readable. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. When this mode is active, it tries to -add virtual separators (like underscores) at places they belong to." + +When this mode is active, it tries to add virtual +separators (like underscores) at places they belong to." :group 'glasses :lighter " o^o" (save-excursion (save-restriction diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 6826674a94..91b4a65edd 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -3363,10 +3363,7 @@ Treats actions as defuns." ;;;###autoload (define-minor-mode gud-tooltip-mode - "Toggle the display of GUD tooltips. -With a prefix argument ARG, enable the feature if ARG is -positive, and disable it otherwise. If called from Lisp, enable -it if ARG is omitted or nil." + "Toggle the display of GUD tooltips." :global t :group 'gud :group 'tooltip diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 7ac1312d8d..ce7127a3d7 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -263,9 +263,6 @@ This backup prevents any accidental clearance of `hide-fidef-env' by ;;;###autoload (define-minor-mode hide-ifdef-mode "Toggle features to hide/show #ifdef blocks (Hide-Ifdef mode). -With a prefix argument ARG, enable Hide-Ifdef mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. Hide-Ifdef mode is a buffer-local minor mode for use with C and C-like major modes. When enabled, code within #ifdef constructs diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index 799536cbf4..84b2147394 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -932,9 +932,6 @@ This can be useful if you have huge RCS logs in those comments." ;;;###autoload (define-minor-mode hs-minor-mode "Minor mode to selectively hide/show code and comment blocks. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. When hideshow minor mode is on, the menu bar is augmented with hideshow commands and the hideshow commands are enabled. diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index dcb81f5a94..616341b0a2 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -4251,9 +4251,6 @@ Otherwise, just expand the file name." (define-minor-mode idlwave-shell-electric-debug-mode "Toggle Idlwave Shell Electric Debug mode. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. When Idlwave Shell Electric Debug mode is enabled, the Idlwave Shell debugging commands are available as single key sequences." diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el index 58dc213d8a..6d13d328c5 100644 --- a/lisp/progmodes/pascal.el +++ b/lisp/progmodes/pascal.el @@ -1405,9 +1405,6 @@ The default is a name found in the buffer around point." (define-minor-mode pascal-outline-mode "Outline-line minor mode for Pascal mode. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. When enabled, portions of the text being edited may be made invisible.\\<pascal-outline-map> diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el index 19269766c9..b1a17dfa3c 100644 --- a/lisp/progmodes/prog-mode.el +++ b/lisp/progmodes/prog-mode.el @@ -196,9 +196,6 @@ on the symbol." ;;;###autoload (define-minor-mode prettify-symbols-mode "Toggle Prettify Symbols mode. -With a prefix argument ARG, enable Prettify Symbols mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. When Prettify Symbols mode and font-locking are enabled, symbols are prettified (displayed as composed characters) according to the rules diff --git a/lisp/progmodes/subword.el b/lisp/progmodes/subword.el index cbaa273a7a..ed71b862cf 100644 --- a/lisp/progmodes/subword.el +++ b/lisp/progmodes/subword.el @@ -93,9 +93,6 @@ ;;;###autoload (define-minor-mode subword-mode "Toggle subword movement and editing (Subword mode). -With a prefix argument ARG, enable Subword mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. Subword mode is a buffer-local minor mode. Enabling it changes the definition of a word so that word-based commands stop inside @@ -269,9 +266,6 @@ Optional argument ARG is the same as for `capitalize-word'." ;;;###autoload (define-minor-mode superword-mode "Toggle superword movement and editing (Superword mode). -With a prefix argument ARG, enable Superword mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. Superword mode is a buffer-local minor mode. Enabling it changes the definition of words such that symbols characters are treated diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index f6cb2419de..e17b7f504e 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -8707,17 +8707,11 @@ project is defined." ;; Enabling/disabling (define-minor-mode vhdl-electric-mode - "Toggle VHDL electric mode. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable it if ARG -is omitted or nil." + "Toggle VHDL electric mode." :global t :group 'vhdl-mode) (define-minor-mode vhdl-stutter-mode - "Toggle VHDL stuttering mode. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable it if ARG -is omitted or nil." + "Toggle VHDL stuttering mode." :global t :group 'vhdl-mode) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index 152f6d2293..7604be0c25 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -247,9 +247,6 @@ It creates the Imenu index for the buffer, if necessary." ;;;###autoload (define-minor-mode which-function-mode "Toggle mode line display of current function (Which Function mode). -With a prefix argument ARG, enable Which Function mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. Which Function mode is a global minor mode. When enabled, the current function name is continuously displayed in the mode line, diff --git a/lisp/recentf.el b/lisp/recentf.el index c3c4e45922..e318486cde 100644 --- a/lisp/recentf.el +++ b/lisp/recentf.el @@ -1342,9 +1342,6 @@ That is, remove duplicates, non-kept, and excluded files." ;;;###autoload (define-minor-mode recentf-mode "Toggle \"Open Recent\" menu (Recentf mode). -With a prefix argument ARG, enable Recentf mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -Recentf mode if ARG is omitted or nil. When Recentf mode is enabled, a \"Open Recent\" submenu is displayed in the \"File\" menu, containing a list of files that diff --git a/lisp/rect.el b/lisp/rect.el index ba13e12358..8ccf051ee1 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -604,6 +604,7 @@ with a prefix argument, prompt for START-AT and FORMAT." ;;;###autoload (define-minor-mode rectangle-mark-mode "Toggle the region as rectangular. + Activates the region if needed. Only lasts until the region is deactivated." nil nil nil (rectangle--reset-crutches) diff --git a/lisp/reveal.el b/lisp/reveal.el index 2831c0cc01..a3ecfc490e 100644 --- a/lisp/reveal.el +++ b/lisp/reveal.el @@ -191,9 +191,6 @@ Each element has the form (WINDOW . OVERLAY).") ;;;###autoload (define-minor-mode reveal-mode "Toggle uncloaking of invisible text near point (Reveal mode). -With a prefix argument ARG, enable Reveal mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -Reveal mode if ARG is omitted or nil. Reveal mode is a buffer-local minor mode. When enabled, it reveals invisible text around point." @@ -210,11 +207,7 @@ reveals invisible text around point." ;;;###autoload (define-minor-mode global-reveal-mode "Toggle Reveal mode in all buffers (Global Reveal mode). -Reveal mode renders invisible text around point visible again. - -With a prefix argument ARG, enable Global Reveal mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil." +Reveal mode renders invisible text around point visible again." :global t :group 'reveal (setq-default reveal-mode global-reveal-mode) (if global-reveal-mode diff --git a/lisp/rfn-eshadow.el b/lisp/rfn-eshadow.el index 847db68a77..41fd8b5f97 100644 --- a/lisp/rfn-eshadow.el +++ b/lisp/rfn-eshadow.el @@ -209,9 +209,6 @@ been set up by `rfn-eshadow-setup-minibuffer'." (define-minor-mode file-name-shadow-mode "Toggle file-name shadowing in minibuffers (File-Name Shadow mode). -With a prefix argument ARG, enable File-Name Shadow mode if ARG -is positive, and disable it otherwise. If called from Lisp, -enable the mode if ARG is omitted or nil. File-Name Shadow mode is a global minor mode. When enabled, any part of a filename being read in the minibuffer that would be diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el index 02d5a211ba..366bd15041 100644 --- a/lisp/ruler-mode.el +++ b/lisp/ruler-mode.el @@ -591,10 +591,7 @@ format first." ;;;###autoload (define-minor-mode ruler-mode - "Toggle display of ruler in header line (Ruler mode). -With a prefix argument ARG, enable Ruler mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil." + "Toggle display of ruler in header line (Ruler mode)." nil nil ruler-mode-map :group 'ruler-mode diff --git a/lisp/savehist.el b/lisp/savehist.el index 0a261b0b0c..e555450c20 100644 --- a/lisp/savehist.el +++ b/lisp/savehist.el @@ -171,9 +171,6 @@ minibuffer history.") ;;;###autoload (define-minor-mode savehist-mode "Toggle saving of minibuffer history (Savehist mode). -With a prefix argument ARG, enable Savehist mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. When Savehist mode is enabled, minibuffer history is saved periodically and when exiting Emacs. When Savehist mode is diff --git a/lisp/saveplace.el b/lisp/saveplace.el index aeb6cf1de7..9d3f10ac35 100644 --- a/lisp/saveplace.el +++ b/lisp/saveplace.el @@ -160,9 +160,6 @@ If this mode is enabled, point is recorded when you kill the buffer or exit Emacs. Visiting this file again will go to that position, even in a later Emacs session. -If called with a prefix arg, the mode is enabled if and only if -the argument is positive. - To save places automatically in all files, put this in your init file: diff --git a/lisp/scroll-all.el b/lisp/scroll-all.el index dea15d58d8..c32960efba 100644 --- a/lisp/scroll-all.el +++ b/lisp/scroll-all.el @@ -102,9 +102,6 @@ ;;;###autoload (define-minor-mode scroll-all-mode "Toggle shared scrolling in same-frame windows (Scroll-All mode). -With a prefix argument ARG, enable Scroll-All mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. When Scroll-All mode is enabled, scrolling commands invoked in one window apply to all visible windows in the same frame." diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el index dd4a8aab0e..4d1ad03fa5 100644 --- a/lisp/scroll-bar.el +++ b/lisp/scroll-bar.el @@ -133,9 +133,6 @@ Setting the variable with a customization buffer also takes effect." (define-minor-mode scroll-bar-mode "Toggle vertical scroll bars on all frames (Scroll Bar mode). -With a prefix argument ARG, enable Scroll Bar mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. This command applies to all frames that exist and frames to be created in the future." @@ -152,9 +149,6 @@ created in the future." (define-minor-mode horizontal-scroll-bar-mode "Toggle horizontal scroll bars on all frames (Horizontal Scroll Bar mode). -With a prefix argument ARG, enable Horizontal Scroll Bar mode if -ARG is positive, and disable it otherwise. If called from Lisp, -enable the mode if ARG is omitted or nil. This command applies to all frames that exist and frames to be created in the future." diff --git a/lisp/scroll-lock.el b/lisp/scroll-lock.el index 2ce0f4578b..123fbb2b37 100644 --- a/lisp/scroll-lock.el +++ b/lisp/scroll-lock.el @@ -49,12 +49,11 @@ ;;;###autoload (define-minor-mode scroll-lock-mode "Buffer-local minor mode for pager-like scrolling. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. When enabled, keys that normally move -point by line or paragraph will scroll the buffer by the -respective amount of lines instead and point will be kept -vertically fixed relative to window boundaries during scrolling." + +When enabled, keys that normally move point by line or paragraph +will scroll the buffer by the respective amount of lines instead +and point will be kept vertically fixed relative to window +boundaries during scrolling." :lighter " ScrLck" :keymap scroll-lock-mode-map (if scroll-lock-mode diff --git a/lisp/server.el b/lisp/server.el index 87942e8419..77850e49da 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -777,9 +777,6 @@ by the current Emacs process, use the `server-process' variable." ;;;###autoload (define-minor-mode server-mode "Toggle Server mode. -With a prefix argument ARG, enable Server mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -Server mode if ARG is omitted or nil. Server mode runs a process that accepts commands from the `emacsclient' program. See Info node `Emacs server' and diff --git a/lisp/shell.el b/lisp/shell.el index 91c65ed171..c78903b3e5 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -967,9 +967,6 @@ Environment variables are expanded, see function `substitute-in-file-name'." (define-minor-mode shell-dirtrack-mode "Toggle directory tracking in this shell buffer (Shell Dirtrack mode). -With a prefix argument ARG, enable Shell Dirtrack mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. The `dirtrack' package provides an alternative implementation of this feature; see the function `dirtrack-mode'." diff --git a/lisp/simple.el b/lisp/simple.el index f8c02c1dbf..e98cea78d4 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -401,9 +401,7 @@ select the source buffer." (define-minor-mode next-error-follow-minor-mode "Minor mode for compilation, occur and diff modes. -With a prefix argument ARG, enable mode if ARG is positive, and -disable it otherwise. If called from Lisp, enable mode if ARG is -omitted or nil. + When turned on, cursor motion in the compilation, grep, occur or diff buffer causes automatic display of the corresponding source code location." :group 'next-error :init-value nil :lighter " Fol" @@ -5817,9 +5815,6 @@ its earlier value." (define-minor-mode transient-mark-mode "Toggle Transient Mark mode. -With a prefix argument ARG, enable Transient Mark mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -Transient Mark mode if ARG is omitted or nil. Transient Mark mode is a global minor mode. When enabled, the region is highlighted with the `region' face whenever the mark @@ -6854,12 +6849,6 @@ other purposes." (define-minor-mode visual-line-mode "Toggle visual line based editing (Visual Line mode) in the current buffer. -Interactively, with a prefix argument, enable -Visual Line mode if the prefix argument is positive, -and disable it otherwise. If called from Lisp, toggle -the mode if ARG is `toggle', disable the mode if ARG is -a non-positive integer, and enable the mode otherwise -\(including if ARG is omitted or nil or a positive integer). When Visual Line mode is enabled, `word-wrap' is turned on in this buffer, and simple editing commands are redefined to act on @@ -7290,12 +7279,6 @@ Some major modes set this.") (define-minor-mode auto-fill-mode "Toggle automatic line breaking (Auto Fill mode). -Interactively, with a prefix argument, enable -Auto Fill mode if the prefix argument is positive, -and disable it otherwise. If called from Lisp, toggle -the mode if ARG is `toggle', disable the mode if ARG is -a non-positive integer, and enable the mode otherwise -\(including if ARG is omitted or nil or a positive integer). When Auto Fill mode is enabled, inserting a space at a column beyond `current-fill-column' automatically breaks the line at a @@ -7410,9 +7393,6 @@ if long lines are truncated." (define-minor-mode overwrite-mode "Toggle Overwrite mode. -With a prefix argument ARG, enable Overwrite mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. When Overwrite mode is enabled, printing characters typed in replace existing text on a one-for-one basis, rather than pushing @@ -7426,9 +7406,6 @@ characters when necessary." (define-minor-mode binary-overwrite-mode "Toggle Binary Overwrite mode. -With a prefix argument ARG, enable Binary Overwrite mode if ARG -is positive, and disable it otherwise. If called from Lisp, -enable the mode if ARG is omitted or nil. When Binary Overwrite mode is enabled, printing characters typed in replace existing text. Newlines are not treated specially, so @@ -7446,9 +7423,6 @@ a specialization of overwrite mode, entered by setting the (define-minor-mode line-number-mode "Toggle line number display in the mode line (Line Number mode). -With a prefix argument ARG, enable Line Number mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. Line numbers do not appear for very large buffers and buffers with very long lines; see variables `line-number-display-limit' @@ -7456,27 +7430,15 @@ and `line-number-display-limit-width'." :init-value t :global t :group 'mode-line) (define-minor-mode column-number-mode - "Toggle column number display in the mode line (Column Number mode). -With a prefix argument ARG, enable Column Number mode if ARG is -positive, and disable it otherwise. - -If called from Lisp, enable the mode if ARG is omitted or nil." + "Toggle column number display in the mode line (Column Number mode)." :global t :group 'mode-line) (define-minor-mode size-indication-mode - "Toggle buffer size display in the mode line (Size Indication mode). -With a prefix argument ARG, enable Size Indication mode if ARG is -positive, and disable it otherwise. - -If called from Lisp, enable the mode if ARG is omitted or nil." + "Toggle buffer size display in the mode line (Size Indication mode)." :global t :group 'mode-line) (define-minor-mode auto-save-mode - "Toggle auto-saving in the current buffer (Auto Save mode). -With a prefix argument ARG, enable Auto Save mode if ARG is -positive, and disable it otherwise. - -If called from Lisp, enable the mode if ARG is omitted or nil." + "Toggle auto-saving in the current buffer (Auto Save mode)." :variable ((and buffer-auto-save-file-name ;; If auto-save is off because buffer has shrunk, ;; then toggling should turn it on. @@ -8687,9 +8649,6 @@ call `normal-erase-is-backspace-mode' (which see) instead." (define-minor-mode normal-erase-is-backspace-mode "Toggle the Erase and Delete mode of the Backspace and Delete keys. -With a prefix argument ARG, enable this feature if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. On window systems, when this mode is on, Delete is mapped to C-d and Backspace is mapped to DEL; when this mode is off, both @@ -8766,9 +8725,9 @@ See also `normal-erase-is-backspace'." (define-minor-mode read-only-mode "Change whether the current buffer is read-only. -With prefix argument ARG, make the buffer read-only if ARG is -positive, otherwise make it writable. If buffer is read-only -and `view-read-only' is non-nil, enter view mode. + +If buffer is read-only and `view-read-only' is non-nil, enter +view mode. Do not call this from a Lisp program unless you really intend to do the same thing as the \\[read-only-mode] command, including @@ -8792,9 +8751,6 @@ to a non-nil value." (define-minor-mode visible-mode "Toggle making all invisible text temporarily visible (Visible mode). -With a prefix argument ARG, enable Visible mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. This mode works by saving the value of `buffer-invisibility-spec' and setting it to nil." diff --git a/lisp/strokes.el b/lisp/strokes.el index 6ffcff73c2..d5c287c341 100644 --- a/lisp/strokes.el +++ b/lisp/strokes.el @@ -1388,9 +1388,6 @@ If STROKES-MAP is not given, `strokes-global-map' will be used instead." ;;;###autoload (define-minor-mode strokes-mode "Toggle Strokes mode, a global minor mode. -With a prefix argument ARG, enable Strokes mode if ARG is -positive, and disable it otherwise. If called from Lisp, -enable the mode if ARG is omitted or nil. \\<strokes-mode-map> Strokes are pictographic mouse gestures which invoke commands. diff --git a/lisp/t-mouse.el b/lisp/t-mouse.el index 8a816fd444..3ad719d193 100644 --- a/lisp/t-mouse.el +++ b/lisp/t-mouse.el @@ -67,9 +67,6 @@ ;;;###autoload (define-minor-mode gpm-mouse-mode "Toggle mouse support in GNU/Linux consoles (GPM Mouse mode). -With a prefix argument ARG, enable GPM Mouse mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. This allows the use of the mouse when operating on a GNU/Linux console, in the same way as you can use the mouse under X11. diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index f7b14fab51..9860c8b30c 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -762,12 +762,10 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'. (define-minor-mode tar-subfile-mode "Minor mode for editing an element of a tar-file. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. This mode arranges for \"saving\" this -buffer to write the data into the tar-file buffer that it came -from. The changes will actually appear on disk when you save the -tar-file's buffer." + +This mode arranges for \"saving\" this buffer to write the data +into the tar-file buffer that it came from. The changes will +actually appear on disk when you save the tar-file's buffer." ;; Don't do this, because it is redundant and wastes mode line space. ;; :lighter " TarFile" nil nil nil diff --git a/lisp/term/tvi970.el b/lisp/term/tvi970.el index 97687894ec..0c4b0ae73b 100644 --- a/lisp/term/tvi970.el +++ b/lisp/term/tvi970.el @@ -101,9 +101,6 @@ ;; Should keypad numbers send ordinary digits or distinct escape sequences? (define-minor-mode tvi970-set-keypad-mode "Toggle alternate keypad mode on TVI 970 keypad. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. In alternate keypad mode, the keys send distinct escape sequences, meaning that they can have their own bindings, diff --git a/lisp/term/vt100.el b/lisp/term/vt100.el index d40c550aff..b61e557e2f 100644 --- a/lisp/term/vt100.el +++ b/lisp/term/vt100.el @@ -39,10 +39,7 @@ ;;; Controlling the screen width. (define-minor-mode vt100-wide-mode - "Toggle 132/80 column mode for vt100s. -With a prefix argument ARG, switch to 132-column mode if ARG is -positive, and 80-column mode otherwise. If called from Lisp, -switch to 132-column mode if ARG is omitted or nil." + "Toggle 132/80 column mode for vt100s." :global t :init-value (= (frame-width) 132) :group 'terminals (send-string-to-terminal (if vt100-wide-mode "\e[?3h" "\e[?3l")) diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el index 61ca0856bc..940a78ae92 100644 --- a/lisp/textmodes/artist.el +++ b/lisp/textmodes/artist.el @@ -1198,7 +1198,7 @@ PREV-OP-ARG are used when invoked recursively during the build-up." ;;;###autoload (define-minor-mode artist-mode "Toggle Artist mode. -With argument ARG, turn Artist mode on if ARG is positive. + Artist lets you draw lines, squares, rectangles and poly-lines, ellipses and circles with your mouse and/or keyboard. diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el index 6b4c44a39e..f2065cbff9 100644 --- a/lisp/textmodes/enriched.el +++ b/lisp/textmodes/enriched.el @@ -210,10 +210,6 @@ The value is a list of \(VAR VALUE VAR VALUE...).") These are files with embedded formatting information in the MIME standard text/enriched format. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. - Turning the mode on or off runs `enriched-mode-hook'. More information about Enriched mode is available in the file diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index 9747f8e2eb..8ad6832880 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -505,9 +505,6 @@ See also `flyspell-duplicate-distance'." ;;;###autoload (define-minor-mode flyspell-mode "Toggle on-the-fly spell checking (Flyspell mode). -With a prefix argument ARG, enable Flyspell mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. Flyspell mode is a buffer-local minor mode. When enabled, it spawns a single Ispell process and checks each word. The default diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index d1d47718f9..d80447e0a5 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -3695,9 +3695,6 @@ available on the net." ;;;###autoload (define-minor-mode ispell-minor-mode "Toggle last-word spell checking (Ispell minor mode). -With a prefix argument ARG, enable Ispell minor mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. Ispell minor mode is a buffer-local minor mode. When enabled, typing SPC or RET warns you if the previous word is incorrectly diff --git a/lisp/textmodes/nroff-mode.el b/lisp/textmodes/nroff-mode.el index 6955ed25e1..51a9f5820d 100644 --- a/lisp/textmodes/nroff-mode.el +++ b/lisp/textmodes/nroff-mode.el @@ -298,9 +298,6 @@ automatically inserts the matching closing request after point." (define-minor-mode nroff-electric-mode "Toggle automatic nroff request pairing (Nroff Electric mode). -With a prefix argument ARG, enable Nroff Electric mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. Nroff Electric mode is a buffer-local minor mode, for use with `nroff-mode'. When enabled, Emacs checks for an nroff request at diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el index 3e2784ca95..ee812566b9 100644 --- a/lisp/textmodes/paragraphs.el +++ b/lisp/textmodes/paragraphs.el @@ -36,9 +36,6 @@ (put 'use-hard-newlines 'permanent-local t) (define-minor-mode use-hard-newlines "Toggle distinguishing between hard and soft newlines. -With a prefix argument ARG, enable the feature if ARG is -positive, and disable it otherwise. If called from Lisp, enable -it if ARG is omitted or nil. When enabled, the functions `newline' and `open-line' add the text-property `hard' to newlines that they insert, and a line is diff --git a/lisp/textmodes/refill.el b/lisp/textmodes/refill.el index 1252afe417..229d6a24dd 100644 --- a/lisp/textmodes/refill.el +++ b/lisp/textmodes/refill.el @@ -213,9 +213,6 @@ complex processing.") ;;;###autoload (define-minor-mode refill-mode "Toggle automatic refilling (Refill mode). -With a prefix argument ARG, enable Refill mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. Refill mode is a buffer-local minor mode. When enabled, the current paragraph is refilled as you edit. Self-inserting diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index 40d75a9db8..126804fdab 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -1411,9 +1411,6 @@ highlighting. ;;;###autoload (define-minor-mode rst-minor-mode "Toggle ReST minor mode. -With a prefix argument ARG, enable ReST minor mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. When ReST minor mode is enabled, the ReST mode keybindings are installed on top of the major mode bindings. Use this diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 30ca11199d..470f4a348a 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -941,9 +941,6 @@ Return non-nil if we skipped over matched tags." (define-minor-mode sgml-electric-tag-pair-mode "Toggle SGML Electric Tag Pair mode. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. SGML Electric Tag Pair mode is a buffer-local minor mode for use with `sgml-mode' and related major modes. When enabled, editing @@ -2379,9 +2376,6 @@ The third `match-string' will be the used in the menu.") (define-minor-mode html-autoview-mode "Toggle viewing of HTML files on save (HTML Autoview mode). -With a prefix argument ARG, enable HTML Autoview mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. HTML Autoview mode is a buffer-local minor mode for use with `html-mode'. If enabled, saving the file automatically runs diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index c65b3b3ea2..c223af4769 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -713,9 +713,6 @@ An alternative value is \" . \", if you use a font with a narrow period." (define-minor-mode latex-electric-env-pair-mode "Toggle Latex Electric Env Pair mode. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable it if ARG -is omitted or nil. Latex Electric Env Pair mode is a buffer-local minor mode for use with `latex-mode'. When enabled, typing a \\begin or \\end tag diff --git a/lisp/time.el b/lisp/time.el index ab6b5b9632..94f7009953 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -488,9 +488,6 @@ update which can wait for the next redisplay." ;;;###autoload (define-minor-mode display-time-mode "Toggle display of time, load level, and mail flag in mode lines. -With a prefix argument ARG, enable Display Time mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -it if ARG is omitted or nil. When Display Time mode is enabled, it updates every minute (you can control the number of seconds between updates by customizing diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el index 18f54dbac6..e2242cf6f7 100644 --- a/lisp/tool-bar.el +++ b/lisp/tool-bar.el @@ -44,9 +44,6 @@ ;; when you are on a tty. I hope that won't cause too much trouble -- rms. (define-minor-mode tool-bar-mode "Toggle the tool bar in all graphical frames (Tool Bar mode). -With a prefix argument ARG, enable Tool Bar mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -Tool Bar mode if ARG is omitted or nil. See `tool-bar-add-item' and `tool-bar-add-item-from-menu' for conveniently adding tool bar items." diff --git a/lisp/tooltip.el b/lisp/tooltip.el index 81df229a13..384d3d19db 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el @@ -42,9 +42,6 @@ (define-minor-mode tooltip-mode "Toggle Tooltip mode. -With a prefix argument ARG, enable Tooltip mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. When this global minor mode is enabled, Emacs displays help text (e.g. for buttons and menu items that you put the mouse on) diff --git a/lisp/type-break.el b/lisp/type-break.el index 98947bac27..c7cdc46036 100644 --- a/lisp/type-break.el +++ b/lisp/type-break.el @@ -287,9 +287,6 @@ again in a short period of time. The idea is to give the user enough time to find a good breaking point in his or her work, but be sufficiently annoying to discourage putting typing breaks off indefinitely. -A negative prefix argument disables this mode. -No argument or any non-negative argument enables it. - The user may enable or disable this mode by setting the variable of the same name, though setting it in that way doesn't reschedule a break or reset the keystroke counter. @@ -406,9 +403,6 @@ problems." (define-minor-mode type-break-mode-line-message-mode "Toggle warnings about typing breaks in the mode line. -With a prefix argument ARG, enable these warnings if ARG is -positive, and disable them otherwise. If called from Lisp, -enable them if ARG is omitted or nil. The user may also enable or disable this mode simply by setting the variable of the same name. @@ -423,9 +417,6 @@ Variables controlling the display of messages in the mode line include: (define-minor-mode type-break-query-mode "Toggle typing break queries. -With a prefix argument ARG, enable these queries if ARG is -positive, and disable them otherwise. If called from Lisp, -enable them if ARG is omitted or nil. The user may also enable or disable this mode simply by setting the variable of the same name." diff --git a/lisp/url/url-dired.el b/lisp/url/url-dired.el index 784f70eb1f..50d84f71cc 100644 --- a/lisp/url/url-dired.el +++ b/lisp/url/url-dired.el @@ -43,10 +43,7 @@ (url-dired-find-file)) (define-minor-mode url-dired-minor-mode - "Minor mode for directory browsing. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil." + "Minor mode for directory browsing." :lighter " URL" :keymap url-dired-minor-mode-map) (defun url-find-file-dired (dir) diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el index 98f9f1e373..3802c39b78 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el @@ -102,10 +102,7 @@ ;;;###autoload (define-minor-mode url-handler-mode - "Toggle using `url' library for URL filenames (URL Handler mode). -With a prefix argument ARG, enable URL Handler mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil." + "Toggle using `url' library for URL filenames (URL Handler mode)." :global t :group 'url ;; Remove old entry, if any. (setq file-name-handler-alist diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 1e2fbb97fc..e88ccece41 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -216,9 +216,6 @@ when editing big diffs)." (define-minor-mode diff-auto-refine-mode "Toggle automatic diff hunk highlighting (Diff Auto Refine mode). -With a prefix argument ARG, enable Diff Auto Refine mode if ARG -is positive, and disable it otherwise. If called from Lisp, -enable the mode if ARG is omitted or nil. Diff Auto Refine mode is a buffer-local minor mode used with `diff-mode'. When enabled, Emacs automatically highlights @@ -1424,9 +1421,6 @@ a diff with \\[diff-reverse-direction]. ;;;###autoload (define-minor-mode diff-minor-mode "Toggle Diff minor mode. -With a prefix argument ARG, enable Diff minor mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. \\{diff-minor-mode-map}" :group 'diff-mode :lighter " Diff" diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index 99a074cf25..cb51fbab8e 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -1398,9 +1398,7 @@ with a \\[universal-argument] prefix, makes up a 3-way conflict." ;;;###autoload (define-minor-mode smerge-mode "Minor mode to simplify editing output from the diff3 program. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. + \\{smerge-mode-map}" :group 'smerge :lighter " SMerge" (when (and (boundp 'font-lock-mode) font-lock-mode) diff --git a/lisp/vcursor.el b/lisp/vcursor.el index 8974330452..ce7a895a62 100644 --- a/lisp/vcursor.el +++ b/lisp/vcursor.el @@ -815,8 +815,7 @@ out how much to copy." (define-minor-mode vcursor-use-vcursor-map "Toggle the state of the vcursor key map. -With a prefix argument ARG, enable it if ARG is positive, and disable -it otherwise. If called from Lisp, enable it if ARG is omitted or nil. + When on, the keys defined in it are mapped directly on top of the main keymap, allowing you to move the vcursor with ordinary motion keys. An indication \"!VC\" appears in the mode list. The effect is diff --git a/lisp/view.el b/lisp/view.el index cc328680e2..56f98a6db2 100644 --- a/lisp/view.el +++ b/lisp/view.el @@ -381,9 +381,6 @@ own View-like bindings." ;; bindings instead of using the \\[] construction. The reason for this ;; is that most commands have more than one key binding. "Toggle View mode, a minor mode for viewing text but not editing it. -With a prefix argument ARG, enable View mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable View mode -if ARG is omitted or nil. When View mode is enabled, commands that do not change the buffer contents are available as usual. Kill commands insert text in diff --git a/lisp/whitespace.el b/lisp/whitespace.el index c2827d3d51..d8249316e4 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -924,11 +924,6 @@ Any other value is treated as nil." ;;;###autoload (define-minor-mode whitespace-mode "Toggle whitespace visualization (Whitespace mode). -With a prefix argument ARG, enable Whitespace mode if ARG is -positive, and disable it otherwise. - -If called from Lisp, also enables the mode if ARG is omitted or nil, -and toggles it if ARG is `toggle'. See also `whitespace-style', `whitespace-newline' and `whitespace-display-mappings'." @@ -949,11 +944,6 @@ See also `whitespace-style', `whitespace-newline' and ;;;###autoload (define-minor-mode whitespace-newline-mode "Toggle newline visualization (Whitespace Newline mode). -With a prefix argument ARG, enable Whitespace Newline mode if ARG -is positive, and disable it otherwise. - -If called from Lisp, also enables the mode if ARG is omitted or nil, -and toggles it if ARG is `toggle'. Use `whitespace-newline-mode' only for NEWLINE visualization exclusively. For other visualizations, including NEWLINE @@ -979,11 +969,6 @@ See also `whitespace-newline' and `whitespace-display-mappings'." ;;;###autoload (define-minor-mode global-whitespace-mode "Toggle whitespace visualization globally (Global Whitespace mode). -With a prefix argument ARG, enable Global Whitespace mode if ARG -is positive, and disable it otherwise. - -If called from Lisp, also enables the mode if ARG is omitted or nil, -and toggles it if ARG is `toggle'. See also `whitespace-style', `whitespace-newline' and `whitespace-display-mappings'." @@ -1040,11 +1025,6 @@ This variable is normally modified via `add-function'.") ;;;###autoload (define-minor-mode global-whitespace-newline-mode "Toggle global newline visualization (Global Whitespace Newline mode). -With a prefix argument ARG, enable Global Whitespace Newline mode -if ARG is positive, and disable it otherwise. - -If called from Lisp, also enables the mode if ARG is omitted or nil, -and toggles it if ARG is `toggle'. Use `global-whitespace-newline-mode' only for NEWLINE visualization exclusively. For other visualizations, including diff --git a/lisp/wid-browse.el b/lisp/wid-browse.el index db2be0cc90..d86e9cd2e2 100644 --- a/lisp/wid-browse.el +++ b/lisp/wid-browse.el @@ -269,10 +269,7 @@ VALUE is assumed to be a list of widgets." ;;;###autoload (define-minor-mode widget-minor-mode - "Minor mode for traversing widgets. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil." + "Minor mode for traversing widgets." :lighter " Widget") ;;; The End: diff --git a/lisp/winner.el b/lisp/winner.el index 72b90b0e43..5e13a378a7 100644 --- a/lisp/winner.el +++ b/lisp/winner.el @@ -351,9 +351,6 @@ You may want to include buffer names such as *Help*, *Apropos*, ;;;###autoload (define-minor-mode winner-mode "Toggle Winner mode on or off. -With a prefix argument ARG, enable Winner mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. Winner mode is a global minor mode that records the changes in the window configuration (i.e. how the frames are partitioned diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index 8fb65d5bfa..da4af32e5e 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -312,9 +312,6 @@ which is the \"1006\" extension implemented in Xterm >= 277." ;;;###autoload (define-minor-mode xterm-mouse-mode "Toggle XTerm mouse mode. -With a prefix argument ARG, enable XTerm mouse mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. Turn it on to use Emacs mouse commands, and off to use xterm mouse commands. This works in terminal emulators compatible with xterm. It only commit fd5bf49139ab84f630b60c6714e0db2da34edff2 Author: Eli Zaretskii <eliz@gnu.org> Date: Sun Jul 1 19:19:51 2018 +0300 Fix last change * src/w32console.c (Fset_screen_color): Call Frecenter with 2 arguments. (Bug#31325) * etc/NEWS: * doc/lispref/windows.texi (Textual Scrolling): Clarify the role of the second argument to 'recenter'. diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 9740bbebf2..ae6837b444 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -4154,7 +4154,9 @@ If @var{count} is @code{nil} (or a non-@code{nil} list), @code{recenter} puts the line containing point in the middle of the window. If @var{count} is @code{nil} and @var{redisplay} is non-@code{nil}, this function may redraw the frame, according to the -value of @code{recenter-redisplay}. +value of @code{recenter-redisplay}. Thus, omitting the second +argument can be used to countermand the effect of +@code{recenter-redisplay} being non-@code{nil}. When @code{recenter} is called interactively, @var{count} is the raw prefix argument. Thus, typing @kbd{C-u} as the prefix sets the diff --git a/etc/NEWS b/etc/NEWS index d5f1abb5fe..3f761e9210 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -690,9 +690,10 @@ manual for more details. * Lisp Changes in Emacs 27.1 +++ -** The function 'recenter' accepts an additional optional argument. -If the optional second argument is nil, recenter will not redisplay -the frame regardless of the value of 'recenter-redisplay'. +** The function 'recenter' now accepts an additional optional argument. +By default, calling 'recenter' will not redraw the frame even if +'recenter-redisplay' is non-nil. Call 'recenter' with the new second +argument non-nil to force redisplay per 'recenter-redisplay's value. +++ ** New functions 'major-mode-suspend' and 'major-mode-restore'. diff --git a/src/w32console.c b/src/w32console.c index ea30853bad..330aef5758 100644 --- a/src/w32console.c +++ b/src/w32console.c @@ -793,7 +793,7 @@ Arguments should be indices between 0 and 15, see w32console.el. */) { char_attr_normal = XFASTINT (foreground) + (XFASTINT (background) << 4); - Frecenter (Qnil); + Frecenter (Qnil, Qt); return Qt; } commit 260768a64be39aada03247d6057698df97bcb800 Author: John Shahid <jvshahid@gmail.com> Date: Thu Jun 28 09:13:45 2018 -0400 Add a new argument to 'recenter' to allow finer control of redisplay * window.c (recenter): Add a new REDISPLAY argument to allow the caller to control the redisplay behavior. 'recenter' will only redisplay the frame if this new arg and 'recenter-redisplay' are both non-nil. (recenter-top-bottom): Pass an extra non-nil argument to 'recenter' to force a redisplay. (Bug#31325) diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 5497759595..9740bbebf2 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -4138,7 +4138,7 @@ beginning or end of the buffer (depending on scrolling direction); only if point is already on that position do they signal an error. @end defopt -@deffn Command recenter &optional count +@deffn Command recenter &optional count redisplay @cindex centering point This function scrolls the text in the selected window so that point is displayed at a specified vertical position within the window. It does @@ -4152,8 +4152,9 @@ line in the window. If @var{count} is @code{nil} (or a non-@code{nil} list), @code{recenter} puts the line containing point in the middle of the -window. If @var{count} is @code{nil}, this function may redraw the -frame, according to the value of @code{recenter-redisplay}. +window. If @var{count} is @code{nil} and @var{redisplay} is +non-@code{nil}, this function may redraw the frame, according to the +value of @code{recenter-redisplay}. When @code{recenter} is called interactively, @var{count} is the raw prefix argument. Thus, typing @kbd{C-u} as the prefix sets the @@ -4181,8 +4182,9 @@ respect to the entire window group. @defopt recenter-redisplay If this variable is non-@code{nil}, calling @code{recenter} with a -@code{nil} argument redraws the frame. The default value is -@code{tty}, which means only redraw the frame if it is a tty frame. +@code{nil} @var{count} argument and non-@code{nil} @var{redisplay} +argument redraws the frame. The default value is @code{tty}, which +means only redraw the frame if it is a tty frame. @end defopt @deffn Command recenter-top-bottom &optional count diff --git a/etc/NEWS b/etc/NEWS index 63c59ae921..d5f1abb5fe 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -689,6 +689,11 @@ manual for more details. * Lisp Changes in Emacs 27.1 ++++ +** The function 'recenter' accepts an additional optional argument. +If the optional second argument is nil, recenter will not redisplay +the frame regardless of the value of 'recenter-redisplay'. + +++ ** New functions 'major-mode-suspend' and 'major-mode-restore'. Use them when switching temporarily to another major mode, e.g. for diff --git a/lisp/window.el b/lisp/window.el index fdd510401d..6d9d8bdcd2 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -8778,15 +8778,15 @@ A prefix argument is handled like `recenter': (min (max 0 scroll-margin) (truncate (/ (window-body-height) 4.0))))) (cond ((eq recenter-last-op 'middle) - (recenter)) + (recenter nil t)) ((eq recenter-last-op 'top) - (recenter this-scroll-margin)) + (recenter this-scroll-margin t)) ((eq recenter-last-op 'bottom) - (recenter (- -1 this-scroll-margin))) + (recenter (- -1 this-scroll-margin) t)) ((integerp recenter-last-op) - (recenter recenter-last-op)) + (recenter recenter-last-op t)) ((floatp recenter-last-op) - (recenter (round (* recenter-last-op (window-height)))))))))) + (recenter (round (* recenter-last-op (window-height))) t))))))) (define-key global-map [?\C-l] 'recenter-top-bottom) diff --git a/src/window.c b/src/window.c index a97f1dd3ef..20f6862e3b 100644 --- a/src/window.c +++ b/src/window.c @@ -5896,22 +5896,23 @@ displayed_window_lines (struct window *w) } -DEFUN ("recenter", Frecenter, Srecenter, 0, 1, "P", +DEFUN ("recenter", Frecenter, Srecenter, 0, 2, "P", doc: /* Center point in selected window and maybe redisplay frame. With a numeric prefix argument ARG, recenter putting point on screen line ARG relative to the selected window. If ARG is negative, it counts up from the bottom of the window. (ARG should be less than the height of the window.) -If ARG is omitted or nil, then recenter with point on the middle line of -the selected window; if the variable `recenter-redisplay' is non-nil, -also erase the entire frame and redraw it (when `auto-resize-tool-bars' -is set to `grow-only', this resets the tool-bar's height to the minimum -height needed); if `recenter-redisplay' has the special value `tty', -then only tty frames are redrawn. +If ARG is omitted or nil, then recenter with point on the middle line +of the selected window; if REDISPLAY & `recenter-redisplay' are +non-nil, also erase the entire frame and redraw it (when +`auto-resize-tool-bars' is set to `grow-only', this resets the +tool-bar's height to the minimum height needed); if +`recenter-redisplay' has the special value `tty', then only tty frames +are redrawn. Just C-u as prefix means put point in the center of the window and redisplay normally--don't erase and redraw the frame. */) - (register Lisp_Object arg) + (Lisp_Object arg, Lisp_Object redisplay) { struct window *w = XWINDOW (selected_window); struct buffer *buf = XBUFFER (w->contents); @@ -5931,7 +5932,8 @@ and redisplay normally--don't erase and redraw the frame. */) if (NILP (arg)) { - if (!NILP (Vrecenter_redisplay) + if (!NILP (redisplay) + && !NILP (Vrecenter_redisplay) && (!EQ (Vrecenter_redisplay, Qtty) || !NILP (Ftty_type (selected_frame)))) { commit fc5cae731cede7e00f3f2d40d6577537f872d439 Author: Paul Eggert <eggert@cs.ucla.edu> Date: Sun Jul 1 08:36:30 2018 -0700 ; Fix ChangeLog typo. diff --git a/ChangeLog.3 b/ChangeLog.3 index c05303c5d4..a0a4794b4e 100644 --- a/ChangeLog.3 +++ b/ChangeLog.3 @@ -1,6 +1,6 @@ 2018-07-01 Paul Eggert <eggert@cs.ucla.edu> - * etc/HISTORY: Cite Brinkoff on early history. + * etc/HISTORY: Cite Brinkhoff on early history. 2018-07-01 Martin Rudalics <rudalics@gmx.at> commit e17a5e58b798ffbe2024d62a35376786c1b2b35e Author: Paul Eggert <eggert@cs.ucla.edu> Date: Sun Jul 1 08:35:18 2018 -0700 ; make change-history-commit diff --git a/ChangeLog.3 b/ChangeLog.3 index 6704d0d716..c05303c5d4 100644 --- a/ChangeLog.3 +++ b/ChangeLog.3 @@ -1,3 +1,1430 @@ +2018-07-01 Paul Eggert <eggert@cs.ucla.edu> + + * etc/HISTORY: Cite Brinkoff on early history. + +2018-07-01 Martin Rudalics <rudalics@gmx.at> + + Document internal use of 'above-suspended' z-group frame parameter + + * src/w32fns.c (w32_dialog_in_progress, x_set_z_group): + * src/xterm.c (x_set_z_group): Clarify the internal use of + 'above-suspended' when setting a frame's 'z-group' parameter. + +2018-06-30 Gemini Lasswell <gazally@runbox.com> + + Increase max-lisp-eval-depth adjustment while in debugger (bug#31919) + + * src/eval.c (call_debugger): Increase the amount of extra Lisp + evaluation depth given to the debugger to allow it to call cl-print. + * lisp/emacs-lisp/debug.el (debugger-setup-buffer): Add a comment + to suggest updating call_debugger when changing print-level. + +2018-06-30 Eli Zaretskii <eliz@gnu.org> + + Improve on last change in replace-buffer-contents + + * src/editfns.c (Freplace_buffer_contents): Call modification + hooks only for the actual region where changes are made. + (Bug#31888) + +2018-06-30 Eli Zaretskii <eliz@gnu.org> + + Fix a factual error in Introduction to Emacs Lisp + + * doc/lispintro/emacs-lisp-intro.texi (Buffer Names): Update the + key that exits the splash screen. (Bug#32019) + +2018-06-30 Eli Zaretskii <eliz@gnu.org> + + Minor improvements in documentation of imenu.el + + * lisp/imenu.el (imenu-generic-skip-comments-and-strings) + (imenu--generic-function): Doc fixes. (Bug#31962) + +2018-06-30 Eli Zaretskii <eliz@gnu.org> + + Avoid errors with recentering in 'skeleton-insert' + + * lisp/skeleton.el (skeleton-insert): Don't recenter if we are + running in a buffer other than the one displayed in the selected + window. (Bug#31950) + +2018-06-29 Paul Eggert <eggert@cs.ucla.edu> + + * src/lisp.h: Omit obsolete comment re bytecode stack. + +2018-06-29 Eli Zaretskii <eliz@gnu.org> + + Speed up replace-buffer-contents + + * src/editfns.c (EXTRA_CONTEXT_FIELDS): Add a_unibyte and + b_unibyte members. + (rbc_quitcounter): New static variable. + (Freplace_buffer_contents): Initialize a_unibyte, b_unibyte, and + rbc_quitcounter. Inhibit modification hooks if they were not + already inhibited. Use rarely_quit to allow user to quit, to + avoid calling maybe_quit too frequently (which hurts performance). + Remove redundant assertions (which hurt performance too much). + Call signal_after_change and update_compositions after all the + changes are done. + (buffer_chars_equal): Remove redundant assertions (which hurt + performance). Avoid using BUF_FETCH_CHAR_AS_MULTIBYTE, which + hurts performance by referencing Lisp symbols; instead, use + lower-level macros with explicit tests to select which macro to + use. (Bug#31888) + +2018-06-27 Dmitry Gutov <dgutov@yandex.ru> + + Remove extra process call from vc-git-find-file-hook + + * lisp/vc/vc-git.el (vc-git-find-file-hook): Resolve FIXMEs. + +2018-06-27 Dmitry Gutov <dgutov@yandex.ru> + + Speed up vc-git-dir-status-files + + * lisp/vc/vc-git.el (vc-git-dir-status-goto-stage): Call 'git + ls-files -u' for the ls-files-conflict stage + (https://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00885.html). + +2018-06-27 Eli Zaretskii <eliz@gnu.org> + + Avoid compiler warning using coding.h + + * src/coding.h: Add INLINE_HEADER_BEGIN..INLINE_HEADER_END, since + this header now has an extern INLINE function. + +2018-06-27 Michael Albinus <michael.albinus@gmx.de> + + Sync with Tramp 2.3.4. Do not merge with master + + * doc/misc/trampver.texi: + * lisp/net/trampver.el: Change version to "2.3.4". + + * lisp/net/tramp-smb.el (tramp-smb-handle-delete-directory): + Check, that the directory has been removed indeed. + + * test/lisp/net/tramp-tests.el (tramp-test21-file-links): Adapt test. + (tramp--test-emacs25-p): New defun. + (tramp-test34-vc-registered): Use it. + +2018-06-27 Martin Rudalics <rudalics@gmx.at> + + * src/xdisp.c (Vmouse_autoselect_window): Clarify doc-string (Bug#31975) + +2018-06-26 Noam Postavsky <npostavs@gmail.com> + + Detect a non-list package archive content properly (Bug#22311) + + * lisp/emacs-lisp/package.el (package--download-one-archive): Use + `read' instead of `read-from-string'; the latter always returns a + cons, so the `listp' check on its return value doesn't make sense. It + was changed from `read' to `read-from-string' in 2015-04-01 "* + emacs-lisp/package.el: Implement asynchronous refreshing", but that + change was not needed because `read' works fine on strings as well as + buffers. + +2018-06-25 Christophe Junke <junke.christophe@gmail.com> (tiny change) + + Add ido-fallback special variable (Bug#31707) + + Before ido.el switch to lexical-binding, it was possible for other + packages to modify the 'fallback' variables declared inside + 'ido-file-internal' and 'ido-buffer-internal'. + * lisp/ido.el (ido-fallback): New variable. + (ido-buffer-internal, ido-file-internal): Reset ido-fallback to nil + before prompting user. Use ido-fallback when ido-exit is 'fallback'. + (ido-fallback-command): Add optional FALLBACK-COMMAND argument. + +2018-06-25 Karl Fogel <kfogel@red-bean.com> + + Tighten a cross-reference in documentation + + * doc/lispref/internals.texi (Writing Emacs Primitives): Switch to + a simple parenthetical cross-reference, following up to my + commit 9a53b6d426 of 2018-06-24. + + See discussion: + + https://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00826.html + From: Eli Zaretskii + Subject: Re: [Emacs-diffs] \ + emacs-26 9a53b6d: Say how to override a primitive interactive spec + To: Karl Fogel + CC: Stefan Monnier, Emacs Devel + Date: Mon, 25 Jun 2018 17:41:53 +0300 + Message-Id: <83r2kvrkr2.fsf@gnu.org> + +2018-06-25 Michael Albinus <michael.albinus@gmx.de> + + Fix last change in tramp-sh.el + + * lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file-directly): + Use "-R" rather than "-r" for recursive copy of directories. + +2018-06-24 Paul Eggert <eggert@cs.ucla.edu> + + Revert previous patch; comment was OK after all. + +2018-06-24 Paul Eggert <eggert@cs.ucla.edu> + + Fix lead comment for count_trailing_zero_bits + + * src/data.c (count_trailing_zero_bits): Fix comment to match code. + +2018-06-24 Noam Postavsky <npostavs@gmail.com> + + * lisp/emacs-lisp/regexp-opt.el (regexp-opt): Fix docstring quotes. + +2018-06-24 Simen Heggestøyl <simenheg@gmail.com> + + Make a minor update to the CSS mode docstring + + * lisp/textmodes/css-mode.el (css-mode): Mention 'fill-paragraph'. + +2018-06-24 Karl Fogel <kfogel@red-bean.com> + + Say how to override a primitive interactive spec + + * doc/lispref/internals.texi (Writing Emacs Primitives): Mention that + the `interactive-form' property can be used to override a primitive + interactive specification, and refer to the detailed documentation + for setting that property. + + From this thread on Emacs Devel: + + https://lists.gnu.org/archive/html/emacs-devel/2018-03/msg00923.html + From: Eli Zaretskii + To: Karl Fogel + CC: Juri Linkov, Emacs Devel + Subject: Re: [Emacs-diffs] \ + master b88e7c8: Make transpose-regions interactive (Bug#30343) + Date: Thu, 29 Mar 2018 14:38:15 +0300 + Message-Id: <834lkzdsd4.fsf@gnu.org> + +2018-06-24 Michael Albinus <michael.albinus@gmx.de> + + Fix Bug#31941 + + * lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file): In case of + FILENAME being a directory, check whether `copy-directory' could + be avoided. Suggested by Stephen Nutt <stnutt@gmail.com>. (Bug#31941) + (tramp-do-copy-or-rename-file-directly): Call "cp" with "-r". + +2018-06-23 Leo Liu <sdl.web@gmail.com> + + Fix previous change in minibuffer-default-add-dired-shell-commands + + The mailcap minibuffer completion used dynamic binding. Locally set + a dynamic variable. + * lisp/dired-aux.el (minibuffer-default-add-dired-shell-commands): + Store list of files in 'minibuffer-completion-table'. (Bug#31794) + +2018-06-23 Eli Zaretskii <eliz@gnu.org> + + * src/editfns.c (Fformat): Make %x easier to spot in doc string. (Bug#31945) + +2018-06-23 Eli Zaretskii <eliz@gnu.org> + + Improve responsiveness while in 'replace-buffer-contents' + + * src/editfns.c (buffer_chars_equal): Avoid calling + buf_charpos_to_bytepos when the buffer is plain-ASCII. + Suggested by Milan Stanojević <mstanojevic@janestreet.com>. + Call maybe_quit to improve responsiveness. + (Freplace_buffer_contents): Call maybe_quit. Warn in the doc + string that the function could be slow. (Bug#31888) + +2018-06-23 Eli Zaretskii <eliz@gnu.org> + + Improve documentation of 'server-start' and friends + + * lisp/server.el (server-start, server-running-p): Document how to + reliably check that the current Emacs process started the server. + (Bug#31859) + +2018-06-23 Eli Zaretskii <eliz@gnu.org> + + Clarify wording about functions' argument lists + + * doc/lispref/functions.texi (Argument List): Clarify the + wording. (Bug#31872) + +2018-06-23 Eli Zaretskii <eliz@gnu.org> + + * lisp/doc-view.el: Fix typos in the commentary. (Bug#31937) + +2018-06-22 Eli Zaretskii <eliz@gnu.org> + + Fix a typo in emacs-lisp-intro.texi + + * doc/lispintro/emacs-lisp-intro.texi (kill-ring-yank-pointer): + Add a missing quote. Reported by Jean-Christophe Helary + <brandelune@gmail.com> in emacs-devel. + +2018-06-22 Paul Eggert <eggert@cs.ucla.edu> + + Fix doc typo: missing double-quote + +2018-06-22 Eli Zaretskii <eliz@gnu.org> + + Avoid segfaults in replace-buffer-contents with large buffers + + * src/editfns.c (Freplace_buffer_contents): Don't release + malloc'ed memory as long as we are using it. (Bug#31888) + +2018-06-22 Robert Pluim <rpluim@gmail.com> + + Adjust for scaling for mode-line popup menus (Bug#31880) + + * src/xmenu.c (menu_position_func) [HAVE_GTK3]: Take scaling + into account when calculating screen size. + +2018-06-21 Simen Heggestøyl <simenheg@gmail.com> + + Change name of `seqp' argument (Bug#26411) + + * lisp/emacs-lisp/seq.el (seqp): Change argument name. + + * doc/lispref/sequences.texi: Update the documentation for seqp. + +2018-06-20 Noam Postavsky <npostavs@gmail.com> + + Change index of ";" to better reflect it's usage (Bug#31623) + + * doc/lispref/objects.texi (Comments): "; for commenting" fits better + with the following text about how a semicolon begins a comment. Also + mention that only unescaped semicolons start a comment. + +2018-06-20 Tak Kunihiro <tkk@misasa.okayama-u.ac.jp> + + Fix bug of 'mouse-drag-and-drop-region' to detect edges of region (Bug#31905) + + * lisp/mouse.el (mouse-drag-and-drop-region): Detect both the + beginning and the end of character of region during dragging + text. + +2018-06-19 Noam Postavsky <npostavs@gmail.com> + + Fix #'fun handling inside `labels' (Bug#31792) + + * lisp/emacs-lisp/cl.el (labels): Apply the equivalent of the + cl-labels change from 2015-01-16 "* lisp/emacs-lisp/cl-macs.el: Fix + last change". + * test/lisp/emacs-lisp/cl-tests.el (labels-function-quoting): New + test. + * lisp/emacs-lisp/cl-macs.el (cl-flet, cl-labels): Improve docstring, + link to relevant manual page. + * doc/misc/cl.texi (Function Bindings): Don't imply that function + cells of symbols are modified by cl-flet. Don't claim that cl-flet or + cl-labels affect references of the form (quote FUNC). + +2018-06-18 Eli Zaretskii <eliz@gnu.org> + + Fix vertical-motion with 'visual' line-number display + + * src/indent.c (Fvertical_motion): Don't exempt 'visual' sty;e of + line-number display from X coordinate adjustments. (Bug#31875) + +2018-06-17 Alan Third <alan@idiocy.org> + + Handle NSAttributedString inputs (bug#29837) + + + * src/nsterm.m (EmacsView::insertText): Handle NSAttributedString. + +2018-06-17 Philipp Stephani <phst@google.com> + + Allow inserting non-BMP characters + + * src/coding.h (UTF_16_HIGH_SURROGATE_P, UTF_16_LOW_SURROGATE_P): Move + from coding.c and document. + (surrogates_to_codepoint): New function. + + * src/nsterm.m (insertText:): Properly handle surrogate pairs. + + (cherry picked from commit 703ac3ea1c1ce381f385469a0e88bc29d3fe83c2) + +2018-06-17 Aaron Jensen <aaronjensen@gmail.com> + + Prevent errant scroll on mouse click (Bug#31546) + + * src/nsterm.m (ns_mouse_position): Use correct frame when determining + mouse position. + * lisp/mouse.el (mouse-drag-track): Only account for mode-line height + if `mode-line-format' is non-nil. + +2018-06-17 Eli Zaretskii <eliz@gnu.org> + + Minor documentation fix + + * doc/lispref/windows.texi (Window Start and End): Improve + documentation and indexing of window-end. + +2018-06-16 Eli Zaretskii <eliz@gnu.org> + + * lisp/window.el (window-toggle-side-windows): Doc fix. (Bug#31858) + +2018-06-16 Paul Eggert <eggert@Penguin.CS.UCLA.EDU> + + Fix byte compilation of (eq foo 'default) + + Backport from master. + Do not use the symbol â€default’ as a special marker. + Instead, use a value that cannot appear in the program, + improving on a patch proposed by Robert Cochran (Bug#31718#14). + * lisp/emacs-lisp/bytecomp.el (byte-compile--default-val): + New constant. + (byte-compile-cond-jump-table-info) + (byte-compile-cond-jump-table): Use it instead of 'default. + * test/lisp/emacs-lisp/bytecomp-tests.el: + (byte-opt-testsuite-arith-data): Add a test for the bug. + +2018-06-16 Michael Albinus <michael.albinus@gmx.de> + + Fix Bug#31846. Do not merge with master + + * lisp/net/secrets.el (secrets-search-items) + (secrets-create-item): Fix format of :dict-entry values. (Bug#31846) + +2018-06-16 Eli Zaretskii <eliz@gnu.org> + + Fix documentation of ':propertize' in mode-line-format + + * doc/lispref/modes.texi (Mode Line Data): Make the description of + ':propertize' more accurate. (Bug#26291) + +2018-06-15 Eli Zaretskii <eliz@gnu.org> + + Reject invalid 5-byte sequences when detecting UTF-8 encoding + + * src/coding.c (detect_coding_utf_8): Reject multibyte sequences + whose leading byte is greater than MAX_MULTIBYTE_LEADING_CODE. + (Bug#31829) + * src/character.h (MAX_MULTIBYTE_LEADING_CODE): Add commentary + about the connection between the value of this macro and MAX_CHAR. + +2018-06-15 Eli Zaretskii <eliz@gnu.org> + + Fix 'replace-buffer-contents' in multibyte buffers + + * src/editfns.c (buffer_chars_equal): Pass a byte position to + BUF_FETCH_CHAR_AS_MULTIBYTE, not a character position. + (Bug#31837) + + * test/src/editfns-tests.el (replace-buffer-contents-bug31837): + New test. + +2018-06-15 Robert Pluim <rpluim@gmail.com> + + Update etc/NEWS for mail-source-movemail-program change + + * etc/NEWS: Describe change in how we search for + mail-source-movemail-program. + +2018-06-15 Robert Pluim <rpluim@gmail.com> + + Improve movemail default + + * lisp/gnus/mail-source.el (mail-source-movemail-program): + Change default to "movemail". + (mail-source-movemail): Pass just mail-source-movemail-program to + call-process instead of fully specifying it relative to + exec-directory. Ensures that we will find Mailutils movemail if + it is installed. (Bug#31737) + +2018-06-15 Eli Zaretskii <eliz@gnu.org> + + Delete description of deleted Customize functions + + * doc/lispref/customize.texi (Variable Definitions): Remove the + description of 'custom-initialize-safe-set' and + 'custom-initialize-safe-default', which were deleted in Emacs + 23.2, and replace with the description of + 'custom-initialize-delay'. + +2018-06-14 Noam Postavsky <npostavs@gmail.com> + + Keep vc-print-log from putting point at buffer end (Bug#31764) + + * lisp/vc/vc.el (vc-print-log-internal): Use `save-excursion' around + `vc-print-log-setup-buttons'. + +2018-06-14 Paul Eggert <eggert@cs.ucla.edu> + + Don’t set EMACS=t if Bash is 4.4 or newer + + (Backport from master.) + (Thanks to Stefan Monnier for improvements to this patch.) + * lisp/term.el (term--bash-needs-EMACS-status): New var. + (term--bash-needs-EMACSp): New function. + (term-exec-1): Use it instead of always setting EMACS. + +2018-06-14 Eli Zaretskii <eliz@gnu.org> + + Improve commentary in info.el + + * lisp/info.el: Explain in commentary why some commands start with + "info-" and others with "Info-". See also + http://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00482.html. + +2018-06-13 Michael Albinus <michael.albinus@gmx.de> + + Fix wording in tramp.texi + + * doc/misc/tramp.texi (Frequently Asked Questions): + Fix wording for abbreviations. + +2018-06-13 Michael Albinus <michael.albinus@gmx.de> + + * doc/misc/tramp.texi (Remote shell setup): Fix typo. + +2018-06-12 Sam Steingold <sds@gnu.org> + + Finish the Bug#11728 work: hg & git + + * lisp/vc/vc-git.el (vc-git--pushpull): Make `extra-args' a list. + Do not set `compilation-error-regexp-alist', this is done in + `vc-compilation-mode'. + (vc-git-error-regexp-alist): Tweak the regexp. + * lisp/vc/vc-hg.el (vc-hg-error-regexp-alist): Make non-trivial. + (vc-hg--pushpull): Accept `post-processing' argument. + Call them after the `command'. + (vc-hg-pull): Pass the `post-processing' commands that show which + are to be modified by the `update', and then run `update'. + +2018-06-12 Sam Steingold <sds@gnu.org> + + Fix Bug#11728: show files updated by git + + * lisp/vc/vc-git.el (vc-git--pushpull): Accept extra-args and set + `compilation-error-regexp-alist' to `vc-git-error-regexp-alist'. + (vc-git-pull): Pass "--stat" as `extra-args' to `vc-git--pushpull'. + (vc-git-push): Pass "" as `extra-args' to `vc-git--pushpull'. + +2018-06-12 Noam Postavsky <npostavs@gmail.com> + + Make 'tags' targets respect --with-silent-rules (Bug#31744) + + * lwlib/Makefile.in (TAGS): + * lisp/Makefile.in (TAGS): + * src/Makefile.in (TAGS): Use AM_V_GEN and AM_V_at. + * src/Makefile.in: Note that TAGS are generated in build dir. + +2018-06-11 Thomas Fitzsimmons <fitzsim@fitzsim.org> + Noam Postavsky <npostavs@gmail.com> + + soap-client: Add byte-code compatibility function (Bug#31742) + + * lisp/net/soap-client.el: Bump version to 3.1.4. + (soap-type-of): New function. + (soap-resolve-references, soap-decode-type) + (soap-encode-attributes, soap-encode-value): Replace aref + calls with calls to soap-type-of. + + * lisp/net/soap-inspect.el (soap-sample-value, soap-inspect): + Replace aref calls with calls to soap-type-of. + + + Backport: (cherry picked from commit + 1feb2e221349f26ec26bc684e0cce2acecbed3ca) + +2018-06-11 Eli Zaretskii <eliz@gnu.org> + + * doc/lispref/files.texi (Unique File Names): Fix a typo. (Bug#31784) + +2018-06-10 Noam Postavsky <npostavs@gmail.com> + + Fix term.el cursor movement at bottom margin (Bug#31690) + + * lisp/term.el (term-handle-ansi-escape) <\E[B cud>: Allow moving the + cursor to the bottom margin line, rather than stopping one line + before. + +2018-06-10 Reuben Thomas <rrt@sc3d.org> + + Call enchant-lsmod correctly when Enchant is installed with a suffix + + * lisp/textmodes/ispell.el (ispell--call-enchant-lsmod): Cope with a + version suffix on the binary name, so enchant-2 is converted to + enchant-lsmod-2, not enchant-2-lsmod. (Bug#31761) + + (cherry picked from commit a402d9aacbecf4bf0b9afde592a3b90c71f96832) + +2018-06-09 Eli Zaretskii <eliz@gnu.org> + + Enlarge DUMPED_HEAP_SIZE for 64-bit Windows builds + + * src/w32heap.c (DUMPED_HEAP_SIZE): Bump to 23MB. Reported by + Andy Moreton <andrewjmoreton@gmail.com>. + +2018-06-09 Eli Zaretskii <eliz@gnu.org> + + Update Unicode data files to version 11.0.0 of Unicode + + * admin/unidata/UnicodeData.txt: + * admin/unidata/SpecialCasing.txt: + * admin/unidata/NormalizationTest.txt: + * admin/unidata/copyright.html: + * admin/unidata/BidiMirroring.txt: + * admin/unidata/BidiBrackets.txt: Import from Unicode 11.0. + * admin/notes/unicode: Update the URL for OTF script tags. + + * lisp/international/mule-cmds.el (ucs-names): Update unused ranges. + * lisp/international/fontset.el (script-representative-chars): Add + hanifi-rohingya, old-sogdian, sogdian, dogra, gunjala-gondi, + makasar, and medefaidrin. + (otf-script-alist): Add old-hungarian. + * lisp/international/characters.el (tbl): Add syntax entries for + Supplemental Mathematical Operators, Miscellaneous Symbols and + Arrows, and Supplemental Punctuation. + Update the list of wide characters. + + * test/lisp/international/ucs-normalize-tests.el + (ucs-normalize-tests--failing-lines-part2): Update to match + admin/unidata/NormalizationTest.txt. + + * doc/lispref/nonascii.texi (Character Properties): Update the + reference to the Unicode Standard. + * doc/misc/efaq.texi (New in Emacs 26): + * etc/NEWS: Mention compatibility with Unicode 11.0. + +2018-06-09 Eli Zaretskii <eliz@gnu.org> + + * etc/NEWS: Belatedly call out vc-hg changes in v26.1. (Bug#31759) + +2018-06-09 Eli Zaretskii <eliz@gnu.org> + + Clarify the documentation of 'dired-recursive-deletes' + + * doc/emacs/dired.texi (Dired Deletion): Clarify text regarding + recursive deletion of non-empty directories. (Bug#31529) + +2018-06-08 Eli Zaretskii <eliz@gnu.org> + + Clarify doc string of 'update-glyphless-char-display' + + * lisp/international/characters.el + (update-glyphless-char-display): Doc fix. (Bug#31730) + +2018-06-08 Eli Zaretskii <eliz@gnu.org> + + Clarify subtle issues with 'eq' in byte-compiled code + + * doc/lispref/objects.texi (Equality Predicates): Explain why + byte-compiled code might compare literal objects with identical + contents as 'eq'. (Bug#31688) + +2018-06-07 Gemini Lasswell <gazally@runbox.com> + + Make cl-print respect print-quoted (bug#31649) + + * lisp/emacs-lisp/cl-print.el (cl-print-object) <cons>: Observe + print-quoted when printing quote and its relatives. Add printing of + 'function' as #'. + +2018-06-07 Martin Rudalics <rudalics@gmx.at> + + Fix unexpected jumps of window-point in 'set-window-configuration' (Bug#31695) + + * src/window.c (Fset_window_configuration): Prevent that the + fix for Bug#12208 affects restoration of window points when + using separate minibuffer frames (Bug#31695). + +2018-06-06 Nicolas Petton <nicolas@petton.fr> + + * etc/emacs.appdata.xml: Update Emacs screenshot. + +2018-06-06 Eli Zaretskii <eliz@gnu.org> + + Fix cursor movement by 'next-logical-line' after 'next-line' + + * src/indent.c (Fvertical_motion): Adjust TO_X when line-numbers + are being displayed. Remove unneeded "correction" of TO_X at the + goal line. + + * lisp/simple.el (last--line-number-width): Remove unneeded + variable. + (line-move-visual): Account for line-number display width by + adjusting the pixel X coordinate that gets converted into + canonical columns passed to vertical-motion, instead of adjusting + temporary-goal-column (which then affects next commands, including + next-logical-line). (Bug#31723) + +2018-06-05 Allen Li <darkfeline@felesatra.moe> + + Fix prompt in bookmark.el (Bug#24726) + + * lisp/bookmark.el (bookmark-set-internal): Conform to the standard + default prompt format (per `minibuffer-electric-default-mode') which + does not use a colon. + +2018-06-05 Basil L. Contovounesios <contovob@tcd.ie> + + Improve documentation of 'empty' whitespace-style + + * doc/emacs/display.texi (Useless Whitespace): Clarify that the + 'empty' whitespace-style option highlights empty lines only at + BOB/EOB, as per the docstring of whitespace-style. (bug#31713) + +2018-06-05 Paul Eggert <eggert@cs.ucla.edu> + + Port FC_COLOR change to older fontconfig + + Problem reported by John ff in: + https://lists.gnu.org/r/emacs-devel/2018-04/msg00058.html + * src/ftfont.c (ftfont_spec_pattern) [!FC_COLOR]: + Don’t use FC_COLOR on older fontconfigs that don’t have it. + +2018-06-05 Robert Pluim <rpluim@gmail.com> + + Ignore color fonts when using Xft + + * src/font.c (syms_of_font): New configuration variable + xft-ignore-color-fonts, default t. + * src/ftfont.c (ftfont_spec_pattern): Tell fontconfig to ignore + color fonts if xft-ignore-color-fonts is t. (Bug#30874, Bug#30045) + * etc/NEWS: Document xft-ignore-color-fonts. + +2018-06-04 Noam Postavsky <npostavs@gmail.com> + + Fix comint-get-old-input-default for output field case (Bug#25028) + + * lisp/comint.el (comint-get-old-input-default): Don't return whole + field when point was on an output field. + +2018-06-04 Eli Zaretskii <eliz@gnu.org> + + Prevent infloop in 'delete-trailing-whitespace' + + * lisp/simple.el (delete-trailing-whitespace): Avoid inflooping + when some region of trailing whitespace is unmodifiable. + (Bug#31557) + +2018-06-04 Gemini Lasswell <gazally@runbox.com> + + Make cl-print respect print-level and print-length (bug#31559) + + * lisp/emacs-lisp/cl-print.el (cl-print--depth): New variable. + (cl-print-object) <cons>: Print ellipsis if printing depth greater + than 'print-level' or length of list greater than 'print-length'. + (cl-print-object) <vector>: Truncate printing with ellipsis if + vector is longer than 'print-length'. + (cl-print-object) <cl-structure-object>: Truncate printing with + ellipsis if structure has more slots than 'print-length'. + (cl-print-object) <:around>: Bind 'cl-print--depth'. + * test/lisp/emacs-lisp/cl-print-tests.el + (cl-print-tests-3, cl-print-tests-4): New tests. + + (cherry picked from commit 0f48d18fd2a30f29cc3592a835d2a2254c9b0afb) + +2018-06-03 Phil Sainty <psainty@orcon.net.nz> + + Fix remote-host directory tracking for shells in `term' buffers + + * lisp/term.el (term-handle-ansi-terminal-messages): Use an explicit + tramp method when constructing the tramp path for a non-local host, + as this is now mandatory. "-" is a pseudo-method for the user's + `tramp-default-method'. (Bug#31355) + + Specify the remote username explicitly in all cases, as + `tramp-default-user' and `tramp-default-user-alist' could cause the + previous logic to fail. + + Minor related improvements to the commentary. + +2018-06-03 Eli Zaretskii <eliz@gnu.org> + + Update doc string of 'rx' + + * lisp/emacs-lisp/rx.el (rx): Update the description of some + character classes. + +2018-06-03 Stefan Monnier <monnier@iro.umontreal.ca> + + Fix bug#30846, along with misc cleanups found along the way + + * test/src/data-tests.el (data-tests-kill-all-local-variables): New test. + + * src/buffer.c (swap_out_buffer_local_variables): Remove. + Fuse the body of its loop into that of reset_buffer_local_variables. + (Fkill_buffer, Fkill_all_local_variables): Don't call it any more. + (reset_buffer_local_variables): Make sure the buffer's local binding + is swapped out before removing it from the alist (bug#30846). + Call watchers before actually killing the var. + + * src/data.c (Fmake_local_variable): Simplify. + Use swap_in_global_binding to swap out any local binding, instead of + a mix of find_symbol_value followed by messing with where&found. + Don't call swap_in_symval_forwarding since the currently swapped + binding is never one we've modified. + (Fkill_local_variable): Use swap_in_global_binding rather than messing + with where&found to try and trick find_symbol_value into doing the same. + + * src/alloc.c (mark_localized_symbol): 'where' can't be a frame any more. + + (cherry picked from commit 3ddff080341580eb6fc18d907181e9cc2301f62d) + +2018-06-03 Jay Kamat <jaygkamat@gmail.com> + + esh-opt.el: Fix improper parsing of first argument (Bug#28323) + + Examples of broken behavior: + + sudo -u root whoami + Outputs: -u + ls -I '*.txt' /dev/null + Errors with: *.txt: No such file or directory + + * lisp/eshell/esh-opt.el (eshell--process-args): Refactor usage of + args to eshell--args, as we rely on modifications from + eshell--process-option and vice versa. These modifications were not + being propogated in the (if (= ai 0)) case, since popping the first + element of a list doesn't destructively modify the underlying list + object. + + (cherry picked from commit 92a8230e49a65be48442ee95cf50c90514e48f99) + +2018-06-03 Noam Postavsky <npostavs@gmail.com> + + * lisp/epa.el (epa-decrypt-file): Apply epa-pinentry-mode (Bug#30363). + + (cherry picked from commit 217202c084232f36d4fa0fead0f3aca21396d074) + +2018-06-03 Noam Postavsky <npostavs@gmail.com> + + Fix cl-print for circular sublists (Bug#31146) + + * lisp/emacs-lisp/cl-print.el (cl-print-object) <cons>: Push each + element of list being printed onto cl-print--currently-printing. + * test/lisp/emacs-lisp/cl-print-tests.el (cl-print-circle-2): New + test. + + (cherry picked from commit b8aa7ecf54c9b164a59f1b0e9f9fe90531dadd20) + +2018-06-03 Lars Ingebrigtsen <larsi@gnus.org> + + Revert "Make mail-extract-address-components return the user name more" + + This reverts commit 8b50ae8b2284b5652c2843a9d0d076f4f657be28. + + According to tests in bug#27656 by OGAWA Hirofumi, this patch + led to wrong results when binding + + (dolist (addr '("Rasmus <rasmus@gmx.us>" "Rasmus <mbox@gmx.us>")) + (dolist (ignore-single '(t nil)) + (dolist (ignore-same '(t nil)) + (let ((mail-extr-ignore-single-names ignore-single) + (mail-extr-ignore-realname-equals-mailbox-name ignore-same)) + (message "%s" (mail-extract-address-components addr)))))) + + in combination. + + (cherry picked from commit a3a9d5434d56f8736cc47e379a1d011d4c779b7c) + +2018-06-03 Paul Eggert <eggert@cs.ucla.edu> + + Centralize Bug#30931 fix + + * src/marker.c (detach_marker): New function. + * src/editfns.c (save_restriction_restore): + * src/insdel.c (signal_before_change): Use it. + + (cherry picked from commit 6f66a43d7ad6cada2b7dbb6d07efe36be1dc7ecb) + +2018-06-03 Noam Postavsky <npostavs@gmail.com> + + Fix another case of freed markers in the undo-list (Bug#30931) + + * src/alloc.c (free_marker): Remove. + * src/editfns.c (save_restriction_restore): + * src/insdel.c (signal_before_change): Detach the markers from the + buffer when we're done with them instead of calling free_marker on + them. + * test/src/editfns-tests.el (delete-region-undo-markers-1) + (delete-region-undo-markers-2): New tests. + + (cherry picked from commit 96b8747d5c5d747af13fd84d8fe0308ef2a0ea7a) + +2018-06-03 Paul Eggert <eggert@cs.ucla.edu> + + Fix CHECK_ALLOCATED_AND_LIVE abort during GC + + * src/editfns.c (save_restriction_restore): + Wait for the GC to free the temporary markers (Bug#30931). + + (cherry picked from commit 670f2ffae718046c0fb37313965a51c040ed096f) + +2018-06-03 Noam Postavsky <npostavs@gmail.com> + + Don't wait for visible frames to become visible + + For discussion, see thread starting at + https://lists.gnu.org/archive/html/emacs-devel/2018-03/msg00807.html. + * src/xterm.c (x_make_frame_visible): Check FRAME_VISIBLE_P before + calling x_wait_for_event. + + (cherry picked from commits 2a192e21cf3b04b7f830b4971c1508c611e13a3c + and 00c1f771f2a51ffa675ec5a07ea330f2605cd302) + +2018-06-03 Tino Calancha <tino.calancha@gmail.com> + + query-replace undo: Handle when user edits the replacement string + + * lisp/replace.el (perform-replace): Update the replacement string + after the user edit it (Fix Bug#31538). + + * test/lisp/replace-tests.el (query-replace-undo-bug31538): New test. + + Backport: (cherry picked from commits + ea133e04f49afa7928e49a3ac4a85b47f6f13f01 + and + 7dcfdf5b14325ae7996f272f14c72810d7c84944) + +2018-06-03 Tino Calancha <tino.calancha@gmail.com> + + Backport: Fix corner case in query-replace-regexp undo + + This commit fixes Bug#31492. + * lisp/replace.el (replace-match-maybe-edit): Preserve match data. + + * test/lisp/replace-tests.el (query-replace-undo-bug31492): Add test. + + (cherry picked from commit bab73230d1be1fe394b7269c1365ef6fb1a5d9b3) + +2018-06-03 Tino Calancha <tino.calancha@gmail.com> + + Backport: Preserve case in query-replace undo + + If the user query and replaces 'foo' with 'BAR', then + undo must comeback to 'foo', not to 'FOO' (Bug#31073). + * lisp/replace.el (perform-replace): Bind nocasify to non-nil + value during undo/undo-all actions. + * test/lisp/replace-tests.el (query-replace-undo-bug31073): Add test. + + (cherry picked from commit 32dc0cb1b5ae895d237c7118ccaeb084715934fd) + +2018-06-02 Alan Third <alan@idiocy.org> + + Set accessibility subroles for child frame (bug#31324) + + + * src/nsterm.m (x_set_parent_frame): Set subrole depending on whether + frame is a child or not. + +2018-06-02 Alan Third <alan@idiocy.org> + + Fix redefinition of child frames on NS + + * src/nsterm.m (x_set_parent_frame): If the NSWindow has an existing + parent frame, remove it. + +2018-06-02 Eli Zaretskii <eliz@gnu.org> + + Improve ELisp documentation of 'clone-indirect-buffer' + + * doc/lispref/buffers.texi (Indirect Buffers): Be more explicit + about the value of DISPLAY-FLAG in interactive usage. (Bug#31648) + +2018-06-02 Eli Zaretskii <eliz@gnu.org> + + Improve documentation of 'inhibit-message' + + * src/xdisp.c (syms_of_xdisp) <inhibit-message>: Warn against + setting it non-nil globally. (Bug#31627) + +2018-06-02 Eli Zaretskii <eliz@gnu.org> + + Improve documentation of comment styles + + * doc/lispref/syntax.texi (Syntax Flags): Define the "a" style. + (Bug#31624) + +2018-06-02 Eli Zaretskii <eliz@gnu.org> + + Documentation improvements in newcomment.el + + * lisp/newcomment.el (uncomment-region) + (uncomment-region-default): Doc fixes. (Bug#31615) + +2018-06-02 Eli Zaretskii <eliz@gnu.org> + + Imp[rove documentation of 'with-silent-modifications' + + * doc/lispref/buffers.texi (Buffer Modification): Document + 'with-silent-modifications'. (Bug#31613) + * doc/lispref/text.texi (Changing Properties): Add a + cross-reference to "Buffer Modification". Improve wording. + +2018-06-02 Eli Zaretskii <eliz@gnu.org> + + Fix decoding of directories when "~" includes non-ASCII chars + + * src/fileio.c (Fexpand_file_name): Don't build multibyte strings + from unibyte non-ASCII strings when NAME and DEFAULT_DIRECTORY + have different multibyteness, as this adds bytes to the byte + sequence, and in some situations, e.g., when the home directory + includes non-ASCII characters, can fail file APIs. (Bug#30755) + + * lisp/startup.el (normal-top-level): Make sure default-directory + is set to a multibyte string when decoded on MS-Windows. + + (cherry picked from commit 3aab8626ba5080bb04d0fdae52d99c850a842a52) + +2018-06-02 Eli Zaretskii <eliz@gnu.org> + + Don't remove highlight of misspelled word on pdict save + + * lisp/textmodes/ispell.el (ispell-pdict-save): Don't restart + flyspell-mode, as bug#11963, which this was supposed to fix, is + fixed better by ispell-command-loop, when the user types 'i' or + 'a'. Restarting Flyspell mode when the personal dictionary is + saved caused bug#31372 as side effect. + (ispell-command-loop): Test 'flyspell-mode', not whether + flyspell-unhighlight-at is fboundp, to determine whether Flyspell + mode is turned on in the current buffer. + (flyspell-unhighlight-at): Add declare-function form for it. + + (cherry picked from commit 91e582a31ada28fab5ae55bdbf959a9d30796587) + +2018-06-02 Ari Roponen <ari.roponen@gmail.com> + + Fix some problems in the Cairo build + + * src/xterm.c (x_begin_cr_clip): Create image surface. + (x_update_end) [USE_CAIRO]: Remove GTK3-specific code. + (x_scroll_run) [USE_CAIRO]: Implement scrolling. + * src/image.c (lookup_rgb_color) [USE_CAIRO]: Support Cairo. + (jpeg_load_body) [USE_CAIRO]: Support Cairo. Use USE_CAIRO + instead of CAIRO for #ifdef's. + (imagemagick_load_image) [USE_CAIRO]: Support Cairo. + (Bug#31288) + + (cherry picked from commit 2d0eff42b8f1122e00f948759ed01a3be1a8c3fc) + +2018-06-02 Eli Zaretskii <eliz@gnu.org> + + Avoid infloops in font_open_entity + + * src/font.c (font_open_entity): Fail after 15 iterations through + the loop that looks for a font whose average_width and height are + both positive. This avoids infinite loops for fonts that, e.g., + report average_width of zero for any possible size we try. + (Bug#31316) + + (cherry picked from commit e2879c1f837059335af89022b2a9ac9bc861e96d) + +2018-06-02 Eli Zaretskii <eliz@gnu.org> + + Fix encoding of characters when using GB18030 fonts + + * lisp/international/fontset.el (font-encoding-alist): Fix the + GB18030 entry to encode characters correctly when passing them to + the xfont back-end. (Bug#31315) See also + http://lists.gnu.org/archive/html/emacs-devel/2008-01/msg00754.html. + + (cherry picked from commit bbe2cadc544e63e9378350621887f8fb9bbcc236) + +2018-06-02 Eli Zaretskii <eliz@gnu.org> + + Fix C-p and C-n when wrap-prefix is too wide + + * src/xdisp.c (move_it_in_display_line_to): Avoid looping in + previous/next-line when wrap-prefix is set to a too-wide + stretch of whitespace. (Bug#30432) + + (cherry picked from commit 842b3d7412eaed6b2c9f90c3361abb4932ec0b1d) + +2018-06-02 Eli Zaretskii <eliz@gnu.org> + + Avoid redisplay problems with too wide wrap-prefix + + * src/xdisp.c (display_line): Avoid looping in redisplay when + wrap-prefix is set to a too-wide stretch of whitespace. + (Bug#30432) + + (cherry picked from commit 2a1fe08307402d6217d073f8ab7737750d253dd4) + +2018-06-02 Eli Zaretskii <eliz@gnu.org> + + Fix 'posn-at-point' when line numbers are displayed + + * src/xdisp.c (pos_visible_p): For the leftmost glyph, adjust the X + coordinate due to line-number display. (Bug#30834) + + (cherry picked from commit 4a20174d7949028f66b18a92a75d6b74194242a8) + +2018-06-02 Eli Zaretskii <eliz@gnu.org> + + Another followup to fixing 'window-text-pixel-width' + + * src/xdisp.c (Fwindow_text_pixel_size): Adjust the return value + when we stop one buffer position short of TO. (Bug#30746) + + (cherry picked from commit 33cba5405c724566673cf023513bfb1faa963bea) + +2018-06-02 Eli Zaretskii <eliz@gnu.org> + + Fix mouse-set-point when line numbers are displayed + + * src/xdisp.c (move_it_to): Initialize the line_number_produced_p + flag before iterating on a new line. (Bug#30818) + + (cherry picked from commit 5c585b8b994aad4e6844f8eed80bdfbb396e91bf) + +2018-06-02 Eli Zaretskii <eliz@gnu.org> + + * src/xdisp.c (Fwindow_text_pixel_size): Fix last change. + + (cherry picked from commit 06911714ef66ea81380b1eda75a9f7cfbc9e0b65) + +2018-06-02 Eli Zaretskii <eliz@gnu.org> + + Fix 'window-text-pixel-size' when display properties are around + + * src/xdisp.c (Fwindow_text_pixel_size): Correct the result when + there's a display property at the TO position, and the call to + move_it_to overshoots. (Bug#30746) + + (cherry picked from commit 50e2c0fb5180a757d8d533518f68837ffe5909be) + +2018-06-02 Eli Zaretskii <eliz@gnu.org> + + Fix display of TABs in hscrolled windows with line numbers + + * src/dispextern.h (struct it): New members tab_offset and + line_number_produced_p. + * src/xdisp.c (display_line): Don't set row->x to a negative value + if line numbers are being displayed. (Bug#30582) + Reset the line_number_produced_p flag before laying out the glyph + row. + (x_produce_glyphs): Use the line_number_produced_p flag to decide + whether to offset the X coordinate due to line-number display. + Use the tab_offset member to restore the original TAB width for + alignment purposes. + (move_it_in_display_line_to): Don't produce line numbers when moving + in hscrolled window to the left of first_visible_x. + (maybe_produce_line_number): Set the line_number_produced_p flag. + (Bug#30584) + * src/term.c (produce_glyphs): Correct TAB width only when + line_number_produced_p flag is set. + + (cherry picked from commit 1ac190553886ff20817d3dd218464e2fc6f9e42a) + +2018-06-02 Matthias Dahl <matthias.dahl@binary-island.eu> + + Fix wait_reading_process_output wait_proc hang + + * src/process.c (read_process_output): Track bytes read from + a process. + (wait_reading_process_output): If called recursively through + timers and/or process filters via accept-process-output, it is + possible that the output of wait_proc has already been read by + one of those recursive calls, leaving the original call hanging + forever if no further output arrives through that fd and no + timeout has been set. Fix that by using the process read + accounting to keep track of how many bytes have been read and + use that as a condition to break out of the infinite loop and + return to the caller as well as to calculate the proper return + value (if a wait_proc is given that is). + + * src/process.h (struct Lisp_Process): Add nbytes_read to track + bytes read from a process. + + (cherry picked from commit 4ba32858d61eee16f17b51aca01c15211a0912f8) + +2018-06-02 Eli Zaretskii <eliz@gnu.org> + + Fix posn-at-point in Flycheck buffers + + * src/dispnew.c (buffer_posn_from_coords): Improve commentary. + + * src/xdisp.c (move_it_in_display_line_to): Don't exit the loop + under truncate-lines if the glyph at TO_CHARPOS was not yet + produced. This avoids bailing out too early when we are at + TO_CHARPOS, but didn't yet produce glyphs for that buffer + position, because the last call to PRODUCE_GLYPHS at this position + was for an object other than the buffer. For further details, see + http://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00537.html. + + (cherry picked from commit c0154ac7c3423f68d8f3a2e85a756c9759219039) + +2018-06-02 Martin Rudalics <rudalics@gmx.at> + + * etc/PROBLEMS: Document stickyness problem with FVWM (Bug#31650) + +2018-06-01 Eli Zaretskii <eliz@gnu.org> + + Update Emacs Lisp Intro to match current behavior + + * doc/lispintro/emacs-lisp-intro.texi (Wrong Type of Argument) + (debug, debug-on-entry, Void Function, Void Variable): Update the + *Backtrace* buffer display to current Emacs. (Bug#31654) + +2018-06-01 Robert Pluim <rpluim@gmail.com> + + Fix previous commit + + * doc/emacs/files.texi (Interlocking): Two spaces at end of sentence + +2018-06-01 Ville Skyttä <ville.skytta@iki.fi> (tiny change) + + Fix typos in several manuals (Bug#31610) + +2018-06-01 Robert Pluim <rpluim@gmail.com> + + Add detailed documentation about lock files + + * doc/emacs/files.texi (Interlocking): Point user at detailed + file locking description in lisp reference manual. Add index + entry for '.#' to improve disoverability of information about locking. + + * doc/lispref/files.texi (File Locks): Describe in detail what + the form of the lock file is. Add index entry for '.#' to + improve disoverability of information about locking. + + * src/filelock.c (create-lockfiles): Add cross reference to + file locking in user manual and to 'lock-buffer'. Add string + '.#' to help users find the doc string. + +2018-06-01 Eli Zaretskii <eliz@gnu.org> + + Add commentary for subtle aspect of frame.el + + * lisp/frame.el: Explain why we use symbol-function when adding + watchers for certain variables that need to trigger redisplay. + +2018-06-01 Eli Zaretskii <eliz@gnu.org> + + Improve documentation of 'directory-files-and-attributes' + + * doc/lispref/files.texi (Contents of Directories): Fix inaccurate + description of the return value of directory-files-and-attributes. + + * src/dired.c (Fdirectory_files_and_attributes): Describe the + function's value in more detail. + +2018-05-30 Katsumi Yamaoka <yamaoka@jpl.org> + + * lisp/gnus/message.el (message-remove-header): Don't remove things + not looking like header (bug#31651). + +2018-05-30 Eli Zaretskii <eliz@gnu.org> + + Adapt hexl-mode to native line-number display + + * lisp/hexl.el (hexl-mode-ruler): When display-line-numbers is in + effect, adjust offsets and columns to account for the line-number + display. (Bug#31595) + +2018-05-30 Michael Albinus <michael.albinus@gmx.de> + + Fix example in Tramp manual + + * doc/misc/tramp.texi (Frequently Asked Questions): Fix wording + for the zsh example. + +2018-05-29 Robert Pluim <rpluim@gmail.com> + + Handle case where Xft is found but not XRender + + * configure.ac (XFT_LIBS): Ensure that HAVE_XFT is no if + XRender is not found. (Bug#31634) + +2018-05-29 Michael Albinus <michael.albinus@gmx.de> + + * doc/misc/tramp.texi (Frequently Asked Questions): Adapt zsh example. + +2018-05-29 Damien Cassou <damien@cassou.me> + + Improve read-multiple-choice docstring (Bug#31628) + + * lisp/emacs-lisp/rmc.el (read-multiple-choice): Improve docstring. + +2018-05-29 Michael Albinus <michael.albinus@gmx.de> + + * doc/misc/tramp.texi (All): Use @code instead of @option for user options. + +2018-05-29 Michael Albinus <michael.albinus@gmx.de> + + Fix Bug#31605 + + * doc/misc/tramp.texi (All): Add @vindex entries for + environment variables. + (Remote shell setup): New items `tramp-terminal-type' and + "Determining a Tramp session". + (Frequently Asked Questions): Adapt zsh example. (Bug#31605) + +2018-05-29 Michael Albinus <michael.albinus@gmx.de> + + Sync with Tramp 2.3.4-pre + + * doc/misc/trampver.texi: Change version to "2.3.4-pre + + * lisp/net/tramp.el (tramp-mode, tramp-verbose) + (tramp-backup-directory-alist, tramp-auto-save-directory) + (tramp-encoding-shell, tramp-encoding-command-switch) + (tramp-encoding-command-interactive, tramp-default-method) + (tramp-default-method-alist, tramp-default-user) + (tramp-default-user-alist, tramp-default-host) + (tramp-default-host-alist, tramp-default-proxies-alist) + (tramp-save-ad-hoc-proxies, tramp-restricted-shell-hosts-alist) + (tramp-local-end-of-line, tramp-rsh-end-of-line) + (tramp-login-prompt-regexp, tramp-shell-prompt-pattern) + (tramp-password-prompt-regexp, tramp-wrong-passwd-regexp) + (tramp-yesno-prompt-regexp, tramp-yn-prompt-regexp) + (tramp-terminal-prompt-regexp) + (tramp-operation-not-permitted-regexp, tramp-copy-failed-regexp) + (tramp-process-alive-regexp, tramp-chunksize) + (tramp-process-connection-type, tramp-connection-timeout) + (tramp-connection-min-time-diff) + (tramp-completion-reread-directory-timeout): + * lisp/net/tramp-adb.el (tramp-adb-program) + (tramp-adb-connect-if-not-connected, tramp-adb-prompt): + * lisp/net/tramp-cache.el (tramp-connection-properties) + (tramp-persistency-file-name): + * lisp/net/tramp-gvfs.el (tramp-gvfs-methods) + (tramp-gvfs-zeroconf-domain, tramp-bluez-discover-devices-timeout): + * lisp/net/tramp-sh.el (tramp-inline-compress-start-size) + (tramp-copy-size-limit, tramp-terminal-type) + (tramp-histfile-override, tramp-use-ssh-controlmaster-options) + (tramp-remote-path, tramp-remote-process-environment) + (tramp-sh-extra-args): + * lisp/net/tramp-smb.el (tramp-smb-program, tramp-smb-acl-program) + (tramp-smb-conf, tramp-smb-winexe-program) + (tramp-smb-winexe-shell-command) + (tramp-smb-winexe-shell-command-switch): + Dont't require 'tramp. (Bug#31558) + + * lisp/net/tramp.el (tramp-accept-process-output): + * lisp/net/tramp-adb.el (tramp-adb-handle-start-file-process): + * lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band) + (tramp-sh-handle-start-file-process): + * lisp/net/tramp-smb.el (tramp-smb-handle-copy-directory) + (tramp-smb-handle-file-acl, tramp-smb-handle-process-file) + (tramp-smb-handle-set-file-acl) + (tramp-smb-handle-start-file-process): Suppress timers. + + * lisp/net/tramp-adb.el (tramp-adb-handle-write-region): + * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-write-region): + * lisp/net/tramp-sh.el (tramp-sh-handle-write-region): + * lisp/net/tramp-smb.el (tramp-smb-handle-write-region): + Write proper message. + + * lisp/net/tramp-cmds.el (tramp-change-syntax): + Use `customize-set-variable'. + + * lisp/net/tramp-sh.el (tramp-open-connection-setup-interactive-shell): + Ensure proper EOL handling for Darwin. + (tramp-find-inline-compress): Improve command quoting for w32. + Reported by Chris Zheng <chriszheng99@gmail.com>. + (tramp-open-connection-setup-interactive-shell): Wrap both echo + calls in parentheses, in order to avoid double prompt. + + * lisp/net/tramp-smb.el (tramp-smb-errors): + Add "NT_STATUS_RESOURCE_NAME_NOT_FOUND". + + * lisp/net/tramp.el (tramp-default-user-alist) + (tramp-default-host-alist): Fix docstring. + (tramp-dissect-file-name): Adapt docstring. (Bug#30904) + (tramp-make-tramp-file-name): Check, that method is + not empty. (Bug#30038) + (tramp-message-show-message): Change default. + + * lisp/net/trampver.el: Change version to "2.3.4-pre". + + * test/lisp/net/tramp-tests.el (ert-x): Require it. + (tramp-test10-write-region): Extend test. + (tramp--test-emacs27-p, tramp--test-windows-nt): New defuns. + (tramp-test11-copy-file, tramp-test12-rename-file) + (tramp-test21-file-links, tramp-test24-file-acl) + (tramp-test25-file-selinux, tramp--test-check-files): Use them. + (tramp-test21-file-links): Do not call `make-symbolic-link' on w32. + Fix file name quoting test. + (tramp-test32-environment-variables-and-port-numbers): + Adapt check for systems which do not support "echo -n". (Bug#29712) + (tramp-test36-find-backup-file-name): Call also + `convert-standard-filename' due to w32. + (tramp-test41-asynchronous-requests): + Use $REMOTE_PARALLEL_PROCESSES. Flush cache prior file operations. + (tramp-test42-auto-load, tramp-test42-delay-load) + (tramp-test42-recursive-load, tramp-test42-remote-load-path): + Quote command due to w32. + +2018-05-28 Eli Zaretskii <eliz@gnu.org> + + Bump Emacs version to 26.1.50 + + * msdos/sed2v2.inp: + * nt/README.W32: + * configure.ac: + * README: Bump Emacs version to 26.1.50. + +2018-05-27 Thien-Thi Nguyen <ttn@gnu.org> + + Mention pcase as a fifth conditional form + + * doc/lispref/control.texi (Conditionals): ...here, + in first para, w/ xref to "Pattern-Matching Conditional". + +2018-05-27 Thien-Thi Nguyen <ttn@gnu.org> + + Overhaul pcase documentation + + Suggested by Drew Adams (Bug#31311). + + * doc/lispref/control.texi (Control Structures): + Add "Pattern-Matching Conditional" to menu, before "Iteration". + (Conditionals): Delete menu. + (Pattern matching case statement): Delete node/subsection, + by actually moving, renaming, and overhauling it to... + (Pattern-Matching Conditional): ...new node/section. + (pcase Macro): New node/subsection. + (Extending pcase): Likewise. + (Backquote Patterns): Likewise. + * doc/lispref/elisp.texi (Top) In @detailmenu, add + "Pattern-Matching Conditional" under "Control Structures" + section and delete "Conditionals" section. + * lisp/emacs-lisp/pcase.el (pcase): Rewrite docstring. + (pcase-defmacro \` (qpat) ...): Likewise. + +2018-05-27 Thien-Thi Nguyen <ttn@gnu.org> + + Use EXPVAL in docstrings of patterns defined using pcase-defmacro + + Suggested by Drew Adams (Bug#31311). + + * lisp/emacs-lisp/cl-macs.el (cl-struct): ...here. + * lisp/emacs-lisp/eieio.el (eieio): Likewise. + * lisp/emacs-lisp/radix-tree.el (radix-tree-leaf): Likewise. + * lisp/emacs-lisp/rx.el (rx): Likewise. + +2018-05-27 Thien-Thi Nguyen <ttn@gnu.org> + + Introduce EXPVAL for pcase, pcase-defmacro docstrings + + Suggested by Drew Adams (Bug#31311). + + * lisp/emacs-lisp/pcase.el (pcase): Use EXPVAL in + docstring to stand for the result of evaluating EXP. + (pcase-defmacro): Add (fn ...) form in docstring + that includes [DOC], and the EXPVAL convention. + +2018-05-27 Thien-Thi Nguyen <ttn@gnu.org> + + Ensure pcase doc shows `QPAT first among extensions + + * lisp/emacs-lisp/pcase.el (pcase--make-docstring): + Split extensions display into two phases, collection + and display, separated by a reordering step that + ensures backquote is the first. + +2018-05-25 Nicolas Petton <nicolas@petton.fr> + + * etc/HISTORY: Update for Emacs 26.1 release. + + * etc/AUTHORS: Update. + 2018-05-25 Noam Postavsky <npostavs@gmail.com> Note caveat for backward regexp searching in docstring (Bug#31584) @@ -59730,7 +61157,7 @@ This file records repository revisions from commit 9d56a21e6a696ad19ac65c4b405aeca44785884a (exclusive) to -commit 35574609dd09e2eab0301309b0e3bf831f627fcc (inclusive). +commit f205928d1f93f4373d755ca91805a88e022ac414 (inclusive). See ChangeLog.1 for earlier changes. ;; Local Variables: commit f205928d1f93f4373d755ca91805a88e022ac414 Author: Paul Eggert <eggert@cs.ucla.edu> Date: Sun Jul 1 08:25:46 2018 -0700 * etc/HISTORY: Cite Brinkoff on early history. diff --git a/etc/HISTORY b/etc/HISTORY index ba86182a1c..b239904253 100644 --- a/etc/HISTORY +++ b/etc/HISTORY @@ -12,10 +12,11 @@ development is sketchy, the following text summarizes what is known. EMACS started out as a set of macros atop the TECO text editor, and was first operational in late 1976. It was inspired by earlier work such as the E editor of Stanford, and was based on older TECO macro -sets. EMACS in turn inspired several similar editors. See: -Stallman RM. EMACS: The Extensible, Customizable Self-Documenting -Display Editor. AI Memo 519a, MIT, 1981-03-26 +sets. See: Stallman RM. EMACS: The Extensible, Customizable +Self-Documenting Display Editor. AI Memo 519a, MIT, 1981-03-26 <http://dspace.mit.edu/bitstream/handle/1721.1/5736/AIM-519A.pdf>. +EMACS in turn inspired several similar editors. For a summary of +this history, see <https://github.com/larsbrinkhoff/emacs-history>. In 1984, work began on GNU Emacs, a fresh implementation designed to run on GNU and GNU-like systems, with a full-featured Lisp at its commit 7edc019651b3e16592d2d16616a7d4cecc285ae6 Author: Glenn Morris <rgm@gnu.org> Date: Sun Jul 1 07:27:20 2018 -0400 ; Auto-commit of loaddefs files. diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 35cff524c9..5f26eba695 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -1548,7 +1548,7 @@ let-binding.") ;;;### (autoloads nil "auth-source-pass" "auth-source-pass.el" (0 ;;;;;; 0 0 0)) ;;; Generated autoloads from auth-source-pass.el -(push (purecopy '(auth-source-pass 2 0 0)) package--builtin-versions) +(push (purecopy '(auth-source-pass 4 0 1)) package--builtin-versions) (autoload 'auth-source-pass-enable "auth-source-pass" "\ Enable auth-source-password-store. @@ -5918,6 +5918,9 @@ Use `\\[info-lookup-symbol]' to look up documentation of CSS properties, at-rule pseudo-classes, and pseudo-elements on the Mozilla Developer Network (MDN). +Use `\\[fill-paragraph]' to reformat CSS declaration blocks. It can also +be used to fill comments. + \\{css-mode-map} \(fn)" t nil) @@ -12932,7 +12935,7 @@ to get the effect of a C-q. ;;;### (autoloads nil "flymake" "progmodes/flymake.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/flymake.el -(push (purecopy '(flymake 0 3)) package--builtin-versions) +(push (purecopy '(flymake 1 0)) package--builtin-versions) (autoload 'flymake-log "flymake" "\ Log, at level LEVEL, the message MSG formatted with ARGS. @@ -12945,10 +12948,11 @@ generated it. (autoload 'flymake-make-diagnostic "flymake" "\ Make a Flymake diagnostic for BUFFER's region from BEG to END. -TYPE is a key to `flymake-diagnostic-types-alist' and TEXT is a -description of the problem detected in this region. +TYPE is a key to symbol and TEXT is a description of the problem +detected in this region. DATA is any object that the caller +wishes to attach to the created diagnostic for later retrieval. -\(fn BUFFER BEG END TYPE TEXT)" nil nil) +\(fn BUFFER BEG END TYPE TEXT &optional DATA)" nil nil) (autoload 'flymake-diagnostics "flymake" "\ Get Flymake diagnostics in region determined by BEG and END. @@ -12989,7 +12993,9 @@ The commands `flymake-goto-next-error' and diagnostics annotated in the buffer. The visual appearance of each type of diagnostic can be changed -in the variable `flymake-diagnostic-types-alist'. +by setting properties `flymake-overlay-control', `flymake-bitmap' +and `flymake-severity' on the symbols of diagnostic types (like +`:error', `:warning' and `:note'). Activation or deactivation of backends used by Flymake in each buffer happens via the special hook @@ -13018,10 +13024,26 @@ Turn Flymake mode off. ;;;*** +;;;### (autoloads nil "flymake-cc" "progmodes/flymake-cc.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from progmodes/flymake-cc.el + +(autoload 'flymake-cc "flymake-cc" "\ +Flymake backend for GNU-style C compilers. +This backend uses `flymake-cc-command' (which see) to launch a +process that is passed the current buffer's contents via stdin. +REPORT-FN is Flymake's callback. + +\(fn REPORT-FN &rest ARGS)" nil nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "flymake-cc" '("flymake-cc-"))) + +;;;*** + ;;;### (autoloads nil "flymake-proc" "progmodes/flymake-proc.el" ;;;;;; (0 0 0 0)) ;;; Generated autoloads from progmodes/flymake-proc.el -(push (purecopy '(flymake-proc 0 3)) package--builtin-versions) +(push (purecopy '(flymake-proc 1 0)) package--builtin-versions) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "flymake-proc" '("flymake-proc-"))) @@ -18636,16 +18658,10 @@ If nil, the default personal dictionary for your spelling checker is used.") (put 'ispell-local-dictionary 'safe-local-variable 'string-or-null-p) -(defvar ispell-menu-map nil "\ +(defconst ispell-menu-map (let ((map (make-sparse-keymap "Spell"))) (define-key map [ispell-change-dictionary] `(menu-item ,(purecopy "Change Dictionary...") ispell-change-dictionary :help ,(purecopy "Supply explicit dictionary file name"))) (define-key map [ispell-kill-ispell] `(menu-item ,(purecopy "Kill Process") (lambda nil (interactive) (ispell-kill-ispell nil 'clear)) :enable (and (boundp 'ispell-process) ispell-process (eq (ispell-process-status) 'run)) :help ,(purecopy "Terminate Ispell subprocess"))) (define-key map [ispell-pdict-save] `(menu-item ,(purecopy "Save Dictionary") (lambda nil (interactive) (ispell-pdict-save t t)) :help ,(purecopy "Save personal dictionary"))) (define-key map [ispell-customize] `(menu-item ,(purecopy "Customize...") (lambda nil (interactive) (customize-group 'ispell)) :help ,(purecopy "Customize spell checking options"))) (define-key map [ispell-help] `(menu-item ,(purecopy "Help") (lambda nil (interactive) (describe-function 'ispell-help)) :help ,(purecopy "Show standard Ispell keybindings and commands"))) (define-key map [flyspell-mode] `(menu-item ,(purecopy "Automatic spell checking (Flyspell)") flyspell-mode :help ,(purecopy "Check spelling while you edit the text") :button (:toggle bound-and-true-p flyspell-mode))) (define-key map [ispell-complete-word] `(menu-item ,(purecopy "Complete Word") ispell-complete-word :help ,(purecopy "Complete word at cursor using dictionary"))) (define-key map [ispell-complete-word-interior-frag] `(menu-item ,(purecopy "Complete Word Fragment") ispell-complete-word-interior-frag :help ,(purecopy "Complete word fragment at cursor"))) (define-key map [ispell-continue] `(menu-item ,(purecopy "Continue Spell-Checking") ispell-continue :enable (and (boundp 'ispell-region-end) (marker-position ispell-region-end) (equal (marker-buffer ispell-region-end) (current-buffer))) :help ,(purecopy "Continue spell checking last region"))) (define-key map [ispell-word] `(menu-item ,(purecopy "Spell-Check Word") ispell-word :help ,(purecopy "Spell-check word at cursor"))) (define-key map [ispell-comments-and-strings] `(menu-item ,(purecopy "Spell-Check Comments") ispell-comments-and-strings :help ,(purecopy "Spell-check only comments and strings"))) (define-key map [ispell-region] `(menu-item ,(purecopy "Spell-Check Region") ispell-region :enable mark-active :help ,(purecopy "Spell-check text in marked region"))) (define-key map [ispell-message] `(menu-item ,(purecopy "Spell-Check Message") ispell-message :visible (eq major-mode 'mail-mode) :help ,(purecopy "Skip headers and included message text"))) (define-key map [ispell-buffer] `(menu-item ,(purecopy "Spell-Check Buffer") ispell-buffer :help ,(purecopy "Check spelling of selected buffer"))) map) "\ Key map for ispell menu.") -(defvar ispell-menu-map-needed (unless ispell-menu-map 'reload)) - -(if ispell-menu-map-needed (progn (setq ispell-menu-map (make-sparse-keymap "Spell")) (define-key ispell-menu-map [ispell-change-dictionary] `(menu-item ,(purecopy "Change Dictionary...") ispell-change-dictionary :help ,(purecopy "Supply explicit dictionary file name"))) (define-key ispell-menu-map [ispell-kill-ispell] `(menu-item ,(purecopy "Kill Process") (lambda nil (interactive) (ispell-kill-ispell nil 'clear)) :enable (and (boundp 'ispell-process) ispell-process (eq (ispell-process-status) 'run)) :help ,(purecopy "Terminate Ispell subprocess"))) (define-key ispell-menu-map [ispell-pdict-save] `(menu-item ,(purecopy "Save Dictionary") (lambda nil (interactive) (ispell-pdict-save t t)) :help ,(purecopy "Save personal dictionary"))) (define-key ispell-menu-map [ispell-customize] `(menu-item ,(purecopy "Customize...") (lambda nil (interactive) (customize-group 'ispell)) :help ,(purecopy "Customize spell checking options"))) (define-key ispell-menu-map [ispell-help] `(menu-item ,(purecopy "Help") (lambda nil (interactive) (describe-function 'ispell-help)) :help ,(purecopy "Show standard Ispell keybindings and commands"))) (define-key ispell-menu-map [flyspell-mode] `(menu-item ,(purecopy "Automatic spell checking (Flyspell)") flyspell-mode :help ,(purecopy "Check spelling while you edit the text") :button (:toggle bound-and-true-p flyspell-mode))) (define-key ispell-menu-map [ispell-complete-word] `(menu-item ,(purecopy "Complete Word") ispell-complete-word :help ,(purecopy "Complete word at cursor using dictionary"))) (define-key ispell-menu-map [ispell-complete-word-interior-frag] `(menu-item ,(purecopy "Complete Word Fragment") ispell-complete-word-interior-frag :help ,(purecopy "Complete word fragment at cursor"))))) - -(if ispell-menu-map-needed (progn (define-key ispell-menu-map [ispell-continue] `(menu-item ,(purecopy "Continue Spell-Checking") ispell-continue :enable (and (boundp 'ispell-region-end) (marker-position ispell-region-end) (equal (marker-buffer ispell-region-end) (current-buffer))) :help ,(purecopy "Continue spell checking last region"))) (define-key ispell-menu-map [ispell-word] `(menu-item ,(purecopy "Spell-Check Word") ispell-word :help ,(purecopy "Spell-check word at cursor"))) (define-key ispell-menu-map [ispell-comments-and-strings] `(menu-item ,(purecopy "Spell-Check Comments") ispell-comments-and-strings :help ,(purecopy "Spell-check only comments and strings"))))) - -(if ispell-menu-map-needed (progn (define-key ispell-menu-map [ispell-region] `(menu-item ,(purecopy "Spell-Check Region") ispell-region :enable mark-active :help ,(purecopy "Spell-check text in marked region"))) (define-key ispell-menu-map [ispell-message] `(menu-item ,(purecopy "Spell-Check Message") ispell-message :visible (eq major-mode 'mail-mode) :help ,(purecopy "Skip headers and included message text"))) (define-key ispell-menu-map [ispell-buffer] `(menu-item ,(purecopy "Spell-Check Buffer") ispell-buffer :help ,(purecopy "Check spelling of selected buffer"))) (fset 'ispell-menu-map (symbol-value 'ispell-menu-map)))) +(fset 'ispell-menu-map (symbol-value 'ispell-menu-map)) (defvar ispell-skip-region-alist `((ispell-words-keyword forward-line) (ispell-dictionary-keyword forward-line) (ispell-pdict-keyword forward-line) (ispell-parsing-keyword forward-line) (,(purecopy "^---*BEGIN PGP [A-Z ]*--*") \, (purecopy "^---*END PGP [A-Z ]*--*")) (,(purecopy "^begin [0-9][0-9][0-9] [^ \11]+$") \, (purecopy "\nend\n")) (,(purecopy "^%!PS-Adobe-[123].0") \, (purecopy "\n%%EOF\n")) (,(purecopy "^---* \\(Start of \\)?[Ff]orwarded [Mm]essage") \, (purecopy "^---* End of [Ff]orwarded [Mm]essage"))) "\ Alist expressing beginning and end of regions not to spell check. @@ -19009,6 +19025,14 @@ locally, like so: ;;;*** +;;;### (autoloads nil "jsonrpc" "jsonrpc.el" (0 0 0 0)) +;;; Generated autoloads from jsonrpc.el +(push (purecopy '(jsonrpc 1 0 0)) package--builtin-versions) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "jsonrpc" '("jrpc-default-request-timeout" "jsonrpc-"))) + +;;;*** + ;;;### (autoloads nil "kermit" "kermit.el" (0 0 0 0)) ;;; Generated autoloads from kermit.el @@ -22613,7 +22637,7 @@ closing requests for requests that are used in matched pairs. ;;;### (autoloads nil "nsm" "net/nsm.el" (0 0 0 0)) ;;; Generated autoloads from net/nsm.el -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nsm" '("network-security-level" "nsm-"))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nsm" '("network-security-" "nsm-"))) ;;;*** @@ -27353,12 +27377,12 @@ than that of a simplified version: (defun simplified-regexp-opt (strings &optional paren) (let ((parens (cond ((stringp paren) (cons paren \"\\\\)\")) - ((eq paren 'words) '(\"\\\\\\=<\\\\(\" . \"\\\\)\\\\>\")) - ((eq paren 'symbols) '(\"\\\\_<\\\\(\" . \"\\\\)\\\\_>\")) - ((null paren) '(\"\\\\(?:\" . \"\\\\)\")) - (t '(\"\\\\(\" . \"\\\\)\"))))) + ((eq paren \\='words) \\='(\"\\\\\\=<\\\\(\" . \"\\\\)\\\\>\")) + ((eq paren \\='symbols) \\='(\"\\\\_<\\\\(\" . \"\\\\)\\\\_>\")) + ((null paren) \\='(\"\\\\(?:\" . \"\\\\)\")) + (t \\='(\"\\\\(\" . \"\\\\)\"))))) (concat (car paren) - (mapconcat 'regexp-quote strings \"\\\\|\") + (mapconcat \\='regexp-quote strings \"\\\\|\") (cdr paren)))) \(fn STRINGS &optional PAREN)" nil nil) @@ -27934,9 +27958,15 @@ buffer, updates it accordingly. This command always outputs the complete message header, even if the header display is currently pruned. +If `rmail-output-reset-deleted-flag' is non-nil, the message's +deleted flag is reset in the message appended to the destination +file. Otherwise, the appended message will remain marked as +deleted if it was deleted before invoking this command. + Optional prefix argument COUNT (default 1) says to output that many consecutive messages, starting with the current one (ignoring -deleted messages). If `rmail-delete-after-output' is non-nil, deletes +deleted messages, unless `rmail-output-reset-deleted-flag' is +non-nil). If `rmail-delete-after-output' is non-nil, deletes messages after output. The optional third argument NOATTRIBUTE, if non-nil, says not to @@ -28002,12 +28032,12 @@ than appending to it. Deletes the message after writing if Ask user a multiple choice question. PROMPT should be a string that will be displayed as the prompt. -CHOICES is an alist where the first element in each entry is a -character to be entered, the second element is a short name for -the entry to be displayed while prompting (if there's room, it -might be shortened), and the third, optional entry is a longer -explanation that will be displayed in a help buffer if the user -requests more help. +CHOICES is a list of (KEY NAME [DESCRIPTION]). KEY is a +character to be entered. NAME is a short name for the entry to +be displayed while prompting (if there's room, it might be +shortened). DESCRIPTION is an optional longer explanation that +will be displayed in a help buffer if the user requests more +help. This function translates user input into responses by consulting the bindings in `query-replace-map'; see the documentation of @@ -28018,9 +28048,9 @@ perform the requested window recentering or scrolling and ask again. When `use-dialog-box' is t (the default), this function can pop -up a dialog window to collect the user input. That functionality -requires `display-popup-menus-p' to return t. Otherwise, a text -dialog will be used. +up a dialog window to collect the user input. That functionality +requires `display-popup-menus-p' to return t. Otherwise, a +text dialog will be used. The return value is the matching entry from the CHOICES list. @@ -28452,12 +28482,14 @@ CHAR matches whitespace and graphic characters. `alphanumeric', `alnum' - matches alphabetic characters and digits. (For multibyte characters, - it matches according to Unicode character properties.) + matches alphabetic characters and digits. For multibyte characters, + it matches characters whose Unicode `general-category' property + indicates they are alphabetic or decimal number characters. `letter', `alphabetic', `alpha' - matches alphabetic characters. (For multibyte characters, - it matches according to Unicode character properties.) + matches alphabetic characters. For multibyte characters, + it matches characters whose Unicode `general-category' property + indicates they are alphabetic characters. `ascii' matches ASCII (unibyte) characters. @@ -28466,10 +28498,14 @@ CHAR matches non-ASCII (multibyte) characters. `lower', `lower-case' - matches anything lower-case. + matches anything lower-case, as determined by the current case + table. If `case-fold-search' is non-nil, this also matches any + upper-case letter. `upper', `upper-case' - matches anything upper-case. + matches anything upper-case, as determined by the current case + table. If `case-fold-search' is non-nil, this also matches any + lower-case letter. `punctuation', `punct' matches punctuation. (But at present, for multibyte characters, @@ -29865,6 +29901,9 @@ argument INHIBIT-PROMPT is non-nil. To force-start a server, do \\[server-force-delete] and then \\[server-start]. +To check from a Lisp program whether a server is running, use +the `server-process' variable. + \(fn &optional LEAVE-DEAD INHIBIT-PROMPT)" t nil) (autoload 'server-force-delete "server" "\ @@ -30636,7 +30675,7 @@ then `snmpv2-mode-hook'. ;;;### (autoloads nil "soap-client" "net/soap-client.el" (0 0 0 0)) ;;; Generated autoloads from net/soap-client.el -(push (purecopy '(soap-client 3 1 3)) package--builtin-versions) +(push (purecopy '(soap-client 3 1 4)) package--builtin-versions) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "soap-client" '("soap-"))) @@ -31291,6 +31330,39 @@ The default comes from `process-coding-system-alist' and \(fn &optional BUFFER)" t nil) +(autoload 'sql-mariadb "sql" "\ +Run mysql by MariaDB as an inferior process. + +MariaDB is free software. + +If buffer `*SQL*' exists but no process is running, make a new process. +If buffer exists and a process is running, just switch to buffer +`*SQL*'. + +Interpreter used comes from variable `sql-mariadb-program'. Login uses +the variables `sql-user', `sql-password', `sql-database', and +`sql-server' as defaults, if set. Additional command line parameters +can be stored in the list `sql-mariadb-options'. + +The buffer is put in SQL interactive mode, giving commands for sending +input. See `sql-interactive-mode'. + +To set the buffer name directly, use \\[universal-argument] +before \\[sql-mariadb]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + +To specify a coding system for converting non-ASCII characters +in the input and output to the process, use \\[universal-coding-system-argument] +before \\[sql-mariadb]. You can also specify this with \\[set-buffer-process-coding-system] +in the SQL buffer, after you start the process. +The default comes from `process-coding-system-alist' and +`default-process-coding-system'. + +\(Type \\[describe-mode] in the SQL buffer for a list of commands.) + +\(fn &optional BUFFER)" t nil) + (autoload 'sql-solid "sql" "\ Run solsql by Solid as an inferior process. @@ -31712,31 +31784,6 @@ Major-mode for writing SRecode macros. ;;;*** -;;;### (autoloads nil "starttls" "net/starttls.el" (0 0 0 0)) -;;; Generated autoloads from net/starttls.el - -(autoload 'starttls-open-stream "starttls" "\ -Open a TLS connection for a port to a host. -Returns a subprocess object to represent the connection. -Input and output work as for subprocesses; `delete-process' closes it. -Args are NAME BUFFER HOST PORT. -NAME is name for process. It is modified if necessary to make it unique. -BUFFER is the buffer (or `buffer-name') to associate with the process. - Process output goes at end of that buffer, unless you specify - a filter function to handle the output. - BUFFER may be also nil, meaning that this process is not associated - with any buffer -Third arg is name of the host to connect to, or its IP address. -Fourth arg PORT is an integer specifying a port to connect to. -If `starttls-use-gnutls' is nil, this may also be a service name, but -GnuTLS requires a port number. - -\(fn NAME BUFFER HOST PORT)" nil nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "starttls" '("starttls-"))) - -;;;*** - ;;;### (autoloads nil "strokes" "strokes.el" (0 0 0 0)) ;;; Generated autoloads from strokes.el @@ -34001,13 +34048,6 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\". ;;;*** -;;;### (autoloads nil "tls" "net/tls.el" (0 0 0 0)) -;;; Generated autoloads from net/tls.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tls" '("open-tls-stream" "tls-"))) - -;;;*** - ;;;### (autoloads nil "tmm" "tmm.el" (0 0 0 0)) ;;; Generated autoloads from tmm.el (define-key global-map "\M-`" 'tmm-menubar) @@ -34413,7 +34453,7 @@ Reenable Ange-FTP, when Tramp is unloaded. ;;;### (autoloads nil "trampver" "net/trampver.el" (0 0 0 0)) ;;; Generated autoloads from net/trampver.el -(push (purecopy '(tramp 2 4 0 -1)) package--builtin-versions) +(push (purecopy '(tramp 2 4 0)) package--builtin-versions) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "trampver" '("tramp-"))) commit 8b6812fd905be2484364c75a62fd7e371d686adb Author: Michael Albinus <michael.albinus@gmx.de> Date: Sun Jul 1 11:58:55 2018 +0200 Minor change in tramp-tests.el * test/lisp/net/tramp-tests.el (tramp-test03-file-name-host-rules): Cleanup before running the test. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 504b0aae78..5c5eff8798 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -1745,7 +1745,9 @@ handled properly. BODY shall not contain a timeout." ;; Host names must match rules in case the command template of a ;; method doesn't use them. (dolist (m '("su" "sg" "sudo" "doas" "ksu")) - (let (tramp-default-proxies-alist) + (let ((vec (tramp-dissect-file-name tramp-test-temporary-file-directory)) + tramp-connection-properties tramp-default-proxies-alist) + (ignore-errors (tramp-cleanup-connection vec nil 'keep-password)) ;; Single hop. The host name must match `tramp-local-host-regexp'. (should-error (find-file (format "/%s:foo:" m)) @@ -1758,9 +1760,7 @@ handled properly. BODY shall not contain a timeout." (substring (file-remote-p tramp-test-temporary-file-directory) 0 -1) m)) :type - (if (tramp-method-out-of-band-p - (tramp-dissect-file-name tramp-test-temporary-file-directory) 0) - 'file-error 'user-error))))) + (if (tramp-method-out-of-band-p vec 0) 'file-error 'user-error))))) (ert-deftest tramp-test03-file-name-method-rules () "Check file name rules for some methods." commit 4e58ca87f99d08a91d37a41c2d18f7a1f23fa8c6 Author: Martin Rudalics <rudalics@gmx.at> Date: Sun Jul 1 10:22:59 2018 +0200 Document internal use of 'above-suspended' z-group frame parameter * src/w32fns.c (w32_dialog_in_progress, x_set_z_group): * src/xterm.c (x_set_z_group): Clarify the internal use of 'above-suspended' when setting a frame's 'z-group' parameter. diff --git a/src/w32fns.c b/src/w32fns.c index e50b7d5c3c..1b199bf54f 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -2192,6 +2192,11 @@ x_set_no_accept_focus (struct frame *f, Lisp_Object new_value, Lisp_Object old_v * * Some window managers may not honor this parameter. The value `below' * is not supported on Windows. + * + * Internally, this function also handles a value 'above-suspended'. + * That value is used to temporarily remove F from the 'above' group + * to make sure that it does not obscure the window of a dialog in + * progress. */ static void x_set_z_group (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) @@ -7726,12 +7731,27 @@ file_dialog_callback (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) return 0; } +/** + * w32_dialog_in_progress: + * + * This function is called by Fx_file_dialog and Fx_select_font and + * serves to temporarily remove any Emacs frame currently in the + * 'above' z-group from that group to assure that such a frame does + * not hide the dialog window. Frames that are temporarily removed + * from the 'above' group have their z_group bit-field set to + * z_group_above_suspended. Any such frame is moved back to the + * 'above' group as soon as the dialog finishes and has its z_group + * bit-field reset to z_group_above. + * + * This function does not affect the z-order or the z-group state of + * the dialog window itself. + */ void w32_dialog_in_progress (Lisp_Object in_progress) { Lisp_Object frames, frame; - /* Don't let frames in `above' z-group obscure popups. */ + /* Don't let frames in `above' z-group obscure dialog windows. */ FOR_EACH_FRAME (frames, frame) { struct frame *f = XFRAME (frame); diff --git a/src/xterm.c b/src/xterm.c index 496effaf42..a564691033 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10560,6 +10560,10 @@ x_set_skip_taskbar (struct frame *f, Lisp_Object new_value, Lisp_Object old_valu * windows that do not have the `below' property set. * * Some window managers may not honor this parameter. + * + * Internally, this function also handles a value 'above-suspended'. + * That value is used to temporarily remove F from the 'above' group + * to make sure that it does not obscure a menu currently popped up. */ void x_set_z_group (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) commit 32853e1531532af6f6dad4aba86cf6464aac8437 Author: Stefan Monnier <monnier@iro.umontreal.ca> Date: Sun Jul 1 00:08:11 2018 -0400 * lisp/hexl.el (hexl-follow-ascii-mode): Fix last fix (bug#32021) diff --git a/lisp/hexl.el b/lisp/hexl.el index e4d3471897..ad860aee18 100644 --- a/lisp/hexl.el +++ b/lisp/hexl.el @@ -1000,7 +1000,8 @@ Embedded whitespace, dashes, and periods in the string are ignored." When following is enabled, the ASCII character corresponding to the element under the point is highlighted. The default activation is controlled by `hexl-follow-ascii'." - (if hexl-follow-ascii + :global nil + (if hexl-follow-ascii-mode ;; turn it on (progn (unless hexl-ascii-overlay commit 31d1bb04ccf66f2f25e856fc224285a851f1eeff Author: Glenn Morris <rgm@gnu.org> Date: Sat Jun 30 18:56:49 2018 -0700 Unbreak bootstrap * lisp/jsonrpc.el (jsonrpc-connection, jsonrpc-process-connection): Don't autoload defclass, else dumping fails loading loaddefs.el due to trying to autoload eieio-defclass-autoload. diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 5814ff692f..b77db71601 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -49,7 +49,7 @@ ;;; Public API ;;; -;;;###autoload + (defclass jsonrpc-connection () ((name :accessor jsonrpc-name @@ -311,7 +311,7 @@ DEFERRED is passed to `jsonrpc-async-request', which see." ;;; Specfic to `jsonrpc-process-connection' ;;; -;;;###autoload + (defclass jsonrpc-process-connection (jsonrpc-connection) ((-process :initarg :process :accessor jsonrpc--process commit 67afa75e2b97c08976f0e5a8502dac5851d45f93 Author: Glenn Morris <rgm@gnu.org> Date: Sat Jun 30 18:51:35 2018 -0700 * doc/lispref/text.texi (JSONRPC): Add missing menu. diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 5e8601083e..825827095b 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -5144,6 +5144,13 @@ generic @code{Remote Procedure Call} protocol designed around @acronym{JSON} objects, which you can convert to and from Lisp objects (@pxref{Parsing JSON}). +@menu +* JSONRPC Overview:: +* Process-based JSONRPC connections:: +* JSONRPC JSON object format:: +* JSONRPC deferred requests:: +@end menu + @node JSONRPC Overview @subsection Overview commit 64eb2fc74013a221927f9bef920e367758e1bc15 Author: JoĂŁo Távora <joaotavora@gmail.com> Date: Sat Jun 30 21:14:16 2018 +0100 * lisp/jsonrpc.el (subr-x): Only require when compiling diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 6d16da7153..5814ff692f 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -40,7 +40,7 @@ (require 'cl-lib) (require 'json) (require 'eieio) -(require 'subr-x) +(eval-when-compile (require 'subr-x)) (require 'warnings) (require 'pcase) (require 'ert) ; to escape a `condition-case-unless-debug' commit 37dd95866a004a9db1d77f075715243246033773 Author: JoĂŁo Távora <joaotavora@gmail.com> Date: Sat Jun 30 21:11:05 2018 +0100 * lisp/jsonrpc.el: Add "Package-Requires" and "Version" headers diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 8cc853ed5e..6d16da7153 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -5,6 +5,11 @@ ;; Author: JoĂŁo Távora <joaotavora@gmail.com> ;; Maintainer: JoĂŁo Távora <joaotavora@gmail.com> ;; Keywords: processes, languages, extensions +;; Package-Requires: ((emacs "26.1")) +;; Version: 1.0.0 + +;; This is an Elpa :core package. Don't use functionality that is not +;; compatible with Emacs 26.1. ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by commit 8af26410a91c3c9679bb0281ddd71f0dd77ec97c Author: JoĂŁo Távora <joaotavora@gmail.com> Date: Sat Jun 30 19:06:43 2018 +0100 Add lisp/jsonrpc.el * doc/lispref/text.texi (Text): Add JSONRPC. (JSONRPC): New node. * etc/NEWS (New Modes and Packages in Emacs 27.1): Mention jsonrpc.el * lisp/jsonrpc.el: New file. * test/lisp/jsonrpc-tests.el: New file. diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 94cd87acf7..5e8601083e 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -62,6 +62,7 @@ the character after point. * GnuTLS Cryptography:: Cryptographic algorithms imported from GnuTLS. * Parsing HTML/XML:: Parsing HTML and XML. * Parsing JSON:: Parsing and generating JSON values. +* JSONRPC:: JSON Remote Procedure Call protocol * Atomic Changes:: Installing several buffer changes atomically. * Change Hooks:: Supplying functions to be run when text is changed. @end menu @@ -5132,6 +5133,192 @@ doesn't move point. The arguments @var{args} are interpreted as in @code{json-parse-string}. @end defun +@node JSONRPC +@section JSONRPC communication +@cindex JSON remote procedure call protocol + +The @code{jsonrpc} library implements the @acronym{JSONRPC} +specification, version 2.0, as it is described in +@uref{http://www.jsonrpc.org/}. As the name suggests, JSONRPC is a +generic @code{Remote Procedure Call} protocol designed around +@acronym{JSON} objects, which you can convert to and from Lisp objects +(@pxref{Parsing JSON}). + +@node JSONRPC Overview +@subsection Overview + +Quoting from the @uref{http://www.jsonrpc.org/, spec}, JSONRPC "is +transport agnostic in that the concepts can be used within the same +process, over sockets, over http, or in many various message passing +environments." + +To model this agnosticism, the @code{jsonrpc} library uses objects of +a @code{jsonrpc-connection} class, which represent a connection the +remote JSON endpoint (for details on Emacs's object system, +@pxref{Top,EIEIO,,eieio,EIEIO}). In modern object-oriented parlance, +this class is ``abstract'', i.e. the actual class of a useful +connection object used is always a subclass of it. Nevertheless, we +can define two distinct API's around the @code{jsonrpc-connection} +class: + +@enumerate + +@item A user interface for building JSONRPC applications + +In this scenario, the JSONRPC application instantiates +@code{jsonrpc-connection} objects of one of its concrete subclasses +using @code{make-instance}. To initiate a contact to the remote +endpoint, the JSONRPC application passes this object to the functions +@code{jsonrpc-notify'}, @code{jsonrpc-request} and +@code{jsonrpc-async-request}. For handling remotely initiated +contacts, which generally come in asynchronously, the instantiation +should include @code{:request-dispatcher} and +@code{:notification-dispatcher} initargs, which are both functions of +3 arguments: the connection object; a symbol naming the JSONRPC method +invoked remotely; and a JSONRPC "params" object. + +The function passed as @code{:request-dispatcher} is responsible for +handling the remote endpoint's requests, which expect a reply from the +local endpoint (in this case, the program you're building). Inside +that function, you may either return locally (normally) or non-locally +(error). A local return value must be a Lisp object serializable as +JSON (@pxref{Parsing JSON}). This determines a success response, and +the object is forwarded to the server as the JSONRPC "result" object. +A non-local return, achieved by calling the function +@code{jsonrpc-error}, causes an error response to be sent to the +server. The details of the accompanying JSONRPC "error" are filled +out with whatever was passed to @code{jsonrpc-error}. A non-local +return triggered by an unexpected error of any other type also causes +an error response to be sent (unless you have set +@code{debug-on-error}, in which case this should land you in the +debugger, @pxref{Error Debugging}). + +@item A inheritance interface for building JSONRPC transport implementations + +In this scenario, @code{jsonrpc-connection} is subclassed to implement +a different underlying transport strategy (for details on how to +subclass, @pxref{Inheritance,Inheritance,,eieio}). Users of the +application-building interface can then instantiate objects of this +concrete class (using the @code{make-instance} function) and connect +to JSONRPC endpoints using that strategy. + +This API has mandatory and optional parts. + +To allow its users to initiate JSONRPC contacts (notifications or +requests) or reply to endpoint requests, the method +@code{jsonrpc-connection-send} must be implemented for the subclass. + +Likewise, for handling the three types of remote contacts (requests, +notifications and responses to local requests) the transport +implementation must arrange for the function +@code{jsonrpc-connection-receive} to be called after noticing a new +JSONRPC message on the wire (whatever that "wire" may be). + +Finally, and optionally, the @code{jsonrpc-connection} subclass should +implement @code{jsonrpc-shutdown} and @code{jsonrpc-running-p} if +these concepts apply to the transport. If they do, then any system +resources (e.g. processes, timers, etc..) used listen for messages on +the wire should be released in @code{jsonrpc-shutdown}, i.e. they +should only be needed while @code{jsonrpc-running-p} is non-nil. + +@end enumerate + +@node Process-based JSONRPC connections +@subsection Process-based JSONRPC connections + +For convenience, the @code{jsonrpc} library comes built-in with a +@code{jsonrpc-process-connection} transport implementation that can +talk to local subprocesses (using the standard input and standard +output); or TCP hosts (using sockets); or any other remote endpoint +that Emacs's process object can represent (@pxref{Processes}). + +Using this transport, the JSONRPC messages are encoded on the wire as +plain text and prefaced by some basic HTTP-style enveloping headers, +such as ``Content-Length''. + +For an example of an application using this transport scheme on top of +JSONRPC, see the +@uref{https://microsoft.github.io/language-server-protocol/specification, +Language Server Protocol}. + +Along with the mandatory @code{:request-dispatcher} and +@code{:notification-dispatcher} initargs, users of the +@code{jsonrpc-process-connection} class should pass the following +initargs as keyword-value pairs to @code{make-instance}: + +@table @code +@item :process +Value must be a live process object or a function of no arguments +producing one such object. If passed a process object, that is +expected to contain an pre-established connection; otherwise, the +function is called immediately after the object is made. + +@item :on-shutdown +Value must be a function of a single argument, the +@code{jsonrpc-process-connection} object. The function is called +after the underlying process object has been deleted (either +deliberately by @code{jsonrpc-shutdown} or unexpectedly, because of +some external cause). +@end table + +@node JSONRPC JSON object format +@subsection JSON object format + +JSON objects are exchanged as Lisp plists (@pxref{Parsing JSON}): +JSON-compatible plists are handed to the dispatcher functions and, +likewise, JSON-compatible plists should be given to +@code{jsonrpc-notify}, @code{jsonrpc-request} and +@code{jsonrpc-async-request}. + +To facilitate handling plists, this library make liberal use of +@code{cl-lib} library and suggests (but doesn't force) its clients to +do the same. A macro @code{jsonrpc-lambda} can be used to create a +lambda for destructuring a JSON-object like in this example: + +@example +(jsonrpc-async-request + myproc :frobnicate `(:foo "trix") + :success-fn (jsonrpc-lambda (&key bar baz &allow-other-keys) + (message "Server replied back with %s and %s!" + bar baz)) + :error-fn (jsonrpc-lambda (&key code message _data) + (message "Sadly, server reports %s: %s" + code message))) +@end example + +@node JSONRPC deferred requests +@subsection Deferred requests + +In many @acronym{RPC} situations, synchronization between the two +communicating endpoints is a matter of correctly designing the RPC +application: when synchronization is needed, requests (which are +blocking) should be used; when it isn't, notifications should suffice. +However, when Emacs acts as one of these endpoints, asynchronous +events (e.g. timer- or process-related) may be triggered while there +is still uncertainty about the state of the remote endpoint. +Furthermore, acting on these events may only sometimes demand +synchronization, depending on the event's specific nature. + +The @code{:deferred} keyword argument to @code{jsonrpc-request} and +@code{jsonrpc-async-request} is designed to let the caller indicate +that the specific request needs synchronization and its actual +issuance may be delayed to the future, until some condition is +satisfied. Specifying @code{:deferred} for a request doesn't mean it +@emph{will} be delayed, only that it @emph{can} be. If the request +isn't sent immediately, @code{jsonrpc} will make renewed efforts to +send it at certain key times during communication, such as when +receiving or sending other messages to the endpoint. + +Before any attempt to send the request, the application-specific +conditions are checked. Since the @code{jsonrpc} library can't known +what these conditions are, the programmer may use the +@code{jsonrpc-connection-ready-p} generic function (@pxref{Generic +Functions}) to specify them. The default method for this function +returns @code{t}, but you can add overriding methods that return +@code{nil} in some situations, based on the arguments passed to it, +which are the @code{jsonrpc-connection} object (@pxref{JSONRPC +Overview}) and whichever value you passed as the @code{:deferred} +keyword argument. @node Atomic Changes @section Atomic Change Groups diff --git a/etc/NEWS b/etc/NEWS index f5332c0782..63c59ae921 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -579,6 +579,15 @@ This feature uses Tramp and works only on systems which support GVFS, i.e. GNU/Linux, roughly spoken. See the chapter "(tramp) Archive file names" in the Tramp manual for full documentation of these facilities. ++++ +** New library for writing JSONRPC applications (https://jsonrpc.org) +The 'jsonrpc' library enables writing Emacs Lisp applications that +rely on this protocol. Since the protocol is designed to be +transport-agnostic, the library provides an API to implement new +transport strategies as well as a separate API to use them. A +transport implementation for process-based communication, such as is +used by the Language Server Protocol (LSP), is readily available. + * Incompatible Lisp Changes in Emacs 27.1 diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el new file mode 100644 index 0000000000..8cc853ed5e --- /dev/null +++ b/lisp/jsonrpc.el @@ -0,0 +1,649 @@ +;;; jsonrpc.el --- JSON-RPC library -*- lexical-binding: t; -*- + +;; Copyright (C) 2018 Free Software Foundation, Inc. + +;; Author: JoĂŁo Távora <joaotavora@gmail.com> +;; Maintainer: JoĂŁo Távora <joaotavora@gmail.com> +;; Keywords: processes, languages, extensions + +;; This program 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. + +;; This program 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 this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This library implements the JSONRPC 2.0 specification as described +;; in http://www.jsonrpc.org/. As the name suggests, JSONRPC is a +;; generic Remote Procedure Call protocol designed around JSON +;; objects. To learn how to write JSONRPC programs with this library, +;; see Info node `(elisp)JSONRPC'." +;; +;; This library was originally extracted from eglot.el, an Emacs LSP +;; client, which you should see for an example usage. +;; +;;; Code: + +(require 'cl-lib) +(require 'json) +(require 'eieio) +(require 'subr-x) +(require 'warnings) +(require 'pcase) +(require 'ert) ; to escape a `condition-case-unless-debug' +(require 'array) ; xor + + +;;; Public API +;;; +;;;###autoload +(defclass jsonrpc-connection () + ((name + :accessor jsonrpc-name + :initarg :name + :documentation "A name for the connection") + (-request-dispatcher + :accessor jsonrpc--request-dispatcher + :initform #'ignore + :initarg :request-dispatcher + :documentation "Dispatcher for remotely invoked requests.") + (-notification-dispatcher + :accessor jsonrpc--notification-dispatcher + :initform #'ignore + :initarg :notification-dispatcher + :documentation "Dispatcher for remotely invoked notifications.") + (last-error + :accessor jsonrpc-last-error + :documentation "Last JSONRPC error message received from endpoint.") + (-request-continuations + :initform (make-hash-table) + :accessor jsonrpc--request-continuations + :documentation "A hash table of request ID to continuation lambdas.") + (-events-buffer + :accessor jsonrpc--events-buffer + :documentation "A buffer pretty-printing the JSON-RPC RPC events") + (-deferred-actions + :initform (make-hash-table :test #'equal) + :accessor jsonrpc--deferred-actions + :documentation "Map (DEFERRED BUF) to (FN TIMER ID). FN is\ +a saved DEFERRED `async-request' from BUF, to be sent not later\ +than TIMER as ID.") + (-next-request-id + :initform 0 + :accessor jsonrpc--next-request-id + :documentation "Next number used for a request")) + :documentation "Base class representing a JSONRPC connection. +The following initargs are accepted: + +:NAME (mandatory), a string naming the connection + +:REQUEST-DISPATCHER (optional), a function of three +arguments (CONN METHOD PARAMS) for handling JSONRPC requests. +CONN is a `jsonrpc-connection' object, method is a symbol, and +PARAMS is a plist representing a JSON object. The function is +expected to return a JSONRPC result, a plist of (:result +RESULT) or signal an error of type `jsonrpc-error'. + +:NOTIFICATION-DISPATCHER (optional), a function of three +arguments (CONN METHOD PARAMS) for handling JSONRPC +notifications. CONN, METHOD and PARAMS are the same as in +:REQUEST-DISPATCHER.") + +;;; API mandatory +(cl-defgeneric jsonrpc-connection-send (conn &key id method params result error) + "Send a JSONRPC message to connection CONN. +ID, METHOD, PARAMS, RESULT and ERROR. ") + +;;; API optional +(cl-defgeneric jsonrpc-shutdown (conn) + "Shutdown the JSONRPC connection CONN.") + +;;; API optional +(cl-defgeneric jsonrpc-running-p (conn) + "Tell if the JSONRPC connection CONN is still running.") + +;;; API optional +(cl-defgeneric jsonrpc-connection-ready-p (connection what) + "Tell if CONNECTION is ready for WHAT in current buffer. +If it isn't, a request which was passed a value to the +`:deferred' keyword argument will be deferred to the future. +WHAT is whatever was passed the as the value to that argument. + +By default, all connections are ready for sending all requests +immediately." + (:method (_s _what) ;; by default all connections are ready + t)) + + +;;; Convenience +;;; +(cl-defmacro jsonrpc-lambda (cl-lambda-list &body body) + (declare (indent 1) (debug (sexp &rest form))) + (let ((e (gensym "jsonrpc-lambda-elem"))) + `(lambda (,e) (apply (cl-function (lambda ,cl-lambda-list ,@body)) ,e)))) + +(defun jsonrpc-events-buffer (connection) + "Get or create JSONRPC events buffer for CONNECTION." + (let* ((probe (jsonrpc--events-buffer connection)) + (buffer (or (and (buffer-live-p probe) + probe) + (let ((buffer (get-buffer-create + (format "*%s events*" + (jsonrpc-name connection))))) + (with-current-buffer buffer + (buffer-disable-undo) + (read-only-mode t) + (setf (jsonrpc--events-buffer connection) buffer)) + buffer)))) + buffer)) + +(defun jsonrpc-forget-pending-continuations (connection) + "Stop waiting for responses from the current JSONRPC CONNECTION." + (clrhash (jsonrpc--request-continuations connection))) + +(defun jsonrpc-connection-receive (connection message) + "Process MESSAGE just received from CONNECTION. +This function will destructure MESSAGE and call the appropriate +dispatcher in CONNECTION." + (cl-destructuring-bind (&key method id error params result _jsonrpc) + message + (let (continuations) + (jsonrpc--log-event connection message 'server) + (setf (jsonrpc-last-error connection) error) + (cond + (;; A remote request + (and method id) + (let* ((debug-on-error (and debug-on-error (not (ert-running-test)))) + (reply + (condition-case-unless-debug _ignore + (condition-case oops + `(:result ,(funcall (jsonrpc--request-dispatcher connection) + connection (intern method) params)) + (jsonrpc-error + `(:error + (:code + ,(or (alist-get 'jsonrpc-error-code (cdr oops)) -32603) + :message ,(or (alist-get 'jsonrpc-error-message + (cdr oops)) + "Internal error"))))) + (error + `(:error (:code -32603 :message "Internal error")))))) + (apply #'jsonrpc--reply connection id reply))) + (;; A remote notification + method + (funcall (jsonrpc--notification-dispatcher connection) + connection (intern method) params)) + (;; A remote response + (setq continuations + (and id (gethash id (jsonrpc--request-continuations connection)))) + (let ((timer (nth 2 continuations))) + (when timer (cancel-timer timer))) + (remhash id (jsonrpc--request-continuations connection)) + (if error (funcall (nth 1 continuations) error) + (funcall (nth 0 continuations) result))) + (;; An abnormal situation + id (jsonrpc--warn "No continuation for id %s" id))) + (jsonrpc--call-deferred connection)))) + + +;;; Contacting the remote endpoint +;;; +(defun jsonrpc-error (&rest args) + "Error out with FORMAT and ARGS. +If invoked inside a dispatcher function, this function is suitable +for replying to the remote endpoint with an error message. + +ARGS can be of the form (FORMAT-STRING . MOREARGS) for replying +with a -32603 error code and a message formed by formatting +FORMAT-STRING with MOREARGS. + +Alternatively ARGS can be plist representing a JSONRPC error +object, using the keywords `:code', `:message' and `:data'." + (if (stringp (car args)) + (let ((msg + (apply #'format-message (car args) (cdr args)))) + (signal 'jsonrpc-error + `(,msg + (jsonrpc-error-code . ,32603) + (jsonrpc-error-message . ,msg)))) + (cl-destructuring-bind (&key code message data) args + (signal 'jsonrpc-error + `(,(format "[jsonrpc] error ") + (jsonrpc-error-code . ,code) + (jsonrpc-error-message . ,message) + (jsonrpc-error-data . ,data)))))) + +(cl-defun jsonrpc-async-request (connection + method + params + &rest args + &key _success-fn _error-fn + _timeout-fn + _timeout _deferred) + "Make a request to CONNECTION, expecting a reply, return immediately. +The JSONRPC request is formed by METHOD, a symbol, and PARAMS a +JSON object. + +The caller can expect SUCCESS-FN or ERROR-FN to be called with a +JSONRPC `:result' or `:error' object, respectively. If this +doesn't happen after TIMEOUT seconds (defaults to +`jsonrpc-request-timeout'), the caller can expect TIMEOUT-FN to be +called with no arguments. The default values of SUCCESS-FN, +ERROR-FN and TIMEOUT-FN simply log the events into +`jsonrpc-events-buffer'. + +If DEFERRED is non-nil, maybe defer the request to a future time +when the server is thought to be ready according to +`jsonrpc-connection-ready-p' (which see). The request might +never be sent at all, in case it is overridden in the meantime by +a new request with identical DEFERRED and for the same buffer. +However, in that situation, the original timeout is kept. + +Returns nil." + (apply #'jsonrpc--async-request-1 connection method params args) + nil) + +(cl-defun jsonrpc-request (connection method params &key deferred timeout) + "Make a request to CONNECTION, wait for a reply. +Like `jsonrpc-async-request' for CONNECTION, METHOD and PARAMS, +but synchronous, i.e. this function doesn't exit until anything +interesting (success, error or timeout) happens. Furthermore, it +only exits locally (returning the JSONRPC result object) if the +request is successful, otherwise exit non-locally with an error +of type `jsonrpc-error'. + +DEFERRED is passed to `jsonrpc-async-request', which see." + (let* ((tag (cl-gensym "jsonrpc-request-catch-tag")) id-and-timer + (retval + (unwind-protect ; protect against user-quit, for example + (catch tag + (setq + id-and-timer + (jsonrpc--async-request-1 + connection method params + :success-fn (lambda (result) (throw tag `(done ,result))) + :error-fn + (jsonrpc-lambda + (&key code message data) + (throw tag `(error (jsonrpc-error-code . ,code) + (jsonrpc-error-message . ,message) + (jsonrpc-error-data . ,data)))) + :timeout-fn + (lambda () + (throw tag '(error (jsonrpc-error-message . "Timed out")))) + :deferred deferred + :timeout timeout)) + (while t (accept-process-output nil 30))) + (pcase-let* ((`(,id ,timer) id-and-timer)) + (remhash id (jsonrpc--request-continuations connection)) + (remhash (list deferred (current-buffer)) + (jsonrpc--deferred-actions connection)) + (when timer (cancel-timer timer)))))) + (when (eq 'error (car retval)) + (signal 'jsonrpc-error + (cons + (format "request id=%s failed:" (car id-and-timer)) + (cdr retval)))) + (cadr retval))) + +(cl-defun jsonrpc-notify (connection method params) + "Notify CONNECTION of something, don't expect a reply." + (jsonrpc-connection-send connection + :method method + :params params)) + +(defconst jrpc-default-request-timeout 10 + "Time in seconds before timing out a JSONRPC request.") + + +;;; Specfic to `jsonrpc-process-connection' +;;; +;;;###autoload +(defclass jsonrpc-process-connection (jsonrpc-connection) + ((-process + :initarg :process :accessor jsonrpc--process + :documentation "Process object wrapped by the this connection.") + (-expected-bytes + :accessor jsonrpc--expected-bytes + :documentation "How many bytes declared by server") + (-on-shutdown + :accessor jsonrpc--on-shutdown + :initform #'ignore + :initarg :on-shutdown + :documentation "Function run when the process dies.")) + :documentation "A JSONRPC connection over an Emacs process. +The following initargs are accepted: + +:PROCESS (mandatory), a live running Emacs process object or a +function of no arguments producing one such object. The process +represents either a pipe connection to locally running process or +a stream connection to a network host. The remote endpoint is +expected to understand JSONRPC messages with basic HTTP-style +enveloping headers such as \"Content-Length:\". + +:ON-SHUTDOWN (optional), a function of one argument, the +connection object, called when the process dies .") + +(cl-defmethod initialize-instance ((conn jsonrpc-process-connection) slots) + (cl-call-next-method) + (let* ((proc (plist-get slots :process)) + (proc (if (functionp proc) (funcall proc) proc)) + (buffer (get-buffer-create (format "*%s output*" (process-name proc)))) + (stderr (get-buffer-create (format "*%s stderr*" (process-name proc))))) + (setf (jsonrpc--process conn) proc) + (set-process-buffer proc buffer) + (process-put proc 'jsonrpc-stderr stderr) + (set-process-filter proc #'jsonrpc--process-filter) + (set-process-sentinel proc #'jsonrpc--process-sentinel) + (with-current-buffer (process-buffer proc) + (set-marker (process-mark proc) (point-min)) + (let ((inhibit-read-only t)) (erase-buffer) (read-only-mode t) proc)) + (process-put proc 'jsonrpc-connection conn))) + +(cl-defmethod jsonrpc-connection-send ((connection jsonrpc-process-connection) + &rest args + &key + _id + method + _params + _result + _error + _partial) + "Send MESSAGE, a JSON object, to CONNECTION." + (when method + (plist-put args :method + (cond ((keywordp method) (substring (symbol-name method) 1)) + ((and method (symbolp method)) (symbol-name method))))) + (let* ( (message `(:jsonrpc "2.0" ,@args)) + (json (jsonrpc--json-encode message)) + (headers + `(("Content-Length" . ,(format "%d" (string-bytes json))) + ;; ("Content-Type" . "application/vscode-jsonrpc; charset=utf-8") + ))) + (process-send-string + (jsonrpc--process connection) + (cl-loop for (header . value) in headers + concat (concat header ": " value "\r\n") into header-section + finally return (format "%s\r\n%s" header-section json))) + (jsonrpc--log-event connection message 'client))) + +(defun jsonrpc-process-type (conn) + "Return the `process-type' of JSONRPC connection CONN." + (process-type (jsonrpc--process conn))) + +(cl-defmethod jsonrpc-running-p ((conn jsonrpc-process-connection)) + "Return non-nil if JSONRPC connection CONN is running." + (process-live-p (jsonrpc--process conn))) + +(cl-defmethod jsonrpc-shutdown ((conn jsonrpc-process-connection)) + "Shutdown the JSONRPC connection CONN." + (cl-loop + with proc = (jsonrpc--process conn) + do + (delete-process proc) + (accept-process-output nil 0.1) + while (not (process-get proc 'jsonrpc-sentinel-done)) + do (jsonrpc--warn + "Sentinel for %s still hasn't run, deleting it!" proc))) + +(defun jsonrpc-stderr-buffer (conn) + "Get CONN's standard error buffer, if any." + (process-get (jsonrpc--process conn) 'jsonrpc-stderr)) + + +;;; Private stuff +;;; +(define-error 'jsonrpc-error "jsonrpc-error") + +(defun jsonrpc--json-read () + "Read JSON object in buffer, move point to end of buffer." + ;; TODO: I guess we can make these macros if/when jsonrpc.el + ;; goes into Emacs core. + (cond ((fboundp 'json-parse-buffer) (json-parse-buffer + :object-type 'plist + :null-object nil + :false-object :json-false)) + (t (let ((json-object-type 'plist)) + (json-read))))) + +(defun jsonrpc--json-encode (object) + "Encode OBJECT into a JSON string." + (cond ((fboundp 'json-serialize) (json-serialize + object + :false-object :json-false + :null-object nil)) + (t (let ((json-false :json-false) + (json-null nil)) + (json-encode object))))) + +(cl-defun jsonrpc--reply (connection id &key (result nil result-supplied-p) error) + "Reply to CONNECTION's request ID with RESULT or ERROR." + (jsonrpc-connection-send connection :id id :result result :error error)) + +(defun jsonrpc--call-deferred (connection) + "Call CONNECTION's deferred actions, who may again defer themselves." + (when-let ((actions (hash-table-values (jsonrpc--deferred-actions connection)))) + (jsonrpc--debug connection `(:maybe-run-deferred ,(mapcar #'caddr actions))) + (mapc #'funcall (mapcar #'car actions)))) + +(defun jsonrpc--process-sentinel (proc change) + "Called when PROC undergoes CHANGE." + (let ((connection (process-get proc 'jsonrpc-connection))) + (jsonrpc--debug connection `(:message "Connection state changed" :change ,change)) + (when (not (process-live-p proc)) + (with-current-buffer (jsonrpc-events-buffer connection) + (let ((inhibit-read-only t)) + (insert "\n----------b---y---e---b---y---e----------\n"))) + ;; Cancel outstanding timers + (maphash (lambda (_id triplet) + (pcase-let ((`(,_success ,_error ,timeout) triplet)) + (when timeout (cancel-timer timeout)))) + (jsonrpc--request-continuations connection)) + (unwind-protect + ;; Call all outstanding error handlers + (maphash (lambda (_id triplet) + (pcase-let ((`(,_success ,error ,_timeout) triplet)) + (funcall error `(:code -1 :message "Server died")))) + (jsonrpc--request-continuations connection)) + (jsonrpc--message "Server exited with status %s" (process-exit-status proc)) + (process-put proc 'jsonrpc-sentinel-done t) + (delete-process proc) + (funcall (jsonrpc--on-shutdown connection) connection))))) + +(defun jsonrpc--process-filter (proc string) + "Called when new data STRING has arrived for PROC." + (when (buffer-live-p (process-buffer proc)) + (with-current-buffer (process-buffer proc) + (let* ((inhibit-read-only t) + (connection (process-get proc 'jsonrpc-connection)) + (expected-bytes (jsonrpc--expected-bytes connection))) + ;; Insert the text, advancing the process marker. + ;; + (save-excursion + (goto-char (process-mark proc)) + (insert string) + (set-marker (process-mark proc) (point))) + ;; Loop (more than one message might have arrived) + ;; + (unwind-protect + (let (done) + (while (not done) + (cond + ((not expected-bytes) + ;; Starting a new message + ;; + (setq expected-bytes + (and (search-forward-regexp + "\\(?:.*: .*\r\n\\)*Content-Length: \ +*\\([[:digit:]]+\\)\r\n\\(?:.*: .*\r\n\\)*\r\n" + (+ (point) 100) + t) + (string-to-number (match-string 1)))) + (unless expected-bytes + (setq done :waiting-for-new-message))) + (t + ;; Attempt to complete a message body + ;; + (let ((available-bytes (- (position-bytes (process-mark proc)) + (position-bytes (point))))) + (cond + ((>= available-bytes + expected-bytes) + (let* ((message-end (byte-to-position + (+ (position-bytes (point)) + expected-bytes)))) + (unwind-protect + (save-restriction + (narrow-to-region (point) message-end) + (let* ((json-message + (condition-case-unless-debug oops + (jsonrpc--json-read) + (error + (jsonrpc--warn "Invalid JSON: %s %s" + (cdr oops) (buffer-string)) + nil)))) + (when json-message + ;; Process content in another + ;; buffer, shielding proc buffer from + ;; tamper + (with-temp-buffer + (jsonrpc-connection-receive connection + json-message))))) + (goto-char message-end) + (delete-region (point-min) (point)) + (setq expected-bytes nil)))) + (t + ;; Message is still incomplete + ;; + (setq done :waiting-for-more-bytes-in-this-message)))))))) + ;; Saved parsing state for next visit to this filter + ;; + (setf (jsonrpc--expected-bytes connection) expected-bytes)))))) + +(cl-defun jsonrpc--async-request-1 (connection + method + params + &rest args + &key success-fn error-fn timeout-fn + (timeout jrpc-default-request-timeout) + (deferred nil)) + "Does actual work for `jsonrpc-async-request'. + +Return a list (ID TIMER). ID is the new request's ID, or nil if +the request was deferred. TIMER is a timer object set (or nil, if +TIMEOUT is nil)." + (pcase-let* ((buf (current-buffer)) (point (point)) + (`(,_ ,timer ,old-id) + (and deferred (gethash (list deferred buf) + (jsonrpc--deferred-actions connection)))) + (id (or old-id (cl-incf (jsonrpc--next-request-id connection)))) + (make-timer + (lambda ( ) + (when timeout + (run-with-timer + timeout nil + (lambda () + (remhash id (jsonrpc--request-continuations connection)) + (remhash (list deferred buf) + (jsonrpc--deferred-actions connection)) + (if timeout-fn (funcall timeout-fn) + (jsonrpc--debug + connection `(:timed-out ,method :id ,id + :params ,params))))))))) + (when deferred + (if (jsonrpc-connection-ready-p connection deferred) + ;; Server is ready, we jump below and send it immediately. + (remhash (list deferred buf) (jsonrpc--deferred-actions connection)) + ;; Otherwise, save in `eglot--deferred-actions' and exit non-locally + (unless old-id + (jsonrpc--debug connection `(:deferring ,method :id ,id :params + ,params))) + (puthash (list deferred buf) + (list (lambda () + (when (buffer-live-p buf) + (with-current-buffer buf + (save-excursion (goto-char point) + (apply #'jsonrpc-async-request + connection + method params args))))) + (or timer (setq timer (funcall make-timer))) id) + (jsonrpc--deferred-actions connection)) + (cl-return-from jsonrpc--async-request-1 (list id timer)))) + ;; Really send it + ;; + (jsonrpc-connection-send connection + :id id + :method method + :params params) + (puthash id + (list (or success-fn + (jsonrpc-lambda (&rest _ignored) + (jsonrpc--debug + connection (list :message "success ignored" + :id id)))) + (or error-fn + (jsonrpc-lambda (&key code message &allow-other-keys) + (jsonrpc--debug + connection (list + :message + (format "error ignored, status set (%s)" + message) + :id id :error code)))) + (setq timer (funcall make-timer))) + (jsonrpc--request-continuations connection)) + (list id timer))) + +(defun jsonrpc--message (format &rest args) + "Message out with FORMAT with ARGS." + (message "[jsonrpc] %s" (apply #'format format args))) + +(defun jsonrpc--debug (server format &rest args) + "Debug message for SERVER with FORMAT and ARGS." + (jsonrpc--log-event + server (if (stringp format)`(:message ,(format format args)) format))) + +(defun jsonrpc--warn (format &rest args) + "Warning message with FORMAT and ARGS." + (apply #'jsonrpc--message (concat "(warning) " format) args) + (let ((warning-minimum-level :error)) + (display-warning 'jsonrpc + (apply #'format format args) + :warning))) + +(defun jsonrpc--log-event (connection message &optional type) + "Log a JSONRPC-related event. +CONNECTION is the current connection. MESSAGE is a JSON-like +plist. TYPE is a symbol saying if this is a client or server +originated." + (with-current-buffer (jsonrpc-events-buffer connection) + (cl-destructuring-bind (&key method id error &allow-other-keys) message + (let* ((inhibit-read-only t) + (subtype (cond ((and method id) 'request) + (method 'notification) + (id 'reply) + (t 'message))) + (type + (concat (format "%s" (or type 'internal)) + (if type + (format "-%s" subtype))))) + (goto-char (point-max)) + (let ((msg (format "%s%s%s %s:\n%s\n" + type + (if id (format " (id:%s)" id) "") + (if error " ERROR" "") + (current-time-string) + (pp-to-string message)))) + (when error + (setq msg (propertize msg 'face 'error))) + (insert-before-markers msg)))))) + +(provide 'jsonrpc) +;;; jsonrpc.el ends here diff --git a/test/lisp/jsonrpc-tests.el b/test/lisp/jsonrpc-tests.el new file mode 100644 index 0000000000..9395ab6ac0 --- /dev/null +++ b/test/lisp/jsonrpc-tests.el @@ -0,0 +1,240 @@ +;;; jsonrpc-tests.el --- tests for jsonrpc.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2018 Free Software Foundation, Inc. + +;; Author: JoĂŁo Távora <joaotavora@gmail.com> +;; Maintainer: JoĂŁo Távora <joaotavora@gmail.com> +;; Keywords: tests + +;; This program 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. + +;; This program 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 this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; About "deferred" tests, `jsonrpc--test-client' has a flag that we +;; test this flag in the this `jsonrpc-connection-ready-p' API method. +;; It holds any `jsonrpc-request's and `jsonrpc-async-request's +;; explicitly passed `:deferred'. After clearing the flag, the held +;; requests are actually sent to the server in the next opportunity +;; (when receiving or sending something to the server). + +;;; Code: + +(require 'ert) +(require 'jsonrpc) +(require 'eieio) + +(defclass jsonrpc--test-endpoint (jsonrpc-process-connection) + ((scp :accessor jsonrpc--shutdown-complete-p))) + +(defclass jsonrpc--test-client (jsonrpc--test-endpoint) + ((hold-deferred :initform t :accessor jsonrpc--hold-deferred))) + +(cl-defmacro jsonrpc--with-emacsrpc-fixture ((endpoint-sym) &body body) + (declare (indent 1) (debug t)) + (let ((server (gensym "server-")) (listen-server (gensym "listen-server-"))) + `(let* (,server + (,listen-server + (make-network-process + :name "Emacs RPC server" :server t :host "localhost" + :service 0 + :log (lambda (_server client _message) + (setq ,server + (make-instance + 'jsonrpc--test-endpoint + :name (process-name client) + :process client + :request-dispatcher + (lambda (_endpoint method params) + (unless (memq method '(+ - * / vconcat append + sit-for ignore)) + (signal 'jsonrpc-error + `((jsonrpc-error-message + . "Sorry, this isn't allowed") + (jsonrpc-error-code . -32601)))) + (apply method (append params nil))) + :on-shutdown + (lambda (conn) + (setf (jsonrpc--shutdown-complete-p conn) t))))))) + (,endpoint-sym (make-instance + 'jsonrpc--test-client + "Emacs RPC client" + :process + (open-network-stream "JSONRPC test tcp endpoint" + nil "localhost" + (process-contact ,listen-server + :service)) + :on-shutdown + (lambda (conn) + (setf (jsonrpc--shutdown-complete-p conn) t))))) + (unwind-protect + (progn + (cl-assert ,endpoint-sym) + ,@body + (kill-buffer (jsonrpc--events-buffer ,endpoint-sym)) + (when ,server + (kill-buffer (jsonrpc--events-buffer ,server)))) + (unwind-protect + (jsonrpc-shutdown ,endpoint-sym) + (unwind-protect + (jsonrpc-shutdown ,server) + (cl-loop do (delete-process ,listen-server) + while (progn (accept-process-output nil 0.1) + (process-live-p ,listen-server)) + do (jsonrpc--message + "test listen-server is still running, waiting")))))))) + +(ert-deftest returns-3 () + "A basic test for adding two numbers in our test RPC." + (jsonrpc--with-emacsrpc-fixture (conn) + (should (= 3 (jsonrpc-request conn '+ [1 2]))))) + +(ert-deftest errors-with--32601 () + "Errors with -32601" + (jsonrpc--with-emacsrpc-fixture (conn) + (condition-case err + (progn + (jsonrpc-request conn 'delete-directory "~/tmp") + (ert-fail "A `jsonrpc-error' should have been signalled!")) + (jsonrpc-error + (should (= -32601 (cdr (assoc 'jsonrpc-error-code (cdr err))))))))) + +(ert-deftest signals-an--32603-JSONRPC-error () + "Signals an -32603 JSONRPC error." + (jsonrpc--with-emacsrpc-fixture (conn) + (condition-case err + (progn + (jsonrpc-request conn '+ ["a" 2]) + (ert-fail "A `jsonrpc-error' should have been signalled!")) + (jsonrpc-error + (should (= -32603 (cdr (assoc 'jsonrpc-error-code (cdr err))))))))) + +(ert-deftest times-out () + "Request for 3-sec sit-for with 1-sec timeout times out." + (jsonrpc--with-emacsrpc-fixture (conn) + (should-error + (jsonrpc-request conn 'sit-for [3] :timeout 1)))) + +(ert-deftest doesnt-time-out () + :tags '(:expensive-test) + "Request for 1-sec sit-for with 2-sec timeout succeeds." + (jsonrpc--with-emacsrpc-fixture (conn) + (jsonrpc-request conn 'sit-for [1] :timeout 2))) + +(ert-deftest stretching-it-but-works () + "Vector of numbers or vector of vector of numbers are serialized." + (jsonrpc--with-emacsrpc-fixture (conn) + ;; (vconcat [1 2 3] [3 4 5]) => [1 2 3 3 4 5] which can be + ;; serialized. + (should (equal + [1 2 3 3 4 5] + (jsonrpc-request conn 'vconcat [[1 2 3] [3 4 5]]))))) + +(ert-deftest json-el-cant-serialize-this () + "Can't serialize a response that is half-vector/half-list." + (jsonrpc--with-emacsrpc-fixture (conn) + (should-error + ;; (append [1 2 3] [3 4 5]) => (1 2 3 . [3 4 5]), which can't be + ;; serialized + (jsonrpc-request conn 'append [[1 2 3] [3 4 5]])))) + +(cl-defmethod jsonrpc-connection-ready-p + ((conn jsonrpc--test-client) what) + (and (cl-call-next-method) + (or (not (string-match "deferred" what)) + (not (jsonrpc--hold-deferred conn))))) + +(ert-deftest deferred-action-toolate () + :tags '(:expensive-test) + "Deferred request fails because noone clears the flag." + (jsonrpc--with-emacsrpc-fixture (conn) + (should-error + (jsonrpc-request conn '+ [1 2] + :deferred "deferred-testing" :timeout 0.5) + :type 'jsonrpc-error) + (should + (= 3 (jsonrpc-request conn '+ [1 2] + :timeout 0.5))))) + +(ert-deftest deferred-action-intime () + :tags '(:expensive-test) + "Deferred request barely makes it after event clears a flag." + ;; Send an async request, which returns immediately. However the + ;; success fun which sets the flag only runs after some time. + (jsonrpc--with-emacsrpc-fixture (conn) + (jsonrpc-async-request conn + 'sit-for [0.5] + :success-fn + (lambda (_result) + (setf (jsonrpc--hold-deferred conn) nil))) + ;; Now wait for an answer to this request, which should be sent as + ;; soon as the previous one is answered. + (should + (= 3 (jsonrpc-request conn '+ [1 2] + :deferred "deferred" + :timeout 1))))) + +(ert-deftest deferred-action-complex-tests () + :tags '(:expensive-test) + "Test a more complex situation with deferred requests." + (jsonrpc--with-emacsrpc-fixture (conn) + (let (n-deferred-1 + n-deferred-2 + second-deferred-went-through-p) + ;; This returns immediately + (jsonrpc-async-request + conn + 'sit-for [0.1] + :success-fn + (lambda (_result) + ;; this only gets runs after the "first deferred" is stashed. + (setq n-deferred-1 + (hash-table-count (jsonrpc--deferred-actions conn))))) + (should-error + ;; This stashes the request and waits. It will error because + ;; no-one clears the "hold deferred" flag. + (jsonrpc-request conn 'ignore ["first deferred"] + :deferred "first deferred" + :timeout 0.5) + :type 'jsonrpc-error) + ;; The error means the deferred actions stash is now empty + (should (zerop (hash-table-count (jsonrpc--deferred-actions conn)))) + ;; Again, this returns immediately. + (jsonrpc-async-request + conn + 'sit-for [0.1] + :success-fn + (lambda (_result) + ;; This gets run while "third deferred" below is waiting for + ;; a reply. Notice that we clear the flag in time here. + (setq n-deferred-2 (hash-table-count (jsonrpc--deferred-actions conn))) + (setf (jsonrpc--hold-deferred conn) nil))) + ;; This again stashes a request and returns immediately. + (jsonrpc-async-request conn 'ignore ["second deferred"] + :deferred "second deferred" + :timeout 1 + :success-fn + (lambda (_result) + (setq second-deferred-went-through-p t))) + ;; And this also stashes a request, but waits. Eventually the + ;; flag is cleared in time and both requests go through. + (jsonrpc-request conn 'ignore ["third deferred"] + :deferred "third deferred" + :timeout 1) + (should second-deferred-went-through-p) + (should (eq 1 n-deferred-1)) + (should (eq 2 n-deferred-2)) + (should (eq 0 (hash-table-count (jsonrpc--deferred-actions conn))))))) + +(provide 'jsonrpc-tests) +;;; jsonrpc-tests.el ends here commit 852395bab71cb7032692f3c95e1e4b81a884b66b Author: Eli Zaretskii <eliz@gnu.org> Date: Sat Jun 30 20:59:20 2018 +0300 * lisp/hexl.el (hexl-follow-ascii-mode): Fix a typo. (Bug#32021) diff --git a/lisp/hexl.el b/lisp/hexl.el index f37be9d410..e4d3471897 100644 --- a/lisp/hexl.el +++ b/lisp/hexl.el @@ -1000,7 +1000,7 @@ Embedded whitespace, dashes, and periods in the string are ignored." When following is enabled, the ASCII character corresponding to the element under the point is highlighted. The default activation is controlled by `hexl-follow-ascii'." - (if hexl-follow-ascii-mode + (if hexl-follow-ascii ;; turn it on (progn (unless hexl-ascii-overlay commit 4bd43b03526ae893609c7b54958fc332a1c81681 Author: Gemini Lasswell <gazally@runbox.com> Date: Wed Jun 20 13:58:33 2018 -0700 Increase max-lisp-eval-depth adjustment while in debugger (bug#31919) * src/eval.c (call_debugger): Increase the amount of extra Lisp evaluation depth given to the debugger to allow it to call cl-print. * lisp/emacs-lisp/debug.el (debugger-setup-buffer): Add a comment to suggest updating call_debugger when changing print-level. diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 593fab9727..821d674882 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -322,6 +322,7 @@ That buffer should be current already." (backtrace-frames 'debug))) (print-escape-newlines t) (print-escape-control-characters t) + ;; If you increase print-level, add more depth in call_debugger. (print-level 8) (print-length 50) (pos (point))) diff --git a/src/eval.c b/src/eval.c index ca1eb84ff3..40cba3bb1c 100644 --- a/src/eval.c +++ b/src/eval.c @@ -282,8 +282,12 @@ call_debugger (Lisp_Object arg) /* Do not allow max_specpdl_size less than actual depth (Bug#16603). */ EMACS_INT old_max = max (max_specpdl_size, count); - if (lisp_eval_depth + 40 > max_lisp_eval_depth) - max_lisp_eval_depth = lisp_eval_depth + 40; + /* The previous value of 40 is too small now that the debugger + prints using cl-prin1 instead of prin1. Printing lists nested 8 + deep (which is the value of print-level used in the debugger) + currently requires 77 additional frames. See bug#31919. */ + if (lisp_eval_depth + 100 > max_lisp_eval_depth) + max_lisp_eval_depth = lisp_eval_depth + 100; /* While debugging Bug#16603, previous value of 100 was found too small to avoid specpdl overflow in the debugger itself. */ commit ab983522a140187fa2f7bd996c6e3760b0db8d09 Author: Eli Zaretskii <eliz@gnu.org> Date: Sat Jun 30 16:50:31 2018 +0300 Improve on last change in replace-buffer-contents * src/editfns.c (Freplace_buffer_contents): Call modification hooks only for the actual region where changes are made. (Bug#31888) diff --git a/src/editfns.c b/src/editfns.c index 4d3c838d2f..9002211714 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -3238,9 +3238,21 @@ differences between the two buffers. */) Instead, we announce a single modification for the entire modified region. But don't do that if the caller inhibited modification hooks, because then they don't want that. */ + ptrdiff_t from, to; if (!inhibit_modification_hooks) { - prepare_to_modify_buffer (BEGV, ZV, NULL); + ptrdiff_t k, l; + + /* Find the first character position to be changed. */ + for (k = 0; k < size_a && !bit_is_set (ctx.deletions, k); k++) + ; + from = BEGV + k; + + /* Find the last character position to be changed. */ + for (l = size_a; l > 0 && !bit_is_set (ctx.deletions, l - 1); l--) + ; + to = BEGV + l; + prepare_to_modify_buffer (from, to, NULL); specbind (Qinhibit_modification_hooks, Qt); modification_hooks_inhibited = true; } @@ -3293,8 +3305,9 @@ differences between the two buffers. */) if (modification_hooks_inhibited) { - signal_after_change (BEGV, size_a, ZV - BEGV); - update_compositions (BEGV, ZV, CHECK_BORDER); + ptrdiff_t updated_to = to + ZV - BEGV - size_a; + signal_after_change (from, to - from, updated_to - from); + update_compositions (from, updated_to, CHECK_INSIDE); } return Qnil; commit 2f149c074d4323e607f4c91b5e6f80c4efd8e09b Author: Eli Zaretskii <eliz@gnu.org> Date: Sat Jun 30 16:13:01 2018 +0300 Fix a factual error in Introduction to Emacs Lisp * doc/lispintro/emacs-lisp-intro.texi (Buffer Names): Update the key that exits the splash screen. (Bug#32019) diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index cc940e5cbd..be3e938b24 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -2729,8 +2729,8 @@ In the old days, when you lacked a @file{~/.emacs} file and started an Emacs session by typing the command @code{emacs} alone, without naming any files, Emacs started with the @file{*scratch*} buffer visible. Nowadays, you will see a splash screen. You can follow one of the -commands suggested on the splash screen, visit a file, or press the -spacebar to reach the @file{*scratch*} buffer. +commands suggested on the splash screen, visit a file, or press @kbd{q} +to quit the splash screen and reach the @file{*scratch*} buffer. If you switch to the @file{*scratch*} buffer, type @code{(buffer-name)}, position the cursor after it, and then type commit 8ad50a34e5b9a7ebb7a1f52b3c0a3b7e3570e40b Author: Eli Zaretskii <eliz@gnu.org> Date: Sat Jun 30 12:54:58 2018 +0300 ; * lisp/files.el (buffer-offer-save): Doc fix. (Bug#32000) diff --git a/lisp/files.el b/lisp/files.el index d0b7285fdb..fb8c34bcae 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -148,12 +148,16 @@ This variable is relevant only if `backup-by-copying' and Called with an absolute file name as argument, it returns t to enable backup.") (defcustom buffer-offer-save nil - "Non-nil in a buffer means always offer to save buffer on exit. + "Non-nil in a buffer means always offer to save buffer on exiting Emacs. Do so even if the buffer is not visiting a file. Automatically local in all buffers. Set to the symbol `always' to offer to save buffer whenever -`save-some-buffers' is called." +`save-some-buffers' is called. + +Note that this option has no effect on `kill-buffer'; +if you want to control what happens when a buffer is killed, +use `kill-buffer-query-functions'." :type '(choice (const :tag "Never" nil) (const :tag "On Emacs exit" t) (const :tag "Whenever save-some-buffers is called" always)) commit c80f31f591685203162f8fc44fd0f1b98332866a Author: Eli Zaretskii <eliz@gnu.org> Date: Sat Jun 30 12:22:05 2018 +0300 Minor improvements in documentation of imenu.el * lisp/imenu.el (imenu-generic-skip-comments-and-strings) (imenu--generic-function): Doc fixes. (Bug#31962) diff --git a/lisp/imenu.el b/lisp/imenu.el index f56e7b5039..8cf3c768ea 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -187,7 +187,9 @@ with name concatenation." (defcustom imenu-generic-skip-comments-and-strings t "When non-nil, ignore text inside comments and strings. -Only affects `imenu--generic-function'." +Only affects `imenu-default-create-index-function' (and any +alternative implementation of `imenu-create-index-function' that +uses `imenu--generic-function')." :type 'boolean :group 'imenu :version "24.4") @@ -738,7 +740,7 @@ for modes which use `imenu--generic-function'. If it is not set, but ;; so it needs to be careful never to loop! (defun imenu--generic-function (patterns) "Return an index alist of the current buffer based on PATTERNS. -PATTERNS should be an alist with the same form as `imenu-generic-expression'. +PATTERNS should be an alist of the same form as `imenu-generic-expression'. If `imenu-generic-skip-comments-and-strings' is non-nil, this ignores text inside comments and strings. commit 8ebb6830fafcd272bd0d6f7f9d765ef72500ffc5 Author: Eli Zaretskii <eliz@gnu.org> Date: Sat Jun 30 12:07:24 2018 +0300 Avoid errors with recentering in 'skeleton-insert' * lisp/skeleton.el (skeleton-insert): Don't recenter if we are running in a buffer other than the one displayed in the selected window. (Bug#31950) diff --git a/lisp/skeleton.el b/lisp/skeleton.el index 90e3819cb7..e3cebba916 100644 --- a/lisp/skeleton.el +++ b/lisp/skeleton.el @@ -268,7 +268,8 @@ available: (or (eolp) (not skeleton-end-newline) (newline-and-indent)) (run-hooks 'skeleton-end-hook) (sit-for 0) - (or (pos-visible-in-window-p beg) + (or (not (eq (window-buffer) (current-buffer))) + (pos-visible-in-window-p beg) (progn (goto-char beg) (recenter 0))) commit ed65ea18152636500399a7b6b75c87bac7d4ef2b Author: Eli Zaretskii <eliz@gnu.org> Date: Sat Jun 30 11:43:42 2018 +0300 Speed up reading sub-process output on MS-Windows * src/w32proc.c (syms_of_ntproc) <w32-pipe-read-delay>: Set to zero. For the details, see this discussion: http://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00711.html. * src/w32.c (_sys_read_ahead): Update the commentary for w32-pipe-read-delay usage. * doc/emacs/msdos.texi (Windows Processes): Document w32-pipe-read-delay. * etc/NEWS: Mention the change of the value of w32-pipe-read-delay. diff --git a/doc/emacs/msdos.texi b/doc/emacs/msdos.texi index 679bdd3e83..c69c7d37f9 100644 --- a/doc/emacs/msdos.texi +++ b/doc/emacs/msdos.texi @@ -808,6 +808,13 @@ communications with subprocesses to programs that exhibit unusual behavior with respect to buffering pipe I/O. @ifnottex +@vindex w32-pipe-read-delay + If you need to invoke MS-DOS programs as Emacs subprocesses, you may +see low rate of reading data from such programs. Setting the variable +@code{w32-pipe-read-delay} to a non-zero value may improve throughput +in these cases; we suggest the value of 50 for such situations. The +default is zero. + @findex w32-shell-execute The function @code{w32-shell-execute} can be useful for writing customized commands that run MS-Windows applications registered to diff --git a/etc/NEWS b/etc/NEWS index eb9169a776..f5332c0782 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -851,6 +851,17 @@ retrieving values stored under a given key. It is intended to be used for supporting features such as XDG-like location of important files and directories. ++++ +** The default value of 'w32-pipe-read-delay' is now zero. +This speeds up reading output from sub-processes that produce a lot of +data. + +This variable may need to be non-zero only when running DOS programs +as Emacs subprocesses, which by now is not supported on modern +versions of MS-Windows. Set this variable to 50 if for some reason +you need the old behavior (and please report such situations to Emacs +developers). + ---------------------------------------------------------------------- This file is part of GNU Emacs. diff --git a/src/w32.c b/src/w32.c index e93aaab9ca..c848b33b2a 100644 --- a/src/w32.c +++ b/src/w32.c @@ -8469,13 +8469,14 @@ _sys_read_ahead (int fd) { rc = _read (fd, &cp->chr, sizeof (char)); - /* Give subprocess time to buffer some more output for us before - reporting that input is available; we need this because Windows 95 - connects DOS programs to pipes by making the pipe appear to be - the normal console stdout - as a result most DOS programs will - write to stdout without buffering, ie. one character at a - time. Even some W32 programs do this - "dir" in a command - shell on NT is very slow if we don't do this. */ + /* Optionally give subprocess time to buffer some more output + for us before reporting that input is available; we may need + this because Windows 9X connects DOS programs to pipes by + making the pipe appear to be the normal console stdout -- as + a result most DOS programs will write to stdout without + buffering, i.e., one character at a time. Even some W32 + programs do this -- "dir" in a command shell on NT is very + slow if we don't do this. */ if (rc > 0) { int wait = w32_pipe_read_delay; diff --git a/src/w32proc.c b/src/w32proc.c index 28d7b6611f..5934669c36 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -3763,14 +3763,17 @@ them blocking when trying to access unmounted drives etc. */); DEFVAR_INT ("w32-pipe-read-delay", w32_pipe_read_delay, doc: /* Forced delay before reading subprocess output. -This is done to improve the buffering of subprocess output, by -avoiding the inefficiency of frequently reading small amounts of data. +This may need to be done to improve the buffering of subprocess output, +by avoiding the inefficiency of frequently reading small amounts of data. +Typically needed only with DOS programs on Windows 9X; set to 50 if +throughput with such programs is slow. If positive, the value is the number of milliseconds to sleep before -reading the subprocess output. If negative, the magnitude is the number -of time slices to wait (effectively boosting the priority of the child -process temporarily). A value of zero disables waiting entirely. */); - w32_pipe_read_delay = 50; +signaling that output from a subprocess is ready to be read. +If negative, the value is the number of time slices to wait (effectively +boosting the priority of the child process temporarily). +A value of zero disables waiting entirely. */); + w32_pipe_read_delay = 0; DEFVAR_INT ("w32-pipe-buffer-size", w32_pipe_buffer_size, doc: /* Size of buffer for pipes created to communicate with subprocesses. commit 3b4e65e797e15668345cf606c7d822cce11f17b2 Author: Eli Zaretskii <eliz@gnu.org> Date: Sat Jun 30 11:17:25 2018 +0300 Speed-up let-binding of automatically-local variables * src/data.c (set_default_internal): Use FOR_EACH_LIVE_BUFFER when binding variables that don't nominally have a local value, to avoid slowing down due to a large number of dead buffers. (Bug#18522) (Bug#31853) diff --git a/src/data.c b/src/data.c index 605a5f43af..c8beeda720 100644 --- a/src/data.c +++ b/src/data.c @@ -1713,11 +1713,21 @@ set_default_internal (Lisp_Object symbol, Lisp_Object value, set it in the buffers that don't nominally have a local value. */ if (idx > 0) { - struct buffer *b; + Lisp_Object buf, tail; + + /* Do this only in live buffers, so that if there are + a lot of buffers which are dead, that doesn't slow + down let-binding of variables that are + automatically local when set, like + case-fold-search. This is for Lisp programs that + let-bind such variables in their inner loops. */ + FOR_EACH_LIVE_BUFFER (tail, buf) + { + struct buffer *b = XBUFFER (buf); - FOR_EACH_BUFFER (b) - if (!PER_BUFFER_VALUE_P (b, idx)) - set_per_buffer_value (b, offset, value); + if (!PER_BUFFER_VALUE_P (b, idx)) + set_per_buffer_value (b, offset, value); + } } } else commit 35e9dcab5141bf9cae67abe740933fe627ecc371 Author: Paul Eggert <eggert@cs.ucla.edu> Date: Fri Jun 29 17:31:04 2018 -0700 Update from Gnulib This incorporates: 2018-06-29 regex: glibc does not use intprops.h 2018-06-28 regex: port to recently proposed glibc regex merge 2018-06-25 Continue to use spaces for indentation, not tabs 2018-06-25 manywarnings: Don't enable -Wjump-misses-init by default 2018-06-25 acl-internal.h: remove _GL_ATTRIBUTE_CONST on void function 2018-06-24 manywarnings: accommodate GCC 9: remove -Wchkp and -Wabi 2018-06-24 maint: clarify comments about sticky EOF 2018-06-24 af_alg: avoid hangs when reading from streams 2018-06-17 crypto: use byteswap 2018-06-17 getloadavg: Return 0 on MS-Windows without Cygwi 2018-06-17 getloadavg: Allow building on MS-Windows without Cygwin * build-aux/config.guess, build-aux/config.sub, doc/misc/texinfo.tex: * lib/acl-internal.c, lib/acl-internal.h, lib/get-permissions.c: * lib/getloadavg.c, lib/gettimeofday.c, lib/md5.c, lib/pselect.c: * lib/set-permissions.c, lib/sha1.c, lib/sha256.c, lib/sha512.c: * lib/time.in.h, m4/getloadavg.m4, m4/gnulib-common.m4: * m4/manywarnings.m4, m4/pthread_sigmask.m4, m4/vararrays.m4: Copy from Gnulib. diff --git a/build-aux/config.guess b/build-aux/config.guess index 883a6713bf..445c406836 100755 --- a/build-aux/config.guess +++ b/build-aux/config.guess @@ -2,7 +2,7 @@ # Attempt to guess a canonical system name. # Copyright 1992-2018 Free Software Foundation, Inc. -timestamp='2018-05-19' +timestamp='2018-06-26' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -894,8 +894,8 @@ EOF # other systems with GNU libc and userland echo "$UNAME_MACHINE-unknown-`echo "$UNAME_SYSTEM" | sed 's,^[^/]*/,,' | tr "[:upper:]" "[:lower:]"``echo "$UNAME_RELEASE"|sed -e 's/[-(].*//'`-$LIBC" exit ;; - i*86:Minix:*:*) - echo "$UNAME_MACHINE"-pc-minix + *:Minix:*:*) + echo "$UNAME_MACHINE"-unknown-minix exit ;; aarch64:Linux:*:*) echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" diff --git a/build-aux/config.sub b/build-aux/config.sub index f38250f1da..d1f5b54903 100755 --- a/build-aux/config.sub +++ b/build-aux/config.sub @@ -2,7 +2,7 @@ # Configuration validation subroutine script. # Copyright 1992-2018 Free Software Foundation, Inc. -timestamp='2018-05-19' +timestamp='2018-05-24' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -149,8 +149,30 @@ case $1 in esac ;; *-*) - basic_machine=$field1 - os=$field2 + # Second component is usually, but not always the OS + case $field2 in + # Prevent following clause from handling this valid os + sun*os*) + basic_machine=$field1 + os=$field2 + ;; + # Manufacturers + dec* | mips* | sequent* | encore* | pc532* | sgi* | sony* \ + | att* | 7300* | 3300* | delta* | motorola* | sun[234]* \ + | unicom* | ibm* | next | hp | isi* | apollo | altos* \ + | convergent* | ncr* | news | 32* | 3600* | 3100* | hitachi* \ + | c[123]* | convex* | sun | crds | omron* | dg | ultra | tti* \ + | harris | dolphin | highlevel | gould | cbm | ns | masscomp \ + | apple | axis | knuth | cray | microblaze* \ + | sim | cisco | oki | wec | wrs | winbond) + basic_machine=$field1-$field2 + os= + ;; + *) + basic_machine=$field1 + os=$field2 + ;; + esac ;; *) # Convert single-component short-hands not valid as part of @@ -540,110 +562,6 @@ case $1 in ;; esac -### Let's recognize common machines as not being operating systems so -### that things like config.sub decstation-3100 work. We also -### recognize some manufacturers as not being operating systems, so we -### can provide default operating systems below. -case $os in - sun*os*) - # Prevent following clause from handling this invalid input. - ;; - dec* | mips* | sequent* | encore* | pc532* | sgi* | sony* | \ - att* | 7300* | 3300* | delta* | motorola* | sun[234]* | \ - unicom* | ibm* | next | hp | isi* | apollo | altos* | \ - convergent* | ncr* | news | 32* | 3600* | 3100* | hitachi* |\ - c[123]* | convex* | sun | crds | omron* | dg | ultra | tti* | \ - harris | dolphin | highlevel | gould | cbm | ns | masscomp | \ - apple | axis | knuth | cray | microblaze*) - os= - basic_machine=$1 - ;; - bluegene*) - os=cnk - ;; - sim | cisco | oki | wec | winbond) - os= - basic_machine=$1 - ;; - scout) - ;; - wrs) - os=vxworks - basic_machine=$1 - ;; - chorusos*) - os=chorusos - basic_machine=$1 - ;; - chorusrdb) - os=chorusrdb - basic_machine=$1 - ;; - hiux*) - os=hiuxwe2 - ;; - sco6) - os=sco5v6 - basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'` - ;; - sco5) - os=sco3.2v5 - basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'` - ;; - sco4) - os=sco3.2v4 - basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'` - ;; - sco3.2.[4-9]*) - os=`echo $os | sed -e 's/sco3.2./sco3.2v/'` - basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'` - ;; - sco3.2v[4-9]*) - # Don't forget version if it is 3.2v4 or newer. - basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'` - ;; - sco5v6*) - # Don't forget version if it is 3.2v4 or newer. - basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'` - ;; - sco*) - os=sco3.2v2 - basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'` - ;; - udk*) - basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'` - ;; - isc) - os=isc2.2 - basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'` - ;; - clix*) - basic_machine=clipper-intergraph - ;; - isc*) - basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'` - ;; - lynx*178) - os=lynxos178 - ;; - lynx*5) - os=lynxos5 - ;; - lynx*) - os=lynxos - ;; - ptx*) - basic_machine=`echo "$1" | sed -e 's/86-.*/86-sequent/'` - ;; - psos*) - os=psos - ;; - mint | mint[0-9]*) - basic_machine=m68k-atari - os=mint - ;; -esac - # Decode aliases for certain CPU-COMPANY combinations. case $basic_machine in # Recognize the basic CPU types without company name. @@ -1377,6 +1295,9 @@ case $os in auroraux) os=auroraux ;; + bluegene*) + os=cnk + ;; solaris1 | solaris1.*) os=`echo $os | sed -e 's|solaris1|sunos4|'` ;; @@ -1393,26 +1314,57 @@ case $os in es1800*) os=ose ;; + # Some version numbers need modification + chorusos*) + os=chorusos + ;; + isc) + os=isc2.2 + ;; + sco6) + os=sco5v6 + ;; + sco5) + os=sco3.2v5 + ;; + sco4) + os=sco3.2v4 + ;; + sco3.2.[4-9]*) + os=`echo $os | sed -e 's/sco3.2./sco3.2v/'` + ;; + sco3.2v[4-9]* | sco5v6*) + # Don't forget version if it is 3.2v4 or newer. + ;; + scout) + # Don't match below + ;; + sco*) + os=sco3.2v2 + ;; + psos*) + os=psos + ;; # Now accept the basic system types. # The portable systems comes first. # Each alternative MUST end in a * to match a version number. # sysv* is not here because it comes later, after sysvr4. gnu* | bsd* | mach* | minix* | genix* | ultrix* | irix* \ - | *vms* | sco* | esix* | isc* | aix* | cnk* | sunos | sunos[34]*\ + | *vms* | esix* | aix* | cnk* | sunos | sunos[34]*\ | hpux* | unos* | osf* | luna* | dgux* | auroraux* | solaris* \ | sym* | kopensolaris* | plan9* \ | amigaos* | amigados* | msdos* | newsos* | unicos* | aof* \ | aos* | aros* | cloudabi* | sortix* \ | nindy* | vxsim* | vxworks* | ebmon* | hms* | mvs* \ | clix* | riscos* | uniplus* | iris* | rtu* | xenix* \ - | hiux* | knetbsd* | mirbsd* | netbsd* \ + | knetbsd* | mirbsd* | netbsd* \ | bitrig* | openbsd* | solidbsd* | libertybsd* \ | ekkobsd* | kfreebsd* | freebsd* | riscix* | lynxos* \ | bosx* | nextstep* | cxux* | aout* | elf* | oabi* \ | ptx* | coff* | ecoff* | winnt* | domain* | vsta* \ | udi* | eabi* | lites* | ieee* | go32* | aux* | hcos* \ - | chorusos* | chorusrdb* | cegcc* | glidix* \ - | cygwin* | msys* | pe* | psos* | moss* | proelf* | rtems* \ + | chorusrdb* | cegcc* | glidix* \ + | cygwin* | msys* | pe* | moss* | proelf* | rtems* \ | midipix* | mingw32* | mingw64* | linux-gnu* | linux-android* \ | linux-newlib* | linux-musl* | linux-uclibc* \ | uxpv* | beos* | mpeix* | udk* | moxiebox* \ @@ -1436,6 +1388,9 @@ case $os in ;; esac ;; + hiux*) + os=hiuxwe2 + ;; nto-qnx*) ;; nto*) @@ -1445,20 +1400,23 @@ case $os in | windows* | osx | abug | netware* | os9* \ | macos* | mpw* | magic* | mmixware* | mon960* | lnews*) ;; - mac*) - os=`echo "$os" | sed -e 's|mac|macos|'` - ;; linux-dietlibc) os=linux-dietlibc ;; linux*) os=`echo $os | sed -e 's|linux|linux-gnu|'` ;; - sunos5*) - os=`echo "$os" | sed -e 's|sunos5|solaris2|'` + lynx*178) + os=lynxos178 ;; - sunos6*) - os=`echo "$os" | sed -e 's|sunos6|solaris3|'` + lynx*5) + os=lynxos5 + ;; + lynx*) + os=lynxos + ;; + mac*) + os=`echo "$os" | sed -e 's|mac|macos|'` ;; opened*) os=openedition @@ -1466,6 +1424,12 @@ case $os in os400*) os=os400 ;; + sunos5*) + os=`echo "$os" | sed -e 's|sunos5|solaris2|'` + ;; + sunos6*) + os=`echo "$os" | sed -e 's|sunos6|solaris3|'` + ;; wince*) os=wince ;; @@ -1599,6 +1563,9 @@ case $basic_machine in c8051-*) os=elf ;; + clipper-intergraph) + os=clix + ;; hexagon-*) os=elf ;; @@ -1744,6 +1711,9 @@ case $basic_machine in *-atari*) os=mint ;; + *-wrs) + os=vxworks + ;; *) os=none ;; @@ -1789,6 +1759,9 @@ case $basic_machine in genix*) vendor=ns ;; + clix*) + vendor=intergraph + ;; mvs* | opened*) vendor=ibm ;; diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex index aa4f256437..d7f7f53a34 100644 --- a/doc/misc/texinfo.tex +++ b/doc/misc/texinfo.tex @@ -3,7 +3,7 @@ % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -\def\texinfoversion{2018-03-10.14} +\def\texinfoversion{2018-06-02.09} % % Copyright 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995, % 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, @@ -1528,6 +1528,9 @@ \startlink attr{/Border [0 0 0]}% user{/Subtype /Link /A << /S /URI /URI (#1) >>}% \endgroup} + % \pdfgettoks - Surround page numbers in #1 with @pdflink. #1 may + % be a simple number, or a list of numbers in the case of an index + % entry. \def\pdfgettoks#1.{\setbox\boxA=\hbox{\toksA={#1.}\toksB={}\maketoks}} \def\addtokens#1#2{\edef\addtoks{\noexpand#1={\the#1#2}}\addtoks} \def\adn#1{\addtokens{\toksC}{#1}\global\countA=1\let\next=\maketoks} diff --git a/lib/acl-internal.c b/lib/acl-internal.c index 383c5ddb6f..c62adb0d9d 100644 --- a/lib/acl-internal.c +++ b/lib/acl-internal.c @@ -355,7 +355,7 @@ acl_nontrivial (int count, struct acl_entry *entries) struct acl_entry *ace = &entries[i]; if (ace->uid != ACL_NSUSER && ace->gid != ACL_NSGROUP) - return 1; + return 1; } return 0; } diff --git a/lib/acl-internal.h b/lib/acl-internal.h index 6c65e65e5e..0669d83c46 100644 --- a/lib/acl-internal.h +++ b/lib/acl-internal.h @@ -293,10 +293,6 @@ struct permission_context { int get_permissions (const char *, int, mode_t, struct permission_context *); int set_permissions (struct permission_context *, const char *, int); -void free_permission_context (struct permission_context *) -#if ! (defined USE_ACL && (HAVE_ACL_GET_FILE || defined GETACL)) - _GL_ATTRIBUTE_CONST -#endif - ; +void free_permission_context (struct permission_context *); _GL_INLINE_HEADER_END diff --git a/lib/get-permissions.c b/lib/get-permissions.c index bb1af5dbdf..83ba2639a1 100644 --- a/lib/get-permissions.c +++ b/lib/get-permissions.c @@ -31,7 +31,7 @@ int get_permissions (const char *name, int desc, mode_t mode, - struct permission_context *ctx) + struct permission_context *ctx) { memset (ctx, 0, sizeof *ctx); ctx->mode = mode; @@ -57,7 +57,7 @@ get_permissions (const char *name, int desc, mode_t mode, { ctx->default_acl = acl_get_file (name, ACL_TYPE_DEFAULT); if (ctx->default_acl == NULL) - return -1; + return -1; } # if HAVE_ACL_TYPE_NFS4 /* FreeBSD */ @@ -115,16 +115,16 @@ get_permissions (const char *name, int desc, mode_t mode, int ret; if (desc != -1) - ret = facl (desc, ACE_GETACLCNT, 0, NULL); + ret = facl (desc, ACE_GETACLCNT, 0, NULL); else - ret = acl (name, ACE_GETACLCNT, 0, NULL); + ret = acl (name, ACE_GETACLCNT, 0, NULL); if (ret < 0) - { - if (errno == ENOSYS || errno == EINVAL) - ret = 0; - else - return -1; - } + { + if (errno == ENOSYS || errno == EINVAL) + ret = 0; + else + return -1; + } ctx->ace_count = ret; if (ctx->ace_count == 0) @@ -138,15 +138,15 @@ get_permissions (const char *name, int desc, mode_t mode, } if (desc != -1) - ret = facl (desc, ACE_GETACL, ctx->ace_count, ctx->ace_entries); + ret = facl (desc, ACE_GETACL, ctx->ace_count, ctx->ace_entries); else - ret = acl (name, ACE_GETACL, ctx->ace_count, ctx->ace_entries); + ret = acl (name, ACE_GETACL, ctx->ace_count, ctx->ace_entries); if (ret < 0) { if (errno == ENOSYS || errno == EINVAL) { - free (ctx->ace_entries); - ctx->ace_entries = NULL; + free (ctx->ace_entries); + ctx->ace_entries = NULL; ctx->ace_count = 0; break; } @@ -154,10 +154,10 @@ get_permissions (const char *name, int desc, mode_t mode, return -1; } if (ret <= ctx->ace_count) - { - ctx->ace_count = ret; - break; - } + { + ctx->ace_count = ret; + break; + } /* Huh? The number of ACL entries has increased since the last call. Repeat. */ free (ctx->ace_entries); @@ -170,20 +170,20 @@ get_permissions (const char *name, int desc, mode_t mode, int ret; if (desc != -1) - ret = facl (desc, GETACLCNT, 0, NULL); + ret = facl (desc, GETACLCNT, 0, NULL); else - ret = acl (name, GETACLCNT, 0, NULL); + ret = acl (name, GETACLCNT, 0, NULL); if (ret < 0) - { - if (errno == ENOSYS || errno == ENOTSUP || errno == EOPNOTSUPP) - ret = 0; - else - return -1; - } + { + if (errno == ENOSYS || errno == ENOTSUP || errno == EOPNOTSUPP) + ret = 0; + else + return -1; + } ctx->count = ret; if (ctx->count == 0) - break; + break; ctx->entries = (aclent_t *) malloc (ctx->count * sizeof (aclent_t)); if (ctx->entries == NULL) @@ -193,26 +193,26 @@ get_permissions (const char *name, int desc, mode_t mode, } if (desc != -1) - ret = facl (desc, GETACL, ctx->count, ctx->entries); + ret = facl (desc, GETACL, ctx->count, ctx->entries); else - ret = acl (name, GETACL, ctx->count, ctx->entries); + ret = acl (name, GETACL, ctx->count, ctx->entries); if (ret < 0) - { - if (errno == ENOSYS || errno == ENOTSUP || errno == EOPNOTSUPP) - { - free (ctx->entries); - ctx->entries = NULL; - ctx->count = 0; - break; - } - else - return -1; - } + { + if (errno == ENOSYS || errno == ENOTSUP || errno == EOPNOTSUPP) + { + free (ctx->entries); + ctx->entries = NULL; + ctx->count = 0; + break; + } + else + return -1; + } if (ret <= ctx->count) - { - ctx->count = ret; - break; - } + { + ctx->count = ret; + break; + } /* Huh? The number of ACL entries has increased since the last call. Repeat. */ free (ctx->entries); diff --git a/lib/getloadavg.c b/lib/getloadavg.c index 702338fb9e..435d10a6b1 100644 --- a/lib/getloadavg.c +++ b/lib/getloadavg.c @@ -68,7 +68,7 @@ UMAX UMAX4_3 VMS - WINDOWS32 No-op for Windows95/NT. + _WIN32 Native Windows (possibly also defined on Cygwin) __linux__ Linux: assumes /proc file system mounted. Support from Michael K. Johnson. __CYGWIN__ Cygwin emulates linux /proc/loadavg. @@ -97,6 +97,10 @@ # include "intprops.h" +# if defined _WIN32 && ! defined __CYGWIN__ +# define WINDOWS32 +# endif + # if !defined (BSD) && defined (ultrix) /* Ultrix behaves like BSD on Vaxen. */ # define BSD @@ -324,7 +328,9 @@ # define LDAV_SYMBOL "avenrun" # endif -# include <unistd.h> +# ifdef HAVE_UNISTD_H +# include <unistd.h> +# endif /* LOAD_AVE_TYPE should only get defined if we're going to use the nlist method. */ diff --git a/lib/gettimeofday.c b/lib/gettimeofday.c index d598b2f7f5..fd44f45ca3 100644 --- a/lib/gettimeofday.c +++ b/lib/gettimeofday.c @@ -45,7 +45,7 @@ initialize (void) if (kernel32 != NULL) { GetSystemTimePreciseAsFileTimeFunc = - (GetSystemTimePreciseAsFileTimeFuncType) GetProcAddress (kernel32, "GetSystemTimePreciseAsFileTime"); + (GetSystemTimePreciseAsFileTimeFuncType) GetProcAddress (kernel32, "GetSystemTimePreciseAsFileTime"); } initialized = TRUE; } diff --git a/lib/md5.c b/lib/md5.c index 577aab46d7..554d421c7b 100644 --- a/lib/md5.c +++ b/lib/md5.c @@ -52,9 +52,9 @@ # define md5_buffer __md5_buffer #endif +#include <byteswap.h> #ifdef WORDS_BIGENDIAN -# define SWAP(n) \ - (((n) << 24) | (((n) & 0xff00) << 8) | (((n) >> 8) & 0xff00) | ((n) >> 24)) +# define SWAP(n) bswap_32 (n) #else # define SWAP(n) (n) #endif @@ -170,6 +170,14 @@ md5_stream (FILE *stream, void *resblock) /* Read block. Take care for partial reads. */ while (1) { + /* Either process a partial fread() from this loop, + or the fread() in afalg_stream may have gotten EOF. + We need to avoid a subsequent fread() as EOF may + not be sticky. For details of such systems, see: + https://sourceware.org/bugzilla/show_bug.cgi?id=1190 */ + if (feof (stream)) + goto process_partial_block; + n = fread (buffer + sum, 1, BLOCKSIZE - sum, stream); sum += n; @@ -189,12 +197,6 @@ md5_stream (FILE *stream, void *resblock) } goto process_partial_block; } - - /* We've read at least one byte, so ignore errors. But always - check for EOF, since feof may be true even though N > 0. - Otherwise, we could end up calling fread after EOF. */ - if (feof (stream)) - goto process_partial_block; } /* Process buffer with BLOCKSIZE bytes. Note that diff --git a/lib/pselect.c b/lib/pselect.c index 40758251ef..33b2719561 100644 --- a/lib/pselect.c +++ b/lib/pselect.c @@ -83,9 +83,9 @@ pselect (int nfds, fd_set *restrict rfds, int rpl_pselect (int nfds, fd_set *restrict rfds, - fd_set *restrict wfds, fd_set *restrict xfds, + fd_set *restrict wfds, fd_set *restrict xfds, struct timespec const *restrict timeout, - sigset_t const *restrict sigmask) + sigset_t const *restrict sigmask) { int i; diff --git a/lib/set-permissions.c b/lib/set-permissions.c index 4b7371c9b4..d42335aa50 100644 --- a/lib/set-permissions.c +++ b/lib/set-permissions.c @@ -229,14 +229,14 @@ set_acls_from_mode (const char *name, int desc, mode_t mode, bool *must_chmod) if (ret < 0 && errno != EINVAL && errno != ENOTSUP) { if (errno == ENOSYS) - { - *must_chmod = true; - return 0; - } + { + *must_chmod = true; + return 0; + } return -1; } if (ret == 0) - return 0; + return 0; } # endif @@ -256,18 +256,18 @@ set_acls_from_mode (const char *name, int desc, mode_t mode, bool *must_chmod) if (desc != -1) ret = facl (desc, SETACL, - sizeof (entries) / sizeof (aclent_t), entries); + sizeof (entries) / sizeof (aclent_t), entries); else ret = acl (name, SETACL, - sizeof (entries) / sizeof (aclent_t), entries); + sizeof (entries) / sizeof (aclent_t), entries); if (ret < 0) { - if (errno == ENOSYS || errno == EOPNOTSUPP) - { - *must_chmod = true; - return 0; - } - return -1; + if (errno == ENOSYS || errno == EOPNOTSUPP) + { + *must_chmod = true; + return 0; + } + return -1; } return 0; } @@ -483,7 +483,7 @@ context_acl_from_mode (struct permission_context *ctx) static int set_acls (struct permission_context *ctx, const char *name, int desc, - int from_mode, bool *must_chmod, bool *acls_set) + int from_mode, bool *must_chmod, bool *acls_set) { int ret = 0; @@ -503,43 +503,43 @@ set_acls (struct permission_context *ctx, const char *name, int desc, if (! ctx->acls_not_supported) { if (ret == 0 && from_mode) - { - if (ctx->acl) - acl_free (ctx->acl); - ctx->acl = acl_from_mode (ctx->mode); - if (ctx->acl == NULL) - ret = -1; - } + { + if (ctx->acl) + acl_free (ctx->acl); + ctx->acl = acl_from_mode (ctx->mode); + if (ctx->acl == NULL) + ret = -1; + } if (ret == 0 && ctx->acl) - { - if (HAVE_ACL_SET_FD && desc != -1) - ret = acl_set_fd (desc, ctx->acl); - else - ret = acl_set_file (name, ACL_TYPE_ACCESS, ctx->acl); - if (ret != 0) - { - if (! acl_errno_valid (errno)) - { - ctx->acls_not_supported = true; - if (from_mode || acl_access_nontrivial (ctx->acl) == 0) - ret = 0; - } - } - else - { - *acls_set = true; - if (S_ISDIR(ctx->mode)) - { - if (! from_mode && ctx->default_acl && - acl_default_nontrivial (ctx->default_acl)) - ret = acl_set_file (name, ACL_TYPE_DEFAULT, - ctx->default_acl); - else - ret = acl_delete_def_file (name); - } - } - } + { + if (HAVE_ACL_SET_FD && desc != -1) + ret = acl_set_fd (desc, ctx->acl); + else + ret = acl_set_file (name, ACL_TYPE_ACCESS, ctx->acl); + if (ret != 0) + { + if (! acl_errno_valid (errno)) + { + ctx->acls_not_supported = true; + if (from_mode || acl_access_nontrivial (ctx->acl) == 0) + ret = 0; + } + } + else + { + *acls_set = true; + if (S_ISDIR(ctx->mode)) + { + if (! from_mode && ctx->default_acl && + acl_default_nontrivial (ctx->default_acl)) + ret = acl_set_file (name, ACL_TYPE_DEFAULT, + ctx->default_acl); + else + ret = acl_delete_def_file (name); + } + } + } } # if HAVE_ACL_TYPE_NFS4 /* FreeBSD */ @@ -573,38 +573,38 @@ set_acls (struct permission_context *ctx, const char *name, int desc, /* Remove ACLs if the file has ACLs. */ if (HAVE_ACL_GET_FD && desc != -1) - acl = acl_get_fd (desc); + acl = acl_get_fd (desc); else - acl = acl_get_file (name, ACL_TYPE_EXTENDED); + acl = acl_get_file (name, ACL_TYPE_EXTENDED); if (acl) - { - acl_free (acl); - - acl = acl_init (0); - if (acl) - { - if (HAVE_ACL_SET_FD && desc != -1) - ret = acl_set_fd (desc, acl); - else - ret = acl_set_file (name, ACL_TYPE_EXTENDED, acl); - acl_free (acl); - } - else - ret = -1; - } + { + acl_free (acl); + + acl = acl_init (0); + if (acl) + { + if (HAVE_ACL_SET_FD && desc != -1) + ret = acl_set_fd (desc, acl); + else + ret = acl_set_file (name, ACL_TYPE_EXTENDED, acl); + acl_free (acl); + } + else + ret = -1; + } } else { if (HAVE_ACL_SET_FD && desc != -1) - ret = acl_set_fd (desc, ctx->acl); + ret = acl_set_fd (desc, ctx->acl); else - ret = acl_set_file (name, ACL_TYPE_EXTENDED, ctx->acl); + ret = acl_set_file (name, ACL_TYPE_EXTENDED, ctx->acl); if (ret != 0) - { - if (! acl_errno_valid (errno) - && ! acl_extended_nontrivial (ctx->acl)) - ret = 0; - } + { + if (! acl_errno_valid (errno) + && ! acl_extended_nontrivial (ctx->acl)) + ret = 0; + } } *acls_set = true; @@ -626,34 +626,34 @@ set_acls (struct permission_context *ctx, const char *name, int desc, if (ret == 0 && ctx->count) { if (desc != -1) - ret = facl (desc, SETACL, ctx->count, ctx->entries); + ret = facl (desc, SETACL, ctx->count, ctx->entries); else - ret = acl (name, SETACL, ctx->count, ctx->entries); + ret = acl (name, SETACL, ctx->count, ctx->entries); if (ret < 0) - { - if ((errno == ENOSYS || errno == EOPNOTSUPP || errno == EINVAL) - && acl_nontrivial (ctx->count, ctx->entries) == 0) - ret = 0; - } + { + if ((errno == ENOSYS || errno == EOPNOTSUPP || errno == EINVAL) + && acl_nontrivial (ctx->count, ctx->entries) == 0) + ret = 0; + } else - *acls_set = true; + *acls_set = true; } # ifdef ACE_GETACL if (ret == 0 && ctx->ace_count) { if (desc != -1) - ret = facl (desc, ACE_SETACL, ctx->ace_count, ctx->ace_entries); + ret = facl (desc, ACE_SETACL, ctx->ace_count, ctx->ace_entries); else - ret = acl (name, ACE_SETACL, ctx->ace_count, ctx->ace_entries); + ret = acl (name, ACE_SETACL, ctx->ace_count, ctx->ace_entries); if (ret < 0) - { - if ((errno == ENOSYS || errno == EINVAL || errno == ENOTSUP) - && acl_ace_nontrivial (ctx->ace_count, ctx->ace_entries) == 0) - ret = 0; - } + { + if ((errno == ENOSYS || errno == EINVAL || errno == ENOTSUP) + && acl_ace_nontrivial (ctx->ace_count, ctx->ace_entries) == 0) + ret = 0; + } else - *acls_set = true; + *acls_set = true; } # endif @@ -665,17 +665,17 @@ set_acls (struct permission_context *ctx, const char *name, int desc, if (ret == 0 && ctx->count > 0) { if (desc != -1) - ret = fsetacl (desc, ctx->count, ctx->entries); + ret = fsetacl (desc, ctx->count, ctx->entries); else - ret = setacl (name, ctx->count, ctx->entries); + ret = setacl (name, ctx->count, ctx->entries); if (ret < 0) - { - if ((errno == ENOSYS || errno == EOPNOTSUPP || errno == ENOTSUP) - && (from_mode || !acl_nontrivial (ctx->count, ctx->entries))) - ret = 0; - } + { + if ((errno == ENOSYS || errno == EOPNOTSUPP || errno == ENOTSUP) + && (from_mode || !acl_nontrivial (ctx->count, ctx->entries))) + ret = 0; + } else - *acls_set = true; + *acls_set = true; } # if HAVE_ACLV_H @@ -686,13 +686,13 @@ set_acls (struct permission_context *ctx, const char *name, int desc, { ret = acl ((char *) name, ACL_SET, ctx->aclv_count, ctx->aclv_entries); if (ret < 0) - { - if ((errno == ENOSYS || errno == EOPNOTSUPP || errno == EINVAL) - && (from_mode || !aclv_nontrivial (ctx->aclv_count, ctx->aclv_entries))) - ret = 0; - } + { + if ((errno == ENOSYS || errno == EOPNOTSUPP || errno == EINVAL) + && (from_mode || !aclv_nontrivial (ctx->aclv_count, ctx->aclv_entries))) + ret = 0; + } else - *acls_set = true; + *acls_set = true; } # endif @@ -711,16 +711,16 @@ set_acls (struct permission_context *ctx, const char *name, int desc, if (ret == 0 && ctx->have_u) { if (desc != -1) - ret = fchacl (desc, &ctx->u.a, ctx->u.a.acl_len); + ret = fchacl (desc, &ctx->u.a, ctx->u.a.acl_len); else - ret = chacl ((char *) name, &ctx->u.a, ctx->u.a.acl_len); + ret = chacl ((char *) name, &ctx->u.a, ctx->u.a.acl_len); if (ret < 0) - { - if (errno == ENOSYS && from_mode) - ret = 0; - } + { + if (errno == ENOSYS && from_mode) + ret = 0; + } else - *acls_set = true; + *acls_set = true; } # elif HAVE_ACLSORT /* NonStop Kernel */ @@ -732,12 +732,12 @@ set_acls (struct permission_context *ctx, const char *name, int desc, { ret = acl ((char *) name, ACL_SET, ctx->count, ctx->entries); if (ret != 0) - { - if (!acl_nontrivial (ctx->count, ctx->entries)) - ret = 0; - } + { + if (!acl_nontrivial (ctx->count, ctx->entries)) + ret = 0; + } else - *acls_set = true; + *acls_set = true; } # else /* No ACLs */ @@ -805,7 +805,7 @@ set_permissions (struct permission_context *ctx, const char *name, int desc) { ret = chmod_or_fchmod (name, desc, ctx->mode); if (ret != 0) - return -1; + return -1; } #if USE_ACL @@ -815,18 +815,18 @@ set_permissions (struct permission_context *ctx, const char *name, int desc) int saved_errno = ret ? errno : 0; /* If we can't set an acl which we expect to be able to set, try setting - the permissions to ctx->mode. Due to possible inherited permissions, - we cannot simply chmod. */ + the permissions to ctx->mode. Due to possible inherited permissions, + we cannot simply chmod. */ ret = set_acls (ctx, name, desc, true, &must_chmod, &acls_set); if (! acls_set) - must_chmod = true; + must_chmod = true; if (saved_errno) - { - errno = saved_errno; - ret = -1; - } + { + errno = saved_errno; + ret = -1; + } } #endif @@ -837,10 +837,10 @@ set_permissions (struct permission_context *ctx, const char *name, int desc) ret = chmod_or_fchmod (name, desc, ctx->mode); if (saved_errno) - { - errno = saved_errno; - ret = -1; - } + { + errno = saved_errno; + ret = -1; + } } return ret; diff --git a/lib/sha1.c b/lib/sha1.c index 8306d887da..cd79dfa877 100644 --- a/lib/sha1.c +++ b/lib/sha1.c @@ -37,11 +37,11 @@ # include "unlocked-io.h" #endif +#include <byteswap.h> #ifdef WORDS_BIGENDIAN # define SWAP(n) (n) #else -# define SWAP(n) \ - (((n) << 24) | (((n) & 0xff00) << 8) | (((n) >> 8) & 0xff00) | ((n) >> 24)) +# define SWAP(n) bswap_32 (n) #endif #define BLOCKSIZE 32768 @@ -158,6 +158,14 @@ sha1_stream (FILE *stream, void *resblock) /* Read block. Take care for partial reads. */ while (1) { + /* Either process a partial fread() from this loop, + or the fread() in afalg_stream may have gotten EOF. + We need to avoid a subsequent fread() as EOF may + not be sticky. For details of such systems, see: + https://sourceware.org/bugzilla/show_bug.cgi?id=1190 */ + if (feof (stream)) + goto process_partial_block; + n = fread (buffer + sum, 1, BLOCKSIZE - sum, stream); sum += n; @@ -177,12 +185,6 @@ sha1_stream (FILE *stream, void *resblock) } goto process_partial_block; } - - /* We've read at least one byte, so ignore errors. But always - check for EOF, since feof may be true even though N > 0. - Otherwise, we could end up calling fread after EOF. */ - if (feof (stream)) - goto process_partial_block; } /* Process buffer with BLOCKSIZE bytes. Note that diff --git a/lib/sha256.c b/lib/sha256.c index a036befcaf..c518517077 100644 --- a/lib/sha256.c +++ b/lib/sha256.c @@ -36,11 +36,11 @@ # include "unlocked-io.h" #endif +#include <byteswap.h> #ifdef WORDS_BIGENDIAN # define SWAP(n) (n) #else -# define SWAP(n) \ - (((n) << 24) | (((n) & 0xff00) << 8) | (((n) >> 8) & 0xff00) | ((n) >> 24)) +# define SWAP(n) bswap_32 (n) #endif #define BLOCKSIZE 32768 @@ -208,6 +208,14 @@ shaxxx_stream (FILE *stream, char const *alg, void *resblock, /* Read block. Take care for partial reads. */ while (1) { + /* Either process a partial fread() from this loop, + or the fread() in afalg_stream may have gotten EOF. + We need to avoid a subsequent fread() as EOF may + not be sticky. For details of such systems, see: + https://sourceware.org/bugzilla/show_bug.cgi?id=1190 */ + if (feof (stream)) + goto process_partial_block; + n = fread (buffer + sum, 1, BLOCKSIZE - sum, stream); sum += n; @@ -227,12 +235,6 @@ shaxxx_stream (FILE *stream, char const *alg, void *resblock, } goto process_partial_block; } - - /* We've read at least one byte, so ignore errors. But always - check for EOF, since feof may be true even though N > 0. - Otherwise, we could end up calling fread after EOF. */ - if (feof (stream)) - goto process_partial_block; } /* Process buffer with BLOCKSIZE bytes. Note that diff --git a/lib/sha512.c b/lib/sha512.c index e175e705f5..e854951eb3 100644 --- a/lib/sha512.c +++ b/lib/sha512.c @@ -36,18 +36,11 @@ # include "unlocked-io.h" #endif +#include <byteswap.h> #ifdef WORDS_BIGENDIAN # define SWAP(n) (n) #else -# define SWAP(n) \ - u64or (u64or (u64or (u64shl (n, 56), \ - u64shl (u64and (n, u64lo (0x0000ff00)), 40)), \ - u64or (u64shl (u64and (n, u64lo (0x00ff0000)), 24), \ - u64shl (u64and (n, u64lo (0xff000000)), 8))), \ - u64or (u64or (u64and (u64shr (n, 8), u64lo (0xff000000)), \ - u64and (u64shr (n, 24), u64lo (0x00ff0000))), \ - u64or (u64and (u64shr (n, 40), u64lo (0x0000ff00)), \ - u64shr (n, 56)))) +# define SWAP(n) bswap_64 (n) #endif #define BLOCKSIZE 32768 @@ -216,6 +209,14 @@ shaxxx_stream (FILE *stream, char const *alg, void *resblock, /* Read block. Take care for partial reads. */ while (1) { + /* Either process a partial fread() from this loop, + or the fread() in afalg_stream may have gotten EOF. + We need to avoid a subsequent fread() as EOF may + not be sticky. For details of such systems, see: + https://sourceware.org/bugzilla/show_bug.cgi?id=1190 */ + if (feof (stream)) + goto process_partial_block; + n = fread (buffer + sum, 1, BLOCKSIZE - sum, stream); sum += n; @@ -235,12 +236,6 @@ shaxxx_stream (FILE *stream, char const *alg, void *resblock, } goto process_partial_block; } - - /* We've read at least one byte, so ignore errors. But always - check for EOF, since feof may be true even though N > 0. - Otherwise, we could end up calling fread after EOF. */ - if (feof (stream)) - goto process_partial_block; } /* Process buffer with BLOCKSIZE bytes. Note that diff --git a/lib/time.in.h b/lib/time.in.h index a2dca89340..cda16c69d2 100644 --- a/lib/time.in.h +++ b/lib/time.in.h @@ -212,7 +212,7 @@ _GL_CXXALIASWARN (gmtime_r); # define localtime rpl_localtime # endif _GL_FUNCDECL_RPL (localtime, struct tm *, (time_t const *__timer) - _GL_ARG_NONNULL ((1))); + _GL_ARG_NONNULL ((1))); _GL_CXXALIAS_RPL (localtime, struct tm *, (time_t const *__timer)); # else _GL_CXXALIAS_SYS (localtime, struct tm *, (time_t const *__timer)); diff --git a/m4/getloadavg.m4 b/m4/getloadavg.m4 index d3a8910ecf..c9f5a6da5d 100644 --- a/m4/getloadavg.m4 +++ b/m4/getloadavg.m4 @@ -108,7 +108,7 @@ AC_DEFUN([gl_PREREQ_GETLOADAVG], [ # Figure out what our getloadavg.c needs. -AC_CHECK_HEADERS_ONCE([sys/param.h]) +AC_CHECK_HEADERS_ONCE([sys/param.h unistd.h]) # On HPUX9, an unprivileged user can get load averages this way. if test $gl_func_getloadavg_done = no; then diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4 index 736e421016..5f07855acf 100644 --- a/m4/gnulib-common.m4 +++ b/m4/gnulib-common.m4 @@ -354,16 +354,16 @@ AC_DEFUN([AC_C_RESTRICT], for ac_kw in __restrict __restrict__ _Restrict restrict; do AC_COMPILE_IFELSE( [AC_LANG_PROGRAM( - [[typedef int *int_ptr; - int foo (int_ptr $ac_kw ip) { return ip[0]; } - int bar (int [$ac_kw]); /* Catch GCC bug 14050. */ - int bar (int ip[$ac_kw]) { return ip[0]; } - ]], - [[int s[1]; - int *$ac_kw t = s; - t[0] = 0; - return foo (t) + bar (t); - ]])], + [[typedef int *int_ptr; + int foo (int_ptr $ac_kw ip) { return ip[0]; } + int bar (int [$ac_kw]); /* Catch GCC bug 14050. */ + int bar (int ip[$ac_kw]) { return ip[0]; } + ]], + [[int s[1]; + int *$ac_kw t = s; + t[0] = 0; + return foo (t) + bar (t); + ]])], [ac_cv_c_restrict=$ac_kw]) test "$ac_cv_c_restrict" != no && break done diff --git a/m4/manywarnings.m4 b/m4/manywarnings.m4 index 60c0e4051c..925c40e139 100644 --- a/m4/manywarnings.m4 +++ b/m4/manywarnings.m4 @@ -1,4 +1,4 @@ -# manywarnings.m4 serial 14 +# manywarnings.m4 serial 15 dnl Copyright (C) 2008-2018 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -108,12 +108,11 @@ m4_defun([gl_MANYWARN_ALL_GCC(C)], # comm -3 \ # <((sed -n 's/^ *\(-[^ 0-9][^ ]*\) .*/\1/p' manywarnings.m4; \ # awk '/^[^#]/ {print $1}' ../build-aux/gcc-warning.spec) | sort) \ - # <(gcc --help=warnings | sed -n 's/^ \(-[^ ]*\) .*/\1/p' | sort) + # <(LC_ALL=C gcc --help=warnings | sed -n 's/^ \(-[^ ]*\) .*/\1/p' | sort) gl_manywarn_set= for gl_manywarn_item in -fno-common \ -W \ - -Wabi \ -Waddress \ -Waggressive-loop-optimizations \ -Wall \ @@ -128,7 +127,6 @@ m4_defun([gl_MANYWARN_ALL_GCC(C)], -Wcast-align=strict \ -Wcast-function-type \ -Wchar-subscripts \ - -Wchkp \ -Wclobbered \ -Wcomment \ -Wcomments \ @@ -176,7 +174,6 @@ m4_defun([gl_MANYWARN_ALL_GCC(C)], -Wint-to-pointer-cast \ -Winvalid-memory-model \ -Winvalid-pch \ - -Wjump-misses-init \ -Wlogical-not-parentheses \ -Wlogical-op \ -Wmain \ diff --git a/m4/pthread_sigmask.m4 b/m4/pthread_sigmask.m4 index a33b433c0e..585b80a40f 100644 --- a/m4/pthread_sigmask.m4 +++ b/m4/pthread_sigmask.m4 @@ -124,41 +124,41 @@ AC_DEFUN([gl_FUNC_PTHREAD_SIGMASK], case " $LIBS " in *' -pthread '*) ;; *' -lpthread '*) ;; - *) - AC_CACHE_CHECK([whether pthread_sigmask works without -lpthread], - [gl_cv_func_pthread_sigmask_in_libc_works], - [ - AC_RUN_IFELSE( - [AC_LANG_SOURCE([[ - #include <pthread.h> - #include <signal.h> - #include <stddef.h> - int main () - { - sigset_t set; - sigemptyset (&set); - return pthread_sigmask (1729, &set, NULL) != 0; - }]])], - [gl_cv_func_pthread_sigmask_in_libc_works=no], - [gl_cv_func_pthread_sigmask_in_libc_works=yes], - [ - changequote(,)dnl - case "$host_os" in - freebsd* | hpux* | solaris | solaris2.[2-9]*) - gl_cv_func_pthread_sigmask_in_libc_works="guessing no";; - *) - gl_cv_func_pthread_sigmask_in_libc_works="guessing yes";; - esac - changequote([,])dnl - ]) - ]) - case "$gl_cv_func_pthread_sigmask_in_libc_works" in - *no) - REPLACE_PTHREAD_SIGMASK=1 - AC_DEFINE([PTHREAD_SIGMASK_INEFFECTIVE], [1], - [Define to 1 if pthread_sigmask may return 0 and have no effect.]) - ;; - esac;; + *) + AC_CACHE_CHECK([whether pthread_sigmask works without -lpthread], + [gl_cv_func_pthread_sigmask_in_libc_works], + [ + AC_RUN_IFELSE( + [AC_LANG_SOURCE([[ + #include <pthread.h> + #include <signal.h> + #include <stddef.h> + int main () + { + sigset_t set; + sigemptyset (&set); + return pthread_sigmask (1729, &set, NULL) != 0; + }]])], + [gl_cv_func_pthread_sigmask_in_libc_works=no], + [gl_cv_func_pthread_sigmask_in_libc_works=yes], + [ + changequote(,)dnl + case "$host_os" in + freebsd* | hpux* | solaris | solaris2.[2-9]*) + gl_cv_func_pthread_sigmask_in_libc_works="guessing no";; + *) + gl_cv_func_pthread_sigmask_in_libc_works="guessing yes";; + esac + changequote([,])dnl + ]) + ]) + case "$gl_cv_func_pthread_sigmask_in_libc_works" in + *no) + REPLACE_PTHREAD_SIGMASK=1 + AC_DEFINE([PTHREAD_SIGMASK_INEFFECTIVE], [1], + [Define to 1 if pthread_sigmask may return 0 and have no effect.]) + ;; + esac;; esac fi diff --git a/m4/vararrays.m4 b/m4/vararrays.m4 index 329eb490c3..17563b519b 100644 --- a/m4/vararrays.m4 +++ b/m4/vararrays.m4 @@ -18,44 +18,44 @@ AC_DEFUN([AC_C_VARARRAYS], ac_cv_c_vararrays, [AC_EGREP_CPP([defined], [#ifdef __STDC_NO_VLA__ - defined - #endif + defined + #endif ], [ac_cv_c_vararrays='no: __STDC_NO_VLA__ is defined'], [AC_COMPILE_IFELSE( - [AC_LANG_PROGRAM( - [[/* Test for VLA support. This test is partly inspired - from examples in the C standard. Use at least two VLA - functions to detect the GCC 3.4.3 bug described in: - https://lists.gnu.org/r/bug-gnulib/2014-08/msg00014.html - */ - #ifdef __STDC_NO_VLA__ - syntax error; - #else - extern int n; - int B[100]; - int fvla (int m, int C[m][m]); + [AC_LANG_PROGRAM( + [[/* Test for VLA support. This test is partly inspired + from examples in the C standard. Use at least two VLA + functions to detect the GCC 3.4.3 bug described in: + https://lists.gnu.org/r/bug-gnulib/2014-08/msg00014.html + */ + #ifdef __STDC_NO_VLA__ + syntax error; + #else + extern int n; + int B[100]; + int fvla (int m, int C[m][m]); - int - simple (int count, int all[static count]) - { - return all[count - 1]; - } + int + simple (int count, int all[static count]) + { + return all[count - 1]; + } - int - fvla (int m, int C[m][m]) - { - typedef int VLA[m][m]; - VLA x; - int D[m]; - static int (*q)[m] = &B; - int (*s)[n] = q; - return C && &x[0][0] == &D[0] && &D[0] == s[0]; - } - #endif - ]])], - [ac_cv_c_vararrays=yes], - [ac_cv_c_vararrays=no])])]) + int + fvla (int m, int C[m][m]) + { + typedef int VLA[m][m]; + VLA x; + int D[m]; + static int (*q)[m] = &B; + int (*s)[n] = q; + return C && &x[0][0] == &D[0] && &D[0] == s[0]; + } + #endif + ]])], + [ac_cv_c_vararrays=yes], + [ac_cv_c_vararrays=no])])]) if test "$ac_cv_c_vararrays" = yes; then dnl This is for compatibility with Autoconf 2.61-2.69. AC_DEFINE([HAVE_C_VARARRAYS], 1, commit 2e2811865f0adb6658a87d3581a2dc3a9022f451 Author: Paul Eggert <eggert@cs.ucla.edu> Date: Fri Jun 29 17:07:38 2018 -0700 unbind_to performance tuning * src/alloc.c (which_symbols): * src/dispnew.c (Fredisplay): * src/editfns.c (Fsubst_char_in_region): * src/fileio.c (Fdo_auto_save): * src/indent.c (Fvertical_motion): * src/keymap.c (Fcurrent_active_maps): * src/lread.c (Feval_buffer): * src/minibuf.c (get_minibuffer): * src/sysdep.c (system_process_attributes): * src/textprop.c (Fnext_single_char_property_change) (Fprevious_single_char_property_change): * src/window.c (Fscroll_other_window, Fscroll_other_window_down): * src/xdisp.c (Fformat_mode_line): Help the compiler eliminate tail recursion in call to unbind_to. * src/coding.c (decode_coding_gap): Omit unnecessary unbind_to, as we’re about to call unbind_to anyway. * src/coding.c (Fread_coding_system): * src/eval.c (eval_sub): * src/xdisp.c (handle_single_display_spec, decode_mode_spec): * src/xselect.c (x_get_local_selection): Avoid need to save a machine register when calling unbind_to. * src/minibuf.c (Ftry_completion, Fall_completions): Omit unnecessary assignment. diff --git a/src/alloc.c b/src/alloc.c index cc846fd38e..8764591336 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -7206,8 +7206,7 @@ which_symbols (Lisp_Object obj, EMACS_INT find_max) } out: - unbind_to (gc_count, Qnil); - return found; + return unbind_to (gc_count, found); } #ifdef SUSPICIOUS_OBJECT_CHECKING diff --git a/src/coding.c b/src/coding.c index 32a9df1c53..8ce902b06d 100644 --- a/src/coding.c +++ b/src/coding.c @@ -8005,7 +8005,6 @@ decode_coding_gap (struct coding_system *coding, ptrdiff_t prev_Z = Z, prev_Z_BYTE = Z_BYTE; Lisp_Object val; Lisp_Object undo_list = BVAR (current_buffer, undo_list); - ptrdiff_t count1 = SPECPDL_INDEX (); record_unwind_protect (coding_restore_undo_list, Fcons (undo_list, Fcurrent_buffer ())); @@ -8016,7 +8015,6 @@ decode_coding_gap (struct coding_system *coding, CHECK_NATNUM (val); coding->produced_char += Z - prev_Z; coding->produced += Z_BYTE - prev_Z_BYTE; - unbind_to (count1, Qnil); } unbind_to (count, Qnil); @@ -8545,7 +8543,7 @@ are lower-case). */) val = Fcompleting_read (prompt, Vcoding_system_alist, Qnil, Qt, Qnil, Qcoding_system_history, default_coding_system, Qnil); - unbind_to (count, Qnil); + val = unbind_to (count, val); return (SCHARS (val) == 0 ? Qnil : Fintern (val, Qnil)); } diff --git a/src/dispnew.c b/src/dispnew.c index 46e0c83ef6..fc6f9e2263 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -5828,8 +5828,7 @@ immediately by pending input. */) if (!NILP (force) && !redisplay_dont_pause) specbind (Qredisplay_dont_pause, Qt); redisplay_preserve_echo_area (2); - unbind_to (count, Qnil); - return Qt; + return unbind_to (count, Qt); } diff --git a/src/editfns.c b/src/editfns.c index 88dfba1f91..efe83e811b 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -3531,8 +3531,7 @@ Both characters must have the same length of multi-byte form. */) update_compositions (changed, last_changed, CHECK_ALL); } - unbind_to (count, Qnil); - return Qnil; + return unbind_to (count, Qnil); } diff --git a/src/eval.c b/src/eval.c index 9e0fabdcfb..c16a267bc5 100644 --- a/src/eval.c +++ b/src/eval.c @@ -2366,7 +2366,7 @@ eval_sub (Lisp_Object form) specbind (Qlexical_binding, NILP (Vinternal_interpreter_environment) ? Qnil : Qt); exp = apply1 (Fcdr (fun), original_args); - unbind_to (count1, Qnil); + exp = unbind_to (count1, exp); val = eval_sub (exp); } else if (EQ (funcar, Qlambda) diff --git a/src/fileio.c b/src/fileio.c index 7f678dd821..5a1c7ae10e 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -5767,8 +5767,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) Vquit_flag = oquit; /* This restores the message-stack status. */ - unbind_to (count, Qnil); - return Qnil; + return unbind_to (count, Qnil); } DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved, diff --git a/src/indent.c b/src/indent.c index 9c751bc30b..a86db71642 100644 --- a/src/indent.c +++ b/src/indent.c @@ -2356,9 +2356,7 @@ whether or not it is currently displayed in some window. */) bidi_unshelve_cache (itdata, 0); } - unbind_to (count, Qnil); - - return make_number (it.vpos); + return unbind_to (count, make_number (it.vpos)); } diff --git a/src/keymap.c b/src/keymap.c index 982c014f01..fcee788e6f 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1608,9 +1608,7 @@ like in the respective argument of `key-binding'. */) keymaps = Fcons (otlp, keymaps); } - unbind_to (count, Qnil); - - return keymaps; + return unbind_to (count, keymaps); } /* GC is possible in this function if it autoloads a keymap. */ diff --git a/src/lread.c b/src/lread.c index 4229ff568b..d4e5be21b4 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2143,9 +2143,7 @@ This function preserves the position of point. */) BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf))); readevalloop (buf, 0, filename, !NILP (printflag), unibyte, Qnil, Qnil, Qnil); - unbind_to (count, Qnil); - - return Qnil; + return unbind_to (count, Qnil); } DEFUN ("eval-region", Feval_region, Seval_region, 2, 4, "r", diff --git a/src/minibuf.c b/src/minibuf.c index e18c99bef2..abc4866380 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -755,7 +755,7 @@ get_minibuffer (EMACS_INT depth) call0 (intern ("minibuffer-inactive-mode")); else Fkill_all_local_variables (); - unbind_to (count, Qnil); + buf = unbind_to (count, buf); } return buf; @@ -1274,11 +1274,12 @@ is used to further constrain the set of candidates. */) for (regexps = Vcompletion_regexp_list; CONSP (regexps); regexps = XCDR (regexps)) { - if (bindcount < 0) { - bindcount = SPECPDL_INDEX (); - specbind (Qcase_fold_search, - completion_ignore_case ? Qt : Qnil); - } + if (bindcount < 0) + { + bindcount = SPECPDL_INDEX (); + specbind (Qcase_fold_search, + completion_ignore_case ? Qt : Qnil); + } tem = Fstring_match (XCAR (regexps), eltstring, zero); if (NILP (tem)) break; @@ -1377,10 +1378,8 @@ is used to further constrain the set of candidates. */) } } - if (bindcount >= 0) { + if (bindcount >= 0) unbind_to (bindcount, Qnil); - bindcount = -1; - } if (NILP (bestmatch)) return Qnil; /* No completions found. */ @@ -1534,11 +1533,12 @@ with a space are ignored unless STRING itself starts with a space. */) for (regexps = Vcompletion_regexp_list; CONSP (regexps); regexps = XCDR (regexps)) { - if (bindcount < 0) { - bindcount = SPECPDL_INDEX (); - specbind (Qcase_fold_search, - completion_ignore_case ? Qt : Qnil); - } + if (bindcount < 0) + { + bindcount = SPECPDL_INDEX (); + specbind (Qcase_fold_search, + completion_ignore_case ? Qt : Qnil); + } tem = Fstring_match (XCAR (regexps), eltstring, zero); if (NILP (tem)) break; @@ -1556,10 +1556,11 @@ with a space are ignored unless STRING itself starts with a space. */) tem = Fcommandp (elt, Qnil); else { - if (bindcount >= 0) { - unbind_to (bindcount, Qnil); - bindcount = -1; - } + if (bindcount >= 0) + { + unbind_to (bindcount, Qnil); + bindcount = -1; + } tem = type == 3 ? call2 (predicate, elt, HASH_VALUE (XHASH_TABLE (collection), idx - 1)) @@ -1572,10 +1573,8 @@ with a space are ignored unless STRING itself starts with a space. */) } } - if (bindcount >= 0) { + if (bindcount >= 0) unbind_to (bindcount, Qnil); - bindcount = -1; - } return Fnreverse (allmatches); } diff --git a/src/sysdep.c b/src/sysdep.c index c59034ce5c..231b11614f 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -3592,8 +3592,7 @@ system_process_attributes (Lisp_Object pid) Vlocale_coding_system, 0); attrs = Fcons (Fcons (Qargs, decoded_cmd), attrs); } - unbind_to (count, Qnil); - return attrs; + return unbind_to (count, attrs); } #elif defined __FreeBSD__ diff --git a/src/textprop.c b/src/textprop.c index 984f2e6640..f7e69f30ea 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -826,7 +826,7 @@ last valid position in OBJECT. */) break; } - unbind_to (count, Qnil); + position = unbind_to (count, position); } return position; @@ -920,7 +920,7 @@ first valid position in OBJECT. */) } } - unbind_to (count, Qnil); + position = unbind_to (count, position); } return position; diff --git a/src/window.c b/src/window.c index 81fd7f2b47..a97f1dd3ef 100644 --- a/src/window.c +++ b/src/window.c @@ -5771,8 +5771,7 @@ which see. */) { ptrdiff_t count = SPECPDL_INDEX (); scroll_command (Fother_window_for_scrolling (), arg, 1); - unbind_to (count, Qnil); - return Qnil; + return unbind_to (count, Qnil); } DEFUN ("scroll-other-window-down", Fscroll_other_window_down, @@ -5783,8 +5782,7 @@ For more details, see the documentation for `scroll-other-window'. */) { ptrdiff_t count = SPECPDL_INDEX (); scroll_command (Fother_window_for_scrolling (), arg, -1); - unbind_to (count, Qnil); - return Qnil; + return unbind_to (count, Qnil); } DEFUN ("scroll-left", Fscroll_left, Sscroll_left, 0, 2, "^P\np", diff --git a/src/xdisp.c b/src/xdisp.c index 3406c2fb46..e383b3b0d1 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -4937,7 +4937,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, specbind (Qposition, make_number (CHARPOS (*position))); specbind (Qbuffer_position, make_number (bufpos)); form = safe_eval (form); - unbind_to (count, Qnil); + form = unbind_to (count, form); } if (NILP (form)) @@ -5000,7 +5000,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, specbind (Qheight, face->lface[LFACE_HEIGHT_INDEX]); value = safe_eval (it->font_height); - unbind_to (count, Qnil); + value = unbind_to (count, value); if (NUMBERP (value)) new_height = XFLOATINT (value); @@ -24183,8 +24183,7 @@ are the selected window and the WINDOW's buffer). */) empty_unibyte_string); } - unbind_to (count, Qnil); - return str; + return unbind_to (count, str); } /* Write a null-terminated, right justified decimal representation of @@ -24804,7 +24803,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, if (STRINGP (curdir)) val = call1 (intern ("file-remote-p"), curdir); - unbind_to (count, Qnil); + val = unbind_to (count, val); if (NILP (val)) return "-"; diff --git a/src/xselect.c b/src/xselect.c index ecf59df294..1f51be4c52 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -387,7 +387,7 @@ x_get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type, XCAR (XCDR (local_value))); else value = Qnil; - unbind_to (count, Qnil); + value = unbind_to (count, value); } /* Make sure this value is of a type that we could transmit commit e980a3c992c13178052f5994b063be58a2f95a2d Author: Paul Eggert <eggert@cs.ucla.edu> Date: Fri Jun 29 11:14:36 2018 -0700 * src/lisp.h: Omit obsolete comment re bytecode stack. diff --git a/src/lisp.h b/src/lisp.h index 56ad8b814b..b2449cb87d 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3044,15 +3044,13 @@ extern void defvar_kboard (struct Lisp_Kboard_Objfwd *, const char *, int); } while (false) -/* Elisp uses several stacks: - - the C stack. - - the bytecode stack: used internally by the bytecode interpreter. - Allocated from the C stack. - - The specpdl stack: keeps track of active unwind-protect and - dynamic-let-bindings. Allocated from the `specpdl' array, a manually - managed stack. - - The handler stack: keeps track of active catch tags and condition-case - handlers. Allocated in a manually managed stack implemented by a +/* Elisp uses multiple stacks: + - The C stack. + - The specpdl stack keeps track of backtraces, unwind-protects and + dynamic let-bindings. It is allocated from the 'specpdl' array, + a manually managed stack. + - The handler stack keeps track of active catch tags and condition-case + handlers. It is allocated in a manually managed stack implemented by a doubly-linked list allocated via xmalloc and never freed. */ /* Structure for recording Lisp call stack for backtrace purposes. */ @@ -3131,7 +3129,7 @@ SPECPDL_INDEX (void) control structures. A struct handler contains all the information needed to restore the state of the interpreter after a non-local jump. - handler structures are chained together in a doubly linked list; the `next' + Handler structures are chained together in a doubly linked list; the `next' member points to the next outer catchtag and the `nextfree' member points in the other direction to the next inner element (which is typically the next free element since we mostly use it on the deepest handler). commit 08594a975a3d95b1c1eae38af608e487e2edfafc Author: Andreas Schwab <schwab@linux-m68k.org> Date: Fri Jun 29 17:33:26 2018 +0200 * lisp/url/url-http.el (url-http-create-request): Doc fix. diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index 817c5ce3b3..6b5749e1bc 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -285,8 +285,8 @@ The string is based on `url-privacy-level' and `url-user-agent'." (if ua-string (format "User-Agent: %s\r\n" (string-trim ua-string)) ""))) (defun url-http-create-request () - "Create an HTTP request for `url-http-target-url', using `url-http-referer' -as the Referer-header (subject to `url-privacy-level'." + "Create an HTTP request for `url-http-target-url'. +Use `url-http-referer' as the Referer-header (subject to `url-privacy-level')." (let* ((extra-headers) (request nil) (no-cache (cdr-safe (assoc "Pragma" url-http-extra-headers))) commit 84613dae5c34ea742dd9a3e56f5acb55f604b483 Author: Andreas Schwab <schwab@linux-m68k.org> Date: Fri Jun 29 17:24:31 2018 +0200 Use a non-proxy request when retrieving https URLs via a proxy * lisp/url/url-http.el (url-https-proxy-after-change-function): Bind url-http-proxy to nil around url-http-create-request. diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index 53798f77c3..817c5ce3b3 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -1412,7 +1412,9 @@ The return value of this function is the retrieval buffer." 'url-http-wait-for-headers-change-function) (set-process-filter tls-connection 'url-http-generic-filter) (process-send-string tls-connection - (url-http-create-request))) + ;; Use the non-proxy form of the request + (let (url-http-proxy) + (url-http-create-request)))) (gnutls-error (url-http-activate-callback) (error "gnutls-error: %s" e)) commit eec71ebdb50c3110bb747db57c7d7f04b6d14ad1 Author: Eli Zaretskii <eliz@gnu.org> Date: Fri Jun 29 16:55:20 2018 +0300 Speed up replace-buffer-contents * src/editfns.c (EXTRA_CONTEXT_FIELDS): Add a_unibyte and b_unibyte members. (rbc_quitcounter): New static variable. (Freplace_buffer_contents): Initialize a_unibyte, b_unibyte, and rbc_quitcounter. Inhibit modification hooks if they were not already inhibited. Use rarely_quit to allow user to quit, to avoid calling maybe_quit too frequently (which hurts performance). Remove redundant assertions (which hurt performance too much). Call signal_after_change and update_compositions after all the changes are done. (buffer_chars_equal): Remove redundant assertions (which hurt performance). Avoid using BUF_FETCH_CHAR_AS_MULTIBYTE, which hurts performance by referencing Lisp symbols; instead, use lower-level macros with explicit tests to select which macro to use. (Bug#31888) diff --git a/src/editfns.c b/src/editfns.c index 4fba68692b..4d3c838d2f 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -3115,6 +3115,9 @@ determines whether case is significant or ignored. */) #undef ELEMENT #undef EQUAL +/* Counter used to rarely_quit in replace-buffer-contents. */ +static unsigned short rbc_quitcounter; + #define XVECREF_YVECREF_EQUAL(ctx, xoff, yoff) \ buffer_chars_equal ((ctx), (xoff), (yoff)) @@ -3124,6 +3127,9 @@ determines whether case is significant or ignored. */) /* Buffers to compare. */ \ struct buffer *buffer_a; \ struct buffer *buffer_b; \ + /* Whether each buffer is unibyte/plain-ASCII or not. */ \ + bool a_unibyte; \ + bool b_unibyte; \ /* Bit vectors recording for each character whether it was deleted or inserted. */ \ unsigned char *deletions; \ @@ -3202,6 +3208,8 @@ differences between the two buffers. */) struct context ctx = { .buffer_a = a, .buffer_b = b, + .a_unibyte = BUF_ZV (a) == BUF_ZV_BYTE (a), + .b_unibyte = BUF_ZV (b) == BUF_ZV_BYTE (b), .deletions = SAFE_ALLOCA (del_bytes), .insertions = SAFE_ALLOCA (ins_bytes), .fdiag = buffer + size_b + 1, @@ -3218,10 +3226,25 @@ differences between the two buffers. */) early. */ eassert (! early_abort); + rbc_quitcounter = 0; + Fundo_boundary (); + bool modification_hooks_inhibited = false; ptrdiff_t count = SPECPDL_INDEX (); record_unwind_protect (save_excursion_restore, save_excursion_save ()); + /* We are going to make a lot of small modifications, and having the + modification hooks called for each of them will slow us down. + Instead, we announce a single modification for the entire + modified region. But don't do that if the caller inhibited + modification hooks, because then they don't want that. */ + if (!inhibit_modification_hooks) + { + prepare_to_modify_buffer (BEGV, ZV, NULL); + specbind (Qinhibit_modification_hooks, Qt); + modification_hooks_inhibited = true; + } + ptrdiff_t i = size_a; ptrdiff_t j = size_b; /* Walk backwards through the lists of changes. This was also @@ -3230,15 +3253,13 @@ differences between the two buffers. */) while (i >= 0 || j >= 0) { /* Allow the user to quit if this gets too slow. */ - maybe_quit (); + rarely_quit (++rbc_quitcounter); /* Check whether there is a change (insertion or deletion) before the current position. */ if ((i > 0 && bit_is_set (ctx.deletions, i - 1)) || (j > 0 && bit_is_set (ctx.insertions, j - 1))) { - maybe_quit (); - ptrdiff_t end_a = min_a + i; ptrdiff_t end_b = min_b + j; /* Find the beginning of the current change run. */ @@ -3246,14 +3267,13 @@ differences between the two buffers. */) --i; while (j > 0 && bit_is_set (ctx.insertions, j - 1)) --j; + + rarely_quit (rbc_quitcounter++); + ptrdiff_t beg_a = min_a + i; ptrdiff_t beg_b = min_b + j; - eassert (beg_a >= BEGV); - eassert (beg_b >= BUF_BEGV (b)); eassert (beg_a <= end_a); eassert (beg_b <= end_b); - eassert (end_a <= ZV); - eassert (end_b <= BUF_ZV (b)); eassert (beg_a < end_a || beg_b < end_b); if (beg_a < end_a) del_range (beg_a, end_a); @@ -3269,6 +3289,13 @@ differences between the two buffers. */) } unbind_to (count, Qnil); SAFE_FREE (); + rbc_quitcounter = 0; + + if (modification_hooks_inhibited) + { + signal_after_change (BEGV, size_a, ZV - BEGV); + update_compositions (BEGV, ZV, CHECK_BORDER); + } return Qnil; } @@ -3296,39 +3323,45 @@ bit_is_set (const unsigned char *a, ptrdiff_t i) /* Return true if the characters at position POS_A of buffer CTX->buffer_a and at position POS_B of buffer CTX->buffer_b are equal. POS_A and POS_B are zero-based. Text properties are - ignored. */ + ignored. + + Implementation note: this function is called inside the inner-most + loops of compareseq, so it absolutely must be optimized for speed, + every last bit of it. E.g., each additional use of BEGV or such + likes will slow down replace-buffer-contents by dozens of percents, + because builtin_lisp_symbol will be called one more time in the + innermost loop. */ static bool buffer_chars_equal (struct context *ctx, ptrdiff_t pos_a, ptrdiff_t pos_b) { - eassert (pos_a >= 0); pos_a += BUF_BEGV (ctx->buffer_a); - eassert (pos_a >= BUF_BEGV (ctx->buffer_a)); - eassert (pos_a < BUF_ZV (ctx->buffer_a)); - - eassert (pos_b >= 0); pos_b += BUF_BEGV (ctx->buffer_b); - eassert (pos_b >= BUF_BEGV (ctx->buffer_b)); - eassert (pos_b < BUF_ZV (ctx->buffer_b)); - - bool a_unibyte = BUF_ZV (ctx->buffer_a) == BUF_ZV_BYTE (ctx->buffer_a); - bool b_unibyte = BUF_ZV (ctx->buffer_b) == BUF_ZV_BYTE (ctx->buffer_b); /* Allow the user to escape out of a slow compareseq call. */ - maybe_quit (); + rarely_quit (++rbc_quitcounter); ptrdiff_t bpos_a = - a_unibyte ? pos_a : buf_charpos_to_bytepos (ctx->buffer_a, pos_a); + ctx->a_unibyte ? pos_a : buf_charpos_to_bytepos (ctx->buffer_a, pos_a); ptrdiff_t bpos_b = - b_unibyte ? pos_b : buf_charpos_to_bytepos (ctx->buffer_b, pos_b); + ctx->b_unibyte ? pos_b : buf_charpos_to_bytepos (ctx->buffer_b, pos_b); - if (a_unibyte && b_unibyte) + /* We make the below a series of specific test to avoid using + BUF_FETCH_CHAR_AS_MULTIBYTE, which references Lisp symbols, and + is therefore significantly slower (see the note in the commentary + to this function). */ + if (ctx->a_unibyte && ctx->b_unibyte) return BUF_FETCH_BYTE (ctx->buffer_a, bpos_a) == BUF_FETCH_BYTE (ctx->buffer_b, bpos_b); - - return BUF_FETCH_CHAR_AS_MULTIBYTE (ctx->buffer_a, bpos_a) - == BUF_FETCH_CHAR_AS_MULTIBYTE (ctx->buffer_b, bpos_b); + if (ctx->a_unibyte && !ctx->b_unibyte) + return UNIBYTE_TO_CHAR (BUF_FETCH_BYTE (ctx->buffer_a, bpos_a)) + == BUF_FETCH_MULTIBYTE_CHAR (ctx->buffer_b, bpos_b); + if (!ctx->a_unibyte && ctx->b_unibyte) + return BUF_FETCH_MULTIBYTE_CHAR (ctx->buffer_a, bpos_a) + == UNIBYTE_TO_CHAR (BUF_FETCH_BYTE (ctx->buffer_b, bpos_b)); + return BUF_FETCH_MULTIBYTE_CHAR (ctx->buffer_a, bpos_a) + == BUF_FETCH_MULTIBYTE_CHAR (ctx->buffer_b, bpos_b); } commit 45390596e6d59e14c8f9c0596aeb4f4141d0c1e8 Author: Michael Albinus <michael.albinus@gmx.de> Date: Fri Jun 29 10:17:46 2018 +0200 Sync with Tramp 2.4.0 * doc/misc/trampver.texi: * lisp/net/trampver.el: Change version to "2.4.0". * lisp/net/tramp-gvfs.el (tramp-gvfs-handler-mounted-unmounted): Ignore unknown GVFS methods. * test/lisp/net/tramp-tests.el (tramp-test42-asynchronous-requests): Tag as :unstable. diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index eef2d9b690..6d02b043b6 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -8,7 +8,7 @@ @c In the Tramp GIT, the version number is auto-frobbed from @c configure.ac, so you should edit that file and run @c "autoconf && ./configure" to change the version number. -@set trampver 2.4.0-pre +@set trampver 2.4.0 @c Other flags from configuration @set instprefix /usr/local diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index a30d7ef713..1f40339c27 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1553,18 +1553,19 @@ file-notify events." user (url-user uri) host (url-host uri) port (url-portspec uri))) - (with-parsed-tramp-file-name - (tramp-make-tramp-file-name method user domain host port "") nil - (tramp-message - v 6 "%s %s" - signal-name (tramp-gvfs-stringify-dbus-message mount-info)) - (tramp-flush-file-property v "/" "list-mounts") - (if (string-equal (downcase signal-name) "unmounted") - (tramp-flush-file-properties v "/") - ;; Set mountpoint and location. - (tramp-set-file-property v "/" "fuse-mountpoint" fuse-mountpoint) - (tramp-set-connection-property - v "default-location" default-location))))))) + (when (member method tramp-gvfs-methods) + (with-parsed-tramp-file-name + (tramp-make-tramp-file-name method user domain host port "") nil + (tramp-message + v 6 "%s %s" + signal-name (tramp-gvfs-stringify-dbus-message mount-info)) + (tramp-flush-file-property v "/" "list-mounts") + (if (string-equal (downcase signal-name) "unmounted") + (tramp-flush-file-properties v "/") + ;; Set mountpoint and location. + (tramp-set-file-property v "/" "fuse-mountpoint" fuse-mountpoint) + (tramp-set-connection-property + v "default-location" default-location)))))))) (when tramp-gvfs-enabled (dbus-register-signal diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 46af51ebfd..0b83afcc59 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -7,7 +7,7 @@ ;; Maintainer: Michael Albinus <michael.albinus@gmx.de> ;; Keywords: comm, processes ;; Package: tramp -;; Version: 2.4.0-pre +;; Version: 2.4.0 ;; This file is part of GNU Emacs. @@ -33,7 +33,7 @@ ;; should be changed only there. ;;;###tramp-autoload -(defconst tramp-version "2.4.0-pre" +(defconst tramp-version "2.4.0" "This version of Tramp.") ;;;###tramp-autoload @@ -55,7 +55,7 @@ ;; Check for Emacs version. (let ((x (if (>= emacs-major-version 24) "ok" - (format "Tramp 2.4.0-pre is not fit for %s" + (format "Tramp 2.4.0 is not fit for %s" (replace-regexp-in-string "\n" "" (emacs-version)))))) (unless (string-equal "ok" x) (error "%s" x))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index f2d9b0ab47..504b0aae78 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4883,7 +4883,7 @@ Use the `ls' command." "Check parallel asynchronous requests. Such requests could arrive from timers, process filters and process sentinels. They shall not disturb each other." - :tags '(:expensive-test) + :tags '(:expensive-test :unstable) (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) commit b2c854a0e1364eab11151da7fa7558053bc834c4 Author: Paul Eggert <eggert@cs.ucla.edu> Date: Fri Jun 29 00:29:13 2018 -0700 * src/lisp.h: Add comment (Bug#31996#25). diff --git a/src/lisp.h b/src/lisp.h index cf7b8c0ebc..6203a746a3 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3050,6 +3050,8 @@ enum specbind_tag { union specbinding { + /* Aligning similar members consistently might help efficiency slightly + (Bug#31996#25). */ ENUM_BF (specbind_tag) kind : CHAR_BIT; struct { ENUM_BF (specbind_tag) kind : CHAR_BIT; commit 591bb3d90018ebbcf79e6d496ed73ef396a58887 Author: Noam Postavsky <npostavs@gmail.com> Date: Fri May 11 21:56:56 2018 -0400 Let ediff '=' compare against ancestor buffer (Bug#11320) * lisp/vc/ediff-util.el (ediff-inferior-compare-regions): Ask user whether to compare against the ancestor or merge buffer. Use read-multiple-choice for A vs B buffer query. diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el index 104a578268..b1652e7efd 100644 --- a/lisp/vc/ediff-util.el +++ b/lisp/vc/ediff-util.el @@ -3546,25 +3546,19 @@ Ediff Control Panel to restore highlighting." (ediff-paint-background-regions 'unhighlight) (cond ((ediff-merge-job) - (setq bufB ediff-buffer-C) ;; ask which buffer to compare to the merge buffer - (while (cond ((eq answer ?A) - (setq bufA ediff-buffer-A - possibilities '(?B)) - nil) - ((eq answer ?B) - (setq bufA ediff-buffer-B - possibilities '(?A)) - nil) - ((equal answer "")) - (t (beep 1) - (message "Valid values are A or B") - (sit-for 2) - t)) - (let ((cursor-in-echo-area t)) - (message - "Which buffer to compare to the merge buffer (A or B)? ") - (setq answer (capitalize (read-char-exclusive)))))) + (setq answer (read-multiple-choice + "Which buffer to compare?" + '((?a "A") + (?b "B")))) + (if (eq (car answer) ?a) + (setq bufA ediff-buffer-A) + (setq bufA ediff-buffer-B)) + (setq bufB (if (and ediff-ancestor-buffer + (y-or-n-p (format "Compare %s against ancestor buffer?" + (cadr answer)))) + ediff-ancestor-buffer + ediff-buffer-C))) ((ediff-3way-comparison-job) ;; ask which two buffers to compare commit ddc4371a89e5500e0203bed4b0ad453925b1c74f Author: Paul Eggert <eggert@cs.ucla.edu> Date: Thu Jun 28 13:49:48 2018 -0700 Fix recently-introduced SAFE_FREE bug Problem reported by Andy Moreton (Bug#31996). * src/lisp.h (union specbinding.unwind_array): Remove unused member func. Move array after nelts, as this is likely to generate more efficient code in safe_free, which can call xfree with the same value either way. (safe_free): Also handle SPECPDL_UNWIND_AWAY. diff --git a/src/lisp.h b/src/lisp.h index b544d814d9..cf7b8c0ebc 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3058,9 +3058,8 @@ union specbinding } unwind; struct { ENUM_BF (specbind_tag) kind : CHAR_BIT; - void (*func) (Lisp_Object); - Lisp_Object *array; ptrdiff_t nelts; + Lisp_Object *array; } unwind_array; struct { ENUM_BF (specbind_tag) kind : CHAR_BIT; @@ -4543,9 +4542,16 @@ safe_free (ptrdiff_t sa_count) while (specpdl_ptr != specpdl + sa_count) { specpdl_ptr--; - eassert (specpdl_ptr->kind == SPECPDL_UNWIND_PTR - && specpdl_ptr->unwind_ptr.func == xfree); - xfree (specpdl_ptr->unwind_ptr.arg); + if (specpdl_ptr->kind == SPECPDL_UNWIND_PTR) + { + eassert (specpdl_ptr->unwind_ptr.func == xfree); + xfree (specpdl_ptr->unwind_ptr.arg); + } + else + { + eassert (specpdl_ptr->kind == SPECPDL_UNWIND_ARRAY); + xfree (specpdl_ptr->unwind_array.array); + } } } commit 76eda952b09db6d79342b7ddfcae45c7c836ab62 Author: Paul Eggert <eggert@cs.ucla.edu> Date: Thu Jun 28 00:37:08 2018 -0700 Tune SAFE_FREE On my platform (Fedora 28 x86-64, AMD Phenom II X4 910e) this sped up a SAFE_FREE-using microbenchmark (string-distance "abc" "abc") by about 18%, and shrank the Emacs text size by about 0.1%. * src/callint.c (Fcall_interactively): * src/callproc.c (call_process): * src/doc.c (get_doc_string, Fsnarf_documentation): * src/editfns.c (Freplace_buffer_contents): * src/emacs-module.c (funcall_module): * src/eval.c (Flet): * src/process.c (Fmake_process): * src/term.c (tty_menu_show): * src/xdisp.c (safe__call): * src/xmenu.c (x_menu_show): Use SAFE_FREE_UNBIND_TO. * src/data.c (wrong_choice): No need to call SAFE_FREE here. * src/lisp.h (USE_SAFE_ALLOCA): * src/regex.c (REGEX_USE_SAFE_ALLOCA): Do not declare sa_must_free local; no longer needed. All uses removed. (SAFE_FREE): Rewrite in terms of safe_free. (safe_free): New function, optimized to use xfree. (SAFE_FREE_UNBIND_TO): New macro. (safe_free_unbind_to): New function. diff --git a/src/callint.c b/src/callint.c index fd44494cfe..c6e003ed40 100644 --- a/src/callint.c +++ b/src/callint.c @@ -779,8 +779,7 @@ invoke it. If KEYS is omitted or nil, the return value of specbind (Qcommand_debug_status, Qnil); Lisp_Object val = Ffuncall (nargs, args); - SAFE_FREE (); - return unbind_to (speccount, val); + return SAFE_FREE_UNBIND_TO (speccount, val); } DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value, diff --git a/src/callproc.c b/src/callproc.c index 973f324139..17eb8132d9 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -599,7 +599,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, Lisp_Object volatile coding_systems_volatile = coding_systems; Lisp_Object volatile current_dir_volatile = current_dir; bool volatile display_p_volatile = display_p; - bool volatile sa_must_free_volatile = sa_must_free; int volatile fd_error_volatile = fd_error; int volatile filefd_volatile = filefd; ptrdiff_t volatile count_volatile = count; @@ -616,7 +615,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, coding_systems = coding_systems_volatile; current_dir = current_dir_volatile; display_p = display_p_volatile; - sa_must_free = sa_must_free_volatile; fd_error = fd_error_volatile; filefd = filefd_volatile; count = count_volatile; @@ -885,8 +883,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, when exiting. */ synch_process_pid = 0; - SAFE_FREE (); - unbind_to (count, Qnil); + SAFE_FREE_UNBIND_TO (count, Qnil); if (!wait_ok) return build_unibyte_string ("internal error"); diff --git a/src/data.c b/src/data.c index 49c3dd834b..605a5f43af 100644 --- a/src/data.c +++ b/src/data.c @@ -1049,7 +1049,10 @@ wrong_choice (Lisp_Object choice, Lisp_Object wrong) } obj = Fconcat (i, args); - SAFE_FREE (); + + /* No need to call SAFE_FREE, since signaling does that for us. */ + (void) sa_count; + xsignal2 (Qerror, obj, wrong); } diff --git a/src/doc.c b/src/doc.c index 4264ed5064..075154e94b 100644 --- a/src/doc.c +++ b/src/doc.c @@ -86,7 +86,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition) int offset; EMACS_INT position; Lisp_Object file, tem, pos; - ptrdiff_t count; + ptrdiff_t count = SPECPDL_INDEX (); USE_SAFE_ALLOCA; if (INTEGERP (filepos)) @@ -148,7 +148,6 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition) return concat3 (cannot_open, file, quote_nl); } } - count = SPECPDL_INDEX (); record_unwind_protect_int (close_file_unwind, fd); /* Seek only to beginning of disk block. */ @@ -204,8 +203,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition) } p += nread; } - unbind_to (count, Qnil); - SAFE_FREE (); + SAFE_FREE_UNBIND_TO (count, Qnil); /* Sanity checking. */ if (CONSP (filepos)) @@ -659,8 +657,7 @@ the same file name is found in the `doc-directory'. */) memmove (buf, end, filled); } - SAFE_FREE (); - return unbind_to (count, Qnil); + return SAFE_FREE_UNBIND_TO (count, Qnil); } /* Return true if text quoting style should default to quote `like this'. */ diff --git a/src/editfns.c b/src/editfns.c index 7d032a7ca4..88dfba1f91 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -3198,6 +3198,8 @@ differences between the two buffers. */) return Qnil; } + ptrdiff_t count = SPECPDL_INDEX (); + /* FIXME: It is not documented how to initialize the contents of the context structure. This code cargo-cults from the existing caller in src/analyze.c of GNU Diffutils, which appears to @@ -3231,7 +3233,6 @@ differences between the two buffers. */) eassert (! early_abort); Fundo_boundary (); - ptrdiff_t count = SPECPDL_INDEX (); record_unwind_protect_excursion (); ptrdiff_t i = size_a; @@ -3279,10 +3280,8 @@ differences between the two buffers. */) --i; --j; } - unbind_to (count, Qnil); - SAFE_FREE (); - return Qnil; + return SAFE_FREE_UNBIND_TO (count, Qnil); } static void @@ -4885,7 +4884,6 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) if (buf == initial_buffer) { buf = xmalloc (bufsize); - sa_must_free = true; buf_save_value_index = SPECPDL_INDEX (); record_unwind_protect_ptr (xfree, buf); memcpy (buf, initial_buffer, used); diff --git a/src/emacs-module.c b/src/emacs-module.c index 3a24663799..5b9f6629e7 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -786,7 +786,6 @@ funcall_module (Lisp_Object function, ptrdiff_t nargs, Lisp_Object *arglist) } emacs_value ret = func->subr (env, nargs, args, func->data); - SAFE_FREE (); eassert (&priv == env->private_members); @@ -795,7 +794,7 @@ funcall_module (Lisp_Object function, ptrdiff_t nargs, Lisp_Object *arglist) maybe_quit (); module_signal_or_throw (&priv); - return unbind_to (count, value_to_lisp (ret)); + return SAFE_FREE_UNBIND_TO (count, value_to_lisp (ret)); } Lisp_Object diff --git a/src/eval.c b/src/eval.c index 952a0ec4b4..9e0fabdcfb 100644 --- a/src/eval.c +++ b/src/eval.c @@ -981,8 +981,7 @@ usage: (let VARLIST BODY...) */) specbind (Qinternal_interpreter_environment, lexenv); elt = Fprogn (XCDR (args)); - SAFE_FREE (); - return unbind_to (count, elt); + return SAFE_FREE_UNBIND_TO (count, elt); } DEFUN ("while", Fwhile, Swhile, 1, UNEVALLED, 0, diff --git a/src/lisp.h b/src/lisp.h index 8c884dce15..b544d814d9 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4500,7 +4500,7 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1)); #define USE_SAFE_ALLOCA \ ptrdiff_t sa_avail = MAX_ALLOCA; \ - ptrdiff_t sa_count = SPECPDL_INDEX (); bool sa_must_free = false + ptrdiff_t sa_count = SPECPDL_INDEX () #define AVAIL_ALLOCA(size) (sa_avail -= (size), alloca (size)) @@ -4508,7 +4508,7 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1)); #define SAFE_ALLOCA(size) ((size) <= sa_avail \ ? AVAIL_ALLOCA (size) \ - : (sa_must_free = true, record_xmalloc (size))) + : record_xmalloc (size)) /* SAFE_NALLOCA sets BUF to a newly allocated array of MULTIPLIER * NITEMS items, each of the same type as *BUF. MULTIPLIER must @@ -4521,7 +4521,6 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1)); else \ { \ (buf) = xnmalloc (nitems, sizeof *(buf) * (multiplier)); \ - sa_must_free = true; \ record_unwind_protect_ptr (xfree, buf); \ } \ } while (false) @@ -4534,15 +4533,37 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1)); memcpy (ptr, SDATA (string), SBYTES (string) + 1); \ } while (false) -/* SAFE_FREE frees xmalloced memory and enables GC as needed. */ +/* Free xmalloced memory and enable GC as needed. */ -#define SAFE_FREE() \ - do { \ - if (sa_must_free) { \ - sa_must_free = false; \ - unbind_to (sa_count, Qnil); \ - } \ - } while (false) +#define SAFE_FREE() safe_free (sa_count) + +INLINE void +safe_free (ptrdiff_t sa_count) +{ + while (specpdl_ptr != specpdl + sa_count) + { + specpdl_ptr--; + eassert (specpdl_ptr->kind == SPECPDL_UNWIND_PTR + && specpdl_ptr->unwind_ptr.func == xfree); + xfree (specpdl_ptr->unwind_ptr.arg); + } +} + +/* Pop the specpdl stack back to COUNT, and return VAL. + Prefer this to { SAFE_FREE (); unbind_to (COUNT, VAL); } + when COUNT predates USE_SAFE_ALLOCA, as it is a bit more efficient + and also lets callers intermix SAFE_ALLOCA calls with other calls + that grow the specpdl stack. */ + +#define SAFE_FREE_UNBIND_TO(count, val) \ + safe_free_unbind_to (count, sa_count, val) + +INLINE Lisp_Object +safe_free_unbind_to (ptrdiff_t count, ptrdiff_t sa_count, Lisp_Object val) +{ + eassert (count <= sa_count); + return unbind_to (count, val); +} /* Set BUF to point to an allocated array of NELT Lisp_Objects, immediately followed by EXTRA spare bytes. */ @@ -4560,7 +4581,6 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1)); { \ (buf) = xmalloc (alloca_nbytes); \ record_unwind_protect_array (buf, nelt); \ - sa_must_free = true; \ } \ } while (false) diff --git a/src/process.c b/src/process.c index 6dba218c90..279b74bc66 100644 --- a/src/process.c +++ b/src/process.c @@ -1923,8 +1923,7 @@ usage: (make-process &rest ARGS) */) else create_pty (proc); - SAFE_FREE (); - return unbind_to (count, proc); + return SAFE_FREE_UNBIND_TO (count, proc); } /* If PROC doesn't have its pid set, then an error was signaled and diff --git a/src/regex.c b/src/regex.c index b8c6f3f19b..6ee13c4c99 100644 --- a/src/regex.c +++ b/src/regex.c @@ -455,7 +455,7 @@ ptrdiff_t emacs_re_safe_alloca = MAX_ALLOCA; /* Like USE_SAFE_ALLOCA, but use emacs_re_safe_alloca. */ # define REGEX_USE_SAFE_ALLOCA \ ptrdiff_t sa_avail = emacs_re_safe_alloca; \ - ptrdiff_t sa_count = SPECPDL_INDEX (); bool sa_must_free = false + ptrdiff_t sa_count = SPECPDL_INDEX () # define REGEX_SAFE_FREE() SAFE_FREE () # define REGEX_ALLOCATE SAFE_ALLOCA diff --git a/src/term.c b/src/term.c index 85bfa84d93..f5fca7f987 100644 --- a/src/term.c +++ b/src/term.c @@ -3776,9 +3776,7 @@ tty_menu_show (struct frame *f, int x, int y, int menuflags, tty_menu_end: - SAFE_FREE (); - unbind_to (specpdl_count, Qnil); - return entry; + return SAFE_FREE_UNBIND_TO (specpdl_count, entry); } #endif /* !MSDOS */ diff --git a/src/xdisp.c b/src/xdisp.c index dcb002055b..3406c2fb46 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -2637,8 +2637,7 @@ safe__call (bool inhibit_quit, ptrdiff_t nargs, Lisp_Object func, va_list ap) so there is no possibility of wanting to redisplay. */ val = internal_condition_case_n (Ffuncall, nargs, args, Qt, safe_eval_handler); - SAFE_FREE (); - val = unbind_to (count, val); + val = SAFE_FREE_UNBIND_TO (count, val); } return val; diff --git a/src/xmenu.c b/src/xmenu.c index 6477d5b0ac..dc6f33112c 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -2375,8 +2375,7 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, return_entry: unblock_input (); - SAFE_FREE (); - return unbind_to (specpdl_count, entry); + return SAFE_FREE_UNBIND_TO (specpdl_count, entry); } #endif /* not USE_X_TOOLKIT */ commit 93c41ce6aa64b14fc9bd7bdd0d909915a79191cd Author: Dmitry Gutov <dgutov@yandex.ru> Date: Thu Jun 28 03:14:56 2018 +0300 Remove extra process call from vc-git-find-file-hook * lisp/vc/vc-git.el (vc-git-find-file-hook): Resolve FIXMEs. diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 56e85378cb..ad806b3854 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -974,16 +974,10 @@ This prompts for a branch to merge from." (defun vc-git-find-file-hook () "Activate `smerge-mode' if there is a conflict." (when (and buffer-file-name - ;; FIXME: - ;; 1) the net result is to call git twice per file. - ;; 2) v-g-c-f is documented to take a directory. - ;; https://lists.gnu.org/r/emacs-devel/2014-01/msg01126.html - ;; FIXME: vc-git-state can return `conflict' now. - (vc-git-conflicted-files buffer-file-name) + (eq (vc-state buffer-file-name 'Git) 'conflict) (save-excursion (goto-char (point-min)) (re-search-forward "^<<<<<<< " nil 'noerror))) - (vc-file-setprop buffer-file-name 'vc-state 'conflict) (smerge-start-session) (when vc-git-resolve-conflicts (add-hook 'after-save-hook 'vc-git-resolve-when-done nil 'local)) commit 7ea0873b4f0ceb1ed11c4ab3d692405efc6c79cf Author: Dmitry Gutov <dgutov@yandex.ru> Date: Thu Jun 28 03:05:19 2018 +0300 ; Update some commentary * lisp/vc/vc-git.el (vc-git-state): Remove outdated commentary. (vc-git-dir-status-goto-stage): Move a TODO here. (vc-git-conflicted-files): From here. (vc-git-find-file-hook): Add a FIXME. diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 11b9b34ff6..56e85378cb 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -298,9 +298,6 @@ in the order given by 'git status'." '("--ignored")) "--")) (status (apply #'vc-git--run-command-string file args))) - ;; Alternatively, the `ignored' state could be detected with 'git - ;; ls-files -i -o --exclude-standard', but that's an extra process - ;; call, and the `ignored' state is rarely needed. (if (null status) ;; If status is nil, there was an error calling git, likely because ;; the file is not in a git repo. @@ -565,6 +562,7 @@ or an empty string if none." (declare-function vc-set-async-update "vc-dispatcher" (process-buffer)) (defun vc-git-dir-status-goto-stage (git-state) + ;; TODO: Look into reimplementing this using `git status --porcelain=v2'. (let ((files (vc-git-dir-status-state->files git-state))) (erase-buffer) (pcase (vc-git-dir-status-state->stage git-state) @@ -942,9 +940,6 @@ This prompts for a branch to merge from." (vc-git--run-command-string directory "status" "--porcelain" "--")) (lines (when status (split-string status "\n" 'omit-nulls))) files) - ;; TODO: Look into reimplementing `vc-git-state', as well as - ;; `vc-git-dir-status-files', based on this output, thus making the - ;; extra process call in `vc-git-find-file-hook' unnecessary. (dolist (line lines files) (when (string-match "\\([ MADRCU?!][ MADRCU?!]\\) \\(.+\\)\\(?: -> \\(.+\\)\\)?" line) @@ -979,10 +974,11 @@ This prompts for a branch to merge from." (defun vc-git-find-file-hook () "Activate `smerge-mode' if there is a conflict." (when (and buffer-file-name - ;; FIXME + ;; FIXME: ;; 1) the net result is to call git twice per file. ;; 2) v-g-c-f is documented to take a directory. ;; https://lists.gnu.org/r/emacs-devel/2014-01/msg01126.html + ;; FIXME: vc-git-state can return `conflict' now. (vc-git-conflicted-files buffer-file-name) (save-excursion (goto-char (point-min)) commit 4a7f4232ed415e042a72b85d9c4de1f421ce2bce Author: Dmitry Gutov <dgutov@yandex.ru> Date: Thu Jun 28 03:03:36 2018 +0300 Speed up vc-git-dir-status-files * lisp/vc/vc-git.el (vc-git-dir-status-goto-stage): Call 'git ls-files -u' for the ls-files-conflict stage (https://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00885.html). diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index c6b08e942f..11b9b34ff6 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -581,7 +581,7 @@ or an empty string if none." "ls-files" "-z" "-c" "-s" "--")) (`ls-files-conflict (vc-git-command (current-buffer) 'async files - "ls-files" "-z" "-c" "-s" "--")) + "ls-files" "-z" "-u" "--")) (`ls-files-unknown (vc-git-command (current-buffer) 'async files "ls-files" "-z" "-o" "--directory" commit 79f6911bf1f6262c723f5a3602c2f80cbe63cf54 Author: Eli Zaretskii <eliz@gnu.org> Date: Wed Jun 27 21:08:28 2018 +0300 ; * etc/NEWS: Fix recently added entries. diff --git a/etc/NEWS b/etc/NEWS index 6bfc8e58cf..eb9169a776 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -84,12 +84,6 @@ work right without some adjustment: * Changes in Emacs 27.1 ---- -*** Info browser can follow ``file:'' protocol URL's URL created with -The URL's created by the @url Texinfo command, and followed with the -Info-follow-nearest-node function, can now have 'file:' prototype and -are passed to 'browse-url' function, like were the other Web protocols -(namely ftp, http, and https). --- ** New variable 'xft-ignore-color-fonts'. Default t means don't try to load color fonts when using Xft, as they @@ -251,6 +245,7 @@ This enables more efficient backends. See the docstring of 'flymake-diagnostic-functions' or the Flymake manual for details. ** Package + *** New 'package-quickstart' feature When 'package-quickstart' is non-nil, package.el precomputes a big autoloads file so that activation of packages can be done much faster, which can speed up @@ -261,7 +256,17 @@ you don't need to set them in your early init file. *** New function 'package-activate-all'. +** Info + +--- +*** Info can now follow 'file://' protocol URLs. +The 'file://' URLs in Info documents can now be followed by passing +them to the 'browse-url' function, like the other protocols: ftp, +http, and https. This allows to have references to local HTML files, +for example. + ** Ecomplete + *** The ecomplete sorting has changed to a decay-based algorithm. This can be controlled by the new 'ecomplete-sort-predicate' variable. @@ -308,6 +313,7 @@ and its value has been changed to Duck Duck Go. has been executed. ** Htmlfontify + *** The functions 'hfy-color', 'hfy-color-vals' and 'hfy-fallback-color-values' and the variables 'hfy-fallback-color-map' and 'hfy-rgb-txt-color-map' have been renamed from names that used @@ -326,6 +332,7 @@ Authentication mechanisms can be added via external packages, by defining new cl-defmethod of smtpmail-try-auth-method. ** Footnote-mode + *** Support Hebrew-style footnotes *** Footnote text lines are now aligned. Can be controlled via the new variable 'footnote-align-to-fn-text'. commit 9134c841f1c04c21c16e5661259a4bef3b1c3f5b Author: Eli Zaretskii <eliz@gnu.org> Date: Wed Jun 27 18:02:45 2018 +0300 Avoid compiler warning using coding.h * src/coding.h: Add INLINE_HEADER_BEGIN..INLINE_HEADER_END, since this header now has an extern INLINE function. diff --git a/src/coding.h b/src/coding.h index 502c472314..b803e39128 100644 --- a/src/coding.h +++ b/src/coding.h @@ -28,6 +28,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "lisp.h" +INLINE_HEADER_BEGIN + /* Index to arguments of Fdefine_coding_system_internal. */ enum define_coding_system_arg_index @@ -768,4 +770,6 @@ extern struct coding_system safe_terminal_coding; extern char emacs_mule_bytes[256]; +INLINE_HEADER_END + #endif /* EMACS_CODING_H */ commit ce54573dacaeb234ac006b71cbaafe1c543515f1 Author: JoĂŁo Távora <joaotavora@gmail.com> Date: Wed Jun 27 14:19:00 2018 +0100 Respect s-s-b-default-predicate when killing terminal Fixes: Bug#31951 * lisp/server.el (server-save-buffers-kill-terminal): Only pass PRED=t to save-some-bufers if ARG in non-nil. diff --git a/lisp/server.el b/lisp/server.el index 9eedc293a7..87942e8419 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -1673,13 +1673,15 @@ only these files will be asked to be saved." (save-buffers-kill-emacs arg))) ((processp proc) (let ((buffers (process-get proc 'buffers))) - ;; If client is bufferless, emulate a normal Emacs exit - ;; and offer to save all buffers. Otherwise, offer to - ;; save only the buffers belonging to the client. (save-some-buffers arg (if buffers + ;; Only files from emacsclient file list. (lambda () (memq (current-buffer) buffers)) - t)) + ;; No emacsclient file list: don't override + ;; `save-some-buffers-default-predicate' (unless + ;; ARG is non-nil), since we're not killing + ;; Emacs (unlike `save-buffers-kill-emacs'). + (and arg t))) (server-delete-client proc))) (t (error "Invalid client frame"))))) commit 5924259f152260551e2d153e1273ab600ccda293 Author: Vincent BelaĂŻche <vincentb1@users.sourceforge.net> Date: Wed Jun 27 15:18:52 2018 +0200 Allow 'file:' protocol for Info-follow-nearest-node. diff --git a/etc/NEWS b/etc/NEWS index d86d5e9817..6bfc8e58cf 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -84,6 +84,12 @@ work right without some adjustment: * Changes in Emacs 27.1 +--- +*** Info browser can follow ``file:'' protocol URL's URL created with +The URL's created by the @url Texinfo command, and followed with the +Info-follow-nearest-node function, can now have 'file:' prototype and +are passed to 'browse-url' function, like were the other Web protocols +(namely ftp, http, and https). --- ** New variable 'xft-ignore-color-fonts'. Default t means don't try to load color fonts when using Xft, as they diff --git a/lisp/info.el b/lisp/info.el index c45b7f9cb3..ab2c51d84b 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -3938,8 +3938,8 @@ If FORK is a string, it is the name to use for the new buffer." If FORK is non-nil, it is passed to `Info-goto-node'." (let (node) (cond - ((setq node (Info-get-token (point) "[hf]t?tps?://" - "\\([hf]t?tps?://[^ \t\n\"`â€({<>})’']+\\)")) + ((setq node (Info-get-token (point) "\\(?:f\\(?:ile\\|tp\\)\\|https?\\)://" + "\\(\\(?:f\\(?:ile\\|tp\\)\\|https?\\)://[^ \t\n\"`â€({<>})’']+\\)")) (browse-url node) (setq node t)) ((setq node (Info-get-token (point) "\\*note[ \n\t]+" commit 1f5037925b0830b4129f3d6388f139e339f60da3 Author: Michael Albinus <michael.albinus@gmx.de> Date: Wed Jun 27 13:08:18 2018 +0200 Sync with Tramp 2.3.4. Do not merge with master * doc/misc/trampver.texi: * lisp/net/trampver.el: Change version to "2.3.4". * lisp/net/tramp-smb.el (tramp-smb-handle-delete-directory): Check, that the directory has been removed indeed. * test/lisp/net/tramp-tests.el (tramp-test21-file-links): Adapt test. (tramp--test-emacs25-p): New defun. (tramp-test34-vc-registered): Use it. diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index 68619dcbe9..0970e4e3b3 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -8,7 +8,7 @@ @c In the Tramp GIT, the version number is auto-frobbed from @c configure.ac, so you should edit that file and run @c "autoconf && ./configure" to change the version number. -@set trampver 2.3.4-pre +@set trampver 2.3.4 @c Other flags from configuration @set instprefix /usr/local diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 7e96142a5f..5bcb082626 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -642,7 +642,12 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (goto-char (point-min)) (search-forward-regexp tramp-smb-errors nil t) (tramp-error - v 'file-error "%s `%s'" (match-string 0) directory)))))) + v 'file-error "%s `%s'" (match-string 0) directory))) + + ;; "rmdir" does not report an error. So we check ourselves. + (when (file-exists-p directory) + (tramp-error + v 'file-error "`%s' not removed." directory))))) (defun tramp-smb-handle-delete-file (filename &optional _trash) "Like `delete-file' for Tramp files." diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 25498418dd..d02e6bcc2b 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -7,7 +7,7 @@ ;; Maintainer: Michael Albinus <michael.albinus@gmx.de> ;; Keywords: comm, processes ;; Package: tramp -;; Version: 2.3.4-pre +;; Version: 2.3.4 ;; This file is part of GNU Emacs. @@ -33,7 +33,7 @@ ;; should be changed only there. ;;;###tramp-autoload -(defconst tramp-version "2.3.4-pre" +(defconst tramp-version "2.3.4" "This version of Tramp.") ;;;###tramp-autoload @@ -55,7 +55,7 @@ ;; Check for Emacs version. (let ((x (if (>= emacs-major-version 24) "ok" - (format "Tramp 2.3.4-pre is not fit for %s" + (format "Tramp 2.3.4 is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version))))))) (unless (string-match "\\`ok\\'" x) (error "%s" x))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index d2cbebd63c..e70f00eb2c 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2771,7 +2771,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Check `add-name-to-file'. (unwind-protect - (progn + (unless (tramp-smb-file-name-p tramp-test-temporary-file-directory) (write-region "foo" nil tmp-name1) (should (file-exists-p tmp-name1)) (add-name-to-file tmp-name1 tmp-name2) @@ -3802,11 +3802,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (vc-register (list (car vc-handled-backends) (list (file-name-nondirectory tmp-name2)))) - ;; `vc-register' has changed its arguments in Emacs 25.1. - (error - (vc-register - nil (list (car vc-handled-backends) - (list (file-name-nondirectory tmp-name2)))))) + ;; `vc-register' has changed its arguments in Emacs + ;; 25.1. Let's skip it for older Emacsen. + (error (skip-unless (tramp--test-emacs25-p)))) ;; vc-git uses an own process sentinel, Tramp's sentinel ;; for flushing the cache isn't used. (dired-uncache (concat (file-remote-p default-directory) "/")) @@ -4053,6 +4051,12 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (delete-directory tmp-file) (should-not (file-exists-p tmp-file)))) +(defun tramp--test-emacs25-p () + "Check for Emacs version >= 25.1. +Some semantics has been changed for there, w/o new functions or +variables, so we check the Emacs version directly." + (>= emacs-major-version 25)) + (defun tramp--test-emacs26-p () "Check for Emacs version >= 26.1. Some semantics has been changed for there, w/o new functions or commit d008ef3d0b4aaa83d9ee105450fdcf13aa63a7e3 Author: Martin Rudalics <rudalics@gmx.at> Date: Wed Jun 27 09:07:59 2018 +0200 * src/xdisp.c (Vmouse_autoselect_window): Clarify doc-string (Bug#31975) diff --git a/src/xdisp.c b/src/xdisp.c index 5bce05c219..9247d5bc3e 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -32822,8 +32822,10 @@ mouse pointer enters it. Autoselection selects the minibuffer only if it is active, and never unselects the minibuffer if it is active. -When customizing this variable make sure that the actual value of -`focus-follows-mouse' matches the behavior of your window manager. */); +If you want to use the mouse to autoselect a window on another frame, +make sure that (1) your window manager has focus follow the mouse and +(2) the value of the option `focus-follows-mouse' matches the policy +of your window manager. */); Vmouse_autoselect_window = Qnil; DEFVAR_LISP ("auto-resize-tool-bars", Vauto_resize_tool_bars, commit 6f6d525683d5731d55fcd801a66b078bd6ba8369 Author: Noam Postavsky <npostavs@gmail.com> Date: Sat Jun 16 18:59:43 2018 -0400 Detect a non-list package archive content properly (Bug#22311) * lisp/emacs-lisp/package.el (package--download-one-archive): Use `read' instead of `read-from-string'; the latter always returns a cons, so the `listp' check on its return value doesn't make sense. It was changed from `read' to `read-from-string' in 2015-04-01 "* emacs-lisp/package.el: Implement asynchronous refreshing", but that change was not needed because `read' works fine on strings as well as buffers. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index c56502236e..576a9bc7e7 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1532,7 +1532,7 @@ similar to an entry in `package-alist'. Save the cached copy to (content (buffer-string)) (dir (expand-file-name (format "archives/%s" name) package-user-dir)) (local-file (expand-file-name file dir))) - (when (listp (read-from-string content)) + (when (listp (read content)) (make-directory dir t) (if (or (not package-check-signature) (member name package-unsigned-archives)) commit 513b97c0e94f5c25dd9ac82aea86c9eba248589d Merge: 61f73703c7 12c77f6918 Author: Glenn Morris <rgm@gnu.org> Date: Tue Jun 26 07:51:01 2018 -0700 Merge from origin/emacs-26 12c77f6 (origin/emacs-26) Add ido-fallback special variable (Bug#31707) 826e8d1 Merge branch 'emacs-26' of git.sv.gnu.org:/srv/git/emacs into... c784876 Tighten a cross-reference in documentation 517dc0b Fix last change in tramp-sh.el f43186f Revert previous patch; comment was OK after all. 4c3306e Fix lead comment for count_trailing_zero_bits b419f27 ; * doc/emacs/files.texi (Interlocking): Fix a non-portable @... 7488de4 * lisp/emacs-lisp/regexp-opt.el (regexp-opt): Fix docstring q... 0b69807 Make a minor update to the CSS mode docstring 9a53b6d Say how to override a primitive interactive spec 1d77078 Fix Bug#31941 commit 12c77f6918c4a60dbbae3f716a58300b4026e8da Author: Christophe Junke <junke.christophe@gmail.com> Date: Mon Jun 4 10:39:43 2018 +0200 Add ido-fallback special variable (Bug#31707) Before ido.el switch to lexical-binding, it was possible for other packages to modify the 'fallback' variables declared inside 'ido-file-internal' and 'ido-buffer-internal'. * lisp/ido.el (ido-fallback): New variable. (ido-buffer-internal, ido-file-internal): Reset ido-fallback to nil before prompting user. Use ido-fallback when ido-exit is 'fallback'. (ido-fallback-command): Add optional FALLBACK-COMMAND argument. Copyright-paperwork-exempt: yes diff --git a/lisp/ido.el b/lisp/ido.el index da0c9d463d..761f02ea78 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -1239,6 +1239,9 @@ Only used if `ido-use-virtual-buffers' is non-nil.") ;; Dynamically bound in ido-read-internal. (defvar ido-completing-read) +;; If dynamically set when ido-exit is 'fallback, overrides fallback command. +(defvar ido-fallback nil) + ;;; FUNCTIONS (defun ido-active (&optional merge) @@ -2220,6 +2223,7 @@ If cursor is not at the end of the user input, move to end of input." (run-hook-with-args 'ido-before-fallback-functions (or fallback 'switch-to-buffer)) (call-interactively (or fallback 'switch-to-buffer))) + (setq ido-fallback nil) (let* ((ido-context-switch-command switch-cmd) (ido-current-directory nil) (ido-directory-nonreadable nil) @@ -2245,7 +2249,7 @@ If cursor is not at the end of the user input, move to end of input." ((eq ido-exit 'fallback) (let ((read-buffer-function nil)) - (setq this-command (or fallback 'switch-to-buffer)) + (setq this-command (or ido-fallback fallback 'switch-to-buffer)) (run-hook-with-args 'ido-before-fallback-functions this-command) (call-interactively this-command))) @@ -2341,6 +2345,7 @@ If cursor is not at the end of the user input, move to end of input." ;; Internal function for ido-find-file and friends (unless item (setq item 'file)) + (setq ido-fallback nil) (let ((ido-current-directory (ido-expand-directory default)) (ido-context-switch-command switch-cmd) ido-directory-nonreadable ido-directory-too-big @@ -2412,7 +2417,7 @@ If cursor is not at the end of the user input, move to end of input." ;; we don't want to change directory of current buffer. (let ((default-directory ido-current-directory) (read-file-name-function nil)) - (setq this-command (or fallback 'find-file)) + (setq this-command (or ido-fallback fallback 'find-file)) (run-hook-with-args 'ido-before-fallback-functions this-command) (call-interactively this-command))) @@ -2821,13 +2826,15 @@ If no buffer or file exactly matching the prompt exists, maybe create a new one. (setq ido-exit 'takeprompt) (exit-minibuffer)) -(defun ido-fallback-command () - "Fallback to non-Ido version of current command." +(defun ido-fallback-command (&optional fallback-command) + "Fallback to non-Ido version of current command. +The optional FALLBACK-COMMAND argument indicates which command to run." (interactive) (let ((i (length ido-text))) (while (> i 0) (push (aref ido-text (setq i (1- i))) unread-command-events))) (setq ido-exit 'fallback) + (setq ido-fallback fallback-command) (exit-minibuffer)) (defun ido-enter-find-file () commit 61f73703c74756e6963cc622f03bcc6938ab71b2 Author: Jean-Christophe Helary <brandelune@gmail.com> Date: Wed Jun 20 12:19:00 2018 -0400 Reformat package.el message strings for future l10n * lisp/emacs-lisp/package.el (package-buffer-info) (package--download-one-archive, package-install-selected-packages) (package-autoremove, describe-package-1, package-menu-toggle-hiding) (package-menu-hide-package, package-menu--mark-upgrades-1) (package-menu--list-to-prompt, package-menu--prompt-transaction-p) (package-menu-execute, package-menu--find-and-notify-upgrades): Reformat message strings to remove need for plural computation. Try to put full sentences in source string literals. * test/lisp/emacs-lisp/package-tests.el (package-test-describe-package): Update to match new message format. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 94d98178c4..9a704b2d98 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1015,6 +1015,8 @@ boundaries." (let ((file-name (match-string-no-properties 1)) (desc (match-string-no-properties 2)) (start (line-beginning-position))) + ;; The terminating comment format could be extended to accept a + ;; generic string that is not in English. (unless (search-forward (concat ";;; " file-name ".el ends here")) (error "Package lacks a terminating comment")) ;; Try to include a trailing newline. @@ -1552,7 +1554,7 @@ similar to an entry in `package-alist'. Save the cached copy to (let* ((location (cdr archive)) (name (car archive)) (content (buffer-string)) - (dir (expand-file-name (format "archives/%s" name) package-user-dir)) + (dir (expand-file-name (concat "archives/" name) package-user-dir)) (local-file (expand-file-name file dir))) (when (listp (read-from-string content)) (make-directory dir t) @@ -2034,12 +2036,12 @@ If some packages are not installed propose to install them." (cond (available (when (y-or-n-p - (format "%s packages will be installed:\n%s, proceed?" + (format "Packages to install: %d (%s), proceed? " (length available) - (mapconcat #'symbol-name available ", "))) + (mapconcat #'symbol-name available " "))) (mapc (lambda (p) (package-install p 'dont-select)) available))) ((> difference 0) - (message "%s packages are not available (the rest already installed), maybe you need to `M-x package-refresh-contents'" + (message "Packages that are not available: %d (the rest is already installed), maybe you need to `M-x package-refresh-contents'" difference)) (t (message "All your packages are already installed")))))) @@ -2158,9 +2160,9 @@ will be deleted." (let ((removable (package--removable-packages))) (if removable (when (y-or-n-p - (format "%s packages will be deleted:\n%s, proceed? " + (format "Packages to delete: %d (%s), proceed? " (length removable) - (mapconcat #'symbol-name removable ", "))) + (mapconcat #'symbol-name removable " "))) (mapc (lambda (p) (package-delete (cadr (assq p package-alist)) t)) removable)) @@ -2247,12 +2249,10 @@ Otherwise no newline is inserted." (setq status "available obsolete")) (when incompatible-reason (setq status "incompatible")) - (prin1 name) - (princ " is ") - (princ (if (memq (aref status 0) '(?a ?e ?i ?o ?u)) "an " "a ")) - (princ status) - (princ " package.\n\n") + (princ (format "Package %S is %s.\n\n" name status)) + ;; TODO: Remove the string decorations and reformat the strings + ;; for future l10n. (package--print-help-section "Status") (cond (built-in (insert (propertize (capitalize status) @@ -2634,9 +2634,9 @@ Installed obsolete packages are always displayed.") (user-error "The current buffer is not a Package Menu")) (setq package-menu--hide-packages (not package-menu--hide-packages)) - (message "%s packages" (if package-menu--hide-packages - "Hiding obsolete or unwanted" - "Displaying all")) + (if package-menu--hide-packages + (message "Hiding obsolete or unwanted packages") + (message "Displaying all packages")) (revert-buffer nil 'no-confirm)) (defun package--remove-hidden (pkg-list) @@ -2960,11 +2960,11 @@ If optional arg BUTTON is non-nil, describe its associated package." (let ((hidden (cl-remove-if-not (lambda (e) (string-match re (symbol-name (car e)))) package-archive-contents))) - (message (substitute-command-keys - (concat "Hiding %s packages, type `\\[package-menu-toggle-hiding]'" - " to toggle or `\\[customize-variable] RET package-hidden-regexps'" - " to customize it")) - (length hidden))))) + (message "Packages to hide: %d. Type `%s' to toggle or `%s' to customize" + (length hidden) + (substitute-command-keys "\\[package-menu-toggle-hidding]") + (substitute-command-keys "\\[customize-variable] RET package-hidden-regexps"))))) + (defun package-menu-describe-package (&optional button) "Describe the current package. @@ -3099,7 +3099,7 @@ Implementation of `package-menu-mark-upgrades'." (setq package-menu--mark-upgrades-pending nil) (let ((upgrades (package-menu--find-upgrades))) (if (null upgrades) - (message "No packages to upgrade.") + (message "No packages to upgrade") (widen) (save-excursion (goto-char (point-min)) @@ -3112,9 +3112,9 @@ Implementation of `package-menu-mark-upgrades'." (package-menu-mark-install)) (t (package-menu-mark-delete)))))) - (message "%d package%s marked for upgrading." - (length upgrades) - (if (= (length upgrades) 1) "" "s"))))) + (message "Packages marked for upgrading: %d" + (length upgrades))))) + (defun package-menu-mark-upgrades () "Mark all upgradable packages in the Package Menu. @@ -3137,17 +3137,12 @@ immediately." PACKAGES is a list of `package-desc' objects. Formats the returned string to be usable in a minibuffer prompt (see `package-menu--prompt-transaction-p')." - (cond - ;; None - ((not packages) "") - ;; More than 1 - ((cdr packages) - (format "these %d packages (%s)" - (length packages) - (mapconcat #'package-desc-full-name packages ", "))) - ;; Exactly 1 - (t (format-message "package `%s'" - (package-desc-full-name (car packages)))))) + ;; The case where `package' is empty is handled in + ;; `package-menu--prompt-transaction-p' below. + (format "%d (%s)" + (length packages) + (mapconcat #'package-desc-full-name packages " "))) + (defun package-menu--prompt-transaction-p (delete install upgrade) "Prompt the user about DELETE, INSTALL, and UPGRADE. @@ -3155,16 +3150,14 @@ DELETE, INSTALL, and UPGRADE are lists of `package-desc' objects. Either may be nil, but not all." (y-or-n-p (concat - (when delete "Delete ") - (package-menu--list-to-prompt delete) - (when (and delete install) - (if upgrade "; " "; and ")) - (when install "Install ") - (package-menu--list-to-prompt install) - (when (and upgrade (or install delete)) "; and ") - (when upgrade "Upgrade ") - (package-menu--list-to-prompt upgrade) - "? "))) + (when delete + (format "Packages to delete: %s. " (package-menu--list-to-prompt delete))) + (when install + (format "Packages to install: %s. " (package-menu--list-to-prompt install))) + (when upgrade + (format "Packages to upgrade: %s. " (package-menu--list-to-prompt upgrade))) + "Proceed? "))) + (defun package-menu--partition-transaction (install delete) "Return an alist describing an INSTALL DELETE transaction. @@ -3248,25 +3241,24 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm." (when (or noquery (package-menu--prompt-transaction-p .delete .install .upgrade)) (let ((message-template - (concat "Package menu: Operation %s [" - (when .delete (format "Delet__ %s" (length .delete))) - (when (and .delete .install) "; ") - (when .install (format "Install__ %s" (length .install))) - (when (and .upgrade (or .install .delete)) "; ") - (when .upgrade (format "Upgrad__ %s" (length .upgrade))) + (concat "[ " + (when .delete + (format "Delete %d " (length .delete))) + (when .install + (format "Install %d " (length .install))) + (when .upgrade + (format "Upgrade %d " (length .upgrade))) "]"))) - (message (replace-regexp-in-string "__" "ing" message-template) "started") + (message "Operation %s started" message-template) ;; Packages being upgraded are not marked as selected. (package--update-selected-packages .install .delete) (package-menu--perform-transaction install-list delete-list) (when package-selected-packages (if-let* ((removable (package--removable-packages))) - (message "Package menu: Operation finished. %d packages %s" - (length removable) - (substitute-command-keys - "are no longer needed, type `\\[package-autoremove]' to remove them")) - (message (replace-regexp-in-string "__" "ed" message-template) - "finished")))))))) + (message "Operation finished. Packages that are no longer needed: %d. Type `%s' to remove them" + (length removable) + (substitute-command-keys "\\[package-autoremove]")) + (message "Operation %s finished" message-template)))))))) (defun package-menu--version-predicate (A B) (let ((vA (or (aref (cadr A) 1) '(0))) @@ -3333,11 +3325,10 @@ Store this list in `package-menu--new-package-list'." (defun package-menu--find-and-notify-upgrades () "Notify the user of upgradable packages." (when-let* ((upgrades (package-menu--find-upgrades))) - (message "%d package%s can be upgraded; type `%s' to mark %s for upgrading." - (length upgrades) - (if (= (length upgrades) 1) "" "s") - (substitute-command-keys "\\[package-menu-mark-upgrades]") - (if (= (length upgrades) 1) "it" "them")))) + (message "Packages that can be upgraded: %d; type `%s' to mark for upgrading." + (length upgrades) + (substitute-command-keys "\\[package-menu-mark-upgrades]")))) + (defun package-menu--post-refresh () "If there's a *Packages* buffer, revert it and check for new packages and upgrades. diff --git a/test/lisp/emacs-lisp/package-tests.el b/test/lisp/emacs-lisp/package-tests.el index 0059c546ac..db6d103a2e 100644 --- a/test/lisp/emacs-lisp/package-tests.el +++ b/test/lisp/emacs-lisp/package-tests.el @@ -414,7 +414,7 @@ Must called from within a `tar-mode' buffer." (with-fake-help-buffer (describe-package '5x5) (goto-char (point-min)) - (should (search-forward "5x5 is a built-in package." nil t)) + (should (search-forward "5x5 is built-in." nil t)) ;; Don't assume the descriptions are in any particular order. (save-excursion (should (search-forward "Status: Built-in." nil t))) (save-excursion (should (search-forward "Summary: simple little puzzle game" nil t))) @@ -428,7 +428,7 @@ Must called from within a `tar-mode' buffer." (with-fake-help-buffer (describe-package 'simple-single) (goto-char (point-min)) - (should (search-forward "simple-single is an installed package." nil t)) + (should (search-forward "Package simple-single is installed." nil t)) (save-excursion (should (re-search-forward "Status: Installed in ['`â€]simple-single-1.3/['’] (unsigned)." nil t))) (save-excursion (should (search-forward "Version: 1.3" nil t))) (save-excursion (should (search-forward "Summary: A single-file package with no dependencies" nil t))) commit c71fb6b0cdb7043e2828a6843496ab20f4577cbb Author: Noam Postavsky <npostavs@gmail.com> Date: Wed Jun 20 20:12:23 2018 -0400 Suppress indent errors during electric indentation (Bug#18764) * lisp/electric.el (electric-indent-post-self-insert-function): Suppress errors from indent code, but don't suppress errors from elsewhere in this function. That way, if trouble is encountered with electric indent "not working", the error should be reproducible by calling indent directly (as is the case for Bug#18764), or else it's from the electric indent code and will be reported normally. diff --git a/lisp/electric.el b/lisp/electric.el index c00e7c00a5..a45faf2dbb 100644 --- a/lisp/electric.el +++ b/lisp/electric.el @@ -260,32 +260,43 @@ or comment." (or (memq act '(nil no-indent)) ;; In a string or comment. (unless (eq act 'do-indent) (nth 8 (syntax-ppss)))))))) - ;; For newline, we want to reindent both lines and basically behave like - ;; reindent-then-newline-and-indent (whose code we hence copied). - (let ((at-newline (<= pos (line-beginning-position)))) - (when at-newline - (let ((before (copy-marker (1- pos) t))) - (save-excursion - (unless (or (memq indent-line-function - electric-indent-functions-without-reindent) - electric-indent-inhibit) - ;; Don't reindent the previous line if the indentation function - ;; is not a real one. + ;; If we error during indent, silently give up since this is an + ;; automatic action that the user didn't explicitly request. + ;; But we don't want to suppress errors from elsewhere in *this* + ;; function, hence the `condition-case' and `throw' (Bug#18764). + (catch 'indent-error + ;; For newline, we want to reindent both lines and basically + ;; behave like reindent-then-newline-and-indent (whose code we + ;; hence copied). + (let ((at-newline (<= pos (line-beginning-position)))) + (when at-newline + (let ((before (copy-marker (1- pos) t))) + (save-excursion + (unless (or (memq indent-line-function + electric-indent-functions-without-reindent) + electric-indent-inhibit) + ;; Don't reindent the previous line if the + ;; indentation function is not a real one. + (goto-char before) + (condition-case-unless-debug () + (indent-according-to-mode) + (error (throw 'indent-error nil)))) + ;; We are at EOL before the call to + ;; `indent-according-to-mode', and after it we usually + ;; are as well, but not always. We tried to address + ;; it with `save-excursion' but that uses a normal + ;; marker whereas we need `move after insertion', so + ;; we do the save/restore by hand. (goto-char before) - (indent-according-to-mode)) - ;; We are at EOL before the call to indent-according-to-mode, and - ;; after it we usually are as well, but not always. We tried to - ;; address it with `save-excursion' but that uses a normal marker - ;; whereas we need `move after insertion', so we do the - ;; save/restore by hand. - (goto-char before) - (when (eolp) - ;; Remove the trailing whitespace after indentation because - ;; indentation may (re)introduce the whitespace. - (delete-horizontal-space t))))) - (unless (and electric-indent-inhibit - (not at-newline)) - (indent-according-to-mode)))))) + (when (eolp) + ;; Remove the trailing whitespace after indentation because + ;; indentation may (re)introduce the whitespace. + (delete-horizontal-space t))))) + (unless (and electric-indent-inhibit + (not at-newline)) + (condition-case-unless-debug () + (indent-according-to-mode) + (error (throw 'indent-error nil))))))))) (put 'electric-indent-post-self-insert-function 'priority 60) commit d0e2a341dd9a9a365fd311748df024ecb25b70ec Author: Paul Eggert <eggert@cs.ucla.edu> Date: Mon Jun 25 12:21:40 2018 -0700 (format "%d" F) now truncates floating F Problem reported by Paul Pogonyshev (Bug#31938). * src/editfns.c: Include math.h, for trunc. (styled_format): For %d, truncate floating-point numbers and convert -0 to 0, going back to how Emacs 26 did things. * doc/lispref/strings.texi (Formatting Strings): Document behavior of %o, %d, %x, %X on floating-point numbers. * src/floatfns.c (trunc) [!HAVE_TRUNC]: Rename from emacs_trunc and make it an extern function, so that editfns.c can use it. All callers changed. * test/src/editfns-tests.el (format-%d-float): New test. diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 70ba1aa613..026ba749cb 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -922,18 +922,23 @@ Functions}). Thus, strings are enclosed in @samp{"} characters, and @item %o @cindex integer to octal Replace the specification with the base-eight representation of an -unsigned integer. +unsigned integer. The object can also be a nonnegative floating-point +number that is formatted as an integer, dropping any fraction, if the +integer does not exceed machine limits. @item %d Replace the specification with the base-ten representation of a signed -integer. +integer. The object can also be a floating-point number that is +formatted as an integer, dropping any fraction. @item %x @itemx %X @cindex integer to hexadecimal Replace the specification with the base-sixteen representation of an unsigned integer. @samp{%x} uses lower case and @samp{%X} uses upper -case. +case. The object can also be a nonnegative floating-point number that +is formatted as an integer, dropping any fraction, if the integer does +not exceed machine limits. @item %c Replace the specification with the character which is the value given. diff --git a/src/editfns.c b/src/editfns.c index 30d585cd01..7d032a7ca4 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -47,6 +47,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <errno.h> #include <float.h> #include <limits.h> +#include <math.h> #ifdef HAVE_TIMEZONE_T # include <sys/param.h> @@ -4671,6 +4672,12 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) { strcpy (f - pMlen - 1, "f"); double x = XFLOAT_DATA (arg); + + /* Truncate and then convert -0 to 0, to be more + consistent with %x etc.; see Bug#31938. */ + x = trunc (x); + x = x ? x : 0; + sprintf_bytes = sprintf (sprintf_buf, convspec, 0, x); char c0 = sprintf_buf[0]; bool signedp = ! ('0' <= c0 && c0 <= '9'); diff --git a/src/floatfns.c b/src/floatfns.c index ec0349fbf4..e7d404a84e 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -435,11 +435,9 @@ emacs_rint (double d) } #endif -#ifdef HAVE_TRUNC -#define emacs_trunc trunc -#else -static double -emacs_trunc (double d) +#ifndef HAVE_TRUNC +double +trunc (double d) { return (d < 0 ? ceil : floor) (d); } @@ -482,8 +480,7 @@ Rounds ARG toward zero. With optional DIVISOR, truncate ARG/DIVISOR. */) (Lisp_Object arg, Lisp_Object divisor) { - return rounding_driver (arg, divisor, emacs_trunc, truncate2, - "truncate"); + return rounding_driver (arg, divisor, trunc, truncate2, "truncate"); } @@ -543,7 +540,7 @@ DEFUN ("ftruncate", Fftruncate, Sftruncate, 1, 1, 0, { CHECK_FLOAT (arg); double d = XFLOAT_DATA (arg); - d = emacs_trunc (d); + d = trunc (d); return make_float (d); } diff --git a/src/lisp.h b/src/lisp.h index d0c52d8567..8c884dce15 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3425,8 +3425,11 @@ extern Lisp_Object string_make_unibyte (Lisp_Object); extern void syms_of_fns (void); /* Defined in floatfns.c. */ -extern void syms_of_floatfns (void); +#ifndef HAVE_TRUNC +extern double trunc (double); +#endif extern Lisp_Object fmod_float (Lisp_Object x, Lisp_Object y); +extern void syms_of_floatfns (void); /* Defined in fringe.c. */ extern void syms_of_fringe (void); diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index 1ed0bd5bba..c828000bb4 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -176,6 +176,14 @@ (should-error (format "%o" -1e-37) :type 'overflow-error)) +;; Bug#31938 +(ert-deftest format-%d-float () + (should (string-equal (format "%d" -1.1) "-1")) + (should (string-equal (format "%d" -0.9) "0")) + (should (string-equal (format "%d" -0.0) "0")) + (should (string-equal (format "%d" 0.0) "0")) + (should (string-equal (format "%d" 0.9) "0")) + (should (string-equal (format "%d" 1.1) "1"))) ;;; Check format-time-string with various TZ settings. ;;; Use only POSIX-compatible TZ values, since the tests should work commit 826e8d1f12b014617c8899936730a740a09fefb1 Merge: 517dc0b135 c7848767c9 Author: Michael Albinus <michael.albinus@gmx.de> Date: Mon Jun 25 20:40:37 2018 +0200 Merge branch 'emacs-26' of git.sv.gnu.org:/srv/git/emacs into emacs-26 commit c7848767c9210019c2a8691ff2a224f2b8a583d1 Author: Karl Fogel <kfogel@red-bean.com> Date: Mon Jun 25 12:23:23 2018 -0500 Tighten a cross-reference in documentation * doc/lispref/internals.texi (Writing Emacs Primitives): Switch to a simple parenthetical cross-reference, following up to my commit 9a53b6d426 of 2018-06-24. See discussion: https://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00826.html From: Eli Zaretskii Subject: Re: [Emacs-diffs] \ emacs-26 9a53b6d: Say how to override a primitive interactive spec To: Karl Fogel CC: Stefan Monnier, Emacs Devel Date: Mon, 25 Jun 2018 17:41:53 +0300 Message-Id: <83r2kvrkr2.fsf@gnu.org> diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 25333270c3..45c3b87c0a 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -726,7 +726,8 @@ less than 8. @cindex interactive specification in primitives @item interactive This is an interactive specification, a string such as might be used -as the argument of @code{interactive} in a Lisp function. In the case +as the argument of @code{interactive} in a Lisp function +(@pxref{Using Interactive}). In the case of @code{or}, it is 0 (a null pointer), indicating that @code{or} cannot be called interactively. A value of @code{""} indicates a function that should receive no arguments when called interactively. @@ -743,11 +744,6 @@ DEFUN ("foo", Ffoo, Sfoo, 0, UNEVALLED, 0 @end group @end example -If you wish to override a primitive interactive specification, just -set the @code{interactive-form} property of the primitive function's -symbol (@pxref{Using Interactive}). There is no need to edit C code -and recompile Emacs. - @item doc This is the documentation string. It uses C comment syntax rather than C string syntax because comment syntax requires nothing special commit 27a21970f6faa9baf42823f731b7842b075e86eb Author: Lars Ingebrigtsen <larsi@gnus.org> Date: Mon Jun 25 18:56:55 2018 +0200 Fix spelling of "intermediate" (it's not "intermediary") * doc/emacs/misc.texi (Network Security): Ditto. * lisp/net/nsm.el (network-security-protocol-checks): Fix spelling on "intermediate". (nsm-protocol-check--intermediate-sha1): Ditto. diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 0a15df4120..692f1fd650 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -361,8 +361,8 @@ third parties. If this number is too low, you will be warned. The @acronym{RC4} stream cipher is believed to be of low quality and may allow eavesdropping by third parties. -@item @acronym{SHA1} in the host certificate or in intermediary certificates -It is believed that if an intermediary certificate uses +@item @acronym{SHA1} in the host certificate or in intermediate certificates +It is believed that if an intermediate certificate uses the @acronym{SHA1} hashing algorithm, then third parties can issue certificates pretending to be that issuing instance. These connections are therefore vulnerable to man-in-the-middle attacks. diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el index 146d0d5525..0653cfbb1a 100644 --- a/lisp/net/nsm.el +++ b/lisp/net/nsm.el @@ -185,7 +185,7 @@ unencrypted." '((diffie-hellman-prime-bits medium 1024) (rc4 medium) (signature-sha1 medium) - (intermediary-sha1 medium) + (intermediate-sha1 medium) (3des high) (ssl medium)) "This variable specifies what TLS connection checks to perform. @@ -255,7 +255,7 @@ HOST PORT STATUS OPTIONAL-PARAMETER.") "The certificate used to verify the connection to %s:%s uses the SHA1 algorithm (%s), which is believed to be unsafe." host port signature-algorithm)))) -(defun nsm-protocol-check--intermediary-sha1 (host port status _) +(defun nsm-protocol-check--intermediate-sha1 (host port status _) ;; Skip the first certificate, because that's the host certificate. (cl-loop for certificate in (cdr (plist-get status :certificates)) for algo = (plist-get certificate :signature-algorithm) @@ -266,7 +266,7 @@ HOST PORT STATUS OPTIONAL-PARAMETER.") (string-match "\\bSHA1\\b" algo) (not (nsm-query host port status :signature-sha1 - "An intermediary certificate used to verify the connection to %s:%s uses the SHA1 algorithm (%s), which is believed to be unsafe." + "An intermediate certificate used to verify the connection to %s:%s uses the SHA1 algorithm (%s), which is believed to be unsafe." host port algo))) do (cl-return nil) finally (cl-return t))) commit 71e4a4b7e5d55981f813929ba488a51238187a94 Author: Lars Ingebrigtsen <larsi@gnus.org> Date: Mon Jun 25 18:42:26 2018 +0200 Clean up redundant code from previous checkins * src/gnutls.c (gnutls_verify_boot): Remove reduntant setting of p->gnutls_certificates, which is now performed by gnutls_deinit_certificates. diff --git a/src/gnutls.c b/src/gnutls.c index a8034d0abb..d22d5d267c 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -1500,7 +1500,6 @@ gnutls_verify_boot (Lisp_Object proc, Lisp_Object proplist) if (failed_import != 0) { gnutls_deinit_certificates (p); - p->gnutls_certificates = NULL; return gnutls_make_error (failed_import); } commit 517dc0b13554ec969222404a6d00b03853e1cb2a Author: Michael Albinus <michael.albinus@gmx.de> Date: Mon Jun 25 16:25:41 2018 +0200 Fix last change in tramp-sh.el * lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file-directly): Use "-R" rather than "-r" for recursive copy of directories. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 3e99ab567f..1a31596bf9 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2189,8 +2189,8 @@ the uid and gid from FILENAME." (file-attributes filename))) (file-modes (tramp-default-file-modes filename))) (with-parsed-tramp-file-name (if t1 filename newname) nil - (let* ((cmd (cond ((and (eq op 'copy) preserve-uid-gid) "cp -f -r -p") - ((eq op 'copy) "cp -f -r") + (let* ((cmd (cond ((and (eq op 'copy) preserve-uid-gid) "cp -f -p") + ((eq op 'copy) "cp -f") ((eq op 'rename) "mv -f") (t (tramp-error v 'file-error @@ -2200,6 +2200,8 @@ the uid and gid from FILENAME." (localname2 (if t2 (file-remote-p newname 'localname) newname)) (prefix (file-remote-p (if t1 filename newname))) cmd-result) + (when (and (eq op 'copy) (file-directory-p filename)) + (setq cmd (concat cmd " -R"))) (cond ;; Both files are on a remote host, with same user. commit 15f4cdd873cafeba0b61af9774d2b5da19d77e50 Author: JoĂŁo Távora <joaotavora@gmail.com> Date: Mon Jun 25 12:27:56 2018 +0100 Mention use of C-h . (display-local-help) in Flymake manual Fixes: Bug#31921 * doc/misc/flymake.texi (Using Flymake): Mention display-local-help. diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi index 1e7a5e82c6..bdefd40d77 100644 --- a/doc/misc/flymake.texi +++ b/doc/misc/flymake.texi @@ -4,7 +4,7 @@ @set VERSION 1.0 @set UPDATED June 2018 @settitle GNU Flymake @value{VERSION} -@include docstyle.texi +@include ../emacs/docstyle.texi @syncodeindex pg cp @syncodeindex vr cp @syncodeindex fn cp @@ -99,9 +99,15 @@ some changes were made to the buffer more than @code{0.5} seconds ago Syntax check can also be started manually by typing the @kbd{M-x flymake-start @key{RET}} command. +If the check detected errors or warnings, the respective buffer +regions are highlighted. You can place point on those regions and use +@kbd{C-h .} (@code{display-local-help}) to see what the specific +problem was. Alternatively, hovering the mouse on those regions +should also display a tool-tip with the same information. + @code{flymake-goto-next-error} and @code{flymake-goto-prev-error} are commands that allow easy navigation to the next/previous erroneous -line, respectively. If might be a good idea to map them to @kbd{M-n} +regions, respectively. If might be a good idea to map them to @kbd{M-n} and @kbd{M-p} in @code{flymake-mode}, by adding to your init file: @lisp commit f43186fe28e87738e9ea48216e5a5b67d2742d76 Author: Paul Eggert <eggert@cs.ucla.edu> Date: Sun Jun 24 23:46:18 2018 -0700 Revert previous patch; comment was OK after all. diff --git a/src/data.c b/src/data.c index 677791c594..4bee194e29 100644 --- a/src/data.c +++ b/src/data.c @@ -3311,8 +3311,8 @@ pre_value (bool precondition, int value) return precondition ? value : 0; } -/* Compute the number of trailing zero bits in VAL. VAL must not be zero. */ - +/* Compute the number of trailing zero bits in val. If val is zero, + return the number of bits in val. */ static int count_trailing_zero_bits (bits_word val) { commit 4c3306e12fb4db07a0cae8bdc6291d2efb019933 Author: Paul Eggert <eggert@cs.ucla.edu> Date: Sun Jun 24 23:21:01 2018 -0700 Fix lead comment for count_trailing_zero_bits * src/data.c (count_trailing_zero_bits): Fix comment to match code. diff --git a/src/data.c b/src/data.c index 4bee194e29..677791c594 100644 --- a/src/data.c +++ b/src/data.c @@ -3311,8 +3311,8 @@ pre_value (bool precondition, int value) return precondition ? value : 0; } -/* Compute the number of trailing zero bits in val. If val is zero, - return the number of bits in val. */ +/* Compute the number of trailing zero bits in VAL. VAL must not be zero. */ + static int count_trailing_zero_bits (bits_word val) { commit 79c247700f97ca83bf9ab49f21bf45b936b73de6 Author: Noam Postavsky <npostavs@gmail.com> Date: Sun Jun 24 21:00:32 2018 -0400 ; doc/emacs/misc.texi (Network Security): Fix typo. diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index e178d3f347..0a15df4120 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -378,7 +378,7 @@ If @code{network-security-level} is @code{high}, the following checks will be made, in addition to the above: @table @asis -@item @acronym{3DES} cipther +@item @acronym{3DES} cipher The @acronym{3DES} stream cipher provides at most 112 bits of effective security, which is considered to be towards the low end. commit 3e7692f07d9e90f495ff4104cf1320954398c9fa Author: Lars Ingebrigtsen <larsi@gnus.org> Date: Mon Jun 25 02:40:25 2018 +0200 Make the intermediary-sha1 check work * lisp/net/nsm.el (nsm-protocol-check--intermediary-sha1): Make the "skip the root cert" logic work (suggested by Noam Postavsky). diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el index 2c4f8bf5ed..146d0d5525 100644 --- a/lisp/net/nsm.el +++ b/lisp/net/nsm.el @@ -256,13 +256,14 @@ HOST PORT STATUS OPTIONAL-PARAMETER.") host port signature-algorithm)))) (defun nsm-protocol-check--intermediary-sha1 (host port status _) - ;; We want to check all intermediary certificates, so we skip the - ;; first, reverse the list and then skip the first again, so we miss - ;; the first and final certificates in the chain. - (cl-loop for certificate in (cdr (reverse - (cdr (plist-get status :certificates)))) + ;; Skip the first certificate, because that's the host certificate. + (cl-loop for certificate in (cdr (plist-get status :certificates)) for algo = (plist-get certificate :signature-algorithm) - when (and (string-match "\\bSHA1\\b" algo) + ;; Don't check root certificates -- SHA1 isn't dangerous + ;; there. + when (and (not (equal (plist-get certificate :issuer) + (plist-get certificate :subject))) + (string-match "\\bSHA1\\b" algo) (not (nsm-query host port status :signature-sha1 "An intermediary certificate used to verify the connection to %s:%s uses the SHA1 algorithm (%s), which is believed to be unsafe." commit cf36693bd4eb25c7d0b90affa87c4739daacf355 Author: Lars Ingebrigtsen <larsi@gnus.org> Date: Mon Jun 25 02:34:37 2018 +0200 Don't use XCAR in possibly-nil situations * src/gnutls.c (Fgnutls_peer_status): certs theoretically may be nil, so don't use XCAR. diff --git a/src/gnutls.c b/src/gnutls.c index 92956923db..a8034d0abb 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -1277,7 +1277,7 @@ The return value is a property list with top-level keys :warnings and /* Return the host certificate in its own element for compatibility reasons. */ - result = nconc2 (result, list2 (intern (":certificate"), XCAR (certs))); + result = nconc2 (result, list2 (intern (":certificate"), Fcar (certs))); } state = XPROCESS (proc)->gnutls_state; commit 190a45f201a9ae41c241a93f4b58c7e60b7a1c59 Author: Noam Postavsky <npostavs@gmail.com> Date: Sun Jun 24 23:57:05 2018 +0200 (Network Security): Fix the description of the 3DES weakness * doc/emacs/misc.texi (Network Security): Fix the description of the 3DES weakness. diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 78f28ccfad..e178d3f347 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -379,8 +379,8 @@ will be made, in addition to the above: @table @asis @item @acronym{3DES} cipther -The @acronym{RC4} stream cipher is believed by some to be of low -quality and may allow eavesdropping by third parties. +The @acronym{3DES} stream cipher provides at most 112 bits of +effective security, which is considered to be towards the low end. @item a validated certificate changes the public key Servers change their keys occasionally, and that is normally nothing commit 5a285a4db97d88cfd7a2320e33542a0afe695665 Author: Lars Ingebrigtsen <larsi@gnus.org> Date: Sun Jun 24 22:57:27 2018 +0200 Make more TLS checks trigger on the default `medium' level * doc/emacs/misc.texi (Network Security): Update the doc to say what's on the different levels. * lisp/net/nsm.el (nsm-protocol-check--intermediary-sha1): Check intermediary certificates for SHA1. (nsm-protocol-check--3des): Check for 3DES ciphers. (network-security-protocol-checks): Put most of the checks on `medium'. diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 177cc8fa46..78f28ccfad 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -352,19 +352,6 @@ over these connections. Similarly, if you're sending email via connection to be encrypted. If the connection isn't encrypted, @acronym{NSM} will warn you. -@end table - -If @code{network-security-level} is @code{high}, the following checks -will be made, in addition to the above: - -@table @asis -@item a validated certificate changes the public key -Servers change their keys occasionally, and that is normally nothing -to be concerned about. However, if you are worried that your network -connections are being hijacked by agencies who have access to pliable -Certificate Authorities which issue new certificates for third-party -services, you may want to keep track of these changes. - @item Diffie-Hellman low prime bits When doing the public key exchange, the number of prime bits should be high to ensure that the channel can't be eavesdropped on by @@ -374,10 +361,34 @@ third parties. If this number is too low, you will be warned. The @acronym{RC4} stream cipher is believed to be of low quality and may allow eavesdropping by third parties. +@item @acronym{SHA1} in the host certificate or in intermediary certificates +It is believed that if an intermediary certificate uses +the @acronym{SHA1} hashing algorithm, then third parties can issue +certificates pretending to be that issuing instance. These +connections are therefore vulnerable to man-in-the-middle attacks. + @item @acronym{SSL1}, @acronym{SSL2} and @acronym{SSL3} The protocols older than @acronym{TLS1.0} are believed to be vulnerable to a variety of attacks, and you may want to avoid using these if what you're doing requires higher security. + +@end table + +If @code{network-security-level} is @code{high}, the following checks +will be made, in addition to the above: + +@table @asis +@item @acronym{3DES} cipther +The @acronym{RC4} stream cipher is believed by some to be of low +quality and may allow eavesdropping by third parties. + +@item a validated certificate changes the public key +Servers change their keys occasionally, and that is normally nothing +to be concerned about. However, if you are worried that your network +connections are being hijacked by agencies who have access to pliable +Certificate Authorities which issue new certificates for third-party +services, you may want to keep track of these changes. + @end table Finally, if @code{network-security-level} is @code{paranoid}, you will diff --git a/etc/NEWS b/etc/NEWS index 8ee4831b6e..d86d5e9817 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -135,6 +135,10 @@ the data. of what checks to run via the `network-security-protocol-checks' variable. ++++ +** Most of the checks for outdated, believed-to-be-weak TLS algorithms +and ciphers are now switched on by default. + +++ ** New function 'fill-polish-nobreak-p', to be used in 'fill-nobreak-predicate'. It blocks line breaking after a one-letter word, also in the case when diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el index 97bfc7d62f..2c4f8bf5ed 100644 --- a/lisp/net/nsm.el +++ b/lisp/net/nsm.el @@ -182,10 +182,12 @@ unencrypted." process)))))) (defvar network-security-protocol-checks - '((diffie-hellman-prime-bits high 1024) - (rc4 high) - (signature-sha1 high) - (ssl high)) + '((diffie-hellman-prime-bits medium 1024) + (rc4 medium) + (signature-sha1 medium) + (intermediary-sha1 medium) + (3des high) + (ssl medium)) "This variable specifies what TLS connection checks to perform. It's an alist where the first element is the name of the check, the second is the security level where the check kicks in, and the @@ -230,6 +232,13 @@ HOST PORT STATUS OPTIONAL-PARAMETER.") "The Diffie-Hellman prime bits (%s) used for this connection to %s:%s is less than what is considered safe (%s)." prime-bits host port bits)))) +(defun nsm-protocol-check--3des (host port status _) + (or (not (string-match "\\b3DES\\b" (plist-get status :cipher))) + (nsm-query + host port status :rc4 + "The connection to %s:%s uses the 3DES cipher (%s), which is believed to be unsafe." + host port (plist-get status :cipher)))) + (defun nsm-protocol-check--rc4 (host port status _) (or (not (string-match "\\bRC4\\b" (nsm--encryption status))) (nsm-query @@ -246,6 +255,21 @@ HOST PORT STATUS OPTIONAL-PARAMETER.") "The certificate used to verify the connection to %s:%s uses the SHA1 algorithm (%s), which is believed to be unsafe." host port signature-algorithm)))) +(defun nsm-protocol-check--intermediary-sha1 (host port status _) + ;; We want to check all intermediary certificates, so we skip the + ;; first, reverse the list and then skip the first again, so we miss + ;; the first and final certificates in the chain. + (cl-loop for certificate in (cdr (reverse + (cdr (plist-get status :certificates)))) + for algo = (plist-get certificate :signature-algorithm) + when (and (string-match "\\bSHA1\\b" algo) + (not (nsm-query + host port status :signature-sha1 + "An intermediary certificate used to verify the connection to %s:%s uses the SHA1 algorithm (%s), which is believed to be unsafe." + host port algo))) + do (cl-return nil) + finally (cl-return t))) + (defun nsm-protocol-check--ssl (host port status _) (let ((protocol (plist-get status :protocol))) (or (not protocol) commit fea8c7d181babe6de7daedfef07b291f8dda2322 Author: Lars Ingebrigtsen <larsi@gnus.org> Date: Sun Jun 24 21:21:56 2018 +0200 Tweak previous gnutls change for efficiency * src/gnutls.c (Fgnutls_peer_status): Minor optimisation to avoid computing the topmost certificate twice. diff --git a/src/gnutls.c b/src/gnutls.c index 5a178472ce..92956923db 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -1268,18 +1268,16 @@ The return value is a property list with top-level keys :warnings and { Lisp_Object certs = Qnil; - /* Return the host certificate in its own element for - compatibility reasons. */ - result = nconc2 (result, list2 - (intern (":certificate"), - gnutls_certificate_details (XPROCESS (proc)->gnutls_certificates[0]))); - /* Return all the certificates in a list. */ for (int i = 0; i < XPROCESS (proc)->gnutls_certificates_length; i++) certs = nconc2 (certs, list1 (gnutls_certificate_details (XPROCESS (proc)->gnutls_certificates[i]))); result = nconc2 (result, list2 (intern (":certificates"), certs)); + + /* Return the host certificate in its own element for + compatibility reasons. */ + result = nconc2 (result, list2 (intern (":certificate"), XCAR (certs))); } state = XPROCESS (proc)->gnutls_state; commit c8745d95cffc348da7ae1e7f6a6c07ec2f4b2f3f Author: Lars Ingebrigtsen <larsi@gnus.org> Date: Sun Jun 24 21:17:37 2018 +0200 Return the entire TLS certificate chain back to the caller * src/gnutls.c (gnutls_deinit_certificates): New function. (Fgnutls_peer_status): Return all certificates in the chain back to Lisp land. (gnutls_verify_boot): Compute all the x509 certificates in the chain. * src/process.h (struct Lisp_Process): Adjust gnutls fields so that we can keep tracks of all certificates in the chain instead of just the host certificate. diff --git a/src/gnutls.c b/src/gnutls.c index 903393fed1..5a178472ce 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -819,6 +819,19 @@ gnutls_make_error (int err) return make_number (err); } +static void +gnutls_deinit_certificates (struct Lisp_Process *p) +{ + if (! p->gnutls_certificates) + return; + + for (int i = 0; i < p->gnutls_certificates_length; i++) + gnutls_x509_crt_deinit (p->gnutls_certificates[i]); + + xfree (p->gnutls_certificates); + p->gnutls_certificates = NULL; +} + Lisp_Object emacs_gnutls_deinit (Lisp_Object proc) { @@ -853,6 +866,9 @@ emacs_gnutls_deinit (Lisp_Object proc) GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT - 1; } + if (XPROCESS (proc)->gnutls_certificates) + gnutls_deinit_certificates (XPROCESS (proc)); + XPROCESS (proc)->gnutls_p = false; return Qt; } @@ -1238,9 +1254,9 @@ The return value is a property list with top-level keys :warnings and /* This could get called in the INIT stage, when the certificate is not yet set. */ - if (XPROCESS (proc)->gnutls_certificate != NULL && - gnutls_x509_crt_check_issuer(XPROCESS (proc)->gnutls_certificate, - XPROCESS (proc)->gnutls_certificate)) + if (XPROCESS (proc)->gnutls_certificates != NULL && + gnutls_x509_crt_check_issuer(XPROCESS (proc)->gnutls_certificates[0], + XPROCESS (proc)->gnutls_certificates[0])) warnings = Fcons (intern (":self-signed"), warnings); if (!NILP (warnings)) @@ -1248,10 +1264,23 @@ The return value is a property list with top-level keys :warnings and /* This could get called in the INIT stage, when the certificate is not yet set. */ - if (XPROCESS (proc)->gnutls_certificate != NULL) - result = nconc2 (result, list2 - (intern (":certificate"), - gnutls_certificate_details (XPROCESS (proc)->gnutls_certificate))); + if (XPROCESS (proc)->gnutls_certificates != NULL) + { + Lisp_Object certs = Qnil; + + /* Return the host certificate in its own element for + compatibility reasons. */ + result = nconc2 (result, list2 + (intern (":certificate"), + gnutls_certificate_details (XPROCESS (proc)->gnutls_certificates[0]))); + + /* Return all the certificates in a list. */ + for (int i = 0; i < XPROCESS (proc)->gnutls_certificates_length; i++) + certs = nconc2 (certs, list1 (gnutls_certificate_details + (XPROCESS (proc)->gnutls_certificates[i]))); + + result = nconc2 (result, list2 (intern (":certificates"), certs)); + } state = XPROCESS (proc)->gnutls_state; @@ -1394,7 +1423,7 @@ gnutls_verify_boot (Lisp_Object proc, Lisp_Object proplist) if (ret < GNUTLS_E_SUCCESS) return gnutls_make_error (ret); - XPROCESS (proc)->gnutls_peer_verification = peer_verification; + p->gnutls_peer_verification = peer_verification; warnings = Fplist_get (Fgnutls_peer_status (proc), intern (":warnings")); if (!NILP (warnings)) @@ -1431,49 +1460,61 @@ gnutls_verify_boot (Lisp_Object proc, Lisp_Object proplist) can be easily extended to work with openpgp keys as well. */ if (gnutls_certificate_type_get (state) == GNUTLS_CRT_X509) { - gnutls_x509_crt_t gnutls_verify_cert; - const gnutls_datum_t *gnutls_verify_cert_list; - unsigned int gnutls_verify_cert_list_size; - - ret = gnutls_x509_crt_init (&gnutls_verify_cert); - if (ret < GNUTLS_E_SUCCESS) - return gnutls_make_error (ret); + const gnutls_datum_t *cert_list; + unsigned int cert_list_length; + int failed_import = 0; - gnutls_verify_cert_list - = gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size); + cert_list = gnutls_certificate_get_peers (state, &cert_list_length); - if (gnutls_verify_cert_list == NULL) + if (cert_list == NULL) { - gnutls_x509_crt_deinit (gnutls_verify_cert); emacs_gnutls_deinit (proc); boot_error (p, "No x509 certificate was found\n"); return Qnil; } - /* Check only the first certificate in the given chain. */ - ret = gnutls_x509_crt_import (gnutls_verify_cert, - &gnutls_verify_cert_list[0], - GNUTLS_X509_FMT_DER); + /* Check only the first certificate in the given chain, but + store them all. */ + p->gnutls_certificates = + xmalloc (cert_list_length * sizeof (gnutls_x509_crt_t)); + p->gnutls_certificates_length = cert_list_length; - if (ret < GNUTLS_E_SUCCESS) + for (int i = cert_list_length - 1; i >= 0; i--) { - gnutls_x509_crt_deinit (gnutls_verify_cert); - return gnutls_make_error (ret); + gnutls_x509_crt_t cert; + + gnutls_x509_crt_init (&cert); + + if (ret < GNUTLS_E_SUCCESS) + failed_import = ret; + else + { + ret = gnutls_x509_crt_import (cert, &cert_list[i], + GNUTLS_X509_FMT_DER); + + if (ret < GNUTLS_E_SUCCESS) + failed_import = ret; + } + + p->gnutls_certificates[i] = cert; } - XPROCESS (proc)->gnutls_certificate = gnutls_verify_cert; + if (failed_import != 0) + { + gnutls_deinit_certificates (p); + p->gnutls_certificates = NULL; + return gnutls_make_error (failed_import); + } - int err = gnutls_x509_crt_check_hostname (gnutls_verify_cert, + int err = gnutls_x509_crt_check_hostname (p->gnutls_certificates[0], c_hostname); check_memory_full (err); if (!err) { - XPROCESS (proc)->gnutls_extra_peer_verification - |= CERTIFICATE_NOT_MATCHING; + p->gnutls_extra_peer_verification |= CERTIFICATE_NOT_MATCHING; if (verify_error_all || !NILP (Fmember (QChostname, verify_error))) { - gnutls_x509_crt_deinit (gnutls_verify_cert); emacs_gnutls_deinit (proc); boot_error (p, "The x509 certificate does not match \"%s\"", c_hostname); @@ -1486,7 +1527,7 @@ gnutls_verify_boot (Lisp_Object proc, Lisp_Object proplist) } /* Set this flag only if the whole initialization succeeded. */ - XPROCESS (proc)->gnutls_p = true; + p->gnutls_p = true; return gnutls_make_error (ret); } @@ -1855,7 +1896,8 @@ This function may also return `gnutls-e-again', or state = XPROCESS (proc)->gnutls_state; - gnutls_x509_crt_deinit (XPROCESS (proc)->gnutls_certificate); + if (XPROCESS (proc)->gnutls_certificates) + gnutls_deinit_certificates (XPROCESS (proc)); ret = gnutls_bye (state, NILP (cont) ? GNUTLS_SHUT_RDWR : GNUTLS_SHUT_WR); diff --git a/src/process.h b/src/process.h index 42cc66ec56..6bc22146a7 100644 --- a/src/process.h +++ b/src/process.h @@ -194,7 +194,8 @@ struct Lisp_Process gnutls_session_t gnutls_state; gnutls_certificate_client_credentials gnutls_x509_cred; gnutls_anon_client_credentials_t gnutls_anon_cred; - gnutls_x509_crt_t gnutls_certificate; + gnutls_x509_crt_t *gnutls_certificates; + int gnutls_certificates_length; unsigned int gnutls_peer_verification; unsigned int gnutls_extra_peer_verification; int gnutls_log_level; commit cd5bb4bf3dbad8941d25823f398b595b8f0edbb9 Author: Tom Tromey <tom@tromey.com> Date: Sun Jun 24 11:18:19 2018 -0600 Fix two tcl-mode defun-related bugs Fixes bug#23565 * lisp/progmodes/tcl.el (tcl-mode): Set beginning-of-defun-function and end-of-defun-function. (tcl-beginning-of-defun-function, tcl-end-of-defun-function): New defuns. * test/lisp/progmodes/tcl-tests.el: New file. diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el index 0d9322359c..fad62e100a 100644 --- a/lisp/progmodes/tcl.el +++ b/lisp/progmodes/tcl.el @@ -611,6 +611,9 @@ already exist." (set (make-local-variable 'add-log-current-defun-function) 'tcl-add-log-defun) + (setq-local beginning-of-defun-function #'tcl-beginning-of-defun-function) + (setq-local end-of-defun-function #'tcl-end-of-defun-function) + (easy-menu-add tcl-mode-menu) ;; Append Tcl menu to popup menu for XEmacs. (if (boundp 'mode-popup-menu) @@ -993,15 +996,49 @@ Returns nil if line starts inside a string, t if in a comment." ;; Interfaces to other packages. ;; -;; FIXME Definition of function is very ad-hoc. Should use -;; beginning-of-defun. Also has incestuous knowledge about the -;; format of tcl-proc-regexp. +(defun tcl-beginning-of-defun-function (&optional arg) + "`beginning-of-defun-function' for Tcl mode." + (when (or (not arg) (= arg 0)) + (setq arg 1)) + (let* ((search-fn (if (> arg 0) + ;; Positive arg means to search backward. + #'re-search-backward + #'re-search-forward)) + (arg (abs arg)) + (result t)) + (while (and (> arg 0) result) + (unless (funcall search-fn tcl-proc-regexp nil t) + (setq result nil)) + (setq arg (1- arg))) + result)) + +(defun tcl-end-of-defun-function () + "`end-of-defun-function' for Tcl mode." + ;; Because we let users redefine tcl-proc-list, we don't really know + ;; too much about the exact arguments passed to the "proc"-defining + ;; command. Instead we just skip words and lists until we see + ;; either a ";" or a newline, either of which terminates a command. + (skip-syntax-forward "-") + (while (and (not (eobp)) + (not (looking-at-p "[\n;]"))) + (condition-case nil + (forward-sexp) + (scan-error + (goto-char (point-max)))) + ;; Note that here we do not want to skip \n. + (skip-chars-forward " \t"))) + (defun tcl-add-log-defun () "Return name of Tcl function point is in, or nil." (save-excursion - (end-of-line) - (if (re-search-backward (concat tcl-proc-regexp "\\([^ \t\n{]+\\)") nil t) - (match-string 2)))) + (let ((orig-point (point))) + (when (beginning-of-defun) + ;; Only return the name when in the body of the function. + (when (save-excursion + (end-of-defun) + (>= (point) orig-point)) + (when (looking-at (concat tcl-proc-regexp "\\([^ \t\n{]+\\)")) + (match-string 2))))))) (defun tcl-outline-level () (save-excursion diff --git a/test/lisp/progmodes/tcl-tests.el b/test/lisp/progmodes/tcl-tests.el new file mode 100644 index 0000000000..55211b70be --- /dev/null +++ b/test/lisp/progmodes/tcl-tests.el @@ -0,0 +1,68 @@ +;;; tcl-tests.el --- Test suite for tcl-mode + +;; Copyright (C) 2018 Free Software Foundation, Inc. + +;; 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 'ert) +(require 'tcl) + +;; From bug#23565 +(ert-deftest tcl-mode-beginning-of-defun-1 () + (with-temp-buffer + (tcl-mode) + (insert "proc bad {{value \"\"}} {\n # do something\n}") + (should (beginning-of-defun)) + (should (= (point) (point-min))) + (end-of-defun) + (should (= (point) (point-max))))) + +;; From bug#23565 +(ert-deftest tcl-mode-beginning-of-defun-2 () + (with-temp-buffer + (tcl-mode) + (insert "proc good {{value}} {\n # do something\n}") + (should (beginning-of-defun)) + (should (= (point) (point-min))) + (end-of-defun) + (should (= (point) (point-max))))) + +(ert-deftest tcl-mode-function-name () + (with-temp-buffer + (tcl-mode) + (insert "proc notinthis {} {\n # nothing\n}\n\n") + (should-not (add-log-current-defun)))) + +(ert-deftest tcl-mode-function-name () + (with-temp-buffer + (tcl-mode) + (insert "proc simple {} {\n # nothing\n}") + (backward-char 3) + (should (equal "simple" (add-log-current-defun))))) + +(ert-deftest tcl-mode-function-name () + (with-temp-buffer + (tcl-mode) + (insert "proc inthis {} {\n # nothing\n") + (should (equal "inthis" (add-log-current-defun))))) + +(provide 'tcl-tests) + +;;; tcl-tests.el ends here commit b419f27a43702045f8cd87282d89dccc9c39fd9d Author: Eli Zaretskii <eliz@gnu.org> Date: Sun Jun 24 19:23:13 2018 +0300 ; * doc/emacs/files.texi (Interlocking): Fix a non-portable @xref. diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 821d8c1ead..a13a2c5bb0 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -773,7 +773,7 @@ visiting a file, Emacs records that the file is @dfn{locked} by you. (It does this by creating a specially-named symbolic link@footnote{If your file system does not support symbolic links, a regular file is used.} with special contents in the same directory. @xref{File -Locks,,, elisp} for more details.) Emacs removes the lock when you +Locks,,, elisp}, for more details.) Emacs removes the lock when you save the changes. The idea is that the file is locked whenever an Emacs buffer visiting it has unsaved changes. commit 7488de4f277f1396eaa7fe7322fa599dacaf8882 Author: Noam Postavsky <npostavs@gmail.com> Date: Sun Jun 24 10:57:12 2018 -0400 * lisp/emacs-lisp/regexp-opt.el (regexp-opt): Fix docstring quotes. diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el index 3e05b6cb8c..8de4959c10 100644 --- a/lisp/emacs-lisp/regexp-opt.el +++ b/lisp/emacs-lisp/regexp-opt.el @@ -117,12 +117,12 @@ than that of a simplified version: (defun simplified-regexp-opt (strings &optional paren) (let ((parens (cond ((stringp paren) (cons paren \"\\\\)\")) - ((eq paren 'words) '(\"\\\\\\=<\\\\(\" . \"\\\\)\\\\>\")) - ((eq paren 'symbols) '(\"\\\\_<\\\\(\" . \"\\\\)\\\\_>\")) - ((null paren) '(\"\\\\(?:\" . \"\\\\)\")) - (t '(\"\\\\(\" . \"\\\\)\"))))) + ((eq paren \\='words) \\='(\"\\\\\\=<\\\\(\" . \"\\\\)\\\\>\")) + ((eq paren \\='symbols) \\='(\"\\\\_<\\\\(\" . \"\\\\)\\\\_>\")) + ((null paren) \\='(\"\\\\(?:\" . \"\\\\)\")) + (t \\='(\"\\\\(\" . \"\\\\)\"))))) (concat (car paren) - (mapconcat 'regexp-quote strings \"\\\\|\") + (mapconcat \\='regexp-quote strings \"\\\\|\") (cdr paren))))" (save-match-data ;; Recurse on the sorted list. commit eaa054a94b786ce7dc4169c9b14893f50335f657 Author: Lars Ingebrigtsen <larsi@gnus.org> Date: Sun Jun 24 15:40:43 2018 +0200 Fix reverse test in previous check-in * lisp/net/nsm.el (nsm-check-protocol): Fix reverse test in previous check-in. diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el index 8f09e8dfa9..97bfc7d62f 100644 --- a/lisp/net/nsm.el +++ b/lisp/net/nsm.el @@ -202,8 +202,8 @@ HOST PORT STATUS OPTIONAL-PARAMETER.") ;; Skip the check if the user has already said that this ;; host is OK for this type of "error". when (and (not (memq type (plist-get settings :conditions))) - (< (nsm-level network-security-level) - (nsm-level (cadr check)))) + (>= (nsm-level network-security-level) + (nsm-level (cadr check)))) do (let ((result (funcall (intern (format "nsm-protocol-check--%s" (car check)) commit 6584bc6720fce6a830ab18538f89acc80da597f1 Author: Lars Ingebrigtsen <larsi@gnus.org> Date: Sun Jun 24 15:36:50 2018 +0200 Refactor the protocol NSM checks for flexibility * doc/emacs/misc.texi (Network Security): Mention network-security-protocol-checks. * lisp/net/nsm.el (network-security-protocol-checks): New variable. (nsm-check-protocol): Refactor the checks into separate functions for greater flexibility. (nsm-protocol-check--diffie-hellman-prime-bits) (nsm-protocol-check--rc4, nsm-protocol-check--ssl) (nsm-protocol-check--signature-sha1): Refactored out of the big function. diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 24586eb281..177cc8fa46 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -402,6 +402,22 @@ This means that one can't casually read the settings file to see what servers the user has connected to. If this variable is @code{t}, @acronym{NSM} will also save host names in the @code{nsm-settings-file}. + +@item network-security-protocol-checks +@vindex network-security-protocol-checks +The protocol network checks (mostly for @acronym{TLS} weaknesses) is +controlled via the @code{network-security-protocol-checks} variable. + +It's an alist where the first element is the name of the check, +the second is the security level where the check kicks in, and the +optional third element is a parameter supplied to the check. + +An element like @code{(rc4 medium)} will result in the function +@code{nsm-protocol-check--rc4} being called like thus: +@code{(nsm-protocol-check--rc4 host port status optional-parameter)}. +The function should return non-@code{nil} if the connection should +proceed and @code{nil} otherwise. + @end table diff --git a/etc/NEWS b/etc/NEWS index 12757f61d2..8ee4831b6e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -130,6 +130,11 @@ obsolete, and the new utility function 'xml-remove-comments' can be used to remove comments before calling the libxml functions to parse the data. ++++ +** The Network Security Manager now allows more fine-grained control +of what checks to run via the `network-security-protocol-checks' +variable. + +++ ** New function 'fill-polish-nobreak-p', to be used in 'fill-nobreak-predicate'. It blocks line breaking after a one-letter word, also in the case when diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el index d6fe967fc7..8f09e8dfa9 100644 --- a/lisp/net/nsm.el +++ b/lisp/net/nsm.el @@ -26,6 +26,7 @@ (require 'cl-lib) (require 'rmc) ; read-multiple-choice +(require 'subr-x) (defvar nsm-permanent-host-settings nil) (defvar nsm-temporary-host-settings nil) @@ -118,12 +119,10 @@ unencrypted." process)))))) (defun nsm-check-tls-connection (process host port status settings) - (let ((process (nsm-check-certificate process host port status settings))) - (if (and process - (>= (nsm-level network-security-level) (nsm-level 'high))) - ;; Do further protocol-level checks if the security is high. - (nsm-check-protocol process host port status settings) - process))) + (when-let ((process + (nsm-check-certificate process host port status settings))) + ;; Do further protocol-level checks. + (nsm-check-protocol process host port status settings))) (declare-function gnutls-peer-status-warning-describe "gnutls.c" (status-symbol)) @@ -182,57 +181,79 @@ unencrypted." nil) process)))))) +(defvar network-security-protocol-checks + '((diffie-hellman-prime-bits high 1024) + (rc4 high) + (signature-sha1 high) + (ssl high)) + "This variable specifies what TLS connection checks to perform. +It's an alist where the first element is the name of the check, +the second is the security level where the check kicks in, and the +optional third element is a parameter supplied to the check. + +An element like `(rc4 medium)' will result in the function +`nsm-protocol-check--rc4' being called with the parameters +HOST PORT STATUS OPTIONAL-PARAMETER.") + (defun nsm-check-protocol (process host port status settings) - (let ((prime-bits (plist-get status :diffie-hellman-prime-bits)) - (signature-algorithm - (plist-get (plist-get status :certificate) :signature-algorithm)) - (encryption (format "%s-%s-%s" - (plist-get status :key-exchange) - (plist-get status :cipher) - (plist-get status :mac))) - (protocol (plist-get status :protocol))) - (cond - ((and prime-bits - (< prime-bits 1024) - (not (memq :diffie-hellman-prime-bits - (plist-get settings :conditions))) - (not - (nsm-query - host port status :diffie-hellman-prime-bits - "The Diffie-Hellman prime bits (%s) used for this connection to %s:%s is less than what is considered safe (%s)." - prime-bits host port 1024))) - (delete-process process) - nil) - ((and (string-match "\\bRC4\\b" encryption) - (not (memq :rc4 (plist-get settings :conditions))) - (not - (nsm-query - host port status :rc4 - "The connection to %s:%s uses the RC4 algorithm (%s), which is believed to be unsafe." - host port encryption))) - (delete-process process) - nil) - ((and (string-match "\\bSHA1\\b" signature-algorithm) - (not (memq :signature-sha1 (plist-get settings :conditions))) - (not - (nsm-query - host port status :signature-sha1 - "The certificate used to verify the connection to %s:%s uses the SHA1 algorithm (%s), which is believed to be unsafe." - host port signature-algorithm))) - (delete-process process) - nil) - ((and protocol - (string-match "SSL" protocol) - (not (memq :ssl (plist-get settings :conditions))) - (not - (nsm-query - host port status :ssl - "The connection to %s:%s uses the %s protocol, which is believed to be unsafe." - host port protocol))) - (delete-process process) - nil) - (t - process)))) + (cl-loop for check in network-security-protocol-checks + for type = (intern (format ":%s" (car check)) obarray) + while process + ;; Skip the check if the user has already said that this + ;; host is OK for this type of "error". + when (and (not (memq type (plist-get settings :conditions))) + (< (nsm-level network-security-level) + (nsm-level (cadr check)))) + do (let ((result + (funcall (intern (format "nsm-protocol-check--%s" + (car check)) + obarray) + host port status (nth 2 check)))) + (unless result + (delete-process process) + (setq process nil)))) + ;; If a test failed we return nil, otherwise the process object. + process) + +(defun nsm--encryption (status) + (format "%s-%s-%s" + (plist-get status :key-exchange) + (plist-get status :cipher) + (plist-get status :mac))) + +(defun nsm-protocol-check--diffie-hellman-prime-bits (host port status bits) + (let ((prime-bits (plist-get status :diffie-hellman-prime-bits))) + (or (not prime-bits) + (>= prime-bits bits) + (nsm-query + host port status :diffie-hellman-prime-bits + "The Diffie-Hellman prime bits (%s) used for this connection to %s:%s is less than what is considered safe (%s)." + prime-bits host port bits)))) + +(defun nsm-protocol-check--rc4 (host port status _) + (or (not (string-match "\\bRC4\\b" (nsm--encryption status))) + (nsm-query + host port status :rc4 + "The connection to %s:%s uses the RC4 algorithm (%s), which is believed to be unsafe." + host port (nsm--encryption status)))) + +(defun nsm-protocol-check--signature-sha1 (host port status _) + (let ((signature-algorithm + (plist-get (plist-get status :certificate) :signature-algorithm))) + (or (not (string-match "\\bSHA1\\b" signature-algorithm)) + (nsm-query + host port status :signature-sha1 + "The certificate used to verify the connection to %s:%s uses the SHA1 algorithm (%s), which is believed to be unsafe." + host port signature-algorithm)))) + +(defun nsm-protocol-check--ssl (host port status _) + (let ((protocol (plist-get status :protocol))) + (or (not protocol) + (not (string-match "SSL" protocol)) + (nsm-query + host port status :ssl + "The connection to %s:%s uses the %s protocol, which is believed to be unsafe." + host port protocol)))) (defun nsm-fingerprint (status) (plist-get (plist-get status :certificate) :public-key-id)) commit 0b69807015d2d6d6c0ee5e7c6400e63ef1c97ff8 Author: Simen Heggestøyl <simenheg@gmail.com> Date: Sun Jun 24 14:23:57 2018 +0200 Make a minor update to the CSS mode docstring * lisp/textmodes/css-mode.el (css-mode): Mention 'fill-paragraph'. diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index febf7c6613..62dca463ae 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -1402,6 +1402,9 @@ Use `\\[info-lookup-symbol]' to look up documentation of CSS properties, at-rule pseudo-classes, and pseudo-elements on the Mozilla Developer Network (MDN). +Use `\\[fill-paragraph]' to reformat CSS declaration blocks. It can also +be used to fill comments. + \\{css-mode-map}" (setq-local font-lock-defaults css-font-lock-defaults) (setq-local comment-start "/*") commit 9a53b6d4260bde138117be385d5f626122f49904 Author: Karl Fogel <kfogel@red-bean.com> Date: Sun Jun 24 07:10:43 2018 -0500 Say how to override a primitive interactive spec * doc/lispref/internals.texi (Writing Emacs Primitives): Mention that the `interactive-form' property can be used to override a primitive interactive specification, and refer to the detailed documentation for setting that property. From this thread on Emacs Devel: https://lists.gnu.org/archive/html/emacs-devel/2018-03/msg00923.html From: Eli Zaretskii To: Karl Fogel CC: Juri Linkov, Emacs Devel Subject: Re: [Emacs-diffs] \ master b88e7c8: Make transpose-regions interactive (Bug#30343) Date: Thu, 29 Mar 2018 14:38:15 +0300 Message-Id: <834lkzdsd4.fsf@gnu.org> diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index e6043357a1..25333270c3 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -743,6 +743,11 @@ DEFUN ("foo", Ffoo, Sfoo, 0, UNEVALLED, 0 @end group @end example +If you wish to override a primitive interactive specification, just +set the @code{interactive-form} property of the primitive function's +symbol (@pxref{Using Interactive}). There is no need to edit C code +and recompile Emacs. + @item doc This is the documentation string. It uses C comment syntax rather than C string syntax because comment syntax requires nothing special commit 1d7707886d9b2903666fdcfd7c7962b5e17e6b36 Author: Michael Albinus <michael.albinus@gmx.de> Date: Sun Jun 24 10:24:26 2018 +0200 Fix Bug#31941 * lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file): In case of FILENAME being a directory, check whether `copy-directory' could be avoided. Suggested by Stephen Nutt <stnutt@gmail.com>. (Bug#31941) (tramp-do-copy-or-rename-file-directly): Call "cp" with "-r". diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 02fb8648d8..3e99ab567f 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2038,7 +2038,9 @@ file names." (unless (memq op '(copy rename)) (error "Unknown operation `%s', must be `copy' or `rename'" op)) - (if (file-directory-p filename) + (if (and + (file-directory-p filename) + (not (tramp-equal-remote filename newname))) (progn (copy-directory filename newname keep-date t) (when (eq op 'rename) (delete-directory filename 'recursive))) @@ -2187,8 +2189,8 @@ the uid and gid from FILENAME." (file-attributes filename))) (file-modes (tramp-default-file-modes filename))) (with-parsed-tramp-file-name (if t1 filename newname) nil - (let* ((cmd (cond ((and (eq op 'copy) preserve-uid-gid) "cp -f -p") - ((eq op 'copy) "cp -f") + (let* ((cmd (cond ((and (eq op 'copy) preserve-uid-gid) "cp -f -r -p") + ((eq op 'copy) "cp -f -r") ((eq op 'rename) "mv -f") (t (tramp-error v 'file-error commit 16c2f03c15078c4bd98c4b1e4d15701ba45550c3 Merge: de05ecd116 bbc9d3793d Author: Glenn Morris <rgm@gnu.org> Date: Sat Jun 23 07:51:00 2018 -0700 Merge from origin/emacs-26 bbc9d37 (origin/emacs-26) Fix previous change in minibuffer-default-a... 7caeef1 * src/editfns.c (Fformat): Make %x easier to spot in doc stri... ecc29fb Improve responsiveness while in 'replace-buffer-contents' 8182d64 Improve documentation of 'server-start' and friends decdfed Clarify wording about functions' argument lists 5abac8b * lisp/doc-view.el: Fix typos in the commentary. (Bug#31937) commit de05ecd1166ba319508a9195bf4f6e4cf82ac10b Merge: b81e193ac0 a37cbbcd4a Author: Glenn Morris <rgm@gnu.org> Date: Sat Jun 23 07:51:00 2018 -0700 ; Merge from origin/emacs-26 The following commit was skipped: a37cbbc Merge branch 'emacs-26' of git.savannah.gnu.org:/srv/git/emac... commit b81e193ac0c4644d041a4eb4fa4cb62cf9446bd6 Merge: 4df361557c 5cb3991a4f Author: Glenn Morris <rgm@gnu.org> Date: Sat Jun 23 07:50:59 2018 -0700 Merge from origin/emacs-26 5cb3991 Fix a typo in emacs-lisp-intro.texi d6aa55e Avoid segfaults in replace-buffer-contents with large buffers d22b8d1 Adjust for scaling for mode-line popup menus (Bug#31880) 3d2e3dc Change name of `seqp' argument (Bug#26411) 40e1db8 Change index of ";" to better reflect it's usage (Bug#31623) d289e7e Fix bug of 'mouse-drag-and-drop-region' to detect edges of re... e292c09 Fix #'fun handling inside `labels' (Bug#31792) commit bbc9d3793d86b855045ed322253f687fcd82aa68 Author: Leo Liu <sdl.web@gmail.com> Date: Tue Jun 12 12:24:09 2018 +0800 Fix previous change in minibuffer-default-add-dired-shell-commands The mailcap minibuffer completion used dynamic binding. Locally set a dynamic variable. * lisp/dired-aux.el (minibuffer-default-add-dired-shell-commands): Store list of files in 'minibuffer-completion-table'. (Bug#31794) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index c336103f80..516cd2c567 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -614,14 +614,16 @@ with a prefix argument." (declare-function mailcap-file-default-commands "mailcap" (files)) +(defvar dired-aux-files) + (defun minibuffer-default-add-dired-shell-commands () "Return a list of all commands associated with current dired files. This function is used to add all related commands retrieved by `mailcap' to the end of the list of defaults just after the default value." (interactive) - (let* ((files minibuffer-completion-table) - (commands (and (require 'mailcap nil t) - (mailcap-file-default-commands files)))) + (let ((commands (and (boundp 'dired-aux-files) + (require 'mailcap nil t) + (mailcap-file-default-commands dired-aux-files)))) (if (listp minibuffer-default) (append minibuffer-default commands) (cons minibuffer-default commands)))) @@ -639,9 +641,9 @@ This normally reads using `read-shell-command', but if the offer a smarter default choice of shell command." (minibuffer-with-setup-hook (lambda () - (set (make-local-variable 'minibuffer-completion-table) files) - (set (make-local-variable 'minibuffer-default-add-function) - 'minibuffer-default-add-dired-shell-commands)) + (setq-local dired-aux-files files) + (setq-local minibuffer-default-add-function + #'minibuffer-default-add-dired-shell-commands)) (setq prompt (format prompt (dired-mark-prompt arg files))) (if (functionp 'dired-guess-shell-command) (dired-mark-pop-up nil 'shell files commit 7caeef1622114d62570d507c4b4ba0f647bb4491 Author: Eli Zaretskii <eliz@gnu.org> Date: Sat Jun 23 15:34:14 2018 +0300 * src/editfns.c (Fformat): Make %x easier to spot in doc string. (Bug#31945) diff --git a/src/editfns.c b/src/editfns.c index 7c58391eb1..4fba68692b 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -4105,7 +4105,8 @@ the next available argument, or the argument explicitly specified: %s means print a string argument. Actually, prints any object, with `princ'. %d means print as signed number in decimal. -%o means print as unsigned number in octal, %x as unsigned number in hex. +%o means print as unsigned number in octal. +%x means print as unsigned number in hex. %X is like %x, but uses upper case. %e means print a number in exponential notation. %f means print a number in decimal-point notation. commit ecc29fbd5a73b55d4624c240b8a2d0a01d699e47 Author: Eli Zaretskii <eliz@gnu.org> Date: Sat Jun 23 14:03:10 2018 +0300 Improve responsiveness while in 'replace-buffer-contents' * src/editfns.c (buffer_chars_equal): Avoid calling buf_charpos_to_bytepos when the buffer is plain-ASCII. Suggested by Milan Stanojević <mstanojevic@janestreet.com>. Call maybe_quit to improve responsiveness. (Freplace_buffer_contents): Call maybe_quit. Warn in the doc string that the function could be slow. (Bug#31888) diff --git a/src/editfns.c b/src/editfns.c index d15ae59029..7c58391eb1 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -3147,7 +3147,9 @@ SOURCE can be a buffer or a string that names a buffer. Interactively, prompt for SOURCE. As far as possible the replacement is non-destructive, i.e. existing buffer contents, markers, properties, and overlays in the current -buffer stay intact. */) +buffer stay intact. +Warning: this function can be slow if there's a large number of small +differences between the two buffers. */) (Lisp_Object source) { struct buffer *a = current_buffer; @@ -3227,11 +3229,16 @@ buffer stay intact. */) walk backwards, we don’t have to keep the positions in sync. */ while (i >= 0 || j >= 0) { + /* Allow the user to quit if this gets too slow. */ + maybe_quit (); + /* Check whether there is a change (insertion or deletion) before the current position. */ if ((i > 0 && bit_is_set (ctx.deletions, i - 1)) || (j > 0 && bit_is_set (ctx.insertions, j - 1))) { + maybe_quit (); + ptrdiff_t end_a = min_a + i; ptrdiff_t end_b = min_b + j; /* Find the beginning of the current change run. */ @@ -3305,14 +3312,20 @@ buffer_chars_equal (struct context *ctx, eassert (pos_b >= BUF_BEGV (ctx->buffer_b)); eassert (pos_b < BUF_ZV (ctx->buffer_b)); + bool a_unibyte = BUF_ZV (ctx->buffer_a) == BUF_ZV_BYTE (ctx->buffer_a); + bool b_unibyte = BUF_ZV (ctx->buffer_b) == BUF_ZV_BYTE (ctx->buffer_b); + + /* Allow the user to escape out of a slow compareseq call. */ + maybe_quit (); + ptrdiff_t bpos_a = - NILP (BVAR (ctx->buffer_a, enable_multibyte_characters)) - ? pos_a - : buf_charpos_to_bytepos (ctx->buffer_a, pos_a); + a_unibyte ? pos_a : buf_charpos_to_bytepos (ctx->buffer_a, pos_a); ptrdiff_t bpos_b = - NILP (BVAR (ctx->buffer_b, enable_multibyte_characters)) - ? pos_b - : buf_charpos_to_bytepos (ctx->buffer_b, pos_b); + b_unibyte ? pos_b : buf_charpos_to_bytepos (ctx->buffer_b, pos_b); + + if (a_unibyte && b_unibyte) + return BUF_FETCH_BYTE (ctx->buffer_a, bpos_a) + == BUF_FETCH_BYTE (ctx->buffer_b, bpos_b); return BUF_FETCH_CHAR_AS_MULTIBYTE (ctx->buffer_a, bpos_a) == BUF_FETCH_CHAR_AS_MULTIBYTE (ctx->buffer_b, bpos_b); commit 4df361557c3f1b4039fa59d23cd1ed66c2ca5b1c Author: Michael Albinus <michael.albinus@gmx.de> Date: Sat Jun 23 10:18:55 2018 +0200 * lisp/net/tramp-sh.el (tramp-get-ls-command-with): Fix typo. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 9bedce78c8..63b39a0378 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -5359,7 +5359,7 @@ Nonexistent directories are removed from spec." (tramp-send-command-and-check vec (format - "%s ls --help 2>&1 | grep -iq busybox" (tramp-get-ls-command vec)))) + "%s --help 2>&1 | grep -iq busybox" (tramp-get-ls-command vec)))) (tramp-send-command-and-check vec (format "%s %s -al /dev/null" (tramp-get-ls-command vec) option)) option))) commit 8182d648cb18fb048495c761db7c21fbf3c2a624 Author: Eli Zaretskii <eliz@gnu.org> Date: Sat Jun 23 10:50:58 2018 +0300 Improve documentation of 'server-start' and friends * lisp/server.el (server-start, server-running-p): Document how to reliably check that the current Emacs process started the server. (Bug#31859) diff --git a/lisp/server.el b/lisp/server.el index ac0d701851..270eff55dc 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -599,7 +599,10 @@ running, ask the user for confirmation first, unless optional argument INHIBIT-PROMPT is non-nil. To force-start a server, do \\[server-force-delete] and then -\\[server-start]." +\\[server-start]. + +To check from a Lisp program whether a server is running, use +the `server-process' variable." (interactive "P") (when (or (not server-clients) ;; Ask the user before deleting existing clients---except @@ -725,7 +728,11 @@ Return values: nil the server is definitely not running. t the server seems to be running. something else we cannot determine whether it's running without using - commands which may have to wait for a long time." + commands which may have to wait for a long time. + +This function can return non-nil if the server was started by some other +Emacs process. To check from a Lisp program whether a server was started +by the current Emacs process, use the `server-process' variable." (unless name (setq name server-name)) (condition-case nil (if server-use-tcp commit decdfedf029904c3ecaa082e59e2501572ec77c9 Author: Eli Zaretskii <eliz@gnu.org> Date: Sat Jun 23 10:38:44 2018 +0300 Clarify wording about functions' argument lists * doc/lispref/functions.texi (Argument List): Clarify the wording. (Bug#31872) diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 86181f1b49..93059e8e3a 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -412,10 +412,14 @@ variables that tell you whether an argument was explicitly passed. binds @code{a} and @code{b} to the first two actual arguments, which are required. If one or two more arguments are provided, @code{c} and @code{d} are bound to them respectively; any arguments after the first -four are collected into a list and @code{e} is bound to that list. If -there are only two arguments, @code{c} is @code{nil}; if two or three -arguments, @code{d} is @code{nil}; if four arguments or fewer, @code{e} -is @code{nil}. +four are collected into a list and @code{e} is bound to that list. +Thus, if there are only two arguments, @code{c}, @code{d} and @code{e} +are @code{nil}; if two or three arguments, @code{d} and @code{e} are +@code{nil}; if four arguments or fewer, @code{e} is @code{nil}. Note +that exactly five arguments with an explicit @code{nil} argument +provided for @code{e} will cause that @code{nil} argument to be passed +as a list with one element, @code{(nil)}, as with any other single +value for @code{e}. There is no way to have required arguments following optional ones---it would not make sense. To see why this must be so, suppose commit 5abac8bf81ea4f5d7a9f7b008852c4d80d806c88 Author: Eli Zaretskii <eliz@gnu.org> Date: Sat Jun 23 10:26:33 2018 +0300 * lisp/doc-view.el: Fix typos in the commentary. (Bug#31937) diff --git a/lisp/doc-view.el b/lisp/doc-view.el index dfc4d887ae..4a4862f828 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -39,7 +39,7 @@ ;; ;; C-x C-f ~/path/to/document RET ;; -;; and the document will be converted and displayed, if your emacs supports png +;; and the document will be converted and displayed, if your emacs supports PNG ;; images. With `C-c C-c' you can toggle between the rendered images ;; representation and the source text representation of the document. ;; @@ -50,7 +50,7 @@ ;; `doc-view-clear-cache'. To open the cache with dired, so that you can tidy ;; it out use `doc-view-dired-cache'. ;; -;; When conversion in underway the first page will be displayed as soon as it +;; When conversion is underway the first page will be displayed as soon as it ;; is available and the available pages are refreshed every ;; `doc-view-conversion-refresh-interval' seconds. If that variable is nil the ;; pages won't be displayed before conversion of the document finished commit a37cbbcd4a1643ce3598a44298299fc6320128d7 Merge: 5cb3991a4f 79d43cfc33 Author: Eli Zaretskii <eliz@gnu.org> Date: Fri Jun 22 21:26:45 2018 +0300 Merge branch 'emacs-26' of git.savannah.gnu.org:/srv/git/emacs into emacs-26 commit 5cb3991a4f78b39a2c95b22a5159ae3ba779397e Author: Eli Zaretskii <eliz@gnu.org> Date: Fri Jun 22 21:25:55 2018 +0300 Fix a typo in emacs-lisp-intro.texi * doc/lispintro/emacs-lisp-intro.texi (kill-ring-yank-pointer): Add a missing quote. Reported by Jean-Christophe Helary <brandelune@gmail.com> in emacs-devel. diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index aad572623a..cc940e5cbd 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -10049,7 +10049,7 @@ kill-ring kill-ring-yank-pointer | | | | | --> "yet more text" | | - | --> "a different piece of text + | --> "a different piece of text" | --> "some text" @end group commit 79d43cfc33eceec32c624d125a55cfce23f6be0d Author: Paul Eggert <eggert@cs.ucla.edu> Date: Fri Jun 22 11:13:15 2018 -0700 Fix doc typo: missing double-quote diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index aad572623a..cc940e5cbd 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -10049,7 +10049,7 @@ kill-ring kill-ring-yank-pointer | | | | | --> "yet more text" | | - | --> "a different piece of text + | --> "a different piece of text" | --> "some text" @end group commit 6ffc6a698f5d425e402c35010394cdb17d8888ce Author: Stefan Monnier <monnier@iro.umontreal.ca> Date: Fri Jun 22 11:12:14 2018 -0400 * lisp/net/tramp-sh.el (tramp-sh--quoting-style-options): New function (tramp-do-directory-files-and-attributes-with-stat) (tramp-do-file-attributes-with-ls): Use it. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 26bf3cd0c0..9bedce78c8 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1270,6 +1270,13 @@ component is used as the target of the symlink." ;; The scripts could fail, for example with huge file size. (tramp-do-file-attributes-with-ls v localname id-format))))))))) +(defun tramp-sh--quoting-style-options (vec) + (or + (tramp-get-ls-command-with + vec "--quoting-style=literal --show-control-chars") + (tramp-get-ls-command-with vec "-w") + "")) + (defun tramp-do-file-attributes-with-ls (vec localname &optional id-format) "Implement `file-attributes' for Tramp files using the ls(1) command." (let (symlinkp dirp @@ -1295,11 +1302,7 @@ component is used as the target of the symlink." (if (eq id-format 'integer) "-ildn" "-ild") ;; On systems which have no quoting style, file names ;; with special characters could fail. - (cond - ((tramp-get-ls-command-with - vec "--quoting-style=literal --show-control-chars")) - ((tramp-get-ls-command-with vec "-w")) - (t "")) + (tramp-sh--quoting-style-options vec) (tramp-shell-quote-argument localname))) ;; Parse `ls -l' output ... (with-current-buffer (tramp-get-buffer vec) @@ -1828,11 +1831,7 @@ be non-negative integers." (tramp-get-ls-command vec) ;; On systems which have no quoting style, file names with special ;; characters could fail. - (cond - ((tramp-get-ls-command-with - vec "--quoting-style=literal --show-control-chars")) - ((tramp-get-ls-command-with vec "-w")) - (t "")) + (tramp-sh--quoting-style-options vec) (tramp-get-remote-stat vec) tramp-stat-marker tramp-stat-marker tramp-stat-marker tramp-stat-marker @@ -2632,7 +2631,7 @@ The method used must be an out-of-band method." filename switches wildcard full-directory-p) (when (stringp switches) (setq switches (split-string switches))) - (when (tramp-get-ls-command-with + (when (tramp-get-ls-command-with ;FIXME: tramp-sh--quoting-style-options? v "--quoting-style=literal --show-control-chars") (setq switches (append @@ -5334,7 +5333,7 @@ Nonexistent directories are removed from spec." ;; Check parameters. On busybox, "ls" output coloring is ;; enabled by default sometimes. So we try to disable it ;; when possible. $LS_COLORING is not supported there. - ;; Some "ls" versions are sensible wrt the order of + ;; Some "ls" versions are sensitive to the order of ;; arguments, they fail when "-al" is after the ;; "--color=never" argument (for example on FreeBSD). (when (tramp-send-command-and-check @@ -5351,7 +5350,7 @@ Nonexistent directories are removed from spec." "Return OPTION, if the remote `ls' command supports the OPTION option." (with-tramp-connection-property vec (concat "ls" option) (tramp-message vec 5 "Checking, whether `ls %s' works" option) - ;; Some "ls" versions are sensible wrt the order of arguments, + ;; Some "ls" versions are sensitive to the order of arguments, ;; they fail when "-al" is after the "--dired" argument (for ;; example on FreeBSD). Busybox does not support this kind of ;; options. commit e6476c914ebd60971708e0ea0a292e1616d928fd Author: Michael Albinus <michael.albinus@gmx.de> Date: Fri Jun 22 16:17:17 2018 +0200 Improve backward compatibility of Tramp * lisp/net/tramp-adb.el (tramp-adb-handle-exec-path): * lisp/net/tramp-sh.el (tramp-sh-handle-exec-path): Use ´file-remote-p'. (tramp-get-ls-command-with): Handle busybox specially. * test/lisp/net/tramp-tests.el (tramp-test34-exec-path): Check for `fboundp'. Use `file-remote-p'. Hide compiler warning for older Emacsen. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 7cb61adde8..297bdd712f 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -1130,7 +1130,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (read (current-buffer))) ":" 'omit))) ;; The equivalent to `exec-directory'. - `(,(file-local-name default-directory)))) + `(,(file-remote-p default-directory 'localname)))) (defun tramp-adb-get-device (vec) "Return full host name from VEC to be used in shell execution. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 0b3c12333f..26bf3cd0c0 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3089,7 +3089,7 @@ the result will be a local, non-Tramp, file name." (append (tramp-get-remote-path (tramp-dissect-file-name default-directory)) ;; The equivalent to `exec-directory'. - `(,(file-local-name default-directory)))) + `(,(file-remote-p default-directory 'localname)))) (defun tramp-sh-handle-file-local-copy (filename) "Like `file-local-copy' for Tramp files." @@ -5349,16 +5349,21 @@ Nonexistent directories are removed from spec." (defun tramp-get-ls-command-with (vec option) "Return OPTION, if the remote `ls' command supports the OPTION option." - (save-match-data - (with-tramp-connection-property vec (concat "ls" option) - (tramp-message vec 5 "Checking, whether `ls %s' works" option) - ;; Some "ls" versions are sensible wrt the order of arguments, - ;; they fail when "-al" is after the "--dired" argument (for - ;; example on FreeBSD). - (and - (tramp-send-command-and-check - vec (format "%s %s -al /dev/null" (tramp-get-ls-command vec) option)) - option)))) + (with-tramp-connection-property vec (concat "ls" option) + (tramp-message vec 5 "Checking, whether `ls %s' works" option) + ;; Some "ls" versions are sensible wrt the order of arguments, + ;; they fail when "-al" is after the "--dired" argument (for + ;; example on FreeBSD). Busybox does not support this kind of + ;; options. + (and + (not + (tramp-send-command-and-check + vec + (format + "%s ls --help 2>&1 | grep -iq busybox" (tramp-get-ls-command vec)))) + (tramp-send-command-and-check + vec (format "%s %s -al /dev/null" (tramp-get-ls-command vec) option)) + option))) (defun tramp-get-test-command (vec) "Determine remote `test' command." diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index df07a8f1b8..f2d9b0ab47 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4021,13 +4021,15 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (put 'explicit-shell-file-name 'permanent-local nil) (kill-buffer "*shell*")))) -;; The function was introduced in Emacs 27.1. +;; `exec-path' was introduced in Emacs 27.1. `executable-find' has +;; changed the number of parameters, so we use `apply' for older +;; Emacsen. (ert-deftest tramp-test34-exec-path () "Check `exec-path' and `executable-find'." (skip-unless (tramp--test-enabled)) (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) ;; Since Emacs 27.1. - (skip-unless (boundp 'exec-path)) + (skip-unless (fboundp 'exec-path)) (let ((tmp-name (tramp--test-make-temp-name)) (default-directory tramp-test-temporary-file-directory)) @@ -4038,9 +4040,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (string-equal (car (last (with-no-warnings (exec-path)))) - (file-local-name default-directory))) + (file-remote-p default-directory 'localname))) ;; The shell "sh" shall always exist. - (should (executable-find "sh" 'remote)) + (should (apply 'executable-find '("sh" remote))) ;; Since the last element in `exec-path' is the current ;; directory, an executable file in that directory will be ;; found. @@ -4050,11 +4052,13 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (file-executable-p tmp-name)) (should (string-equal - (executable-find (file-name-nondirectory tmp-name) 'remote) - (file-local-name tmp-name))) + (apply + 'executable-find `(,(file-name-nondirectory tmp-name) remote)) + (file-remote-p tmp-name 'localname))) (should-not - (executable-find - (concat (file-name-nondirectory tmp-name) "foo") 'remote))) + (apply + 'executable-find + `(,(concat (file-name-nondirectory tmp-name) "foo") remote)))) ;; Cleanup. (ignore-errors (delete-file tmp-name))))) commit d6aa55e2b48d56bf9a2cd25176029b6fb80a80b2 Author: Eli Zaretskii <eliz@gnu.org> Date: Fri Jun 22 15:57:47 2018 +0300 Avoid segfaults in replace-buffer-contents with large buffers * src/editfns.c (Freplace_buffer_contents): Don't release malloc'ed memory as long as we are using it. (Bug#31888) diff --git a/src/editfns.c b/src/editfns.c index fc5b6c117f..d15ae59029 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -3215,7 +3215,6 @@ buffer stay intact. */) /* Since we didn’t define EARLY_ABORT, we should never abort early. */ eassert (! early_abort); - SAFE_FREE (); Fundo_boundary (); ptrdiff_t count = SPECPDL_INDEX (); @@ -3261,8 +3260,10 @@ buffer stay intact. */) --i; --j; } + unbind_to (count, Qnil); + SAFE_FREE (); - return unbind_to (count, Qnil); + return Qnil; } static void commit 4e15d263134fdb8c9ff75e70f3f86225ad32ad31 Author: Eli Zaretskii <eliz@gnu.org> Date: Fri Jun 22 11:48:38 2018 +0300 Document 'major-mode-suspend' and 'major-mode-restore' * doc/lispref/modes.texi (Major Modes): Document 'major-mode-suspend' and 'major-mode-restore'. (Bug#31551) * etc/NEWS: Mark the corresponding entry as documented in manuals. diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index d7e217c528..49b7e1ea3f 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -197,6 +197,7 @@ from the buffer-local hook list instead of from the global hook list. @cindex major mode @cindex major mode command +@cindex suspend major mode temporarily Major modes specialize Emacs for editing or interacting with particular kinds of text. Each buffer has exactly one major mode at a time. Every major mode is associated with a @dfn{major mode command}, @@ -205,7 +206,8 @@ switching to that mode in the current buffer, by setting various buffer-local variables such as a local keymap. @xref{Major Mode Conventions}. Note that unlike minor modes there is no way to ``turn off'' a major mode, instead the buffer must be switched to a different -one. +one. However, you can temporarily @dfn{suspend} a major mode and later +@dfn{restore} the suspended mode, see below. The least specialized major mode is called @dfn{Fundamental mode}, which has no mode-specific definitions or variable settings. @@ -216,6 +218,24 @@ commands, it does @emph{not} run any mode hooks (@pxref{Major Mode Conventions}), since you are not supposed to customize this mode. @end deffn +@defun major-mode-suspend +This function works like @code{fundamental-mode}, in that it kills all +buffer-local variables, but it also records the major mode in effect, +so that it could subsequently be restored. This function and +@code{major-mode-restore} (described next) are useful when you need to +put a buffer under some specialized mode other than the one Emacs +chooses for it automatically (@pxref{Auto Major Mode}), but would also +like to be able to switch back to the original mode later. +@end defun + +@defun major-mode-restore &optional avoided-modes +This function restores the major mode recorded by +@code{major-mode-suspend}. If no major mode was recorded, this +function calls @code{normal-mode} (@pxref{Auto Major Mode, +normal-mode}), but tries to force it not to choose any modes in +@var{avoided-modes}, if that argument is non-@code{nil}. +@end defun + The easiest way to write a major mode is to use the macro @code{define-derived-mode}, which sets up the new mode as a variant of an existing major mode. @xref{Derived Modes}. We recommend using diff --git a/etc/NEWS b/etc/NEWS index 83e106ced8..12757f61d2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -658,9 +658,10 @@ manual for more details. * Lisp Changes in Emacs 27.1 -** New functions 'major-mode-suspend' and 'major-mode-restore' -Used when switching temporarily to another major mode, e.g. for hexl-mode, -or to switch between c-mode and image-mode in XPM. ++++ +** New functions 'major-mode-suspend' and 'major-mode-restore'. +Use them when switching temporarily to another major mode, e.g. for +'hexl-mode', or to switch between 'c-mode' and 'image-mode' in XPM. +++ ** New macro 'dolist-with-progress-reporter'. commit d22b8d1ad12c69a2c97bb9f4c9eb4316df13429e Author: Robert Pluim <rpluim@gmail.com> Date: Fri Jun 22 09:59:47 2018 +0200 Adjust for scaling for mode-line popup menus (Bug#31880) * src/xmenu.c (menu_position_func) [HAVE_GTK3]: Take scaling into account when calculating screen size. diff --git a/src/xmenu.c b/src/xmenu.c index e7ef31ac56..d285e568b0 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -1162,11 +1162,17 @@ menu_position_func (GtkMenu *menu, gint *x, gint *y, gboolean *push_in, gpointer GtkRequisition req; int max_x = -1; int max_y = -1; +#ifdef HAVE_GTK3 + int scale; +#endif Lisp_Object frame, workarea; XSETFRAME (frame, data->f); +#ifdef HAVE_GTK3 + scale = xg_get_scale (data->f); +#endif /* TODO: Get the monitor workarea directly without calculating other items in x-display-monitor-attributes-list. */ workarea = call3 (Qframe_monitor_workarea, @@ -1192,11 +1198,20 @@ menu_position_func (GtkMenu *menu, gint *x, gint *y, gboolean *push_in, gpointer max_y = x_display_pixel_height (dpyinfo); } + /* frame-monitor-workarea and {x,y}_display_pixel_width/height all + return device pixels, but GTK wants scaled pixels. The positions + passed in via data were already scaled for us. */ +#ifdef HAVE_GTK3 + max_x /= scale; + max_y /= scale; +#endif *x = data->x; *y = data->y; /* Check if there is room for the menu. If not, adjust x/y so that - the menu is fully visible. */ + the menu is fully visible. gtk_widget_get_preferred_size returns + scaled pixels, so there is no need to apply the scaling + factor. */ gtk_widget_get_preferred_size (GTK_WIDGET (menu), NULL, &req); if (data->x + req.width > max_x) *x -= data->x + req.width - max_x; commit a5511956b483e22cfebc0ebeb54d83c95f852648 Author: Stefan Monnier <monnier@iro.umontreal.ca> Date: Thu Jun 21 23:30:11 2018 -0400 New functions to switch back and forth to another major mode * subr.el (major-mode--suspended): New var. (major-mode-suspend, major-mode-restore): New funs, extracted from doc-view. * doc-view.el (doc-view--previous-major-mode): Remove. (doc-view-mode): Use major-mode-suspend. (doc-view-fallback-mode): Use major-mode-restore. * hexl-mode.el (hexl-mode--minor-mode-p, hexl-mode--setq-local): Remove. (hexl-mode): Use major-mode-suspend and hexl-follow-ascii-mode. (hexl-mode-exit): Use major-mode-restore. (hexl-activate-ruler, hexl-follow-line): Don't bother trying to preserve earlier state, now that entering/leaving hexl-mode kills local vars. (hexl-follow-ascii-mode): New proper local minor mode. (hexl-follow-ascii): Rewrite, using it. * image-mode.el (image-mode-previous-major-mode): Remove. (image-mode): Use major-mode-suspend. (image-mode-to-text): Use major-mode-restore. diff --git a/etc/NEWS b/etc/NEWS index 537e99c90e..83e106ced8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -658,6 +658,10 @@ manual for more details. * Lisp Changes in Emacs 27.1 +** New functions 'major-mode-suspend' and 'major-mode-restore' +Used when switching temporarily to another major mode, e.g. for hexl-mode, +or to switch between c-mode and image-mode in XPM. + +++ ** New macro 'dolist-with-progress-reporter'. This works like 'dolist', but reports progress similar to diff --git a/lisp/doc-view.el b/lisp/doc-view.el index dfc4d887ae..970e12402d 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -354,9 +354,6 @@ of the page moves to the previous page." (defvar doc-view--pending-cache-flush nil "Only used internally.") -(defvar doc-view--previous-major-mode nil - "Only used internally.") - (defvar doc-view--buffer-file-name nil "Only used internally. The file name used for conversion. Normally it's the same as @@ -1752,12 +1749,7 @@ toggle between displaying the document or editing it as text. ;; returns nil for tar members. (doc-view-fallback-mode) - (let* ((prev-major-mode (if (derived-mode-p 'doc-view-mode) - doc-view--previous-major-mode - (unless (eq major-mode 'fundamental-mode) - major-mode)))) - (kill-all-local-variables) - (setq-local doc-view--previous-major-mode prev-major-mode)) + (major-mode-suspend) (dolist (var doc-view-saved-settings) (set (make-local-variable (car var)) (cdr var))) @@ -1848,14 +1840,7 @@ toggle between displaying the document or editing it as text. '(doc-view-resolution image-mode-winprops-alist))))) (remove-overlays (point-min) (point-max) 'doc-view t) - (if doc-view--previous-major-mode - (funcall doc-view--previous-major-mode) - (let ((auto-mode-alist - (rassq-delete-all - 'doc-view-mode-maybe - (rassq-delete-all 'doc-view-mode - (copy-alist auto-mode-alist))))) - (normal-mode))) + (major-mode-restore '(doc-view-mode-maybe doc-view-mode)) (when vars (setq-local doc-view-saved-settings vars)))) diff --git a/lisp/hexl.el b/lisp/hexl.el index 2c1a7de48a..f37be9d410 100644 --- a/lisp/hexl.el +++ b/lisp/hexl.el @@ -58,53 +58,45 @@ (const 16) (const 32) (const 64)) - :group 'hexl :version "24.3") (defcustom hexl-program "hexl" "The program that will hexlify and dehexlify its stdin. `hexl-program' will always be concatenated with `hexl-options' and \"-de\" when dehexlifying a buffer." - :type 'string - :group 'hexl) + :type 'string) (defcustom hexl-iso "" "If your Emacs can handle ISO characters, this should be set to \"-iso\" otherwise it should be \"\"." - :type 'string - :group 'hexl) + :type 'string) (defcustom hexl-options (format "-hex %s" hexl-iso) "Space separated options to `hexl-program' that suit your needs. Quoting cannot be used, so the arguments cannot themselves contain spaces. If you wish to set the `-group-by-X-bits' options, set `hexl-bits' instead, as that will override any bit grouping options set here." - :type 'string - :group 'hexl) + :type 'string) (defcustom hexl-follow-ascii t "If non-nil then highlight the ASCII character corresponding to point." :type 'boolean - :group 'hexl :version "20.3") (defcustom hexl-mode-hook '(hexl-follow-line hexl-activate-ruler) "Normal hook run when entering Hexl mode." :type 'hook - :options '(hexl-follow-line hexl-activate-ruler eldoc-mode) - :group 'hexl) + :options '(hexl-follow-line hexl-activate-ruler eldoc-mode)) (defface hexl-address-region '((t (:inherit header-line))) - "Face used in address area of Hexl mode buffer." - :group 'hexl) + "Face used in address area of Hexl mode buffer.") (defface hexl-ascii-region '((t (:inherit header-line))) - "Face used in ASCII area of Hexl mode buffer." - :group 'hexl) + "Face used in ASCII area of Hexl mode buffer.") -(defvar hexl-max-address 0 +(defvar-local hexl-max-address 0 "Maximum offset into hexl buffer.") (defvar hexl-mode-map @@ -252,24 +244,6 @@ as that will override any bit grouping options set here." "The length of a hexl display line (varies with `hexl-bits')." (+ 60 (/ 128 (or hexl-bits 16)))) -(defun hexl-mode--minor-mode-p (var) - (memq var '(ruler-mode hl-line-mode))) - -(defun hexl-mode--setq-local (var val) - ;; `var' can be either a symbol or a pair, in which case the `car' - ;; is the getter function and the `cdr' is the corresponding setter. - (unless (or (member var hexl-mode--old-var-vals) - (assoc var hexl-mode--old-var-vals)) - (push (if (or (consp var) (boundp var)) - (cons var - (if (consp var) (funcall (car var)) (symbol-value var))) - var) - hexl-mode--old-var-vals)) - (cond - ((consp var) (funcall (cdr var) val)) - ((hexl-mode--minor-mode-p var) (funcall var (if val 1 -1))) - (t (set (make-local-variable var) val)))) - ;;;###autoload (defun hexl-mode (&optional arg) "\\<hexl-mode-map>A mode for editing binary files in hex dump format. @@ -364,35 +338,33 @@ You can use \\[hexl-find-file] to visit a file in Hexl mode. (or (bolp) (setq original-point (1- original-point)))) (hexlify-buffer) (restore-buffer-modified-p modified)) - (set (make-local-variable 'hexl-max-address) - (+ (* (/ (1- (buffer-size)) (hexl-line-displen)) 16) 15)) + (setq hexl-max-address + (+ (* (/ (1- (buffer-size)) (hexl-line-displen)) 16) 15)) (condition-case nil (hexl-goto-address original-point) (error nil))) - ;; We do not turn off the old major mode; instead we just - ;; override most of it. That way, we can restore it perfectly. + (let ((max-address hexl-max-address)) + (major-mode-suspend) + (setq hexl-max-address max-address)) - (hexl-mode--setq-local '(current-local-map . use-local-map) hexl-mode-map) + (use-local-map hexl-mode-map) - (hexl-mode--setq-local 'mode-name "Hexl") - (hexl-mode--setq-local 'isearch-search-fun-function - 'hexl-isearch-search-function) - (hexl-mode--setq-local 'major-mode 'hexl-mode) + (setq-local mode-name "Hexl") + (setq-local isearch-search-fun-function #'hexl-isearch-search-function) + (setq-local major-mode 'hexl-mode) - (hexl-mode--setq-local '(syntax-table . set-syntax-table) - (standard-syntax-table)) + ;; (set-syntax-table (standard-syntax-table)) - (add-hook 'write-contents-functions 'hexl-save-buffer nil t) + (add-hook 'write-contents-functions #'hexl-save-buffer nil t) - (hexl-mode--setq-local 'require-final-newline nil) + (setq-local require-final-newline nil) - (hexl-mode--setq-local 'font-lock-defaults '(hexl-font-lock-keywords t)) + (setq-local font-lock-defaults '(hexl-font-lock-keywords t)) - (hexl-mode--setq-local 'revert-buffer-function - #'hexl-revert-buffer-function) - (add-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer nil t) + (setq-local revert-buffer-function #'hexl-revert-buffer-function) + (add-hook 'change-major-mode-hook #'hexl-maybe-dehexlify-buffer nil t) ;; Set a callback function for eldoc. (add-function :before-until (local 'eldoc-documentation-function) @@ -401,7 +373,7 @@ You can use \\[hexl-find-file] to visit a file in Hexl mode. (eldoc-remove-command "hexl-save-buffer" "hexl-current-address") - (if hexl-follow-ascii (hexl-follow-ascii 1))) + (if hexl-follow-ascii (hexl-follow-ascii-mode 1))) (run-mode-hooks 'hexl-mode-hook)) @@ -469,6 +441,7 @@ and edit the file in `hexl-mode'." (hexl-mode))) (defun hexl-revert-buffer-function (_ignore-auto _noconfirm) + ;; FIXME: We don't obey revert-buffer-preserve-modes! (let ((coding-system-for-read 'no-conversion) revert-buffer-function) ;; Call the original `revert-buffer' without code conversion; also @@ -481,7 +454,7 @@ and edit the file in `hexl-mode'." ;; already hexl-mode. ;; 2. reset change-major-mode-hook in case that `hexl-mode' ;; previously added hexl-maybe-dehexlify-buffer to it. - (remove-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer t) + (remove-hook 'change-major-mode-hook #'hexl-maybe-dehexlify-buffer t) (setq major-mode 'fundamental-mode) (hexl-mode))) @@ -494,7 +467,7 @@ With arg, don't unhexlify buffer." (inhibit-read-only t) (original-point (1+ (hexl-current-address)))) (dehexlify-buffer) - (remove-hook 'write-contents-functions 'hexl-save-buffer t) + (remove-hook 'write-contents-functions #'hexl-save-buffer t) (restore-buffer-modified-p modified) (goto-char original-point) ;; Maybe adjust point for the removed CR characters. @@ -504,27 +477,8 @@ With arg, don't unhexlify buffer." (or (bobp) (setq original-point (1+ original-point)))) (goto-char original-point))) - (remove-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer t) - (remove-hook 'post-command-hook 'hexl-follow-ascii-find t) - (setq hexl-ascii-overlay nil) - - (let ((mms ())) - (dolist (varval hexl-mode--old-var-vals) - (let* ((bound (consp varval)) - (var (if bound (car varval) varval)) - (val (cdr-safe varval))) - (cond - ((consp var) (funcall (cdr var) val)) - ((hexl-mode--minor-mode-p var) (push (cons var val) mms)) - (bound (set (make-local-variable var) val)) - (t (kill-local-variable var))))) - (kill-local-variable 'hexl-mode--old-var-vals) - ;; Enable/disable minor modes. Do it after having reset the other vars, - ;; since some of them may affect the minor modes. - (dolist (mm mms) - (funcall (car mm) (if (cdr mm) 1 -1)))) - - (force-mode-line-update)) + (remove-hook 'change-major-mode-hook #'hexl-maybe-dehexlify-buffer t) + (major-mode-restore)) (defun hexl-maybe-dehexlify-buffer () "Convert a hexl format buffer to binary. @@ -534,7 +488,7 @@ Ask the user for confirmation." (inhibit-read-only t) (original-point (1+ (hexl-current-address)))) (dehexlify-buffer) - (remove-hook 'write-contents-functions 'hexl-save-buffer t) + (remove-hook 'write-contents-functions #'hexl-save-buffer t) (restore-buffer-modified-p modified) (goto-char original-point)))) @@ -1041,48 +995,47 @@ Embedded whitespace, dashes, and periods in the string are ignored." (error "Decimal number out of range") (hexl-insert-multibyte-char num arg)))) -(defun hexl-follow-ascii (&optional arg) - "Toggle following ASCII in Hexl buffers. -With prefix ARG, turn on following if and only if ARG is positive. +(define-minor-mode hexl-follow-ascii-mode + "Minor mode to follow ASCII in current Hexl buffer. When following is enabled, the ASCII character corresponding to the element under the point is highlighted. -Customize the variable `hexl-follow-ascii' to disable this feature." - (interactive "P") +The default activation is controlled by `hexl-follow-ascii'." + (if hexl-follow-ascii-mode + ;; turn it on + (progn + (unless hexl-ascii-overlay + (setq hexl-ascii-overlay (make-overlay (point) (point))) + (overlay-put hexl-ascii-overlay 'face 'highlight)) + (add-hook 'post-command-hook #'hexl-follow-ascii-find nil t)) + ;; turn it off + (when hexl-ascii-overlay + (delete-overlay hexl-ascii-overlay) + (setq hexl-ascii-overlay nil)) + (remove-hook 'post-command-hook #'hexl-follow-ascii-find t))) + +(define-minor-mode hexl-follow-ascii + "Toggle following ASCII in Hexl buffers. +Like `hexl-follow-ascii-mode' but remembers the choice globally." + :global t (let ((on-p (if arg (> (prefix-numeric-value arg) 0) (not hexl-ascii-overlay)))) - - (if on-p - ;; turn it on - (if (not hexl-ascii-overlay) - (progn - (setq hexl-ascii-overlay (make-overlay 1 1) - hexl-follow-ascii t) - (overlay-put hexl-ascii-overlay 'face 'highlight) - (add-hook 'post-command-hook 'hexl-follow-ascii-find nil t))) - ;; turn it off - (if hexl-ascii-overlay - (progn - (delete-overlay hexl-ascii-overlay) - (setq hexl-ascii-overlay nil - hexl-follow-ascii nil) - (remove-hook 'post-command-hook 'hexl-follow-ascii-find t) - ))))) + (hexl-follow-ascii-mode (if on-p 1 -1)) + ;; Remember this choice globally for later use. + (setq hexl-follow-ascii hexl-follow-ascii-mode))) (defun hexl-activate-ruler () "Activate `ruler-mode'." (require 'ruler-mode) - (hexl-mode--setq-local 'ruler-mode-ruler-function - #'hexl-mode-ruler) - (hexl-mode--setq-local 'ruler-mode t)) + (setq-local ruler-mode-ruler-function #'hexl-mode-ruler) + (ruler-mode 1)) (defun hexl-follow-line () "Activate `hl-line-mode'." (require 'hl-line) - (hexl-mode--setq-local 'hl-line-range-function - #'hexl-highlight-line-range) - (hexl-mode--setq-local 'hl-line-face 'highlight) - (hexl-mode--setq-local 'hl-line-mode t)) + (setq-local hl-line-range-function #'hexl-highlight-line-range) + (setq-local hl-line-face 'highlight) ;FIXME: Why? + (hl-line-mode 1)) (defun hexl-highlight-line-range () "Return the range of address region for the point. diff --git a/lisp/image-mode.el b/lisp/image-mode.el index c504afa697..0925c6ef9c 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -412,9 +412,6 @@ call." (defvar-local image-multi-frame nil "Non-nil if image for the current Image mode buffer has multiple frames.") -(defvar image-mode-previous-major-mode nil - "Internal variable to keep the previous non-image major mode.") - (defvar image-mode-map (let ((map (make-sparse-keymap))) (define-key map "\C-c\C-c" 'image-toggle-display) @@ -551,7 +548,7 @@ Key bindings: (unless (display-images-p) (error "Display does not support images")) - (kill-all-local-variables) + (major-mode-suspend) (setq major-mode 'image-mode) (if (not (image-get-display-property)) @@ -641,26 +638,7 @@ A non-mage major mode found from `auto-mode-alist' or fundamental mode displays an image file as text." ;; image-mode-as-text = normal-mode + image-minor-mode (let ((previous-image-type image-type)) ; preserve `image-type' - (if image-mode-previous-major-mode - ;; Restore previous major mode that was already found by this - ;; function and cached in `image-mode-previous-major-mode' - (funcall image-mode-previous-major-mode) - (let ((auto-mode-alist - (delq nil (mapcar - (lambda (elt) - (unless (memq (or (car-safe (cdr elt)) (cdr elt)) - '(image-mode image-mode-maybe image-mode-as-text)) - elt)) - auto-mode-alist))) - (magic-fallback-mode-alist - (delq nil (mapcar - (lambda (elt) - (unless (memq (or (car-safe (cdr elt)) (cdr elt)) - '(image-mode image-mode-maybe image-mode-as-text)) - elt)) - magic-fallback-mode-alist)))) - (normal-mode) - (setq-local image-mode-previous-major-mode major-mode))) + (major-mode-restore '(image-mode image-mode-maybe image-mode-as-text)) ;; Restore `image-type' after `kill-all-local-variables' in `normal-mode'. (setq image-type previous-image-type) ;; Enable image minor mode with `C-c C-c'. diff --git a/lisp/subr.el b/lisp/subr.el index 7ac1c91281..ca184d8fc8 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1866,7 +1866,7 @@ running their FOO-mode-hook." (push hook delayed-mode-hooks)) ;; Normal case, just run the hook as before plus any delayed hooks. (setq hooks (nconc (nreverse delayed-mode-hooks) hooks)) - (and syntax-propertize-function + (and (bound-and-true-p syntax-propertize-function) (not (local-variable-p 'parse-sexp-lookup-properties)) ;; `syntax-propertize' sets `parse-sexp-lookup-properties' for us, but ;; in order for the sexp primitives to automatically call @@ -1908,6 +1908,36 @@ If you just want to check `major-mode', use `derived-mode-p'." "Non-nil if the current major mode is derived from one of MODES. Uses the `derived-mode-parent' property of the symbol to trace backwards." (apply #'provided-mode-derived-p major-mode modes)) + +(defvar-local major-mode--suspended nil) +(put 'major-mode--suspended 'permanent-local t) + +(defun major-mode-suspend () + "Exit current major, remembering it." + (let* ((prev-major-mode (or major-mode--suspended + (unless (eq major-mode 'fundamental-mode) + major-mode)))) + (kill-all-local-variables) + (setq-local major-mode--suspended prev-major-mode))) + +(defun major-mode-restore (&optional avoided-modes) + "Restore major mode earlier suspended with `major-mode-suspend'. +If there was no earlier suspended major mode, then fallback to `normal-mode', +tho trying to avoid AVOIDED-MODES." + (if major-mode--suspended + (funcall (prog1 major-mode--suspended + (kill-local-variable 'major-mode--suspended))) + (let ((auto-mode-alist + (let ((alist (copy-sequence auto-mode-alist))) + (dolist (mode avoided-modes) + (setq alist (rassq-delete-all mode alist))) + alist)) + (magic-fallback-mode-alist + (let ((alist (copy-sequence magic-fallback-mode-alist))) + (dolist (mode avoided-modes) + (setq alist (rassq-delete-all mode alist))) + alist))) + (normal-mode)))) ;;;; Minor modes. @@ -3034,6 +3064,8 @@ This function is like `insert', except it honors the variables (inhibit-read-only inhibit-read-only) end) + ;; FIXME: This throws away any yank-undo-function set by previous calls + ;; to insert-for-yank-1 within the loop of insert-for-yank! (setq yank-undo-function t) (if (nth 0 handler) ; FUNCTION (funcall (car handler) param) commit 3d2e3dc1ca8ee7226668ab5bbd35061d37bcbbec Author: Simen Heggestøyl <simenheg@gmail.com> Date: Sun Apr 9 11:06:44 2017 +0200 Change name of `seqp' argument (Bug#26411) * lisp/emacs-lisp/seq.el (seqp): Change argument name. * doc/lispref/sequences.texi: Update the documentation for seqp. diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index f347cd9e98..76a4a46888 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -474,8 +474,8 @@ built-in sequence types, @code{seq-length} behaves like @code{length}. @xref{Definition of length}. @end defun -@defun seqp sequence - This function returns non-@code{nil} if @var{sequence} is a sequence +@defun seqp object + This function returns non-@code{nil} if @var{object} is a sequence (a list or array), or any additional type of sequence defined via @file{seq.el} generic functions. diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 5d6ab7e057..b40c424e30 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -127,9 +127,9 @@ the sequence, and its index within the sequence." (setq index (1+ index))) sequence))) -(cl-defgeneric seqp (sequence) - "Return non-nil if SEQUENCE is a sequence, nil otherwise." - (sequencep sequence)) +(cl-defgeneric seqp (object) + "Return non-nil if OBJECT is a sequence, nil otherwise." + (sequencep object)) (cl-defgeneric seq-copy (sequence) "Return a shallow copy of SEQUENCE." commit 8a7475ca796ecd5816fab9f11baf07bcc395d951 Author: memeplex <carlosjosepita@gmail.com> Date: Tue Jun 19 02:12:11 2018 -0300 Remove broken icon from tooltip (Bug#31884) * src/gtkutil.c (xg_show_tooltip): Call gtk_widget_show instead of gtk_widget_show_all, the latter displays an extra placeholder icon. diff --git a/src/gtkutil.c b/src/gtkutil.c index 8cc523649d..69325ff00a 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -764,7 +764,7 @@ xg_show_tooltip (struct frame *f, int root_x, int root_y) block_input (); gtk_window_move (x->ttip_window, root_x / xg_get_scale (f), root_y / xg_get_scale (f)); - gtk_widget_show_all (GTK_WIDGET (x->ttip_window)); + gtk_widget_show (GTK_WIDGET (x->ttip_window)); unblock_input (); } #endif commit 9a27310f0ab068bef52cfe30d3abc5eda3a0d12b Author: Paul Eggert <eggert@cs.ucla.edu> Date: Thu Jun 21 13:29:15 2018 -0700 Set group when installing, too From a patch by Ulrich Mueller in: https://lists.gnu.org/r/emacs-devel/2018-06/msg00687.html * Makefile.in (set_installuser): Also set the group, in order to match install(1) behavior. Also, don’t clutter stderr with a diagnostic if â€id’ is missing. diff --git a/Makefile.in b/Makefile.in index 52d44d9708..4d7627ba09 100644 --- a/Makefile.in +++ b/Makefile.in @@ -516,9 +516,11 @@ INSTALL_ARCH_INDEP_EXTRA = @INSTALL_ARCH_INDEP_EXTRA@ ## https://lists.gnu.org/r/emacs-devel/2007-10/msg01672.html ## Needs to be the user running install, so configure can't set it. set_installuser=for installuser in $${LOGNAME} $${USERNAME} $${USER} \ - `id -un 2> /dev/null`; do \ + `(id -u) 2> /dev/null`; do \ [ -n "$${installuser}" ] && break ; \ - done + done; \ + installgroup=`(id -g) 2>/dev/null` && [ -n "$$installgroup" ] && \ + installuser=$$installuser:$$installgroup ### Install the files that are machine-independent. ### Most of them come straight from the distribution; the exception is commit 5583e6460c38c5d613e732934b066421349a5259 Author: Michael Albinus <michael.albinus@gmx.de> Date: Wed Jun 20 20:21:48 2018 +0200 ; Fix typo diff --git a/lisp/files.el b/lisp/files.el index 0b52ebd241..398e6dc12b 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1028,7 +1028,7 @@ customize the variable `user-emacs-directory-warning'." "Return list of directories to search programs to run in remote subprocesses. The remote host is identified by `default-directory'. For remote hosts which do not support subprocesses, this returns `nil'. -If `default-directory' is a local directory, this function retruns +If `default-directory' is a local directory, this function returns the value of the variable `exec-path'." (let ((handler (find-file-name-handler default-directory 'exec-path))) (if handler commit dffe02d259937f052ac090348c377f5b28105582 Author: Eli Zaretskii <eliz@gnu.org> Date: Wed Jun 20 18:39:41 2018 +0300 Improve documentation of a recent change * doc/lispref/processes.texi (Subprocess Creation): Improve wording of documentation for the function 'exec-path'. * etc/NEWS: Improve wording and formatting of recently added entries. * lisp/files.el (exec-path): Doc fix. diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index f78d8485e4..447644022c 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -178,9 +178,9 @@ independently of @env{PATH} can lead to confusing results. @end defopt @defun exec-path -The function @code{exec-path} is an extension of the respective -variable. If @code{default-directory} indicates a remote directory, -it returns a list of directories used for searching programs on the +This function is an extension of the variable @code{exec-path}. If +@code{default-directory} indicates a remote directory, this function +returns a list of directories used for searching programs on the respective remote host. In case of a local @code{default-directory}, the function returns just the value of the variable @code{exec-path}. @end defun diff --git a/etc/NEWS b/etc/NEWS index 709c446849..537e99c90e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -146,11 +146,14 @@ regular expression was previously invalid, but is now accepted: ** The German prefix and postfix input methods now support Capital sharp S. +++ -** The new function 'exec-path' returns a directory list from a remote host. +** New function 'exec-path'. +This function by default returns the value of the corresponding +variable, but can optionally return the equivalent of 'exec-path' +from a remote host. +++ -** Function 'executable-find' supports an optional argument REMOTE. -This triggers to search a program name on the remote host indicated by +** The function 'executable-find' supports an optional argument REMOTE. +This triggers to search the program on the remote host as indicated by 'default-directory'. diff --git a/lisp/files.el b/lisp/files.el index d0804b000a..0b52ebd241 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1025,11 +1025,11 @@ customize the variable `user-emacs-directory-warning'." bestname)))) (defun exec-path () - "List of directories to search programs to run in remote subprocesses. + "Return list of directories to search programs to run in remote subprocesses. The remote host is identified by `default-directory'. For remote hosts which do not support subprocesses, this returns `nil'. -If `default-directory' is a local directory, the value of the variable -`exec-path' is returned." +If `default-directory' is a local directory, this function retruns +the value of the variable `exec-path'." (let ((handler (find-file-name-handler default-directory 'exec-path))) (if handler (funcall handler 'exec-path) commit 40e1db8ccd1239fc7da5ccd3f5f79017b2b44afc Author: Noam Postavsky <npostavs@gmail.com> Date: Wed Jun 20 08:40:51 2018 -0400 Change index of ";" to better reflect it's usage (Bug#31623) * doc/lispref/objects.texi (Comments): "; for commenting" fits better with the following text about how a semicolon begins a comment. Also mention that only unescaped semicolons start a comment. diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index c7e751cbd8..b8cae49027 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -109,15 +109,15 @@ not be evaluated later. @xref{Input Functions}, for a description of @node Comments @section Comments @cindex comments -@cindex @samp{;} in comment - - A @dfn{comment} is text that is written in a program only for the sake -of humans that read the program, and that has no effect on the meaning -of the program. In Lisp, a semicolon (@samp{;}) starts a comment if it -is not within a string or character constant. The comment continues to -the end of line. The Lisp reader discards comments; they do not become -part of the Lisp objects which represent the program within the Lisp -system. +@cindex @samp{;} for commenting + + A @dfn{comment} is text that is written in a program only for the +sake of humans that read the program, and that has no effect on the +meaning of the program. In Lisp, an unescaped semicolon (@samp{;}) +starts a comment if it is not within a string or character constant. +The comment continues to the end of line. The Lisp reader discards +comments; they do not become part of the Lisp objects which represent +the program within the Lisp system. The @samp{#@@@var{count}} construct, which skips the next @var{count} characters, is useful for program-generated comments containing binary commit 6f649e77b8512f73b17f03fd795beea9965c4029 Author: Michael Albinus <michael.albinus@gmx.de> Date: Wed Jun 20 12:13:56 2018 +0200 Implement command completion in remote shells. (Bug#31704) * doc/lispref/files.texi (Locating Files): Describe optional argument REMOTE of `executable-find'. (Magic File Names): Add `exec-path'. * doc/lispref/processes.texi (Subprocess Creation): Describe function `exec-path'. * doc/misc/tramp.texi (Remote programs): Explain refresh of search paths by `tramp-cleanup-this-connection'. * etc/NEWS: Mention 'exec-path' and 'executable-find'. * lisp/files.el (exec-path): New defun. (executable-find): Add optional argument REMOTE. * lisp/shell.el (shell-completion-vars): Set `comint-file-name-prefix'. (shell--command-completion-data): Use `(exec-path)'. (Bug#31704) * lisp/net/ange-ftp.el (exec-path): * lisp/net/tramp.el (tramp-file-name-for-operation): * lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist): * lisp/net/tramp-archive.el (tramp-archive-file-name-handler-alist): * lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): * lisp/net/tramp-sh.el (tramp-sh-file-name-handler-alist): * lisp/net/tramp-smb.el (tramp-smb-file-name-handler-alist) <exec-path>: Add handler. * lisp/net/tramp-adb.el (tramp-adb-handle-exec-path): New defun. (tramp-adb-maybe-open-connection): Do not set "remote-path" connection property. * lisp/net/tramp-compat.el (tramp-compat-exec-path): New defun. * lisp/net/tramp-sh.el (tramp-sh-handle-exec-path): New defun. * lisp/net/tramp.el (tramp-eshell-directory-change): Use it. * test/lisp/net/tramp-archive-tests.el (tramp-archive-test38-make-nearby-temp-file) (tramp-archive-test41-file-system-info) (tramp-archive-test43-auto-load) (tramp-archive-test43-delay-load): Rename. * test/lisp/net/tramp-tests.el (tramp-test34-exec-path): New test. (tramp-test36-make-auto-save-file-name) (tramp-test37-find-backup-file-name) (tramp-test38-make-nearby-temp-file) (tramp-test39-special-characters) (tramp-test39-special-characters-with-stat) (tramp-test39-special-characters-with-perl) (tramp-test39-special-characters-with-ls, tramp-test40-utf8) (tramp-test40-utf8-with-stat, tramp-test40-utf8-with-perl) (tramp-test40-utf8-with-ls, tramp-test41-file-system-info) (tramp-test42-asynchronous-requests, tramp-test43-auto-load) (tramp-test43-delay-load, tramp-test43-recursive-load) (tramp-test43-remote-load-path, tramp-test44-unload): Rename. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index f4678ddd84..068cf05443 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -1567,13 +1567,16 @@ For compatibility, @var{predicate} can also be one of the symbols a list of one or more of these symbols. @end defun -@defun executable-find program +@defun executable-find program &optional remote This function searches for the executable file of the named @var{program} and returns the absolute file name of the executable, including its file-name extensions, if any. It returns @code{nil} if -the file is not found. The functions searches in all the directories +the file is not found. The function searches in all the directories in @code{exec-path}, and tries all the file-name extensions in @code{exec-suffixes} (@pxref{Subprocess Creation}). + +If @var{remote} is non-@code{nil}, and @code{default-directory} is a +remote directory, @var{program} is searched on the respective remote host. @end defun @node Changing Files @@ -3137,8 +3140,8 @@ first, before handlers for jobs such as remote file access. @code{directory-file-name}, @code{directory-files}, @code{directory-files-and-attributes}, -@code{dired-compress-file}, @code{dired-uncache},@* -@code{expand-file-name}, +@code{dired-compress-file}, @code{dired-uncache}, +@code{exec-path}, @code{expand-file-name},@* @code{file-accessible-directory-p}, @code{file-acl}, @code{file-attributes}, @@ -3195,7 +3198,7 @@ first, before handlers for jobs such as remote file access. @code{directory-files}, @code{directory-files-and-at@discretionary{}{}{}tributes}, @code{dired-compress-file}, @code{dired-uncache}, -@code{expand-file-name}, +@code{exec-path}, @code{expand-file-name}, @code{file-accessible-direc@discretionary{}{}{}tory-p}, @code{file-acl}, @code{file-attributes}, diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 3e26f57798..f78d8485e4 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -177,6 +177,14 @@ before starting Emacs. Trying to modify @code{exec-path} independently of @env{PATH} can lead to confusing results. @end defopt +@defun exec-path +The function @code{exec-path} is an extension of the respective +variable. If @code{default-directory} indicates a remote directory, +it returns a list of directories used for searching programs on the +respective remote host. In case of a local @code{default-directory}, +the function returns just the value of the variable @code{exec-path}. +@end defun + @node Shell Arguments @section Shell Arguments @cindex arguments for shell commands diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 420fef7164..a9de1fddc6 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -1816,9 +1816,9 @@ shell supports the login argument @samp{-l}. @end defopt When remote search paths are changed, local @value{tramp} caches must -be recomputed. To force @value{tramp} to recompute afresh, exit -Emacs, remove the persistent file (@pxref{Connection caching}), and -restart Emacs. +be recomputed. To force @value{tramp} to recompute afresh, call +@kbd{M-x tramp-cleanup-this-connection @key{RET}} or friends +(@pxref{Cleanup remote connections}). @node Remote shell setup diff --git a/etc/NEWS b/etc/NEWS index 632627b241..709c446849 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -145,6 +145,14 @@ regular expression was previously invalid, but is now accepted: --- ** The German prefix and postfix input methods now support Capital sharp S. ++++ +** The new function 'exec-path' returns a directory list from a remote host. + ++++ +** Function 'executable-find' supports an optional argument REMOTE. +This triggers to search a program name on the remote host indicated by +'default-directory'. + * Editing Changes in Emacs 27.1 @@ -436,7 +444,6 @@ It can be used to set any buffer as the next one to be used by This means that pressing C-M-SPACE now selects the entire tree by default, and not just the opening element. - ** Eshell --- @@ -454,11 +461,15 @@ To restore the old behavior, use Previously eshell/kill would fail if provided a kill signal to send to the process. It now accepts signals specified either by name or by its number. +** Shell + +--- +*** Program name completion inside remote shells works now as expected. + ** Pcomplete *** The function 'pcomplete-uniquify-list' has been renamed from 'pcomplete-uniqify-list'. - ** Auth-source --- @@ -755,7 +766,6 @@ will be chosen even if you have an entry for image/* in your overrides all system and Emacs-provided defaults. To get the old method back, set 'mailcap-prefer-mailcap-viewers' to nil. - ** URL *** The file: handler no longer looks for index.html in directories if @@ -763,14 +773,12 @@ you ask it for a file:///dir URL. Since this is a low-level library, such decisions (if they are to be made at all) are left to higher-level functions. - ** image-mode *** image-mode started using ImageMagick by default for all images some years back. It now respects 'imagemagick-types-inhibit' as a way to disable that. - +++ ** The new function 'read-answer' accepts either long or short answers depending on the new customizable variable 'read-answer-short'. diff --git a/lisp/files.el b/lisp/files.el index c4a68d0440..d0804b000a 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1024,13 +1024,33 @@ customize the variable `user-emacs-directory-warning'." errtype user-emacs-directory))))) bestname)))) +(defun exec-path () + "List of directories to search programs to run in remote subprocesses. +The remote host is identified by `default-directory'. For remote +hosts which do not support subprocesses, this returns `nil'. +If `default-directory' is a local directory, the value of the variable +`exec-path' is returned." + (let ((handler (find-file-name-handler default-directory 'exec-path))) + (if handler + (funcall handler 'exec-path) + exec-path))) -(defun executable-find (command) +(defun executable-find (command &optional remote) "Search for COMMAND in `exec-path' and return the absolute file name. -Return nil if COMMAND is not found anywhere in `exec-path'." - ;; Use 1 rather than file-executable-p to better match the behavior of - ;; call-process. - (locate-file command exec-path exec-suffixes 1)) +Return nil if COMMAND is not found anywhere in `exec-path'. If +REMOTE is non-nil, search on the remote host indicated by +`default-directory' instead." + (if (and remote (file-remote-p default-directory)) + (let ((res (locate-file + command + (mapcar + (lambda (x) (concat (file-remote-p default-directory) x)) + (exec-path)) + exec-suffixes 'file-executable-p))) + (when (stringp res) (file-local-name res))) + ;; Use 1 rather than file-executable-p to better match the + ;; behavior of call-process. + (locate-file command exec-path exec-suffixes 1))) (defun load-library (library) "Load the Emacs Lisp library named LIBRARY. diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index cf9667ac62..2fc7ac251e 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -4439,6 +4439,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") (put 'process-file 'ange-ftp 'ange-ftp-process-file) (put 'start-file-process 'ange-ftp 'ignore) (put 'shell-command 'ange-ftp 'ange-ftp-shell-command) +(put 'exec-path 'ange-ftp 'ignore) ;;; Define ways of getting at unmodified Emacs primitives, ;;; turning off our handler. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index df2160770b..7cb61adde8 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -107,6 +107,7 @@ It is used for TCP/IP devices." . tramp-adb-handle-directory-files-and-attributes) (dired-compress-file . ignore) (dired-uncache . tramp-handle-dired-uncache) + (exec-path . tramp-adb-handle-exec-path) (expand-file-name . tramp-adb-handle-expand-file-name) (file-accessible-directory-p . tramp-handle-file-accessible-directory-p) (file-acl . ignore) @@ -1116,6 +1117,21 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (tramp-flush-connection-property v "process-name") (tramp-flush-connection-property v "process-buffer")))))) +(defun tramp-adb-handle-exec-path () + "Like `exec-path' for Tramp files." + (append + (with-parsed-tramp-file-name default-directory nil + (with-tramp-connection-property v "remote-path" + (tramp-adb-send-command v "echo \\\"$PATH\\\"") + (split-string + (with-current-buffer (tramp-get-connection-buffer v) + ;; Read the expression. + (goto-char (point-min)) + (read (current-buffer))) + ":" 'omit))) + ;; The equivalent to `exec-directory'. + `(,(file-local-name default-directory)))) + (defun tramp-adb-get-device (vec) "Return full host name from VEC to be used in shell execution. E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\" @@ -1340,18 +1356,6 @@ connection if a previous connection has died for some reason." (tramp-error vec 'file-error "Cannot switch to user `%s'" user))) - ;; Set "remote-path" connection property. This is needed - ;; for eshell. - (tramp-adb-send-command vec "echo \\\"$PATH\\\"") - (tramp-set-connection-property - vec "remote-path" - (split-string - (with-current-buffer (tramp-get-connection-buffer vec) - ;; Read the expression. - (goto-char (point-min)) - (read (current-buffer))) - ":" 'omit)) - ;; Set connection-local variables. (tramp-set-connection-local-variables vec) diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 42c3d40c1b..5d7562f707 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -220,6 +220,7 @@ It must be supported by libarchive(3).") . tramp-handle-directory-files-and-attributes) (dired-compress-file . tramp-archive-handle-not-implemented) (dired-uncache . tramp-archive-handle-dired-uncache) + (exec-path . ignore) ;; `expand-file-name' performed by default handler. (file-accessible-directory-p . tramp-handle-file-accessible-directory-p) (file-acl . ignore) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index aa0c99bf9c..9af57fb075 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -236,6 +236,17 @@ If NAME is a remote file name, the local part of NAME is unquoted." (defconst tramp-compat-use-url-tramp-p (fboundp 'temporary-file-directory) "Whether to use url-tramp.el.") +;; `exec-path' is new in Emacs 27.1. +(eval-and-compile + (if (fboundp 'exec-path) + (defalias 'tramp-compat-exec-path 'exec-path) + (defun tramp-compat-exec-path () + "List of directories to search programs to run in remote subprocesses." + (let ((handler (find-file-name-handler default-directory 'exec-path))) + (if handler + (funcall handler 'exec-path) + exec-path))))) + (add-hook 'tramp-unload-hook (lambda () (unload-feature 'tramp-loaddefs 'force) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 87c0c796b6..a30d7ef713 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -536,6 +536,7 @@ It has been changed in GVFS 1.14.") . tramp-handle-directory-files-and-attributes) (dired-compress-file . ignore) (dired-uncache . tramp-handle-dired-uncache) + (exec-path . ignore) (expand-file-name . tramp-gvfs-handle-expand-file-name) (file-accessible-directory-p . tramp-handle-file-accessible-directory-p) (file-acl . ignore) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 76dae9cea5..0b3c12333f 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -990,6 +990,7 @@ of command line.") . tramp-sh-handle-directory-files-and-attributes) (dired-compress-file . tramp-sh-handle-dired-compress-file) (dired-uncache . tramp-handle-dired-uncache) + (exec-path . tramp-sh-handle-exec-path) (expand-file-name . tramp-sh-handle-expand-file-name) (file-accessible-directory-p . tramp-handle-file-accessible-directory-p) (file-acl . tramp-sh-handle-file-acl) @@ -3083,6 +3084,13 @@ the result will be a local, non-Tramp, file name." (keyboard-quit) ret)))) +(defun tramp-sh-handle-exec-path () + "Like `exec-path' for Tramp files." + (append + (tramp-get-remote-path (tramp-dissect-file-name default-directory)) + ;; The equivalent to `exec-directory'. + `(,(file-local-name default-directory)))) + (defun tramp-sh-handle-file-local-copy (filename) "Like `file-local-copy' for Tramp files." (with-parsed-tramp-file-name filename nil diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 0334f052a0..335f05cfce 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -229,6 +229,7 @@ See `tramp-actions-before-shell' for more info.") . tramp-handle-directory-files-and-attributes) (dired-compress-file . ignore) (dired-uncache . tramp-handle-dired-uncache) + (exec-path . ignore) (expand-file-name . tramp-smb-handle-expand-file-name) (file-accessible-directory-p . tramp-handle-file-accessible-directory-p) (file-acl . tramp-smb-handle-file-acl) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 1d6e0146c4..d56b09a604 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2163,7 +2163,9 @@ ARGS are the arguments OPERATION has been called with." ((member operation '(process-file shell-command start-file-process ;; Emacs 26+ only. - make-nearby-temp-file temporary-file-directory)) + make-nearby-temp-file temporary-file-directory + ;; Emacs 27+ only. + exec-path)) default-directory) ;; PROC. ((member operation @@ -4616,19 +4618,9 @@ Only works for Bourne-like shells." ;; when `default-directory' points to another host. (defun tramp-eshell-directory-change () "Set `eshell-path-env' to $PATH of the host related to `default-directory'." + ;; Remove last element of `(exec-path)', which is `exec-directory'. (setq eshell-path-env - (if (tramp-tramp-file-p default-directory) - (with-parsed-tramp-file-name default-directory nil - (mapconcat - 'identity - (or - ;; When `tramp-own-remote-path' is in `tramp-remote-path', - ;; the remote path is only set in the session cache. - (tramp-get-connection-property - (tramp-get-connection-process v) "remote-path" nil) - (tramp-get-connection-property v "remote-path" nil)) - ":")) - (getenv "PATH")))) + (mapconcat 'identity (butlast (tramp-compat-exec-path)) ":"))) (eval-after-load "esh-util" '(progn diff --git a/lisp/shell.el b/lisp/shell.el index 232186083d..91c65ed171 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -468,6 +468,8 @@ Shell buffers. It implements `shell-completion-execonly' for (set (make-local-variable 'comint-file-name-chars) shell-file-name-chars) (set (make-local-variable 'comint-file-name-quote-list) shell-file-name-quote-list) + (set (make-local-variable 'comint-file-name-prefix) + (file-remote-p default-directory)) (set (make-local-variable 'comint-dynamic-complete-functions) shell-dynamic-complete-functions) (setq-local comint-unquote-function #'shell--unquote-argument) @@ -1170,9 +1172,12 @@ Returns t if successful." (start (if (zerop (length filename)) (point) (match-beginning 0))) (end (if (zerop (length filename)) (point) (match-end 0))) (filenondir (file-name-nondirectory filename)) - ; why cdr? see `shell-dynamic-complete-command' - (path-dirs (append (cdr (reverse exec-path)) - (if (memq system-type '(windows-nt ms-dos)) '(".")))) + (path-dirs + ;; Ignore `exec-directory', the last entry in `exec-path'. + (append (cdr (reverse (exec-path))) + (if (and (memq system-type '(windows-nt ms-dos)) + (not (file-remote-p default-directory))) + '(".")))) (cwd (file-name-as-directory (expand-file-name default-directory))) (ignored-extensions (and comint-completion-fignore diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index b327e64818..0a8716be0d 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el @@ -748,7 +748,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (tramp-archive-cleanup-hash)))) ;; The functions were introduced in Emacs 26.1. -(ert-deftest tramp-archive-test37-make-nearby-temp-file () +(ert-deftest tramp-archive-test38-make-nearby-temp-file () "Check `make-nearby-temp-file' and `temporary-file-directory'." (skip-unless tramp-archive-enabled) ;; Since Emacs 26.1. @@ -785,7 +785,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (delete-directory tmp-file) (should-not (file-exists-p tmp-file)))) -(ert-deftest tramp-archive-test40-file-system-info () +(ert-deftest tramp-archive-test41-file-system-info () "Check that `file-system-info' returns proper values." (skip-unless tramp-archive-enabled) ;; Since Emacs 27.1. @@ -802,7 +802,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (zerop (nth 1 fsi)) (zerop (nth 2 fsi)))))) -(ert-deftest tramp-archive-test42-auto-load () +(ert-deftest tramp-archive-test43-auto-load () "Check that `tramp-archive' autoloads properly." (skip-unless tramp-archive-enabled) ;; Autoloading tramp-archive works since Emacs 27.1. @@ -832,7 +832,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (mapconcat 'shell-quote-argument load-path " -L ") (shell-quote-argument (format code file))))))))) -(ert-deftest tramp-archive-test42-delay-load () +(ert-deftest tramp-archive-test43-delay-load () "Check that `tramp-archive' is loaded lazily, only when needed." (skip-unless tramp-archive-enabled) ;; Autoloading tramp-archive works since Emacs 27.1. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index c5cb4cb43e..df07a8f1b8 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -33,7 +33,7 @@ ;; remote host, set this environment variable to "/dev/null" or ;; whatever is appropriate on your system. -;; For slow remote connections, `tramp-test41-asynchronous-requests' +;; For slow remote connections, `tramp-test42-asynchronous-requests' ;; might be too heavy. Setting $REMOTE_PARALLEL_PROCESSES to a proper ;; value less than 10 could help. @@ -4021,7 +4021,45 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (put 'explicit-shell-file-name 'permanent-local nil) (kill-buffer "*shell*")))) -(ert-deftest tramp-test34-vc-registered () +;; The function was introduced in Emacs 27.1. +(ert-deftest tramp-test34-exec-path () + "Check `exec-path' and `executable-find'." + (skip-unless (tramp--test-enabled)) + (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) + ;; Since Emacs 27.1. + (skip-unless (boundp 'exec-path)) + + (let ((tmp-name (tramp--test-make-temp-name)) + (default-directory tramp-test-temporary-file-directory)) + (unwind-protect + (progn + (should (consp (with-no-warnings (exec-path)))) + ;; Last element is the `exec-directory'. + (should + (string-equal + (car (last (with-no-warnings (exec-path)))) + (file-local-name default-directory))) + ;; The shell "sh" shall always exist. + (should (executable-find "sh" 'remote)) + ;; Since the last element in `exec-path' is the current + ;; directory, an executable file in that directory will be + ;; found. + (write-region "foo" nil tmp-name) + (should (file-exists-p tmp-name)) + (set-file-modes tmp-name #o777) + (should (file-executable-p tmp-name)) + (should + (string-equal + (executable-find (file-name-nondirectory tmp-name) 'remote) + (file-local-name tmp-name))) + (should-not + (executable-find + (concat (file-name-nondirectory tmp-name) "foo") 'remote))) + + ;; Cleanup. + (ignore-errors (delete-file tmp-name))))) + +(ert-deftest tramp-test35-vc-registered () "Check `vc-registered'." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) @@ -4091,7 +4129,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Cleanup. (ignore-errors (delete-directory tmp-name1 'recursive)))))) -(ert-deftest tramp-test35-make-auto-save-file-name () +(ert-deftest tramp-test36-make-auto-save-file-name () "Check `make-auto-save-file-name'." (skip-unless (tramp--test-enabled)) @@ -4182,7 +4220,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (ignore-errors (delete-file tmp-name1)) (ignore-errors (delete-directory tmp-name2 'recursive)))))) -(ert-deftest tramp-test36-find-backup-file-name () +(ert-deftest tramp-test37-find-backup-file-name () "Check `find-backup-file-name'." (skip-unless (tramp--test-enabled)) @@ -4293,7 +4331,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (ignore-errors (delete-directory tmp-name2 'recursive)))))) ;; The functions were introduced in Emacs 26.1. -(ert-deftest tramp-test37-make-nearby-temp-file () +(ert-deftest tramp-test38-make-nearby-temp-file () "Check `make-nearby-temp-file' and `temporary-file-directory'." (skip-unless (tramp--test-enabled)) ;; Since Emacs 26.1. @@ -4586,7 +4624,7 @@ This requires restrictions of file name syntax." (ignore-errors (delete-directory tmp-name2 'recursive)))))) (defun tramp--test-special-characters () - "Perform the test in `tramp-test38-special-characters*'." + "Perform the test in `tramp-test39-special-characters*'." ;; Newlines, slashes and backslashes in file names are not ;; supported. So we don't test. And we don't test the tab ;; character on Windows or Cygwin, because the backslash is @@ -4634,7 +4672,7 @@ This requires restrictions of file name syntax." files (list (mapconcat 'identity files "")))))) ;; These tests are inspired by Bug#17238. -(ert-deftest tramp-test38-special-characters () +(ert-deftest tramp-test39-special-characters () "Check special characters in file names." (skip-unless (tramp--test-enabled)) (skip-unless (not (tramp--test-rsync-p))) @@ -4642,7 +4680,7 @@ This requires restrictions of file name syntax." (tramp--test-special-characters)) -(ert-deftest tramp-test38-special-characters-with-stat () +(ert-deftest tramp-test39-special-characters-with-stat () "Check special characters in file names. Use the `stat' command." :tags '(:expensive-test) @@ -4660,7 +4698,7 @@ Use the `stat' command." tramp-connection-properties))) (tramp--test-special-characters))) -(ert-deftest tramp-test38-special-characters-with-perl () +(ert-deftest tramp-test39-special-characters-with-perl () "Check special characters in file names. Use the `perl' command." :tags '(:expensive-test) @@ -4681,7 +4719,7 @@ Use the `perl' command." tramp-connection-properties))) (tramp--test-special-characters))) -(ert-deftest tramp-test38-special-characters-with-ls () +(ert-deftest tramp-test39-special-characters-with-ls () "Check special characters in file names. Use the `ls' command." :tags '(:expensive-test) @@ -4704,7 +4742,7 @@ Use the `ls' command." (tramp--test-special-characters))) (defun tramp--test-utf8 () - "Perform the test in `tramp-test39-utf8*'." + "Perform the test in `tramp-test40-utf8*'." (let* ((utf8 (if (and (eq system-type 'darwin) (memq 'utf-8-hfs (coding-system-list))) 'utf-8-hfs 'utf-8)) @@ -4739,7 +4777,7 @@ Use the `ls' command." (replace-regexp-in-string "[\t\n/.?]" "" x))) language-info-alist))))))) -(ert-deftest tramp-test39-utf8 () +(ert-deftest tramp-test40-utf8 () "Check UTF8 encoding in file names and file contents." (skip-unless (tramp--test-enabled)) (skip-unless (not (tramp--test-docker-p))) @@ -4749,7 +4787,7 @@ Use the `ls' command." (tramp--test-utf8)) -(ert-deftest tramp-test39-utf8-with-stat () +(ert-deftest tramp-test40-utf8-with-stat () "Check UTF8 encoding in file names and file contents. Use the `stat' command." :tags '(:expensive-test) @@ -4769,7 +4807,7 @@ Use the `stat' command." tramp-connection-properties))) (tramp--test-utf8))) -(ert-deftest tramp-test39-utf8-with-perl () +(ert-deftest tramp-test40-utf8-with-perl () "Check UTF8 encoding in file names and file contents. Use the `perl' command." :tags '(:expensive-test) @@ -4792,7 +4830,7 @@ Use the `perl' command." tramp-connection-properties))) (tramp--test-utf8))) -(ert-deftest tramp-test39-utf8-with-ls () +(ert-deftest tramp-test40-utf8-with-ls () "Check UTF8 encoding in file names and file contents. Use the `ls' command." :tags '(:expensive-test) @@ -4815,7 +4853,7 @@ Use the `ls' command." tramp-connection-properties))) (tramp--test-utf8))) -(ert-deftest tramp-test40-file-system-info () +(ert-deftest tramp-test41-file-system-info () "Check that `file-system-info' returns proper values." (skip-unless (tramp--test-enabled)) ;; Since Emacs 27.1. @@ -4837,7 +4875,7 @@ Use the `ls' command." (ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test))))) ;; This test is inspired by Bug#16928. -(ert-deftest tramp-test41-asynchronous-requests () +(ert-deftest tramp-test42-asynchronous-requests () "Check parallel asynchronous requests. Such requests could arrive from timers, process filters and process sentinels. They shall not disturb each other." @@ -5012,7 +5050,7 @@ process sentinels. They shall not disturb each other." (ignore-errors (delete-directory tmp-name 'recursive))))))) ;; This test is inspired by Bug#29163. -(ert-deftest tramp-test42-auto-load () +(ert-deftest tramp-test43-auto-load () "Check that Tramp autoloads properly." (let ((default-directory (expand-file-name temporary-file-directory)) (code @@ -5030,7 +5068,7 @@ process sentinels. They shall not disturb each other." (mapconcat 'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) -(ert-deftest tramp-test42-delay-load () +(ert-deftest tramp-test43-delay-load () "Check that Tramp is loaded lazily, only when needed." ;; The autoloaded Tramp objects are different since Emacs 26.1. We ;; cannot test older Emacsen, therefore. @@ -5063,7 +5101,7 @@ process sentinels. They shall not disturb each other." (mapconcat 'shell-quote-argument load-path " -L ") (shell-quote-argument (format code tm))))))))) -(ert-deftest tramp-test42-recursive-load () +(ert-deftest tramp-test43-recursive-load () "Check that Tramp does not fail due to recursive load." (skip-unless (tramp--test-enabled)) @@ -5087,7 +5125,7 @@ process sentinels. They shall not disturb each other." (mapconcat 'shell-quote-argument load-path " -L ") (shell-quote-argument code)))))))) -(ert-deftest tramp-test42-remote-load-path () +(ert-deftest tramp-test43-remote-load-path () "Check that Tramp autoloads its packages with remote `load-path'." ;; The autoloaded Tramp objects are different since Emacs 26.1. We ;; cannot test older Emacsen, therefore. @@ -5115,7 +5153,7 @@ process sentinels. They shall not disturb each other." (mapconcat 'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) -(ert-deftest tramp-test43-unload () +(ert-deftest tramp-test44-unload () "Check that Tramp and its subpackages unload completely. Since it unloads Tramp, it shall be the last test to run." :tags '(:expensive-test) @@ -5176,14 +5214,14 @@ Since it unloads Tramp, it shall be the last test to run." ;; * file-name-case-insensitive-p ;; * Work on skipped tests. Make a comment, when it is impossible. -;; * Revisit expensive tests, once problems in tramp-error are solved. +;; * Revisit expensive tests, once problems in `tramp-error' are solved. ;; * Fix `tramp-test05-expand-file-name-relative' in `expand-file-name'. ;; * Fix `tramp-test06-directory-file-name' for `ftp'. ;; * Investigate, why `tramp-test11-copy-file' and `tramp-test12-rename-file' ;; do not work properly for `owncloud'. ;; * Fix `tramp-test29-start-file-process' on MS Windows (`process-send-eof'?). ;; * Fix `tramp-test30-interrupt-process', timeout doesn't work reliably. -;; * Fix Bug#16928 in `tramp-test41-asynchronous-requests'. +;; * Fix Bug#16928 in `tramp-test42-asynchronous-requests'. (provide 'tramp-tests) ;;; tramp-tests.el ends here commit d289e7e38a4769fad8a3390721f75d996d0e07b4 Author: Tak Kunihiro <tkk@misasa.okayama-u.ac.jp> Date: Wed Jun 20 09:27:50 2018 +0200 Fix bug of 'mouse-drag-and-drop-region' to detect edges of region (Bug#31905) * lisp/mouse.el (mouse-drag-and-drop-region): Detect both the beginning and the end of character of region during dragging text. diff --git a/lisp/mouse.el b/lisp/mouse.el index 5c9056fb43..f749d12054 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -2515,9 +2515,9 @@ is copied instead of being cut." (setq drag-but-negligible (and (eq (overlay-buffer mouse-drag-and-drop-overlay) buffer-to-paste) - (< (overlay-start mouse-drag-and-drop-overlay) + (<= (overlay-start mouse-drag-and-drop-overlay) point-to-paste) - (< point-to-paste + (<= point-to-paste (overlay-end mouse-drag-and-drop-overlay))))) ;; Show a tooltip. commit e292c0973cf7a92819d312ea8a828b67e6adf1ab Author: Noam Postavsky <npostavs@gmail.com> Date: Tue Jun 12 18:41:46 2018 -0400 Fix #'fun handling inside `labels' (Bug#31792) * lisp/emacs-lisp/cl.el (labels): Apply the equivalent of the cl-labels change from 2015-01-16 "* lisp/emacs-lisp/cl-macs.el: Fix last change". * test/lisp/emacs-lisp/cl-tests.el (labels-function-quoting): New test. * lisp/emacs-lisp/cl-macs.el (cl-flet, cl-labels): Improve docstring, link to relevant manual page. * doc/misc/cl.texi (Function Bindings): Don't imply that function cells of symbols are modified by cl-flet. Don't claim that cl-flet or cl-labels affect references of the form (quote FUNC). diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi index bf85b00e93..553b935b1e 100644 --- a/doc/misc/cl.texi +++ b/doc/misc/cl.texi @@ -1299,17 +1299,18 @@ These forms make @code{let}-like bindings to functions instead of variables. @defmac cl-flet (bindings@dots{}) forms@dots{} -This form establishes @code{let}-style bindings on the function -cells of symbols rather than on the value cells. Each @var{binding} -must be a list of the form @samp{(@var{name} @var{arglist} -@var{forms}@dots{})}, which defines a function exactly as if -it were a @code{cl-defun} form. The function @var{name} is defined -accordingly but only within the body of the @code{cl-flet}, hiding any external -definition if applicable. +This form establishes @code{let}-style bindings for functions rather +than values. Each @var{binding} must be a list of the form +@samp{(@var{name} @var{arglist} @var{body}@dots{})}. Within +@var{forms}, any reference to the function @var{name} uses the local +definition instead of the global one. + +A ``reference'' to a function name is either a call to that function, +or a use of its name quoted by @code{function} to be passed on to, +say, @code{mapcar}. The bindings are lexical in scope. This means that all references to -the named functions must appear physically within the body of the -@code{cl-flet} form. +the named functions must appear physically within @var{forms}. Functions defined by @code{cl-flet} may use the full Common Lisp argument notation supported by @code{cl-defun}; also, the function @@ -1336,10 +1337,6 @@ functions must appear physically within the body of the the functions themselves. Thus, @code{cl-labels} can define local recursive functions, or mutually-recursive sets of functions. -A ``reference'' to a function name is either a call to that -function, or a use of its name quoted by @code{quote} or -@code{function} to be passed on to, say, @code{mapcar}. - Note that the @file{cl.el} version of this macro behaves slightly differently. @xref{Obsolete Macros}. @end defmac diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 9c47ceae18..0854e665b9 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -1964,13 +1964,16 @@ a `let' form, except that the list of symbols can be computed at run-time." ;;;###autoload (defmacro cl-flet (bindings &rest body) "Make local function definitions. -Like `cl-labels' but the definitions are not recursive. -Each binding can take the form (FUNC EXP) where +Each definition can take the form (FUNC EXP) where FUNC is the function name, and EXP is an expression that returns the function value to which it should be bound, or it can take the more common form \(FUNC ARGLIST BODY...) which is a shorthand for (FUNC (lambda ARGLIST BODY)). +FUNC is defined only within FORM, not BODY, so you can't write +recursive function definitions. Use `cl-labels' for that. See +info node `(cl) Function Bindings' for details. + \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" (declare (indent 1) (debug ((&rest (cl-defun)) cl-declarations body))) (let ((binds ()) (newenv macroexpand-all-environment)) @@ -2012,9 +2015,13 @@ Like `cl-flet' but the definitions can refer to previous ones. ;;;###autoload (defmacro cl-labels (bindings &rest body) - "Make temporary function bindings. -The bindings can be recursive and the scoping is lexical, but capturing them -in closures will only work if `lexical-binding' is in use. + "Make local (recursive) function definitions. +Each definition can take the form (FUNC ARGLIST BODY...) where +FUNC is the function name, ARGLIST its arguments, and BODY the +forms of the function body. FUNC is defined in any BODY, as well +as FORM, so you can write recursive and mutually recursive +function definitions. See info node `(cl) Function Bindings' for +details. \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" (declare (indent 1) (debug cl-flet)) diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index d53c8e0bbc..f6643158d2 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el @@ -466,9 +466,12 @@ rather than relying on `lexical-binding'." (push var sets) (push (cons (car binding) `(lambda (&rest cl-labels-args) - (cl-list* 'funcall ',var - cl-labels-args))) + (if (eq (car cl-labels-args) cl--labels-magic) + (list cl--labels-magic ',var) + (cl-list* 'funcall ',var cl-labels-args)))) newenv))) + ;; `lexical-let' adds `cl--function-convert' (which calls + ;; `cl--labels-convert') as a macroexpander for `function'. (macroexpand-all `(lexical-let ,vars (setq ,@sets) ,@body) newenv))) ;; Generalized variables are provided by gv.el, but some details are diff --git a/test/lisp/emacs-lisp/cl-tests.el b/test/lisp/emacs-lisp/cl-tests.el new file mode 100644 index 0000000000..b673822cd9 --- /dev/null +++ b/test/lisp/emacs-lisp/cl-tests.el @@ -0,0 +1,35 @@ +;;; cl-tests.el --- tests for emacs-lisp/cl.el -*- lexical-binding:t -*- + +;; Copyright (C) 2018 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; This program 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. +;; +;; This program 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 this program. If not, see `https://www.gnu.org/licenses/'. + +;;; Commentary: + +;;; Code: + +(require 'cl) +(require 'ert) + + + +(ert-deftest labels-function-quoting () + "Test that #'foo does the right thing in `labels'." ; Bug#31792. + (should (eq (funcall (labels ((foo () t)) + #'foo)) + t))) + +;;; cl-tests.el ends here commit 3a47f3921bdaaf7b7d80dc3be05a5f1b1f2501eb Author: JoĂŁo Távora <joaotavora@gmail.com> Date: Tue Jun 19 20:59:27 2018 +0100 Properly ignore stderr in elisp Flymake backend Naively passing `null-device' as stderr creates a buffer named "/dev/null" instead. Pass a hidden buffer name instead. (Bug#31902). * lisp/progmodes/elisp-mode.el (elisp-flymake-byte-compile): Pass hidden buffer as make-process :stderr instead of null-device. diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index d74c523c8c..8eded03b9c 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -1717,7 +1717,7 @@ current buffer state and calls REPORT-FN when done." (format "byte-compile process %s died" proc)))) (ignore-errors (delete-file temp-file)) (kill-buffer output-buffer)))) - :stderr null-device + :stderr " *stderr of elisp-flymake-byte-compile*" :noquery t))))) (defun elisp-flymake--batch-compile-for-flymake (&optional file) commit a9b720ac5030a4ca84e8ebe8436027da0468624c Author: Daniel Colascione <dancol@dancol.org> Date: Tue Jun 19 07:38:47 2018 -0700 Fix theme application Fix an inverted test. Patch due to Andy Moreton. * lisp/cus-face.el (custom-theme-set-faces): Correct sense of `custom--should-apply-setting' test. diff --git a/lisp/cus-face.el b/lisp/cus-face.el index 039c1fafa7..54f5d51358 100644 --- a/lisp/cus-face.el +++ b/lisp/cus-face.el @@ -342,7 +342,7 @@ argument list." ;; is aliased to. (if (get face 'face-alias) (setq face (get face 'face-alias))) - (if (custom--should-apply-setting theme) + (if (not (custom--should-apply-setting theme)) ;; Just update theme settings. (custom-push-theme 'theme-face face theme 'set spec) ;; Update theme settings and set the face spec. commit e5a15ee1c2153da0676b29680dcc003ea368e272 Author: Daniel Colascione <dancol@dancol.org> Date: Mon Jun 18 20:41:25 2018 -0700 Unbreak dabbrev This commit partially reverts edb1f85a27817a3fac38bb85752671414819203b, which results in dabbev expansion failing due to trying to switch to the null buffer. * lisp/dabbrev.el (dabbrev--progress-reporter): Restore variable. (dabbrev--find-expansion): Restore original code. diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el index 4af22e6140..57ee9a526a 100644 --- a/lisp/dabbrev.el +++ b/lisp/dabbrev.el @@ -327,6 +327,9 @@ this list." ;; The regexp for recognizing a character in an abbreviation. (defvar dabbrev--abbrev-char-regexp nil) +;; The progress reporter for buffer-scanning progress. +(defvar dabbrev--progress-reporter nil) + ;;---------------------------------------------------------------- ;; Macros ;;---------------------------------------------------------------- @@ -736,19 +739,21 @@ of the start of the occurrence." ;; Put that list in dabbrev--friend-buffer-list. (unless dabbrev--friend-buffer-list (setq dabbrev--friend-buffer-list - (dabbrev--make-friend-buffer-list)))) + (dabbrev--make-friend-buffer-list)) + (setq dabbrev--progress-reporter + (make-progress-reporter + "Scanning for dabbrevs..." + (- (length dabbrev--friend-buffer-list)) 0 0 1 1.5)))) ;; Walk through the buffers till we find a match. (let (expansion) - (dolist-with-progress-reporter - (_ dabbrev--friend-buffer-list) - (make-progress-reporter - "Scanning for dabbrevs..." - 0 (length dabbrev--friend-buffer-list) 0 1 1.5) + (while (and (not expansion) dabbrev--friend-buffer-list) (setq dabbrev--last-buffer (pop dabbrev--friend-buffer-list)) (set-buffer dabbrev--last-buffer) + (progress-reporter-update dabbrev--progress-reporter + (- (length dabbrev--friend-buffer-list))) (setq dabbrev--last-expansion-location (point-min)) - (setq expansion (dabbrev--try-find abbrev nil 1 ignore-case)) - (unless expansion (setq dabbrev--friend-buffer-list '()))) + (setq expansion (dabbrev--try-find abbrev nil 1 ignore-case))) + (progress-reporter-done dabbrev--progress-reporter) expansion))))) ;; Compute the list of buffers to scan. commit 3057260b476a5c8efde523d0e5e72202b96ed9d1 Author: Stefan Monnier <monnier@iro.umontreal.ca> Date: Mon Jun 18 22:19:57 2018 -0400 lisp/obsolete/*tls.el: Note when obsolescence was decided diff --git a/lisp/obsolete/starttls.el b/lisp/obsolete/starttls.el index e2dff2d53d..0dc2663870 100644 --- a/lisp/obsolete/starttls.el +++ b/lisp/obsolete/starttls.el @@ -6,6 +6,7 @@ ;; Author: Simon Josefsson <simon@josefsson.org> ;; Created: 1999/11/20 ;; Keywords: TLS, SSL, OpenSSL, GnuTLS, mail, news +;; Obsolete-since: 27.1 ;; This file is part of GNU Emacs. diff --git a/lisp/obsolete/tls.el b/lisp/obsolete/tls.el index b02a2654d4..fb7c20c843 100644 --- a/lisp/obsolete/tls.el +++ b/lisp/obsolete/tls.el @@ -4,6 +4,7 @@ ;; Author: Simon Josefsson <simon@josefsson.org> ;; Keywords: comm, tls, gnutls, ssl +;; Obsolete-since: 27.1 ;; This file is part of GNU Emacs. commit 1e2e48c13c3902c251360bce83a5fa212fd4b825 Author: JoĂŁo Távora <joaotavora@gmail.com> Date: Tue Jun 19 03:02:09 2018 +0100 Skip a json.c test unless functions being tested exist * test/src/json-tests.el (json-parse-with-custom-null-and-false-objects): Skip this test unless functions being tested exist. diff --git a/test/src/json-tests.el b/test/src/json-tests.el index ffa6fe19f9..8bd679b886 100644 --- a/test/src/json-tests.el +++ b/test/src/json-tests.el @@ -210,6 +210,8 @@ Test with both unibyte and multibyte strings." (should (looking-at-p (rx " [456]" eos))))) (ert-deftest json-parse-with-custom-null-and-false-objects () + (skip-unless (and (fboundp 'json-serialize) + (fboundp 'json-parse-string))) (let* ((input "{ \"abc\" : [9, false] , \"def\" : null }") (output commit d37d30cef5bbbdf8d17315835126d76d4681b22a Author: JoĂŁo Távora <joaotavora@gmail.com> Date: Tue Jun 19 02:49:54 2018 +0100 Mark a specific electric-pair-mode test as an expected failure See https://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00535.html * test/lisp/electric-tests.el (electric-pair-whitespace-chomping-2-at-point-4-in-c++-mode-in-strings): Mark as failing. diff --git a/test/lisp/electric-tests.el b/test/lisp/electric-tests.el index 2f64b2c08e..7e94dfa496 100644 --- a/test/lisp/electric-tests.el +++ b/test/lisp/electric-tests.el @@ -391,6 +391,16 @@ baz\"\"" :bindings '((electric-pair-skip-whitespace . chomp)) :test-in-comments nil) + +;; A test failure introduced by some changes in CC mode. Hopefully CC +;; mode will sort this out eventually, using some new e-p-m machinery. +;; See +;; https://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00535.html +(setf + (ert-test-expected-result-type + (ert-get-test 'electric-pair-whitespace-chomping-2-at-point-4-in-c++-mode-in-strings)) + :failed) + (define-electric-pair-test whitespace-chomping-dont-cross-comments " ( \n\t\t\n ) " "--)------" :expected-string " () \n\t\t\n ) " :expected-point 4 commit 5b9cc1508e80e7e39ffea0395c1e9128405514dc Author: Mark Oteiza <mvoteiza@udel.edu> Date: Mon Jun 18 21:27:26 2018 -0400 Change errant if to when (Bug#31840) * lisp/emacs-lisp/subr-x.el: Expand to 'when' instead of 'if'. diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 7fab9083e8..e03a81c892 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -152,8 +152,8 @@ are non-nil, then the result is non-nil." (let (res) (if varlist `(let* ,(setq varlist (internal--build-bindings varlist)) - (if ,(setq res (caar (last varlist))) - ,@(or body `(,res)))) + (when ,(setq res (caar (last varlist))) + ,@(or body `(,res)))) `(let* () ,@(or body '(t)))))) (defmacro if-let (spec then &rest else) commit 6353387835f6cb34765ac525ac3e9edf3239e589 Author: JoĂŁo Távora <joaotavora@gmail.com> Date: Tue Jun 19 02:18:43 2018 +0100 Electric-pair-mode lets modes choose how to skip whitespace cc-mode.el-based major-modes with stricter syntax for invalid NL-terminated strings might choose to have electric-pair-mode skip some of whitespace into non-string-syntax regions, for the sake of letting electric-pair-mode chomp that whitespace and make the string valid again. * lisp/elec-pair.el (electric-pair-post-self-insert-function): Call it. (electric-pair-skip-whitespace-function): New buffer-local variable. diff --git a/lisp/elec-pair.el b/lisp/elec-pair.el index 97049a7d9d..85c25f0469 100644 --- a/lisp/elec-pair.el +++ b/lisp/elec-pair.el @@ -155,6 +155,13 @@ return value is considered instead." (const :tag "Newline" ?\n)) (list character))) +(defvar-local electric-pair-skip-whitespace-function + #'electric-pair--skip-whitespace + "Function to use to skip whitespace forward. +Before attempting a skip, if `electric-pair-skip-whitespace' is +non-nil, this function is called. It move point to a new buffer +position, presumably skipping only whitespace in between.") + (defun electric-pair--skip-whitespace () "Skip whitespace forward, not crossing comment or string boundaries." (let ((saved (point)) @@ -501,7 +508,7 @@ happened." (functionp electric-pair-skip-whitespace)) (funcall electric-pair-skip-whitespace) electric-pair-skip-whitespace))) - (electric-pair--skip-whitespace)) + (funcall electric-pair-skip-whitespace-function)) (eq (char-after) last-command-event)))) ;; This is too late: rather than insert&delete we'd want to only ;; skip (or insert in overwrite mode). The difference is in what @@ -509,7 +516,7 @@ happened." ;; be visible to other post-self-insert-hook. We'll just have to ;; live with it for now. (when skip-whitespace-info - (electric-pair--skip-whitespace)) + (funcall electric-pair-skip-whitespace-function)) (delete-region (1- pos) (if (eq skip-whitespace-info 'chomp) (point) pos)) commit 5498acb5a2b4a19060d17c0e2ce0aec36ee684f9 Author: Noam Postavsky <npostavs@gmail.com> Date: Mon Jun 11 20:41:07 2018 -0400 Stop assuming .git is a directory in gitmerge.el * admin/gitmerge.el (gitmerge-maybe-resume): Use 'git rev-parse --git-dir' to find the git directory rather than assuming it is .git/ (that assumption fails for separated worktrees). diff --git a/admin/gitmerge.el b/admin/gitmerge.el index e676e8fa02..a123e0352d 100644 --- a/admin/gitmerge.el +++ b/admin/gitmerge.el @@ -483,8 +483,12 @@ Throw an user-error if we cannot resolve automatically." (defun gitmerge-maybe-resume () "Check if we have to resume a merge. If so, add no longer conflicted files and commit." - (let ((mergehead (file-exists-p - (expand-file-name ".git/MERGE_HEAD" default-directory))) + (let ((mergehead + (file-exists-p + (expand-file-name + "MERGE_HEAD" + (car (process-lines + "git" "rev-parse" "--no-flags" "--git-dir"))))) (statusexist (file-exists-p gitmerge-status-file))) (when (and mergehead (not statusexist)) (user-error "Unfinished merge, but no record of a previous gitmerge run")) commit 91ebbbfa107c60db84e09d54d952ffd969821ccb Author: Noam Postavsky <npostavs@gmail.com> Date: Wed May 23 19:26:49 2018 -0400 Default to splash on current frame, if none visible (Bug#31169) * lisp/startup.el (fancy-splash-frame): Default to current frame. diff --git a/lisp/startup.el b/lisp/startup.el index fdf6cc1dba..c1e56fcdff 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1903,7 +1903,8 @@ we put it on this frame." (if (and (frame-visible-p frame) (not (window-minibuffer-p (frame-selected-window frame)))) (setq chosen-frame frame))) - chosen-frame)) + ;; If there are no visible frames yet, try the selected one. + (or chosen-frame (selected-frame)))) (defun use-fancy-splash-screens-p () "Return t if fancy splash screens should be used." commit 97d5d1a1f4790f959d1bee64e552b492103eddbe Author: Noam Postavsky <npostavs@gmail.com> Date: Thu Jul 13 08:52:39 2017 -0400 Move tls.el and starttls.el to lisp/obsolete/ (Bug#31457) * lisp/obsolete/tls.el: Moved from lisp/net/tls.el. * lisp/gnus/nnimap.el: * lisp/url/url-http.el: Don't require tls, since it's obsolete. * lisp/net/network-stream.el: Only require tls if we actually try to use it (i.e., when (gnutls-available-p) returns nil). Declare some functions to fix compilation warnings. * lisp/obsolete/starttls.el: Moved from lisp/net/starttls.el. * lisp/net/sieve-manage.el: * lisp/net/network-stream.el: Don't require `starttls' at the top-level, declare the variables and functions used instead. (network-stream-open-starttls): Only require `starttls' if needed (i.e., gnutls-available-p fails). * etc/NEWS: Announce obsoletion. diff --git a/etc/NEWS b/etc/NEWS index f290e76e44..632627b241 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -485,6 +485,10 @@ Tramp for some look-alike remote file names. ** The options.el library has been removed. It was obsolete since Emacs 22.1, replaced by customize. +** The tls.el and starttls.el libraries are now marked obsolete. +Use of built-in libgnutls based functionality (described in the Emacs +GnuTLS manual) is recommended instead. + ** Message diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index dc51b5f0f0..3b39731927 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -36,7 +36,6 @@ (require 'nnoo) (require 'netrc) (require 'utf7) -(require 'tls) (require 'parse-time) (require 'nnmail) diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el index 19e0c6421f..a0589e25a4 100644 --- a/lisp/net/network-stream.el +++ b/lisp/net/network-stream.el @@ -42,14 +42,20 @@ ;;; Code: -(require 'tls) -(require 'starttls) (require 'auth-source) (require 'nsm) (require 'puny) +(declare-function starttls-available-p "starttls" ()) +(declare-function starttls-negotiate "starttls" (process)) + (autoload 'gnutls-negotiate "gnutls") (autoload 'open-gnutls-stream "gnutls") +(defvar starttls-extra-arguments) +(defvar starttls-extra-args) +(defvar starttls-use-gnutls) +(defvar starttls-gnutls-program) +(defvar starttls-program) ;;;###autoload (defun open-network-stream (name buffer host service &rest parameters) @@ -255,7 +261,8 @@ gnutls-boot (as returned by `gnutls-boot-parameters')." (or (gnutls-available-p) (and (or require-tls (plist-get parameters :use-starttls-if-possible)) - (starttls-available-p)))) + (require 'starttls) + (starttls-available-p)))) (not (eq (plist-get parameters :type) 'plain))) ;; If using external STARTTLS, drop this connection and start ;; anew with `starttls-open-stream'. @@ -336,7 +343,8 @@ gnutls-boot (as returned by `gnutls-boot-parameters')." ;; See `starttls-available-p'. If this predicate ;; changes to allow running under Windows, the error ;; message below should be amended. - (if (memq system-type '(windows-nt ms-dos)) + (if (or (memq system-type '(windows-nt ms-dos)) + (not (featurep 'starttls))) (concat "Emacs does not support TLS") (concat "Emacs does not support TLS, and no external `" (if starttls-use-gnutls @@ -373,6 +381,8 @@ gnutls-boot (as returned by `gnutls-boot-parameters')." (unless (= start (point)) (buffer-substring start (point))))))) +(declare-function open-tls-stream "tls" (name buffer host port)) + (defun network-stream-open-tls (name buffer host service parameters) (with-current-buffer buffer (let* ((start (point-max)) @@ -380,6 +390,7 @@ gnutls-boot (as returned by `gnutls-boot-parameters')." (if (gnutls-available-p) (open-gnutls-stream name buffer host service (plist-get parameters :nowait)) + (require 'tls) (open-tls-stream name buffer host service))) (eoc (plist-get parameters :end-of-command))) (if (plist-get parameters :nowait) @@ -406,6 +417,9 @@ gnutls-boot (as returned by `gnutls-boot-parameters')." (network-stream-command stream capability-command eo-capa) 'tls))))))) +(declare-function format-spec "format-spec" (format spec)) +(declare-function format-spec-make "format-spec" (&rest pairs)) + (defun network-stream-open-shell (name buffer host service parameters) (require 'format-spec) (let* ((capability-command (plist-get parameters :capability-command)) diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el index cd40307238..8c70ae037a 100644 --- a/lisp/net/sieve-manage.el +++ b/lisp/net/sieve-manage.el @@ -77,7 +77,6 @@ (eval-when-compile (require 'cl-lib)) (require 'sasl) -(require 'starttls) (autoload 'sasl-find-mechanism "sasl") (autoload 'auth-source-search "auth-source") diff --git a/lisp/net/starttls.el b/lisp/obsolete/starttls.el similarity index 100% rename from lisp/net/starttls.el rename to lisp/obsolete/starttls.el diff --git a/lisp/net/tls.el b/lisp/obsolete/tls.el similarity index 100% rename from lisp/net/tls.el rename to lisp/obsolete/tls.el diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index 0b95453b30..53798f77c3 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -1600,7 +1600,6 @@ p3p ;; HTTPS. This used to be in url-https.el, but that file collides ;; with url-http.el on systems with 8-character file names. -(require 'tls) (defconst url-https-asynchronous-p t "HTTPS retrievals are asynchronous.") commit 1d9d35a4e8d6339e064bfe5b1655544e851128ff Merge: 96dd452be5 36737705b4 Author: Glenn Morris <rgm@gnu.org> Date: Mon Jun 18 12:14:26 2018 -0700 Merge from origin/emacs-26 3673770 (origin/emacs-26) Fix vertical-motion with 'visual' line-numb... d8bff53 ; CONTRIBUTE: Add a couple of nits. commit 96dd452be5b4accbd72864573f479d8b66d5e0e5 Merge: 988b53ed2d 48829cba21 Author: Glenn Morris <rgm@gnu.org> Date: Mon Jun 18 12:14:26 2018 -0700 ; Merge from origin/emacs-26 The following commits were skipped: 48829cb Handle NSAttributedString inputs (bug#29837) 0deab3f Allow inserting non-BMP characters commit 988b53ed2d3287f7ee9cfa4225765a97a245c133 Merge: 2f477cbe7f ebe065fddf Author: Glenn Morris <rgm@gnu.org> Date: Mon Jun 18 12:14:26 2018 -0700 Merge from origin/emacs-26 ebe065f Prevent errant scroll on mouse click (Bug#31546) ffd2018 Minor documentation fix cf4dc95 * lisp/window.el (window-toggle-side-windows): Doc fix. (Bug... commit 2f477cbe7f7754c08e00b2b8bdceb2bc1a836db3 Merge: b455a1b2a8 e1284341fd Author: Glenn Morris <rgm@gnu.org> Date: Mon Jun 18 12:14:26 2018 -0700 ; Merge from origin/emacs-26 The following commits were skipped: e128434 Fix byte compilation of (eq foo 'default) 4753d79 Fix Bug#31846. Do not merge with master commit b455a1b2a8b927d3376e30814954a88f611a17c1 Merge: 2c335777f7 63ba73a9f2 Author: Glenn Morris <rgm@gnu.org> Date: Mon Jun 18 12:14:25 2018 -0700 Merge from origin/emacs-26 63ba73a Fix documentation of ':propertize' in mode-line-format 22aa665 Reject invalid 5-byte sequences when detecting UTF-8 encoding 0d3c358 Fix 'replace-buffer-contents' in multibyte buffers c79a627 Update etc/NEWS for mail-source-movemail-program change 63f1dc4 Improve movemail default 0b1a2ae Delete description of deleted Customize functions fcd66d0 Keep vc-print-log from putting point at buffer end (Bug#31764) Conflicts: etc/NEWS commit 2c335777f78cac0f44df217a48762739533b32db Merge: 72b20dd7a8 b635c548c6 Author: Glenn Morris <rgm@gnu.org> Date: Mon Jun 18 12:14:24 2018 -0700 ; Merge from origin/emacs-26 The following commit was skipped: b635c54 Don’t set EMACS=t if Bash is 4.4 or newer commit 72b20dd7a8d073fe98abbd559f6d0e9e8dc674c1 Merge: 0f7c3bae44 a933ebef57 Author: Glenn Morris <rgm@gnu.org> Date: Mon Jun 18 12:14:24 2018 -0700 Merge from origin/emacs-26 a933ebe Improve commentary in info.el 94e84a9 ; Further wording fix in tramp.texi a5a0b11 Fix wording in tramp.texi 2933242 * doc/misc/tramp.texi (Remote shell setup): Fix typo. commit 0f7c3bae445dc161835d9f1fea1461996aa1f6c6 Merge: ef02c9fd1a 6d4cbe8084 Author: Glenn Morris <rgm@gnu.org> Date: Mon Jun 18 12:14:24 2018 -0700 ; Merge from origin/emacs-26 The following commits were skipped: 6d4cbe8 Finish the Bug#11728 work: hg & git 66a491f Fix Bug#11728: show files updated by git commit ef02c9fd1a6bdafebc2bba58a551ec11e29bd394 Merge: e347754df7 5bdc344780 Author: Glenn Morris <rgm@gnu.org> Date: Mon Jun 18 12:14:24 2018 -0700 Merge from origin/emacs-26 5bdc344 ; Reduce quoting for SELECTOR in 'make -C test' (Bug#31744) b6b793b ; test/Makefile.in: Add TEST_INTERACTIVE option (Bug#31744). 1aa906f Make 'tags' targets respect --with-silent-rules (Bug#31744) Conflicts: test/Makefile.in test/README commit e347754df7b8ec6a6e5d1f1a7749f5a19746d55f Merge: 012338f34e 642c11fdd1 Author: Glenn Morris <rgm@gnu.org> Date: Mon Jun 18 12:13:51 2018 -0700 ; Merge from origin/emacs-26 The following commit was skipped: 642c11f soap-client: Add byte-code compatibility function (Bug#31742) commit 012338f34ea037929ac018bd8e044c51acfc6a2e Merge: bfc1dfd459 9c6f35a6b2 Author: Glenn Morris <rgm@gnu.org> Date: Mon Jun 18 12:13:51 2018 -0700 Merge from origin/emacs-26 9c6f35a * doc/lispref/files.texi (Unique File Names): Fix a typo. (B... commit 36737705b451ad4c765baa5789e3ceb752ee07a3 Author: Eli Zaretskii <eliz@gnu.org> Date: Mon Jun 18 19:39:16 2018 +0300 Fix vertical-motion with 'visual' line-number display * src/indent.c (Fvertical_motion): Don't exempt 'visual' sty;e of line-number display from X coordinate adjustments. (Bug#31875) diff --git a/src/indent.c b/src/indent.c index bcffa0d11e..9c751bc30b 100644 --- a/src/indent.c +++ b/src/indent.c @@ -2147,8 +2147,7 @@ whether or not it is currently displayed in some window. */) will sometimes err by one column. */ int lnum_width = 0; int lnum_pixel_width = 0; - if (!NILP (Vdisplay_line_numbers) - && !EQ (Vdisplay_line_numbers, Qvisual)) + if (!NILP (Vdisplay_line_numbers)) line_number_display_width (w, &lnum_width, &lnum_pixel_width); SET_TEXT_POS (pt, PT, PT_BYTE); itdata = bidi_shelve_cache (); commit d8bff5305b83d15f1a000de988b3c1f6a0803425 Author: Eli Zaretskii <eliz@gnu.org> Date: Mon Jun 18 19:34:55 2018 +0300 ; CONTRIBUTE: Add a couple of nits. diff --git a/CONTRIBUTE b/CONTRIBUTE index c324375bb0..c4f424ce56 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -78,9 +78,16 @@ admin/notes/bug-triage. ** Documenting your changes Any change that matters to end-users should have an entry in etc/NEWS. +Try to start each NEWS entry with a sentence that summarizes the entry +and takes just one line -- this will allow to read NEWS in Outline +mode after hiding the body of each entry. Doc-strings should be updated together with the code. +New defcustom's should always have a ':version' tag stating the first +Emacs version in which they will appear. Likewise with defcustom's +whose value is changed -- update their ':version' tag. + Think about whether your change requires updating the manuals. If you know it does not, mark the NEWS entry with "---". If you know that *all* the necessary documentation updates have been made as part commit bfc1dfd459c431e95ef685e7cd39f8a8a90d2377 Author: Eli Zaretskii <eliz@gnu.org> Date: Mon Jun 18 19:21:09 2018 +0300 Improve documentation of recent changes in Comint * lisp/comint.el (comint-insert-previous-argument) (comint-arguments, comint-insert-previous-argument-from-end): Doc fixes. (comint-insert-previous-argument-from-end): Add :version. * doc/emacs/misc.texi (Shell Ring): Fix a typo in the name of 'comint-insert-previous-argument'. Document 'comint-insert-previous-argument-from-end'. (Bug#25271) * etc/NEWS: Reformat and rephrase the entry for recent Comint changes. diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 7c595388ea..24586eb281 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -1133,7 +1133,7 @@ Fetch the next subsequent command from the history @item C-c . @kindex C-c . @r{(Shell mode)} -@findex comint-input-previous-argument +@findex comint-insert-previous-argument Fetch one argument from an old shell command (@code{comint-input-previous-argument}). @@ -1180,14 +1180,20 @@ you just repeated. Then type @key{RET} to reexecute this command. You can reexecute several successive commands by typing @kbd{C-c C-x @key{RET}} over and over. - The command @kbd{C-c .}@: (@code{comint-input-previous-argument}) + The command @kbd{C-c .}@: (@code{comint-insert-previous-argument}) copies an individual argument from a previous command, like -@kbd{@key{ESC} .} in Bash. The simplest use copies the last argument from the -previous shell command. With a prefix argument @var{n}, it copies the -@var{n}th argument instead. Repeating @kbd{C-c .} copies from an -earlier shell command instead, always using the same value of @var{n} -(don't give a prefix argument when you repeat the @kbd{C-c .} -command). +@kbd{@key{ESC} .}@: in Bash and @command{zsh}. The simplest use +copies the last argument from the previous shell command. With a +prefix argument @var{n}, it copies the @var{n}th argument instead. +Repeating @kbd{C-c .} copies from an earlier shell commands, always +using the same value of @var{n} (don't give a prefix argument when +you repeat the @kbd{C-c .} command). + +@vindex comint-insert-previous-argument-from-end + If you set @code{comint-insert-previous-argument-from-end} to a +non-@code{nil} value, @kbd{C-c .}@: will instead copy the @var{n}th +argument counting from the last one; this emulates @kbd{@key{ESC} .}@: +in @command{zsh}. These commands get the text of previous shell commands from a special history list, not from the shell buffer itself. Thus, editing the shell diff --git a/etc/NEWS b/etc/NEWS index 5568e29eb8..f290e76e44 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -186,24 +186,29 @@ navigation and editing of large files. * Changes in Specialized Modes and Packages in Emacs 27.1 ** Browse-url + *** The function 'browse-url-emacs' can now visit a URL in selected window. It now treats the optional 2nd argument to mean that the URL should be shown in the currently selected window. ** Comint -*** 'comint-insert-previous-argument' no longer interprets &. -This worked strangely in shell-mode in the presence of &&. And omitting this -logic makes sense since 'comint-insert-previous-argument' exists to emulate M-. -in bash and zsh, and neither of those treat & specially. - -*** 'comint-insert-previous-argument' knows how to count args -from the beginning or from the end. This is useful because -'comint-insert-previous-argument' exists to emulate M-. in bash and zsh; and -bash counts from the start while zsh counts from the end. - -*** New variable 'comint-insert-previous-argument-from-end' controls whether -args passed to 'comint-insert-previous-argument' count from the beginning or -from the end + ++++ +*** 'C-c .' (comint-insert-previous-argument) no longer interprets '&'. +This feature caused problems when '&&' was present in the previous +command. Since this command emulates 'M-.' in Bash and zsh, neither +of which treats '&' specially, the feature was removed for +compatibility with these shells. + ++++ +*** 'comint-insert-previous-argument' can now count arguments from the end. +By default, invoking 'C-c .' with a numeric argument N would copy the +Nth argument, counting from the first one. But if the new option +'comint-insert-previous-argument-from-end' is non-nil, it will copy +the Nth argument counting from the last one. Thus 'C-c .' can now +better emulate 'M-.' in both Bash and zsh, since the former counts +from the beginning of the arguments, while the latter counts from the +end. ** Flymake diff --git a/lisp/comint.el b/lisp/comint.el index 82c547c976..71a2b5eca5 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -1682,8 +1682,9 @@ characters), and are not considered to be delimiters." (defun comint-arguments (string nth mth) "Return from STRING the NTH to MTH arguments. -NTH and/or MTH can be nil, which means the last argument. NTH -and MTH can be <0 to count from the end; -1 means last argument. +NTH and/or MTH can be nil, which means the last argument. +NTH and MTH can be negative to count from the end; -1 means +the last argument. Returned arguments are separated by single spaces. We assume whitespace separates arguments, except within quotes and except for a space or tab that immediately follows a backslash. Also, a @@ -2660,14 +2661,15 @@ text matching `comint-prompt-regexp'." (defvar-local comint-insert-previous-argument-last-index nil) (defcustom comint-insert-previous-argument-from-end nil - "If nil, the INDEX argument to -`comint-insert-previous-argument' refers to the INDEX-th -argument, counting from the beginning; if non-nil, counting from -the end. This exists to emulate the bahavior of `M-number M-.' -in bash and zsh: in bash, `number' counts from the -beginning (variable in nil), while in zsh it counts from the end." + "If non-nil, `comint-insert-previous-argument' counts args from the end. +If this variable is nil, the default, `comint-insert-previous-argument' +counts the arguments from the beginning; if non-nil, it counts from +the end instead. This allows to emulate the behavior of `ESC-NUM ESC-.' +in both Bash and zsh: in Bash, `number' counts from the +beginning (variable is nil), while in zsh, it counts from the end." :type 'boolean - :group 'comint) + :group 'comint + :version "27.1") (defun comint-insert-previous-argument (index) "Insert the INDEXth argument from the previous Comint command-line at point. @@ -2676,8 +2678,9 @@ necessary to ensure that it's separated from adjacent arguments. Interactively, if no prefix argument is given, the last argument is inserted. Repeated interactive invocations will cycle through the same argument from progressively earlier commands (using the value of INDEX specified -with the first command). Values of INDEX<0 count from the end, so INDEX=-1 -is the last argument. This command is like `M-.' in bash and zsh." +with the first command). Values of INDEX < 0 count from the end, so +INDEX = -1 is the last argument. This command is like `M-.' in +Bash and zsh." (interactive "P") (unless (null index) (setq index (prefix-numeric-value index))) commit 3e2215642bbca3d1335155278eace39d0a87c267 Author: Richard Stallman <rms@gnu.org> Date: Mon Jun 18 00:20:45 2018 -0700 rmail-summary-by-senders defaults to sender * etc/NEWS: Mention this. * lisp/mail/rmailsum.el (rmail-summary-by-senders): Offer From field of current message as a default argument. diff --git a/etc/NEWS b/etc/NEWS index 87c3950b1e..5568e29eb8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -522,6 +522,10 @@ been removed. Use 'encode-coding-string', 'decode-coding-string', and If this option is non-nil, messages appended to an output file by the 'rmail-output' command have their Deleted flag reset. +*** The command 'rmail-summary-by-senders' with an empty argument +selects the messages to summarize with a regexp that matches the +sender of the current message. + * New Modes and Packages in Emacs 27.1 +++ diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el index 3dd486a792..e5363d2198 100644 --- a/lisp/mail/rmailsum.el +++ b/lisp/mail/rmailsum.el @@ -390,8 +390,17 @@ SUBJECT is a regular expression." ;;;###autoload (defun rmail-summary-by-senders (senders) "Display a summary of all messages whose \"From\" field matches SENDERS. -SENDERS is a regular expression." - (interactive "sSenders to summarize by: ") +SENDERS is a regular expression. The default for SENDERS matches the +sender of the current messsage." + (interactive + (let* ((def (rmail-get-header "From")) + ;; We quote the default argument, because if it contains regexp + ;; special characters (eg "?"), it can fail to match itself. + (sender (regexp-quote def)) + (prompt (concat "Senders to summarize by (regexp" + (if sender ", default this message's sender" "") + "): "))) + (list (read-string prompt nil nil sender)))) (rmail-new-summary (concat "senders " senders) (list 'rmail-summary-by-senders senders) 'rmail-message-senders-p senders)) commit ba2ddadb5378351e8003c8e172b52bfabaa27554 Author: Dima Kogan <dima@secretsauce.net> Date: Sun Dec 25 11:49:44 2016 -0800 comint-insert-previous-argument doesn't detect and ignore trailing & This function is invoked in shell-mode by the user, and is meant to emulate what M-. does in zsh and bash: it inserts an argument from a previous command. Neither zsh nor bash treat a trailing & specially: M-. simply inserts it if it is encountered. Emacs DID have extra logic to detect and discard trailing &, but this logic was buggy, and a && anywhere in the sequence would confuse it. This patch simply removes that logic to fix the bug and to emulate zsh and bash more closely * lisp/comint.el (comint-insert-previous-argument): don't detect and ignore trailing & (Bug#25271) * etc/NEWS: Document this. diff --git a/etc/NEWS b/etc/NEWS index 8bf1da470f..87c3950b1e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -191,6 +191,11 @@ It now treats the optional 2nd argument to mean that the URL should be shown in the currently selected window. ** Comint +*** 'comint-insert-previous-argument' no longer interprets &. +This worked strangely in shell-mode in the presence of &&. And omitting this +logic makes sense since 'comint-insert-previous-argument' exists to emulate M-. +in bash and zsh, and neither of those treat & specially. + *** 'comint-insert-previous-argument' knows how to count args from the beginning or from the end. This is useful because 'comint-insert-previous-argument' exists to emulate M-. in bash and zsh; and diff --git a/lisp/comint.el b/lisp/comint.el index f66e40b150..82c547c976 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -2705,9 +2705,6 @@ is the last argument. This command is like `M-.' in bash and zsh." (set-marker comint-insert-previous-argument-last-start-pos (point)) ;; Insert the argument. (let ((input-string (comint-previous-input-string 0))) - (when (string-match "[ \t\n]*&" input-string) - ;; strip terminating '&' - (setq input-string (substring input-string 0 (match-beginning 0)))) (insert (comint-arguments input-string index index))) ;; Make next invocation return arg from previous input (setq comint-input-ring-index (1+ (or comint-input-ring-index 0))) commit 74f377b3955198d6f66afa34bbbf6d004aad134a Author: Dima Kogan <dima@secretsauce.net> Date: Sun Dec 25 11:35:26 2016 -0800 comint-insert-previous-argument counts args from start or from end This function is invoked in shell-mode by the user, and is meant to emulate what M-. does in zsh and bash: it inserts an argument from a previous command. Without a prefix argument, it inserts the last arg from the previous command; with an argument INDEX, it inserts the INDEX-th argument. bash counts from the start, while zsh counts from the end. This patch adds a variable `comint-insert-previous-argument-from-end' that emulates the zsh behavior if non-nil. * lisp/comint.el (comint-arguments): can take in negative arguments to count from the end, same as indexing in python. (comint-insert-previous-argument): if comint-insert-previous-argument-from-end is non-nil, INDEX counts arguments from the end; if nil, from the beginning (Bug#25271) * etc/NEWS: Document this. diff --git a/etc/NEWS b/etc/NEWS index 5a3a27ee4a..8bf1da470f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -190,6 +190,16 @@ navigation and editing of large files. It now treats the optional 2nd argument to mean that the URL should be shown in the currently selected window. +** Comint +*** 'comint-insert-previous-argument' knows how to count args +from the beginning or from the end. This is useful because +'comint-insert-previous-argument' exists to emulate M-. in bash and zsh; and +bash counts from the start while zsh counts from the end. + +*** New variable 'comint-insert-previous-argument-from-end' controls whether +args passed to 'comint-insert-previous-argument' count from the beginning or +from the end + ** Flymake +++ diff --git a/lisp/comint.el b/lisp/comint.el index f334a4ca4d..f66e40b150 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -1682,12 +1682,13 @@ characters), and are not considered to be delimiters." (defun comint-arguments (string nth mth) "Return from STRING the NTH to MTH arguments. -NTH and/or MTH can be nil, which means the last argument. -Returned arguments are separated by single spaces. -We assume whitespace separates arguments, except within quotes -and except for a space or tab that immediately follows a backslash. -Also, a run of one or more of a single character -in `comint-delimiter-argument-list' is a separate argument. +NTH and/or MTH can be nil, which means the last argument. NTH +and MTH can be <0 to count from the end; -1 means last argument. +Returned arguments are separated by single spaces. We assume +whitespace separates arguments, except within quotes and except +for a space or tab that immediately follows a backslash. Also, a +run of one or more of a single character in +`comint-delimiter-argument-list' is a separate argument. Argument 0 is the command name." ;; The first line handles ordinary characters and backslash-sequences ;; (except with w32 msdos-like shells, where backslashes are valid). @@ -1709,7 +1710,7 @@ Argument 0 is the command name." (count 0) beg str quotes) ;; Build a list of all the args until we have as many as we want. - (while (and (or (null mth) (<= count mth)) + (while (and (or (null mth) (< mth 0) (<= count mth)) (string-match argpart string pos)) ;; Apply the `literal' text property to backslash-escaped ;; characters, so that `comint-delim-arg' won't break them up. @@ -1736,8 +1737,14 @@ Argument 0 is the command name." args (if quotes (cons str args) (nconc (comint-delim-arg str) args)))) (setq count (length args)) - (let ((n (or nth (1- count))) - (m (if mth (1- (- count mth)) 0))) + (let ((n (cond + ((null nth) (1- count)) + ((>= nth 0) nth) + (t (+ count nth)))) + (m (cond + ((null mth) 0) + ((>= mth 0) (1- (- count mth))) + (t (1- (- mth)))))) (mapconcat (function (lambda (a) a)) (nthcdr n (nreverse (nthcdr m args))) " ")))) @@ -2652,8 +2659,16 @@ text matching `comint-prompt-regexp'." (defvar-local comint-insert-previous-argument-last-start-pos nil) (defvar-local comint-insert-previous-argument-last-index nil) -;; Needs fixing: -;; make comint-arguments understand negative indices as bash does +(defcustom comint-insert-previous-argument-from-end nil + "If nil, the INDEX argument to +`comint-insert-previous-argument' refers to the INDEX-th +argument, counting from the beginning; if non-nil, counting from +the end. This exists to emulate the bahavior of `M-number M-.' +in bash and zsh: in bash, `number' counts from the +beginning (variable in nil), while in zsh it counts from the end." + :type 'boolean + :group 'comint) + (defun comint-insert-previous-argument (index) "Insert the INDEXth argument from the previous Comint command-line at point. Spaces are added at beginning and/or end of the inserted string if @@ -2661,8 +2676,8 @@ necessary to ensure that it's separated from adjacent arguments. Interactively, if no prefix argument is given, the last argument is inserted. Repeated interactive invocations will cycle through the same argument from progressively earlier commands (using the value of INDEX specified -with the first command). -This command is like `M-.' in bash." +with the first command). Values of INDEX<0 count from the end, so INDEX=-1 +is the last argument. This command is like `M-.' in bash and zsh." (interactive "P") (unless (null index) (setq index (prefix-numeric-value index))) @@ -2672,6 +2687,9 @@ This command is like `M-.' in bash." (setq index comint-insert-previous-argument-last-index)) (t ;; This is a non-repeat invocation, so initialize state. + (when (and index + comint-insert-previous-argument-from-end) + (setq index (- index))) (setq comint-input-ring-index nil) (setq comint-insert-previous-argument-last-index index) (when (null comint-insert-previous-argument-last-start-pos) commit 2d1b774dbc31b753527321ae1e441d5e424a5265 Author: Glenn Morris <rgm@gnu.org> Date: Sun Jun 17 10:22:28 2018 -0700 * test/lisp/simple-tests.el (simple-tests-async-shell-command-30280): Use the correct emacs executable, not first in PATH. diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el index 678d9b9385..417aa648ed 100644 --- a/test/lisp/simple-tests.el +++ b/test/lisp/simple-tests.el @@ -533,7 +533,9 @@ See Bug#21722." (second (generate-new-buffer-name base)) ;; `save-window-excursion' doesn't restore frame configurations. (pop-up-frames nil) - (inhibit-message t)) + (inhibit-message t) + (emacs (expand-file-name invocation-name invocation-directory))) + (skip-unless (file-executable-p emacs)) ;; Let `shell-command' create the buffer as needed. (kill-buffer first) (unwind-protect @@ -544,7 +546,7 @@ See Bug#21722." ;; `accept-process-output' is called on the second command. (dolist (form '("(sleep-for 8)" "(message \"\")")) (async-shell-command (format "%s -Q -batch -eval '%s'" - invocation-name form) + emacs form) first)) ;; First command should neither have nor display output. (let* ((buffer (get-buffer first)) commit 45ee24efed57093b421159ca1028097952f2d564 Author: Michael Heerdegen <michael_heerdegen@web.de> Date: Wed Jun 13 04:37:38 2018 +0200 Allow floats as 'pcase' QPATS * lisp/emacs-lisp/pcase.el (\`): Extend semantics of QPATS to all numbers. Add a comment explaining why we disallow some atoms as QPATS. * doc/lispref/control.texi (Backquote Patterns): Update the paragraph explaining QPATS. Remove a sentence suggesting an analogy between QPATS to self-quoting objects. diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index 34f5f57044..975ab3d075 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -1090,12 +1090,10 @@ Matches if @var{expval} is a vector of length @var{m} whose @item @var{symbol} @itemx @var{keyword} -@itemx @var{integer} +@itemx @var{number} @itemx @var{string} Matches if the corresponding element of @var{expval} is @code{equal} to the specified literal object. -Note that, aside from @var{symbol}, this is the same set of -self-quoting literal objects that are acceptable as a core pattern. @item ,@var{pattern} Matches if the corresponding element of @var{expval} diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index fa7b1de8b4..4a69244d26 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -919,7 +919,7 @@ QPAT can take the following forms: ,PAT matches if the `pcase' pattern PAT matches. SYMBOL matches if EXPVAL is `equal' to SYMBOL. KEYWORD likewise for KEYWORD. - INTEGER likewise for INTEGER. + NUMBER likewise for NUMBER. STRING likewise for STRING. The list or vector QPAT is a template. The predicate formed @@ -949,7 +949,10 @@ The predicate is the logical-AND of: `(and (pred consp) (app car ,(list '\` (car qpat))) (app cdr ,(list '\` (cdr qpat))))) - ((or (stringp qpat) (integerp qpat) (symbolp qpat)) `',qpat) + ((or (stringp qpat) (numberp qpat) (symbolp qpat)) `',qpat) + ;; In all other cases just raise an error so we can't break + ;; backward compatibility when adding \` support for other + ;; compounded values that are not `consp' (t (error "Unknown QPAT: %S" qpat)))) (provide 'pcase) commit fa9679ca488a17b2b6b9f31299d69c190aa86642 Author: JoĂŁo Távora <joaotavora@gmail.com> Date: Sun Jun 17 12:41:24 2018 +0100 Minor Flymake docstring fixes * lisp/progmodes/flymake.el (flymake-diagnostic-functions): Clarify meaning of :region in docstring. (flymake-start): Fix broken docstring. diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index eb0eebf672..e8bb3355a0 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -452,11 +452,11 @@ Currently, Flymake may provide these keyword-value pairs: at all (i.e. it's not merely nil). Each element is in the form (BEG END TEXT) where BEG and END - are buffer positions, and text is a string containing the text + are buffer positions, and TEXT is a string containing the text contained between those positions (if any) after the change was performed. -* `:changes-start' and `:changes-end' the minimum and maximum +* `:changes-start' and `:changes-end', the minimum and maximum buffer positions touched by the recent changes. These are only provided if `:recent-changes' is also provided. @@ -470,8 +470,9 @@ asynchronous processes or other asynchronous mechanisms. In any case, backend functions are expected to return quickly or signal an error, in which case the backend is disabled. Flymake will not try disabled backends again for any future checks of -this buffer. Certain commands, like turning `flymake-mode' off -and on again, reset the list of disabled backends. +this buffer. To reset the list of disabled backends, turn +`flymake-mode' off and on again, or interactively call +`flymake-start' with a prefix argument. If the function returns, Flymake considers the backend to be \"running\". If it has not done so already, the backend is @@ -482,8 +483,9 @@ pairs in the form (:REPORT-KEY VALUE :REPORT-KEY2 VALUE2...). Currently accepted values for REPORT-ACTION are: * A (possibly empty) list of diagnostic objects created with - `flymake-make-diagnostic', causing Flymake to annotate the - buffer with this information. + `flymake-make-diagnostic', causing Flymake to delete all + previous diagnostic annotations in the buffer and create new + ones from this list. A backend may call REPORT-FN repeatedly in this manner, but only until Flymake considers that the most recently requested @@ -506,8 +508,10 @@ Currently accepted REPORT-KEY arguments are: consider the report even if it was somehow unexpected. * `:region': a cons (BEG . END) of buffer positions indicating - that the report applies to that region and that previous - reports targeting other buffer regions are still valid.") + that the report applies to that region only. Specifically, + this means that Flymake will only delete diagnostic annotations + of past reports if they intersect the region by at least one + character.") (put 'flymake-diagnostic-functions 'safe-local-variable #'null) @@ -838,7 +842,7 @@ with a report function." "Start a syntax check for the current buffer. DEFERRED is a list of symbols designating conditions to wait for before actually starting the check. If it is nil (the list is - empty), start it immediately, else defer the check to when those +empty), start it immediately, else defer the check to when those conditions are met. Currently recognized conditions are `post-command', for waiting until the current command is over, `on-display', for waiting until the buffer is actually displayed commit 48829cba2168bcf8bfe2301ebe694b37152a7959 Author: Alan Third <alan@idiocy.org> Date: Sun Dec 24 15:40:03 2017 +0000 Handle NSAttributedString inputs (bug#29837) ; Do not merge to master. * src/nsterm.m (EmacsView::insertText): Handle NSAttributedString. diff --git a/src/nsterm.m b/src/nsterm.m index 799bbd5bc0..5ed71c9f8f 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -6317,11 +6317,18 @@ flag set (this is probably a bug in the OS). by doCommandBySelector: deleteBackward: */ - (void)insertText: (id)aString { - NSString *s = aString; - NSUInteger len = [s length]; + NSString *s; + NSUInteger len; NSTRACE ("[EmacsView insertText:]"); + if ([aString isKindOfClass:[NSAttributedString class]]) + s = [aString string]; + else + s = aString; + + len = [s length]; + if (NS_KEYLOG) NSLog (@"insertText '%@'\tlen = %lu", aString, (unsigned long) len); processingCompose = NO; commit 0deab3fbd8a51fc83ab7c8031f4e296a4003b055 Author: Philipp Stephani <phst@google.com> Date: Mon Dec 25 22:00:00 2017 +0100 Allow inserting non-BMP characters * src/coding.h (UTF_16_HIGH_SURROGATE_P, UTF_16_LOW_SURROGATE_P): Move from coding.c and document. (surrogates_to_codepoint): New function. * src/nsterm.m (insertText:): Properly handle surrogate pairs. (cherry picked from commit 703ac3ea1c1ce381f385469a0e88bc29d3fe83c2) diff --git a/src/coding.c b/src/coding.c index b1eb2edb49..867f84de60 100644 --- a/src/coding.c +++ b/src/coding.c @@ -1518,13 +1518,6 @@ encode_coding_utf_8 (struct coding_system *coding) /* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions". Return true if a text is encoded in one of UTF-16 based coding systems. */ -#define UTF_16_HIGH_SURROGATE_P(val) \ - (((val) & 0xFC00) == 0xD800) - -#define UTF_16_LOW_SURROGATE_P(val) \ - (((val) & 0xFC00) == 0xDC00) - - static bool detect_coding_utf_16 (struct coding_system *coding, struct coding_detection_info *detect_info) diff --git a/src/coding.h b/src/coding.h index 2a87fc32e9..502c472314 100644 --- a/src/coding.h +++ b/src/coding.h @@ -662,6 +662,30 @@ struct coding_system /* Note that this encodes utf-8, not utf-8-emacs, so it's not a no-op. */ #define ENCODE_UTF_8(str) code_convert_string_norecord (str, Qutf_8, true) +/* Return true if VAL is a high surrogate. VAL must be a 16-bit code + unit. */ + +#define UTF_16_HIGH_SURROGATE_P(val) \ + (((val) & 0xFC00) == 0xD800) + +/* Return true if VAL is a low surrogate. VAL must be a 16-bit code + unit. */ + +#define UTF_16_LOW_SURROGATE_P(val) \ + (((val) & 0xFC00) == 0xDC00) + +/* Return the Unicode code point for the given UTF-16 surrogates. */ + +INLINE int +surrogates_to_codepoint (int low, int high) +{ + eassert (0 <= low && low <= 0xFFFF); + eassert (0 <= high && high <= 0xFFFF); + eassert (UTF_16_LOW_SURROGATE_P (low)); + eassert (UTF_16_HIGH_SURROGATE_P (high)); + return 0x10000 + (low - 0xDC00) + ((high - 0xD800) * 0x400); +} + /* Extern declarations. */ extern Lisp_Object code_conversion_save (bool, bool); extern bool encode_coding_utf_8 (struct coding_system *); diff --git a/src/nsterm.m b/src/nsterm.m index 1afd637b61..799bbd5bc0 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -6317,14 +6317,13 @@ flag set (this is probably a bug in the OS). by doCommandBySelector: deleteBackward: */ - (void)insertText: (id)aString { - int code; - int len = [(NSString *)aString length]; - int i; + NSString *s = aString; + NSUInteger len = [s length]; NSTRACE ("[EmacsView insertText:]"); if (NS_KEYLOG) - NSLog (@"insertText '%@'\tlen = %d", aString, len); + NSLog (@"insertText '%@'\tlen = %lu", aString, (unsigned long) len); processingCompose = NO; if (!emacs_event) @@ -6334,10 +6333,24 @@ - (void)insertText: (id)aString if (workingText != nil) [self deleteWorkingText]; + /* It might be preferable to use getCharacters:range: below, + cf. https://developer.apple.com/library/content/documentation/Cocoa/Conceptual/CocoaPerformance/Articles/StringDrawing.html#//apple_ref/doc/uid/TP40001445-112378. + However, we probably can't use SAFE_NALLOCA here because it might + exit nonlocally. */ + /* now insert the string as keystrokes */ - for (i =0; i<len; i++) + for (NSUInteger i = 0; i < len; i++) { - code = [aString characterAtIndex: i]; + NSUInteger code = [s characterAtIndex:i]; + if (UTF_16_HIGH_SURROGATE_P (code) && i < len - 1) + { + unichar low = [s characterAtIndex:i + 1]; + if (UTF_16_LOW_SURROGATE_P (low)) + { + code = surrogates_to_codepoint (low, code); + ++i; + } + } /* TODO: still need this? */ if (code == 0x2DC) code = '~'; /* 0x7E */ commit ebe065fddf76fde64a9c07b419b67fe47fb6c1cb Author: Aaron Jensen <aaronjensen@gmail.com> Date: Thu May 24 03:45:03 2018 -0700 Prevent errant scroll on mouse click (Bug#31546) * src/nsterm.m (ns_mouse_position): Use correct frame when determining mouse position. * lisp/mouse.el (mouse-drag-track): Only account for mode-line height if `mode-line-format' is non-nil. diff --git a/lisp/mouse.el b/lisp/mouse.el index 9a3e2235ec..5c9056fb43 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -1225,7 +1225,11 @@ The region will be defined with mark and point." (bounds (window-edges start-window)) (make-cursor-line-fully-visible nil) (top (nth 1 bounds)) - (bottom (if (window-minibuffer-p start-window) + (bottom (if (or (window-minibuffer-p start-window) + ;; Do not account for the mode line if there + ;; is no mode line, which is common for child + ;; frames. + (not mode-line-format)) (nth 3 bounds) ;; Don't count the mode line. (1- (nth 3 bounds)))) diff --git a/src/nsterm.m b/src/nsterm.m index e4a9b014f4..1afd637b61 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -2547,7 +2547,7 @@ so some key presses (TAB) are swallowed by the system. */ if (f && FRAME_NS_P (f)) { - view = FRAME_NS_VIEW (*fp); + view = FRAME_NS_VIEW (f); position = [[view window] mouseLocationOutsideOfEventStream]; position = [view convertPoint: position fromView: nil]; commit 849631c1b7e9c5c4a90655208265de9db0854bb2 Author: Eli Zaretskii <eliz@gnu.org> Date: Sun Jun 17 13:13:52 2018 +0300 Fix last change * etc/NEWS: Fix last added entry. * lisp/subr.el (dotimes-with-progress-reporter) (dolist-with-progress-reporter): Fix the advertised signature. * doc/lispref/display.texi (Progress): Fix last change. (Bug#31696) (Bug#31697) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index feeb1caf19..a3dca1cd9c 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -472,43 +472,51 @@ Secondly, @samp{done} is more explicit. @defmac dotimes-with-progress-reporter (var count [result]) reporter-or-message body@dots{} This is a convenience macro that works the same way as @code{dotimes} does, but also reports loop progress using the functions described -above. It allows you to save some typing. +above. It allows you to save some typing. The argument +@var{reporter-or-message} can be either a string or a progress +reporter object. -You can rewrite the example in the beginning of this node using -this macro this way: +You can rewrite the example in the beginning of this subsection using +this macro as follows: @example +@group (dotimes-with-progress-reporter (k 500) "Collecting some mana for Emacs..." (sit-for 0.01)) +@end group @end example +Using a reporter object as the @var{reporter-or-message} argument is +useful if you want to specify the optional arguments in +@var{make-progress-reporter}. For instance, you can write the +previous example as follows: -The second argument @code{reporter-or-message} might be a progress -reporter object. This is useful if you want to specify the optional -arguments in @code{make-progress-reporter}. -For instance, you can write previous example as follows: @example +@group (dotimes-with-progress-reporter (k 500) (make-progress-reporter "Collecting some mana for Emacs..." 0 500 0 1 1.5) (sit-for 0.01)) +@end group @end example @end defmac @defmac dolist-with-progress-reporter (var count [result]) reporter-or-message body@dots{} This is another convenience macro that works the same way as @code{dolist} does, but also reports loop progress using the functions described -above. As in @code{dotimes-with-progress-reporter}, @code{reporter-or-message} can be -a progress reporter or an string. -We can rewrite our previous example with this macro as follows: +above. As in @code{dotimes-with-progress-reporter}, +@code{reporter-or-message} can be a progress reporter or a string. +You can rewrite the previous example with this macro as follows: @example +@group (dolist-with-progress-reporter (k (number-sequence 0 500)) "Collecting some mana for Emacs..." (sit-for 0.01)) +@end group @end example @end defmac diff --git a/etc/NEWS b/etc/NEWS index b5d3d59320..5a3a27ee4a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -617,7 +617,9 @@ manual for more details. * Lisp Changes in Emacs 27.1 +++ -** New macro dolist-with-progress-reporter. +** New macro 'dolist-with-progress-reporter'. +This works like 'dolist', but reports progress similar to +'dotimes-with-progress-reporter'. +++ ** New hook 'after-delete-frame-functions'. diff --git a/lisp/subr.el b/lisp/subr.el index dc946bd90b..7ac1c91281 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -5050,11 +5050,11 @@ case, use this string to create a progress reporter. At each iteration, print the reporter message followed by progress percentage in the echo area. After the loop is finished, -print the reporter message followed by word \"done\". +print the reporter message followed by the word \"done\". This macro is a convenience wrapper around `make-progress-reporter' and friends. -\(fn (VAR COUNT [RESULT]) MESSAGE BODY...)" +\(fn (VAR COUNT [RESULT]) REPORTER-OR-MESSAGE BODY...)" (declare (indent 2) (debug ((symbolp form &optional form) form body))) (let ((prep (make-symbol "--dotimes-prep--")) (end (make-symbol "--dotimes-end--"))) @@ -5078,9 +5078,9 @@ case, use this string to create a progress reporter. At each iteration, print the reporter message followed by progress percentage in the echo area. After the loop is finished, -print the reporter message followed by word \"done\". +print the reporter message followed by the word \"done\". -\(fn (VAR LIST [RESULT]) MESSAGE BODY...)" +\(fn (VAR LIST [RESULT]) REPORTER-OR-MESSAGE BODY...)" (declare (indent 2) (debug ((symbolp form &optional form) form body))) (let ((prep (make-symbol "--dolist-progress-reporter--")) (count (make-symbol "--dolist-count--")) commit edb1f85a27817a3fac38bb85752671414819203b Author: Tino Calancha <tino.calancha@gmail.com> Date: Sun Jun 17 18:28:34 2018 +0900 Add new macro dolist-with-progress-reporter * lisp/subr.el (dolist-with-progress-reporter): New macro (Bug#31697). * lisp/cus-edit.el (custom-group-value-create): Use it. * lisp/dabbrev.el (dabbrev--progress-reporter): Delete variable. (dabbrev--find-expansion): Use dotimes-with-progress-reporter. * doc/lispref/display.texi: Document the macro. ; * etc/NEWS: Announce it. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 12c36bb08f..feeb1caf19 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -497,6 +497,21 @@ For instance, you can write previous example as follows: @end example @end defmac +@defmac dolist-with-progress-reporter (var count [result]) reporter-or-message body@dots{} +This is another convenience macro that works the same way as @code{dolist} +does, but also reports loop progress using the functions described +above. As in @code{dotimes-with-progress-reporter}, @code{reporter-or-message} can be +a progress reporter or an string. +We can rewrite our previous example with this macro as follows: + +@example +(dolist-with-progress-reporter + (k (number-sequence 0 500)) + "Collecting some mana for Emacs..." + (sit-for 0.01)) +@end example +@end defmac + @node Logging Messages @subsection Logging Messages in @file{*Messages*} @cindex logging echo-area messages diff --git a/etc/NEWS b/etc/NEWS index a77be110ff..b5d3d59320 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -616,6 +616,9 @@ manual for more details. * Lisp Changes in Emacs 27.1 ++++ +** New macro dolist-with-progress-reporter. + +++ ** New hook 'after-delete-frame-functions'. This works like 'delete-frame-functions', but runs after the frame to diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index ff6a4f6d33..723cd5010d 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -4221,19 +4221,14 @@ If GROUPS-ONLY is non-nil, return only those members that are groups." custom-buffer-order-groups)) (prefixes (widget-get widget :custom-prefixes)) (custom-prefix-list (custom-prefix-add symbol prefixes)) - (len (length members)) - (count 0) - (reporter (make-progress-reporter - "Creating group entries..." 0 len)) (have-subtitle (and (not (eq symbol 'emacs)) (eq custom-buffer-order-groups 'last))) prev-type children) - (dolist (entry members) + (dolist-with-progress-reporter (entry members) "Creating group entries..." (unless (eq prev-type 'custom-group) (widget-insert "\n")) - (progress-reporter-update reporter (setq count (1+ count))) (let ((sym (nth 0 entry)) (type (nth 1 entry))) (when (and have-subtitle (eq type 'custom-group)) @@ -4255,8 +4250,7 @@ If GROUPS-ONLY is non-nil, return only those members that are groups." (setq children (nreverse children)) (mapc 'custom-magic-reset children) (widget-put widget :children children) - (custom-group-state-update widget) - (progress-reporter-done reporter)) + (custom-group-state-update widget)) ;; End line (let ((p (1+ (point)))) (insert "\n\n") diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el index 57ee9a526a..4af22e6140 100644 --- a/lisp/dabbrev.el +++ b/lisp/dabbrev.el @@ -327,9 +327,6 @@ this list." ;; The regexp for recognizing a character in an abbreviation. (defvar dabbrev--abbrev-char-regexp nil) -;; The progress reporter for buffer-scanning progress. -(defvar dabbrev--progress-reporter nil) - ;;---------------------------------------------------------------- ;; Macros ;;---------------------------------------------------------------- @@ -739,21 +736,19 @@ of the start of the occurrence." ;; Put that list in dabbrev--friend-buffer-list. (unless dabbrev--friend-buffer-list (setq dabbrev--friend-buffer-list - (dabbrev--make-friend-buffer-list)) - (setq dabbrev--progress-reporter - (make-progress-reporter - "Scanning for dabbrevs..." - (- (length dabbrev--friend-buffer-list)) 0 0 1 1.5)))) + (dabbrev--make-friend-buffer-list)))) ;; Walk through the buffers till we find a match. (let (expansion) - (while (and (not expansion) dabbrev--friend-buffer-list) + (dolist-with-progress-reporter + (_ dabbrev--friend-buffer-list) + (make-progress-reporter + "Scanning for dabbrevs..." + 0 (length dabbrev--friend-buffer-list) 0 1 1.5) (setq dabbrev--last-buffer (pop dabbrev--friend-buffer-list)) (set-buffer dabbrev--last-buffer) - (progress-reporter-update dabbrev--progress-reporter - (- (length dabbrev--friend-buffer-list))) (setq dabbrev--last-expansion-location (point-min)) - (setq expansion (dabbrev--try-find abbrev nil 1 ignore-case))) - (progress-reporter-done dabbrev--progress-reporter) + (setq expansion (dabbrev--try-find abbrev nil 1 ignore-case)) + (unless expansion (setq dabbrev--friend-buffer-list '()))) expansion))))) ;; Compute the list of buffers to scan. diff --git a/lisp/subr.el b/lisp/subr.el index d4383f862a..dc946bd90b 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -5068,6 +5068,34 @@ This macro is a convenience wrapper around `make-progress-reporter' and friends. (progress-reporter-done ,prep) (or ,@(cdr (cdr spec)) nil)))) +(defmacro dolist-with-progress-reporter (spec reporter-or-message &rest body) + "Loop over a list and report progress in the echo area. +Evaluate BODY with VAR bound to each car from LIST, in turn. +Then evaluate RESULT to get return value, default nil. + +REPORTER-OR-MESSAGE is a progress reporter object or a string. In the latter +case, use this string to create a progress reporter. + +At each iteration, print the reporter message followed by progress +percentage in the echo area. After the loop is finished, +print the reporter message followed by word \"done\". + +\(fn (VAR LIST [RESULT]) MESSAGE BODY...)" + (declare (indent 2) (debug ((symbolp form &optional form) form body))) + (let ((prep (make-symbol "--dolist-progress-reporter--")) + (count (make-symbol "--dolist-count--")) + (list (make-symbol "--dolist-list--"))) + `(let ((,prep ,reporter-or-message) + (,count 0) + (,list ,(cadr spec))) + (when (stringp ,prep) + (setq ,prep (make-progress-reporter ,prep 0 (1- (length ,list))))) + (dolist (,(car spec) ,list) + ,@body + (progress-reporter-update ,prep (setq ,count (1+ ,count)))) + (progress-reporter-done ,prep) + (or ,@(cdr (cdr spec)) nil)))) + ;;;; Comparing version strings. commit 5099b3abb2b623ce949b8efc37bee8c41d5ad754 Author: Tino Calancha <tino.calancha@gmail.com> Date: Sun Jun 17 18:28:34 2018 +0900 dotimes-with-progress-reporter: Polymorphic 2nd argument * lisp/subr.el (dotimes-with-progress-reporter): Allow 2nd arg to be a string or a progress reporter (Bug#31696). * doc/lispref/display.texi (node Progress): Update manual. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 0ba7f0fd58..12c36bb08f 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -469,7 +469,7 @@ never print it, there are many good reasons for this not to happen. Secondly, @samp{done} is more explicit. @end defun -@defmac dotimes-with-progress-reporter (var count [result]) message body@dots{} +@defmac dotimes-with-progress-reporter (var count [result]) reporter-or-message body@dots{} This is a convenience macro that works the same way as @code{dotimes} does, but also reports loop progress using the functions described above. It allows you to save some typing. @@ -483,6 +483,18 @@ this macro this way: "Collecting some mana for Emacs..." (sit-for 0.01)) @end example + + +The second argument @code{reporter-or-message} might be a progress +reporter object. This is useful if you want to specify the optional +arguments in @code{make-progress-reporter}. +For instance, you can write previous example as follows: +@example +(dotimes-with-progress-reporter + (k 500) + (make-progress-reporter "Collecting some mana for Emacs..." 0 500 0 1 1.5) + (sit-for 0.01)) +@end example @end defmac @node Logging Messages diff --git a/lisp/subr.el b/lisp/subr.el index 8123e60f62..d4383f862a 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -5039,32 +5039,34 @@ NEW-MESSAGE, if non-nil, sets a new message for the reporter." "Print reporter's message followed by word \"done\" in echo area." (message "%sdone" (aref (cdr reporter) 3))) -(defmacro dotimes-with-progress-reporter (spec message &rest body) +(defmacro dotimes-with-progress-reporter (spec reporter-or-message &rest body) "Loop a certain number of times and report progress in the echo area. Evaluate BODY with VAR bound to successive integers running from 0, inclusive, to COUNT, exclusive. Then evaluate RESULT to get the return value (nil if RESULT is omitted). -At each iteration MESSAGE followed by progress percentage is -printed in the echo area. After the loop is finished, MESSAGE -followed by word \"done\" is printed. This macro is a -convenience wrapper around `make-progress-reporter' and friends. +REPORTER-OR-MESSAGE is a progress reporter object or a string. In the latter +case, use this string to create a progress reporter. + +At each iteration, print the reporter message followed by progress +percentage in the echo area. After the loop is finished, +print the reporter message followed by word \"done\". + +This macro is a convenience wrapper around `make-progress-reporter' and friends. \(fn (VAR COUNT [RESULT]) MESSAGE BODY...)" (declare (indent 2) (debug ((symbolp form &optional form) form body))) - (let ((temp (make-symbol "--dotimes-temp--")) - (temp2 (make-symbol "--dotimes-temp2--")) - (start 0) - (end (nth 1 spec))) - `(let ((,temp ,end) - (,(car spec) ,start) - (,temp2 (make-progress-reporter ,message ,start ,end))) - (while (< ,(car spec) ,temp) - ,@body - (progress-reporter-update ,temp2 - (setq ,(car spec) (1+ ,(car spec))))) - (progress-reporter-done ,temp2) - nil ,@(cdr (cdr spec))))) + (let ((prep (make-symbol "--dotimes-prep--")) + (end (make-symbol "--dotimes-end--"))) + `(let ((,prep ,reporter-or-message) + (,end ,(cadr spec))) + (when (stringp ,prep) + (setq ,prep (make-progress-reporter ,prep 0 ,end))) + (dotimes (,(car spec) ,end) + ,@body + (progress-reporter-update ,prep (1+ ,(car spec)))) + (progress-reporter-done ,prep) + (or ,@(cdr (cdr spec)) nil)))) ;;;; Comparing version strings. commit 39ccbacf9c42b2fed08c47ed7314e4c067de21b9 Author: Michael Albinus <michael.albinus@gmx.de> Date: Sun Jun 17 11:19:16 2018 +0200 Cleanup secrets-tests * test/lisp/net/secrets-tests.el (secrets-test03-items) (secrets-test04-search): Cleanup "session" collection initially. diff --git a/test/lisp/net/secrets-tests.el b/test/lisp/net/secrets-tests.el index b501fa602d..9aa79dab0e 100644 --- a/test/lisp/net/secrets-tests.el +++ b/test/lisp/net/secrets-tests.el @@ -154,6 +154,9 @@ (let (item-path) (should (secrets-open-session)) + ;; Cleanup. There could be items in the "session" collection. + (secrets--test-delete-all-session-items) + ;; There shall be no items in the "session" collection. (should-not (secrets-list-items "session")) ;; There shall be items in the "Login" collection. @@ -215,6 +218,9 @@ (progn (should (secrets-open-session)) + ;; Cleanup. There could be items in the "session" collection. + (secrets--test-delete-all-session-items) + ;; There shall be no items in the "session" collection. (should-not (secrets-list-items "session")) commit ffd20184ca9bb026064f28aa260f2298baeb7fc8 Author: Eli Zaretskii <eliz@gnu.org> Date: Sun Jun 17 11:19:59 2018 +0300 Minor documentation fix * doc/lispref/windows.texi (Window Start and End): Improve documentation and indexing of window-end. diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index f5de2fc90b..265067146d 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -3730,6 +3730,7 @@ argument @var{window}, then returns its result. @end defun @cindex window end position +@cindex last visible position in a window @defun window-end &optional window update This function returns the position where display of its buffer ends in @var{window}. The default for @var{window} is the selected window. @@ -3752,7 +3753,8 @@ Even if @var{update} is non-@code{nil}, @code{window-end} does not attempt to scroll the display if point has moved off the screen, the way real redisplay would do. It does not alter the @code{window-start} value. In effect, it reports where the displayed -text will end if scrolling is not required. +text will end if scrolling is not required. Note that the position it +returns might be only partially visible. @end defun @vindex window-group-end-function commit c6f992b8e30b1d7c2a53a629e1a4be0deda7fb77 Author: Eli Zaretskii <eliz@gnu.org> Date: Sun Jun 17 10:40:29 2018 +0300 When possible, prefer UTF-8 as the safe encoding for saving * lisp/international/mule-cmds.el (select-safe-coding-system): If possible, offer UTF-8 as the default encoding. (Bug#31807) diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 8e69a1c7ab..cf6a8c78d0 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -988,6 +988,11 @@ It is highly recommended to fix it before writing to a file." ;; If all the defaults failed, ask a user. (when (not coding-system) + ;; If UTF-8 is in CODINGS, but is not its first member, make + ;; it the first one, so it is offered as the default. + (and (memq 'utf-8 codings) (not (eq 'utf-8 (car codings))) + (setq codings (append '(utf-8) (delq 'utf-8 codings)))) + (setq coding-system (select-safe-coding-system-interactively from to codings unsafe rejected (car codings)))) commit cf4dc95f166d85a90560cbb3494d2eb878185862 Author: Eli Zaretskii <eliz@gnu.org> Date: Sun Jun 17 08:42:11 2018 +0300 * lisp/window.el (window-toggle-side-windows): Doc fix. (Bug#31858) diff --git a/lisp/window.el b/lisp/window.el index abd1a68b1f..2c0ea8e4d5 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -1144,15 +1144,16 @@ explicitly provided via a `window-parameters' entry in ALIST." buffer best-window 'reuse alist dedicated))))))))) (defun window-toggle-side-windows (&optional frame) - "Toggle side windows on specified FRAME. + "Toggle display of side windows on specified FRAME. FRAME must be a live frame and defaults to the selected one. -If FRAME has at least one side window, save FRAME's state in the -FRAME's `window-state' frame parameter and delete all side -windows on FRAME afterwards. Otherwise, if FRAME has a -`window-state' parameter, use that to restore any side windows on -FRAME leaving FRAME's main window alone. Signal an error if -FRAME has no side window and no saved state is found." +If FRAME has at least one side window, delete all side +windows on FRAME after saving FRAME's state in the +FRAME's `window-state' frame parameter. Otherwise, +restore any side windows recorded in FRAME's `window-state' +parameter, leaving FRAME's main window alone. Signal an +error if FRAME has no side windows and no saved state for +it is found." (interactive) (let* ((frame (window-normalize-frame frame)) (window--sides-inhibit-check t) commit 85a1e2f9278381ea2d95102f8fddb20f8eb0da0c Author: Eli Zaretskii <eliz@gnu.org> Date: Sun Jun 17 08:22:23 2018 +0300 ; * etc/NEWS: Tweak a recently-added NEWS entry. diff --git a/etc/NEWS b/etc/NEWS index 39b8b5ca0c..a77be110ff 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -518,14 +518,21 @@ names" in the Tramp manual for full documentation of these facilities. * Incompatible Lisp Changes in Emacs 27.1 -+++ -** Theme settings generally aren't actually applied until a call to -`enable-theme-, either one made explicitly or implicitly through -`load-theme' with NO-ENABLE nil. This change has the effect of not -applying theme changes just because we load a lisp file containing a -theme specification. The previous behavior is preserved for the -special case of the `user' theme, which is frequently used for -ad-hoc customization. +--- +** Just loading a theme's file no longer activates the theme's settings. +Loading a theme with 'M-x load-theme' still activates the theme, as it +did before. However, loading the theme's file with "M-x load-file", +or using 'require' or 'load' in a Lisp program, doesn't actually apply +the theme's settings until you either invoke 'M-x enable-theme' or +type 'M-x load-theme'. (In a Lisp program, calling 'enable-theme' or +invoking 'load-theme' with NO-ENABLE argument omitted or nil has the +same effect of activating a theme whose file has been loaded.) The +special case of the 'user' theme is an exception: it is frequently +used for ad-hoc customizations, so the settings of that theme are by +default applied immediately. + +The variable 'custom--inhibit-theme-enable' controls this behavior; +its default value changed in Emacs 27.1. ** The 'repetitions' argument of 'benchmark-run' can now also be a variable. ** The FILENAME argument to 'file-name-base' is now mandatory and no commit aabaa9f8c8b79df44887392fcaa199e17b016afd Author: Daniel Colascione <dancol@dancol.org> Date: Sat Jun 16 15:42:56 2018 -0700 Apply non-user themes only when asked Theme settings now generally aren't actually applied until a call to `enable-theme-, either one made explicitly or implicitly through `load-theme' with NO-ENABLE nil. This change has the effect of not applying theme changes just because we load a lisp file containing a theme specification. The previous behavior is preserved for the special case of the `user' theme, which is frequently used for ad-hoc customization. * lisp/cus-face.el (custom-theme-set-faces): Call `custom--should-apply-setting' to decide whether to apply a setting. * lisp/custom.el (custom--should-apply-setting): New function. (custom--inhibit-theme-enable): Add `apply-only-user' option; default to it. (custom-push-theme, custom-theme-set-variables): Call `custom--should-apply-setting' to decide whether to apply a setting. diff --git a/etc/NEWS b/etc/NEWS index d59b4a7cf4..39b8b5ca0c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -518,6 +518,15 @@ names" in the Tramp manual for full documentation of these facilities. * Incompatible Lisp Changes in Emacs 27.1 ++++ +** Theme settings generally aren't actually applied until a call to +`enable-theme-, either one made explicitly or implicitly through +`load-theme' with NO-ENABLE nil. This change has the effect of not +applying theme changes just because we load a lisp file containing a +theme specification. The previous behavior is preserved for the +special case of the `user' theme, which is frequently used for +ad-hoc customization. + ** The 'repetitions' argument of 'benchmark-run' can now also be a variable. ** The FILENAME argument to 'file-name-base' is now mandatory and no longer defaults to 'buffer-file-name'. diff --git a/lisp/cus-face.el b/lisp/cus-face.el index 2b352b3dc6..039c1fafa7 100644 --- a/lisp/cus-face.el +++ b/lisp/cus-face.el @@ -342,7 +342,7 @@ argument list." ;; is aliased to. (if (get face 'face-alias) (setq face (get face 'face-alias))) - (if custom--inhibit-theme-enable + (if (custom--should-apply-setting theme) ;; Just update theme settings. (custom-push-theme 'theme-face face theme 'set spec) ;; Update theme settings and set the face spec. diff --git a/lisp/custom.el b/lisp/custom.el index 2a489c4f5b..4a778a0573 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -843,6 +843,11 @@ to the front of this list.") (unless (custom-theme-p theme) (error "Unknown theme `%s'" theme))) +(defun custom--should-apply-setting (theme) + (or (null custom--inhibit-theme-enable) + (and (eq custom--inhibit-theme-enable 'apply-only-user) + (eq theme 'user)))) + (defun custom-push-theme (prop symbol theme mode &optional value) "Record VALUE for face or variable SYMBOL in custom theme THEME. PROP is `theme-face' for a face, `theme-value' for a variable. @@ -882,7 +887,7 @@ See `custom-known-themes' for a list of known themes." (setcar (cdr setting) value))) ;; Add a new setting: (t - (unless custom--inhibit-theme-enable + (when (custom--should-apply-setting theme) (unless old ;; If the user changed a variable outside of Customize, save ;; the value to a fake theme, `changed'. If the theme is @@ -981,7 +986,7 @@ COMMENT is a comment string about SYMBOL." (let* ((symbol (indirect-variable (nth 0 entry))) (value (nth 1 entry))) (custom-push-theme 'theme-value symbol theme 'set value) - (unless custom--inhibit-theme-enable + (when (custom--should-apply-setting theme) ;; Now set the variable. (let* ((now (nth 2 entry)) (requests (nth 3 entry)) @@ -1149,11 +1154,13 @@ This variable is designed for use in lisp code (including external packages). For manual user customizations, use `custom-theme-directory' instead.") -(defvar custom--inhibit-theme-enable nil +(defvar custom--inhibit-theme-enable 'apply-only-user "Whether the custom-theme-set-* functions act immediately. If nil, `custom-theme-set-variables' and `custom-theme-set-faces' change the current values of the given variable or face. If -non-nil, they just make a record of the theme settings.") +t, they just make a record of the theme settings. If the +value is `apply-only-user', then apply setting to the +`user' theme immediately and defer other updates.") (defun provide-theme (theme) "Indicate that this file provides THEME. commit 6021e1db92e355fbf5c66765fb0bc4658a80180a Author: Noam Postavsky <npostavs@gmail.com> Date: Thu Jun 7 19:58:47 2018 -0400 Don't forget to analyze args of lambda lifted functions (Bug#30872) * lisp/emacs-lisp/cconv.el (cconv--convert-funcbody): New function. (cconv--convert-function): Extracted from here. (cconv-convert): Also use it here, in the lambda lifted case, so that mutated args are properly accounted for. * test/lisp/emacs-lisp/cconv-tests.el: New test. diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index ca46dbb7b5..010026b416 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -206,7 +206,6 @@ Returns a form where all lambdas don't have any free variables." (cl-assert (equal body (caar cconv-freevars-alist))) (let* ((fvs (cdr (pop cconv-freevars-alist))) (body-new '()) - (letbind '()) (envector ()) (i 0) (new-env ())) @@ -227,25 +226,8 @@ Returns a form where all lambdas don't have any free variables." (setq envector (nreverse envector)) (setq new-env (nreverse new-env)) - (dolist (arg args) - (if (not (member (cons (list arg) parentform) cconv-captured+mutated)) - (if (assq arg new-env) (push `(,arg) new-env)) - (push `(,arg . (car-safe ,arg)) new-env) - (push `(,arg (list ,arg)) letbind))) - - (setq body-new (mapcar (lambda (form) - (cconv-convert form new-env nil)) - body)) - - (when letbind - (let ((special-forms '())) - ;; Keep special forms at the beginning of the body. - (while (or (stringp (car body-new)) ;docstring. - (memq (car-safe (car body-new)) '(interactive declare))) - (push (pop body-new) special-forms)) - (setq body-new - `(,@(nreverse special-forms) (let ,letbind . ,body-new))))) - + (setq body-new (cconv--convert-funcbody + args body new-env parentform)) (cond ((not (or envector docstring)) ;If no freevars - do nothing. `(function (lambda ,args . ,body-new))) @@ -279,6 +261,30 @@ Returns a form where all lambdas don't have any free variables." (nthcdr 3 mapping))))) new-env)) +(defun cconv--convert-funcbody (funargs funcbody env parentform) + "Run `cconv-convert' on FUNCBODY, the forms of a lambda expression. +PARENTFORM is the form containing the lambda expression. ENV is a +lexical environment (same format as for `cconv-convert'), not +including FUNARGS, the function's argument list. Return a list +of converted forms." + (let ((letbind ())) + (dolist (arg funargs) + (if (not (member (cons (list arg) parentform) cconv-captured+mutated)) + (if (assq arg env) (push `(,arg . nil) env)) + (push `(,arg . (car-safe ,arg)) env) + (push `(,arg (list ,arg)) letbind))) + (setq funcbody (mapcar (lambda (form) + (cconv-convert form env nil)) + funcbody)) + (if letbind + (let ((special-forms '())) + ;; Keep special forms at the beginning of the body. + (while (or (stringp (car funcbody)) ;docstring. + (memq (car-safe (car funcbody)) '(interactive declare))) + (push (pop funcbody) special-forms)) + `(,@(nreverse special-forms) (let ,letbind . ,funcbody))) + funcbody))) + (defun cconv-convert (form env extend) ;; This function actually rewrites the tree. "Return FORM with all its lambdas changed so they are closed. @@ -292,6 +298,9 @@ ENV is a list where each entry takes the shape either: environment's Nth slot. (VAR . (apply-partially F ARG1 ARG2 ..)): VAR has been λ-lifted and takes additional arguments ARGs. + (VAR . nil): VAR is accessed normally. This is the same as VAR + being absent from ENV, but an explicit nil entry is useful + for shadowing VAR for a specific scope. EXTEND is a list of variables which might need to be accessed even from places where they are shadowed, because some part of ENV causes them to be used at places where they originally did not directly appear." @@ -360,10 +369,8 @@ places where they originally did not directly appear." (not (memq fv funargs))) (push `(,fv . (car-safe ,fv)) funcbody-env))) `(function (lambda ,funcvars . - ,(mapcar (lambda (form) - (cconv-convert - form funcbody-env nil)) - funcbody))))) + ,(cconv--convert-funcbody + funargs funcbody funcbody-env value))))) ;; Check if it needs to be turned into a "ref-cell". ((member (cons binder form) cconv-captured+mutated) diff --git a/test/lisp/emacs-lisp/cconv-tests.el b/test/lisp/emacs-lisp/cconv-tests.el new file mode 100644 index 0000000000..d14847ce45 --- /dev/null +++ b/test/lisp/emacs-lisp/cconv-tests.el @@ -0,0 +1,40 @@ +;;; cconv-tests.el -*- lexical-binding: t -*- + +;; Copyright (C) 2018 Free Software Foundation, Inc. + +;; 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: + +(require 'ert) + +(ert-deftest cconv-convert-lambda-lifted () + "Bug#30872." + (should + (equal (funcall + (byte-compile + '#'(lambda (handle-fun arg) + (let* ((subfun + #'(lambda (params) + (ignore handle-fun) + (funcall #'(lambda () (setq params 42))) + params))) + (funcall subfun arg)))) + nil 99) + 42))) + +(provide 'cconv-tests) +;; cconv-tests.el ends here. commit 05345babc988060cca540770599282102c34f2a7 Author: Noam Postavsky <npostavs@gmail.com> Date: Sat Jun 2 16:22:17 2018 -0400 Fix off by one error in python-mode assertion (Bug#30964) * lisp/progmodes/python.el (python-nav-end-of-statement): Don't assert that string-start is strictly greater than last-string-end, because the string end is a position outside of the string and may therefore be the same as the following string's start. * test/lisp/progmodes/python-tests.el (python-nav-end-of-statement-2): New test. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 6f4a343310..e39ff08739 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1518,7 +1518,7 @@ of the statement." ;; are somehow out of whack. This has been ;; observed when using `syntax-ppss' during ;; narrowing. - (cl-assert (> string-start last-string-end) + (cl-assert (>= string-start last-string-end) :show-args "\ Overlapping strings detected (start=%d, last-end=%d)") diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 1c4d22d72f..0b9f8484c1 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -2004,6 +2004,12 @@ string (python-util-forward-comment -1) (point)))))) +(ert-deftest python-nav-end-of-statement-2 () + "Test the string overlap assertion (Bug#30964)." + (python-tests-with-temp-buffer + "'\n''\n" + (python-nav-end-of-statement))) + (ert-deftest python-nav-forward-statement-1 () (python-tests-with-temp-buffer " commit 92b609c572c127b6c6616413549809ff20ee30c1 Author: Daniel Colascione <dancol@dancol.org> Date: Sat Jun 16 14:21:54 2018 -0700 Restore old echo_truncate condition * src/keyboard.c (read_key_sequence): Restore old echo_truncate condition. diff --git a/src/keyboard.c b/src/keyboard.c index 540991872a..aa58e26843 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -8888,9 +8888,6 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt, /* Whether each event in the mocked input came from a mouse menu. */ bool used_mouse_menu_history[READ_KEY_ELTS] = {0}; - /* Distinguish first time through from replay with mock_input == 0. */ - bool is_replay = false; - /* If the sequence is unbound in submaps[], then keybuf[fkey.start..fkey.end-1] is a prefix in Vfunction_key_map, and fkey.map is its binding. @@ -8999,9 +8996,8 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt, /* These are no-ops the first time through, but if we restart, they revert the echo area and this_command_keys to their original state. */ this_command_key_count = keys_start; - if (INTERACTIVE && is_replay) + if (INTERACTIVE && t < mock_input) echo_truncate (echo_start); - is_replay = true; /* If the best binding for the current key sequence is a keymap, or we may be looking at a function key's escape sequence, keep on commit 938d252d1c6c5e2027aa250c649deb024154f936 Author: Daniel Colascione <dancol@dancol.org> Date: Sat Jun 16 13:46:10 2018 -0700 Make regex matching reentrant; update syntax during match * src/lisp.h (compile_pattern): Remove prototype of now-internal function. * src/regex.c (POS_AS_IN_BUFFER): Consult gl_state instead of re_match_object: the latter can change in Lisp. (re_match_2_internal): Switch back to UPDATE_SYNTAX_* FROM UPDATE_SYNTAX_FAST*, allowing calls into Lisp. * src/regex.h (re_match_object): Uncomment declaration. * src/search.c (struct regexp_cache): Add `busy' field. (thaw_buffer_relocation): Delete; rely on unbind. (compile_pattern_1): Assert pattern isn't busy. (shrink_regexp_cache): Don't shrink busy patterns. (clear_regexp_cache): Don't nuke busy patterns. (unfreeze_pattern, freeze_pattern): New functions. (compile_pattern): Return a regexp_cache pointer instead of the re_pattern_buffer, allowing callers to use `freeze_pattern' if needed. Do not consider busy patterns as cache hit candidates; error if we run out of non-busy cache entries. (looking_at_1, fast_looking_at): Snapshot Vinhibit_changing_match_data; mark pattern busy while we're matching it; unbind. (string_match_1, fast_string_match_internal) (fast_c_string_match_ignore_case): Adjust for compile_pattern return type. (search_buffer_re): Regex code from old search_buffer moved here; snapshot Vinhibit_changing_match_data; mark pattern busy while we're matching it; unbind. (search_buffer_non_re): Non-regex code from old search_buffer moved here. (search_buffer): Split into search_buffer_re, search_buffer_non_re. (syms_of_search): Staticpro re_match_object, even though we really shouldn't have to. * src/syntax.h (UPDATE_SYNTAX_TABLE_FORWARD_FAST): (UPDATE_SYNTAX_TABLE_FAST): Remove. * src/thread.h (struct thread_state): Remove m_re_match_object, which is global again. (It never needs to be preserved across thread switch.) diff --git a/src/lisp.h b/src/lisp.h index ff708ebf60..d0c52d8567 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4029,10 +4029,6 @@ extern void restore_search_regs (void); extern void update_search_regs (ptrdiff_t oldstart, ptrdiff_t oldend, ptrdiff_t newend); extern void record_unwind_save_match_data (void); -struct re_registers; -extern struct re_pattern_buffer *compile_pattern (Lisp_Object, - struct re_registers *, - Lisp_Object, bool, bool); extern ptrdiff_t fast_string_match_internal (Lisp_Object, Lisp_Object, Lisp_Object); diff --git a/src/regex.c b/src/regex.c index 85e63feea1..b8c6f3f19b 100644 --- a/src/regex.c +++ b/src/regex.c @@ -155,7 +155,8 @@ # define PTR_TO_OFFSET(d) POS_AS_IN_BUFFER (POINTER_TO_OFFSET (d)) /* Strings are 0-indexed, buffers are 1-indexed; we pun on the boolean result to get the right base index. */ -# define POS_AS_IN_BUFFER(p) ((p) + (NILP (re_match_object) || BUFFERP (re_match_object))) +# define POS_AS_IN_BUFFER(p) \ + ((p) + (NILP (gl_state.object) || BUFFERP (gl_state.object))) # define RE_MULTIBYTE_P(bufp) ((bufp)->multibyte) # define RE_TARGET_MULTIBYTE_P(bufp) ((bufp)->target_multibyte) @@ -1233,6 +1234,15 @@ static const char *re_error_msgid[] = # undef MATCH_MAY_ALLOCATE #endif +/* While regex matching of a single compiled pattern isn't reentrant + (because we compile regexes to bytecode programs, and the bytecode + programs are self-modifying), the regex machinery must nevertheless + be reentrant with respect to _different_ patterns, and we do that + by avoiding global variables and using MATCH_MAY_ALLOCATE. */ +#if !defined MATCH_MAY_ALLOCATE && defined emacs +# error "Emacs requires MATCH_MAY_ALLOCATE" +#endif + /* Failure stack declarations and macros; both re_compile_fastmap and re_match_2 use a failure stack. These have to be macros because of @@ -5895,12 +5905,12 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, #ifdef emacs ssize_t offset = PTR_TO_OFFSET (d - 1); ssize_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset); - UPDATE_SYNTAX_TABLE_FAST (charpos); + UPDATE_SYNTAX_TABLE (charpos); #endif GET_CHAR_BEFORE_2 (c1, d, string1, end1, string2, end2); s1 = SYNTAX (c1); #ifdef emacs - UPDATE_SYNTAX_TABLE_FORWARD_FAST (charpos + 1); + UPDATE_SYNTAX_TABLE_FORWARD (charpos + 1); #endif PREFETCH_NOLIMIT (); GET_CHAR_AFTER (c2, d, dummy); @@ -5937,7 +5947,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, #ifdef emacs ssize_t offset = PTR_TO_OFFSET (d); ssize_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset); - UPDATE_SYNTAX_TABLE_FAST (charpos); + UPDATE_SYNTAX_TABLE (charpos); #endif PREFETCH (); GET_CHAR_AFTER (c2, d, dummy); @@ -5982,7 +5992,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, #ifdef emacs ssize_t offset = PTR_TO_OFFSET (d) - 1; ssize_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset); - UPDATE_SYNTAX_TABLE_FAST (charpos); + UPDATE_SYNTAX_TABLE (charpos); #endif GET_CHAR_BEFORE_2 (c1, d, string1, end1, string2, end2); s1 = SYNTAX (c1); @@ -5997,7 +6007,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, PREFETCH_NOLIMIT (); GET_CHAR_AFTER (c2, d, dummy); #ifdef emacs - UPDATE_SYNTAX_TABLE_FORWARD_FAST (charpos); + UPDATE_SYNTAX_TABLE_FORWARD (charpos); #endif s2 = SYNTAX (c2); @@ -6026,7 +6036,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, #ifdef emacs ssize_t offset = PTR_TO_OFFSET (d); ssize_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset); - UPDATE_SYNTAX_TABLE_FAST (charpos); + UPDATE_SYNTAX_TABLE (charpos); #endif PREFETCH (); c2 = RE_STRING_CHAR (d, target_multibyte); @@ -6069,7 +6079,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, #ifdef emacs ssize_t offset = PTR_TO_OFFSET (d) - 1; ssize_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset); - UPDATE_SYNTAX_TABLE_FAST (charpos); + UPDATE_SYNTAX_TABLE (charpos); #endif GET_CHAR_BEFORE_2 (c1, d, string1, end1, string2, end2); s1 = SYNTAX (c1); @@ -6084,7 +6094,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, PREFETCH_NOLIMIT (); c2 = RE_STRING_CHAR (d, target_multibyte); #ifdef emacs - UPDATE_SYNTAX_TABLE_FORWARD_FAST (charpos + 1); + UPDATE_SYNTAX_TABLE_FORWARD (charpos + 1); #endif s2 = SYNTAX (c2); @@ -6107,7 +6117,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, { ssize_t offset = PTR_TO_OFFSET (d); ssize_t pos1 = SYNTAX_TABLE_BYTE_TO_CHAR (offset); - UPDATE_SYNTAX_TABLE_FAST (pos1); + UPDATE_SYNTAX_TABLE (pos1); } #endif { diff --git a/src/regex.h b/src/regex.h index 082f7e010d..3a2d74d86a 100644 --- a/src/regex.h +++ b/src/regex.h @@ -181,8 +181,15 @@ typedef unsigned long reg_syntax_t; string; if it's nil, we are matching text in the current buffer; if it's t, we are matching text in a C string. - This is defined as a macro in thread.h, which see. */ -/* extern Lisp_Object re_match_object; */ + This value is effectively another parameter to re_search_2 and + re_match_2. No calls into Lisp or thread switches are allowed + before setting re_match_object and calling into the regex search + and match functions. These functions capture the current value of + re_match_object into gl_state on entry. + + TODO: once we get rid of the !emacs case in this code, turn into an + actual function parameter. */ +extern Lisp_Object re_match_object; #endif /* Roughly the maximum number of failure points on the stack. */ diff --git a/src/search.c b/src/search.c index a21c01ca4b..ccdb659776 100644 --- a/src/search.c +++ b/src/search.c @@ -48,6 +48,8 @@ struct regexp_cache char fastmap[0400]; /* True means regexp was compiled to do full POSIX backtracking. */ bool posix; + /* True means we're inside a buffer match. */ + bool busy; }; /* The instances of that struct. */ @@ -93,6 +95,8 @@ static EMACS_INT search_buffer (Lisp_Object, ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, EMACS_INT, int, Lisp_Object, Lisp_Object, bool); +Lisp_Object re_match_object; + static _Noreturn void matcher_overflow (void) { @@ -110,14 +114,6 @@ freeze_buffer_relocation (void) #endif } -static void -thaw_buffer_relocation (void) -{ -#ifdef REL_ALLOC - unbind_to (SPECPDL_INDEX () - 1, Qnil); -#endif -} - /* Compile a regexp and signal a Lisp error if anything goes wrong. PATTERN is the pattern to compile. CP is the place to put the result. @@ -134,6 +130,7 @@ compile_pattern_1 (struct regexp_cache *cp, Lisp_Object pattern, const char *whitespace_regexp; char *val; + eassert (!cp->busy); cp->regexp = Qnil; cp->buf.translate = (! NILP (translate) ? translate : make_number (0)); cp->posix = posix; @@ -170,10 +167,11 @@ shrink_regexp_cache (void) struct regexp_cache *cp; for (cp = searchbuf_head; cp != 0; cp = cp->next) - { - cp->buf.allocated = cp->buf.used; - cp->buf.buffer = xrealloc (cp->buf.buffer, cp->buf.used); - } + if (!cp->busy) + { + cp->buf.allocated = cp->buf.used; + cp->buf.buffer = xrealloc (cp->buf.buffer, cp->buf.used); + } } /* Clear the regexp cache w.r.t. a particular syntax table, @@ -190,10 +188,25 @@ clear_regexp_cache (void) /* It's tempting to compare with the syntax-table we've actually changed, but it's not sufficient because char-table inheritance means that modifying one syntax-table can change others at the same time. */ - if (!EQ (searchbufs[i].syntax_table, Qt)) + if (!searchbufs[i].busy && !EQ (searchbufs[i].syntax_table, Qt)) searchbufs[i].regexp = Qnil; } +static void +unfreeze_pattern (void *arg) +{ + struct regexp_cache *searchbuf = arg; + searchbuf->busy = false; +} + +static void +freeze_pattern (struct regexp_cache *searchbuf) +{ + eassert (!searchbuf->busy); + record_unwind_protect_ptr (unfreeze_pattern, searchbuf); + searchbuf->busy = true; +} + /* Compile a regexp if necessary, but first check to see if there's one in the cache. PATTERN is the pattern to compile. @@ -205,7 +218,7 @@ clear_regexp_cache (void) POSIX is true if we want full backtracking (POSIX style) for this pattern. False means backtrack only enough to get a valid match. */ -struct re_pattern_buffer * +static struct regexp_cache * compile_pattern (Lisp_Object pattern, struct re_registers *regp, Lisp_Object translate, bool posix, bool multibyte) { @@ -222,6 +235,7 @@ compile_pattern (Lisp_Object pattern, struct re_registers *regp, if (NILP (cp->regexp)) goto compile_it; if (SCHARS (cp->regexp) == SCHARS (pattern) + && !cp->busy && STRING_MULTIBYTE (cp->regexp) == STRING_MULTIBYTE (pattern) && !NILP (Fstring_equal (cp->regexp, pattern)) && EQ (cp->buf.translate, (! NILP (translate) ? translate : make_number (0))) @@ -237,7 +251,10 @@ compile_pattern (Lisp_Object pattern, struct re_registers *regp, string value. */ if (cp->next == 0) { + if (cp->busy) + error ("Too much matching reentrancy"); compile_it: + eassert (!cp->busy); compile_pattern_1 (cp, pattern, translate, posix); break; } @@ -258,8 +275,7 @@ compile_pattern (Lisp_Object pattern, struct re_registers *regp, /* The compiled pattern can be used both for multibyte and unibyte target. But, we have to tell which the pattern is used for. */ cp->buf.target_multibyte = multibyte; - - return &cp->buf; + return cp; } @@ -270,7 +286,6 @@ looking_at_1 (Lisp_Object string, bool posix) unsigned char *p1, *p2; ptrdiff_t s1, s2; register ptrdiff_t i; - struct re_pattern_buffer *bufp; if (running_asynch_code) save_search_regs (); @@ -280,13 +295,17 @@ looking_at_1 (Lisp_Object string, bool posix) BVAR (current_buffer, case_eqv_table)); CHECK_STRING (string); - bufp = compile_pattern (string, - (NILP (Vinhibit_changing_match_data) - ? &search_regs : NULL), - (!NILP (BVAR (current_buffer, case_fold_search)) - ? BVAR (current_buffer, case_canon_table) : Qnil), - posix, - !NILP (BVAR (current_buffer, enable_multibyte_characters))); + + /* Snapshot in case Lisp changes the value. */ + bool preserve_match_data = NILP (Vinhibit_changing_match_data); + + struct regexp_cache *cache_entry = compile_pattern ( + string, + preserve_match_data ? &search_regs : NULL, + (!NILP (BVAR (current_buffer, case_fold_search)) + ? BVAR (current_buffer, case_canon_table) : Qnil), + posix, + !NILP (BVAR (current_buffer, enable_multibyte_characters))); /* Do a pending quit right away, to avoid paradoxical behavior */ maybe_quit (); @@ -310,21 +329,20 @@ looking_at_1 (Lisp_Object string, bool posix) s2 = 0; } - re_match_object = Qnil; - + ptrdiff_t count = SPECPDL_INDEX (); freeze_buffer_relocation (); - i = re_match_2 (bufp, (char *) p1, s1, (char *) p2, s2, + freeze_pattern (cache_entry); + re_match_object = Qnil; + i = re_match_2 (&cache_entry->buf, (char *) p1, s1, (char *) p2, s2, PT_BYTE - BEGV_BYTE, - (NILP (Vinhibit_changing_match_data) - ? &search_regs : NULL), + preserve_match_data ? &search_regs : NULL, ZV_BYTE - BEGV_BYTE); - thaw_buffer_relocation (); if (i == -2) matcher_overflow (); val = (i >= 0 ? Qt : Qnil); - if (NILP (Vinhibit_changing_match_data) && i >= 0) + if (preserve_match_data && i >= 0) { for (i = 0; i < search_regs.num_regs; i++) if (search_regs.start[i] >= 0) @@ -338,7 +356,7 @@ looking_at_1 (Lisp_Object string, bool posix) XSETBUFFER (last_thing_searched, current_buffer); } - return val; + return unbind_to (count, val); } DEFUN ("looking-at", Flooking_at, Slooking_at, 1, 1, 0, @@ -396,15 +414,14 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, set_char_table_extras (BVAR (current_buffer, case_canon_table), 2, BVAR (current_buffer, case_eqv_table)); - bufp = compile_pattern (regexp, - (NILP (Vinhibit_changing_match_data) - ? &search_regs : NULL), - (!NILP (BVAR (current_buffer, case_fold_search)) - ? BVAR (current_buffer, case_canon_table) : Qnil), - posix, - STRING_MULTIBYTE (string)); + bufp = &compile_pattern (regexp, + (NILP (Vinhibit_changing_match_data) + ? &search_regs : NULL), + (!NILP (BVAR (current_buffer, case_fold_search)) + ? BVAR (current_buffer, case_canon_table) : Qnil), + posix, + STRING_MULTIBYTE (string))->buf; re_match_object = string; - val = re_search (bufp, SSDATA (string), SBYTES (string), pos_byte, SBYTES (string) - pos_byte, @@ -471,10 +488,9 @@ fast_string_match_internal (Lisp_Object regexp, Lisp_Object string, ptrdiff_t val; struct re_pattern_buffer *bufp; - bufp = compile_pattern (regexp, 0, table, - 0, STRING_MULTIBYTE (string)); + bufp = &compile_pattern (regexp, 0, table, + 0, STRING_MULTIBYTE (string))->buf; re_match_object = string; - val = re_search (bufp, SSDATA (string), SBYTES (string), 0, SBYTES (string), 0); @@ -494,10 +510,10 @@ fast_c_string_match_ignore_case (Lisp_Object regexp, struct re_pattern_buffer *bufp; regexp = string_make_unibyte (regexp); + bufp = &compile_pattern (regexp, 0, + Vascii_canon_table, 0, + 0)->buf; re_match_object = Qt; - bufp = compile_pattern (regexp, 0, - Vascii_canon_table, 0, - 0); val = re_search (bufp, string, len, 0, len, 0); return val; } @@ -513,7 +529,6 @@ fast_looking_at (Lisp_Object regexp, ptrdiff_t pos, ptrdiff_t pos_byte, ptrdiff_t limit, ptrdiff_t limit_byte, Lisp_Object string) { bool multibyte; - struct re_pattern_buffer *buf; unsigned char *p1, *p2; ptrdiff_t s1, s2; ptrdiff_t len; @@ -528,7 +543,6 @@ fast_looking_at (Lisp_Object regexp, ptrdiff_t pos, ptrdiff_t pos_byte, s1 = 0; p2 = SDATA (string); s2 = SBYTES (string); - re_match_object = string; multibyte = STRING_MULTIBYTE (string); } else @@ -554,16 +568,19 @@ fast_looking_at (Lisp_Object regexp, ptrdiff_t pos, ptrdiff_t pos_byte, s1 = ZV_BYTE - BEGV_BYTE; s2 = 0; } - re_match_object = Qnil; multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); } - buf = compile_pattern (regexp, 0, Qnil, 0, multibyte); + struct regexp_cache *cache_entry = + compile_pattern (regexp, 0, Qnil, 0, multibyte); + ptrdiff_t count = SPECPDL_INDEX (); freeze_buffer_relocation (); - len = re_match_2 (buf, (char *) p1, s1, (char *) p2, s2, + freeze_pattern (cache_entry); + re_match_object = STRINGP (string) ? string : Qnil; + len = re_match_2 (&cache_entry->buf, (char *) p1, s1, (char *) p2, s2, pos_byte, NULL, limit_byte); - thaw_buffer_relocation (); + unbind_to (count, Qnil); return len; } @@ -1151,355 +1168,372 @@ while (0) static struct re_registers search_regs_1; static EMACS_INT -search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte, - ptrdiff_t lim, ptrdiff_t lim_byte, EMACS_INT n, - int RE, Lisp_Object trt, Lisp_Object inverse_trt, bool posix) +search_buffer_re (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte, + ptrdiff_t lim, ptrdiff_t lim_byte, EMACS_INT n, + Lisp_Object trt, Lisp_Object inverse_trt, bool posix) { - ptrdiff_t len = SCHARS (string); - ptrdiff_t len_byte = SBYTES (string); - register ptrdiff_t i; + unsigned char *p1, *p2; + ptrdiff_t s1, s2; - if (running_asynch_code) - save_search_regs (); + /* Snapshot in case Lisp changes the value. */ + bool preserve_match_data = NILP (Vinhibit_changing_match_data); - /* Searching 0 times means don't move. */ - /* Null string is found at starting position. */ - if (len == 0 || n == 0) + struct regexp_cache *cache_entry = + compile_pattern (string, + preserve_match_data ? &search_regs : &search_regs_1, + trt, posix, + !NILP (BVAR (current_buffer, enable_multibyte_characters))); + struct re_pattern_buffer *bufp = &cache_entry->buf; + + maybe_quit (); /* Do a pending quit right away, + to avoid paradoxical behavior */ + /* Get pointers and sizes of the two strings + that make up the visible portion of the buffer. */ + + p1 = BEGV_ADDR; + s1 = GPT_BYTE - BEGV_BYTE; + p2 = GAP_END_ADDR; + s2 = ZV_BYTE - GPT_BYTE; + if (s1 < 0) { - set_search_regs (pos_byte, 0); - return pos; + p2 = p1; + s2 = ZV_BYTE - BEGV_BYTE; + s1 = 0; } - - if (RE && !(trivial_regexp_p (string) && NILP (Vsearch_spaces_regexp))) + if (s2 < 0) { - unsigned char *p1, *p2; - ptrdiff_t s1, s2; - struct re_pattern_buffer *bufp; + s1 = ZV_BYTE - BEGV_BYTE; + s2 = 0; + } - bufp = compile_pattern (string, - (NILP (Vinhibit_changing_match_data) - ? &search_regs : &search_regs_1), - trt, posix, - !NILP (BVAR (current_buffer, enable_multibyte_characters))); + ptrdiff_t count = SPECPDL_INDEX (); + freeze_buffer_relocation (); + freeze_pattern (cache_entry); - maybe_quit (); /* Do a pending quit right away, - to avoid paradoxical behavior */ - /* Get pointers and sizes of the two strings - that make up the visible portion of the buffer. */ + while (n < 0) + { + ptrdiff_t val; - p1 = BEGV_ADDR; - s1 = GPT_BYTE - BEGV_BYTE; - p2 = GAP_END_ADDR; - s2 = ZV_BYTE - GPT_BYTE; - if (s1 < 0) - { - p2 = p1; - s2 = ZV_BYTE - BEGV_BYTE; - s1 = 0; - } - if (s2 < 0) - { - s1 = ZV_BYTE - BEGV_BYTE; - s2 = 0; - } re_match_object = Qnil; + val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2, + pos_byte - BEGV_BYTE, lim_byte - pos_byte, + preserve_match_data ? &search_regs : &search_regs_1, + /* Don't allow match past current point */ + pos_byte - BEGV_BYTE); + if (val == -2) + { + matcher_overflow (); + } + if (val >= 0) + { + if (preserve_match_data) + { + pos_byte = search_regs.start[0] + BEGV_BYTE; + for (ptrdiff_t i = 0; i < search_regs.num_regs; i++) + if (search_regs.start[i] >= 0) + { + search_regs.start[i] + = BYTE_TO_CHAR (search_regs.start[i] + BEGV_BYTE); + search_regs.end[i] + = BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE); + } + XSETBUFFER (last_thing_searched, current_buffer); + /* Set pos to the new position. */ + pos = search_regs.start[0]; + } + else + { + pos_byte = search_regs_1.start[0] + BEGV_BYTE; + /* Set pos to the new position. */ + pos = BYTE_TO_CHAR (search_regs_1.start[0] + BEGV_BYTE); + } + } + else + { + unbind_to (count, Qnil); + return (n); + } + n++; + maybe_quit (); + } + while (n > 0) + { + ptrdiff_t val; - freeze_buffer_relocation (); + re_match_object = Qnil; + val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2, + pos_byte - BEGV_BYTE, lim_byte - pos_byte, + preserve_match_data ? &search_regs : &search_regs_1, + lim_byte - BEGV_BYTE); + if (val == -2) + { + matcher_overflow (); + } + if (val >= 0) + { + if (preserve_match_data) + { + pos_byte = search_regs.end[0] + BEGV_BYTE; + for (ptrdiff_t i = 0; i < search_regs.num_regs; i++) + if (search_regs.start[i] >= 0) + { + search_regs.start[i] + = BYTE_TO_CHAR (search_regs.start[i] + BEGV_BYTE); + search_regs.end[i] + = BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE); + } + XSETBUFFER (last_thing_searched, current_buffer); + pos = search_regs.end[0]; + } + else + { + pos_byte = search_regs_1.end[0] + BEGV_BYTE; + pos = BYTE_TO_CHAR (search_regs_1.end[0] + BEGV_BYTE); + } + } + else + { + unbind_to (count, Qnil); + return (0 - n); + } + n--; + maybe_quit (); + } + unbind_to (count, Qnil); + return (pos); +} - while (n < 0) - { - ptrdiff_t val; - - val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2, - pos_byte - BEGV_BYTE, lim_byte - pos_byte, - (NILP (Vinhibit_changing_match_data) - ? &search_regs : &search_regs_1), - /* Don't allow match past current point */ - pos_byte - BEGV_BYTE); - if (val == -2) - { - matcher_overflow (); - } - if (val >= 0) - { - if (NILP (Vinhibit_changing_match_data)) - { - pos_byte = search_regs.start[0] + BEGV_BYTE; - for (i = 0; i < search_regs.num_regs; i++) - if (search_regs.start[i] >= 0) - { - search_regs.start[i] - = BYTE_TO_CHAR (search_regs.start[i] + BEGV_BYTE); - search_regs.end[i] - = BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE); - } - XSETBUFFER (last_thing_searched, current_buffer); - /* Set pos to the new position. */ - pos = search_regs.start[0]; - } - else - { - pos_byte = search_regs_1.start[0] + BEGV_BYTE; - /* Set pos to the new position. */ - pos = BYTE_TO_CHAR (search_regs_1.start[0] + BEGV_BYTE); - } - } - else - { - thaw_buffer_relocation (); - return (n); - } - n++; - maybe_quit (); - } - while (n > 0) - { - ptrdiff_t val; - - val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2, - pos_byte - BEGV_BYTE, lim_byte - pos_byte, - (NILP (Vinhibit_changing_match_data) - ? &search_regs : &search_regs_1), - lim_byte - BEGV_BYTE); - if (val == -2) - { - matcher_overflow (); - } - if (val >= 0) - { - if (NILP (Vinhibit_changing_match_data)) - { - pos_byte = search_regs.end[0] + BEGV_BYTE; - for (i = 0; i < search_regs.num_regs; i++) - if (search_regs.start[i] >= 0) - { - search_regs.start[i] - = BYTE_TO_CHAR (search_regs.start[i] + BEGV_BYTE); - search_regs.end[i] - = BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE); - } - XSETBUFFER (last_thing_searched, current_buffer); - pos = search_regs.end[0]; - } - else - { - pos_byte = search_regs_1.end[0] + BEGV_BYTE; - pos = BYTE_TO_CHAR (search_regs_1.end[0] + BEGV_BYTE); - } - } - else - { - thaw_buffer_relocation (); - return (0 - n); - } - n--; - maybe_quit (); - } - thaw_buffer_relocation (); - return (pos); +static EMACS_INT +search_buffer_non_re (Lisp_Object string, ptrdiff_t pos, + ptrdiff_t pos_byte, ptrdiff_t lim, ptrdiff_t lim_byte, + EMACS_INT n, int RE, Lisp_Object trt, Lisp_Object inverse_trt, + bool posix) +{ + unsigned char *raw_pattern, *pat; + ptrdiff_t raw_pattern_size; + ptrdiff_t raw_pattern_size_byte; + unsigned char *patbuf; + bool multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); + unsigned char *base_pat; + /* Set to positive if we find a non-ASCII char that need + translation. Otherwise set to zero later. */ + int char_base = -1; + bool boyer_moore_ok = 1; + USE_SAFE_ALLOCA; + + /* MULTIBYTE says whether the text to be searched is multibyte. + We must convert PATTERN to match that, or we will not really + find things right. */ + + if (multibyte == STRING_MULTIBYTE (string)) + { + raw_pattern = SDATA (string); + raw_pattern_size = SCHARS (string); + raw_pattern_size_byte = SBYTES (string); } - else /* non-RE case */ + else if (multibyte) { - unsigned char *raw_pattern, *pat; - ptrdiff_t raw_pattern_size; - ptrdiff_t raw_pattern_size_byte; - unsigned char *patbuf; - bool multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); - unsigned char *base_pat; - /* Set to positive if we find a non-ASCII char that need - translation. Otherwise set to zero later. */ - int char_base = -1; - bool boyer_moore_ok = 1; - USE_SAFE_ALLOCA; - - /* MULTIBYTE says whether the text to be searched is multibyte. - We must convert PATTERN to match that, or we will not really - find things right. */ - - if (multibyte == STRING_MULTIBYTE (string)) - { - raw_pattern = SDATA (string); - raw_pattern_size = SCHARS (string); - raw_pattern_size_byte = SBYTES (string); - } - else if (multibyte) - { - raw_pattern_size = SCHARS (string); - raw_pattern_size_byte - = count_size_as_multibyte (SDATA (string), - raw_pattern_size); - raw_pattern = SAFE_ALLOCA (raw_pattern_size_byte + 1); - copy_text (SDATA (string), raw_pattern, - SCHARS (string), 0, 1); - } - else - { - /* Converting multibyte to single-byte. - - ??? Perhaps this conversion should be done in a special way - by subtracting nonascii-insert-offset from each non-ASCII char, - so that only the multibyte chars which really correspond to - the chosen single-byte character set can possibly match. */ - raw_pattern_size = SCHARS (string); - raw_pattern_size_byte = SCHARS (string); - raw_pattern = SAFE_ALLOCA (raw_pattern_size + 1); - copy_text (SDATA (string), raw_pattern, - SBYTES (string), 1, 0); - } + raw_pattern_size = SCHARS (string); + raw_pattern_size_byte + = count_size_as_multibyte (SDATA (string), + raw_pattern_size); + raw_pattern = SAFE_ALLOCA (raw_pattern_size_byte + 1); + copy_text (SDATA (string), raw_pattern, + SCHARS (string), 0, 1); + } + else + { + /* Converting multibyte to single-byte. + + ??? Perhaps this conversion should be done in a special way + by subtracting nonascii-insert-offset from each non-ASCII char, + so that only the multibyte chars which really correspond to + the chosen single-byte character set can possibly match. */ + raw_pattern_size = SCHARS (string); + raw_pattern_size_byte = SCHARS (string); + raw_pattern = SAFE_ALLOCA (raw_pattern_size + 1); + copy_text (SDATA (string), raw_pattern, + SBYTES (string), 1, 0); + } - /* Copy and optionally translate the pattern. */ - len = raw_pattern_size; - len_byte = raw_pattern_size_byte; - SAFE_NALLOCA (patbuf, MAX_MULTIBYTE_LENGTH, len); - pat = patbuf; - base_pat = raw_pattern; - if (multibyte) - { - /* Fill patbuf by translated characters in STRING while - checking if we can use boyer-moore search. If TRT is - non-nil, we can use boyer-moore search only if TRT can be - represented by the byte array of 256 elements. For that, - all non-ASCII case-equivalents of all case-sensitive - characters in STRING must belong to the same character - group (two characters belong to the same group iff their - multibyte forms are the same except for the last byte; - i.e. every 64 characters form a group; U+0000..U+003F, - U+0040..U+007F, U+0080..U+00BF, ...). */ - - while (--len >= 0) - { - unsigned char str_base[MAX_MULTIBYTE_LENGTH], *str; - int c, translated, inverse; - int in_charlen, charlen; - - /* If we got here and the RE flag is set, it's because we're - dealing with a regexp known to be trivial, so the backslash - just quotes the next character. */ - if (RE && *base_pat == '\\') - { - len--; - raw_pattern_size--; - len_byte--; - base_pat++; - } + /* Copy and optionally translate the pattern. */ + ptrdiff_t len = raw_pattern_size; + ptrdiff_t len_byte = raw_pattern_size_byte; + SAFE_NALLOCA (patbuf, MAX_MULTIBYTE_LENGTH, len); + pat = patbuf; + base_pat = raw_pattern; + if (multibyte) + { + /* Fill patbuf by translated characters in STRING while + checking if we can use boyer-moore search. If TRT is + non-nil, we can use boyer-moore search only if TRT can be + represented by the byte array of 256 elements. For that, + all non-ASCII case-equivalents of all case-sensitive + characters in STRING must belong to the same character + group (two characters belong to the same group iff their + multibyte forms are the same except for the last byte; + i.e. every 64 characters form a group; U+0000..U+003F, + U+0040..U+007F, U+0080..U+00BF, ...). */ + + while (--len >= 0) + { + unsigned char str_base[MAX_MULTIBYTE_LENGTH], *str; + int c, translated, inverse; + int in_charlen, charlen; + + /* If we got here and the RE flag is set, it's because we're + dealing with a regexp known to be trivial, so the backslash + just quotes the next character. */ + if (RE && *base_pat == '\\') + { + len--; + raw_pattern_size--; + len_byte--; + base_pat++; + } - c = STRING_CHAR_AND_LENGTH (base_pat, in_charlen); + c = STRING_CHAR_AND_LENGTH (base_pat, in_charlen); - if (NILP (trt)) - { - str = base_pat; - charlen = in_charlen; - } - else - { - /* Translate the character. */ - TRANSLATE (translated, trt, c); - charlen = CHAR_STRING (translated, str_base); - str = str_base; - - /* Check if C has any other case-equivalents. */ - TRANSLATE (inverse, inverse_trt, c); - /* If so, check if we can use boyer-moore. */ - if (c != inverse && boyer_moore_ok) - { - /* Check if all equivalents belong to the same - group of characters. Note that the check of C - itself is done by the last iteration. */ - int this_char_base = -1; + if (NILP (trt)) + { + str = base_pat; + charlen = in_charlen; + } + else + { + /* Translate the character. */ + TRANSLATE (translated, trt, c); + charlen = CHAR_STRING (translated, str_base); + str = str_base; + + /* Check if C has any other case-equivalents. */ + TRANSLATE (inverse, inverse_trt, c); + /* If so, check if we can use boyer-moore. */ + if (c != inverse && boyer_moore_ok) + { + /* Check if all equivalents belong to the same + group of characters. Note that the check of C + itself is done by the last iteration. */ + int this_char_base = -1; + + while (boyer_moore_ok) + { + if (ASCII_CHAR_P (inverse)) + { + if (this_char_base > 0) + boyer_moore_ok = 0; + else + this_char_base = 0; + } + else if (CHAR_BYTE8_P (inverse)) + /* Boyer-moore search can't handle a + translation of an eight-bit + character. */ + boyer_moore_ok = 0; + else if (this_char_base < 0) + { + this_char_base = inverse & ~0x3F; + if (char_base < 0) + char_base = this_char_base; + else if (this_char_base != char_base) + boyer_moore_ok = 0; + } + else if ((inverse & ~0x3F) != this_char_base) + boyer_moore_ok = 0; + if (c == inverse) + break; + TRANSLATE (inverse, inverse_trt, inverse); + } + } + } - while (boyer_moore_ok) - { - if (ASCII_CHAR_P (inverse)) - { - if (this_char_base > 0) - boyer_moore_ok = 0; - else - this_char_base = 0; - } - else if (CHAR_BYTE8_P (inverse)) - /* Boyer-moore search can't handle a - translation of an eight-bit - character. */ - boyer_moore_ok = 0; - else if (this_char_base < 0) - { - this_char_base = inverse & ~0x3F; - if (char_base < 0) - char_base = this_char_base; - else if (this_char_base != char_base) - boyer_moore_ok = 0; - } - else if ((inverse & ~0x3F) != this_char_base) - boyer_moore_ok = 0; - if (c == inverse) - break; - TRANSLATE (inverse, inverse_trt, inverse); - } - } - } + /* Store this character into the translated pattern. */ + memcpy (pat, str, charlen); + pat += charlen; + base_pat += in_charlen; + len_byte -= in_charlen; + } - /* Store this character into the translated pattern. */ - memcpy (pat, str, charlen); - pat += charlen; - base_pat += in_charlen; - len_byte -= in_charlen; - } + /* If char_base is still negative we didn't find any translated + non-ASCII characters. */ + if (char_base < 0) + char_base = 0; + } + else + { + /* Unibyte buffer. */ + char_base = 0; + while (--len >= 0) + { + int c, translated, inverse; - /* If char_base is still negative we didn't find any translated - non-ASCII characters. */ - if (char_base < 0) - char_base = 0; - } - else - { - /* Unibyte buffer. */ - char_base = 0; - while (--len >= 0) - { - int c, translated, inverse; + /* If we got here and the RE flag is set, it's because we're + dealing with a regexp known to be trivial, so the backslash + just quotes the next character. */ + if (RE && *base_pat == '\\') + { + len--; + raw_pattern_size--; + base_pat++; + } + c = *base_pat++; + TRANSLATE (translated, trt, c); + *pat++ = translated; + /* Check that none of C's equivalents violates the + assumptions of boyer_moore. */ + TRANSLATE (inverse, inverse_trt, c); + while (1) + { + if (inverse >= 0200) + { + boyer_moore_ok = 0; + break; + } + if (c == inverse) + break; + TRANSLATE (inverse, inverse_trt, inverse); + } + } + } - /* If we got here and the RE flag is set, it's because we're - dealing with a regexp known to be trivial, so the backslash - just quotes the next character. */ - if (RE && *base_pat == '\\') - { - len--; - raw_pattern_size--; - base_pat++; - } - c = *base_pat++; - TRANSLATE (translated, trt, c); - *pat++ = translated; - /* Check that none of C's equivalents violates the - assumptions of boyer_moore. */ - TRANSLATE (inverse, inverse_trt, c); - while (1) - { - if (inverse >= 0200) - { - boyer_moore_ok = 0; - break; - } - if (c == inverse) - break; - TRANSLATE (inverse, inverse_trt, inverse); - } - } - } + len_byte = pat - patbuf; + pat = base_pat = patbuf; + + EMACS_INT result + = (boyer_moore_ok + ? boyer_moore (n, pat, len_byte, trt, inverse_trt, + pos_byte, lim_byte, + char_base) + : simple_search (n, pat, raw_pattern_size, len_byte, trt, + pos, pos_byte, lim, lim_byte)); + SAFE_FREE (); + return result; +} + +static EMACS_INT +search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte, + ptrdiff_t lim, ptrdiff_t lim_byte, EMACS_INT n, + int RE, Lisp_Object trt, Lisp_Object inverse_trt, bool posix) +{ + if (running_asynch_code) + save_search_regs (); - len_byte = pat - patbuf; - pat = base_pat = patbuf; - - EMACS_INT result - = (boyer_moore_ok - ? boyer_moore (n, pat, len_byte, trt, inverse_trt, - pos_byte, lim_byte, - char_base) - : simple_search (n, pat, raw_pattern_size, len_byte, trt, - pos, pos_byte, lim, lim_byte)); - SAFE_FREE (); - return result; + /* Searching 0 times means don't move. */ + /* Null string is found at starting position. */ + if (n == 0 || SCHARS (string) == 0) + { + set_search_regs (pos_byte, 0); + return pos; } + + if (RE && !(trivial_regexp_p (string) && NILP (Vsearch_spaces_regexp))) + pos = search_buffer_re (string, pos, pos_byte, lim, lim_byte, + n, trt, inverse_trt, posix); + else + pos = search_buffer_non_re (string, pos, pos_byte, lim, lim_byte, + n, RE, trt, inverse_trt, posix); + + return pos; } /* Do a simple string search N times for the string PAT, @@ -3353,6 +3387,7 @@ the buffer. If the buffer doesn't have a cache, the value is nil. */) return val; } + void syms_of_search (void) { @@ -3365,6 +3400,7 @@ syms_of_search (void) searchbufs[i].buf.fastmap = searchbufs[i].fastmap; searchbufs[i].regexp = Qnil; searchbufs[i].f_whitespace_regexp = Qnil; + searchbufs[i].busy = false; searchbufs[i].syntax_table = Qnil; staticpro (&searchbufs[i].regexp); staticpro (&searchbufs[i].f_whitespace_regexp); @@ -3405,6 +3441,9 @@ syms_of_search (void) saved_last_thing_searched = Qnil; staticpro (&saved_last_thing_searched); + re_match_object = Qnil; + staticpro (&re_match_object); + DEFVAR_LISP ("search-spaces-regexp", Vsearch_spaces_regexp, doc: /* Regexp to substitute for bunches of spaces in regexp search. Some commands use this for user-specified regexps. diff --git a/src/syntax.h b/src/syntax.h index 2171cbbba4..f02a17ce8d 100644 --- a/src/syntax.h +++ b/src/syntax.h @@ -186,13 +186,6 @@ UPDATE_SYNTAX_TABLE_FORWARD (ptrdiff_t charpos) false, gl_state.object); } -INLINE void -UPDATE_SYNTAX_TABLE_FORWARD_FAST (ptrdiff_t charpos) -{ - if (parse_sexp_lookup_properties && charpos >= gl_state.e_property) - update_syntax_table (charpos + gl_state.offset, 1, false, gl_state.object); -} - /* Make syntax table state (gl_state) good for CHARPOS, assuming it is currently good for a position after CHARPOS. */ @@ -212,13 +205,6 @@ UPDATE_SYNTAX_TABLE (ptrdiff_t charpos) UPDATE_SYNTAX_TABLE_FORWARD (charpos); } -INLINE void -UPDATE_SYNTAX_TABLE_FAST (ptrdiff_t charpos) -{ - UPDATE_SYNTAX_TABLE_BACKWARD (charpos); - UPDATE_SYNTAX_TABLE_FORWARD_FAST (charpos); -} - /* Set up the buffer-global syntax table. */ INLINE void diff --git a/src/thread.h b/src/thread.h index 2c8914e1b2..c10e5ecb75 100644 --- a/src/thread.h +++ b/src/thread.h @@ -137,15 +137,6 @@ struct thread_state struct re_registers m_saved_search_regs; #define saved_search_regs (current_thread->m_saved_search_regs) - /* This is the string or buffer in which we - are matching. It is used for looking up syntax properties. - - If the value is a Lisp string object, we are matching text in that - string; if it's nil, we are matching text in the current buffer; if - it's t, we are matching text in a C string. */ - Lisp_Object m_re_match_object; -#define re_match_object (current_thread->m_re_match_object) - /* This member is different from waiting_for_input. It is used to communicate to a lisp process-filter/sentinel (via the function Fwaiting_for_user_input_p) whether Emacs was waiting commit 1502b377d35d6db623301829549ebcab9a2777e6 Author: Daniel Colascione <dancol@dancol.org> Date: Sat Jun 16 12:43:56 2018 -0700 Decouple dired from regex internals * src/dired.c: Remove use of regex.h (directory_files_internal): Use higher-level regular expression functions. diff --git a/src/dired.c b/src/dired.c index a753b1930e..5812c569fa 100644 --- a/src/dired.c +++ b/src/dired.c @@ -40,7 +40,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "systime.h" #include "buffer.h" #include "coding.h" -#include "regex.h" #ifdef MSDOS #include "msdos.h" /* for fstatat */ @@ -171,7 +170,6 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, { ptrdiff_t directory_nbytes; Lisp_Object list, dirfilename, encoded_directory; - struct re_pattern_buffer *bufp = NULL; bool needsep = 0; ptrdiff_t count = SPECPDL_INDEX (); #ifdef WINDOWSNT @@ -187,33 +185,12 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, list = encoded_directory = dirfilename = Qnil; dirfilename = Fdirectory_file_name (directory); - if (!NILP (match)) - { - CHECK_STRING (match); - - /* MATCH might be a flawed regular expression. Rather than - catching and signaling our own errors, we just call - compile_pattern to do the work for us. */ - /* Pass 1 for the MULTIBYTE arg - because we do make multibyte strings if the contents warrant. */ -# ifdef WINDOWSNT - /* Windows users want case-insensitive wildcards. */ - bufp = compile_pattern (match, 0, - BVAR (&buffer_defaults, case_canon_table), 0, 1); -# else /* !WINDOWSNT */ - bufp = compile_pattern (match, 0, Qnil, 0, 1); -# endif /* !WINDOWSNT */ - } - /* Note: ENCODE_FILE and DECODE_FILE can GC because they can run run_pre_post_conversion_on_str which calls Lisp directly and indirectly. */ dirfilename = ENCODE_FILE (dirfilename); encoded_directory = ENCODE_FILE (directory); - /* Now *bufp is the compiled form of MATCH; don't call anything - which might compile a new regexp until we're done with the loop! */ - int fd; DIR *d = open_directory (dirfilename, &fd); @@ -250,6 +227,15 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, || !IS_ANY_SEP (SREF (directory, directory_nbytes - 1))) needsep = 1; + /* Windows users want case-insensitive wildcards. */ + Lisp_Object case_table = +#ifdef WINDOWSNT + BVAR (&buffer_defaults, case_canon_table) +#else + Qnil +#endif + ; + /* Loop reading directory entries. */ for (struct dirent *dp; (dp = read_dirent (d, directory)); ) { @@ -266,8 +252,9 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, allow matching to be interrupted. */ maybe_quit (); - bool wanted = (NILP (match) - || re_search (bufp, SSDATA (name), len, 0, len, 0) >= 0); + bool wanted = (NILP (match) || + fast_string_match_internal ( + match, name, case_table) >= 0); if (wanted) { commit 971abd6753ed0b13019e52baab862e68453c7306 Author: Daniel Colascione <dancol@dancol.org> Date: Fri Jun 15 23:53:36 2018 -0700 Remove commented-out code in compile_pattern_1 * src/search.c (compile_pattern_1): Remove commented-out code. diff --git a/src/search.c b/src/search.c index 6d010466dc..a21c01ca4b 100644 --- a/src/search.c +++ b/src/search.c @@ -144,12 +144,6 @@ compile_pattern_1 (struct regexp_cache *cp, Lisp_Object pattern, else cp->f_whitespace_regexp = Qnil; - /* rms: I think BLOCK_INPUT is not needed here any more, - because regex.c defines malloc to call xmalloc. - Using BLOCK_INPUT here means the debugger won't run if an error occurs. - So let's turn it off. */ - /* BLOCK_INPUT; */ - whitespace_regexp = STRINGP (Vsearch_spaces_regexp) ? SSDATA (Vsearch_spaces_regexp) : NULL; @@ -160,7 +154,6 @@ compile_pattern_1 (struct regexp_cache *cp, Lisp_Object pattern, syntax-table, it can only be reused with *this* syntax table. */ cp->syntax_table = cp->buf.used_syntax ? BVAR (current_buffer, syntax_table) : Qt; - /* unblock_input (); */ if (val) xsignal1 (Qinvalid_regexp, build_string (val)); commit 55bc3db67c6a691bf40036394cd8ed4ab0a31c08 Author: Daniel Colascione <dancol@dancol.org> Date: Fri Jun 15 23:48:26 2018 -0700 Tweak field ordering in re_pattern_buffer * src/regex.h (struct re_pattern_buffer): Reorder charset_unibyte field to keep bitfields together. diff --git a/src/regex.h b/src/regex.h index 6974951f57..082f7e010d 100644 --- a/src/regex.h +++ b/src/regex.h @@ -367,7 +367,10 @@ struct re_pattern_buffer /* Number of bytes actually used in `buffer'. */ size_t used; -#ifndef emacs +#ifdef emacs + /* Charset of unibyte characters at compiling time. */ + int charset_unibyte; +#else /* Syntax setting with which the pattern was compiled. */ reg_syntax_t syntax; #endif @@ -427,9 +430,6 @@ struct re_pattern_buffer /* If true, multi-byte form in the target of match should be recognized as a multibyte character. */ unsigned target_multibyte : 1; - - /* Charset of unibyte characters at compiling time. */ - int charset_unibyte; #endif /* [[[end pattern_buffer]]] */ commit adc80ddcfb37cdd9fa192053a1088d22585416e7 Author: Bozhidar Batsov <bozhidar@batsov.com> Date: Sat Jun 16 23:00:50 2018 +0300 Fix a docstring diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index bed88036ee..fad7bc1fb8 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -257,8 +257,7 @@ the statement: qux end -Only has effect when `ruby-use-smie' is t. -" +Only has effect when `ruby-use-smie' is t." :type `(choice (const :tag "None" nil) (const :tag "All" t) commit a7350d09eebfe256c3c84413637f6b7371fb2106 Author: Bozhidar Batsov <bozhidar@batsov.com> Date: Sat Jun 16 22:58:33 2018 +0300 Fix references to RuboCop in ruby-mode.el diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 1f5d8865a7..bed88036ee 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -2313,8 +2313,8 @@ See `font-lock-syntax-table'.") (process-send-eof ruby--flymake-proc)))) (defcustom ruby-flymake-use-rubocop-if-available t - "Non-nil to use the Rubocop Flymake backend. -Only takes effect if Rubocop is installed." + "Non-nil to use the RuboCop Flymake backend. +Only takes effect if RuboCop is installed." :version "26.1" :type 'boolean :group 'ruby @@ -2328,7 +2328,7 @@ Only takes effect if Rubocop is installed." :safe 'stringp) (defun ruby-flymake-rubocop (report-fn &rest _args) - "Rubocop backend for Flymake." + "RuboCop backend for Flymake." (unless (executable-find "rubocop") (error "Cannot find the rubocop executable")) @@ -2354,7 +2354,7 @@ Only takes effect if Rubocop is installed." (when (eq (process-exit-status proc) 127) ;; Not sure what to do in this case. Maybe ideally we'd ;; switch back to ruby-flymake-simple. - (flymake-log :warning "Rubocop returned status 127: %s" + (flymake-log :warning "RuboCop returned status 127: %s" (buffer-string))) (goto-char (point-min)) (cl-loop commit 9740768a757141a3f0bd95ed3970cbd24111e7bd Author: JoĂŁo Távora <joaotavora@gmail.com> Date: Sat Jun 16 18:08:09 2018 +0100 Fix bug in elisp-flymake-byte-compile * lisp/progmodes/elisp-mode.el (elisp-flymake-byte-compile): Pass keyword args to make-process. diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 935e55c5d7..d74c523c8c 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -1716,9 +1716,9 @@ current buffer state and calls REPORT-FN when done." :explanation (format "byte-compile process %s died" proc)))) (ignore-errors (delete-file temp-file)) - (kill-buffer output-buffer)))))) - :stderr null-device - :noquery t))) + (kill-buffer output-buffer)))) + :stderr null-device + :noquery t))))) (defun elisp-flymake--batch-compile-for-flymake (&optional file) "Helper for `elisp-flymake-byte-compile'. commit e1284341fdc9a5d9b25339c3d47b02bc35cd8db4 Author: Paul Eggert <eggert@Penguin.CS.UCLA.EDU> Date: Sat Jun 16 07:44:58 2018 -0700 Fix byte compilation of (eq foo 'default) Backport from master. Do not use the symbol â€default’ as a special marker. Instead, use a value that cannot appear in the program, improving on a patch proposed by Robert Cochran (Bug#31718#14). * lisp/emacs-lisp/bytecomp.el (byte-compile--default-val): New constant. (byte-compile-cond-jump-table-info) (byte-compile-cond-jump-table): Use it instead of 'default. * test/lisp/emacs-lisp/bytecomp-tests.el: (byte-opt-testsuite-arith-data): Add a test for the bug. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index d1119e1090..68e2fd1d10 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -4094,6 +4094,8 @@ that suppresses all warnings during execution of BODY." (and (symbolp obj1) (macroexp-const-p obj2) (cons obj1 obj2)) (and (symbolp obj2) (macroexp-const-p obj1) (cons obj2 obj1)))) +(defconst byte-compile--default-val (cons nil nil) "A unique object.") + (defun byte-compile-cond-jump-table-info (clauses) "If CLAUSES is a `cond' form where: The condition for each clause is of the form (TEST VAR VALUE). @@ -4126,7 +4128,9 @@ Return a list of the form ((TEST . VAR) ((VALUE BODY) ...))" (not (assq obj2 cases))) (push (list (if (consp obj2) (eval obj2) obj2) body) cases) (if (and (macroexp-const-p condition) condition) - (progn (push (list 'default (or body `(,condition))) cases) + (progn (push (list byte-compile--default-val + (or body `(,condition))) + cases) (throw 'break t)) (setq ok nil) (throw 'break nil)))))) @@ -4141,11 +4145,12 @@ Return a list of the form ((TEST . VAR) ((VALUE BODY) ...))" (when (and cases (not (= (length cases) 1))) ;; TODO: Once :linear-search is implemented for `make-hash-table' ;; set it to `t' for cond forms with a small number of cases. - (setq jump-table (make-hash-table :test test - :purecopy t - :size (if (assq 'default cases) - (1- (length cases)) - (length cases))) + (setq jump-table (make-hash-table + :test test + :purecopy t + :size (if (assq byte-compile--default-val cases) + (1- (length cases)) + (length cases))) default-tag (byte-compile-make-tag) donetag (byte-compile-make-tag)) ;; The structure of byte-switch code: @@ -4177,9 +4182,10 @@ Return a list of the form ((TEST . VAR) ((VALUE BODY) ...))" (let ((byte-compile-depth byte-compile-depth)) (byte-compile-goto 'byte-goto default-tag)) - (when (assq 'default cases) - (setq default-case (cadr (assq 'default cases)) - cases (butlast cases 1))) + (let ((default-match (assq byte-compile--default-val cases))) + (when default-match + (setq default-case (cadr default-match) + cases (butlast cases)))) (dolist (case cases) (setq tag (byte-compile-make-tag) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 13df5912ee..f93c3bdc40 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -286,7 +286,14 @@ (t))) (let ((a)) (cond ((eq a 'foo) 'incorrect) - ('correct)))) + ('correct))) + ;; Bug#31734 + (let ((variable 0)) + (cond + ((eq variable 'default) + (message "equal")) + (t + (message "not equal"))))) "List of expression for test. Each element will be executed by interpreter and with bytecompiled code, and their results compared.") commit ec1b4d9a51db61b77c3953f3de4339f34e512c42 Author: Paul Eggert <eggert@cs.ucla.edu> Date: Sat Jun 16 08:11:37 2018 -0700 Rewrite memory-limit in Lisp Have it return Emacs virtual memory size, not the sbrk value which is often useless newadays. * doc/lispref/internals.texi (Garbage Collection): * etc/NEWS: Document this. * lisp/subr.el (memory-limit): New implementation in Lisp, written in terms of process-attributes, and which returns virtual memory size. * src/alloc.c (Fmemory_limit): Remove C implementation. diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 9cf1a4f9a3..faaf26f4f7 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -507,10 +507,8 @@ function @code{memory-limit} provides information on the total amount of memory Emacs is currently using. @defun memory-limit -This function returns the address of the last byte Emacs has allocated, -divided by 1024. We divide the value by 1024 to make sure it fits in a -Lisp integer. - +This function returns an estimate of the total amount of bytes of +virtual memory that Emacs is currently using, divided by 1024. You can use this to get a general idea of how your actions affect the memory usage. @end defun diff --git a/etc/NEWS b/etc/NEWS index cecd3f81f8..d59b4a7cf4 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -664,6 +664,9 @@ socket has been passed to Emacs (Bug#24218). instead of just Microsoft platforms. This fixes a 'get-free-disk-space' bug on OS X 10.8 and later (Bug#28639). ++++ +** 'memory-limit' now returns a better estimate of memory consumption. + +++ ** New macro 'combine-change-calls' arranges to call the change hooks ('before-change-functions' and 'after-change-functions') just once diff --git a/lisp/subr.el b/lisp/subr.el index 4a2b797fa0..8123e60f62 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2182,6 +2182,10 @@ It can be retrieved with `(process-get PROCESS PROPNAME)'." (set-process-plist process (plist-put (process-plist process) propname value))) +(defun memory-limit () + "Return an estimate of Emacs virtual memory usage, divided by 1024." + (or (cdr (assq 'vsize (process-attributes (emacs-pid)))) 0)) + ;;;; Input and display facilities. diff --git a/src/alloc.c b/src/alloc.c index 286358662b..cc846fd38e 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -7120,24 +7120,6 @@ or memory information can't be obtained, return nil. */) /* Debugging aids. */ -DEFUN ("memory-limit", Fmemory_limit, Smemory_limit, 0, 0, 0, - doc: /* Return the address of the last byte Emacs has allocated, divided by 1024. -This may be helpful in debugging Emacs's memory usage. -We divide the value by 1024 to make sure it fits in a Lisp integer. */) - (void) -{ - Lisp_Object end; - -#if defined HAVE_NS || defined __APPLE__ || !HAVE_SBRK - /* Avoid warning. sbrk has no relation to memory allocated anyway. */ - XSETINT (end, 0); -#else - XSETINT (end, (intptr_t) (char *) sbrk (0) / 1024); -#endif - - return end; -} - DEFUN ("memory-use-counts", Fmemory_use_counts, Smemory_use_counts, 0, 0, 0, doc: /* Return a list of counters that measure how much consing there has been. Each of these counters increments for a certain kind of object. @@ -7495,7 +7477,6 @@ The time is in seconds as a floating point value. */); defsubr (&Smake_finalizer); defsubr (&Spurecopy); defsubr (&Sgarbage_collect); - defsubr (&Smemory_limit); defsubr (&Smemory_info); defsubr (&Smemory_use_counts); defsubr (&Ssuspicious_object); commit 9af399fd803ac1ca79f319945b9745b5b96122e7 Author: Paul Eggert <eggert@Penguin.CS.UCLA.EDU> Date: Sat Jun 16 07:44:58 2018 -0700 Fix byte compilation of (eq foo 'default) Do not use the symbol â€default’ as a special marker. Instead, use a value that cannot appear in the program, improving on a patch proposed by Robert Cochran (Bug#31718#14). * lisp/emacs-lisp/bytecomp.el (byte-compile--default-val): New constant. (byte-compile-cond-jump-table-info) (byte-compile-cond-jump-table): Use it instead of 'default. * test/lisp/emacs-lisp/bytecomp-tests.el: (byte-opt-testsuite-arith-data): Add a test for the bug. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index ad6b5b7ce2..ee28e61800 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -4092,6 +4092,8 @@ that suppresses all warnings during execution of BODY." (and (symbolp obj1) (macroexp-const-p obj2) (cons obj1 obj2)) (and (symbolp obj2) (macroexp-const-p obj1) (cons obj2 obj1)))) +(defconst byte-compile--default-val (cons nil nil) "A unique object.") + (defun byte-compile-cond-jump-table-info (clauses) "If CLAUSES is a `cond' form where: The condition for each clause is of the form (TEST VAR VALUE). @@ -4124,7 +4126,9 @@ Return a list of the form ((TEST . VAR) ((VALUE BODY) ...))" (not (assq obj2 cases))) (push (list (if (consp obj2) (eval obj2) obj2) body) cases) (if (and (macroexp-const-p condition) condition) - (progn (push (list 'default (or body `(,condition))) cases) + (progn (push (list byte-compile--default-val + (or body `(,condition))) + cases) (throw 'break t)) (setq ok nil) (throw 'break nil)))))) @@ -4139,11 +4143,12 @@ Return a list of the form ((TEST . VAR) ((VALUE BODY) ...))" (when (and cases (not (= (length cases) 1))) ;; TODO: Once :linear-search is implemented for `make-hash-table' ;; set it to `t' for cond forms with a small number of cases. - (setq jump-table (make-hash-table :test test - :purecopy t - :size (if (assq 'default cases) - (1- (length cases)) - (length cases))) + (setq jump-table (make-hash-table + :test test + :purecopy t + :size (if (assq byte-compile--default-val cases) + (1- (length cases)) + (length cases))) default-tag (byte-compile-make-tag) donetag (byte-compile-make-tag)) ;; The structure of byte-switch code: @@ -4175,9 +4180,10 @@ Return a list of the form ((TEST . VAR) ((VALUE BODY) ...))" (let ((byte-compile-depth byte-compile-depth)) (byte-compile-goto 'byte-goto default-tag)) - (when (assq 'default cases) - (setq default-case (cadr (assq 'default cases)) - cases (butlast cases 1))) + (let ((default-match (assq byte-compile--default-val cases))) + (when default-match + (setq default-case (cadr default-match) + cases (butlast cases)))) (dolist (case cases) (setq tag (byte-compile-make-tag) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 7c5aa9abed..ba62549096 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -289,7 +289,14 @@ (t))) (let ((a)) (cond ((eq a 'foo) 'incorrect) - ('correct)))) + ('correct))) + ;; Bug#31734 + (let ((variable 0)) + (cond + ((eq variable 'default) + (message "equal")) + (t + (message "not equal"))))) "List of expression for test. Each element will be executed by interpreter and with bytecompiled code, and their results compared.") commit 4753d79331f747001ebdbbe9c32b33597daab37f Author: Michael Albinus <michael.albinus@gmx.de> Date: Sat Jun 16 16:05:07 2018 +0200 Fix Bug#31846. Do not merge with master * lisp/net/secrets.el (secrets-search-items) (secrets-create-item): Fix format of :dict-entry values. (Bug#31846) diff --git a/lisp/net/secrets.el b/lisp/net/secrets.el index fbb0a74978..c468548316 100644 --- a/lisp/net/secrets.el +++ b/lisp/net/secrets.el @@ -612,9 +612,9 @@ The object labels of the found items are returned as list." (error 'wrong-type-argument (cadr attributes))) (setq props (append props - (list :dict-entry - (substring (symbol-name (car attributes)) 1) - (cadr attributes))) + `((:dict-entry + ,(substring (symbol-name (car attributes)) 1) + ,(cadr attributes)))) attributes (cddr attributes))) ;; Search. The result is a list of object paths. (setq result @@ -650,9 +650,9 @@ The object path of the created item is returned." (error 'wrong-type-argument (cadr attributes))) (setq props (append props - (list :dict-entry - (substring (symbol-name (car attributes)) 1) - (cadr attributes))) + `((:dict-entry + ,(substring (symbol-name (car attributes)) 1) + ,(cadr attributes)))) attributes (cddr attributes))) ;; Create the item. (setq result commit 34e257f83a22093cc8dd7a6cd8a4707123f5af77 Author: Eli Zaretskii <eliz@gnu.org> Date: Sat Jun 16 14:16:53 2018 +0300 Use mint_ptr in w32notify.c * src/w32notify.c (Fw32notify_add_watch, Fw32notify_rm_watch) (Fw32notify_valid_p, w32_get_watch_object): Use make_mint_ptr and xmint_pointer. diff --git a/src/w32notify.c b/src/w32notify.c index 5c1d212054..67385b80a8 100644 --- a/src/w32notify.c +++ b/src/w32notify.c @@ -622,7 +622,7 @@ generate notifications correctly, though. */) report_file_notify_error ("Cannot watch file", Fcons (file, Qnil)); } /* Store watch object in watch list. */ - watch_descriptor = make_pointer_integer (dirwatch); + watch_descriptor = make_mint_ptr (dirwatch); watch_object = Fcons (watch_descriptor, callback); watch_list = Fcons (watch_object, watch_list); @@ -647,7 +647,7 @@ WATCH-DESCRIPTOR should be an object returned by `w32notify-add-watch'. */) if (!NILP (watch_object)) { watch_list = Fdelete (watch_object, watch_list); - dirwatch = (struct notification *)XINTPTR (watch_descriptor); + dirwatch = (struct notification *)xmint_pointer (watch_descriptor); if (w32_valid_pointer_p (dirwatch, sizeof(struct notification))) status = remove_watch (dirwatch); } @@ -662,7 +662,7 @@ WATCH-DESCRIPTOR should be an object returned by `w32notify-add-watch'. */) Lisp_Object w32_get_watch_object (void *desc) { - Lisp_Object descriptor = make_pointer_integer (desc); + Lisp_Object descriptor = make_mint_ptr (desc); /* This is called from the input queue handling code, inside a critical section, so we cannot possibly quit if watch_list is not @@ -685,7 +685,7 @@ watch by calling `w32notify-rm-watch' also makes it invalid. */) if (!NILP (watch_object)) { struct notification *dirwatch = - (struct notification *)XINTPTR (watch_descriptor); + (struct notification *)xmint_pointer (watch_descriptor); if (w32_valid_pointer_p (dirwatch, sizeof(struct notification)) && dirwatch->dir != NULL) return Qt; commit 63ba73a9f2bdf75363eea678a8c119ed0ffd9799 Author: Eli Zaretskii <eliz@gnu.org> Date: Sat Jun 16 14:00:47 2018 +0300 Fix documentation of ':propertize' in mode-line-format * doc/lispref/modes.texi (Mode Line Data): Make the description of ':propertize' more accurate. (Bug#26291) diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 8a77745d8f..d7e217c528 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -1839,10 +1839,13 @@ recursion. @item (:propertize @var{elt} @var{props}@dots{}) A list whose first element is the symbol @code{:propertize} says to -process the mode line construct @var{elt} recursively, then add the text -properties specified by @var{props} to the result. The argument +process the mode line construct @var{elt} recursively, then add the +text properties specified by @var{props} to the result. The argument @var{props} should consist of zero or more pairs @var{text-property} -@var{value}. +@var{value}. If @var{elt} is or produces a string with text +properties, all the characters of that string should have the same +properties, or else some of them might be removed by +@code{:propertize}. @item (@var{symbol} @var{then} @var{else}) A list whose first element is a symbol that is not a keyword specifies commit e0f7c49823bcb3c569f7334355e4fac8ba7061f7 Author: Eli Zaretskii <eliz@gnu.org> Date: Sat Jun 16 13:49:36 2018 +0300 * doc/lispref/text.texi (Parsing JSON): Minor formatting changes. diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index ea9c82422e..94cd87acf7 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -5016,14 +5016,14 @@ textual nodes that just contain white-space. @node Parsing JSON @section Parsing and generating JSON values @cindex JSON +@cindex JavaScript Object Notation - When Emacs is compiled with JSON support, it provides a couple of -functions to convert between Lisp objects and JSON values. Any JSON -value can be converted to a Lisp object, but not vice versa. -Specifically: + When Emacs is compiled with @acronym{JSON} (@dfn{JavaScript Object +Notation}) support, it provides several functions to convert +between Lisp objects and JSON values. Any JSON value can be converted +to a Lisp object, but not vice versa. Specifically: @itemize - @item JSON uses three keywords: @code{true}, @code{null}, @code{false}. @code{true} is represented by the symbol @code{t}. By default, the @@ -5035,8 +5035,8 @@ JSON only has floating-point numbers. They can represent both Lisp integers and Lisp floating-point numbers. @item -JSON strings are always Unicode strings. Lisp strings can contain -non-Unicode characters. +JSON strings are always Unicode strings encoded in UTF-8. Lisp +strings can contain non-Unicode characters. @item JSON has only one sequence type, the array. JSON arrays are @@ -5048,7 +5048,6 @@ using Lisp hashtables, alists or plists. When an alist or plist contains several elements with the same key, Emacs uses only the first element for serialization, in accordance with the behavior of @code{assq}. - @end itemize @noindent @@ -5059,20 +5058,18 @@ values. If some Lisp object can't be represented in JSON, the serialization functions will signal an error of type @code{wrong-type-argument}. -The parsing functions will signal the following errors: +The parsing functions can also signal the following errors: @table @code - @item json-end-of-file - Signaled when encountering a premature end of the input text. +Signaled when encountering a premature end of the input text. @item json-trailing-content - Signaled when encountering unexpected input after the first JSON - object parsed. +Signaled when encountering unexpected input after the first JSON +object parsed. @item json-parse-error - Signaled when encountering invalid JSON syntax. - +Signaled when encountering invalid JSON syntax. @end table Only top-level values (arrays and objects) can be serialized to @@ -5086,7 +5083,6 @@ representation of @var{object}. The argument @var{args} is a list of keyword/argument pairs. The following keywords are accepted: @table @code - @item :null-object The value decides which Lisp object to use to represent the JSON keyword @code{null}. It defaults to the symbol @code{:null}. @@ -5094,15 +5090,14 @@ keyword @code{null}. It defaults to the symbol @code{:null}. @item :false-object The value decides which Lisp object to use to represent the JSON keyword @code{false}. It defaults to the symbol @code{:false}. - @end table @end defun @defun json-insert object &rest args This function inserts the JSON representation of @var{object} into the -current buffer before point. @var{args} is interpreted as in -@code{json-parse-string}. +current buffer before point. The argument @var{args} are interpreted +as in @code{json-parse-string}. @end defun @defun json-parse-string string &rest args @@ -5111,7 +5106,6 @@ Lisp string. The argument @var{args} is a list of keyword/argument pairs. The following keywords are accepted: @table @code - @item :object-type The value decides which Lisp object to use for representing the key-value mappings of a JSON object. It can be either @@ -5126,7 +5120,6 @@ keyword @code{null}. It defaults to the symbol @code{:null}. @item :false-object The value decides which Lisp object to use to represent the JSON keyword @code{false}. It defaults to the symbol @code{:false}. - @end table @end defun @@ -5135,7 +5128,7 @@ keyword @code{false}. It defaults to the symbol @code{:false}. This function reads the next JSON value from the current buffer, starting at point. It moves point to the position immediately after the value if a value could be read and converted to Lisp; otherwise it -doesn't move point. @var{args} is interpreted as in +doesn't move point. The arguments @var{args} are interpreted as in @code{json-parse-string}. @end defun commit bd68321df157ef82190e0992fc030d1acc922a7b Author: Eli Zaretskii <eliz@gnu.org> Date: Sat Jun 16 13:40:38 2018 +0300 Minor doc string fixes in json.c * src/json.c (Fjson_serialize, Fjson_insert): Fix 'usage'. diff --git a/src/json.c b/src/json.c index d30c997da4..ea941d7bb5 100644 --- a/src/json.c +++ b/src/json.c @@ -574,7 +574,7 @@ represent a JSON false value. It defaults to `:false'. In you specify the same value for `:null-object' and `:false-object', a potentially ambiguous situation, the JSON output will not contain any JSON false values. -usage: (json-serialize STRING &rest ARGS) */) +usage: (json-serialize OBJECT &rest ARGS) */) (ptrdiff_t nargs, Lisp_Object *args) { ptrdiff_t count = SPECPDL_INDEX (); @@ -658,7 +658,8 @@ DEFUN ("json-insert", Fjson_insert, Sjson_insert, 1, MANY, doc: /* Insert the JSON representation of OBJECT before point. This is the same as (insert (json-serialize OBJECT)), but potentially faster. See the function `json-serialize' for allowed values of -OBJECT. */) +OBJECT. +usage: (json-insert OBJECT &rest ARGS) */) (ptrdiff_t nargs, Lisp_Object *args) { ptrdiff_t count = SPECPDL_INDEX (); commit 67946b0cde83a66591934a5e1e1c4e8a58c36b4c Author: Eli Zaretskii <eliz@gnu.org> Date: Sat Jun 16 13:27:24 2018 +0300 Formatting and doc fixes in recent changes * src/xfaces.c (evaluate_face_filter): Explain the inner braces. (merge_face_ref): Fix whitespace. (syms_of_xfaces) <face-filters-always-match>: Doc fix. * src/xdisp.c (extend_face_to_end_of_line): Fix whitespace. diff --git a/src/xdisp.c b/src/xdisp.c index a2b6513e57..dcb002055b 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -20231,9 +20231,8 @@ extend_face_to_end_of_line (struct it *it) return; /* The default face, possibly remapped. */ - default_face = FACE_FROM_ID_OR_NULL ( - f, - lookup_basic_face (it->w, f, DEFAULT_FACE_ID)); + default_face = + FACE_FROM_ID_OR_NULL (f, lookup_basic_face (it->w, f, DEFAULT_FACE_ID)); /* Face extension extends the background and box of IT->face_id to the end of the line. If the background equals the background diff --git a/src/xfaces.c b/src/xfaces.c index 31aa14b710..eea0672418 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -2203,6 +2203,8 @@ evaluate_face_filter (Lisp_Object filter, struct window *w, { Lisp_Object orig_filter = filter; + /* Inner braces keep compiler happy about the goto skipping variable + initialization. */ { if (NILP (filter)) return true; @@ -2356,7 +2358,7 @@ merge_face_ref (struct window *w, Lisp_Object first = XCAR (face_ref); if (EQ (first, Qforeground_color) - || EQ (first, Qbackground_color)) + || EQ (first, Qbackground_color)) { /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR . COLOR). COLOR must be a string. */ @@ -6650,10 +6652,10 @@ syms_of_xfaces (void) #endif DEFVAR_BOOL ("face-filters-always-match", face_filters_always_match, - doc: /* Non-nil means that face filters are always -deemed to match. This variable is intended for use only by code that -evaluates the "specifity" of a face specification and should be -let-bound only for this purpose. */); + doc: /* Non-nil means that face filters are always deemed to match. +This variable is intended for use only by code that evaluates +the "specifity" of a face specification and should be let-bound +only for this purpose. */); DEFVAR_LISP ("face-new-frame-defaults", Vface_new_frame_defaults, doc: /* List of global face definitions (for internal use only.) */); commit 0a6a2fb1d0b02a5ac442cf6b344e35696aac7eb7 Author: Eli Zaretskii <eliz@gnu.org> Date: Sat Jun 16 13:10:52 2018 +0300 Improve documentation of several recent changes * src/xfaces.c (merge_face_ref): Fix a typo in the commentary. (evaluate_face_filter, filter_face_ref): Minor copyedits in the commentary. * doc/lispref/display.texi (Face Remapping): * doc/lispref/text.texi (Special Properties): Document the ':filter' face specs and their effects. Document 'face-filters-always-match'. * doc/emacs/files.texi (Visiting): Document the new possibility to visit large files literally in response to question asked by Emacs. * etc/NEWS: Mention the new possibility to visit large files literally. * lisp/files.el (files--ask-user-about-large-file): Use "literally" instead of "raw", for consistency with find-file-literally. * doc/lispref/frames.texi (Input Focus): Tell explicitly that focus-change events are sometimes supported on TTY frames. diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 7043bdc068..f902baee9c 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -206,7 +206,10 @@ saved it. If the file has changed, Emacs offers to reread it. If you try to visit a file larger than @code{large-file-warning-threshold} (the default is 10000000, which is about 10 megabytes), Emacs asks you for confirmation first. You can -answer @kbd{y} to proceed with visiting the file. Note, however, that +answer @kbd{y} to proceed with visiting the file or @kbd{l} to visit +the file literally (see below). Visiting large files literally speeds +up navigation and editing of such files, because various +potentially-expensive features are turned off. Note, however, that Emacs cannot visit files that are larger than the maximum Emacs buffer size, which is limited by the amount of memory Emacs can allocate and by the integers that Emacs can represent (@pxref{Buffers}). If you diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index ce7ec3ac10..0ba7f0fd58 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -2938,7 +2938,13 @@ the remapped face---it replaces the normal definition of @var{face}, instead of modifying it. If @code{face-remapping-alist} is buffer-local, its local value takes -effect only within that buffer. +effect only within that buffer. If @code{face-remapping-alist} +includes faces applicable only to certain windows, by using the +@w{@code{(:filtered (:window @var{param} @var{val}) @var{spec})}}, +that face takes effect only in windows that match the filter +conditions (@pxref{Special Properties}). To turn off face filtering +temporarily, bind @code{face-filters-always-match} to a non-@code{nil} +value, then all face filters will match any window. Note: face remapping is non-recursive. If @var{remapping} references the same face name @var{face}, either directly or via the diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 5e8b5b46d5..6678644bec 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -2783,11 +2783,15 @@ could switch to a different terminal without switching back when you're done. @end deffn +@cindex text-terminal focus notification Emacs cooperates with the window system by arranging to select frames as the server and window manager request. When a window system informs Emacs that one of its frames has been selected, Emacs -internally generates a @dfn{focus-in} event. Focus events are -normally handled by @code{handle-focus-in}. +internally generates a @dfn{focus-in} event. When an Emacs frame is +displayed on a text-terminal emulator, such as @command{xterm}, which +supports reporting of focus-change notification, the focus-in and +focus-out events are available even for text-mode frames. Focus +events are normally handled by @code{handle-focus-in}. @deffn Command handle-focus-in event This function handles focus-in events from window systems and diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index bb6ab04a92..ea9c82422e 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -3325,6 +3325,17 @@ foreground or background color, similar to @code{(:foreground @var{color-name})} or @code{(:background @var{color-name})}. This form is supported for backward compatibility only, and should be avoided. + +@item +A cons cell of the form @w{@code{(:filtered @var{filter} +@var{face-spec})}}, that specifies the face given by @var{face-spec}, +but only if @var{filter} matches when the face is used for display. +The @var{face-spec} can use any of the forms mentioned above. The +@var{filter} should be of the form @w{@code{(:window @var{param} +@var{value})}}, which matches for windows whose parameter @var{param} +is @code{eq} to @var{value}. If the variable +@code{face-filters-always-match} is non-@code{nil}, all face filters +are deemed to have matched. @end itemize Font Lock mode (@pxref{Font Lock Mode}) works in most buffers by @@ -3699,6 +3710,12 @@ string to display, which is passed through The GNU Emacs Manual}) provides an example. @end defvar +@defvar face-filters-always-match +If this variable is non-@code{nil}, face filters that specify +attributes applied only when certain conditions are met will be deemed +to match always. +@end defvar + @node Format Properties @subsection Formatted Text Properties diff --git a/etc/NEWS b/etc/NEWS index e89402db13..cecd3f81f8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -175,6 +175,13 @@ interface that's more like functions like @code{search-forward}. ** More commands support noncontiguous rectangular regions, namely 'upcase-dwim', 'downcase-dwim', 'replace-string', 'replace-regexp'. ++++ +** When asked to visit a large file, Emacs now offers visiting it literally. +Previously, Emacs would only ask for confirmation before visiting +large files. Now it also offers a third alternative: to visit the +file literally, as in 'find-file-literally', which speeds up +navigation and editing of large files. + * Changes in Specialized Modes and Packages in Emacs 27.1 @@ -613,7 +620,8 @@ On terminal emulators that support the feature, Emacs can now support ** Window-specific face remapping. Face specifications (of the kind used in 'face-remapping-alist') now support filters, allowing faces to vary between different windows -displaying the same buffer. +displaying the same buffer. See the Info node "Face Remapping" of the +Emacs Lisp Reference manual for more detail. +++ ** New function assoc-delete-all. diff --git a/lisp/files.el b/lisp/files.el index 3921040fa9..c4a68d0440 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2031,19 +2031,19 @@ think it does, because \"free\" is pretty hard to define in practice." (x-popup-dialog t `(,prompt ("Yes" . ?y) ("No" . ?n) - ("Open in raw mode" . ?r))) + ("Open literally" . ?l))) (read-char-choice - (concat prompt " (y)es or (n)o or (r)aw ") - '(?y ?Y ?n ?N ?r ?R))))) + (concat prompt " (y)es or (n)o or (l)iterally ") + '(?y ?Y ?n ?N ?l ?L))))) (cond ((memq choice '(?y ?Y)) nil) - ((memq choice '(?r ?R)) 'raw) + ((memq choice '(?l ?L)) 'raw) (t 'abort)))))) (defun abort-if-file-too-large (size op-type filename &optional offer-raw) "If file SIZE larger than `large-file-warning-threshold', allow user to abort. OP-TYPE specifies the file operation being performed (for message to user). If OFFER-RAW is true, give user the additional option -to open the file in raw mode. If the user chooses this option, +to open the file literally. If the user chooses this option, `abort-if-file-too-large' returns the symbol `raw'. Otherwise, it returns nil or exits non-locally." (let ((choice (and large-file-warning-threshold size diff --git a/src/xfaces.c b/src/xfaces.c index 265581cca8..31aa14b710 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -2193,7 +2193,7 @@ merge_named_face (struct window *w, (:window PARAMETER VALUE), which matches if the current window has a PARAMETER EQ to VALUE. - This function returns true if the face filter matches and false if + This function returns true if the face filter matches, and false if it doesn't or if the function encountered an error. If the filter is invalid, set *OK to false and, if ERR_MSGS is true, log an error message. On success, *OK is untouched. */ @@ -2247,12 +2247,12 @@ evaluate_face_filter (Lisp_Object filter, struct window *w, /* Determine whether FACE_REF is a "filter" face specification (case #4 in merge_face_ref). If it is, evaluate the filter, and if the - filter matches, return the filtered expression. If the filter does + filter matches, return the filtered face spec. If the filter does not match, return `nil'. If FACE_REF is not a filtered face specification, return FACE_REF. On error, set *OK to false, having logged an error message if - ERR_MSGS is true, and return `nil'. + ERR_MSGS is true, and return `nil'. Otherwise, *OK is not touched. W is either NULL or a window used to evaluate filters. If W is NULL, no window-based face specification filter matches. @@ -2319,7 +2319,7 @@ filter_face_ref (Lisp_Object face_ref, for compatibility with 20.2. 4. Conses of the form - (:filter (:window PARAMETER VALUE) FACE-SPECIFICATION), + (:filtered (:window PARAMETER VALUE) FACE-SPECIFICATION), which applies FACE-SPECIFICATION only if the given face attributes are being evaluated in the context of a window with a parameter named PARAMETER being EQ VALUE. commit 2461266be1ea68a8c79af61abe850bb5a2c65040 Author: Eli Zaretskii <eliz@gnu.org> Date: Sat Jun 16 11:25:01 2018 +0300 Prevent QUIT to top level inside 'while-no-input' * lisp/subr.el (while-no-input): Handle the case when BODY never tests quit-flag, and runs to completion even though input arrives while BODY executes. (Bug#31692) diff --git a/lisp/subr.el b/lisp/subr.el index 914112ccef..4a2b797fa0 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3520,9 +3520,31 @@ If BODY finishes, `while-no-input' returns whatever value BODY produced." (let ((catch-sym (make-symbol "input"))) `(with-local-quit (catch ',catch-sym - (let ((throw-on-input ',catch-sym)) - (or (input-pending-p) - (progn ,@body))))))) + (let ((throw-on-input ',catch-sym) + val) + (setq val (or (input-pending-p) + (progn ,@body))) + (cond + ;; When input arrives while throw-on-input is non-nil, + ;; kbd_buffer_store_buffered_event sets quit-flag to the + ;; value of throw-on-input. If, when BODY finishes, + ;; quit-flag still has the same value as throw-on-input, it + ;; means BODY never tested quit-flag, and therefore ran to + ;; completion even though input did arrive before it + ;; finished. In that case, we must manually simulate what + ;; 'throw' in process_quit_flag would do, and we must + ;; reset quit-flag, because leaving it set will cause us + ;; quit to top-level, which has undesirable consequences, + ;; such as discarding input etc. We return t in that case + ;; because input did arrive during execution of BODY. + ((eq quit-flag throw-on-input) + (setq quit-flag nil) + t) + ;; This is for when the user actually QUITs during + ;; execution of BODY. + (quit-flag + nil) + (t val))))))) (defmacro condition-case-unless-debug (var bodyform &rest handlers) "Like `condition-case' except that it does not prevent debugging. commit 31b2680bc955b99fd812d904a95271afbc3882db Author: Eli Zaretskii <eliz@gnu.org> Date: Sat Jun 16 10:17:05 2018 +0300 Fix a typo in xmenu.c * src/xmenu.c (x_menu_show): Replace a call to record_unwind_protect_pointer with record_unwind_protect_ptr. (Bug#31856) diff --git a/src/xmenu.c b/src/xmenu.c index 2fbf9e8bf6..22995d8c7e 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -2290,8 +2290,8 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, XMenuActivateSetWaitFunction (x_menu_wait_for_event, FRAME_X_DISPLAY (f)); #endif - record_unwind_protect_pointer (pop_down_menu, - &(struct pop_down_menu) {f, menu}); + record_unwind_protect_ptr (pop_down_menu, + &(struct pop_down_menu) {f, menu}); /* Help display under X won't work because XMenuActivate contains a loop that doesn't give Emacs a chance to process it. */ commit a36008b5fc92b9ea00d70973ddc761c94a831c01 Author: Ari Roponen <ari.roponen@gmail.com> Date: Sat Jun 16 08:37:04 2018 +0300 Fix --with-cairo build * src/xterm.c (x_cr_destroy): Remove extra semicolon. (x_cr_export_frames): Fix a typo in calling record_unwind_protect_ptr. (Bug#31856) diff --git a/src/xterm.c b/src/xterm.c index 48ce791889..9504bfb183 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -544,7 +544,7 @@ x_cr_accumulate_data (void *closure, const unsigned char *data, } static void -x_cr_destroy (void *cr); +x_cr_destroy (void *cr) { block_input (); cairo_destroy (cr); @@ -604,7 +604,7 @@ x_cr_export_frames (Lisp_Object frames, cairo_surface_type_t surface_type) cr = cairo_create (surface); cairo_surface_destroy (surface); - record_unwind_protect_pointer (x_cr_destroy, cr); + record_unwind_protect_ptr (x_cr_destroy, cr); while (1) { commit 7f2cfcce95d6472b436def7a9cdf4e47a3b82eaf Author: Paul Eggert <eggert@cs.ucla.edu> Date: Fri Jun 15 16:11:41 2018 -0700 * src/Makefile.in: Update paxctl comment. diff --git a/src/Makefile.in b/src/Makefile.in index a1ec0bd7f7..7bbe4e199e 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -104,7 +104,7 @@ LD_SWITCH_SYSTEM_TEMACS=@LD_SWITCH_SYSTEM_TEMACS@ ## Flags to pass to ld only for temacs. TEMACS_LDFLAGS = $(LD_SWITCH_SYSTEM) $(LD_SWITCH_SYSTEM_TEMACS) -## If available, the names of the paxctl and setfattr programs. +## If needed, the names of the paxctl and setfattr programs. ## On grsecurity/PaX systems, unexec will fail due to a gap between ## the bss section and the heap. Older versions need paxctl to work ## around this, newer ones setfattr. See Bug#11398 and Bug#16343. commit b8b960e5e1520874b0a59575d31368f96b7f8b47 Author: Paul Eggert <eggert@cs.ucla.edu> Date: Fri Jun 15 15:51:39 2018 -0700 Minor CANNOT_DUMP cleanups Mostly, this avoids munging executables when CANNOT_DUMP = yes, as the munging is needed only for unexec. * configure.ac (PAXCTL_dumped, PAXCTL_notdumped) [CANNOT_DUMP]: Leave these empty. (LD_SWITCH_SYSTEM_TEMACS) [CANNOT_DUMP]: Do not append -no-pie or -nopie. * src/alloc.c (my_heap_start) [CANNOT_DUMP]: Omit; not used. diff --git a/configure.ac b/configure.ac index 4fcb846c60..e33b1f1e35 100644 --- a/configure.ac +++ b/configure.ac @@ -1226,50 +1226,52 @@ AC_SUBST([FIND_DELETE]) PAXCTL_dumped= PAXCTL_notdumped= -if test $opsys = gnu-linux; then - if test "${SETFATTR+set}" != set; then - AC_CACHE_CHECK([for setfattr], - [emacs_cv_prog_setfattr], - [touch conftest.tmp - if (setfattr -n user.pax.flags conftest.tmp) >/dev/null 2>&1; then - emacs_cv_prog_setfattr=yes - else - emacs_cv_prog_setfattr=no - fi]) - if test "$emacs_cv_prog_setfattr" = yes; then - PAXCTL_notdumped='$(SETFATTR) -n user.pax.flags -v er' - SETFATTR=setfattr - else - SETFATTR= +if test "$CANNOT_DUMP" != yes; then + if test $opsys = gnu-linux; then + if test "${SETFATTR+set}" != set; then + AC_CACHE_CHECK([for setfattr], + [emacs_cv_prog_setfattr], + [touch conftest.tmp + if (setfattr -n user.pax.flags conftest.tmp) >/dev/null 2>&1; then + emacs_cv_prog_setfattr=yes + else + emacs_cv_prog_setfattr=no + fi]) + if test "$emacs_cv_prog_setfattr" = yes; then + PAXCTL_notdumped='$(SETFATTR) -n user.pax.flags -v er' + SETFATTR=setfattr + else + SETFATTR= + fi + rm -f conftest.tmp + AC_SUBST([SETFATTR]) fi - rm -f conftest.tmp - AC_SUBST([SETFATTR]) fi -fi -case $opsys,$PAXCTL_notdumped,$emacs_uname_r in - gnu-linux,,* | netbsd,,[0-7].*) - AC_PATH_PROG([PAXCTL], [paxctl], [], - [$PATH$PATH_SEPARATOR/sbin$PATH_SEPARATOR/usr/sbin]) - if test -n "$PAXCTL"; then - if test "$opsys" = netbsd; then - PAXCTL_dumped='$(PAXCTL) +a' - PAXCTL_notdumped=$PAXCTL_dumped - else - AC_MSG_CHECKING([whether binaries have a PT_PAX_FLAGS header]) - AC_LINK_IFELSE([AC_LANG_PROGRAM([], [])], - [if $PAXCTL -v conftest$EXEEXT >/dev/null 2>&1; then - AC_MSG_RESULT([yes]) - else - AC_MSG_RESULT([no]) - PAXCTL= - fi]) - if test -n "$PAXCTL"; then - PAXCTL_dumped='$(PAXCTL) -zex' - PAXCTL_notdumped='$(PAXCTL) -r' + case $opsys,$PAXCTL_notdumped,$emacs_uname_r in + gnu-linux,,* | netbsd,,[0-7].*) + AC_PATH_PROG([PAXCTL], [paxctl], [], + [$PATH$PATH_SEPARATOR/sbin$PATH_SEPARATOR/usr/sbin]) + if test -n "$PAXCTL"; then + if test "$opsys" = netbsd; then + PAXCTL_dumped='$(PAXCTL) +a' + PAXCTL_notdumped=$PAXCTL_dumped + else + AC_MSG_CHECKING([whether binaries have a PT_PAX_FLAGS header]) + AC_LINK_IFELSE([AC_LANG_PROGRAM([], [])], + [if $PAXCTL -v conftest$EXEEXT >/dev/null 2>&1; then + AC_MSG_RESULT([yes]) + else + AC_MSG_RESULT([no]) + PAXCTL= + fi]) + if test -n "$PAXCTL"; then + PAXCTL_dumped='$(PAXCTL) -zex' + PAXCTL_notdumped='$(PAXCTL) -r' + fi fi - fi - fi;; -esac + fi;; + esac +fi AC_SUBST([PAXCTL_dumped]) AC_SUBST([PAXCTL_notdumped]) @@ -5287,19 +5289,25 @@ esac AC_CACHE_CHECK( [for $CC option to disable position independent executables], [emacs_cv_prog_cc_no_pie], - [emacs_save_c_werror_flag=$ac_c_werror_flag - emacs_save_LDFLAGS=$LDFLAGS - ac_c_werror_flag=yes - for emacs_cv_prog_cc_no_pie in -no-pie -nopie no; do - test $emacs_cv_prog_cc_no_pie = no && break - LDFLAGS="$emacs_save_LDFLAGS $emacs_cv_prog_cc_no_pie" - AC_LINK_IFELSE([AC_LANG_PROGRAM([], [])], [break]) - done - ac_c_werror_flag=$emacs_save_c_werror_flag - LDFLAGS=$emacs_save_LDFLAGS]) -if test "$emacs_cv_prog_cc_no_pie" != no; then - LD_SWITCH_SYSTEM_TEMACS="$LD_SWITCH_SYSTEM_TEMACS $emacs_cv_prog_cc_no_pie" -fi + [if test "$CANNOT_DUMP" = yes; then + emacs_cv_prog_cc_no_pie='not needed' + else + emacs_save_c_werror_flag=$ac_c_werror_flag + emacs_save_LDFLAGS=$LDFLAGS + ac_c_werror_flag=yes + for emacs_cv_prog_cc_no_pie in -no-pie -nopie no; do + test $emacs_cv_prog_cc_no_pie = no && break + LDFLAGS="$emacs_save_LDFLAGS $emacs_cv_prog_cc_no_pie" + AC_LINK_IFELSE([AC_LANG_PROGRAM([], [])], [break]) + done + ac_c_werror_flag=$emacs_save_c_werror_flag + LDFLAGS=$emacs_save_LDFLAGS + fi]) +case $emacs_cv_prog_cc_no_pie in + -*) + LD_SWITCH_SYSTEM_TEMACS="$LD_SWITCH_SYSTEM_TEMACS $emacs_cv_prog_cc_no_pie" + ;; +esac if test x$ac_enable_profiling != x ; then case $opsys in diff --git a/src/alloc.c b/src/alloc.c index 7b2140501e..286358662b 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -104,7 +104,7 @@ static bool valgrind_p; #include "w32heap.h" /* for sbrk */ #endif -#ifdef GNU_LINUX +#if defined GNU_LINUX && !defined CANNOT_DUMP /* The address where the heap starts. */ void * my_heap_start (void) commit c2b20948fbe1dbb4be76c477e66cf120797417ff Author: Paul Eggert <eggert@cs.ucla.edu> Date: Fri Jun 15 14:37:39 2018 -0700 Remove old combreloc hack It has not been needed for many years and gets in the way of portable dumping, address sanitization, etc. See: https://lists.gnu.org/r/emacs-devel/2016-12/msg00147.html * configure.ac (LDFLAGS_NOCOMBRELOC, emacs_cv_znocombreloc): Remove. All uses removed. * etc/PROBLEMS: Remove discussion of combreloc problems. diff --git a/configure.ac b/configure.ac index eddeb5073c..4fcb846c60 100644 --- a/configure.ac +++ b/configure.ac @@ -1333,39 +1333,6 @@ else ac_link="$ac_link $NON_GCC_LINK_TEST_OPTIONS" fi -dnl We need -znocombreloc if we're using a relatively recent GNU ld. -dnl If we can link with the flag, it shouldn't do any harm anyhow. -dnl Treat GCC specially since it just gives a non-fatal 'unrecognized option' -dnl if not built to support GNU ld. - -dnl For a long time, -znocombreloc was added to LDFLAGS rather than -dnl LD_SWITCH_SYSTEM_TEMACS. That is: -dnl * inappropriate, as LDFLAGS is a user option but this is essential. -dnl Eg "make LDFLAGS=... all" could run into problems, -dnl https://bugs.debian.org/684788 -dnl * unnecessary, since temacs is the only thing that actually needs it. -dnl Indeed this is where it was originally, prior to: -dnl https://lists.gnu.org/r/emacs-pretest-bug/2004-03/msg00170.html -if test x$GCC = xyes; then - LDFLAGS_NOCOMBRELOC="-Wl,-znocombreloc" -else - LDFLAGS_NOCOMBRELOC="-znocombreloc" -fi - -AC_CACHE_CHECK([for -znocombreloc], [emacs_cv_znocombreloc], -[late_LDFLAGS="$LDFLAGS" -LDFLAGS="$LDFLAGS $LDFLAGS_NOCOMBRELOC" - -AC_LINK_IFELSE([AC_LANG_PROGRAM([], [])], - [emacs_cv_znocombreloc=yes], [emacs_cv_znocombreloc=no]) - -LDFLAGS="$late_LDFLAGS"]) - -if test x$emacs_cv_znocombreloc = xno; then - LDFLAGS_NOCOMBRELOC= -fi - - AC_CACHE_CHECK([whether addresses are sanitized], [emacs_cv_sanitize_address], [AC_COMPILE_IFELSE( @@ -5341,8 +5308,6 @@ if test x$ac_enable_profiling != x ; then esac fi -LD_SWITCH_SYSTEM_TEMACS="$LDFLAGS_NOCOMBRELOC $LD_SWITCH_SYSTEM_TEMACS" - AC_SUBST(LD_SWITCH_SYSTEM_TEMACS) ## Common for all window systems diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 5a8618f71e..fe59b52c75 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -192,18 +192,6 @@ Upgrading to a newer version of Exceed has been reported to prevent these crashes. You should consider switching to a free X server, such as Xming or Cygwin/X. -** Emacs crashes with SIGSEGV in XtInitializeWidgetClass. - -It crashes on X, but runs fine when called with option "-nw". - -This has been observed when Emacs is linked with GNU ld but without passing -the -z nocombreloc flag. Emacs normally knows to pass the -z nocombreloc -flag when needed, so if you come across a situation where the flag is -necessary but missing, please report it via M-x report-emacs-bug. - -On platforms such as Solaris, you can also work around this problem by -configuring your compiler to use the native linker instead of GNU ld. - ** When Emacs is compiled with Gtk+, closing a display kills Emacs. There is a long-standing bug in GTK that prevents it from recovering commit dec54ec0c067535c87371b1f7942941b90765647 Author: Paul Eggert <eggert@cs.ucla.edu> Date: Fri Jun 15 13:40:12 2018 -0700 Fix typo in previous macfont.m change * src/macfont.m (macfont_descriptor_entity): Fix typo. Problem reported by Clemens SchĂĽller. diff --git a/src/macfont.m b/src/macfont.m index 3a1e9e5f47..e0c704fac9 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -908,7 +908,8 @@ static void mac_font_get_glyphs_for_variants (CFDataRef, UTF32Char, ASET (entity, FONT_EXTRA_INDEX, Fcopy_sequence (extra)); name = CTFontDescriptorCopyAttribute (desc, kCTFontNameAttribute); font_put_extra (entity, QCfont_entity, - Fcons (make_mint_ptr ((void *) name), make_number (traits))); + Fcons (make_mint_ptr ((void *) name), + make_number (sym_traits))); if (synth_sym_traits & kCTFontTraitItalic) FONT_SET_STYLE (entity, FONT_SLANT_INDEX, make_number (FONT_SLANT_SYNTHETIC_ITALIC)); commit 850c0c1a8799f4e59b465b849fdbe6a57ec2ebfd Author: Paul Eggert <eggert@cs.ucla.edu> Date: Fri Jun 15 09:06:13 2018 -0700 Restore macfont.m casts to void * * src/macfont.m (macfont_set_family_cache): Restore casts to void * that were mistakenly removed in my recent change. The types in question are pointer-to-const. Problem reported by Clemens SchĂĽller. diff --git a/src/macfont.m b/src/macfont.m index 8abe203644..3a1e9e5f47 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -908,7 +908,7 @@ static void mac_font_get_glyphs_for_variants (CFDataRef, UTF32Char, ASET (entity, FONT_EXTRA_INDEX, Fcopy_sequence (extra)); name = CTFontDescriptorCopyAttribute (desc, kCTFontNameAttribute); font_put_extra (entity, QCfont_entity, - Fcons (make_mint_ptr (name), make_number (traits))); + Fcons (make_mint_ptr ((void *) name), make_number (traits))); if (synth_sym_traits & kCTFontTraitItalic) FONT_SET_STYLE (entity, FONT_SLANT_INDEX, make_number (FONT_SLANT_SYNTHETIC_ITALIC)); @@ -984,7 +984,7 @@ static void mac_font_get_glyphs_for_variants (CFDataRef, UTF32Char, h = XHASH_TABLE (macfont_family_cache); i = hash_lookup (h, symbol, &hash); - value = string ? make_mint_ptr (CFRetain (string)) : Qnil; + value = string ? make_mint_ptr ((void *) CFRetain (string)) : Qnil; if (i >= 0) { Lisp_Object old_value = HASH_VALUE (h, i); commit 115decb07d99be74c114141a6745cfd3603c7aaf Author: JoĂŁo Távora <joaotavora@gmail.com> Date: Fri Jun 15 15:48:59 2018 +0100 Fix a bug in Flymake handling of region-specific reports The backend's diagnostic list must be updated too, not just cleared. * lisp/progmodes/flymake.el (flymake--diag): Add overlay field. (flymake--highlight-line): Return created overlay. (flymake--handle-report): Iterate the backend's diagnostics, not the overlays. Set diagnostic overlay. (flymake--run-backend): Don't clean diagnostic list here. (flymake-mode): Call delete-overlay directly. diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index e3c07fc898..eb0eebf672 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -14,10 +14,10 @@ ;; 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. +;; 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/>. @@ -292,7 +292,7 @@ generated it." (cl-defstruct (flymake--diag (:constructor flymake--diag-make)) - buffer beg end type text backend data) + buffer beg end type text backend data overlay) ;;;###autoload (defun flymake-make-diagnostic (buffer @@ -354,10 +354,6 @@ verify FILTER, a function, and sort them by COMPARE (using KEY)." #'identity)) ovs)))) -(defun flymake--delete-own-overlays (&optional filter beg end) - "Delete Flymake overlays matching FILTER between BEG and END." - (mapc #'delete-overlay (flymake--overlays :filter filter :beg beg :end end))) - (defface flymake-error '((((supports :underline (:style wave))) :underline (:style wave :color "Red1")) @@ -630,7 +626,8 @@ associated `flymake-category' return DEFAULT." ;; Some properties can't be overridden. ;; (overlay-put ov 'evaporate t) - (overlay-put ov 'flymake-diagnostic diagnostic))) + (overlay-put ov 'flymake-diagnostic diagnostic) + ov)) ;; Nothing in Flymake uses this at all any more, so this is just for ;; third-party compatibility. @@ -717,21 +714,28 @@ report applies to that region." (setq new-diags report-action) (save-restriction (widen) - ;; Decide whether to delete some of this backend's overlays - (let ((ov-filter - (lambda (ov) - (eq backend - (flymake--diag-backend - (overlay-get ov 'flymake-diagnostic)))))) - (cond - (region (flymake--delete-own-overlays ov-filter - (car region) - (cdr region))) - (first-report (flymake--delete-own-overlays ov-filter)))) + ;; Before adding to backend's diagnostic list, decide if + ;; some or all must be deleted. When deleting, also delete + ;; the associated overlay. + (cond + (region + (dolist (diag (flymake--backend-state-diags state)) + (let ((diag-beg (flymake--diag-beg diag)) + (diag-end (flymake--diag-beg diag))) + (when (and (< diag-beg (cdr region)) + (> diag-end (car region))) + (delete-overlay (flymake--diag-overlay diag)) + (setf (flymake--backend-state-diags state) + (delq diag (flymake--backend-state-diags state))))))) + (first-report + (dolist (diag (flymake--backend-state-diags state)) + (delete-overlay (flymake--diag-overlay diag))) + (setf (flymake--backend-state-diags state) nil))) ;; Now make new ones (mapc (lambda (diag) - (flymake--highlight-line diag) - (setf (flymake--diag-backend diag) backend)) + (let ((overlay (flymake--highlight-line diag))) + (setf (flymake--diag-backend diag) backend + (flymake--diag-overlay diag) overlay))) new-diags) (setf (flymake--backend-state-diags state) (append new-diags (flymake--backend-state-diags state))) @@ -812,7 +816,6 @@ with a report function." (flymake--with-backend-state backend state (setf (flymake--backend-state-running state) run-token (flymake--backend-state-disabled state) nil - (flymake--backend-state-diags state) nil (flymake--backend-state-reported-p state) nil)) ;; FIXME: Should use `condition-case-unless-debug' here, but don't ;; for two reasons: (1) that won't let me catch errors from inside @@ -963,7 +966,7 @@ special *Flymake log* buffer." :group 'flymake :lighter (remove-hook 'kill-buffer-hook 'flymake-kill-buffer-hook t) ;;+(remove-hook 'find-file-hook (function flymake-find-file-hook) t) - (flymake--delete-own-overlays) + (mapc #'delete-overlay (flymake--overlays)) (when flymake-timer (cancel-timer flymake-timer) commit 4221809b00e526892b7ff3979b3829eb493f0616 Author: Eli Zaretskii <eliz@gnu.org> Date: Fri Jun 15 17:45:27 2018 +0300 Fix building --without-x and similar * src/keyboard.c (make_lispy_focus_out): Compile it unconditionally, as it is now supported on TTYs as well. Reported by Filipp Gunbin <fgunbin@fastmail.fm>. diff --git a/src/keyboard.c b/src/keyboard.c index 12fc33787a..540991872a 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -360,9 +360,7 @@ static Lisp_Object modify_event_symbol (ptrdiff_t, int, Lisp_Object, Lisp_Object *, ptrdiff_t); static Lisp_Object make_lispy_switch_frame (Lisp_Object); static Lisp_Object make_lispy_focus_in (Lisp_Object); -#ifdef HAVE_WINDOW_SYSTEM static Lisp_Object make_lispy_focus_out (Lisp_Object); -#endif /* HAVE_WINDOW_SYSTEM */ static bool help_char_p (Lisp_Object); static void save_getcjmp (sys_jmp_buf); static void restore_getcjmp (sys_jmp_buf); @@ -6047,16 +6045,12 @@ make_lispy_focus_in (Lisp_Object frame) return list2 (Qfocus_in, frame); } -#ifdef HAVE_WINDOW_SYSTEM - static Lisp_Object make_lispy_focus_out (Lisp_Object frame) { return list2 (Qfocus_out, frame); } -#endif /* HAVE_WINDOW_SYSTEM */ - /* Manipulating modifiers. */ /* Parse the name of SYMBOL, and return the set of modifiers it contains. commit 22aa665c9b536775a28ff2e4907afc31b69ccb21 Author: Eli Zaretskii <eliz@gnu.org> Date: Fri Jun 15 17:39:34 2018 +0300 Reject invalid 5-byte sequences when detecting UTF-8 encoding * src/coding.c (detect_coding_utf_8): Reject multibyte sequences whose leading byte is greater than MAX_MULTIBYTE_LEADING_CODE. (Bug#31829) * src/character.h (MAX_MULTIBYTE_LEADING_CODE): Add commentary about the connection between the value of this macro and MAX_CHAR. diff --git a/src/character.h b/src/character.h index 1f21b2ad33..bc65759aa2 100644 --- a/src/character.h +++ b/src/character.h @@ -57,7 +57,8 @@ INLINE_HEADER_BEGIN /* Minimum leading code of multibyte characters. */ #define MIN_MULTIBYTE_LEADING_CODE 0xC0 -/* Maximum leading code of multibyte characters. */ +/* Maximum leading code of multibyte characters. Note: this must be + updated if we ever increase MAX_CHAR above. */ #define MAX_MULTIBYTE_LEADING_CODE 0xF8 /* Unicode character values. */ diff --git a/src/coding.c b/src/coding.c index e756ba169d..b1eb2edb49 100644 --- a/src/coding.c +++ b/src/coding.c @@ -1225,7 +1225,10 @@ detect_coding_utf_8 (struct coding_system *coding, ONE_MORE_BYTE (c4); if (c4 < 0 || ! UTF_8_EXTRA_OCTET_P (c4)) break; - if (UTF_8_5_OCTET_LEADING_P (c)) + if (UTF_8_5_OCTET_LEADING_P (c) + /* If we ever need to increase MAX_CHAR, the below may need + to be reviewed. */ + && c < MAX_MULTIBYTE_LEADING_CODE) { nchars++; continue; commit 3e7dff88928b568f8d4126c7fe2251662d140be6 Author: JoĂŁo Távora <joaotavora@gmail.com> Date: Fri Jun 15 12:17:37 2018 +0100 Flymake and backends exchange hints abouts changed regions * lisp/progmodes/flymake.el (flymake--delete-own-overlays): Accept BEG and END. Rename from flymake-delete-own-overlays. (flymake-diagnostic-functions): Describe :region, :recent-changes in docstring. (flymake--handle-report): Accept REGION. (flymake--run-backend): Accept optional ARGS to pass to backend fn. (flymake--recent-changes): New buffer-local variable. (flymake-start): Call flymake--run-backend with recent changes. (flymake-mode): Initialize flymake--recent-changes. Call flymake--delete-own-overlays. (flymake-after-change-function): Collect recent changes. * doc/misc/flymake.texi (Backend functions): Describe :recent-changes and :region. * etc/NEWS (Flymake): Mention improvements in backend communication. diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi index 502d408f2b..1e7a5e82c6 100644 --- a/doc/misc/flymake.texi +++ b/doc/misc/flymake.texi @@ -437,18 +437,35 @@ calling convention: one for calls made by Flymake into the backend via the backend function, the other in the reverse direction via a callback. To be usable, backends must adhere to both. -Backend functions must accept an arbitrary number of arguments: +The first argument passed to a backend function is always +@var{report-fn}, a callback function detailed below. Beyond it, +functions must be prepared to accept (and possibly ignore) an +arbitrary number of keyword-value pairs of the form +@w{@code{(@var{:key} @var{value} @var{:key2} @var{value2}...)}}. + +Currently, Flymake may pass the following keywords and values to the +backend function: @itemize -@item -the first argument is always @var{report-fn}, a callback function -detailed below; -@item -the remaining arguments are keyword-value pairs of the form -@w{@code{(@var{:key} @var{value} @var{:key2} @var{value2}...)}}. -Currently, Flymake provides no such arguments, but backend functions -must be prepared to accept (and possibly ignore) any number of them. +@item @code{:recent-changes} +The value is a list recent changes since the last time the backend +function was called for the buffer. If the list is empty, this +indicates that no changes have been recorded. If it is the first time +that this backend function is called for this activation of +@code{flymake-mode}, then this argument isn't provided at all +(i.e. it's not merely nil). + +Each element is in the form (@var{beg} @var{end} @var{text}) where +@var{beg} and @var{end} are buffer positions, and @var{text} is a +string containing the text contained between those positions (if any), +after the change was performed. + +@item @code{:changes-start} and @code{:changes-end} +The value is, repectively, the minimum and maximum buffer positions +touched by the recent changes. These are provided for convenience and +only if @code{:recent-changes} is also provided. + @end itemize Whenever Flymake or the user decide to re-check the buffer, backend @@ -504,6 +521,11 @@ details of the situation encountered, if any. @code{:force}, whose value should be a boolean suggesting that Flymake consider the report even if it was somehow unexpected. + +@item +@code{:region}, a cons (@var{beg} . @var{end}) of buffer positions +indicating that the report applies to that region and that previous +reports targeting other parts of the buffer remain valid. @end itemize @menu diff --git a/etc/NEWS b/etc/NEWS index 50433eb7f2..e89402db13 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -193,6 +193,10 @@ You should instead set properties on known diagnostic symbols, like *** New customizable variable 'flymake-start-on-save-buffer' Control whether Flymake starts checking the buffer on save. +*** Flymake and backend functions may exchange hints about buffer changes +This enables more efficient backends. See the docstring of +'flymake-diagnostic-functions' or the Flymake manual for details. + ** Package *** New 'package-quickstart' feature When 'package-quickstart' is non-nil, package.el precomputes a big autoloads diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index fdb22ccaf3..e3c07fc898 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -354,9 +354,9 @@ verify FILTER, a function, and sort them by COMPARE (using KEY)." #'identity)) ovs)))) -(defun flymake-delete-own-overlays (&optional filter) - "Delete all Flymake overlays in BUFFER." - (mapc #'delete-overlay (flymake--overlays :filter filter))) +(defun flymake--delete-own-overlays (&optional filter beg end) + "Delete Flymake overlays matching FILTER between BEG and END." + (mapc #'delete-overlay (flymake--overlays :filter filter :beg beg :end end))) (defface flymake-error '((((supports :underline (:style wave))) @@ -444,9 +444,25 @@ number of arguments: detailed below; * the remaining arguments are keyword-value pairs in the - form (:KEY VALUE :KEY2 VALUE2...). Currently, Flymake provides - no such arguments, but backend functions must be prepared to - accept and possibly ignore any number of them. + form (:KEY VALUE :KEY2 VALUE2...). + +Currently, Flymake may provide these keyword-value pairs: + +* `:recent-changes', a list of recent changes since the last time + the backend function was called for the buffer. An empty list + indicates that no changes have been reocrded. If it is the + first time that this backend function is called for this + activation of `flymake-mode', then this argument isn't provided + at all (i.e. it's not merely nil). + + Each element is in the form (BEG END TEXT) where BEG and END + are buffer positions, and text is a string containing the text + contained between those positions (if any) after the change was + performed. + +* `:changes-start' and `:changes-end' the minimum and maximum + buffer positions touched by the recent changes. These are only + provided if `:recent-changes' is also provided. Whenever Flymake or the user decides to re-check the buffer, backend functions are called as detailed above and are expected @@ -491,7 +507,11 @@ Currently accepted REPORT-KEY arguments are: the situation encountered, if any. * `:force': value should be a boolean suggesting that Flymake - consider the report even if it was somehow unexpected.") + consider the report even if it was somehow unexpected. + +* `:region': a cons (BEG . END) of buffer positions indicating + that the report applies to that region and that previous + reports targeting other buffer regions are still valid.") (put 'flymake-diagnostic-functions 'safe-local-variable #'null) @@ -657,13 +677,15 @@ backend is operating normally.") (flymake-running-backends)) (cl-defun flymake--handle-report (backend token report-action - &key explanation force + &key explanation force region &allow-other-keys) "Handle reports from BACKEND identified by TOKEN. -BACKEND, REPORT-ACTION and EXPLANATION, and FORCE conform to the calling -convention described in `flymake-diagnostic-functions' (which -see). Optional FORCE says to handle a report even if TOKEN was -not expected." +BACKEND, REPORT-ACTION and EXPLANATION, and FORCE conform to the +calling convention described in +`flymake-diagnostic-functions' (which see). Optional FORCE says +to handle a report even if TOKEN was not expected. REGION is +a (BEG . END) pair of buffer positions indicating that this +report applies to that region." (let* ((state (gethash backend flymake--backend-state)) (first-report (not (flymake--backend-state-reported-p state)))) (setf (flymake--backend-state-reported-p state) t) @@ -695,13 +717,18 @@ not expected." (setq new-diags report-action) (save-restriction (widen) - ;; only delete overlays if this is the first report - (when first-report - (flymake-delete-own-overlays - (lambda (ov) - (eq backend - (flymake--diag-backend - (overlay-get ov 'flymake-diagnostic)))))) + ;; Decide whether to delete some of this backend's overlays + (let ((ov-filter + (lambda (ov) + (eq backend + (flymake--diag-backend + (overlay-get ov 'flymake-diagnostic)))))) + (cond + (region (flymake--delete-own-overlays ov-filter + (car region) + (cdr region))) + (first-report (flymake--delete-own-overlays ov-filter)))) + ;; Now make new ones (mapc (lambda (diag) (flymake--highlight-line diag) (setf (flymake--diag-backend diag) backend)) @@ -776,8 +803,10 @@ If it is running also stop it." (flymake--backend-state-disabled state) explanation (flymake--backend-state-reported-p state) t))) -(defun flymake--run-backend (backend) - "Run the backend BACKEND, reenabling if necessary." +(defun flymake--run-backend (backend &optional args) + "Run the backend BACKEND, re-enabling if necessary. +ARGS is a keyword-value plist passed to the backend along +with a report function." (flymake-log :debug "Running backend %s" backend) (let ((run-token (cl-gensym "backend-token"))) (flymake--with-backend-state backend state @@ -794,16 +823,19 @@ If it is running also stop it." ;; backend) will trigger an annoying backtrace. ;; (condition-case err - (funcall backend - (flymake-make-report-fn backend run-token)) + (apply backend (flymake-make-report-fn backend run-token) + args) (error (flymake--disable-backend backend err))))) +(defvar-local flymake--recent-changes nil + "Recent changes collected by `flymake-after-change-function'.") + (defun flymake-start (&optional deferred force) "Start a syntax check for the current buffer. DEFERRED is a list of symbols designating conditions to wait for before actually starting the check. If it is nil (the list is -empty), start it immediately, else defer the check to when those + empty), start it immediately, else defer the check to when those conditions are met. Currently recognized conditions are `post-command', for waiting until the current command is over, `on-display', for waiting until the buffer is actually displayed @@ -844,18 +876,30 @@ Interactively, with a prefix arg, FORCE is t." 'append 'local)) (t (setq flymake-check-start-time (float-time)) - (run-hook-wrapped - 'flymake-diagnostic-functions - (lambda (backend) - (cond - ((and (not force) - (flymake--with-backend-state backend state - (flymake--backend-state-disabled state))) - (flymake-log :debug "Backend %s is disabled, not starting" - backend)) - (t - (flymake--run-backend backend))) - nil))))))) + (let ((backend-args + (and + flymake--recent-changes + (list :recent-changes + flymake--recent-changes + :changes-start + (cl-reduce + #'min (mapcar #'car flymake--recent-changes)) + :changes-end + (cl-reduce + #'max (mapcar #'cadr flymake--recent-changes)))))) + (setq flymake--recent-changes nil) + (run-hook-wrapped + 'flymake-diagnostic-functions + (lambda (backend) + (cond + ((and (not force) + (flymake--with-backend-state backend state + (flymake--backend-state-disabled state))) + (flymake-log :debug "Backend %s is disabled, not starting" + backend)) + (t + (flymake--run-backend backend backend-args))) + nil)))))))) (defvar flymake-mode-map (let ((map (make-sparse-keymap))) map) @@ -908,6 +952,7 @@ special *Flymake log* buffer." :group 'flymake :lighter (add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t) (setq flymake--backend-state (make-hash-table)) + (setq flymake--recent-changes nil) (when flymake-start-on-flymake-mode (flymake-start t))) @@ -918,7 +963,7 @@ special *Flymake log* buffer." :group 'flymake :lighter (remove-hook 'kill-buffer-hook 'flymake-kill-buffer-hook t) ;;+(remove-hook 'find-file-hook (function flymake-find-file-hook) t) - (flymake-delete-own-overlays) + (flymake--delete-own-overlays) (when flymake-timer (cancel-timer flymake-timer) @@ -960,8 +1005,10 @@ Do it only if `flymake-no-changes-timeout' is non-nil." (make-obsolete 'flymake-mode-off 'flymake-mode "26.1") (defun flymake-after-change-function (start stop _len) - "Start syntax check for current buffer if it isn't already running." + "Start syntax check for current buffer if it isn't already running. +START and STOP and LEN are as in `after-change-functions'." (let((new-text (buffer-substring start stop))) + (push (list start stop new-text) flymake--recent-changes) (when (and flymake-start-syntax-check-on-newline (equal new-text "\n")) (flymake-log :debug "starting syntax check as new-line has been seen") (flymake-start t)) commit 0d3c35807d0b0a3aaa4c4ebd2f040bb78013879d Author: Eli Zaretskii <eliz@gnu.org> Date: Fri Jun 15 11:27:56 2018 +0300 Fix 'replace-buffer-contents' in multibyte buffers * src/editfns.c (buffer_chars_equal): Pass a byte position to BUF_FETCH_CHAR_AS_MULTIBYTE, not a character position. (Bug#31837) * test/src/editfns-tests.el (replace-buffer-contents-bug31837): New test. diff --git a/src/editfns.c b/src/editfns.c index b553a213e6..fc5b6c117f 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -3304,8 +3304,17 @@ buffer_chars_equal (struct context *ctx, eassert (pos_b >= BUF_BEGV (ctx->buffer_b)); eassert (pos_b < BUF_ZV (ctx->buffer_b)); - return BUF_FETCH_CHAR_AS_MULTIBYTE (ctx->buffer_a, pos_a) - == BUF_FETCH_CHAR_AS_MULTIBYTE (ctx->buffer_b, pos_b); + ptrdiff_t bpos_a = + NILP (BVAR (ctx->buffer_a, enable_multibyte_characters)) + ? pos_a + : buf_charpos_to_bytepos (ctx->buffer_a, pos_a); + ptrdiff_t bpos_b = + NILP (BVAR (ctx->buffer_b, enable_multibyte_characters)) + ? pos_b + : buf_charpos_to_bytepos (ctx->buffer_b, pos_b); + + return BUF_FETCH_CHAR_AS_MULTIBYTE (ctx->buffer_a, bpos_a) + == BUF_FETCH_CHAR_AS_MULTIBYTE (ctx->buffer_b, bpos_b); } diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index 714e92e505..ec411ff773 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -247,6 +247,17 @@ (buffer-string) "foo bar baz qux")))))) +(ert-deftest replace-buffer-contents-bug31837 () + (switch-to-buffer "a") + (insert-char (char-from-name "SMILE")) + (insert "1234") + (switch-to-buffer "b") + (insert-char (char-from-name "SMILE")) + (insert "5678") + (replace-buffer-contents "a") + (should (equal (buffer-substring-no-properties (point-min) (point-max)) + (concat (string (char-from-name "SMILE")) "1234")))) + (ert-deftest delete-region-undo-markers-1 () "Make sure we don't end up with freed markers reachable from Lisp." ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=30931#40 commit c79a6275b2f3bc529f9e7e9a65dc56fbd30364d9 Author: Robert Pluim <rpluim@gmail.com> Date: Fri Jun 15 10:24:43 2018 +0200 Update etc/NEWS for mail-source-movemail-program change * etc/NEWS: Describe change in how we search for mail-source-movemail-program. diff --git a/etc/NEWS b/etc/NEWS index 938644215f..92331108e9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -46,6 +46,16 @@ often cause crashes. Set it to nil if you really need those fonts. * Changes in Specialized Modes and Packages in Emacs 26.2 +** Gnus + +--- +*** Mailutils movemail will now be used if found at runtime. +The default value of mail-source-movemail-program is now "movemail". +This ensures that the movemail program from GNU Mailutils will be used +if found in 'exec-path', even if it was not found at build time. To +use a different program, customize mail-source-movemail-program to the +absolute file name of the desired executable. + ** Shell mode --- commit 63f1dc4f7c33cc7cc738dbfae3d8192ae448b2f6 Author: Robert Pluim <rpluim@gmail.com> Date: Fri Jun 15 00:40:53 2018 -0700 Improve movemail default * lisp/gnus/mail-source.el (mail-source-movemail-program): Change default to "movemail". (mail-source-movemail): Pass just mail-source-movemail-program to call-process instead of fully specifying it relative to exec-directory. Ensures that we will find Mailutils movemail if it is installed. (Bug#31737) diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index d2850f4cee..abb5e2d123 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -301,9 +301,9 @@ number." :group 'mail-source :type 'number) -(defcustom mail-source-movemail-program nil +(defcustom mail-source-movemail-program "movemail" "If non-nil, name of program for fetching new mail." - :version "22.1" + :version "26.2" :group 'mail-source :type '(choice (const nil) string)) @@ -682,12 +682,16 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) (setq errors (generate-new-buffer " *mail source loss*")) (let ((default-directory "/")) (setq result + ;; call-process looks in exec-path, which + ;; contains exec-directory, so will find + ;; Mailutils movemail if it exists, else it will + ;; find "our" movemail in exec-directory. + ;; Bug#31737 (apply 'call-process (append (list - (or mail-source-movemail-program - (expand-file-name "movemail" exec-directory)) + mail-source-movemail-program nil errors nil from to))))) (when (file-exists-p to) (set-file-modes to mail-source-default-file-modes)) commit 0b1a2ae84afe840997c1444b1dc56909b542b011 Author: Eli Zaretskii <eliz@gnu.org> Date: Fri Jun 15 10:32:45 2018 +0300 Delete description of deleted Customize functions * doc/lispref/customize.texi (Variable Definitions): Remove the description of 'custom-initialize-safe-set' and 'custom-initialize-safe-default', which were deleted in Emacs 23.2, and replace with the description of 'custom-initialize-delay'. diff --git a/doc/lispref/customize.texi b/doc/lispref/customize.texi index 4d88d7c8c9..02fcd80fa3 100644 --- a/doc/lispref/customize.texi +++ b/doc/lispref/customize.texi @@ -416,20 +416,14 @@ Use the @code{:set} function to initialize the variable, if it is already set or has been customized; otherwise, just use @code{set-default}. -@item custom-initialize-safe-set -@itemx custom-initialize-safe-default -These functions behave like @code{custom-initialize-set} -(@code{custom-initialize-default}, respectively), but catch errors. -If an error occurs during initialization, they set the variable to -@code{nil} using @code{set-default}, and signal no error. - -These functions are meant for options defined in pre-loaded files, -where the @var{standard} expression may signal an error because some -required variable or function is not yet defined. The value normally -gets updated in @file{startup.el}, ignoring the value computed by -@code{defcustom}. After startup, if one unsets the value and -reevaluates the @code{defcustom}, the @var{standard} expression can be -evaluated without error. +@item custom-initialize-delay +This functions behaves like @code{custom-initialize-set}, but it +delays the actual initialization to the next Emacs start. This should +be used in files that are preloaded (or for autoloaded variables), so +that the initialization is done in the run-time context rather than +the build-time context. This also has the side-effect that the +(delayed) initialization is performed with the @code{:set} function. +@xref{Building Emacs}. @end table @item :risky @var{value} commit aeb6b2e31fea5d3fa78e2f8a0895dc86f6b4a7a6 Author: Tino Calancha <tino.calancha@gmail.com> Date: Fri Jun 15 16:21:03 2018 +0900 customize-apropos: Separate package name from its description * lisp/cus-edit.el (custom-group-value-create): Always insert documentation indented from its package name (Bug#31466). diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index a12897e799..ff6a4f6d33 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -4145,7 +4145,7 @@ If GROUPS-ONLY is non-nil, return only those members that are groups." ;; Update buttons. (widget-put widget :buttons buttons) ;; Insert documentation. - (if (and (eq custom-buffer-style 'links) (> level 1)) + (when (eq custom-buffer-style 'links) (widget-put widget :documentation-indent custom-group-doc-align-col)) (widget-add-documentation-string-button commit 4139c98eb5f9003fefe62187e6a60644e38389e9 Author: Paul Eggert <eggert@cs.ucla.edu> Date: Thu Jun 7 19:12:29 2018 -0700 Remove Lisp_Misc_Save_Value This type and its associated routines are no longer used. * src/alloc.c (voidfuncptr): Move here from src/lisp.h. (free_misc, make_save_int_int_int) (make_save_obj_obj_obj_obj, make_save_ptr) (make_save_ptr_int, make_save_ptr_ptr) (make_save_funcptr_ptr_obj, make_save_memory) (free_save_value, mark_save_value): Remove. (mark_object): Remove mention of Lisp_Misc_Save_Value. * src/lisp.h (Lisp_Misc_Save_Value, SAVE_SLOT_BITS) (SAVE_VALUE_SLOTS, SAVE_TYPE_BITS, enum Lisp_Save_Type) (struct Lisp_Save_Value, SAVE_VALUEP, XSAVE_VALUE) (save_type, XSAVE_POINTER, set_save_pointer) (XSAVE_FUNCPOINTER, XSAVE_INTEGER, set_save_integer) (XSAVE_OBJECT): Remove. (union Lisp_Misc): Remove u_save_value. (voidfuncptr): Move from here to src/alloc.c. * src/print.c (print_object): Remove support for printing Lisp_Misc_Save_Value. diff --git a/src/alloc.c b/src/alloc.c index 6b57c83cc2..7b2140501e 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -172,6 +172,7 @@ malloc_initialize_hook (void) /* Declare the malloc initialization hook, which runs before 'main' starts. EXTERNALLY_VISIBLE works around Bug#22522. */ +typedef void (*voidfuncptr) (void); # ifndef __MALLOC_HOOK_VOLATILE # define __MALLOC_HOOK_VOLATILE # endif @@ -3710,123 +3711,6 @@ allocate_misc (enum Lisp_Misc_Type type) return val; } -/* Free a Lisp_Misc object. */ - -void -free_misc (Lisp_Object misc) -{ - XMISCANY (misc)->type = Lisp_Misc_Free; - XMISC (misc)->u_free.chain = misc_free_list; - misc_free_list = XMISC (misc); - consing_since_gc -= sizeof (union Lisp_Misc); - total_free_markers++; -} - -/* Verify properties of Lisp_Save_Value's representation - that are assumed here and elsewhere. */ - -verify (SAVE_UNUSED == 0); -verify (((SAVE_INTEGER | SAVE_POINTER | SAVE_FUNCPOINTER | SAVE_OBJECT) - >> SAVE_SLOT_BITS) - == 0); - -/* Return Lisp_Save_Value objects for the various combinations - that callers need. */ - -Lisp_Object -make_save_int_int_int (ptrdiff_t a, ptrdiff_t b, ptrdiff_t c) -{ - Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); - struct Lisp_Save_Value *p = XSAVE_VALUE (val); - p->save_type = SAVE_TYPE_INT_INT_INT; - p->data[0].integer = a; - p->data[1].integer = b; - p->data[2].integer = c; - return val; -} - -Lisp_Object -make_save_obj_obj_obj_obj (Lisp_Object a, Lisp_Object b, Lisp_Object c, - Lisp_Object d) -{ - Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); - struct Lisp_Save_Value *p = XSAVE_VALUE (val); - p->save_type = SAVE_TYPE_OBJ_OBJ_OBJ_OBJ; - p->data[0].object = a; - p->data[1].object = b; - p->data[2].object = c; - p->data[3].object = d; - return val; -} - -Lisp_Object -make_save_ptr (void *a) -{ - Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); - struct Lisp_Save_Value *p = XSAVE_VALUE (val); - p->save_type = SAVE_POINTER; - p->data[0].pointer = a; - return val; -} - -Lisp_Object -make_save_ptr_int (void *a, ptrdiff_t b) -{ - Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); - struct Lisp_Save_Value *p = XSAVE_VALUE (val); - p->save_type = SAVE_TYPE_PTR_INT; - p->data[0].pointer = a; - p->data[1].integer = b; - return val; -} - -Lisp_Object -make_save_ptr_ptr (void *a, void *b) -{ - Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); - struct Lisp_Save_Value *p = XSAVE_VALUE (val); - p->save_type = SAVE_TYPE_PTR_PTR; - p->data[0].pointer = a; - p->data[1].pointer = b; - return val; -} - -Lisp_Object -make_save_funcptr_ptr_obj (void (*a) (void), void *b, Lisp_Object c) -{ - Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); - struct Lisp_Save_Value *p = XSAVE_VALUE (val); - p->save_type = SAVE_TYPE_FUNCPTR_PTR_OBJ; - p->data[0].funcpointer = a; - p->data[1].pointer = b; - p->data[2].object = c; - return val; -} - -/* Return a Lisp_Save_Value object that represents an array A - of N Lisp objects. */ - -Lisp_Object -make_save_memory (Lisp_Object *a, ptrdiff_t n) -{ - Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); - struct Lisp_Save_Value *p = XSAVE_VALUE (val); - p->save_type = SAVE_TYPE_MEMORY; - p->data[0].pointer = a; - p->data[1].integer = n; - return val; -} - -/* Free a Lisp_Save_Value object. Do not use this function - if SAVE contains pointer other than returned by xmalloc. */ - -void -free_save_value (Lisp_Object save) -{ - xfree (XSAVE_POINTER (save, 0)); - free_misc (save); -} - Lisp_Object make_misc_ptr (void *a) { @@ -5281,10 +5165,8 @@ valid_pointer_p (void *p) /* Return 2 if OBJ is a killed or special buffer object, 1 if OBJ is a valid lisp object, 0 if OBJ is NOT a valid lisp object, or -1 if we - cannot validate OBJ. This function can be quite slow, so its primary - use is the manual debugging. The only exception is print_object, where - we use it to check whether the memory referenced by the pointer of - Lisp_Save_Value object contains valid objects. */ + cannot validate OBJ. This function can be quite slow, and is used + only in debugging. */ int valid_lisp_object_p (Lisp_Object obj) @@ -6363,30 +6245,6 @@ mark_localized_symbol (struct Lisp_Symbol *ptr) mark_object (blv->defcell); } -NO_INLINE /* To reduce stack depth in mark_object. */ -static void -mark_save_value (struct Lisp_Save_Value *ptr) -{ - /* If `save_type' is zero, `data[0].pointer' is the address - of a memory area containing `data[1].integer' potential - Lisp_Objects. */ - if (ptr->save_type == SAVE_TYPE_MEMORY) - { - Lisp_Object *p = ptr->data[0].pointer; - ptrdiff_t nelt; - for (nelt = ptr->data[1].integer; nelt > 0; nelt--, p++) - mark_maybe_object (*p); - } - else - { - /* Find Lisp_Objects in `data[N]' slots and mark them. */ - int i; - for (i = 0; i < SAVE_VALUE_SLOTS; i++) - if (save_type (ptr, i) == SAVE_OBJECT) - mark_object (ptr->data[i].object); - } -} - /* Remove killed buffers or items whose car is a killed buffer from LIST, and mark other items. Return changed LIST, which is marked. */ @@ -6695,11 +6553,6 @@ mark_object (Lisp_Object arg) XMISCANY (obj)->gcmarkbit = 1; break; - case Lisp_Misc_Save_Value: - XMISCANY (obj)->gcmarkbit = 1; - mark_save_value (XSAVE_VALUE (obj)); - break; - case Lisp_Misc_Ptr: XMISCANY (obj)->gcmarkbit = true; break; diff --git a/src/lisp.h b/src/lisp.h index 12f326f6a6..ff708ebf60 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -511,7 +511,6 @@ enum Lisp_Misc_Type Lisp_Misc_Free = 0x5eab, Lisp_Misc_Marker, Lisp_Misc_Overlay, - Lisp_Misc_Save_Value, Lisp_Misc_Finalizer, Lisp_Misc_Ptr, #ifdef HAVE_MODULES @@ -560,9 +559,8 @@ enum Lisp_Fwd_Type members that are accessible only from C. A Lisp_Misc object is a wrapper for a C struct that can contain anything you like. - Explicit freeing is discouraged for Lisp objects in general. But if - you really need to exploit this, use Lisp_Misc (check free_misc in - alloc.c to see why). There is no way to free a vectorlike object. + There is no way to explicitly free a Lisp Object; only the garbage + collector frees them. To add a new pseudovector type, extend the pvec_type enumeration; to add a new Lisp_Misc, extend the Lisp_Misc_Type enumeration. @@ -2362,140 +2360,6 @@ struct Lisp_Overlay Lisp_Object plist; }; -/* Number of bits needed to store one of the values - SAVE_UNUSED..SAVE_OBJECT. */ -enum { SAVE_SLOT_BITS = 3 }; - -/* Number of slots in a save value where save_type is nonzero. */ -enum { SAVE_VALUE_SLOTS = 4 }; - -/* Bit-width and values for struct Lisp_Save_Value's save_type member. */ - -enum { SAVE_TYPE_BITS = SAVE_VALUE_SLOTS * SAVE_SLOT_BITS + 1 }; - -/* Types of data which may be saved in a Lisp_Save_Value. */ - -enum Lisp_Save_Type - { - SAVE_UNUSED, - SAVE_INTEGER, - SAVE_FUNCPOINTER, - SAVE_POINTER, - SAVE_OBJECT, - SAVE_TYPE_INT_INT = SAVE_INTEGER + (SAVE_INTEGER << SAVE_SLOT_BITS), - SAVE_TYPE_INT_INT_INT - = (SAVE_INTEGER + (SAVE_TYPE_INT_INT << SAVE_SLOT_BITS)), - SAVE_TYPE_OBJ_OBJ = SAVE_OBJECT + (SAVE_OBJECT << SAVE_SLOT_BITS), - SAVE_TYPE_OBJ_OBJ_OBJ = SAVE_OBJECT + (SAVE_TYPE_OBJ_OBJ << SAVE_SLOT_BITS), - SAVE_TYPE_OBJ_OBJ_OBJ_OBJ - = SAVE_OBJECT + (SAVE_TYPE_OBJ_OBJ_OBJ << SAVE_SLOT_BITS), - SAVE_TYPE_PTR_INT = SAVE_POINTER + (SAVE_INTEGER << SAVE_SLOT_BITS), - SAVE_TYPE_PTR_OBJ = SAVE_POINTER + (SAVE_OBJECT << SAVE_SLOT_BITS), - SAVE_TYPE_PTR_PTR = SAVE_POINTER + (SAVE_POINTER << SAVE_SLOT_BITS), - SAVE_TYPE_FUNCPTR_PTR_OBJ - = SAVE_FUNCPOINTER + (SAVE_TYPE_PTR_OBJ << SAVE_SLOT_BITS), - - /* This has an extra bit indicating it's raw memory. */ - SAVE_TYPE_MEMORY = SAVE_TYPE_PTR_INT + (1 << (SAVE_TYPE_BITS - 1)) - }; - -/* SAVE_SLOT_BITS must be large enough to represent these values. */ -verify (((SAVE_UNUSED | SAVE_INTEGER | SAVE_FUNCPOINTER - | SAVE_POINTER | SAVE_OBJECT) - >> SAVE_SLOT_BITS) - == 0); - -/* Special object used to hold a different values for later use. - - This is mostly used to package C integers and pointers to call - record_unwind_protect when two or more values need to be saved. - For example: - - ... - struct my_data *md = get_my_data (); - ptrdiff_t mi = get_my_integer (); - record_unwind_protect (my_unwind, make_save_ptr_int (md, mi)); - ... - - Lisp_Object my_unwind (Lisp_Object arg) - { - struct my_data *md = XSAVE_POINTER (arg, 0); - ptrdiff_t mi = XSAVE_INTEGER (arg, 1); - ... - } - - If ENABLE_CHECKING is in effect, XSAVE_xxx macros do type checking of the - saved objects and raise eassert if type of the saved object doesn't match - the type which is extracted. In the example above, XSAVE_INTEGER (arg, 2) - and XSAVE_OBJECT (arg, 0) are wrong because nothing was saved in slot 2 and - slot 0 is a pointer. */ - -typedef void (*voidfuncptr) (void); - -struct Lisp_Save_Value - { - ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Save_Value */ - bool_bf gcmarkbit : 1; - unsigned spacer : 32 - (16 + 1 + SAVE_TYPE_BITS); - - /* V->data may hold up to SAVE_VALUE_SLOTS entries. The type of - V's data entries are determined by V->save_type. E.g., if - V->save_type == SAVE_TYPE_PTR_OBJ, V->data[0] is a pointer, - V->data[1] is an integer, and V's other data entries are unused. - - If V->save_type == SAVE_TYPE_MEMORY, V->data[0].pointer is the address of - a memory area containing V->data[1].integer potential Lisp_Objects. */ - ENUM_BF (Lisp_Save_Type) save_type : SAVE_TYPE_BITS; - union { - void *pointer; - voidfuncptr funcpointer; - ptrdiff_t integer; - Lisp_Object object; - } data[SAVE_VALUE_SLOTS]; - }; - -INLINE bool -SAVE_VALUEP (Lisp_Object x) -{ - return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value; -} - -INLINE struct Lisp_Save_Value * -XSAVE_VALUE (Lisp_Object a) -{ - eassert (SAVE_VALUEP (a)); - return XUNTAG (a, Lisp_Misc, struct Lisp_Save_Value); -} - -/* Return the type of V's Nth saved value. */ -INLINE int -save_type (struct Lisp_Save_Value *v, int n) -{ - eassert (0 <= n && n < SAVE_VALUE_SLOTS); - return (v->save_type >> (SAVE_SLOT_BITS * n) & ((1 << SAVE_SLOT_BITS) - 1)); -} - -/* Get and set the Nth saved pointer. */ - -INLINE void * -XSAVE_POINTER (Lisp_Object obj, int n) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER); - return XSAVE_VALUE (obj)->data[n].pointer; -} -INLINE void -set_save_pointer (Lisp_Object obj, int n, void *val) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER); - XSAVE_VALUE (obj)->data[n].pointer = val; -} -INLINE voidfuncptr -XSAVE_FUNCPOINTER (Lisp_Object obj, int n) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_FUNCPOINTER); - return XSAVE_VALUE (obj)->data[n].funcpointer; -} - struct Lisp_Misc_Ptr { ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Ptr */ @@ -2543,30 +2407,6 @@ xmint_pointer (Lisp_Object a) return XUNTAG (a, Lisp_Misc, struct Lisp_Misc_Ptr)->pointer; } -/* Get and set the Nth saved integer. */ - -INLINE ptrdiff_t -XSAVE_INTEGER (Lisp_Object obj, int n) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER); - return XSAVE_VALUE (obj)->data[n].integer; -} -INLINE void -set_save_integer (Lisp_Object obj, int n, ptrdiff_t val) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER); - XSAVE_VALUE (obj)->data[n].integer = val; -} - -/* Extract Nth saved object. */ - -INLINE Lisp_Object -XSAVE_OBJECT (Lisp_Object obj, int n) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_OBJECT); - return XSAVE_VALUE (obj)->data[n].object; -} - #ifdef HAVE_MODULES struct Lisp_User_Ptr { @@ -2625,7 +2465,6 @@ union Lisp_Misc struct Lisp_Free u_free; struct Lisp_Marker u_marker; struct Lisp_Overlay u_overlay; - struct Lisp_Save_Value u_save_value; struct Lisp_Finalizer u_finalizer; struct Lisp_Misc_Ptr u_misc_ptr; #ifdef HAVE_MODULES @@ -3708,7 +3547,6 @@ extern void parse_str_as_multibyte (const unsigned char *, ptrdiff_t, /* Defined in alloc.c. */ extern void *my_heap_start (void); extern void check_pure_size (void); -extern void free_misc (Lisp_Object); extern void allocate_string_data (struct Lisp_String *, EMACS_INT, EMACS_INT); extern void malloc_warning (const char *); extern _Noreturn void memory_full (size_t); @@ -3862,16 +3700,6 @@ extern bool gc_in_progress; extern Lisp_Object make_float (double); extern void display_malloc_warning (void); extern ptrdiff_t inhibit_garbage_collection (void); -extern Lisp_Object make_save_int_int_int (ptrdiff_t, ptrdiff_t, ptrdiff_t); -extern Lisp_Object make_save_obj_obj_obj_obj (Lisp_Object, Lisp_Object, - Lisp_Object, Lisp_Object); -extern Lisp_Object make_save_ptr (void *); -extern Lisp_Object make_save_ptr_int (void *, ptrdiff_t); -extern Lisp_Object make_save_ptr_ptr (void *, void *); -extern Lisp_Object make_save_funcptr_ptr_obj (void (*) (void), void *, - Lisp_Object); -extern Lisp_Object make_save_memory (Lisp_Object *, ptrdiff_t); -extern void free_save_value (Lisp_Object); extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object); extern void free_cons (struct Lisp_Cons *); extern void init_alloc_once (void); diff --git a/src/print.c b/src/print.c index 741d1cc5fd..71591952a2 100644 --- a/src/print.c +++ b/src/print.c @@ -2185,89 +2185,6 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) } break; - case Lisp_Misc_Save_Value: - { - int i; - struct Lisp_Save_Value *v = XSAVE_VALUE (obj); - - print_c_string ("#<save-value ", printcharfun); - - if (v->save_type == SAVE_TYPE_MEMORY) - { - ptrdiff_t amount = v->data[1].integer; - - /* valid_lisp_object_p is reliable, so try to print up - to 8 saved objects. This code is rarely used, so - it's OK that valid_lisp_object_p is slow. */ - - int limit = min (amount, 8); - Lisp_Object *area = v->data[0].pointer; - - i = sprintf (buf, "with %"pD"d objects", amount); - strout (buf, i, i, printcharfun); - - for (i = 0; i < limit; i++) - { - Lisp_Object maybe = area[i]; - int valid = valid_lisp_object_p (maybe); - - printchar (' ', printcharfun); - if (0 < valid) - print_object (maybe, printcharfun, escapeflag); - else - print_c_string (valid < 0 ? "<some>" : "<invalid>", - printcharfun); - } - if (i == limit && i < amount) - print_c_string (" ...", printcharfun); - } - else - { - /* Print each slot according to its type. */ - int index; - for (index = 0; index < SAVE_VALUE_SLOTS; index++) - { - if (index) - printchar (' ', printcharfun); - - switch (save_type (v, index)) - { - case SAVE_UNUSED: - i = sprintf (buf, "<unused>"); - break; - - case SAVE_POINTER: - i = sprintf (buf, "<pointer %p>", - v->data[index].pointer); - break; - - case SAVE_FUNCPOINTER: - i = sprintf (buf, "<funcpointer %p>", - ((void *) (intptr_t) - v->data[index].funcpointer)); - break; - - case SAVE_INTEGER: - i = sprintf (buf, "<integer %"pD"d>", - v->data[index].integer); - break; - - case SAVE_OBJECT: - print_object (v->data[index].object, printcharfun, - escapeflag); - continue; - - default: - emacs_abort (); - } - - strout (buf, i, i, printcharfun); - } - } - printchar ('>', printcharfun); - } - break; - default: goto badtype; } commit f8ad6b311bf142defe4c203b64713c5a5051c4a7 Author: Paul Eggert <eggert@cs.ucla.edu> Date: Thu Jun 7 19:12:28 2018 -0700 New type Lisp_Misc_Ptr This is a streamlined version of Lisp_Save_Value, which contains just a pointer, as that is all Lisp_Save_Values are used for any more. With the previous changes, these objects are not primarily used as save values, so just call them "Misc" rather than "Save". * src/alloc.c (make_misc_ptr): New function. (mark_object): Mark Lisp_Misc_Ptr too. * src/lisp.h (Lisp_Misc_Ptr): New constant. (struct Lisp_Misc_Ptr): New type. (make_mint_ptr, mint_ptrp, xmint_pointer): Use Lisp_Misc_Ptr, not Lisp_Save_Value. (union Lisp_Misc): Add Lisp_Misc_Ptr. * src/print.c (print_object): Print Lisp_Misc_Ptr. diff --git a/src/alloc.c b/src/alloc.c index 1d3ec4fbb8..6b57c83cc2 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3827,6 +3827,14 @@ free_save_value (Lisp_Object save) free_misc (save); } +Lisp_Object +make_misc_ptr (void *a) +{ + Lisp_Object val = allocate_misc (Lisp_Misc_Ptr); + XUNTAG (val, Lisp_Misc, struct Lisp_Misc_Ptr)->pointer = a; + return val; +} + /* Return a Lisp_Misc_Overlay object with specified START, END and PLIST. */ Lisp_Object @@ -6692,6 +6700,10 @@ mark_object (Lisp_Object arg) mark_save_value (XSAVE_VALUE (obj)); break; + case Lisp_Misc_Ptr: + XMISCANY (obj)->gcmarkbit = true; + break; + case Lisp_Misc_Overlay: mark_overlay (XOVERLAY (obj)); break; diff --git a/src/font.h b/src/font.h index 6ec32def4b..e84c6f3ff8 100644 --- a/src/font.h +++ b/src/font.h @@ -613,7 +613,7 @@ struct font_driver (symbols). */ Lisp_Object (*list_family) (struct frame *f); - /* Optional (if FONT_EXTRA_INDEX is not Lisp_Save_Value). + /* Optional. Free FONT_EXTRA_INDEX field of FONT_ENTITY. */ void (*free_entity) (Lisp_Object font_entity); diff --git a/src/lisp.h b/src/lisp.h index f02b50bad7..12f326f6a6 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -513,6 +513,7 @@ enum Lisp_Misc_Type Lisp_Misc_Overlay, Lisp_Misc_Save_Value, Lisp_Misc_Finalizer, + Lisp_Misc_Ptr, #ifdef HAVE_MODULES Lisp_Misc_User_Ptr, #endif @@ -539,10 +540,11 @@ enum Lisp_Fwd_Type First, there are already a couple of Lisp types that can be used if your new type does not need to be exposed to Lisp programs nor - displayed to users. These are Lisp_Save_Value, a Lisp_Misc + displayed to users. These are Lisp_Misc_Ptr, a Lisp_Misc subtype; and PVEC_OTHER, a kind of vectorlike object. The former - is suitable for temporarily stashing away pointers and integers in - a Lisp object. The latter is useful for vector-like Lisp objects + is suitable for stashing a pointer in a Lisp object; the pointer + might be to some low-level C object that contains auxiliary + information. The latter is useful for vector-like Lisp objects that need to be used as part of other objects, but which are never shown to users or Lisp code (search for PVEC_OTHER in xterm.c for an example). @@ -2494,14 +2496,22 @@ XSAVE_FUNCPOINTER (Lisp_Object obj, int n) return XSAVE_VALUE (obj)->data[n].funcpointer; } -extern Lisp_Object make_save_ptr (void *); +struct Lisp_Misc_Ptr + { + ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Ptr */ + bool_bf gcmarkbit : 1; + unsigned spacer : 15; + void *pointer; + }; + +extern Lisp_Object make_misc_ptr (void *); /* A mint_ptr object OBJ represents a C-language pointer P efficiently. Preferably (and typically), OBJ is a Lisp integer I such that XINTPTR (I) == P, as this represents P within a single Lisp value without requiring any auxiliary memory. However, if P would be damaged by being tagged as an integer and then untagged via - XINTPTR, then OBJ is a Lisp_Save_Value with pointer component P. + XINTPTR, then OBJ is a Lisp_Misc_Ptr with pointer component P. mint_ptr objects are efficiency hacks intended for C code. Although xmint_ptr can be given any mint_ptr generated by non-buggy @@ -2515,14 +2525,13 @@ INLINE Lisp_Object make_mint_ptr (void *a) { Lisp_Object val = TAG_PTR (Lisp_Int0, a); - return INTEGERP (val) && XINTPTR (val) == a ? val : make_save_ptr (a); + return INTEGERP (val) && XINTPTR (val) == a ? val : make_misc_ptr (a); } INLINE bool mint_ptrp (Lisp_Object x) { - return (INTEGERP (x) - || (SAVE_VALUEP (x) && XSAVE_VALUE (x)->save_type == SAVE_POINTER)); + return INTEGERP (x) || (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Ptr); } INLINE void * @@ -2531,7 +2540,7 @@ xmint_pointer (Lisp_Object a) eassert (mint_ptrp (a)); if (INTEGERP (a)) return XINTPTR (a); - return XSAVE_POINTER (a, 0); + return XUNTAG (a, Lisp_Misc, struct Lisp_Misc_Ptr)->pointer; } /* Get and set the Nth saved integer. */ @@ -2618,6 +2627,7 @@ union Lisp_Misc struct Lisp_Overlay u_overlay; struct Lisp_Save_Value u_save_value; struct Lisp_Finalizer u_finalizer; + struct Lisp_Misc_Ptr u_misc_ptr; #ifdef HAVE_MODULES struct Lisp_User_Ptr u_user_ptr; #endif @@ -3855,6 +3865,7 @@ extern ptrdiff_t inhibit_garbage_collection (void); extern Lisp_Object make_save_int_int_int (ptrdiff_t, ptrdiff_t, ptrdiff_t); extern Lisp_Object make_save_obj_obj_obj_obj (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); +extern Lisp_Object make_save_ptr (void *); extern Lisp_Object make_save_ptr_int (void *, ptrdiff_t); extern Lisp_Object make_save_ptr_ptr (void *, void *); extern Lisp_Object make_save_funcptr_ptr_obj (void (*) (void), void *, diff --git a/src/print.c b/src/print.c index 234f44a4a5..741d1cc5fd 100644 --- a/src/print.c +++ b/src/print.c @@ -2178,6 +2178,13 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) print_c_string ("#<misc free cell>", printcharfun); break; + case Lisp_Misc_Ptr: + { + int i = sprintf (buf, "#<ptr %p>", xmint_pointer (obj)); + strout (buf, i, i, printcharfun); + } + break; + case Lisp_Misc_Save_Value: { int i; diff --git a/src/w32font.c b/src/w32font.c index 9cbc3ee14b..65409b92d2 100644 --- a/src/w32font.c +++ b/src/w32font.c @@ -718,7 +718,7 @@ w32font_draw (struct glyph_string *s, int from, int to, } /* w32 implementation of free_entity for font backend. - Optional (if FONT_EXTRA_INDEX is not Lisp_Save_Value). + Optional. Free FONT_EXTRA_INDEX field of FONT_ENTITY. static void w32font_free_entity (Lisp_Object entity); commit d98670eb04925fdc4a4928a9b0d0858881da418f Author: Paul Eggert <eggert@cs.ucla.edu> Date: Thu Jun 7 19:12:28 2018 -0700 Avoid allocating Lisp_Save_Value for arrays * src/alloc.c (mark_maybe_objects): New function. * src/eval.c (default_toplevel_binding) (backtrace_eval_unrewind, Fbacktrace__locals): Treat array unwindings like other miscellaneous pdl types. (record_unwind_protect_array): New function. (do_one_unbind): Free the array while unwinding. (mark_specpdl): Mark arrays directly. * src/lisp.h (SPECPDL_UNWIND_ARRAY): New constant. (union specbinding): New member unwind_array. (SAFE_ALLOCA_LISP_EXTRA): Use record_unwind_protect_array instead of make_save_memory + record_unwind_protect. diff --git a/src/alloc.c b/src/alloc.c index e5fc6ebeb1..1d3ec4fbb8 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -4845,6 +4845,13 @@ mark_maybe_object (Lisp_Object obj) } } +void +mark_maybe_objects (Lisp_Object *array, ptrdiff_t nelts) +{ + for (Lisp_Object *lim = array + nelts; array < lim; array++) + mark_maybe_object (*array); +} + /* Return true if P might point to Lisp data that can be garbage collected, and false otherwise (i.e., false if it is easy to see that P cannot point to Lisp data that can be garbage collected). diff --git a/src/eval.c b/src/eval.c index dded16bed5..952a0ec4b4 100644 --- a/src/eval.c +++ b/src/eval.c @@ -673,6 +673,7 @@ default_toplevel_binding (Lisp_Object symbol) break; case SPECPDL_UNWIND: + case SPECPDL_UNWIND_ARRAY: case SPECPDL_UNWIND_PTR: case SPECPDL_UNWIND_INT: case SPECPDL_UNWIND_EXCURSION: @@ -3407,6 +3408,15 @@ record_unwind_protect (void (*function) (Lisp_Object), Lisp_Object arg) grow_specpdl (); } +void +record_unwind_protect_array (Lisp_Object *array, ptrdiff_t nelts) +{ + specpdl_ptr->unwind_array.kind = SPECPDL_UNWIND_ARRAY; + specpdl_ptr->unwind_array.array = array; + specpdl_ptr->unwind_array.nelts = nelts; + grow_specpdl (); +} + void record_unwind_protect_ptr (void (*function) (void *), void *arg) { @@ -3469,6 +3479,9 @@ do_one_unbind (union specbinding *this_binding, bool unwinding, case SPECPDL_UNWIND: this_binding->unwind.func (this_binding->unwind.arg); break; + case SPECPDL_UNWIND_ARRAY: + xfree (this_binding->unwind_array.array); + break; case SPECPDL_UNWIND_PTR: this_binding->unwind_ptr.func (this_binding->unwind_ptr.arg); break; @@ -3771,6 +3784,7 @@ backtrace_eval_unrewind (int distance) save_excursion_restore (marker, window); } break; + case SPECPDL_UNWIND_ARRAY: case SPECPDL_UNWIND_PTR: case SPECPDL_UNWIND_INT: case SPECPDL_UNWIND_VOID: @@ -3903,6 +3917,7 @@ NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'. break; case SPECPDL_UNWIND: + case SPECPDL_UNWIND_ARRAY: case SPECPDL_UNWIND_PTR: case SPECPDL_UNWIND_INT: case SPECPDL_UNWIND_EXCURSION: @@ -3935,6 +3950,10 @@ mark_specpdl (union specbinding *first, union specbinding *ptr) mark_object (specpdl_arg (pdl)); break; + case SPECPDL_UNWIND_ARRAY: + mark_maybe_objects (pdl->unwind_array.array, pdl->unwind_array.nelts); + break; + case SPECPDL_UNWIND_EXCURSION: mark_object (pdl->unwind_excursion.marker); mark_object (pdl->unwind_excursion.window); diff --git a/src/lisp.h b/src/lisp.h index af3f587222..f02b50bad7 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3186,6 +3186,8 @@ extern void defvar_kboard (struct Lisp_Kboard_Objfwd *, const char *, int); enum specbind_tag { SPECPDL_UNWIND, /* An unwind_protect function on Lisp_Object. */ + SPECPDL_UNWIND_ARRAY, /* Likewise, on an array that needs freeing. + Its elements are potential Lisp_Objects. */ SPECPDL_UNWIND_PTR, /* Likewise, on void *. */ SPECPDL_UNWIND_INT, /* Likewise, on int. */ SPECPDL_UNWIND_EXCURSION, /* Likewise, on an execursion. */ @@ -3205,6 +3207,12 @@ union specbinding void (*func) (Lisp_Object); Lisp_Object arg; } unwind; + struct { + ENUM_BF (specbind_tag) kind : CHAR_BIT; + void (*func) (Lisp_Object); + Lisp_Object *array; + ptrdiff_t nelts; + } unwind_array; struct { ENUM_BF (specbind_tag) kind : CHAR_BIT; void (*func) (void *); @@ -3702,6 +3710,7 @@ extern void refill_memory_reserve (void); #endif extern void alloc_unexec_pre (void); extern void alloc_unexec_post (void); +extern void mark_maybe_objects (Lisp_Object *, ptrdiff_t); extern void mark_stack (char *, char *); extern void flush_stack_call_func (void (*func) (void *arg), void *arg); extern const char *pending_malloc_warning; @@ -4016,6 +4025,7 @@ extern struct handler *push_handler (Lisp_Object, enum handlertype); extern struct handler *push_handler_nosignal (Lisp_Object, enum handlertype); extern void specbind (Lisp_Object, Lisp_Object); extern void record_unwind_protect (void (*) (Lisp_Object), Lisp_Object); +extern void record_unwind_protect_array (Lisp_Object *, ptrdiff_t); extern void record_unwind_protect_ptr (void (*) (void *), void *); extern void record_unwind_protect_int (void (*) (int), int); extern void record_unwind_protect_void (void (*) (void)); @@ -4710,11 +4720,9 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1)); (buf) = AVAIL_ALLOCA (alloca_nbytes); \ else \ { \ - Lisp_Object arg_; \ (buf) = xmalloc (alloca_nbytes); \ - arg_ = make_save_memory (buf, nelt); \ + record_unwind_protect_array (buf, nelt); \ sa_must_free = true; \ - record_unwind_protect (free_save_value, arg_); \ } \ } while (false) commit aca938d1f4ec176a2d00a77693b231298b9c5c4e Author: Paul Eggert <eggert@cs.ucla.edu> Date: Thu Jun 14 15:59:09 2018 -0700 Avoid allocating Lisp_Save_Value for excursions * src/editfns.c (save_excursion_save): New arg PDL, specifying where to save the state. All uses changed. (save_excursion_restore): Args are now the marker and info rather than a pointer to a Lisp_Save_Value containing them. All uses changed. * src/eval.c (default_toplevel_binding, Fbacktrace__locals): Treat excursions like other miscellaneous pdl types. (record_unwind_protect_excursion): Save data directly into the pdl rather than creating an object on the heap. This avoids the need to allocate and free an object. (do_one_unbind, backtrace_eval_unrewind): Unwind excursions directly. (mark_specpdl): Mark excursions directly. * src/lisp.h (SPECPDL_UNWIND_EXCURSION): New constant. (union specbinding): New member unwind_excursion. diff --git a/src/editfns.c b/src/editfns.c index e672c0eb74..3147f9d146 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -995,30 +995,24 @@ This function does not move point. */) Qnil, Qt, Qnil); } -/* Save current buffer state for `save-excursion' special form. - We (ab)use Lisp_Misc_Save_Value to allow explicit free and so - offload some work from GC. */ +/* Save current buffer state for save-excursion special form. */ -Lisp_Object -save_excursion_save (void) +void +save_excursion_save (union specbinding *pdl) { - return make_save_obj_obj_obj_obj - (Fpoint_marker (), - Qnil, - /* Selected window if current buffer is shown in it, nil otherwise. */ - (EQ (XWINDOW (selected_window)->contents, Fcurrent_buffer ()) - ? selected_window : Qnil), - Qnil); + eassert (pdl->unwind_excursion.kind == SPECPDL_UNWIND_EXCURSION); + pdl->unwind_excursion.marker = Fpoint_marker (); + /* Selected window if current buffer is shown in it, nil otherwise. */ + pdl->unwind_excursion.window + = (EQ (XWINDOW (selected_window)->contents, Fcurrent_buffer ()) + ? selected_window : Qnil); } /* Restore saved buffer before leaving `save-excursion' special form. */ void -save_excursion_restore (Lisp_Object info) +save_excursion_restore (Lisp_Object marker, Lisp_Object window) { - Lisp_Object marker = XSAVE_OBJECT (info, 0); - Lisp_Object window = XSAVE_OBJECT (info, 2); - free_misc (info); Lisp_Object buffer = Fmarker_buffer (marker); /* If we're unwinding to top level, saved buffer may be deleted. This means that all of its markers are unchained and so BUFFER is nil. */ @@ -1027,6 +1021,7 @@ save_excursion_restore (Lisp_Object info) Fset_buffer (buffer); + /* Point marker. */ Fgoto_char (marker); unchain_marker (XMARKER (marker)); diff --git a/src/eval.c b/src/eval.c index 5c7cb3196a..dded16bed5 100644 --- a/src/eval.c +++ b/src/eval.c @@ -675,6 +675,7 @@ default_toplevel_binding (Lisp_Object symbol) case SPECPDL_UNWIND: case SPECPDL_UNWIND_PTR: case SPECPDL_UNWIND_INT: + case SPECPDL_UNWIND_EXCURSION: case SPECPDL_UNWIND_VOID: case SPECPDL_BACKTRACE: case SPECPDL_LET_LOCAL: @@ -3427,7 +3428,9 @@ record_unwind_protect_int (void (*function) (int), int arg) void record_unwind_protect_excursion (void) { - record_unwind_protect (save_excursion_restore, save_excursion_save ()); + specpdl_ptr->unwind_excursion.kind = SPECPDL_UNWIND_EXCURSION; + save_excursion_save (specpdl_ptr); + grow_specpdl (); } void @@ -3475,6 +3478,10 @@ do_one_unbind (union specbinding *this_binding, bool unwinding, case SPECPDL_UNWIND_VOID: this_binding->unwind_void.func (); break; + case SPECPDL_UNWIND_EXCURSION: + save_excursion_restore (this_binding->unwind_excursion.marker, + this_binding->unwind_excursion.window); + break; case SPECPDL_BACKTRACE: break; case SPECPDL_LET: @@ -3749,18 +3756,21 @@ backtrace_eval_unrewind (int distance) unwind_protect, but the problem is that we don't know how to rewind them afterwards. */ case SPECPDL_UNWIND: - { - Lisp_Object oldarg = tmp->unwind.arg; - if (tmp->unwind.func == set_buffer_if_live) + if (tmp->unwind.func == set_buffer_if_live) + { + Lisp_Object oldarg = tmp->unwind.arg; tmp->unwind.arg = Fcurrent_buffer (); - else if (tmp->unwind.func == save_excursion_restore) - tmp->unwind.arg = save_excursion_save (); - else - break; - tmp->unwind.func (oldarg); - break; + set_buffer_if_live (oldarg); + } + break; + case SPECPDL_UNWIND_EXCURSION: + { + Lisp_Object marker = tmp->unwind_excursion.marker; + Lisp_Object window = tmp->unwind_excursion.window; + save_excursion_save (tmp); + save_excursion_restore (marker, window); } - + break; case SPECPDL_UNWIND_PTR: case SPECPDL_UNWIND_INT: case SPECPDL_UNWIND_VOID: @@ -3895,6 +3905,7 @@ NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'. case SPECPDL_UNWIND: case SPECPDL_UNWIND_PTR: case SPECPDL_UNWIND_INT: + case SPECPDL_UNWIND_EXCURSION: case SPECPDL_UNWIND_VOID: case SPECPDL_BACKTRACE: break; @@ -3924,6 +3935,11 @@ mark_specpdl (union specbinding *first, union specbinding *ptr) mark_object (specpdl_arg (pdl)); break; + case SPECPDL_UNWIND_EXCURSION: + mark_object (pdl->unwind_excursion.marker); + mark_object (pdl->unwind_excursion.window); + break; + case SPECPDL_BACKTRACE: { ptrdiff_t nargs = backtrace_nargs (pdl); diff --git a/src/lisp.h b/src/lisp.h index b7e5d9e376..af3f587222 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3188,6 +3188,7 @@ enum specbind_tag { SPECPDL_UNWIND, /* An unwind_protect function on Lisp_Object. */ SPECPDL_UNWIND_PTR, /* Likewise, on void *. */ SPECPDL_UNWIND_INT, /* Likewise, on int. */ + SPECPDL_UNWIND_EXCURSION, /* Likewise, on an execursion. */ SPECPDL_UNWIND_VOID, /* Likewise, with no arg. */ SPECPDL_BACKTRACE, /* An element of the backtrace. */ SPECPDL_LET, /* A plain and simple dynamic let-binding. */ @@ -3214,6 +3215,10 @@ union specbinding void (*func) (int); int arg; } unwind_int; + struct { + ENUM_BF (specbind_tag) kind : CHAR_BIT; + Lisp_Object marker, window; + } unwind_excursion; struct { ENUM_BF (specbind_tag) kind : CHAR_BIT; void (*func) (void); @@ -4106,9 +4111,9 @@ extern void mark_threads (void); /* Defined in editfns.c. */ extern void insert1 (Lisp_Object); -extern Lisp_Object save_excursion_save (void); +extern void save_excursion_save (union specbinding *); +extern void save_excursion_restore (Lisp_Object, Lisp_Object); extern Lisp_Object save_restriction_save (void); -extern void save_excursion_restore (Lisp_Object); extern void save_restriction_restore (Lisp_Object); extern _Noreturn void time_overflow (void); extern Lisp_Object make_buffer_string (ptrdiff_t, ptrdiff_t, bool); commit 6c04c848e677e458e39811b10335cd6aeece6e2a Author: Paul Eggert <eggert@cs.ucla.edu> Date: Thu Jun 14 15:59:09 2018 -0700 Just use cons in macfont_descriptor_entity * src/macfont.m (macfont_descriptor_entity): Use cons instead of make_save_ptr_int, as this avoids the need for a special type and function for this one-off. diff --git a/src/macfont.m b/src/macfont.m index 3b14a89c5c..8abe203644 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -908,7 +908,7 @@ static void mac_font_get_glyphs_for_variants (CFDataRef, UTF32Char, ASET (entity, FONT_EXTRA_INDEX, Fcopy_sequence (extra)); name = CTFontDescriptorCopyAttribute (desc, kCTFontNameAttribute); font_put_extra (entity, QCfont_entity, - make_save_ptr_int ((void *) name, sym_traits)); + Fcons (make_mint_ptr (name), make_number (traits))); if (synth_sym_traits & kCTFontTraitItalic) FONT_SET_STYLE (entity, FONT_SLANT_INDEX, make_number (FONT_SLANT_SYNTHETIC_ITALIC)); @@ -2505,7 +2505,7 @@ So we use CTFontDescriptorCreateMatchingFontDescriptor (no { Lisp_Object val = assq_no_quit (QCfont_entity, AREF (entity, FONT_EXTRA_INDEX)); - CFStringRef name = XSAVE_POINTER (XCDR (val), 0); + CFStringRef name = xmint_pointer (XCAR (XCDR (val))); block_input (); CFRelease (name); @@ -2528,11 +2528,10 @@ So we use CTFontDescriptorCreateMatchingFontDescriptor (no val = assq_no_quit (QCfont_entity, AREF (entity, FONT_EXTRA_INDEX)); if (! CONSP (val) - || XTYPE (XCDR (val)) != Lisp_Misc - || XMISCTYPE (XCDR (val)) != Lisp_Misc_Save_Value) + || ! CONSP (XCDR (val))) return Qnil; - font_name = XSAVE_POINTER (XCDR (val), 0); - sym_traits = XSAVE_INTEGER (XCDR (val), 1); + font_name = xmint_pointer (XCAR (XCDR (val))); + sym_traits = XINT (XCDR (XCDR (val))); size = XINT (AREF (entity, FONT_SIZE_INDEX)); if (size == 0) @@ -2711,7 +2710,7 @@ So we use CTFontDescriptorCreateMatchingFontDescriptor (no val = assq_no_quit (QCfont_entity, AREF (font, FONT_EXTRA_INDEX)); val = XCDR (val); - name = XSAVE_POINTER (val, 0); + name = xmint_pointer (XCAR (val)); charset = macfont_get_cf_charset_for_name (name); } else commit 888bf9877d466dbb65aec821bede9ac49e12798f Author: Paul Eggert <eggert@cs.ucla.edu> Date: Thu Jun 14 15:59:08 2018 -0700 Avoid allocating a Lisp_Save_Value in ftfont.c * src/ftfont.c (struct ftfont_cache_data): New member face_refcount. (ftfont_lookup_cache): Clear it when initializing. Use make_mint_ptr, since this typically avoids the need to allocate a Lisp_Save_Value as refcount is now stored elsewhere. (ftfont_open2, ftfont_close): Manipulate the reference count in the struct, not in the save object. diff --git a/src/ftfont.c b/src/ftfont.c index a53467000f..d50fa39fa7 100644 --- a/src/ftfont.c +++ b/src/ftfont.c @@ -345,6 +345,7 @@ struct ftfont_cache_data { FT_Face ft_face; FcCharSet *fc_charset; + intptr_t face_refcount; }; static Lisp_Object @@ -371,17 +372,15 @@ ftfont_lookup_cache (Lisp_Object key, enum ftfont_cache_for cache_for) { if (NILP (ft_face_cache)) ft_face_cache = CALLN (Fmake_hash_table, QCtest, Qequal); - cache_data = xmalloc (sizeof *cache_data); - cache_data->ft_face = NULL; - cache_data->fc_charset = NULL; - val = make_save_ptr_int (cache_data, 0); + cache_data = xzalloc (sizeof *cache_data); + val = make_mint_ptr (cache_data); cache = Fcons (Qnil, val); Fputhash (key, cache, ft_face_cache); } else { val = XCDR (cache); - cache_data = XSAVE_POINTER (val, 0); + cache_data = xmint_pointer (val); } if (cache_for == FTFONT_CACHE_FOR_ENTITY) @@ -447,7 +446,7 @@ ftfont_get_fc_charset (Lisp_Object entity) cache = ftfont_lookup_cache (entity, FTFONT_CACHE_FOR_CHARSET); val = XCDR (cache); - cache_data = XSAVE_POINTER (val, 0); + cache_data = xmint_pointer (val); return cache_data->fc_charset; } @@ -1118,9 +1117,9 @@ ftfont_open2 (struct frame *f, filename = XCAR (val); idx = XCDR (val); val = XCDR (cache); - cache_data = XSAVE_POINTER (XCDR (cache), 0); + cache_data = xmint_pointer (XCDR (cache)); ft_face = cache_data->ft_face; - if (XSAVE_INTEGER (val, 1) > 0) + if (cache_data->face_refcount > 0) { /* FT_Face in this cache is already used by the different size. */ if (FT_New_Size (ft_face, &ft_size) != 0) @@ -1136,14 +1135,14 @@ ftfont_open2 (struct frame *f, size = pixel_size; if (FT_Set_Pixel_Sizes (ft_face, size, size) != 0) { - if (XSAVE_INTEGER (val, 1) == 0) + if (cache_data->face_refcount == 0) { FT_Done_Face (ft_face); cache_data->ft_face = NULL; } return Qnil; } - set_save_integer (val, 1, XSAVE_INTEGER (val, 1) + 1); + cache_data->face_refcount++; ASET (font_object, FONT_FILE_INDEX, filename); font = XFONT_OBJECT (font_object); @@ -1255,11 +1254,10 @@ ftfont_close (struct font *font) cache = ftfont_lookup_cache (val, FTFONT_CACHE_FOR_FACE); eassert (CONSP (cache)); val = XCDR (cache); - set_save_integer (val, 1, XSAVE_INTEGER (val, 1) - 1); - if (XSAVE_INTEGER (val, 1) == 0) + struct ftfont_cache_data *cache_data = xmint_pointer (val); + cache_data->face_refcount--; + if (cache_data->face_refcount == 0) { - struct ftfont_cache_data *cache_data = XSAVE_POINTER (val, 0); - FT_Done_Face (cache_data->ft_face); #ifdef HAVE_LIBOTF if (ftfont_info->otf) commit 3f0a8a2e14669cf4a1f56e97f8b1299fced79796 Author: Paul Eggert <eggert@cs.ucla.edu> Date: Thu Jun 14 15:59:08 2018 -0700 Use record_unwind_protect_ptr to avoid allocation * src/term.c (struct tty_pop_down_menu): New type. (tty_pop_down_menu, tty_menu_show): Use it, along with record_unwind_protect_ptr, to avoid allocating a Lisp_Misc. * src/xmenu.c (struct pop_down_menu): New type. (pop_down_menu, x_menu_show): Use it, likewise. * src/xterm.c (x_cr_destroy, x_cr_export_frames): Use record_unwind_protect_pointer to avoid possibly allocating a Lisp_Misc. diff --git a/src/term.c b/src/term.c index bcd7dd82d6..85bfa84d93 100644 --- a/src/term.c +++ b/src/term.c @@ -3408,15 +3408,20 @@ tty_menu_help_callback (char const *help_string, int pane, int item) Qnil, menu_object, make_number (item)); } +struct tty_pop_down_menu +{ + tty_menu *menu; + struct buffer *buffer; +}; + static void -tty_pop_down_menu (Lisp_Object arg) +tty_pop_down_menu (void *arg) { - tty_menu *menu = XSAVE_POINTER (arg, 0); - struct buffer *orig_buffer = XSAVE_POINTER (arg, 1); + struct tty_pop_down_menu *data = arg; block_input (); - tty_menu_destroy (menu); - set_buffer_internal (orig_buffer); + tty_menu_destroy (data->menu); + set_buffer_internal (data->buffer); unblock_input (); } @@ -3697,8 +3702,9 @@ tty_menu_show (struct frame *f, int x, int y, int menuflags, /* We save and restore the current buffer because tty_menu_activate triggers redisplay, which switches buffers at will. */ - record_unwind_protect (tty_pop_down_menu, - make_save_ptr_ptr (menu, current_buffer)); + record_unwind_protect_ptr (tty_pop_down_menu, + &((struct tty_pop_down_menu) + {menu, current_buffer})); specbind (Qoverriding_terminal_local_map, Fsymbol_value (Qtty_menu_navigation_map)); diff --git a/src/xmenu.c b/src/xmenu.c index a5865a6ec2..2fbf9e8bf6 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -2033,11 +2033,18 @@ menu_help_callback (char const *help_string, int pane, int item) Qnil, menu_object, make_number (item)); } +struct pop_down_menu +{ + struct frame *frame; + XMenu *menu; +}; + static void -pop_down_menu (Lisp_Object arg) +pop_down_menu (void *arg) { - struct frame *f = XSAVE_POINTER (arg, 0); - XMenu *menu = XSAVE_POINTER (arg, 1); + union pop_down_menu *data = arg; + struct frame *f = data->frame; + XMenu *menu = data->menu; block_input (); #ifndef MSDOS @@ -2283,7 +2290,8 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, XMenuActivateSetWaitFunction (x_menu_wait_for_event, FRAME_X_DISPLAY (f)); #endif - record_unwind_protect (pop_down_menu, make_save_ptr_ptr (f, menu)); + record_unwind_protect_pointer (pop_down_menu, + &(struct pop_down_menu) {f, menu}); /* Help display under X won't work because XMenuActivate contains a loop that doesn't give Emacs a chance to process it. */ diff --git a/src/xterm.c b/src/xterm.c index 00ca18c2a9..48ce791889 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -544,10 +544,8 @@ x_cr_accumulate_data (void *closure, const unsigned char *data, } static void -x_cr_destroy (Lisp_Object arg) +x_cr_destroy (void *cr); { - cairo_t *cr = xmint_pointer (arg); - block_input (); cairo_destroy (cr); unblock_input (); @@ -606,7 +604,7 @@ x_cr_export_frames (Lisp_Object frames, cairo_surface_type_t surface_type) cr = cairo_create (surface); cairo_surface_destroy (surface); - record_unwind_protect (x_cr_destroy, make_mint_ptr (cr)); + record_unwind_protect_pointer (x_cr_destroy, cr); while (1) { commit 12fd59bba0b04fb6727f4fa54e3305a65fae1d44 Author: Paul Eggert <eggert@cs.ucla.edu> Date: Thu Jun 14 15:59:08 2018 -0700 Avoid Lisp_Misc allocation if C stack suffices * src/fileio.c (union read_non_regular): New type. (read_non_regular, Finsert_file_contents): Use it to avoid allocating a Lisp_Misc. * src/keymap.c (union map_keymap): New type. (map_keymap_char_table_item, map_keymap_internal): Use it to avoid allocating a Lisp_Misc. diff --git a/src/fileio.c b/src/fileio.c index 47c5fec853..7f678dd821 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -3362,20 +3362,27 @@ decide_coding_unwind (Lisp_Object unwind_data) bset_undo_list (current_buffer, undo_list); } -/* Read from a non-regular file. STATE is a Lisp_Save_Value - object where slot 0 is the file descriptor, slot 1 specifies - an offset to put the read bytes, and slot 2 is the maximum - amount of bytes to read. Value is the number of bytes read. */ +/* Read from a non-regular file. Return the number of bytes read. */ + +union read_non_regular +{ + struct + { + int fd; + ptrdiff_t inserted, trytry; + } s; + GCALIGNED_UNION +}; +verify (alignof (union read_non_regular) % GCALIGNMENT == 0); static Lisp_Object read_non_regular (Lisp_Object state) { - int nbytes = emacs_read_quit (XSAVE_INTEGER (state, 0), + union read_non_regular *data = XINTPTR (state); + int nbytes = emacs_read_quit (data->s.fd, ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE - + XSAVE_INTEGER (state, 1)), - XSAVE_INTEGER (state, 2)); - /* Fast recycle this object for the likely next call. */ - free_misc (state); + + data->s.inserted), + data->s.trytry); return make_number (nbytes); } @@ -4230,9 +4237,9 @@ by calling `format-decode', which see. */) /* Read from the file, capturing `quit'. When an error occurs, end the loop, and arrange for a quit to be signaled after decoding the text we read. */ + union read_non_regular data = {{fd, inserted, trytry}}; nbytes = internal_condition_case_1 - (read_non_regular, - make_save_int_int_int (fd, inserted, trytry), + (read_non_regular, make_pointer_integer (&data), Qerror, read_non_regular_quit); if (NILP (nbytes)) diff --git a/src/keymap.c b/src/keymap.c index c8cc933e78..982c014f01 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -546,19 +546,29 @@ map_keymap_item (map_keymap_function_t fun, Lisp_Object args, Lisp_Object key, L (*fun) (key, val, args, data); } +union map_keymap +{ + struct + { + map_keymap_function_t fun; + Lisp_Object args; + void *data; + } s; + GCALIGNED_UNION +}; +verify (alignof (union map_keymap) % GCALIGNMENT == 0); + static void map_keymap_char_table_item (Lisp_Object args, Lisp_Object key, Lisp_Object val) { if (!NILP (val)) { - map_keymap_function_t fun - = (map_keymap_function_t) XSAVE_FUNCPOINTER (args, 0); /* If the key is a range, make a copy since map_char_table modifies it in place. */ if (CONSP (key)) key = Fcons (XCAR (key), XCDR (key)); - map_keymap_item (fun, XSAVE_OBJECT (args, 2), key, - val, XSAVE_POINTER (args, 1)); + union map_keymap *md = XINTPTR (args); + map_keymap_item (md->s.fun, md->s.args, key, val, md->s.data); } } @@ -594,9 +604,11 @@ map_keymap_internal (Lisp_Object map, } } else if (CHAR_TABLE_P (binding)) - map_char_table (map_keymap_char_table_item, Qnil, binding, - make_save_funcptr_ptr_obj ((voidfuncptr) fun, data, - args)); + { + union map_keymap mapdata = {{fun, args, data}}; + map_char_table (map_keymap_char_table_item, Qnil, binding, + make_pointer_integer (&mapdata)); + } } return tail; commit ef66660c17d1b164414c46d67ba3494f8a18c8ec Author: Paul Eggert <eggert@cs.ucla.edu> Date: Thu Jun 14 15:59:08 2018 -0700 Simplify init_module_assertions * src/emacs-module.c (init_module_assertions): Just use NULL instead of allocating a dummy on the stack and then using eassert. Practical platforms check for null pointer dereferencing nowadays, so this is good enough. diff --git a/src/emacs-module.c b/src/emacs-module.c index ff575ff44d..3a24663799 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -1167,15 +1167,11 @@ module_handle_throw (emacs_env *env, Lisp_Object tag_val) void init_module_assertions (bool enable) { + /* If enabling module assertions, use a hidden environment for + storing the globals. This environment is never freed. */ module_assertions = enable; if (enable) - { - /* We use a hidden environment for storing the globals. This - environment is never freed. */ - emacs_env env; - global_env = initialize_environment (&env, &global_env_private); - eassert (global_env != &env); - } + global_env = initialize_environment (NULL, &global_env_private); } static _Noreturn void commit 30d393f9118035ec5d12917252bc4339c771a539 Author: Paul Eggert <eggert@cs.ucla.edu> Date: Thu Jun 14 15:59:08 2018 -0700 New mint_ptr representation for C pointers * src/lisp.h (make_mint_ptr, mint_ptrp, xmint_pointer): New functions. * src/dbusbind.c (xd_lisp_dbus_to_dbus, Fdbus__init_bus): * src/emacs-module.c (module_free_global_ref, Fmodule_load) (module_assert_runtime, module_assert_env, value_to_lisp) (lisp_to_value, initialize_environment) (finalize_environment, finalize_runtime_unwind) (mark_modules): * src/font.c (otf_open, font_put_frame_data) (font_get_frame_data): * src/macfont.m (macfont_invalidate_family_cache) (macfont_get_family_cache_if_present) (macfont_set_family_cache): * src/nsterm.h (XNS_SCROLL_BAR): * src/nsterm.m (ns_set_vertical_scroll_bar) (ns_set_horizontal_scroll_bar): * src/w32fns.c (w32_monitor_enum) (w32_display_monitor_attributes_list): * src/xterm.c (x_cr_destroy, x_cr_export_frames): * src/xwidget.c (webkit_javascript_finished_cb) (save_script_callback, Fxwidget_webkit_execute_script) (kill_buffer_xwidgets): Use mint pointers instead of merely save pointers. diff --git a/src/dbusbind.c b/src/dbusbind.c index 4e0b99bea9..4ebea5712a 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -946,7 +946,7 @@ xd_get_connection_references (DBusConnection *connection) static DBusConnection * xd_lisp_dbus_to_dbus (Lisp_Object bus) { - return (DBusConnection *) XSAVE_POINTER (bus, 0); + return xmint_pointer (bus); } /* Return D-Bus connection address. BUS is either a Lisp symbol, @@ -1189,7 +1189,7 @@ this connection to those buses. */) XD_SIGNAL1 (build_string ("Cannot add watch functions")); /* Add bus to list of registered buses. */ - val = make_save_ptr (connection); + val = make_mint_ptr (connection); xd_registered_buses = Fcons (Fcons (bus, val), xd_registered_buses); /* Cleanup. */ diff --git a/src/emacs-module.c b/src/emacs-module.c index c18c7ab308..ff575ff44d 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -347,7 +347,7 @@ module_free_global_ref (emacs_env *env, emacs_value ref) for (Lisp_Object tail = global_env_private.values; CONSP (tail); tail = XCDR (tail)) { - emacs_value global = XSAVE_POINTER (XCAR (globals), 0); + emacs_value global = xmint_pointer (XCAR (globals)); if (global == ref) { if (NILP (prev)) @@ -735,7 +735,7 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0, rt->private_members = &rt_priv; rt->get_environment = module_get_environment; - Vmodule_runtimes = Fcons (make_save_ptr (rt), Vmodule_runtimes); + Vmodule_runtimes = Fcons (make_mint_ptr (rt), Vmodule_runtimes); ptrdiff_t count = SPECPDL_INDEX (); record_unwind_protect_ptr (finalize_runtime_unwind, rt); @@ -830,7 +830,7 @@ module_assert_runtime (struct emacs_runtime *ert) ptrdiff_t count = 0; for (Lisp_Object tail = Vmodule_runtimes; CONSP (tail); tail = XCDR (tail)) { - if (XSAVE_POINTER (XCAR (tail), 0) == ert) + if (xmint_pointer (XCAR (tail)) == ert) return; ++count; } @@ -847,7 +847,7 @@ module_assert_env (emacs_env *env) for (Lisp_Object tail = Vmodule_environments; CONSP (tail); tail = XCDR (tail)) { - if (XSAVE_POINTER (XCAR (tail), 0) == env) + if (xmint_pointer (XCAR (tail)) == env) return; ++count; } @@ -959,11 +959,11 @@ value_to_lisp (emacs_value v) for (Lisp_Object environments = Vmodule_environments; CONSP (environments); environments = XCDR (environments)) { - emacs_env *env = XSAVE_POINTER (XCAR (environments), 0); + emacs_env *env = xmint_pointer (XCAR (environments)); for (Lisp_Object values = env->private_members->values; CONSP (values); values = XCDR (values)) { - Lisp_Object *p = XSAVE_POINTER (XCAR (values), 0); + Lisp_Object *p = xmint_pointer (XCAR (values)); if (p == optr) return *p; ++num_values; @@ -1021,7 +1021,7 @@ lisp_to_value (emacs_env *env, Lisp_Object o) void *vptr = optr; ATTRIBUTE_MAY_ALIAS emacs_value ret = vptr; struct emacs_env_private *priv = env->private_members; - priv->values = Fcons (make_save_ptr (ret), priv->values); + priv->values = Fcons (make_mint_ptr (ret), priv->values); return ret; } @@ -1086,7 +1086,7 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv) env->vec_get = module_vec_get; env->vec_size = module_vec_size; env->should_quit = module_should_quit; - Vmodule_environments = Fcons (make_save_ptr (env), Vmodule_environments); + Vmodule_environments = Fcons (make_mint_ptr (env), Vmodule_environments); return env; } @@ -1095,7 +1095,7 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv) static void finalize_environment (emacs_env *env) { - eassert (XSAVE_POINTER (XCAR (Vmodule_environments), 0) == env); + eassert (xmint_pointer (XCAR (Vmodule_environments)) == env); Vmodule_environments = XCDR (Vmodule_environments); if (module_assertions) /* There is always at least the global environment. */ @@ -1109,10 +1109,10 @@ finalize_environment_unwind (void *env) } static void -finalize_runtime_unwind (void* raw_ert) +finalize_runtime_unwind (void *raw_ert) { struct emacs_runtime *ert = raw_ert; - eassert (XSAVE_POINTER (XCAR (Vmodule_runtimes), 0) == ert); + eassert (xmint_pointer (XCAR (Vmodule_runtimes)) == ert); Vmodule_runtimes = XCDR (Vmodule_runtimes); finalize_environment (ert->private_members->env); } @@ -1123,7 +1123,7 @@ mark_modules (void) for (Lisp_Object tail = Vmodule_environments; CONSP (tail); tail = XCDR (tail)) { - emacs_env *env = XSAVE_POINTER (XCAR (tail), 0); + emacs_env *env = xmint_pointer (XCAR (tail)); struct emacs_env_private *priv = env->private_members; mark_object (priv->non_local_exit_symbol); mark_object (priv->non_local_exit_data); diff --git a/src/font.c b/src/font.c index 3800869c5b..3a82e501a8 100644 --- a/src/font.c +++ b/src/font.c @@ -1897,11 +1897,11 @@ otf_open (Lisp_Object file) OTF *otf; if (! NILP (val)) - otf = XSAVE_POINTER (XCDR (val), 0); + otf = xmint_pointer (XCDR (val)); else { otf = STRINGP (file) ? OTF_open (SSDATA (file)) : NULL; - val = make_save_ptr (otf); + val = make_mint_ptr (otf); otf_list = Fcons (Fcons (file, val), otf_list); } return otf; @@ -3632,10 +3632,10 @@ font_put_frame_data (struct frame *f, Lisp_Object driver, void *data) else { if (NILP (val)) - fset_font_data (f, Fcons (Fcons (driver, make_save_ptr (data)), + fset_font_data (f, Fcons (Fcons (driver, make_mint_ptr (data)), f->font_data)); else - XSETCDR (val, make_save_ptr (data)); + XSETCDR (val, make_mint_ptr (data)); } } @@ -3644,7 +3644,7 @@ font_get_frame_data (struct frame *f, Lisp_Object driver) { Lisp_Object val = assq_no_quit (driver, f->font_data); - return NILP (val) ? NULL : XSAVE_POINTER (XCDR (val), 0); + return NILP (val) ? NULL : xmint_pointer (XCDR (val)); } #endif /* HAVE_XFT || HAVE_FREETYPE */ diff --git a/src/lisp.h b/src/lisp.h index aaad90b2da..b7e5d9e376 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2494,7 +2494,47 @@ XSAVE_FUNCPOINTER (Lisp_Object obj, int n) return XSAVE_VALUE (obj)->data[n].funcpointer; } -/* Likewise for the saved integer. */ +extern Lisp_Object make_save_ptr (void *); + +/* A mint_ptr object OBJ represents a C-language pointer P efficiently. + Preferably (and typically), OBJ is a Lisp integer I such that + XINTPTR (I) == P, as this represents P within a single Lisp value + without requiring any auxiliary memory. However, if P would be + damaged by being tagged as an integer and then untagged via + XINTPTR, then OBJ is a Lisp_Save_Value with pointer component P. + + mint_ptr objects are efficiency hacks intended for C code. + Although xmint_ptr can be given any mint_ptr generated by non-buggy + C code, it should not be given a mint_ptr generated from Lisp code + as that would allow Lisp code to coin pointers from integers and + could lead to crashes. To package a C pointer into a Lisp-visible + object you can put the pointer into a Lisp_Misc object instead; see + Lisp_User_Ptr for an example. */ + +INLINE Lisp_Object +make_mint_ptr (void *a) +{ + Lisp_Object val = TAG_PTR (Lisp_Int0, a); + return INTEGERP (val) && XINTPTR (val) == a ? val : make_save_ptr (a); +} + +INLINE bool +mint_ptrp (Lisp_Object x) +{ + return (INTEGERP (x) + || (SAVE_VALUEP (x) && XSAVE_VALUE (x)->save_type == SAVE_POINTER)); +} + +INLINE void * +xmint_pointer (Lisp_Object a) +{ + eassert (mint_ptrp (a)); + if (INTEGERP (a)) + return XINTPTR (a); + return XSAVE_POINTER (a, 0); +} + +/* Get and set the Nth saved integer. */ INLINE ptrdiff_t XSAVE_INTEGER (Lisp_Object obj, int n) @@ -3801,7 +3841,6 @@ extern ptrdiff_t inhibit_garbage_collection (void); extern Lisp_Object make_save_int_int_int (ptrdiff_t, ptrdiff_t, ptrdiff_t); extern Lisp_Object make_save_obj_obj_obj_obj (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); -extern Lisp_Object make_save_ptr (void *); extern Lisp_Object make_save_ptr_int (void *, ptrdiff_t); extern Lisp_Object make_save_ptr_ptr (void *, void *); extern Lisp_Object make_save_funcptr_ptr_obj (void (*) (void), void *, diff --git a/src/macfont.m b/src/macfont.m index 817071fa44..3b14a89c5c 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -943,8 +943,8 @@ static void mac_font_get_glyphs_for_variants (CFDataRef, UTF32Char, { Lisp_Object value = HASH_VALUE (h, i); - if (SAVE_VALUEP (value)) - CFRelease (XSAVE_POINTER (value, 0)); + if (mint_ptrp (value)) + CFRelease (xmint_pointer (value)); } macfont_family_cache = Qnil; } @@ -962,7 +962,7 @@ static void mac_font_get_glyphs_for_variants (CFDataRef, UTF32Char, { Lisp_Object value = HASH_VALUE (h, i); - *string = SAVE_VALUEP (value) ? XSAVE_POINTER (value, 0) : NULL; + *string = mint_ptrp (value) ? xmint_pointer (value) : NULL; return true; } @@ -984,13 +984,13 @@ static void mac_font_get_glyphs_for_variants (CFDataRef, UTF32Char, h = XHASH_TABLE (macfont_family_cache); i = hash_lookup (h, symbol, &hash); - value = string ? make_save_ptr ((void *) CFRetain (string)) : Qnil; + value = string ? make_mint_ptr (CFRetain (string)) : Qnil; if (i >= 0) { Lisp_Object old_value = HASH_VALUE (h, i); - if (SAVE_VALUEP (old_value)) - CFRelease (XSAVE_POINTER (old_value, 0)); + if (mint_ptrp (old_value)) + CFRelease (xmint_pointer (old_value)); set_hash_value_slot (h, i, value); } else diff --git a/src/nsterm.h b/src/nsterm.h index a99b517fd5..23460abc65 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -1019,9 +1019,9 @@ struct x_output #define FRAME_FONT(f) ((f)->output_data.ns->font) #ifdef __OBJC__ -#define XNS_SCROLL_BAR(vec) ((id) XSAVE_POINTER (vec, 0)) +#define XNS_SCROLL_BAR(vec) ((id) xmint_pointer (vec)) #else -#define XNS_SCROLL_BAR(vec) XSAVE_POINTER (vec, 0) +#define XNS_SCROLL_BAR(vec) xmint_pointer (vec) #endif /* Compute pixel height of the frame's titlebar. */ diff --git a/src/nsterm.m b/src/nsterm.m index c0d2d91fde..f0e6790e99 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -4819,7 +4819,7 @@ in certain situations (rapid incoming events). ns_clear_frame_area (f, left, top, width, height); bar = [[EmacsScroller alloc] initFrame: r window: win]; - wset_vertical_scroll_bar (window, make_save_ptr (bar)); + wset_vertical_scroll_bar (window, make_mint_ptr (bar)); update_p = YES; } else @@ -4898,7 +4898,7 @@ in certain situations (rapid incoming events). ns_clear_frame_area (f, left, top, width, height); bar = [[EmacsScroller alloc] initFrame: r window: win]; - wset_horizontal_scroll_bar (window, make_save_ptr (bar)); + wset_horizontal_scroll_bar (window, make_mint_ptr (bar)); update_p = YES; } else diff --git a/src/w32fns.c b/src/w32fns.c index 2cb715a356..3bd320928d 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -6296,7 +6296,7 @@ w32_monitor_enum (HMONITOR monitor, HDC hdc, RECT *rcMonitor, LPARAM dwData) { Lisp_Object *monitor_list = (Lisp_Object *) dwData; - *monitor_list = Fcons (make_save_ptr (monitor), *monitor_list); + *monitor_list = Fcons (make_mint_ptr (monitor), *monitor_list); return TRUE; } @@ -6325,7 +6325,7 @@ w32_display_monitor_attributes_list (void) monitors = xmalloc (n_monitors * sizeof (*monitors)); for (i = 0; i < n_monitors; i++) { - monitors[i] = XSAVE_POINTER (XCAR (monitor_list), 0); + monitors[i] = xmint_pointer (XCAR (monitor_list)); monitor_list = XCDR (monitor_list); } diff --git a/src/xterm.c b/src/xterm.c index decaa33670..00ca18c2a9 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -546,7 +546,7 @@ x_cr_accumulate_data (void *closure, const unsigned char *data, static void x_cr_destroy (Lisp_Object arg) { - cairo_t *cr = (cairo_t *) XSAVE_POINTER (arg, 0); + cairo_t *cr = xmint_pointer (arg); block_input (); cairo_destroy (cr); @@ -606,7 +606,7 @@ x_cr_export_frames (Lisp_Object frames, cairo_surface_type_t surface_type) cr = cairo_create (surface); cairo_surface_destroy (surface); - record_unwind_protect (x_cr_destroy, make_save_ptr (cr)); + record_unwind_protect (x_cr_destroy, make_mint_ptr (cr)); while (1) { diff --git a/src/xwidget.c b/src/xwidget.c index 5f2651214e..2a53966ef4 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -374,7 +374,7 @@ webkit_javascript_finished_cb (GObject *webview, Lisp_Object script_callback = AREF (xw->script_callbacks, script_idx); ASET (xw->script_callbacks, script_idx, Qnil); if (!NILP (script_callback)) - xfree (XSAVE_POINTER (XCAR (script_callback), 0)); + xfree (xmint_pointer (XCAR (script_callback))); js_result = webkit_web_view_run_javascript_finish (WEBKIT_WEB_VIEW (webview), result, &error); @@ -724,7 +724,7 @@ save_script_callback (struct xwidget *xw, Lisp_Object script, Lisp_Object fun) break; } - ASET (cbs, idx, Fcons (make_save_ptr (xlispstrdup (script)), fun)); + ASET (cbs, idx, Fcons (make_mint_ptr (xlispstrdup (script)), fun)); return idx; } @@ -750,7 +750,7 @@ argument procedure FUN.*/) callback function is provided we pass it to the C callback procedure that retrieves the return value. */ gchar *script_string - = XSAVE_POINTER (XCAR (AREF (xw->script_callbacks, idx)), 0); + = xmint_pointer (XCAR (AREF (xw->script_callbacks, idx))); webkit_web_view_run_javascript (WEBKIT_WEB_VIEW (xw->widget_osr), script_string, NULL, /* cancelable */ @@ -1227,7 +1227,7 @@ kill_buffer_xwidgets (Lisp_Object buffer) { Lisp_Object cb = AREF (xw->script_callbacks, idx); if (!NILP (cb)) - xfree (XSAVE_POINTER (XCAR (cb), 0)); + xfree (xmint_pointer (XCAR (cb))); ASET (xw->script_callbacks, idx, Qnil); } } commit fcd66d059cffbcfff8325304c2c100b64d28ae29 Author: Noam Postavsky <npostavs@gmail.com> Date: Mon Jun 11 20:00:54 2018 -0400 Keep vc-print-log from putting point at buffer end (Bug#31764) * lisp/vc/vc.el (vc-print-log-internal): Use `save-excursion' around `vc-print-log-setup-buttons'. diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 93e9c25cbf..41a76e0007 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -2256,8 +2256,9 @@ earlier revisions. Show up to LIMIT entries (non-nil means unlimited)." (vc-call-backend bk 'print-log files-arg buf shortlog (when is-start-revision working-revision) limit)) (lambda (_bk _files-arg ret) - (vc-print-log-setup-buttons working-revision - is-start-revision limit ret)) + (save-excursion + (vc-print-log-setup-buttons working-revision + is-start-revision limit ret))) ;; When it's nil, point really shouldn't move (bug#15322). (when working-revision (lambda (bk) commit 51adab5de24b3ee215fe636aedb7ff91d69a220c Author: JoĂŁo Távora <joaotavora@gmail.com> Date: Fri Jun 8 02:35:50 2018 +0100 Also allow custom false and null when serializing to JSON * doc/lispref/text.texi (Parsing JSON): Describe new arguments of json-serialize and json-insert. * src/json.c (enum json_object_type, struct json_configuration): Move up in file before first usage. (lisp_to_json_toplevel, lisp_to_json_toplevel_1, lisp_to_json): Accept a struct json_configuration*. (Fjson_serialize, Fjson_insert): Accept multiple args. (json_parse_args): Accept new boolean configure_object_type. * test/src/json-tests.el (json-serialize, json-insert): Update forward decls. (json-parse-with-custom-null-and-false-objects): Add assertions for json-serialize. diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 5b94580827..bb6ab04a92 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -5063,14 +5063,29 @@ JSON. The subobjects within these top-level values can be of any type. Likewise, the parsing functions will only return vectors, hashtables, alists, and plists. -@defun json-serialize object +@defun json-serialize object &rest args This function returns a new Lisp string which contains the JSON -representation of @var{object}. +representation of @var{object}. The argument @var{args} is a list of +keyword/argument pairs. The following keywords are accepted: + +@table @code + +@item :null-object +The value decides which Lisp object to use to represent the JSON +keyword @code{null}. It defaults to the symbol @code{:null}. + +@item :false-object +The value decides which Lisp object to use to represent the JSON +keyword @code{false}. It defaults to the symbol @code{:false}. + +@end table + @end defun -@defun json-insert object +@defun json-insert object &rest args This function inserts the JSON representation of @var{object} into the -current buffer before point. +current buffer before point. @var{args} is interpreted as in +@code{json-parse-string}. @end defun @defun json-parse-string string &rest args @@ -5078,24 +5093,24 @@ This function parses the JSON value in @var{string}, which must be a Lisp string. The argument @var{args} is a list of keyword/argument pairs. The following keywords are accepted: -@itemize +@table @code -@item @code{:object-type} +@item :object-type The value decides which Lisp object to use for representing the key-value mappings of a JSON object. It can be either @code{hash-table}, the default, to make hashtables with strings as keys; @code{alist} to use alists with symbols as keys; or @code{plist} to use plists with keyword symbols as keys. -@item @code{:null-object} +@item :null-object The value decides which Lisp object to use to represent the JSON -keyword @code{null}. It defaults to the lisp symbol @code{:null}. +keyword @code{null}. It defaults to the symbol @code{:null}. -@item @code{:false-object} +@item :false-object The value decides which Lisp object to use to represent the JSON -keyword @code{false}. It defaults to the lisp symbol @code{:false}. +keyword @code{false}. It defaults to the symbol @code{:false}. -@end itemize +@end table @end defun diff --git a/src/json.c b/src/json.c index e86ef237d0..d30c997da4 100644 --- a/src/json.c +++ b/src/json.c @@ -325,12 +325,25 @@ json_check_utf8 (Lisp_Object string) CHECK_TYPE (utf8_string_p (string), Qutf_8_string_p, string); } -static json_t *lisp_to_json (Lisp_Object); +enum json_object_type { + json_object_hashtable, + json_object_alist, + json_object_plist +}; + +struct json_configuration { + enum json_object_type object_type; + Lisp_Object null_object; + Lisp_Object false_object; +}; + +static json_t *lisp_to_json (Lisp_Object, struct json_configuration *conf); /* Convert a Lisp object to a toplevel JSON object (array or object). */ static json_t * -lisp_to_json_toplevel_1 (Lisp_Object lisp) +lisp_to_json_toplevel_1 (Lisp_Object lisp, + struct json_configuration *conf) { json_t *json; ptrdiff_t count; @@ -344,7 +357,8 @@ lisp_to_json_toplevel_1 (Lisp_Object lisp) for (ptrdiff_t i = 0; i < size; ++i) { int status - = json_array_append_new (json, lisp_to_json (AREF (lisp, i))); + = json_array_append_new (json, lisp_to_json (AREF (lisp, i), + conf)); if (status == -1) json_out_of_memory (); } @@ -369,7 +383,8 @@ lisp_to_json_toplevel_1 (Lisp_Object lisp) if (json_object_get (json, key_str) != NULL) wrong_type_argument (Qjson_value_p, lisp); int status = json_object_set_new (json, key_str, - lisp_to_json (HASH_VALUE (h, i))); + lisp_to_json (HASH_VALUE (h, i), + conf)); if (status == -1) { /* A failure can be caused either by an invalid key or @@ -424,7 +439,8 @@ lisp_to_json_toplevel_1 (Lisp_Object lisp) if (json_object_get (json, key_str) == NULL) { int status - = json_object_set_new (json, key_str, lisp_to_json (value)); + = json_object_set_new (json, key_str, lisp_to_json (value, + conf)); if (status == -1) json_out_of_memory (); } @@ -444,11 +460,11 @@ lisp_to_json_toplevel_1 (Lisp_Object lisp) hashtable, alist, or plist. */ static json_t * -lisp_to_json_toplevel (Lisp_Object lisp) +lisp_to_json_toplevel (Lisp_Object lisp, struct json_configuration *conf) { if (++lisp_eval_depth > max_lisp_eval_depth) xsignal0 (Qjson_object_too_deep); - json_t *json = lisp_to_json_toplevel_1 (lisp); + json_t *json = lisp_to_json_toplevel_1 (lisp, conf); --lisp_eval_depth; return json; } @@ -458,11 +474,11 @@ lisp_to_json_toplevel (Lisp_Object lisp) JSON object. */ static json_t * -lisp_to_json (Lisp_Object lisp) +lisp_to_json (Lisp_Object lisp, struct json_configuration *conf) { - if (EQ (lisp, QCnull)) + if (EQ (lisp, conf->null_object)) return json_check (json_null ()); - else if (EQ (lisp, QCfalse)) + else if (EQ (lisp, conf->false_object)) return json_check (json_false ()); else if (EQ (lisp, Qt)) return json_check (json_true ()); @@ -488,21 +504,78 @@ lisp_to_json (Lisp_Object lisp) } /* LISP now must be a vector, hashtable, alist, or plist. */ - return lisp_to_json_toplevel (lisp); + return lisp_to_json_toplevel (lisp, conf); } -DEFUN ("json-serialize", Fjson_serialize, Sjson_serialize, 1, 1, NULL, +static void +json_parse_args (ptrdiff_t nargs, + Lisp_Object *args, + struct json_configuration *conf, + bool configure_object_type) +{ + if ((nargs % 2) != 0) + wrong_type_argument (Qplistp, Flist (nargs, args)); + + /* Start from the back so keyword values appearing + first take precedence. */ + for (ptrdiff_t i = nargs; i > 0; i -= 2) { + Lisp_Object key = args[i - 2]; + Lisp_Object value = args[i - 1]; + if (configure_object_type && EQ (key, QCobject_type)) + { + if (EQ (value, Qhash_table)) + conf->object_type = json_object_hashtable; + else if (EQ (value, Qalist)) + conf->object_type = json_object_alist; + else if (EQ (value, Qplist)) + conf->object_type = json_object_plist; + else + wrong_choice (list3 (Qhash_table, Qalist, Qplist), value); + } + else if (EQ (key, QCnull_object)) + conf->null_object = value; + else if (EQ (key, QCfalse_object)) + conf->false_object = value; + else if (configure_object_type) + wrong_choice (list3 (QCobject_type, + QCnull_object, + QCfalse_object), + value); + else + wrong_choice (list2 (QCnull_object, + QCfalse_object), + value); + } +} + +DEFUN ("json-serialize", Fjson_serialize, Sjson_serialize, 1, MANY, + NULL, doc: /* Return the JSON representation of OBJECT as a string. + OBJECT must be a vector, hashtable, alist, or plist and its elements -can recursively contain `:null', `:false', t, numbers, strings, or -other vectors hashtables, alists or plists. `:null', `:false', and t -will be converted to JSON null, false, and true values, respectively. -Vectors will be converted to JSON arrays, whereas hashtables, alists -and plists are converted to JSON objects. Hashtable keys must be -strings without embedded null characters and must be unique within -each object. Alist and plist keys must be symbols; if a key is -duplicate, the first instance is used. */) - (Lisp_Object object) +can recursively contain the Lisp equivalents to the JSON null and +false values, t, numbers, strings, or other vectors hashtables, alists +or plists. t will be converted to the JSON true value. Vectors will +be converted to JSON arrays, whereas hashtables, alists and plists are +converted to JSON objects. Hashtable keys must be strings without +embedded null characters and must be unique within each object. Alist +and plist keys must be symbols; if a key is duplicate, the first +instance is used. + +The Lisp equivalents to the JSON null and false values are +configurable in the arguments ARGS, a list of keyword/argument pairs: + +The keyword argument `:null-object' specifies which object to use +to represent a JSON null value. It defaults to `:null'. + +The keyword argument `:false-object' specifies which object to use to +represent a JSON false value. It defaults to `:false'. + +In you specify the same value for `:null-object' and `:false-object', +a potentially ambiguous situation, the JSON output will not contain +any JSON false values. +usage: (json-serialize STRING &rest ARGS) */) + (ptrdiff_t nargs, Lisp_Object *args) { ptrdiff_t count = SPECPDL_INDEX (); @@ -521,7 +594,10 @@ duplicate, the first instance is used. */) } #endif - json_t *json = lisp_to_json_toplevel (object); + struct json_configuration conf = {json_object_hashtable, QCnull, QCfalse}; + json_parse_args (nargs - 1, args + 1, &conf, false); + + json_t *json = lisp_to_json_toplevel (args[0], &conf); record_unwind_protect_ptr (json_release_object, json); /* If desired, we might want to add the following flags: @@ -577,12 +653,13 @@ json_insert_callback (const char *buffer, size_t size, void *data) return NILP (d->error) ? 0 : -1; } -DEFUN ("json-insert", Fjson_insert, Sjson_insert, 1, 1, NULL, +DEFUN ("json-insert", Fjson_insert, Sjson_insert, 1, MANY, + NULL, doc: /* Insert the JSON representation of OBJECT before point. - This is the same as (insert (json-serialize OBJECT)), but potentially - faster. See the function `json-serialize' for allowed values of - OBJECT. */) - (Lisp_Object object) +This is the same as (insert (json-serialize OBJECT)), but potentially +faster. See the function `json-serialize' for allowed values of +OBJECT. */) + (ptrdiff_t nargs, Lisp_Object *args) { ptrdiff_t count = SPECPDL_INDEX (); @@ -601,7 +678,10 @@ DEFUN ("json-insert", Fjson_insert, Sjson_insert, 1, 1, NULL, } #endif - json_t *json = lisp_to_json (object); + struct json_configuration conf = {json_object_hashtable, QCnull, QCfalse}; + json_parse_args (nargs - 1, args + 1, &conf, false); + + json_t *json = lisp_to_json (args[0], &conf); record_unwind_protect_ptr (json_release_object, json); struct json_insert_data data; @@ -620,18 +700,6 @@ DEFUN ("json-insert", Fjson_insert, Sjson_insert, 1, 1, NULL, return unbind_to (count, Qnil); } -enum json_object_type { - json_object_hashtable, - json_object_alist, - json_object_plist -}; - -struct json_configuration { - enum json_object_type object_type; - Lisp_Object null_object; - Lisp_Object false_object; -}; - /* Convert a JSON object to a Lisp object. */ static _GL_ARG_NONNULL ((1)) Lisp_Object @@ -751,42 +819,6 @@ json_to_lisp (json_t *json, struct json_configuration *conf) emacs_abort (); } -static void -json_parse_args (ptrdiff_t nargs, - Lisp_Object *args, - struct json_configuration *conf) -{ - if ((nargs % 2) != 0) - wrong_type_argument (Qplistp, Flist (nargs, args)); - - /* Start from the back so keyword values appearing - first take precedence. */ - for (ptrdiff_t i = nargs; i > 0; i -= 2) { - Lisp_Object key = args[i - 2]; - Lisp_Object value = args[i - 1]; - if (EQ (key, QCobject_type)) - { - if (EQ (value, Qhash_table)) - conf->object_type = json_object_hashtable; - else if (EQ (value, Qalist)) - conf->object_type = json_object_alist; - else if (EQ (value, Qplist)) - conf->object_type = json_object_plist; - else - wrong_choice (list3 (Qhash_table, Qalist, Qplist), value); - } - else if (EQ (key, QCnull_object)) - conf->null_object = value; - else if (EQ (key, QCfalse_object)) - conf->false_object = value; - else - wrong_choice (list3 (QCobject_type, - QCnull_object, - QCfalse_object), - value); - } -} - DEFUN ("json-parse-string", Fjson_parse_string, Sjson_parse_string, 1, MANY, NULL, doc: /* Parse the JSON STRING into a Lisp object. @@ -808,9 +840,8 @@ to represent a JSON null value. It defaults to `:null'. The keyword argument `:false-object' specifies which object to use to represent a JSON false value. It defaults to `:false'. - -usage: (json-parse-string STRING &rest args) */) - (ptrdiff_t nargs, Lisp_Object *args) +usage: (json-parse-string STRING &rest ARGS) */) + (ptrdiff_t nargs, Lisp_Object *args) { ptrdiff_t count = SPECPDL_INDEX (); @@ -833,7 +864,7 @@ usage: (json-parse-string STRING &rest args) */) Lisp_Object encoded = json_encode (string); check_string_without_embedded_nulls (encoded); struct json_configuration conf = {json_object_hashtable, QCnull, QCfalse}; - json_parse_args (nargs - 1, args + 1, &conf); + json_parse_args (nargs - 1, args + 1, &conf, true); json_error_t error; json_t *object = json_loads (SSDATA (encoded), 0, &error); @@ -882,7 +913,7 @@ DEFUN ("json-parse-buffer", Fjson_parse_buffer, Sjson_parse_buffer, This is similar to `json-parse-string', which see. Move point after the end of the object if parsing was successful. On error, point is not moved. -usage: (json-parse-buffer &rest args) */) +usage: (json-parse-buffer &rest args) */) (ptrdiff_t nargs, Lisp_Object *args) { ptrdiff_t count = SPECPDL_INDEX (); @@ -903,7 +934,7 @@ usage: (json-parse-buffer &rest args) */) #endif struct json_configuration conf = {json_object_hashtable, QCnull, QCfalse}; - json_parse_args (nargs, args, &conf); + json_parse_args (nargs, args, &conf, true); ptrdiff_t point = PT_BYTE; struct json_read_buffer_data data = {.point = point}; diff --git a/test/src/json-tests.el b/test/src/json-tests.el index 918b2336d0..ffa6fe19f9 100644 --- a/test/src/json-tests.el +++ b/test/src/json-tests.el @@ -26,8 +26,8 @@ (require 'cl-lib) (require 'map) -(declare-function json-serialize "json.c" (object)) -(declare-function json-insert "json.c" (object)) +(declare-function json-serialize "json.c" (object &rest args)) +(declare-function json-insert "json.c" (object &rest args)) (declare-function json-parse-string "json.c" (string &rest args)) (declare-function json-parse-buffer "json.c" (&rest args)) @@ -210,8 +210,10 @@ Test with both unibyte and multibyte strings." (should (looking-at-p (rx " [456]" eos))))) (ert-deftest json-parse-with-custom-null-and-false-objects () - (let ((input - "{ \"abc\" : [1, 2, true], \"def\" : null, \"abc\" : [9, false] }\n")) + (let* ((input + "{ \"abc\" : [9, false] , \"def\" : null }") + (output + (replace-regexp-in-string " " "" input))) (should (equal (json-parse-string input :object-type 'plist :null-object :json-null @@ -236,7 +238,13 @@ Test with both unibyte and multibyte strings." :false-object thingy :null-object nil))) (should (equal retval `((abc . [9 ,thingy]) (def)))) - (should (eq (elt (cdr (car retval)) 1) thingy))))) + (should (eq (elt (cdr (car retval)) 1) thingy))) + (should (equal output + (json-serialize '((abc . [9 :myfalse]) (def . :mynull)) + :false-object :myfalse + :null-object :mynull))) + ;; :object-type is not allowed in json-serialize + (should-error (json-serialize '() :object-type 'alist)))) (ert-deftest json-insert/signal () (skip-unless (fboundp 'json-insert)) commit 9348039ed45c8e493e8bfef0220249d4d31ef6da Author: JoĂŁo Távora <joaotavora@gmail.com> Date: Thu Jun 7 17:41:19 2018 +0100 Support custom null and false objects when parsing JSON * doc/lispref/text.texi (Parsing JSON): Describe new :null-object and :false-object kwargs to json-parse-string and json-parse-buffer. * src/json.c (struct json_configuration): New type. (json_to_lisp): Accept a struct json_configuration* param. (json_parse_args): Rename from json_parse_object_type. (Fjson_parse_string): Rework docstring. (Fjson_parse_string, Fjson_parse_buffer): Update call to json_to_lisp. (syms_of_json): Two new syms, QCnull_object and QCfalse_object. * test/src/json-tests.el (json-parse-with-custom-null-and-false-objects): New test. diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 2c5b5a1b42..5b94580827 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -5008,9 +5008,10 @@ Specifically: @itemize @item -JSON has a couple of keywords: @code{null}, @code{false}, and -@code{true}. These are represented in Lisp using the keywords -@code{:null}, @code{:false}, and @code{t}, respectively. +JSON uses three keywords: @code{true}, @code{null}, @code{false}. +@code{true} is represented by the symbol @code{t}. By default, the +remaining two are represented, respectively, by the symbols +@code{:null} and @code{:false}. @item JSON only has floating-point numbers. They can represent both Lisp @@ -5062,14 +5063,6 @@ JSON. The subobjects within these top-level values can be of any type. Likewise, the parsing functions will only return vectors, hashtables, alists, and plists. - The parsing functions accept keyword arguments. Currently only one -keyword argument, @code{:object-type}, is recognized; its value -decides which Lisp object to use for representing the key-value -mappings of a JSON object. It can be either @code{hash-table}, the -default, to make hashtables with strings as keys, @code{alist} to use -alists with symbols as keys or @code{plist} to use plists with keyword -symbols as keys. - @defun json-serialize object This function returns a new Lisp string which contains the JSON representation of @var{object}. @@ -5080,16 +5073,38 @@ This function inserts the JSON representation of @var{object} into the current buffer before point. @end defun -@defun json-parse-string string &key (object-type @code{hash-table}) +@defun json-parse-string string &rest args This function parses the JSON value in @var{string}, which must be a -Lisp string. +Lisp string. The argument @var{args} is a list of keyword/argument +pairs. The following keywords are accepted: + +@itemize + +@item @code{:object-type} +The value decides which Lisp object to use for representing the +key-value mappings of a JSON object. It can be either +@code{hash-table}, the default, to make hashtables with strings as +keys; @code{alist} to use alists with symbols as keys; or @code{plist} +to use plists with keyword symbols as keys. + +@item @code{:null-object} +The value decides which Lisp object to use to represent the JSON +keyword @code{null}. It defaults to the lisp symbol @code{:null}. + +@item @code{:false-object} +The value decides which Lisp object to use to represent the JSON +keyword @code{false}. It defaults to the lisp symbol @code{:false}. + +@end itemize + @end defun -@defun json-parse-buffer &key (object-type @code{hash-table}) +@defun json-parse-buffer &rest args This function reads the next JSON value from the current buffer, starting at point. It moves point to the position immediately after the value if a value could be read and converted to Lisp; otherwise it -doesn't move point. +doesn't move point. @var{args} is interpreted as in +@code{json-parse-string}. @end defun diff --git a/src/json.c b/src/json.c index c28e14d63c..e86ef237d0 100644 --- a/src/json.c +++ b/src/json.c @@ -7,7 +7,7 @@ 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. +nyour 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 @@ -502,7 +502,7 @@ and plists are converted to JSON objects. Hashtable keys must be strings without embedded null characters and must be unique within each object. Alist and plist keys must be symbols; if a key is duplicate, the first instance is used. */) - (Lisp_Object object) + (Lisp_Object object) { ptrdiff_t count = SPECPDL_INDEX (); @@ -579,10 +579,10 @@ json_insert_callback (const char *buffer, size_t size, void *data) DEFUN ("json-insert", Fjson_insert, Sjson_insert, 1, 1, NULL, doc: /* Insert the JSON representation of OBJECT before point. -This is the same as (insert (json-serialize OBJECT)), but potentially -faster. See the function `json-serialize' for allowed values of -OBJECT. */) - (Lisp_Object object) + This is the same as (insert (json-serialize OBJECT)), but potentially + faster. See the function `json-serialize' for allowed values of + OBJECT. */) + (Lisp_Object object) { ptrdiff_t count = SPECPDL_INDEX (); @@ -621,22 +621,28 @@ OBJECT. */) } enum json_object_type { - json_object_hashtable, - json_object_alist, - json_object_plist + json_object_hashtable, + json_object_alist, + json_object_plist +}; + +struct json_configuration { + enum json_object_type object_type; + Lisp_Object null_object; + Lisp_Object false_object; }; /* Convert a JSON object to a Lisp object. */ static _GL_ARG_NONNULL ((1)) Lisp_Object -json_to_lisp (json_t *json, enum json_object_type object_type) +json_to_lisp (json_t *json, struct json_configuration *conf) { switch (json_typeof (json)) { case JSON_NULL: - return QCnull; + return conf->null_object; case JSON_FALSE: - return QCfalse; + return conf->false_object; case JSON_TRUE: return Qt; case JSON_INTEGER: @@ -644,9 +650,9 @@ json_to_lisp (json_t *json, enum json_object_type object_type) otherwise. This loses precision for integers with large magnitude; however, such integers tend to be nonportable anyway because many JSON implementations use only 64-bit - floating-point numbers with 53 mantissa bits. See - https://tools.ietf.org/html/rfc7159#section-6 for some - discussion. */ + floating-point numbers with 53 mantissa bits. See + https://tools.ietf.org/html/rfc7159#section-6 for some + discussion. */ return make_fixnum_or_float (json_integer_value (json)); case JSON_REAL: return make_float (json_real_value (json)); @@ -663,7 +669,7 @@ json_to_lisp (json_t *json, enum json_object_type object_type) Lisp_Object result = Fmake_vector (make_natnum (size), Qunbound); for (ptrdiff_t i = 0; i < size; ++i) ASET (result, i, - json_to_lisp (json_array_get (json, i), object_type)); + json_to_lisp (json_array_get (json, i), conf)); --lisp_eval_depth; return result; } @@ -672,7 +678,7 @@ json_to_lisp (json_t *json, enum json_object_type object_type) if (++lisp_eval_depth > max_lisp_eval_depth) xsignal0 (Qjson_object_too_deep); Lisp_Object result; - switch (object_type) + switch (conf->object_type) { case json_object_hashtable: { @@ -692,7 +698,7 @@ json_to_lisp (json_t *json, enum json_object_type object_type) /* Keys in JSON objects are unique, so the key can't be present yet. */ eassert (i < 0); - hash_put (h, key, json_to_lisp (value, object_type), hash); + hash_put (h, key, json_to_lisp (value, conf), hash); } break; } @@ -705,7 +711,7 @@ json_to_lisp (json_t *json, enum json_object_type object_type) { Lisp_Object key = Fintern (json_build_string (key_str), Qnil); result - = Fcons (Fcons (key, json_to_lisp (value, object_type)), + = Fcons (Fcons (key, json_to_lisp (value, conf)), result); } result = Fnreverse (result); @@ -727,7 +733,7 @@ json_to_lisp (json_t *json, enum json_object_type object_type) /* Build the plist as value-key since we're going to reverse it in the end.*/ result = Fcons (key, result); - result = Fcons (json_to_lisp (value, object_type), result); + result = Fcons (json_to_lisp (value, conf), result); SAFE_FREE (); } result = Fnreverse (result); @@ -745,47 +751,66 @@ json_to_lisp (json_t *json, enum json_object_type object_type) emacs_abort (); } -static enum json_object_type -json_parse_object_type (ptrdiff_t nargs, Lisp_Object *args) -{ - switch (nargs) - { - case 0: - return json_object_hashtable; - case 2: +static void +json_parse_args (ptrdiff_t nargs, + Lisp_Object *args, + struct json_configuration *conf) +{ + if ((nargs % 2) != 0) + wrong_type_argument (Qplistp, Flist (nargs, args)); + + /* Start from the back so keyword values appearing + first take precedence. */ + for (ptrdiff_t i = nargs; i > 0; i -= 2) { + Lisp_Object key = args[i - 2]; + Lisp_Object value = args[i - 1]; + if (EQ (key, QCobject_type)) { - Lisp_Object key = args[0]; - Lisp_Object value = args[1]; - if (!EQ (key, QCobject_type)) - wrong_choice (list1 (QCobject_type), key); if (EQ (value, Qhash_table)) - return json_object_hashtable; + conf->object_type = json_object_hashtable; else if (EQ (value, Qalist)) - return json_object_alist; + conf->object_type = json_object_alist; else if (EQ (value, Qplist)) - return json_object_plist; + conf->object_type = json_object_plist; else wrong_choice (list3 (Qhash_table, Qalist, Qplist), value); } - default: - wrong_type_argument (Qplistp, Flist (nargs, args)); - } + else if (EQ (key, QCnull_object)) + conf->null_object = value; + else if (EQ (key, QCfalse_object)) + conf->false_object = value; + else + wrong_choice (list3 (QCobject_type, + QCnull_object, + QCfalse_object), + value); + } } DEFUN ("json-parse-string", Fjson_parse_string, Sjson_parse_string, 1, MANY, NULL, doc: /* Parse the JSON STRING into a Lisp object. + This is essentially the reverse operation of `json-serialize', which see. The returned object will be a vector, hashtable, alist, or -plist. Its elements will be `:null', `:false', t, numbers, strings, -or further vectors, hashtables, alists, or plists. If there are -duplicate keys in an object, all but the last one are ignored. If -STRING doesn't contain a valid JSON object, an error of type -`json-parse-error' is signaled. The keyword argument `:object-type' -specifies which Lisp type is used to represent objects; it can be -`hash-table', `alist' or `plist'. -usage: (json-parse-string STRING &key (OBJECT-TYPE \\='hash-table)) */) - (ptrdiff_t nargs, Lisp_Object *args) +plist. Its elements will be the JSON null value, the JSON false +value, t, numbers, strings, or further vectors, hashtables, alists, or +plists. If there are duplicate keys in an object, all but the last +one are ignored. If STRING doesn't contain a valid JSON object, an +error of type `json-parse-error' is signaled. The arguments ARGS are +a list of keyword/argument pairs: + +The keyword argument `:object-type' specifies which Lisp type is used +to represent objects; it can be `hash-table', `alist' or `plist'. + +The keyword argument `:null-object' specifies which object to use +to represent a JSON null value. It defaults to `:null'. + +The keyword argument `:false-object' specifies which object to use to +represent a JSON false value. It defaults to `:false'. + +usage: (json-parse-string STRING &rest args) */) + (ptrdiff_t nargs, Lisp_Object *args) { ptrdiff_t count = SPECPDL_INDEX (); @@ -807,8 +832,8 @@ usage: (json-parse-string STRING &key (OBJECT-TYPE \\='hash-table)) */) Lisp_Object string = args[0]; Lisp_Object encoded = json_encode (string); check_string_without_embedded_nulls (encoded); - enum json_object_type object_type - = json_parse_object_type (nargs - 1, args + 1); + struct json_configuration conf = {json_object_hashtable, QCnull, QCfalse}; + json_parse_args (nargs - 1, args + 1, &conf); json_error_t error; json_t *object = json_loads (SSDATA (encoded), 0, &error); @@ -819,7 +844,7 @@ usage: (json-parse-string STRING &key (OBJECT-TYPE \\='hash-table)) */) if (object != NULL) record_unwind_protect_ptr (json_release_object, object); - return unbind_to (count, json_to_lisp (object, object_type)); + return unbind_to (count, json_to_lisp (object, &conf)); } struct json_read_buffer_data @@ -857,8 +882,8 @@ DEFUN ("json-parse-buffer", Fjson_parse_buffer, Sjson_parse_buffer, This is similar to `json-parse-string', which see. Move point after the end of the object if parsing was successful. On error, point is not moved. -usage: (json-parse-buffer &key (OBJECT-TYPE \\='hash-table)) */) - (ptrdiff_t nargs, Lisp_Object *args) +usage: (json-parse-buffer &rest args) */) + (ptrdiff_t nargs, Lisp_Object *args) { ptrdiff_t count = SPECPDL_INDEX (); @@ -877,7 +902,8 @@ usage: (json-parse-buffer &key (OBJECT-TYPE \\='hash-table)) */) } #endif - enum json_object_type object_type = json_parse_object_type (nargs, args); + struct json_configuration conf = {json_object_hashtable, QCnull, QCfalse}; + json_parse_args (nargs, args, &conf); ptrdiff_t point = PT_BYTE; struct json_read_buffer_data data = {.point = point}; @@ -892,7 +918,7 @@ usage: (json-parse-buffer &key (OBJECT-TYPE \\='hash-table)) */) record_unwind_protect_ptr (json_release_object, object); /* Convert and then move point only if everything succeeded. */ - Lisp_Object lisp = json_to_lisp (object, object_type); + Lisp_Object lisp = json_to_lisp (object, &conf); /* Adjust point by how much we just read. */ point += error.position; @@ -955,6 +981,8 @@ syms_of_json (void) Fput (Qjson_parse_string, Qside_effect_free, Qt); DEFSYM (QCobject_type, ":object-type"); + DEFSYM (QCnull_object, ":null-object"); + DEFSYM (QCfalse_object, ":false-object"); DEFSYM (Qalist, "alist"); DEFSYM (Qplist, "plist"); diff --git a/test/src/json-tests.el b/test/src/json-tests.el index 7a193545b1..918b2336d0 100644 --- a/test/src/json-tests.el +++ b/test/src/json-tests.el @@ -209,6 +209,35 @@ Test with both unibyte and multibyte strings." (should-not (bobp)) (should (looking-at-p (rx " [456]" eos))))) +(ert-deftest json-parse-with-custom-null-and-false-objects () + (let ((input + "{ \"abc\" : [1, 2, true], \"def\" : null, \"abc\" : [9, false] }\n")) + (should (equal (json-parse-string input + :object-type 'plist + :null-object :json-null + :false-object :json-false) + '(:abc [9 :json-false] :def :json-null))) + (should (equal (json-parse-string input + :object-type 'plist + :false-object :json-false) + '(:abc [9 :json-false] :def :null))) + (should (equal (json-parse-string input + :object-type 'alist + :null-object :zilch) + '((abc . [9 :false]) (def . :zilch)))) + (should (equal (json-parse-string input + :object-type 'alist + :false-object nil + :null-object nil) + '((abc . [9 nil]) (def)))) + (let* ((thingy '(1 2 3)) + (retval (json-parse-string input + :object-type 'alist + :false-object thingy + :null-object nil))) + (should (equal retval `((abc . [9 ,thingy]) (def)))) + (should (eq (elt (cdr (car retval)) 1) thingy))))) + (ert-deftest json-insert/signal () (skip-unless (fboundp 'json-insert)) (with-temp-buffer commit b635c548c681532335b89b39e0642ecdf7bf1d9c Author: Paul Eggert <eggert@cs.ucla.edu> Date: Sat May 26 13:29:06 2018 -0700 Don’t set EMACS=t if Bash is 4.4 or newer (Backport from master.) (Thanks to Stefan Monnier for improvements to this patch.) * lisp/term.el (term--bash-needs-EMACS-status): New var. (term--bash-needs-EMACSp): New function. (term-exec-1): Use it instead of always setting EMACS. diff --git a/lisp/term.el b/lisp/term.el index 60cd547f93..b7f5b0e7f2 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -1520,6 +1520,31 @@ Using \"emacs\" loses, because bash disables editing if $TERM == emacs.") ;; don't define :te=\\E[2J\\E[?47l\\E8:ti=\\E7\\E[?47h\ "Termcap capabilities supported.") +;; This private hack is for backwards compatibility with Bash 4.3 and earlier. +;; It can be useful even when running a program other than Bash, as the +;; program might invoke Bash as an interactive subshell. See this thread: +;; https://lists.gnu.org/r/emacs-devel/2018-05/msg00670.html +;; Remove this hack and its uses once Bash 4.4-or-later is reasonably +;; universal, because it slows down execution slightly when +;; term--bash-needs-EMACSp is first called. +(defvar term--bash-needs-EMACS-status nil + "43 if Bash is so old that it needs EMACS set. +Some other integer if Bash is new or not in use. +Nil if unknown.") +(defun term--bash-needs-EMACSp () + "t if Bash is old, nil if it is new or not in use." + (eq 43 + (or term--bash-needs-EMACS-status + (setf + term--bash-needs-EMACS-status + (let ((process-environment + (cons "BASH_ENV" process-environment))) + (condition-case nil + (call-process + "bash" nil nil nil "-c" + "case $BASH_VERSION in [0123].*|4.[0123].*) exit 43;; esac") + (error 0))))))) + ;; This auxiliary function cranks up the process for term-exec in ;; the appropriate environment. @@ -1537,12 +1562,6 @@ Using \"emacs\" loses, because bash disables editing if $TERM == emacs.") (format term-termcap-format "TERMCAP=" term-term-name term-height term-width) - ;; This is for backwards compatibility with Bash 4.3 and earlier. - ;; Remove this hack once Bash 4.4-or-later is common, because - ;; it breaks './configure' of some packages that expect it to - ;; say where to find EMACS. - (format "EMACS=%s (term:%s)" emacs-version term-protocol-version) - (format "INSIDE_EMACS=%s,term:%s" emacs-version term-protocol-version) (format "LINES=%d" term-height) (format "COLUMNS=%d" term-width)) @@ -1554,6 +1573,9 @@ Using \"emacs\" loses, because bash disables editing if $TERM == emacs.") ;; escape codes, so we need to see the raw output. We will have to ;; do the decoding by hand on the parts that are made of chars. (coding-system-for-read 'binary)) + (when (term--bash-needs-EMACSp) + (push (format "EMACS=%s (term:%s)" emacs-version term-protocol-version) + process-environment)) (apply 'start-process name buffer "/bin/sh" "-c" (format "stty -nl echo rows %d columns %d sane 2>/dev/null;\ commit a933ebef57cde64c90fd6d92ae34eabd705f100a Author: Eli Zaretskii <eliz@gnu.org> Date: Thu Jun 14 16:54:08 2018 +0300 Improve commentary in info.el * lisp/info.el: Explain in commentary why some commands start with "info-" and others with "Info-". See also http://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00482.html. diff --git a/lisp/info.el b/lisp/info.el index 8743b44997..30df4bfe5c 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -30,6 +30,15 @@ ;; This distinction is to support indexing of computer programming ;; language terms that may contain ":" but not ": ". +;; The commands in this file should start either with "Info-" or with +;; "info-". The capitalized version is for commands that are bound to +;; keys, and therefore are unlikely to be invoked by name via "M-x"; +;; the lower-case version is for commands invoked by name. This +;; arrangement makes completion of "info-" commands work better, +;; because the "Info-" commands (of which there are a lot) don't get +;; in the way. Please adhere to this convention when you add commands +;; here. + ;;; Code: (eval-when-compile (require 'cl-lib)) commit 8cb9beb32163fa3ce3b052ced646fd673814ddc6 Author: Damien Cassou <damien@cassou.me> Date: Sat May 19 08:36:32 2018 +0200 Fix pretty-printing empty objects as null * lisp/json.el (json-pretty-print): Force distinction between empty objects and null. (json-encode-list): Remove responsibility to print "null" as this value is not a list. (json-encode): Give higher precedence to lists so that an empty list is printed as an empty object, not as "null". * test/lisp/json-tests.el (test-json-encode): Add many tests to check the behavior of pretty-printing. diff --git a/lisp/json.el b/lisp/json.el index d374f452e6..cd95ec2832 100644 --- a/lisp/json.el +++ b/lisp/json.el @@ -609,8 +609,7 @@ Please see the documentation of `json-object-type' and `json-key-type'." "Return a JSON representation of LIST. Tries to DWIM: simple lists become JSON arrays, while alists and plists become JSON objects." - (cond ((null list) "null") - ((json-alist-p list) (json-encode-alist list)) + (cond ((json-alist-p list) (json-encode-alist list)) ((json-plist-p list) (json-encode-plist list)) ((listp list) (json-encode-array list)) (t @@ -723,12 +722,12 @@ Advances point just past JSON object." ((stringp object) (json-encode-string object)) ((keywordp object) (json-encode-string (substring (symbol-name object) 1))) + ((listp object) (json-encode-list object)) ((symbolp object) (json-encode-string (symbol-name object))) ((numberp object) (json-encode-number object)) ((arrayp object) (json-encode-array object)) ((hash-table-p object) (json-encode-hash-table object)) - ((listp object) (json-encode-list object)) (t (signal 'json-error (list object))))) ;; Pretty printing @@ -743,6 +742,8 @@ Advances point just past JSON object." (interactive "r") (atomic-change-group (let ((json-encoding-pretty-print t) + ;; Distinguish an empty objects from 'null' + (json-null :json-null) ;; Ensure that ordering is maintained (json-object-type 'alist) (txt (delete-and-extract-region begin end))) diff --git a/test/lisp/json-tests.el b/test/lisp/json-tests.el index ea562e8b13..84039c09ce 100644 --- a/test/lisp/json-tests.el +++ b/test/lisp/json-tests.el @@ -325,5 +325,72 @@ Point is moved to beginning of the buffer." (with-temp-buffer (should-error (json-encode (current-buffer)) :type 'json-error))) +;;; Pretty-print + +(defun json-tests-equal-pretty-print (original &optional expected) + "Abort current test if pretty-printing ORIGINAL does not yield EXPECTED. + +Both ORIGINAL and EXPECTED should be strings. If EXPECTED is +nil, ORIGINAL should stay unchanged by pretty-printing." + (with-temp-buffer + (insert original) + (json-pretty-print-buffer) + (should (equal (buffer-string) (or expected original))))) + +(ert-deftest test-json-pretty-print-string () + (json-tests-equal-pretty-print "\"\"") + (json-tests-equal-pretty-print "\"foo\"")) + +(ert-deftest test-json-pretty-print-atom () + (json-tests-equal-pretty-print "true") + (json-tests-equal-pretty-print "false") + (json-tests-equal-pretty-print "null")) + +(ert-deftest test-json-pretty-print-number () + (json-tests-equal-pretty-print "123") + (json-tests-equal-pretty-print "0.123")) + +(ert-deftest test-json-pretty-print-object () + ;; empty (regression test for bug#24252) + (json-tests-equal-pretty-print + "{}" + "{\n}") + ;; one pair + (json-tests-equal-pretty-print + "{\"key\":1}" + "{\n \"key\": 1\n}") + ;; two pairs + (json-tests-equal-pretty-print + "{\"key1\":1,\"key2\":2}" + "{\n \"key1\": 1,\n \"key2\": 2\n}") + ;; embedded object + (json-tests-equal-pretty-print + "{\"foo\":{\"key\":1}}" + "{\n \"foo\": {\n \"key\": 1\n }\n}") + ;; embedded array + (json-tests-equal-pretty-print + "{\"key\":[1,2]}" + "{\n \"key\": [\n 1,\n 2\n ]\n}")) + +(ert-deftest test-json-pretty-print-array () + ;; empty + (json-tests-equal-pretty-print "[]") + ;; one item + (json-tests-equal-pretty-print + "[1]" + "[\n 1\n]") + ;; two items + (json-tests-equal-pretty-print + "[1,2]" + "[\n 1,\n 2\n]") + ;; embedded object + (json-tests-equal-pretty-print + "[{\"key\":1}]" + "[\n {\n \"key\": 1\n }\n]") + ;; embedded array + (json-tests-equal-pretty-print + "[[1,2]]" + "[\n [\n 1,\n 2\n ]\n]")) + (provide 'json-tests) ;;; json-tests.el ends here commit 967d2c55ef3908fd378e05b2a0070663ae45f6de Author: Paul Eggert <eggert@cs.ucla.edu> Date: Wed Jun 13 13:30:29 2018 -0700 Remove some wrong 8-byte alignment assumptions Do not assume that 8-byte alignment suffices for all C objects, as some platforms require 16-byte alignment for some objects, and this will start to bite us as time goes on (e.g., if an Emacs module ever uses an object containing a long double, which requires 16-byte alignment on x86-64). Conversely, on !USE_LSB_TAG platforms, do not insist on aligning Lisp objects to a multiple of 8, as this is not needed for high-order tag bits. * src/alloc.c (LISP_ALIGNMENT, MALLOC_IS_LISP_ALIGNED): New constants. (XMALLOC_BASE_ALIGNMENT, XMALLOC_HEADER_ALIGNMENT): Removed. All uses replaced by LISP_ALIGNMENT. (aligned_alloc, laligned, lmalloc, lrealloc, union aligned_Lisp_Misc) (maybe_lisp_pointer, pure_alloc): Use LISP_ALIGNMENT rather than GCALIGNMENT. (aligned_alloc): Do not worry about an alignment of LISP_ALIGNMENT when MALLOC_IS_LISP_ALIGNED, as the code never uses aligned_alloc with alignment == LISP_ALIGNMENT in that case. (__alignof__): Remove. All uses removed. (MALLOC_IS_GC_ALIGNED): Remove. All uses replaced with MALLOC_IS_LISP_ALIGNED. (vector_alignment): Remove. All uses replaced with LISP_ALIGNMENT. * src/alloc.c (mark_maybe_pointer): * src/emacs-module.c (value_to_lisp_bits): Do not assume GCALIGNMENT == 1 << GCTYPEBITS, as GCALIGNMENT is 1 on !USE_LSB_TAG platforms now. * src/lisp.h (GCALIGNMENT) [!USE_LSB_TAG]: Now 1. (struct Lisp_Symbol, union vectorlike_header, struct Lisp_Cons) (struct Lisp_String): Simplify test for verifying alignment. diff --git a/src/alloc.c b/src/alloc.c index cde2e4b340..e5fc6ebeb1 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -633,6 +633,27 @@ buffer_memory_full (ptrdiff_t nbytes) #define COMMON_MULTIPLE(a, b) \ ((a) % (b) == 0 ? (a) : (b) % (a) == 0 ? (b) : (a) * (b)) +/* LISP_ALIGNMENT is the alignment of Lisp objects. It must be at + least GCALIGNMENT so that pointers can be tagged. It also must be + at least as strict as the alignment of all the C types used to + implement Lisp objects; since pseudovectors can contain any C type, + this is max_align_t. On recent GNU/Linux x86 and x86-64 this can + often waste up to 8 bytes, since alignof (max_align_t) is 16 but + typical vectors need only an alignment of 8. However, it is not + worth the hassle to avoid this waste. */ +enum { LISP_ALIGNMENT = alignof (union { max_align_t x; GCALIGNED_UNION }) }; +verify (LISP_ALIGNMENT % GCALIGNMENT == 0); + +/* True if malloc (N) is known to return storage suitably aligned for + Lisp objects whenever N is a multiple of LISP_ALIGNMENT. In + practice this is true whenever alignof (max_align_t) is also a + multiple of LISP_ALIGNMENT. This works even for x86, where some + platform combinations (e.g., GCC 7 and later, glibc 2.25 and + earlier) have bugs where alignof (max_align_t) is 16 even though + the malloc alignment is only 8, and where Emacs still works because + it never does anything that requires an alignment of 16. */ +enum { MALLOC_IS_LISP_ALIGNED = alignof (max_align_t) % LISP_ALIGNMENT == 0 }; + #ifndef XMALLOC_OVERRUN_CHECK #define XMALLOC_OVERRUN_CHECK_OVERHEAD 0 #else @@ -653,18 +674,13 @@ buffer_memory_full (ptrdiff_t nbytes) #define XMALLOC_OVERRUN_CHECK_OVERHEAD \ (2 * XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE) -#define XMALLOC_BASE_ALIGNMENT alignof (max_align_t) - -#define XMALLOC_HEADER_ALIGNMENT \ - COMMON_MULTIPLE (GCALIGNMENT, XMALLOC_BASE_ALIGNMENT) - /* Define XMALLOC_OVERRUN_SIZE_SIZE so that (1) it's large enough to hold a size_t value and (2) the header size is a multiple of the alignment that Emacs needs for C types and for USE_LSB_TAG. */ #define XMALLOC_OVERRUN_SIZE_SIZE \ (((XMALLOC_OVERRUN_CHECK_SIZE + sizeof (size_t) \ - + XMALLOC_HEADER_ALIGNMENT - 1) \ - / XMALLOC_HEADER_ALIGNMENT * XMALLOC_HEADER_ALIGNMENT) \ + + LISP_ALIGNMENT - 1) \ + / LISP_ALIGNMENT * LISP_ALIGNMENT) \ - XMALLOC_OVERRUN_CHECK_SIZE) static char const xmalloc_overrun_check_header[XMALLOC_OVERRUN_CHECK_SIZE] = @@ -1165,9 +1181,11 @@ aligned_alloc (size_t alignment, size_t size) Verify this for all arguments this function is given. */ verify (BLOCK_ALIGN % sizeof (void *) == 0 && POWER_OF_2 (BLOCK_ALIGN / sizeof (void *))); - verify (GCALIGNMENT % sizeof (void *) == 0 - && POWER_OF_2 (GCALIGNMENT / sizeof (void *))); - eassert (alignment == BLOCK_ALIGN || alignment == GCALIGNMENT); + verify (MALLOC_IS_LISP_ALIGNED + || (LISP_ALIGNMENT % sizeof (void *) == 0 + && POWER_OF_2 (LISP_ALIGNMENT / sizeof (void *)))); + eassert (alignment == BLOCK_ALIGN + || (!MALLOC_IS_LISP_ALIGNED && alignment == LISP_ALIGNMENT)); void *p; return posix_memalign (&p, alignment, size) == 0 ? p : 0; @@ -1399,31 +1417,15 @@ lisp_align_free (void *block) MALLOC_UNBLOCK_INPUT; } -#if !defined __GNUC__ && !defined __alignof__ -# define __alignof__(type) alignof (type) -#endif - -/* True if malloc (N) is known to return a multiple of GCALIGNMENT - whenever N is also a multiple. In practice this is true if - __alignof__ (max_align_t) is a multiple as well, assuming - GCALIGNMENT is 8; other values of GCALIGNMENT have not been looked - into. Use __alignof__ if available, as otherwise - MALLOC_IS_GC_ALIGNED would be false on GCC x86 even though the - alignment is OK there. - - This is a macro, not an enum constant, for portability to HP-UX - 10.20 cc and AIX 3.2.5 xlc. */ -#define MALLOC_IS_GC_ALIGNED \ - (GCALIGNMENT == 8 && __alignof__ (max_align_t) % GCALIGNMENT == 0) - /* True if a malloc-returned pointer P is suitably aligned for SIZE, - where Lisp alignment may be needed if SIZE is Lisp-aligned. */ + where Lisp object alignment may be needed if SIZE is a multiple of + LISP_ALIGNMENT. */ static bool laligned (void *p, size_t size) { - return (MALLOC_IS_GC_ALIGNED || (intptr_t) p % GCALIGNMENT == 0 - || size % GCALIGNMENT != 0); + return (MALLOC_IS_LISP_ALIGNED || (intptr_t) p % LISP_ALIGNMENT == 0 + || size % LISP_ALIGNMENT != 0); } /* Like malloc and realloc except that if SIZE is Lisp-aligned, make @@ -1446,8 +1448,8 @@ static void * lmalloc (size_t size) { #ifdef USE_ALIGNED_ALLOC - if (! MALLOC_IS_GC_ALIGNED && size % GCALIGNMENT == 0) - return aligned_alloc (GCALIGNMENT, size); + if (! MALLOC_IS_LISP_ALIGNED && size % LISP_ALIGNMENT == 0) + return aligned_alloc (LISP_ALIGNMENT, size); #endif while (true) @@ -1456,7 +1458,7 @@ lmalloc (size_t size) if (laligned (p, size)) return p; free (p); - size_t bigger = size + GCALIGNMENT; + size_t bigger = size + LISP_ALIGNMENT; if (size < bigger) size = bigger; } @@ -1470,7 +1472,7 @@ lrealloc (void *p, size_t size) p = realloc (p, size); if (laligned (p, size)) return p; - size_t bigger = size + GCALIGNMENT; + size_t bigger = size + LISP_ALIGNMENT; if (size < bigger) size = bigger; } @@ -2931,16 +2933,8 @@ set_next_vector (struct Lisp_Vector *v, struct Lisp_Vector *p) #define VECTOR_BLOCK_SIZE 4096 -/* Alignment of struct Lisp_Vector objects. Because pseudovectors - can contain any C type, align at least as strictly as - max_align_t. On x86 and x86-64 this can waste up to 8 bytes - for typical vectors, since alignof (max_align_t) is 16 but - typical vectors need only an alignment of 8. However, it is - not worth the hassle to avoid wasting those bytes. */ -enum {vector_alignment = COMMON_MULTIPLE (alignof (max_align_t), GCALIGNMENT)}; - /* Vector size requests are a multiple of this. */ -enum { roundup_size = COMMON_MULTIPLE (vector_alignment, word_size) }; +enum { roundup_size = COMMON_MULTIPLE (LISP_ALIGNMENT, word_size) }; /* Verify assumptions described above. */ verify (VECTOR_BLOCK_SIZE % roundup_size == 0); @@ -3007,7 +3001,7 @@ struct large_vector enum { - large_vector_offset = ROUNDUP (sizeof (struct large_vector), vector_alignment) + large_vector_offset = ROUNDUP (sizeof (struct large_vector), LISP_ALIGNMENT) }; static struct Lisp_Vector * @@ -3656,8 +3650,8 @@ Its value is void, and its function definition and property list are nil. */) union aligned_Lisp_Misc { union Lisp_Misc m; - unsigned char c[(sizeof (union Lisp_Misc) + GCALIGNMENT - 1) - & -GCALIGNMENT]; + unsigned char c[(sizeof (union Lisp_Misc) + LISP_ALIGNMENT - 1) + & -LISP_ALIGNMENT]; }; /* Allocation of markers and other objects that share that structure. @@ -4851,14 +4845,16 @@ mark_maybe_object (Lisp_Object obj) } } -/* Return true if P can point to Lisp data, and false otherwise. +/* Return true if P might point to Lisp data that can be garbage + collected, and false otherwise (i.e., false if it is easy to see + that P cannot point to Lisp data that can be garbage collected). Symbols are implemented via offsets not pointers, but the offsets - are also multiples of GCALIGNMENT. */ + are also multiples of LISP_ALIGNMENT. */ static bool maybe_lisp_pointer (void *p) { - return (uintptr_t) p % GCALIGNMENT == 0; + return (uintptr_t) p % LISP_ALIGNMENT == 0; } #ifndef HAVE_MODULES @@ -4887,7 +4883,7 @@ mark_maybe_pointer (void *p) { /* For the wide-int case, also mark emacs_value tagged pointers, which can be generated by emacs-module.c's value_to_lisp. */ - p = (void *) ((uintptr_t) p & ~(GCALIGNMENT - 1)); + p = (void *) ((uintptr_t) p & ~((1 << GCTYPEBITS) - 1)); } m = mem_find (p); @@ -5358,7 +5354,7 @@ pure_alloc (size_t size, int type) { /* Allocate space for a Lisp object from the beginning of the free space with taking account of alignment. */ - result = pointer_align (purebeg + pure_bytes_used_lisp, GCALIGNMENT); + result = pointer_align (purebeg + pure_bytes_used_lisp, LISP_ALIGNMENT); pure_bytes_used_lisp = ((char *)result - (char *)purebeg) + size; } else diff --git a/src/emacs-module.c b/src/emacs-module.c index 956706cf9f..c18c7ab308 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -924,7 +924,7 @@ value_to_lisp_bits (emacs_value v) makes TAG_PTR faster. */ intptr_t i = (intptr_t) v; - EMACS_UINT tag = i & (GCALIGNMENT - 1); + EMACS_UINT tag = i & ((1 << GCTYPEBITS) - 1); EMACS_UINT untagged = i - tag; switch (tag) { diff --git a/src/lisp.h b/src/lisp.h index d449984605..aaad90b2da 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -233,10 +233,6 @@ extern bool suppress_checking EXTERNALLY_VISIBLE; enum Lisp_Bits { - /* 2**GCTYPEBITS. This must be a macro that expands to a literal - integer constant, for older versions of GCC (through at least 4.9). */ -#define GCALIGNMENT 8 - /* Number of bits in a Lisp_Object value, not counting the tag. */ VALBITS = EMACS_INT_WIDTH - GCTYPEBITS, @@ -247,10 +243,6 @@ enum Lisp_Bits FIXNUM_BITS = VALBITS + 1 }; -#if GCALIGNMENT != 1 << GCTYPEBITS -# error "GCALIGNMENT and GCTYPEBITS are inconsistent" -#endif - /* The maximum value that can be stored in a EMACS_INT, assuming all bits other than the type bits contribute to a nonnegative signed value. This can be used in #if, e.g., '#if USE_LSB_TAG' below expands to an @@ -277,12 +269,21 @@ DEFINE_GDB_SYMBOL_END (VALMASK) error !; #endif +/* Minimum alignment requirement for Lisp objects, imposed by the + internal representation of tagged pointers. It is 2**GCTYPEBITS if + USE_LSB_TAG, 1 otherwise. It must be a literal integer constant, + for older versions of GCC (through at least 4.9). */ #if USE_LSB_TAG -# define GCALIGNED_UNION char alignas (GCALIGNMENT) gcaligned; +# define GCALIGNMENT 8 +# if GCALIGNMENT != 1 << GCTYPEBITS +# error "GCALIGNMENT and GCTYPEBITS are inconsistent" +# endif #else -# define GCALIGNED_UNION +# define GCALIGNMENT 1 #endif +#define GCALIGNED_UNION char alignas (GCALIGNMENT) gcaligned; + /* Lisp_Word is a scalar word suitable for holding a tagged pointer or integer. Usually it is a pointer to a deliberately-incomplete type 'union Lisp_X'. However, it is EMACS_INT when Lisp_Objects and @@ -774,7 +775,7 @@ struct Lisp_Symbol GCALIGNED_UNION } u; }; -verify (!USE_LSB_TAG || alignof (struct Lisp_Symbol) % GCALIGNMENT == 0); +verify (alignof (struct Lisp_Symbol) % GCALIGNMENT == 0); /* Declare a Lisp-callable function. The MAXARGS parameter has the same meaning as in the DEFUN macro, and is used to construct a prototype. */ @@ -888,7 +889,7 @@ union vectorlike_header ptrdiff_t size; GCALIGNED_UNION }; -verify (!USE_LSB_TAG || alignof (union vectorlike_header) % GCALIGNMENT == 0); +verify (alignof (union vectorlike_header) % GCALIGNMENT == 0); INLINE bool (SYMBOLP) (Lisp_Object x) @@ -1249,7 +1250,7 @@ struct Lisp_Cons GCALIGNED_UNION } u; }; -verify (!USE_LSB_TAG || alignof (struct Lisp_Cons) % GCALIGNMENT == 0); +verify (alignof (struct Lisp_Cons) % GCALIGNMENT == 0); INLINE bool (NILP) (Lisp_Object x) @@ -1371,7 +1372,7 @@ struct Lisp_String GCALIGNED_UNION } u; }; -verify (!USE_LSB_TAG || alignof (struct Lisp_String) % GCALIGNMENT == 0); +verify (alignof (struct Lisp_String) % GCALIGNMENT == 0); INLINE bool STRINGP (Lisp_Object x) commit 94e84a92fee4f7015ceedc0e39c767d72facb0e2 Author: Michael Albinus <michael.albinus@gmx.de> Date: Wed Jun 13 10:28:39 2018 +0200 ; Further wording fix in tramp.texi diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 1dd91727ad..4115d40340 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -3551,6 +3551,8 @@ The reduced typing: @kbd{C-x C-f /xy @key{RET}}. @strong{Note} that file name cannot be edited here because the abbreviations are not expanded during editing in the minibuffer. +Furthermore, the abbreviation is not expanded during @key{TAB} +completion. @item Define own abbreviation (2): commit a5a0b11186656dd406e425f314f28c0338354d6e Author: Michael Albinus <michael.albinus@gmx.de> Date: Wed Jun 13 09:34:35 2018 +0200 Fix wording in tramp.texi * doc/misc/tramp.texi (Frequently Asked Questions): Fix wording for abbreviations. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 0e171277e7..1dd91727ad 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -3550,8 +3550,7 @@ Abbreviation list expansion can be used to reduce typing long file names: The reduced typing: @kbd{C-x C-f /xy @key{RET}}. @strong{Note} that file name cannot be edited here because the -environment variables are not expanded during editing in the -minibuffer. +abbreviations are not expanded during editing in the minibuffer. @item Define own abbreviation (2): commit 29332428f1e850fb92169d23540bbb6598638793 Author: Michael Albinus <michael.albinus@gmx.de> Date: Wed Jun 13 09:21:29 2018 +0200 * doc/misc/tramp.texi (Remote shell setup): Fix typo. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index a00f2f249b..0e171277e7 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -1919,7 +1919,7 @@ Another possibility is to check the environment variable to the version of the parent Emacs process, @xref{Interactive Shell, , , emacs}. @value{tramp} adds its own package version to this string, which could be used for further tests in an inferior shell. The -string of that environment variable loooks always like +string of that environment variable looks always like @example @group commit 6d4cbe80844a56e0b469fd6304ab7f24daa3d3af Author: Sam Steingold <sds@gnu.org> Date: Fri Nov 3 12:00:35 2017 -0400 Finish the Bug#11728 work: hg & git * lisp/vc/vc-git.el (vc-git--pushpull): Make `extra-args' a list. Do not set `compilation-error-regexp-alist', this is done in `vc-compilation-mode'. (vc-git-error-regexp-alist): Tweak the regexp. * lisp/vc/vc-hg.el (vc-hg-error-regexp-alist): Make non-trivial. (vc-hg--pushpull): Accept `post-processing' argument. Call them after the `command'. (vc-hg-pull): Pass the `post-processing' commands that show which are to be modified by the `update', and then run `update'. diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 6650c5d764..c6b08e942f 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -860,7 +860,7 @@ It is based on `log-edit-mode', and has Git-specific extensions.") (vc-git-command nil nil file "checkout" "-q" "--"))) (defvar vc-git-error-regexp-alist - '(("^ \\(.+\\) |" 1 nil nil 0)) + '(("^ \\(.+\\)\\> *|" 1 nil nil 0)) "Value of `compilation-error-regexp-alist' in *vc-git* buffers.") ;; To be called via vc-pull from vc.el, which requires vc-dispatcher. @@ -885,17 +885,16 @@ If PROMPT is non-nil, prompt for the Git command to run." (setq git-program (car args) command (cadr args) args (cddr args))) + (setq args (nconc args extra-args)) (require 'vc-dispatcher) (apply 'vc-do-async-command buffer root git-program command args) (with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'git) (setq-local compile-command - (concat git-program " " command " " extra-args " " - (if args (mapconcat 'identity args " ") ""))) + (concat git-program " " command " " + (mapconcat 'identity args " "))) (setq-local compilation-directory root) - (setq-local compilation-error-regexp-alist - vc-git-error-regexp-alist) ;; Either set `compilation-buffer-name-function' locally to nil ;; or use `compilation-arguments' to set `name-function'. ;; See `compilation-buffer-name'. @@ -909,13 +908,13 @@ If PROMPT is non-nil, prompt for the Git command to run." "Pull changes into the current Git branch. Normally, this runs \"git pull\". If PROMPT is non-nil, prompt for the Git command to run." - (vc-git--pushpull "pull" prompt "--stat")) + (vc-git--pushpull "pull" prompt '("--stat"))) (defun vc-git-push (prompt) "Push changes from the current Git branch. Normally, this runs \"git push\". If PROMPT is non-nil, prompt for the Git command to run." - (vc-git--pushpull "push" prompt "")) + (vc-git--pushpull "push" prompt nil)) (defun vc-git-merge-branch () "Merge changes into the current Git branch. diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 2deac2aae2..08b1be8f6d 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -1296,12 +1296,8 @@ REV is the revision to check out into WORKFILE." (vc-hg-command buffer 1 nil "outgoing" "-n" (unless (string= remote-location "") remote-location))) -(defvar vc-hg-error-regexp-alist nil - ;; 'hg pull' does not list modified files, so, for now, the only - ;; benefit of `vc-compilation-mode' is that one can get rid of - ;; *vc-hg* buffer with 'q' or 'z'. - ;; TODO: call 'hg incoming' before pull/merge to get the list of - ;; modified files +(defvar vc-hg-error-regexp-alist + '(("^M \\(.+\\)" 1 nil nil 0)) "Value of `compilation-error-regexp-alist' in *vc-hg* buffers.") (autoload 'vc-do-async-command "vc-dispatcher") @@ -1309,9 +1305,10 @@ REV is the revision to check out into WORKFILE." (defvar compilation-directory) (defvar compilation-arguments) ; defined in compile.el -(defun vc-hg--pushpull (command prompt &optional obsolete) +(defun vc-hg--pushpull (command prompt post-processing &optional obsolete) "Run COMMAND (a string; either push or pull) on the current Hg branch. If PROMPT is non-nil, prompt for the Hg command to run. +POST-PROCESSING is a list of commands to execute after the command. If OBSOLETE is non-nil, behave like the old versions of the Hg push/pull commands, which only operated on marked files." (let (marked-list) @@ -1327,18 +1324,14 @@ commands, which only operated on marked files." (let* ((root (vc-hg-root default-directory)) (buffer (format "*vc-hg : %s*" (expand-file-name root))) (hg-program vc-hg-program) - ;; Fixme: before updating the working copy to the latest - ;; state, should check if it's visiting an old revision. - (args (if (equal command "pull") '("-u")))) + args) ;; If necessary, prompt for the exact command. ;; TODO if pushing, prompt if no default push location - cf bzr. (when prompt (setq args (split-string (read-shell-command (format "Hg %s command: " command) - (format "%s %s%s" hg-program command - (if (not args) "" - (concat " " (mapconcat 'identity args " ")))) + (format "%s %s" hg-program command) 'vc-hg-history) " " t)) (setq hg-program (car args) @@ -1347,10 +1340,17 @@ commands, which only operated on marked files." (apply 'vc-do-async-command buffer root hg-program command args) (with-current-buffer buffer (vc-run-delayed + (dolist (cmd post-processing) + (apply 'vc-do-command buffer nil hg-program nil cmd)) (vc-compilation-mode 'hg) (setq-local compile-command (concat hg-program " " command " " - (if args (mapconcat 'identity args " ") ""))) + (mapconcat 'identity args " ") + (mapconcat (lambda (args) + (concat " && " hg-program " " + (mapconcat 'identity + args " "))) + post-processing ""))) (setq-local compilation-directory root) ;; Either set `compilation-buffer-name-function' locally to nil ;; or use `compilation-arguments' to set `name-function'. @@ -1371,7 +1371,15 @@ specific Mercurial pull command. The default is \"hg pull -u\", which fetches changesets from the default remote repository and then attempts to update the working directory." (interactive "P") - (vc-hg--pushpull "pull" prompt (called-interactively-p 'interactive))) + (vc-hg--pushpull "pull" prompt + ;; Fixme: before updating the working copy to the latest + ;; state, should check if it's visiting an old revision. + ;; post-processing: list modified files and update + ;; NB: this will not work with "pull = --rebase" + ;; or "pull = --update" in hgrc. + '(("--pager" "no" "status" "--rev" "." "--rev" "tip") + ("update")) + (called-interactively-p 'interactive))) (defun vc-hg-push (prompt) "Push changes from the current Mercurial branch. @@ -1381,7 +1389,7 @@ for the Hg command to run. If called interactively with a set of marked Log View buffers, call \"hg push -r REVS\" to push the specified revisions REVS." (interactive "P") - (vc-hg--pushpull "push" prompt (called-interactively-p 'interactive))) + (vc-hg--pushpull "push" prompt nil (called-interactively-p 'interactive))) (defun vc-hg-merge-branch () "Merge incoming changes into the current working directory. commit 66a491fbec005b6a7ba255612ddb6efcf1a4bbcb Author: Sam Steingold <sds@gnu.org> Date: Wed Nov 1 19:13:46 2017 -0400 Fix Bug#11728: show files updated by git * lisp/vc/vc-git.el (vc-git--pushpull): Accept extra-args and set `compilation-error-regexp-alist' to `vc-git-error-regexp-alist'. (vc-git-pull): Pass "--stat" as `extra-args' to `vc-git--pushpull'. (vc-git-push): Pass "" as `extra-args' to `vc-git--pushpull'. diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index efe853e5ee..6650c5d764 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -866,7 +866,7 @@ It is based on `log-edit-mode', and has Git-specific extensions.") ;; To be called via vc-pull from vc.el, which requires vc-dispatcher. (declare-function vc-compilation-mode "vc-dispatcher" (backend)) -(defun vc-git--pushpull (command prompt) +(defun vc-git--pushpull (command prompt extra-args) "Run COMMAND (a string; either push or pull) on the current Git branch. If PROMPT is non-nil, prompt for the Git command to run." (let* ((root (vc-git-root default-directory)) @@ -891,9 +891,11 @@ If PROMPT is non-nil, prompt for the Git command to run." (vc-run-delayed (vc-compilation-mode 'git) (setq-local compile-command - (concat git-program " " command " " + (concat git-program " " command " " extra-args " " (if args (mapconcat 'identity args " ") ""))) (setq-local compilation-directory root) + (setq-local compilation-error-regexp-alist + vc-git-error-regexp-alist) ;; Either set `compilation-buffer-name-function' locally to nil ;; or use `compilation-arguments' to set `name-function'. ;; See `compilation-buffer-name'. @@ -907,13 +909,13 @@ If PROMPT is non-nil, prompt for the Git command to run." "Pull changes into the current Git branch. Normally, this runs \"git pull\". If PROMPT is non-nil, prompt for the Git command to run." - (vc-git--pushpull "pull" prompt)) + (vc-git--pushpull "pull" prompt "--stat")) (defun vc-git-push (prompt) "Push changes from the current Git branch. Normally, this runs \"git push\". If PROMPT is non-nil, prompt for the Git command to run." - (vc-git--pushpull "push" prompt)) + (vc-git--pushpull "push" prompt "")) (defun vc-git-merge-branch () "Merge changes into the current Git branch. commit 5bdc344780faabbc91b7e55306b2071dffb44fa2 Author: Noam Postavsky <npostavs@gmail.com> Date: Wed Jun 6 21:25:52 2018 -0400 ; Reduce quoting for SELECTOR in 'make -C test' (Bug#31744) Before: make -C test SELECTOR='\"foo\"' make -C test SELECTOR='(quote (tag :some-tag))' After: make -C test SELECTOR='"foo"' make -C test SELECTOR='(tag :some-tag)' * test/Makefile.in: Use single quotes around the command line call to ert, this means the user doesn't have to backslash escape double quotes when writing lisp strings for the selector. Also wrap the SELECTOR value in (quote ...) so the user won't have to type it in (and not get tempted to use the '... reader syntax form which would now fail to work due to using single quotes around the whole shell arg). * test/README: Update instructions accordingly. diff --git a/test/Makefile.in b/test/Makefile.in index 451513a747..597ef91311 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -98,9 +98,9 @@ TEST_LOCALE = C TEST_INTERACTIVE ?= no ifeq ($(TEST_INTERACTIVE),yes) -TEST_RUN_ERT = --eval "(ert ${SELECTOR_ACTUAL})" +TEST_RUN_ERT = --eval '(ert (quote ${SELECTOR_ACTUAL}))' else -TEST_RUN_ERT = --batch --eval "(ert-run-tests-batch-and-exit ${SELECTOR_ACTUAL})" ${WRITE_LOG} +TEST_RUN_ERT = --batch --eval '(ert-run-tests-batch-and-exit (quote ${SELECTOR_ACTUAL}))' ${WRITE_LOG} endif # Whether to run tests from .el files in preference to .elc, we do @@ -140,8 +140,8 @@ test_module_dir := $(srcdir)/data/emacs-module all: check -SELECTOR_DEFAULT = (quote (not (or (tag :expensive-test) (tag :unstable)))) -SELECTOR_EXPENSIVE = (quote (not (tag :unstable))) +SELECTOR_DEFAULT = (not (or (tag :expensive-test) (tag :unstable))) +SELECTOR_EXPENSIVE = (not (tag :unstable)) SELECTOR_ALL = t ifdef SELECTOR SELECTOR_ACTUAL=$(SELECTOR) diff --git a/test/README b/test/README index c1dde2e0d0..e473248c9e 100644 --- a/test/README +++ b/test/README @@ -42,7 +42,10 @@ except the tests tagged as expensive. If your test file contains the tests "test-foo", "test2-foo" and "test-foo-remote", and you want to run only the former two tests, you -could use a selector regexp: "make <filename> SELECTOR='\"foo$$\"'". +could use a selector regexp (note that the "$" needs to be doubled to +protect against "make" variable expansion): + + make <filename> SELECTOR='"foo$$"' Note that although the test files are always compiled (unless they set no-byte-compile), the source files will be run by default, to give commit b6b793bd77cb8be0a2d2745262e53037dc6798a0 Author: Noam Postavsky <npostavs@gmail.com> Date: Sat Dec 16 20:06:11 2017 -0500 ; test/Makefile.in: Add TEST_INTERACTIVE option (Bug#31744). * test/README: Note the new option. diff --git a/test/Makefile.in b/test/Makefile.in index e6b3f77523..451513a747 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -81,7 +81,7 @@ EMACS_EXTRAOPT= # Command line flags for Emacs. # Apparently MSYS bash would convert "-L :" to "-L ;" anyway, # but we might as well be explicit. -EMACSOPT = -batch --no-site-file --no-site-lisp -L "$(SEPCHAR)$(srcdir)" $(EMACS_EXTRAOPT) +EMACSOPT = --no-init-file --no-site-file --no-site-lisp -L "$(SEPCHAR)$(srcdir)" $(EMACS_EXTRAOPT) # Prevent any settings in the user environment causing problems. unexport EMACSDATA EMACSDOC EMACSPATH GREP_OPTIONS @@ -94,6 +94,15 @@ GDB = # supported everywhere. TEST_LOCALE = C +# Set this to 'yes' to run the tests in an interactive instance. +TEST_INTERACTIVE ?= no + +ifeq ($(TEST_INTERACTIVE),yes) +TEST_RUN_ERT = --eval "(ert ${SELECTOR_ACTUAL})" +else +TEST_RUN_ERT = --batch --eval "(ert-run-tests-batch-and-exit ${SELECTOR_ACTUAL})" ${WRITE_LOG} +endif + # Whether to run tests from .el files in preference to .elc, we do # this by default since it gives nicer stacktraces. TEST_LOAD_EL ?= yes @@ -120,6 +129,11 @@ emacs = EMACSLOADPATH= LC_ALL=$(TEST_LOCALE) \ EMACS_TEST_DIRECTORY=$(abspath $(srcdir)) \ $(GDB) "$(EMACS)" $(MODULES_EMACSOPT) $(EMACSOPT) +# Set HOME to a nonexistent directory to prevent tests from accessing +# it accidentally (e.g., popping up a gnupg dialog if ~/.authinfo.gpg +# exists, or writing to ~/.bzr.log when running bzr commands). +TEST_HOME = /nonexistent + test_module_dir := $(srcdir)/data/emacs-module .PHONY: all check @@ -128,7 +142,7 @@ all: check SELECTOR_DEFAULT = (quote (not (or (tag :expensive-test) (tag :unstable)))) SELECTOR_EXPENSIVE = (quote (not (tag :unstable))) -SELECTOR_ALL = nil +SELECTOR_ALL = t ifdef SELECTOR SELECTOR_ACTUAL=$(SELECTOR) else ifndef MAKECMDGOALS @@ -145,7 +159,7 @@ endif ## Byte-compile all test files to test for errors. %.elc: %.el - $(AM_V_ELC)$(emacs) -f batch-byte-compile $< + $(AM_V_ELC)$(emacs) --batch -f batch-byte-compile $< ## Save logs, and show logs for failed tests. WRITE_LOG = > $@ 2>&1 || { STAT=$$?; cat $@; exit $$STAT; } @@ -158,9 +172,9 @@ endif %.log: %.elc $(AM_V_at)${MKDIR_P} $(dir $@) - $(AM_V_GEN)HOME=/nonexistent $(emacs) \ + $(AM_V_GEN)HOME=$(TEST_HOME) $(emacs) \ -l ert ${ert_opts} -l $(testloadfile) \ - --eval "(ert-run-tests-batch-and-exit ${SELECTOR_ACTUAL})" ${WRITE_LOG} + $(TEST_RUN_ERT) ifeq (@HAVE_MODULES@, yes) maybe_exclude_module_tests := @@ -260,8 +274,15 @@ check-maybe: check-no-automated-subdir ## We can't put LOGFILES as prerequisites, because that would stop the ## summarizing step from running when there is an error. check-doit: +ifeq ($(TEST_INTERACTIVE), yes) + HOME=$(TEST_HOME) $(emacs) \ + -l ert ${ert_opts} \ + $(patsubst %,-l %,$(if $(findstring $(TEST_LOAD_EL),yes),$ELFILES,$(ELFILES:.el=))) \ + $(TEST_RUN_ERT) +else -@${MAKE} -k ${LOGFILES} - @$(emacs) -l ert -f ert-summarize-tests-batch-and-exit ${LOGFILES} + @$(emacs) --batch -l ert -f ert-summarize-tests-batch-and-exit ${LOGFILES} +endif .PHONY: mostlyclean clean bootstrap-clean distclean maintainer-clean diff --git a/test/README b/test/README index 1cd9db3bb8..c1dde2e0d0 100644 --- a/test/README +++ b/test/README @@ -50,6 +50,12 @@ nicer backtraces. To run the compiled version of a test use make TEST_LOAD_EL=no ... +The tests are run in batch mode by default; sometimes it's useful to +get precisely the same environment but run in interactive mode for +debugging. To do that, use + + make TEST_INTERACTIVE=yes ... + (Also, see etc/compilation.txt for compilation mode font lock tests.) commit 1aa906f10d3a5dc3905c2f74cddbfd8c6cb8eb7a Author: Noam Postavsky <npostavs@gmail.com> Date: Thu Dec 7 04:31:47 2017 -0500 Make 'tags' targets respect --with-silent-rules (Bug#31744) * lwlib/Makefile.in (TAGS): * lisp/Makefile.in (TAGS): * src/Makefile.in (TAGS): Use AM_V_GEN and AM_V_at. * src/Makefile.in: Note that TAGS are generated in build dir. diff --git a/lisp/Makefile.in b/lisp/Makefile.in index d4709bd79d..05fca9579f 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -259,9 +259,9 @@ ${ETAGS}: FORCE ## compile-main. But maybe this is not even necessary any more now ## that this uses relative filenames. TAGS: ${ETAGS} ${tagsfiles} - rm -f $@ - touch $@ - ls ${tagsfiles} | xargs $(XARGS_LIMIT) "${ETAGS}" -a -o $@ + $(AM_V_at)rm -f $@ + $(AM_V_at)touch $@ + $(AM_V_GEN)ls ${tagsfiles} | xargs $(XARGS_LIMIT) "${ETAGS}" -a -o $@ # The src/Makefile.in has its own set of dependencies and when they decide diff --git a/lwlib/Makefile.in b/lwlib/Makefile.in index 32d7a91f9b..6bd2608381 100644 --- a/lwlib/Makefile.in +++ b/lwlib/Makefile.in @@ -131,6 +131,6 @@ FORCE: .PHONY: tags FORCE tags: TAGS TAGS: ${ETAGS} $(ctagsfiles) - ${ETAGS} $(ctagsfiles) + $(AM_V_GEN)${ETAGS} $(ctagsfiles) ### Makefile.in ends here diff --git a/src/Makefile.in b/src/Makefile.in index 15ca1667d6..6ed8f3cc91 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -674,13 +674,14 @@ ${ETAGS}: FORCE ctagsfiles1 = $(wildcard ${srcdir}/*.[hc]) ctagsfiles2 = $(wildcard ${srcdir}/*.m) -## FIXME? In out-of-tree builds, should TAGS be generated in srcdir? +## In out-of-tree builds, TAGS are generated in the build dir, like +## other non-bootstrap build products (see Bug#31744). ## This does not need to depend on ../lisp and ../lwlib TAGS files, ## because etags "--include" only includes a pointer to the file, ## rather than the file contents. TAGS: ${ETAGS} $(ctagsfiles1) $(ctagsfiles2) - ${ETAGS} --include=../lisp/TAGS --include=$(lwlibdir)/TAGS \ + $(AM_V_GEN)${ETAGS} --include=../lisp/TAGS --include=$(lwlibdir)/TAGS \ --regex='{c}/[ ]*DEFVAR_[A-Z_ (]+"\([^"]+\)"/\1/' \ --regex='{c}/[ ]*DEFVAR_[A-Z_ (]+"[^"]+",[ ]\([A-Za-z0-9_]+\)/\1/' \ $(ctagsfiles1) \ commit 642c11fdd179c9b7de32c4c83bf17b073dcdd527 Author: Thomas Fitzsimmons <fitzsim@fitzsim.org> Date: Fri Jun 8 22:41:28 2018 -0400 soap-client: Add byte-code compatibility function (Bug#31742) * lisp/net/soap-client.el: Bump version to 3.1.4. (soap-type-of): New function. (soap-resolve-references, soap-decode-type) (soap-encode-attributes, soap-encode-value): Replace aref calls with calls to soap-type-of. * lisp/net/soap-inspect.el (soap-sample-value, soap-inspect): Replace aref calls with calls to soap-type-of. Co-authored-by: Noam Postavsky <npostavs@gmail.com> Backport: (cherry picked from commit 1feb2e221349f26ec26bc684e0cce2acecbed3ca) diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el index 3996da0b55..17f83082f8 100644 --- a/lisp/net/soap-client.el +++ b/lisp/net/soap-client.el @@ -5,7 +5,7 @@ ;; Author: Alexandru Harsanyi <AlexHarsanyi@gmail.com> ;; Author: Thomas Fitzsimmons <fitzsim@fitzsim.org> ;; Created: December, 2009 -;; Version: 3.1.3 +;; Version: 3.1.4 ;; Keywords: soap, web-services, comm, hypermedia ;; Package: soap-client ;; Homepage: https://github.com/alex-hhh/emacs-soap-client @@ -685,8 +685,17 @@ This is a specialization of `soap-decode-type' for (anyType (soap-decode-any-type node)) (Array (soap-decode-array node)))))) +(defun soap-type-of (element) + "Return the type of ELEMENT." + ;; Support Emacs < 26 byte-code running in Emacs >= 26 sessions + ;; (Bug#31742). + (let ((type (type-of element))) + (if (eq type 'vector) + (aref element 0) ; For Emacs 25 and earlier. + type))) + ;; Register methods for `soap-xs-basic-type' -(let ((tag (aref (make-soap-xs-basic-type) 0))) +(let ((tag (soap-type-of (make-soap-xs-basic-type)))) (put tag 'soap-attribute-encoder #'soap-encode-xs-basic-type-attributes) (put tag 'soap-encoder #'soap-encode-xs-basic-type) (put tag 'soap-decoder #'soap-decode-xs-basic-type)) @@ -915,7 +924,7 @@ This is a specialization of `soap-decode-type' for (soap-decode-type type node))) ;; Register methods for `soap-xs-element' -(let ((tag (aref (make-soap-xs-element) 0))) +(let ((tag (soap-type-of (make-soap-xs-element)))) (put tag 'soap-resolve-references #'soap-resolve-references-for-xs-element) (put tag 'soap-attribute-encoder #'soap-encode-xs-element-attributes) (put tag 'soap-encoder #'soap-encode-xs-element) @@ -1011,7 +1020,7 @@ See also `soap-wsdl-resolve-references'." (setf (soap-xs-attribute-reference attribute) (soap-wsdl-get reference wsdl predicate))))) -(put (aref (make-soap-xs-attribute) 0) +(put (soap-type-of (make-soap-xs-attribute)) 'soap-resolve-references #'soap-resolve-references-for-xs-attribute) (defun soap-resolve-references-for-xs-attribute-group (attribute-group wsdl) @@ -1036,7 +1045,7 @@ See also `soap-wsdl-resolve-references'." (setf (soap-xs-attribute-group-attribute-groups attribute-group) (soap-xs-attribute-group-attribute-groups resolved)))))) -(put (aref (make-soap-xs-attribute-group) 0) +(put (soap-type-of (make-soap-xs-attribute-group)) 'soap-resolve-references #'soap-resolve-references-for-xs-attribute-group) ;;;;; soap-xs-simple-type @@ -1374,7 +1383,7 @@ This is a specialization of `soap-decode-type' for (soap-validate-xs-simple-type value type)))) ;; Register methods for `soap-xs-simple-type' -(let ((tag (aref (make-soap-xs-simple-type) 0))) +(let ((tag (soap-type-of (make-soap-xs-simple-type)))) (put tag 'soap-resolve-references #'soap-resolve-references-for-xs-simple-type) (put tag 'soap-attribute-encoder #'soap-encode-xs-simple-type-attributes) @@ -1927,7 +1936,7 @@ This is a specialization of `soap-decode-type' for (soap-xs-complex-type-indicator type))))) ;; Register methods for `soap-xs-complex-type' -(let ((tag (aref (make-soap-xs-complex-type) 0))) +(let ((tag (soap-type-of (make-soap-xs-complex-type)))) (put tag 'soap-resolve-references #'soap-resolve-references-for-xs-complex-type) (put tag 'soap-attribute-encoder #'soap-encode-xs-complex-type-attributes) @@ -2147,7 +2156,7 @@ This is a generic function which invokes a specific resolver function depending on the type of the ELEMENT. If ELEMENT has no resolver function, it is silently ignored." - (let ((resolver (get (aref element 0) 'soap-resolve-references))) + (let ((resolver (get (soap-type-of element) 'soap-resolve-references))) (when resolver (funcall resolver element wsdl)))) @@ -2272,13 +2281,13 @@ See also `soap-wsdl-resolve-references'." ;; Install resolvers for our types (progn - (put (aref (make-soap-message) 0) 'soap-resolve-references + (put (soap-type-of (make-soap-message)) 'soap-resolve-references 'soap-resolve-references-for-message) - (put (aref (make-soap-operation) 0) 'soap-resolve-references + (put (soap-type-of (make-soap-operation)) 'soap-resolve-references 'soap-resolve-references-for-operation) - (put (aref (make-soap-binding) 0) 'soap-resolve-references + (put (soap-type-of (make-soap-binding)) 'soap-resolve-references 'soap-resolve-references-for-binding) - (put (aref (make-soap-port) 0) 'soap-resolve-references + (put (soap-type-of (make-soap-port)) 'soap-resolve-references 'soap-resolve-references-for-port)) (defun soap-wsdl-resolve-references (wsdl) @@ -2685,16 +2694,17 @@ decode function to perform the actual decoding." (cond ((listp type) (catch 'done (dolist (union-member type) - (let* ((decoder (get (aref union-member 0) + (let* ((decoder (get (soap-type-of union-member) 'soap-decoder)) (result (ignore-errors (funcall decoder union-member node)))) (when result (throw 'done result)))))) (t - (let ((decoder (get (aref type 0) 'soap-decoder))) + (let ((decoder (get (soap-type-of type) 'soap-decoder))) (cl-assert decoder nil - "no soap-decoder for %s type" (aref type 0)) + "no soap-decoder for %s type" + (soap-type-of type)) (funcall decoder type node)))))))))) (defun soap-decode-any-type (node) @@ -2878,9 +2888,9 @@ for the type and calls that specialized function to do the work. Attributes are inserted in the current buffer at the current position." - (let ((attribute-encoder (get (aref type 0) 'soap-attribute-encoder))) + (let ((attribute-encoder (get (soap-type-of type) 'soap-attribute-encoder))) (cl-assert attribute-encoder nil - "no soap-attribute-encoder for %s type" (aref type 0)) + "no soap-attribute-encoder for %s type" (soap-type-of type)) (funcall attribute-encoder value type))) (defun soap-encode-value (value type) @@ -2892,8 +2902,8 @@ TYPE is one of the soap-*-type structures which defines how VALUE is to be encoded. This is a generic function which finds an encoder function based on TYPE and calls that encoder to do the work." - (let ((encoder (get (aref type 0) 'soap-encoder))) - (cl-assert encoder nil "no soap-encoder for %s type" (aref type 0)) + (let ((encoder (get (soap-type-of type) 'soap-encoder))) + (cl-assert encoder nil "no soap-encoder for %s type" (soap-type-of type)) (funcall encoder value type)) (when (soap-element-namespace-tag type) (add-to-list 'soap-encoded-namespaces (soap-element-namespace-tag type)))) diff --git a/lisp/net/soap-inspect.el b/lisp/net/soap-inspect.el index 050be453db..252b1f35ff 100644 --- a/lisp/net/soap-inspect.el +++ b/lisp/net/soap-inspect.el @@ -49,10 +49,10 @@ for encoding it using TYPE when making SOAP requests. This is a generic function, depending on TYPE a specific function will be called." - (let ((sample-value (get (aref type 0) 'soap-sample-value))) + (let ((sample-value (get (soap-type-of type) 'soap-sample-value))) (if sample-value (funcall sample-value type) - (error "Cannot provide sample value for type %s" (aref type 0))))) + (error "Cannot provide sample value for type %s" (soap-type-of type))))) (defun soap-sample-value-for-xs-basic-type (type) "Provide a sample value for TYPE, an xs-basic-type. @@ -174,31 +174,31 @@ This is a specialization of `soap-sample-value' for (progn ;; Install soap-sample-value methods for our types - (put (aref (make-soap-xs-basic-type) 0) + (put (soap-type-of (make-soap-xs-basic-type)) 'soap-sample-value 'soap-sample-value-for-xs-basic-type) - (put (aref (make-soap-xs-element) 0) + (put (soap-type-of (make-soap-xs-element)) 'soap-sample-value 'soap-sample-value-for-xs-element) - (put (aref (make-soap-xs-attribute) 0) + (put (soap-type-of (make-soap-xs-attribute)) 'soap-sample-value 'soap-sample-value-for-xs-attribute) - (put (aref (make-soap-xs-attribute) 0) + (put (soap-type-of (make-soap-xs-attribute)) 'soap-sample-value 'soap-sample-value-for-xs-attribute-group) - (put (aref (make-soap-xs-simple-type) 0) + (put (soap-type-of (make-soap-xs-simple-type)) 'soap-sample-value 'soap-sample-value-for-xs-simple-type) - (put (aref (make-soap-xs-complex-type) 0) + (put (soap-type-of (make-soap-xs-complex-type)) 'soap-sample-value 'soap-sample-value-for-xs-complex-type) - (put (aref (make-soap-message) 0) + (put (soap-type-of (make-soap-message)) 'soap-sample-value 'soap-sample-value-for-message)) @@ -222,7 +222,7 @@ Used to implement the BACK button.") The buffer is populated with information about ELEMENT with links to its sub elements. If ELEMENT is the WSDL document itself, the entire WSDL can be inspected." - (let ((inspect (get (aref element 0) 'soap-inspect))) + (let ((inspect (get (soap-type-of element) 'soap-inspect))) (unless inspect (error "Soap-inspect: no inspector for element")) @@ -507,39 +507,39 @@ TYPE is a `soap-xs-complex-type'" (progn ;; Install the soap-inspect methods for our types - (put (aref (make-soap-xs-basic-type) 0) 'soap-inspect + (put (soap-type-of (make-soap-xs-basic-type)) 'soap-inspect 'soap-inspect-xs-basic-type) - (put (aref (make-soap-xs-element) 0) 'soap-inspect + (put (soap-type-of (make-soap-xs-element)) 'soap-inspect 'soap-inspect-xs-element) - (put (aref (make-soap-xs-simple-type) 0) 'soap-inspect + (put (soap-type-of (make-soap-xs-simple-type)) 'soap-inspect 'soap-inspect-xs-simple-type) - (put (aref (make-soap-xs-complex-type) 0) 'soap-inspect + (put (soap-type-of (make-soap-xs-complex-type)) 'soap-inspect 'soap-inspect-xs-complex-type) - (put (aref (make-soap-xs-attribute) 0) 'soap-inspect + (put (soap-type-of (make-soap-xs-attribute)) 'soap-inspect 'soap-inspect-xs-attribute) - (put (aref (make-soap-xs-attribute-group) 0) 'soap-inspect + (put (soap-type-of (make-soap-xs-attribute-group)) 'soap-inspect 'soap-inspect-xs-attribute-group) - (put (aref (make-soap-message) 0) 'soap-inspect + (put (soap-type-of (make-soap-message)) 'soap-inspect 'soap-inspect-message) - (put (aref (make-soap-operation) 0) 'soap-inspect + (put (soap-type-of (make-soap-operation)) 'soap-inspect 'soap-inspect-operation) - (put (aref (make-soap-port-type) 0) 'soap-inspect + (put (soap-type-of (make-soap-port-type)) 'soap-inspect 'soap-inspect-port-type) - (put (aref (make-soap-binding) 0) 'soap-inspect + (put (soap-type-of (make-soap-binding)) 'soap-inspect 'soap-inspect-binding) - (put (aref (make-soap-port) 0) 'soap-inspect + (put (soap-type-of (make-soap-port)) 'soap-inspect 'soap-inspect-port) - (put (aref (soap-make-wsdl "origin") 0) 'soap-inspect + (put (soap-type-of (soap-make-wsdl "origin")) 'soap-inspect 'soap-inspect-wsdl)) (provide 'soap-inspect) commit 9c6f35a6b2071669b88a3fd72456cced5fd55bff Author: Eli Zaretskii <eliz@gnu.org> Date: Mon Jun 11 19:58:14 2018 +0300 * doc/lispref/files.texi (Unique File Names): Fix a typo. (Bug#31784) diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 6dfca0f212..c434336d5a 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -2573,10 +2573,10 @@ This function creates a temporary file and returns its name. Emacs creates the temporary file's name by adding to @var{prefix} some random characters that are different in each Emacs job. The result is guaranteed to be a newly created file, containing @var{text} if that's -given as a string and empty otherwise. On MS-DOS, this function -can truncate the @var{string} prefix to fit into the 8+3 file-name -limits. If @var{prefix} is a relative file name, it is expanded -against @code{temporary-file-directory}. +given as a string and empty otherwise. On MS-DOS, this function can +truncate @var{prefix} to fit into the 8+3 file-name limits. If +@var{prefix} is a relative file name, it is expanded against +@code{temporary-file-directory}. @example @group